Annotation of qemu/roms/openbios/forth/device/display.fs, revision 1.1

1.1     ! root        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: ;

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.