├── Tachyon Forth Model.pdf └── rp2040 └── mecrisp ├── Forth ├── FONT16X32.FTH ├── FRED.FTH ├── SPLAT.FTH ├── ST7789A.FTH └── TACHYON.FTH ├── README.md ├── acm ├── mecrisp-2.61-921600bd.uf2 ├── qt ├── s └── usb /Tachyon Forth Model.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/forth2020/tachyon/861e6c756e4c237eb1540497dfee84cb7a11647f/Tachyon Forth Model.pdf -------------------------------------------------------------------------------- /rp2040/mecrisp/Forth/FONT16X32.FTH: -------------------------------------------------------------------------------- 1 | mecrisp 2 | compiletoflash 3 | CREATE FONT16X32 4 | $FFFFFFFF , $FFFFFFFF , $FFFFFFFF , $FFFFFFFF , 5 | $000000FF , $000000FF , $000000FF , $555540FF , 6 | $155540FF , $055540FF , $015540FF , $005540FF , 7 | $001540FF , $000540FF , $000140FF , $000040FF , 8 | $000040FF , $000140FF , $000540FF , $001540FF , 9 | $005540FF , $015540FF , $055540FF , $155540FF , 10 | $555540FF , $000000FF , $000000FF , $000000FF , 11 | $AAAAAAFF , $AAAAAABF , $AAAAAAAF , $AAAAAAAB , 12 | $00000000 , $00000000 , $00000000 , $00000000 , 13 | $00000000 , $00000000 , $00000000 , $00000000 , 14 | $00000000 , $00000000 , $00081000 , $00281400 , 15 | $00A81500 , $02A81540 , $1FFFFFF8 , $3FFFFFFC , 16 | $3FFFFFFC , $1FFFFFF8 , $02A81540 , $00A81500 , 17 | $00281400 , $00081000 , $00000000 , $00000000 , 18 | $00000000 , $00000000 , $00000000 , $00000000 , 19 | $00000000 , $00000000 , $00000000 , $00000000 , 20 | $00000000 , $00000000 , $00000000 , $00000000 , 21 | $00000000 , $00000000 , $00000000 , $00000000 , 22 | $00000000 , $000BE000 , $000FF000 , $001FF400 , 23 | $005FF500 , $015FF540 , $055FF550 , $000FF000 , 24 | $000FF000 , $0AAFFAA0 , $02AFFA80 , $00AFFA00 , 25 | $002FF800 , $000FF000 , $0007D000 , $00000000 , 26 | $00000000 , $00000000 , $00000000 , $00000000 , 27 | $00000000 , $00000000 , $00000000 , $00000000 , 28 | $00000000 , $00000000 , $00000000 , $00000000 , 29 | $00000000 , $05000280 , $15400AA0 , $15502AA0 , 30 | $1554AAA0 , $1557AAA0 , $155FEAA0 , $157FFAA0 , 31 | $15FFFEA0 , $17FFFFA0 , $1FFFFFE0 , $3FFFFFF0 , 32 | $3FFFFFF0 , $1FFFFFE0 , $17FFFFA0 , $15FFFEA0 , 33 | $157FFAA0 , $155FEAA0 , $1557AAA0 , $1554AAA0 , 34 | $15502AA0 , $15400AA0 , $05000280 , $00000000 , 35 | $00000000 , $00000000 , $00000000 , $00000000 , 36 | $FFFFFFFF , $BFFFFFFF , $AFFFFFFF , $ABFFFFFF , 37 | $AA000000 , $AA000000 , $AA000000 , $AA015555 , 38 | $AA015554 , $AA015550 , $AA015540 , $AA015500 , 39 | $AA015400 , $AA015000 , $AA014000 , $AA010000 , 40 | $AA010000 , $AA014000 , $AA015000 , $AA015400 , 41 | $AA015500 , $AA015540 , $AA015550 , $AA015554 , 42 | $AA015555 , $AA000000 , $AA000000 , $AA000000 , 43 | $AAAAAAAA , $AAAAAAAA , $AAAAAAAA , $AAAAAAAA , 44 | $000000FF , $000000FF , $000000FF , $000000FF , 45 | $000000FF , $000000FF , $000000FF , $000000FF , 46 | $000000FF , $000000FF , $000000FF , $000000FF , 47 | $000000FF , $000000FF , $000000FF , $000000FF , 48 | $AA000000 , $AA000000 , $AA000000 , $AA000000 , 49 | $AA000000 , $AA000000 , $AA000000 , $AA000000 , 50 | $AA000000 , $AA000000 , $AA000000 , $AA000000 , 51 | $AA000000 , $AA000000 , $AA000000 , $AA000000 , 52 | $FFFFFFFF , $FFFFFFFF , $FFFFFFFF , $FFFFFFFF , 53 | $00000000 , $00000000 , $00000000 , $00000000 , 54 | $00000000 , $00000000 , $00000000 , $00000000 , 55 | $15555550 , $15555550 , $15555550 , $00000000 , 56 | $00000000 , $15555550 , $15555550 , $15555550 , 57 | $00000000 , $00000000 , $00000000 , $00000000 , 58 | $00000000 , $00000000 , $00000000 , $00000000 , 59 | $AAAAAAAA , $AAAAAAAA , $AAAAAAAA , $AAAAAAAA , 60 | $00000000 , $00000000 , $00000000 , $00000000 , 61 | $00000000 , $00555500 , $01555540 , $05555550 , 62 | $05555550 , $055FF550 , $05FFFF50 , $07FFFFD0 , 63 | $0FFFFFF0 , $0FFFFFF0 , $2FFFFFF8 , $2FFFFFF8 , 64 | $2FFFFFF8 , $2FFFFFF8 , $0FFFFFF0 , $0FFFFFF0 , 65 | $07FFFFD0 , $05FFFF50 , $055FF550 , $05555550 , 66 | $05555550 , $01555540 , $00555500 , $00000000 , 67 | $00000000 , $00000000 , $00000000 , $00000000 , 68 | $00000000 , $00000000 , $00000000 , $00000000 , 69 | $00000000 , $00000000 , $00000000 , $00000000 , 70 | $00000000 , $00000000 , $00000000 , $00014000 , 71 | $2AABEAA0 , $2AAFFAA8 , $0AAFFAA8 , $02B55E88 , 72 | $02B55E80 , $02F41F80 , $02F41F80 , $03F00FC0 , 73 | $03F00FC0 , $07E00BD0 , $07E00BD0 , $17A00AD4 , 74 | $37F55FD4 , $7FF55FF5 , $5FD557F5 , $00000000 , 75 | $00000000 , $00000000 , $00000000 , $00000000 , 76 | $00000000 , $00000000 , $00000000 , $00000000 , 77 | $00000000 , $00000000 , $00000000 , $00000000 , 78 | $00000000 , $00000000 , $00000000 , $002AA800 , 79 | $07FFFFD4 , $0FFFFFF0 , $1FF55FE0 , $3E8017A8 , 80 | $2A0054A8 , $2A0150A8 , $2A0540A8 , $2A1500A8 , 81 | $0A8542A0 , $0A8152A0 , $02A05E80 , $14A83F00 , 82 | $3FFD7FE8 , $2FFD7FF8 , $2FFD7FFC , $00000000 , 83 | $00000000 , $00000000 , $00000000 , $00000000 , 84 | $00000000 , $00000000 , $00000000 , $00000000 , 85 | $00000000 , $00000000 , $2AA80000 , $2AA80000 , 86 | $2AA80000 , $14A85500 , $14A95540 , $15AD5FF0 , 87 | $15FD4BF0 , $05FD2AF0 , $01FC2A50 , $00A8AA00 , 88 | $14A8FD00 , $14ABFD40 , $15AFF550 , $15FFE150 , 89 | $05FF8050 , $01FE8050 , $00AA0000 , $00AA0000 , 90 | $00A80000 , $00A80000 , $00000000 , $00000000 , 91 | $00000000 , $00000000 , $00000000 , $00000000 , 92 | $00000000 , $00000000 , $00140000 , $00154000 , 93 | $00154000 , $00140000 , $00140550 , $00140550 , 94 | $00140000 , $00140000 , $01554000 , $A1554000 , 95 | $AA800000 , $AAAA0000 , $0AAAA800 , $002AAAA0 , 96 | $0002AAAA , $000282AA , $0002800A , $00028000 , 97 | $00028000 , $00028000 , $00028000 , $00028000 , 98 | $00028000 , $00028000 , $00028000 , $00028000 , 99 | $00028000 , $00028000 , $00028000 , $00028000 , 100 | $00014000 , $00014000 , $A803C000 , $A803C000 , 101 | $2803C000 , $2803C000 , $2803C000 , $2803C000 , 102 | $2803C000 , $2803C000 , $2803C000 , $2803C000 , 103 | $2803C000 , $2803C000 , $7D57D555 , $7D57FFFF , 104 | $3C02AABE , $3D028054 , $2D028050 , $2D428150 , 105 | $29428140 , $29528540 , $28528500 , $28569500 , 106 | $28169400 , $2817D400 , $2807D000 , $2807D000 , 107 | $A803C000 , $A803C000 , $00000000 , $00000000 , 108 | $00028000 , $00028000 , $5403EAAA , $5403EAAA , 109 | $14014000 , $14014000 , $14014000 , $14014000 , 110 | $14014000 , $14014000 , $14014000 , $14014000 , 111 | $14014550 , $14015554 , $14015415 , $14015005 , 112 | $14015005 , $14015415 , $14015554 , $14014550 , 113 | $14014000 , $14014000 , $14014000 , $14014000 , 114 | $14014000 , $14014000 , $14014000 , $14014000 , 115 | $5403EAAA , $5403EAAA , $00028000 , $00028000 , 116 | $00000000 , $00000000 , $0F000000 , $0F000000 , 117 | $0F000000 , $0F000000 , $0F000000 , $0F000000 , 118 | $0F000000 , $CF000A00 , $FF002A00 , $FF00A800 , 119 | $3F02A000 , $0F028000 , $0F000A00 , $0F557F55 , 120 | $0F55FD55 , $0F02A000 , $0F028000 , $3F000000 , 121 | $FF000000 , $FF000000 , $CF000000 , $0F000000 , 122 | $0F000000 , $0F000000 , $0F000000 , $0F000000 , 123 | $0F000000 , $0F000000 , $00000000 , $00000000 , 124 | $0003C000 , $0003C000 , $0003F020 , $0000FCA0 , 125 | $00003FA0 , $00000FE0 , $00002BF0 , $0000AAFC , 126 | $0000003F , $0000000F , $00000003 , $00000000 , 127 | $00000000 , $00000000 , $00000000 , $00000000 , 128 | $00000000 , $00000000 , $00000000 , $00000000 , 129 | $00000000 , $00000003 , $0000000F , $0000003F , 130 | $000040FC , $000053F0 , $00005FC0 , $00007F00 , 131 | $0000FD40 , $0003F550 , $0003C000 , $0003C000 , 132 | $00000000 , $00000000 , $00000000 , $00000000 , 133 | $00000000 , $0002A000 , $000AA800 , $000AA800 , 134 | $000AA800 , $000AA800 , $000AA800 , $000AA800 , 135 | $000AA800 , $000AA800 , $000AA800 , $000AA800 , 136 | $0002A000 , $0002A000 , $0002A000 , $0002A000 , 137 | $00000000 , $00000000 , $0002A000 , $000AA800 , 138 | $000AA800 , $000AA800 , $0002A000 , $00000000 , 139 | $00000000 , $00000000 , $00000000 , $00000000 , 140 | $00000000 , $00000000 , $05400540 , $15501550 , 141 | $15501550 , $15501550 , $05400540 , $07E02F40 , 142 | $03E02B40 , $02A02A00 , $02A02A00 , $2AAAAAA0 , 143 | $2AAAAAA0 , $2AAAAAA0 , $02A02A00 , $02A02A00 , 144 | $02A02A00 , $02A02A00 , $2AAAAAA0 , $2AAAAAA0 , 145 | $2AAAAAA0 , $02A02A00 , $02A02A00 , $02A02A00 , 146 | $02A02A00 , $00000000 , $00000000 , $00000000 , 147 | $00000000 , $00000000 , $00000000 , $00000000 , 148 | $00000000 , $00000000 , $00000000 , $00000000 , 149 | $00000000 , $00000000 , $00054000 , $0A856A80 , 150 | $0A85EAA0 , $02F5F4A0 , $07F5F5E0 , $15FDFFF0 , 151 | $15A82FD0 , $002A0150 , $002B5550 , $015FD540 , 152 | $055FD500 , $1557A000 , $1502A000 , $1FE0A950 , 153 | $3FFDFD50 , $2D7D7F40 , $287D7E00 , $2AAD4A80 , 154 | $0AA54A80 , $00054000 , $00000000 , $00000000 , 155 | $00000000 , $00000000 , $00000000 , $00000000 , 156 | $00000000 , $00000000 , $0002A000 , $000AA800 , 157 | $000AA800 , $000AA800 , $0002A000 , $0017F000 , 158 | $0055F400 , $01545500 , $01501500 , $01501500 , 159 | $01545500 , $00555400 , $00155000 , $00055400 , 160 | $04155500 , $15151540 , $15540540 , $05500150 , 161 | $01500150 , $05540550 , $15555540 , $15155540 , 162 | $04015400 , $00000000 , $00000000 , $00000000 , 163 | $00000000 , $00000000 , $00000000 , $00000000 , 164 | $00000000 , $00000000 , $01400A00 , $05502A80 , 165 | $05502A80 , $0154AA00 , $0054A800 , $0057A800 , 166 | $0017A000 , $001FE000 , $000FC000 , $000FC000 , 167 | $002FD000 , $002B5000 , $002B5000 , $002B5000 , 168 | $002B5000 , $002B5000 , $002B5000 , $002FD000 , 169 | $000FC000 , $000FC000 , $001FE000 , $0017A000 , 170 | $0057A800 , $0054A800 , $0154AA00 , $05502A80 , 171 | $05502A80 , $01400A00 , $00000000 , $00000000 , 172 | $00000000 , $00000000 , $00000000 , $00000000 , 173 | $00000000 , $00000000 , $00000000 , $00000000 , 174 | $00000000 , $00000000 , $000FC000 , $000FC000 , 175 | $050FC140 , $154FC550 , $055FD540 , $2BFFFFA0 , 176 | $2AFFFEA0 , $2BFFFFA0 , $055FD540 , $154FC550 , 177 | $050FC140 , $000FC000 , $000FC000 , $00000000 , 178 | $00000000 , $00000000 , $00000000 , $00000000 , 179 | $00000000 , $00000000 , $00000000 , $00000000 , 180 | $00000000 , $00000000 , $00000000 , $00000000 , 181 | $00000000 , $00000000 , $00000000 , $00000000 , 182 | $00000000 , $00000000 , $00000000 , $00000000 , 183 | $00000000 , $00000000 , $00000000 , $2AAAAAA0 , 184 | $2AAAAAA0 , $2AAAAAA0 , $00000000 , $00000000 , 185 | $00000000 , $00000000 , $00015000 , $00055400 , 186 | $00055400 , $00055400 , $00055000 , $00054000 , 187 | $00015000 , $00015400 , $00005400 , $00000000 , 188 | $00000000 , $00000000 , $00000000 , $00000000 , 189 | $00000000 , $2A000000 , $2A000000 , $0A800000 , 190 | $0A800000 , $02A00000 , $02A00000 , $00A80000 , 191 | $00A80000 , $002A0000 , $002A0000 , $000A8000 , 192 | $000A8000 , $0002A000 , $0002A000 , $0000A800 , 193 | $0000A800 , $00002A00 , $00017A00 , $00055E80 , 194 | $00055E80 , $000556A0 , $000152A0 , $00000000 , 195 | $00000000 , $00000000 , $00000000 , $00000000 , 196 | $00000000 , $00000000 , $00000000 , $00000000 , 197 | $00000000 , $001FD000 , $015FF500 , $055FFD40 , 198 | $055EAF40 , $151EABD0 , $151F8BF0 , $151F83F0 , 199 | $150F8150 , $150F8150 , $150F8150 , $150FC150 , 200 | $150FC150 , $150BC150 , $150BC150 , $150BC150 , 201 | $150BD150 , $150BD150 , $150AD150 , $054AD540 , 202 | $2FFFFFE0 , $2BFFFFA0 , $2ABFFAA0 , $00000000 , 203 | $00000000 , $00000000 , $00000000 , $00000000 , 204 | $00000000 , $00000000 , $00000000 , $00000000 , 205 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 206 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F000000 , 207 | $3F000000 , $0FC00000 , $0FFAA000 , $03FFA000 , 208 | $0AFFE000 , $0A855400 , $2A015500 , $2A001540 , 209 | $2A000540 , $2A0007F0 , $2A0003F0 , $0A800BD0 , 210 | $1FFFFFD0 , $17FFFF50 , $157FF550 , $00000000 , 211 | $00000000 , $00000000 , $00000000 , $00000000 , 212 | $00000000 , $00000000 , $00000000 , $00000000 , 213 | $00000000 , $0AAFEAA0 , $0AAFEAA0 , $0AABFAA0 , 214 | $000152A0 , $000152A0 , $000056A0 , $000056A0 , 215 | $000056A0 , $002AB7A0 , $02FEBFA0 , $0AFEBFA0 , 216 | $0AD407E0 , $2A540540 , $2A540540 , $3F555550 , 217 | $3F555550 , $3F5557F0 , $2A5402A0 , $0AD40A80 , 218 | $0AFEAA80 , $02FEAA00 , $007EA000 , $00000000 , 219 | $00000000 , $00000000 , $00000000 , $00000000 , 220 | $00000000 , $00000000 , $00000000 , $00000000 , 221 | $00000000 , $2ABFFAA0 , $2BFFFFA0 , $2FFFFFE0 , 222 | $2F400540 , $1F800150 , $1F800150 , $0A800150 , 223 | $02A00150 , $02B55150 , $03F55550 , $05FD5550 , 224 | $05E80550 , $15A80150 , $152A0150 , $152A0150 , 225 | $152A0150 , $150A8150 , $150A8150 , $054A8540 , 226 | $0557F540 , $0157F500 , $0017F000 , $00000000 , 227 | $00000000 , $00000000 , $00000000 , $00000000 , 228 | $00000000 , $00000000 , $00000000 , $00000000 , 229 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 230 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 231 | $3F0003F0 , $2F4007E0 , $2F5557E0 , $2BD55F80 , 232 | $2FFFFFC0 , $2FEAAF40 , $3F2AA150 , $3F000150 , 233 | $3F000150 , $3F0003F0 , $3F0003F0 , $0FC00FC0 , 234 | $0FFFFFC0 , $03FFFF00 , $003FF000 , $00000000 , 235 | $00000000 , $00000000 , $00000000 , $00000000 , 236 | $00000000 , $00000000 , $00000000 , $00000000 , 237 | $00000000 , $00000000 , $00000000 , $00000000 , 238 | $00000000 , $00015000 , $00055400 , $00055400 , 239 | $0007F400 , $000BF800 , $000AA800 , $000AA800 , 240 | $0002A000 , $00000000 , $00000000 , $00015000 , 241 | $00055400 , $00055400 , $0007F400 , $000BF800 , 242 | $000AA800 , $000AA800 , $000AA000 , $000A8000 , 243 | $0002A000 , $0002A800 , $0000A800 , $00000000 , 244 | $00000000 , $00000000 , $00000000 , $00000000 , 245 | $00000000 , $00000000 , $00000000 , $00000000 , 246 | $00000000 , $00000000 , $15000000 , $15500000 , 247 | $2FFFAAA0 , $2AFFFAA0 , $2AAFFFA0 , $00005550 , 248 | $00000550 , $00005550 , $2AAFFFA0 , $2AFFFAA0 , 249 | $2FFFAAA0 , $15500000 , $15000000 , $00000000 , 250 | $00000000 , $00000000 , $00000000 , $00000000 , 251 | $00000000 , $00000000 , $00000000 , $00000000 , 252 | $00000000 , $00000000 , $00000000 , $00000000 , 253 | $00000000 , $002AA000 , $02AAAA00 , $0AAAAA80 , 254 | $0A800A80 , $2A0002A0 , $2A0003F0 , $2A001550 , 255 | $0A815540 , $0AB55400 , $03FD4000 , $15FE0000 , 256 | $156A0000 , $155E8000 , $015FC000 , $001FD400 , 257 | $00015540 , $00001550 , $000A8150 , $002AA000 , 258 | $002AA000 , $002AA000 , $000A8000 , $00000000 , 259 | $00000000 , $00000000 , $00000000 , $00000000 , 260 | $00000000 , $00000000 , $00000000 , $00000000 , 261 | $00000000 , $002AA000 , $02AAAA00 , $0ABFEA80 , 262 | $0BD55E80 , $2F5557A0 , $2F4017E0 , $3F0007E0 , 263 | $3E0003F0 , $3E5543F0 , $3EFFFAF0 , $3EFAFAF0 , 264 | $3EFAFAF0 , $3F5552F0 , $2F4543F0 , $2A0003F0 , 265 | $3E0007E0 , $3F0017E0 , $2F5557A0 , $2B5556A0 , 266 | $2A1542A0 , $2A0002A0 , $2A0002A0 , $00000000 , 267 | $00000000 , $00000000 , $00000000 , $00000000 , 268 | $00000000 , $00000000 , $00000000 , $00000000 , 269 | $00000000 , $003FF550 , $03FFFF50 , $0FFFFFD0 , 270 | $0FC00BD0 , $3F0003F0 , $3F0003F0 , $150003F0 , 271 | $150003F0 , $054003F0 , $055557F0 , $015557F0 , 272 | $055557F0 , $054003F0 , $150003F0 , $150003F0 , 273 | $150003F0 , $3F0003F0 , $3F0003F0 , $0FC00BD0 , 274 | $0FFFFFD0 , $03FFFF50 , $003FF550 , $00000000 , 275 | $00000000 , $00000000 , $00000000 , $00000000 , 276 | $00000000 , $00000000 , $00000000 , $00000000 , 277 | $00000000 , $2ABFFFF0 , $2BFFFFF0 , $2FFFFFF0 , 278 | $054003F0 , $150003F0 , $150003F0 , $150003F0 , 279 | $150003F0 , $150003F0 , $152AABF0 , $152AABF0 , 280 | $152AABF0 , $150003F0 , $150003F0 , $150003F0 , 281 | $150003F0 , $150003F0 , $150003F0 , $054003F0 , 282 | $2FFFFFF0 , $2BFFFFF0 , $2ABFFFF0 , $00000000 , 283 | $00000000 , $00000000 , $00000000 , $00000000 , 284 | $00000000 , $00000000 , $00000000 , $00000000 , 285 | $00000000 , $157FF550 , $17FFFF50 , $1FFFFFD0 , 286 | $0A800BD0 , $2A0003F0 , $2A0003F0 , $000003F0 , 287 | $000003F0 , $000003F0 , $001557F0 , $001557F0 , 288 | $001557F0 , $2AA003F0 , $2AA003F0 , $2AA003F0 , 289 | $2A0003F0 , $2A0003F0 , $2A0003F0 , $2A800BD0 , 290 | $2AAAABD0 , $2AAAAB50 , $2A2AA150 , $00000000 , 291 | $00000000 , $00000000 , $00000000 , $00000000 , 292 | $00000000 , $00000000 , $00000000 , $00000000 , 293 | $00000000 , $1FAAABD0 , $1FAAABD0 , $1FAAABD0 , 294 | $150A8150 , $150A8150 , $150A8150 , $150A8150 , 295 | $150A8150 , $150A8150 , $155FD550 , $155FD550 , 296 | $155FD550 , $150A8150 , $150A8150 , $150A8150 , 297 | $150A8150 , $150A8150 , $150A8150 , $150A8150 , 298 | $1FAAABD0 , $1FAAABD0 , $1FAAABD0 , $00000000 , 299 | $00000000 , $00000000 , $00000000 , $00000000 , 300 | $00000000 , $00000000 , $00000000 , $00000000 , 301 | $00000000 , $3F0002A0 , $3F8002A0 , $1FA002A0 , 302 | $17A802A0 , $15AA02A0 , $152A82A0 , $150AA2A0 , 303 | $1502AAA0 , $1500AAA0 , $15002AA0 , $15000AA0 , 304 | $15000AA0 , $15002AA0 , $1500AAA0 , $1502ABF0 , 305 | $150AA3F0 , $152A83F0 , $15AA03F0 , $07E807E0 , 306 | $0FF557E0 , $2BD557A0 , $2A1552A0 , $00000000 , 307 | $00000000 , $00000000 , $00000000 , $00000000 , 308 | $00000000 , $00000000 , $00000000 , $00000000 , 309 | $00000000 , $2A0003F0 , $2A0003F0 , $2A800BF0 , 310 | $2A800BF0 , $2AA02BF0 , $2AA02BF0 , $2AA8ABF0 , 311 | $2AA8ABF0 , $2A2AA3F0 , $2A2AA3F0 , $2A0A83F0 , 312 | $2A0A83F0 , $2A0003F0 , $2A0003F0 , $2A0003F0 , 313 | $2A0003F0 , $2A0003F0 , $2A0003F0 , $2A0003F0 , 314 | $3F5557F0 , $3F5557F0 , $3F5557F0 , $00000000 , 315 | $00000000 , $00000000 , $00000000 , $00000000 , 316 | $00000000 , $00000000 , $00000000 , $00000000 , 317 | $00000000 , $152AA150 , $17AAAB50 , $1FAAAFD0 , 318 | $1F800FD0 , $3F0017F0 , $3F0017F0 , $3F0057F0 , 319 | $3F0057F0 , $3F0153F0 , $3F0153F0 , $3F0543F0 , 320 | $3F0543F0 , $3F1503F0 , $3F1503F0 , $3F5403F0 , 321 | $3F5403F0 , $3F5003F0 , $3F5003F0 , $1FC00BD0 , 322 | $1FEAABD0 , $17AAAB50 , $152AA150 , $00000000 , 323 | $00000000 , $00000000 , $00000000 , $00000000 , 324 | $00000000 , $00000000 , $00000000 , $00000000 , 325 | $00000000 , $003FF550 , $03FFFF50 , $0FFFFFD0 , 326 | $0FC00BD0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 327 | $3F0003F0 , $2F4003F0 , $2F5557F0 , $2B5557F0 , 328 | $2A1557F0 , $2A0003F0 , $2A0003F0 , $2A0003F0 , 329 | $2A0003F0 , $2A0A83F0 , $2A0A83F0 , $0A8A8BD0 , 330 | $0AAAABD0 , $02AAAB50 , $00AAA150 , $02A80000 , 331 | $02A00000 , $02A00000 , $00000000 , $00000000 , 332 | $00000000 , $00000000 , $00000000 , $00000000 , 333 | $00000000 , $003FF550 , $03FFFF50 , $0FFFFFD0 , 334 | $0FC00BD0 , $3F0003F0 , $3F0003F0 , $150003F0 , 335 | $15000BD0 , $05402BD0 , $0557FF50 , $015FFD50 , 336 | $00FFD550 , $03FE0150 , $0FF00150 , $0FC00150 , 337 | $3F400150 , $3F0003F0 , $3F0003F0 , $1F800BD0 , 338 | $1FAAABD0 , $17AAAB50 , $152AA150 , $00000000 , 339 | $00000000 , $00000000 , $00000000 , $00000000 , 340 | $00000000 , $00000000 , $00000000 , $00000000 , 341 | $00000000 , $3F5557F0 , $3F5557F0 , $3F5557F0 , 342 | $2A0542A0 , $2A0542A0 , $2A0542A0 , $2A0542A0 , 343 | $2A0542A0 , $2A0542A0 , $2A0542A0 , $2A0542A0 , 344 | $2A0542A0 , $2A0542A0 , $2A0542A0 , $2A0542A0 , 345 | $2A0542A0 , $2A0542A0 , $2A0542A0 , $0A854A80 , 346 | $0AAFEA80 , $02AFEA00 , $002FE000 , $00000000 , 347 | $00000000 , $00000000 , $00000000 , $00000000 , 348 | $00000000 , $00000000 , $00000000 , $00000000 , 349 | $00000000 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 350 | $2F4007E0 , $2F4007E0 , $2F4007E0 , $2F4007E0 , 351 | $2B5017A0 , $2B5017A0 , $2B5A97A0 , $2B5A97A0 , 352 | $2A7EF6A0 , $2A7EF6A0 , $2AFEFEA0 , $2AFCFEA0 , 353 | $2ABDFAA0 , $2AB57AA0 , $2AB57AA0 , $2A955AA0 , 354 | $2A854AA0 , $2A0542A0 , $2A0542A0 , $00000000 , 355 | $00000000 , $00000000 , $00000000 , $00000000 , 356 | $00000000 , $00000000 , $00000000 , $00000000 , 357 | $00000000 , $3F0003F0 , $3F0003F0 , $3FC00FF0 , 358 | $0FC00FC0 , $0FF03FC0 , $03F03F00 , $03FCFF00 , 359 | $00FCFC00 , $00FFFC00 , $003FF000 , $003FF000 , 360 | $001FD000 , $001FD000 , $005FD400 , $005ED400 , 361 | $015ED500 , $015A9500 , $055A9540 , $054A8540 , 362 | $154A8550 , $150A8150 , $150A8150 , $00000000 , 363 | $00000000 , $00000000 , $00000000 , $00000000 , 364 | $00000000 , $00000000 , $0AAAA800 , $0AAAA800 , 365 | $0AAAA800 , $0555FD50 , $0555FD50 , $0555FD50 , 366 | $0150A800 , $0150A800 , $0054A800 , $0054A800 , 367 | $0015A800 , $0015A800 , $0005E800 , $0005E800 , 368 | $0001F800 , $0001F800 , $0000FC00 , $0000FC00 , 369 | $0000BD00 , $0000BD00 , $0000AD40 , $0000AD40 , 370 | $0555FD50 , $0555FD50 , $0555FD50 , $0AAAA800 , 371 | $0AAAA800 , $0AAAA800 , $00000000 , $00000000 , 372 | $00000000 , $00000000 , $00AAAA80 , $00AAAA80 , 373 | $00AAAA80 , $00A80150 , $00A80150 , $00A80540 , 374 | $00A80540 , $00A81500 , $00A81500 , $00A85400 , 375 | $00A85400 , $00A95000 , $00A95000 , $00AD4000 , 376 | $00AD4000 , $00BD0000 , $00BD0000 , $00FC0000 , 377 | $00FC0000 , $01F80000 , $01F80000 , $05E80000 , 378 | $05E80000 , $15A80000 , $15A80000 , $00AAAA80 , 379 | $00AAAA80 , $00AAAA80 , $00000000 , $00000000 , 380 | $00000000 , $00000000 , $00000000 , $00000000 , 381 | $00000000 , $00000000 , $00000000 , $00000000 , 382 | $00000000 , $00054000 , $00054000 , $00155000 , 383 | $00155000 , $00545400 , $00545400 , $01501500 , 384 | $01501500 , $05400540 , $05400540 , $15000150 , 385 | $15000150 , $00000000 , $00000000 , $00000000 , 386 | $00000000 , $00000000 , $00000000 , $00000000 , 387 | $00000000 , $AAAAAAAA , $AAAAAAAA , $AAAAAAAA , 388 | $00000000 , $00000000 , $00000000 , $00000000 , 389 | $00000000 , $00000000 , $00000000 , $00000000 , 390 | $00000000 , $00000000 , $00000000 , $00000000 , 391 | $00001400 , $00AAF500 , $0AABFF00 , $2AAFFE80 , 392 | $2A955280 , $2A554000 , $2A7FA800 , $2ABEAA80 , 393 | $2AAAAAA0 , $2A0002A0 , $2A0000A0 , $2A8002A0 , 394 | $2AAAAAA0 , $2AAAAA80 , $2A2AA800 , $00000000 , 395 | $00000000 , $00000000 , $00000000 , $00000000 , 396 | $00000000 , $00000000 , $00000000 , $00000000 , 397 | $00000000 , $00000150 , $00000150 , $00000150 , 398 | $00000150 , $00000150 , $00000150 , $00000150 , 399 | $00000150 , $003FF150 , $03FFFF50 , $0FFFFFD0 , 400 | $2FC00FD0 , $3F0003F0 , $150003F0 , $150003F0 , 401 | $150003F0 , $150003F0 , $3F0003F0 , $2FC00FD0 , 402 | $0FFFFFD0 , $03FFFF50 , $003FF150 , $00000000 , 403 | $00000000 , $00000000 , $00000000 , $00000000 , 404 | $00000000 , $00000000 , $00000000 , $00000000 , 405 | $00000000 , $15000000 , $15000000 , $15000000 , 406 | $15000000 , $15000000 , $15000000 , $15000000 , 407 | $15000000 , $153FF000 , $17FFFF00 , $1FFFFFC0 , 408 | $1FC00FC0 , $3F0003F0 , $3FAAABF0 , $3FAAABF0 , 409 | $3FAAABF0 , $150003F0 , $150003F0 , $3F400FC0 , 410 | $3FFFFFC0 , $1FFFFF00 , $15BFF000 , $00000000 , 411 | $00000000 , $00000000 , $00000000 , $00000000 , 412 | $00000000 , $00000000 , $00000000 , $00000000 , 413 | $00000000 , $15500000 , $15550000 , $15554000 , 414 | $00054000 , $00015000 , $00015000 , $00015000 , 415 | $00015000 , $3F7FF550 , $3FFFFF50 , $3FFFFFD0 , 416 | $2A815A80 , $2A0152A0 , $2A0152A0 , $2A0152A0 , 417 | $2A0152A0 , $2A0152A0 , $2A0152A0 , $2A815A80 , 418 | $2AABFA80 , $2AABFA00 , $2A2BF000 , $2A000000 , 419 | $0A800000 , $0AAAAA00 , $02AAAA00 , $002AAA00 , 420 | $00000000 , $00000000 , $00000000 , $00000000 , 421 | $00000000 , $00000150 , $00000150 , $00028150 , 422 | $000AA150 , $000AA150 , $00028150 , $00000150 , 423 | $00000150 , $001FFB50 , $015FFF50 , $055FFF50 , 424 | $054A8550 , $150A8150 , $150A8150 , $150A8150 , 425 | $150A8150 , $150A8150 , $150A8150 , $150A8150 , 426 | $1FAAABD0 , $1FAAABD0 , $1FAAABD0 , $00000000 , 427 | $00000000 , $00000000 , $00000000 , $00000000 , 428 | $00000000 , $00000000 , $00000000 , $00000000 , 429 | $00000000 , $000002A0 , $000002A0 , $000502A0 , 430 | $001542A0 , $001542A0 , $000502A0 , $000002A0 , 431 | $000002A0 , $2A1556A0 , $2A9556A0 , $0AB556A0 , 432 | $02BD02A0 , $00BF02A0 , $003FAAA0 , $001FAAA0 , 433 | $001FAAA0 , $003FAAA0 , $00BF02A0 , $02BD02A0 , 434 | $0AB502A0 , $2A9502A0 , $2A1502A0 , $00150000 , 435 | $00054000 , $00055550 , $00015550 , $00001550 , 436 | $00000000 , $00000000 , $00000000 , $00000000 , 437 | $00000000 , $00055500 , $00055500 , $00055500 , 438 | $00054000 , $00054000 , $00054000 , $00054000 , 439 | $00054000 , $02A7E2A0 , $0AAFEAA0 , $0AAFEAA0 , 440 | $2A2FCAA0 , $2A0FC2A0 , $2A0FC2A0 , $2A0FC2A0 , 441 | $2A0FC2A0 , $2A0FC2A0 , $2A0FC2A0 , $2A0FC2A0 , 442 | $2F5FD7E0 , $2F5FD7E0 , $2F5FD7E0 , $00000000 , 443 | $00000000 , $00000000 , $00000000 , $00000000 , 444 | $00000000 , $00000000 , $00000000 , $00000000 , 445 | $00000000 , $00000000 , $00000000 , $00000000 , 446 | $00000000 , $00000000 , $00000000 , $00000000 , 447 | $00000000 , $003FF150 , $03FFFF50 , $0FFFFFD0 , 448 | $0FC00FD0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 449 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $1F800BD0 , 450 | $1FAAABD0 , $17AAAB50 , $152AA150 , $00000000 , 451 | $00000000 , $00000000 , $00000000 , $00000000 , 452 | $00000000 , $00000000 , $00000000 , $00000000 , 453 | $00000000 , $00000000 , $00000000 , $00000000 , 454 | $00000000 , $00000000 , $00000000 , $00000000 , 455 | $00000000 , $2A3FF150 , $2BFFFF50 , $2FFFFFD0 , 456 | $2FC00FD0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 457 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $2FC00FD0 , 458 | $2FFFFFD0 , $2BFFFF50 , $2A3FF150 , $2A000150 , 459 | $2A000150 , $2A000150 , $2A000150 , $2A000150 , 460 | $00000000 , $00000000 , $00000000 , $00000000 , 461 | $00000000 , $00000000 , $00000000 , $00000000 , 462 | $00000000 , $00000000 , $00000000 , $00000000 , 463 | $00000000 , $00BFF950 , $0BFFFFD0 , $2FFFFFF0 , 464 | $3F400FF0 , $150003F0 , $0002ABF0 , $02AAABD0 , 465 | $0AAAAB50 , $2AAA0150 , $2A000150 , $2A8003F0 , 466 | $2AAAABF0 , $0AAAABD0 , $00AAA950 , $00000000 , 467 | $00000000 , $00000000 , $00000000 , $00000000 , 468 | $00000000 , $00000000 , $00000000 , $00000000 , 469 | $00000000 , $00000000 , $00000000 , $00000000 , 470 | $00000000 , $00000000 , $00015000 , $00015000 , 471 | $00015000 , $3F5557F0 , $3F5557F0 , $3F5557F0 , 472 | $2A0152A0 , $2A0152A0 , $2A0152A0 , $2A0152A0 , 473 | $2A0152A0 , $2A0152A0 , $2A0152A0 , $2A854A80 , 474 | $3FFFEA80 , $3FFFAA00 , $3F7AA000 , $00000000 , 475 | $00000000 , $00000000 , $00000000 , $00000000 , 476 | $00000000 , $00000000 , $00000000 , $00000000 , 477 | $00000000 , $00000000 , $00000000 , $00000000 , 478 | $00000000 , $00000000 , $00000000 , $00000000 , 479 | $00000000 , $3F0003F0 , $3F0003F0 , $3F4007F0 , 480 | $3F4007F0 , $2F5017E0 , $2F5A97E0 , $2B5ED7A0 , 481 | $2B5ED7A0 , $2A5FD6A0 , $2A5FD6A0 , $2A3FF2A0 , 482 | $2ABFFAA0 , $0AADEA80 , $02A56A00 , $00000000 , 483 | $00000000 , $00000000 , $00000000 , $00000000 , 484 | $00000000 , $00000000 , $00000000 , $00000000 , 485 | $00000000 , $00000000 , $00000000 , $00000000 , 486 | $00000000 , $00000000 , $00000000 , $00000000 , 487 | $00000000 , $3E0002F0 , $3F0003F0 , $3F4007F0 , 488 | $2F5017E0 , $2B5457A0 , $2A5556A0 , $2A1552A0 , 489 | $2A1552A0 , $2A5556A0 , $2B5457A0 , $2FD01FC0 , 490 | $3FEAAFD0 , $3FAAAB50 , $3E2AA050 , $2A000000 , 491 | $0A800000 , $0AAAAA00 , $02AAAA00 , $002AAA00 , 492 | $00000000 , $00000000 , $0A800000 , $0AA00000 , 493 | $02A80000 , $00A80000 , $00AA0000 , $002A0000 , 494 | $002A0000 , $002A0000 , $002A0000 , $002A0000 , 495 | $002A8000 , $155FD550 , $155FF550 , $1557FD50 , 496 | $0552A800 , $015EA000 , $005F8000 , $003FC000 , 497 | $002F5000 , $002B5400 , $002A5500 , $002A1540 , 498 | $157F5550 , $15FF5550 , $15FD5550 , $02A80000 , 499 | $0AA00000 , $0A800000 , $00000000 , $00000000 , 500 | $00000000 , $00000000 , $00054A80 , $00056A80 , 501 | $0005EA00 , $0005E800 , $0007E800 , $0007E000 , 502 | $0007E000 , $0007E000 , $0007E000 , $0007E000 , 503 | $000FE000 , $000FC000 , $002FC000 , $00AF4000 , 504 | $00AF4000 , $002FC000 , $000FC000 , $000FE000 , 505 | $0007E000 , $0007E000 , $0007E000 , $0007E000 , 506 | $0007E000 , $0007E800 , $0005E800 , $0005EA00 , 507 | $00056A80 , $00054A80 , $00000000 , $00000000 , 508 | $00000000 , $00000000 , $A080A80A , $A0A02A0A , 509 | $A0A80A0A , $A02A020A , $A00A800A , $A002A00A , 510 | $A080A80A , $A0A02A0A , $A0A80A0A , $A02A020A , 511 | $A00A800A , $B402F50A , $B481FD4A , $B5A57F5A , 512 | $B5FD4B5A , $A57F025A , $A15E805A , $A002A00A , 513 | $A080A80A , $A0A02A0A , $A0A80A0A , $A02A020A , 514 | $A00A800A , $A002A00A , $A080A80A , $A0A02A0A , 515 | $A0A80A0A , $A02A020A , $00000000 , $00000000 , 516 | $00000000 , $00000000 , $00000000 , $00000000 , 517 | $00000000 , $55400155 , $55500555 , $00500500 , 518 | $00541500 , $00141400 , $00141400 , $00155400 , 519 | $00055000 , $00055000 , $00055000 , $00014000 , 520 | $00014000 , $00055000 , $00055000 , $00055000 , 521 | $00155400 , $00141400 , $00141400 , $00541500 , 522 | $00500500 , $FFFAAFFF , $FFEAABFF , $00000000 , 523 | $00000000 , $00000000 , $00000000 , $00000000 , 524 | $00000000 , $00000000 , $00000000 , $00000000 , 525 | $00000000 , $FFC00000 , $FFF00000 , $00F00000 , 526 | $00FC0000 , $003C0000 , $003C0000 , $003F0000 , 527 | $000F0000 , $000F0000 , $000FC000 , $0003C000 , 528 | $0003C000 , $0003F000 , $0000F000 , $0000F000 , 529 | $0000FC00 , $00003C00 , $00003C00 , $00003F00 , 530 | $00000F00 , $AAAAAFFF , $AAAAABFF , $00000000 , 531 | $00000000 , $00000000 , $00000000 , $00000000 , 532 | $00000000 , $00000000 , $00000000 , $00000000 , 533 | $00000000 , $000002AA , $00000AAA , $00000A00 , 534 | $00002A00 , $00002800 , $00002800 , $0000A800 , 535 | $0000A000 , $0000A000 , $0002A000 , $55568000 , 536 | $55578000 , $000F8000 , $000F4000 , $000B4000 , 537 | $002B4000 , $00294000 , $00294000 , $00A95000 , 538 | $00A05000 , $AAA05555 , $AA801555 , $00000000 , 539 | $00000000 , $00000000 , $00000000 , $00000000 , 540 | $00000000 , $00000000 , $00000000 , $00000000 , 541 | $00000000 , $FFFFFFFF , $FFFFFFFF , $00000A00 , 542 | $00002A00 , $00002800 , $00002800 , $0000A800 , 543 | $0000A000 , $0000A000 , $0002A000 , $00028000 , 544 | $00028000 , $000A8000 , $000A0000 , $000A0000 , 545 | $002A0000 , $00280000 , $00280000 , $00A80000 , 546 | $00A00000 , $AAA00000 , $AA800000 , $00000000 , 547 | $00000000 , $00000000 , $00000000 , $00000000 , 548 | $00000000 , $00000000 , $00000000 , $00000000 , 549 | $00000000 , $000017FF , $00005FFF , $00005A00 , 550 | $00017A00 , $00016800 , $00016800 , $0001E800 , 551 | $0001E000 , $0005E000 , $0007A000 , $55578000 , 552 | $55568000 , $000A8000 , $000A0000 , $000A0000 , 553 | $002A0000 , $00280000 , $00280000 , $00A80000 , 554 | $00A00000 , $AAAAAAAA , $AAAAAAAA , $00000000 , 555 | $00000000 , $00000000 , $00000000 , $00000000 , 556 | $00000000 , $00000000 , $00000000 , $00000000 , 557 | $00000000 , $FFFFFFFF , $FFFFFFFF , $00500000 , 558 | $00540000 , $00140000 , $00140000 , $00150000 , 559 | $00050000 , $00050000 , $00054000 , $00014000 , 560 | $00014000 , $00015000 , $00005000 , $00005000 , 561 | $00005400 , $00001400 , $00001400 , $00001500 , 562 | $00000500 , $AAAAAFFF , $AAAAABFF , $00000000 , 563 | $00000000 , $00000000 , $00000000 , $00000000 , 564 | $00000000 , $00000000 , $00000000 , $00000000 , 565 | $00000000 , $00000555 , $00001555 , $00001400 , 566 | $00005400 , $00005000 , $00005000 , $00015000 , 567 | $00014000 , $00014000 , $00054000 , $55552AAA , 568 | $5555AAAA , $0005E000 , $0003E000 , $0003C000 , 569 | $0003D000 , $0002D000 , $0002D000 , $000AD400 , 570 | $000A1400 , $AAAA1555 , $AAA80555 , $00000000 , 571 | $00000000 , $00000000 , $00000000 , $00000000 , 572 | $00000000 , $00000000 , $00000000 , $00000000 , 573 | $00000000 , $FFF40000 , $FFFD0000 , $002D0000 , 574 | $002F4000 , $000B4000 , $000B4000 , $000BC000 , 575 | $0003C000 , $0003D000 , $0002F000 , $0000FFFF , 576 | $0000BFFF , $0002A000 , $00028000 , $00028000 , 577 | $000A8000 , $000A0000 , $000A0000 , $002A0000 , 578 | $00280000 , $AAA80000 , $AAA00000 , $00000000 , 579 | $00000000 , $00000000 , $00000000 , $00000000 , 580 | $00028000 , $00028000 , $00028000 , $00028000 , 581 | $00028000 , $00028000 , $00028000 , $00028000 , 582 | $00028000 , $00028000 , $00028000 , $00028000 , 583 | $00028000 , $00028000 , $00028000 , $5557D555 , 584 | $5557D555 , $00028000 , $00028000 , $00028000 , 585 | $00028000 , $00028000 , $00028000 , $00028000 , 586 | $00028000 , $00028000 , $00028000 , $00028000 , 587 | $00028000 , $00028000 , $00028000 , $00028000 , 588 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 589 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 590 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 591 | $0003C000 , $000BE000 , $002BE800 , $FFFFFFFF , 592 | $FFFFFFFF , $002BE800 , $000BE000 , $0003C000 , 593 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 594 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 595 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 596 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 597 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 598 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 599 | $0003C000 , $0003C000 , $0003C000 , $AAABD555 , 600 | $AAABD555 , $0003C000 , $0003C000 , $0003C000 , 601 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 602 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 603 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 604 | $00014000 , $00014000 , $00014000 , $00014000 , 605 | $00014000 , $00014000 , $00014000 , $00014000 , 606 | $00014000 , $00014000 , $00014000 , $00014000 , 607 | $00014000 , $00014000 , $00014000 , $FFFFFFFF , 608 | $FFFFFFFF , $00028000 , $00028000 , $00028000 , 609 | $00028000 , $00028000 , $00028000 , $00028000 , 610 | $00028000 , $00028000 , $00028000 , $00028000 , 611 | $00028000 , $00028000 , $00028000 , $00028000 , 612 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 613 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 614 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 615 | $0003C000 , $000FF000 , $003FFC00 , $AABFFD55 , 616 | $AABFFD55 , $003FFC00 , $000FF000 , $0003C000 , 617 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 618 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 619 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 620 | $00014000 , $00014000 , $00014000 , $00014000 , 621 | $00014000 , $00014000 , $00014000 , $00014000 , 622 | $00014000 , $00014000 , $00014000 , $00014000 , 623 | $00014000 , $000FF000 , $003FFC00 , $FFFFFFFF , 624 | $FFFFFFFF , $003FFC00 , $000FF000 , $00028000 , 625 | $00028000 , $00028000 , $00028000 , $00028000 , 626 | $00028000 , $00028000 , $00028000 , $00028000 , 627 | $00028000 , $00028000 , $00028000 , $00028000 , 628 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 629 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 630 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 631 | $0003C000 , $0003C000 , $0003C000 , $AAABD555 , 632 | $AAABD555 , $00000000 , $00000000 , $00000000 , 633 | $00000000 , $00000000 , $00000000 , $00000000 , 634 | $00000000 , $00000000 , $00000000 , $00000000 , 635 | $00000000 , $00000000 , $00000000 , $00000000 , 636 | $00000000 , $00000000 , $00000000 , $00000000 , 637 | $00000000 , $00000000 , $00000000 , $00000000 , 638 | $00000000 , $00000000 , $00000000 , $00000000 , 639 | $00000000 , $00000000 , $00000000 , $AAABD555 , 640 | $AAABD555 , $0003C000 , $0003C000 , $0003C000 , 641 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 642 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 643 | $0003C000 , $0003C000 , $0003C000 , $0003C000 , 644 | $00014000 , $00055000 , $00155400 , $00555500 , 645 | $01514540 , $0543E150 , $150BE854 , $140BE814 , 646 | $000BE800 , $0003E000 , $00014000 , $00014000 , 647 | $0003E000 , $0003E000 , $0003E000 , $0003E000 , 648 | $000BE800 , $000BE800 , $000BE800 , $000BE800 , 649 | $000BE800 , $000BE800 , $000BE800 , $000BE800 , 650 | $000BE800 , $000BE800 , $0003E000 , $00014000 , 651 | $00014000 , $00014000 , $00014000 , $00014000 , 652 | $00014000 , $00014000 , $00014000 , $00014000 , 653 | $00014000 , $002B4000 , $02ABE000 , $0AABE800 , 654 | $0A81E800 , $0A016A00 , $00016A00 , $00016A00 , 655 | $0001E800 , $0001E800 , $00ABEA80 , $00ABEAA0 , 656 | $002BEAA0 , $0001E800 , $0001E800 , $0001E800 , 657 | $00016A00 , $00016A00 , $00014A80 , $2A03EA80 , 658 | $3EABEAB4 , $3FABEAF4 , $0FE94BF0 , $01514540 , 659 | $00555500 , $00155400 , $00055000 , $00014000 , 660 | $00000000 , $00000000 , $00000000 , $00000000 , 661 | $00000000 , $2F5402A0 , $3F5542A0 , $3FD55AA0 , 662 | $1E815A80 , $0AA07E80 , $02A07E00 , $03FDFF40 , 663 | $01FDFD50 , $2AFFFFF0 , $2AAABFA0 , $2AAABFA0 , 664 | $015FD540 , $015FD550 , $2AFFFFF0 , $2AAABFA0 , 665 | $2AAABFA0 , $000AD400 , $000AD400 , $140BD000 , 666 | $155FD000 , $155FC000 , $055E8000 , $00000000 , 667 | $00000000 , $00000000 , $00000000 , $00000000 , 668 | $00000000 , $00000000 , $0005A000 , $0015A000 , 669 | $0055A000 , $0155A000 , $0545A000 , $1505A000 , 670 | $5405A000 , $5005A002 , $4005A00A , $0005A02A , 671 | $0005A0A8 , $0005A2A0 , $0005AA80 , $AAAFFF55 , 672 | $AAAFFF55 , $0005AA80 , $0005A2A0 , $0005A0A8 , 673 | $0005A02A , $4005A00A , $5005A002 , $5405A000 , 674 | $1505A000 , $0545A000 , $0155A000 , $0055A000 , 675 | $0015A000 , $0005A000 , $00000000 , $00000000 , 676 | $00000000 , $00000000 , $50005000 , $54005000 , 677 | $15005000 , $05405000 , $01405000 , $50005000 , 678 | $54005000 , $1500500B , $0540502F , $014050BD , 679 | $000052F4 , $00005BD0 , $00007F40 , $FFFFFD00 , 680 | $FFFFFD00 , $00007F40 , $00005BD0 , $000052F4 , 681 | $000050BD , $0000502F , $0000500B , $00005000 , 682 | $00005000 , $00005000 , $00005000 , $00005000 , 683 | $00005000 , $00005000 , $00000000 , $00000000 , 684 | $00000000 , $00000000 , $00A00A00 , $00A00A00 , 685 | $00A00A00 , $00A00A00 , $00A00A00 , $00A00A00 , 686 | $00A00A00 , $50A00A00 , $54A00A00 , $15A00A00 , 687 | $05E00A00 , $01F00A00 , $00F40A00 , $AAB55FFF , 688 | $AAB55FFF , $00F40A00 , $01F00A00 , $05E00A00 , 689 | $15A00A00 , $54A00A00 , $50A00A00 , $00A00A00 , 690 | $00A00A00 , $00A00A00 , $00A00A00 , $00A00A00 , 691 | $00A00A00 , $00A00A00 , $00000000 , $00000000 , 692 | $00028000 , $00028000 , $00028000 , $00028000 , 693 | $00028000 , $00028000 , $00028000 , $00028000 , 694 | $00028000 , $00028000 , $00028000 , $00028000 , 695 | $FFFAAAAA , $FFFAAAAA , $00000000 , $00000000 , 696 | $00000000 , $00000000 , $FFFAAAAA , $FFFAAAAA , 697 | $00028000 , $00028000 , $00028000 , $00028000 , 698 | $00028000 , $00028000 , $00028000 , $00028000 , 699 | $00028000 , $00028000 , $00028000 , $00028000 , 700 | $00000000 , $00000000 , $00000000 , $00000000 , 701 | $00000000 , $00000000 , $00000000 , $00000000 , 702 | $00000000 , $0000000A , $0000000A , $0000000A , 703 | $0000055F , $0000055F , $0000000A , $AAAAAAAA , 704 | $AAAAAAAA , $0000000A , $0000055F , $0000055F , 705 | $0000000A , $0000000A , $0000000A , $00000000 , 706 | $00000000 , $00000000 , $00000000 , $00000000 , 707 | $00000000 , $00000000 , $00000000 , $00000000 , 708 | $00000000 , $00000000 , $00000000 , $00000000 , 709 | $00000000 , $00055000 , $00155400 , $005E9500 , 710 | $005A8500 , $005A8500 , $005E9500 , $001FD400 , 711 | $2AAFFAA0 , $2AAAAAA0 , $2AAAAAA0 , $000A8000 , 712 | $000A8000 , $000A8000 , $000A8000 , $000A8000 , 713 | $00000000 , $00000000 , $2AAAAAA0 , $2AAAAAA0 , 714 | $2AAAAAA0 , $00000000 , $00000000 , $00000000 , 715 | $00000000 , $00000000 , $00000000 , $00000000 , 716 | $00000000 , $00000000 , $0000FF00 , $0003FFC0 , 717 | $0003C3C0 , $0003C000 , $0001F800 , $0002FC00 , 718 | $00029500 , $000287C0 , $0003FFC0 , $0001FF40 , 719 | $00000000 , $00000000 , $00000000 , $00000000 , 720 | $00000000 , $00000000 , $00000000 , $00000000 , 721 | $00000000 , $00000000 , $00000000 , $00000000 , 722 | $00000000 , $00000000 , $00000000 , $00000000 , 723 | $00000000 , $00000000 , $00000000 , $00000000 , 724 | $00000000 , $00000000 , $00000000 , $00000000 , 725 | $00000000 , $00000000 , $00000000 , $00000000 , 726 | $00000000 , $50000000 , $50000000 , $50000000 , 727 | $50000000 , $7A0002A0 , $7A0002A0 , $7F5557F5 , 728 | $7F5557F5 , $7A0002A0 , $7A0002A0 , $7A0002A0 , 729 | $7A0002A0 , $7A0002A0 , $7A0002A0 , $2A800AA0 , 730 | $2AAAAAA0 , $2AAAAAA0 , $2A2AA2A0 , $000002A0 , 731 | $000002A0 , $000002A0 , $000002A0 , $000002A0 , 732 | $00554000 , $05554000 , $15400000 , $54000000 , 733 | $50015540 , $54155554 , $15550055 , $15500005 , 734 | $1FFD0AD5 , $FEBFFFF4 , $F80BFDE8 , $F002A028 , 735 | $F003F56A , $FC1FFD5E , $3D5F285F , $3F7A2A0F , 736 | $1F7D0A5F , $5E3D5F54 , $5A295F40 , $5A280A00 , 737 | $7A2B7F40 , $7C1F7D54 , $BD5FA855 , $B552A005 , 738 | $15550055 , $54155554 , $50015540 , $54000000 , 739 | $15400000 , $05554000 , $00554000 , $00014000 , 740 | $00000000 , $00000000 , $00002800 , $00002A80 , 741 | $00002A80 , $00002800 , $00002800 , $00002800 , 742 | $00542D54 , $01557D55 , $0547FE85 , $0503FA81 , 743 | $15015001 , $14055405 , $14051405 , $54151515 , 744 | $54140514 , $00140514 , $00140514 , $00140514 , 745 | $00151515 , $00051405 , $00055405 , $00015001 , 746 | $00000000 , $00000000 , $00000000 , $00000000 , 747 | $00000000 , $00000000 , $00000000 , $00000000 , 748 | $00000000 , $00000000 , $00000000 , $00000000 , 749 | $00000000 , $00000000 , $00000000 , $00000000 , 750 | $00000000 , $000A5000 , $002A5400 , $00A81500 , 751 | $02A00540 , $0A800150 , $2A000054 , $FFFFFFFF , 752 | $FFFFFFFF , $2A000054 , $0A800150 , $02A00540 , 753 | $00A81500 , $002A5400 , $000A5000 , $00000000 , 754 | $00000000 , $00000000 , $00000000 , $00000000 , 755 | $00000000 , $00000000 , $00000000 , $00000000 , 756 | $00054000 , $01554000 , $55500000 , $54000000 , 757 | $55500000 , $01555000 , $00055540 , $00000555 , 758 | $2A0002B5 , $2A0007F5 , $2A0557E0 , $A3D55A28 , 759 | $F7D00A28 , $F6800A28 , $D5F0280A , $81F5780A , 760 | $80A57D4A , $80A02D55 , $0028A015 , $0028A555 , 761 | $002DF540 , $015FD000 , $555A8000 , $540A8000 , 762 | $55500000 , $01555000 , $00055540 , $00000555 , 763 | $00000015 , $00000555 , $00015540 , $00015000 , 764 | $00000000 , $00000000 , $00000000 , $00000000 , 765 | $00000000 , $000A8000 , $002AA000 , $002AA000 , 766 | $002BF000 , $000BD000 , $00015000 , $00051400 , 767 | $000F9400 , $000F9400 , $001E8501 , $5016A501 , 768 | $5016AD01 , $5014AF01 , $14502BC5 , $14500BC5 , 769 | $145003E5 , $2F4002F4 , $2F4002F4 , $0FC00AD4 , 770 | $0AAAAA80 , $02AAAA00 , $002AA000 , $00000000 , 771 | $00000000 , $00000000 , $00000000 , $00000000 , 772 | $00000000 , $00000000 , $00A05000 , $00A95000 , 773 | $002F4000 , $001F8000 , $00168000 , $00000000 , 774 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 775 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 776 | $3F0003F0 , $3FFFFFF0 , $3FFFFFF0 , $3FFFFFF0 , 777 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 778 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $00000000 , 779 | $00000000 , $00000000 , $00000000 , $00000000 , 780 | $00000000 , $00000000 , $00054000 , $0295FA00 , 781 | $02D6FE80 , $03FA9780 , $01EA0780 , $00000000 , 782 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 783 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 784 | $3F0003F0 , $3FFFFFF0 , $3FFFFFF0 , $3FFFFFF0 , 785 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 786 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $00000000 , 787 | $00000000 , $00000000 , $00000000 , $00000000 , 788 | $00000000 , $00000000 , $000A8000 , $007AB400 , 789 | $01F47D00 , $01F47D00 , $007AB400 , $000A8000 , 790 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 791 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 792 | $3F0003F0 , $3FFFFFF0 , $3FFFFFF0 , $3FFFFFF0 , 793 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 794 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $00000000 , 795 | $00000000 , $00000000 , $00000000 , $00000000 , 796 | $00000000 , $00000000 , $00000000 , $00000000 , 797 | $00000000 , $157FF000 , $17FFFF00 , $1FFFFFC0 , 798 | $0A950FC0 , $2A1503F0 , $2A1503F0 , $001503F0 , 799 | $001503F0 , $001503F0 , $055503F0 , $055503F0 , 800 | $055557F0 , $001557F0 , $001557F0 , $001503F0 , 801 | $001503F0 , $2A1503F0 , $2A1503F0 , $0A950BD0 , 802 | $1FFFABD0 , $17FFAB50 , $157FA150 , $00A80000 , 803 | $00A00000 , $00A80000 , $00AA8000 , $002A8000 , 804 | $00000000 , $00000000 , $00285000 , $002B5000 , 805 | $000FC000 , $0017A000 , $0014A000 , $00000000 , 806 | $00000000 , $3FFFFFF0 , $3FFFFFF0 , $3FFFFFF0 , 807 | $000003F0 , $000003F0 , $000003F0 , $000003F0 , 808 | $003FFFF0 , $003FFFF0 , $003FFFF0 , $000003F0 , 809 | $000003F0 , $000003F0 , $000003F0 , $000003F0 , 810 | $3FFFFFF0 , $3FFFFFF0 , $3FFFFFF0 , $00000000 , 811 | $00000000 , $00000000 , $00000000 , $00000000 , 812 | $00000000 , $00000000 , $00054000 , $00B57800 , 813 | $02FCFE00 , $03F8BF00 , $01E02D00 , $00000000 , 814 | $00000000 , $3FFFFFF0 , $3FFFFFF0 , $3FFFFFF0 , 815 | $000003F0 , $000003F0 , $000003F0 , $000003F0 , 816 | $003FFFF0 , $003FFFF0 , $003FFFF0 , $000003F0 , 817 | $000003F0 , $000003F0 , $000003F0 , $000003F0 , 818 | $3FFFFFF0 , $3FFFFFF0 , $3FFFFFF0 , $00000000 , 819 | $00000000 , $00000000 , $00000000 , $00000000 , 820 | $00000000 , $00000000 , $00285000 , $002B5000 , 821 | $000FC000 , $0017A000 , $0014A000 , $00000000 , 822 | $00000000 , $0FFFFFC0 , $0FFFFFC0 , $0FFFFFC0 , 823 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 824 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 825 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 826 | $0FFFFFC0 , $0FFFFFC0 , $0FFFFFC0 , $00000000 , 827 | $00000000 , $00000000 , $00000000 , $00000000 , 828 | $00000000 , $00000000 , $00054000 , $00B57800 , 829 | $02FCFE00 , $03F8BF00 , $01E02D00 , $00000000 , 830 | $00000000 , $0FFFFFC0 , $0FFFFFC0 , $0FFFFFC0 , 831 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 832 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 833 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 834 | $0FFFFFC0 , $0FFFFFC0 , $0FFFFFC0 , $00000000 , 835 | $00000000 , $00000000 , $00000000 , $00000000 , 836 | $00000000 , $00000000 , $00000000 , $0280AA00 , 837 | $0282AA80 , $02BFD7D0 , $01FF57D0 , $05555550 , 838 | $05400150 , $3F0003F0 , $3F000BF0 , $3F002BF0 , 839 | $3F00ABF0 , $3F02ABF0 , $3F0BF7F4 , $3F2BD7F4 , 840 | $3FAB57F4 , $3FA803F0 , $3FA003F0 , $3F8003F0 , 841 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $2F4003F0 , 842 | $2F5557F0 , $2B5557F0 , $2A1557F0 , $00000000 , 843 | $00000000 , $00000000 , $00000000 , $00000000 , 844 | $00000000 , $00000000 , $00285000 , $002B5000 , 845 | $000FC000 , $0017A000 , $0014A000 , $00000000 , 846 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 847 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 848 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 849 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $0FC00FC0 , 850 | $0FFFFFC0 , $03FFFF00 , $003FF000 , $00000000 , 851 | $00000000 , $00000000 , $00000000 , $00000000 , 852 | $00000000 , $00000000 , $00054000 , $0295FA00 , 853 | $02D6FE80 , $03FA9780 , $01EA0780 , $00000000 , 854 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 855 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 856 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 857 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $0FC00FC0 , 858 | $0FFFFFC0 , $03FFFF00 , $003FF000 , $00000000 , 859 | $00000000 , $00000000 , $00000000 , $00000000 , 860 | $00000000 , $00000000 , $00000000 , $00501400 , 861 | $01545500 , $01545500 , $00501400 , $00000000 , 862 | $00000000 , $00155000 , $0B555780 , $2FD55FE0 , 863 | $2FE02FE0 , $1FA8ABD0 , $17AAAB50 , $15AAA950 , 864 | $152AA150 , $15AAA950 , $17AAAB50 , $1FA8ABD0 , 865 | $3FA02BF0 , $3F800BF0 , $1F0003D0 , $05400540 , 866 | $05555540 , $01555500 , $00155000 , $00000000 , 867 | $00000000 , $00000000 , $00000000 , $00000000 , 868 | $00000000 , $00000000 , $0000A000 , $0002A000 , 869 | $000A8000 , $143F5000 , $157D5500 , $15555540 , 870 | $05400540 , $3F5003F0 , $3F5003F0 , $3F5403F0 , 871 | $3F5403F0 , $3F1503F0 , $3F1503F0 , $3F0543F0 , 872 | $3F0543F0 , $3F0153F0 , $3F0153F0 , $3F0057F0 , 873 | $3F0057F0 , $3F0017F0 , $3F0017F0 , $0FC00FC0 , 874 | $0FFFFFD0 , $03FFFF50 , $003FF050 , $00000000 , 875 | $00000000 , $00000000 , $00000000 , $00000000 , 876 | $00000000 , $00000000 , $001E8000 , $003FA000 , 877 | $00ADE800 , $02A17A00 , $02805A00 , $00000000 , 878 | $00000000 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 879 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 880 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 881 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $0FC00FC0 , 882 | $0FFFFFC0 , $03FFFF00 , $003FF000 , $00000000 , 883 | $00000000 , $00000000 , $00000000 , $00000000 , 884 | $00000000 , $00000000 , $00280000 , $007A1400 , 885 | $015ED500 , $0156F500 , $0050B400 , $00000000 , 886 | $00000000 , $3F0003F0 , $3F0003F0 , $3F800BF0 , 887 | $1F800BD0 , $1FA02BD0 , $17A02B50 , $17A8AB50 , 888 | $15A8A950 , $15AAA950 , $152AA150 , $152AA150 , 889 | $150A8150 , $150A8150 , $150A8150 , $054A8540 , 890 | $055FD540 , $015FD500 , $001FD000 , $00000000 , 891 | $00000000 , $00000000 , $00000000 , $00000000 , 892 | $00000000 , $00000000 , $00000000 , $00000000 , 893 | $00000000 , $000AA150 , $00AAAB50 , $02AAABD0 , 894 | $02A00BD0 , $0A9557F0 , $0BD557F0 , $0FD557F0 , 895 | $07E003F0 , $17AA83F0 , $15AA83F0 , $17AA83F0 , 896 | $1FA003F0 , $1F8003F0 , $3F8003F0 , $2F4003F0 , 897 | $2F5557F0 , $2B5557F0 , $2A1557F0 , $0A8003F0 , 898 | $0AAA83F0 , $02AA83F0 , $002A83F0 , $000002A0 , 899 | $000002A0 , $000002A0 , $000002A0 , $00000000 , 900 | $00000000 , $00000000 , $00000000 , $00000000 , 901 | $00000000 , $00000000 , $00A05000 , $00A95000 , 902 | $002F4000 , $001F8000 , $00168000 , $00000000 , 903 | $00000000 , $00FFF000 , $0FFFFF00 , $3FFFFFC0 , 904 | $3FC003C0 , $3F000000 , $3F3FFC00 , $3FFFFFC0 , 905 | $3FFFFFF0 , $3F0003F0 , $3F0000F0 , $3FC003F0 , 906 | $3FFFFFF0 , $3FFFFFC0 , $3F3FFC00 , $00000000 , 907 | $00000000 , $00000000 , $00000000 , $00000000 , 908 | $00000000 , $00000000 , $00000000 , $00000000 , 909 | $00000000 , $00000000 , $00054000 , $0295FA00 , 910 | $02D6FE80 , $03FA9780 , $01EA0780 , $00000000 , 911 | $00000000 , $00FFF000 , $0FFFFF00 , $3FFFFFC0 , 912 | $3FC003C0 , $3F000000 , $3F3FFC00 , $3FFFFFC0 , 913 | $3FFFFFF0 , $3F0003F0 , $3F0000F0 , $3FC003F0 , 914 | $3FFFFFF0 , $3FFFFFC0 , $3F3FFC00 , $00000000 , 915 | $00000000 , $00000000 , $00000000 , $00000000 , 916 | $00000000 , $00000000 , $00000000 , $00000000 , 917 | $00000000 , $00000000 , $000A0000 , $007A9400 , 918 | $01F4F500 , $01F4F500 , $007A9400 , $000A0000 , 919 | $00000000 , $00FFF000 , $0FFFFF00 , $3FFFFFC0 , 920 | $3FC003C0 , $3F000000 , $3F3FFC00 , $3FFFFFC0 , 921 | $3FFFFFF0 , $3F0003F0 , $3F0000F0 , $3FC003F0 , 922 | $3FFFFFF0 , $3FFFFFC0 , $3F3FFC00 , $00000000 , 923 | $00000000 , $00000000 , $00000000 , $00000000 , 924 | $00000000 , $00000000 , $00000000 , $00000000 , 925 | $00000000 , $00000000 , $00000000 , $00000000 , 926 | $00000000 , $00000000 , $00000000 , $00000000 , 927 | $00000000 , $016AB400 , $07FBFF00 , $1FFFFFC0 , 928 | $3F955BC0 , $3E0542A0 , $155547A0 , $155557E0 , 929 | $155557F0 , $000543F0 , $2A0542F0 , $3E955BD0 , 930 | $1FFFFFD0 , $17FFFF40 , $056FE500 , $00A80000 , 931 | $00A00000 , $00A80000 , $00AA8000 , $002A8000 , 932 | $00000000 , $00000000 , $00000000 , $00000000 , 933 | $00000000 , $00000000 , $00285000 , $002B5000 , 934 | $000FC000 , $0017A000 , $0014A000 , $00000000 , 935 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 936 | $0FC00FC0 , $3F0003F0 , $3FFFFFF0 , $3FFFFFF0 , 937 | $3FFFFFF0 , $000003F0 , $000003F0 , $3F000FC0 , 938 | $3FFFFFC0 , $0FFFFF00 , $00FFF000 , $00000000 , 939 | $00000000 , $00000000 , $00000000 , $00000000 , 940 | $00000000 , $00000000 , $00000000 , $00000000 , 941 | $00000000 , $00000000 , $00054000 , $00B57800 , 942 | $02FCFE00 , $03F8BF00 , $01E02D00 , $00000000 , 943 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 944 | $0FC00FC0 , $3F0003F0 , $3FFFFFF0 , $3FFFFFF0 , 945 | $3FFFFFF0 , $000003F0 , $000003F0 , $3F000FC0 , 946 | $3FFFFFC0 , $0FFFFF00 , $00FFF000 , $00000000 , 947 | $00000000 , $00000000 , $00000000 , $00000000 , 948 | $00000000 , $00000000 , $00000000 , $00000000 , 949 | $00000000 , $00000000 , $00029400 , $0002F400 , 950 | $0001F800 , $00056A00 , $00050A00 , $00000000 , 951 | $00000000 , $000FFF00 , $000FFF00 , $000FFF00 , 952 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 953 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 954 | $0FFFFFC0 , $0FFFFFC0 , $0FFFFFC0 , $00000000 , 955 | $00000000 , $00000000 , $00000000 , $00000000 , 956 | $00000000 , $00000000 , $00000000 , $00000000 , 957 | $00000000 , $00000000 , $00015000 , $002D5E00 , 958 | $00BF3F80 , $00FE2FC0 , $00780B40 , $00000000 , 959 | $00000000 , $000FFF00 , $000FFF00 , $000FFF00 , 960 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 961 | $000FC000 , $000FC000 , $000FC000 , $000FC000 , 962 | $0FFFFFC0 , $0FFFFFC0 , $0FFFFFC0 , $00000000 , 963 | $00000000 , $00000000 , $00000000 , $00000000 , 964 | $00000000 , $00000000 , $00000000 , $00000000 , 965 | $14000000 , $15015500 , $05555500 , $03D5FF00 , 966 | $03D6AA80 , $07FF8280 , $05EF4280 , $05414000 , 967 | $15000000 , $153FF2A0 , $17FFFFA0 , $1FFFFFE0 , 968 | $1FC00FE0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 969 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $2F4007E0 , 970 | $2F5557E0 , $2B5557A0 , $2A1552A0 , $00000000 , 971 | $00000000 , $00000000 , $00000000 , $00000000 , 972 | $00000000 , $00000000 , $00000000 , $00000000 , 973 | $00000000 , $00000000 , $00285000 , $002B5000 , 974 | $000FC000 , $0017A000 , $0014A000 , $00000000 , 975 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 976 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 977 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $0FC00FC0 , 978 | $0FFFFFC0 , $03FFFF00 , $003FF000 , $00000000 , 979 | $00000000 , $00000000 , $00000000 , $00000000 , 980 | $00000000 , $00000000 , $00000000 , $00000000 , 981 | $00000000 , $00000000 , $00054000 , $0295FA00 , 982 | $02D6FE80 , $03FA9780 , $01EA0780 , $00000000 , 983 | $00000000 , $003FF000 , $03FFFF00 , $0FFFFFC0 , 984 | $0FC00FC0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 985 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $0FC00FC0 , 986 | $0FFFFFC0 , $03FFFF00 , $003FF000 , $00000000 , 987 | $00000000 , $00000000 , $00000000 , $00000000 , 988 | $00000000 , $00000000 , $00000000 , $00000000 , 989 | $00000000 , $00000000 , $00000000 , $00501400 , 990 | $015ED500 , $017EF500 , $007AB400 , $002AA000 , 991 | $000A8000 , $00155000 , $01555500 , $2FFFFFE0 , 992 | $2FEAAFE0 , $3FAAABF0 , $15000150 , $15000150 , 993 | $150A8150 , $152AA150 , $152AA150 , $056AA540 , 994 | $055FD540 , $01555500 , $00155000 , $00000000 , 995 | $00000000 , $00000000 , $00000000 , $00000000 , 996 | $00000000 , $00000000 , $00000000 , $00000000 , 997 | $00000000 , $00000000 , $0000A000 , $0002A000 , 998 | $000A8000 , $002A0000 , $00280000 , $00000000 , 999 | $00000000 , $3E1552A0 , $3F5557A0 , $3F5557E0 , 1000 | $2F5007E0 , $3F5403F0 , $3F5503F0 , $3F1543F0 , 1001 | $3F0553F0 , $3F0157F0 , $3F0057F0 , $2FC01FC0 , 1002 | $2FFFFFD0 , $2BFFFF50 , $2A3FF050 , $00000000 , 1003 | $00000000 , $00000000 , $00000000 , $00000000 , 1004 | $00000000 , $00000000 , $00000000 , $00000000 , 1005 | $00000000 , $00000000 , $001E8000 , $003FA000 , 1006 | $00ADE800 , $02A17A00 , $02805A00 , $00000000 , 1007 | $00000000 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 1008 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 1009 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3FC00FC0 , 1010 | $3FFFFFC0 , $3FFFFF00 , $3F3FF000 , $00000000 , 1011 | $00000000 , $00000000 , $00000000 , $00000000 , 1012 | $00000000 , $00000000 , $00000000 , $00000000 , 1013 | $00000000 , $00000000 , $00280000 , $007A1400 , 1014 | $015ED500 , $0156F500 , $0050B400 , $00000000 , 1015 | $00000000 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 1016 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3F0003F0 , 1017 | $3F0003F0 , $3F0003F0 , $3F0003F0 , $3FC00FC0 , 1018 | $3FFFFFC0 , $3FFFFF00 , $3F3FF000 , $2A000000 , 1019 | $0A800000 , $0AAAA800 , $02AAA800 , $002AA800 , 1020 | $00000000 , $00000000 , $00000000 , $00000000 , 1021 | $00000000 , $00000000 , $00000000 , $00000150 , 1022 | $00000150 , $00000150 , $00000150 , $00000150 , 1023 | $0A800BD0 , $2AB57BF0 , $A97DF5F8 , $A55FD578 , 1024 | $A54A8578 , $BD28A1F8 , $3FA02BF0 , $1F800BD0 , 1025 | $15000150 , $15000150 , $15000150 , $05400550 , 1026 | $05555550 , $01555550 , $00155150 , $00000150 , 1027 | $00000150 , $00000150 , $00000150 , $00000150 , 1028 | compiletoram 1029 | 1030 | 1031 | *END* 1032 | -------------------------------------------------------------------------------- /rp2040/mecrisp/Forth/FRED.FTH: -------------------------------------------------------------------------------- 1 | mecrisp 2 | 2205012200 tme? --- make sure TACHYON.FTH is new enough 3 | 4 | pub *FRED* PRINT" FORTH READY TEXT EDITOR 220510-2345" ; 5 | 6 | { 7 | TO DO: Limit editing to file size 8 | Latch insert/delete mode? 9 | Use ^F10 to load from cursor 10 | add word wrap 11 | 220510 Add import function 12 | Refresh does not clear page (less flicker) 13 | 220503 Add narrow/wide view 14 | Add auto refresh 15 | 220502 Added hightlighting 16 | 220501 Added FLOAD 17 | Added autoindent 18 | 220430 Added page sized clipboard to allow copy&paste across pages 19 | 220429 Added ^B to ^C selection mode which also highlights selected text. 20 | 220427 ED without parameters will try to reopen the last file at the same position 21 | RE (redit) redundant 22 | Skip over terminator 23 | Rename functions to emphasize PAGE vs BLOCK mode 24 | Improve refresh ops - by line or by page as needed 25 | Simple HOME key - repeated operation goes to top of page then top of file 26 | Add page # 27 | 220426 28 | 220425 29 | 220424 Porting to RP2040-Mecrisp/Tachyon 30 | 210204 Fixed refresh, added ins & del etc. 31 | 210203 32 | 210202 check and clean up, factor 33 | Don't refresh display if adding text on same line. 34 | Improved hex display with highlight 35 | 210131 Add super sector BLOCK mode 36 | 210129 Added Flash and RAM as targets (4k pages to do) 37 | Added simple underline cursor to VGA 38 | 210128 Added ANSI sequences and hex mode 39 | 40 | 210126 Created ED to edit config files by sector 41 | Added addtional controls etc 42 | Added cursor key sequences etc 43 | 44 | 45 | } 46 | 47 | \ patches 48 | 49 | 50 | --- --- --- --- --- --- --- --- --- --- 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | \ public 59 | 0 bytes _ed 60 | \ private 61 | long ~tcur --- cursor postion in file 62 | long ~begin --- marks beginning of selection (default -1 = none) 63 | long ~end --- marks end of select 64 | long ~clipsz --- size of content copied to clipboard 65 | long ~ew --- width 66 | long ~pagesz 67 | long ~edsect 68 | long ~opts --- option flags 0=indent 1=narrow 2=line# 69 | long ~idle 70 | long ~eflgs --- general editor flags 0=update, 71 | long ~seq --- highlight sequence 72 | long ~hflgs --- highlight flags 73 | long ~ecold 74 | 75 | DATA $D000 + constant clipboard --- 4kB clipboard holds up to 1 page 76 | DATA $E000 + constant pagebuf --- allocate PAGEBUF near end of RAM 77 | 78 | 2 longs ~skeys 79 | --- read a key and maintain a history (debug) 80 | \ pri EDKEY KEY DUP ~skeys @ 8 << OR ~skeys ! ; 81 | pri EDKEY ( -- ch ) KEY ~skeys DUP 1+ 7 MOVE DUP ~skeys C! ; 82 | 83 | 84 | 85 | pri tcur@ ~tcur @ ; 86 | 87 | pri tcur! ~tcur ! ; 88 | pri tcur+! tcur@ + 0 MAX tcur! ; 89 | pri tcur-! NEGATE tcur+! ; 90 | 91 | \ pri ew ~ew C@ ; --- editor width (default 64 ) 92 | pri ew 128 ; 93 | --- editor print width 94 | pri pw 1 ~opts BIT? IF 64 ELSE ew THEN ; 95 | 96 | \ pri pagesz ~pagesz @ ; 97 | pri pagesz 4096 ; 98 | 99 | pri PAGE# tcur@ pagesz / ; 100 | pri PAGEADR tcur@ pagesz 1- ANDN ; 101 | 102 | 103 | 104 | pri BLK! ( width blksiz -- ) ~pagesz ! ~ew C! ; 105 | 106 | pri @x ( -- x ) tcur@ ew // ; --- current x position 107 | pri LEFTLN ( -- row ) tcur@ ew 1- ANDN ; 108 | 109 | 110 | pri HEXBLK 16 512 BLK! ; 111 | pri TXTBLK 2048 BLK! ; 112 | 113 | 114 | --- Takes about 13.2ms to read a page (8 sectors = 1.6ms/sector ) 115 | --- less than 1us otherwise 116 | --- Read in a page from SD into the page buffer 117 | pri SDRDPAGE ( sect bytes -- ram ) 118 | OVER ~edsect @ <> 119 | --- update edsect buffer size 120 | IF OVER ~edsect ! pagebuf SWAP SDRDS 121 | ELSE 2DROP THEN pagebuf 122 | ; 123 | pri PAGE ( offset -- ram ) 124 | DUP pagesz 1- ANDN 125 | SWAP OVER - SWAP 9 >> 126 | @FILE + pagesz SDRDPAGE + 127 | ; 128 | --- save the current page to file 129 | pri SAVEPAGE RW ~edSect @ IF pagebuf ~edsect @ pagesz SDWRS THEN ; 130 | 131 | pri FORMAT.PAGE --- convert block to CR delimited lines and replace nulls with spaces 132 | pagebuf pagesz BOUNDS DO I C@ 0= IF $20 I C! THEN 133 | I pagesz // ?DUP IF 1+ ew // 0= IF $0D I C! THEN THEN 134 | LOOP 135 | ; 136 | pri WIPE.PAGE pagebuf pagesz $20 FILL FORMAT.PAGE ; 137 | --- format the whole file as pages (blanks with CRs) 138 | pri FORMAT.BLK 139 | @FILE 0EXIT 140 | --- Write over whole file 141 | RW FSIZE@ 0 142 | DO 143 | I PAGE DUP pagesz $20 FILL 144 | pagesz BOUNDS DO $0D I ew 1- + C! ew +LOOP 145 | SAVEPAGE SPINNER 146 | pagesz 147 | +LOOP 148 | RO 149 | ; 150 | pri ?FORMAT.BLK ." Format? " KEY $0D = IF FORMAT.BLK THEN ; 151 | 152 | --- Open a file as temporary using Mecrisp strings (does not replace file$ name) 153 | pub EDOPEN ( str len -- ) OVER + 1- C~ FIND-FILE FSECTOR OPEN-SECTOR ; 154 | 155 | 156 | --- fetch long from SD virtual memory in current file 157 | pri BC@ PAGE C@ ; 158 | pri BC! PAGE C! ; \ wrflg C~~ ; 159 | 160 | pri SFADR ; 161 | pri FLASH@ SFADR C@ ; 162 | pri FLASH! SFADR C! ; 163 | 164 | pri ED@ BC@ ; 165 | pri ED! BC! ; 166 | 167 | pri FILE? file$ SWAP C$= ; 168 | pri FLASH? s" FLASH" FILE? ; 169 | pri RAM? s" RAM" FILE? ; 170 | pri SECTOR? s" SECTOR" FILE? ; 171 | 172 | \ pri [b] CON? IF BOLD red PEN ELSE red PEN THEN ; 173 | \ pri [/b] CON? IF PLAIN ELSE white PEN THEN ; 174 | 175 | byte ~ey 176 | pri TEXTXY@ ( -- x y ) tcur@ 0 MAX pagesz // ew U/MOD DUP ~ey C! ; 177 | pri !TEXTXY TEXTXY@ SWAP 9 + SWAP 3 + XY ; 178 | pri @STATUS ( n -- ) 1+ pagesz ew / 3 + XY ; 179 | 180 | --- THEME --- 181 | long ~edcols 182 | pub edcols ( i -- ) ~edcols + ; 183 | 184 | pub THEME 8 << OR 8 << OR 8 << OR ~edcols ! ; 185 | --- text paper info frame 186 | pub -C64 white blue blue white THEME ; 187 | --- text paper info frame 188 | pub -MINT blue white black green THEME ; 189 | 190 | pri -HDRS 2 edcols C@ PEN 3 edcols C@ PAPER ; 191 | 192 | pri -TEXT PLAIN 0 edcols C@ PEN 1 edcols C@ PAPER ; 193 | 194 | --- HEADER INFO --- 195 | 196 | pri .FILE 197 | 1 1 XY PRINT" FILE: " file$ PRINT$ 3 SPACES 198 | SECTOR? IF @FILE .L THEN 199 | ; 200 | pri .SIZE 201 | 28 1 XY ." SIZE: " pagesz SPACE 4 U.R PRINT" x" ew 3 U.R 202 | ; 203 | pri .CLIP 204 | 46 1 XY ." CLIP: " ~clipsz @ 4 U.R 205 | ; 206 | --- display the clock in the top right corner ( use quick time software clock ) 207 | pri .CLOCK 208 | 63 1 XY QTIME@ 0 <# # # ` : HOLD # # ` : HOLD # # #> TYPE 209 | ; 210 | { 211 | \ 0....|....1....|....2....|....3....|....4....|....5....|....6....|....7....|....8....|....9....|....1....|....1....|....2.......< 212 | pri .TXTRULE 213 | ew 0 DO I 10 // 0= IF I 10 /MOD NIP 1 U.R ELSE I 5 // IF ` . ELSE ` | THEN EMIT THEN LOOP 214 | ; 215 | } 216 | pri .TXTRULE 217 | pw 0 DO I 7 AND 0= IF I 3 >> 1 U.R ELSE I 3 AND IF ` . ELSE ` | THEN EMIT THEN LOOP 218 | ; 219 | pri .HEXRULE 220 | pw 0 DO I >N 0 1 .HEX LOOP 221 | pw 16 = IF 16 0 DO SPACE I .BYTE LOOP THEN 222 | ; 223 | { 224 | pri .RULER 225 | 1 2 XY ." PAGE" PAGE# 1+ 3 U.R SPACE 226 | ew 16 = IF .HEXRULE ELSE .TXTRULE THEN 227 | ; 228 | } 229 | pri .RULER 230 | -HDRS 231 | 1 2 XY 8 SPACES CR ." PG# " PAGE# 1+ . 232 | 9 2 XY pw 16 = IF .HEXRULE ELSE .TXTRULE THEN 233 | ; 234 | pri .INDENT 235 | OFF CURSOR 20 1 XY 236 | 0 ~opts BIT? IF white PEN red PAPER ." INDENT" ELSE ." undent" THEN 237 | ; 238 | 239 | --- display header - reset term - plain - clear 240 | pri HEADER 241 | 15 EMIT PLAIN -HDRS 242 | 1 1 XY pw 8 + SPACES 243 | .FILE .CLIP .SIZE .CLOCK .INDENT .RULER 244 | ; 245 | 246 | pri ?SELECT 247 | ~end @ 248 | IF --- selection is active if ~end is non-zero 249 | ~begin @ ~end @ WITHIN 250 | IF red PEN ELSE 0 edcols C@ PEN THEN 251 | ELSE DROP 252 | THEN 253 | ; 254 | 255 | : hflgs? ( b -- f ) 256 | DUP ~hflgs BIT? DUP IF SWAP ~hflgs CLRB ELSE SWAP ~hflgs SETB THEN 257 | ; 258 | : MATCH? ( b s -- f ) 259 | ~seq SWAP C$= 260 | IF hflgs? IF -TEXT 0 ELSE 1 THEN 261 | ELSE DROP 0 262 | THEN 263 | ; 264 | 265 | : ?CODE 266 | 7 ~hflgs BIT? IF ~seq C@ $20 = IF -TEXT 7 ~hflgs CLRB THEN THEN 267 | 7 s" ( " DROP 2 MATCH? IF -TEXT THEN 268 | 7 s" bup" MATCH? IF red pen THEN 269 | 7 s" irp" MATCH? IF black pen THEN 270 | ; 271 | : ?BOLD 0 s" ***" MATCH? IF BOLD THEN ; 272 | : ?UL 1 s" ___" MATCH? IF UL THEN ; 273 | : ?BLINK 2 s" !!!" MATCH? IF BLINK THEN ; 274 | : ?COMMENT 3 s" ---" MATCH? IF magenta PEN THEN 275 | 3 s" \" DROP 2 MATCH? IF magenta pen THEN 276 | ; 277 | : ?REVERSE 4 s" ..." MATCH? IF REVERSE THEN ; 278 | : ?PARA 5 s" (" DROP 1 MATCH? IF magenta PEN THEN 279 | 5 s" )" DROP 1 MATCH? IF -TEXT THEN ; 280 | : ?BRACES 6 s" {" DROP 1 MATCH? IF magenta PEN THEN 281 | 6 s" }" DROP 1 MATCH? IF -TEXT THEN ; 282 | 283 | : ?HIGHLIGHT ( ch -- ) 284 | ~seq @ 8 << OR ~seq ! 285 | ?BOLD ?UL ?BLINK ?COMMENT ?REVERSE ?PARA \ ?BRACES 286 | ?CODE 287 | ; 288 | --- Start each row with address offset 289 | pri .ROW ( index -- ) 290 | -HDRS PLAIN CR DUP 2 ~opts BIT? 291 | IF 7 >> 2 SPACES Z 4 U.R 292 | ELSE L>W .B .H 293 | THEN 294 | ." :" SPACE 295 | -TEXT ~hflgs C~ 296 | pw BOUNDS 297 | DO I ?SELECT I ED@ DUP ?HIGHLIGHT 298 | --- indicate CR terminators anywhere in the line 299 | DUP $0D = IF DROP REVERSE ` < EMIT -TEXT ELSE ` . AEMIT THEN 300 | LOOP 301 | -TEXT \ REVERSE SPACE REVERSE PLAIN 302 | ; 303 | 304 | ( *** PAGE *** ) 305 | 306 | pri .PAGE 307 | --- page offset for page size 308 | PAGEADR pagesz BOUNDS 309 | DO CRLF I .ROW ew +LOOP 310 | ; 311 | 312 | pri REFRESH 313 | OFF CURSOR PLAIN HOME 314 | HEADER .PAGE 315 | --- current cursor 316 | !TEXTXY ON CURSOR 317 | --- refresh timer 318 | cycles ~idle ! 0 ~eflgs CLRB 319 | ; 320 | 321 | long ~page 322 | --- check if block needs to be refreshed 323 | pri ?REFRESH 324 | KEY? ?EXIT --- don't bother if more input is available 325 | ~page @ ~edsect @ <> 326 | IF ~edsect @ ~page ! REFRESH THEN 327 | ; 328 | pri ?PAGE tcur@ PAGE DROP ?REFRESH ; 329 | 330 | ( *** CHARACTER STORE *** ) 331 | 332 | --- write a char to the page and set modified flag 333 | pri EDCHAR! ( ch -- ) tcur@ ED! 0 ~eflgs SETB ; 334 | --- write new char but skip over any CR terminators 335 | pri EDCHAR!! EDCHAR! 1 tcur+! tcur@ ED@ $0D = IF 1 tcur+! THEN ; 336 | --- write character to file forward but skip any embedded CR then check refresh 337 | pri EDCHAR DUP EMIT EDCHAR!! ?REFRESH ; 338 | 339 | --- refresh line 340 | pri .LINE LEFTLN .ROW ; 341 | 342 | 343 | ( *** NAVIGATION *** ) 344 | 345 | --- go to start of next line or auto-indent 346 | pri EDCR 347 | LEFTLN 0 ~opts BIT? 348 | IF 349 | BEGIN DUP BC@ $20 = WHILE 1+ REPEAT 350 | DUP BC@ $0D = IF DROP LEFTLN THEN 351 | THEN 352 | ew + tcur! 353 | ; 354 | --- smart tab will jump to comments column 355 | pri EDTAB 356 | tcur@ 1- ED@ $20 > tcur@ ew 1- AND 8 > AND 357 | IF LEFTLN 48 + ELSE tcur@ 8 + 7 ANDN THEN tcur! 358 | ; 359 | 360 | 361 | pri GOUP ~ey C@ ew tcur-! ?PAGE ; 362 | pri GODN ~ey C@ 1+ pagesz ew / <> ew tcur+! ?PAGE ; 363 | pri PGUP pagesz tcur-! ; 364 | pri PGDN pagesz tcur+! ; 365 | --- go to last char in line - 366 | pri ENDLN LEFTLN ew + BEGIN 1- DUP ED@ $20 > UNTIL 1+ tcur! ; 367 | 368 | pri ENDTEXT tcur@ BEGIN 1+ DUP ED@ 0= UNTIL tcur! REFRESH ; 369 | 370 | pri ENDKEY tcur@ ENDLN tcur@ = IF ENDTEXT THEN ; 371 | 372 | 373 | --- If cursor is already on left then go to page or file home 374 | pri ?HOME 375 | PAGEADR tcur@ = IF 0 tcur! REFRESH EXIT THEN 376 | LEFTLN tcur@ = IF PAGEADR tcur! REFRESH ELSE LEFTLN tcur! THEN 377 | ; 378 | 379 | ( *** EDIT *** ) 380 | pri CLRLN ( ch -- ) LEFTLN PAGE ew 1- ROT FILL ; 381 | --- Insert and Delete mode - just inserts/deletes spaces for now - might latch mode 382 | pri tINS tcur@ PAGE DUP 1+ ew @x - 2- MOVE $20 EDCHAR! ; 383 | pri tDEL tcur@ PAGE DUP 1+ SWAP ew @x - 2- MOVE ; 384 | --- Insert a line in the page 385 | pri INSLN LEFTLN PAGE DUP ew + pagebuf pagesz + OVER - MOVE $20 CLRLN ; 386 | --- Delete a line in the page (need to clear last line) 387 | pri DELLN LEFTLN PAGE DUP ew + SWAP OVER pagesz 1- AND pagesz SWAP - MOVE ; 388 | 389 | 390 | pri REVERT file$ FOPEN$ DROP tcur@ pagesz + ED@ DROP CLS REFRESH ~end ~ ; 391 | --- just revert the page for an undo for the present 392 | pri UNDO REVERT ; 393 | 394 | pri SAVEFILE 395 | \ RAM? FLASH? OR ?EXIT 396 | SAVEPAGE RO MODIFIED 397 | 0 @STATUS ." SAVED " 398 | file$ FOPEN$ DROP --- RE-OPEN 399 | ; 400 | 401 | pri !CLIP ~end ~ ~begin ~~ ~clipsz ~ ; 402 | 403 | --- save selected text 404 | pri SAVECLIP 405 | ~begin @ PAGE clipboard ~end @ ~begin @ - DUP ~clipsz ! MOVE 406 | ; 407 | 408 | --- simply make the end of the text to indicate selection 409 | pri COPY 410 | --- if begin is set - select block else just select the current line 411 | ~begin @ 1+ 412 | IF tcur@ ~end ! ~end @ ~begin @ <= 413 | --- swap begin and end if wrong way around (why not?) 414 | IF ~end @ ~begin @ SWAP ~begin ! ~end ! THEN 415 | ELSE LEFTLN DUP ~begin ! ew 1- + ~end ! 416 | THEN 417 | SAVECLIP 418 | ; 419 | --- paste text marked by ^B and ending in ^C to current cursor - skip terminators 420 | pri PASTE 421 | ~clipsz @ clipboard + clipboard ( to from ) 422 | BEGIN 423 | DUP C@ DUP $0D = IF DROP ELSE EDCHAR!! THEN 424 | 1+ DUP 3RD > UNTIL 425 | 2DROP 426 | ; 427 | pri CUT 428 | COPY ~begin @ tcur! ~end @ ~begin @ DO $20 EDCHAR!! LOOP 429 | ~begin @ tcur! 430 | !CLIP 431 | ; 432 | 433 | --- PORTING UTILITY from/to page files 434 | 435 | 436 | pub IMPORT ( -- ) 437 | OPEN-FILE FSIZE@ ( sect size ) 438 | OPEN-FILE ( sect1 size sect2 ) 439 | 3RD OVER AND 0= IF 2DROP EXIT THEN 440 | --- reopen source as main file - setup dest 441 | ROT OPEN-SECTOR ~edsect ! 0 tcur! MUTED 442 | WIPE.PAGE 0 SWAP 0 ( prevch size 0 ) 443 | DO 444 | --- process a single character checking for tabs 445 | FGET DUP $09 = 446 | IF tcur@ 7 ANDN 8 + tcur! 447 | --- else handle CR/LF or characters 448 | ELSE DUP $0A $0D WITHIN 449 | IF OVER $0D = OVER $0A = AND NOT IF LEFTLN ew + tcur! THEN 450 | --- write the character directly to the page buffer 451 | ELSE DUP pagebuf tcur@ + C! 1 tcur+! THEN 452 | THEN 453 | --- replace prev save one full page 454 | NIP tcur@ pagesz >= IF SAVEPAGE 455 | --- adjust dest sector to next page reset to start of page 456 | pagesz 9 >> ~edsect +! WIPE.PAGE 0 tcur! THEN 457 | LOOP 458 | --- terminate text with a null line & flush 459 | DROP LEFTLN ew + pagebuf + ew 1- 0 FILL SAVEPAGE UNMUTED 460 | ; 461 | 462 | 463 | 464 | pri EXPORT 465 | ; 466 | 467 | 468 | 469 | 470 | pri HELP 471 | s" HELP " EDOPEN 0 tcur! REFRESH 472 | ; 473 | 474 | pri OPTIONS 475 | s" OPTIONS " EDOPEN REFRESH 476 | EDKEY REVERT 477 | ; 478 | 479 | 480 | 481 | pri FNC1 HELP ; 482 | pri FNC2 ; 483 | pri FNC3 ; 484 | pri FNC4 ; 485 | pri FNC5 ; 486 | pri FNC6 ; 487 | pri FNC7 ; 488 | pri FNC8 ; 489 | pri FNC9 1 ~opts TOGB CLS REFRESH ; 490 | pri FNC10 PLAIN CLS -FLOAD QUIT ; 491 | pri FNC11 ; 492 | pri FNC12 OFF CURSOR CLS HEADER PLAIN CRLF DIR KEY DROP file$ FOPEN$ DROP REFRESH ; 493 | 494 | pri QUITED 495 | FCLOSE 0 @STATUS white PEN red PAPER file$ PRINT$ PRINT" CLOSED " PLAIN 496 | !SP QUIT 497 | ; 498 | 499 | 500 | 501 | 502 | \ **************************************************** 503 | ( *** KEY COMMANDS *** ) 504 | \ **************************************************** 505 | 506 | 507 | \ 1B 5B 31 3B 35 46 ^END 508 | pri ESC1 ; 509 | { 510 | 1B 5B 32 31 3B 32 7E _F10 511 | 1B 5B 32 31 3B 35 7E ^F10 512 | 1B 5B 32 31 7E F10 513 | } 514 | pri ESC2 ( 1B 5B 32 ) 515 | CASE 516 | $7E OF tINS .LINE ENDOF 517 | ` 1 OF EDKEY $7E = IF FNC10 THEN ENDOF 518 | ENDCASE 519 | ; 520 | pri ESC3 521 | CASE 522 | $7E OF tDEL .LINE ENDOF 523 | ENDCASE 524 | ; 525 | 526 | --- CSI - control sequence introducer ESC [ 527 | pri ESC5B 528 | CASE --- ANSI KEY SEQUENCES USE $1B $5B ?? ?? 529 | ` A OF GOUP ?REFRESH ENDOF --- UP 530 | ` B OF GODN ?REFRESH ENDOF --- DOWN 531 | ` C OF 1 tcur+! ENDOF --- RIGHT 532 | ` D OF 1 tcur-! ENDOF --- LEFT 533 | ` H OF ?HOME ENDOF --- HOME 534 | ` F OF FSIZE@ ew - tcur! ENDOF 535 | ` 5 OF PGUP REFRESH ENDOF --- PGUP VT100 536 | ` 6 OF PGDN REFRESH ENDOF --- PGDN VT100 537 | ` U OF PGDN REFRESH ENDOF --- PGDN ANSI 538 | ` V OF PGUP REFRESH ENDOF --- PGUP ANSI 539 | ` @ OF tINS .LINE ENDOF --- INS 540 | ` 1 OF EDKEY ESC1 ENDOF 541 | ` 2 OF EDKEY ESC2 ENDOF 542 | ` 3 OF EDKEY ESC3 ENDOF 543 | ` Z OF tcur@ 8 - 7 ANDN tcur! ENDOF --- shift+TAB 544 | ENDCASE 545 | ; 546 | 547 | { 548 | m0m[0mmm4m34m4m47m7m[47mm[0m4m[47m47mmm0m7m0m0m0mm0m47mm34m47m34m47m34m0m[47mm[47m[3 549 | 550 | 1B 5B 41 up 551 | 1B 5B 66 down 552 | 1B 5B 44 left 553 | 1B 5B 43 right 554 | 1B 5B 31 home 555 | 1B 5B 40 INS 556 | 1B 5B 32 7E INS VT100 557 | 1B 5B 33 7E DEL VT100 558 | 1B 5B 35 PGUP 559 | 1B 5B 36 7E PGDN VT100 560 | 561 | 1B 5B 55 PGDN ANSI 562 | 1B 5B 56 PGUP ANSI 563 | 1B 5B 36 3B 35 7E ^PGDN 564 | 1B 5B 35 3B 35 7E ^PGUP 565 | 1B 5B 31 3B 35 48 ^HOME to start of file 566 | 1B 5B 32 3B 35 7E ^INS 567 | 1B 5B 33 3B 35 7E ^DEL 568 | 1B 5B 31 3B 35 43 ^RIGHT 569 | 1B 5B 31 3B 35 44 ^LEFT 570 | 1B 5B 31 3B 35 41 ^UP 571 | 1B 5B 31 3B 35 42 ^DN 572 | 1B 5B 31 3B 35 46 ^END ESC [1;5F 573 | 1B 5B 32 31 7E F10 574 | } 575 | 576 | 577 | pri FNCKEY --- 1B 4F XX 578 | CASE 579 | ` F OF ENDKEY ENDOF --- END 580 | ` M OF DELLN REFRESH ENDOF --- SHIFT+ENTER 581 | ` P OF FNC1 ENDOF 582 | ` Q OF FNC2 ENDOF 583 | ` R OF FNC3 ENDOF 584 | ` S OF FNC4 ENDOF 585 | ` T OF FNC5 ENDOF 586 | ` U OF FNC6 ENDOF 587 | ` V OF FNC7 ENDOF 588 | ` W OF FNC8 ENDOF 589 | ` X OF FNC9 ENDOF 590 | ` Y OF FNC12 ENDOF 591 | ENDCASE 592 | ; 593 | 594 | { 595 | : ESS BEGIN KEY DUP 3 <> WHILE .B SPACE REPEAT ; 596 | ansi 597 | 1B 5B 41 up 598 | 1B 5B 66 down 599 | 1B 5B 44 left 600 | 1B 5B 43 right 601 | 1B 5B 31 home 602 | 1B 5B 32 INS 603 | 1B 5B 33 DEL 604 | 1B 5B 35 PGUP 605 | 1B 5B 36 PGDN 606 | 607 | FNC 608 | 1B4F46 END 609 | 1B4F50 F1 610 | 1B4F51 611 | 1B4F52 612 | 1B4F53 613 | 1B4F54 614 | 1B4F55 615 | 1B4F56 616 | 1B4F57 617 | 1B4F58 F9 618 | 1B5B32 F10 619 | 1B4F59 F12 620 | } 621 | 622 | pri EDESC 623 | a>A CASE --- ESC COMMANDS 624 | $0D OF INSLN REFRESH ENDOF --- ALT+ENTER 625 | $5B OF EDKEY ESC5B ENDOF 626 | $4F OF EDKEY FNCKEY ENDOF 627 | $7F OF tDEL .LINE ENDOF --- DEL 628 | $1B OF !CLIP REFRESH ENDOF --- ESC ESC 629 | ENDCASE 630 | ; 631 | 632 | pri ED^Y 633 | a>A CASE 634 | ` I OF 0 ~opts TOGB .INDENT ENDOF 635 | ` L OF 2 ~opts TOGB REFRESH ENDOF 636 | \ ` W OF ENDOF 637 | ` H OF HEXBLK ENDOF 638 | ` N OF 32 TXTBLK ENDOF 639 | ` T OF 64 TXTBLK ENDOF 640 | \ ` W OF 128 4096 BLK! ENDOF 641 | 642 | ` X OF 0 CLRLN ENDOF --- erase current line (nulls) 643 | ` Z OF WIPE.PAGE REFRESH ENDOF --- wipe & format page 644 | ^ Q OF 0 @STATUS PLAIN QUIT ENDOF --- special debug quit 645 | ^ Z OF ?FORMAT.BLK ENDOF 646 | $0D OF FORMAT.PAGE REFRESH ENDOF 647 | $20 OF $20 CLRLN ENDOF --- blank current line (spaces) 648 | ENDCASE 649 | ; 650 | 651 | pri EDKEY: 652 | ?DUP 0EXIT 653 | CASE 654 | ^ A OF 1 tcur+! ENDOF 655 | ^ B OF tcur@ ~begin ! ~end ~ ENDOF --- mark beginning of selection block 656 | ^ C OF COPY REFRESH ENDOF --- mark end of block and copy 657 | \ ^ D OF ENDOF 658 | \ ^ E OF ENDOF 659 | \ ^ F OF ENDOF 660 | \ ^ G OF ENDOF 661 | ^ H OF 1 tcur-! $20 EDCHAR! .LINE ENDOF 662 | ^ I OF EDTAB ENDOF 663 | ^ J OF ( ignore ) ENDOF 664 | \ ^ K OF ENDOF 665 | ^ L OF pagesz tcur+! REFRESH ENDOF --- page down 666 | ^ M OF EDCR ?REFRESH ENDOF --- CR new line 667 | ^ N OF HEXBLK REFRESH ENDOF 668 | ^ O OF OPTIONS ENDOF 669 | \ ^ P OF ENDOF 670 | ^ Q OF QUITED ENDOF 671 | ^ R OF REVERT ENDOF 672 | ^ S OF SAVEFILE ENDOF 673 | ^ T OF 64 TXTBLK REFRESH ENDOF 674 | \ ^ U OF ENDOF 675 | ^ V OF PASTE REFRESH ENDOF 676 | ^ W OF ew tcur-! REFRESH ENDOF 677 | ^ X OF CUT REFRESH ENDOF 678 | ^ Y OF EDKEY ED^Y REFRESH ENDOF 679 | ^ Z OF UNDO ENDOF 680 | --- an escape key itself cancels any selections and always refreshes the page 681 | $1B OF 4 ms KEY? IF EDKEY EDESC ELSE CLS REFRESH THEN ENDOF 682 | ~skeys C@ EDCHAR 683 | ENDCASE 684 | ; 685 | 686 | 687 | --- main editor loop 688 | pri EDTASK ( -- ) 689 | tcur! CLS REFRESH cycles ~idle ! 690 | BEGIN 691 | !SP -TEXT KEY? 692 | IF cycles ~idle ! EDKEY EDKEY: !TEXTXY 693 | ELSE cycles ~idle @ - ABS 500000 > 694 | 0 ~eflgs BIT? AND IF REFRESH THEN 695 | THEN 696 | AGAIN 697 | ; 698 | 699 | --- setup EDIT 700 | pri !ED 701 | SD? 0= IF ." No SD? " QUIT THEN 702 | ~ecold @ $A55A <> 703 | IF 704 | -MINT 128 4096 BLK! ~edsect ~~ ~hflgs ~ ~opts ~ 705 | !CLIP 706 | $A55A ~ecold ! 707 | THEN 708 | ; 709 | 710 | pub ED ( ED or 0 ED SECTOR or 0 ED FLASH ) 711 | !ED GET$ DUP LEN$ 712 | IF SPACE FOPEN$ IF 0 EDTASK THEN 713 | --- try to reopen the last file at the same position 714 | ELSE file$ FOPEN$ IF tcur@ EDTASK THEN 715 | THEN 716 | --- not a file, then check for .... 717 | \ HEXBLK 718 | --- or SECTOR 719 | SECTOR? IF FSECTOR 0 EDTASK THEN 720 | --- don't know 721 | PRINT" BAD COMMAND " 722 | ; 723 | 724 | --- edit a sector (current in text mode) 725 | : EDSECT !ED OPEN-SECTOR file$ 16 ERASE s" SECTOR" file$ SWAP MOVE 0 EDTASK ; 726 | 727 | --- Create a new preformatted file - default size = 1MB (else use "n FSIZE! NEWED ") 728 | \ : NEWED !ED RWC OPEN-FILE IF FORMAT.BLK 0 EDTASK THEN ; 729 | --- deprecate NEWED and standardize EDxxx words 730 | : EDNEW !ED RWC OPEN-FILE IF FORMAT.BLK 0 EDTASK THEN ; 731 | 732 | 733 | --- DEBUG KEY SEQUENCES - USE ^C to exit 734 | { 735 | : ESS BEGIN KEY DUP 3 <> WHILE .B SPACE REPEAT ; 736 | 737 | } 738 | 739 | 740 | *END* 741 | -------------------------------------------------------------------------------- /rp2040/mecrisp/Forth/SPLAT.FTH: -------------------------------------------------------------------------------- 1 | MECRISP 2 | 3 | pub *SPLAT* ." SPLAT - Serial Pico Logic Analyzer Terminal 220424-1320 " ; 4 | 5 | 2204240000 TME? --- check if Tachyon Mecrisp Extensions are new enough 6 | 7 | { 8 | CHANGELOG: 9 | 220424 standardize timebase as tenths of ns 10 | 220420 Added current input state into left column 11 | 2204xx Added measurement window (to do: measurements) 12 | 220411 Adding TRANSITIONAL ACQUISITION function (also updated TACHYON) 13 | 14 | 220404 expand labels to 8 characters (up to 329 labels) 15 | Add pin function info 16 | 220331 Pico version 17 | 210812 Expanded to 64 channels display 18 | Automatic A or B or A+B capture 19 | Added peristent labels 20 | Added popup menu. 21 | 210811 Fixed zoom, optimized code. 22 | 210809 Got this working in TAQOZ on the P2 23 | 170309 Adapted for Tachyon V4 24 | 150915 Improved refresh speed, added division marker rows 25 | 150915 Experimenting with using cursor and function keys as they use ANSI escape sequences rather than a single keycode 26 | 150906 If baud sampling is set then cursor shows decoded ASCII if placed on start bit 27 | 150905 Allow settings to be remembered (via BACKUP) and not overridden on boot 28 | 150905 Changed help text so that it could be loaded into any area of EEPROM 29 | 150905 Various enhancements etc. Changed to V1.0 30 | 150903 Added input channels command I to set input channels from 8 to 32 - defaults to 28 31 | 150903 Changed some commands so that they are the same in the command line (i.e. Z instead of * etc) 32 | 150903 Moved to top of stack to permit command line use. 33 | 150903 Changed KEY method to use standard KEY input plus maintain a latched copy in newkey 34 | 150903 Added aliases for ns us ms and baud as n u m b - so command line 115200 b will set the scale to baud rate 35 | 36 | 150902 Added: units can now be entered in ns us ms and baud modes to set the scale which is shown in ns/us 37 | 150902 Added: PASM capture function - it appears that 525ns is the fastest capture possible with one cog 38 | 150902 Added: PINLOAD function to display whether pin is pulled up/down or floating 39 | 40 | TORefresh time 123ms for 28 channels 100 wide @2M or 510ms @115200 41 | 250ms for 75x16 @115200 42 | 43 | CODE STATS: 44 | 10076 bytes use 45 | 46 | 47 | save to SD inc config 48 | Make HELP text a standard text file that can be pasted in and saved in EEPROM (esp 64k) or SD card 49 | Include DUMP format listing for ASCII decode view mode 50 | 51 | 52 | } 53 | 54 | \ *** PATCHES **** 55 | : 4* 2 << ; 56 | 57 | ( *** DATA *** ) 58 | 59 | --- VARIABLES --- 60 | 61 | 62 | org@ constant spvars 63 | 64 | 65 | \ 18 constant fastcycle 66 | 67 | long timebase --- timebase in ns/10 68 | long scale --- timebase in cycles 69 | long lbaud --- timebase in baud 70 | 71 | long samples --- address of displayed samples 72 | long lcur --- cursor column 73 | long curadr --- absolute address of cursor in samples 74 | 75 | long trig --- trigger masks 76 | long triglev --- trigger level (high/low) 77 | long trigdly --- delay after trigger 78 | 79 | byte newkey 80 | byte snew 81 | 82 | 83 | byte ~width --- width of display * 4 84 | byte ~zoom --- zoom factor 85 | byte zoomo 86 | 87 | 88 | byte first# --- first channel to be displayed 89 | byte last# --- last channel to be displayed 90 | 91 | pri channels last# C@ 1+ first# C@ ; 92 | pri width ~width C@ 4* ; 93 | pri zoom ~zoom C@ ; 94 | 95 | $D0000004 constant INPUTS --- input port address 96 | 97 | $20034000 constant CAPBUF 98 | $1000 constant capsz --- size in longs 99 | 100 | 101 | 102 | 103 | ( *** TRIGGER & CAPTURE *** ) 104 | 105 | --- set trigger but if no parameter then select all 106 | pri TRIGGER trig @ INPUTS begin OVER OVER @ AND 0= UNTIL 2DROP ; 107 | 108 | { 109 | TRANSITIONAL ACQUISITION 110 | Use DELTA capture method where only transitions are saved 111 | along with a microsecond cycle count 112 | When this method is used then the buffer can be reduced also 113 | 114 | If a spare low frequency PWM output is enabled it will force recording 115 | even during inactiviy so this force a timeout without extra logic. 116 | } 117 | pri DELTACAP ( addr cnt -- ) 118 | --- dummy compare value before do loop 119 | 0 -ROT BOUNDS 120 | DO 121 | --- ( old ) update inputs & compare ( new ) 122 | BEGIN INPUTS @ ( 3 bic ) DUP ROT <> UNTIL 123 | --- save current inputs along with cycle count ( cycles,inps) 124 | DUP cycles I 2! 125 | 8 +LOOP DROP 126 | ; 127 | { 128 | BEGIN INPUTS @ DUP ROT <> UNTIL 129 | 20020698: 20D0 movs r0 #D0 130 | 2002069A: 0600 lsls r0 r0 #18 131 | 2002069C: 6843 ldr r3 [ r0 #4 ] 132 | 2002069E: 42B3 cmp r3 r6 133 | 200206A0: 461E mov r6 r3 134 | 200206A2: D0F9 beq 20020698 135 | DUP cycles I 2! 136 | 200206A4: 2080 movs r0 #80 137 | 200206A6: 0300 lsls r0 r0 #C 138 | 200206A8: 30A8 adds r0 #A8 139 | 200206AA: 02C0 lsls r0 r0 #B 140 | 200206AC: 6A83 ldr r3 [ r0 #28 ] 141 | 200206AE: 0022 lsls r2 r4 #0 142 | 200206B0: 6013 str r3 [ r2 #0 ] 143 | 200206B2: 6056 str r6 [ r2 #4 ] 144 | 200206B4: 3F04 subs r7 #4 145 | 200206B6: 603E str r6 [ r7 #0 ] 146 | 8 +LOOP 147 | 200206B8: 2608 movs r6 #8 148 | 200206BA: 2080 movs r0 #80 149 | 200206BC: 0600 lsls r0 r0 #18 150 | 200206BE: 1900 adds r0 r0 r4 151 | 200206C0: 19A4 adds r4 r4 r6 152 | 200206C2: 1B40 subs r0 r0 r5 153 | 200206C4: 1980 adds r0 r0 r6 154 | 200206C6: CF40 ldmia r7 [[ r6 ]] 155 | 200206C8: D7E6 bvc 20020698 156 | } 157 | 158 | { 159 | 8ns cycle time @125MHz 160 | FASTCAP 144ns/sample = 18cycles 161 | } 162 | 144 constant fastns 163 | 164 | pri FASTCAP ( addr cnt -- ) INPUTS -ROT BOUNDS DO DUP @ I ! 4 +LOOP DROP ; 165 | 166 | --- simple capture routine - needs asm/dma and/or other core for full-speed 167 | pri LACAP ( addr cnt scale -- ) 168 | timebase @ 9999 > IF DROP DELTACAP EXIT THEN 169 | ?DUP 170 | IF 171 | 1 MAX -ROT BOUNDS INPUTS -ROT ( scale ioadr end src ) 172 | --- capture with delays 173 | DO DUP @ I ! OVER 0 ?DO LOOP 4 +LOOP 2DROP 174 | --- zero delay capture 175 | ELSE FASTCAP 176 | THEN 177 | ; 178 | 179 | 180 | pub CAPTURE CAPBUF CAPSZ scale @ LACAP ; 181 | 182 | 183 | 184 | ( *** LABELS *** ) 185 | 186 | --- allow for persistent labels in code memory 187 | CREATE clabels 256 ALLOT clabels 256 ERASE 188 | pri @LABEL ( index -- adr ) 3 << clabels + ; 189 | --- Create a channel label of up to 8 characters in one long - usage: 6 LABEL RXD1 190 | pre LABEL ( -- ) 191 | DUP 0 29 WITHIN IF TOKEN ROT @LABEL DUP 8 ERASE SWAP MOVE ELSE DROP THEN 192 | ; 193 | 194 | 0 LABEL TXD 195 | 1 LABEL RXD 196 | 197 | 198 | ( *** DISPLAY *** ) 199 | 200 | 201 | --- use 1 of 7 colors for channels, never black, with offset 202 | pri LAHUE 4 + 7 MOD 1+ PEN ; 203 | 204 | 205 | pri COND 2 2 XY PEN REVERSE ." ** " ; 206 | pri RUNNING red COND ; 207 | pri STOPPED white COND ; 208 | pri ARMED yellow COND ; 209 | 210 | 211 | pri .RULER.SP 212 | 9 SPACES PLAIN width zoom / zoom * 213 | --- vertical division every 10th 214 | 0 DO I 10 MOD 0= I AND IF ` | ELSE ` = THEN EMIT LOOP 215 | BOLD REVERSE SPACE CRLF 216 | ; 217 | 218 | pri GRID? DUP 7 AND 0= SWAP first# C@ <> AND ; 219 | pri .GRID GRID? IF .RULER.SP THEN ; 220 | pri GRID 1 3 XY channels DO I .GRID CRLF LOOP ; 221 | 222 | 223 | pri .STATES 224 | HOME CRLF CRLF 225 | white PEN REVERSE 226 | channels DO 227 | I GRID? IF CRLF THEN 228 | \ width 9 + I 2+ XY 229 | INPUTS @ I |< AND IF ` 1 ELSE ` 0 THEN EMIT 230 | CRLF 231 | LOOP 232 | ; 233 | 234 | pri .LABEL ( CHAN -- ) 235 | white PEN REVERSE SPACE 236 | --- fill in right border and label if set 237 | @LABEL DUP C@ IF 8 TYPE ELSE DROP THEN CRLF 238 | ; 239 | 240 | --- zoom scaling emit - simply repeats characters 241 | pri ZEMIT ( ch -- ) zoom EMITS ; 242 | 243 | 244 | pri .ns ( ns -- ) 245 | DUP 999999 > IF 100000 U/ 5 1 .DP ." ms" EXIT THEN 246 | DUP 999 > IF 100 U/ 5 1 .DP ." us" EXIT THEN 247 | 5 U.R ." ns" 248 | ; 249 | 250 | 251 | 252 | 253 | 254 | 255 | ( *** METRICS *** ) 256 | 257 | byte ~metrics 258 | pri FREQ@ 4* @ 20 BITS ; 259 | pri .FREQ ( index -- ) FREQ@ 7 U.R ." Hz" ; 260 | pri .PW ( index -- ) FREQ@ 1000 M SWAP / .ns ; 261 | 262 | pri .METRIC ( index -- ) 263 | width 11 - 3RD XY SPACE DUP .FREQ SPACE .PW 2 SPACES 264 | ; 265 | pri METRICS --- 23456789.123456789. 266 | white PAPER red PEN width 11 - 2 XY PRINT" FREQUENCY PERIOD " 267 | 268 | blue PAPER white PEN 3 269 | channels DO I GRID? IF 1+ THEN I .METRIC 1+ LOOP 270 | DROP 271 | ; 272 | 273 | pri ?METRICS 274 | ~metrics C@ IF METRICS THEN 275 | ; 276 | 277 | 32 longs freqs 278 | { 279 | 280 | pri edge? ( -- adr ) 281 | 0 282 | BEGIN 283 | ant 8 + ant! 284 | ant capbuf capsz + > ?EXIT 285 | ant 4 - @ bat AND 286 | ant 4 + @ bat AND <> 287 | UNTIL 288 | DROP ant 289 | ; 290 | 291 | long lh 292 | long hl 293 | pub PERIOD ( ch -- min avg max ) 294 | bat! 0 cat! 295 | CAPBUF ant! 296 | BEGIN 297 | ant 4 + @ bat AND 0= 298 | ant 12 + @ bat AND AND 0= 299 | WHILE 300 | ant 8 + ant! 301 | REPEAT 302 | ant 8 + ant! 303 | 304 | ant 8 + @ cat! THEN 305 | 306 | 307 | DO I 4 + @ OVER AND 0= I 12 + @ 3RD AND AND 308 | IF 309 | 8 +LOOP 310 | ; 311 | 312 | } 313 | 314 | pri MEASURE 315 | 316 | 317 | ; 318 | 319 | 320 | 321 | 322 | ( *** DECODE *** ) 323 | 324 | --- return with serial character found from this start bit position assuming 3 samples per bit 325 | pri ASCII? ( addr chan -- byte ) 326 | --- check framing 327 | |< OVER @ OVER AND 0= 3RD 4 - @ 3RD AND 0<> AND 328 | IF ( adr cha dat ) 329 | --- extract data bits 330 | 0 10 1 DO 2/ 3RD I 4* + @ 3RD AND 331 | IF $100 OR THEN LOOP 332 | $100 XOR --- forces invalid if stop bit not set 333 | ELSE 334 | $1FF 335 | THEN 336 | NIP NIP 337 | ; 338 | pri .CURSOR ( addr chan -- offset ) 339 | REVERSE BOLD lbaud @ 340 | IF ( ch BYTE ) 341 | SWAP OVER ASCII? DUP $21 $7E WITHIN ( ch flg ) 342 | IF EMIT 4 ELSE DUP $FF > IF DROP SPACE 4 ELSE .BYTE 12 THEN THEN 343 | ELSE --- j bit 344 | SWAP @ OVER |< AND IF ` 1 ELSE ` 0 THEN ZEMIT 345 | 4 346 | THEN 347 | SWAP PLAIN BOLD LAHUE 348 | ; 349 | --- DIAGNOSTIC FOR ASCII DISPLAY 350 | : .CH 12 0 DO OVER I CELLS + @ OVER |< AND 0<> 1 AND PRINT LOOP ; 351 | 352 | \ ` - variable chh 353 | ` - 8 << ` _ OR variable chlh 354 | 355 | pri .BIT ( bit -- ) IF chlh 1+ C@ ELSE chlh C@ THEN ZEMIT ; 356 | 357 | { 358 | __________________________________----------------------------------- 359 | 360 | FASTCAP 69 for 10us = 144ns = 18 cycles 361 | } 362 | pri .ROWT ( addr longs -- ) 363 | BOUNDS DO 364 | --- check for cursor column 365 | curadr @ I = 366 | IF I bat .CURSOR 367 | ELSE I @ bat |< AND .BIT 4 368 | THEN 369 | +LOOP 370 | ; 371 | pri .ROWV 372 | 5 / 2* BOUNDS 373 | DO I 8 + @ I @ - ABS 5 U.R 8 +LOOP 374 | ; 375 | 376 | --- transitional acquistion display 377 | pri .ROWD ( addr longs -- ) ( bat = row index bit ) 378 | timebase @ 555 = IF .ROWV EXIT THEN 379 | 2 >> cat! ant! 380 | BEGIN 381 | ant 8 + @ ant @ - ABS ( us ) 382 | 10000 timebase @ */ cat UMIN 1 UMAX 383 | ant CELL+ @ bat |< AND ( us bit ) 384 | OVER 0 DO DUP .BIT LOOP DROP 385 | cat SWAP - DUP cat! ( addr cols-us ) 386 | ant 8 + ant! 387 | 0= 388 | UNTIL 389 | ; 390 | pri .ROW.SP timebase @ 9999 > IF .ROWD ELSE .ROWT THEN ; 391 | 392 | --- DEBUG 393 | pub .DELTAS ( cnt -- ) 394 | CAPBUF SWAP 3 << BOUNDS 395 | DO CRLF I 8 + @ I @ - ABS 8 U.R ." us " I 4 + @ .BIN 8 +LOOP 396 | ; 397 | 398 | 399 | 400 | pri .CHAN ( index -- ) 401 | DUP LAHUE 402 | REVERSE DUP 2 U.R 403 | white PEN REVERSE .FNC 404 | PLAIN BOLD 405 | ; 406 | 407 | 408 | 409 | ( *** MAIN DISPLAY *** ) 410 | 411 | pri .TRIG |< trig @ AND IF BLINK red PEN ` + EMIT ELSE SPACE THEN PLAIN ; 412 | 413 | --- print LOGIC ANALYZER DISPLAY --- 414 | pub .LAD ( addr lcnt --- ) 415 | OFF CURSOR 416 | OVER lcur @ 4* + curadr ! 417 | 4* --- convert long count to bytes in byte memory 418 | 1 3 XY REVERSE 419 | --- cycle through all the memory 1 bit position at a time - one line per bit 420 | channels 421 | DO 422 | I bat! 423 | I .GRID 424 | SPACE 425 | I .TRIG 426 | I .CHAN 427 | I LAHUE 428 | ( addr bcnt ) 2DUP .ROW.SP 429 | I .LABEL 430 | LOOP 431 | 2DROP .RULER.SP PLAIN 432 | ?METRICS 433 | ; 434 | 435 | 436 | 437 | 438 | 439 | ( *** CONFIGURATION *** ) 440 | 441 | 442 | --- save old key in upper byte and clear current entry 443 | pri !KEY newkey C~ ; \ newkey H@ 8 << newkey H! ; 444 | 445 | --- add another digit to the current number 446 | pri +ENTRY $30 - SWAP 10 * + ; 447 | 448 | pri CE 0 BEGIN DEPTH 2 > WHILE ROT DROP REPEAT ; 449 | --- clear stack except for last item and also push 0 450 | pri !ENTRY CE !KEY ; 451 | 452 | \ pri .ts 0 <# # ` . HOLD #S #> TYPE ; 453 | 454 | pri .dns ( ns*10 -- ) 455 | 10 /MOD OVER IF 3 U.R ` . EMIT 1 U.R ." ns" 456 | ELSE NIP .ns THEN 457 | ; 458 | 459 | --- Print the scale in units of ns/us/ms etc - input is in tenths of ns - i.e. 28875 = 2.8875us 460 | pri .SCALE ( ns*10 -- ) 461 | timebase @ 9999 > 462 | IF timebase @ 10000 / PRINT ." us" DROP 463 | ELSE 464 | .dns 465 | THEN 466 | ; 467 | pri @footer ( x y -- ) channels - DUP 1- 3 >> + + XY ; 468 | 469 | pub FOOTER 470 | PLAIN white PEN black PAPER REVERSE 471 | PRINT" SCALE=" 472 | lbaud @ ?DUP 473 | IF .DEC ." baud" ELSE timebase @ .SCALE THEN 474 | PRINT" x" zoom PRINT 475 | --- calulate time scale of cursor 476 | PRINT" @" samples @ lcur @ 4* + CAPBUF - 2/ 2/ DUP PRINT 477 | PRINT" =" timebase @ * .SCALE 478 | 2 SPACES OVER 8 U.R SPACE DUP 8 U.R 4 SPACES 479 | ; 480 | 481 | --- draws frame etc - still need to move some stuff from .LAD to here 482 | pub FRAME 483 | OFF CURSOR HOME PLAIN BOLD 484 | white PAPER black PEN ." .:.:--TACHYON--:.:. " 485 | red PEN ." SPLAT " 486 | black PEN ." LOGIC ANALYZER V1.0 " 487 | --- print top border 488 | PLAIN white PAPER black PEN 489 | 1 2 XY ." CH FNC " 490 | --- print horizontal digit position (01234567890..) 491 | 0 width zoom / 0 DO DUP 10 MOD ` 0 + ZEMIT 1+ LOOP SPACE DROP 492 | --- bottom frame 493 | 1 4 @footer width zoom / zoom * 10 + SPACES 494 | --- stats 495 | 1 4 @footer FOOTER 496 | --- reset colors etc 497 | PLAIN black PAPER white PEN 498 | 1 5 @footer *SPLAT* 499 | ; 500 | 501 | 502 | --- return with an entered parameter or else the default supplied 503 | pri PR ( default -- res ) OVER DUP IF NIP ELSE DROP THEN ; 504 | 505 | --- set trigger pattern - always allow console RXD to also trigger this so that it can escape 506 | --- Enter >31 for all or toggle bits with T 507 | pub SETTRIG 508 | DUP 32 < 509 | IF |< trig @ XOR 510 | ELSE DROP -1 511 | THEN 512 | trig ! 513 | ; 514 | 515 | 516 | pub SETCUR DUP lcur ! ; 517 | 518 | long _ps --- picoseconds/cycle (calculated from CLKFREQ ) 519 | 520 | 521 | pri SCALE! scale ! ; 522 | pri SETSCALE lbaud ~ SCALE! ; 523 | 524 | pri SETps ( n mul -- ) _ps @ */ SCALE! lbaud ~ ; 525 | pri SETns fastns UMAX DUP 10 * timebase ! 1K SETps ; 526 | pri SETus DUP 10000 * timebase ! 1 M SETps ; 527 | pri SETms 1k * SETus ; \ DUP 1K * timebase ! 1K M SETps ; 528 | 529 | pri SETbaud DUP lbaud ! clkfreq SWAP 3 * / SCALE! ; 530 | 531 | pri SETWIDTH 40 UMAX 1024 UMIN 2 >> ~width C! ; 532 | 533 | pri SETZOOM timebase @ 9999 > IF zoomo C! ELSE 1 10 LIMIT ~zoom C! THEN ; 534 | 535 | pri SETchan ( from to -- ) 2DUP < IF 1 31 LIMIT last# C! 0 30 LIMIT first# C! ELSE 2DROP THEN ; 536 | 537 | pri SETHL ( h l == ) ?DUP IF chlh C! THEN ?DUP IF chlh 1+ C! THEN ; 538 | 539 | pri FINDMATCH 540 | curadr @ @ curadr BEGIN CELL+ 2DUP @ = UNTIL lcur @ 4* - samples ! 541 | ; 542 | 543 | 544 | 545 | 546 | 547 | pri !! ( y s cnt -- y+1 ) 20 4TH XY SPACE 2DUP TYPE 40 SWAP - SPACES DROP 1+ ; 548 | 549 | pub LAHELP 550 | white PAPER red PEN 3 551 | s" *** MENU FUNCTIONS ***" !! 552 | blue PAPER white PEN 553 | s" s SET SAMPLING RATE: 0s" !! 554 | s" n ns SAMPLING RATE: 50n" !! 555 | s" u us SAMPLING RATE: 100u" !! 556 | s" m ms SAMPLING RATE: 5m" !! 557 | s" b baud RATE: 19200b" !! 558 | s" r CONTINUOUS CAPTURE & DISPLAY" !! 559 | s" > SCROLL RIGHT: >" !! 560 | s" < SCROLL LEFT: 2<" !! 561 | s" ; ENTER COMMAND SEQUENCE " !! 562 | s" . RIGHT CURSOR: 20." !! 563 | s" , LEFT CURSOR: 20," !! 564 | s" / RESET DISPLAY TO HOME" !! 565 | s" @ POSITION CURSOR: 200@" !! 566 | s" + FIND MATCH " !! 567 | --- upper or lower OF keys 568 | s" z ZOOM IN: 4z" !! 569 | s" w SET WIDTH: 200W" !! 570 | s" t SET TRIGGER " !! 571 | s" c SET CURSOR: 100c" !! 572 | s" i INPUT RANGE: 32 47i" !! 573 | s" TAB SINGLE SHOT ACQUISTION" !! 574 | s" BS CORRECT DIGIT" !! 575 | s" SP STOP or ENTER NEXT PARAMETER" !! 576 | s" ? HELP MENU" !! 577 | s" CR Exit to Forth console" !! 578 | s" ANY other key to refresh display" !! 579 | DROP 580 | KEY 581 | ; 582 | 583 | 584 | pri SHELL 1 4 @footer DISCARD ON CURSOR PLAIN QUIT ; 585 | 586 | pub REFRESH.SP FRAME samples @ width zoom / .LAD ; 587 | pub PROCESS !ENTRY REFRESH.SP ; 588 | 589 | pri [CAPTURE] RUNNING 5 ms TRIGGER CAPTURE MEASURE REFRESH.SP STOPPED ; 590 | 591 | 592 | 593 | 594 | 595 | pri CUR- 1 PR NEGATE lcur @ + 0 MAX lcur ! PROCESS ; 596 | pri CUR+ 1 PR lcur +! PROCESS ; 597 | 598 | pri SHIFTS 599 | CASE 600 | ` D OF lbaud @ IF 30 ELSE 10 THEN CUR- ENDOF 601 | ` C OF lbaud @ IF 30 ELSE 10 THEN CUR+ ENDOF 602 | ENDCASE 603 | ; 604 | pri ALTS 605 | DROP 606 | ; 607 | pri CTLS 608 | CASE 609 | ` D OF 1 ` < KEY! ENDOF 610 | ` C OF 1 ` > KEY! ENDOF 611 | ENDCASE 612 | ; 613 | pri CTSHS 614 | DROP 615 | ; 616 | 617 | pri LAESC ( n -- ) 618 | CASE KEY 619 | ` 2 OF SHIFTS ENDOF 620 | ` 3 OF ALTS ENDOF 621 | ` 5 OF CTLS ENDOF 622 | ` 6 OF CTSHS ENDOF 623 | ENDCASE 624 | DROP 625 | ; 626 | 627 | pri UPPER DUP ` a ` z WITHIN IF $20 - THEN ; 628 | 629 | pub LAKEY 630 | KEY? IF KEY UPPER newkey C! ELSE .STATES THEN 631 | newkey C@ ` 0 ` 9 WITHIN IF newkey C@ +ENTRY !KEY FRAME EXIT THEN --- accumulate entry 632 | newkey C@ CASE 633 | $08 OF 10 / !KEY FRAME ENDOF --- BS clear last digit 634 | $7F OF !ENTRY FRAME ENDOF --- DEL to clear entry (was BACKSPACE ) 635 | $20 OF !KEY PROCESS ENDOF --- stop, add entry and refresh screen 636 | $0D OF SHELL ENDOF --- exit to Forth shell 637 | ^ I OF [CAPTURE] !KEY ENDOF --- TAB - take a sample 638 | ` > OF 4 PR 4* samples +! CE REFRESH.SP ENDOF --- scroll right 639 | ` < OF 4 PR 4* NEGATE samples +! CE REFRESH.SP ENDOF --- scroll left 640 | ` ; OF KEY LAESC !ENTRY ENDOF --- ;n simulates ctl/shf/alt 641 | ` . OF CUR+ ENDOF --- move cursor by amount or 1 642 | $E8 OF CUR+ ENDOF --- move cursor by amount or 1 643 | ` , OF CUR- ENDOF 644 | $A2 OF CUR- ENDOF 645 | ` / OF CAPBUF samples ! PROCESS ENDOF 646 | ` @ OF 4* CAPBUF + samples ! PROCESS ENDOF 647 | ` + OF FINDMATCH PROCESS ENDOF 648 | \ A 649 | ` B OF SETbaud PROCESS ENDOF --- set scale by 3*baudrate 650 | ` C OF SETCUR PROCESS ENDOF 651 | \ D E F G 652 | ` H OF SETHL PROCESS ENDOF 653 | ` I OF SETchan CLS PROCESS ENDOF 654 | \ J K L 655 | ` M OF SETms PROCESS ENDOF 656 | ` N OF SETns PROCESS ENDOF 657 | \ 0 P Q 658 | ` R OF [CAPTURE] ENDOF 659 | ` S OF SETSCALE PROCESS ENDOF --- set scale in clock cycles 660 | ` T OF SETTRIG PROCESS ENDOF 661 | ` U OF SETus PROCESS ENDOF 662 | \ V 663 | ` W OF SETWIDTH CLS PROCESS ENDOF --- RESET WIDTH & ZOOM or use entry 664 | \ X Y 665 | ` Z OF SETZOOM PROCESS ENDOF 666 | ` ? OF LAHELP PROCESS ENDOF 667 | ` \ OF ~metrics C++ PROCESS ENDOF 668 | ` | OF ~metrics C~ PROCESS ENDOF 669 | ENDCASE 670 | ; 671 | 672 | 673 | org@ spvars - constant spsz 674 | 675 | pub !SPLAT 676 | 29 last# C! first# C~ 677 | spvars spsz ERASE 678 | snew C@ $A5 <> 679 | IF 680 | first# C~ 681 | 29 last# C! 682 | 76 SETwidth --- set defaults for 80 columns total 683 | 10 lcur ! 1 ~zoom C! 1 zoomo C! 684 | 1 SETus 685 | trig ~ 686 | $A5 snew C! --- used to detect that settings were backed up 687 | THEN 688 | --- calculate constant used by scale 689 | 1000000000000. clkfreq UM/MOD NIP _ps ! 690 | CAPBUF samples ! 691 | !ENTRY --- lnum is now on the stack to permit cli use 692 | ; 693 | pub RESUME 694 | snew C@ $A5 <> IF !SPLAT THEN 695 | STOPPED 696 | CLS PROCESS BEGIN LAKEY AGAIN 697 | ; 698 | pub SPLAT !SPLAT RESUME ; 699 | 700 | ' RESUME ^ R CTRL! 701 | 702 | : STIM 20 2 DO I PIN I $FE AND 5000 * HZ I 4* 100 DUTY LOOP ; \ 50 21 SERVO ; 703 | 704 | 705 | \ 21 LABEL SERVO 706 | \ 12 LABEL BACKLITE 707 | 25 LABEL PICOLED 708 | 709 | 710 | snew C~ \ !SPLAT 711 | 712 | *END* 713 | -------------------------------------------------------------------------------- /rp2040/mecrisp/Forth/ST7789A.FTH: -------------------------------------------------------------------------------- 1 | MECRISP ( ST7789 LCD DRIVER - requires RP2040, FONT16X32 ) 2 | compiletoflash 3 | 4 | : *ST7789* PRINT" Text & Graphics driver for ST7789 240x240 IPS LCD 211202-0000" ; 5 | { 6 | http://www.lcdwiki.com/1.3inch_IPS_Module 7 | st7789 datasheet 8.8.40 4-Line Serial Interface 8 | 9 | LCD MODULE PINOUT 10 | 1 gnd 11 | 2 vcc 12 | 3 scl 13 | 4 sda 14 | 5 res 15 | 6 dc 16 | 7 bl 17 | 18 | Use LCDPINS to setup your configuration in your INIT 19 | The backlite pin is not part of this but the PWM% word 20 | will PWM the pin to the set percentage 0..100 21 | 50 12 PWM% --- Set backlite on GP12 to 50% brightness 22 | or rather than creating a port pin constant, just create BACKLITE 23 | : BACKLITE ( % -- ) 12 PWM% ; 24 | 25 | CHANGELOG: 26 | 211202 Removed pin constants and added LCDPINS 27 | } 28 | 29 | $04050203 variable ~lcdpins 30 | : *lcdclk ~lcdpins C@ ; 31 | : *lcddat ~lcdpins 1+ C@ ; 32 | : *lcddc ~lcdpins 2+ C@ ; 33 | : *lcdres ~lcdpins 3 + C@ ; 34 | 35 | --- with one lone set pins used by LCD (each byte is a pin) 36 | : LCDPINS ( res.dc.dat.clk --- ) ~lcdpins ! ; 37 | \ $0B0D0F0E LCDPINS ( res.dc.dat.clk ) 38 | 39 | \ : BACKLITE ( % pin -- ) 100 10000 ROT PWMHZ ; 40 | 41 | 42 | { 43 | !!!deprecated!!! 44 | 2 constant *lcddat --- spi data 45 | 3 constant *lcdclk --- spi clock 46 | 4 constant *lcdres --- low is reset 47 | 5 constant *lcddc --- low is command 48 | 31 constant *lcdbl 49 | 50 | --- make some fast I/O constants 51 | *lcdclk bit constant &lcdclk 52 | *lcddat bit constant &lcddat 53 | --- bash out SPI bits as fast as possible (needs asm) 54 | : LCDBITS ( dat bits -- ) 55 | 0 DO 56 | ROL 57 | --- optimized bit-basher for speed 58 | &lcdclk IOCLR SIO! 59 | &lcddat OVER 1 AND IF IOSET ELSE IOCLR THEN SIO! 60 | &lcdclk IOSET SIO! 61 | LOOP DROP 62 | ; 63 | } 64 | 65 | : LCDBITS ( data bits -- ) 66 | *lcdclk bit -ROT *lcddat bit -ROT ( clk dat data bits ) 67 | 0 DO ( clk dat data ) 68 | ROL 69 | --- optimized bit-basher for speed 70 | 2 PICK IOCLR SIO! 71 | DUP 1 AND IF OVER IOSET ELSE OVER IOCLR THEN SIO! 72 | 2 PICK IOSET SIO! 73 | LOOP DROP 2DROP 74 | ; 75 | 76 | : LCDWRL 32 LCDBITS ; 77 | : LCDWRD ( dat16 -- ) 16 << 16 LCDBITS ; 78 | : LCDWRB 24 << 8 LCDBITS ; 79 | : LCDCMD *lcddc LOW LCDWRB *lcddc HIGH ; 80 | : LCDRST *lcdclk HIGH *lcdres LOW 20 us *lcdres HIGH ; 81 | 82 | ( LCD COMMANDS ) 83 | 84 | : -NOP 0 LCDCMD ; 85 | : -RES 1 LCDCMD ; 86 | : -WAKE $11 LCDCMD ; 87 | : -NORM $13 LCDCMD ; \ 9.1.14 NORON (13h): Normal Display Mode On 88 | 89 | --- note: I swapped these around since they worked differntly to the datasheet 90 | : -NON $21 LCDCMD ; 91 | : -INV $20 LCDCMD ; \ 9.1.16 INVON (21h): Display Inversion On 92 | 93 | : -OFF $28 LCDCMD ; 94 | : -ON $29 LCDCMD ; \ 9.1.19 DISPON (29h): Display On 95 | 96 | : -CA $2A LCDCMD ; \ 9.1.20 CASET (2Ah): Column Address Set 97 | : -RA $2B LCDCMD ; \ 9.1.21 RASET (2Bh): Row Address Set 98 | : -MW $2C LCDCMD ; \ 9.1.22 RAMWR (2Ch): Memory Write 99 | 100 | \ : -COLMOD $3A LCDCMD LCDDAT ; 101 | pub -CONT $3C LCDCMD ; \ 9.1.33 WRMEMC (3Ch): Write Memory Continue 102 | 103 | \ : -BRIGHT $53 LCDCMD $2C LCDWRB $51 LCDCMD LCDWRB ; 104 | : -ENHANCE $55 LCDCMD $B2 LCDWRB ; 105 | 106 | 107 | CREATE initbl 108 | $36 C, 1 C, $60 C, \ 9.1.28 MADCTL (36h): Memory Data Access Control (rotate - pins on left) 109 | $3A C, 1 C, $05 C, \ 9.1.32 COLMOD (3Ah): Pixel Format - 16-bit/pixel 110 | $B2 C, 5 C, $0C C, $0C C, $00 C, $33 C, $33 C, \ 9.2.3 PORCTRL (B2h): Porch Setting 111 | $B7 C, 1 C, $35 C, \ 9.2.6 GCTRL (B7h): Gate Control (def = $35 ) 112 | $BB C, 1 C, $19 C, \ 9.2.9 VCOMS (BBh): VCOM Setting 113 | $C0 C, 1 C, $2C C, \ 9.2.12 LCMCTRL (C0h): LCM Control (def) 114 | $C2 C, 1 C, $01 C, 115 | $C3 C, 1 C, $12 C, 116 | $C4 C, 1 C, $20 C, 117 | $C6 C, 1 C, $0F C, 118 | $D0 C, 2 C, $A4 C, $A1 C, 119 | $E0 C, 14 C, $D0 C, $04 C, $0D C, $11 C, $13 C, $2B C, $3F C, $54 C, $4C C, $18 C, $0D C, $0B C, $1F C, $23 C, 120 | $E1 C, 14 C, $D0 C, $04 c, $0C C, $11 C, $13 C, $2C C, $3F C, $44 C, $51 C, $2F C, $1F C, $1F C, $20 C, $23 C, 121 | 0 C, 122 | 123 | pub !LCD 124 | *lcdclk HIGH *lcddat LOW 125 | LCDRST 10 ms 126 | -WAKE 5 ms 127 | initbl BEGIN DUP C@ WHILE C@++ LCDCMD C@++ 0 DO C@++ LCDWRB LOOP REPEAT DROP 128 | -NON 129 | -ON 130 | ; 131 | 132 | pub LCDXYS ( x y xend yend--- ) 133 | -RA ROT LCDWRD LCDWRD 134 | -CA SWAP LCDWRD LCDWRD 135 | -MW 136 | ; 137 | pub LCDHOME !LCD 0 0 239 239 LCDXYS ; 138 | 139 | --- PIXEL FORMAT: rrrr rggg gggb bbbb 140 | 141 | --- write to LCD screen from memory 142 | pub LCDWRS ( src -- ) LCDHOME 240 240 * 2* BOUNDS DO I H@ LCDWRD 2 +LOOP ; 143 | 144 | --- fill and clear the screen 145 | pub LCDFILL -OFF 0 0 239 239 lcdxys 240 240 * 0 DO DUP LCDWRD LOOP DROP -ON ; 146 | pub LCDCLS 0 LCDFILL ; 147 | 148 | ( *** BMP VIEWER *** ) 149 | 150 | \ 1024 BUFFER: palette 151 | SDBUF $400 + constant palette --- use upper 1k of SDBUF for temp palette 152 | 153 | 0 variable xres 154 | 0 variable yres 155 | 0 variable bpp 156 | 157 | $FFFF variable pixand 158 | 0 variable pixor 159 | 0 variable pixxor 160 | 161 | pub LCDPIX pixxor @ XOR pixand @ AND DUP IF pixor @ OR THEN LCDWRD ; 162 | 163 | pub VIEW240 164 | LCDHOME 165 | $0A SDH@ 240 240 * 2* + --- start from end 166 | 240 0 DO 480 - --- read from start of line 167 | 240 0 DO dup SDH@ LCDPIX 2+ LOOP 168 | 480 - --- previous line 169 | LOOP 170 | DROP 171 | ; 172 | pri ?PALETTE 173 | bpp C@ 8 = 174 | IF palette 14 SDH@ 14 + 1024 BOUNDS 175 | DO I SDH@ OVER H! 2+ 2 +LOOP DROP 176 | THEN 177 | ; 178 | pub VIEW ( -- ) 179 | --- check if BM header and proceed 180 | 0 SDH@ $4D42 = 0EXIT 181 | --- read resolution and colors 182 | 18 SDH@ xres ! 22 SDH@ yres ! 28 SDC@ bpp C! 183 | --- check if it is optimized for this 240x240 184 | xres @ 240 = yres @ 240 = AND bpp C@ 16 = AND 185 | IF VIEW240 EXIT THEN 186 | --- otherwise assume it is 256 color bmp 640xYSIZE 187 | ?PALETTE LCDCLS LCDHOME 188 | --- point to the end of the pixel array 189 | 10 SDH@ xres @ yres @ * + 1- 190 | --- up to 240 lines 191 | yres @ 2/ 0 DO 192 | --- Read every 2nd pixel from start of line up to 480 pixels (clipped) 193 | DUP xres @ 2- - 480 BOUNDS 194 | DO 195 | I SDC@ 196 | --- lookup 24-bit color from 8-bit color index 197 | 2* 2* palette + 198 | --- read the 3 RGB 8-bit colors from the palette 199 | C@++ SWAP C@++ SWAP C@ 200 | --- and mix down to 16-bit RGB565 201 | 3 >> 11 << --- RED 202 | SWAP 2 >> 5 << OR --- GRN 203 | SWAP 3 >> OR --- BLU 204 | LCDPIX --- send pixel 205 | 2 +LOOP 206 | xres @ 2* - 207 | LOOP 208 | DROP 209 | ; 210 | 211 | 212 | 213 | ( *** LCD TEXT *** ) 214 | 215 | --- LCD PIXEL FORMAT: rrrr rggg gggb bbbb 216 | 217 | --- convert ANSI 0 to 7 colors to a 16-bit color 218 | create lcdcols 219 | 0 , $F800 , $07E0 , $FFE0 , $001F , $F81F , $07FF , $FFFF , 220 | 221 | --- convert ANSI color to 16-bit 222 | pri LCDCOL DUP 8 < IF 2* 2* lcdcols + @ THEN ; 223 | 224 | 0 variable lcdx --- text x 225 | 0 variable lcdy --- text y 226 | 227 | pri LCDXY lcdy ! lcdx ! ; 228 | pri LCDHOME1 0 0 LCDXY ; 229 | 230 | 231 | 1 variable lcdx* --- text font x scale 232 | 1 variable lcdy* --- text font y scale 233 | 1 variable lcdcs --- text char space 234 | 2 variable lcdls --- text line space 235 | 236 | pri xsp lcdx* C@ 4 << lcdcs C@ + ; 237 | 238 | pub LCD* ( x y -- ) lcdy* C! lcdx* C! ; 239 | 240 | pri LCDCR 241 | lcdx C~ 242 | lcdy* C@ 5 << lcdls C@ + DUP lcdy +! 243 | lcdy @ + 239 > IF lcdy ~ THEN 244 | \ lcdy @ 240 lcdls C@ lcdy* C@ * - > IF lcdy ~ THEN 245 | ; 246 | 247 | pri wrpix 248 | if PEN@ else PAPER@ then 249 | LCDCOL LCDPIX \ lcdwrd 250 | ; 251 | pri dopix 252 | lcdx* C@ 0 DO DUP 1 AND wrpix LOOP 253 | ; 254 | 255 | { 256 | Display and scale a character from the font table 257 | This uses the raw 16x32 Parallax Propeller Font which interleaves bits 258 | to do: convert this to native format 259 | } 260 | pub LCDCH ( ch -- ) 261 | --- position character 262 | lcdx C@ dup lcdx* C@ 4 << 1- + 263 | lcdy C@ SWAP OVER lcdy* C@ 5 << 1- + LCDXYS 264 | DUP 1 AND SWAP 2/ 7 << FONT16X32 + 128 bounds 265 | do 266 | lcdy* C@ 0 DO 267 | J @ OVER IF 2/ THEN 268 | 16 0 do dopix 2/ 2/ loop DROP 269 | LOOP 270 | 4 +loop DROP 271 | xsp lcdx +! 272 | lcdx @ 239 xsp - > IF LCDCR THEN 273 | ; 274 | 275 | { 276 | 16x32 font - max 13 chars x 7 lines 277 | 278 | } 279 | 0 variable ~lcdch --- backup of emit code 280 | pub LCDEMIT ( ch -- ) 281 | --- skip ANSI sequences from ESC to m 282 | 283 | ~lcdch C@ $1B = IF [CHAR] m = IF ~lcdch C~ THEN EXIT THEN 284 | DUP ~lcdch C! 285 | --- check control or printing char 286 | DUP $1F > 287 | IF LCDCH 288 | ELSE CASE 289 | $08 OF xsp negate lcdx +! ENDOF 290 | $0D OF lcdx C~ ENDOF 291 | $0A OF LCDCR ENDOF 292 | $0B OF LCDHOME1 ENDOF 293 | $0C OF !LCD LCDCLS LCDHOME1 ENDOF 294 | $09 OF 4 0 DO $20 LCDCH LOOP ENDOF 295 | $1B OF ENDOF 296 | ~lcdch C@ LCDCH 297 | ENDCASE 298 | THEN 299 | ; 300 | --- Make the LCD the character output device 301 | pub LCD ['] LCDEMIT EMIT! ( 13 tw C! ) ; 302 | 303 | compiletoram 304 | 305 | 306 | *END* 307 | -------------------------------------------------------------------------------- /rp2040/mecrisp/Forth/TACHYON.FTH: -------------------------------------------------------------------------------- 1 | compiletoflash 2 | \ ############################################################# 3 | \ ############################################################# 4 | \ TACHYON EXTENSIONS for Mecrisp RP2040 5 | \ Peter Jakacki 2021 6 | \ ############################################################# 7 | \ ############################################################# 8 | 9 | 2205102030 constant tme 10 | : *TACHYON* ." TACHYON Mecrisp extensions " tme U. ." - Peter Jakacki" ; 11 | 12 | ( changelogs at end of file ) 13 | 14 | : TME? ( stamp -- ) tme U> IF ." Needs newer version of Tachyon " QUIT THEN ; 15 | 16 | \ simple block comment 17 | : { BEGIN KEY $7D = UNTIL ; immediate \ } 18 | 19 | 20 | ( Some basic Tachyon compatible extensions ) 21 | 22 | 23 | \ pre-emptive colon definiton (an immediate) 24 | : pre ['] : execute ['] IMMEDIATE execute ; 25 | \ public colon definition (normal) 26 | pre pub ['] : execute ; 27 | \ private colon definition (can be hidden later) 28 | pre pri ['] : execute ; 29 | \ use --- as a clear separator and comment (also same as Tachyon cr response: 12 . --- 12) 30 | pre --- ['] \ execute ; 31 | 32 | pre } ; 33 | pub BOUNDS OVER + SWAP ; 34 | pub >> rshift ; 35 | pub << lshift ; 36 | 37 | --- compile or stack literal value 38 | pri LIT state C@ IF literal, THEN ; 39 | pri ASCLIT ( mask -- ) 0 token BOUNDS DO 8 << OVER I C@ AND + LOOP NIP LIT ; 40 | --- use instead of awkward [CHAR] and CHAR 41 | pre ` $FF ASCLIT ; 42 | --- control char literal 43 | pre ^ $1F ASCLIT ; 44 | 45 | --- IP NOTATION: IP# 192.168.0.101 .L --- C0A80065 46 | pre IP# 47 | token 0 0 2SWAP OVER + SWAP 48 | DO I C@ DIGIT IF SWAP 10 * + ELSE SWAP 8 << + 0 THEN LOOP 49 | SWAP 8 << + 50 | ; 51 | 52 | --- Tachyon standard CR is CR only whereas CRLF is CR+LF combo 53 | pub CR $0D EMIT ; 54 | pub CRLF CR $0A EMIT ; 55 | 56 | ( CLEARTYPE WORDS ) 57 | 58 | --- cleartype words are aliases that stand out from single Forth symbols in source code 59 | 60 | pub PRINT . ; 61 | pre PRINT" ['] ." execute ; 62 | 63 | ( create vector table ) 64 | 65 | : VECTORS ( cnt -- ) ( index -- adr ) 66 | SWAP CELLS + 68 | ; 69 | 70 | : .RSTACK 71 | CRLF PRINT" RETURN STACK: " HEX 72 | RP@ 32 OVER + SWAP DO I @ . SPACE 4 +LOOP CRLF 73 | ; 74 | 75 | ( simple fault handler - resets rather than repeats ) 76 | 77 | : FAULT PRINT" !address fault! " .RSTACK RESET ; 78 | : !FAULT ['] FAULT irq-fault ! ; 79 | !FAULT 80 | 81 | ( hook control ) 82 | 83 | : QUIT! hook-quit ! ; 84 | : QUIT: ' QUIT! QUIT ; 85 | 86 | : EMIT! hook-emit ! ; 87 | : KEY! hook-key ! ; 88 | : !SERKEY ['] serial-key KEY! ['] serial-key? hook-key? ! ; 89 | : CONOUT ['] serial-emit EMIT! ; 90 | : CON CONOUT !SERKEY ; 91 | 92 | ' serial-emit variable save-emit 93 | --- muted output 94 | : MUTED hook-emit @ save-emit ! ['] DROP EMIT! ; 95 | : UNMUTED save-emit @ EMIT! ; 96 | 97 | \ Init Stack Pointer 98 | : !SP SP@ DEPTH 1- CELLS + SP! ; 99 | 100 | ( *** TIMING TOOLS *** ) 101 | 102 | 0 variable ~laps 4 allot 103 | : LAP cycles ~laps @ ~laps CELL+ ! ~laps ! ; 104 | : LAP@ 105 | ~laps @ ~laps CELL+ @ - 106 | LAP LAP ~laps @ ~laps CELL+ @ - - 107 | ; 108 | 109 | ( Terminal source code loader mode ) 110 | 111 | 112 | 113 | 0 variable ~p 114 | \ TO DO: does not work in compiletoflash mode 115 | : ?REPORT 116 | (latest) @ ~p @ <> 117 | IF CRLF PRINT" --- " 118 | (latest) @ DUP ~p ! 119 | 6 + DUP 1+ SWAP C@ TYPE 120 | THEN 121 | ; 122 | 123 | : EMITS ( ch cnt -- ) 0 do dup emit loop drop ; 124 | 125 | : EMITD ( 0...9 -- ) 9 MIN $30 + EMIT ; 126 | 127 | : TAB 9 EMIT ; 128 | : TABS 9 SWAP EMITS ; 129 | : INDENT CR TABS ; 130 | 131 | 0 variable @org \ data space pointer 132 | 0 variable ~m 133 | 0 variable ~o 134 | : mecrisp HERE ~m ! @org @ ~o ! !SP CRLF LAP ; 135 | 136 | 137 | ( CONSOLE CONTROL KEYS ) 138 | 139 | --- create a table of vectors for the 32 control keys 140 | 32 VECTORS ctrls 141 | --- default is do nothing 142 | 0 ctrls 128 0 FILL 143 | 144 | --- Set vector of control key n with cfa 145 | : CTRL! ( cfa n -- ) ctrls ! ; 146 | 147 | \ USER DEBUG HOOK 148 | \ 0 variable 'debug 149 | \ : DEBUG 'debug @ ?DUP IF execute THEN $0D ; 150 | 151 | 0 variable ~k 152 | \ re-execute last entry 153 | : REX ~k C@ rp@ 16 + ! ; 154 | 155 | \ discard and reset the CLI 156 | : DISCARD 2DUP $20 FILL $0D EMIT $2D 80 EMITS ; 157 | 158 | \ setup some control keys so far 159 | ' RESET ^ C CTRL! 160 | ' REX ^ X CTRL! 161 | ' DISCARD $1B CTRL! 162 | 163 | 164 | \ create a background polling method while waiting for input 165 | 166 | 16 buffer: ~polls 167 | 168 | : !POLLS ~polls 16 0 FILL ; 169 | !POLLS 170 | : @POLL ( index -- addr ) CELLS ~polls + ; 171 | : POLLS 172 | 4 0 DO I @POLL @ ?DUP IF EXECUTE THEN LOOP 173 | ; 174 | : +POLL ( cfa -- ) 175 | 4 0 DO I @POLL @ 0= IF DUP I @POLL ! LEAVE THEN LOOP DROP 176 | ; 177 | { 178 | R00# 0 variable x1 --- 179 | R00# : POLL1 x1 ++ ; --- 180 | R00# ' poll1 +poll --- 181 | R00# x1 @ . --- 2850947 182 | R00# X1 @ . --- 5563090 183 | } 184 | 185 | 186 | 187 | : QKEY 188 | BEGIN serial-key? 0= WHILE POLLS REPEAT 189 | serial-key DUP $20 < 190 | IF DUP ctrls @ ?DUP IF NIP EXECUTE $0D THEN THEN 191 | ; 192 | 193 | 0 variable ~defers ( note: just a single deferred execution vector for now) 194 | 0 variable ~depth 195 | --- execute deferred words at the end of the line 196 | : defers 197 | ~defers @ ?DUP IF 0 ~defers ! execute THEN 198 | 199 | ; 200 | --- defer the exection of this word until the end of the line 201 | : -> R> ~defers ! DEPTH ~depth C! ; 202 | 203 | --- Print radix base prompt symbol 204 | : .base 205 | base @ \ change prompt to indicate base 206 | case \ show base. 207 | #10 of ." #" endof \ # decimal 208 | #16 of ." $" endof \ $ hex 209 | #2 of ." %" endof \ % binary 210 | ." ?" \ other base 211 | endcase 212 | ; 213 | : .depth depth 10 /MOD EMITD EMITD ; 214 | : .mode compiletoram? if ." R" else ." F" then ; 215 | 216 | --- placeholder for compex magic - maybe 217 | : COMPEX 218 | 219 | ; 220 | 221 | ' query variable ~query 222 | 223 | ( USER PROMPT ) 224 | 225 | : TACHYON ( -- ) 226 | $BF00 ['] QUIT 4 + H! \ DISABLE STACK RESET 227 | !FAULT \ Simple report and reset handler 228 | (latest) @ ~p ! \ dictionary match register 229 | begin 230 | depth 0< IF !SP THEN \ correct underflow 231 | ~m @ \ user or source mode? 232 | IF 233 | MUTED QUERY \ don't echo input 234 | UNMUTED ?REPORT \ but report new defs 235 | SPACE INTERPRET \ and interpret/compile 236 | ELSE \ else console mode 237 | CRLF .mode .depth .base space 238 | hook-key @ ['] serial-key = 239 | IF 240 | ['] QKEY KEY! \ Use control key manager 241 | ~query @ execute PRINT" --- " \ get input and --- separate from response 242 | !SERKEY \ switch back to standard key input 243 | ELSE 244 | ~query @ execute PRINT" --- " \ get input and --- separate from response 245 | THEN 246 | current-source @ ~k ! \ remember position for ^X re-execute 247 | interpret \ interpret/compile 248 | defers 249 | THEN 250 | again 251 | ; 252 | 253 | MECRISP 254 | QUIT: TACHYON 255 | 256 | 257 | 258 | 259 | 260 | 261 | ( ************************************************************************ ) 262 | 263 | 264 | ( data space variables - unitialized ) 265 | 266 | $20030000 constant DATA \ base for all data and buffers 267 | 268 | \ 0 variable @org \ data space pointer 269 | 270 | : org @org ! ; 271 | : org@ @org @ DATA + ; 272 | ( reserve bytes but do not assign a name ) 273 | pre res @org +! ['] \ execute ; 274 | pri (bytes) org@ ['] constant execute @org +! ; 275 | pre bytes (bytes) ; 276 | pre byte 1 (bytes) ; 277 | : alorg 1- @org @ OVER + SWAP NOT AND org ; 278 | pri (longs) 4 alorg 2* 2* (bytes) ; 279 | pre longs (longs) ; 280 | pre long 1 (longs) ; 281 | 282 | 283 | ( some Tachyon like utility words ) 284 | 285 | 286 | : shift ( n +/-cnt -- ) DUP 0< IF NEGATE >> ELSE << THEN ; 287 | --- convert bit to mask 288 | : |< ( b -- m ) 1 SWAP << ; 289 | : bit ( bit -- mask ) 1 SWAP << ; 290 | : >| ( mask -- bit ) 0 BEGIN OVER 1 AND 0= WHILE SWAP 2/ SWAP 1+ REPEAT NIP ; 291 | pri BITS ( n b -- n2 ) |< 1- AND ; 292 | 293 | : ANDN -1 XOR AND ; 294 | 295 | --- 296 | : >N 4 BITS ; 297 | : >B 8 BITS ; 298 | : >W 16 << 16 >> ; 299 | : W>B ( w -- lb hb ) DUP 8 BITS SWAP 8 >> ; 300 | : L>W ( long -- lw hw ) DUP 16 BITS SWAP 16 >> ; 301 | 302 | : HH! SWAP 16 << OVER @ 16 << 16 >> OR SWAP ! ; 303 | : LH! SWAP OVER @ 16 >> 16 << OR SWAP ! ; 304 | : HH@ @ 16 >> ; 305 | 306 | --- clear and set long 307 | : ~ 0 SWAP ! ; 308 | : ~~ -1 SWAP ! ; 309 | --- clear and set byte 310 | : C~ ( addr -- ) 0 SWAP C! ; 311 | : C~~ ( addr -- ) -1 SWAP C! ; 312 | --- increment long 313 | : ++ 1 SWAP +! ; 314 | : -- -1 SWAP +! ; 315 | --- increment byte 316 | : C++ 1 SWAP C+! ; 317 | --- increment B (TOS+1) 318 | : B++ ( b a -- b+1 a ) SWAP 1+ SWAP ; 319 | 320 | : C@++ ( adr -- adr+1 n ) DUP 1+ SWAP C@ ; 321 | 322 | : 3RD 2 PICK ; 323 | : 4TH 3 PICK ; 324 | 325 | : ERASE 0 FILL ; 326 | 327 | : WITHIN ( n min max -- f ) 2 PICK >= ROT ROT >= AND ; 328 | : LIMIT ( n min max -- n ) >R MAX R> MIN ; 329 | : U/ 1 SWAP U*/MOD NIP ; 330 | : // MOD ; 331 | 332 | --- HOURS MINS SECS 333 | : HMS ( #xxyyzz -- zz yy xx ) 100 U/MOD 100 U/MOD ; 334 | 335 | 336 | ( unit multipliers ) 337 | 338 | --- MEGA multiplier 339 | : KB 10 << ; 340 | : MB 20 << ; 341 | : M 1000000 * ; 342 | \ seconds 343 | : s 1000 * ms ; 344 | 345 | 1 constant ON 346 | 0 constant OFF 347 | 1000 constant 1K 348 | 349 | 350 | 351 | 352 | ( simple conditional EXIT words ) 353 | 354 | \ Exit if zero 355 | : 0EXIT 0= IF R> DROP THEN ; 356 | \ Exit if true 357 | : ?EXIT IF R> DROP THEN ; 358 | 359 | 360 | 361 | \ --- UNALIGNED LONGS --- 362 | 0 variable ~u 363 | : U@ ~u 4 MOVE ~u @ ; 364 | : U! SWAP ~u ! ~u SWAP 4 MOVE ; 365 | 366 | ( stack globals ) 367 | 368 | long ~a 369 | : ant! ~a ! ; 370 | : ant ~a @ ; 371 | long ~b 372 | : bat! ~b ! ; 373 | : bat ~b @ ; 374 | long ~c 375 | : cat! ~c ! ; 376 | : cat ~c @ ; 377 | long ~d 378 | : dog! ~d ! ; 379 | : dog ~d @ ; 380 | long ~e 381 | : emu! ~e ! ; 382 | : emu ~e @ ; 383 | long ~f 384 | : fox! ~f ! ; 385 | : fox ~f @ ; 386 | { 387 | 8 longs vars 388 | : @var 2 << vars + ; 389 | : ant 0 @var @ ; 390 | : bat 1 @var @ ; 391 | : cat 2 @var @ ; 392 | : dog 3 @var @ ; 393 | : elk 4 @var @ ; 394 | : fox 5 @var @ ; 395 | : gal 6 @var @ ; 396 | : hen 7 @var @ ; 397 | 398 | } 399 | 400 | ( bit on byte flags ops ) 401 | : SET ( mask adr -- ) DUP C@ ROT OR SWAP C! ; 402 | : CLR ( mask adr -- ) DUP C@ ROT NOT AND SWAP C! ; 403 | : SET? C@ AND ; 404 | 405 | ( more useful bit manipulation in longs ) 406 | pub SETB ( bit adr -- ) DUP @ ROT BIT OR SWAP ! ; 407 | pub CLRB ( bit adr -- ) DUP @ ROT BIT NOT AND SWAP ! ; 408 | pub TOGB ( bit adr -- ) DUP @ ROT BIT XOR SWAP ! ; 409 | pub BIT? ( bit adr -- f ) @ SWAP BIT AND ; 410 | 411 | ( null terminated strings ) 412 | 413 | --- store nullterm string 414 | pub $! ( src dst -- ) BEGIN OVER C@ OVER C! OVER C@ WHILE b++ 1+ REPEAT 2DROP ; 415 | --- Find length of nullterm string 416 | pub LEN$ ( str -- len ) 0 SWAP BEGIN DUP C@ WHILE B++ 1+ REPEAT DROP ; 417 | --- print nullterm string 418 | pub PRINT$ ( str -- ) BEGIN DUP C@ WHILE DUP C@ EMIT 1+ REPEAT DROP ; 419 | --- convert lower-case to upper-case 420 | pub a>A ( ch -- ch ) DUP $60 > OVER $7B < AND IF $20 - THEN ; 421 | 422 | 423 | 424 | : CON? hook-emit @ ['] serial-emit = ; 425 | 426 | 427 | 428 | ( *** ANSI *** ) 429 | 430 | 7 variable ~pen 431 | 0 variable ~paper 432 | pub PEN@ ~pen @ ; 433 | pub PAPER@ ~paper @ ; 434 | 435 | 436 | --- ANSI COLORS 437 | 0 constant black 438 | 1 constant red 439 | 2 constant green 440 | 3 constant yellow 441 | 4 constant blue 442 | 5 constant magenta 443 | 6 constant cyan 444 | 7 constant white 445 | 446 | 447 | pub ESC ( ch -- ) $1B EMIT EMIT ; 448 | --- ESC [ 449 | pub ESC[ ` [ ESC ; 450 | --- ESC [ ch 451 | pri CSI ( ch -- ) ESC[ EMIT ; 452 | pub HOME ` H CSI ; 453 | 454 | pri COL ( col fg/bg -- ) CSI ` 0 + EMIT ` m EMIT ; 455 | pub PEN! ( col -- ) dup ~pen ! 7 AND ` 3 COL ; --- 1B 5B 33 m 456 | pub PEN ( col -- ) DUP ~pen C@ <> IF PEN! ELSE DROP THEN ; 457 | 458 | pub PAPER! ( col -- ) dup ~paper ! ` 4 COL ; 459 | pub PAPER ( col -- ) DUP ~paper C@ <> IF PAPER! ELSE DROP THEN ; 460 | 461 | 462 | pri .PAR SWAP 0 <# #S #> TYPE EMIT ; 463 | pri CUR ( cmd n -- ) ESC[ SWAP .PAR ; 464 | pub XY ( x y -- ) ` ; SWAP CUR ` H .PAR ; 465 | 466 | 467 | --- Erase the screen from the current location 468 | pub ERSCN ` 2 CSI ` J EMIT ; 469 | --- Erase the current line 470 | pub ERLINE ` 2 CSI ` K EMIT ; 471 | pub CLS ERSCN HOME ; \ $0C EMIT ; 472 | 473 | pri asw IF ` h ELSE ` l THEN EMIT ; 474 | pub CURSOR ( on/off -- ) ` ? CSI ." 25" asw ; 475 | 476 | --- 0 plain 1 bold 2 dim 3 rev 4 uline 477 | pri ATR ( ch -- ) CSI ` m EMIT ; 478 | \ pub PLAIN ` 0 ATR white ~pen ! ~paper ~ ; 479 | pub PLAIN white ~pen ! ~paper ~ ` 0 ATR ; 480 | 481 | pub REVERSE ` 7 ATR ; 482 | pub BOLD ` 1 ATR ; 483 | pub UL ` 4 ATR ; 484 | pub BLINK ` 5 ATR ; 485 | 486 | pub WRAP ( on/off -- ) ` ? CSI ` 7 EMIT asw ; 487 | 488 | \ pub MARGINS ( top bottom -- ) ESC[ SWAP ` : .PAR ` r .PAR ; 489 | 490 | \ E2 96 88 491 | pub UTF8 ( code -- ) $E2 EMIT DUP 6 >> $80 + EMIT $3F AND $80 + EMIT ; 492 | pub EMOJI ( ch -- ) $F0 EMIT $9F EMIT DUP 6 >> $98 + EMIT $3F AND $80 + EMIT ; 493 | 494 | 495 | 496 | 497 | 498 | ( *** PRINT HEX & BINARY *** ) 499 | 500 | 501 | : .HEX ( n cnt -- ) HEX <# 0 DO # LOOP #> TYPE DECIMAL ; 502 | : .B 0 2 .HEX ; 503 | : .H 0 4 .HEX ; 504 | : .L 0 8 .HEX ; 505 | : .BIN 32 0 DO I IF I 3 AND 0= IF $5F EMIT THEN THEN ROL DUP 1 AND EMITD LOOP DROP ; 506 | : .BYTE ` $ EMIT .B ; 507 | 508 | ( *** PRINT DECIMAL NUMBER *** ) 509 | 510 | $20 variable ~z --- leading character 511 | 512 | \ unsigned double right justify to cnt places with leading spaces as default 513 | : D.R ( d. cnt -- ) 514 | <# 0 DO 2DUP OR IF # ELSE I 0= IF $30 ELSE ~z C@ THEN HOLD THEN LOOP #> TYPE 515 | --- reset default leading character 516 | $20 ~z C! 517 | ; 518 | \ unsigned right justify to cnt places with leading spaces as default 519 | : U.R ( u cnt -- ) 0 SWAP D.R ; 520 | \ use leading zeros for next print 521 | : Z $30 ~z C! ; 522 | 523 | \ print wihh commas in western decimal format 524 | : D.DEC DECIMAL <# BEGIN 2DUP 999. D> WHILE # # # $2C HOLD REPEAT #S #> TYPE ; 525 | : .DEC 0 D.DEC ; 526 | : .DEC2 DECIMAL 0 <# # # #> TYPE ; 527 | : .DEC4 DECIMAL 0 <# # # # # #> TYPE ; 528 | 529 | 530 | 0 VARIABLE ~dp 531 | \ Print comma decimal number over cnt places including commas used 532 | : D.DECS ( d. cnt -- ) 533 | ~dp 1+ C! ~dp C~ DECIMAL 534 | <# 2DUP OR 535 | IF 536 | BEGIN 2DUP 999. D> WHILE # # # $2C HOLD 4 ~dp C+! REPEAT 537 | BEGIN 2DUP OR WHILE # ~dp C++ REPEAT 538 | ELSE # ~dp C++ 539 | THEN 540 | #> 541 | ~dp 1+ C@ ~dp C@ - SPACES TYPE ; 542 | : .DECS ( n cnt -- ) 0 SWAP D.DECS ; 543 | 544 | \ print n to decimal places dp to fit width w 545 | pub .DP ( n w dp -- ) ROT 0 <# ROT 0 DO # LOOP ` . HOLD #S #> ROT OVER - SPACES TYPE ; 546 | 547 | 548 | 549 | long ~sp 550 | pub SPINNER ~sp C@ 3 AND s" |/-\" DROP + C@ EMIT 8 EMIT ~sp C++ ; 551 | 552 | 553 | ( TIMING REPORTING TOOLS ) 554 | 555 | : .LAP LAP@ .DEC PRINT" us" ; 556 | : .LAPS ( n -- ) LAP@ 1000 ROT */ .DEC PRINT" ns" ; 557 | 558 | : *END* 559 | lap 560 | CRLF PRINT" End of load - " 561 | HERE ~m @ - PRINT 562 | PRINT" code bytes and " 563 | org@ 16 BITS ~o @ - PRINT PRINT" data bytes used in " 564 | .LAP 565 | CRLF PRINT" !!! Type SAVE to backup to Flash as default" 566 | !SP 0 ~m ! 567 | ; 568 | 569 | 570 | 571 | ( ANY ADDREESS DUMP ) 572 | 573 | \ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ 574 | \ Emit character but substiture if non-printing. 575 | : AEMIT ( ch sub --) SWAP DUP $20 < OVER $7E > OR IF DROP ELSE NIP THEN EMIT ; 576 | 577 | ( DEVICE MEMORY OPERATORS ) 578 | 579 | 580 | ' @ variable ~dm 581 | ' H@ variable ~dmh 582 | ' C@ variable ~dmc 583 | 584 | ( DUMP MEMORY OPERATORS ) 585 | : DMC@ ~dmc @ EXECUTE ; 586 | : DMH@ ~dmh @ EXECUTE ; 587 | : DM@ ~dm @ EXECUTE ; 588 | 589 | ( @ H@ C@ -- ) ( SET DUMP MEMORY OPERATORS ) 590 | : DUMP! ~dm ! ~dmh ! ~dmc ! ; 591 | : MEM ['] C@ ['] H@ ['] @ DUMP! ; 592 | : PRINT: PRINT" : " ; 593 | : .ADDR CRLF .L PRINT: ; 594 | : (DUMPA) BOUNDS DO I DMC@ $20 AEMIT LOOP ; 595 | : .BYTES BOUNDS DO I DMC@ .B SPACE LOOP ; 596 | : DUMP 597 | ~dmc @ 0= IF MEM THEN 598 | BOUNDS DO 599 | I .ADDR 600 | I 8 .BYTES SPACE I 8 + 8 .BYTES 601 | ." | " 602 | I 16 (DUMPA) 603 | ." | " 604 | 16 +LOOP 605 | MEM 606 | ; 607 | : DUMPA BOUNDS DO I .ADDR I 64 (DUMPA) 64 +LOOP MEM ; 608 | : DUMPAW BOUNDS DO I .ADDR I 128 (DUMPA) 128 +LOOP MEM ; 609 | : DUMPL 610 | BOUNDS DO I .ADDR 611 | I 32 BOUNDS DO I DM@ .L SPACE 4 +LOOP 612 | 32 +LOOP MEM ; 613 | : DUMPH 614 | BOUNDS DO I .ADDR 615 | I 32 BOUNDS DO I DMH@ .H SPACE 2 +LOOP 616 | 32 +LOOP MEM ; 617 | 618 | \ QUICK DUMP 619 | : QD $40 DUMP ; 620 | 621 | { 622 | 623 | : MAP BOUNDS DO I $7FFF AND 0= IF I .ADDR THEN 0 I 1024 BOUNDS DO I C@ + LOOP .B SPACE 1024 +LOOP ; 624 | 625 | } 626 | 627 | 628 | ( BETTER STACK LIST ) 629 | 630 | : .S DEPTH ?DUP 631 | IF 64 UMIN 632 | 0 DO CRLF I PRINT PRINT: 633 | I PICK >B $20 AEMIT SPACE 634 | I PICK PRINT" $" .L 3 SPACES I PICK .DEC LOOP 635 | ELSE PRINT" EMPTY " 636 | THEN 637 | ; 638 | 639 | 640 | : >NFA 1- BEGIN 2- DUP C@ $20 < UNTIL 1+ ; 641 | : >LFA >NFA 6 - ; 642 | 643 | : NFA' ' >NFA ; 644 | 645 | \ RENAME A WORD IN THE DICTIONARY WITH A ANOTHER WORD - MUST MATCH LENGTHS. 646 | \ : RENAME: ' >NFA DUP C@ TOKEN 2 PICK = IF ROT 1+ ROT MOVE ELSE DROP 2DROP THEN ; 647 | 648 | \ rename: words lists 649 | 650 | ( Simple names only dictionary listing ) 651 | { 652 | Use qw to list the last 20 words, or swords for a short names only words listing 653 | or nwords 654 | 655 | } 656 | \ link(4) atr?(2) CNT NAME 657 | 0 variable ~n 658 | 80 variable tw --- default terminal width 659 | 660 | : HIGHLIGHT 661 | plain 662 | DUP 4 + H@ CASE 663 | $40 OF magenta pen ENDOF 664 | 8 OF cyan pen ENDOF 665 | 0 OF plain ENDOF 666 | DUP $10 AND 667 | IF red pen ELSE 668 | green pen THEN 669 | ENDCASE 670 | ; 671 | : nwords ( max -- ) 672 | 0 ~n ! 673 | dictionarystart 674 | BEGIN 675 | OVER 0<> OVER -1 <> AND KEY? 0= AND 676 | WHILE 677 | \ skip hidden words marked with a preceding ~ 678 | \ DUP 7 + DUP C@ $7E = SWAP 1+ C@ $7E <> AND NOT 679 | \ IF 680 | HIGHLIGHT 681 | DUP 4 + H@ $FFFF <> 682 | IF 683 | DUP 6 + DUP 1+ SWAP C@ ( dict name cnt ) 684 | \ wrap before it prints over 80 columns 685 | DUP 1+ ~n +! ~n @ tw C@ > IF CRLF DUP 1+ ~n ! THEN 686 | TYPE SPACE plain 687 | THEN 688 | \ THEN 689 | @ SWAP 1- SWAP 690 | 691 | REPEAT 2DROP 692 | ; 693 | : qw 20 nwords ; 694 | : words -1 nwords ; 695 | 696 | 697 | 698 | 699 | ( ENHAHCE SEE TO DISPLAY HEADER ) 700 | 701 | : .HEAD 702 | CRLF DUP >LFA DUP .L PRINT: @ 703 | $5B EMIT .L ." ] {" 704 | DUP >NFA 2- H@ .H ." } " 705 | >NFA DUP C@ 1+ 706 | BOUNDS DO SPACE I C@ .B LOOP 707 | CRLF PRINT" CODE:" 708 | ; 709 | : SEE >IN C@ ' .HEAD >IN C! SEE ; 710 | : DASM ( CODE -- ) disasm-$ ! seec ; 711 | 712 | 713 | 714 | $2003FFD0 constant @code --- HERE 715 | $2003FFD4 constant @words --- dictionary 716 | 717 | pub FORGET ' ?DUP IF >LFA DUP @ @words ! @code ! ELSE DROP THEN ; 718 | 719 | 720 | 721 | 125000000 constant clkfreq 722 | 723 | 724 | $40008040 constant clksysdiv 725 | : clk! 8 << clksysdiv ! ; 726 | 727 | $40024000 constant xosc 728 | 729 | $40028000 constant pllsys 730 | 731 | 732 | 733 | \ ############################################################# 734 | \ ############################################################# 735 | \ I/O WORDS & NEOPIXEL 736 | \ ############################################################# 737 | \ ############################################################# 738 | 739 | 740 | 741 | 742 | 743 | \ Already configured in core for SIO (Software IO), function 5: 744 | 745 | ( ADDRESS MAP CONSTANTS ) 746 | 747 | $00000000 constant ROM 748 | $10000000 constant XIP 749 | $20000000 constant RAM 750 | $40000000 constant APB 751 | $40014000 constant IO0 752 | $4001c000 constant PADS0 --- 2.19.6.3. Pad Control - User Bank 753 | $4000c000 constant RESETS 754 | $50000000 constant AHB 755 | $E0000000 constant M0 756 | 757 | 758 | $40028000 constant PLLSYS 759 | 0 constant PLLCS 760 | 4 constant PLLPWR 761 | 8 constant PLLDIV 762 | 763 | 764 | 765 | 766 | ( SIO REGISTERS ) 767 | 768 | : SIO $D0000000 + ; 769 | 770 | $004 constant IOIN 771 | $010 constant IOOUT 772 | $014 constant IOSET \ GPIO output value set 773 | $018 constant IOCLR \ GPIO output value clear 774 | $01C constant IOXOR 775 | $020 constant IOOE 776 | $024 constant OESET \ GPIO output enable set 777 | $028 constant OECLR 778 | $02C constant OEXOR 779 | 780 | ( GPIO ) 781 | --- GPIO STATUS 782 | : GPSR ( pin -- ) 3 << $40014000 + ; 783 | --- GPIO CONTROL 784 | : GPCR ( pin -- ) 3 << $40014004 + ; 785 | 786 | 787 | : MASK! ( flg adr mask -- ) ROT IF OVER @ OR ELSE OVER @ SWAP BIC THEN SWAP ! ; 788 | 789 | { 790 | PADS 791 | 792 | 2.19.6.3. Pad Control - User Bank 793 | 794 | 31:8 Reserved. - - - 795 | 7 OD Output disable. Has priority over output enable from RW 0x0 796 | peripherals 797 | 6 IE Input enable RW 0x1 798 | 5:4 DRIVE Drive strength. RW 0x1 799 | 0x0 → 2mA 800 | 0x1 → 4mA 801 | 0x2 → 8mA 802 | 0x3 → 12mA 803 | 3 PUE Pull up enable RW 0x0 804 | 2 PDE Pull down enable RW 0x1 805 | 1 SCHMITT Enable schmitt trigger RW 0x1 806 | 0 SLEWFAST Slew rate control. 1 = Fast, 0 = Slow RW 0x0 807 | } 808 | 809 | --- PADS_BANK0: VOLTAGE_SELECT Register 810 | : PADS1V8 1 PADS0 ! ; 811 | : PADS3V3 0 PADS0 ! ; 812 | 813 | \ $4001c000 constant PADS0 814 | : @PAD ( pin -- adr ) 1+ 2* 2* PADS0 + ; 815 | : PAD@ ( pin -- val ) @PAD @ ; 816 | : PAD! ( val pin -- ) @PAD ! ; 817 | 818 | --- enable pullup (and disable pulldown) 819 | : PU ( pin -- ) @PAD DUP @ 8 OR 4 BIC SWAP ! ; 820 | --- enable pulldown (and disable pullup) 821 | : PD ( pin -- ) @PAD DUP @ 4 OR 8 BIC SWAP ! ; 822 | 823 | --- select schmitt input 824 | \ : SCHMITT ( on/off pin -- ) @PAD DUP @ ROT IF 2 OR ELSE 2 BIC THEN SWAP ! ; 825 | : SCHMITT ( on/off pin -- ) @PAD 2 MASK! ; 826 | --- set slewrate 1=fast 0=slow (default) 827 | \ : SLEW ( 1=fast pin -- ) @PAD DUP @ ROT IF 1 OR ELSE 1 BIC THEN SWAP ! ; 828 | : SLEW ( 1=fast pin -- ) @PAD 1 MASK! ; 829 | 830 | { 831 | 832 | $CA SDDO PAD! 833 | $53 SDCK PAD! 834 | $5B SDDI PAD! 835 | $62 SDCS PAD! 836 | } 837 | 838 | 839 | 840 | { 841 | 29:28 IRQOVER 842 | 17:16 INOVER 843 | 13:12 OEOVER 844 | 9:8 OUTOVER 845 | 4:0 FNC 846 | 1 2 3 4 5 6 7 8 9 847 | SPI0 RX UART0 TX I2C0 SDA PWM0 A SIO PIO0 PIO1 USB OVCURIN 848 | SPIO0 CS UART0 RX I2C0 SCL PWM0 B SIO PIO0 PIO1 USB VBUSIN 849 | SPIO0 CK UART0 CTS I2C1 SDA PWM1 A SIO PIO0 PIO1 USB VBUSEN 850 | SPIO0 TX UART0 RTS I2C1 SCL PWM1 B SIO PIO0 PIO1 851 | SPI0 RX UART1 TX I2C0 SDA PWM2 A SIO PIO0 PIO1 852 | SPIO0 CS UART1 RX I2C0 SCL PWM2 B SIO PIO0 PIO1 853 | SPIO0 CK UART1 CTS I2C1 SDA PWM3 A SIO PIO0 PIO1 854 | SPIO0 TX UART1 RTS I2C1 SCL PWM3 B SIO PIO0 PIO1 855 | 856 | } 857 | 858 | ( PIN FUNCTION SELECT ) 859 | 860 | : FNC ( pin fnc -- ) SWAP GPCR ! ; 861 | : #SPI 1 FNC ; 862 | : #UART 2 FNC ; 863 | : #I2C 3 FNC ; 864 | : #PWM 4 FNC ; 865 | : #SIO 5 FNC ; 866 | : #PIO0 6 FNC ; 867 | : #PIO1 7 FNC ; 868 | : #USB 9 FNC ; 869 | 870 | 871 | 872 | 873 | 874 | ( SIMPLE IO WORDS ) 875 | 876 | : SIO! ( val reg -- ) SIO ! ; 877 | : SIO@ SIO @ ; 878 | 879 | : FLOAT ( pin -- ) bit OECLR SIO! ; 880 | : PIN@ ( pin -- bit ) IOIN SIO@ SWAP >> 1 AND ; 881 | : PIN? ( pin -- pin bit ) IOIN SIO@ OVER >> 1 AND ; 882 | : HIGH ( pin -- ) bit DUP IOSET SIO! OESET SIO! ; 883 | : LOW ( pin -- ) bit DUP IOCLR SIO! OESET SIO! ; 884 | : PIN! ( b0 pin -- ) SWAP 1 AND IF HIGH ELSE LOW THEN ; 885 | 886 | : WAITHI ( pin -- ) BEGIN PIN? UNTIL LAP DROP ; 887 | : WAITLO ( pin -- ) BEGIN PIN? 0= UNTIL LAP DROP ; 888 | : WAITEDGE ( pin -- ) DUP PIN@ IF WAITLO ELSE WAITHI THEN ; 889 | 890 | 891 | long ~pin 892 | 893 | : PIN ( pin -- ) ~pin C! ; 894 | : H ~pin C@ HIGH ; 895 | : L ~pin C@ LOW ; 896 | : F ~pin C@ FLOAT ; 897 | 898 | : .FNC ( pin -- ) --- print pin function 899 | SPACE GPCR @ >N 4 * 900 | --- 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 901 | s" GPIOSPI UARTI2C PWM SIO PIO0PIO1fnc8USB fnc9fncAfncBfncCfncDfncEfncF" 902 | DROP + 4 TYPE 903 | ; 904 | : .PIN ( pin -- ) 905 | SPACE DUP .FNC 906 | SPACE DUP bit IOOE @ AND IF ." OUT " ELSE ." INP " THEN 907 | SPACE DUP PIN@ IF ` H ELSE ` L THEN EMIT 908 | SPACE DUP GPSR @ .L 909 | SPACE GPCR @ .L 910 | ; 911 | : lsio 912 | CRLF REVERSE UL BOLD PRINT" PIN FNC DIR S GPSR GPCR " PLAIN 913 | 30 0 DO 914 | CRLF I .DEC2 I .PIN 915 | LOOP 916 | ; 917 | 918 | ' lsio ^ P CTRL! 919 | 920 | 921 | ( *** PWM *** ) 922 | 923 | { 924 | Use a virtual address for the selected PWM channel 925 | Calculates absolute address when the channel is selected 926 | via PIN and by means of PWMPIN 927 | Odd number pins share the previous pin's PWM but 928 | use the high word of PWMCC 929 | } 930 | 931 | $40050000 variable ~pwm --- base address of PWM 932 | 933 | 934 | : @PWM ( offset -- abs-addr ) ~pwm @ + ; 935 | --- find address of register of currently selected PWM pin 936 | : PWMCSR ( -- abs-addr ) 0 @PWM ; 937 | : PWMDIV ( -- abs-addr ) 4 @PWM ; --- INT(8),FRAC(4) 938 | : PWMCTR ( -- abs-addr ) 8 @PWM ; 939 | : PWMCC ( -- abs-addr ) 12 @PWM ; 940 | : PWMTOP ( -- abs-addr ) 16 @PWM ; 941 | 942 | 943 | --- store cc word in top or bottom half as per pin 944 | : PWMCC! ( 16b -- ) ~pin C@ 1 AND IF PWMCC HH! ELSE PWMCC LH! THEN ; 945 | 946 | --- Setup PWM base to be used for this pin 947 | : !PWM ~pin C@ DUP #PWM 2/ 7 AND 20 * ~pwm LH! ; 948 | 949 | --- frame on-time start 950 | : PWM ( on off div -- ) !PWM PWMDIV ! PWMTOP ! PWMCC! 1 PWMCSR ! ; 951 | 952 | : MUTE ~pin C@ #SIO ; 953 | 954 | : HZ ( freq -- ) 955 | !PWM 956 | clkfreq SWAP / 957 | --- div check for optimal pwmtop - no then div++ - or done 958 | 1 SWAP BEGIN 2DUP SWAP / 16 >> WHILE SWAP 1+ SWAP REPEAT OVER / 959 | --- use max 16-bit count for top and half for cc 960 | DUP PWMTOP ! 2/ PWMCC! 961 | --- Set divider 962 | 4 << PWMDIV ! 1 PWMCSR ! 963 | ; 964 | : KHZ 1000 * HZ ; 965 | 966 | --- Change duty cycle within the fram cycle without changing the frequency 967 | : DUTY ( on frame -- ) PWMTOP @ SWAP / * PWMCC! ; 968 | 969 | --- setup pin and set duty cycle to percentage - @1kHz 970 | : PWM% ( duty% -- ) 1000 HZ 100 DUTY ; 971 | 972 | --- output RC servo pulse of 1ms to 2ms on pin @50Hz (0..100%) 973 | \ : SERVO ( 0..100% pin -- ) SWAP 10 * 1000 + SWAP 20000 $7D0 ROT PWM ; 974 | \ : SERVO ( 0..100% -- ) PWMPIN $7D0 PWMDIV ! 10 * 1000 + 20000 DUTY ; 975 | 976 | 977 | 978 | 979 | 980 | 981 | 982 | \ ############################################################# 983 | \ ############################################################# 984 | \ SIMPLE SOUNDS 985 | \ ############################################################# 986 | \ ############################################################# 987 | 988 | 0 variable spkr 989 | { 990 | : TONE ( hz ms -- ) 991 | spkr C@ 992 | IF 993 | 1000 * cycles + 1000000 ROT / 2/ 994 | BEGIN 995 | spkr C@ HIGH DUP us 996 | spkr C@ LOW DUP us OVER cycles < 997 | UNTIL 998 | THEN 999 | 2DROP 1000 | ; 1001 | } 1002 | : TONE ( hz ms -- ) spkr C@ ?DUP IF PIN SWAP HZ ms MUTE ELSE 2DROP THEN ; 1003 | 1004 | : CLICK spkr C@ ?DUP IF DUP HIGH 100 us LOW THEN ; 1005 | : BIP 3000 50 TONE ; 1006 | : BEEP 3000 150 TONE ; 1007 | : BEEPS 0 DO BEEP 50 ms LOOP ; 1008 | : WARBLE ( hz1 hz2 ms -- ) 3 0 DO 3RD OVER TONE 2DUP TONE LOOP DROP 2DROP ; 1009 | : SIREN 400 550 400 WARBLE ; 1010 | : ~R 500 600 40 WARBLE ; 1011 | : RING ~R 200 ms ~R ; 1012 | : RINGS ( rings -- ) 0 DO RING 1000 ms LOOP ; 1013 | 1014 | : ZAP 3000 100 DO I 15 I 300 / - TONE 200 +LOOP ; 1015 | : ZAPS ( cnt -- ) 0 DO ZAP 50 ms LOOP ; 1016 | : SAUCER 10 0 DO 600 50 TONE 580 50 TONE LOOP ; 1017 | 1018 | \ SAUCER ZAP SAUCER 3 ZAPS SIREN 1019 | { 1020 | : CYLON ( from -- ) 1021 | BEGIN 1022 | 16 0 DO I DUP 7 > IF $0F XOR THEN OVER + DUP HIGH 100 ms LOW LOOP 1023 | KEY? 1024 | UNTIL 1025 | ; 1026 | } 1027 | 1028 | 1029 | 1030 | 1031 | 1032 | 1033 | 1034 | 1035 | 1036 | 1037 | ( SIMPLE NEOPIXEL DRIVER ) 1038 | 1039 | ( !!!!!!!!!!!!!! IT WAS WORKING BUT NEED TO FIX UP TIMING AGAIN !!!!!! ) 1040 | \ : HIGH ( pin -- ) bit DUP IOSET SIO! OESET SIO! ; 1041 | 1042 | 28 bit variable _neopin 1043 | \ Specify the NEOPIXEL to use 1044 | : NEOPIN ( n -- ) bit _neopin ! ; 1045 | : pixdly 1 0 do loop ; 1046 | : pix1 _neopin @ IOSET SIO! ; 1047 | : pix0 _neopin @ IOCLR SIO! ; 1048 | : pix! pix1 pixdly IF pix1 ELSE pix0 THEN pixdly pix0 pix0 ; 1049 | ( write to a single neopixel ) 1050 | : NEO! ( $ggrrbb -- ) _neopin @ OESET SIO! 8 << 24 0 DO ROL DUP 1 AND pix! LOOP pixdly DROP ; 1051 | 1052 | \ : CHECK LAP $1000 NEO! LAP .LAP ; CHECK 1053 | 1054 | 1055 | ( wrtie buffer @ 4 bytes/neo to neopixel array ) 1056 | : NEOS! ( buffer neocnt -- ) 1057 | 2 << BOUNDS DO I @ NEO! 4 +LOOP 1058 | 50 us 1059 | ; 1060 | 1061 | : RGB ( red green blue -- ) SWAP 16 << + SWAP 8 << + NEO! ; 1062 | 1063 | ( some demo neo colors ) 1064 | 1065 | \ : hot $10A000 NEO! ; 1066 | : white! -1 NEO! ; 1067 | : blank! 0 NEO! ; 1068 | : blue! ( n -- ) NEO! ; 1069 | : red! ( n -- ) 8 << NEO! ; 1070 | : green! ( n -- ) 16 << NEO! ; 1071 | 1072 | \ : DEMO 0 $1000 BOUNDS DO I 8 NEOS! 100 ms 4 +LOOP ; 1073 | 1074 | 1075 | 1076 | ( UARTS ) 1077 | 1078 | 0 variable ~uart 1079 | \ UART selectors 1080 | : UART0 $40034000 ~uart ! ; 1081 | : UART1 $40038000 ~uart ! ; 1082 | UART0 1083 | 1084 | \ Add in selected uart base 1085 | : UART ~uart @ + ; 1086 | 1087 | ( UART REGISTERS ) 1088 | 1089 | : UDR 0 UART ; 1090 | : UFR $18 UART ; 1091 | : IBRD $24 UART ; 1092 | : FBRD $28 UART ; 1093 | : LCR $2C UART ; 1094 | : UCR $30 UART ; 1095 | 1096 | 115200 variable ~baud 1097 | 1098 | \ Setup the current selected UART and set its baud rate 1099 | \ If baud < 300 then use this as a direct divisor inc 4-bit fractional 1100 | pub BAUD ( baud -- ) 1101 | DUP ~baud ! 1102 | DUP 299 > IF clkfreq SWAP / THEN 1103 | DUP 4 >> IBRD ! $0F AND 2 << FBRD ! 1104 | $301 UCR ! 1105 | $70 LCR ! 1106 | ; 1107 | 1108 | --- change console baud rate 1109 | pub CONBAUD UART0 BAUD ; 1110 | { 1111 | $669E, $66A2 1112 | 921600 $08 $1C 1113 | 1114 | } 1115 | 1116 | --- simple receive routine using select channel 1117 | : RX ( -- ch ) BEGIN UFR @ $10 AND 0= UNTIL UDR @ ; 1118 | : TX ( ch -- ) BEGIN UFR @ $20 AND 0= UNTIL UDR ! ; 1119 | 1120 | 1121 | 1122 | ( EXPERIMENTAL INTERACTIVE PIO REGISTER METHODS - WIP ) 1123 | 1124 | \ Syntax - PIO0 SM3 1125 | 1126 | 0 variable ~pio 1127 | \ Select PIO 1128 | : PIO0 $50200000 ~pio ! ; 1129 | : PIO1 $50300000 ~pio ! ; 1130 | 1131 | : @PIO ~pio @ + ; 1132 | 1133 | 0 variable sm 1134 | 0 variable ch 1135 | \ Select state machine within current PIO 1136 | : SM0 $0C8 @PIO sm ! 0 ch ! ; 1137 | : SM1 $0E0 @PIO sm ! 4 ch ! ; 1138 | : SM2 $0F8 @PIO sm ! 8 ch ! ; 1139 | : SM3 $110 @PIO sm ! 12 ch ! ; 1140 | : @SM sm @ + ; 1141 | 1142 | 1143 | \ get address of register within current PIO 1144 | : FCTRL $00 @PIO ; 1145 | : FSTAT $04 @PIO ; 1146 | : FDEBUG $08 @PIO ; 1147 | : FLEVEL $0C @PIO ; 1148 | \ get address of FIFO with current state machine and PIO 1149 | : TXFIFO ch @ $10 + @PIO ; 1150 | : RXFIFO ch @ $20 + @PIO ; 1151 | 1152 | 1153 | : IRQ $30 @PIO ; 1154 | : IRQ_FORCE $34 @PIO ; 1155 | : INSYN $38 @PIO ; \ INPUT_SYNC_BYPASS 1156 | : DBG_PADOUT $3C @PIO ; 1157 | : DBG_PADOE $30 @PIO ; 1158 | : DBG_CFGINFO $44 @PIO ; 1159 | 1160 | \ Usage: PIO0 SM1 $10 PIOMEM 1161 | : PIOMEM 2* 2* $48 + @PIO ; \ 32 REGISTERS 1162 | 1163 | \ STATE MACHINE REGISTERS 1164 | \ Usage: PIO1 SM3 INSTR @ 1165 | : CLKDIV 00 @SM ; 1166 | : EXECCTRL 04 @SM ; 1167 | : SHIFTCTRL 08 @SM ; 1168 | : ADDR 12 @SM ; 1169 | : INSTR 16 @SM ; 1170 | : PINCTRL 20 @SM ; 1171 | 1172 | 1173 | : INTR $128 @PIO ; 1174 | : IRQE0 $12C @PIO ; 1175 | : IRQF0 $130 @PIO ; 1176 | : IRQS0 $134 @PIO ; 1177 | 1178 | 1179 | 1180 | ( HC-SR04 PIN SENSOR ) 1181 | 1182 | --- PING ( echo trig -- mm ) trigger ping and return with result in mm (less the effective transducer depth) 1183 | : PING DUP LOW 2 us DUP HIGH 10 us LOW DUP FLOAT DUP WAITHI WAITLO LAP@ 170145 1000000 */ 6 - ; 1184 | 1185 | ( GROVE ULTRASONIC RANGER ) 1186 | 1187 | : RANGER ( pin -- mm ) 1188 | DUP LOW 2 us DUP HIGH 5 us DUP LOW 1189 | DUP FLOAT DUP WAITHI WAITLO LAP@ 1190 | --- speed m/s @sea offset 1191 | 170145 1000000 */ 6 - 1192 | ; 1193 | 1194 | 1195 | 1196 | \ ############################################################# 1197 | \ ############################################################# 1198 | \ ANALOG INPUtS + TEMP + VOLTAGE 1199 | \ ############################################################# 1200 | \ ############################################################# 1201 | 1202 | 1203 | : ADC $4004c000 + ; 1204 | : ADC-CS 0 ADC ; --- CS ADC Control and Status 1205 | : ADC-RES 4 ADC ; --- Result of most recent ADC conversion 1206 | : ADC-FCS 8 ADC ; --- FIFO control and status 1207 | : ADC-FIFO $0C ADC ; --- Conversion result FIFO 1208 | : ADC-DIV $10 ADC ; --- Clock divider 1209 | : ADC-INTR $14 ADC ; --- Raw Interrupts 1210 | : ADC-INTE $18 ADC ; --- Interrupt Enable 1211 | : ADC-INTF $1C ADC ; --- Interrupt Force 1212 | : ADC-INTS $20 ADC ; --- Interrupt status after masking & forcing 1213 | { 1214 | If non-zero, CS_START_MANY will start conversions 1215 | at regular intervals rather than back-to-back. 1216 | The divider is reset when either of these fields are written. 1217 | Total period is 1 + INT + FRAC / 256 1218 | 1219 | 0 P26 1220 | 1 P27 1221 | 2 P28 1222 | 3 P29 1223 | 5 TEMP SENSOR 1224 | 1225 | MEASURED 1226 | ADCREF 3.24V 1227 | } 1228 | 1229 | \ 20 BUFFER: adcbuf 1230 | : ADC@ ( n -- val ) ( 0 ADC-DIV ! ) 1231 | 12 << %0111 + ADC-CS ! 1232 | BEGIN $100 ADC-CS BIT@ UNTIL 1233 | ADC-RES @ \ DUP ROT 2* 2* adcbuf + H! 1234 | ; 1235 | { 1236 | !!!! just checking this now --- 1237 | VSYS = 536 to 542 = 5.1V 1238 | } 1239 | \ convert 12-bit ADC reading into microvolts 1240 | 3260000 variable vref 1241 | : >uV vref @ 4096 */ ; 1242 | : >mV >uV 1000 / ; 1243 | : .mV 4 U.R PRINT" mV" ; 1244 | : .V 0 <# # # # ` . HOLD # #> TYPE PRINT" V" ; 1245 | : .VSYS 3 ADC@ 3 * >mV .V ; 1246 | { 1247 | Pico Sensor Vbe = 0.706V at 27 degrees C, with a slope of -1.721mV/'C 1248 | RPi forumula is T = 27 - (ADC_voltage - 0.706)/0.001721 1249 | datasheet says 891 would correspond to 20.1°C 1250 | 1251 | 894 = 707.167mV -> 751.257 - 707.167 = 44.090mv * 1.721 = 25.618'C 1252 | 1253 | } 1254 | : >TEMP >uv 706000 - 1000000 1721 */ 27000000 SWAP - 100000 / ; 1255 | \ : >TEMP >uv 751257 SWAP - 1000 1721 */ 100 / 0 MAX ; 1256 | : TEMP@ 4 ADC@ >TEMP ; 1257 | : .TEMP TEMP@ 0 <# # $2E HOLD #S #> TYPE PRINT" 'C " ; 1258 | 1259 | : .ADCS 5 0 DO CRLF I . PRINT: I ADC@ DUP 5 U.R PRINT" = " >mV .mV LOOP ; 1260 | : !ADC %11 ADC-CS ! 0 ADC@ DROP ( adcbuf 20 ERASE ) ; 1261 | 1262 | 1263 | 1264 | 1265 | 1266 | \ led flasher 1267 | : FLASHES ( cnt led -- ) SWAP 0 DO DUP HIGH 100 ms DUP LOW 100 ms LOOP DROP ; 1268 | 1269 | 1270 | 1271 | 1272 | 1273 | \ ############################################################# 1274 | \ ############################################################# 1275 | \ SD CARD SPI DRIVERS 1276 | \ ############################################################# 1277 | \ ############################################################# 1278 | 1279 | 0 variable ~sdpins 1280 | 0 variable &sdck 1281 | pub SDCK ~sdpins C@ ; 1282 | pub SDDI ~sdpins 1+ C@ ; 1283 | pub SDDO ~sdpins 2+ C@ ; 1284 | pub SDCS ~sdpins 3 + C@ ; 1285 | 1286 | pub SDPINS ( csdodick -- ) ~sdpins ! SDCK bit &sdck ! ; 1287 | 1288 | \ : SPICLK SDCK HIGH SDCK LOW ; 1289 | 1290 | 1291 | : SPICLK &sdck @ IOSET SIO! &sdck @ IOCLR SIO! ; 1292 | 1293 | \ : SPICLKS 0 DO &sdck @ IOSET SIO! &sdck @ IOCLR SIO! LOOP ; 1294 | 1295 | : SPICLKS &sdck @ SWAP 0 DO DUP IOSET SIO! DUP IOCLR SIO! LOOP DROP ; 1296 | 1297 | ( aabbccdd -- bbccddaa ) --- write ms byte to SPI bus and rotate result 1298 | : SPIWR 8 0 do ROL DUP SDDI PIN! SPICLK LOOP ; 1299 | \ : SPIWR 8 0 do ROL DUP 1 AND IF SDDI HIGH ELSE SDDI LOW THEN SPICLK LOOP ; 1300 | ( byte -- ) --- write byte to SPI bus 1301 | : SPIWB 24 << SPIWR DROP ; 1302 | ( cmd -- ) --- format as SD command and write 1303 | : SPIWC $3f AND $40 OR SPIWB ; 1304 | ( long -- ) --- write long to SPI 1305 | : SPIWL SPIWR SPIWR SPIWR SPIWR DROP ; 1306 | 1307 | \ read another byte from SPI and append to lsb of input 1308 | : SPIRD ( input -- output ) 1309 | SDDI HIGH &sdck @ SWAP 1310 | 8 0 DO 2* SDDO PIN@ OR 1311 | OVER IOSET SIO! OVER IOCLR SIO! \ SPICLK 1312 | LOOP NIP 1313 | ; 1314 | 1315 | : SPIRDS ( &clk input -- &clk output ) 1316 | SDDI HIGH 1317 | 8 0 DO 2* SDDO PIN@ OR 1318 | OVER IOSET SIO! OVER IOCLR SIO! \ SPICLK 1319 | LOOP 1320 | ; 1321 | 1322 | \ SPI read 4 byte as a 32-bit long 1323 | : SPIRL 0 SPIRD SPIRD SPIRD SPIRD ; 1324 | : SPIRX ( dst cnt -- ) &sdck @ ROT ROT BOUNDS DO 0 SPIRDS I C! LOOP DROP ; 1325 | : SPITX ( src cnt -- ) BOUNDS DO I C@ SPIWB LOOP ; 1326 | 1327 | 1328 | : SDCLK 8 SPICLKS ; 1329 | : SDCLKS 0 DO SDCLK LOOP ; 1330 | 1331 | 1332 | 1333 | ( SD FUNCTIONS ) 1334 | 1335 | 1336 | 0 org 1337 | 512 4 * bytes SDBUF --- allocate sectors for up to 4 files 1338 | 128 bytes DIRBUF 1339 | 1340 | \ org@ org ( marks start of block for DATLEN ) 1341 | 0 bytes sdvars --- mark start of variables array 1342 | 1 longs ocr --- operating conditions registers 1343 | 16 bytes cid --- card ID 1344 | 16 bytes csd --- card specific data 1345 | \ 32 bytes cfnc 1346 | 1347 | 1 longs sdsize --- numbero of sectors 1348 | 1 longs @sdrd 1349 | 1 longs @sdwr 1350 | 1 longs sdsum --- checksum of sector contents 1351 | 1 longs seccrc --- sector crc 1352 | 1353 | 1 longs readsect --- current buffered sector 1354 | 1 longs filesect --- starting sector of current file ( could be a directory)' 1355 | 1 longs opensect --- starting sector of open file' 1356 | 1357 | 1 longs _fread 1358 | 1 longs _fwrite 1359 | 1 longs mntd --- serial number of mounted device 1360 | 2 bytes _fkey 1361 | 1362 | 1 bytes _sdcmd 1363 | 1 bytes _sdres 1364 | 1 bytes wrflg --- true if sector has been modified 1365 | 1 bytes wrens --- write enables 1366 | 1 bytes file# 1367 | 1 bytes fq --- listing counter 1368 | 1 bytes sdhc 1369 | 1 bytes blklen 1370 | 16 bytes bitbuf 1371 | 1372 | \ *** PARITION RECORDS *** 1373 | 1374 | --- 4 primary partitions 1375 | 16 longs parts --- STATE,[HEAD,[SECT(2),TYPE,HEAD],SECT(2)],1STSECT(4),PARTSEC(4) 1376 | --- 00 82 03 00 0B 50 CA C6 $2000 $00ECC000 1377 | 2 bytes parsig 1378 | 1379 | 1380 | \ *** FAT32 BOOT RECORD *** 1381 | 1382 | 0 longs fat32 1383 | 3 res --- jump code +nop 1384 | 8 bytes oemname --- MSWIN4.1 1385 | 2 bytes b/s --- 0200 = 512B (bytes/sector) 1386 | 1 bytes s/c --- 40 = 32kB clusters (sectors/cluster) 1387 | 2 bytes rsvd --- 32 reserved sectors from boot record until first fat table 1388 | 1389 | 1 bytes fats --- 02 1390 | 2 res --- Maximum Root Directory Entries (non-FAT32) 1391 | 2 res --- Number of Sectors inPartition Smaller than 32MB (non-FAT32) 1392 | 1 bytes media --- F8 hard disk (IBM defined as 11111red, where r is removable, e is eight sectors/track, d is double sided. ) 1393 | 2 res --- Sectors Per FAT in Older FATSystems (N/A for FAT32) 1394 | 2 res --- Sectors Per Track --- 3F 00 1395 | 2 res --- Number of Heads --- FF 00 1396 | 1397 | 4 bytes hidden --- Number of Hidden Sectors before Partition --- 00 20 00 00 1398 | ( 32 ) 1399 | 4 bytes s/p --- $00EC_C000 Number of sectors * byte/sect (512) = capacity' 1400 | 4 bytes s/f --- $0000_0766 Number of sectors per FAT table' 1401 | 2 bytes fat? --- 0000 fat flags (b3..0 = active fat copy, b7=mirroring) 1402 | 2 res fatver --- 0000 fat version MAJOR.MINOR 1403 | ( 44 ) 1404 | 4 bytes rootcl --- $0000_0002 Cluster Number of the Start of the Root Directory' 1405 | 2 bytes infosect --- 0001 info = Sector Number of the FileSystem Information Sector (from part start) 1406 | 2 bytes bbsect --- 0006 boot = Sector Number of the Backup Boot Sector (from part start) 1407 | 12 res --- 00s 1408 | ( 64 ) 1409 | 1 bytes ldn --- 80 logical drive number of partition 1410 | 1 res ldnh --- 01 unused or high byte of ldn 1411 | 1 bytes extsig --- 29 extended sig 1412 | 4 bytes serial --- $63FE_C331 serial number of partition 1413 | 11 bytes volname --- volume name 1414 | 8 res fatname --- "FAT32 " always FAT32 - (don't trust) 1415 | 2 res --- align to a long for FREAD 1416 | ( 90 ) 1417 | 1418 | --- --- --- --- --- --- --- --- --- --- --- --- --- --- 1419 | 1420 | 1 longs freeclusters --- Read from info sector 1421 | 1 longs lastcluster --- Read from info sector 1422 | --- calculated from scan at mount 1423 | 1 longs usedcl --- Used Clusters 1424 | 1 longs freecl --- Free Clusters 1425 | 1 longs used% --- percentage used *100 1426 | 1427 | 1428 | 1 longs mksiz --- size used to create a file if file not found - 0 = none 1429 | 1430 | --- --- --- --- --- --- --- --- --- --- --- --- --- --- 1431 | --- create room for some system variables in this table 1432 | 1433 | 1 longs rootdir --- sector address of root directory (MBR,GAP,BOOT,INFO,BACKUP,FAT1,FAT,ROOT) 1434 | 1 longs cwdir 1435 | 1 longs _fat1 1436 | 1 longs _fat2 1437 | 1 longs cwdsect 1438 | org@ sdvars - constant sdsz --- size of array used to hold all raw SD card related values + FAT etc 1439 | 1440 | 14 bytes cwd$ 1441 | 1442 | 1443 | 1444 | : SDIO 1445 | $CA SDDO PAD! 1446 | $53 SDCK PAD! 1447 | $5B SDDI PAD! 1448 | $62 SDCS PAD! 1449 | $5A 13 PAD! 1450 | $5A 14 PAD! 1451 | SDCS LOW SDCK LOW SDDI HIGH SDCS HIGH 1452 | ; 1453 | 1454 | : RELEASE SDCLK SDIO 0 SPIRD DROP ; 1455 | 1456 | ( CHECK FOFR SD CARD INTERNAL WEAK PULLUP ON SDCS ) 1457 | : SD? ( -- card ) 1458 | ~sdpins @ DUP IF DROP SDIO SDCS LOW SDCS FLOAT 10 us SDCS PIN@ THEN 1459 | ; 1460 | 1461 | \ CNT res 1462 | : SDRES ( -- response ) 1463 | \ retries for read until <> $FF 1464 | 50000 BEGIN DUP 0 SPIRD $FF AND DUP $FF = ROT 0<> AND WHILE DROP 1- REPEAT NIP 1465 | DUP _sdres C! 1466 | ; 1467 | 1468 | : CMD ( data cmd -- res ) 1469 | SDCS LOW 1470 | DUP _sdcmd C! SDCLK 1471 | \ write cmd and 32-bits of data 1472 | SPIWC SPIWL 1473 | \ send a crc of CMD8 or CMD0 - others ignore value 1474 | _sdcmd C@ IF $87 ELSE $95 THEN SPIWB 1475 | SDRES 1476 | ; 1477 | 1478 | : ACMD ( data acmd -- res ) 1479 | 0 55 CMD DROP CMD 1480 | ; 1481 | 1482 | : SDTOKEN ( marker -- flgX ) 1483 | SDDI HIGH 1484 | 10000 1485 | BEGIN OVER 0 SPIRD <> 1486 | WHILE 100 us 1- DUP 0= IF NIP EXIT THEN 1487 | REPEAT 1488 | 2DROP TRUE 1489 | ; 1490 | 1491 | : DAT? SDRES $FE = ; 1492 | 1493 | : SDSTAT ( -- stat ) 2 SDCLKS 0 13 CMD SDRES 8 << OR ; 1494 | 1495 | : SDDAT! ( adr cnt -- ) \ read info into memory 1496 | $FE SDTOKEN IF BOUNDS DO 0 SPIRD I C! LOOP 3 SDCLKS ELSE 2DROP THEN 1497 | ; 1498 | 1499 | 1500 | 1501 | : CMD0 5 0 DO 0 0 CMD 1 = IF LEAVE THEN LOOP _sdres C@ ; 1502 | : CMD8 5 0 DO $1AA 8 CMD 1 = IF LEAVE THEN LOOP _sdres C@ ; 1503 | : CMD8? SPIRL $1AA = ; 1504 | 1505 | 1506 | : ACMD41 30 bit 41 ACMD ; 1507 | : SLOWCLK SDDI HIGH 200 0 DO SDCK HIGH 2 us SDCK LOW 2 us LOOP ; 1508 | : ACMD41? 0 1000 0 DO ACMD41 IF SLOWCLK ELSE 1+ LEAVE THEN LOOP ; 1509 | 1510 | : !SD! 1511 | SDIO 0 ocr ! cid 16 ERASE csd 16 ERASE 1512 | CMD0 0EXIT 1513 | CMD8 0EXIT 1514 | CMD8? 0EXIT 1515 | ACMD41? 0EXIT 1516 | \ operation conditions (voltages) note: 1517 | \ spec says do this before acmd41 but does not work 1518 | 0 58 CMD ?EXIT SPIRL DUP ocr ! 0EXIT 1519 | \ card information FE - 03 53 44 53 43 36 34 47 80 84 F6 18 02 01 2A 79 - 53 DF FF FF 1520 | 0 10 CMD ?EXIT cid 16 SDDAT! 1521 | \ card specific data 1522 | 0 9 CMD ?EXIT csd 16 SDDAT! 1523 | ; 1524 | 1525 | 1526 | ( CSD BIT FIELDS ) 1527 | 1528 | : XSHR 1529 | 0 DO 1530 | 0 bitbuf 16 BOUNDS 1531 | DO I C@ DUP 2/ ROT OR I C! 1532 | 1 AND IF $80 ELSE 0 THEN 1533 | LOOP 1534 | DROP 1535 | LOOP 1536 | ; 1537 | 1538 | \ read bitfield range from CSD register 1539 | : CSD@ ( bith bitl -- dat ) 1540 | csd 1541 | \ pri BITS@ ( bith bitl adr -- dat ) 1542 | bitbuf 16 MOVE 1543 | DUP XSHR - 1+ bit 1544 | 1- 1545 | 0 bitbuf 12 + 4 BOUNDS DO 8 << I C@ OR LOOP 1546 | AND 1547 | ; 1548 | 1549 | 1550 | 1551 | --- Print the CID information in verbose REPORT format 1552 | : .MFG PRINT" MFG= " .B ; 1553 | 1554 | : .CARD 1555 | PRINT" CARD: " 1556 | cid C@ .MFG 1557 | SPACE cid 1+ 2 TYPE 1558 | SPACE cid 3 + 5 TYPE 1559 | PRINT" REV" cid 8 + C@ .B 1560 | PRINT" #" cid 9 + U@ U. 1561 | PRINT" DATE:" cid 14 + C@ cid 13 + C@ >N 8 << + 1562 | DUP 4 >> 2000 + PRINT >N PRINT" /" PRINT 1563 | sdsize @ 2/ PRINT" SIZE= " .DEC PRINT" kB " 1564 | cid 15 + C@ 1 AND ?EXIT 1565 | PRINT" BAD CID " 1566 | ; 1567 | 1568 | \ Initialise the SD card in SPI mode and return with the OCR 1569 | \ pub !SD ( -- ocr|false ) 1570 | : !SD ( --- ocr|false ) 1571 | sdvars sdsz ERASE readsect ~~ 1572 | SDBUF $400 ERASE 1573 | SD? IF 1574 | 3 SDCLKS 20 0 DO 1575 | \ attempt init and check if last operation was 9 1576 | !SD! _sdcmd C@ 9 = IF LEAVE ELSE 512 SDCLKS THEN 1577 | LOOP SDIO 100 SDCLKS 1578 | 69 48 CSD@ 1+ 10 << sdsize ! 1579 | THEN 1580 | $80FFFFF1 6 CMD 0= IF SDBUF 64 SDDAT! THEN 1581 | ocr @ 1582 | ; 1583 | 1584 | 1585 | 1586 | 1587 | --- FILE PERMISSIONS --- 1588 | 1589 | 1590 | pub RO wrens C~ ; --- Read only - write protected 1591 | pri wm wrens SET ; 1592 | pub RW 1 wm ; --- Read/Write access - write enabled 1593 | pub RWC 3 wm ; --- Read/Write & create 1594 | pub RWS 7 wm ; --- Read/Write/System permission 1595 | pri RW? 1 wrens SET? ; 1596 | 1597 | 1598 | 1599 | 1600 | \ : DAT? SDRES $FE = ; 1601 | pub L>S ( n -- offset sect ) DUP $1FF AND SWAP 9 >> ; 1602 | pri B>S ( bytes -- sectors ) L>S SWAP IF 1+ THEN ; 1603 | 1604 | 1605 | : SDRDBLK ( dst -- crc/flg ) 1606 | 512 SPIRX \ sdsum ! 1607 | 0 SPIRD SPIRD 31 bit OR 1608 | ; 1609 | 1610 | ( typical random sector read is around 1.8ms with bit-bashed SPI) 1611 | --- read sector into memory and update sector number 1612 | : SDRD ( sector dst -- ) 1613 | OVER readsect ! 1614 | SDCLK SWAP 17 CMD DUP 0= 1615 | IF DROP DAT? 1616 | IF SDRDBLK ELSE SDSTAT 2DROP 0 THEN 1617 | THEN 1618 | \ save crc as a flag -- only lower 16-bits of seccrc = crc with flag in b31 1619 | DUP @sdrd ! seccrc ! 1620 | RELEASE 1621 | ; 1622 | 1623 | : SDRDS ( sector ram bytes --) 1624 | 9 >> 0 DO 2DUP SDRD 512 + SWAP 1+ SWAP LOOP 2DROP 1625 | ; 1626 | 1627 | 1628 | pri SDWR? @sdwr @ ; 1629 | 1630 | pub SDWR ( src sect -- ) 1631 | @sdwr ~ 1632 | \ never sector 0 or if write protected unless RWS used 1633 | DUP 0<> RW? AND 4 wrens SET? OR 1634 | IF 1635 | \ sector write command 1636 | 3 SDCLKS 24 CMD 1637 | IF DROP 1638 | \ start token, data 1639 | ELSE 3 SDCLKS $FE SPIWB 512 SPITX 1640 | \ read data response 1641 | 0 SDTOKEN $FF SDTOKEN AND 1642 | THEN 1643 | \ always reset any RWS permissions after op - set crc in sdwr 1644 | 4 wrens CLR @sdwr ! RELEASE 1645 | ELSE 1646 | \ else write protect fail 1647 | 2DROP 1648 | THEN 1649 | ; 1650 | 1651 | \ SD WRTIE MULTIPLE SECTORS 1652 | pub SDWRS ( ram sector bytes -- ) 1653 | @sdwr ~ RW? 1654 | IF 1655 | B>S \ convert bytes to sectors 1656 | BOUNDS DO 1657 | DUP I SDWR 512 + SDWR? 0= IF LEAVE THEN 1658 | LOOP 1659 | RELEASE 1660 | ELSE 2DROP THEN 1661 | DROP 1662 | ; 1663 | 1664 | \ Write contents of sector buffer to SD & clear flag 1665 | pub FLUSH SDBUF readsect @ SDWR wrflg C~ ; 1666 | 1667 | \ only flush sector if it has been written to 1668 | pub ?FLUSH wrflg C@ 0EXIT FLUSH ; 1669 | 1670 | 1671 | : SECTORF ( sect -- buf ) ?FLUSH SDBUF SDRD SDBUF ; 1672 | 1673 | --- read 1k at a time 1674 | : SECTORF2 ( sect -- buf ) 1675 | ?FLUSH DUP SDBUF SDRD 1676 | 1+ SDBUF $200 + SDRD 1677 | -1 readsect +! 1678 | ; 1679 | 1680 | : SECTOR ( sect -- sdbuf ) 1681 | DUP readsect @ <> IF SECTORF ELSE DROP SDBUF THEN 1682 | ; 1683 | 1684 | : .BUF SDBUF $200 DUMP ; 1685 | : .SECTOR CRLF PRINT" SECTOR #" I .L SECTOR $200 DUMP ; 1686 | : .SECTORS BOUNDS DO I .SECTOR LOOP ; 1687 | 1688 | 1689 | 1690 | --- return starting sector at current FILE 1691 | pub @FILE ( -- sector ) filesect @ ; 1692 | 1693 | \ pub @OPEN ( -- sector ) opensect @ ; 1694 | 1695 | --- Set the starting sector for file access 1696 | pub OPEN-SECTOR ( sector -- ) _fread ~ filesect ! ; 1697 | 1698 | 1699 | 1700 | 1701 | 1702 | 1703 | 1704 | 1705 | ( virtual memory ) 1706 | 1707 | 1708 | --- Convert SD file address to hub ram address where file is buffered (897 cycles= 4,485ns @200MHz) 1709 | pub SDADR ( sdadr -- ramadr ) L>S @FILE + SECTOR + ; 1710 | 1711 | --- fetch long from SD virtual memory in current file 1712 | pub SD@ ( xaddr -- long ) SDADR @ ; 1713 | pub SDH@ SDADR H@ ; 1714 | pub SDC@ ( sdaddr -- byte ) SDADR C@ ; 1715 | 1716 | 1717 | --- store long to SD virtual memory in current file 1718 | pub SD! ( data xaddr -- ) SDADR ! wrflg C~~ ; 1719 | pub SDC! SDADR C! wrflg C~~ ; 1720 | 1721 | --- select SD for DUMP method : use: 0 $200 SD DUMP 1722 | pub SD ['] SDC@ ['] SDH@ ['] SD@ DUMP! ; 1723 | 1724 | 1725 | \ ############################################################# 1726 | \ ############################################################# 1727 | \ FAT32 1728 | \ ############################################################# 1729 | \ ############################################################# 1730 | 1731 | 1732 | --- at ROOT sector 1733 | pub @ROOT ( -- sector ) rootdir @ ; 1734 | pub @CWD cwdir @ ; 1735 | pub CWD! cwdir ! ; 1736 | 1737 | --- at BOOT sector 1738 | pub @BOOT ( -- sector ) parts 8 + @ ; 1739 | pri @FAT ( fat# -- sector ) s/f @ * @BOOT rsvd H@ + + ; 1740 | 1741 | pri FATSZ ( -- fatsz ) sdsize @ @BOOT - ; 1742 | 1743 | 1744 | 1745 | --- open directory sector as a file 1746 | 1747 | --- open the current working dir as if it were a file 1748 | pub CWD @CWD OPEN-SECTOR ; 1749 | 1750 | --- Open the root folder as a file 1751 | pub ROOT ( " /" cwd$ $! ) @ROOT CWD! CWD ; 1752 | 1753 | --- Use the MBR as a file 1754 | pub MBR 0 OPEN-SECTOR ; 1755 | 1756 | --- access FAT1 or FAT2 as a file 1757 | pub FAT1 _fat1 @ OPEN-SECTOR ; 1758 | pub FAT2 _fat2 @ OPEN-SECTOR ; 1759 | 1760 | 1761 | --- change current working directory 1762 | pub CD# ( sect -- ) cwdsect ! ; 1763 | 1764 | 1765 | --- Close file by flushing, switching to read-only and use sector -1 1766 | pub FCLOSE ?FLUSH RO MBR readsect ~~ ; 1767 | \ pub CLOSE-FILE 1768 | 1769 | 1770 | 1771 | 1772 | \ *** DIRECTORY STRUCTURE *** 1773 | 1774 | \ public --- 8.3 directory entry structure 1775 | 0 longs dirrcd 1776 | \ private 1777 | 8 bytes fname 1778 | 3 bytes fext 1779 | 1 bytes fatr --- (0:read-only, 1:hidden, 2:system, 3:volume label, 4:directory, 5:archive, 6-7: undefined) 1780 | 1 res 0 1781 | 1 bytes fcms --- file creation time - milliseconds 1782 | 2 bytes fctime 1783 | 2 bytes fcdate 1784 | 2 bytes fadate 1785 | 2 bytes fclsth 1786 | 2 bytes ftime 1787 | 2 bytes fdate 1788 | 2 bytes fclstl 1789 | 4 bytes fsize 1790 | 1791 | \ public 1792 | 2 bytes diridx --- directory index 1793 | 16 bytes file$ 1794 | 1795 | 1796 | 1797 | pub FSIZE@ fsize @ ; 1798 | 1799 | 1800 | ( *** CLUSTERS *** ) 1801 | 1802 | 1803 | { 1804 | CLUSTER CHAIN CODES 1805 | If value => $0FFF.FFF8 then there are no more clusters in this chain. 1806 | $0FFF.FFF7 = bad 1807 | 0 = free 1808 | 1809 | } 1810 | pri @CLUSTER ( index -- xadr ) 1811 | FAT1 2* 2* 1812 | ; 1813 | 1814 | pri CLUSTER@ ( index -- cluster ) 1815 | @CLUSTER SD@ 1816 | ; 1817 | 1818 | pri FreeClusters? ( size -- #clusters clust1 ) 1819 | \ calculate clusters required 1820 | B>S s/c C@ U/ ( clusters ) 1821 | 0 1822 | BEGIN 1823 | \ --- find a free cluster 1824 | BEGIN DUP CLUSTER@ WHILE 1+ REPEAT 1825 | \ --- check for sufficient contiguous clusters ( clusters index ) 1826 | 0 OVER 2 PICK BOUNDS DO I @CLUSTER SD@ OR DUP IF NIP I SWAP LEAVE THEN LOOP 1827 | ( clusters chain flag ) 1828 | WHILE 1829 | 1+ 1830 | REPEAT 1831 | ; 1832 | 1833 | 1834 | 1835 | 1836 | --- count number of clusters allocated from start cluster 1837 | pub CLUSTERS? ( cluster# -- clusters ) 1838 | \ scan through fat1 as a file 1839 | filesect @ SWAP 1840 | 0 SWAP ( cnt sect -- ) 1841 | BEGIN B++ CLUSTER@ DUP $0FFFFFF8 >= UNTIL DROP 1842 | SWAP filesect ! 1843 | ; 1844 | 1845 | --- Convert Directory address to first cluster 1846 | pub FCLUSTER ( -- cluster#0 ) 1847 | \ cluster low and cluster high combined 1848 | fclstl H@ fclsth H@ 16 << + 1849 | ; 1850 | 1851 | pri C>S2 1852 | s/c C@ * @ROOT + 1853 | ; 1854 | 1855 | --- Convert Cluster to sector 1856 | pub C>S ( clust# -- sector ) 1857 | rootcl @ - C>S2 1858 | ; 1859 | 1860 | --- read Directory cluster and convert to starting sector 1861 | pub FSECTOR ( -- sector ) 1862 | FCLUSTER C>S 1863 | ; 1864 | 1865 | --- convert a sector to a cluster ( result 0 = out of range ; 2 = 1st ) 1866 | pub SECT>CLST ( sector -- cluster ) 1867 | @CWD - s/c C@ U/ 2+ 1868 | ; 1869 | 1870 | --- convert sector to total allocated clusters 1871 | pri SECT>CLST# ( sector -- clusters ) 1872 | SECT>CLST CLUSTERS? s/c C@ * 9 << 1873 | ; 1874 | 1875 | 1876 | 1877 | 1878 | pri ?FREE \ Calculate used/unused 1879 | 0 0 usedcl 12 ERASE 1880 | sdsize @ @ROOT - ( data-sectors ) 1881 | s/c C@ U/ ( data-clusters ) 2+ ( where root is cluster 2 ) 1882 | 2 DO I CLUSTER@ IF B++ ELSE 1+ THEN LOOP 1883 | 2DUP + 2 PICK 10000 * SWAP U/ 1884 | used% ! freecl ! usedcl ! 1885 | ; 1886 | 1887 | 1888 | 1889 | pub GETFAT 1890 | \ read fat32 as a byte array 1891 | @BOOT SECTORF fat32 90 MOVE 1892 | \ sectors rsvd to fat1 ... size of fat tables 1893 | rsvd H@ s/f @ fats C@ * + ( offset from fat boot ) 1894 | \ rootcl @ 2- C>S2 1895 | hidden @ + rootdir ! 1896 | \ '' save time by precalculating FAT table addresses@ 1897 | 0 @FAT _fat1 ! 1 @FAT _fat2 ! 1898 | \ ?FREE 1899 | \ Open info sector 1900 | @BOOT infosect H@ + OPEN-SECTOR 1901 | $1E8 SD@ freeclusters ! 1902 | $1EC SD@ lastcluster ! 1903 | ; 1904 | 1905 | 1906 | 1907 | \ find total allocated cluster bytes for this byte 1908 | pub FMAX ( -- bytes ) FCLUSTER CLUSTERS? s/c C@ * 9 << ; 1909 | 1910 | pub GETPART 1911 | 0 SECTORF $1FE + H@ $AA55 <> IF PRINT" INVALID PARTITION" THEN 1912 | $1BE SDBUF + parts 66 MOVE 1913 | ; 1914 | 1915 | pub !MOUNT 1916 | !FAULT 1917 | SD? 0EXIT \ ( !SD DROP !SD DROP ) !SD 0EXIT 1918 | !SD 0EXIT 1919 | 1 SECTORF DROP 1920 | !SD 0EXIT 1921 | fat32 cwdsect fat32 - ERASE 1922 | RO 1923 | GETPART 1924 | GETFAT 1925 | ROOT 1926 | serial U@ mntd ! 1927 | 1 MB mksiz ! 1928 | ; 1929 | 1930 | pub MOUNT 1931 | !MOUNT SD? IF .CARD THEN 1932 | ; 1933 | 1934 | 1935 | \ MOUNT FAT32 if not already mounted 1936 | pub ?MOUNT 1937 | SD? serial U@ mntd @ = AND mntd @ 0<> AND 0= 1938 | IF 10 ms !MOUNT ( $0D KEY! ) ELSE SD? 0= IF mntd ~ THEN THEN 1939 | ; 1940 | 1941 | pub MOUNTED? 1942 | ?MOUNT mntd @ 1943 | ; 1944 | 1945 | 1946 | 1947 | 1948 | 1949 | 1950 | 1951 | 1952 | ( DIR.FTH ) 1953 | 1954 | 1955 | ( *** DIRECTORY *** ) 1956 | pub >DIR diridx H@ CWD 5 << SDADR ; 1957 | 1958 | \ reads relevant dir sector in using index 1959 | \ returns with the address in the buffer 1960 | 1961 | pub IDX>DIR ( Index -- diradr ) diridx H! >DIR ; 1962 | 1963 | \ read the nth directory entry into the dir buffer (index saved in diridx) 1964 | pub GETDIR ( index -- ) IDX>DIR fname 32 MOVE ; 1965 | pub SAVEDIR fname >DIR 32 MOVE RW FLUSH RO ; 1966 | pub OPENDIR FSECTOR OPEN-SECTOR ; 1967 | pri FTYPE ( src cnt subs -- ) -ROT BOUNDS DO I C@ OVER AEMIT LOOP DROP ; 1968 | 1969 | \ Print the file name of the current dirbuf 1970 | pub .FNAME 1971 | \ skip invalid index/entry 1972 | fname C@ $20 > 1973 | IF 1974 | $10 fatr SET? IF $5B EMIT ELSE SPACE THEN 1975 | fname 8 $20 FTYPE 1976 | fext C@ $20 > IF $2E EMIT fext 3 $20 FTYPE ELSE 4 SPACES THEN 1977 | $10 fatr SET? IF $5D EMIT ELSE SPACE THEN 1978 | THEN 1979 | ; 1980 | 1981 | \ update file modification/create time in dir buf 1982 | \ Time (5/6/5 bits, for hour/minutes/doubleseconds) 1983 | pub FTIME! ( #hhmmss field -- ) 1984 | SWAP HMS 11 << SWAP 5 << + SWAP 2/ + 1985 | SWAP H! 1986 | ; 1987 | 1988 | \ update file modification/create date in dir buf 1989 | \ Date (7/4/5 bits, for year-since-1980/month/day) 1990 | pub FDATE! ( #yymmdd field -- ) 1991 | \ arrange as decimal YYMMDD from 1980 ( 2000.0000 + 1980.0000 - ) 1992 | SWAP DUP 20000000 < IF 200000 + THEN 1993 | HMS 9 << SWAP 5 << + + 1994 | SWAP H! 1995 | ; 1996 | 1997 | \ DATE TIME STAMPING \ 1998 | { 1999 | \ Update the modified time and date of the current file 2000 | pub MODIFIED ( -- ) 2001 | TIME@ ftime FTIME! 2002 | DATE@ fdate FDATE! 2003 | SAVEDIR 2004 | ; 2005 | pub CREATED ( -- ) 2006 | TIME@ fctime FTIME! 2007 | DATE@ fcdate FDATE! 2008 | SAVEDIR 2009 | ; 2010 | } 2011 | 2012 | \ diagnostic directory entry dump 2013 | pub .DIRHEX GETDIR fname $20 DUMP ; 2014 | 2015 | \ check sector for any non-zero data - something 2016 | pri ACTIVE? ( -- flg ) seccrc @ $80000000 <> ; 2017 | 2018 | \ Print dir entry according to method set in ~dir 2019 | 0 variable ~dir 2020 | pri .DIR ~dir @ ?DUP IF execute THEN ; 2021 | 2022 | pri DODIR 2023 | fq C~ FCLOSE 2024 | s/c C@ 4 << 0 2025 | DO \ continue if the whole sector has entries 2026 | I GETDIR ACTIVE? 2027 | \ valid entries not msb set nor deleted 2028 | IF fatr C@ $0F > fname C@ $80 < AND fname C@ $3F <> AND 2029 | IF .DIR THEN ELSE LEAVE THEN 2030 | LOOP 2031 | ; 2032 | 2033 | pub LIST: ( method -- ) ~dir ! DODIR ; 2034 | pri DIR: ( method -- ) ?MOUNT CRLF volname 11 TYPE LIST: ; 2035 | 2036 | 1 bytes ~x 2037 | 2038 | pri DODIRX fq C@ ~x C@ MOD 0= IF CRLF THEN .FNAME 4 SPACES fq C++ ; 2039 | pub DIRX ( n -- ) ~x C! ['] DODIRX DIR: ; 2040 | 2041 | pub DIRW 6 DIRX ; 2042 | pub DIRN 1 DIRX ; 2043 | 2044 | ( DIRECTORY LIST FORMATTING ) 2045 | 2046 | pri .ASMONTH ( index -- ) >N 1- 3 * S" JanFebMarAprMayJunJulAugSepOctNovDec" DROP + 3 TYPE ; 2047 | 2048 | \ print date in Unix format 2049 | pri .ASDATE ( fdate -- ) DUP 5 >> .ASMONTH $1F AND 3 .DECS ; 2050 | 2051 | 2052 | pri .ASTIME ( ftime -- ) DUP 11 >> .DEC2 $3A EMIT 5 >> $3F AND .DEC2 ; 2053 | \ print as year/month/day 2054 | pri .ASYMD DUP 9 >> 1980 + .DEC4 DUP 5 >> >N $2D EMIT .DEC2 $1F AND $2D EMIT .DEC2 ; 2055 | 2056 | \ print the file date from 1980 2057 | pub .FDATE fdate H@ .ASYMD ftime H@ .ASTIME ; 2058 | 2059 | 2060 | pri .DHD CRLF PRINT" NAME...........ATR.1ST.SECTOR...MODIFIED.............FILE.SIZE.......MAX.SIZE.....HEADER" ; 2061 | 2062 | pub ASDIR 2063 | CRLF diridx H@ 3 .DECS SPACE .FNAME 4 SPACES 2064 | \ print atr 2065 | fatr C@ DUP .B SPACE 8 AND 0= 2066 | IF \ not a directory - so list file info 2067 | \ $0000_9678 2018-12-24 02:56 2068 | FSECTOR .L 3 SPACES fdate H@ .ASYMD SPACE ftime H@ .ASTIME 2069 | \ display file size 2070 | SPACE FSIZE@ 14 .DECS 2071 | THEN 2072 | ; 2073 | pub DIR .DHD ['] ASDIR DIR: ; 2074 | 2075 | \ print the first 20 bytes of the file 2076 | pri .HEADER 3 SPACES FSECTOR SECTOR 20 $2E FTYPE ; 2077 | \ print total allocated memory via assigned cluster count 2078 | pri .ASIZE FSIZE@ 27 >> NOT IF ." /" FMAX 14 .DECS THEN ; 2079 | 2080 | pri DODIR++ 2081 | ASDIR SPACE PRINT" - created " 2082 | fcdate H@ .ASYMD SPACE 2083 | fctime H@ .ASTIME 2084 | fcms C@ $2E EMIT 3 .DECS PRINT" - accessed " 2085 | fcdate H@ .ASDATE 2086 | ; 2087 | pub DIR++ .DHD ['] DODIR++ DIR: ; 2088 | 2089 | pri DODIR+ ASDIR .ASIZE .HEADER ; 2090 | pub DIR+ .DHD ['] DODIR+ DIR: ; 2091 | 2092 | --- open a file using the directory name index 2093 | pub FOPEN# ( index -- ) GETDIR OPENDIR ; 2094 | 2095 | 2096 | 2097 | 16 bytes G$ 2098 | pub GET$ ( -- adr ) 2099 | G$ 16 ERASE 2100 | TOKEN ?DUP IF 0 DO I OVER + C@ G$ I + C! LOOP THEN DROP 2101 | G$ 2102 | ; 2103 | 2104 | \ : GET $20004142 C! GET$ $20 $20004142 C! ; 2105 | 2106 | --- compare strings for len bytes 2107 | pub C$= ( adr1 adr2 len -- flg ) 2108 | BOUNDS DO C@++ I C@ <> IF 0= LEAVE THEN LOOP 2109 | 0<> 2110 | ; 2111 | 2112 | : CREATED ; 2113 | : MODIFIED ; 2114 | 2115 | 2116 | 2117 | \ convert file$ to 8.3 format in dirbuf 2118 | pub AS8.3 ( nstr -- ) 2119 | fname 11 $20 FILL 2120 | fname OVER LEN$ 0 2121 | DO ( file$ fname ) 2122 | OVER I + C@ a>A 2123 | DUP $2E = IF 2DROP fext ELSE OVER C! 1+ THEN 2124 | LOOP 2125 | 2DROP 2126 | ; 2127 | 2128 | 2129 | 2130 | 12 bytes f83$ 2131 | \ find current f83 name index+1 to directory entry 2132 | pri FIND-FILE ( str -- index+1 ) 2133 | DUP C@ $2F = IF 1+ ROOT THEN 2134 | \ convert and save in X$ for comparisons 2135 | AS8.3 fname f83$ 11 MOVE 2136 | 0 s/c C@ 4 << 0 2137 | DO 2138 | \ buffer dir enty into memory and check 2139 | I GETDIR fname f83$ 11 C$= 2140 | IF DROP I 1+ LEAVE THEN 2141 | LOOP 2142 | ; 2143 | 2144 | 2145 | 2146 | 2147 | \ Find the next free directory entry (just looks for a null but could do more) 2148 | \ no range checking just to keep it simple for now 2149 | \ dir index in diridx and entry in fname 2150 | pub FREEDIR 2151 | --- 2152 | s/c C@ 4 << 0 DO I GETDIR fname C@ 0= IF LEAVE THEN LOOP 2153 | ; 2154 | 2155 | pri ClaimClusters ( for from -- from ) 2156 | FAT1 \ RW 2157 | \ link clusters 2158 | DUP 3RD BOUNDS DO 1 I + I @CLUSTER SD! LOOP 2159 | ( #clusters clust1 ) \ mark end cluster 2160 | SWAP OVER + 1- $0FFFFFFF SWAP @CLUSTER SD! 2161 | FLUSH 2162 | ; 2163 | 2164 | 2165 | 2166 | 2167 | \ Create a new file by name but if it already exists then delete the old one and reuse the dir entry. 2168 | \ if size = 0 then max = 4GB 2169 | 2170 | pub FCREATE$ ( size namestr -- ) 2171 | FREEDIR 2172 | \ as 8.3 and write the name of the file to the directory buffer 2173 | fname 32 ERASE AS8.3 $20 fatr C! 2174 | \ Set size of file to maximum & preallocate clusters 2175 | DUP fsize ! FreeClusters? ClaimClusters ( from ) 2176 | \ write first cluster 2177 | CWD L>W fclsth H! fclstl H! 2178 | \ add directory record to directory 2179 | CREATED MODIFIED SAVEDIR 2180 | ; 2181 | 2182 | : FCREATE ( size -- ) GET$ FCREATE$ ; 2183 | 2184 | 2185 | : FSAVE ( src bytes -- ) 2186 | @FILE 2187 | IF 2188 | @FILE SWAP SDWRS 2189 | ELSE 2190 | 2DROP PRINT" No file " 2191 | THEN 2192 | DROP 2193 | ; 2194 | 2195 | 2196 | \ Force file to open - create to size if not found 2197 | pub FSIZE! ( size -- ) mksiz ! RWC ; 2198 | 2199 | 2200 | \ pub OPEN-FISLE$ 2201 | pub FOPEN$ ( str -- flg ) 2202 | DUP file$ $! 2203 | \ check mount and find 8.3 file name 2204 | ?MOUNT FIND-FILE 2205 | \ if found then convert directory entry to starting sector 2206 | IF FSECTOR 2207 | ELSE \ if create flag set then create a preallocated size file - else fail 2208 | 2 wrens SET? IF mksiz @ file$ FCREATE$ FSECTOR ELSE 0 THEN 2209 | THEN 2210 | \ open the sector although 0 = fail (mbr sector 0 is protected anyway) 2211 | OPEN-SECTOR @FILE DUP opensect ! 2212 | ; 2213 | 2214 | pub REOPEN-FILE file$ FOPEN$ ; 2215 | 2216 | 2217 | \ Get the file name and try to open it, return with sector 2218 | pri OPEN-FILE ( -- filesect ) GET$ SPACE FOPEN$ ; 2219 | 2220 | pub FOPEN ( -- ) 2221 | \ grab parameters and permissions then open-file 2222 | OPEN-FILE ?DUP 2223 | IF PRINT" Opened @ " .L 2224 | ELSE PRINT" - File not found! " THEN 2225 | ; 2226 | 2227 | pub FGET ( -- ch ) _fread @ SDC@ _fread ++ ; 2228 | pub FPUT ( ch -- ) _fwrite @ SWAP OVER SDC! 1+ FSIZE@ MOD _fwrite ! ; 2229 | 2230 | pub FLOAD-KEY? @FILE ; 2231 | pub FLOAD-KEY FGET DUP 0= IF !SERKEY THEN ; 2232 | 2233 | pub -FLOAD --- Load current file 2234 | _fread ~ 2235 | ['] fload-key KEY! ['] fload-key? hook-key? ! 2236 | ; 2237 | pub FLOAD FOPEN -FLOAD ; 2238 | 2239 | 2240 | pub CD$ @FILE CWD! file$ cwd$ $! ; 2241 | 2242 | pub CD FOPEN CD$ ; 2243 | 2244 | 2245 | ( TRIED THIS FIRST SINCE i HAD A CARD WITH A CORRUPTED SECTOR 0 ) 2246 | \ NOTE! Issue RWS permissions before using (safety) 2247 | pub FORMAT.MBR 2248 | SDBUF 512 ERASE 2249 | \ copy boot config table for reference in unused area at start 2250 | \ 0 SDBUF $100 CMOVE 2251 | \ MBR NAME OF FORMAT TOOL 2252 | S" Mecrisp FLAT32" SDBUF 3 + SWAP MOVE 2253 | \ 1023, 254, 63 2254 | parts 66 ERASE 2255 | \ valid partition flags 2256 | $AA55 parsig H! 2257 | 2258 | \ $80 parts C! 2259 | \ fs+CHS 2260 | $0CFFFFFE parts 1+ U! 2261 | \ This sets up 4MB hiddenbefore parition according to SD compliance (But >32GB 16MB) 2262 | sdsize @ 70000000 U> IF $8000 ELSE $2000 THEN parts 8 + ! 2263 | \ TOTAL SECTORS = SDSIZE- 2264 | FATSZ parts 12 + ! 2265 | \ copy parts to buffer 2266 | parts $1BE SDBUF + 66 MOVE 2267 | \ Write MBR 2268 | SDBUF 0 SDWR 2269 | ; 2270 | 2271 | 2272 | 2273 | ( MORE SHORTCUTS ) 2274 | 2275 | : ?QS >R >R .S R> R> ; 2276 | : !QS >R !SP R> 0 ?QS ; 2277 | ' ?QS ^ Q CTRL! 2278 | ' !QS ^ S CTRL! 2279 | ' WORDS ^ W CTRL! 2280 | 2281 | 2282 | : DEBUG 2283 | DEPTH 0< IF !SP ELSE .S THEN 2284 | .RSTACK 2285 | ." TIB" 2286 | TIB $50 DUMP 2287 | ; 2288 | : ?DEBUG >R >R DEBUG R> R> ; 2289 | ' ?DEBUG ^ D CTRL! 2290 | 2291 | : .CTRLS 32 0 do i ctrls @ ?DUP IF CRLF I .B ." ^" i $40 + emit space >NFA CTYPE THEN loop ; 2292 | ' .CTRLS ^ _ CTRL! 2293 | 2294 | 2295 | 2296 | ( *** I2C BUS *** ) 2297 | 2298 | { 2299 | I2C & RTC DRIVE 2300 | Simple bit-bashed interface for RP2040 2301 | Also includes RTC driver for RV-3028 I2C RTC and UB3 bridge 2302 | TO DO: use I2C hardware (but keep this as reference) 2303 | } 2304 | 2305 | 2306 | byte acks --- acks flags 2307 | byte i2cdev --- I2C DEVICE ADDRESS 2308 | byte ~sda --- SDA PIN 2309 | byte ~scl --- SCL PIN 2310 | 2311 | 25 variable ~idly --- I2C bit timing delay 2312 | 2313 | pub *SDA ~sda C@ ; 2314 | pub *SCL ~scl C@ ; 2315 | 2316 | pub I2CPINS ( scl sda -- ) ~sda C! ~scl C! ; 2317 | --- setup I2C pins with internal pullups and float them 2318 | pri !I2C *SDA PU *SCL PU *SCL FLOAT *SDA FLOAT ; 2319 | pub I2C.DLY ~idly H@ 0 DO LOOP ; 2320 | 2321 | \ pub I2C.CLK *SCL HIGH *SCL FLOAT BEGIN *SCL PIN@ UNTIL I2C.DLY *SCL LOW I2C.DLY ; 2322 | \ pub I2C.CLK? *SDA PIN@ I2C.CLK ; 2323 | ( Patch for CCS811 clock stretching - Pete Foden ) 2324 | 2325 | pri I2C.CLKH I2C.DLY *SCL HIGH *SCL FLOAT BEGIN I2C.DLY *SCL PIN@ UNTIL ; 2326 | pri I2C.CLKL I2C.DLY *SCL LOW I2C.DLY ; 2327 | pub I2C.CLK? ( -- sda ) I2C.CLKH *SDA PIN@ *SDA FLOAT I2C.CLKL ; 2328 | pub I2C.CLK I2C.CLKH I2C.CLKL ; 2329 | 2330 | --- patch: allow for clock stretch 2331 | pub I2C.STOP !I2C *SDA LOW I2C.CLKH *SDA FLOAT I2C.DLY ; 2332 | pub I2C.START !I2C acks C~ *SCL HIGH *SCL FLOAT I2C.DLY *SDA LOW I2C.DLY *SCL LOW I2C.DLY ; 2333 | --- I2C RESTART - ensure bus is idle then restart 2334 | pub *SDA PIN@ 0= IF I2C.STOP THEN I2C.START ; 2335 | 2336 | { 2337 | ( TAQOZ METHOD ) 2338 | I2C.CLOCK waitx i2cdly 2339 | drvh sclpin 2340 | flth sclpin ' then float to let the pullup work' 2341 | I2C.CNTN waitx i2cdly 2342 | testp sclpin wc ' wait while scl is low' 2343 | if_nc jmp #I2C.CNTN 2344 | testp sdapin wc ' read SDA into wc' 2345 | waitx i2cdly 2346 | drvl sclpin 2347 | ret_ waitx i2cdly 2348 | } 2349 | 2350 | --- default I2C device address 2351 | \ $A4 variable i2cdev 2352 | pub I2CPUT ( data -- ack ) 2353 | 8 0 DO 2354 | DUP 7 >> *SDA PIN! I2C.CLK 2* LOOP 2355 | *SDA FLOAT 2356 | DROP *SDA PIN@ I2C.CLK 2357 | ; 2358 | pub I2CGET ( ack -- data ) 2359 | *SDA FLOAT 2360 | 0 8 0 DO 2* I2C.CLK? OR LOOP 2361 | SWAP 1 AND *SDA PIN! I2C.CLK 2362 | ; 2363 | 2364 | pub I2CRD? ( adr -- ack ) I2C.STOP 1 OR I2C.START I2CPUT 0= ; 2365 | pub I2CRD ( adr -- ) I2CRD? DROP ; 2366 | pub I2CWR ( adr -- ) I2C.STOP $FE AND I2C.START I2CPUT DROP ; 2367 | pub I2C! ( data -- ) I2CPUT 0= 1 AND acks C+! ; 2368 | pub I2C@ 0 I2CGET ; 2369 | pub nakI2C@ TRUE I2CGET ; 2370 | 2371 | pub I2CRDREG ( dev reg -- ) OVER I2CWR I2C! I2CRD ; 2372 | 2373 | ( I2C DUMP SUPPORT ) 2374 | 2375 | pub I2CC@ ( reg -- dat ) i2cdev C@ I2CWR I2C! i2cdev C@ I2CRD 0 I2CGET ; 2376 | --- Switch DUMP source to selected I2C device (use 8-bit addresses) 2377 | pub I2C ( dev -- ) i2cdev C! ['] I2CC@ DUP DUP DUMP! ; 2378 | 2379 | ( I2C DEVICE SCAN ) 2380 | 2381 | pub lsi2c $100 0 DO I I2CRD? IF I ." $" .B THEN 2 +LOOP ; 2382 | 2383 | 2384 | 2385 | ( *** RTC *** ) 2386 | 2387 | --- these two may be combined with current bms to derive the time without reading rtc 2388 | long bdate --- data at reset 2389 | long btime --- time at reset 2390 | long bms --- ms time at reset 2391 | 2392 | byte ~rtc 2393 | --- rtc buffer 2394 | byte @sec 2395 | byte @min 2396 | byte @hour 2397 | byte @day 2398 | byte @date 2399 | byte @month 2400 | byte @year 2401 | 2402 | 2403 | ( *** RV-3028-C7 RTC *** ) 2404 | 2405 | ( Changed @RTC to use a variable instead to allow for other RTC chips) 2406 | \ $A4 variable ~rtc 2407 | pub @RTC ~rtc C@ ; 2408 | pub RTC? ( -- flg ) @RTC I2CRD? I2C.STOP ; 2409 | 2410 | --- fetch reg from 8-bit reg ADDR REG ADDR DATA 2411 | pub I2CREG@ ( reg dev -- dat ) DUP I2CWR SWAP I2C! I2CRD nakI2C@ I2C.STOP ; 2412 | pub RTC@ ( reg -- byte ) @RTC I2CREG@ ; 2413 | 2414 | pub I2CREG! ( dat reg dev -- ) I2CWR I2C! I2C! I2C.STOP ; 2415 | pub RTC! ( byte reg -- ) @RTC I2CREG! ; 2416 | --- RTC BCD STORE - store byte as BCD in RTC register 2417 | pub RTCB! ( bcd reg -- ) SWAP 10 U/MOD 4 << OR SWAP RTC! ; 2418 | 2419 | ( RTC DUMP ) 2420 | pub RTC ['] RTC@ DUP DUP DUMP! ; 2421 | 2422 | ( *** HIGH LEVEL TIME KEEPING RTC INTERFACE *** ) 2423 | 2424 | --- fast sequential read of first 7 time keeping registers 2425 | pub RDRTC 2426 | @sec 7 ERASE 2427 | @RTC 0EXIT 2428 | --- start from reg 0 2429 | I2C.START @RTC I2CPUT ?EXIT 0 I2C! 2430 | @RTC 1+ I2C! @sec 6 BOUNDS DO I2C@ I C! LOOP 2431 | nakI2C@ @year C! I2C.STOP 2432 | ; 2433 | 2434 | \ Init RTC configs etc ( not time ) on boot 2435 | pri !RTC 2436 | @RTC $D0 = IF $B4 $37 RTC! 0 $10 RTC! 0 $0F RTC! THEN 2437 | ; 2438 | 2439 | \ checks for different RTC chips and sets them up 2440 | pri ?RTC 2441 | ~rtc C~ 2442 | @sec 7 ERASE 2443 | $D0 I2CRD? IF $D0 ~rtc C! EXIT THEN 2444 | $A4 I2CRD? IF $A4 ~rtc C! EXIT THEN 2445 | ; 2446 | 2447 | 2448 | pub >HMS ( s m h -- hhmmss ) 100 * + 100 * + ; 2449 | pub BCDS ( bcds -- dec rem ) DUP >N OVER 4 >> >N 10 * + SWAP 8 >> ; 2450 | pub BCD>DEC ( bcds -- val ) BCDS BCDS BCDS DROP >HMS ; 2451 | 2452 | \ RV-3028 supports UNIX time in seconds from 1970 2453 | pub UTIME@ ( -- secs ) 0 27 4 BOUNDS DO I RTC@ OR 8 >> LOOP ; 2454 | pub UTIME! ( secs -- ) 27 4 BOUNDS DO DUP I RTC! 8 >> LOOP DROP ; 2455 | 2456 | \ pub TIME! ( hhmmss -- ) !RTC 100 U/MOD SWAP 0 RTCB! 100 U/MOD SWAP 1 RTCB! 2 RTCB! ; 2457 | pub TIME! ( hhmmss -- ) !RTC HMS 2 RTCB! 1 RTCB! 0 RTCB! ; 2458 | pub DAY! 7 AND 3 RTC! ; 2459 | pub DATE! ( yymmdd -- ) !RTC HMS 6 RTCB! 5 RTCB! 4 RTCB! ; 2460 | 2461 | 2462 | 2463 | --- read bcd fields and mask before converting to decimal 2464 | pub TIME@ RDRTC @sec U@ $3F7F7F AND BCD>DEC ; 2465 | pub DATE@ RDRTC @date U@ $FF1F3F AND BCD>DEC ; 2466 | pub DAY@ @day C@ 7 AND 1 MAX ; 2467 | 2468 | pub .DT DATE@ 6 U.R $2D EMIT TIME@ 6 Z U.R ; 2469 | 2470 | pub .HMS ( n ch -- ) >R HMS 2 Z U.R R@ EMIT 2 Z U.R R> EMIT 2 Z U.R ; 2471 | pub .DATE DATE@ ." 20" $2F .HMS ; 2472 | pub .DAY DAY@ 1- 3 * s" MONTUEWEDTHUFRISATSUN" DROP + 3 TYPE ; 2473 | pub .TIME TIME@ $3A .HMS ; 2474 | pub .FDT .DATE SPACE .DAY SPACE .TIME ; 2475 | 2476 | pub ms@ cycles 1000 U/ ; 2477 | pub secs@ ms@ 1000 U/ ; 2478 | pub QTIME@ secs@ bms @ + 60 U/MOD 60 U/MOD >HMS ; 2479 | 2480 | --- read hardware RTC and sync software time 2481 | pub QTIME! HMS 60 * + 60 * + secs@ - bms ! ; 2482 | pub !QTIME TIME@ QTIME! ; 2483 | \ 2484 | 2485 | ' .FDT ^ T CTRL! 2486 | 2487 | 2488 | 2489 | 2490 | ( *** TIMERS *** ) 2491 | 2492 | 2493 | { 2494 | timer: mytimer 2495 | 100000 mytimer TIMEOUT --- timeout in 100ms using mytimer 2496 | mytimer TIMEOUT? --- check timeout status 2497 | 2498 | } 2499 | pre TIMER: 2 (longs) ; 2500 | 2501 | pub TIMEOUT ( us timer -- ) cycles OVER ! 4 + ! ; 2502 | pub TIMEOUT? ( timer -- flg ) 2@ SWAP cycles - ABS < ; 2503 | 2504 | 2505 | 2506 | 2507 | 2508 | 2509 | pri UQUERY yellow pen bold query plain ; 2510 | 2511 | 2512 | 2513 | \ ############################################################# 2514 | \ ############################################################# 2515 | \ INIT 2516 | \ ############################################################# 2517 | \ ############################################################# 2518 | 2519 | 0 bytes org? 2520 | 2521 | 2522 | pri !TACHYON 2523 | !FAULT DATA $400 ERASE !POLLS 2524 | ['] uquery ~query ! 2525 | ['] TACHYON QUIT! 2526 | org? DATA - org 2527 | bold yellow pen CRLF *TACHYON* CRLF 2528 | ; 2529 | 2530 | ( PICO PINS ) 2531 | 2532 | 25 constant PICOLED 2533 | 23 constant PS \ Pico pwm/pfm regulaotr mode 2534 | 2535 | 2536 | ( *** PCB SPECIFIC INIT *** ) 2537 | 2538 | 2539 | 32 BUFFER: pcb 2540 | : .PCB green PEN PRINT" PCB: " pcb C@ IF pcb 1+ PRINT$ ELSE ." UNKNOWN" THEN ; 2541 | : PCB! pcb 32 ERASE pcb 1+ SWAP MOVE pcb C! ; 2542 | 2543 | : !PICO 2544 | PS HIGH !ADC $50 29 PAD! 2545 | 3 PICOLED FLASHES 2546 | bms ~ 2547 | PRINT" VSYS = " .VSYS PRINT" @" .TEMP 2548 | ; 2549 | 2550 | 2551 | { 2552 | ( MAKER PI RP2040 ) 2553 | 18 constant NEOPIXEL 2554 | 8 constant M1A 2555 | 9 constant M1B 2556 | 20 constant BTN1 2557 | 21 constant BTN2 2558 | 22 constant BUZZER 2559 | } 2560 | pub MAKERPI 2561 | 100 ms !TACHYON 2562 | \ $0F0C0B0A SDPINS ( &15.12.11.10 ) 2563 | 22 spkr C! 2564 | 18 NEOPIN $200000 NEO! 2565 | %101 S" MAKER PI RP2040" PCB! ( b0 = Pico ) 2566 | .PCB CRLF !PICO BEEP 2567 | 3 2 I2CPINS ?RTC ~rtc C@ IF !QTIME CRLF .FDT THEN 2568 | PLAIN 2569 | ; 2570 | 2571 | 2572 | 2573 | { 2574 | ( MAKER PI PICO ) 2575 | 2576 | ( microSD SPI mode ) 2577 | 10 constant SDCK 2578 | 11 constant SDDI --- CMD 2579 | 12 constant SDDO --- SDDAT0 2580 | 15 constant SDCS --- SDDAT3 2581 | 13 constant SDDAT1 2582 | 14 constant SDDAT2 2583 | 15 2584 | 16 constant ESP.8 2585 | 17 constant ESP.1 2586 | 18 constant BUZZER 2587 | 18 constant LA 2588 | 19 constant RA 2589 | 20 constant SW20 2590 | 21 constant SW21 2591 | 22 constant SW22 2592 | 23 constant PS \ Pico pwm/pfm regulaotr mode 2593 | 24 2594 | 25 constant PICOLED 2595 | 26 2596 | 27 2597 | 28 constant NEOPIXEL 2598 | 29 2599 | 2600 | } 2601 | 2602 | pub MAKERPICO 2603 | 100 ms !TACHYON 2604 | $0F0C0B0A SDPINS ( &15.12.11.10 ) 2605 | 18 spkr C! 2606 | 28 NEOPIN $200000 NEO! 2607 | %11 S" MAKER PI PICO" PCB! ( b0 = Pico ) 2608 | .PCB 2609 | CRLF !PICO BEEP 2610 | 3 2 I2CPINS ?RTC ~rtc C@ IF !QTIME CRLF .FDT THEN 2611 | SD? IF cyan pen CRLF PRINT" MOUNTING " MOUNT THEN 2612 | PLAIN 2613 | ; 2614 | 2615 | --- divert console to the ESP01 on 16 and 17 2616 | pub ESPCON 0 0 FNC 1 0 FNC 16 #UART 17 #UART ( UART0 115200 BAUD ) ; 2617 | pub SERCON 16 0 FNC 17 0 FNC 0 #UART 1 #UART ; 2618 | 2619 | 256 bytes chats 2620 | 2621 | pri TKEY? ( us -- ) cycles BEGIN 2DUP cycles - ABS < KEY? OR UNTIL 2DROP KEY? ; 2622 | 2623 | pri ESPCOM 2624 | 5 ms ESPCON 115200 BAUD chats SWAP TYPE $0D EMIT 2625 | chats BEGIN 20000 TKEY? WHILE KEY OVER C! 1+ 0 OVER C! REPEAT 2626 | DROP 5 ms SERCON 921600 BAUD chats PRINT$ 2627 | ; 2628 | pub ESPCHAT 2629 | BEGIN 2630 | UART0 921600 BAUD chats 64 ACCEPT ?DUP 2631 | WHILE 2632 | ESPCOM 2633 | REPEAT 2634 | ; 2635 | 2636 | --- Single line ESP command and response 2637 | pub AT $41 chats C! $54 chats 1+ C! chats 2+ 66 ACCEPT ?DUP IF 2+ ESPCOM THEN ; 2638 | 2639 | 2640 | ( AT+CWJAP=,[,] ) 2641 | 2642 | 2643 | pub PICO 2644 | 100 ms !TACHYON 2645 | %01 S" RASPBERRY PI PICO" PCB! 2646 | .PCB 2647 | CRLF !PICO 2648 | ; 2649 | 2650 | { 2651 | *** MAIN INIT *** 2652 | Include your board specific inits here (or call this from your INIT) 2653 | Most drivers are runtime configurable so there is no need to modify the 2654 | source code other than this INIT, your INIT, or your INIT that calls this INIT 2655 | 2656 | } 2657 | 2658 | 2659 | \ : INIT MAKERPICO ; 2660 | \ : INIT MAKERPI ; 2661 | 2662 | : INIT PICO ; 2663 | 2664 | 2665 | 2666 | { 2667 | README: USER INITS 2668 | For user specific inits just create a new INIT and 2669 | call !TACHYON first up, then any specific inits 2670 | 2671 | OR SIMPLY ase a predefined INIT after loading the source: 2672 | compiletoflash 2673 | : INIT MAKERPICO ; 2674 | compiletoram 2675 | SAVE 2676 | 2677 | 2678 | 2679 | } 2680 | 2681 | 2682 | ' CLS ^ L CTRL! 2683 | 2684 | { 2685 | README: 2686 | Try to use my 921600bd UF2 Mecrisp mod 2687 | and try not to change the source code either because all the pinouts 2688 | are runtime configurable for all devices including SD card etc. 2689 | save original clean kernel with 1 SAVE# - send/paste then type SAVE 2690 | If you want to update an old version of this, type 1 LOAD# for original kernel then paste. 2691 | 2692 | !!! To customize try to keep all changes to INIT (Read the INIT header at the end ) 2693 | I have also isolated the Maker Pi Pico settings from INIT itself 2694 | type MAKERPI to setup the board manually or make a new INIT in Flash. 2695 | I am also including other board configurations such as Pico etc 2696 | 2697 | Linux systems can use ASCII-XFR along with the FL.FTH file for 2698 | super fast 0 delay loads - less than 1.5sec for this file from go to whoa. 2699 | I use this script in Linux which I name fl 2700 | # transfer text file 2701 | # usage: ./fl RP2040 0 2702 | ascii-xfr -sn -l 5 Forth/FL.FTH > /dev/ttyUSB$2 2703 | ascii-xfr -sn Forth/$1.FTH > /dev/ttyUSB$2 2704 | 2705 | CHANGELOG: 2706 | 220503 Modify ` to handle up to 4 characters ` PUB .L --- 00505542 2707 | Add extended bit operations setb clrb togb bit? 2708 | 220501 Change CR to CR only - make CRLF standard 2709 | Add -FLOAD, FGET, FPUT 2710 | 2711 | 220428 Add UTF8 and EMOJI 2712 | 220426 Added SDRDS 2713 | Added QTIME! which synchs the software time with an RTC or manually 2714 | Updated QTIME@ 2715 | 220424 Used PWM hardware for tones 2716 | Add BIT and .DP 2717 | 220417 Updated PWM methods - now frequency does not change with duty 2718 | HZ and KHZ set an optimal frame cycle with a 50% duty 2719 | Added init for org using last data variable in this module (!!! make it search for the name) 2720 | 220415 add HH! and LH! for high and low word store 2721 | Update PWM words - some bugs since using PIN 2722 | 220411 Remove pin parameter from PWM settings and use a general PIN to set first 2723 | 2724 | 2204XX Added ` instead of [CHAR] or CHAR for ASCII literals: ` A .B --- 41 2725 | Added ^ for control characters: ^ A .B --- 01 2726 | Added IP# for IP notation: IP# 192.168.0.101 .L --- C0A80065 2727 | 220403 Added |< .BYTE etc 2728 | Added ` to replace [CHAR] and CHAR 2729 | Added Tachyon Mecrisp Extensions vesion time stamp "tme" (unsigned) 2730 | 211220 Added ESP module support for Maker Pi Pico 2731 | 211214 2732 | 211201 Standardize pin assignments and setup pcb specific handlers 2733 | - I2C bus on 2&3 may use I2C h/w in future 2734 | - User INIT can now simply call !TACHYON and then user inits 2735 | 2736 | 211130 Fixed compile report to list new defintions during block load 2737 | 211129 Changed I2C SCL to pulse high then float to PU 2738 | I2C now waits for SCL high with 200us timeout (clock stretching) 2739 | 211126 Rename signed << and >> to <<< and >>> 2740 | recreate simple << and >> 2741 | 211124 Make SD configuration manual (inc MAKERPI ) 2742 | SD? returns false if not configured 2743 | 211122 Added TIMEOUT words 2744 | 211119 Tweaked SD read speeds - loads bmp in half the time 2745 | 211118 Add lap timing to MECRISP *END* reports 2746 | 211117 Remove CON from TACHYON QUIT loop 2747 | 2748 | 211113 Fixed neopixel timing 2749 | added revectorable query - later set to bold for user input 2750 | added .CTRLS linked to ^? to list control keys 2751 | 211111 Make RTC address user settable 2752 | 211110 Added I2C and RTC 2753 | 211024 Added polling via QKEY 2754 | } 2755 | 2756 | 2757 | 2758 | compiletoram 2759 | *END* 2760 | -------------------------------------------------------------------------------- /rp2040/mecrisp/README.md: -------------------------------------------------------------------------------- 1 | # Installation of Mecrisp-Stellaris Forth kernel with Tachyon extension 2 | 3 | This directory contains four utility shell scripts, it may be necessary to mark them as executable before you can use them: 4 | ```bash 5 | RP2040$ chmod +x acm qt s usb 6 | ``` 7 | 8 | The utilities are: 9 | * `acm`: script to start `minicom` on a /dev/ttyACM***x*** interface at 921600bd. To use specify the number of the ttyACM port that is being used (generally a digit 0-5). This is particularly used when operating with a separate Pico programmed as a multiport serial bridge. 10 | * `usb`: as with `acm` above this will start a `minicom` session but on a /dev/ttyUSB***x*** interface. In use the number of the port is specified in the same way. This is most commonly found when using commercial USB-Serial adapters. 11 | * `s`: script to send a file to a port it assumes that the port dynamics have already been set up by opening a `minicom` session in a separate window. `s` utilises the standard linux `ascii-xfr` utility. Use by passing three parameters: 12 | 1. The trunk of the filename from the `Forth/` directory (i.e. without the `.FTH` extension); 13 | 2. The name of the tty port to send to, e.g. `ACM0`, `ACM1`, `USB0`, and so on; 14 | 3. The time in milliseconds to wait at the end of each line sent, e.g. 5 or 7. 15 | 16 | * `qt`: script to sync host time with system time. Use required the name of the appropriate tty port as above. 17 | 18 | ## Main flash kernel 19 | 20 | Load *mecrisp-2.61-921600bd.uf2* onto the RP2040/Pico by holding down the **BOOTSEL** button whilst connecting the board and then copying the .uf2 file to the revealed memory drive. Once the .uf2 file has been written to the flash memory on the RP2040/Pico it will reboot and start to communicate on the first UART (pins 1 and 2 of the Pico, or Grove port 1 of a Maker Pi Pico). To communicate it is necessary to have a separate serial connection to your main computer, this can be achieved using an existing on board serial port, a commercial USB-Serial adapter or a second Pico programmed as a serial adapter. 21 | 22 | In a separate linux terminal startup minicom in ANSI mode 921600bd and `^AU` to get it to add a CR (Mecrisp outputs a single LF instead of CRLF) 23 | 24 | After booting do a `1 SAVE#` to make a backup of the clean kernel. 25 | 26 | ## Loading Tachyon extension 27 | 28 | With the main kernel loaded and `minicom` being used to view it in a terminal window any command will be acknowledged with a simple 'ok.'. Adding in the Tachyon extensions will provide more feedback as well as extra functionality. One of the first and most obvious elements of the extensions is the provision of a command prompt consisting of a letter, a couple of digits and a hash symbol. The letter reflects the destination of any compiled definations, 'R' for ram and 'F' for flash; and the digits reflect the number of items on the parameter stack. 29 | 30 | Leaving the `minicon` terminal open, open a second command terminal (of, if you're using **Visual Studio Code**, the use the built in terminal) at the RP2040 directory where the utility scripts are. Use the `s` utility script to load `TACHYON.FTH` with a 7ms line-delay. As an example, if you have a serial port running on /dev/ttyUSB0, the following command will send the file: 31 | ```bash 32 | RP2040$ ./s TACHYON USB0 7 33 | ``` 34 | 35 | You can monitor the loading in the `minicom` window and will notice that part way through the load it switches to the new source load mode so that only the definition names and any messages are shown, then a final report. 36 | 37 | ## Extra action for the Maker Pi Pico 38 | 39 | For the Maker Pi Pico which has an SD socket create a new init in flash by entering the following into the `minicom` terminal. 40 | ```forth 41 | R00# compiletoflash 42 | F00# : INIT MAKERPICO ; 43 | F00# compiletoram 44 | R00# SAVE 45 | ``` 46 | 47 | ## Using an SD card 48 | 49 | An SD card can be added by either using the Maker Pi Pico card or by adding a discrete card socket to the GP10-GP19 ports although any random port pins may be used as pins are bit-bashed and assignable with SDPINS. 50 | 51 | Insert a FAT32 SD card - preferably blank or just 8.3 files but optional load the latest on-going incomplete HELP file onto the card. 52 | 53 | Hit `^C` to get it to reboot and it also mount the card if your `INIT` is correct. 54 | 55 | ## Editing files on the SD card 56 | 57 | Following the same procedure as for loading Tachyon, load `FRED.FTH` 58 | ```bash 59 | RP2040$ ./s FRED USB0 5 60 | ``` 61 | In the minicom terminal you should now `SAVE`. 62 | 63 | Create a new file called TEMP for example 64 | ```forth 65 | R00# EDNEW TEMP 66 | ``` 67 | This may take a moment as it claims clusters and creates a default 1MB file and preformats it with spaces and CR terminators. This TEMP can be your playground. 68 | 69 | Type some code and `^S` to save the 4K page then F10 to load it etc. 70 | 71 | Return to editing by typing `ED`. 72 | -------------------------------------------------------------------------------- /rp2040/mecrisp/acm: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | # 3 | if [ -z "$1" ]; then 4 | echo Start a minicom session with the specified system 5 | echo -e 6 | echo Usage: 7 | echo " $0 " 8 | if ls /dev/ttyACM* 1> /dev/null 2>&1; then 9 | echo Available ports: 10 | for fn in /dev/ttyACM*; do 11 | echo -n " ${fn#*ttyACM}" 12 | done 13 | echo -e 14 | else 15 | echo No suitable ports found. 16 | fi 17 | exit 1 18 | fi 19 | minicom --color=on -w -b 921600 -D /dev/ttyACM$1 20 | 21 | -------------------------------------------------------------------------------- /rp2040/mecrisp/mecrisp-2.61-921600bd.uf2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/forth2020/tachyon/861e6c756e4c237eb1540497dfee84cb7a11647f/rp2040/mecrisp/mecrisp-2.61-921600bd.uf2 -------------------------------------------------------------------------------- /rp2040/mecrisp/qt: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | # 3 | if [ -z "$1" ]; then 4 | echo Sync target time/RTC with system time 5 | echo -e 6 | echo Usage: 7 | echo " $0 " 8 | echo " The serial port should fully reflect ACM or USB followed by a digit" 9 | p_found=0 10 | for fl in "/dev/ttyACM" "/dev/ttyUSB"; do 11 | if ls $fl* 1> /dev/null 2>&1; then 12 | echo Available ports: 13 | for fn in $fl*; do 14 | echo -n " ${fn#*tty}" 15 | done 16 | p_found=1 17 | fi 18 | done 19 | if [ $p_found -eq 1 ]; then 20 | echo -e 21 | else 22 | echo No suitable ports found. 23 | fi 24 | exit 1 25 | fi 26 | date +'%g%m%d DATE! %H%M%S QTIME!' > /dev/tty$1 && echo -e "\r" > /dev/tty$1 27 | -------------------------------------------------------------------------------- /rp2040/mecrisp/s: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | # 3 | # transfer text file with extra line delay for UB3 serial 4 | if [ -z "$1" ]; then 5 | echo Send a Forth module to the target system via the specified serial port 6 | echo -e 7 | echo Usage: 8 | echo " $0 " 9 | echo " The forth module should reside in the Forth directory and should not specify the .FTH extension" 10 | echo " The serial port should fully reflect ACM or USB followed by a digit" 11 | echo " The line delay is specified in milliseconds" 12 | if ls ./Forth/*.FTH 1> /dev/null 2>&1; then 13 | echo Forth modules: 14 | for fn in ./Forth/*.FTH; do 15 | fn_=${fn#*Forth/} 16 | echo -n " ${fn_%.FTH}" 17 | done 18 | echo -e 19 | else 20 | echo No Forth modules found. 21 | exit 1 22 | fi 23 | p_found=0 24 | for fl in "/dev/ttyACM" "/dev/ttyUSB"; do 25 | if ls $fl* 1> /dev/null 2>&1; then 26 | echo Available ports: 27 | for fn in $fl*; do 28 | echo -n " ${fn#*tty}" 29 | done 30 | p_found=1 31 | fi 32 | done 33 | if [ $p_found -eq 1 ]; then 34 | echo -e 35 | else 36 | echo No suitable ports found. 37 | fi 38 | exit 1 39 | fi 40 | ascii-xfr -sn -l $3 Forth/$1.FTH > /dev/tty$2 41 | date +'%g%m%d DATE! %H%M%S QTIME!' > /dev/tty$2 && echo -e "\r" > /dev/tty$2 42 | -------------------------------------------------------------------------------- /rp2040/mecrisp/usb: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | # 3 | if [ -z "$1" ]; then 4 | echo Start a minicom session with the specified system 5 | echo -e 6 | echo Usage: 7 | echo " $0 " 8 | if ls /dev/ttyUSB* 1> /dev/null 2>&1; then 9 | echo Available ports: 10 | for fn in /dev/ttyUSB*; do 11 | echo -n " ${fn#*ttyUSB}" 12 | done 13 | echo -e 14 | else 15 | echo No suitable ports found. 16 | fi 17 | exit 1 18 | fi 19 | minicom --color=on --ansi -w -b 921600 -D /dev/ttyUSB$1 20 | 21 | --------------------------------------------------------------------------------