shapes.tal (5972B)
1 ( GUI Shapes ) 2 3 %ABS2 { DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 SUB2 } 4 %LTS2 { #8000 ADD2 SWP2 #8000 ADD2 GTH2 } 5 %GTS2 { #8000 ADD2 SWP2 #8000 ADD2 LTH2 } 6 %WIDTH { #0100 } %HEIGHT { #00a0 } 7 8 ( devices ) 9 10 |00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ] 11 |20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ] 12 13 ( variables ) 14 15 |0000 16 17 ( draw requirements ) 18 @color [ &byte $1 ] 19 20 @rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ] 21 @line [ &x0 $2 &y0 $2 &x $2 &y $2 &sx $2 &sy $2 &dx $2 &dy $2 &e1 $2 &e2 $2 ] 22 @circle [ &xc $2 &yc $2 &x $2 &y $2 &r $2 &d $2 ] 23 24 ( program ) 25 26 |0100 27 28 ( theme ) 29 #f0ff .System/r DEO2 30 #f03c .System/g DEO2 31 #f03f .System/b DEO2 32 33 ( background ) ;checker-icn #03 ;cover-pattern JSR2 34 35 .Screen/width DEI2 #01 SFT2 WIDTH #01 SFT2 SUB2 #0008 ADD2 36 .Screen/height DEI2 #01 SFT2 HEIGHT #01 SFT2 SUB2 #0008 ADD2 37 WIDTH HEIGHT 38 STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2 #02 ;fill-rect JSR2 39 40 .Screen/width DEI2 #01 SFT2 WIDTH #01 SFT2 SUB2 41 .Screen/height DEI2 #01 SFT2 HEIGHT #01 SFT2 SUB2 42 WIDTH HEIGHT 43 STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2 #01 ;fill-rect JSR2 44 45 .Screen/width DEI2 #01 SFT2 WIDTH #01 SFT2 SUB2 #0008 ADD2 46 .Screen/height DEI2 #01 SFT2 HEIGHT #01 SFT2 SUB2 #0008 ADD2 47 WIDTH #0010 SUB2 HEIGHT #0010 SUB2 48 STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2 #03 ;line-rect JSR2 49 50 .Screen/width DEI2 #01 SFT2 .Screen/height DEI2 #01 SFT2 WIDTH #02 SFT2 #02 ;draw-circle JSR2 51 52 #0010 #0030 #0068 #02 ;line-hor JSR2 53 #0020 #0058 #0078 #02 ;line-ver JSR2 54 55 BRK 56 57 @line-slow ( x1 y1 x2 y2 color -- ) 58 59 ( load ) .color STZ #0001 SUB2 .line/y0 STZ2 #0001 SUB2 .line/x0 STZ2 .line/y STZ2 .line/x STZ2 60 .line/x0 LDZ2 .line/x LDZ2 SUB2 ABS2 .line/dx STZ2 61 .line/y0 LDZ2 .line/y LDZ2 SUB2 ABS2 #0000 SWP2 SUB2 .line/dy STZ2 62 #ffff #00 .line/x LDZ2 .line/x0 LDZ2 LTS2 #10 SFT2 ADD2 .line/sx STZ2 63 #ffff #00 .line/y LDZ2 .line/y0 LDZ2 LTS2 #10 SFT2 ADD2 .line/sy STZ2 64 .line/dx LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2 65 &loop 66 .line/x LDZ2 .Screen/x DEO2 .line/y LDZ2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 67 .line/x LDZ2 .line/x0 LDZ2 EQU2 .line/y LDZ2 .line/y0 LDZ2 EQU2 AND ,&end JCN 68 .line/e1 LDZ2 #10 SFT2 .line/e2 STZ2 69 .line/e2 LDZ2 .line/dy LDZ2 LTS2 ,&skipy JCN 70 .line/e1 LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2 71 .line/x LDZ2 .line/sx LDZ2 ADD2 .line/x STZ2 72 &skipy 73 .line/e2 LDZ2 .line/dx LDZ2 GTS2 ,&skipx JCN 74 .line/e1 LDZ2 .line/dx LDZ2 ADD2 .line/e1 STZ2 75 .line/y LDZ2 .line/sy LDZ2 ADD2 .line/y STZ2 76 &skipx 77 ;&loop JMP2 78 79 &end 80 81 JMP2r 82 83 @line-rect ( x1* y1* x2* y2* color -- ) 84 85 STH 86 DUP2 ,&ver-y2 STR2 ,&hor-y2 STR2 87 DUP2 ,&ver-x2 STR2 ,&hor-x2 STR2 88 DUP2 ,&ver-y1 STR2 ,&hor-y1 STR2 89 DUP2 ,&ver-x1 STR2 ,&hor-x1 STR2 90 ( horizontal ) 91 [ LIT2 &hor-x2 $2 ] INC2 [ LIT2 &hor-x1 $2 ] 92 &hor 93 DUP2 .Screen/x DEO2 94 [ LIT2 &hor-y1 $2 ] .Screen/y DEO2 STHkr .Screen/pixel DEOk 95 [ LIT2 &hor-y2 $2 ] .Screen/y DEO2 DEO 96 INC2 GTH2k ,&hor JCN 97 POP2 POP2 98 ( vertical ) 99 [ LIT2 &ver-y2 $2 ] [ LIT2 &ver-y1 $2 ] 100 &ver 101 DUP2 .Screen/y DEO2 102 [ LIT2 &ver-x1 $2 ] .Screen/x DEO2 STHkr .Screen/pixel DEOk 103 [ LIT2 &ver-x2 $2 ] .Screen/x DEO2 DEO 104 INC2 GTH2k ,&ver JCN 105 POP2 POP2 106 POPr 107 108 JMP2r 109 110 @fill-rect ( x1* y1* x2* y2* color -- ) 111 112 ,&color STR 113 ( x1 x2 y1 y2 ) ROT2 114 &ver 115 ( save ) DUP2 .Screen/y DEO2 116 STH2 STH2 OVR2 OVR2 SWP2 117 &hor 118 ( save ) DUP2 .Screen/x DEO2 119 ( draw ) ,&color LDR .Screen/pixel DEO 120 ( incr ) INC2 121 OVR2 OVR2 GTS2 ,&hor JCN 122 POP2 POP2 STH2r STH2r 123 ( incr ) INC2 124 OVR2 OVR2 GTS2 ,&ver JCN 125 POP2 POP2 POP2 POP2 126 127 JMP2r 128 &color $1 129 130 @draw-circle ( xc yc r color -- ) 131 132 ( load ) .color STZ .circle/r STZ2 .circle/yc STZ2 .circle/xc STZ2 133 #0000 .circle/x STZ2 .circle/r LDZ2 .circle/y STZ2 134 .circle/r LDZ2 #10 SFT2 .circle/d STZ2 135 ( draw ) ;&seg JSR2 136 &loop 137 ( incr ) .circle/x LDZ2 INC2 .circle/x STZ2 138 .circle/d LDZ2 #0001 LTS2 ,&else JCN 139 ( decr ) .circle/y LDZ2 #0001 SUB2 .circle/y STZ2 140 .circle/x LDZ2 .circle/y LDZ2 SUB2 #20 SFT2 .circle/d LDZ2 ADD2 .circle/d STZ2 141 ;&end JMP2 142 &else 143 .circle/x LDZ2 #20 SFT2 .circle/d LDZ2 ADD2 .circle/d STZ2 144 &end 145 ( draw ) ;&seg JSR2 146 .circle/y LDZ2 .circle/x LDZ2 #0001 SUB2 GTS2 ,&loop JCN 147 JMP2r 148 &seg 149 .circle/xc LDZ2 .circle/x LDZ2 ADD2 .Screen/x DEO2 .circle/yc LDZ2 .circle/y LDZ2 ADD2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 150 .circle/xc LDZ2 .circle/x LDZ2 SUB2 .Screen/x DEO2 .circle/yc LDZ2 .circle/y LDZ2 ADD2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 151 .circle/xc LDZ2 .circle/x LDZ2 ADD2 .Screen/x DEO2 .circle/yc LDZ2 .circle/y LDZ2 SUB2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 152 .circle/xc LDZ2 .circle/x LDZ2 SUB2 .Screen/x DEO2 .circle/yc LDZ2 .circle/y LDZ2 SUB2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 153 .circle/xc LDZ2 .circle/y LDZ2 ADD2 .Screen/x DEO2 .circle/yc LDZ2 .circle/x LDZ2 ADD2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 154 .circle/xc LDZ2 .circle/y LDZ2 SUB2 .Screen/x DEO2 .circle/yc LDZ2 .circle/x LDZ2 ADD2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 155 .circle/xc LDZ2 .circle/y LDZ2 ADD2 .Screen/x DEO2 .circle/yc LDZ2 .circle/x LDZ2 SUB2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 156 .circle/xc LDZ2 .circle/y LDZ2 SUB2 .Screen/x DEO2 .circle/yc LDZ2 .circle/x LDZ2 SUB2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO 157 158 JMP2r 159 160 @cover-pattern ( addr* color -- ) 161 162 ( load ) STH .Screen/addr DEO2 163 .Screen/height DEI2 #0000 164 &ver 165 ( save ) DUP2 .Screen/y DEO2 166 .Screen/width DEI2 #0000 167 &hor 168 ( save ) DUP2 .Screen/x DEO2 169 ( draw ) STHkr .Screen/sprite DEO 170 #0008 ADD2 GTH2k ,&hor JCN 171 POP2 POP2 172 #0008 ADD2 GTH2k ,&ver JCN 173 POP2 POP2 174 POPr 175 176 JMP2r 177 178 @line-hor ( x0* x1* y* color -- ) 179 180 STH .Screen/y DEO2 181 SWP2 182 &loop 183 ( save ) DUP2 .Screen/x DEO2 184 ( draw ) STHkr .Screen/pixel DEO 185 INC2 GTH2k ,&loop JCN 186 POP2 POP2 POPr 187 188 JMP2r 189 190 @line-ver ( x* y0* y1* color -- ) 191 192 STH ROT2 .Screen/x DEO2 193 SWP2 194 &loop 195 ( save ) DUP2 .Screen/y DEO2 196 ( draw ) STHkr .Screen/pixel DEO 197 INC2 GTH2k ,&loop JCN 198 POP2 POP2 POPr 199 200 JMP2r 201 202 @checker-icn 203 f0f0 f0f0 0f0f 0f0f