text now supports upper/lowercase

CHANGELOG

@@ -346,3 +346,4 @@ UNRELEASED
  * forth: accept now reads keyboard only
 [Fixed]
  * sprite: sp-on, sp-off had inverted sprite number
+ * gfx: text now supports upper/lower case

forth_src/gfx.fs

@@ -6,7 +6,7 @@ code kernal-in
 code kernal-out
 sei, 35 lda,# 1 sta, ;code
 
-code hires 
+code hires
 bb lda,# d011 sta, \ enable bitmap mode
 dd00 lda,
 %11111100 and,# \ vic bank 2
@@ -19,7 +19,7 @@ code lores
 dd00 lda,
 %11 ora,#
 dd00 sta,
-17 lda,# 
+17 lda,#
 d018 sta,
 ;code
 
@@ -104,7 +104,7 @@ if 2drop else doplot then ;
 
 : plot ( x y -- )
 kernal-out
-2dup peny ! penx ! chkplot 
+2dup peny ! penx ! chkplot
 kernal-in ;
 
 : peek ( x y -- b )
@@ -177,7 +177,7 @@ sy lda, 1 cmp,# +branch beq,
 addr lda, 7 and,# +branch bne,
 sec, addr lda, 38 sbc,# addr sta,
 addr 1+ lda, 1 sbc,# addr 1+ sta,
-:+ 
+:+
 addr lda, 3 bne, addr 1+ dec, addr dec,
 lineplot jmp,
 :+ \ down
@@ -195,15 +195,15 @@ err 1+ lda, 2err 1+ sta,
 
 \ step up/down
 
-\ 2err @ dy2 @ > if 
+\ 2err @ dy2 @ > if
 sec, dy2 lda, 2err sbc,
 dy2 1+ lda, 2err 1+ sbc,
 3 bmi, stepx jmp,
 
 \ dy2 @ err +!
 clc, dy2 lda, err adc, err sta,
 dy2 1+ lda, err 1+ adc, err 1+ sta,
-\ sx @ penx +! 
+\ sx @ penx +!
 clc, sx lda, penx adc, penx sta,
 sx 1+ lda, penx 1+ adc, penx 1+ sta,
 
