deck demo

This commit is contained in:
~d6 2023-05-18 18:31:38 -04:00
parent c48d034cf4
commit 07c4f91b45
1 changed files with 58 additions and 7 deletions

View File

@ -45,9 +45,11 @@
@card-is-held $1 @card-is-held $1
|0100 |0100
#1234 #abcd init-rng ( #1234 #abcd init-rng )
#4444 #abc9 init-rng
init-cards init-cards
reset
#2d8b .System/r DEO2 #2d8b .System/r DEO2
#2d18 .System/g DEO2 #2d18 .System/g DEO2
@ -150,9 +152,41 @@
DUP #08 AND ?&start DUP #08 AND ?&start
&skip POP JMP2r &skip POP JMP2r
&ctrl POP !try-to-flip ( ;cards/last LDA2k #8000 EOR2 SWP2 STA2 !draw-cards ) &ctrl POP !try-to-flip ( ;cards/last LDA2k #8000 EOR2 SWP2 STA2 !draw-cards )
&alt POP !flip-all-cards ( reshuffle ) &alt POP !flip-all-cards
&select POP !reshuffle ( ;cards raise-card !draw-cards ) &select POP !randomize ( ;cards raise-card !draw-cards )
&start POP JMP2r ( ;draw-mask !draw-all-cards ) &start POP !reset ( ;draw-mask !draw-all-cards )
( put all cards face down, and stack them )
( in a single deck in the middle of the screen )
@reset ( -> )
all-cards-face-down
shuffle ( FIXME )
( #78 #50 stack-cards )
#08 #18 stack-cards
draw-background
!draw-cards
( f: addr* -> )
@for-all-cards ( f* -> )
STH2 ;cards/end ;cards ( limit* start* [f*] )
&loop DUP2 STH2kr JSR2 ( limit* pos* [f*] )
#0004 ADD2 GTH2k ?&loop ( limit* pos+4* [f*] )
POP2 POP2 POP2r JMP2r ( )
@all-cards-face-down ( -> )
;turn-card-face-down !for-all-cards
@stack-cards ( x^ y^ -> )
,stack-card/y STR ,stack-card/x STR #00 ,stack-card/c
;stack-card !for-all-cards
@stack-card ( addr* -> )
INC2 INC2 STH2 ( [addr+2*] )
LIT [ &x $1 ] STH2kr STA INC2r ( [addr+3] ; addr+2<-x )
LIT [ &y $1 ] STH2r STA ( ; addr+3<-y )
LIT [ &c $1 ] ?&skip
,&y LDR #01 SUB ,&y STR
&skip ,&c LDR INC #03 AND ,&c STR JMP2r
@flip-all-cards ( -> ) @flip-all-cards ( -> )
;cards/end ;cards ( limit* start* ) ;cards/end ;cards ( limit* start* )
@ -160,6 +194,20 @@
#0004 ADD2 GTH2k ?&loop ( limit* pos+4* ) #0004 ADD2 GTH2k ?&loop ( limit* pos+4* )
POP2 POP2 !draw-cards ( ) POP2 POP2 !draw-cards ( )
@shuffle ( -> )
;cards/last ;cards ( last* start* )
&loop ( last* pos* )
SUB2k #02 SFT2 INC2 ( last* pos* n=[last-pos]/4+1* )
random SWP2 ( last* pos* r* n* )
DIV2k MUL2 SUB2 ( last* pos* i=r%n* )
#20 SFT2 OVR2 ADD2 ( last* pos* alt=pos+4i* )
LDA2k ,&c STR2 ( last* pos* alt* ; c<-alt )
STH2 LDA2k STH2r STA2 STH2 ( last* [pos*] ; alt<-pos )
LIT2 [ &c $2 ] STH2kr STA2 ( last* [pos*] )
STH2r #0004 ADD2 ( last* pos+4* )
GTH2k ?&loop ( last* pos+4* )
POP2 POP2 JMP2r ( )
@try-to-flip ( -> ) @try-to-flip ( -> )
find-mouse-over-card find-mouse-over-card
ORAk ?&found POP2 JMP2r ORAk ?&found POP2 JMP2r
@ -168,7 +216,10 @@
@flip-card ( addr* -> ) @flip-card ( addr* -> )
LDA2k #8000 EOR2 SWP2 STA2 JMP2r LDA2k #8000 EOR2 SWP2 STA2 JMP2r
@reshuffle ( -> ) @turn-card-face-down ( addr* -> ) #80 ROT ROT STA JMP2r
@turn-card-face-up ( addr* -> ) #00 ROT ROT STA JMP2r
@randomize ( -> )
init-cards init-cards
draw-background draw-background
!draw-cards !draw-cards
@ -373,7 +424,7 @@
SWP2 DUP2 #03 SFT2 EOR2 ( u* v=t^[t>>3]* ) SWP2 DUP2 #03 SFT2 EOR2 ( u* v=t^[t>>3]* )
EOR2 DUP2 .rng/y STZ2 JMP2r ( u^v* ; y<-u^v ) EOR2 DUP2 .rng/y STZ2 JMP2r ( u^v* ; y<-u^v )
@draw-scene ( @draw-scene
#0000 #0008 #0008 draw-card #0000 #0008 #0008 draw-card
#0001 #0010 #0010 draw-card #0001 #0010 #0010 draw-card
#0002 #0018 #0018 draw-card #0002 #0018 #0018 draw-card
@ -457,7 +508,7 @@
#8000 #00c8 #0058 draw-card #8000 #00c8 #0058 draw-card
#8000 #00c8 #0060 draw-card #8000 #00c8 #0060 draw-card
#8000 #00c8 #0068 draw-card #8000 #00c8 #0068 draw-card
JMP2r JMP2r )
( 52 cards x 4 bytes per card = 208 bytes ) ( 52 cards x 4 bytes per card = 208 bytes )
( each card has: ) ( each card has: )