mouse.tal (4563B)
1 ( Mouse: Paint with 3 colors with each mouse button. ) 2 3 |00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $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 |0000 8 9 @length $2 10 @frame $2 11 @pen &x $2 &y $2 &x2 $2 &y2 $2 12 @pointer &x $2 &y $2 &lastx $2 &lasty $2 &state $1 13 14 |0100 15 16 @on-reset ( -> ) 17 ( | theme ) 18 #48af .System/r DEO2 19 #59bf .System/g DEO2 20 #6ace .System/b DEO2 21 ( | vectors ) 22 ;on-mouse .Mouse/vector DEO2 23 ;on-frame .Screen/vector DEO2 24 <draw-mouse> 25 BRK 26 27 ( 28 @|vectors ) 29 30 @on-frame ( -> ) 31 .Mouse/state DEI ?{ 32 ;run DUP2 JSR2 JSR2 } 33 BRK 34 35 @on-mouse ( -> ) 36 ( | clear last cursor ) 37 .pointer/x LDZ2 .Screen/x DEO2 38 .pointer/y LDZ2 .Screen/y DEO2 39 ;fill-icn .Screen/addr DEO2 40 [ LIT2 40 -Screen/sprite ] DEO 41 <draw-mouse> 42 ( | draw new cursor ) 43 ;pointer-icn .Screen/addr DEO2 44 #00 .Screen/auto DEO 45 .Mouse/x DEI2 DUP2 .pointer/x STZ2 46 .Screen/x DEO2 47 .Mouse/y DEI2 DUP2 .pointer/y STZ2 48 .Screen/y DEO2 49 #45 .Mouse/state DEI #00 NEQ #05 MUL ADD .Screen/sprite DEO 50 ( | on down ) 51 .Mouse/state DEI #00 NEQ .pointer/state LDZ #00 EQU AND ?&down 52 ( | on drag ) 53 .Mouse/state DEI ?&drag 54 .Mouse/state DEI .pointer/state STZ 55 BRK 56 &down ( -> ) 57 #0000 DUP2 .length STZ2 58 .frame STZ2 59 <clear-screen> 60 ( | record start position ) 61 .Mouse/x DEI2 DUP2 .pointer/x STZ2 62 .pointer/lastx STZ2 63 .Mouse/y DEI2 DUP2 .pointer/y STZ2 64 .pointer/lasty STZ2 65 .Mouse/state DEI .pointer/state STZ 66 BRK 67 &drag ( -> ) 68 ( | record ) 69 ;stroke .length LDZ2 #20 SFT2 ADD2 STH2 .pointer/x LDZ2 .pointer/lastx LDZ2 SUB2 STH2kr STA2 70 .pointer/y LDZ2 .pointer/lasty LDZ2 SUB2 STH2r INC2 INC2 STA2 71 ( | move ptr ) 72 .length LDZ2 INC2 .length STZ2 73 ( | draw line ) 74 .pointer/lastx LDZ2 .pointer/lasty LDZ2 .pointer/x LDZ2 .pointer/y LDZ2 #01 <draw-line> 75 ( | record last position ) 76 .Mouse/x DEI2 DUP2 .pointer/lastx STZ2 77 DUP2 .pen/x STZ2 78 .pen/x2 STZ2 79 .Mouse/y DEI2 DUP2 .pointer/lasty STZ2 80 DUP2 .pen/y STZ2 81 .pen/y2 STZ2 82 .Mouse/state DEI DUP #01 NEQ INC ;run/color STA 83 .pointer/state STZ 84 BRK 85 86 ( 87 @|main ) 88 89 @run ( -- ) 90 ( | read ) 91 ;stroke .frame LDZ2 #20 SFT2 ADD2 STH2 .pen/x LDZ2 STH2kr LDA2 ADD2 .pen/x STZ2 92 .pen/y LDZ2 STH2r INC2 INC2 LDA2 ADD2 .pen/y STZ2 93 ( | line ) 94 .pen/x LDZ2 .pen/y LDZ2 .pen/x2 LDZ2 .pen/y2 LDZ2 .frame LDZ2 #01 SFT2 NIP #01 AND [ LIT &color $1 ] ADD INC <draw-line> 95 ( | history ) 96 .pen/x LDZ2 .pen/x2 STZ2 97 .pen/y LDZ2 .pen/y2 STZ2 98 ( | incr frame ) 99 .frame LDZ2 INC2 .length LDZ2 INC2 100 ( mod2 ) DIV2k MUL2 SUB2 .frame STZ2 101 JMP2r 102 103 @<draw-mouse> ( -- ) 104 ( | clear ) 105 #0010 DUP2 .Screen/x DEO2 106 .Screen/y DEO2 107 #16 .Screen/auto DEO 108 ;fill-icn .Screen/addr DEO2 109 #40 .Screen/sprite DEOk 110 DEO 111 ( | buttons ) 112 #0300 113 &l ( -- ) 114 #01 OVR #40 SFT SFT .Mouse/state DEI AND #00 EQU ?{ 115 #0010 .Screen/y DEO2 116 #00 OVR #40 SFT2 ;button-icn ADD2 .Screen/addr DEO2 117 #45 .Screen/sprite DEO } 118 INC GTHk ?&l 119 POP2 120 ( | outline ) 121 #0010 .Screen/y DEO2 122 ;mouse-icn .Screen/addr DEO2 123 #16 .Screen/auto DEO 124 #4a .Screen/sprite DEOk 125 DEO 126 JMP2r 127 128 @<draw-line> ( x1* y1* x2* y2* color -- ) 129 ,&color STR 130 ,&y STR2 131 ,&x STR2 132 ,&y2 STR2 133 ,&x2 STR2 134 ,&x LDR2 ,&x2 LDR2 SUB2 abs2 ,&dx STR2 135 #0000 ,&y LDR2 ,&y2 LDR2 SUB2 abs2 SUB2 ,&dy STR2 136 #ffff [ LIT2 00 _&x2 ] LDR2 ,&x LDR2 lts2 DUP2 ADD2 ADD2 ,&sx STR2 137 #ffff [ LIT2 00 _&y2 ] LDR2 ,&y LDR2 lts2 DUP2 ADD2 ADD2 ,&sy STR2 138 [ LIT2 &dx $2 ] [ LIT2 &dy $2 ] ADD2 STH2 139 &while ( -- ) 140 [ LIT2 &x2 $2 ] DUP2 .Screen/x DEO2 141 [ LIT2 &x $2 ] EQU2 [ LIT2 &y2 $2 ] DUP2 .Screen/y DEO2 142 [ LIT2 &y $2 ] EQU2 [ LIT2 &color $1 -Screen/pixel ] DEO 143 AND ?&end 144 STH2kr DUP2 ADD2 DUP2 ,&dy LDR2 lts2 ?&skipy 145 STH2r ,&dy LDR2 ADD2 STH2 ,&x2 LDR2 [ LIT2 &sx $2 ] ADD2 ,&x2 STR2 146 &skipy ( -- ) 147 ,&dx LDR2 gts2 ?&while 148 STH2r ,&dx LDR2 ADD2 STH2 ,&y2 LDR2 [ LIT2 &sy $2 ] ADD2 ,&y2 STR2 149 !&while 150 &end POP2r JMP2r 151 152 @abs2 ( a* -- f ) 153 DUP2 #0f SFT2 EQU ?{ #0000 SWP2 SUB2 } 154 JMP2r 155 156 @lts2 ( a* b* -- f ) 157 #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r 158 159 @gts2 ( a* b* -- f ) 160 #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r 161 162 @<clear-screen> ( -- ) 163 #0000 DUP2 .Screen/x DEO2 164 .Screen/y DEO2 165 #80 .Screen/pixel DEO 166 JMP2r 167 168 @fill-icn [ ffff ffff ffff ffff ] 169 170 @pointer-icn [ 80c0 e0f0 f8e0 1000 ] 171 172 @mouse-icn [ 173 000d 1212 1212 121d 00b0 4848 4848 48b8 174 1010 1010 1008 0700 0808 0808 0810 e000 ] 175 176 @button-icn [ 177 000c 1e1e 1e1e 1e0c 0000 0000 0000 0000 178 0001 0303 0303 0301 0080 c0c0 c0c0 c080 179 0000 0000 0000 0000 0030 7878 7878 7830 ] 180 181 ( 182 @|memory ) 183 184 @stroke 185 186