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