pond.tal (3967B)
1 ( pond.tal ) 2 3 |00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1 4 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 5 |90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2 6 7 |000 8 9 @circle &xc $2 &yc $2 &x $2 &y $2 &r $2 &d $2 10 11 |100 12 13 @on-reset ( -> ) 14 ( | theme ) 15 #2c2c DUP2 .System/r DEO2 16 DUP2 .System/g DEO2 17 .System/b DEO2 18 ;on-mouse .Mouse/vector DEO2 19 ;on-frame .Screen/vector DEO2 20 BRK 21 22 @on-mouse ( -> ) 23 #c1 ;touch-chr/down ;touch-chr .Mouse/state DEI ?{ SWP2 } 24 POP2 <update-cursor> 25 BRK 26 27 @on-frame ( -> ) 28 ( | 30 fps ) 29 [ LIT &f $1 ] INCk ,&f STR 30 ?{ BRK } 31 ( | clear ) 32 #0000 DUP2 .Screen/x DEO2 33 .Screen/y DEO2 34 [ LIT2 80 -Screen/pixel ] DEO 35 ( | draw ) 36 ;particles/end ;particles 37 &>l ( -- ) 38 ( | animate particle ) 39 DUP2 <draw-particle> 40 ( | increase size ) 41 DUP2 #0004 ADD2 LDA2k INC2 SWP2 STA2 42 #0006 ADD2 GTH2k ?&>l 43 POP2 POP2 44 ( | add particle ) 45 [ LIT &lock $1 ] DUP ?{ 46 .Mouse/state DEI ?{ POP BRK } 47 ( | touch ) 48 .Mouse/x DEI2 #0004 ADD2 .Mouse/y DEI2 #0004 ADD2 <add-particle> 49 [ LIT2 08 _&lock ] STR 50 POP BRK } 51 #01 SUB ,&lock STR 52 BRK 53 54 @<add-particle> ( x* y* -- ) 55 SWP2 [ LIT2r &ptr =particles ] STH2kr INC2r INC2r STA2 56 STH2kr INC2r INC2r STA2 57 #0001 STH2kr INC2r INC2r STA2 58 STH2r DUP2 ;particles/end LTH2 ?{ POP2 ;particles } 59 ,&ptr STR2 60 JMP2r 61 62 @<update-cursor> ( color addr* -- ) 63 ;fill-icn .Screen/addr DEO2 64 #40 <draw-cursor> 65 .Screen/addr DEO2 66 .Mouse/x DEI2 ,<draw-cursor>/x STR2 67 .Mouse/y DEI2 ,<draw-cursor>/y STR2 68 ( >> ) 69 70 @<draw-cursor> ( color -- ) 71 [ LIT2 16 -Screen/auto ] DEO 72 [ LIT2 &x $2 ] .Screen/x DEO2 73 [ LIT2 &y $2 ] .Screen/y DEO2 74 .Screen/sprite DEOk DEO 75 JMP2r 76 77 @<draw-particle> ( addr* -- ) 78 LDA2k ,&x STR2 79 INC2 INC2 LDA2k ,&y STR2 80 INC2 INC2 LDA2 [ LIT2 &x $2 ] [ LIT2 &y $2 ] ROT2 81 ( >> ) 82 83 @<draw-circle> ( xc* yc* r* -- ) 84 .circle/r STZ2 85 .circle/yc STZ2 86 .circle/xc STZ2 87 #0000 .circle/x STZ2 88 .circle/r LDZ2 .circle/y STZ2 89 .circle/r LDZ2 #10 SFT2 .circle/d STZ2 90 ( draw ) <draw-seg> 91 &>loop ( -- ) 92 ( incr ) .circle/x LDZ2 INC2 .circle/x STZ2 93 .circle/d LDZ2 #0001 LTS2 ?{ 94 ( decr ) .circle/y LDZ2 #0001 SUB2 .circle/y STZ2 95 .circle/x LDZ2 .circle/y LDZ2 SUB2 #20 SFT2 .circle/d LDZ2 ADD2 .circle/d STZ2 !&end } 96 .circle/x LDZ2 #20 SFT2 .circle/d LDZ2 ADD2 .circle/d STZ2 97 &end ( draw ) 98 <draw-seg> 99 .circle/y LDZ2 .circle/x LDZ2 #0001 SUB2 GTS2 ?&>loop 100 JMP2r 101 102 @LTS2 ( a* b* -- f ) 103 #8000 ADD2 SWP2 #8000 ADD2 GTH2 JMP2r 104 105 @GTS2 ( a* b* -- f ) 106 #8000 ADD2 SWP2 #8000 ADD2 LTH2 JMP2r 107 108 @<draw-seg> ( -- ) 109 .circle/xc LDZ2 .circle/x LDZ2 ADD2 .circle/yc LDZ2 .circle/y LDZ2 ADD2 <draw-pixel> 110 .circle/xc LDZ2 .circle/x LDZ2 SUB2 .circle/yc LDZ2 .circle/y LDZ2 ADD2 <draw-pixel> 111 .circle/xc LDZ2 .circle/x LDZ2 ADD2 .circle/yc LDZ2 .circle/y LDZ2 SUB2 <draw-pixel> 112 .circle/xc LDZ2 .circle/x LDZ2 SUB2 .circle/yc LDZ2 .circle/y LDZ2 SUB2 <draw-pixel> 113 .circle/xc LDZ2 .circle/y LDZ2 ADD2 .circle/yc LDZ2 .circle/x LDZ2 ADD2 <draw-pixel> 114 .circle/xc LDZ2 .circle/y LDZ2 SUB2 .circle/yc LDZ2 .circle/x LDZ2 ADD2 <draw-pixel> 115 .circle/xc LDZ2 .circle/y LDZ2 ADD2 .circle/yc LDZ2 .circle/x LDZ2 SUB2 <draw-pixel> 116 .circle/xc LDZ2 .circle/y LDZ2 SUB2 .circle/yc LDZ2 .circle/x LDZ2 SUB2 117 ( >> ) 118 119 @<draw-pixel> ( x* y* -- ) 120 DUP2 .Screen/height DEI2 GTH2 ?{ 121 .Screen/y DEO2 122 DUP2 .Screen/width DEI2 GTH2 ?{ 123 .Screen/x DEO2 124 [ LIT2r 01 -Screen/pixel ] DEOr 125 JMP2r } 126 POP2 JMP2r } 127 POP2 POP2 JMP2r 128 129 @touch-chr [ 130 0000 0000 0814 1417 0000 0000 0008 0808 131 0000 0000 0000 00c0 0000 0000 0000 0000 132 1010 2010 1008 0700 0f0f 1f0f 0f07 0000 133 2010 1010 2020 c000 c0e0 e0e0 c0c0 0000 ] 134 &down [ 135 0000 0000 0000 0817 0000 0000 0000 0008 136 0000 0000 0000 00c0 0000 0000 0000 0000 137 1010 2010 1008 0700 0f0f 1f0f 0f07 0000 138 2010 1010 2020 c000 c0e0 e0e0 c0c0 0000 ] 139 140 @fill-icn [ 141 ffff ffff ffff ffff ffff ffff ffff ffff 142 ffff ffff ffff ffff ffff ffff ffff ffff ] 143 144 @particles $60 &end 145