keyboard.pp 39 KB

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