formatting, fix bug with auto-moving clubs
This commit is contained in:
parent
9196a3795b
commit
1adb09817c
48
kodiak.tal
48
kodiak.tal
|
@ -1,12 +1,12 @@
|
|||
( kodiak.tal )
|
||||
|
||||
( TODO )
|
||||
( * title screen, which is also about screen )
|
||||
( * move cards back from foundation? )
|
||||
( * move cards back from foundation )
|
||||
( * display message on win )
|
||||
( * make bear react to moving cards )
|
||||
( * buttons, stock flash when clicked )
|
||||
( * save game file? stats? )
|
||||
( * sometimes movement feels stutter-y )
|
||||
( * card sounds? )
|
||||
( * automatically keeping @auto up-to-date is arguably better than recalculating )
|
||||
|
||||
|00 @System [ &vect $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 ]
|
||||
|
@ -735,7 +735,7 @@
|
|||
maybe-select-button ?&skip
|
||||
maybe-select-stock ?&skip
|
||||
maybe-select-waste ?&found
|
||||
( TODO: maybe-select-foundation )
|
||||
maybe-select-foundation ?&found
|
||||
maybe-select-tableau ?&found
|
||||
( not found, end drag ) .dragging #05 !initialize
|
||||
&found clear-prev-mouse !draw-curr-hold
|
||||
|
@ -903,6 +903,9 @@
|
|||
.Mouse/x DEI2 SUB2 .dragging/x STZ2
|
||||
#01 .dragging STZ JMP2r ( )
|
||||
|
||||
@maybe-select-foundation ( -> bool^ )
|
||||
#00 JMP2r
|
||||
|
||||
@maybe-select-waste ( -> bool^ )
|
||||
.Mouse/y DEI2 #0008 LTH2 ?&no1 ( )
|
||||
.Mouse/y DEI2 #0020 GTH2 ?&no1 ( )
|
||||
|
@ -976,12 +979,12 @@
|
|||
&about POP2 open-about #01 JMP2r
|
||||
|
||||
@game-won ( -> bool^ )
|
||||
.foundation #04 OVR ADD SWP ( lim^ start^ )
|
||||
&loop ( lim^ pos^ )
|
||||
.foundation #04 OVR ADD SWP ( lim^ start^ )
|
||||
&loop ( lim^ pos^ )
|
||||
LDZk #0f AND #0d NEQ ?&no ( lim^ pos^ )
|
||||
INC GTHk ?&loop ( lim^ pos+1^ )
|
||||
POP2 #01 JMP2r ( 1^ )
|
||||
&no POP2 #00 JMP2r ( 0^ )
|
||||
INC GTHk ?&loop ( lim^ pos+1^ )
|
||||
POP2 #01 JMP2r ( 1^ )
|
||||
&no POP2 #00 JMP2r ( 0^ )
|
||||
|
||||
@toggle-audio ( -> )
|
||||
.audio LDZ ?&disable
|
||||
|
@ -1006,21 +1009,22 @@
|
|||
GTH JMP2r ( min-face+3>face^ )
|
||||
|
||||
@auto-move-col ( col^ -> ok^ )
|
||||
DUP top-column LDZ ( col^ card^ )
|
||||
DUP check-auto ?&ok !&done ( col^ card^ )
|
||||
&ok auto-dest STH top-column ( src^ [dst^] )
|
||||
STHr start-move ( )
|
||||
( LDZk STHr STZ remove-card ) #01 JMP2r ( 1^ )
|
||||
&done POP2 #00 JMP2r ( 0^ )
|
||||
DUP top-column LDZ ( col^ card^ )
|
||||
DUP check-auto ?&ok !&done ( col^ card^ )
|
||||
&ok auto-dest STH top-column ( src^ [dst^] )
|
||||
STHr start-move ( )
|
||||
#01 JMP2r ( 1^ )
|
||||
&done POP2 #00 JMP2r ( 0^ )
|
||||
|
||||
@auto-dest ( card^ -> dst^ )
|
||||
DUP #0f AND #01 EQU ?&aces ( card^ )
|
||||
#30 AND STH ( [suit^] )
|
||||
.foundation #04 OVR ADD SWP ( lim^ start^ [suit^] )
|
||||
&loop LDZk #30 AND STHkr EQU ?&ok ( lim^ zp^ [suit^] )
|
||||
INC GTHk ?&loop ( lim^ zp+1^ [suit^] )
|
||||
&ok POPr NIP JMP2r ( zp^ )
|
||||
&aces ( card^ )
|
||||
DUP #0f AND #01 EQU ?&aces ( card^ )
|
||||
#30 AND STH ( [suit^] )
|
||||
.foundation #04 OVR ADD SWP ( lim^ start^ [suit^] )
|
||||
&loop LDZk #00 EQU ?&skip ( lim^ zp^ [suit^] )
|
||||
LDZk #30 AND STHkr EQU ?&ok ( lim^ zp^ [suit^] )
|
||||
&skip INC GTHk ?&loop ( lim^ zp+1^ [suit^] )
|
||||
&ok POPr NIP JMP2r ( zp^ )
|
||||
&aces ( card^ )
|
||||
POP .foundation #04 OVR ADD SWP ( lim^ start^ )
|
||||
&loop2 LDZk ?&next NIP JMP2r ( zp^ )
|
||||
&next INC GTHk ?&loop2 ( lim^ zp+1^ )
|
||||
|
|
Loading…
Reference in New Issue