@@ -286,7 +286,7 @@ repeat 2drop kernal-in ;
 
 : erase if
 4d ['] xor else
-d ['] or then ['] blitop @ ! 
+d ['] or then ['] blitop @ !
 ['] blitop 2+ @ c! ;
 
 \ --------------------------
@@ -352,13 +352,13 @@ lsb lda,x w sta,
 msb lda,x w 1+ sta,
 0 ldy,# w lda,(y)
 lsb 1+ ora,x w sta,(y)
-\ 1 penx +! swap 2/ swap 
+\ 1 penx +! swap 2/ swap
 penx inc, 3 bne, penx 1+ inc,
 lsb 1+ lsr,x rts,
 
 create rightend
 \ nip 80 swap \ mask
-80 lda,# lsb 1+ sta,x 
+80 lda,# lsb 1+ sta,x
 0 lda,# msb 1+ sta,x
 
 :-
@@ -370,7 +370,7 @@ lsb 1+ and,x 1 beq, rts,
 .bitblt jsr, jmp, \ recurse
 
 create bytewise
-\ penx @ 140 < if 
+\ penx @ 140 < if
 penx 1+ lda, 0 cmp,# +branch beq,
 3f lda,# penx cmp, 1 bcs, rts,
 :+
@@ -396,7 +396,7 @@ clc, penx lda, 8 adc,# penx sta,
 jmp, \ recurse
 
 create leavel
-\ 2drop nip penx @ swap 
+\ 2drop nip penx @ swap
 inx, inx,
 penx lda, lsb 1+ sta,x
 penx 1+ lda, msb 1+ sta,x rts,
@@ -416,7 +416,7 @@ dex, dex,
 lsb 2 + lda,x lsb sta,x
 msb 2 + lda,x msb sta,x
 lsb 3 + lda,x lsb 1+ sta,x
-msb 3 + lda,x msb 1+ sta,x 
+msb 3 + lda,x msb 1+ sta,x
 ' blitloc jsr,
 
 \ leftend ( x y mask addr --
@@ -450,17 +450,17 @@ mask ora, w sta,(y)
 
 mask asl, +branch bcc,
 1 lda,# mask sta,
-addr lda, sec, 8 sbc,# addr sta, 
+addr lda, sec, 8 sbc,# addr sta,
 3 bcs, addr 1+ dec,
 
 :+ \ 1-
-lsb 1+ lda,x 2 bne, msb 1+ dec,x 
+lsb 1+ lda,x 2 bne, msb 1+ dec,x
 lsb 1+ dec,x
 jmp, \ recurse
 
 create .scanr
 \ over l ! \ l=x
-lsb 1+ lda,x l sta, 
+lsb 1+ lda,x l sta,
 msb 1+ lda,x l 1+ sta,
 ;code
 
@@ -516,7 +516,7 @@ over x1 @ \ y x y x x1
 branch [ here dy ! 0 , ] \ goto skip
 then
 \ y x y ...
-over 1+ dup l ! 
+over 1+ dup l !
 \ y x y l
 x1 @ < if \ l < x1?
 \ push y,l,x1-1,-dy
@@ -540,12 +540,47 @@ then
 [ here dy @ ! ]
 
 swap 1+ swap
-2dup blitloc scanr 
+2dup blitloc scanr
 
 \ y x y
 over x2 @ > until
 
-2drop drop repeat kernal-in ; 
+2drop drop repeat kernal-in ;
+
+here
+80 c, 81 c, 82 c, 83 c, 84 c, 85 c, 86 c, 87 c, \ 0
+88 c, 89 c, 8a c, 8b c, 8c c, 8d c, 8e c, 8f c,
+90 c, 91 c, 92 c, 93 c, 94 c, 95 c, 96 c, 97 c, \ 1
+98 c, 99 c, 9a c, 9b c, 9c c, 9d c, 9e c, 9f c,
+20 c, 21 c, 22 c, 23 c, 24 c, 25 c, 26 c, 27 c, \ 2
+28 c, 29 c, 2a c, 2b c, 2c c, 2d c, 2e c, 2f c,
+30 c, 31 c, 32 c, 33 c, 34 c, 35 c, 36 c, 37 c, \ 3
+38 c, 39 c, 3a c, 3b c, 3c c, 3d c, 3e c, 3f c,
+00 c, 01 c, 02 c, 03 c, 04 c, 05 c, 06 c, 07 c, \ 4
+08 c, 09 c, 0a c, 0b c, 0c c, 0d c, 0e c, 0f c,
+10 c, 11 c, 12 c, 13 c, 14 c, 15 c, 16 c, 17 c, \ 5
+18 c, 19 c, 1a c, 1b c, 1c c, 1d c, 1e c, 1f c,
+40 c, 41 c, 42 c, 43 c, 44 c, 45 c, 46 c, 47 c, \ 6
+48 c, 49 c, 4a c, 4b c, 4c c, 4d c, 4e c, 4f c,
+50 c, 51 c, 52 c, 53 c, 54 c, 55 c, 56 c, 57 c, \ 7
+58 c, 59 c, 5a c, 5b c, 5c c, 5d c, 5e c, 5f c,
+c0 c, c1 c, c2 c, c3 c, c4 c, c5 c, c6 c, c7 c, \ 8
+c8 c, c9 c, ca c, cb c, cc c, cd c, ce c, cf c,
+d0 c, d1 c, d2 c, d3 c, d4 c, d5 c, d6 c, d7 c, \ 9
+d8 c, d9 c, da c, db c, dc c, dd c, de c, df c,
+60 c, 61 c, 62 c, 63 c, 64 c, 65 c, 66 c, 67 c, \ a
+68 c, 69 c, 6a c, 6b c, 6c c, 6d c, 6e c, 6f c,
+70 c, 71 c, 72 c, 73 c, 74 c, 75 c, 76 c, 77 c, \ b
+78 c, 79 c, 7a c, 7b c, 7c c, 7d c, 7e c, 7f c,
+40 c, 41 c, 42 c, 43 c, 44 c, 45 c, 46 c, 47 c, \ c
+48 c, 49 c, 4a c, 4b c, 4c c, 4d c, 4e c, 4f c,
+50 c, 51 c, 52 c, 53 c, 54 c, 55 c, 56 c, 57 c, \ d
+58 c, 59 c, 5a c, 5b c, 5c c, 5d c, 5e c, 5f c,
+60 c, 61 c, 62 c, 63 c, 64 c, 65 c, 66 c, 67 c, \ e
+68 c, 69 c, 6a c, 6b c, 6c c, 6d c, 6e c, 6f c,
+70 c, 71 c, 72 c, 73 c, 74 c, 75 c, 76 c, 77 c, \ f
+78 c, 79 c, 7a c, 7b c, 7c c, 7d c, 7e c, 5e c,
+: pet>scr literal + c@ ;
 
 : text ( col row str strlen -- )
 kernal-out
@@ -555,7 +590,7 @@ rot 8 * bmpbase + addr +!
 \ disable interrupt,enable char rom
 1 c@ dup >r fb and 1 c!
 begin ?dup while
-swap dup c@ 8 * d800 + \ strlen str ch
+swap dup c@ pet>scr 8 * d800 +
 addr @ 8 move
 1+ swap 8 addr +! 1- repeat
 r> 1 c! drop kernal-in ;