roms/openbios/forth/device/display.fs

   1 \ tag: Display device management
   2 \
   3 \ this code implements IEEE 1275-1994 ch. 5.3.6
   4 \
   5 \ Copyright (C) 2003 Stefan Reinauer
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 hex
  12
  13 \
  14 \ 5.3.6.1 Terminal emulator routines
  15 \
  16
  17 \ The following values are used and set by the terminal emulator
  18 \ defined and described in 3.8.4.2
  19 0 value line# ( -- line# )
  20 0 value column# ( -- column# )
  21 0 value inverse? ( -- white-on-black? )
  22 0 value inverse-screen? ( -- black? )
  23 0 value #lines ( -- rows )
  24 0 value #columns ( -- columns )
  25
  26 \ The following values are used internally by both the 1-bit and the
  27 \ 8-bit frame-buffer support routines.
  28
  29 0 value frame-buffer-adr ( -- addr )
  30 0 value screen-height    ( -- height )
  31 0 value screen-width     ( -- width )
  32 0 value window-top       ( -- border-height )
  33 0 value window-left      ( -- border-width )
  34 0 value char-height      ( -- height )
  35 0 value char-width       ( -- width )
  36 0 value fontbytes        ( -- bytes )
  37
  38 \ these values are used internally and do not represent any
  39 \ official open firmware words
  40 0 value char-min
  41 0 value char-num
  42 0 value font
  43
  44 0 value foreground-color
  45 0 value background-color
  46 create color-palette 100 cells allot
  47
  48 2 value font-spacing
  49 0 value depth-bits
  50 0 value line-bytes
  51 0 value display-ih
  52
  53 \ internal values
  54 0 value openbios-video-addr
  55 0 value openbios-video-height
  56 0 value openbios-video-width
  57
  58 \ The following wordset is called the "defer word interface" of the
  59 \ terminal-emulator support package. It gets overloaded by fb1-install
  60 \ or fb8-install (initiated by the framebuffer fcode driver)
  61
  62 defer draw-character    ( char -- )
  63 defer reset-screen      ( -- )
  64 defer toggle-cursor     ( -- )
  65 defer erase-screen      ( -- )
  66 defer blink-screen      ( -- )
  67 defer invert-screen     ( -- )
  68 defer insert-characters ( n -- )
  69 defer delete-characters ( n -- )
  70 defer insert-lines ( n -- )
  71 defer delete-lines ( n -- )
  72 defer draw-logo ( line# addr width height -- )
  73
  74 defer fb-emit ( x -- )
  75
  76 : depth-bytes ( -- bytes )
  77   depth-bits 1+ 8 /
  78 ;
  79
  80 \
  81 \ 5.3.6.2 Frame-buffer support routines
  82 \
  83
  84 : default-font ( -- addr width height advance min-char #glyphs )
  85   (romfont) (romfont-width) (romfont-height) (romfont-height) 0 100
  86   ;
  87
  88 : set-font ( addr width height advance min-char #glyphs -- )
  89   to char-num
  90   to char-min
  91   to fontbytes
  92   font-spacing + to char-height
  93   to char-width
  94   to font
  95   ;
  96
  97 : >font ( char -- addr )
  98   char-min -
  99   char-num min
 100   fontbytes *
 101   font +
 102   ;
 103
 104 \
 105 \ 5.3.6.3 Display device support
 106 \
 107
 108 \
 109 \ 5.3.6.3.1 Frame-buffer package interface
 110 \
 111
 112 : is-install    ( xt -- )
 113   external
 114   \ Create open and other methods for this display device.
 115   \ Methods to be created: open, write, draw-logo, restore
 116   s" open" header
 117   1 , \ colon definition
 118   ,
 119   ['] (lit) ,
 120   -1 ,
 121   ['] (semis) ,
 122   reveal
 123   s" : write dup >r bounds do i c@ fb-emit loop r> ; " evaluate
 124   s" : draw-logo draw-logo ; " evaluate
 125   s" : restore reset-screen ; " evaluate
 126   ;
 127
 128 : is-remove    ( xt -- )
 129   external
 130   \ Create close method for this display device.
 131   s" close" header
 132   1 , \ colon definition
 133   ,
 134   ['] (semis) ,
 135   reveal
 136   ;
 137
 138 : is-selftest    ( xt -- )
 139   external
 140   \ Create selftest method for this display device.
 141   s" selftest" header
 142   1 , \ colon definition
 143   ,
 144   ['] (semis) ,
 145   reveal
 146   ;
 147
 148
 149 \ 5.3.6.3.2 Generic one-bit frame-buffer support (optional)
 150
 151 : fb1-nonimplemented
 152   ." Monochrome framebuffer support is not implemented." cr
 153   end0
 154   ;
 155
 156 : fb1-draw-character    fb1-nonimplemented ; \ historical
 157 : fb1-reset-screen      fb1-nonimplemented ;
 158 : fb1-toggle-cursor     fb1-nonimplemented ;
 159 : fb1-erase-screen      fb1-nonimplemented ;
 160 : fb1-blink-screen      fb1-nonimplemented ;
 161 : fb1-invert-screen     fb1-nonimplemented ;
 162 : fb1-insert-characters fb1-nonimplemented ;
 163 : fb1-delete-characters fb1-nonimplemented ;
 164 : fb1-insert-lines      fb1-nonimplemented ;
 165 : fb1-delete-lines      fb1-nonimplemented ;
 166 : fb1-slide-up          fb1-nonimplemented ;
 167 : fb1-draw-logo         fb1-nonimplemented ;
 168 : fb1-install           fb1-nonimplemented ;
 169
 170
 171 \ 5.3.6.3.3 Generic eight-bit frame-buffer support
 172
 173 \ bind to low-level C function later
 174 defer fb8-blitmask
 175 defer fb8-fillrect
 176 defer fb8-invertrect
 177
 178 : fb8-line2addr ( line -- addr )
 179   window-top +
 180   screen-width * depth-bytes *
 181   frame-buffer-adr +
 182   window-left depth-bytes * +
 183 ;
 184
 185 : fb8-curpos2addr ( col line -- addr )
 186   char-height * fb8-line2addr
 187   swap char-width * depth-bytes * +
 188 ;
 189
 190 : fb8-copy-lines ( count from to -- )
 191   fb8-line2addr swap
 192   fb8-line2addr swap
 193   #columns char-width * depth-bytes *
 194   3 pick * move drop
 195 ;
 196
 197 : fb8-clear-lines ( count line -- )
 198   background-color 0
 199   2 pick window-top +
 200   #columns char-width *
 201   5 pick
 202   fb8-fillrect
 203   2drop
 204 ;
 205
 206 : fb8-draw-character ( char -- )
 207   \ erase the current character
 208   background-color
 209   column# char-width * window-left +
 210   line# char-height * window-top +
 211   char-width char-height fb8-fillrect
 212   \ draw the character:
 213   >font
 214   line# char-height * window-top + screen-width * depth-bytes *
 215   column# char-width * depth-bytes *
 216   window-left depth-bytes * + + frame-buffer-adr +
 217   swap char-width char-height font-spacing -
 218   \ normal or inverse?
 219   foreground-color background-color
 220   inverse? if
 221     swap
 222   then
 223   fb8-blitmask
 224   ;
 225
 226 : fb8-reset-screen ( -- )
 227   false to inverse?
 228   false to inverse-screen?
 229   0 to foreground-color
 230   d# 15 to background-color
 231
 232   \ override with OpenBIOS defaults
 233   fe to background-color
 234   0 to foreground-color
 235   ;
 236
 237 : fb8-toggle-cursor ( -- )
 238   column# char-width * window-left +
 239   line# char-height * window-top +
 240   char-width char-height font-spacing -
 241   foreground-color background-color
 242   fb8-invertrect
 243   ;
 244
 245 : fb8-erase-screen ( -- )
 246   inverse-screen? if
 247     foreground-color
 248   else
 249     background-color
 250   then
 251   0 0 screen-width screen-height
 252   fb8-fillrect
 253   ;
 254
 255 : fb8-invert-screen ( -- )
 256   0 0 screen-width screen-height
 257   background-color foreground-color
 258   fb8-invertrect
 259   ;
 260
 261 : fb8-blink-screen ( -- )
 262   fb8-invert-screen 2000 ms
 263   fb8-invert-screen
 264   ;
 265
 266 : fb8-insert-characters ( n -- )
 267   \ numcopy = ( #columns - column# - n )
 268   #columns over - column# -
 269   char-width * depth-bytes * ( n numbytescopy )
 270
 271   over column# + line# fb8-curpos2addr
 272   column# line# fb8-curpos2addr ( n numbytescopy destaddr srcaddr )
 273   char-height 0 do
 274     3dup swap rot move
 275     line-bytes + swap line-bytes + swap
 276   loop 3drop
 277
 278   background-color
 279   column# char-width * window-left + line# char-height * window-top +
 280   3 pick char-width * char-height
 281   fb8-fillrect
 282   drop
 283   ;
 284
 285 : fb8-delete-characters ( n -- )
 286   \ numcopy = ( #columns - column# - n )
 287   #columns over - column# -
 288   char-width * depth-bytes * ( n numbytescopy )
 289
 290   over column# + line# fb8-curpos2addr
 291   column# line# fb8-curpos2addr swap ( n numbytescopy destaddr srcaddr )
 292   char-height 0 do
 293     3dup swap rot move
 294     line-bytes + swap line-bytes + swap
 295   loop 3drop
 296
 297   background-color
 298   over #columns swap - char-width * window-left + line# char-height * window-top +
 299   3 pick char-width * char-height
 300   fb8-fillrect
 301   drop
 302   ;
 303
 304 : fb8-insert-lines ( n -- )
 305   \ numcopy = ( #lines - n )
 306   #lines over - char-height *
 307   over line# char-height *
 308   swap char-height * over +
 309   fb8-copy-lines
 310
 311   char-height * line# char-height *
 312   fb8-clear-lines
 313   ;
 314
 315 : fb8-delete-lines ( n -- )
 316   \ numcopy = ( #lines - ( line# + n )) * char-height
 317   #lines over line# + - char-height *
 318   over line# + char-height *
 319   line# char-height *
 320   fb8-copy-lines
 321
 322   #lines over - char-height *
 323   dup #lines char-height * swap - swap
 324   fb8-clear-lines
 325   drop
 326 ;
 327
 328
 329 : fb8-draw-logo ( line# addr width height -- )
 330   2swap swap
 331   char-height  * window-top  +
 332   screen-width * window-left +
 333   frame-buffer-adr +
 334   swap 2swap
 335   \ in-fb-start-adr logo-adr logo-width logo-height
 336
 337   fb8-blitmask ( fbaddr mask-addr width height --  )
 338 ;
 339
 340
 341 : fb8-install ( width height #columns #lines -- )
 342
 343   \ set state variables
 344   to #lines
 345   to #columns
 346   to screen-height
 347   to screen-width
 348
 349   screen-width #columns char-width * - 2/ to window-left
 350   screen-height #lines char-height * - 2/ to window-top
 351
 352   0 to column#
 353   0 to line#
 354   0 to inverse?
 355   0 to inverse-screen?
 356
 357   my-self to display-ih
 358
 359   \ set defer functions to 8bit versions
 360
 361   ['] fb8-draw-character to draw-character
 362   ['] fb8-toggle-cursor to toggle-cursor
 363   ['] fb8-erase-screen to erase-screen
 364   ['] fb8-blink-screen to blink-screen
 365   ['] fb8-invert-screen to invert-screen
 366   ['] fb8-insert-characters to insert-characters
 367   ['] fb8-delete-characters to delete-characters
 368   ['] fb8-insert-lines to insert-lines
 369   ['] fb8-delete-lines to delete-lines
 370   ['] fb8-draw-logo to draw-logo
 371   ['] fb8-reset-screen to reset-screen
 372
 373   \ recommended practice
 374   s" iso6429-1983-colors" get-my-property if
 375     0 ff
 376   else
 377     2drop d# 15 0
 378   then
 379   to foreground-color to background-color
 380
 381   \ setup palette
 382   10101 ['] color-palette cell+ ff 0 do
 383     dup 2 pick i * swap ! cell+
 384   loop 2drop
 385
 386   \ special background color
 387   ffffcc ['] color-palette cell+ fe cells + !
 388
 389   \ load palette onto the hardware
 390   ['] color-palette cell+ ff 0 do
 391     dup @ ff0000 and d# 16 rshift
 392     1 pick @ ff00 and d# 8 rshift
 393     2 pick @ ff and
 394     i
 395     s" hw-set-color" $find if
 396       execute
 397     else
 398       2drop
 399     then
 400     cell+
 401   loop drop
 402
 403   \ ... but let's override with some better defaults
 404   fe to background-color
 405   0 to foreground-color
 406
 407   fb8-erase-screen
 408
 409   \ If we have a startup splash then display it
 410   [IFDEF] CONFIG_MOL
 411       startup-splash 2000 ms
 412       fb8-erase-screen
 413   [THEN]
 414 ;