fth/flkkey_unix.fs

   1 \  FLK EKEY support
   2 \
   3 \  Copyright (C) 1998 Lars Krueger
   4 \
   5 \  This file is part of FLK.
   6 \
   7 \  FLK is free software; you can redistribute it and/or
   8 \  modify it under the terms of the GNU General Public License
   9 \  as published by the Free Software Foundation; either version 2
  10 \  of the License, or (at your option) any later version.
  11 \
  12 \  This program is distributed in the hope that it will be useful,
  13 \  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 \  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 \  GNU General Public License for more details.
  16 \
  17 \  You should have received a copy of the GNU General Public License
  18 \  along with this program; if not, write to the Free Software
  19 \  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 \ $Id: flkkey_unix.fs,v 1.9 1998/07/13 18:08:54 root Exp $
  22 \ $Log: flkkey_unix.fs,v $
  23 \ Revision 1.9  1998/07/13 18:08:54  root
  24 \ various optimizations
  25 \
  26 \ Revision 1.8  1998/06/01 17:51:42  root
  27 \ SEE shows the sourcefile using VIEW
  28 \
  29 \ Revision 1.7  1998/05/27 18:52:12  root
  30 \ \: commants added for SEE and HELP
  31 \
  32 \ Revision 1.6  1998/05/23 17:52:02  root
  33 \ background processing
  34 \
  35 \ Revision 1.5  1998/05/17 08:27:09  root
  36 \ script mode, ODOES>
  37 \
  38 \ Revision 1.4  1998/05/16 16:19:24  root
  39 \ direct terminfo access
  40 \
  41 \ Revision 1.3  1998/05/01 18:11:25  root
  42 \ GNU license text added
  43 \ comments checked
  44 \
  45 \ Revision 1.2  1998/04/29 18:20:30  root
  46 \ TAB key added
  47 \
  48 \ Revision 1.1  1998/04/07 20:10:33  root
  49 \ Initial revision
  50 \
  51
  52    9 CONSTANT KEY_TAB
  53   13 CONSTANT KEY_RET
  54  127 CONSTANT KEY_BACKSPACE     \ Backspace (unreliable)
  55
  56 23 CONSTANT key-list-len
  57 CREATE key-list
  58 -1 ,  79 , ( key_left )
  59 -1 ,  83 , ( key_right )
  60 -1 ,  87 , ( key_up )
  61 -1 ,  61 , ( key_down )
  62 -1 ,  76 , ( key_home )
  63 -1 , 164 , ( key_end )
  64 -1 ,  81 , ( key_npage )
  65 -1 ,  82 , ( key_ppage )
  66 -1 ,  59 , ( key_dc )
  67 -1 ,  77 , ( key_ic )
  68 -1 ,  65 , ( key_f0 )
  69 -1 ,  66 , ( key_f1 )
  70 -1 ,  68 , ( key_f2 )
  71 -1 ,  69 , ( key_f3 )
  72 -1 ,  70 , ( key_f4 )
  73 -1 ,  71 , ( key_f5 )
  74 -1 ,  72 , ( key_f6 )
  75 -1 ,  73 , ( key_f7 )
  76 -1 ,  74 , ( key_f8 )
  77 -1 ,  75 , ( key_f9 )
  78 -1 ,  67 , ( key_f10 )
  79 -1 , 216 , ( key_f11 )
  80 -1 , 217 , ( key_f12 )
  81
  82 CREATE (ekey-buf) 10 ALLOT
  83 0 VALUE (ek-cache-cnt)
  84 0 VALUE (ek-cache-ind)
  85
  86 \ Reset the flags for the keys.
  87 : (ek-reset)        ( -- )
  88   key-list key-list-len 0 DO
  89     TRUE OVER !
  90     2 CELLS +
  91   LOOP DROP ;
  92
  93 \ Type an zero terminated string.
  94 : .asciiz         ( addr -- )
  95   DUP IF
  96     BEGIN
  97       DUP C@ DUP
  98     WHILE
  99       . CHAR+
 100     REPEAT 2DROP
 101   ELSE
 102     ." <nul>" DROP
 103   THEN
 104   ;
 105
 106 \ List the codes of all keys.
 107 : .(keys)
 108   key-list key-list-len 0 DO
 109     CELL+ DUP @ CELLS TERM-STRING + @ \ addr str
 110     .asciiz CR
 111     CELL+
 112   LOOP DROP ;
 113
 114 0 RVALUE backgrounder
 115
 116 \ See standard.
 117 : KEY         ( -- n )
 118   backgrounder IMAGE-BASE <> IF
 119     BEGIN
 120       backgrounder EXECUTE
 121       KEY?
 122     UNTIL
 123   THEN
 124   (KEY) ;
 125
 126 \ EKEY with background tasking
 127 : ((EKEY))      ( -- n )
 128   backgrounder IMAGE-BASE <> IF
 129     BEGIN
 130       backgrounder EXECUTE
 131       EKEY?
 132     UNTIL
 133   THEN
 134   (EKEY) ;
 135
 136 \ Checks key-list and return number of matches. The case that only one key
 137 \ string matches but is not ended is expressed by n==2 .
 138 : (ek-matches)        ( index key -- index { code 1 / n } )
 139   0 key-list key-list-len 0 DO    \ index key n addr
 140     DUP @ IF        \ index key n addr
 141       DUP CELL+ @ CELLS TERM-STRING + @ \ index key n addr str
 142       ?DUP IF         \ index key n addr
 143   TWIST 2DUP + C@     \ key n addr str index char
 144   ROTARE TUCK = IF    \ n addr str index key
 145     TWIST 1+      \ addr str index key n
 146     2SWAP TUCK      \ addr key n index str index
 147     1+ + C@ 0= IF ( end )   \ addr key n index
 148       NIP NIP NIP I 256 +
 149       1 UNLOOP EXIT
 150     ELSE        \ addr key n index
 151       ROT       \ addr n index key
 152       2SWAP SWAP      \ index key addr n
 153     THEN
 154   ELSE        \ n addr str index key
 155     ROT DROP      \ n addr index key
 156     ROT FALSE OVER !    \ n index key addr
 157     TURN SWAP       \ index key n addr
 158   THEN
 159       THEN
 160     THEN
 161     2 CELLS +
 162   LOOP          \ index key n addr
 163   DROP NIP        \ index n
 164   DUP 1 = IF 1+ THEN
 165 ;
 166
 167 \ See standard.
 168 : EKEY          ( -- n )
 169   (ek-cache-ind) (ek-cache-cnt) < IF
 170     (ek-cache-ind) DUP (ekey-buf) + C@  \ ind n
 171     SWAP 1+ TO (ek-cache-ind)
 172   ELSE ( cache empty )      \
 173     (ek-reset)
 174     0 BEGIN         \ index
 175       ((ekey))        \ index key
 176       2DUP SWAP (ekey-buf) + C!   \ index key
 177       (ek-matches)      \ index ( code 1 / 0 / n )
 178       DUP 0= IF       \ index 0
 179         DROP
 180   1+ TO (ek-cache-cnt)
 181   1 TO (ek-cache-ind)
 182   (ekey-buf) C@       \ n
 183   TRUE
 184       ELSE
 185         1 = IF
 186     NIP 0 TO (ek-cache-cnt)
 187       1 TO (ek-cache-ind) TRUE
 188         ELSE
 189     1+ FALSE
 190   THEN
 191       THEN
 192     UNTIL
 193   THEN ;
 194
 195 256 CONSTANT KEY_LEFT
 196 257 CONSTANT KEY_RIGHT
 197 258 CONSTANT KEY_UP
 198 259 CONSTANT KEY_DOWN
 199 260 CONSTANT KEY_HOME
 200 261 CONSTANT KEY_END
 201 262 CONSTANT KEY_NPAGE
 202 263 CONSTANT KEY_PPAGE
 203 264 CONSTANT KEY_DC
 204 265 CONSTANT KEY_IC
 205 266 CONSTANT KEY_F0
 206 267 CONSTANT KEY_F1
 207 268 CONSTANT KEY_F2
 208 269 CONSTANT KEY_F3
 209 270 CONSTANT KEY_F4
 210 271 CONSTANT KEY_F5
 211 272 CONSTANT KEY_F6
 212 273 CONSTANT KEY_F7
 213 274 CONSTANT KEY_F8
 214 275 CONSTANT KEY_F9
 215 276 CONSTANT KEY_F10
 216 277 CONSTANT KEY_F11
 217 278 CONSTANT KEY_F12