C128: support graphics on VIC display

forth_src/gfx.fs

@@ -1,4 +1,47 @@
 base @ hex
+
+native-c128? [if]
+(
+The C128's MMU has 'magic' addresses 
+at $ff00-$ff04 that our bitmap must not
+interfere with; so the bitmap must start
+at $c000, with the color map at $e000.
+Note that this means part of the bitmap
+is under IO space, so clrcol and blkcol
+can no longer 'blindly' write to it.
+)
+
+c000 value bmpbase
+e000 value colbase
+
+code kernal-in
+%00001110 lda,# $ff00 sta, cli, ;code
+code kernal-out
+sei, %00111111 lda,# $ff00 sta, ;code
+
+code hires
+\ VIC bank = $c000
+$dd00 lda, %11111100 and,# $dd00 sta,
+
+\ Use Kernal variables to set up screen
+\ mode. The Kernal IRQ handler picks
+\ these up and sets up the VIC
+\ accordingly.
+
+\ hi-res mode
+%00100000 lda,# $d8 sta,
+\ VIC sees RAM instead of character ROM
+%00000100 lda,# $d9 sta,
+\ value at $0a2d gets put into $d018
+$80 lda,# $0a2d sta,
+;code
+
+code lores
+$dd00 lda, %00000011 ora,# $dd00 sta,
+$0 lda,# $d8 sta, $d9 sta,
+$78 lda,# $0a2d sta,
+;code
+[else]
 e000 value bmpbase
 cc00 value colbase
 
@@ -23,13 +66,18 @@ dd00 sta,
 17 lda,#
 d018 sta,
 ;code
+[then]
 
 : clrcol ( fgbgcol -- )
+[ native-c128? ] [if] kernal-out [then]
 colbase 3e8 rot fill
-bmpbase 1f40 0 fill ;
+bmpbase 1f40 0 fill 
+[ native-c128? ] [if] kernal-in [then] ;
 
 : blkcol ( col row c -- )
--rot 28 * + colbase + c! ;
+[ native-c128? ] [if] kernal-out [then]
+-rot 28 * + colbase + c!
+[ native-c128? ] [if] kernal-in [then] ;
 
 header mask
 80 c, 40 c, 20 c, 10 c,
@@ -89,7 +137,8 @@ w lda,(y) w3 sta,
 
 clc,
 lsb 1+ lda,x f8 and,# lsb adc,x lsb sta,x
-msb 1+ lda,x msb adc,x clc, e0 adc,# msb sta,x
+msb 1+ lda,x msb adc,x clc, 
+bmpbase 100/ adc,# msb sta,x
 w3 lda, lsb 1+ sta,x
 0 lda,# msb 1+ sta,x
 rts,
@@ -587,13 +636,23 @@ kernal-out
 \ addr=dst
 rot 140 * addr !
 rot 8 * bmpbase + addr +!
-\ disable interrupt,enable char rom
+\ enable char rom
+[ native-c128? ] [if]
+$ff00 c@ dup >r 
+%11001111 and %00000001 or $ff00 c!
+[else]
 1 c@ dup >r fb and 1 c!
+[then]
 begin ?dup while
 swap dup c@ pet>scr 8 * d800 +
 addr @ 8 move
 1+ swap 8 addr +! 1- repeat
-r> 1 c! drop kernal-in ;
+[ native-c128? ] [if]
+r> $ff00 c!
+[else]
+r> 1 c! 
+[then]
+drop kernal-in ;
 
 : drawchar ( col row srcaddr -- )
 kernal-out