selection mostly working
This commit is contained in:
parent
25b8d47e45
commit
a73bdac979
106
kodiak.tal
106
kodiak.tal
|
@ -25,7 +25,7 @@
|
||||||
|
|
||||||
|0000
|
|0000
|
||||||
|
|
||||||
@stock $34 ( draw pile - 52 bytes )
|
@stock $34 ( draw pile - 52 bytes, 24 bytes at start )
|
||||||
@waste $18 ( face up pile - 24 bytes )
|
@waste $18 ( face up pile - 24 bytes )
|
||||||
@foundation $4 ( one per suit - 4 bytes, 4x1 )
|
@foundation $4 ( one per suit - 4 bytes, 4x1 )
|
||||||
@tableau $85 ( the main board - 133 bytes, 7x19 )
|
@tableau $85 ( the main board - 133 bytes, 7x19 )
|
||||||
|
@ -47,9 +47,18 @@
|
||||||
init-rng-from-datetime
|
init-rng-from-datetime
|
||||||
init-stock init-waste init-foundation
|
init-stock init-waste init-foundation
|
||||||
shuffle-stock deal-tableau
|
shuffle-stock deal-tableau
|
||||||
draw-background
|
|
||||||
draw-stock draw-waste draw-foundation draw-tableau
|
|
||||||
|
|
||||||
|
( for now, we'll deal the first 3 cards to the waste for testing )
|
||||||
|
( TODO: implement deal-waste )
|
||||||
|
#17 LDZ #bf AND .waste #00 ADD STZ #0017 STZ
|
||||||
|
#16 LDZ #bf AND .waste #01 ADD STZ #0016 STZ
|
||||||
|
#15 LDZ #bf AND .waste #02 ADD STZ #0015 STZ
|
||||||
|
|
||||||
|
draw-background
|
||||||
|
draw-stock
|
||||||
|
draw-waste
|
||||||
|
draw-foundation
|
||||||
|
draw-tableau
|
||||||
;on-mouse .Mouse/vect DEO2
|
;on-mouse .Mouse/vect DEO2
|
||||||
( ;on-key .Controller/vect DEO2 )
|
( ;on-key .Controller/vect DEO2 )
|
||||||
BRK
|
BRK
|
||||||
|
@ -98,6 +107,7 @@
|
||||||
INCr !&loop ( d+1^ s-1^ [-c+1^] )
|
INCr !&loop ( d+1^ s-1^ [-c+1^] )
|
||||||
&done POPr SWP ( s^ d^)
|
&done POPr SWP ( s^ d^)
|
||||||
OVR LDZ #bf AND SWP STZ ( s^ ; d<-s )
|
OVR LDZ #bf AND SWP STZ ( s^ ; d<-s )
|
||||||
|
#00 OVR STZ ( s^ ; s<-0 )
|
||||||
#01 SUB JMP2r ( s-1^ )
|
#01 SUB JMP2r ( s-1^ )
|
||||||
|
|
||||||
@swap-c ( src^ dst^ -> )
|
@swap-c ( src^ dst^ -> )
|
||||||
|
@ -117,7 +127,7 @@
|
||||||
draw-c STHkr ?&skip ( lim^ zp^ [n^] ; draw c )
|
draw-c STHkr ?&skip ( lim^ zp^ [n^] ; draw c )
|
||||||
,&y LDR2 #0001 SUB2 ,&y STR2 ( lim^ zp^ [n^] ; y<-y-1 )
|
,&y LDR2 #0001 SUB2 ,&y STR2 ( lim^ zp^ [n^] ; y<-y-1 )
|
||||||
&skip INC INCr LITr 07 ANDr GTHk ?&loop ( lim^ zp+1^ [(n+1)%8] )
|
&skip INC INCr LITr 07 ANDr GTHk ?&loop ( lim^ zp+1^ [(n+1)%8] )
|
||||||
&done POP2 POPr JMP2r ( )
|
&done POP POP2 POPr JMP2r ( )
|
||||||
|
|
||||||
@draw-waste ( -> )
|
@draw-waste ( -> )
|
||||||
#001c ,&x STR2 ( ; x0<-28 )
|
#001c ,&x STR2 ( ; x0<-28 )
|
||||||
|
@ -129,7 +139,7 @@
|
||||||
draw-c ( lim^ zp^ ; draw c )
|
draw-c ( lim^ zp^ ; draw c )
|
||||||
,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 )
|
,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 )
|
||||||
INC GTHk ?&loop ( lim^ zp+1^ )
|
INC GTHk ?&loop ( lim^ zp+1^ )
|
||||||
&done POP2 JMP2r ( )
|
&done POP POP2 JMP2r ( )
|
||||||
|
|
||||||
@draw-foundation ( -> )
|
@draw-foundation ( -> )
|
||||||
#0030 ,&y STR2 ( ; y0<-48 )
|
#0030 ,&y STR2 ( ; y0<-48 )
|
||||||
|
@ -143,7 +153,7 @@
|
||||||
POP2 JMP2r ( )
|
POP2 JMP2r ( )
|
||||||
|
|
||||||
@draw-tableau
|
@draw-tableau
|
||||||
#0700 &loop DUP draw-column INC GTHk ?&loop JMP2r
|
#0700 &loop DUP draw-column INC GTHk ?&loop POP2 JMP2r
|
||||||
|
|
||||||
@draw-column ( idx^ -> )
|
@draw-column ( idx^ -> )
|
||||||
#00 OVR #0018 MUL2 #0030 ADD2 ,&x STR2 ( idx^ ; x<-32+24*idx )
|
#00 OVR #0018 MUL2 #0030 ADD2 ,&x STR2 ( idx^ ; x<-32+24*idx )
|
||||||
|
@ -170,7 +180,7 @@
|
||||||
POP !draw-mask-down
|
POP !draw-mask-down
|
||||||
&norm adjust-c !draw-face-up
|
&norm adjust-c !draw-face-up
|
||||||
&down POP !draw-face-down
|
&down POP !draw-face-down
|
||||||
&held adjust-c !draw-mask-up
|
&held #3f AND adjust-c !draw-mask-up
|
||||||
|
|
||||||
( we map from our sparse, logical card format )
|
( we map from our sparse, logical card format )
|
||||||
( to the dense, tile position card location )
|
( to the dense, tile position card location )
|
||||||
|
@ -191,19 +201,10 @@
|
||||||
.Mouse/state DEI .prev-mouse-state STZ
|
.Mouse/state DEI .prev-mouse-state STZ
|
||||||
BRK
|
BRK
|
||||||
|
|
||||||
@mouse-dx ( -> dx* ) .Mouse/x DEI2 .prev-mouse-x LDZ2 SUB2 JMP2r
|
|
||||||
@mouse-dy ( -> dy* ) .Mouse/y DEI2 .prev-mouse-y LDZ2 SUB2 JMP2r
|
|
||||||
|
|
||||||
@mouse-dx8 ( -> dx^ ) .Mouse/x DEI2 .prev-mouse-x LDZ2 SUB2 NIP JMP2r
|
|
||||||
@mouse-dy8 ( -> dy^ ) .Mouse/y DEI2 .prev-mouse-y LDZ2 SUB2 NIP JMP2r
|
|
||||||
|
|
||||||
@on-move ( -> )
|
@on-move ( -> )
|
||||||
.Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw
|
.Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?draw-mouse
|
||||||
.Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw
|
.Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?draw-mouse
|
||||||
JMP2r
|
JMP2r
|
||||||
&redraw ( #00 .Screen/auto DEO )
|
|
||||||
!draw-mouse
|
|
||||||
( clear-prev-mouse draw-curr-mouse JMP2r )
|
|
||||||
|
|
||||||
@draw-mouse ( -> )
|
@draw-mouse ( -> )
|
||||||
#00 .Screen/auto DEO
|
#00 .Screen/auto DEO
|
||||||
|
@ -224,31 +225,60 @@
|
||||||
@on-click-down ( -> )
|
@on-click-down ( -> )
|
||||||
.Mouse/state DEI ( state^ )
|
.Mouse/state DEI ( state^ )
|
||||||
.prev-mouse-state LDZ #ff EOR AND ( down^ )
|
.prev-mouse-state LDZ #ff EOR AND ( down^ )
|
||||||
#01 AND ?{ JMP2r } !maybe-select-card
|
#01 AND ?&ok JMP2r &ok
|
||||||
|
|
||||||
@maybe-select-card ( -> )
|
|
||||||
.Mouse/x DEI2 .Mouse/y DEI2
|
|
||||||
maybe-select-stock ?&done
|
maybe-select-stock ?&done
|
||||||
|
maybe-select-waste ?&done
|
||||||
|
maybe-select-tableau ?&done
|
||||||
&done JMP2r
|
&done JMP2r
|
||||||
|
|
||||||
@top-stock ( -> zp^ )
|
@find-top ( lim^ start^ -> zp^ )
|
||||||
.stock #34 OVR ADD SWP
|
|
||||||
&loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r
|
&loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r
|
||||||
|
|
||||||
@maybe-select-stock ( x* y* -> bool^ )
|
@top-stock ( -> zp^ ) .stock #34 OVR ADD SWP !find-top
|
||||||
top-stock STH ( [z^] )
|
@top-waste ( -> zp^ ) .waste #18 OVR ADD SWP !find-top
|
||||||
OVR2 #0008 LTH2 ?&no1 ( x* y* [z^] ; x<8 )
|
|
||||||
SWP2 #0017 GTH2 ?&no2 ( y* [z^] ; x>=16 )
|
@top-column ( i^ -> zp^ )
|
||||||
#00 STHkr .stock SUB #03 SFT2 ( y* d* [z^] )
|
#13 MUL .tableau ADD #13 OVR ADD SWP !find-top
|
||||||
SWP2 STH2 ( d* [z^ y*] )
|
|
||||||
#0020 ( d* max=32-d* [z^ y*] )
|
@maybe-select-stock ( -> bool^ )
|
||||||
#0008 ROT2 SUB2 ( max* min=8-d* [z^ y*] )
|
.Mouse/x DEI2 #0008 LTH2 ?&no1 ( ; x<8 )
|
||||||
STH2kr GTH2 ?&no3 ( max* [z^ y*] )
|
.Mouse/x DEI2 #0017 GTH2 ?&no1 ( ; x>=23 )
|
||||||
STH2r LTH2 ?&no4 ( [z^] )
|
.Mouse/y DEI2 #0020 GTH2 ?&no1 ( ; y>=32 )
|
||||||
STHr LDZk #80 EOR SWP STZ ( ; z<-z^0x80 )
|
top-stock STHk #00 EQU ?&no2 ( [z^] ; unset card )
|
||||||
draw-stock #01 JMP2r ( 1^ )
|
#0008 ( 8* [z^] )
|
||||||
&no1 POP2 &no2 POP2 POPr #00 JMP2r ( 0^ )
|
#00 STHkr .stock SUB #03 SFT2 SUB2 ( min=8-[z-stock]/8* [z^] )
|
||||||
&no3 POP2 POP2r &no4 POPr #00 JMP2r ( 0^ )
|
.Mouse/y DEI2 GTH2 ?&no2 ( [z^] )
|
||||||
|
STHr LDZk #80 EOR SWP STZ ( ; z<-z^0x80 )
|
||||||
|
draw-stock #01 JMP2r ( 1^ )
|
||||||
|
&no2 POPr &no1 #00 JMP2r ( 0^ )
|
||||||
|
|
||||||
|
@maybe-select-waste ( -> bool^ )
|
||||||
|
.Mouse/y DEI2 #0008 LTH2 ?&no1
|
||||||
|
.Mouse/y DEI2 #0020 GTH2 ?&no1
|
||||||
|
top-waste STHk #00 EQU ?&no2
|
||||||
|
#001c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x1c+8*index* )
|
||||||
|
.Mouse/x DEI2 GTH2 ?&no2
|
||||||
|
#002c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x2c+8*index* )
|
||||||
|
.Mouse/x DEI2 LTH2 ?&no2
|
||||||
|
STHr LDZk #80 EOR SWP STZ draw-waste #01 JMP2r
|
||||||
|
&no2 POPr &no1 #00 JMP2r
|
||||||
|
|
||||||
|
@maybe-select-tableau ( -> bool^ )
|
||||||
|
.Mouse/y DEI2 #0024 LTH2 ?&no1
|
||||||
|
.Mouse/x DEI2 #0030 LTH2 ?&no1
|
||||||
|
.Mouse/x DEI2 #00cf GTH2 ?&no1
|
||||||
|
|
||||||
|
#0040 LIT2r 0700
|
||||||
|
&loop
|
||||||
|
.Mouse/x DEI2 OVR2 LTH2 ?&col #0008 ADD2
|
||||||
|
.Mouse/x DEI2 OVR2 LTH2 ?&no2
|
||||||
|
#0010 ADD2 INCr GTHkr STHr ?&loop
|
||||||
|
&no2 POP2 POP2r &no1 #00 JMP2r
|
||||||
|
|
||||||
|
&col
|
||||||
|
POP2 NIPr STHr
|
||||||
|
LIT "1 OVR ADD .Console/w DEO #0a .Console/w DEO
|
||||||
|
POP #00 JMP2r
|
||||||
|
|
||||||
@on-click-up ( -> )
|
@on-click-up ( -> )
|
||||||
.Mouse/state DEI #ff EOR ( not-state^ )
|
.Mouse/state DEI #ff EOR ( not-state^ )
|
||||||
|
|
Loading…
Reference in New Issue