git.gag.com Git - debian/pforth/blob - fth/termio.fth

   1 \ Terminal I/O
   2 \
   3 \ Requires an ANSI compatible terminal.
   4 \
   5 \ To get Windows computers to use ANSI mode in their DOS windows,
   6 \ Add this line to "C:\CONFIG.SYS" then reboot.
   7 \
   8 \  device=c:\windows\command\ansi.sys
   9 \
  10 \ Author: Phil Burk
  11 \ Copyright 1988 Phil Burk
  12 \ Revised 2001 for pForth
  13
  14 ANEW TASK-TERMIO.FTH
  15 decimal
  16
  17 $ 08 constant ASCII_BACKSPACE
  18 $ 7F constant ASCII_DELETE
  19 $ 1B constant ASCII_ESCAPE
  20 $ 01 constant ASCII_CTRL_A
  21 $ 05 constant ASCII_CTRL_E
  22 $ 18 constant ASCII_CTRL_X
  23
  24 \ ANSI arrow key sequences
  25 \ ESC [ 0x41 is UP
  26 \ ESC [ 0x42 is DOWN
  27 \ ESC [ 0x43 is RIGHT
  28 \ ESC [ 0x44 is LEFT
  29
  30 \ ANSI terminal control
  31 \ ESC [ 2J is clear screen
  32 \ ESC [ {n} D is move left
  33 \ ESC [ {n} C is move right
  34 \ ESC [ K is erase to end of line
  35
  36 : ESC[ ( send ESCAPE and [ )
  37     ASCII_ESCAPE emit
  38     ascii [ emit
  39 ;
  40
  41 : CLS ( -- , clear screen )
  42     ESC[ ." 2J"
  43 ;
  44
  45 : TIO.BACKWARDS ( n -- , move cursor backwards )
  46     ESC[
  47     base @ >r decimal
  48     0 .r
  49     r> base !
  50     ascii D emit
  51 ;
  52
  53 : TIO.FORWARDS ( n -- , move cursor forwards )
  54     ESC[
  55     base @ >r decimal
  56     0 .r
  57     r> base !
  58     ascii C emit
  59 ;
  60
  61 : TIO.ERASE.EOL ( -- , erase to the end of the line )
  62     ESC[
  63     ascii K emit
  64 ;
  65
  66 : BELL ( -- , ring the terminal bell )
  67     7 emit
  68 ;
  69
  70 : BACKSPACE ( -- , backspace action )
  71     8 emit  space  8 emit
  72 ;
  73
  74 0 [IF] \ for testing
  75
  76 : SHOWKEYS  ( -- , show keys pressed in hex )
  77     BEGIN
  78         key
  79         dup .
  80         ." , $ " dup .hex cr
  81         ascii q =
  82     UNTIL
  83 ;
  84
  85 : AZ ascii z 1+ ascii a DO i emit LOOP ;
  86
  87 : TEST.BACK1
  88     AZ 5 tio.backwards
  89     1000 msec
  90     tio.erase.eol
  91 ;
  92 : TEST.BACK2
  93     AZ 10 tio.backwards
  94     1000 msec
  95     ." 12345"
  96     1000 msec
  97 ;
  98 [THEN]