keyboard.pp 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. Keyboard unit for linux
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit Keyboard;
  14. interface
  15. {$i keybrdh.inc}
  16. Const
  17. AltPrefix : byte = 0;
  18. ShiftPrefix : byte = 0;
  19. CtrlPrefix : byte = 0;
  20. Function RawReadKey:char;
  21. Function RawReadString : String;
  22. Function KeyPressed : Boolean;
  23. {$ifndef NotUseTree}
  24. Procedure AddSequence(Const St : String; AChar,AScan :byte);
  25. Function FindSequence(Const St : String;var AChar, Ascan : byte) : boolean;
  26. {$endif NotUseTree}
  27. procedure RestoreStartMode;
  28. implementation
  29. uses
  30. Mouse,
  31. {$ifndef NotUseTree}
  32. Strings,
  33. TermInfo,
  34. {$endif NotUseTree}
  35. Unix;
  36. {$i keyboard.inc}
  37. var
  38. OldIO,StartTio : TermIos;
  39. {$ifdef logging}
  40. f : text;
  41. {$endif logging}
  42. {$i keyscan.inc}
  43. {$ifdef Unused}
  44. type
  45. TKeyState = Record
  46. Normal, Shift, Ctrl, Alt : word;
  47. end;
  48. Const
  49. KeyStates : Array[0..255] of TKeyState
  50. (
  51. );
  52. {$endif Unused}
  53. Procedure SetRawMode(b:boolean);
  54. Var
  55. Tio : Termios;
  56. Begin
  57. TCGetAttr(1,Tio);
  58. if b then
  59. begin
  60. OldIO:=Tio;
  61. Tio.c_iflag:=Tio.c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  62. INLCR or IGNCR or ICRNL or IXON));
  63. Tio.c_lflag:=Tio.c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  64. end
  65. else
  66. Tio := OldIO;
  67. TCSetAttr(1,TCSANOW,Tio);
  68. End;
  69. type
  70. chgentry=packed record
  71. tab,
  72. idx,
  73. oldtab,
  74. oldidx : byte;
  75. oldval,
  76. newval : word;
  77. end;
  78. kbentry=packed record
  79. kb_table,
  80. kb_index : byte;
  81. kb_value : word;
  82. end;
  83. const
  84. kbdchanges=10;
  85. kbdchange:array[1..kbdchanges] of chgentry=(
  86. (tab:8; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
  87. (tab:8; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0),
  88. (tab:8; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0),
  89. (tab:8; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0),
  90. (tab:8; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0),
  91. (tab:8; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0),
  92. (tab:8; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0),
  93. (tab:8; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
  94. (tab:8; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
  95. (tab:8; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0)
  96. );
  97. KDGKBENT=$4B46;
  98. KDSKBENT=$4B47;
  99. KDGKBMETA=$4B62;
  100. KDSKBMETA=$4B63;
  101. K_ESCPREFIX=$4;
  102. K_METABIT=$3;
  103. const
  104. oldmeta : longint = 0;
  105. meta : longint = 0;
  106. procedure PatchKeyboard;
  107. var
  108. e : ^chgentry;
  109. entry : kbentry;
  110. i : longint;
  111. begin
  112. Ioctl(stdinputhandle,KDGKBMETA,@oldmeta);
  113. meta:=K_ESCPREFIX;
  114. Ioctl(stdinputhandle,KDSKBMETA,@meta);
  115. for i:=1 to kbdchanges do
  116. begin
  117. e:=@kbdchange[i];
  118. entry.kb_table:=e^.tab;
  119. entry.kb_index:=e^.idx;
  120. Ioctl(stdinputhandle,KDGKBENT,@entry);
  121. e^.oldval:=entry.kb_value;
  122. entry.kb_table:=e^.oldtab;
  123. entry.kb_index:=e^.oldidx;
  124. ioctl(stdinputhandle,KDGKBENT,@entry);
  125. e^.newval:=entry.kb_value;
  126. end;
  127. for i:=1 to kbdchanges do
  128. begin
  129. e:=@kbdchange[i];
  130. entry.kb_table:=e^.tab;
  131. entry.kb_index:=e^.idx;
  132. entry.kb_value:=e^.newval;
  133. Ioctl(stdinputhandle,KDSKBENT,@entry);
  134. end;
  135. end;
  136. procedure UnpatchKeyboard;
  137. var
  138. e : ^chgentry;
  139. entry : kbentry;
  140. i : longint;
  141. begin
  142. if oldmeta in [K_ESCPREFIX,K_METABIT] then
  143. Ioctl(stdinputhandle,KDSKBMETA,@oldmeta);
  144. for i:=1 to kbdchanges do
  145. begin
  146. e:=@kbdchange[i];
  147. entry.kb_table:=e^.tab;
  148. entry.kb_index:=e^.idx;
  149. entry.kb_value:=e^.oldval;
  150. Ioctl(stdinputhandle,KDSKBENT,@entry);
  151. end;
  152. end;
  153. { Buffered Input routines }
  154. const
  155. InSize=256;
  156. var
  157. InBuf : array [0..InSize-1] of char;
  158. InCnt,
  159. InHead,
  160. InTail : longint;
  161. function ttyRecvChar:char;
  162. var
  163. Readed,i : longint;
  164. begin
  165. {Buffer Empty? Yes, Input from StdIn}
  166. if (InHead=InTail) then
  167. begin
  168. {Calc Amount of Chars to Read}
  169. i:=InSize-InHead;
  170. if InTail>InHead then
  171. i:=InTail-InHead;
  172. {Read}
  173. Readed:=fdRead(StdInputHandle,InBuf[InHead],i);
  174. {Increase Counters}
  175. inc(InCnt,Readed);
  176. inc(InHead,Readed);
  177. {Wrap if End has Reached}
  178. if InHead>=InSize then
  179. InHead:=0;
  180. end;
  181. {Check Buffer}
  182. if (InCnt=0) then
  183. ttyRecvChar:=#0
  184. else
  185. begin
  186. ttyRecvChar:=InBuf[InTail];
  187. dec(InCnt);
  188. inc(InTail);
  189. if InTail>=InSize then
  190. InTail:=0;
  191. end;
  192. end;
  193. Const
  194. KeyBufferSize = 20;
  195. var
  196. KeyBuffer : Array[0..KeyBufferSize-1] of Char;
  197. KeyPut,
  198. KeySend : longint;
  199. Procedure PushKey(Ch:char);
  200. Var
  201. Tmp : Longint;
  202. Begin
  203. Tmp:=KeyPut;
  204. Inc(KeyPut);
  205. If KeyPut>=KeyBufferSize Then
  206. KeyPut:=0;
  207. If KeyPut<>KeySend Then
  208. KeyBuffer[Tmp]:=Ch
  209. Else
  210. KeyPut:=Tmp;
  211. End;
  212. Function PopKey:char;
  213. Begin
  214. If KeyPut<>KeySend Then
  215. Begin
  216. PopKey:=KeyBuffer[KeySend];
  217. Inc(KeySend);
  218. If KeySend>=KeyBufferSize Then
  219. KeySend:=0;
  220. End
  221. Else
  222. PopKey:=#0;
  223. End;
  224. Procedure PushExt(b:byte);
  225. begin
  226. PushKey(#0);
  227. PushKey(chr(b));
  228. end;
  229. const
  230. AltKeyStr : string[38]='qwertyuiopasdfghjklzxcvbnm1234567890-=';
  231. AltCodeStr : string[38]=#016#017#018#019#020#021#022#023#024#025#030#031#032#033#034#035#036#037#038+
  232. #044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131;
  233. Function FAltKey(ch:char):byte;
  234. var
  235. Idx : longint;
  236. Begin
  237. Idx:=Pos(ch,AltKeyStr);
  238. if Idx>0 then
  239. FAltKey:=byte(AltCodeStr[Idx])
  240. else
  241. FAltKey:=0;
  242. End;
  243. { This one doesn't care about keypresses already processed by readkey }
  244. { and waiting in the KeyBuffer, only about waiting keypresses at the }
  245. { TTYLevel (including ones that are waiting in the TTYRecvChar buffer) }
  246. function sysKeyPressed: boolean;
  247. var
  248. fdsin : fdSet;
  249. begin
  250. if (InCnt>0) then
  251. sysKeyPressed:=true
  252. else
  253. begin
  254. FD_Zero(fdsin);
  255. fd_Set(StdInputHandle,fdsin);
  256. sysKeypressed:=(Select(StdInputHandle+1,@fdsin,nil,nil,0)>0);
  257. end;
  258. end;
  259. Function KeyPressed:Boolean;
  260. Begin
  261. Keypressed := (KeySend<>KeyPut) or sysKeyPressed;
  262. End;
  263. Function IsConsole : Boolean;
  264. var
  265. ThisTTY: String[30];
  266. begin
  267. IsConsole:=false;
  268. { check for tty }
  269. if IsATTY(stdinputhandle) then
  270. begin
  271. { running on a tty, find out whether locally or remotely }
  272. ThisTTY:=TTYName(stdinputhandle);
  273. if (Copy(ThisTTY, 1, 8) = '/dev/tty') and
  274. (ThisTTY[9] >= '0') and (ThisTTY[9] <= '9') then
  275. IsConsole:=true;
  276. end;
  277. end;
  278. Const
  279. LastMouseEvent : TMouseEvent =
  280. (
  281. Buttons : 0;
  282. X : 0;
  283. Y : 0;
  284. Action : 0;
  285. );
  286. {$ifndef NotUseTree}
  287. procedure GenMouseEvent;
  288. var MouseEvent: TMouseEvent;
  289. ch : char;
  290. fdsin : fdSet;
  291. begin
  292. FD_Zero(fdsin);
  293. fd_Set(StdInputHandle,fdsin);
  294. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  295. if InCnt=0 then
  296. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  297. ch:=ttyRecvChar;
  298. { Other bits are used for Shift, Meta and Ctrl modifiers PM }
  299. case (ord(ch)-ord(' ')) and 3 of
  300. 0 : {left button press}
  301. MouseEvent.buttons:=1;
  302. 1 : {middle button pressed }
  303. MouseEvent.buttons:=2;
  304. 2 : { right button pressed }
  305. MouseEvent.buttons:=4;
  306. 3 : { no button pressed };
  307. end;
  308. if InCnt=0 then
  309. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  310. ch:=ttyRecvChar;
  311. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  312. if InCnt=0 then
  313. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  314. ch:=ttyRecvChar;
  315. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  316. if (MouseEvent.buttons<>0) then
  317. MouseEvent.action:=MouseActionDown
  318. else
  319. begin
  320. if (LastMouseEvent.Buttons<>0) and
  321. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  322. begin
  323. MouseEvent.Action:=MouseActionMove;
  324. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  325. {$ifdef DebugMouse}
  326. Writeln(system.stderr,' Mouse Move (',MouseEvent.X,',',MouseEvent.Y,')');
  327. {$endif DebugMouse}
  328. PutMouseEvent(MouseEvent);
  329. MouseEvent.Buttons:=0;
  330. end;
  331. MouseEvent.Action:=MouseActionUp;
  332. end;
  333. PutMouseEvent(MouseEvent);
  334. {$ifdef DebugMouse}
  335. if MouseEvent.Action=MouseActionDown then
  336. Write(system.stderr,'Button down : ')
  337. else
  338. Write(system.stderr,'Button up : ');
  339. Writeln(system.stderr,'buttons = ',MouseEvent.Buttons,' (',MouseEvent.X,',',MouseEvent.Y,')');
  340. {$endif DebugMouse}
  341. LastMouseEvent:=MouseEvent;
  342. end;
  343. type
  344. TProcedure = procedure;
  345. PTreeElement = ^TTreeElement;
  346. TTreeElement = record
  347. Next,Parent,Child : PTreeElement;
  348. CanBeTerminal : boolean;
  349. char : byte;
  350. ScanValue : byte;
  351. CharValue : byte;
  352. SpecialHandler : TProcedure;
  353. end;
  354. var
  355. RootTree : Array[0..255] of PTreeElement;
  356. function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement;
  357. var PT : PTreeElement;
  358. begin
  359. New(PT);
  360. FillChar(PT^,SizeOf(TTreeElement),#0);
  361. PT^.char:=ch;
  362. PT^.Parent:=Pa;
  363. if Assigned(Pa) and (Pa^.Child=nil) then
  364. Pa^.Child:=PT;
  365. NewPTree:=PT;
  366. end;
  367. function DoAddSequence(Const St : String; AChar,AScan :byte) : PTreeElement;
  368. var
  369. CurPTree,NPT : PTreeElement;
  370. c : byte;
  371. i : longint;
  372. begin
  373. if St='' then
  374. begin
  375. DoAddSequence:=nil;
  376. exit;
  377. end;
  378. CurPTree:=RootTree[ord(st[1])];
  379. if CurPTree=nil then
  380. begin
  381. CurPTree:=NewPTree(ord(st[1]),nil);
  382. RootTree[ord(st[1])]:=CurPTree;
  383. end;
  384. for i:=2 to Length(St) do
  385. begin
  386. NPT:=CurPTree^.Child;
  387. c:=ord(St[i]);
  388. if NPT=nil then
  389. NPT:=NewPTree(c,CurPTree);
  390. CurPTree:=nil;
  391. while assigned(NPT) and (NPT^.char<c) do
  392. begin
  393. CurPTree:=NPT;
  394. NPT:=NPT^.Next;
  395. end;
  396. if assigned(NPT) and (NPT^.char=c) then
  397. CurPTree:=NPT
  398. else
  399. begin
  400. if CurPTree=nil then
  401. begin
  402. NPT^.Parent^.child:=NewPTree(c,NPT^.Parent);
  403. CurPTree:=NPT^.Parent^.Child;
  404. CurPTree^.Next:=NPT;
  405. end
  406. else
  407. begin
  408. CurPTree^.Next:=NewPTree(c,CurPTree^.Parent);
  409. CurPTree:=CurPTree^.Next;
  410. CurPTree^.Next:=NPT;
  411. end;
  412. end;
  413. end;
  414. if CurPTree^.CanBeTerminal then
  415. begin
  416. { here we have a conflict !! }
  417. { maybe we should claim }
  418. with CurPTree^ do
  419. begin
  420. {$ifdef DEBUG}
  421. if (ScanValue<>AScan) or (CharValue<>AChar) then
  422. Writeln(system.stderr,'key "',st,'" changed value');
  423. if (ScanValue<>AScan) then
  424. Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan);
  425. if (CharValue<>AChar) then
  426. Writeln(system.stderr,'Char was ',chr(CharValue),' now ',chr(AChar));
  427. {$endif DEBUG}
  428. ScanValue:=AScan;
  429. CharValue:=AChar;
  430. end;
  431. end
  432. else with CurPTree^ do
  433. begin
  434. CanBeTerminal:=True;
  435. ScanValue:=AScan;
  436. CharValue:=AChar;
  437. end;
  438. DoAddSequence:=CurPTree;
  439. end;
  440. procedure AddSequence(Const St : String; AChar,AScan :byte);
  441. begin
  442. DoAddSequence(St,AChar,AScan);
  443. end;
  444. { Returns the Child that as c as char if it exists }
  445. Function FindChild(c : byte;Root : PTreeElement) : PTreeElement;
  446. var
  447. NPT : PTreeElement;
  448. begin
  449. if not assigned(Root) then
  450. begin
  451. FindChild:=nil;
  452. exit;
  453. end;
  454. NPT:=Root^.Child;
  455. while assigned(NPT) and (NPT^.char<c) do
  456. NPT:=NPT^.Next;
  457. if assigned(NPT) and (NPT^.char=c) then
  458. FindChild:=NPT
  459. else
  460. FindChild:=nil;
  461. end;
  462. Function AddSpecialSequence(Const St : string;Proc : TProcedure) : PTreeElement;
  463. var
  464. NPT : PTreeElement;
  465. begin
  466. NPT:=DoAddSequence(St,0,0);
  467. NPT^.SpecialHandler:=Proc;
  468. AddSpecialSequence:=NPT;
  469. end;
  470. function FindSequence(Const St : String;var AChar,AScan :byte) : boolean;
  471. var
  472. NPT : PTreeElement;
  473. I : longint;
  474. begin
  475. FindSequence:=false;
  476. AChar:=0;
  477. AScan:=0;
  478. if St='' then
  479. exit;
  480. NPT:=RootTree[ord(St[1])];
  481. if not assigned(NPT) then
  482. exit;
  483. for i:=2 to Length(St) do
  484. begin
  485. NPT:=FindChild(ord(St[i]),NPT);
  486. if not assigned(NPT) then
  487. exit;
  488. end;
  489. if not NPT^.CanBeTerminal then
  490. exit
  491. else
  492. begin
  493. FindSequence:=true;
  494. AScan:=NPT^.ScanValue;
  495. AChar:=NPT^.CharValue;
  496. end;
  497. end;
  498. Procedure LoadDefaultSequences;
  499. begin
  500. AddSpecialSequence(#27'[M',@GenMouseEvent);
  501. { linux default values, the next setting is
  502. compatible with xterms from XFree 4.x }
  503. DoAddSequence(#127,8,0);
  504. { all Esc letter }
  505. DoAddSequence(#27'A',0,kbAltA);
  506. DoAddSequence(#27'a',0,kbAltA);
  507. DoAddSequence(#27'B',0,kbAltB);
  508. DoAddSequence(#27'b',0,kbAltB);
  509. DoAddSequence(#27'C',0,kbAltC);
  510. DoAddSequence(#27'c',0,kbAltC);
  511. DoAddSequence(#27'D',0,kbAltD);
  512. DoAddSequence(#27'd',0,kbAltD);
  513. DoAddSequence(#27'E',0,kbAltE);
  514. DoAddSequence(#27'e',0,kbAltE);
  515. DoAddSequence(#27'F',0,kbAltF);
  516. DoAddSequence(#27'f',0,kbAltF);
  517. DoAddSequence(#27'G',0,kbAltG);
  518. DoAddSequence(#27'g',0,kbAltG);
  519. DoAddSequence(#27'H',0,kbAltH);
  520. DoAddSequence(#27'h',0,kbAltH);
  521. DoAddSequence(#27'I',0,kbAltI);
  522. DoAddSequence(#27'i',0,kbAltI);
  523. DoAddSequence(#27'J',0,kbAltJ);
  524. DoAddSequence(#27'j',0,kbAltJ);
  525. DoAddSequence(#27'K',0,kbAltK);
  526. DoAddSequence(#27'k',0,kbAltK);
  527. DoAddSequence(#27'L',0,kbAltL);
  528. DoAddSequence(#27'l',0,kbAltL);
  529. DoAddSequence(#27'M',0,kbAltM);
  530. DoAddSequence(#27'm',0,kbAltM);
  531. DoAddSequence(#27'N',0,kbAltN);
  532. DoAddSequence(#27'n',0,kbAltN);
  533. DoAddSequence(#27'O',0,kbAltO);
  534. DoAddSequence(#27'o',0,kbAltO);
  535. DoAddSequence(#27'P',0,kbAltP);
  536. DoAddSequence(#27'p',0,kbAltP);
  537. DoAddSequence(#27'Q',0,kbAltQ);
  538. DoAddSequence(#27'q',0,kbAltQ);
  539. DoAddSequence(#27'R',0,kbAltR);
  540. DoAddSequence(#27'r',0,kbAltR);
  541. DoAddSequence(#27'S',0,kbAltS);
  542. DoAddSequence(#27's',0,kbAltS);
  543. DoAddSequence(#27'T',0,kbAltT);
  544. DoAddSequence(#27't',0,kbAltT);
  545. DoAddSequence(#27'U',0,kbAltU);
  546. DoAddSequence(#27'u',0,kbAltU);
  547. DoAddSequence(#27'V',0,kbAltV);
  548. DoAddSequence(#27'v',0,kbAltV);
  549. DoAddSequence(#27'W',0,kbAltW);
  550. DoAddSequence(#27'w',0,kbAltW);
  551. DoAddSequence(#27'X',0,kbAltX);
  552. DoAddSequence(#27'x',0,kbAltX);
  553. DoAddSequence(#27'Y',0,kbAltY);
  554. DoAddSequence(#27'y',0,kbAltY);
  555. DoAddSequence(#27'Z',0,kbAltZ);
  556. DoAddSequence(#27'z',0,kbAltZ);
  557. DoAddSequence(#27'-',0,kbAltMinus);
  558. DoAddSequence(#27'=',0,kbAltEqual);
  559. DoAddSequence(#27'0',0,kbAlt0);
  560. DoAddSequence(#27'1',0,kbAlt1);
  561. DoAddSequence(#27'2',0,kbAlt2);
  562. DoAddSequence(#27'3',0,kbAlt3);
  563. DoAddSequence(#27'4',0,kbAlt4);
  564. DoAddSequence(#27'5',0,kbAlt5);
  565. DoAddSequence(#27'6',0,kbAlt6);
  566. DoAddSequence(#27'7',0,kbAlt7);
  567. DoAddSequence(#27'8',0,kbAlt8);
  568. DoAddSequence(#27'9',0,kbAlt9);
  569. { vt100 default values }
  570. DoAddSequence(#27'[[A',0,kbF1);
  571. DoAddSequence(#27'[[B',0,kbF2);
  572. DoAddSequence(#27'[[C',0,kbF3);
  573. DoAddSequence(#27'[[D',0,kbF4);
  574. DoAddSequence(#27'[[E',0,kbF5);
  575. DoAddSequence(#27'[17~',0,kbF6);
  576. DoAddSequence(#27'[18~',0,kbF7);
  577. DoAddSequence(#27'[19~',0,kbF8);
  578. DoAddSequence(#27'[20~',0,kbF9);
  579. DoAddSequence(#27'[21~',0,kbF10);
  580. DoAddSequence(#27'[23~',0,kbF11);
  581. DoAddSequence(#27'[24~',0,kbF12);
  582. DoAddSequence(#27'[25~',0,kbShiftF3);
  583. DoAddSequence(#27'[26~',0,kbShiftF4);
  584. DoAddSequence(#27'[28~',0,kbShiftF5);
  585. DoAddSequence(#27'[29~',0,kbShiftF6);
  586. DoAddSequence(#27'[31~',0,kbShiftF7);
  587. DoAddSequence(#27'[32~',0,kbShiftF8);
  588. DoAddSequence(#27'[33~',0,kbShiftF9);
  589. DoAddSequence(#27'[34~',0,kbShiftF10);
  590. DoAddSequence(#27#27'[[A',0,kbAltF1);
  591. DoAddSequence(#27#27'[[B',0,kbAltF2);
  592. DoAddSequence(#27#27'[[C',0,kbAltF3);
  593. DoAddSequence(#27#27'[[D',0,kbAltF4);
  594. DoAddSequence(#27#27'[[E',0,kbAltF5);
  595. DoAddSequence(#27#27'[17~',0,kbAltF6);
  596. DoAddSequence(#27#27'[18~',0,kbAltF7);
  597. DoAddSequence(#27#27'[19~',0,kbAltF8);
  598. DoAddSequence(#27#27'[20~',0,kbAltF9);
  599. DoAddSequence(#27#27'[21~',0,kbAltF10);
  600. DoAddSequence(#27#27'[23~',0,kbAltF11);
  601. DoAddSequence(#27#27'[24~',0,kbAltF12);
  602. DoAddSequence(#27'[A',0,kbUp);
  603. DoAddSequence(#27'[B',0,kbDown);
  604. DoAddSequence(#27'[C',0,kbRight);
  605. DoAddSequence(#27'[D',0,kbLeft);
  606. DoAddSequence(#27'[F',0,kbEnd);
  607. DoAddSequence(#27'[H',0,kbHome);
  608. DoAddSequence(#27'[Z',0,kbShiftTab);
  609. DoAddSequence(#27'[5~',0,kbPgUp);
  610. DoAddSequence(#27'[6~',0,kbPgDn);
  611. DoAddSequence(#27'[4~',0,kbEnd);
  612. DoAddSequence(#27'[1~',0,kbHome);
  613. DoAddSequence(#27'[2~',0,kbIns);
  614. DoAddSequence(#27'[3~',0,kbDel);
  615. DoAddSequence(#27#27'[A',0,kbAltUp);
  616. DoAddSequence(#27#27'[B',0,kbAltDown);
  617. DoAddSequence(#27#27'[D',0,kbAltLeft);
  618. DoAddSequence(#27#27'[C',0,kbAltRight);
  619. DoAddSequence(#27#27'[5~',0,kbAltPgUp);
  620. DoAddSequence(#27#27'[6~',0,kbAltPgDn);
  621. DoAddSequence(#27#27'[4~',0,kbAltEnd);
  622. DoAddSequence(#27#27'[1~',0,kbAltHome);
  623. DoAddSequence(#27#27'[2~',0,kbAltIns);
  624. DoAddSequence(#27#27'[3~',0,kbAltDel);
  625. DoAddSequence(#27'OP',0,kbF1);
  626. DoAddSequence(#27'OQ',0,kbF2);
  627. DoAddSequence(#27'OR',0,kbF3);
  628. DoAddSequence(#27'OS',0,kbF4);
  629. DoAddSequence(#27'Ot',0,kbF5);
  630. DoAddSequence(#27'Ou',0,kbF6);
  631. DoAddSequence(#27'Ov',0,kbF7);
  632. DoAddSequence(#27'Ol',0,kbF8);
  633. DoAddSequence(#27'Ow',0,kbF9);
  634. DoAddSequence(#27'Ox',0,kbF10);
  635. DoAddSequence(#27'Oy',0,kbF11);
  636. DoAddSequence(#27'Oz',0,kbF12);
  637. DoAddSequence(#27#27'OP',0,kbAltF1);
  638. DoAddSequence(#27#27'OQ',0,kbAltF2);
  639. DoAddSequence(#27#27'OR',0,kbAltF3);
  640. DoAddSequence(#27#27'OS',0,kbAltF4);
  641. DoAddSequence(#27#27'Ot',0,kbAltF5);
  642. DoAddSequence(#27#27'Ou',0,kbAltF6);
  643. DoAddSequence(#27#27'Ov',0,kbAltF7);
  644. DoAddSequence(#27#27'Ol',0,kbAltF8);
  645. DoAddSequence(#27#27'Ow',0,kbAltF9);
  646. DoAddSequence(#27#27'Ox',0,kbAltF10);
  647. DoAddSequence(#27#27'Oy',0,kbAltF11);
  648. DoAddSequence(#27#27'Oz',0,kbAltF12);
  649. DoAddSequence(#27'OA',0,kbUp);
  650. DoAddSequence(#27'OB',0,kbDown);
  651. DoAddSequence(#27'OC',0,kbRight);
  652. DoAddSequence(#27'OD',0,kbLeft);
  653. DoAddSequence(#27#27'OA',0,kbAltUp);
  654. DoAddSequence(#27#27'OB',0,kbAltDown);
  655. DoAddSequence(#27#27'OC',0,kbAltRight);
  656. DoAddSequence(#27#27'OD',0,kbAltLeft);
  657. { xterm default values }
  658. { xterm alternate default values }
  659. { ignored sequences }
  660. DoAddSequence(#27'[?1;0c',0,0);
  661. DoAddSequence(#27'[?1l',0,0);
  662. DoAddSequence(#27'[?1h',0,0);
  663. DoAddSequence(#27'[?1;2c',0,0);
  664. DoAddSequence(#27'[?7l',0,0);
  665. DoAddSequence(#27'[?7h',0,0);
  666. end;
  667. function EnterEscapeSeqNdx(Ndx: Word;Char,Scan : byte) : PTreeElement;
  668. var
  669. P,pdelay: PChar;
  670. St : string;
  671. begin
  672. EnterEscapeSeqNdx:=nil;
  673. P:=cur_term_Strings^[Ndx];
  674. if assigned(p) then
  675. begin { Do not record the delays }
  676. pdelay:=strpos(p,'$<');
  677. if assigned(pdelay) then
  678. pdelay^:=#0;
  679. St:=StrPas(p);
  680. EnterEscapeSeqNdx:=DoAddSequence(St,Char,Scan);
  681. if assigned(pdelay) then
  682. pdelay^:='$';
  683. end;
  684. end;
  685. Procedure LoadTermInfoSequences;
  686. var
  687. err : longint;
  688. begin
  689. if not assigned(cur_term) then
  690. setupterm(nil, stdoutputhandle, err);
  691. if not assigned(cur_term_Strings) then
  692. exit;
  693. EnterEscapeSeqNdx(key_f1,0,kbF1);
  694. EnterEscapeSeqNdx(key_f2,0,kbF2);
  695. EnterEscapeSeqNdx(key_f3,0,kbF3);
  696. EnterEscapeSeqNdx(key_f4,0,kbF4);
  697. EnterEscapeSeqNdx(key_f5,0,kbF5);
  698. EnterEscapeSeqNdx(key_f6,0,kbF6);
  699. EnterEscapeSeqNdx(key_f7,0,kbF7);
  700. EnterEscapeSeqNdx(key_f8,0,kbF8);
  701. EnterEscapeSeqNdx(key_f9,0,kbF9);
  702. EnterEscapeSeqNdx(key_f10,0,kbF10);
  703. EnterEscapeSeqNdx(key_f11,0,kbF11);
  704. EnterEscapeSeqNdx(key_f12,0,kbF12);
  705. EnterEscapeSeqNdx(key_up,0,kbUp);
  706. EnterEscapeSeqNdx(key_down,0,kbDown);
  707. EnterEscapeSeqNdx(key_left,0,kbLeft);
  708. EnterEscapeSeqNdx(key_right,0,kbRight);
  709. EnterEscapeSeqNdx(key_ppage,0,kbPgUp);
  710. EnterEscapeSeqNdx(key_npage,0,kbPgDn);
  711. EnterEscapeSeqNdx(key_end,0,kbEnd);
  712. EnterEscapeSeqNdx(key_home,0,kbHome);
  713. EnterEscapeSeqNdx(key_ic,0,kbIns);
  714. EnterEscapeSeqNdx(key_dc,0,kbDel);
  715. EnterEscapeSeqNdx(key_stab,0,kbShiftTab);
  716. { EnterEscapeSeqNdx(key_,0,kb);
  717. EnterEscapeSeqNdx(key_,0,kb); }
  718. end;
  719. {$endif not NotUseTree}
  720. Function RawReadKey:char;
  721. Var
  722. fdsin : fdSet;
  723. Begin
  724. {Check Buffer first}
  725. if KeySend<>KeyPut then
  726. begin
  727. RawReadKey:=PopKey;
  728. exit;
  729. end;
  730. {Wait for Key}
  731. if not sysKeyPressed then
  732. begin
  733. FD_Zero (fdsin);
  734. FD_Set (StdInputHandle,fdsin);
  735. Select (StdInputHandle+1,@fdsin,nil,nil,nil);
  736. end;
  737. RawReadKey:=ttyRecvChar;
  738. end;
  739. Function RawReadString : String;
  740. Var
  741. ch : char;
  742. fdsin : fdSet;
  743. St : String;
  744. Begin
  745. St:=RawReadKey;
  746. FD_Zero (fdsin);
  747. FD_Set (StdInputHandle,fdsin);
  748. Repeat
  749. if InCnt=0 then
  750. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  751. if SysKeyPressed then
  752. ch:=ttyRecvChar
  753. else
  754. ch:=#0;
  755. if ch<>#0 then
  756. St:=St+ch;
  757. Until ch=#0;
  758. RawReadString:=St;
  759. end;
  760. Function ReadKey(var IsAlt : boolean):char;
  761. Var
  762. ch : char;
  763. {$ifdef NotUseTree}
  764. OldState : longint;
  765. State : longint;
  766. {$endif NotUseTree}
  767. is_delay : boolean;
  768. fdsin : fdSet;
  769. store : array [0..8] of char;
  770. arrayind : byte;
  771. {$ifndef NotUseTree}
  772. NPT,NNPT : PTreeElement;
  773. {$else NotUseTree}
  774. procedure GenMouseEvent;
  775. var MouseEvent: TMouseEvent;
  776. begin
  777. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  778. case ch of
  779. #32 : {left button pressed }
  780. MouseEvent.buttons:=1;
  781. #33 : {middle button pressed }
  782. MouseEvent.buttons:=2;
  783. #34 : { right button pressed }
  784. MouseEvent.buttons:=4;
  785. #35 : { no button pressed };
  786. end;
  787. if InCnt=0 then
  788. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  789. ch:=ttyRecvChar;
  790. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  791. if InCnt=0 then
  792. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  793. ch:=ttyRecvChar;
  794. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  795. if (MouseEvent.buttons<>0) then
  796. MouseEvent.action:=MouseActionDown
  797. else
  798. begin
  799. if (LastMouseEvent.Buttons<>0) and
  800. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  801. begin
  802. MouseEvent.Action:=MouseActionMove;
  803. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  804. PutMouseEvent(MouseEvent);
  805. MouseEvent.Buttons:=0;
  806. end;
  807. MouseEvent.Action:=MouseActionUp;
  808. end;
  809. PutMouseEvent(MouseEvent);
  810. LastMouseEvent:=MouseEvent;
  811. end;
  812. {$endif NotUseTree}
  813. procedure RestoreArray;
  814. var
  815. i : byte;
  816. begin
  817. for i:=0 to arrayind-1 do
  818. PushKey(store[i]);
  819. end;
  820. Begin
  821. IsAlt:=false;
  822. {Check Buffer first}
  823. if KeySend<>KeyPut then
  824. begin
  825. ReadKey:=PopKey;
  826. exit;
  827. end;
  828. {Wait for Key}
  829. if not sysKeyPressed then
  830. begin
  831. FD_Zero (fdsin);
  832. FD_Set (StdInputHandle,fdsin);
  833. Select (StdInputHandle+1,@fdsin,nil,nil,nil);
  834. end;
  835. ch:=ttyRecvChar;
  836. {$ifndef NotUseTree}
  837. NPT:=RootTree[ord(ch)];
  838. if not assigned(NPT) then
  839. PushKey(ch)
  840. else
  841. begin
  842. FD_Zero(fdsin);
  843. fd_Set(StdInputHandle,fdsin);
  844. store[0]:=ch;
  845. arrayind:=1;
  846. while assigned(NPT) and syskeypressed do
  847. begin
  848. if (InCnt=0) then
  849. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  850. ch:=ttyRecvChar;
  851. NNPT:=FindChild(ord(ch),NPT);
  852. if assigned(NNPT) then
  853. Begin
  854. NPT:=NNPT;
  855. if NPT^.CanBeTerminal and
  856. assigned(NPT^.SpecialHandler) then
  857. break;
  858. End;
  859. if ch<>#0 then
  860. begin
  861. store[arrayind]:=ch;
  862. inc(arrayind);
  863. end;
  864. if not assigned(NNPT) then
  865. begin
  866. if ch<>#0 then
  867. begin
  868. { Put that unused char back into InBuf }
  869. If InTail=0 then
  870. InTail:=InSize-1
  871. else
  872. Dec(InTail);
  873. InBuf[InTail]:=ch;
  874. inc(InCnt);
  875. end;
  876. break;
  877. end;
  878. end;
  879. if assigned(NPT) and NPT^.CanBeTerminal then
  880. begin
  881. if assigned(NPT^.SpecialHandler) then
  882. begin
  883. NPT^.SpecialHandler;
  884. PushExt(0);
  885. end
  886. else if NPT^.CharValue<>0 then
  887. PushKey(chr(NPT^.CharValue))
  888. else if NPT^.ScanValue<>0 then
  889. PushExt(NPT^.ScanValue);
  890. end
  891. else
  892. RestoreArray;
  893. {$else NotUseTree}
  894. {Esc Found ?}
  895. If (ch=#27) then
  896. begin
  897. FD_Zero(fdsin);
  898. fd_Set(StdInputHandle,fdsin);
  899. State:=1;
  900. store[0]:=#27;
  901. arrayind:=1;
  902. {$ifdef logging}
  903. write(f,'Esc');
  904. {$endif logging}
  905. if InCnt=0 then
  906. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  907. while (State<>0) and (sysKeyPressed) do
  908. begin
  909. ch:=ttyRecvChar;
  910. store[arrayind]:=ch;
  911. inc(arrayind);
  912. {$ifdef logging}
  913. if ord(ch)>31 then
  914. write(f,ch)
  915. else
  916. write(f,'#',ord(ch):2);
  917. {$endif logging}
  918. OldState:=State;
  919. State:=0;
  920. case OldState of
  921. 1 : begin {Esc}
  922. case ch of
  923. 'a'..'z',
  924. '0'..'9',
  925. '-','=' : PushExt(FAltKey(ch));
  926. 'A'..'N',
  927. 'P'..'Z' : PushExt(FAltKey(chr(ord(ch)+ord('a')-ord('A'))));
  928. #10 : PushKey(#10);
  929. #13 : PushKey(#10);
  930. #27 : begin
  931. IsAlt:=True;
  932. State:=1;
  933. end;
  934. #127 : PushExt(kbAltDel);
  935. '[' : State:=2;
  936. 'O' : State:=6;
  937. else
  938. RestoreArray;
  939. end;
  940. end;
  941. 2 : begin {Esc[}
  942. case ch of
  943. '[' : State:=3;
  944. 'A' : PushExt(kbUp);
  945. 'B' : PushExt(kbDown);
  946. 'C' : PushExt(kbRight);
  947. 'D' : PushExt(kbLeft);
  948. 'F' : PushExt(kbEnd);
  949. 'G' : PushKey('5');
  950. 'H' : PushExt(kbHome);
  951. 'K' : PushExt(kbEnd);
  952. 'M' : State:=13;
  953. '1' : State:=4;
  954. '2' : State:=5;
  955. '3' : State:=12;{PushExt(kbDel)}
  956. '4' : PushExt(kbEnd);
  957. '5' : PushExt(73);
  958. '6' : PushExt(kbPgDn);
  959. '?' : State:=7;
  960. else
  961. RestoreArray;
  962. end;
  963. if ch in ['4'..'6'] then
  964. State:=255;
  965. end;
  966. 3 : begin {Esc[[}
  967. case ch of
  968. 'A' : PushExt(kbF1);
  969. 'B' : PushExt(kbF2);
  970. 'C' : PushExt(kbF3);
  971. 'D' : PushExt(kbF4);
  972. 'E' : PushExt(kbF5);
  973. else
  974. RestoreArray;
  975. end;
  976. end;
  977. 4 : begin {Esc[1}
  978. case ch of
  979. '~' : PushExt(kbHome);
  980. '7' : PushExt(kbF6);
  981. '8' : PushExt(kbF7);
  982. '9' : PushExt(kbF8);
  983. else
  984. RestoreArray;
  985. end;
  986. if (Ch<>'~') then
  987. State:=255;
  988. end;
  989. 5 : begin {Esc[2}
  990. case ch of
  991. '~' : PushExt(kbIns);
  992. '0' : pushExt(kbF9);
  993. '1' : PushExt(kbF10);
  994. '3' : PushExt($85){F11, but ShiftF1 also !!};
  995. '4' : PushExt($86){F12, but Shift F2 also !!};
  996. '5' : PushExt($56){ShiftF3};
  997. '6' : PushExt($57){ShiftF4};
  998. '8' : PushExt($58){ShiftF5};
  999. '9' : PushExt($59){ShiftF6};
  1000. else
  1001. RestoreArray;
  1002. end;
  1003. if (Ch<>'~') then
  1004. State:=255;
  1005. end;
  1006. 12 : begin {Esc[3}
  1007. case ch of
  1008. '~' : PushExt(kbDel);
  1009. '1' : PushExt($5A){ShiftF7};
  1010. '2' : PushExt($5B){ShiftF8};
  1011. '3' : PushExt($5C){ShiftF9};
  1012. '4' : PushExt($5D){ShiftF10};
  1013. else
  1014. RestoreArray;
  1015. end;
  1016. if (Ch<>'~') then
  1017. State:=255;
  1018. end;
  1019. 6 : begin {EscO Function keys in vt100 mode PM }
  1020. case ch of
  1021. 'P' : {F1}PushExt(kbF1);
  1022. 'Q' : {F2}PushExt(kbF2);
  1023. 'R' : {F3}PushExt(kbF3);
  1024. 'S' : {F4}PushExt(kbF4);
  1025. 't' : {F5}PushExt(kbF5);
  1026. 'u' : {F6}PushExt(kbF6);
  1027. 'v' : {F7}PushExt(kbF7);
  1028. 'l' : {F8}PushExt(kbF8);
  1029. 'w' : {F9}PushExt(kbF9);
  1030. 'x' : {F10}PushExt(kbF10);
  1031. 'D' : {keyLeft}PushExt($4B);
  1032. 'C' : {keyRight}PushExt($4D);
  1033. 'A' : {keyUp}PushExt($48);
  1034. 'B' : {keyDown}PushExt($50);
  1035. else
  1036. RestoreArray;
  1037. end;
  1038. end;
  1039. 7 : begin {Esc[? keys in vt100 mode PM }
  1040. case ch of
  1041. '0' : State:=11;
  1042. '1' : State:=8;
  1043. '7' : State:=9;
  1044. else
  1045. RestoreArray;
  1046. end;
  1047. end;
  1048. 8 : begin {Esc[?1 keys in vt100 mode PM }
  1049. case ch of
  1050. 'l' : {local mode};
  1051. 'h' : {transmit mode};
  1052. ';' : { 'Esc[1;0c seems to be sent by M$ telnet app
  1053. for no hangup purposes }
  1054. state:=10;
  1055. else
  1056. RestoreArray;
  1057. end;
  1058. end;
  1059. 9 : begin {Esc[?7 keys in vt100 mode PM }
  1060. case ch of
  1061. 'l' : {exit_am_mode};
  1062. 'h' : {enter_am_mode};
  1063. else
  1064. RestoreArray;
  1065. end;
  1066. end;
  1067. 10 : begin {Esc[?1; keys in vt100 mode PM }
  1068. case ch of
  1069. '0' : state:=11;
  1070. else
  1071. RestoreArray;
  1072. end;
  1073. end;
  1074. 11 : begin {Esc[?1;0 keys in vt100 mode PM }
  1075. case ch of
  1076. 'c' : ;
  1077. else
  1078. RestoreArray;
  1079. end;
  1080. end;
  1081. 13 : begin {Esc[M mouse prefix for xterm }
  1082. GenMouseEvent;
  1083. end;
  1084. 255 : { just forget this trailing char };
  1085. end;
  1086. if (State<>0) and (InCnt=0) then
  1087. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1088. end;
  1089. if State=1 then
  1090. PushKey(ch);
  1091. {$endif NotUseTree}
  1092. if ch='$' then
  1093. begin { '$<XX>' means a delay of XX millisecs }
  1094. is_delay :=false;
  1095. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1096. if (sysKeyPressed) then
  1097. begin
  1098. ch:=ttyRecvChar;
  1099. is_delay:=(ch='<');
  1100. if not is_delay then
  1101. begin
  1102. PushKey('$');
  1103. PushKey(ch);
  1104. end
  1105. else
  1106. begin
  1107. {$ifdef logging}
  1108. write(f,'$<');
  1109. {$endif logging}
  1110. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1111. while (sysKeyPressed) and (ch<>'>') do
  1112. begin
  1113. { Should we really repect this delay ?? }
  1114. ch:=ttyRecvChar;
  1115. {$ifdef logging}
  1116. write(f,ch);
  1117. {$endif logging}
  1118. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1119. end;
  1120. end;
  1121. end
  1122. else
  1123. PushKey('$');
  1124. end;
  1125. end
  1126. {$ifdef logging}
  1127. writeln(f);
  1128. {$endif logging}
  1129. {$ifndef NotUseTree}
  1130. ;
  1131. ReadKey:=PopKey;
  1132. {$else NotUseTree}
  1133. else
  1134. Begin
  1135. case ch of
  1136. #127 : PushKey(#8);
  1137. else
  1138. PushKey(ch);
  1139. end;
  1140. End;
  1141. ReadKey:=PopKey;
  1142. {$endif NotUseTree}
  1143. End;
  1144. function ShiftState:byte;
  1145. var
  1146. arg,shift : longint;
  1147. begin
  1148. arg:=6;
  1149. shift:=0;
  1150. {$Ifndef BSD}
  1151. if IOCtl(StdInputHandle,TIOCLINUX,@arg) then
  1152. begin
  1153. if (arg and 8)<>0 then
  1154. shift:=kbAlt;
  1155. if (arg and 4)<>0 then
  1156. inc(shift,kbCtrl);
  1157. { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
  1158. if (arg and 2)<>0 then
  1159. shift:=shift or (kbAlt or kbCtrl);
  1160. if (arg and 1)<>0 then
  1161. inc(shift,kbShift);
  1162. end;
  1163. {$endif}
  1164. ShiftState:=shift;
  1165. end;
  1166. { Exported functions }
  1167. procedure SysInitKeyboard;
  1168. begin
  1169. SetRawMode(true);
  1170. patchkeyboard;
  1171. {$ifdef logging}
  1172. assign(f,'keyboard.log');
  1173. rewrite(f);
  1174. {$endif logging}
  1175. if not IsConsole then
  1176. begin
  1177. { default for Shift prefix is ^ A}
  1178. if ShiftPrefix = 0 then
  1179. ShiftPrefix:=1;
  1180. {default for Alt prefix is ^Z }
  1181. if AltPrefix=0 then
  1182. AltPrefix:=26;
  1183. { default for Ctrl Prefix is ^W }
  1184. if CtrlPrefix=0 then
  1185. CtrlPrefix:=23;
  1186. end;
  1187. {$ifndef NotUseTree}
  1188. LoadDefaultSequences;
  1189. LoadTerminfoSequences;
  1190. {$endif not NotUseTree}
  1191. end;
  1192. procedure SysDoneKeyboard;
  1193. begin
  1194. unpatchkeyboard;
  1195. SetRawMode(false);
  1196. {$ifdef logging}
  1197. close(f);
  1198. {$endif logging}
  1199. end;
  1200. function SysGetKeyEvent: TKeyEvent;
  1201. function EvalScan(b:byte):byte;
  1202. const
  1203. DScan:array[0..31] of byte = (
  1204. $39, $02, $28, $04, $05, $06, $08, $28,
  1205. $0A, $0B, $09, $0D, $33, $0C, $34, $35,
  1206. $0B, $02, $03, $04, $05, $06, $07, $08,
  1207. $09, $0A, $27, $27, $33, $0D, $34, $35);
  1208. LScan:array[0..31] of byte = (
  1209. $29, $1E, $30, $2E, $20, $12, $21, $22,
  1210. $23, $17, $24, $25, $26, $32, $31, $18,
  1211. $19, $10, $13, $1F, $14, $16, $2F, $11,
  1212. $2D, $15, $2C, $1A, $2B, $1B, $29, $0C);
  1213. begin
  1214. if (b and $E0)=$20 { digits / leters } then
  1215. EvalScan:=DScan[b and $1F]
  1216. else
  1217. case b of
  1218. $08:EvalScan:=$0E; { backspace }
  1219. $09:EvalScan:=$0F; { TAB }
  1220. $0D:EvalScan:=$1C; { CR }
  1221. $1B:EvalScan:=$01; { esc }
  1222. $40:EvalScan:=$03; { @ }
  1223. $5E:EvalScan:=$07; { ^ }
  1224. $60:EvalScan:=$29; { ` }
  1225. else
  1226. EvalScan:=LScan[b and $1F];
  1227. end;
  1228. end;
  1229. function EvalScanZ(b:byte):byte;
  1230. begin
  1231. EvalScanZ:=b;
  1232. if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then
  1233. EvalScanZ:=b+$2D;
  1234. end;
  1235. const
  1236. {kbHome, kbUp, kbPgUp,Missing, kbLeft,
  1237. kbCenter, kbRight, kbAltGrayPlus, kbend,
  1238. kbDown, kbPgDn, kbIns, kbDel }
  1239. CtrlArrow : array [kbHome..kbDel] of byte =
  1240. {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);}
  1241. (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft,
  1242. kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd,
  1243. kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel);
  1244. AltArrow : array [kbHome..kbDel] of byte =
  1245. (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft,
  1246. kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd,
  1247. kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
  1248. var
  1249. MyScan,
  1250. SState : byte;
  1251. MyChar : char;
  1252. EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
  1253. begin {main}
  1254. MyChar:=Readkey(IsAlt);
  1255. MyScan:=ord(MyChar);
  1256. SState:=ShiftState;
  1257. CtrlPrefixUsed:=false;
  1258. AltPrefixUsed:=false;
  1259. ShiftPrefixUsed:=false;
  1260. EscUsed:=false;
  1261. if IsAlt then
  1262. SState:=SState or kbAlt;
  1263. repeat
  1264. again:=false;
  1265. if Mychar=#0 then
  1266. begin
  1267. MyScan:=ord(ReadKey(IsAlt));
  1268. { Handle Ctrl-<x>, but not AltGr-<x> }
  1269. if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
  1270. begin
  1271. case MyScan of
  1272. kbHome..kbDel : { cArrow }
  1273. MyScan:=CtrlArrow[MyScan];
  1274. kbF1..KbF10 : { cF1-cF10 }
  1275. MyScan:=MyScan+kbCtrlF1-kbF1;
  1276. kbF11..KbF12 : { cF11-cF12 }
  1277. MyScan:=MyScan+kbCtrlF11-kbF11;
  1278. end;
  1279. end
  1280. { Handle Alt-<x>, but not AltGr }
  1281. else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1282. begin
  1283. case MyScan of
  1284. kbHome..kbDel : { AltArrow }
  1285. MyScan:=AltArrow[MyScan];
  1286. kbF1..KbF10 : { aF1-aF10 }
  1287. MyScan:=MyScan+kbAltF1-kbF1;
  1288. kbF11..KbF12 : { aF11-aF12 }
  1289. MyScan:=MyScan+kbAltF11-kbF11;
  1290. end;
  1291. end
  1292. else if (SState and kbShift)<>0 then
  1293. begin
  1294. case MyScan of
  1295. kbIns: MyScan:=kbShiftIns;
  1296. kbDel: MyScan:=kbShiftDel;
  1297. kbF1..KbF10 : { sF1-sF10 }
  1298. MyScan:=MyScan+kbShiftF1-kbF1;
  1299. kbF11..KbF12 : { sF11-sF12 }
  1300. MyScan:=MyScan+kbShiftF11-kbF11;
  1301. end;
  1302. end;
  1303. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1304. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1305. else
  1306. SysGetKeyEvent:=0;
  1307. exit;
  1308. end
  1309. else if MyChar=#27 then
  1310. begin
  1311. if EscUsed then
  1312. SState:=SState and not kbAlt
  1313. else
  1314. begin
  1315. SState:=SState or kbAlt;
  1316. Again:=true;
  1317. EscUsed:=true;
  1318. end;
  1319. end
  1320. else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
  1321. begin { ^Z - replace Alt for Linux OS }
  1322. if AltPrefixUsed then
  1323. begin
  1324. SState:=SState and not kbAlt;
  1325. end
  1326. else
  1327. begin
  1328. AltPrefixUsed:=true;
  1329. SState:=SState or kbAlt;
  1330. Again:=true;
  1331. end;
  1332. end
  1333. else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
  1334. begin
  1335. if CtrlPrefixUsed then
  1336. SState:=SState and not kbCtrl
  1337. else
  1338. begin
  1339. CtrlPrefixUsed:=true;
  1340. SState:=SState or kbCtrl;
  1341. Again:=true;
  1342. end;
  1343. end
  1344. else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
  1345. begin
  1346. if ShiftPrefixUsed then
  1347. SState:=SState and not kbShift
  1348. else
  1349. begin
  1350. ShiftPrefixUsed:=true;
  1351. SState:=SState or kbShift;
  1352. Again:=true;
  1353. end;
  1354. end;
  1355. if not again then
  1356. begin
  1357. MyScan:=EvalScan(ord(MyChar));
  1358. if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1359. begin
  1360. if MyScan in [$02..$0D] then
  1361. inc(MyScan,$76);
  1362. MyChar:=chr(0);
  1363. end
  1364. else if (SState and kbShift)<>0 then
  1365. if MyChar=#9 then
  1366. begin
  1367. MyChar:=#0;
  1368. MyScan:=kbShiftTab;
  1369. end;
  1370. end
  1371. else
  1372. begin
  1373. MyChar:=Readkey(IsAlt);
  1374. MyScan:=ord(MyChar);
  1375. if IsAlt then
  1376. SState:=SState or kbAlt;
  1377. end;
  1378. until not Again;
  1379. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1380. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1381. else
  1382. SysGetKeyEvent:=0;
  1383. end;
  1384. function SysPollKeyEvent: TKeyEvent;
  1385. var
  1386. KeyEvent : TKeyEvent;
  1387. begin
  1388. if keypressed then
  1389. begin
  1390. KeyEvent:=SysGetKeyEvent;
  1391. PutKeyEvent(KeyEvent);
  1392. SysPollKeyEvent:=KeyEvent
  1393. end
  1394. else
  1395. SysPollKeyEvent:=0;
  1396. end;
  1397. function SysGetShiftState : Byte;
  1398. begin
  1399. SysGetShiftState:=ShiftState;
  1400. end;
  1401. procedure RestoreStartMode;
  1402. begin
  1403. TCSetAttr(1,TCSANOW,StartTio);
  1404. end;
  1405. Const
  1406. SysKeyboardDriver : TKeyboardDriver = (
  1407. InitDriver : @SysInitKeyBoard;
  1408. DoneDriver : @SysDoneKeyBoard;
  1409. GetKeyevent : @SysGetKeyEvent;
  1410. PollKeyEvent : @SysPollKeyEvent;
  1411. GetShiftState : @SysGetShiftState;
  1412. TranslateKeyEvent : Nil;
  1413. TranslateKeyEventUnicode : Nil;
  1414. );
  1415. begin
  1416. SetKeyBoardDriver(SysKeyBoardDriver);
  1417. TCGetAttr(1,StartTio);
  1418. end.
  1419. {
  1420. $Log$
  1421. Revision 1.11 2002-09-07 16:01:27 peter
  1422. * old logs removed and tabs fixed
  1423. Revision 1.10 2002/03/03 13:23:51 peter
  1424. * adjust backspace sequence so it works according to the latest
  1425. XFree xterms and linux consoles
  1426. }