basic card animations are working

This commit is contained in:
~d6 2024-07-31 01:29:42 -04:00
parent 4baecc3a4c
commit f9d3585b93
1 changed files with 64 additions and 35 deletions

View File

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