diff --git a/kodiak.tal b/kodiak.tal index b0543ea..0e24a21 100644 --- a/kodiak.tal +++ b/kodiak.tal @@ -50,9 +50,10 @@ &mouse-y $2 ] ( previous y-coordinate ) @auto $4 ( sorted foundation for auto-move: C D S H ) @frame $1 ( frame counter; cycles 0-255 continually ) - @move [ &src $1 ( card starting address ) + @move [ &card $1 ( card to move ) &dst $1 ( card destination address after move ) - &time $1 ( time spent moving, 0-15 frames ) + &time $2 ( time spent moving, 0-15 frames; ) + &max-time $2 ( max time for this move, 16 frames ) &x0 $2 ( starting x coord ) &y0 $2 ( starting y coord ) &x1 $2 ( ending x coord ) @@ -82,15 +83,19 @@ .prev #06 initialize .auto #04 initialize .frame #01 initialize - .move #0a initialize + .move #0e initialize shuffle-stock deal-tableau + + ( TODO: clear foreground ) draw ;on-mouse .Mouse/vect DEO2 ;on-key .Controller/vect DEO2 ;on-refresh .Screen/vect DEO2 + + auto-move JMP2r @dump-byte ( byte^ -- ) @@ -139,7 +144,7 @@ .dragging #05 dump-mem .prev #06 dump-mem .auto #04 dump-mem - .move #0a dump-mem + .move #0e dump-mem LIT "- .Console/w DEOk DEOk DEOk DEOk DEO #0a .Console/w DEO JMP2r @@ -312,59 +317,83 @@ #001c ADD2 #0008 JMP2r ( x=28+8i* y=8* ) @foundation-pos ( card^ -> x* y* ) - #00 SWP #0008 SWP2 .foundation SUB ( x=8* i* ) - #50 SFT2 #0020 ADD2 #0008 SWP2 JMP2r ( x*, y=48+32i* ) + .foundation SUB #00 SWP #0008 SWP2 ( x=8* i* ) + #50 SFT2 #0030 ADD2 JMP2r ( x*, y=48+32i* ) @tableau-pos ( card^ -> x* y* ) - STHk #13 DIV STHk column-x ( x* [card^ col^] ) - #00 STH2r #13 MUL SUB #30 SFT2 ( x* 8pos* ) - #0024 ADD2 JMP2r ( x* y=36+8pos* ) + .tableau SUB STHk #13 DIV STHk column-x ( x* [card^ col^] ) + #00 STH2r #13 MUL SUB #30 SFT2 ( x* 8pos* ) + #0024 ADD2 JMP2r ( x* y=36+8pos* ) @card-pos-xy ( card^ -> x* y* ) - #00 SWP .stock + .stock #33 ADD GTHk ?{ POP !stock-pos } #18 ADD GTHk ?{ POP !waste-pos } #04 ADD GTHk ?{ POP !foundation-pos } #85 ADD GTHk ?{ POP !tableau-pos } POP2 #010e DEO #0000 #0000 JMP2r ( ; error, x=0, y=0 ) -( we expect 0 <= time <= 16 ) +( divides n by d with rounding ) +@sdiv ( n* d* -> n/d* ) + STH2 DUP2 #8000 LTH2 ?&non-neg + #ffff MUL2 STH2kr #01 SFT2 ADD2 STH2r DIV2 #ffff MUL2 JMP2r + &non-neg STH2kr #01 SFT2 ADD2 STH2r DIV2 JMP2r + +@scale ( n1* n0* -> [t*dn]/m+n0* ) + STH2k SUB2 .move/time LDZ2 MUL2 ( dn*t* [n0*] ) + .move/max-time LDZ2 sdiv STH2r ADD2 JMP2r ( [dn*t]/m+n0* ) + @move-pos-xy ( -> x* y* ) - #00 .move/time LDZ ( t* ) - .move/x1 LDZ2 .move/x0 LDZ2 STH2k SUB2 ( dx* [x0*] ) - OVR2 MUL2 #04 SFT2 STH2r ADD2 SWP2 ( x=x0+[dx*t/16]* t* ) - .move/y1 LDZ2 .move/y0 LDZ2 STH2k SUB2 ( x* t* dy* [y0*] ) - MUL2 #04 SFT2 STH2r ADD2 JMP2r ( x* y=y0+[dy*t/16]* ) + .move/x1 LDZ2 .move/x0 LDZ2 scale + .move/y1 LDZ2 .move/y0 LDZ2 !scale + +@max ( x* y* -> max* ) + GTH2k JMP SWP2 POP2 JMP2r + +@dist ( a* b* -> |a-b|* ) + GTH2k JMP SWP2 SUB2 JMP2r + +@move-duration ( -> duration* ) + .move/x1 LDZ2 .move/x0 LDZ2 dist ( dx* ) + .move/y1 LDZ2 .move/y0 LDZ2 dist ( dx* dy* ) + max #03 SFT2 JMP2r ( max[dx,dy]/8* ) @start-move ( src^ dst^ -> ) - DUP card-pos-xy ( src^ dst^ x1* y1* ) - .move/y1 STZ2 .move/x1 STZ2 .move/dst STZ ( src^ ) - DUP card-pos-xy ( src^ x0* y* ) - .move/y0 STZ2 .move/x0 STZ2 .move/src STZ ( ) - #00 .move/time STZ !update-move ( ) + DUP card-pos-xy ( src^ dst^ x1* y1* ) + .move/y1 STZ2 .move/x1 STZ2 ( src^ dst^ ) + .move/dst STZ ( src^ ; write dst ) + DUP card-pos-xy ( src^ x0* y* ) + .move/y0 STZ2 .move/x0 STZ2 ( src^ ) + LDZk .move/card STZ ( src^ ; write card ) + #0000 .move/time STZ2 ( ) + move-duration .move/max-time STZ2 ( ) + !remove-card ( ) +( from column 0: ) +( 00 90 00 44 00 08 00 20 ) @update-move ( -> ) move-pos-xy ( x* y* ) .Screen/y DEO2 .Screen/x DEO2 ( ; set x,y ) ;blank .Screen/addr DEO2 ( ; use blank tile ) #12 .Screen/auto DEO ( ; draw 2, inc x ) #41 .Screen/sprite DEOk DEOk DEO ( ; erase three rows ) - .move/time LDZ #0f GTH ?end-move ( ; are we done? ) - .move/time LDZk INC SWP STZ ( ; time<-time+1 ) + .move/time LDZ2 ( t* ) + .move/max-time LDZ2 ( t* max-t* ) + LTH2 ?{ !end-move } ( ; continue if t < max-t ) + .move/time LDZ2k INC ROT STZ2 ( ; time<-time+1 ) move-pos-xy ( x* y* ) .Screen/y DEO2 .Screen/x DEO2 ( ; set x,y ) - .move/src LDZ LDZ !draw-c ( ; draw card ) + .move/card LDZ ( card^ ) + set-fg draw-c !set-bg ( ; draw card ) @end-move ( -> ) - .move/src LDZ STH LDZ ( card^ [src^] ) + .move/card LDZ ( card^ [src^] ) .move/dst LDZ STZ ( [src^] ; dst<-card ) - STHr remove-card ( ; remove card, flip, etc. ) - .move #0b initialize ( ; zero out move ) - post-move draw ( ; finish move and draw ) - !auto-move ( ; start another auto move maybe? ) + .move #0e initialize ( ; zero out move ) + post-move !draw ( ; finish move and draw ) @on-refresh ( -> brk ) - .move/src LDZ #00 EQU ?{ update-move } + .move/card LDZ #00 EQU ?{ update-move } on-refresh-bear ( ; possibly refresh bear ) .frame LDZk INC SWP STZ ( ; increment frame counter ) BRK @@ -385,7 +414,7 @@ @on-mouse ( -> brk ) on-move - .move/src LDZ ?&skip + .move/card LDZ ?&skip on-click-down on-click-up &skip .Mouse/state DEI .prev/mouse-state STZ @@ -686,7 +715,8 @@ DUP top-column LDZ ( col^ card^ ) DUP check-auto ?&ok !&done ( col^ card^ ) &ok auto-dest STH top-column ( src^ [dst^] ) - LDZk STHr STZ remove-card #01 JMP2r ( 1^ ) + STHr start-move ( ) +( LDZk STHr STZ remove-card ) #01 JMP2r ( 1^ ) &done POP2 #00 JMP2r ( 0^ ) @auto-dest ( card^ -> dst^ ) @@ -704,8 +734,7 @@ @auto-move ( -> ) prepare-auto #0700 ( lim^ col0^ ) &loop DUP auto-move-col ?&found INC GTHk ?&loop ( lim^ col+1^ ) - POP2 post-move !draw ( x; FIXME ) - &found POP2 !auto-move ( ) + POP2 JMP2r &found POP2 !draw ( ) @prepare-auto ( -> ) .auto #04 initialize ( ; reset auto ) @@ -721,7 +750,7 @@ SWP #0f AND SWP STZ JMP2r ( ; zp<-face ) @post-move ( -> ) - JMP2r + auto-move JMP2r @on-click-up ( -> ) .Mouse/state DEI #ff EOR ( not-state^ )