qemu/roms/SLOF/slof/fs/fbuffer.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 IBM Corporation
   3 \ * All rights reserved.
   4 \ * This program and the accompanying materials
   5 \ * are made available under the terms of the BSD License
   6 \ * which accompanies this distribution, and is available at
   7 \ * http://www.opensource.org/licenses/bsd-license.php
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13 #include "terminal.fs"
  14 #include "display.fs"
  15
  16 \ \\\\\\\\\\\\\\ Global Data
  17
  18 0 VALUE frame-buffer-adr
  19 0 VALUE screen-height
  20 0 VALUE screen-width
  21 0 VALUE screen-depth
  22 0 VALUE window-top
  23 0 VALUE window-left
  24
  25 0 VALUE .sc
  26
  27 : screen-#rows  ( -- rows )
  28    .sc IF
  29       screen-height char-height /
  30     ELSE
  31       true to .sc
  32       s" screen-#rows" eval
  33       false to .sc
  34     THEN
  35 ;
  36
  37 : screen-#columns ( -- columns )
  38    .sc IF
  39       screen-width char-width /
  40    ELSE
  41       true to .sc
  42       s" screen-#columns" eval
  43       false to .sc
  44    THEN
  45 ;
  46
  47 \ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
  48
  49
  50 \ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
  51 \ *
  52 \ *
  53
  54 : fb8-background inverse? ;
  55 : fb8-foreground inverse? invert ;
  56
  57 : fb8-lines2bytes ( #lines -- #bytes ) char-height * screen-width * screen-depth * ;
  58 : fb8-columns2bytes ( #columns -- #bytes ) char-width * screen-depth * ;
  59 : fb8-line2addr ( line# -- addr )
  60         char-height * window-top + screen-width * screen-depth *
  61         frame-buffer-adr + window-left screen-depth * +
  62 ;
  63
  64 : fb8-erase-block ( addr len ) fb8-background rfill ;
  65
  66
  67 0 VALUE .ab
  68 CREATE bitmap-buffer 400 4 * allot
  69
  70 : active-bits ( -- new ) .ab dup 8 > IF 8 - to .ab 8 ELSE
  71                 char-width to .ab ?dup 0= IF recurse THEN
  72         THEN ;
  73
  74 : fb8-char2bitmap ( font-height font-addr -- bitmap-buffer )
  75         bitmap-buffer >r
  76         char-height rot 0> IF r> char-width 2dup fb8-erase-block + >r 1- THEN
  77
  78         r> -rot char-width to .ab
  79         ( fb-addr font-addr font-height )
  80         fontbytes * bounds ?DO
  81                 i c@ active-bits 0 ?DO
  82                         dup 80 and IF fb8-foreground ELSE fb8-background THEN
  83                         ( fb-addr fbyte colr ) 2 pick ! 1 lshift
  84                         swap screen-depth + swap
  85                 LOOP drop
  86         LOOP drop
  87         bitmap-buffer
  88 ;
  89
  90 \ \\\\\\\\\\\\\\ Exported Interface:
  91 \ *
  92 \ * IEEE 1275: Frame buffer support routines
  93 \ *
  94
  95 : fb8-draw-logo ( line# addr width height -- ) ." fb8-draw-logo ( " .s ."  )" cr
  96         2drop 2drop
  97 ;
  98
  99 : fb8-toggle-cursor ( -- )
 100         line# fb8-line2addr column# fb8-columns2bytes +
 101         char-height 0 ?DO
 102                 char-width screen-depth * 0 ?DO dup dup rb@ -1 xor swap rb! 1+ LOOP
 103                 screen-width screen-depth * + char-width screen-depth * -
 104         LOOP drop
 105 ;
 106
 107 : fb8-draw-character ( char -- )
 108     >r default-font over + r@ -rot between IF
 109         2swap 3drop r> >font fb8-char2bitmap ( bitmap-buf )
 110         line# fb8-line2addr column# fb8-columns2bytes + ( bitmap-buf fb-addr )
 111         char-height 0 ?DO
 112                 2dup char-width screen-depth * mrmove
 113                 screen-width screen-depth * + >r char-width screen-depth * + r>
 114         LOOP 2drop
 115     ELSE 2drop r> 3drop THEN
 116 ;
 117
 118 : fb8-insert-lines ( n -- )
 119         fb8-lines2bytes >r line# fb8-line2addr dup dup r@ +
 120         #lines line# - fb8-lines2bytes r@ - rmove
 121         r> fb8-erase-block
 122 ;
 123
 124 : fb8-delete-lines ( n -- )
 125         fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + swap
 126         #lines fb8-lines2bytes r@ - dup >r rmove
 127         r> + r> fb8-erase-block
 128 ;
 129
 130 : fb8-insert-characters ( n -- )
 131         line# fb8-line2addr column# fb8-columns2bytes + >r
 132         #columns column# - 2dup >= IF
 133                 nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
 134         ELSE
 135                 fb8-columns2bytes swap fb8-columns2bytes tuck -
 136                 over r@ tuck + rot char-height 0 ?DO
 137                         3dup rmove
 138                         -rot screen-width screen-depth * tuck + -rot + swap rot
 139                 LOOP
 140                 3drop r>
 141         THEN
 142         char-height 0 ?DO
 143                 dup 2 pick fb8-erase-block screen-width screen-depth * +
 144         LOOP
 145         2drop
 146 ;
 147
 148 : fb8-delete-characters ( n -- )
 149         line# fb8-line2addr column# fb8-columns2bytes + >r
 150         #columns column# - 2dup >= IF
 151                 nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
 152         ELSE
 153                 fb8-columns2bytes swap fb8-columns2bytes tuck -
 154                 over r@ + 2dup + r> swap >r rot char-height 0 ?DO
 155                         3dup rmove
 156                         -rot screen-width screen-depth * tuck + -rot + swap rot
 157                 LOOP
 158                 3drop r> over -
 159         THEN
 160         char-height 0 ?DO
 161                 dup 2 pick fb8-erase-block screen-width screen-depth * +
 162         LOOP
 163         2drop
 164 ;
 165
 166 : fb8-reset-screen ( -- ) ( Left as no-op by design ) ;
 167
 168 : fb8-erase-screen ( -- )
 169         frame-buffer-adr screen-height screen-width * screen-depth * fb8-erase-block
 170 ;
 171
 172 : fb8-invert-screen ( -- )
 173         frame-buffer-adr screen-height screen-width * screen-depth * 2dup /x / 0 ?DO
 174                 dup rx@ -1 xor over rx! xa1+
 175         LOOP 3drop
 176 ;
 177
 178 : fb8-blink-screen ( -- ) fb8-invert-screen fb8-invert-screen ;
 179
 180 : fb8-install ( width height #columns #lines -- )
 181         1 to screen-depth
 182         2swap  to screen-height  to screen-width
 183         screen-#rows min to #lines
 184         screen-#columns min to #columns
 185         screen-height char-height #lines * - 2/ to window-top
 186         screen-width char-width #columns * - 2/ to window-left
 187         ['] fb8-toggle-cursor to toggle-cursor
 188         ['] fb8-draw-character to draw-character
 189         ['] fb8-insert-lines to insert-lines
 190         ['] fb8-delete-lines to delete-lines
 191         ['] fb8-insert-characters to insert-characters
 192         ['] fb8-delete-characters to delete-characters
 193         ['] fb8-erase-screen to erase-screen
 194         ['] fb8-blink-screen to blink-screen
 195         ['] fb8-invert-screen to invert-screen
 196         ['] fb8-reset-screen to reset-screen
 197         ['] fb8-draw-logo to draw-logo
 198 ;
 199
 200 : fb-install  ( width height #columns #lines depth -- )
 201         >r
 202         fb8-install
 203         r> to screen-depth
 204 ;
 205
 206
 207 \ Install display related FCODE evaluator tokens
 208 : fb8-set-tokens  ( -- )
 209         ['] is-install        0 11C set-token
 210         ['] is-remove         0 11D set-token
 211         ['] is-selftest       0 11E set-token
 212
 213         ['] #lines            0 150 set-token
 214         ['] #columns          0 151 set-token
 215         ['] line#             0 152 set-token
 216         ['] column#           0 153 set-token
 217         ['] inverse?          0 154 set-token
 218         ['] inverse-screen?   0 155 set-token
 219         ['] draw-character    0 157 set-token
 220         ['] reset-screen      0 158 set-token
 221         ['] toggle-cursor     0 159 set-token
 222         ['] erase-screen      0 15A set-token
 223         ['] blink-screen      0 15B set-token
 224         ['] invert-screen     0 15C set-token
 225         ['] insert-characters 0 15D set-token
 226         ['] delete-characters 0 15E set-token
 227         ['] insert-lines      0 15F set-token
 228         ['] delete-lines      0 160 set-token
 229         ['] draw-logo         0 161 set-token
 230         ['] frame-buffer-adr  0 162 set-token
 231         ['] screen-height     0 163 set-token
 232         ['] screen-width      0 164 set-token
 233         ['] window-top        0 165 set-token
 234         ['] window-left       0 166 set-token
 235         \ ['] foreground-color  0 168 set-token  \ 16-color extension - n/a
 236         \ ['] background-color  0 169 set-token  \ 16-color extension - n/a
 237         ['] default-font      0 16A set-token
 238         ['] set-font          0 16B set-token
 239         ['] char-height       0 16C set-token
 240         ['] char-width        0 16D set-token
 241         ['] >font             0 16E set-token
 242         ['] fontbytes         0 16F set-token
 243
 244         ['] fb8-draw-character    0 180 set-token
 245         ['] fb8-reset-screen      0 181 set-token
 246         ['] fb8-toggle-cursor     0 182 set-token
 247         ['] fb8-erase-screen      0 183 set-token
 248         ['] fb8-blink-screen      0 184 set-token
 249         ['] fb8-invert-screen     0 185 set-token
 250         ['] fb8-insert-characters 0 186 set-token
 251         ['] fb8-delete-characters 0 187 set-token
 252         ['] fb8-insert-lines      0 188 set-token
 253         ['] fb8-delete-lines      0 189 set-token
 254         ['] fb8-draw-logo         0 18A set-token
 255         ['] fb8-install           0 18B set-token
 256 ;
 257 fb8-set-tokens
 258
 259
 260 \ \\\\\\\\\\\\ Debug Stuff \\\\\\\\\\\\\\\\
 261
 262 : fb8-dump-bitmap cr char-height 0 ?do char-width 0 ?do dup c@ if ." @" else ." ." then 1+ loop cr loop drop ;
 263
 264 : fb8-dump-char >font -b swap fb8-char2bitmap fb8-dump-bitmap ;