123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by Florian Klaempfl
- member of the Free Pascal development team
- Keyboard unit for linux
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit Keyboard;
- interface
- {$i keybrdh.inc}
- Const
- AltPrefix : byte = 0;
- ShiftPrefix : byte = 0;
- CtrlPrefix : byte = 0;
- Function RawReadKey:char;
- Function RawReadString : String;
- Function KeyPressed : Boolean;
- {$ifndef NotUseTree}
- Procedure AddSequence(Const St : String; AChar,AScan :byte);
- Function FindSequence(Const St : String;var AChar, Ascan : byte) : boolean;
- {$endif NotUseTree}
- procedure RestoreStartMode;
- implementation
- uses
- Mouse,
- {$ifndef NotUseTree}
- Strings,
- TermInfo,
- {$endif NotUseTree}
- termio,baseUnix;
- {$i keyboard.inc}
- var
- OldIO,StartTio : TermIos;
- {$ifdef logging}
- f : text;
- {$endif logging}
- {$i keyscan.inc}
- {$ifdef Unused}
- type
- TKeyState = Record
- Normal, Shift, Ctrl, Alt : word;
- end;
- Const
- KeyStates : Array[0..255] of TKeyState
- (
- );
- {$endif Unused}
- Procedure SetRawMode(b:boolean);
- Var
- Tio : Termios;
- Begin
- TCGetAttr(1,Tio);
- if b then
- begin
- OldIO:=Tio;
- Tio.c_iflag:=Tio.c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
- INLCR or IGNCR or ICRNL or IXON));
- Tio.c_lflag:=Tio.c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
- end
- else
- Tio := OldIO;
- TCSetAttr(1,TCSANOW,Tio);
- End;
- type
- chgentry=packed record
- tab,
- idx,
- oldtab,
- oldidx : byte;
- oldval,
- newval : word;
- end;
- kbentry=packed record
- kb_table,
- kb_index : byte;
- kb_value : word;
- end;
- const
- kbdchanges=10;
- kbdchange:array[1..kbdchanges] of chgentry=(
- (tab:8; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
- (tab:8; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0),
- (tab:8; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0),
- (tab:8; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0),
- (tab:8; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0),
- (tab:8; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0),
- (tab:8; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0),
- (tab:8; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
- (tab:8; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
- (tab:8; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0)
- );
- KDGKBENT=$4B46;
- KDSKBENT=$4B47;
- KDGKBMETA=$4B62;
- KDSKBMETA=$4B63;
- K_ESCPREFIX=$4;
- K_METABIT=$3;
- const
- oldmeta : longint = 0;
- meta : longint = 0;
- procedure PatchKeyboard;
- var
- e : ^chgentry;
- entry : kbentry;
- i : longint;
- begin
- fpIoctl(stdinputhandle,KDGKBMETA,@oldmeta);
- meta:=K_ESCPREFIX;
- fpIoctl(stdinputhandle,KDSKBMETA,@meta);
- for i:=1 to kbdchanges do
- begin
- e:=@kbdchange[i];
- entry.kb_table:=e^.tab;
- entry.kb_index:=e^.idx;
- fpIoctl(stdinputhandle,KDGKBENT,@entry);
- e^.oldval:=entry.kb_value;
- entry.kb_table:=e^.oldtab;
- entry.kb_index:=e^.oldidx;
- fpioctl(stdinputhandle,KDGKBENT,@entry);
- e^.newval:=entry.kb_value;
- end;
- for i:=1 to kbdchanges do
- begin
- e:=@kbdchange[i];
- entry.kb_table:=e^.tab;
- entry.kb_index:=e^.idx;
- entry.kb_value:=e^.newval;
- fpioctl(stdinputhandle,KDSKBENT,@entry);
- end;
- end;
- procedure UnpatchKeyboard;
- var
- e : ^chgentry;
- entry : kbentry;
- i : longint;
- begin
- if oldmeta in [K_ESCPREFIX,K_METABIT] then
- fpioctl(stdinputhandle,KDSKBMETA,@oldmeta);
- for i:=1 to kbdchanges do
- begin
- e:=@kbdchange[i];
- entry.kb_table:=e^.tab;
- entry.kb_index:=e^.idx;
- entry.kb_value:=e^.oldval;
- fpioctl(stdinputhandle,KDSKBENT,@entry);
- end;
- end;
- { Buffered Input routines }
- const
- InSize=256;
- var
- InBuf : array [0..InSize-1] of char;
- InCnt,
- InHead,
- InTail : longint;
- function ttyRecvChar:char;
- var
- Readed,i : longint;
- begin
- {Buffer Empty? Yes, Input from StdIn}
- if (InHead=InTail) then
- begin
- {Calc Amount of Chars to Read}
- i:=InSize-InHead;
- if InTail>InHead then
- i:=InTail-InHead;
- {Read}
- Readed:=fpRead(StdInputHandle,InBuf[InHead],i);
- {Increase Counters}
- inc(InCnt,Readed);
- inc(InHead,Readed);
- {Wrap if End has Reached}
- if InHead>=InSize then
- InHead:=0;
- end;
- {Check Buffer}
- if (InCnt=0) then
- ttyRecvChar:=#0
- else
- begin
- ttyRecvChar:=InBuf[InTail];
- dec(InCnt);
- inc(InTail);
- if InTail>=InSize then
- InTail:=0;
- end;
- end;
- Const
- KeyBufferSize = 20;
- var
- KeyBuffer : Array[0..KeyBufferSize-1] of Char;
- KeyPut,
- KeySend : longint;
- Procedure PushKey(Ch:char);
- Var
- Tmp : Longint;
- Begin
- Tmp:=KeyPut;
- Inc(KeyPut);
- If KeyPut>=KeyBufferSize Then
- KeyPut:=0;
- If KeyPut<>KeySend Then
- KeyBuffer[Tmp]:=Ch
- Else
- KeyPut:=Tmp;
- End;
- Function PopKey:char;
- Begin
- If KeyPut<>KeySend Then
- Begin
- PopKey:=KeyBuffer[KeySend];
- Inc(KeySend);
- If KeySend>=KeyBufferSize Then
- KeySend:=0;
- End
- Else
- PopKey:=#0;
- End;
- Procedure PushExt(b:byte);
- begin
- PushKey(#0);
- PushKey(chr(b));
- end;
- const
- AltKeyStr : string[38]='qwertyuiopasdfghjklzxcvbnm1234567890-=';
- AltCodeStr : string[38]=#016#017#018#019#020#021#022#023#024#025#030#031#032#033#034#035#036#037#038+
- #044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131;
- Function FAltKey(ch:char):byte;
- var
- Idx : longint;
- Begin
- Idx:=Pos(ch,AltKeyStr);
- if Idx>0 then
- FAltKey:=byte(AltCodeStr[Idx])
- else
- FAltKey:=0;
- End;
- { This one doesn't care about keypresses already processed by readkey }
- { and waiting in the KeyBuffer, only about waiting keypresses at the }
- { TTYLevel (including ones that are waiting in the TTYRecvChar buffer) }
- function sysKeyPressed: boolean;
- var
- fdsin : tfdSet;
- begin
- if (InCnt>0) then
- sysKeyPressed:=true
- else
- begin
- fpFD_ZERO(fdsin);
- fpFD_SET(StdInputHandle,fdsin);
- sysKeypressed:=(fpSelect(StdInputHandle+1,@fdsin,nil,nil,0)>0);
- end;
- end;
- Function KeyPressed:Boolean;
- Begin
- Keypressed := (KeySend<>KeyPut) or sysKeyPressed;
- End;
- Function IsConsole : Boolean;
- var
- ThisTTY: String[30];
- begin
- IsConsole:=false;
- { check for tty }
- if (IsATTY(stdinputhandle)<>-1) then
- begin
- { running on a tty, find out whether locally or remotely }
- ThisTTY:=TTYName(stdinputhandle);
- if (Copy(ThisTTY, 1, 8) = '/dev/tty') and
- (ThisTTY[9] >= '0') and (ThisTTY[9] <= '9') then
- IsConsole:=true;
- end;
- end;
- Const
- LastMouseEvent : TMouseEvent =
- (
- Buttons : 0;
- X : 0;
- Y : 0;
- Action : 0;
- );
- {$ifndef NotUseTree}
- procedure GenMouseEvent;
- var MouseEvent: TMouseEvent;
- ch : char;
- fdsin : tfdSet;
- begin
- fpFD_ZERO(fdsin);
- fpFD_SET(StdInputHandle,fdsin);
- Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
- if InCnt=0 then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- ch:=ttyRecvChar;
- { Other bits are used for Shift, Meta and Ctrl modifiers PM }
- case (ord(ch)-ord(' ')) and 3 of
- 0 : {left button press}
- MouseEvent.buttons:=1;
- 1 : {middle button pressed }
- MouseEvent.buttons:=2;
- 2 : { right button pressed }
- MouseEvent.buttons:=4;
- 3 : { no button pressed };
- end;
- if InCnt=0 then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- ch:=ttyRecvChar;
- MouseEvent.x:=Ord(ch)-ord(' ')-1;
- if InCnt=0 then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- ch:=ttyRecvChar;
- MouseEvent.y:=Ord(ch)-ord(' ')-1;
- if (MouseEvent.buttons<>0) then
- MouseEvent.action:=MouseActionDown
- else
- begin
- if (LastMouseEvent.Buttons<>0) and
- ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
- begin
- MouseEvent.Action:=MouseActionMove;
- MouseEvent.Buttons:=LastMouseEvent.Buttons;
- {$ifdef DebugMouse}
- Writeln(system.stderr,' Mouse Move (',MouseEvent.X,',',MouseEvent.Y,')');
- {$endif DebugMouse}
- PutMouseEvent(MouseEvent);
- MouseEvent.Buttons:=0;
- end;
- MouseEvent.Action:=MouseActionUp;
- end;
- PutMouseEvent(MouseEvent);
- {$ifdef DebugMouse}
- if MouseEvent.Action=MouseActionDown then
- Write(system.stderr,'Button down : ')
- else
- Write(system.stderr,'Button up : ');
- Writeln(system.stderr,'buttons = ',MouseEvent.Buttons,' (',MouseEvent.X,',',MouseEvent.Y,')');
- {$endif DebugMouse}
- LastMouseEvent:=MouseEvent;
- end;
- type
- TProcedure = procedure;
- PTreeElement = ^TTreeElement;
- TTreeElement = record
- Next,Parent,Child : PTreeElement;
- CanBeTerminal : boolean;
- char : byte;
- ScanValue : byte;
- CharValue : byte;
- SpecialHandler : TProcedure;
- end;
- var
- RootTree : Array[0..255] of PTreeElement;
- procedure FreeElement (PT:PTreeElement);
- var next : PTreeElement;
- begin
- while PT <> nil do
- begin
- FreeElement(PT^.Child);
- next := PT^.Next;
- dispose(PT);
- PT := next;
- end;
- end;
- procedure FreeTree;
- var i : integer;
- begin
- for i := low(RootTree) to high(RootTree) do
- begin
- FreeElement(RootTree[i]);
- RootTree[i] := nil;
- end;
- end;
- function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement;
- var PT : PTreeElement;
- begin
- New(PT);
- FillChar(PT^,SizeOf(TTreeElement),#0);
- PT^.char:=ch;
- PT^.Parent:=Pa;
- if Assigned(Pa) and (Pa^.Child=nil) then
- Pa^.Child:=PT;
- NewPTree:=PT;
- end;
- function DoAddSequence(Const St : String; AChar,AScan :byte) : PTreeElement;
- var
- CurPTree,NPT : PTreeElement;
- c : byte;
- i : longint;
- begin
- if St='' then
- begin
- DoAddSequence:=nil;
- exit;
- end;
- CurPTree:=RootTree[ord(st[1])];
- if CurPTree=nil then
- begin
- CurPTree:=NewPTree(ord(st[1]),nil);
- RootTree[ord(st[1])]:=CurPTree;
- end;
- for i:=2 to Length(St) do
- begin
- NPT:=CurPTree^.Child;
- c:=ord(St[i]);
- if NPT=nil then
- NPT:=NewPTree(c,CurPTree);
- CurPTree:=nil;
- while assigned(NPT) and (NPT^.char<c) do
- begin
- CurPTree:=NPT;
- NPT:=NPT^.Next;
- end;
- if assigned(NPT) and (NPT^.char=c) then
- CurPTree:=NPT
- else
- begin
- if CurPTree=nil then
- begin
- NPT^.Parent^.child:=NewPTree(c,NPT^.Parent);
- CurPTree:=NPT^.Parent^.Child;
- CurPTree^.Next:=NPT;
- end
- else
- begin
- CurPTree^.Next:=NewPTree(c,CurPTree^.Parent);
- CurPTree:=CurPTree^.Next;
- CurPTree^.Next:=NPT;
- end;
- end;
- end;
- if CurPTree^.CanBeTerminal then
- begin
- { here we have a conflict !! }
- { maybe we should claim }
- with CurPTree^ do
- begin
- {$ifdef DEBUG}
- if (ScanValue<>AScan) or (CharValue<>AChar) then
- Writeln(system.stderr,'key "',st,'" changed value');
- if (ScanValue<>AScan) then
- Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan);
- if (CharValue<>AChar) then
- Writeln(system.stderr,'Char was ',chr(CharValue),' now ',chr(AChar));
- {$endif DEBUG}
- ScanValue:=AScan;
- CharValue:=AChar;
- end;
- end
- else with CurPTree^ do
- begin
- CanBeTerminal:=True;
- ScanValue:=AScan;
- CharValue:=AChar;
- end;
- DoAddSequence:=CurPTree;
- end;
- procedure AddSequence(Const St : String; AChar,AScan :byte);
- begin
- DoAddSequence(St,AChar,AScan);
- end;
- { Returns the Child that as c as char if it exists }
- Function FindChild(c : byte;Root : PTreeElement) : PTreeElement;
- var
- NPT : PTreeElement;
- begin
- if not assigned(Root) then
- begin
- FindChild:=nil;
- exit;
- end;
- NPT:=Root^.Child;
- while assigned(NPT) and (NPT^.char<c) do
- NPT:=NPT^.Next;
- if assigned(NPT) and (NPT^.char=c) then
- FindChild:=NPT
- else
- FindChild:=nil;
- end;
- Function AddSpecialSequence(Const St : string;Proc : TProcedure) : PTreeElement;
- var
- NPT : PTreeElement;
- begin
- NPT:=DoAddSequence(St,0,0);
- NPT^.SpecialHandler:=Proc;
- AddSpecialSequence:=NPT;
- end;
- function FindSequence(Const St : String;var AChar,AScan :byte) : boolean;
- var
- NPT : PTreeElement;
- I : longint;
- begin
- FindSequence:=false;
- AChar:=0;
- AScan:=0;
- if St='' then
- exit;
- NPT:=RootTree[ord(St[1])];
- if not assigned(NPT) then
- exit;
- for i:=2 to Length(St) do
- begin
- NPT:=FindChild(ord(St[i]),NPT);
- if not assigned(NPT) then
- exit;
- end;
- if not NPT^.CanBeTerminal then
- exit
- else
- begin
- FindSequence:=true;
- AScan:=NPT^.ScanValue;
- AChar:=NPT^.CharValue;
- end;
- end;
- Procedure LoadDefaultSequences;
- begin
- AddSpecialSequence(#27'[M',@GenMouseEvent);
- { linux default values, the next setting is
- compatible with xterms from XFree 4.x }
- DoAddSequence(#127,8,0);
- { all Esc letter }
- DoAddSequence(#27'A',0,kbAltA);
- DoAddSequence(#27'a',0,kbAltA);
- DoAddSequence(#27'B',0,kbAltB);
- DoAddSequence(#27'b',0,kbAltB);
- DoAddSequence(#27'C',0,kbAltC);
- DoAddSequence(#27'c',0,kbAltC);
- DoAddSequence(#27'D',0,kbAltD);
- DoAddSequence(#27'd',0,kbAltD);
- DoAddSequence(#27'E',0,kbAltE);
- DoAddSequence(#27'e',0,kbAltE);
- DoAddSequence(#27'F',0,kbAltF);
- DoAddSequence(#27'f',0,kbAltF);
- DoAddSequence(#27'G',0,kbAltG);
- DoAddSequence(#27'g',0,kbAltG);
- DoAddSequence(#27'H',0,kbAltH);
- DoAddSequence(#27'h',0,kbAltH);
- DoAddSequence(#27'I',0,kbAltI);
- DoAddSequence(#27'i',0,kbAltI);
- DoAddSequence(#27'J',0,kbAltJ);
- DoAddSequence(#27'j',0,kbAltJ);
- DoAddSequence(#27'K',0,kbAltK);
- DoAddSequence(#27'k',0,kbAltK);
- DoAddSequence(#27'L',0,kbAltL);
- DoAddSequence(#27'l',0,kbAltL);
- DoAddSequence(#27'M',0,kbAltM);
- DoAddSequence(#27'm',0,kbAltM);
- DoAddSequence(#27'N',0,kbAltN);
- DoAddSequence(#27'n',0,kbAltN);
- DoAddSequence(#27'O',0,kbAltO);
- DoAddSequence(#27'o',0,kbAltO);
- DoAddSequence(#27'P',0,kbAltP);
- DoAddSequence(#27'p',0,kbAltP);
- DoAddSequence(#27'Q',0,kbAltQ);
- DoAddSequence(#27'q',0,kbAltQ);
- DoAddSequence(#27'R',0,kbAltR);
- DoAddSequence(#27'r',0,kbAltR);
- DoAddSequence(#27'S',0,kbAltS);
- DoAddSequence(#27's',0,kbAltS);
- DoAddSequence(#27'T',0,kbAltT);
- DoAddSequence(#27't',0,kbAltT);
- DoAddSequence(#27'U',0,kbAltU);
- DoAddSequence(#27'u',0,kbAltU);
- DoAddSequence(#27'V',0,kbAltV);
- DoAddSequence(#27'v',0,kbAltV);
- DoAddSequence(#27'W',0,kbAltW);
- DoAddSequence(#27'w',0,kbAltW);
- DoAddSequence(#27'X',0,kbAltX);
- DoAddSequence(#27'x',0,kbAltX);
- DoAddSequence(#27'Y',0,kbAltY);
- DoAddSequence(#27'y',0,kbAltY);
- DoAddSequence(#27'Z',0,kbAltZ);
- DoAddSequence(#27'z',0,kbAltZ);
- DoAddSequence(#27'-',0,kbAltMinus);
- DoAddSequence(#27'=',0,kbAltEqual);
- DoAddSequence(#27'0',0,kbAlt0);
- DoAddSequence(#27'1',0,kbAlt1);
- DoAddSequence(#27'2',0,kbAlt2);
- DoAddSequence(#27'3',0,kbAlt3);
- DoAddSequence(#27'4',0,kbAlt4);
- DoAddSequence(#27'5',0,kbAlt5);
- DoAddSequence(#27'6',0,kbAlt6);
- DoAddSequence(#27'7',0,kbAlt7);
- DoAddSequence(#27'8',0,kbAlt8);
- DoAddSequence(#27'9',0,kbAlt9);
- { vt100 default values }
- DoAddSequence(#27'[[A',0,kbF1);
- DoAddSequence(#27'[[B',0,kbF2);
- DoAddSequence(#27'[[C',0,kbF3);
- DoAddSequence(#27'[[D',0,kbF4);
- DoAddSequence(#27'[[E',0,kbF5);
- DoAddSequence(#27'[17~',0,kbF6);
- DoAddSequence(#27'[18~',0,kbF7);
- DoAddSequence(#27'[19~',0,kbF8);
- DoAddSequence(#27'[20~',0,kbF9);
- DoAddSequence(#27'[21~',0,kbF10);
- DoAddSequence(#27'[23~',0,kbF11);
- DoAddSequence(#27'[24~',0,kbF12);
- DoAddSequence(#27'[25~',0,kbShiftF3);
- DoAddSequence(#27'[26~',0,kbShiftF4);
- DoAddSequence(#27'[28~',0,kbShiftF5);
- DoAddSequence(#27'[29~',0,kbShiftF6);
- DoAddSequence(#27'[31~',0,kbShiftF7);
- DoAddSequence(#27'[32~',0,kbShiftF8);
- DoAddSequence(#27'[33~',0,kbShiftF9);
- DoAddSequence(#27'[34~',0,kbShiftF10);
- DoAddSequence(#27#27'[[A',0,kbAltF1);
- DoAddSequence(#27#27'[[B',0,kbAltF2);
- DoAddSequence(#27#27'[[C',0,kbAltF3);
- DoAddSequence(#27#27'[[D',0,kbAltF4);
- DoAddSequence(#27#27'[[E',0,kbAltF5);
- DoAddSequence(#27#27'[17~',0,kbAltF6);
- DoAddSequence(#27#27'[18~',0,kbAltF7);
- DoAddSequence(#27#27'[19~',0,kbAltF8);
- DoAddSequence(#27#27'[20~',0,kbAltF9);
- DoAddSequence(#27#27'[21~',0,kbAltF10);
- DoAddSequence(#27#27'[23~',0,kbAltF11);
- DoAddSequence(#27#27'[24~',0,kbAltF12);
- DoAddSequence(#27'[A',0,kbUp);
- DoAddSequence(#27'[B',0,kbDown);
- DoAddSequence(#27'[C',0,kbRight);
- DoAddSequence(#27'[D',0,kbLeft);
- DoAddSequence(#27'[F',0,kbEnd);
- DoAddSequence(#27'[H',0,kbHome);
- DoAddSequence(#27'[Z',0,kbShiftTab);
- DoAddSequence(#27'[5~',0,kbPgUp);
- DoAddSequence(#27'[6~',0,kbPgDn);
- DoAddSequence(#27'[4~',0,kbEnd);
- DoAddSequence(#27'[1~',0,kbHome);
- DoAddSequence(#27'[2~',0,kbIns);
- DoAddSequence(#27'[3~',0,kbDel);
- DoAddSequence(#27#27'[A',0,kbAltUp);
- DoAddSequence(#27#27'[B',0,kbAltDown);
- DoAddSequence(#27#27'[D',0,kbAltLeft);
- DoAddSequence(#27#27'[C',0,kbAltRight);
- DoAddSequence(#27#27'[5~',0,kbAltPgUp);
- DoAddSequence(#27#27'[6~',0,kbAltPgDn);
- DoAddSequence(#27#27'[4~',0,kbAltEnd);
- DoAddSequence(#27#27'[1~',0,kbAltHome);
- DoAddSequence(#27#27'[2~',0,kbAltIns);
- DoAddSequence(#27#27'[3~',0,kbAltDel);
- DoAddSequence(#27'OP',0,kbF1);
- DoAddSequence(#27'OQ',0,kbF2);
- DoAddSequence(#27'OR',0,kbF3);
- DoAddSequence(#27'OS',0,kbF4);
- DoAddSequence(#27'Ot',0,kbF5);
- DoAddSequence(#27'Ou',0,kbF6);
- DoAddSequence(#27'Ov',0,kbF7);
- DoAddSequence(#27'Ol',0,kbF8);
- DoAddSequence(#27'Ow',0,kbF9);
- DoAddSequence(#27'Ox',0,kbF10);
- DoAddSequence(#27'Oy',0,kbF11);
- DoAddSequence(#27'Oz',0,kbF12);
- DoAddSequence(#27#27'OP',0,kbAltF1);
- DoAddSequence(#27#27'OQ',0,kbAltF2);
- DoAddSequence(#27#27'OR',0,kbAltF3);
- DoAddSequence(#27#27'OS',0,kbAltF4);
- DoAddSequence(#27#27'Ot',0,kbAltF5);
- DoAddSequence(#27#27'Ou',0,kbAltF6);
- DoAddSequence(#27#27'Ov',0,kbAltF7);
- DoAddSequence(#27#27'Ol',0,kbAltF8);
- DoAddSequence(#27#27'Ow',0,kbAltF9);
- DoAddSequence(#27#27'Ox',0,kbAltF10);
- DoAddSequence(#27#27'Oy',0,kbAltF11);
- DoAddSequence(#27#27'Oz',0,kbAltF12);
- DoAddSequence(#27'OA',0,kbUp);
- DoAddSequence(#27'OB',0,kbDown);
- DoAddSequence(#27'OC',0,kbRight);
- DoAddSequence(#27'OD',0,kbLeft);
- DoAddSequence(#27#27'OA',0,kbAltUp);
- DoAddSequence(#27#27'OB',0,kbAltDown);
- DoAddSequence(#27#27'OC',0,kbAltRight);
- DoAddSequence(#27#27'OD',0,kbAltLeft);
- { xterm default values }
- { xterm alternate default values }
- { ignored sequences }
- DoAddSequence(#27'[?1;0c',0,0);
- DoAddSequence(#27'[?1l',0,0);
- DoAddSequence(#27'[?1h',0,0);
- DoAddSequence(#27'[?1;2c',0,0);
- DoAddSequence(#27'[?7l',0,0);
- DoAddSequence(#27'[?7h',0,0);
- end;
- function EnterEscapeSeqNdx(Ndx: Word;Char,Scan : byte) : PTreeElement;
- var
- P,pdelay: PChar;
- St : string;
- begin
- EnterEscapeSeqNdx:=nil;
- P:=cur_term_Strings^[Ndx];
- if assigned(p) then
- begin { Do not record the delays }
- pdelay:=strpos(p,'$<');
- if assigned(pdelay) then
- pdelay^:=#0;
- St:=StrPas(p);
- EnterEscapeSeqNdx:=DoAddSequence(St,Char,Scan);
- if assigned(pdelay) then
- pdelay^:='$';
- end;
- end;
- Procedure LoadTermInfoSequences;
- var
- err : longint;
- begin
- if not assigned(cur_term) then
- setupterm(nil, stdoutputhandle, err);
- if not assigned(cur_term_Strings) then
- exit;
- EnterEscapeSeqNdx(key_f1,0,kbF1);
- EnterEscapeSeqNdx(key_f2,0,kbF2);
- EnterEscapeSeqNdx(key_f3,0,kbF3);
- EnterEscapeSeqNdx(key_f4,0,kbF4);
- EnterEscapeSeqNdx(key_f5,0,kbF5);
- EnterEscapeSeqNdx(key_f6,0,kbF6);
- EnterEscapeSeqNdx(key_f7,0,kbF7);
- EnterEscapeSeqNdx(key_f8,0,kbF8);
- EnterEscapeSeqNdx(key_f9,0,kbF9);
- EnterEscapeSeqNdx(key_f10,0,kbF10);
- EnterEscapeSeqNdx(key_f11,0,kbF11);
- EnterEscapeSeqNdx(key_f12,0,kbF12);
- EnterEscapeSeqNdx(key_up,0,kbUp);
- EnterEscapeSeqNdx(key_down,0,kbDown);
- EnterEscapeSeqNdx(key_left,0,kbLeft);
- EnterEscapeSeqNdx(key_right,0,kbRight);
- EnterEscapeSeqNdx(key_ppage,0,kbPgUp);
- EnterEscapeSeqNdx(key_npage,0,kbPgDn);
- EnterEscapeSeqNdx(key_end,0,kbEnd);
- EnterEscapeSeqNdx(key_home,0,kbHome);
- EnterEscapeSeqNdx(key_ic,0,kbIns);
- EnterEscapeSeqNdx(key_dc,0,kbDel);
- EnterEscapeSeqNdx(key_stab,0,kbShiftTab);
- { EnterEscapeSeqNdx(key_,0,kb);
- EnterEscapeSeqNdx(key_,0,kb); }
- end;
- {$endif not NotUseTree}
- Function RawReadKey:char;
- Var
- fdsin : tfdSet;
- Begin
- {Check Buffer first}
- if KeySend<>KeyPut then
- begin
- RawReadKey:=PopKey;
- exit;
- end;
- {Wait for Key}
- if not sysKeyPressed then
- begin
- fpFD_ZERO (fdsin);
- fpFD_SET (StdInputHandle,fdsin);
- fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
- end;
- RawReadKey:=ttyRecvChar;
- end;
- Function RawReadString : String;
- Var
- ch : char;
- fdsin : tfdSet;
- St : String;
- Begin
- St:=RawReadKey;
- fpFD_ZERO (fdsin);
- fpFD_SET (StdInputHandle,fdsin);
- Repeat
- if InCnt=0 then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- if SysKeyPressed then
- ch:=ttyRecvChar
- else
- ch:=#0;
- if ch<>#0 then
- St:=St+ch;
- Until ch=#0;
- RawReadString:=St;
- end;
- Function ReadKey(var IsAlt : boolean):char;
- Var
- ch : char;
- {$ifdef NotUseTree}
- OldState : longint;
- State : longint;
- {$endif NotUseTree}
- is_delay : boolean;
- fdsin : tfdSet;
- store : array [0..8] of char;
- arrayind : byte;
- {$ifndef NotUseTree}
- NPT,NNPT : PTreeElement;
- {$else NotUseTree}
- procedure GenMouseEvent;
- var MouseEvent: TMouseEvent;
- begin
- Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
- case ch of
- #32 : {left button pressed }
- MouseEvent.buttons:=1;
- #33 : {middle button pressed }
- MouseEvent.buttons:=2;
- #34 : { right button pressed }
- MouseEvent.buttons:=4;
- #35 : { no button pressed };
- end;
- if InCnt=0 then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- ch:=ttyRecvChar;
- MouseEvent.x:=Ord(ch)-ord(' ')-1;
- if InCnt=0 then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- ch:=ttyRecvChar;
- MouseEvent.y:=Ord(ch)-ord(' ')-1;
- if (MouseEvent.buttons<>0) then
- MouseEvent.action:=MouseActionDown
- else
- begin
- if (LastMouseEvent.Buttons<>0) and
- ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
- begin
- MouseEvent.Action:=MouseActionMove;
- MouseEvent.Buttons:=LastMouseEvent.Buttons;
- PutMouseEvent(MouseEvent);
- MouseEvent.Buttons:=0;
- end;
- MouseEvent.Action:=MouseActionUp;
- end;
- PutMouseEvent(MouseEvent);
- LastMouseEvent:=MouseEvent;
- end;
- {$endif NotUseTree}
- procedure RestoreArray;
- var
- i : byte;
- begin
- for i:=0 to arrayind-1 do
- PushKey(store[i]);
- end;
- Begin
- IsAlt:=false;
- {Check Buffer first}
- if KeySend<>KeyPut then
- begin
- ReadKey:=PopKey;
- exit;
- end;
- {Wait for Key}
- if not sysKeyPressed then
- begin
- fpFD_ZERO (fdsin);
- fpFD_SET (StdInputHandle,fdsin);
- fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
- end;
- ch:=ttyRecvChar;
- {$ifndef NotUseTree}
- NPT:=RootTree[ord(ch)];
- if not assigned(NPT) then
- PushKey(ch)
- else
- begin
- fpFD_ZERO(fdsin);
- fpFD_SET(StdInputHandle,fdsin);
- store[0]:=ch;
- arrayind:=1;
- while assigned(NPT) and syskeypressed do
- begin
- if (InCnt=0) then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- ch:=ttyRecvChar;
- NNPT:=FindChild(ord(ch),NPT);
- if assigned(NNPT) then
- Begin
- NPT:=NNPT;
- if NPT^.CanBeTerminal and
- assigned(NPT^.SpecialHandler) then
- break;
- End;
- if ch<>#0 then
- begin
- store[arrayind]:=ch;
- inc(arrayind);
- end;
- if not assigned(NNPT) then
- begin
- if ch<>#0 then
- begin
- { Put that unused char back into InBuf }
- If InTail=0 then
- InTail:=InSize-1
- else
- Dec(InTail);
- InBuf[InTail]:=ch;
- inc(InCnt);
- end;
- break;
- end;
- end;
- if assigned(NPT) and NPT^.CanBeTerminal then
- begin
- if assigned(NPT^.SpecialHandler) then
- begin
- NPT^.SpecialHandler;
- PushExt(0);
- end
- else if NPT^.CharValue<>0 then
- PushKey(chr(NPT^.CharValue))
- else if NPT^.ScanValue<>0 then
- PushExt(NPT^.ScanValue);
- end
- else
- RestoreArray;
- {$else NotUseTree}
- {Esc Found ?}
- If (ch=#27) then
- begin
- fpFD_ZERO(fdsin);
- fpFD_SET(StdInputHandle,fdsin);
- State:=1;
- store[0]:=#27;
- arrayind:=1;
- {$ifdef logging}
- write(f,'Esc');
- {$endif logging}
- if InCnt=0 then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- while (State<>0) and (sysKeyPressed) do
- begin
- ch:=ttyRecvChar;
- store[arrayind]:=ch;
- inc(arrayind);
- {$ifdef logging}
- if ord(ch)>31 then
- write(f,ch)
- else
- write(f,'#',ord(ch):2);
- {$endif logging}
- OldState:=State;
- State:=0;
- case OldState of
- 1 : begin {Esc}
- case ch of
- 'a'..'z',
- '0'..'9',
- '-','=' : PushExt(FAltKey(ch));
- 'A'..'N',
- 'P'..'Z' : PushExt(FAltKey(chr(ord(ch)+ord('a')-ord('A'))));
- #10 : PushKey(#10);
- #13 : PushKey(#10);
- #27 : begin
- IsAlt:=True;
- State:=1;
- end;
- #127 : PushExt(kbAltDel);
- '[' : State:=2;
- 'O' : State:=6;
- else
- RestoreArray;
- end;
- end;
- 2 : begin {Esc[}
- case ch of
- '[' : State:=3;
- 'A' : PushExt(kbUp);
- 'B' : PushExt(kbDown);
- 'C' : PushExt(kbRight);
- 'D' : PushExt(kbLeft);
- 'F' : PushExt(kbEnd);
- 'G' : PushKey('5');
- 'H' : PushExt(kbHome);
- 'K' : PushExt(kbEnd);
- 'M' : State:=13;
- '1' : State:=4;
- '2' : State:=5;
- '3' : State:=12;{PushExt(kbDel)}
- '4' : PushExt(kbEnd);
- '5' : PushExt(73);
- '6' : PushExt(kbPgDn);
- '?' : State:=7;
- else
- RestoreArray;
- end;
- if ch in ['4'..'6'] then
- State:=255;
- end;
- 3 : begin {Esc[[}
- case ch of
- 'A' : PushExt(kbF1);
- 'B' : PushExt(kbF2);
- 'C' : PushExt(kbF3);
- 'D' : PushExt(kbF4);
- 'E' : PushExt(kbF5);
- else
- RestoreArray;
- end;
- end;
- 4 : begin {Esc[1}
- case ch of
- '~' : PushExt(kbHome);
- '7' : PushExt(kbF6);
- '8' : PushExt(kbF7);
- '9' : PushExt(kbF8);
- else
- RestoreArray;
- end;
- if (Ch<>'~') then
- State:=255;
- end;
- 5 : begin {Esc[2}
- case ch of
- '~' : PushExt(kbIns);
- '0' : pushExt(kbF9);
- '1' : PushExt(kbF10);
- '3' : PushExt($85){F11, but ShiftF1 also !!};
- '4' : PushExt($86){F12, but Shift F2 also !!};
- '5' : PushExt($56){ShiftF3};
- '6' : PushExt($57){ShiftF4};
- '8' : PushExt($58){ShiftF5};
- '9' : PushExt($59){ShiftF6};
- else
- RestoreArray;
- end;
- if (Ch<>'~') then
- State:=255;
- end;
- 12 : begin {Esc[3}
- case ch of
- '~' : PushExt(kbDel);
- '1' : PushExt($5A){ShiftF7};
- '2' : PushExt($5B){ShiftF8};
- '3' : PushExt($5C){ShiftF9};
- '4' : PushExt($5D){ShiftF10};
- else
- RestoreArray;
- end;
- if (Ch<>'~') then
- State:=255;
- end;
- 6 : begin {EscO Function keys in vt100 mode PM }
- case ch of
- 'P' : {F1}PushExt(kbF1);
- 'Q' : {F2}PushExt(kbF2);
- 'R' : {F3}PushExt(kbF3);
- 'S' : {F4}PushExt(kbF4);
- 't' : {F5}PushExt(kbF5);
- 'u' : {F6}PushExt(kbF6);
- 'v' : {F7}PushExt(kbF7);
- 'l' : {F8}PushExt(kbF8);
- 'w' : {F9}PushExt(kbF9);
- 'x' : {F10}PushExt(kbF10);
- 'D' : {keyLeft}PushExt($4B);
- 'C' : {keyRight}PushExt($4D);
- 'A' : {keyUp}PushExt($48);
- 'B' : {keyDown}PushExt($50);
- else
- RestoreArray;
- end;
- end;
- 7 : begin {Esc[? keys in vt100 mode PM }
- case ch of
- '0' : State:=11;
- '1' : State:=8;
- '7' : State:=9;
- else
- RestoreArray;
- end;
- end;
- 8 : begin {Esc[?1 keys in vt100 mode PM }
- case ch of
- 'l' : {local mode};
- 'h' : {transmit mode};
- ';' : { 'Esc[1;0c seems to be sent by M$ telnet app
- for no hangup purposes }
- state:=10;
- else
- RestoreArray;
- end;
- end;
- 9 : begin {Esc[?7 keys in vt100 mode PM }
- case ch of
- 'l' : {exit_am_mode};
- 'h' : {enter_am_mode};
- else
- RestoreArray;
- end;
- end;
- 10 : begin {Esc[?1; keys in vt100 mode PM }
- case ch of
- '0' : state:=11;
- else
- RestoreArray;
- end;
- end;
- 11 : begin {Esc[?1;0 keys in vt100 mode PM }
- case ch of
- 'c' : ;
- else
- RestoreArray;
- end;
- end;
- 13 : begin {Esc[M mouse prefix for xterm }
- GenMouseEvent;
- end;
- 255 : { just forget this trailing char };
- end;
- if (State<>0) and (InCnt=0) then
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- end;
- if State=1 then
- PushKey(ch);
- {$endif NotUseTree}
- if ch='$' then
- begin { '$<XX>' means a delay of XX millisecs }
- is_delay :=false;
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- if (sysKeyPressed) then
- begin
- ch:=ttyRecvChar;
- is_delay:=(ch='<');
- if not is_delay then
- begin
- PushKey('$');
- PushKey(ch);
- end
- else
- begin
- {$ifdef logging}
- write(f,'$<');
- {$endif logging}
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- while (sysKeyPressed) and (ch<>'>') do
- begin
- { Should we really repect this delay ?? }
- ch:=ttyRecvChar;
- {$ifdef logging}
- write(f,ch);
- {$endif logging}
- fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
- end;
- end;
- end
- else
- PushKey('$');
- end;
- end
- {$ifdef logging}
- writeln(f);
- {$endif logging}
- {$ifndef NotUseTree}
- ;
- ReadKey:=PopKey;
- {$else NotUseTree}
- else
- Begin
- case ch of
- #127 : PushKey(#8);
- else
- PushKey(ch);
- end;
- End;
- ReadKey:=PopKey;
- {$endif NotUseTree}
- End;
- function ShiftState:byte;
- var
- arg,shift : longint;
- begin
- arg:=6;
- shift:=0;
- {$Ifndef BSD}
- if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
- begin
- if (arg and 8)<>0 then
- shift:=kbAlt;
- if (arg and 4)<>0 then
- inc(shift,kbCtrl);
- { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
- if (arg and 2)<>0 then
- shift:=shift or (kbAlt or kbCtrl);
- if (arg and 1)<>0 then
- inc(shift,kbShift);
- end;
- {$endif}
- ShiftState:=shift;
- end;
- { Exported functions }
- procedure SysInitKeyboard;
- begin
- SetRawMode(true);
- patchkeyboard;
- {$ifdef logging}
- assign(f,'keyboard.log');
- rewrite(f);
- {$endif logging}
- if not IsConsole then
- begin
- { default for Shift prefix is ^ A}
- if ShiftPrefix = 0 then
- ShiftPrefix:=1;
- {default for Alt prefix is ^Z }
- if AltPrefix=0 then
- AltPrefix:=26;
- { default for Ctrl Prefix is ^W }
- if CtrlPrefix=0 then
- CtrlPrefix:=23;
- end;
- {$ifndef NotUseTree}
- LoadDefaultSequences;
- LoadTerminfoSequences;
- {$endif not NotUseTree}
- end;
- procedure SysDoneKeyboard;
- begin
- unpatchkeyboard;
- SetRawMode(false);
- {$ifndef NotUseTree}
- FreeTree;
- {$endif not NotUseTree}
- {$ifdef logging}
- close(f);
- {$endif logging}
- end;
- function SysGetKeyEvent: TKeyEvent;
- function EvalScan(b:byte):byte;
- const
- DScan:array[0..31] of byte = (
- $39, $02, $28, $04, $05, $06, $08, $28,
- $0A, $0B, $09, $0D, $33, $0C, $34, $35,
- $0B, $02, $03, $04, $05, $06, $07, $08,
- $09, $0A, $27, $27, $33, $0D, $34, $35);
- LScan:array[0..31] of byte = (
- $29, $1E, $30, $2E, $20, $12, $21, $22,
- $23, $17, $24, $25, $26, $32, $31, $18,
- $19, $10, $13, $1F, $14, $16, $2F, $11,
- $2D, $15, $2C, $1A, $2B, $1B, $29, $0C);
- begin
- if (b and $E0)=$20 { digits / leters } then
- EvalScan:=DScan[b and $1F]
- else
- case b of
- $08:EvalScan:=$0E; { backspace }
- $09:EvalScan:=$0F; { TAB }
- $0D:EvalScan:=$1C; { CR }
- $1B:EvalScan:=$01; { esc }
- $40:EvalScan:=$03; { @ }
- $5E:EvalScan:=$07; { ^ }
- $60:EvalScan:=$29; { ` }
- else
- EvalScan:=LScan[b and $1F];
- end;
- end;
- function EvalScanZ(b:byte):byte;
- begin
- EvalScanZ:=b;
- if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then
- EvalScanZ:=b+$2D;
- end;
- const
- {kbHome, kbUp, kbPgUp,Missing, kbLeft,
- kbCenter, kbRight, kbAltGrayPlus, kbend,
- kbDown, kbPgDn, kbIns, kbDel }
- CtrlArrow : array [kbHome..kbDel] of byte =
- {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);}
- (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft,
- kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd,
- kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel);
- AltArrow : array [kbHome..kbDel] of byte =
- (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft,
- kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd,
- kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
- var
- MyScan,
- SState : byte;
- MyChar : char;
- EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
- begin {main}
- MyChar:=Readkey(IsAlt);
- MyScan:=ord(MyChar);
- SState:=ShiftState;
- CtrlPrefixUsed:=false;
- AltPrefixUsed:=false;
- ShiftPrefixUsed:=false;
- EscUsed:=false;
- if IsAlt then
- SState:=SState or kbAlt;
- repeat
- again:=false;
- if Mychar=#0 then
- begin
- MyScan:=ord(ReadKey(IsAlt));
- { Handle Ctrl-<x>, but not AltGr-<x> }
- if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
- begin
- case MyScan of
- kbHome..kbDel : { cArrow }
- MyScan:=CtrlArrow[MyScan];
- kbF1..KbF10 : { cF1-cF10 }
- MyScan:=MyScan+kbCtrlF1-kbF1;
- kbF11..KbF12 : { cF11-cF12 }
- MyScan:=MyScan+kbCtrlF11-kbF11;
- end;
- end
- { Handle Alt-<x>, but not AltGr }
- else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
- begin
- case MyScan of
- kbHome..kbDel : { AltArrow }
- MyScan:=AltArrow[MyScan];
- kbF1..KbF10 : { aF1-aF10 }
- MyScan:=MyScan+kbAltF1-kbF1;
- kbF11..KbF12 : { aF11-aF12 }
- MyScan:=MyScan+kbAltF11-kbF11;
- end;
- end
- else if (SState and kbShift)<>0 then
- begin
- case MyScan of
- kbIns: MyScan:=kbShiftIns;
- kbDel: MyScan:=kbShiftDel;
- kbF1..KbF10 : { sF1-sF10 }
- MyScan:=MyScan+kbShiftF1-kbF1;
- kbF11..KbF12 : { sF11-sF12 }
- MyScan:=MyScan+kbShiftF11-kbF11;
- end;
- end;
- if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
- SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
- else
- SysGetKeyEvent:=0;
- exit;
- end
- else if MyChar=#27 then
- begin
- if EscUsed then
- SState:=SState and not kbAlt
- else
- begin
- SState:=SState or kbAlt;
- Again:=true;
- EscUsed:=true;
- end;
- end
- else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
- begin { ^Z - replace Alt for Linux OS }
- if AltPrefixUsed then
- begin
- SState:=SState and not kbAlt;
- end
- else
- begin
- AltPrefixUsed:=true;
- SState:=SState or kbAlt;
- Again:=true;
- end;
- end
- else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
- begin
- if CtrlPrefixUsed then
- SState:=SState and not kbCtrl
- else
- begin
- CtrlPrefixUsed:=true;
- SState:=SState or kbCtrl;
- Again:=true;
- end;
- end
- else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
- begin
- if ShiftPrefixUsed then
- SState:=SState and not kbShift
- else
- begin
- ShiftPrefixUsed:=true;
- SState:=SState or kbShift;
- Again:=true;
- end;
- end;
- if not again then
- begin
- MyScan:=EvalScan(ord(MyChar));
- if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
- begin
- if MyScan in [$02..$0D] then
- inc(MyScan,$76);
- MyChar:=chr(0);
- end
- else if (SState and kbShift)<>0 then
- if MyChar=#9 then
- begin
- MyChar:=#0;
- MyScan:=kbShiftTab;
- end;
- end
- else
- begin
- MyChar:=Readkey(IsAlt);
- MyScan:=ord(MyChar);
- if IsAlt then
- SState:=SState or kbAlt;
- end;
- until not Again;
- if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
- SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
- else
- SysGetKeyEvent:=0;
- end;
- function SysPollKeyEvent: TKeyEvent;
- var
- KeyEvent : TKeyEvent;
- begin
- if keypressed then
- begin
- KeyEvent:=SysGetKeyEvent;
- PutKeyEvent(KeyEvent);
- SysPollKeyEvent:=KeyEvent
- end
- else
- SysPollKeyEvent:=0;
- end;
- function SysGetShiftState : Byte;
- begin
- SysGetShiftState:=ShiftState;
- end;
- procedure RestoreStartMode;
- begin
- TCSetAttr(1,TCSANOW,StartTio);
- end;
- Const
- SysKeyboardDriver : TKeyboardDriver = (
- InitDriver : @SysInitKeyBoard;
- DoneDriver : @SysDoneKeyBoard;
- GetKeyevent : @SysGetKeyEvent;
- PollKeyEvent : @SysPollKeyEvent;
- GetShiftState : @SysGetShiftState;
- TranslateKeyEvent : Nil;
- TranslateKeyEventUnicode : Nil;
- );
- begin
- SetKeyBoardDriver(SysKeyBoardDriver);
- TCGetAttr(1,StartTio);
- end.
- {
- $Log$
- Revision 1.19 2004-07-09 19:03:35 peter
- * isatty return cint again
- Revision 1.17 2003/11/19 17:11:40 marco
- * termio unit
- Revision 1.16 2003/11/17 10:05:51 marco
- * threads for FreeBSD. Not working tho
- Revision 1.15 2003/09/16 16:13:56 marco
- * fdset functions renamed to fp<posix name>
- Revision 1.14 2003/09/14 20:15:01 marco
- * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
- Revision 1.13 2003/03/27 12:52:10 armin
- * forgot to initialize RootTree to nil in FreeTree
- Revision 1.12 2003/03/26 12:35:23 armin
- * Free the Tree in SysDoneKeyboard to avoid a lot of messages if heaptrace is enabled
- Revision 1.11 2002/09/07 16:01:27 peter
- * old logs removed and tabs fixed
- Revision 1.10 2002/03/03 13:23:51 peter
- * adjust backspace sequence so it works according to the latest
- XFree xterms and linux consoles
- }
|