bifurcan.tal (3487B)
1 ( Bifurcan ) 2 3 |00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2 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 &wheel $1 6 |c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 7 |80 @Controller &vector $2 &button $1 &key $1 8 9 |0000 10 11 @last $1 12 @style $1 13 @center &x $2 &y $2 14 15 |0100 16 17 @on-reset ( -> ) 18 ( | theme ) 19 #0f3a .System/r DEO2 20 #0fda .System/g DEO2 21 #0faa .System/b DEO2 22 ( | vectors ) 23 ;on-frame .Screen/vector DEO2 24 ;on-mouse .Mouse/vector DEO2 25 ;on-button .Controller/vector DEO2 26 ( | find center ) 27 .Screen/width DEI2 #01 SFT2 .center/x STZ2 28 .Screen/height DEI2 #01 SFT2 .center/y STZ2 29 ( | background ) 30 ;tiles <cover-pattern> 31 <redraw> 32 BRK 33 34 @on-frame ( -> ) 35 ( | only draw once per second ) 36 .DateTime/second DEI .last LDZ NEQk ?{ POP2 BRK } 37 .last STZ 38 POP <redraw> 39 BRK 40 41 @on-mouse ( -> ) 42 [ LIT2 00 -Mouse/state ] DEI NEQ #41 ADD ;cursor-icn <update-cursor> 43 .Mouse/state DEI ?{ BRK } 44 select [ LIT2 00 -Mouse/state ] DEO 45 BRK 46 47 @on-button ( -> ) 48 .Controller/button DEI ?{ BRK } 49 select [ LIT2 00 -Controller/button ] DEO 50 BRK 51 52 @select ( -- ) 53 .style LDZ INC #03 DIVk MUL SUB .style STZ 54 ;tiles [ LIT2 00 -style ] LDZ #40 SFT ADD2 <cover-pattern> 55 ( >> ) 56 57 @<redraw> ( -- ) 58 ( | hrs ) 59 [ .center/x LDZ2 #0018 SUB2 ] [ .center/y LDZ2 #0048 SUB2 ] .DateTime/hour DEI #0a DIV <draw-number> 60 [ .center/x LDZ2 #0008 ADD2 ] [ .center/y LDZ2 #0048 SUB2 ] .DateTime/hour DEI #0a DIVk MUL SUB <draw-number> 61 ( | min ) 62 [ .center/x LDZ2 #0018 SUB2 ] [ .center/y LDZ2 #0018 SUB2 ] .DateTime/minute DEI #0a DIV <draw-number> 63 [ .center/x LDZ2 #0008 ADD2 ] [ .center/y LDZ2 #0018 SUB2 ] .DateTime/minute DEI #0a DIVk MUL SUB <draw-number> 64 ( | sec ) 65 [ .center/x LDZ2 #0018 SUB2 ] [ .center/y LDZ2 #0018 ADD2 ] .DateTime/second DEI #0a DIV <draw-number> 66 [ .center/x LDZ2 #0008 ADD2 ] [ .center/y LDZ2 #0018 ADD2 ] .DateTime/second DEI #0a DIVk MUL SUB 67 68 @<draw-number> ( x* y* n -- ) 69 ,&digit STR 70 ,&y STR2 71 ,&x STR2 72 #0f00 73 &loop ( -- ) 74 ( save-x ) DUP #03 DIVk MUL SUB #00 SWP #30 SFT2 [ LIT2 &x $2 ] ADD2 .Screen/x DEO2 75 ( save-y ) DUP #03 DIV #00 SWP #30 SFT2 [ LIT2 &y $2 ] ADD2 .Screen/y DEO2 76 ( get digit* ) DUP [ LIT &digit $1 ] DUP ADD #00 SWP ;digits ADD2 LDA2 77 ( get bit ) ROT #0e SWP SUB SFT2 #0001 AND2 78 ( set tile ) #30 SFT2 ;tiles ADD2 79 ( set style ) .style LDZ #40 SFT #00 SWP ADD2 .Screen/addr DEO2 80 ( draw ) [ LIT2 01 -Screen/sprite ] DEO 81 INC GTHk ?&loop 82 POP2 JMP2r 83 84 @<cover-pattern> ( addr* -- ) 85 .Screen/addr DEO2 86 .Screen/height DEI2 #03 SFT2 NIP ,&h STR 87 .Screen/width DEI2 #03 SFT2 NIP ,&w STR 88 [ LIT &h $1 ] #00 89 &ver ( -- ) 90 #00 OVR #30 SFT2 .Screen/y DEO2 91 [ LIT &w $1 ] #00 92 &hor ( -- ) 93 #00 OVR #30 SFT2 .Screen/x DEO2 94 [ LIT2 01 -Screen/sprite ] DEO 95 INC GTHk ?&hor 96 POP2 INC GTHk ?&ver 97 POP2 JMP2r 98 99 @<update-cursor> ( color addr* -- ) 100 [ LIT2 00 -Screen/auto ] DEO 101 ;fill-icn .Screen/addr DEO2 102 #40 <draw-cursor> 103 .Mouse/x DEI2 ,<draw-cursor>/x STR2 104 .Mouse/y DEI2 ,<draw-cursor>/y STR2 105 .Screen/addr DEO2 106 107 @<draw-cursor> ( color -- ) 108 [ LIT2 &x $2 ] .Screen/x DEO2 109 [ LIT2 &y $2 ] .Screen/y DEO2 110 .Screen/sprite DEO 111 JMP2r 112 113 @cursor-icn [ 80c0 e0f0 f8e0 1000 ] 114 115 @fill-icn [ ffff ffff ffff ffff ] 116 117 @digits [ 118 7b6f 2492 73e7 73cf 5bc9 79cf 49ef 7249 119 7bef 7bc9 ] 120 121 @tiles [ 122 0102 0408 1020 4080 8040 2010 0804 0201 123 0718 2040 4080 8080 0101 0102 0204 18e0 124 0808 0810 e304 0808 0808 0804 e310 0808 ] 125