diff options
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/display.fs')
-rw-r--r-- | qemu/roms/SLOF/slof/fs/display.fs | 123 |
1 files changed, 123 insertions, 0 deletions
diff --git a/qemu/roms/SLOF/slof/fs/display.fs b/qemu/roms/SLOF/slof/fs/display.fs new file mode 100644 index 000000000..5bb8797a2 --- /dev/null +++ b/qemu/roms/SLOF/slof/fs/display.fs @@ -0,0 +1,123 @@ +\ ***************************************************************************** +\ * Copyright (c) 2004, 2008 IBM Corporation +\ * All rights reserved. +\ * This program and the accompanying materials +\ * are made available under the terms of the BSD License +\ * which accompanies this distribution, and is available at +\ * http://www.opensource.org/licenses/bsd-license.php +\ * +\ * Contributors: +\ * IBM Corporation - initial implementation +\ ****************************************************************************/ + +0 VALUE char-height +0 VALUE char-width +0 VALUE fontbytes + +CREATE display-emit-buffer 20 allot + +\ \\\\\\\\\\\\\\ Global Data + +\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods + +\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) +\ * +\ * +defer dis-old-emit +' emit behavior to dis-old-emit + +: display-write terminal-write ; +: display-emit dup dis-old-emit display-emit-buffer tuck c! 1 terminal-write drop ; + +\ \\\\\\\\\\\\\\ Exported Interface: +\ * +\ Generic device methods: +\ * + + +\ \\\\\\\\\\\\\\ Exported Interface: +\ * +\ IEEE 1275 : display device driver initialization +\ * +: is-install ( 'open -- ) + s" defer vendor-open to vendor-open" eval + s" : open deadbeef vendor-open dup deadbeef = IF drop true ELSE nip THEN ;" eval + s" defer write ' display-write to write" eval + s" : draw-logo ['] draw-logo CATCH IF 2drop 2drop THEN ;" eval + s" : reset-screen ['] reset-screen CATCH drop ;" eval +; + +: is-remove ( 'close -- ) + s" defer close to close" eval +; + +: is-selftest ( 'selftest -- ) + s" defer selftest to selftest" eval +; + + +STRUCT + cell FIELD font>addr + cell FIELD font>width + cell FIELD font>height + cell FIELD font>advance + cell FIELD font>min-char + cell FIELD font>#glyphs +CONSTANT /font + +CREATE default-font-ctrblk /font allot default-font-ctrblk + dup font>addr 0 swap ! + dup font>width 8 swap ! + dup font>height -10 swap ! + dup font>advance 1 swap ! + dup font>min-char 20 swap ! + font>#glyphs 7f swap ! + +: display-default-font ( str len -- ) + romfs-lookup dup 0= IF drop EXIT THEN + 600 <> IF ." Only support 60x8x16 fonts ! " drop EXIT THEN + default-font-ctrblk font>addr ! +; + +s" default-font.bin" display-default-font + +\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) +\ * +\ * + + +\ \\\\\\\\\\\\\\ Exported Interface: +\ * +\ Generic device methods: +\ * +: .scan-lines ( height -- scanlines ) dup 0>= IF 1- ELSE negate THEN ; + + +\ \\\\\\\\\\\\\\ Exported Interface: +\ * +\ * + +: set-font ( addr width height advance min-char #glyphs -- ) + default-font-ctrblk /font + /font 0 + DO + 1 cells - dup >r ! r> 1 cells + +LOOP drop + default-font-ctrblk dup font>height @ abs to char-height + dup font>width @ to char-width font>advance @ to fontbytes +; + +: >font ( char -- addr ) + dup default-font-ctrblk dup >r font>min-char @ dup r@ font>#glyphs + within + IF + r@ font>min-char @ - + r@ font>advance @ * r@ font>height @ .scan-lines * + r> font>addr @ + + ELSE + drop r> font>addr @ + THEN +; + +: default-font ( -- addr width height advance min-char #glyphs ) + default-font-ctrblk /font 0 DO dup cell+ >r @ r> 1 cells +LOOP drop +; + |