home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d6xx
/
d666
/
kme.lha
/
KME
/
KME.mod
< prev
next >
Wrap
Text File
|
1992-05-21
|
60KB
|
2,053 lines
(*---------------------------------------------------------------------------
:Program. KME.mod
:Contents. Keymap-Editor
:Author. Christian Stiens
:Address. Heustiege 2, W-4710 Lüdinghausen, Germany
:Copyright. Freeware, © 92 by cs-soft, all rights reserved
:Language. Oberon
:Translator. Amiga Oberon V2.25d (inofficial beta version)
:History. V1.0, 01-Jul-91: first release
:History. V1.1, 28-Oct-91: message filtering, ...
:History. V1.2, 26-Mar-92: 2.0-BusyPointer, ...
:Support. Iconify by Steffen Köhler
:Remark. Compile: Oberon -dm KME
:Remark. Link: OLink KME -dm
---------------------------------------------------------------------------*)
MODULE KME;
IMPORT
c : Console,
d : Dos,
fs : FileSystem,
fr : FileReq,
g : Graphics,
e : Exec,
km : KeyMap,
I : Intuition,
ie : InputEvent,
NoGuruRq,
ol : OberonLib,
rq : Requests,
str: Strings,
sys: SYSTEM;
CONST
ver = "$VER: kme 1.2 (26.3.92)\n\r";
kmr = "KME Request:";
ok = " Ok ";
rtry = "Retry";
cncl = "Cancel";
oom = "Out of memory";
ooc = "Out of chip mem";
cow = "Can't open window";
clk = "Can't load keymap";
csk = "Can't save keymap";
wer = "Write error, delete corrupt file?";
fae = "File already exists";
ovw = "Overwrite";
load = "Map is modified, really load another?";
quit = "Keymap has been modified, really quit?";
kme = "KME Keymap Editor V1.2";
cprt = "© 1992 by Christian Stiens";
please = "Yes, please";
forget = "Oh No!";
strLen = 80;
numGads = 130;
keyHeight = 14;
W1 = 24;
W2 = 30;
S1 = 10;
C1 = 28;
S2 = (S1+6*W1-W2*4) DIV 2;
X1 = -10;
X2 = 0;
(* Key.type *)
white = 0;
gray = 1;
nok = 2;
(* Gadget ID's *)
idKey=5;
idAbout=10;
idIconify=20;
idQuit=30;
idMod=50;
idLoad=101;
idSave=102;
idShift=203;
idAlt=204;
idControl=205;
idDownup=206;
idDead=207;
idString=208;
idNop=209;
idCapsable=210;
idRepeatable=211;
idUndo=112;
idStr=300;
TYPE
KeyMapPtr = UNTRACED POINTER TO KeyMap;
KeyMap = STRUCT
loKeyMapTypes : UNTRACED POINTER TO ARRAY 64 OF SHORTSET;
loKeyMap : UNTRACED POINTER TO ARRAY 64 OF LONGINT;
loCapsable : UNTRACED POINTER TO ARRAY 8 OF SHORTSET;
loRepeatable : UNTRACED POINTER TO ARRAY 8 OF SHORTSET;
hiKeyMapTypes : UNTRACED POINTER TO ARRAY 56 OF SHORTSET;
hiKeyMap : UNTRACED POINTER TO ARRAY 56 OF LONGINT;
hiCapsable : UNTRACED POINTER TO ARRAY 7 OF SHORTSET;
hiRepeatable : UNTRACED POINTER TO ARRAY 7 OF SHORTSET;
END;
String = ARRAY strLen OF CHAR;
Str4 = ARRAY 4 OF CHAR;
Key = STRUCT
type : SHORTINT;
width : INTEGER;
name : Str4;
code : SHORTINT;
END;
StrDeskr = ARRAY 8 OF STRUCT
len,offs: SHORTINT;
END;
StrDeskrPtr = UNTRACED POINTER TO StrDeskr;
DeadDeskr = ARRAY 8 OF STRUCT
type,val: SHORTINT;
END;
DeadDeskrPtr = UNTRACED POINTER TO DeadDeskr;
VAR
attr : g.TextAttr;
nw : I.NewWindow;
win : I.WindowPtr;
scr : I.ScreenPtr;
rp : g.RastPortPtr;
mes : I.IntuiMessage;
Y1 : INTEGER;
font : g.TextFontPtr;
msg : I.IntuiMessagePtr;
keyMap : KeyMapPtr;
gadCnt : INTEGER;
strCnt : INTEGER;
gad : ARRAY numGads OF I.Gadget;
ioreq : e.IOStdReq;
buffer : ARRAY 8 OF String;
undobf : ARRAY 8 OF String;
strInf : ARRAY 8 OF I.StringInfo;
pat : ARRAY 2 OF INTEGER;
clickedGad : I.GadgetPtr;
gadget : I.GadgetPtr;
gadID,i : INTEGER;
con : BOOLEAN;
lastKeyGad : I.GadgetPtr;
kmeIcon : I.Image;
kmeIconData : UNTRACED POINTER TO ARRAY 494 OF INTEGER;
iconX,iconY : INTEGER;
kmePic : I.Image;
kmePicData : UNTRACED POINTER TO ARRAY 132 OF INTEGER;
type : SHORTSET;
rawCode : INTEGER;
oldCode : INTEGER;
keyModified : BOOLEAN;
mapModified : BOOLEAN;
makeGads : BOOLEAN;
fileName : String;
seg,newSeg : e.BPTR;
string : String;
zz : UNTRACED POINTER TO ARRAY (16+2)*2 OF INTEGER;
dfltKeyMap : KeyMap;
loTypes : ARRAY 64 OF SHORTSET;
hiTypes : ARRAY 56 OF SHORTSET;
loCaps : ARRAY 8 OF SHORTSET;
hiCaps : ARRAY 7 OF SHORTSET;
loRepeat : ARRAY 8 OF SHORTSET;
hiRepeat : ARRAY 7 OF SHORTSET;
loMap : ARRAY 64 OF LONGINT;
hiMap : ARRAY 56 OF LONGINT;
deadLen : INTEGER;
reloTab : ARRAY 130 OF LONGINT;
reloTabPtr : INTEGER;
chipBuf : UNTRACED POINTER TO ARRAY 128 OF BYTE;
dummy : LONGINT;
TYPE
KeyRow0 = ARRAY 13 OF Key;
KeyRow1 = ARRAY 23 OF Key;
KeyRow2 = ARRAY 19 OF Key;
KeyRow3 = ARRAY 21 OF Key;
KeyRow4 = ARRAY 22 OF Key;
KeyRow5 = ARRAY 9 OF Key;
CONST
keyRow0 = KeyRow0(
1,W1,"Esc",69,
nok,S1,"",0,
1,W2,"f1",80,
1,W2,"f2",81,
1,W2,"f3",82,
1,W2,"f4",83,
1,W2,"f5",84,
nok,S1,"",0,
1,W2,"f6",85,
1,W2,"f7",86,
1,W2,"f8",87,
1,W2,"f9",88,
1,W2,"f0",89);
keyRow1 = KeyRow1(
1,W1+S1,"x",0,
0,W1,"x",1,
0,W1,"x",2,
0,W1,"x",3,
0,W1,"x",4,
0,W1,"x",5,
0,W1,"x",6,
0,W1,"x",7,
0,W1,"x",8,
0,W1,"x",9,
0,W1,"x",10,
0,W1,"x",11,
0,W1,"x",12,
0,W1,"x",13,
1,W1,"Bs",65,
nok,S1,"",0,
1,W1*3 DIV 2,"Del",70,
1,W1*3 DIV 2,"Help",95,
nok,S1,"",0,
1,W1,"x",90,
1,W1,"x",91,
1,W1,"x",92,
1,W1,"x",93);
keyRow2 = KeyRow2(
1,W1+S1+W1 DIV 2,"Tab",66,
0,W1,"x",16,
0,W1,"x",17,
0,W1,"x",18,
0,W1,"x",19,
0,W1,"x",20,
0,W1,"x",21,
0,W1,"x",22,
0,W1,"x",23,
0,W1,"x",24,
0,W1,"x",25,
0,W1,"x",26,
0,W1,"x",27,
1,W1*3 DIV 2,"Rtrn",68,
nok,S1+W1*3+S1,"",0,
0,W1,"x",61,
0,W1,"x",62,
0,W1,"x",63,
1,W1,"x",74);
keyRow3 = KeyRow3(
1,C1,"Ctrl",99,
1,W1,"Caps",98,
0,W1,"x",32,
0,W1,"x",33,
0,W1,"x",34,
0,W1,"x",35,
0,W1,"x",36,
0,W1,"x",37,
0,W1,"x",38,
0,W1,"x",39,
0,W1,"x",40,
0,W1,"x",41,
0,W1,"x",42,
0,W1,"x",43,
nok,S1+W1*2-C1+S1+W1,"",0,
0,W1,"Up",76,
nok,W1+S1,"",0,
0,W1,"x",45,
0,W1,"x",46,
0,W1,"x",47,
1,W1,"x",94);
keyRow4 = KeyRow4(
1,C1+W1 DIV 2,"Shft",96,
0,W1,"x",48,
0,W1,"x",49,
0,W1,"x",50,
0,W1,"x",51,
0,W1,"x",52,
0,W1,"x",53,
0,W1,"x",54,
0,W1,"x",55,
0,W1,"x",56,
0,W1,"x",57,
0,W1,"x",58,
1,S1+4*W1-C1-W1 DIV 2,"Shft",97,
nok,S1,"",0,
0,W1,"Left",79,
0,W1,"Down",77,
0,W1,"Rght",78,
nok,S1,"",0,
0,W1,"x",29,
0,W1,"x",30,
0,W1,"x",31,
1,W1,"Entr",67);
keyRow5 = KeyRow5(
nok,S2,"",0,
1,W2,"Alt",100,
1,W2,"LAmi",102,
0,W1*9,"Spc",64,
1,W2,"RAmi",103,
1,W2,"Alt",101,
nok,S2+S1*2+W1*3,"",0,
0,W1*2,"x",15,
0,W1,"x",60);
(*---------------------------------------------------------------------*)
TYPE ModData = ARRAY 3,10 OF INTEGER;
CONST
modData = ModData(
00000U,00000U,
00000U,00000U,
00000U,00000U,
00000U,00000U,
00000U,00000U,
060C3U,087C0U,
071CCU,06630U,
07BCCU,06630U,
06ECCU,06630U,
060C3U,087C0U,
0F0F8U,070F0U,
0CCC0U,0D8CCU,
0CCF1U,08CCCU,
0CCC1U,0FCCCU,
0F0F9U,08CF0U);
(*---------------------------------------------------------------------*)
TYPE IntArray5 = ARRAY 5 OF INTEGER;
CONST cycData = IntArray5(
07800U,
0CC00U,
0DE00U,
0CC00U,
06000U);
(*---------------------------------------------------------------------*)
TYPE IntArray136 = ARRAY 136 OF INTEGER;
CONST Pics16Data = IntArray136(
00000U, 03800U, 00800U, 03800U, 03800U, 08400U, 03000U, 03000U,
03000U, 08400U, 0CC00U, 08C00U, 0CC00U, 0CC00U, 0CC00U, 08400U,
07000U, 0C400U, 01C00U, 00000U, 08400U, 03000U, 0E400U, 03000U,
08400U, 0C400U, 0A400U, 06400U, 00000U, 0E400U, 00000U, 03C00U,
00400U, 0F000U, 00400U, 08400U, 03C00U, 00400U, 03000U, 08400U,
00000U, 0F000U, 0E400U, 0CC00U, 09C00U, 08400U, 03000U, 08400U,
03000U, 08400U, 08400U, 03000U, 08000U, 0F000U, 08400U, 0CE74U,
08664U, 03240U, 00264U, 03270U, 08DF8U, 039F8U, 03188U, 03998U,
08C98U, 00FE0U, 02660U, 024A0U, 02460U, 00E20U, 00FF8U, 03CC0U,
01998U, 03C98U, 009C0U, 0F3C0U, 0CCC0U, 01E00U, 0CCC0U, 0C0C0U,
0F080U, 0E080U, 0C880U, 08080U, 03800U, 0F080U, 0E280U, 0CA80U,
08280U, 03800U, 05FF0U, 00000U, 05FF0U, 0FFA0U, 00000U, 0FFA0U,
0FF80U, 0FF80U, 0FF80U, 0FF80U, 0FF80U, 0FF80U, 0FF80U, 0F780U,
0C780U, 00000U, 0C7E0U, 0F7E0U, 00000U, 01000U, 07000U, 00000U,
0F000U, 00000U, 02000U, 0F000U, 09000U, 00000U, 09000U, 0F000U,
00000U, 01000U, 08000U, 0F000U, 00000U, 03000U, 03000U, 0FF9FU,
0FF0FU, 0FF9FU, 08FFFU, 03FFFU, 03C8FU, 03297U, 0888FU, 0FF9FU);
(*---------------------------------------------------------------------*)
TYPE IntArray10 = ARRAY 10 OF INTEGER;
CONST Pics32Data = IntArray10(
027E7U,0C000U,
02664U,04000U,
004A4U,08000U,
02464U,04000U,
02624U,0C000U);
(*---------------------------------------------------------------------*)
TYPE IntArray28 = ARRAY 28 OF INTEGER;
CONST ArrowData = IntArray28(
03000U, 0FF00U, 03000U, 0CF00U, 00000U, 0CF00U,
00C00U, 0FF00U, 00C00U, 0F300U, 00000U, 0F300U,
03000U, 0FC00U, 03000U, 03000U, 0CC00U, 00000U, 0CC00U, 0CC00U,
03000U, 03000U, 0FC00U, 03000U, 0CC00U, 0CC00U, 00000U, 0CC00U);
(*---------------------------------------------------------------------*)
TYPE IntArray36 = ARRAY 36 OF INTEGER;
CONST ZZData = IntArray36(
00000U,00000U,
00400U,007C0U,
00000U,007C0U,
00100U,00380U,
00000U,007E0U,
007C0U,01FF8U,
01FF0U,03FECU,
03FF8U,07FDEU,
03FF8U,07FBEU,
07FFCU,0FF7FU,
07EFCU,0FFFFU,
07FFCU,0FFFFU,
03FF8U,07FFEU,
03FF8U,07FFEU,
01FF0U,03FFCU,
007C0U,01FF8U,
00000U,007E0U,
00000U,00000U);
(*------------------------------------------------------------------------*)
CONST
kmeIconWidth = 202;
kmeIconHeight = 19;
TYPE IntArray494 = ARRAY 2,247 OF INTEGER;
CONST KmeIconData = IntArray494(
(* [0] *)
00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07F9EU,0418FU,081FFU,08007U,0FFFFU,0F9E7U,0FFFFU,0FFFFU,0FFFFU,0F03FU,0CCF9U,0FFFFU,0FFC0U,
07F9CU,0C427U,03CFFU,0F9E7U,0FFFFU,0F9CFU,0FFFFU,0FFFFU,0FFFFU,0E79FU,0CFF9U,0FFFFU,0FFC0U,
07F33U,09CE4U,0FFFFU,0F3C0U,0787FU,0F33EU,01CF0U,033C0U,081FFU,09FF0U,019E0U,07060U,03FC0U,
07F27U,09CE4U,0FFFFU,0F3C7U,0333FU,0F27CU,0CE70U,0019EU,01CFFU,09FE7U,019F3U,0E723U,09FC0U,
07E0FU,039C8U,03C03U,0E79FU,00CFFU,0E0F3U,03E61U,0987CU,03CFFU,0079FU,033E7U,09F0FU,0FFC0U,
07E27U,039C9U,0FFFFU,0E79FU,009FFU,0E272U,07F21U,0987CU,03CFFU,03F9FU,033E7U,09F0FU,0FFC0U,
07CE6U,07393U,0FFFFU,0CF3EU,0073FU,0CE61U,0CF03U,030F8U,079FEU,07F3EU,067CFU,03E1FU,0FFC0U,
07CF2U,07399U,0E7FFU,0CF3EU,04E7FU,0CF33U,09F83U,03270U,073FFU,03C9CU,0E7CFU,09C9FU,0FFC0U,
079F0U,0E738U,01FFFU,09E7CU,0C1FFU,09F30U,06786U,06600U,00FFFU,00383U,0CF9FU,0833FU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0F33FU,0FFFCU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0F0FFU,0FFFDU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
07FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
(* [1] *)
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
0FFEFU,03BDFU,0C3FFU,0C61BU,0FFFFU,0FEF3U,0FFFFU,0FFFFU,0FFFFU,0F87FU,0F67EU,0FFFFU,0FF80U,
0FFCEU,0631BU,09E7FU,0FCFFU,0FFFFU,0FCE7U,0FFFFU,0FFFFU,0FFFFU,0F3CFU,0E7FFU,0FFFFU,0FF80U,
0FFD9U,0EF7BU,07FFFU,0FDF8U,0FCFFU,0FD9FU,03FFFU,0FFE1U,0E3FFU,0EFF8U,0EEFCU,038FCU,07F80U,
0FFF3U,0CE77U,0FFFFU,0F9E3U,0FB9FU,0FF3EU,0E7BEU,067CFU,0CF7FU,0FFF3U,0CCF9U,0F3F1U,0CF80U,
0FFDFU,0DEF6U,01E01U,0FBEFU,0F67FU,0FDFDU,09FFEU,0EFBFU,0DF7FU,0C3EFU,0DDFBU,0EFF7U,0FF80U,
0FF1BU,09CECU,0FFFFU,0F3CFU,0FCFFU,0F1BFU,03FFCU,0CF3FU,09E7FU,09FCFU,099F3U,0CFE7U,0FF80U,
0FF7FU,0BDEFU,0FFFFU,0F7DFU,0B39FU,0F7FCU,0E7FDU,0DDFFU,0BCFFU,0FFFFU,03BF7U,0FF6FU,0FF80U,
0FE7FU,039CFU,0F3FFU,0E79FU,03F3FU,0E7DFU,0DFF9U,099FFU,0F9FFU,0FE7EU,073E7U,0FECFU,0FF80U,
0FCF8U,0739CU,00FFFU,0CF3EU,060FFU,0CF98U,03FC3U,03303U,007FFU,081C1U,0E7CFU,0C19FU,0FF80U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF9FU,0FFFEU,07FFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0F87FU,0FFFEU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF80U,
08000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U,00000U);
(*------------------------------------------------------------------------*)
CONST
kmePicWidth = 190;
kmePicHeight = 11;
TYPE IntArray132 = ARRAY 132 OF INTEGER;
CONST KmePicData = IntArray132(
0F3C8U,031F0U,03FF0U,000FFU,0FFFFU,03CFFU,0FFFFU,0FFFFU,0FFFEU,007F9U,09F3FU,0FFFFU,
0F398U,084E7U,09FFFU,03CFFU,0FFFFU,039FFU,0FFFFU,0FFFFU,0FFFCU,0F3F9U,0FF3FU,0FFFFU,
0E673U,09C9FU,0FFFEU,0780FU,00FFEU,067C3U,09E06U,07810U,03FF3U,0FE03U,03C0EU,00C07U,
0E4F3U,09C9FU,0FFFEU,078E6U,067FEU,04F99U,0CE00U,033C3U,09FF3U,0FCE3U,03E7CU,0E473U,
0C1E7U,03907U,0807CU,0F3E1U,09FFCU,01E67U,0CC33U,00F87U,09FE0U,0F3E6U,07CF3U,0E1FFU,
0C4E7U,0393FU,0FFFCU,0F3E1U,03FFCU,04E4FU,0E433U,00F87U,09FE7U,0F3E6U,07CF3U,0E1FFU,
09CCEU,0727FU,0FFF9U,0E7C0U,0E7F9U,0CC39U,0E066U,01F0FU,03FCFU,0E7CCU,0F9E7U,0C3FFU,
09E4EU,0733CU,0FFF9U,0E7C9U,0CFF9U,0E673U,0F066U,04E0EU,07FE7U,0939CU,0F9F3U,093FFU,
03E1CU,0E703U,0FFF3U,0CF98U,03FF3U,0E60CU,0F0CCU,0C001U,0FFE0U,07079U,0F3F0U,067FFU,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,067FFU,0FF9FU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,
0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,01FFFU,0FFBFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU);
(*------------------------------------------------------------------------*)
PROCEDURE Busy(win: I.WindowPtr);
BEGIN
I.SetPointer(win,zz^,16,16,-6,0);
END Busy;
(*------------------------------------------------------------------------*)
PROCEDURE Iconify (VAR x,y: INTEGER; VAR Image: I.Image);
VAR
nw : I.NewWindow;
win : I.WindowPtr;
msg : I.IntuiMessagePtr;
gad : I.Gadget;
firstClick,endFlag : BOOLEAN;
lastSec,lastMic : LONGINT;
second, micro : LONGINT;
BEGIN
gad := I.Gadget(NIL,0,0,0,0,{I.gRelWidth,I.gRelHeight}+I.gadgHNone,
{I.gadgImmediate},I.wDragging,NIL,NIL,NIL,LONGSET{},NIL,0,NIL);
nw := I.NewWindow(0,0,0,0,0,1,LONGSET{I.gadgetDown},
LONGSET{I.noCareRefresh,I.borderless},NIL,
NIL,NIL,NIL,NIL,0,0,-1,-1,{I.wbenchScreen});
nw.leftEdge:= x; nw.topEdge := y;
nw.width := Image.width; nw.height := Image.height;
nw.firstGadget := sys.ADR(gad);
win := I.OpenWindow(nw);
IF win#NIL THEN
I.DrawImage(win.rPort,Image,0,0);
endFlag := FALSE; firstClick := TRUE;
REPEAT
e.WaitPort(win.userPort);
msg := e.GetMsg(win.userPort) ;
WHILE msg # NIL DO
second := msg.time.secs;
micro := msg.time.micro;
e.ReplyMsg(msg) ;
IF NOT firstClick THEN
endFlag:=I.DoubleClick(lastSec,lastMic,second,micro);
ELSE
firstClick:=FALSE;
END;
msg := e.GetMsg(win.userPort) ;
lastSec:=second; lastMic:=micro;
END;
UNTIL endFlag;
x := win.leftEdge; y := win.topEdge;
I.CloseWindow(win);
END;
END Iconify;
(*------------------------------------------------------------------------*)
PROCEDURE GetIMsg (win: I.WindowPtr;
VAR mes: I.IntuiMessage;
wait: BOOLEAN);
VAR msg : I.IntuiMessagePtr;
waited: BOOLEAN;
BEGIN
waited := NOT wait;
msg := e.GetMsg(win.userPort);
IF (msg = NIL) & wait THEN
e.WaitPort(win.userPort);
msg := e.GetMsg(win.userPort);
waited := TRUE;
END;
IF msg # NIL THEN
LOOP
mes := msg^;
e.ReplyMsg(msg);
IF (mes.class * LONGSET{I.gadgetUp,I.closeWindow,I.rawKey}) = LONGSET{} THEN EXIT END;
msg := e.GetMsg(win.userPort);
IF msg = NIL THEN
IF NOT waited THEN mes.class := LONGSET{} END;
EXIT;
END;
END;
ELSE
mes.class := LONGSET{}
END;
END GetIMsg;
(*------------------------------------------------------------------------*)
PROCEDURE FindGadget(id: INTEGER): I.GadgetPtr;
VAR i: INTEGER;
BEGIN
i := 0;
WHILE i < gadCnt DO
IF gad[i].gadgetID = id THEN RETURN sys.ADR(gad[i]) END;
INC(i);
END;
HALT(0);
END FindGadget;
(*---------------------------------------------------------------------*)
PROCEDURE PutImage(rp : g.RastPortPtr;
x,y,width,height : INTEGER;
data : e.APTR;
mode : INTEGER);
VAR
img: I.Image;
dat: POINTER TO BYTE;
BEGIN
dat := data;
e.CopyMem(dat^,chipBuf^,SIZE(chipBuf^));
img.leftEdge := 6;
img.topEdge := 1;
img.width := width;
img.height := height;
IF mode < 2 THEN
img.depth := 1;
ELSE
img.depth := 2;
END;
img.imageData := chipBuf;
CASE mode OF
| 0:
img.planePick := SHORTSET{0};
img.planeOnOff := SHORTSET{};
| 1:
img.planePick := SHORTSET{1};
img.planeOnOff := SHORTSET{0};
ELSE
img.planePick := SHORTSET{0,1};
img.planeOnOff := SHORTSET{0};
END;
img.nextImage := NIL;
I.DrawImage(rp,img,x,y);
END PutImage;
(*---------------------------------------------------------------------*)
PROCEDURE AsciiToRaw(VAR s1,s2: String);
VAR i,j,l,n,z : INTEGER;
state : INTEGER;
ch : CHAR;
PROCEDURE AddChar(ch: CHAR);
BEGIN
IF j < strLen THEN
s2[j] := ch;
INC(j);
END;
END AddChar;
PROCEDURE Hex2Dez(ch: CHAR; VAR z: INTEGER): BOOLEAN;
BEGIN
IF (ch >= "0") & (ch <= "9") THEN
z := ORD(ch) - ORD("0");
RETURN TRUE;
END;
ch := CAP(ch);
IF (ch >= "A") & (ch <= "F") THEN
z := 10 + (ORD(ch) - ORD("A"));
RETURN TRUE;
END;
RETURN FALSE;
END Hex2Dez;
BEGIN (* AsciiToRaw *)
state := 0;
l := str.Length(s1);
j := 0;
i := 0; WHILE i <= l DO
IF i < l THEN
ch := s1[i]
ELSE
ch := 0X
END;
CASE state OF
| 0:
IF ch = "\\" THEN
state := 1;
ELSE
AddChar(ch);
END;
| 1:
CASE CAP(ch) OF
| "N": AddChar(0AX); state := 0
| "R": AddChar(0DX); state := 0
| "E": AddChar(1BX); state := 0
| "[": AddChar(9BX); state := 0
| "O": AddChar(00X); state := 0
| "T": AddChar(09X); state := 0
| "B": AddChar(08X); state := 0
| "F": AddChar(0CX); state := 0
| "X": state := 2; n := 0;
ELSE
AddChar(ch);
state := 0;
END;
| 2,3:
IF Hex2Dez(ch,z) THEN
n := n * 16 + z;
INC(state);
ELSE
AddChar(CHR(n));
state := 0;
DEC(i);
END;
| 4:
state := 0;
AddChar(CHR(n));
DEC(i);
END;
INC(i) END;
AddChar(0X);
s2[strLen-1] := 0X
END AsciiToRaw;
(*---------------------------------------------------------------------*)
PROCEDURE RawToAscii(VAR s1,s2: String; hex: BOOLEAN);
CONST
hexStr = "0123456789ABCDEF";
VAR
i,j,l : INTEGER;
ch : CHAR;
ctrl : BOOLEAN;
PROCEDURE AddChar(ch: CHAR);
BEGIN
IF j < strLen THEN
s2[j] := ch;
INC(j);
END;
END AddChar;
PROCEDURE AddHex(ch: CHAR);
BEGIN
AddChar(hexStr[ORD(ch) DIV 16]);
AddChar(hexStr[ORD(ch) MOD 16]);
END AddHex;
BEGIN
l := str.Length(s1);
j := 0;
i := 0; WHILE i < l DO
ch := s1[i];
ctrl := ((ORD(ch) MOD 128) < 32) OR hex;
IF ctrl THEN
AddChar("\\");
IF hex THEN
AddChar("x"); AddHex(ch);
ELSE
CASE ch OF
| 0AX: AddChar("n")
| 1BX: AddChar("e")
| 0DX: AddChar("r")
| 09X: AddChar("t")
| 9BX: AddChar("[")
| 08X: AddChar("b")
| 0CX: AddChar("f")
ELSE
AddChar("x"); AddHex(ch);
END;
END;
ELSE
AddChar(ch);
IF ch = "\\" THEN AddChar("\\") END;
END;
INC(i) END;
AddChar(0X);
s2[strLen-1] := 0X
END RawToAscii;
(*---------------------------------------------------------------------*)
PROCEDURE DrawKey(key: Key; x,y: INTEGER);
VAR dummy,height,z : INTEGER;
buf: ARRAY 40 OF CHAR;
iev : ie.InputEventAdr;
num : LONGINT;
BEGIN
g.SetDrMd(rp,g.jam2);
height := keyHeight;
y := Y1+y-11;
INC(x,5);
IF (key.name="Entr") OR (key.name="Rtrn") THEN INC(height,height) END;
g.SetAPen(rp,1); g.SetBPen(rp,1);
g.RectFill(rp,x,y-1,x+key.width-1,y+height-1);
IF key.type = white THEN
g.SetAPen(rp,1); g.SetBPen(rp,2);
ELSE
g.SetAPen(rp,1); g.SetBPen(rp,3);
END;
g.RectFill(rp,x+1,y,x+key.width-2,y+height-2);
IF key.type = white THEN
g.SetAPen(rp,2); g.SetBPen(rp,2);
ELSE
g.SetAPen(rp,3) ; g.SetBPen(rp,3);
END;
g.RectFill(rp,x+5,y,x+key.width-6,y+height-5);
IF key.name="x" THEN
iev.nextEvent := NIL;
iev.class := ie.rawkey;
iev.subClass := ie.null;
iev.code := key.code;
iev.qualifier := {};
iev.addr := NIL;
num := c.RawKeyConvert(sys.ADR(iev),buf,SIZE(buf),NIL);
IF num=1 THEN key.name[0] := CAP(buf[0])
ELSIF num>1 THEN key.name[0] := buf[0]
ELSE IF (key.code#43)&(key.code#48) THEN
key.name := "´"
ELSE
key.name := " "
END;
END;
g.SetAPen(rp,1); g.SetDrMd(rp,g.jam1); g.Move(rp,x+6,y+7);
g.Text(rp,key.name,1);
ELSE
IF key.name="Alt" THEN PutImage(rp,x,y,14,5,sys.ADR(Pics16Data[55]),1);
ELSIF key.name="LAmi" THEN PutImage(rp,x,y,9,5,sys.ADR(Pics16Data[80]),1);
ELSIF key.name="RAmi" THEN PutImage(rp,x,y,9,5,sys.ADR(Pics16Data[85]),1);
ELSIF key.name="Ctrl" THEN PutImage(rp,x,y,15,5,sys.ADR(Pics16Data[60]),1);
ELSIF key.name="Caps" THEN PutImage(rp,x,y-1,13,9,sys.ADR(Pics16Data[127]),1);
ELSIF key.name="Esc" THEN PutImage(rp,x,y,13,5,sys.ADR(Pics16Data[70]),1);
ELSIF key.name="Help" THEN PutImage(rp,x,y,18,5,sys.ADR(Pics32Data[0]),1);
ELSIF key.name="Del" THEN PutImage(rp,x,y,13,5,sys.ADR(Pics16Data[65]),1);
ELSIF key.name="Shft" THEN PutImage(rp,x,y,10,5,sys.ADR(Pics16Data[75]),1);
ELSIF key.name="Rtrn" THEN PutImage(rp,x+6,y+8,11,12,sys.ADR(Pics16Data[96]),1);
ELSIF key.name="Tab" THEN PutImage(rp,x,y,12,6,sys.ADR(Pics16Data[90]),1);
ELSIF key.name="Left" THEN PutImage(rp,x,y,8,3,sys.ADR(ArrowData[0]),2);
ELSIF key.name="Rght" THEN PutImage(rp,x,y,8,3,sys.ADR(ArrowData[6]),2);
ELSIF key.name="Up" THEN PutImage(rp,x,y,6,4,sys.ADR(ArrowData[12]),2);
ELSIF key.name="Down" THEN PutImage(rp,x,y,6,4,sys.ADR(ArrowData[20]),2);
ELSIF key.name="Bs" THEN PutImage(rp,x,y,8,3,sys.ADR(ArrowData[3]),1);
ELSIF key.name="Entr" THEN PutImage(rp,x+2,y,4,19,sys.ADR(Pics16Data[108]),1);
ELSIF key.name[0]="f" THEN
PutImage(rp,x,y,5,5,sys.ADR(Pics16Data[0]),1);
z := ORD(key.name[1]) - ORD("0");
IF z = 0 THEN (* F10 *)
PutImage(rp,x+6,y,6,5,sys.ADR(Pics16Data[10]),1);
PutImage(rp,x+12,y,6,5,sys.ADR(Pics16Data[(z+1)*5]),1);
ELSE (* F1 - F9 *)
PutImage(rp,x+6,y,6,5,sys.ADR(Pics16Data[(z+1)*5]),1);
END;
END;
END;
IF makeGads THEN
gad[gadCnt].leftEdge := x+5;
gad[gadCnt].topEdge := y;
gad[gadCnt].width := key.width-6-5+1;
gad[gadCnt].height := height-5+1;
gad[gadCnt].gadgetType := I.boolGadget;
gad[gadCnt].activation := {I.gadgImmediate,I.toggleSelect};
gad[gadCnt].gadgetID := idKey;
gad[gadCnt].flags := {};
gad[gadCnt].gadgetRender := NIL;
gad[gadCnt].selectRender := NIL;
gad[gadCnt].gadgetText := NIL;
gad[gadCnt].specialInfo := NIL;
gad[gadCnt].mutualExclude := LONGSET{};
gad[gadCnt].nextGadget := NIL;
gad[gadCnt].userData := key.code;
END;
dummy := I.AddGadget(win,gad[gadCnt],-1);
INC(gadCnt);
END DrawKey;
(*---------------------------------------------------------------------*)
PROCEDURE DrawKeyRow(key: ARRAY OF Key; y: INTEGER); (* CopyArrays- *)
VAR i : INTEGER;
x : INTEGER;
BEGIN
x := 36;
i := 0; WHILE i < LEN(key) DO
IF key[i].type # nok THEN DrawKey(key[i],x,y) END;
INC(x,key[i].width);
INC(i) END;
END DrawKeyRow;
(*---------------------------------------------------------------------*)
PROCEDURE DrawBorder (x,y,w,h: INTEGER);
BEGIN
g.SetDrMd(rp,g.jam1);
g.SetAPen(rp,2);
g.Move(rp,x+1,y+h-2); g.Draw(rp,x+1,y); g.Draw(rp,x+w-2,y);
g.Move(rp,x,y); g.Draw(rp,x,y+h-1);
g.SetAPen(rp,1);
g.Move(rp,x+1,y+h-1); g.Draw(rp,x+w-2,y+h-1); g.Draw(rp,x+w-2,y+1);
g.Move(rp,x+w-1,y); g.Draw(rp,x+w-1,y+h-1);
END DrawBorder;
(*---------------------------------------------------------------------*)
PROCEDURE MakeGadget(x,y : INTEGER;
txt : ARRAY OF CHAR;
id : INTEGER); (* $CopyArrays- *)
VAR w,h : INTEGER;
BEGIN
w := SHORT(LEN(txt))*8; h := 12;
IF txt[0] = 0X THEN
w := 46; h := 9;
PutImage(rp,x-3,y+1,7,5,sys.ADR(cycData),0);
ELSE
g.SetDrMd(rp,g.jam1); g.SetAPen(rp,1);
g.Move(rp,x+4,y+8); g.Text(rp,txt,LEN(txt)-1);
END;
DrawBorder(x,y,w,h);
IF makeGads THEN
gad[gadCnt].leftEdge := x;
gad[gadCnt].topEdge := y;
gad[gadCnt].width := w;
gad[gadCnt].height := h;
gad[gadCnt].gadgetType := I.boolGadget;
IF id >= 200 THEN
gad[gadCnt].activation := {I.gadgImmediate,I.toggleSelect};
ELSE
gad[gadCnt].activation := {I.relVerify};
END;
gad[gadCnt].gadgetID := id;
gad[gadCnt].flags := {};
gad[gadCnt].gadgetRender := NIL;
gad[gadCnt].selectRender := NIL;
gad[gadCnt].gadgetText := NIL;
gad[gadCnt].specialInfo := NIL;
gad[gadCnt].mutualExclude := LONGSET{};
gad[gadCnt].nextGadget := NIL;
gad[gadCnt].userData := NIL;
END;
dummy := I.AddGadget(win,gad[gadCnt],-1);
INC(gadCnt);
END MakeGadget;
(*---------------------------------------------------------------------*)
PROCEDURE MakeStrGadget(x,y,w,id:INTEGER);
BEGIN
g.SetAPen(rp,1);
g.Move(rp,x,y+8);
g.Draw(rp,x+w,y+8);
IF makeGads THEN
gad[gadCnt].leftEdge := x;
gad[gadCnt].topEdge := y;
gad[gadCnt].width := w;
gad[gadCnt].height := 8;
gad[gadCnt].gadgetType := I.strGadget;
gad[gadCnt].activation := {I.relVerify,I.gadgImmediate};
gad[gadCnt].gadgetID := id;
gad[gadCnt].flags := {I.tabCycle};
gad[gadCnt].gadgetRender := NIL;
gad[gadCnt].selectRender := NIL;
gad[gadCnt].gadgetText := NIL;
gad[gadCnt].specialInfo := sys.ADR(strInf[strCnt]);
gad[gadCnt].mutualExclude := LONGSET{};
gad[gadCnt].nextGadget := NIL;
gad[gadCnt].userData := NIL;
buffer[strCnt,0] := 0X;
strInf[strCnt].buffer := sys.ADR(buffer[strCnt]);
strInf[strCnt].undoBuffer := sys.ADR(undobf[strCnt]);
strInf[strCnt].maxChars := strLen;
strInf[strCnt].extension := NIL;
END;
dummy := I.AddGadget(win,gad[gadCnt],-1);
INC(gadCnt);
INC(strCnt);
END MakeStrGadget;
(*---------------------------------------------------------------------*)
PROCEDURE NumQual(type: SHORTSET): INTEGER;
VAR n: INTEGER;
deskr: BOOLEAN;
BEGIN
n := 1;
IF km.alt IN type THEN INC(n,n) END;
IF km.shift IN type THEN INC(n,n) END;
IF km.control IN type THEN INC(n,n) END;
IF km.nop IN type THEN n := 0 END;
deskr := (km.string IN type) OR (km.dead IN type);
IF ~deskr & (n > 4) THEN n := 4 END;
RETURN n
END NumQual;
(*---------------------------------------------------------------------*)
PROCEDURE SetModGads;
VAR i: INTEGER; gad: I.GadgetPtr;
BEGIN
i := 0; WHILE i < 8 DO
gad := FindGadget(idMod+i);
PutImage(rp,gad.leftEdge+6,gad.topEdge+1,30,5,sys.ADR(modData[sys.VAL(LONGINT,gad.userData)]),0);
INC(i) END;
END SetModGads;
(*---------------------------------------------------------------------*)
PROCEDURE SetStrGads(type : SHORTSET);
TYPE Tab = ARRAY 8,8 OF SHORTINT;
CONST
tab = Tab (0,0,0,0,0,0,0,0,
0,1,0,0,0,0,0,0,
0,2,0,0,0,0,0,0,
0,1,2,3,0,0,0,0,
0,4,0,0,0,0,0,0,
0,1,4,5,0,0,0,0,
0,2,4,6,0,0,0,0,
0,1,2,3,4,5,6,7);
VAR
i,n : INTEGER;
gad: I.GadgetPtr;
qual : SHORTINT;
qualStr : ARRAY 16 OF CHAR;
PROCEDURE QualString(VAR qualStr : ARRAY OF CHAR; i: INTEGER);
VAR l : INTEGER;
q : SHORTSET;
BEGIN
qualStr := "";
q := sys.VAL(SHORTSET,SHORT(i));
IF km.shift IN q THEN str.Append(qualStr,"SHFT+") END;
IF km.alt IN q THEN str.Append(qualStr,"ALT+") END;
IF km.control IN q THEN str.Append(qualStr,"CTRL+") END;
l := str.Length(qualStr);
IF (l > 0) & (qualStr[l-1] = "+") THEN
str.Delete(qualStr,l-1,1);
END;
END QualString;
BEGIN
g.SetDrMd(rp,g.jam2);
g.SetAPen(rp,1); g.SetBPen(rp,0);
n := NumQual(type);
qual := sys.VAL(SHORTINT,type * SHORTSET{0,1,2});
i := 0; WHILE i < 8 DO
g.Move(rp,255+X2,i*10+112+Y1); g.Text(rp," ",13);
gad := FindGadget(idStr+i);
IF i < n THEN
QualString(qualStr,tab[qual,i]);
g.Move(rp,255+X2+(13-str.Length(qualStr))*8,i*10+112+Y1);
g.Text(rp,qualStr,str.Length(qualStr));
EXCL(gad.flags,I.gadgDisabled);
ELSE
INCL(gad.flags,I.gadgDisabled);
END;
INC(i) END;
I.RefreshGList(FindGadget(idStr),win,NIL,8);
END SetStrGads;
(*---------------------------------------------------------------------*)
PROCEDURE ClearGadgets;
VAR i: INTEGER;
gadget:I.GadgetPtr;
BEGIN
I.RefreshGList(FindGadget(idShift),win,NIL,9);
gadget := FindGadget(idShift); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idAlt); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idControl); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idDownup); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idString); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idDead); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idCapsable); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idRepeatable); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idNop); EXCL(gadget.flags,I.selected);
IF lastKeyGad # NIL THEN
INCL(lastKeyGad.flags,I.selected);
I.RefreshGList(lastKeyGad,win,NIL,1);
EXCL(lastKeyGad.flags,I.selected);
END;
i := 0; WHILE i < 8 DO
buffer[i,0] := 0X;
gadget := FindGadget(idMod+i);
gadget.userData := 0;
INC(i) END;
SetStrGads(SHORTSET{});
SetModGads;
lastKeyGad := NIL;
rawCode := -1;
keyModified := FALSE;
END ClearGadgets;
(*---------------------------------------------------------------------*)
PROCEDURE SetType(type: SHORTSET);
VAR gad : I.GadgetPtr;
PROCEDURE Select(id,flag:INTEGER);
BEGIN
gad := FindGadget(id);
IF flag IN type THEN
INCL(gad.flags,I.selected)
ELSE
EXCL(gad.flags,I.selected)
END;
END Select;
BEGIN
I.RefreshGList(FindGadget(idShift),win,NIL,7);
Select(idShift,km.shift);
Select(idAlt,km.alt);
Select(idControl,km.control);
Select(idNop,km.nop);
Select(idDead,km.dead);
Select(idString,km.string);
Select(idDownup,km.downup);
I.RefreshGList(FindGadget(idShift),win,NIL,7);
END SetType;
(*---------------------------------------------------------------------*)
PROCEDURE GetType(VAR type: SHORTSET);
PROCEDURE Select(id,flag:INTEGER);
VAR gad : I.GadgetPtr;
BEGIN
gad := FindGadget(id);
IF I.selected IN gad.flags THEN INCL(type,flag) END;
END Select;
BEGIN
type := SHORTSET{};
Select(idShift,km.shift);
Select(idAlt,km.alt);
Select(idControl,km.control);
Select(idNop,km.nop);
Select(idDead,km.dead);
Select(idString,km.string);
Select(idDownup,km.downup);
END GetType;
(*---------------------------------------------------------------------*)
PROCEDURE New(VAR adr: e.APTR; size : LONGINT);
BEGIN
IF size <= 0 THEN size := 1 END;
LOOP
ol.New(adr,size);
IF adr # NIL THEN RETURN END;
IF ~rq.Request(kmr,oom,rtry,cncl) THEN HALT(0) END;
END;
END New;
(*---------------------------------------------------------------------*)
PROCEDURE IntToByte(i: INTEGER): BYTE;
BEGIN
rq.Assert((i >= 0) & (i < 256),"Range Error");
(* $RangeChk- *)
RETURN SHORT(i);
(* $RangeChk= *)
END IntToByte;
(*---------------------------------------------------------------------*)
PROCEDURE GetKey(code : INTEGER);
VAR
strDeskr : StrDeskrPtr;
deadDeskr : DeadDeskrPtr;
deadType : SHORTINT;
charPtr : e.STRPTR;
i,len : INTEGER;
gadget : I.GadgetPtr;
type : SHORTSET;
keyInfo : Str4;
code64 : INTEGER;
kmap : KeyMapPtr;
BEGIN
IF (code < 0) OR (keyMap = NIL) THEN RETURN END;
code64 := code MOD 64;
IF code >= 64 THEN
kmap := sys.ADR(keyMap.hiKeyMapTypes)
ELSE
kmap := sys.ADR(keyMap.loKeyMapTypes)
END;
type := kmap.loKeyMapTypes^[code64];
SetType(type);
gadget := FindGadget(idCapsable);
I.RefreshGList(gadget,win,NIL,2);
IF (code64 MOD 8) IN kmap.loCapsable^[code64 DIV 8] THEN
INCL(gadget.flags,I.selected)
ELSE
EXCL(gadget.flags,I.selected)
END;
gadget := FindGadget(idRepeatable);
IF (code64 MOD 8) IN kmap.loRepeatable^[code64 DIV 8] THEN
INCL(gadget.flags,I.selected)
ELSE
EXCL(gadget.flags,I.selected)
END;
gadget := FindGadget(idCapsable);
I.RefreshGList(gadget,win,NIL,2);
SetStrGads(type);
i := 0; WHILE i < 8 DO
gadget := FindGadget(idMod+i);
gadget.userData := 0;
INC(i) END;
IF km.string IN type THEN
strDeskr := sys.VAL(e.APTR,kmap.loKeyMap^[code64]);
i := 0; WHILE i < NumQual(type) DO
charPtr := sys.VAL(e.APTR,sys.VAL(LONGINT,strDeskr) + ORD(sys.VAL(BYTE,strDeskr^[i].offs)));
len := ORD(sys.VAL(BYTE,strDeskr^[i].len));
IF len >= strLen THEN len := strLen - 1 END;
IF len > 0 THEN
e.CopyMem(charPtr^,string,len);
END;
string[len] := 0X;
RawToAscii(string,buffer[i],FALSE);
INC(i) END;
WHILE i < 8 DO
buffer[i,0] := 0X;
INC(i) END;
ELSIF km.dead IN type THEN
deadDeskr := sys.VAL(e.APTR,kmap.loKeyMap^[code64]);
i := 0; WHILE i < NumQual(type) DO
gadget := FindGadget(idMod+i);
deadType := deadDeskr^[i].type;
CASE deadType OF
| 0:
gadget.userData := 0;
string[0] := CHR(deadDeskr^[i].val);
string[1] := 0X;
RawToAscii(string,buffer[i],FALSE);
| 1: (* mod *)
gadget.userData := 1;
charPtr := sys.VAL(e.APTR,sys.VAL(LONGINT,deadDeskr) + ORD(sys.VAL(BYTE,deadDeskr^[i].val)));
len := deadLen;
IF len >= strLen THEN len := strLen - 1 END;
IF len > 0 THEN
e.CopyMem(charPtr^,string,len);
END;
string[len] := 0X;
RawToAscii(string,buffer[i],FALSE);
| 8: (* dead *)
gadget.userData := 2;
string[0] := CHR(deadDeskr^[i].val);
string[1] := 0X;
RawToAscii(string,buffer[i],TRUE);
ELSE
END;
INC(i) END;
WHILE i < 8 DO
buffer[i,0] := 0X;
INC(i) END;
ELSE
keyInfo := sys.VAL(Str4,kmap.loKeyMap^[code64]);
i := 0; WHILE i < NumQual(type) DO
string[0] := keyInfo[3-i];
string[1] := 0X;
RawToAscii(string,buffer[i],FALSE);
INC(i) END;
WHILE i < 8 DO
buffer[i,0] := 0X;
INC(i) END;
END;
SetModGads;
I.RefreshGList(FindGadget(idStr),win,NIL,8);
END GetKey;
(*---------------------------------------------------------------------*)
PROCEDURE SetKey(code: INTEGER);
VAR
strDeskr : StrDeskrPtr;
deadDeskr : DeadDeskrPtr;
deadType : SHORTINT;
charPtr : e.STRPTR;
i,len : INTEGER;
size,offset : INTEGER;
gadget : I.GadgetPtr;
type : SHORTSET;
keyInfo : Str4;
code64 : INTEGER;
kmap : KeyMapPtr;
BEGIN
IF (code < 0) OR (keyMap = NIL) THEN RETURN END;
mapModified := TRUE;
code64 := code MOD 64;
IF code >= 64 THEN
kmap := sys.ADR(keyMap.hiKeyMapTypes)
ELSE
kmap := sys.ADR(keyMap.loKeyMapTypes)
END;
GetType(type);
kmap.loKeyMapTypes^[code64] := type;
gadget := FindGadget(idCapsable);
IF I.selected IN gadget.flags THEN
INCL(kmap.loCapsable^[code64 DIV 8],code64 MOD 8)
ELSE
EXCL(kmap.loCapsable^[code64 DIV 8],code64 MOD 8)
END;
gadget := FindGadget(idRepeatable);
IF I.selected IN gadget.flags THEN
INCL(kmap.loRepeatable^[code64 DIV 8],code64 MOD 8)
ELSE
EXCL(kmap.loRepeatable^[code64 DIV 8],code64 MOD 8)
END;
IF km.string IN type THEN
size := 0;
i := 0; WHILE i < NumQual(type) DO
INC(size,2);
AsciiToRaw(buffer[i],string);
INC(size,str.Length(string));
INC(i) END;
New(strDeskr,size);
offset := NumQual(type) * 2;
i := 0; WHILE i < NumQual(type) DO
AsciiToRaw(buffer[i],string);
charPtr := sys.VAL(e.APTR,sys.VAL(LONGINT,strDeskr) + offset);
len := str.Length(string);
IF len > 0 THEN
e.CopyMem(string,charPtr^,len);
END;
strDeskr^[i].len := IntToByte(len);
strDeskr^[i].offs := IntToByte(offset);
INC(offset,str.Length(string));
INC(i) END;
kmap.loKeyMap^[code64] := sys.VAL(LONGINT,strDeskr);
ELSIF km.dead IN type THEN
size := 0;
i := 0; WHILE i < NumQual(type) DO
gadget := FindGadget(idMod + i);
INC(size,2);
IF sys.VAL(LONGINT,gadget.userData) = 1 THEN
INC(size,deadLen)
END;
INC(i) END;
New(deadDeskr,size);
offset := NumQual(type) * 2;
i := 0; WHILE i < NumQual(type) DO
AsciiToRaw(buffer[i],string);
gadget := FindGadget(idMod + i);
CASE sys.VAL(LONGINT,gadget.userData) OF
| 0:
deadDeskr^[i].type := 0;
deadDeskr^[i].val := sys.VAL(BYTE,string[0]);
| 1:
deadDeskr^[i].type := 1;
deadDeskr^[i].val := IntToByte(offset);
charPtr := sys.VAL(e.APTR,sys.VAL(LONGINT,deadDeskr) + offset);
IF deadLen > 0 THEN
e.CopyMem(string,charPtr^,deadLen);
END;
INC(offset,deadLen);
| 2:
deadDeskr^[i].type := 8;
deadDeskr^[i].val := sys.VAL(BYTE,string[0]);
END;
INC(i) END;
kmap.loKeyMap^[code64] := sys.VAL(LONGINT,deadDeskr);
ELSE
i := 0; WHILE i < NumQual(type) DO
AsciiToRaw(buffer[i],string);
keyInfo[3-i] := string[0];
INC(i) END;
WHILE i < 4 DO
keyInfo[3-i] := 0X;
INC(i) END;
kmap.loKeyMap^[code64] := sys.VAL(LONGINT,keyInfo);
END;
END SetKey;
(*---------------------------------------------------------------------*)
PROCEDURE PushRelo(offs: LONGINT);
BEGIN
reloTab[reloTabPtr] := offs;
INC(reloTabPtr);
END PushRelo;
(*---------------------------------------------------------------------*)
PROCEDURE BaseName(VAR path,name: String);
VAR i,j : INTEGER;
BEGIN
i := str.Length(path);
WHILE (i > 0) & (path[i-1] # ":") & (path[i-1] # "/") DO
DEC(i)
END;
j := 0;
WHILE (i < strLen) & (j < strLen) & (path[i] # 0X) DO
name[j] := path[i];
INC(i); INC(j)
END;
IF j < strLen THEN name[j] := 0X END;
END BaseName;
(*---------------------------------------------------------------------*)
PROCEDURE SaveMap(keyMap: KeyMapPtr; VAR fileName: String);
VAR
i,code : INTEGER;
l,offset : LONGINT;
mapName : String;
kmap : KeyMapPtr;
strDeskr : StrDeskrPtr;
deadDeskr : DeadDeskrPtr;
file : fs.File;
ok : BOOLEAN;
node : e.Node;
size : LONGINT;
type : SHORTSET;
nameOffset : LONGINT;
hunkSize : LONGINT;
zero : SHORTINT;
PROCEDURE Write(dat: ARRAY OF BYTE); (* $CopyArrays- *)
BEGIN
ok := ok & fs.Write(file,dat);
END Write;
PROCEDURE WriteBlock(from: e.APTR; size: LONGINT);
BEGIN
IF ok THEN
IF size > 0 THEN
ok := fs.WriteBlock(file,from,size)
END
END
END WriteBlock;
PROCEDURE GetStrDeskrSize(strDeskr:StrDeskrPtr; type:SHORTSET): LONGINT;
VAR j: INTEGER; size: LONGINT;
BEGIN
size := 0;
j := 0; WHILE j < NumQual(type) DO
INC(size,2);
INC(size,strDeskr^[j].len);
INC(j) END;
RETURN size;
END GetStrDeskrSize;
PROCEDURE GetDeadDeskrSize(deadDeskr:DeadDeskrPtr;type:SHORTSET):LONGINT;
VAR j: INTEGER; size: LONGINT;
BEGIN
size := 0;
j := 0; WHILE j < NumQual(type) DO
INC(size,2);
IF deadDeskr^[j].type = 1 THEN INC(size,deadLen) END;
INC(j) END;
RETURN size;
END GetDeadDeskrSize;
BEGIN
IF keyMap = NIL THEN RETURN END;
ok := TRUE;
BaseName(fileName,mapName);
IF mapName[0] = 0X THEN
IF rq.Request(kmr,csk,"",cncl) THEN END;
RETURN;
END;
IF fs.Exists(fileName) THEN
IF ~rq.Request(kmr,fae,ovw,cncl) THEN
RETURN
END;
END;
IF NOT fs.Open(file,fileName,TRUE) THEN
IF rq.Request(kmr,csk,"",cncl) THEN END;
RETURN;
END;
l := 03F3H;
Write(l);
l := 0;
Write(l);
l := 1;
Write(l);
l := 0;
Write(l);
Write(l);
Write(l);
l := 03E9H;
Write(l);
l := 0;
Write(l);
node := e.Node(NIL,NIL,0,0,NIL);
Write(node);
PushRelo(10);
l := 76; Write(l);
l := 196; Write(l);
l := 46; Write(l);
l := 61; Write(l);
l := 140; Write(l);
l := 452; Write(l);
l := 54; Write(l);
l := 69; Write(l);
PushRelo(14);
PushRelo(18);
PushRelo(22);
PushRelo(26);
PushRelo(30);
PushRelo(34);
PushRelo(38);
PushRelo(42);
WriteBlock(keyMap.loCapsable,8);
WriteBlock(keyMap.hiCapsable,7);
WriteBlock(keyMap.loRepeatable,8);
WriteBlock(keyMap.hiRepeatable,7);
Write(keyMap.loKeyMapTypes^);
Write(keyMap.hiKeyMapTypes^);
offset := 676;
kmap := sys.ADR(keyMap.loKeyMapTypes);
i := 0; WHILE i < 120 DO
IF i = 64 THEN kmap := sys.ADR(keyMap.hiKeyMapTypes) END;
code := i MOD 64;
type := kmap.loKeyMapTypes[code];
IF km.string IN type THEN
PushRelo(i*4+196);
strDeskr := sys.VAL(e.APTR,kmap.loKeyMap[code]);
Write(offset);
size := GetStrDeskrSize(strDeskr,type);
INC(offset,size);
ELSIF km.dead IN type THEN
PushRelo(i*4+196);
deadDeskr := sys.VAL(e.APTR,kmap.loKeyMap[code]);
Write(offset);
size := GetDeadDeskrSize(deadDeskr,type);
INC(offset,size);
ELSE
Write(kmap.loKeyMap^[code]);
END;
INC(i) END;
kmap := sys.ADR(keyMap.loKeyMapTypes);
i := 0; WHILE i < 120 DO
IF i = 64 THEN kmap := sys.ADR(keyMap.hiKeyMapTypes) END;
code := i MOD 64;
type := kmap.loKeyMapTypes^[code];
IF km.string IN type THEN
strDeskr := sys.VAL(e.APTR,kmap.loKeyMap^[code]);
size := GetStrDeskrSize(strDeskr,type);
WriteBlock(strDeskr,size);
ELSIF km.dead IN type THEN
deadDeskr := sys.VAL(e.APTR,kmap.loKeyMap^[code]);
size := GetDeadDeskrSize(deadDeskr,type);
WriteBlock(deadDeskr,size);
END;
INC(i) END;
nameOffset := offset;
size := str.Length(mapName);
WriteBlock(sys.ADR(mapName),size);
zero := 0;
Write(zero);
INC(offset,size+1);
WHILE (offset MOD 4) # 0 DO INC(offset); Write(zero) END;
hunkSize := offset DIV 4;
l := 03ECH; Write(l);
l := reloTabPtr; Write(l);
l := 0; Write(l);
WHILE reloTabPtr > 0 DO
DEC(reloTabPtr);
l := reloTab[reloTabPtr];
Write(l);
END;
l := 0; Write(l);
l := 03F2H; Write(l);
ok := ok & fs.Move(file,5*4);
Write(hunkSize);
ok := ok & fs.Move(file,7*4);
Write(hunkSize);
ok := ok & fs.Move(file,8*4 + 10);
Write(nameOffset);
ok := fs.Close(file) & ok;
IF NOT ok THEN
IF rq.Request(kmr,wer,please,forget) THEN
IF d.DeleteFile(fileName) THEN END;
END;
ELSE
mapModified := FALSE;
END;
END SaveMap;
(*---------------------------------------------------------------------*)
PROCEDURE GetDeadLen;
VAR
code,i,j : INTEGER;
kmap : KeyMapPtr;
deskr : DeadDeskrPtr;
type : SHORTSET;
val : SHORTINT;
offs : INTEGER;
nibble1 : INTEGER;
nibble2 : INTEGER;
maxNibble2 : INTEGER;
maxFaktor : INTEGER;
faktor : INTEGER;
BEGIN
maxNibble2 := 0;
maxFaktor := 0;
i := 0; WHILE i < 120 DO
code := i MOD 64;
IF i >= 64 THEN
kmap := sys.ADR(keyMap.hiKeyMapTypes)
ELSE
kmap := sys.ADR(keyMap.loKeyMapTypes)
END;
type := kmap.loKeyMapTypes^[code];
IF km.dead IN type THEN
deskr := sys.VAL(e.APTR,kmap.loKeyMap^[code]);
j := 0; WHILE j < NumQual(type) DO
IF deskr^[j].type = 8 THEN
val := deskr^[j].val;
nibble1 := sys.LSH(val,-4);
nibble2 := val MOD 16;
IF nibble1 = 0 THEN
IF nibble2 > maxNibble2 THEN maxNibble2 := nibble2 END;
ELSE
faktor := nibble1 * nibble2;
IF faktor > maxFaktor THEN maxFaktor := faktor END;
END;
END;
INC(j) END;
END;
INC(i) END;
deadLen := maxFaktor + maxNibble2 + 1;
IF deadLen < 1 THEN deadLen := 1 END;
IF deadLen > 32 THEN deadLen := 32 END;
END GetDeadLen;
(*---------------------------------------------------------------------*)
PROCEDURE SetUp(firstTime: BOOLEAN);
VAR i: INTEGER; type: SHORTSET;
BEGIN
makeGads := firstTime;
gadCnt := 0;
strCnt := 0;
win := I.OpenWindow(nw); rq.Assert(win # NIL,cow);
rp := win.rPort;
g.SetFont(rp,font);
g.SetAPen(rp,2);
g.RectFill(rp,25,Y1+2,615,104+Y1);
I.DrawImage(rp,kmePic,400,Y1-11+20);
g.SetAfPt(rp,sys.ADR(pat),1);
DrawKeyRow(keyRow0,20);
DrawKeyRow(keyRow1,25+keyHeight);
DrawKeyRow(keyRow2,25+keyHeight*2);
DrawKeyRow(keyRow3,25+keyHeight*3);
DrawKeyRow(keyRow4,25+keyHeight*4);
DrawKeyRow(keyRow5,25+keyHeight*5);
MakeGadget(30+X1 ,108+Y1,"LOAD",idLoad);
MakeGadget(116+X1,108+Y1,"SAVE",idSave);
MakeGadget(202+X1,108+Y1,"ABOUT",idAbout);
MakeGadget(30+X1 ,124+Y1,"SHIFT",idShift);
MakeGadget(116+X1,124+Y1,"ALT",idAlt);
MakeGadget(186+X1,124+Y1,"CONTROL",idControl);
MakeGadget(30+X1 ,140+Y1,"DOWNUP",idDownup);
MakeGadget(98+X1 ,140+Y1,"DEAD",idDead);
MakeGadget(150+X1,140+Y1,"STRING",idString);
MakeGadget(218+X1,140+Y1,"NOP",idNop);
MakeGadget(30+X1 ,156+Y1,"CAPSABLE",idCapsable);
MakeGadget(162+X1,156+Y1,"REPEATABLE",idRepeatable);
MakeGadget(30+X1 ,172+Y1,"QUIT",idQuit);
MakeGadget(108+X1,172+Y1,"ICONIFY",idIconify);
MakeGadget(210+X1,172+Y1,"UNDO",idUndo);
i := 0; WHILE i < 8 DO
MakeStrGadget(370+X2,106+Y1+i*10,192,idStr+i);
INC(i) END;
i := 0; WHILE i < 8 DO
MakeGadget(574,106+Y1+i*10,"",idMod+i);
INC(i) END;
I.RefreshGList(sys.ADR(gad[0]),win,NIL,gadCnt);
IF firstTime THEN
type := SHORTSET{}
ELSE
GetType(type);
END;
SetStrGads(type);
SetModGads;
END SetUp;
(*---------------------------------------------------------------------*)
PROCEDURE Quit;
BEGIN
IF keyModified THEN
SetKey(rawCode);
keyModified := FALSE;
END;
IF ~mapModified OR rq.Request(kmr,quit,please,forget) THEN
HALT(0)
END;
END Quit;
(*---------------------------------------------------------------------*)
BEGIN
IF ver[0]=0X THEN END;
win := NIL; scr := NIL; font := NIL; seg := NIL; con := FALSE;
lastKeyGad := NIL; keyModified := FALSE;
rawCode := -1; reloTabPtr := 0; mapModified := FALSE;
iconX := 350; iconY := 40;
fileName := "DEVS:keymaps/";
INCL(ol.MemReqs,e.chip);
NEW(chipBuf);
NEW(zz);
NEW(kmeIconData);
NEW(kmePicData);
EXCL(ol.MemReqs,e.chip);
rq.Assert((chipBuf # NIL) & (zz # NIL) &
(kmeIconData # NIL) & (kmePicData # NIL),ooc);
e.CopyMem(ZZData,zz^,SIZE(zz^));
e.CopyMem(KmeIconData,kmeIconData^,SIZE(kmeIconData^));
e.CopyMem(KmePicData,kmePicData^,SIZE(kmePicData^));
kmeIcon := I.Image(0,0,kmeIconWidth,kmeIconHeight,2,NIL,SHORTSET{0,1},SHORTSET{},NIL);
kmeIcon.imageData := kmeIconData;
kmePic := I.Image(0,0,kmePicWidth,kmePicHeight,1,NIL,SHORTSET{1},SHORTSET{},NIL);
kmePic.imageData := kmePicData;
i := 32; WHILE i <= 39 DO
hiTypes[i] := SHORTSET{km.nop};
INC(i) END;
dfltKeyMap.loKeyMapTypes := sys.ADR(loTypes);
dfltKeyMap.hiKeyMapTypes := sys.ADR(hiTypes);
dfltKeyMap.loKeyMap := sys.ADR(loMap);
dfltKeyMap.hiKeyMap := sys.ADR(hiMap);
dfltKeyMap.loCapsable := sys.ADR(loCaps);
dfltKeyMap.hiCapsable := sys.ADR(hiCaps);
dfltKeyMap.loRepeatable := sys.ADR(loRepeat);
dfltKeyMap.hiRepeatable := sys.ADR(hiRepeat);
deadLen := 18;
keyMap := sys.ADR(dfltKeyMap);
attr := g.TextAttr(sys.ADR("topaz.font"),8,g.normalFont,SHORTSET{g.romFont});
font := g.OpenFont(attr);
IF font = NIL THEN HALT(0) END;
pat[0] := 05555U;
pat[1] := 0AAAAU;
con := e.OpenDevice(c.consoleName,-1,sys.ADR(ioreq),LONGSET{}) = 0;
IF NOT con THEN HALT(0) ELSE c.base := ioreq.device END;
IF I.int.libNode.version>=36 THEN scr := I.LockPubScreen(NIL)
ELSE scr := I.OpenWorkBench() END;
IF scr=NIL THEN HALT(0) END;
nw := I.NewWindow(0,0,640,189,-1,-1,
LONGSET{I.closeWindow,I.gadgetUp,I.gadgetDown,I.rawKey},
LONGSET{I.windowDepth,I.windowDrag,I.windowClose,I.activate,I.rmbTrap},
NIL,NIL,sys.ADR("KME"),NIL,NIL,0,0,0,0,I.customScreen);
Y1 := scr.wBorTop+scr.font.ySize+1;
INC(nw.height,Y1);
nw.screen := scr;
IF nw.height > scr.height THEN
DEC(Y1,nw.height-scr.height);
nw.height := scr.height;
END;
SetUp(TRUE);
LOOP
GetIMsg(win,mes,TRUE);
IF I.closeWindow IN mes.class THEN
Quit;
ELSIF I.rawKey IN mes.class THEN
IF mes.code < 128 THEN
gadget := FindGadget(idKey);
WHILE (gadget # NIL) &
(gadget.gadgetID = idKey) &
(sys.VAL(LONGINT,gadget.userData) # mes.code) DO
gadget := gadget.nextGadget;
END;
IF sys.VAL(LONGINT,gadget.userData) = mes.code THEN
IF lastKeyGad # NIL THEN
INCL(lastKeyGad.flags,I.selected);
I.RefreshGList(lastKeyGad,win,NIL,1);
EXCL(lastKeyGad.flags,I.selected);
END;
INCL(gadget.flags,I.selected);
I.RefreshGList(gadget,win,NIL,1);
oldCode := rawCode;
lastKeyGad := gadget;
rawCode := SHORT(sys.VAL(LONGINT,gadget.userData));
IF keyModified THEN
SetKey(oldCode);
END;
GetKey(rawCode);
keyModified := FALSE;
END;
END;
ELSIF I.gadgetUp IN mes.class THEN
clickedGad := mes.iAddress;
gadID := clickedGad.gadgetID;
CASE gadID OF
| idQuit:
Quit;
| idLoad:
IF keyModified THEN
SetKey(rawCode);
keyModified := FALSE;
END;
IF ~mapModified OR rq.Request(kmr,load,please,forget) THEN
IF fr.FileReq("Load Keymap:",fileName) THEN
Busy(win);
newSeg := d.LoadSeg(fileName);
I.ClearPointer(win);
IF newSeg # NIL THEN
IF seg # NIL THEN d.UnLoadSeg(seg) END;
seg := newSeg;
keyMap := sys.VAL(e.APTR,sys.VAL(LONGINT,seg)*4+4+SIZE(e.Node));
GetDeadLen;
ClearGadgets;
mapModified := FALSE;
ELSE
IF rq.Request(kmr,clk,"",cncl) THEN END;
END;
END;
END;
| idSave:
IF keyModified THEN
SetKey(rawCode);
keyModified := FALSE;
END;
IF fr.FileReqSave("Save Keymap:",fileName) THEN
Busy(win);
SaveMap(keyMap,fileName);
I.ClearPointer(win);
END;
| idUndo:
IF keyModified THEN
GetKey(rawCode);
keyModified := FALSE;
END;
| idMod .. idMod + 7:
keyModified := TRUE;
clickedGad.userData := sys.VAL(e.APTR,(sys.VAL(LONGINT,clickedGad.userData)+1) MOD 3);
SetModGads;
| idAbout:
IF rq.Request(kme,cprt,"",ok) THEN END;
| idStr..idStr+7:
i := gadID - idStr;
AsciiToRaw(buffer[i],string);
gadget := FindGadget(idMod+i);
RawToAscii(string,buffer[i],sys.VAL(LONGINT,gadget.userData) = 2);
gadget := FindGadget(idStr+i);
I.RefreshGList(gadget,win,NIL,1);
keyModified := TRUE;
| idIconify:
nw.leftEdge := win.leftEdge;
nw.topEdge := win.topEdge;
I.CloseWindow(win); win := NIL;
Iconify(iconX,iconY,kmeIcon);
SetUp(FALSE);
ELSE
END (*CASE*);
ELSIF I.gadgetDown IN mes.class THEN
clickedGad := mes.iAddress;
gadID := clickedGad.gadgetID;
CASE gadID OF
| idStr..idStr+7:
keyModified := TRUE;
| idKey :
IF lastKeyGad # NIL THEN
INCL(lastKeyGad.flags,I.selected);
I.RefreshGList(lastKeyGad,win,NIL,1);
EXCL(lastKeyGad.flags,I.selected);
INCL(clickedGad.flags,I.selected);
END;
oldCode := rawCode;
lastKeyGad := clickedGad;
rawCode := SHORT(sys.VAL(LONGINT,clickedGad.userData));
IF keyModified THEN
SetKey(oldCode);
END;
GetKey(rawCode);
keyModified := FALSE;
| idDead,idString:
keyModified := TRUE;
LOOP
IF I.selected IN clickedGad.flags THEN
gadget := FindGadget(idNop);
IF I.selected IN gadget.flags THEN
I.RefreshGList(clickedGad,win,NIL,1);
EXCL(clickedGad.flags,I.selected);
EXIT;
ELSE
IF gadID = idDead THEN
gadget := FindGadget(idString);
ELSE
gadget := FindGadget(idDead);
END;
IF I.selected IN gadget.flags THEN
I.RefreshGList(gadget,win,NIL,1);
EXCL(gadget.flags,I.selected);
END;
END;
END;
GetType(type);
SetStrGads(type);
EXIT;
END;
| idAlt,idControl,idShift:
keyModified := TRUE;
LOOP
IF I.selected IN clickedGad.flags THEN
gadget := FindGadget(idNop);
IF I.selected IN gadget.flags THEN
I.RefreshGList(clickedGad,win,NIL,1);
EXCL(clickedGad.flags,I.selected);
EXIT;
END;
END;
GetType(type);
SetStrGads(type);
EXIT
END;
| idCapsable,idRepeatable,idDownup:
keyModified := TRUE;
IF I.selected IN clickedGad.flags THEN
gadget := FindGadget(idNop);
IF I.selected IN gadget.flags THEN
I.RefreshGList(clickedGad,win,NIL,1);
EXCL(clickedGad.flags,I.selected);
END;
END;
| idNop:
keyModified := TRUE;
IF I.selected IN clickedGad.flags THEN
I.RefreshGList(FindGadget(idShift),win,NIL,6);
I.RefreshGList(FindGadget(idCapsable),win,NIL,2);
gadget := FindGadget(idShift); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idAlt); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idControl); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idDownup); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idString); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idDead); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idCapsable); EXCL(gadget.flags,I.selected);
gadget := FindGadget(idRepeatable); EXCL(gadget.flags,I.selected);
END;
GetType(type);
SetStrGads(type);
ELSE
END (*CASE*);
END (*IF*)
END (*LOOP*)
CLOSE
IF seg # NIL THEN d.UnLoadSeg(seg) END;
IF win # NIL THEN I.CloseWindow(win) END;
IF (I.int.libNode.version>=36)&(scr#NIL) THEN I.UnlockPubScreen(NIL,scr) END;
IF font # NIL THEN g.CloseFont(font) END;
IF con THEN e.CloseDevice(sys.ADR(ioreq)) END;
END KME.