qemu/roms/SLOF/slof/fs/terminal.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 \ \\\\\\\\\\\\\\ Global Data
  14
  15 0 VALUE line#
  16 0 VALUE column#
  17 false VALUE inverse?
  18 false VALUE inverse-screen?
  19 18 VALUE #lines
  20 50 VALUE #columns
  21
  22 false VALUE cursor
  23 false VALUE saved-cursor
  24
  25
  26 \ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
  27
  28 defer draw-character    \ 2B inited by display driver
  29 defer reset-screen      \ 2B inited by display driver
  30 defer toggle-cursor     \ 2B inited by display driver
  31 defer erase-screen      \ 2B inited by display driver
  32 defer blink-screen      \ 2B inited by display driver
  33 defer invert-screen     \ 2B inited by display driver
  34 defer insert-characters \ 2B inited by display driver
  35 defer delete-characters \ 2B inited by display driver
  36 defer insert-lines      \ 2B inited by display driver
  37 defer delete-lines      \ 2B inited by display driver
  38 defer draw-logo         \ 2B inited by display driver
  39
  40 : nop-toggle-cursor ( nop ) ;
  41 ' nop-toggle-cursor to toggle-cursor
  42
  43 \ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
  44 \ *
  45 \ *
  46 : (cursor-off) ( -- ) cursor dup to saved-cursor
  47         IF toggle-cursor false to cursor THEN ;
  48 : (cursor-on) ( -- ) cursor dup to saved-cursor
  49         0= IF toggle-cursor true to cursor THEN ;
  50 : restore-cursor ( -- ) saved-cursor dup cursor
  51         <> IF toggle-cursor to cursor ELSE drop THEN ;
  52
  53 ' (cursor-off) to cursor-off
  54 ' (cursor-on) to cursor-on
  55
  56 \ \\\\\\\\\\\\\\ Exported Interface:
  57 \ *
  58 \ Generic device methods:
  59 \ *
  60
  61
  62 \ \\\\\\\\\\\\\\ Exported Interface:
  63 \ *
  64 \ *
  65
  66 false VALUE esc-on
  67 false VALUE csi-on
  68 defer esc-process
  69 0 VALUE esc-num-parm
  70 0 VALUE esc-num-parm2
  71 0 VALUE saved-line#
  72 0 VALUE saved-column#
  73
  74 : get-esc-parm ( default -- value )
  75         esc-num-parm dup 0> IF nip ELSE drop THEN 0 to esc-num-parm ;
  76 : get-esc-parm2 ( default -- value )
  77         esc-num-parm2 dup 0> IF nip ELSE drop THEN 0 to esc-num-parm2 ;
  78 : set-esc-parm ( newdigit -- ) [char] 0 - esc-num-parm a * + to esc-num-parm ;
  79
  80 : reverse-cursor ( oldpos -- newpos) dup IF 1 get-esc-parm - THEN ;
  81 : advance-cursor ( bound oldpos -- newpos) tuck > IF 1 get-esc-parm + THEN ;
  82 : erase-in-line #columns column# - dup 0> IF delete-characters ELSE drop THEN ;
  83
  84 : terminal-line++ ( -- )
  85         line# 1+ dup #lines = IF 1- 0 to line# 1 delete-lines THEN
  86         to line#
  87 ;
  88
  89 0 VALUE dang
  90 0 VALUE blipp
  91 false VALUE stopcsi
  92 0 VALUE term-background
  93 7 VALUE term-foreground
  94
  95 : set-term-color
  96    dup d# 30 d# 39 between IF dup d# 30 - to term-foreground THEN
  97    dup d# 40 d# 49 between IF dup d# 40 - to term-background THEN
  98    0 = IF
  99       0 to term-background
 100       7 to term-foreground
 101   THEN
 102   term-foreground term-background <= to inverse?
 103 ;
 104
 105 : ansi-esc ( char -- )
 106     csi-on IF
 107         dup [char] 0 [char] 9 between IF set-esc-parm
 108         ELSE true to stopcsi CASE
 109             [char] A OF line# reverse-cursor to line# ENDOF
 110             [char] B OF #lines line# advance-cursor to line# ENDOF
 111             [char] C OF #columns column# advance-cursor to column# ENDOF
 112             [char] D OF column# reverse-cursor to column# ENDOF
 113             [char] E OF ( FIXME: Cursor Next Line - No idea what does it mean )
 114                 #lines line# advance-cursor to line#
 115             ENDOF
 116             [char] f OF
 117                 1 get-esc-parm2 to line# column# get-esc-parm to column#
 118             ENDOF
 119             [char] H OF
 120                 1 get-esc-parm2 to line# column# get-esc-parm to column#
 121             ENDOF
 122             ( second parameter delimiter for f and H commands )
 123             [char] ; OF false to stopcsi 0 get-esc-parm to esc-num-parm2 ENDOF
 124             [char] ? OF false to stopcsi ENDOF ( FIXME: Ignore that for now )
 125             [char] l OF ENDOF ( FIXME: ?25l should hide cursor )
 126             [char] h OF ENDOF ( FIXME: ?25h should show cursor )
 127             [char] J OF
 128                 #lines line# - dup 0> IF
 129                         line# 1+ to line# delete-lines line# 1- to line#
 130                 ELSE drop THEN
 131                 erase-in-line
 132             ENDOF
 133             [char] K OF erase-in-line ENDOF
 134             [char] L OF 1 get-esc-parm insert-lines ENDOF
 135             [char] M OF 1 get-esc-parm delete-lines ENDOF
 136             [char] @ OF 1 get-esc-parm insert-characters ENDOF
 137             [char] P OF 1 get-esc-parm delete-characters ENDOF
 138             [char] m OF 0 get-esc-parm set-term-color ENDOF
 139             ( These are non-ANSI commands recommended by OpenBoot )
 140             [char] p OF inverse-screen? IF false to inverse-screen?
 141                         inverse? 0= to inverse? invert-screen
 142                 THEN
 143             ENDOF
 144             [char] q OF inverse-screen? 0= IF true to inverse-screen?
 145                         inverse? 0= to inverse? invert-screen
 146                 THEN
 147             ENDOF
 148 \           [char] s OF reset-screen ENDOF ( FIXME: this conflicts w. ANSI )
 149 \           [char] s OF line# to saved-line# column# to saved-column# ENDOF
 150             [char] u OF saved-line# to line# saved-column# to column# ENDOF
 151             dup dup to dang OF blink-screen ENDOF
 152         ENDCASE stopcsi IF false to csi-on
 153                 false to esc-on 0 to esc-num-parm 0 to esc-num-parm2 THEN
 154         THEN
 155     ELSE CASE
 156         ( DEV VT compatibility stuff used by accept.fs )
 157         [char] 7 OF line# to saved-line# column# to saved-column# ENDOF
 158         [char] 8 OF saved-line# to line# saved-column# to column# ENDOF
 159         [char] [ OF true to csi-on ENDOF
 160         dup dup OF false to esc-on to blipp ENDOF
 161         ENDCASE
 162         csi-on 0= IF false to esc-on THEN 0 to esc-num-parm 0 to esc-num-parm2
 163     THEN
 164 ;
 165
 166 ' ansi-esc to esc-process
 167 CREATE twtracebuf 4000 allot twtracebuf 4000 erase
 168 twtracebuf VALUE twbp
 169 0 VALUE twbc
 170
 171 : twtrace
 172         twbc 4000 = IF 0 to twbc twtracebuf to twbp THEN
 173         dup twbp c! twbp 1+ to twbp twbc 1+ to twbc
 174 ;
 175
 176 : terminal-write ( addr len -- actual-len )
 177         cursor-off
 178         tuck bounds ?DO i c@
 179                 twtrace
 180                 esc-on IF esc-process
 181                 ELSE CASE
 182                         1B OF true to esc-on ENDOF
 183                         carret OF 0 to column# ENDOF
 184                         linefeed OF terminal-line++ ENDOF
 185                         bell OF blink-screen ENDOF
 186                         9 ( TAB ) OF column# 7 + -8 and dup #columns < IF
 187                                         to column#
 188                                 ELSE drop THEN
 189                         ENDOF
 190                         B ( VT ) OF line# ?dup IF 1- to line# THEN ENDOF
 191                         C ( FF ) OF 0 to line# 0 to column# erase-screen ENDOF
 192                         bs OF   column# 1- dup 0< IF
 193                                         line# IF
 194                                                 line# 1- to line#
 195                                                 drop #columns 1-
 196                                         ELSE drop column#
 197                                         THEN
 198                                 THEN
 199                                 to column# ( bl draw-character )
 200                         ENDOF
 201                         dup OF
 202                                 i c@ draw-character
 203                                 column# 1+ dup #columns >= IF
 204                                         drop 0 terminal-line++
 205                                 THEN
 206                                 to column#
 207                         ENDOF
 208                     ENDCASE
 209                 THEN
 210         LOOP
 211         restore-cursor
 212 ;