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. 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. procedure FreeElement (PT:PTreeElement);
  357. var next : PTreeElement;
  358. begin
  359. while PT <> nil do
  360. begin
  361. FreeElement(PT^.Child);
  362. next := PT^.Next;
  363. dispose(PT);
  364. PT := next;
  365. end;
  366. end;
  367. procedure FreeTree;
  368. var i : integer;
  369. begin
  370. for i := low(RootTree) to high(RootTree) do
  371. FreeElement(RootTree[i]);
  372. end;
  373. function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement;
  374. var PT : PTreeElement;
  375. begin
  376. New(PT);
  377. FillChar(PT^,SizeOf(TTreeElement),#0);
  378. PT^.char:=ch;
  379. PT^.Parent:=Pa;
  380. if Assigned(Pa) and (Pa^.Child=nil) then
  381. Pa^.Child:=PT;
  382. NewPTree:=PT;
  383. end;
  384. function DoAddSequence(Const St : String; AChar,AScan :byte) : PTreeElement;
  385. var
  386. CurPTree,NPT : PTreeElement;
  387. c : byte;
  388. i : longint;
  389. begin
  390. if St='' then
  391. begin
  392. DoAddSequence:=nil;
  393. exit;
  394. end;
  395. CurPTree:=RootTree[ord(st[1])];
  396. if CurPTree=nil then
  397. begin
  398. CurPTree:=NewPTree(ord(st[1]),nil);
  399. RootTree[ord(st[1])]:=CurPTree;
  400. end;
  401. for i:=2 to Length(St) do
  402. begin
  403. NPT:=CurPTree^.Child;
  404. c:=ord(St[i]);
  405. if NPT=nil then
  406. NPT:=NewPTree(c,CurPTree);
  407. CurPTree:=nil;
  408. while assigned(NPT) and (NPT^.char<c) do
  409. begin
  410. CurPTree:=NPT;
  411. NPT:=NPT^.Next;
  412. end;
  413. if assigned(NPT) and (NPT^.char=c) then
  414. CurPTree:=NPT
  415. else
  416. begin
  417. if CurPTree=nil then
  418. begin
  419. NPT^.Parent^.child:=NewPTree(c,NPT^.Parent);
  420. CurPTree:=NPT^.Parent^.Child;
  421. CurPTree^.Next:=NPT;
  422. end
  423. else
  424. begin
  425. CurPTree^.Next:=NewPTree(c,CurPTree^.Parent);
  426. CurPTree:=CurPTree^.Next;
  427. CurPTree^.Next:=NPT;
  428. end;
  429. end;
  430. end;
  431. if CurPTree^.CanBeTerminal then
  432. begin
  433. { here we have a conflict !! }
  434. { maybe we should claim }
  435. with CurPTree^ do
  436. begin
  437. {$ifdef DEBUG}
  438. if (ScanValue<>AScan) or (CharValue<>AChar) then
  439. Writeln(system.stderr,'key "',st,'" changed value');
  440. if (ScanValue<>AScan) then
  441. Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan);
  442. if (CharValue<>AChar) then
  443. Writeln(system.stderr,'Char was ',chr(CharValue),' now ',chr(AChar));
  444. {$endif DEBUG}
  445. ScanValue:=AScan;
  446. CharValue:=AChar;
  447. end;
  448. end
  449. else with CurPTree^ do
  450. begin
  451. CanBeTerminal:=True;
  452. ScanValue:=AScan;
  453. CharValue:=AChar;
  454. end;
  455. DoAddSequence:=CurPTree;
  456. end;
  457. procedure AddSequence(Const St : String; AChar,AScan :byte);
  458. begin
  459. DoAddSequence(St,AChar,AScan);
  460. end;
  461. { Returns the Child that as c as char if it exists }
  462. Function FindChild(c : byte;Root : PTreeElement) : PTreeElement;
  463. var
  464. NPT : PTreeElement;
  465. begin
  466. if not assigned(Root) then
  467. begin
  468. FindChild:=nil;
  469. exit;
  470. end;
  471. NPT:=Root^.Child;
  472. while assigned(NPT) and (NPT^.char<c) do
  473. NPT:=NPT^.Next;
  474. if assigned(NPT) and (NPT^.char=c) then
  475. FindChild:=NPT
  476. else
  477. FindChild:=nil;
  478. end;
  479. Function AddSpecialSequence(Const St : string;Proc : TProcedure) : PTreeElement;
  480. var
  481. NPT : PTreeElement;
  482. begin
  483. NPT:=DoAddSequence(St,0,0);
  484. NPT^.SpecialHandler:=Proc;
  485. AddSpecialSequence:=NPT;
  486. end;
  487. function FindSequence(Const St : String;var AChar,AScan :byte) : boolean;
  488. var
  489. NPT : PTreeElement;
  490. I : longint;
  491. begin
  492. FindSequence:=false;
  493. AChar:=0;
  494. AScan:=0;
  495. if St='' then
  496. exit;
  497. NPT:=RootTree[ord(St[1])];
  498. if not assigned(NPT) then
  499. exit;
  500. for i:=2 to Length(St) do
  501. begin
  502. NPT:=FindChild(ord(St[i]),NPT);
  503. if not assigned(NPT) then
  504. exit;
  505. end;
  506. if not NPT^.CanBeTerminal then
  507. exit
  508. else
  509. begin
  510. FindSequence:=true;
  511. AScan:=NPT^.ScanValue;
  512. AChar:=NPT^.CharValue;
  513. end;
  514. end;
  515. Procedure LoadDefaultSequences;
  516. begin
  517. AddSpecialSequence(#27'[M',@GenMouseEvent);
  518. { linux default values, the next setting is
  519. compatible with xterms from XFree 4.x }
  520. DoAddSequence(#127,8,0);
  521. { all Esc letter }
  522. DoAddSequence(#27'A',0,kbAltA);
  523. DoAddSequence(#27'a',0,kbAltA);
  524. DoAddSequence(#27'B',0,kbAltB);
  525. DoAddSequence(#27'b',0,kbAltB);
  526. DoAddSequence(#27'C',0,kbAltC);
  527. DoAddSequence(#27'c',0,kbAltC);
  528. DoAddSequence(#27'D',0,kbAltD);
  529. DoAddSequence(#27'd',0,kbAltD);
  530. DoAddSequence(#27'E',0,kbAltE);
  531. DoAddSequence(#27'e',0,kbAltE);
  532. DoAddSequence(#27'F',0,kbAltF);
  533. DoAddSequence(#27'f',0,kbAltF);
  534. DoAddSequence(#27'G',0,kbAltG);
  535. DoAddSequence(#27'g',0,kbAltG);
  536. DoAddSequence(#27'H',0,kbAltH);
  537. DoAddSequence(#27'h',0,kbAltH);
  538. DoAddSequence(#27'I',0,kbAltI);
  539. DoAddSequence(#27'i',0,kbAltI);
  540. DoAddSequence(#27'J',0,kbAltJ);
  541. DoAddSequence(#27'j',0,kbAltJ);
  542. DoAddSequence(#27'K',0,kbAltK);
  543. DoAddSequence(#27'k',0,kbAltK);
  544. DoAddSequence(#27'L',0,kbAltL);
  545. DoAddSequence(#27'l',0,kbAltL);
  546. DoAddSequence(#27'M',0,kbAltM);
  547. DoAddSequence(#27'm',0,kbAltM);
  548. DoAddSequence(#27'N',0,kbAltN);
  549. DoAddSequence(#27'n',0,kbAltN);
  550. DoAddSequence(#27'O',0,kbAltO);
  551. DoAddSequence(#27'o',0,kbAltO);
  552. DoAddSequence(#27'P',0,kbAltP);
  553. DoAddSequence(#27'p',0,kbAltP);
  554. DoAddSequence(#27'Q',0,kbAltQ);
  555. DoAddSequence(#27'q',0,kbAltQ);
  556. DoAddSequence(#27'R',0,kbAltR);
  557. DoAddSequence(#27'r',0,kbAltR);
  558. DoAddSequence(#27'S',0,kbAltS);
  559. DoAddSequence(#27's',0,kbAltS);
  560. DoAddSequence(#27'T',0,kbAltT);
  561. DoAddSequence(#27't',0,kbAltT);
  562. DoAddSequence(#27'U',0,kbAltU);
  563. DoAddSequence(#27'u',0,kbAltU);
  564. DoAddSequence(#27'V',0,kbAltV);
  565. DoAddSequence(#27'v',0,kbAltV);
  566. DoAddSequence(#27'W',0,kbAltW);
  567. DoAddSequence(#27'w',0,kbAltW);
  568. DoAddSequence(#27'X',0,kbAltX);
  569. DoAddSequence(#27'x',0,kbAltX);
  570. DoAddSequence(#27'Y',0,kbAltY);
  571. DoAddSequence(#27'y',0,kbAltY);
  572. DoAddSequence(#27'Z',0,kbAltZ);
  573. DoAddSequence(#27'z',0,kbAltZ);
  574. DoAddSequence(#27'-',0,kbAltMinus);
  575. DoAddSequence(#27'=',0,kbAltEqual);
  576. DoAddSequence(#27'0',0,kbAlt0);
  577. DoAddSequence(#27'1',0,kbAlt1);
  578. DoAddSequence(#27'2',0,kbAlt2);
  579. DoAddSequence(#27'3',0,kbAlt3);
  580. DoAddSequence(#27'4',0,kbAlt4);
  581. DoAddSequence(#27'5',0,kbAlt5);
  582. DoAddSequence(#27'6',0,kbAlt6);
  583. DoAddSequence(#27'7',0,kbAlt7);
  584. DoAddSequence(#27'8',0,kbAlt8);
  585. DoAddSequence(#27'9',0,kbAlt9);
  586. { vt100 default values }
  587. DoAddSequence(#27'[[A',0,kbF1);
  588. DoAddSequence(#27'[[B',0,kbF2);
  589. DoAddSequence(#27'[[C',0,kbF3);
  590. DoAddSequence(#27'[[D',0,kbF4);
  591. DoAddSequence(#27'[[E',0,kbF5);
  592. DoAddSequence(#27'[17~',0,kbF6);
  593. DoAddSequence(#27'[18~',0,kbF7);
  594. DoAddSequence(#27'[19~',0,kbF8);
  595. DoAddSequence(#27'[20~',0,kbF9);
  596. DoAddSequence(#27'[21~',0,kbF10);
  597. DoAddSequence(#27'[23~',0,kbF11);
  598. DoAddSequence(#27'[24~',0,kbF12);
  599. DoAddSequence(#27'[25~',0,kbShiftF3);
  600. DoAddSequence(#27'[26~',0,kbShiftF4);
  601. DoAddSequence(#27'[28~',0,kbShiftF5);
  602. DoAddSequence(#27'[29~',0,kbShiftF6);
  603. DoAddSequence(#27'[31~',0,kbShiftF7);
  604. DoAddSequence(#27'[32~',0,kbShiftF8);
  605. DoAddSequence(#27'[33~',0,kbShiftF9);
  606. DoAddSequence(#27'[34~',0,kbShiftF10);
  607. DoAddSequence(#27#27'[[A',0,kbAltF1);
  608. DoAddSequence(#27#27'[[B',0,kbAltF2);
  609. DoAddSequence(#27#27'[[C',0,kbAltF3);
  610. DoAddSequence(#27#27'[[D',0,kbAltF4);
  611. DoAddSequence(#27#27'[[E',0,kbAltF5);
  612. DoAddSequence(#27#27'[17~',0,kbAltF6);
  613. DoAddSequence(#27#27'[18~',0,kbAltF7);
  614. DoAddSequence(#27#27'[19~',0,kbAltF8);
  615. DoAddSequence(#27#27'[20~',0,kbAltF9);
  616. DoAddSequence(#27#27'[21~',0,kbAltF10);
  617. DoAddSequence(#27#27'[23~',0,kbAltF11);
  618. DoAddSequence(#27#27'[24~',0,kbAltF12);
  619. DoAddSequence(#27'[A',0,kbUp);
  620. DoAddSequence(#27'[B',0,kbDown);
  621. DoAddSequence(#27'[C',0,kbRight);
  622. DoAddSequence(#27'[D',0,kbLeft);
  623. DoAddSequence(#27'[F',0,kbEnd);
  624. DoAddSequence(#27'[H',0,kbHome);
  625. DoAddSequence(#27'[Z',0,kbShiftTab);
  626. DoAddSequence(#27'[5~',0,kbPgUp);
  627. DoAddSequence(#27'[6~',0,kbPgDn);
  628. DoAddSequence(#27'[4~',0,kbEnd);
  629. DoAddSequence(#27'[1~',0,kbHome);
  630. DoAddSequence(#27'[2~',0,kbIns);
  631. DoAddSequence(#27'[3~',0,kbDel);
  632. DoAddSequence(#27#27'[A',0,kbAltUp);
  633. DoAddSequence(#27#27'[B',0,kbAltDown);
  634. DoAddSequence(#27#27'[D',0,kbAltLeft);
  635. DoAddSequence(#27#27'[C',0,kbAltRight);
  636. DoAddSequence(#27#27'[5~',0,kbAltPgUp);
  637. DoAddSequence(#27#27'[6~',0,kbAltPgDn);
  638. DoAddSequence(#27#27'[4~',0,kbAltEnd);
  639. DoAddSequence(#27#27'[1~',0,kbAltHome);
  640. DoAddSequence(#27#27'[2~',0,kbAltIns);
  641. DoAddSequence(#27#27'[3~',0,kbAltDel);
  642. DoAddSequence(#27'OP',0,kbF1);
  643. DoAddSequence(#27'OQ',0,kbF2);
  644. DoAddSequence(#27'OR',0,kbF3);
  645. DoAddSequence(#27'OS',0,kbF4);
  646. DoAddSequence(#27'Ot',0,kbF5);
  647. DoAddSequence(#27'Ou',0,kbF6);
  648. DoAddSequence(#27'Ov',0,kbF7);
  649. DoAddSequence(#27'Ol',0,kbF8);
  650. DoAddSequence(#27'Ow',0,kbF9);
  651. DoAddSequence(#27'Ox',0,kbF10);
  652. DoAddSequence(#27'Oy',0,kbF11);
  653. DoAddSequence(#27'Oz',0,kbF12);
  654. DoAddSequence(#27#27'OP',0,kbAltF1);
  655. DoAddSequence(#27#27'OQ',0,kbAltF2);
  656. DoAddSequence(#27#27'OR',0,kbAltF3);
  657. DoAddSequence(#27#27'OS',0,kbAltF4);
  658. DoAddSequence(#27#27'Ot',0,kbAltF5);
  659. DoAddSequence(#27#27'Ou',0,kbAltF6);
  660. DoAddSequence(#27#27'Ov',0,kbAltF7);
  661. DoAddSequence(#27#27'Ol',0,kbAltF8);
  662. DoAddSequence(#27#27'Ow',0,kbAltF9);
  663. DoAddSequence(#27#27'Ox',0,kbAltF10);
  664. DoAddSequence(#27#27'Oy',0,kbAltF11);
  665. DoAddSequence(#27#27'Oz',0,kbAltF12);
  666. DoAddSequence(#27'OA',0,kbUp);
  667. DoAddSequence(#27'OB',0,kbDown);
  668. DoAddSequence(#27'OC',0,kbRight);
  669. DoAddSequence(#27'OD',0,kbLeft);
  670. DoAddSequence(#27#27'OA',0,kbAltUp);
  671. DoAddSequence(#27#27'OB',0,kbAltDown);
  672. DoAddSequence(#27#27'OC',0,kbAltRight);
  673. DoAddSequence(#27#27'OD',0,kbAltLeft);
  674. { xterm default values }
  675. { xterm alternate default values }
  676. { ignored sequences }
  677. DoAddSequence(#27'[?1;0c',0,0);
  678. DoAddSequence(#27'[?1l',0,0);
  679. DoAddSequence(#27'[?1h',0,0);
  680. DoAddSequence(#27'[?1;2c',0,0);
  681. DoAddSequence(#27'[?7l',0,0);
  682. DoAddSequence(#27'[?7h',0,0);
  683. end;
  684. function EnterEscapeSeqNdx(Ndx: Word;Char,Scan : byte) : PTreeElement;
  685. var
  686. P,pdelay: PChar;
  687. St : string;
  688. begin
  689. EnterEscapeSeqNdx:=nil;
  690. P:=cur_term_Strings^[Ndx];
  691. if assigned(p) then
  692. begin { Do not record the delays }
  693. pdelay:=strpos(p,'$<');
  694. if assigned(pdelay) then
  695. pdelay^:=#0;
  696. St:=StrPas(p);
  697. EnterEscapeSeqNdx:=DoAddSequence(St,Char,Scan);
  698. if assigned(pdelay) then
  699. pdelay^:='$';
  700. end;
  701. end;
  702. Procedure LoadTermInfoSequences;
  703. var
  704. err : longint;
  705. begin
  706. if not assigned(cur_term) then
  707. setupterm(nil, stdoutputhandle, err);
  708. if not assigned(cur_term_Strings) then
  709. exit;
  710. EnterEscapeSeqNdx(key_f1,0,kbF1);
  711. EnterEscapeSeqNdx(key_f2,0,kbF2);
  712. EnterEscapeSeqNdx(key_f3,0,kbF3);
  713. EnterEscapeSeqNdx(key_f4,0,kbF4);
  714. EnterEscapeSeqNdx(key_f5,0,kbF5);
  715. EnterEscapeSeqNdx(key_f6,0,kbF6);
  716. EnterEscapeSeqNdx(key_f7,0,kbF7);
  717. EnterEscapeSeqNdx(key_f8,0,kbF8);
  718. EnterEscapeSeqNdx(key_f9,0,kbF9);
  719. EnterEscapeSeqNdx(key_f10,0,kbF10);
  720. EnterEscapeSeqNdx(key_f11,0,kbF11);
  721. EnterEscapeSeqNdx(key_f12,0,kbF12);
  722. EnterEscapeSeqNdx(key_up,0,kbUp);
  723. EnterEscapeSeqNdx(key_down,0,kbDown);
  724. EnterEscapeSeqNdx(key_left,0,kbLeft);
  725. EnterEscapeSeqNdx(key_right,0,kbRight);
  726. EnterEscapeSeqNdx(key_ppage,0,kbPgUp);
  727. EnterEscapeSeqNdx(key_npage,0,kbPgDn);
  728. EnterEscapeSeqNdx(key_end,0,kbEnd);
  729. EnterEscapeSeqNdx(key_home,0,kbHome);
  730. EnterEscapeSeqNdx(key_ic,0,kbIns);
  731. EnterEscapeSeqNdx(key_dc,0,kbDel);
  732. EnterEscapeSeqNdx(key_stab,0,kbShiftTab);
  733. { EnterEscapeSeqNdx(key_,0,kb);
  734. EnterEscapeSeqNdx(key_,0,kb); }
  735. end;
  736. {$endif not NotUseTree}
  737. Function RawReadKey:char;
  738. Var
  739. fdsin : fdSet;
  740. Begin
  741. {Check Buffer first}
  742. if KeySend<>KeyPut then
  743. begin
  744. RawReadKey:=PopKey;
  745. exit;
  746. end;
  747. {Wait for Key}
  748. if not sysKeyPressed then
  749. begin
  750. FD_Zero (fdsin);
  751. FD_Set (StdInputHandle,fdsin);
  752. Select (StdInputHandle+1,@fdsin,nil,nil,nil);
  753. end;
  754. RawReadKey:=ttyRecvChar;
  755. end;
  756. Function RawReadString : String;
  757. Var
  758. ch : char;
  759. fdsin : fdSet;
  760. St : String;
  761. Begin
  762. St:=RawReadKey;
  763. FD_Zero (fdsin);
  764. FD_Set (StdInputHandle,fdsin);
  765. Repeat
  766. if InCnt=0 then
  767. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  768. if SysKeyPressed then
  769. ch:=ttyRecvChar
  770. else
  771. ch:=#0;
  772. if ch<>#0 then
  773. St:=St+ch;
  774. Until ch=#0;
  775. RawReadString:=St;
  776. end;
  777. Function ReadKey(var IsAlt : boolean):char;
  778. Var
  779. ch : char;
  780. {$ifdef NotUseTree}
  781. OldState : longint;
  782. State : longint;
  783. {$endif NotUseTree}
  784. is_delay : boolean;
  785. fdsin : fdSet;
  786. store : array [0..8] of char;
  787. arrayind : byte;
  788. {$ifndef NotUseTree}
  789. NPT,NNPT : PTreeElement;
  790. {$else NotUseTree}
  791. procedure GenMouseEvent;
  792. var MouseEvent: TMouseEvent;
  793. begin
  794. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  795. case ch of
  796. #32 : {left button pressed }
  797. MouseEvent.buttons:=1;
  798. #33 : {middle button pressed }
  799. MouseEvent.buttons:=2;
  800. #34 : { right button pressed }
  801. MouseEvent.buttons:=4;
  802. #35 : { no button pressed };
  803. end;
  804. if InCnt=0 then
  805. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  806. ch:=ttyRecvChar;
  807. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  808. if InCnt=0 then
  809. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  810. ch:=ttyRecvChar;
  811. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  812. if (MouseEvent.buttons<>0) then
  813. MouseEvent.action:=MouseActionDown
  814. else
  815. begin
  816. if (LastMouseEvent.Buttons<>0) and
  817. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  818. begin
  819. MouseEvent.Action:=MouseActionMove;
  820. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  821. PutMouseEvent(MouseEvent);
  822. MouseEvent.Buttons:=0;
  823. end;
  824. MouseEvent.Action:=MouseActionUp;
  825. end;
  826. PutMouseEvent(MouseEvent);
  827. LastMouseEvent:=MouseEvent;
  828. end;
  829. {$endif NotUseTree}
  830. procedure RestoreArray;
  831. var
  832. i : byte;
  833. begin
  834. for i:=0 to arrayind-1 do
  835. PushKey(store[i]);
  836. end;
  837. Begin
  838. IsAlt:=false;
  839. {Check Buffer first}
  840. if KeySend<>KeyPut then
  841. begin
  842. ReadKey:=PopKey;
  843. exit;
  844. end;
  845. {Wait for Key}
  846. if not sysKeyPressed then
  847. begin
  848. FD_Zero (fdsin);
  849. FD_Set (StdInputHandle,fdsin);
  850. Select (StdInputHandle+1,@fdsin,nil,nil,nil);
  851. end;
  852. ch:=ttyRecvChar;
  853. {$ifndef NotUseTree}
  854. NPT:=RootTree[ord(ch)];
  855. if not assigned(NPT) then
  856. PushKey(ch)
  857. else
  858. begin
  859. FD_Zero(fdsin);
  860. fd_Set(StdInputHandle,fdsin);
  861. store[0]:=ch;
  862. arrayind:=1;
  863. while assigned(NPT) and syskeypressed do
  864. begin
  865. if (InCnt=0) then
  866. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  867. ch:=ttyRecvChar;
  868. NNPT:=FindChild(ord(ch),NPT);
  869. if assigned(NNPT) then
  870. Begin
  871. NPT:=NNPT;
  872. if NPT^.CanBeTerminal and
  873. assigned(NPT^.SpecialHandler) then
  874. break;
  875. End;
  876. if ch<>#0 then
  877. begin
  878. store[arrayind]:=ch;
  879. inc(arrayind);
  880. end;
  881. if not assigned(NNPT) then
  882. begin
  883. if ch<>#0 then
  884. begin
  885. { Put that unused char back into InBuf }
  886. If InTail=0 then
  887. InTail:=InSize-1
  888. else
  889. Dec(InTail);
  890. InBuf[InTail]:=ch;
  891. inc(InCnt);
  892. end;
  893. break;
  894. end;
  895. end;
  896. if assigned(NPT) and NPT^.CanBeTerminal then
  897. begin
  898. if assigned(NPT^.SpecialHandler) then
  899. begin
  900. NPT^.SpecialHandler;
  901. PushExt(0);
  902. end
  903. else if NPT^.CharValue<>0 then
  904. PushKey(chr(NPT^.CharValue))
  905. else if NPT^.ScanValue<>0 then
  906. PushExt(NPT^.ScanValue);
  907. end
  908. else
  909. RestoreArray;
  910. {$else NotUseTree}
  911. {Esc Found ?}
  912. If (ch=#27) then
  913. begin
  914. FD_Zero(fdsin);
  915. fd_Set(StdInputHandle,fdsin);
  916. State:=1;
  917. store[0]:=#27;
  918. arrayind:=1;
  919. {$ifdef logging}
  920. write(f,'Esc');
  921. {$endif logging}
  922. if InCnt=0 then
  923. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  924. while (State<>0) and (sysKeyPressed) do
  925. begin
  926. ch:=ttyRecvChar;
  927. store[arrayind]:=ch;
  928. inc(arrayind);
  929. {$ifdef logging}
  930. if ord(ch)>31 then
  931. write(f,ch)
  932. else
  933. write(f,'#',ord(ch):2);
  934. {$endif logging}
  935. OldState:=State;
  936. State:=0;
  937. case OldState of
  938. 1 : begin {Esc}
  939. case ch of
  940. 'a'..'z',
  941. '0'..'9',
  942. '-','=' : PushExt(FAltKey(ch));
  943. 'A'..'N',
  944. 'P'..'Z' : PushExt(FAltKey(chr(ord(ch)+ord('a')-ord('A'))));
  945. #10 : PushKey(#10);
  946. #13 : PushKey(#10);
  947. #27 : begin
  948. IsAlt:=True;
  949. State:=1;
  950. end;
  951. #127 : PushExt(kbAltDel);
  952. '[' : State:=2;
  953. 'O' : State:=6;
  954. else
  955. RestoreArray;
  956. end;
  957. end;
  958. 2 : begin {Esc[}
  959. case ch of
  960. '[' : State:=3;
  961. 'A' : PushExt(kbUp);
  962. 'B' : PushExt(kbDown);
  963. 'C' : PushExt(kbRight);
  964. 'D' : PushExt(kbLeft);
  965. 'F' : PushExt(kbEnd);
  966. 'G' : PushKey('5');
  967. 'H' : PushExt(kbHome);
  968. 'K' : PushExt(kbEnd);
  969. 'M' : State:=13;
  970. '1' : State:=4;
  971. '2' : State:=5;
  972. '3' : State:=12;{PushExt(kbDel)}
  973. '4' : PushExt(kbEnd);
  974. '5' : PushExt(73);
  975. '6' : PushExt(kbPgDn);
  976. '?' : State:=7;
  977. else
  978. RestoreArray;
  979. end;
  980. if ch in ['4'..'6'] then
  981. State:=255;
  982. end;
  983. 3 : begin {Esc[[}
  984. case ch of
  985. 'A' : PushExt(kbF1);
  986. 'B' : PushExt(kbF2);
  987. 'C' : PushExt(kbF3);
  988. 'D' : PushExt(kbF4);
  989. 'E' : PushExt(kbF5);
  990. else
  991. RestoreArray;
  992. end;
  993. end;
  994. 4 : begin {Esc[1}
  995. case ch of
  996. '~' : PushExt(kbHome);
  997. '7' : PushExt(kbF6);
  998. '8' : PushExt(kbF7);
  999. '9' : PushExt(kbF8);
  1000. else
  1001. RestoreArray;
  1002. end;
  1003. if (Ch<>'~') then
  1004. State:=255;
  1005. end;
  1006. 5 : begin {Esc[2}
  1007. case ch of
  1008. '~' : PushExt(kbIns);
  1009. '0' : pushExt(kbF9);
  1010. '1' : PushExt(kbF10);
  1011. '3' : PushExt($85){F11, but ShiftF1 also !!};
  1012. '4' : PushExt($86){F12, but Shift F2 also !!};
  1013. '5' : PushExt($56){ShiftF3};
  1014. '6' : PushExt($57){ShiftF4};
  1015. '8' : PushExt($58){ShiftF5};
  1016. '9' : PushExt($59){ShiftF6};
  1017. else
  1018. RestoreArray;
  1019. end;
  1020. if (Ch<>'~') then
  1021. State:=255;
  1022. end;
  1023. 12 : begin {Esc[3}
  1024. case ch of
  1025. '~' : PushExt(kbDel);
  1026. '1' : PushExt($5A){ShiftF7};
  1027. '2' : PushExt($5B){ShiftF8};
  1028. '3' : PushExt($5C){ShiftF9};
  1029. '4' : PushExt($5D){ShiftF10};
  1030. else
  1031. RestoreArray;
  1032. end;
  1033. if (Ch<>'~') then
  1034. State:=255;
  1035. end;
  1036. 6 : begin {EscO Function keys in vt100 mode PM }
  1037. case ch of
  1038. 'P' : {F1}PushExt(kbF1);
  1039. 'Q' : {F2}PushExt(kbF2);
  1040. 'R' : {F3}PushExt(kbF3);
  1041. 'S' : {F4}PushExt(kbF4);
  1042. 't' : {F5}PushExt(kbF5);
  1043. 'u' : {F6}PushExt(kbF6);
  1044. 'v' : {F7}PushExt(kbF7);
  1045. 'l' : {F8}PushExt(kbF8);
  1046. 'w' : {F9}PushExt(kbF9);
  1047. 'x' : {F10}PushExt(kbF10);
  1048. 'D' : {keyLeft}PushExt($4B);
  1049. 'C' : {keyRight}PushExt($4D);
  1050. 'A' : {keyUp}PushExt($48);
  1051. 'B' : {keyDown}PushExt($50);
  1052. else
  1053. RestoreArray;
  1054. end;
  1055. end;
  1056. 7 : begin {Esc[? keys in vt100 mode PM }
  1057. case ch of
  1058. '0' : State:=11;
  1059. '1' : State:=8;
  1060. '7' : State:=9;
  1061. else
  1062. RestoreArray;
  1063. end;
  1064. end;
  1065. 8 : begin {Esc[?1 keys in vt100 mode PM }
  1066. case ch of
  1067. 'l' : {local mode};
  1068. 'h' : {transmit mode};
  1069. ';' : { 'Esc[1;0c seems to be sent by M$ telnet app
  1070. for no hangup purposes }
  1071. state:=10;
  1072. else
  1073. RestoreArray;
  1074. end;
  1075. end;
  1076. 9 : begin {Esc[?7 keys in vt100 mode PM }
  1077. case ch of
  1078. 'l' : {exit_am_mode};
  1079. 'h' : {enter_am_mode};
  1080. else
  1081. RestoreArray;
  1082. end;
  1083. end;
  1084. 10 : begin {Esc[?1; keys in vt100 mode PM }
  1085. case ch of
  1086. '0' : state:=11;
  1087. else
  1088. RestoreArray;
  1089. end;
  1090. end;
  1091. 11 : begin {Esc[?1;0 keys in vt100 mode PM }
  1092. case ch of
  1093. 'c' : ;
  1094. else
  1095. RestoreArray;
  1096. end;
  1097. end;
  1098. 13 : begin {Esc[M mouse prefix for xterm }
  1099. GenMouseEvent;
  1100. end;
  1101. 255 : { just forget this trailing char };
  1102. end;
  1103. if (State<>0) and (InCnt=0) then
  1104. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1105. end;
  1106. if State=1 then
  1107. PushKey(ch);
  1108. {$endif NotUseTree}
  1109. if ch='$' then
  1110. begin { '$<XX>' means a delay of XX millisecs }
  1111. is_delay :=false;
  1112. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1113. if (sysKeyPressed) then
  1114. begin
  1115. ch:=ttyRecvChar;
  1116. is_delay:=(ch='<');
  1117. if not is_delay then
  1118. begin
  1119. PushKey('$');
  1120. PushKey(ch);
  1121. end
  1122. else
  1123. begin
  1124. {$ifdef logging}
  1125. write(f,'$<');
  1126. {$endif logging}
  1127. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1128. while (sysKeyPressed) and (ch<>'>') do
  1129. begin
  1130. { Should we really repect this delay ?? }
  1131. ch:=ttyRecvChar;
  1132. {$ifdef logging}
  1133. write(f,ch);
  1134. {$endif logging}
  1135. Select(StdInputHandle+1,@fdsin,nil,nil,10);
  1136. end;
  1137. end;
  1138. end
  1139. else
  1140. PushKey('$');
  1141. end;
  1142. end
  1143. {$ifdef logging}
  1144. writeln(f);
  1145. {$endif logging}
  1146. {$ifndef NotUseTree}
  1147. ;
  1148. ReadKey:=PopKey;
  1149. {$else NotUseTree}
  1150. else
  1151. Begin
  1152. case ch of
  1153. #127 : PushKey(#8);
  1154. else
  1155. PushKey(ch);
  1156. end;
  1157. End;
  1158. ReadKey:=PopKey;
  1159. {$endif NotUseTree}
  1160. End;
  1161. function ShiftState:byte;
  1162. var
  1163. arg,shift : longint;
  1164. begin
  1165. arg:=6;
  1166. shift:=0;
  1167. {$Ifndef BSD}
  1168. if IOCtl(StdInputHandle,TIOCLINUX,@arg) then
  1169. begin
  1170. if (arg and 8)<>0 then
  1171. shift:=kbAlt;
  1172. if (arg and 4)<>0 then
  1173. inc(shift,kbCtrl);
  1174. { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
  1175. if (arg and 2)<>0 then
  1176. shift:=shift or (kbAlt or kbCtrl);
  1177. if (arg and 1)<>0 then
  1178. inc(shift,kbShift);
  1179. end;
  1180. {$endif}
  1181. ShiftState:=shift;
  1182. end;
  1183. { Exported functions }
  1184. procedure SysInitKeyboard;
  1185. begin
  1186. SetRawMode(true);
  1187. patchkeyboard;
  1188. {$ifdef logging}
  1189. assign(f,'keyboard.log');
  1190. rewrite(f);
  1191. {$endif logging}
  1192. if not IsConsole then
  1193. begin
  1194. { default for Shift prefix is ^ A}
  1195. if ShiftPrefix = 0 then
  1196. ShiftPrefix:=1;
  1197. {default for Alt prefix is ^Z }
  1198. if AltPrefix=0 then
  1199. AltPrefix:=26;
  1200. { default for Ctrl Prefix is ^W }
  1201. if CtrlPrefix=0 then
  1202. CtrlPrefix:=23;
  1203. end;
  1204. {$ifndef NotUseTree}
  1205. LoadDefaultSequences;
  1206. LoadTerminfoSequences;
  1207. {$endif not NotUseTree}
  1208. end;
  1209. procedure SysDoneKeyboard;
  1210. begin
  1211. unpatchkeyboard;
  1212. SetRawMode(false);
  1213. {$ifndef NotUseTree}
  1214. FreeTree;
  1215. {$endif not NotUseTree}
  1216. {$ifdef logging}
  1217. close(f);
  1218. {$endif logging}
  1219. end;
  1220. function SysGetKeyEvent: TKeyEvent;
  1221. function EvalScan(b:byte):byte;
  1222. const
  1223. DScan:array[0..31] of byte = (
  1224. $39, $02, $28, $04, $05, $06, $08, $28,
  1225. $0A, $0B, $09, $0D, $33, $0C, $34, $35,
  1226. $0B, $02, $03, $04, $05, $06, $07, $08,
  1227. $09, $0A, $27, $27, $33, $0D, $34, $35);
  1228. LScan:array[0..31] of byte = (
  1229. $29, $1E, $30, $2E, $20, $12, $21, $22,
  1230. $23, $17, $24, $25, $26, $32, $31, $18,
  1231. $19, $10, $13, $1F, $14, $16, $2F, $11,
  1232. $2D, $15, $2C, $1A, $2B, $1B, $29, $0C);
  1233. begin
  1234. if (b and $E0)=$20 { digits / leters } then
  1235. EvalScan:=DScan[b and $1F]
  1236. else
  1237. case b of
  1238. $08:EvalScan:=$0E; { backspace }
  1239. $09:EvalScan:=$0F; { TAB }
  1240. $0D:EvalScan:=$1C; { CR }
  1241. $1B:EvalScan:=$01; { esc }
  1242. $40:EvalScan:=$03; { @ }
  1243. $5E:EvalScan:=$07; { ^ }
  1244. $60:EvalScan:=$29; { ` }
  1245. else
  1246. EvalScan:=LScan[b and $1F];
  1247. end;
  1248. end;
  1249. function EvalScanZ(b:byte):byte;
  1250. begin
  1251. EvalScanZ:=b;
  1252. if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then
  1253. EvalScanZ:=b+$2D;
  1254. end;
  1255. const
  1256. {kbHome, kbUp, kbPgUp,Missing, kbLeft,
  1257. kbCenter, kbRight, kbAltGrayPlus, kbend,
  1258. kbDown, kbPgDn, kbIns, kbDel }
  1259. CtrlArrow : array [kbHome..kbDel] of byte =
  1260. {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);}
  1261. (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft,
  1262. kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd,
  1263. kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel);
  1264. AltArrow : array [kbHome..kbDel] of byte =
  1265. (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft,
  1266. kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd,
  1267. kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
  1268. var
  1269. MyScan,
  1270. SState : byte;
  1271. MyChar : char;
  1272. EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
  1273. begin {main}
  1274. MyChar:=Readkey(IsAlt);
  1275. MyScan:=ord(MyChar);
  1276. SState:=ShiftState;
  1277. CtrlPrefixUsed:=false;
  1278. AltPrefixUsed:=false;
  1279. ShiftPrefixUsed:=false;
  1280. EscUsed:=false;
  1281. if IsAlt then
  1282. SState:=SState or kbAlt;
  1283. repeat
  1284. again:=false;
  1285. if Mychar=#0 then
  1286. begin
  1287. MyScan:=ord(ReadKey(IsAlt));
  1288. { Handle Ctrl-<x>, but not AltGr-<x> }
  1289. if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
  1290. begin
  1291. case MyScan of
  1292. kbHome..kbDel : { cArrow }
  1293. MyScan:=CtrlArrow[MyScan];
  1294. kbF1..KbF10 : { cF1-cF10 }
  1295. MyScan:=MyScan+kbCtrlF1-kbF1;
  1296. kbF11..KbF12 : { cF11-cF12 }
  1297. MyScan:=MyScan+kbCtrlF11-kbF11;
  1298. end;
  1299. end
  1300. { Handle Alt-<x>, but not AltGr }
  1301. else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1302. begin
  1303. case MyScan of
  1304. kbHome..kbDel : { AltArrow }
  1305. MyScan:=AltArrow[MyScan];
  1306. kbF1..KbF10 : { aF1-aF10 }
  1307. MyScan:=MyScan+kbAltF1-kbF1;
  1308. kbF11..KbF12 : { aF11-aF12 }
  1309. MyScan:=MyScan+kbAltF11-kbF11;
  1310. end;
  1311. end
  1312. else if (SState and kbShift)<>0 then
  1313. begin
  1314. case MyScan of
  1315. kbIns: MyScan:=kbShiftIns;
  1316. kbDel: MyScan:=kbShiftDel;
  1317. kbF1..KbF10 : { sF1-sF10 }
  1318. MyScan:=MyScan+kbShiftF1-kbF1;
  1319. kbF11..KbF12 : { sF11-sF12 }
  1320. MyScan:=MyScan+kbShiftF11-kbF11;
  1321. end;
  1322. end;
  1323. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1324. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1325. else
  1326. SysGetKeyEvent:=0;
  1327. exit;
  1328. end
  1329. else if MyChar=#27 then
  1330. begin
  1331. if EscUsed then
  1332. SState:=SState and not kbAlt
  1333. else
  1334. begin
  1335. SState:=SState or kbAlt;
  1336. Again:=true;
  1337. EscUsed:=true;
  1338. end;
  1339. end
  1340. else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
  1341. begin { ^Z - replace Alt for Linux OS }
  1342. if AltPrefixUsed then
  1343. begin
  1344. SState:=SState and not kbAlt;
  1345. end
  1346. else
  1347. begin
  1348. AltPrefixUsed:=true;
  1349. SState:=SState or kbAlt;
  1350. Again:=true;
  1351. end;
  1352. end
  1353. else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
  1354. begin
  1355. if CtrlPrefixUsed then
  1356. SState:=SState and not kbCtrl
  1357. else
  1358. begin
  1359. CtrlPrefixUsed:=true;
  1360. SState:=SState or kbCtrl;
  1361. Again:=true;
  1362. end;
  1363. end
  1364. else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
  1365. begin
  1366. if ShiftPrefixUsed then
  1367. SState:=SState and not kbShift
  1368. else
  1369. begin
  1370. ShiftPrefixUsed:=true;
  1371. SState:=SState or kbShift;
  1372. Again:=true;
  1373. end;
  1374. end;
  1375. if not again then
  1376. begin
  1377. MyScan:=EvalScan(ord(MyChar));
  1378. if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1379. begin
  1380. if MyScan in [$02..$0D] then
  1381. inc(MyScan,$76);
  1382. MyChar:=chr(0);
  1383. end
  1384. else if (SState and kbShift)<>0 then
  1385. if MyChar=#9 then
  1386. begin
  1387. MyChar:=#0;
  1388. MyScan:=kbShiftTab;
  1389. end;
  1390. end
  1391. else
  1392. begin
  1393. MyChar:=Readkey(IsAlt);
  1394. MyScan:=ord(MyChar);
  1395. if IsAlt then
  1396. SState:=SState or kbAlt;
  1397. end;
  1398. until not Again;
  1399. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1400. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1401. else
  1402. SysGetKeyEvent:=0;
  1403. end;
  1404. function SysPollKeyEvent: TKeyEvent;
  1405. var
  1406. KeyEvent : TKeyEvent;
  1407. begin
  1408. if keypressed then
  1409. begin
  1410. KeyEvent:=SysGetKeyEvent;
  1411. PutKeyEvent(KeyEvent);
  1412. SysPollKeyEvent:=KeyEvent
  1413. end
  1414. else
  1415. SysPollKeyEvent:=0;
  1416. end;
  1417. function SysGetShiftState : Byte;
  1418. begin
  1419. SysGetShiftState:=ShiftState;
  1420. end;
  1421. procedure RestoreStartMode;
  1422. begin
  1423. TCSetAttr(1,TCSANOW,StartTio);
  1424. end;
  1425. Const
  1426. SysKeyboardDriver : TKeyboardDriver = (
  1427. InitDriver : @SysInitKeyBoard;
  1428. DoneDriver : @SysDoneKeyBoard;
  1429. GetKeyevent : @SysGetKeyEvent;
  1430. PollKeyEvent : @SysPollKeyEvent;
  1431. GetShiftState : @SysGetShiftState;
  1432. TranslateKeyEvent : Nil;
  1433. TranslateKeyEventUnicode : Nil;
  1434. );
  1435. begin
  1436. SetKeyBoardDriver(SysKeyBoardDriver);
  1437. TCGetAttr(1,StartTio);
  1438. end.
  1439. {
  1440. $Log$
  1441. Revision 1.12 2003-03-26 12:35:23 armin
  1442. * Free the Tree in SysDoneKeyboard to avoid a lot of messages if heaptrace is enabled
  1443. Revision 1.11 2002/09/07 16:01:27 peter
  1444. * old logs removed and tabs fixed
  1445. Revision 1.10 2002/03/03 13:23:51 peter
  1446. * adjust backspace sequence so it works according to the latest
  1447. XFree xterms and linux consoles
  1448. }