2
0

keyboard.pp 40 KB

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