keyboard.pp 41 KB

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