( deck.tal ) |00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ] |10 @Console [ &vect $2 &r $1 &exec $2 &mode $1 &dead $1 &exit $1 &w $1 ] |20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ] |80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ] |90 @Mouse [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ] |a0 @File1 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |b0 @File2 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |c0 @DateTime [ &y $2 &m $1 &d $1 &hr $1 &min $1 &sec $1 &dow $1 &doy $2 &isdst $1 ] ( 1 byte per card ) ( #01 ace ... #0d king ) ( #00 club #10 diamond #20 spade #30 heart ) ( #00 face up, #40 face down ) ( #00 normal #80 held ) ( examples: ) ( - #00 no card ) ( - #01 ace of clubs ) ( - #1a ten of diamonds ) ( - #24 four of hearts ) ( - #3d king of spades ) ( - #6c queen of hearts, face down ) ( - #93 three of diamonds, held ) |0000 @stock $34 ( draw pile - 52 bytes ) @waste $18 ( face up pile - 24 bytes ) @foundation $4 ( one per suit - 4 bytes, 4x1 ) @tableau $85 ( the main board - 133 bytes, 7x19 ) @prev-button $1 @prev-mouse-state $1 @prev-mouse-x $2 @prev-mouse-y $2 @card-is-held $1 |0100 #2d8b .System/r DEO2 #2d18 .System/g DEO2 #2d14 .System/b DEO2 #0100 .Screen/w DEO2 #00c0 .Screen/h DEO2 init-rng-from-datetime init-stock init-waste init-foundation shuffle-stock deal-tableau draw-background draw-stock draw-waste draw-foundation draw-tableau ;on-mouse .Mouse/vect DEO2 ( ;on-key .Controller/vect DEO2 ) BRK @init-stock ( -> ) LITr -stock #8000 #4e41 &outer DUP2 &inner DUP STHkr STZ INC INCr GTHk ?&inner POP2 #1010 ADD2 GTH2k ?&outer POP2 POP2 POPr JMP2r @init-waste ( -> ) #00 LITr -waste LITr 18 OVRr ADDr SWPr &loop DUP STHkr STZ INCr GTHkr STHr ?&loop POP POP2r JMP2r @init-foundation #00 .foundation STZk INC STZk INC STZk INC STZk POP2 JMP2r @shuffle-stock ( -> ) .stock #33 OVR ADD SWP ( last^ start^ ) &loop ( last^ pos^ ) SUBk INC #00 SWP ( last^ pos^ n=last-pos+1* ) random SWP2 ( last^ pos^ r* n* ) DIV2k MUL2 SUB2 NIP ( last^ pos^ i=r%n^ ) OVR ADD LDZk ,&c STR ( last^ pos^ alt=pos+i^ ; c<-alt ) STH LDZk STHr STZ STH ( last^ [pos^] ; alt<-pos ) LIT [ &c $1 ] STHkr STZ ( last^ [pos^] ; pos<-c ) STHr INC GTHk ?&loop ( last^ pos+1^ ) POP2 JMP2r ( ) @deal-tableau ( -> ) #33 LIT2r -tableau 00 &loop STH2kr deal-column LIT2r 1301 ADD2r STHkr #07 LTH ?&loop POP2r POP JMP2r @deal-column ( src^ dst^ count^ -> src2^ ) #00 SWP SUB STH SWP ( dst^ src^ [-count^] ) &loop STHkr ?&ok !&done ( d^ s^ [-c^] ) &ok DUP2 LDZ SWP STZ ( d^ s^ [-c^] ; d<-s|64 ) #01 SUB SWP INC SWP ( d+1^ s-1^ [-c^] ) INCr !&loop ( d+1^ s-1^ [-c+1^] ) &done POPr SWP ( s^ d^) OVR LDZ #bf AND SWP STZ ( s^ ; d<-s ) #01 SUB JMP2r ( s-1^ ) @swap-c ( src^ dst^ -> ) LDZk STH ( src^ dst^ [d^] ) OVR LDZ ( src^ dst^ s^ [d^] ) SWP STZ ( src^ [d^] ; dst<-s ) STHr SWP ( d^ src^ ) STZ JMP2r ( ; src<-d ) @draw-stock ( -> ) #0008 ,&y STR2 ( ; y0<-8 ) .stock #34 OVR ADD SWP LITr 01 ( stock+52 stock^ [n^] ) &loop LDZk DUP ?&ok !&done ( lim^ zp^ c^ [n^] ) &ok ( lim^ zp^ c^ [n^] ) #0008 .Screen/x DEO2 ( lim^ zp^ c^ [n^] ; x<-8 ) LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ c^ [n^] ; y<- ) draw-c STHkr ?&skip ( lim^ zp^ [n^] ; draw c ) ,&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] ) &done POP2 POPr JMP2r ( ) @draw-waste ( -> ) #001c ,&x STR2 ( ; x0<-28 ) .waste #18 OVR ADD SWP ( waste+24^ waste^ ) &loop LDZk DUP ?&ok !&done ( lim^ zp^ c^ ) &ok ( lim^ zp^ c^ ) #0008 .Screen/y DEO2 ( lim^ zp^ c^ ; y<-8 ) LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ zp^ c^ ; x<- ) draw-c ( lim^ zp^ ; draw c ) ,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 ) INC GTHk ?&loop ( lim^ zp+1^ ) &done POP2 JMP2r ( ) @draw-foundation ( -> ) #0030 ,&y STR2 ( ; y0<-48 ) .foundation #04 OVR ADD SWP ( lim^ zp^ ) &loop ( lim^ zp^ ) #0008 .Screen/x DEO2 ( lim^ zp^ ; x<-8 ) LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ ; y<- ) LDZk maybe-draw-c ( lim^ zp^ ; draw ) ,&y LDR2 #0020 ADD2 ,&y STR2 ( lim^ zp^ ; y<-y+32 ) INC GTHk ?&loop ( lim^ zp+1^ ) POP2 JMP2r ( ) @draw-tableau #0700 &loop DUP draw-column INC GTHk ?&loop JMP2r @draw-column ( idx^ -> ) #00 OVR #0018 MUL2 #0030 ADD2 ,&x STR2 ( idx^ ; x<-32+24*idx ) #0024 ,&y STR2 ( idx^ ; y<-32 ) #13 MUL .tableau ADD ( pos=t+idx*19^ ) DUP #13 ADD SWP ( lim=pos+19^ pos^ ) &loop ( lim^ pos^ ) LDZk DUP ?&ok !&done ( lim^ pos^ c^ ) &ok LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ pos^ ; s/x<-x ) LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ pos^ ; s/y<-y ) draw-c INC ( lim^ pos+1^ ) ,&y LDR2 #0008 ADD2 ,&y STR2 ( lim^ pos+1^ ) GTHk ?&loop ( lim^ pos+1^ ) &done POP POP2 JMP2r ( ) @maybe-draw-c DUP ?{ POP !draw-mask-down } !draw-c ( assumes x/y already set ) @draw-c ( card^ -> ) DUP #40 LTH ?&norm DUP #80 LTH ?&down DUP #c0 LTH ?&held POP !draw-mask-down &norm adjust-c !draw-face-up &down POP !draw-face-down &held adjust-c !draw-mask-up ( we map from our sparse, logical card format ) ( to the dense, tile position card location ) ( clubs: #01 -> #27 ... #0d -> #33 ) ( diamonds: #11 -> #1a ... #1d -> #26 ) ( spades: #21 -> #00 ... #2d -> #0c ) ( hearts: #31 -> #0d ... #3d -> #19 ) @adjust-c ( card^ -> idx* ) #00 SWP DUP #21 LTH ?< DUP #31 LTH #03 MUL ADD #24 SUB JMP2r < DUP #11 LTH #1d MUL ADD #09 ADD JMP2r @on-mouse ( -> brk ) on-move on-click-down ( on-click-up ) .Mouse/state DEI .prev-mouse-state STZ 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 ( -> ) .Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw .Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw JMP2r &redraw ( #00 .Screen/auto DEO ) !draw-mouse ( clear-prev-mouse draw-curr-mouse JMP2r ) @draw-mouse ( -> ) #00 .Screen/auto DEO clear-prev-mouse !draw-curr-mouse @clear-prev-mouse ( -> ) .prev-mouse-x LDZ2 .Screen/x DEO2 .prev-mouse-y LDZ2 .Screen/y DEO2 ;blank .Screen/addr DEO2 #41 .Screen/sprite DEO JMP2r @draw-curr-mouse ( -> ) .Mouse/x DEI2 DUP2 .prev-mouse-x STZ2 .Screen/x DEO2 .Mouse/y DEI2 DUP2 .prev-mouse-y STZ2 .Screen/y DEO2 ;cursor .Screen/addr DEO2 #43 .Screen/sprite DEO JMP2r @on-click-down ( -> ) .Mouse/state DEI ( state^ ) .prev-mouse-state LDZ #ff EOR AND ( down^ ) #01 AND ?{ JMP2r } !maybe-select-card @maybe-select-card ( -> ) .Mouse/x DEI2 .Mouse/y DEI2 maybe-select-stock ?&done &done JMP2r @top-stock ( -> zp^ ) .stock #34 OVR ADD SWP &loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r @maybe-select-stock ( x* y* -> bool^ ) top-stock STH ( [z^] ) OVR2 #0008 LTH2 ?&no1 ( x* y* [z^] ; x<8 ) SWP2 #0017 GTH2 ?&no2 ( y* [z^] ; x>=16 ) #00 STHkr .stock SUB #03 SFT2 ( y* d* [z^] ) SWP2 STH2 ( d* [z^ y*] ) #0020 ( d* max=32-d* [z^ y*] ) #0008 ROT2 SUB2 ( max* min=8-d* [z^ y*] ) STH2kr GTH2 ?&no3 ( max* [z^ y*] ) STH2r LTH2 ?&no4 ( [z^] ) STHr LDZk #80 EOR SWP STZ ( ; z<-z^0x80 ) draw-stock #01 JMP2r ( 1^ ) &no1 POP2 &no2 POP2 POPr #00 JMP2r ( 0^ ) &no3 POP2 POP2r &no4 POPr #00 JMP2r ( 0^ ) @on-click-up ( -> ) .Mouse/state DEI #ff EOR ( not-state^ ) .prev-mouse-state LDZ AND ( up^ ) #01 AND ?{ JMP2r } JMP2r ( TODO: anything to do here? ) ( @on-key ( -> brk ) on-press on-release .Controller/button DEI .prev-button STZ BRK ) ( @on-release ( -> ) .Controller/button DEI #ff EOR ( not-button^ ) .prev-button LDZ AND ( release^ ) DUP #00 EQU ?&skip DUP #08 AND ?&start &skip POP JMP2r &start POP !draw-cards ) ( @on-press ( -> ) .Controller/button DEI ( button^ ) .prev-button LDZ #ff EOR AND ( press^ ) DUP #00 EQU ?&skip DUP #01 AND ?&ctrl DUP #02 AND ?&alt DUP #04 AND ?&select DUP #08 AND ?&start &skip POP JMP2r &ctrl POP !try-to-flip &alt POP !flip-all-cards &select POP !randomize &start POP !reset ) ~cards.tal