summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/display.fs
diff options
context:
space:
mode:
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/display.fs')
-rw-r--r--qemu/roms/SLOF/slof/fs/display.fs123
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
+;
+