\                                                                    vandys
\ cons.f
\       VGA text console driver in Forth
\
only
drivers definitions             \ Stash all this in driver namespace
also os

NSCREEN constant NSCREEN        \ # virtual screens supported
CONS_COLS constant CONS_COLS    \ Columns on display
 CONS_COLS 1- constant CONS_COLS-1
CONS_ROWS constant CONS_ROWS    \ Rows on display
RAM_SIZE constant RAM_SIZE      \ Words on display
RAM_BYTES constant RAM_BYTES    \ Bytes on display

3 constant CHAR_INTR            \ Interrupt char (^C)

$3D4 constant GDC_REG           \ I/O ports to control cursor hardware
$3D5 constant GDC_VAL
$B8000 constant TVRAM           \ Mapped screen memory





\                                                                    vandys
create cur_attr 7 8 lshift ,
$0720 constant BLWORD

variable cur_col   variable cur_row
variable cursor_moved
variable scrollCount
80 dup constant #TTYQ   create ttyq allot   create nttyq 0 ,

SCRMEM constant SCRMEM          \ # bytes of state per screen
create screens                  \ Per-screen state
   SCRMEM NSCREEN * allot
   \ 0: Current display pointer (either virtual or HW address)
   \ 4: row
   \ 8: col
   \ 12: attr
   \ 16: scroll count
   \ 20: <reserved>
   \ 24: RAM_BYTES bytes of screen image storage






\                                                                    vandys
\ Get pointer to screen state
: >scrptr ( u -- a )   SCRMEM * screens +   ;

