esop-lib-subs.tal (5082B)
1 ( ESOP stdlib, subroutine part ) 2 ( by Luxferre, 2022, public domain ) 3 4 ( sprite and text drawing routines ) 5 6 ( subtract #20 from the ASCII code and get the absolute offset from the nanofont label ) 7 %CHAR-TO-NF { #20 SUB BTS #10 SFT2 ;nanofont ADD2 } 8 9 ( 4x1 scanline output from the nibble ) 10 @line4 ( x y nibble -- x y ) 11 #04 ( x y nibble counter -- ) 12 &lp 13 DEC ( first effective counter value is 3 ) 14 DUP2 ( x y nibble counter nibble counter -- ) 15 GETBIT ( x y nibble counter bit -- ) 16 ,&dpxl JCN 17 ,&skip JMP 18 &dpxl ( x y nibble counter -- ) 19 SWP2 PXLk SWP2 20 &skip ( x y nibble counter -- ) 21 SWP2 SWP ( nibble counter y x -- ) 22 INC ( increment x coord ) 23 SWP SWP2 ( x y nibble counter -- ) 24 DUP ,&lp JCN 25 POP2 ( x y nibble counter -- x y ) 26 SWP #04 SUB SWP ( restore x coord ) 27 JMP2r 28 29 ( 4x4 sprite output from the short ) 30 @sprite4 ( x y sprval* -- x y ) 31 SWP2 OVR2 ( sprval* x y sprval* -- ) 32 ( line 1 ) 33 #0c SFT2 NIP ( sprval* x y nibble -- ) 34 ;line4 JSR2 ( sprval* x y -- ) 35 ( line 2 ) 36 INC ( increment y coord ) 37 OVR2 ( sprval* x y sprval* -- ) 38 #08 SFT2 NIP #0f AND ( sprval* x y nibble -- ) 39 ;line4 JSR2 ( sprval* x y -- ) 40 ( line 3 ) 41 INC ( increment y coord ) 42 OVR2 ( sprval* x y sprval* -- ) 43 #04 SFT2 NIP #0f AND ( sprval* x y nibble -- ) 44 ;line4 JSR2 ( sprval* x y -- ) 45 ( line 4 ) 46 INC ( increment y coord ) 47 OVR2 ( sprval* x y sprval* -- ) 48 NIP #0f AND ( sprval* x y nibble -- ) 49 ;line4 JSR2 ( sprval* x y -- ) 50 #03 SUB ( restore y coord ) 51 SWP2 POP2 ( x y -- ) 52 JMP2r 53 54 ( nanofont character sprite output ) 55 @drawc ( x y char -- x y ) 56 CHAR-TO-NF LDA2 ;sprite4 JSR2 57 JMP2r 58 59 ( same as drawc but auto increment x coord ) 60 @putc ( x y char -- x y ) 61 ;drawc JSR2 62 SWP ( y x -- ) 63 #04 ADD 64 SWP ( x y -- ) 65 JMP2r 66 67 ( same as drawc but auto increment x coord and correct x and y coords if it's outside the screen ) 68 @putc-wrapover-xy ( x y char -- x y ) 69 ;drawc JSR2 70 SWP ( y x -- ) 71 #04 ADD 72 DUP #51 LTH ( y x flg -- ) 73 ,&skp JCN 74 POP #04 ADD #00 ( replace x coord with 0 and add 4 to y coord ) 75 &skp 76 SWP ( x y -- ) 77 JMP2r 78 79 ( output a complete null-terminated string at x y ) 80 @draw-str ( x y s* -- x y ) 81 &loop 82 LDAk ( x y s* c -- ) 83 #00 EQU ,&eof JCN ( eof on #00 ) 84 ( x y s* -- ) 85 LDAk ( x y s* c -- ) 86 ROT ROT ( x y c s* -- ) 87 STH2 ( x y c -- ) 88 ;putc JSR2 ( x y -- ) 89 STH2r ( x y s* ) 90 INC2 ,&loop JMP 91 &eof POP2 JMP2r 92 93 ( output a complete null-terminated string at x y with auto line breaks ) 94 @draw-long-str ( x y s* -- x y ) 95 &loop 96 LDAk ( x y s* c -- ) 97 #00 EQU ,&eof JCN ( eof on #00 ) 98 ( x y s* -- ) 99 LDAk ( x y s* c -- ) 100 ROT ROT ( x y c s* -- ) 101 STH2 ( x y c -- ) 102 ;putc-wrapover-xy JSR2 ( x y -- ) 103 STH2r ( x y s* ) 104 INC2 ,&loop JMP 105 &eof POP2 JMP2r 106 107 ( draw decimal short ) 108 @print-dec ( x y value* -- x y ) 109 #00 ,&sflag STR 110 SWP2 ,&coords STR2 ( value* -- ) 111 #2710 ,&parse JSR 112 #03e8 ,&parse JSR 113 #0064 ,&parse JSR 114 #000a ,&parse JSR 115 NIP ,&emit JSR 116 ,&coords LDR2 117 JMP2r 118 &parse 119 DIV2k ( value* divisor* -- value* divisor* div* ) 120 DUP ( value* divisor* div* divlonib -- ) 121 DUP #00 EQU ,&sk JCN 122 #01 ,&sflag STR 123 &sk 124 ,&emit JSR ( value* divisor* div* -- ) 125 MUL2 ( value* divisor* div* -- value* wholevalue* ) 126 SUB2 ( value* wholevalue* -- rem* ) 127 JMP2r 128 &emit 129 ,&sflag LDR ,&nsk JCN 130 POP JMP2r 131 &nsk 132 #30 ADD 133 ,&coords LDR2 134 ROT 135 ;putc JSR2 136 ,&coords STR2 137 JMP2r 138 LIT &coords $2 139 LIT &sflag $1 140 141 ( draw decimal byte ) 142 @print-dec-byte ( x y value -- x y ) 143 ROT ROT ,&coords STR2 ( value -- ) 144 #64 ,&parse JSR 145 #0a ,&parse JSR 146 ,&emit JSR 147 ,&coords LDR2 148 JMP2r 149 &parse 150 DIVk ( value divisor -- value divisor div ) 151 DUP ( value divisor div div -- ) 152 ,&emit JSR ( value divisor div -- ) 153 MUL ( value divisor div -- value wholevalue ) 154 SUB ( value wholevalue -- rem ) 155 JMP2r 156 &emit 157 #30 ADD 158 ,&coords LDR2 159 ROT 160 ;putc JSR2 161 ,&coords STR2 162 JMP2r 163 LIT &coords $2 164 165 ( draw decimal byte limited to 2 digits ) 166 @print-dec2-byte ( x y value -- x y ) 167 ROT ROT ,&coords STR2 ( value -- ) 168 #64 DIVk MUL SUB 169 #0a ,&parse JSR 170 ,&emit JSR 171 ,&coords LDR2 172 JMP2r 173 &parse 174 DIVk ( value divisor -- value divisor div ) 175 DUP ( value divisor div div -- ) 176 ,&emit JSR ( value divisor div -- ) 177 MUL ( value divisor div -- value wholevalue ) 178 SUB ( value wholevalue -- rem ) 179 JMP2r 180 &emit 181 #30 ADD 182 ,&coords LDR2 183 ROT 184 ;putc JSR2 185 ,&coords STR2 186 JMP2r 187 LIT &coords $2 188 189 ( the basic 96 nanofont glyphs for ESOP, courtesy of Michaelangel007 ) 190 191 @nanofont 192 0000 4400 aa00 aee0 64c4 ce60 4c60 4000 4840 4240 6600 4e40 0088 0e00 0080 2480 193 4a40 8440 c460 e6e0 ae20 64c0 8ee0 e220 6ec0 ee20 4040 0448 4840 e0e0 4240 6240 194 cc20 4ea0 cee0 6860 cac0 ece0 ec80 cae0 aea0 4440 22c0 aca0 88e0 eea0 eaa0 eae0 195 ee80 eac0 cea0 64c0 e440 aae0 aa40 aee0 a4a0 a440 e4e0 c8c0 8420 6260 4a00 00e0 196 8400 04c0 8cc0 0cc0 4cc0 08c0 4880 0ccc 8cc0 0880 0448 8ca0 8840 0ce0 0ca0 0cc0 197 0cc8 0cc4 0c80 0480 4c60 0ae0 0a40 0e60 0cc0 0ae2 0840 6c60 4444 c6c0 6c00 a4a4