keyboard.pp 39 KB

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