\ Convert pointer to screen state into pointer to hardware buffer memory
: >scrhw ( a -- a' )   6 cells +   ;

\ Point to TTY channel USER variable
: >ttchan   ttchan up @ - +   ;

variable SCR            \ Base address of screen memory
variable SCRrow1        \  ...address of 2nd line of screen
variable SCRrow24       \  ...of start of last line
variable SCRrow25       \  ...of last line

variable cur_hw         \ Screen # displayed on physical screen
variable cur_chan       \ Screen # currently set on SCR

\ Amount of memory to scroll up with move
CONS_ROWS 1- dup constant CONS_ROWS-1
 CONS_COLS * 2* constant SCRscrollsize




\                                                                    vandys
: set_screenmem ( a -- )   dup CONS_COLS 2* + SCRrow1 !
   dup SCRscrollsize + dup SCRrow24 !   CONS_COLS 2* + SCRrow25 !   SCR ! ;

: gdc! ( val gdcreg -- )   GDC_REG outb   GDC_VAL outb ;
: cursor_pos ( -- )
   cursor_moved off
   cur_row @ CONS_COLS * cur_col @ +

   dup 8 rshift   $E gdc!   $F gdc! ;

: on_hw? ( -- ? )   ttchan @ cur_hw @ = ;













\                                                                    vandys
: (scroll_up) ( -- )
   SCRrow1 @   SCR @   SCRscrollsize move
   SCRrow25 @ SCRrow24 @ do    BLWORD i w!   2 +loop ;
: check_intr ( -- )   nttyq @ if   ttyq c@ CHAR_INTR = if
      handler @ if   nttyq off   1 abort" Interrupt"   then then then ;
: scroll_up ( -- )   scrollCount @ CONS_ROWS < if
      (scroll_up)   exit then
   nttyq @ if   (scroll_up)   exit then
   CONS_COLS-1   cur_col !
   begin   pause   on_hw? dup if cursor_pos then
      nttyq @ 0<> and until   (scroll_up)
   cur_col off   cursor_moved on
   scrollCount off   check_intr   nttyq off ;

: consput ( c -- )
   cur_attr @ +
   SCR @   cur_row @ CONS_COLS *   cur_col @ + 2* +   w! ;







\                                                                    vandys
: (cons_fwd) ( -- )   cur_col inc   cur_col @ CONS_COLS < if exit then
   cur_col off   cur_row inc   scrollCount inc
   cur_row @ CONS_ROWS < if exit then
   cur_row dec   scroll_up ;

: (cons_putc) ( c -- )   consput (cons_fwd) ;

: cons_putc ( c -- )
   on_hw? if   cursor_moved on   then

   dup 31 > over 128 < and if   (cons_putc) exit   then













\                                                                    vandys
   dup 9 = if   drop
      begin   32 recurse   cur_col @ 8 mod 0= until   exit then

   dup 13 = if   drop   0 cur_col !   exit then

   dup 10 = if   drop   cur_row inc   scrollCount inc
      cur_row @ CONS_ROWS >= if   cur_row dec   scroll_up   then
   exit then
















\                                                                    vandys
   dup 8 = if   drop   cur_col @ 0 > if   cur_col dec
      else   cur_row @ if   cur_row dec   CONS_COLS 1- cur_col !
      then then
   exit then

   \ Unknown control char
   drop ;

















\                                                                    vandys
: blank_page ( a -- ) RAM_SIZE 0 do BLWORD over i 2* + w! loop drop ;
: cons_page ( -- )   SCR @ blank_page
   cur_col off   cur_row off   cursor_moved on ;

: cons_xy ( row col -- )   cur_col !   cur_row !
   scrollCount off   cursor_moved on ;

: cons_attr ( ? -- )   if $7000 else $700 then   cur_attr ! ;

: cons_blot ( -- )   SCR @ cur_row @ CONS_COLS * cur_col @ + 2* +
   CONS_COLS cur_col @ - 0 do BLWORD over w! 2 + loop drop ;

: cons_putpage ( a -- )
   SCR @ RAM_SIZE 0 do   over c@ $700 + over w!   2+ swap 1+ swap
   loop   2drop ;









\                                                                    vandys
\ Ports for PC keyboard
$61 constant KBD_CTL
$60 constant KBD_DATA
$64 constant KBD_STATUS




















\                                                                    vandys
\ Mapping from key position to ASCII

\ Un-shifted mapping of PC scancodes to ASCII
create key_map
 0 c, 27 c, ,chars 1234567890-= 8 c, 9 c,
 ,chars qwertyuiop[] 13 c, $80 c,
 ,chars asdfghjkl; 39 c, 96 c, $80 c,
 92 c, ,chars zxcvbnm,./ $80 c,
 char * c, $80 c, 32 c, 23 pad80 char 0 c, 127 c,

\ Shifted mapping of PC scancodes to ASCII
create shift_map
 0 c, 27 c, ,chars !@#$%^&*()_+ 8 c, 9 c,
 ,chars QWERTYUIOP{} 13 c, $80 c,
 ,chars ASDFGHJKL: 34 c, char ~ c, $80 c,
 ,chars |ZXCVBNM<>? $80 c,
 42 c, $80 c, 32 c, 13 pad80 ,chars 789 $80 c,
 ,chars 456 $80 c, ,chars 1230 127 c,
 align





\                                                                    vandys
variable conshift   variable conctrl

: set_chan ( u -- )
   cur_chan @ 2dup = if 2drop exit then

   >scrptr SCR @ over !
   cell+ cur_row @ over !   cell+ cur_col @ over !
   cell+ cur_attr @ over !   cell+ scrollCount @ swap !

   dup cur_chan !   >scrptr dup @ set_screenmem
   cell+ dup @ cur_row !   cell+ dup @ cur_col !
   cell+ dup @ cur_attr !   cell+ @ scrollCount ! ;












\                                                                    vandys
: set_hw ( u-newchan -- )
   dup NSCREEN u< not if   drop exit   then

   dup cur_hw @ = if   drop exit   then

   'pause @ 0= if   drop exit   then

   dup set_chan

   TVRAM   cur_hw @ >scrptr   dup >r   >scrhw RAM_BYTES cmove
   r>   dup >scrhw   swap !
   ( newchan )












\                                                                    vandys
   ( newchan ) dup cur_hw !
   >scrptr   dup >r   >scrhw TVRAM RAM_BYTES cmove
   r> TVRAM swap !

   TVRAM set_screenmem   cursor_moved on ;



















\                                                                    vandys

\ Get next character typed on PC keyboard
: (cons_getc) ( -- c T | F )





















\                                                                    vandys
        0 begin
                drop    \ Char from previous time around

                \ Strobe enable on keyboard
                KBD_CTL inb dup $7F and KBD_CTL outb
                dup $80 or KBD_CTL outb
                $7F and KBD_CTL outb

                \ Return FALSE if no data available
                KBD_STATUS inb 1 and 0= if false exit then

                \ Read next byte of data
                KBD_DATA inb

                \ F1..F10 select screens (TBD... require ALT-Fx?)
                dup 59 >= over 68 <= and if 59 - set_hw false exit then

                \ Shift pressed?
                dup $36 = over $2A = or if 1 conshift ! drop $80 then





\                                                                    vandys
                \ Shift released?
                dup $B6 = over $AA = or if 0 conshift ! drop $80 then

                \ Ctrl pressed?
                dup $1D = if 1 conctrl ! drop $80 then

                \ Ctrl released?
                dup $9D = if 0 conctrl ! drop $80 then

        \ Iterate until actual data key
        dup 58 < until

        \ Trim to 7-bit ASCII, look up character in keyboard map
        $7F and conshift @ if shift_map else key_map then + c@

        \ Control key?
        conctrl @ if $1F and then

        true    \ Return flag that we have the data
;




\                                                                    vandys
: bad_cons_op   1 abort" Bad console operation"   ;

: cons_q ( c -- )   nttyq @ #TTYQ >= if   drop exit   then
   nttyq @ ttyq + c!   nttyq inc ;
: cons_deq ( -- c )   ttyq c@   nttyq @ dup 0= abort" Empty" 1- nttyq !
   ttyq dup 1+ swap   nttyq @ move ;
: cons_watcher ( -- )   begin   (cons_getc) if
      dup CHAR_INTR = if   ttyq c!   1 nttyq !   else   cons_q   then
      scrollCount off
   then   pause again ;
: cons_getc ( -- c T | F )   on_hw? not if    false exit    then
   cursor_moved @ if   cursor_pos   then
   nttyq @ 0= if   false exit   then
   check_intr   cons_deq true ;

: cons_op ( op -- ... )
        dup 2 = if drop pause cons_getc exit then
        ttchan @ cur_chan @ <> if   ttchan @ set_chan   then






\                                                                    vandys
        \ Dispatch request
        (exec:)
        ( 0: )  bad_cons_op
        ( 1: )  cons_putc
        ( 2: )  nop ( cons_getc is handled above as a special case )
        ( 3: )  cons_page
        ( 4: )  cons_xy
        ( 5: )  cons_blot
        ( 6: )  cons_attr
        ( 7: )  nop ( was initialize--obsolete )
        ( 8: )  cons_putpage
;












\                                                                    vandys
initialize definitions os
: boot-cons ( ? -- n | )
   0= if  400 exit   then

   ['] cons_op   'ttyops !
   $4D 10 gdc!   $0F 11 gdc!
   0 dup cur_chan ! cur_hw !

   cold? if
      fork ?dup 0= if   cons_watcher   else   setrun   then   then

   NSCREEN 0 do   i >scrptr












\                                                                    vandys
      i 0= if   TVRAM   else   dup >scrhw   then   over !

      i if   cold? if

         fork ?dup 0= if drop quit then

         i over >ttchan !   setrun
      then   then
















\                                                                    vandys
      cell+ CONS_ROWS 1- over !   cell+ 0 over !
      cell+ cur_attr @ over !   cell+ 0 over !   cell+ 0 over !
      cell+ blank_page
   loop

   TVRAM set_screenmem

   CONS_ROWS 1- cur_row !   0 cur_col !

   NSCREEN 1 do   i ttchan !   ." Task" i . cr   loop   0 ttchan !
;













\ Support for TTY integration into tasking edisms                    vandys

\ : (key-edisms) ( ttchan -- ? )   cur_hw @ - if   false exit   then
\ TBD: need ttchan/vector combo to be pollable from any context.

only