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
  47
  48 \ The following wordset is called the "defer word interface" of the
  49 \ terminal-emulator support package. It gets overloaded by fb1-install
  50 \ or fb8-install (initiated by the framebuffer fcode driver)
  51
  52 defer draw-character    ( char -- )
  53 defer reset-screen      ( -- )
  54 defer toggle-cursor     ( -- )
  55 defer erase-screen      ( -- )
  56 defer blink-screen      ( -- )
  57 defer invert-screen     ( -- )
  58 defer insert-characters ( n -- )
  59 defer delete-characters ( n -- )
  60 defer insert-lines ( n -- )
  61 defer delete-lines ( n -- )
  62 defer draw-logo ( line# addr width height -- )
  63
  64 defer fb-emit ( x -- )
  65
  66 \
  67 \ 5.3.6.2 Frame-buffer support routines
  68 \
  69
  70 : default-font ( -- addr width height advance min-char #glyphs )
  71   \ (romfont-8x16) 8 10 10 0 100
  72   ;
  73
  74 : set-font ( addr width height advance min-char #glyphs -- )
  75   to char-num
  76   to char-min
  77   to fontbytes
  78   to char-height
  79   to char-width
  80   to font
  81   ;
  82
  83 : >font ( char -- addr )
  84   char-min -
  85   char-num min
  86   fontbytes *
  87   font +
  88   ;
  89
  90 \
  91 \ 5.3.6.3 Display device support
  92 \
  93
  94 \
  95 \ 5.3.6.3.1 Frame-buffer package interface
  96 \
  97
  98 : is-install    ( xt -- )
  99   external
 100   \ Create open and other methods for this display device.
 101   \ Methods to be created: open, write, draw-logo, restore
 102   s" open" header
 103   1 , \ colon definition
 104   ,
 105   ['] (semis) ,
 106   reveal
 107   s" : write dup >r bounds do i c@ fb-emit loop r> ; " evaluate
 108   s" : draw-logo draw-logo ; " evaluate
 109   s" : restore reset-screen ; " evaluate
 110   ;
 111
 112 : is-remove    ( xt -- )
 113   external
 114   \ Create close method for this display device.
 115   s" close" header
 116   1 , \ colon definition
 117   ,
 118   ['] (semis) ,
 119   reveal
 120   ;
 121
 122 : is-selftest    ( xt -- )
 123   external
 124   \ Create selftest method for this display device.
 125   s" selftest" header
 126   1 , \ colon definition
 127   ,
 128   ['] (semis) ,
 129   reveal
 130   ;
 131
 132
 133 \ 5.3.6.3.2 Generic one-bit frame-buffer support (optional)
 134
 135 : fb1-nonimplemented
 136   ." Monochrome framebuffer support is not implemented." cr
 137   end0
 138   ;
 139
 140 : fb1-draw-character    fb1-nonimplemented ; \ historical
 141 : fb1-reset-screen      fb1-nonimplemented ;
 142 : fb1-toggle-cursor     fb1-nonimplemented ;
 143 : fb1-erase-screen      fb1-nonimplemented ;
 144 : fb1-blink-screen      fb1-nonimplemented ;
 145 : fb1-invert-screen     fb1-nonimplemented ;
 146 : fb1-insert-characters fb1-nonimplemented ;
 147 : fb1-delete-characters fb1-nonimplemented ;
 148 : fb1-insert-lines      fb1-nonimplemented ;
 149 : fb1-delete-lines      fb1-nonimplemented ;
 150 : fb1-slide-up          fb1-nonimplemented ;
 151 : fb1-draw-logo         fb1-nonimplemented ;
 152 : fb1-install           fb1-nonimplemented ;
 153
 154
 155 \ 5.3.6.3.3 Generic eight-bit frame-buffer support
 156
 157 \ The following two functions are unrolled for speed.
 158
 159
 160 \ blit 8 continuous pixels described by the 8bit
 161 \ value in bitmask8. The most significant bit is
 162 \ painted first.
 163
 164 \ this function should honour fg and bg colors
 165
 166 : fb8-write-mask8 ( bitmask8 faddr -- )
 167   over 1  and 0<> over 7 + c!
 168   over 2  and 0<> over 6 + c!
 169   over 4  and 0<> over 5 + c!
 170   over 8  and 0<> over 4 + c!
 171   over 10 and 0<> over 3 + c!
 172   over 20 and 0<> over 2 + c!
 173   over 40 and 0<> over 1 + c!
 174   over 80 and 0<> over 0 + c!
 175   2drop
 176   ;
 177
 178 : fb8-blitmask ( fbaddr mask-addr width height --  )
 179   over >r          \ save width ( -- R: width )
 180   * 3 >>           \ fbaddr mask-addr width*height/8
 181   bounds           \ fbaddr mask-end mask
 182   r> 0 2swap       \ fbaddr width 0 mask-end mask
 183   ?do              \ ( fbaddr width l-cnt )
 184     2 pick over +  \ fbaddr-current
 185     i c@           \ bitmask8
 186     swap fb8-write-mask8
 187     ( fbaddr width l-cnt )
 188     8 + 2dup = if
 189       drop swap screen-width +
 190       swap 0
 191     then
 192     ( fbaddr width l-cnt )
 193   loop
 194   2drop drop
 195   ;
 196
 197 : fb8-line2addr ( line -- addr )
 198   window-top +
 199   screen-width *
 200   frame-buffer-adr +
 201   window-left +
 202 ;
 203
 204 : fb8-copy-line ( from to -- )
 205   fb8-line2addr swap
 206   fb8-line2addr swap
 207   #columns char-width * move
 208 ;
 209
 210 : fb8-clear-line ( line -- )
 211   fb8-line2addr
 212   #columns char-width *
 213   background-color fill
 214 \ 0 fill
 215 ;
 216
 217 : fb8-draw-character ( char -- )
 218   \ draw the character:
 219   >font
 220   line# char-height * window-top + screen-width *
 221   column# char-width * window-left + + frame-buffer-adr +
 222   swap char-width char-height
 223   fb8-blitmask
 224   \ now advance the position
 225   column# 1+
 226   dup #columns = if
 227     drop 0 to column#
 228     line# 1+
 229     dup #lines = if
 230       drop
 231       \ FIXME move up screen (and keep position)
 232     else
 233       to #lines
 234     then
 235   else
 236     to column#
 237   then
 238   ;
 239
 240 : fb8-reset-screen ( -- )
 241   false to inverse?
 242   false to inverse-screen?
 243   0 to foreground-color
 244   d# 15 to background-color
 245   ;
 246
 247 : fb8-toggle-cursor ( -- )
 248   line# char-height * window-top + screen-width *
 249   column# char-width * window-left + + frame-buffer-adr +
 250   char-height 0 ?do
 251     char-width 0 ?do
 252       dup i + dup c@ invert ff and swap c!
 253     loop
 254     screen-width +
 255   loop
 256   drop
 257   ;
 258
 259 : fb8-erase-screen ( -- )
 260   frame-buffer-adr
 261   screen-height screen-width *
 262   inverse-screen? if
 263     foreground-color
 264   else
 265     background-color
 266   then
 267   fill
 268   ;
 269
 270 : fb8-invert-screen ( -- )
 271   frame-buffer-adr
 272   screen-height screen-width *
 273   bounds ?do
 274     i c@ case
 275       foreground-color of background-color endof
 276       background-color of foreground-color endof
 277       dup
 278     endcase
 279     i c!
 280   loop
 281   ;
 282
 283 : fb8-blink-screen ( -- )
 284   fb8-invert-screen fb8-invert-screen
 285   ;
 286
 287 : fb8-insert-characters ( n -- )
 288   ;
 289
 290 : fb8-delete-characters ( n -- )
 291   ;
 292
 293 : fb8-insert-lines ( n -- )
 294   ;
 295
 296 : fb8-delete-lines ( n -- )
 297   \ numcopy = ( #lines - ( line# + n )) * char-height
 298   #lines over #line + - char-height *
 299
 300   ( numcopy ) 0 ?do
 301     dup line# + char-height * i +
 302     line# char-height * i +
 303     swap fb8-copy-line
 304   loop
 305
 306   #lines over - char-height *
 307   over char-height *
 308   0 ?do
 309     dup i + fb8-clear-line
 310   loop
 311
 312   2drop
 313 ;
 314
 315
 316 : fb8-draw-logo ( line# addr width height -- )
 317   2swap swap
 318   char-height  * window-top  +
 319   screen-width * window-left +
 320   frame-buffer-adr +
 321   swap 2swap
 322   \ in-fb-start-adr logo-adr logo-width logo-height
 323
 324   fb8-blitmask ( fbaddr mask-addr width height --  )
 325 ;
 326
 327
 328 : fb8-install ( width height #columns #lines -- )
 329
 330   \ set state variables
 331   to #lines
 332   to #columns
 333   to screen-height
 334   to screen-width
 335
 336   screen-width #columns char-width * - 2/ to window-left
 337   screen-height #lines char-height * - 2/ to window-top
 338
 339   0 to column#
 340   0 to line#
 341   0 to inverse?
 342   0 to inverse-screen?
 343
 344   \ set defer functions to 8bit versions
 345
 346   ['] fb8-draw-character to draw-character
 347   ['] fb8-toggle-cursor to toggle-cursor
 348   ['] fb8-erase-screen to erase-screen
 349   ['] fb8-blink-screen to blink-screen
 350   ['] fb8-invert-screen to invert-screen
 351   ['] fb8-insert-characters to insert-characters
 352   ['] fb8-delete-characters to delete-characters
 353   ['] fb8-insert-lines to insert-lines
 354   ['] fb8-delete-lines to delete-lines
 355   ['] fb8-draw-logo to draw-logo
 356   ['] fb8-reset-screen to reset-screen
 357
 358   \ recommended practice
 359   s" iso6429-1983-colors" get-my-property if
 360     0 ff
 361   else
 362     2drop d# 15 0
 363   then
 364   to foreground-color to background-color
 365
 366 ;