neralie.tal (7173B)
1 ( app/neralie : clock with arvelie date ) 2 3 ( devices ) 4 5 |00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ] 6 |10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ] 7 |20 @Screen [ &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ] 8 |c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ] 9 10 ( variables ) 11 12 |0000 13 14 @fps [ ¤t $1 &next $1 &second $1 ] 15 @number [ &started $1 &count $1 ] 16 @lines [ &addr $1 ] 17 @neralie [ &n0123 $2 &n4 $1 &n5 $1 &n6 $1 &n7 $1 &n8 $1 &n9 $1 &color $1 &x $2 &y $2 &w $2 &h $2 ] 18 @mul [ &ahi $1 &alo $1 &bhi $1 &blo $1 ] 19 @frame 20 &x1 $2 &x2 $2 &y1 $2 &y2 $2 21 22 ( program ) 23 24 |0100 25 26 ( theme ) 27 #0f3d .System/r DEO2 28 #0fe3 .System/g DEO2 29 #0fb2 .System/b DEO2 30 31 ( vectors ) 32 ;on-screen .Screen/vector DEO2 33 34 ( window ) 35 #0160 .Screen/width DEO2 36 #0110 .Screen/height DEO2 37 38 #01 .fps/current STZ 39 40 ( set size ) 41 #0018 ( padding ) 42 DUP2 .frame/x1 STZ2 43 DUP2 .frame/y1 STZ2 44 DUP2 .Screen/width DEI2 SWP2 SUB2 #0001 SUB2 .frame/x2 STZ2 45 .Screen/height DEI2 SWP2 SUB2 .frame/y2 STZ2 46 47 #01 .neralie/color STZ 48 49 .frame/x1 LDZ2 .frame/x2 LDZ2 50 OVR2 OVR2 .frame/y1 LDZ2 ;h JSR2 51 .frame/y2 LDZ2 ;h JSR2 52 .frame/y1 LDZ2 #0001 SUB2 .frame/y2 LDZ2 INC2 53 OVR2 OVR2 .frame/x1 LDZ2 ;v JSR2 54 .frame/x2 LDZ2 ;v JSR2 55 56 @on-screen ( -> ) 57 58 ;update-fps JSR2 59 60 #00 .neralie/color STZ 61 ;draw-clock JSR2 62 ;neralie-calc JSR2 63 64 #01 .neralie/color STZ 65 ;draw-date JSR2 66 ;draw-clock JSR2 67 68 BRK 69 70 @neralie-calc ( -- ) 71 72 ( add up fractions of a pulse, store tenths in n6 ) 73 #0120 #00 .DateTime/hour DEI MUL2 74 #00c0 #00 .DateTime/minute DEI MUL2 ADD2 75 #00f8 #00 .DateTime/second DEI MUL2 ADD2 76 #0271 #00 .fps/next LDZ MUL2 #00 .fps/current LDZ DIV2 #30 SFT2 ADD2 77 #01b0 ;modf JSR2 SWP2 #0017 MUL2 #03e8 DIV2 .neralie/n6 STZ POP 78 79 ( add up units and tens of pulses, store in n5 and n4 ) 80 #0042 #00 .DateTime/hour DEI MUL2 ADD2 81 #005e #00 .DateTime/minute DEI MUL2 ADD2 82 #000b #00 .DateTime/second DEI MUL2 ADD2 83 #000a ;modf JSR2 SWP2 .neralie/n5 STZ POP 84 #000a ;modf JSR2 SWP2 .neralie/n4 STZ POP 85 86 ( add up hundreds of pulses + 10 x beats, store in n0123 ) 87 #01a0 #00 .DateTime/hour DEI MUL2 ADD2 88 #0006 #00 .DateTime/minute DEI MUL2 ADD2 .neralie/n0123 STZ2 89 90 JMP2r 91 92 @draw-date ( -- ) 93 94 ( auto x ) #01 .Screen/auto DEO 95 96 .Screen/width DEI2 #01 SFT2 #0034 SUB2 .Screen/x DEO2 97 .Screen/height DEI2 #0010 SUB2 .Screen/y DEO2 98 99 ( arvelie ) 100 .DateTime/year DEI2 #07d6 SUB2 NIP 101 DUP #0a DIV #00 SWP #30 SFT2 ;font-numbers ADD2 .Screen/addr DEO2 102 #01 .Screen/sprite DEO 103 #0a DIVk MUL SUB #00 SWP #30 SFT2 ;font-numbers ADD2 .Screen/addr DEO2 104 #01 .Screen/sprite DEO 105 .DateTime/doty DEI2 106 DUP2 #000e DIV2 #30 SFT2 ;font-letters ADD2 .Screen/addr DEO2 107 #01 .Screen/sprite DEO 108 #000e DIV2k MUL2 SUB2 109 DUP2 #000a DIV2 ,digit JSR 110 #000a DIV2k MUL2 SUB2 ,digit JSR 111 112 .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2 113 114 ( neralie ) 115 .neralie/n0123 LDZ2 116 #03e8 ;modf JSR2 ,digit JSR 117 #0064 ;modf JSR2 ,digit JSR 118 #000a ;modf JSR2 ,digit JSR 119 #000b ,digit JSR ( the colon ) 120 ,digit JSR 121 #00 .neralie/n4 LDZ ,digit JSR 122 #00 .neralie/n5 LDZ ,digit JSR 123 124 ( auto none ) #00 .Screen/auto DEO 125 126 JMP2r 127 128 @digit ( index* -- ) 129 130 #30 SFT2 ;font-numbers ADD2 .Screen/addr DEO2 131 .neralie/color LDZ .Screen/sprite DEO 132 133 JMP2r 134 135 @draw-clock ( -- ) 136 137 .frame/x2 LDZ2 .frame/x1 LDZ2 138 DUP2 .neralie/x STZ2 SUB2 .neralie/w STZ2 139 .frame/y2 LDZ2 .frame/y1 LDZ2 140 DUP2 .neralie/y STZ2 SUB2 .neralie/h STZ2 141 142 ;neralie/n4 NIP .neralie/n0123 LDZ2 143 144 DUP2 ;&h JSR2 145 146 ;&next JSR2 #0008 .Screen/x DEO2 .neralie/y LDZ2 #0003 SUB2 .Screen/y DEO2 ,digit JSR 147 148 DUP2 ;&v JSR2 149 #04 ;v/spacing STA 150 .frame/y1 LDZ2 #0003 SUB2 .neralie/y LDZ2 .neralie/x LDZ2 ;v JSR2 151 #01 ;v/spacing STA 152 ,&next JSR #0008 .Screen/y DEO2 .neralie/x LDZ2 #0003 SUB2 .Screen/x DEO2 ;digit JSR2 153 DUP2 ,&h JSR 154 ,&next JSR .Screen/width DEI2 #0010 SUB2 .Screen/x DEO2 .neralie/y LDZ2 #0003 SUB2 .Screen/y DEO2 ;digit JSR2 155 DUP2 ,&v JSR 156 ,&next JSR POP2 157 DUP2 ,&h JSR 158 ,&next JSR POP2 159 DUP2 ,&v JSR 160 POP2 POP 161 JMP2r 162 163 &next ( digit-addr number* -- next-digit-addr next-number* prev-digit* ) 164 #03e8 ;modf JSR2 STH2 #000a MUL2 165 ROT STHk INC ROT ROT 166 #00 STHr LDZ ADD2 167 STH2r 168 JMP2r 169 170 &h ( number* -- ) 171 ,scale JSR 172 .neralie/h LDZ2 ;mul2hi JSR2 173 ORAk #02 JCN POP2 JMP2r 174 DUP2 .neralie/y LDZ2 ADD2 .neralie/y STZ2 175 .neralie/h LDZ2 SWP2 SUB2 .neralie/h STZ2 176 .neralie/x LDZ2 DUP2 .neralie/w LDZ2 ADD2 .neralie/y LDZ2 ,h JMP 177 178 &v ( number* -- ) 179 ,scale JSR 180 .neralie/w LDZ2 ;mul2hi JSR2 181 ORAk #02 JCN POP2 JMP2r 182 DUP2 .neralie/x LDZ2 ADD2 .neralie/x STZ2 183 .neralie/w LDZ2 SWP2 SUB2 .neralie/w STZ2 184 .neralie/y LDZ2 DUP2 .neralie/h LDZ2 ADD2 .neralie/x LDZ2 ,v JMP 185 186 @scale ( 0..10000* -- 0..65535* ) 187 DUP2 #8db8 ;mul2hi JSR2 188 SWP2 #0006 MUL2 ADD2 189 JMP2r 190 191 @h ( x1* x2* y* -- ) 192 .Screen/y DEO2 193 .Screen/x .lines/addr STZ 194 ,v/draw-line JMP 195 196 @v ( y1* y2* x* -- ) 197 .Screen/x DEO2 198 .Screen/y .lines/addr STZ 199 200 &draw-line ( v1* v2* -- ) 201 LTH2k #01 JCN SWP2 202 STH2 203 204 &loop 205 LIT2 [ 00 ] &spacing [ 01 ] ADD2 206 DUP2 DUP2r STH2r LTH2 ,&keep-going JCN 207 POP2 POP2r 208 JMP2r 209 210 &keep-going 211 DUP2 .lines/addr LDZ DEO2 212 .neralie/color LDZ .Screen/pixel DEO 213 ,&loop JMP 214 215 @update-fps ( -- ) 216 .fps/next LDZ INC .fps/next STZ 217 .DateTime/second DEI .fps/second LDZ NEQ JMP JMP2r 218 .DateTime/second DEI .fps/second STZ 219 .fps/next LDZ .fps/current STZ 220 221 #00 .fps/next STZ 222 JMP2r 223 224 @modf ( dividend* divisor* SUB2 remainder* quotient* ) 225 DIV2k STH2k MUL2 SUB2 STH2r JMP2r 226 227 @mul2hi ( a* b* -- product-top-16-bits* ) 228 ( 229 Multiplying two 16-bit numbers yields a 32-bit number. 230 MUL2 returns the lowest 16 bits, we want the highest. 231 232 We split each short into hi and lo bytes, then sum 233 the following multiplications: 234 235 31..24 23..16 15..08 07..00 236 { ahi * bhi } 237 { alo * bhi } 238 { ahi * blo } 239 { alo * blo } 240 241 Bits 07..00 can be ignored, but each sum in bits 23..16 242 can end up overflowing into bit 24. 243 ) 244 245 ;mul/bhi STA2 ;mul/ahi STA2 246 #00 247 #00 248 #00 .mul/alo LDZ #00 .mul/blo LDZ MUL2 249 POP 250 #00 .mul/ahi LDZ #00 .mul/blo LDZ MUL2 ,&adc JSR 251 #00 .mul/alo LDZ #00 .mul/bhi LDZ MUL2 ,&adc JSR 252 POP 253 #00 .mul/ahi LDZ #00 .mul/bhi LDZ MUL2 ADD2 254 JMP2r 255 256 &adc ( 31..24 a* b* -- 31..24 sum* ) 257 OVR2 ADD2 SWP2 OVR2 258 GTH2 ,&carry JCN 259 JMP2r 260 &carry 261 ROT INC ROT ROT 262 JMP2r 263 264 @font-numbers 265 7cc6 ced6 e6c6 7c00 1838 1818 1818 7e00 3c66 063c 6066 7e00 266 3c66 061c 0666 3c00 1c3c 6ccc fe0c 1e00 7e62 607c 0666 3c00 267 3c66 607c 6666 3c00 7e66 060c 1818 1800 3c66 663c 6666 3c00 268 3c66 663e 0666 3c00 7cc6 ced6 e6c6 7c00 0018 1800 1818 0000 269 270 @font-letters 271 183c 6666 7e66 6600 fc66 667c 6666 fc00 3c66 c0c0 c066 3c00 272 f86c 6666 666c f800 fe62 6878 6862 fe00 fe62 6878 6860 f000 273 3c66 c0c0 ce66 3e00 6666 667e 6666 6600 7e18 1818 1818 7e00 274 1e0c 0c0c cccc 7800 e666 6c78 6c66 e600 f060 6060 6266 fe00 275 c6ee fefe d6c6 c600 c6e6 f6de cec6 c600 386c c6c6 c66c 3800 276 fc66 667c 6060 f000 386c c6c6 dacc 7600 fc66 667c 6c66 e600 277 3c66 603c 0666 3c00 7e5a 1818 1818 3c00 6666 6666 6666 3c00 278 6666 6666 663c 1800 c6c6 c6d6 feee c600 c66c 3838 6cc6 c600 279 6666 663c 1818 3c00 fec6 8c18 3266 fe00 0018 187e 1818 0000