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

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