(*---------------------------------------------------------------------------
  :Program.     KME.mod
  :Contents.    KeyMap-Editor
  :Author.      Christian Stiens
  :Address.     Heustiege 2, W-4710 Lüdinghausen
  :Copyright.   Freeware
  :Language.    Oberon
  :Translator.  A+L Amiga Oberon V2.01
  :History.     V1.0, 15-Jul-91
  :Imports.     Iconify (Steffen Köhler)
---------------------------------------------------------------------------*)

MODULE KME;

  IMPORT

    (* $IF debug *)

    io,NoGuru,ARP,

    (* $END *)

    I  : Intuition,
    d  : Dos,
    fs : FileSystem,
    fr : FileReq,
    g  : Graphics,
    e  : Exec,
    km : KeyMap,
    ic : Iconify,
    ol : OberonLib,
    rq : Requests,
    st : Strings,
    s  : SYSTEM;

  CONST
    kmr  = "KME Request:";
    ok   = " Ok ";
    rtry = "Retry";
    cncl = "Cancel";
    nos  = "";
    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.0";
    cprt = "© 1991 by Christian Stiens";
    please = "Yes, please!";
    forget = "Forget it!";

    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;
    Y1 = 11;

    (* Key.type *)
    white = 0;
    gray  = 1;
    nop   = 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  = POINTER TO KeyMap;

    KeyMap  = STRUCT
      loKeyMapTypes : POINTER TO ARRAY 64 OF SHORTSET;
      loKeyMap      : POINTER TO ARRAY 64 OF LONGINT;
      loCapsable    : POINTER TO ARRAY  8 OF SHORTSET;
      loRepeatable  : POINTER TO ARRAY  8 OF SHORTSET;
      hiKeyMapTypes : POINTER TO ARRAY 56 OF SHORTSET;
      hiKeyMap      : POINTER TO ARRAY 56 OF LONGINT;
      hiCapsable    : POINTER TO ARRAY  7 OF SHORTSET;
      hiRepeatable  : POINTER TO ARRAY  7 OF SHORTSET;
    END;

    String = ARRAY strLen OF CHAR;
    Str4   = ARRAY 4 OF CHAR;

    Key = STRUCT
      type  : SHORTINT;
      width : INTEGER;
      name  : ARRAY 4 OF CHAR;
      code  : SHORTINT;
    END;

    StrDeskr = ARRAY 8 OF STRUCT
      len,offs: SHORTINT;
    END;

    StrDeskrPtr = POINTER TO StrDeskr;

    DeadDeskr = ARRAY 8 OF STRUCT
      type,val: SHORTINT;
    END;

    DeadDeskrPtr = POINTER TO DeadDeskr;


  VAR
    attr        : g.TextAttr;
    nw          : I.NewWindow;
    win         : I.WindowPtr;
    rp          : g.RastPortPtr;
    mes         : I.IntuiMessage;
    font        : g.TextFontPtr;
    msg         : I.IntuiMessagePtr;
    keyMap      : KeyMapPtr;
    gadCnt      : INTEGER;
    strCnt      : INTEGER;
    gad         : ARRAY numGads OF I.Gadget;
    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;
    lastKeyGad  : I.GadgetPtr;
    kmeIcon     : I.Image;
    kmeIconData : POINTER TO ARRAY 360 OF INTEGER;
    iconX,iconY : INTEGER;
    kmePic      : I.Image;
    kmePicData  : 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          : POINTER TO ARRAY (22+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     : 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,
      nop,S1,nos,0,
      1,W2,"f1",80,
      1,W2,"f2",81,
      1,W2,"f3",82,
      1,W2,"f4",83,
      1,W2,"f5",84,
      nop,S1,nos,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,"`",0,
      0,W1,"1",1,
      0,W1,"2",2,
      0,W1,"3",3,
      0,W1,"4",4,
      0,W1,"5",5,
      0,W1,"6",6,
      0,W1,"7",7,
      0,W1,"8",8,
      0,W1,"9",9,
      0,W1,"0",10,
      0,W1,"ß",11,
      0,W1,"'",12,
      0,W1,"\\",13,
      1,W1,"Bs",65,
      nop,S1,nos,0,
      1,W1*3 DIV 2,"Del",70,
      1,W1*3 DIV 2,"Help",95,
      nop,S1,nos,0,
      1,W1,"[",90,
      1,W1,"]",91,
      1,W1,"/",92,
      1,W1,"*",93);

    keyRow2 = KeyRow2(
      1,W1+S1+W1 DIV 2,"Tab",66,
      0,W1,"Q",16,
      0,W1,"W",17,
      0,W1,"E",18,
      0,W1,"R",19,
      0,W1,"T",20,
      0,W1,"Z",21,
      0,W1,"U",22,
      0,W1,"I",23,
      0,W1,"O",24,
      0,W1,"P",25,
      0,W1,"Ü",26,
      0,W1,"+",27,
      1,W1*3 DIV 2,"Rtrn",68,
      nop,S1+W1*3+S1,nos,0,
      0,W1,"7",61,
      0,W1,"8",62,
      0,W1,"9",63,
      1,W1,"-",74);

    keyRow3 = KeyRow3(
      1,C1,"Ctrl",99,
      1,W1,"Caps",98,
      0,W1,"A",32,
      0,W1,"S",33,
      0,W1,"D",34,
      0,W1,"F",35,
      0,W1,"G",36,
      0,W1,"H",37,
      0,W1,"J",38,
      0,W1,"K",39,
      0,W1,"L",40,
      0,W1,"Ö",41,
      0,W1,"Ä",42,
      0,W1,"#",43,
      nop,S1+W1*2-C1+S1+W1,nos,0,
      0,W1,"Up",76,
      nop,W1+S1,nos,0,
      0,W1,"4",45,
      0,W1,"5",46,
      0,W1,"6",47,
      1,W1,"+",94);

    keyRow4 = KeyRow4(
      1,C1+W1 DIV 2,"Shft",96,
      0,W1,"<",48,
      0,W1,"Y",49,
      0,W1,"X",50,
      0,W1,"C",51,
      0,W1,"V",52,
      0,W1,"B",53,
      0,W1,"N",54,
      0,W1,"M",55,
      0,W1,",",56,
      0,W1,".",57,
      0,W1,"-",58,
      1,S1+4*W1-C1-W1 DIV 2,"Shft",97,
      nop,S1,nos,0,
      0,W1,"Left",79,
      0,W1,"Down",77,
      0,W1,"Rght",78,
      nop,S1,nos,0,
      0,W1,"1",29,
      0,W1,"2",30,
      0,W1,"3",31,
      1,W1,"Entr",67);

    keyRow5 = KeyRow5(
      nop,S2,nos,0,
      1,W2,"Alt",100,
      1,W2,"LAmi",102,
      0,W1*9,"Spc",64,
      1,W2,"RAmi",103,
      1,W2,"Alt",101,
      nop,S2+S1*2+W1*3,nos,0,
      0,W1*2,"0",15,
      0,W1,".",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 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 IntArray48 = ARRAY 48 OF INTEGER;

  CONST ZZData = IntArray48(
    00000U,00000U,00600U,00940U,00F40U,030A0U,03FE0U,04010U,
    07FE0U,08010U,07FF0U,09E08U,07FF8U,08404U,0FFF8U,00804U,
    07FFCU,09E02U,07FFCU,080F2U,03FFEU,04020U,07FFCU,08042U,
    03FFCU,040F2U,01FF8U,02004U,007F0U,01808U,001C0U,00630U,
    00700U,008C0U,00FC0U,01020U,00680U,00940U,00000U,006C0U,
    000C0U,00120U,000E0U,00110U,00040U,000A0U,00000U,00000U);

(*------------------------------------------------------------------------*)

  CONST
    kmeIconWidth = 93;
    kmeIconHeight = 30;

  TYPE IntArray360 = ARRAY 360 OF INTEGER;

  CONST KmeIconData = IntArray360(
    0FDFFU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,0F828U,
    0CDFEU,0AAAAU,0AAAAU,0AAAAU,0AAAEU,0C1E8U,
    0FDFFU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,0C1E8U,
    08000U,00000U,00000U,00000U,00000U,00008U,
    0839FU,0FFFFU,0BFFFU,0FF00U,00000U,00008U,
    0839FU,0FFFFU,0BFFFU,0FF00U,00000U,00008U,
    08000U,00000U,00000U,00000U,00000U,00008U,
    083F1U,03448U,01A24U,04CF3U,0FF3FU,0FF08U,
    083E2U,04489U,09122U,040F3U,0FF3FU,0FF08U,
    083F9U,0952AU,050A5U,081F0U,00014U,0AF08U,
    083F8U,01224U,00C08U,013F0U,00008U,05F08U,
    083FCU,06CD1U,02448U,034F0U,0281AU,01F08U,
    083FCU,08912U,02244U,089F0U,00804U,0AF08U,
    083F2U,00B06U,0A912U,03FF0U,0A11AU,01F08U,
    083F1U,02040U,04091U,03FF0U,0CA04U,0AF08U,
    080FFU,0EA24U,01225U,07FC0U,00018U,01F08U,
    080FFU,08000U,00000U,0FFC0U,0000AU,08F08U,
    08000U,00000U,00000U,00000U,00000U,00008U,
    08000U,00000U,00000U,00000U,00000U,00008U,
    08010U,00080U,00400U,00000U,00000U,00028U,
    09FF0U,0FF87U,0FC00U,000FFU,0FFFFU,0FF08U,
    08000U,00000U,00000U,00092U,04924U,09228U,
    08000U,00000U,00000U,000FFU,0FFFFU,0FF08U,
    08080U,04010U,00400U,00092U,04924U,09228U,
    09F8FU,0C3F0U,0FC00U,000FFU,0FFFFU,0FF08U,
    08000U,00000U,00000U,00092U,04924U,09228U,
    08000U,00000U,00000U,000FFU,0FFFFU,0FF08U,
    08010U,00080U,00400U,00092U,04924U,09228U,
    09FF0U,0FF87U,0FC00U,000FFU,0FFFFU,0FF08U,
    0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFF8U,
    00000U,00000U,00000U,00000U,00000U,003C0U,
    03000U,00000U,00000U,00000U,00000U,03A00U,
    00000U,00000U,00000U,00000U,00000U,03A00U,
    01FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
    01FFDU,0EF77U,05FDEU,0EFFFU,0FFFFU,0FFC0U,
    01DEEU,0EEF7U,0FDEEU,0F7FFU,0FFFFU,0FFC0U,
    01FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
    01DCEU,0CBB7U,0E5DBU,0B31DU,0A3FBU,05AC0U,
    01FFDU,0BB76U,06EDDU,0BF6DU,0EFF7U,0E7C0U,
    01CF6U,06AD5U,0AF5AU,07EFFU,0FFEBU,05EC0U,
    01FF7U,0EDDBU,0F3F7U,0EDEFU,0FFF7U,0A7C0U,
    01FBBU,0932EU,0DBB7U,0CBEFU,0D7E5U,0E7C0U,
    01DDBU,076EDU,0DDBBU,076FFU,0F7FBU,05EC0U,
    01EFDU,0F4F9U,056EDU,0DFEFU,05EE5U,0E3C0U,
    01DEEU,0DFBFU,0BF6EU,0DFFFU,035FBU,05EC0U,
    01FB5U,095DBU,0EDDAU,09DBFU,0FFE7U,0E7C0U,
    01F7FU,07FFFU,0FFFFU,073BFU,0FFF5U,07EC0U,
    01FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FFC0U,
    01FF0U,0FF87U,0FC00U,00000U,00000U,00000U,
    01000U,08004U,00000U,00000U,00000U,00000U,
    00000U,00000U,00000U,00000U,00000U,00000U,
    00000U,00000U,00000U,00000U,00000U,00000U,
    01F8FU,0C3F0U,0FC00U,00000U,00000U,00000U,
    01008U,00200U,08000U,00000U,00000U,00000U,
    00000U,00000U,00000U,00000U,00000U,00000U,
    00000U,00000U,00000U,00000U,00000U,00000U,
    01FF0U,0FF87U,0FC00U,00000U,00000U,00000U,
    01000U,08004U,00000U,00000U,00000U,00000U,
    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^,22,16,-7,-8);
  END Busy;

(*------------------------------------------------------------------------*)

  PROCEDURE FindGadget(id: INTEGER): I.GadgetPtr;
    VAR i: INTEGER;
  BEGIN
    i := 0;
    WHILE i < gadCnt DO
      IF gad[i].gadgetID = id THEN RETURN s.ADR(gad[i]) END;
      INC(i);
    END;
    (* $IF debug *)
    io.WriteString("'FindGadget' failed\n");
    (* $END *)
    HALT(0);
  END FindGadget;

(*---------------------------------------------------------------------*)

  PROCEDURE PutImage(rp               : g.RastPortPtr;
                     x,y,width,height : INTEGER;
                     data             : e.ADDRESS;
                     mode             : INTEGER);
    VAR
      img: I.Image;
      dat: g.PLANEPTR;

  BEGIN
    dat := data;
    e.CopyMem(dat^,chipBuf^,s.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 := st.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 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 := st.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;
  BEGIN
    g.SetDrMd(rp,g.jam2);
    height := keyHeight;
    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 st.Length(key.name) = 1 THEN
      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,s.ADR(Pics16Data[55]),1);
      ELSIF key.name="LAmi" THEN PutImage(rp,x,y,9,5,s.ADR(Pics16Data[80]),1);
      ELSIF key.name="RAmi" THEN PutImage(rp,x,y,9,5,s.ADR(Pics16Data[85]),1);
      ELSIF key.name="Ctrl" THEN PutImage(rp,x,y,15,5,s.ADR(Pics16Data[60]),1);
      ELSIF key.name="Caps" THEN PutImage(rp,x,y-1,13,9,s.ADR(Pics16Data[127]),1);
      ELSIF key.name="Esc"  THEN PutImage(rp,x,y,13,5,s.ADR(Pics16Data[70]),1);
      ELSIF key.name="Help" THEN PutImage(rp,x,y,18,5,s.ADR(Pics32Data[0]),1);
      ELSIF key.name="Del"  THEN PutImage(rp,x,y,13,5,s.ADR(Pics16Data[65]),1);
      ELSIF key.name="Shft" THEN PutImage(rp,x,y,10,5,s.ADR(Pics16Data[75]),1);
      ELSIF key.name="Rtrn" THEN PutImage(rp,x+6,y+8,11,12,s.ADR(Pics16Data[96]),1);
      ELSIF key.name="Tab"  THEN PutImage(rp,x,y,12,6,s.ADR(Pics16Data[90]),1);
      ELSIF key.name="Left" THEN PutImage(rp,x,y,8,3,s.ADR(ArrowData[0]),2);
      ELSIF key.name="Rght" THEN PutImage(rp,x,y,8,3,s.ADR(ArrowData[6]),2);
      ELSIF key.name="Up"   THEN PutImage(rp,x,y,6,4,s.ADR(ArrowData[12]),2);
      ELSIF key.name="Down" THEN PutImage(rp,x,y,6,4,s.ADR(ArrowData[20]),2);
      ELSIF key.name="Bs"   THEN PutImage(rp,x,y,8,3,s.ADR(ArrowData[3]),1);
      ELSIF key.name="Entr" THEN PutImage(rp,x+2,y,4,19,s.ADR(Pics16Data[108]),1);
      ELSIF key.name[0]="f" THEN
        PutImage(rp,x,y,5,5,s.ADR(Pics16Data[0]),1);
        z := ORD(key.name[1]) - ORD("0");
        IF z = 0 THEN (* F10 *)
          PutImage(rp,x+6,y,6,5,s.ADR(Pics16Data[10]),1);
          PutImage(rp,x+12,y,6,5,s.ADR(Pics16Data[(z+1)*5]),1);
        ELSE          (* F1 - F9 *)
          PutImage(rp,x+6,y,6,5,s.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.relVerify,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 # nop THEN DrawKey(key[i],x,y) END;
      INC(x,key[i].width);
    INC(i) END;
  END DrawKeyRow;

(*---------------------------------------------------------------------*)

  PROCEDURE MakeGadget(x,y : INTEGER;
                       txt : ARRAY OF CHAR;
                       id  : INTEGER);       (* $CopyArrays- *)
    VAR
      w,h : INTEGER;

  BEGIN
    w := LEN(txt)*8; h := 12;
    IF txt[0] = 0X THEN w := 40; h := 9 END;
    g.SetDrMd(rp,g.jam1); g.SetAPen(rp,1);
    g.Move(rp,x+4,y+8); g.Text(rp,txt,LEN(txt)-1);
    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);
    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.relVerify,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

      buffer[strCnt,0] := 0X;

      strInf[strCnt].buffer := s.ADR(buffer[strCnt]);
      strInf[strCnt].undoBuffer := s.ADR(undobf[strCnt]);
      strInf[strCnt].maxChars := strLen;

      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};
      gad[gadCnt].gadgetID := id;
      gad[gadCnt].flags := {};
      gad[gadCnt].gadgetRender := NIL;
      gad[gadCnt].selectRender := NIL;
      gad[gadCnt].gadgetText := NIL;
      gad[gadCnt].specialInfo := s.ADR(strInf[strCnt]);
      gad[gadCnt].mutualExclude := LONGSET{};
      gad[gadCnt].nextGadget := NIL;
      gad[gadCnt].userData := 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-1,gad.topEdge+1,30,5,s.ADR(modData[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 := nos;
      q := s.VAL(SHORTSET,SHORT(i));
      IF km.shift   IN q THEN st.Append(qualStr,"SHFT+") END;
      IF km.alt     IN q THEN st.Append(qualStr,"ALT+") END;
      IF km.control IN q THEN st.Append(qualStr,"CTRL+") END;
      l := st.Length(qualStr);
      IF (l > 0) & (qualStr[l-1] = "+") THEN
        st.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 := s.VAL(SHORTINT,type * SHORTSET{0,1,2});
    i := 0; WHILE i < 8 DO
      g.Move(rp,265+X2,i*10+113+Y1); g.Text(rp,"             ",13);
      gad := FindGadget(idStr+i);
      IF i < n THEN
        QualString(qualStr,tab[qual,i]);
        g.Move(rp,265+X2+(13-st.Length(qualStr))*8,i*10+113+Y1);
        g.Text(rp,qualStr,st.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(idNop);     EXCL(gadget.flags,I.selected);
    gadget := FindGadget(idCapsable);   EXCL(gadget.flags,I.selected);
    gadget := FindGadget(idRepeatable); 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);

    PROCEDURE Select(id,flag:INTEGER);
      VAR gad : I.GadgetPtr;
    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.ADDRESS; 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 := s.ADR(keyMap.hiKeyMapTypes)
    ELSE
      kmap := s.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 := kmap.loKeyMap^[code64];
      i := 0; WHILE i < NumQual(type) DO
        charPtr := s.VAL(LONGINT,strDeskr) + ORD(s.VAL(BYTE,strDeskr^[i].offs));
        len := ORD(s.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 := 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 := s.VAL(LONGINT,deadDeskr) + ORD(s.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 := s.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 := s.ADR(keyMap.hiKeyMapTypes)
    ELSE
      kmap := s.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,st.Length(string));
      INC(i) END;

      New(strDeskr,size);

      offset := NumQual(type) * 2;
      i := 0; WHILE i < NumQual(type) DO
        AsciiToRaw(buffer[i],string);
        charPtr := s.VAL(LONGINT,strDeskr) + offset;
        len := st.Length(string);
        IF len > 0 THEN
          e.CopyMem(string,charPtr^,len);
        END;
        strDeskr^[i].len := IntToByte(len);
        strDeskr^[i].offs := IntToByte(offset);
        INC(offset,st.Length(string));
      INC(i) END;

      kmap.loKeyMap^[code64] := strDeskr;

    ELSIF km.dead IN type THEN

      size := 0;
      i := 0; WHILE i < NumQual(type) DO
        gadget := FindGadget(idMod + i);
        INC(size,2);
        IF 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 gadget.userData OF
        | 0:
          deadDeskr^[i].type := 0;
          deadDeskr^[i].val := s.VAL(BYTE,string[0]);

        | 1:
          deadDeskr^[i].type := 1;
          deadDeskr^[i].val := IntToByte(offset);
          charPtr := s.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 := s.VAL(BYTE,string[0]);
        END;

      INC(i) END;

      kmap.loKeyMap^[code64] := 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] := s.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 := st.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,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,nos,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,nos,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 := s.ADR(keyMap.loKeyMapTypes);
    i := 0; WHILE i < 120 DO
      IF i = 64 THEN kmap := s.ADR(keyMap.hiKeyMapTypes) END;
      code := i MOD 64;
      type := kmap.loKeyMapTypes[code];
      IF km.string IN type THEN
        PushRelo(i*4+196);
        strDeskr := kmap.loKeyMap[code];
        Write(offset);
        size := GetStrDeskrSize(strDeskr,type);
        INC(offset,size);
      ELSIF km.dead IN type THEN
        PushRelo(i*4+196);
        deadDeskr := kmap.loKeyMap[code];
        Write(offset);
        size := GetDeadDeskrSize(deadDeskr,type);
        INC(offset,size);
      ELSE
        Write(kmap.loKeyMap^[code]);
      END;
    INC(i) END;

    kmap := s.ADR(keyMap.loKeyMapTypes);
    i := 0; WHILE i < 120 DO
      IF i = 64 THEN kmap := s.ADR(keyMap.hiKeyMapTypes) END;
      code := i MOD 64;
      type := kmap.loKeyMapTypes^[code];
      IF km.string IN type THEN
        strDeskr := kmap.loKeyMap^[code];
        size := GetStrDeskrSize(strDeskr,type);
        WriteBlock(strDeskr,size);
      ELSIF km.dead IN type THEN
        deadDeskr := kmap.loKeyMap^[code];
        size := GetDeadDeskrSize(deadDeskr,type);
        WriteBlock(deadDeskr,size);
      END;
    INC(i) END;

    nameOffset := offset;
    size := st.Length(mapName);
    WriteBlock(s.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 := s.ADR(keyMap.hiKeyMapTypes)
      ELSE
        kmap := s.ADR(keyMap.loKeyMapTypes)
      END;
      type := kmap.loKeyMapTypes^[code];
      IF km.dead IN type THEN
        deskr := kmap.loKeyMap^[code];
        j := 0; WHILE j < NumQual(type) DO
          IF deskr^[j].type = 8 THEN
            val := deskr^[j].val;
            nibble1 := s.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;
    (* $IF debug *)
    IF ARP.FPrintf(io.out,"DeadLen = %ld.\n",deadLen) = 0 THEN END;
    (* $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,20,Y1,610,105+Y1);
    I.DrawImage(rp,kmePic,400,20);
    g.SetAfPt(rp,s.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 ,110+Y1,"LOAD",idLoad);
    MakeGadget(116+X1,110+Y1,"SAVE",idSave);
    MakeGadget(202+X1,110+Y1,"ABOUT",idAbout);
    MakeGadget(30+X1 ,126+Y1,"SHIFT",idShift);
    MakeGadget(116+X1,126+Y1,"ALT",idAlt);
    MakeGadget(186+X1,126+Y1,"CONTROL",idControl);
    MakeGadget(30+X1 ,142+Y1,"DOWNUP",idDownup);
    MakeGadget(98+X1 ,142+Y1,"DEAD",idDead);
    MakeGadget(150+X1,142+Y1,"STRING",idString);
    MakeGadget(218+X1,142+Y1,"NOP",idNop);
    MakeGadget(30+X1 ,158+Y1,"CAPSABLE",idCapsable);
    MakeGadget(162+X1,158+Y1,"REPEATABLE",idRepeatable);
    MakeGadget(30+X1 ,174+Y1,"QUIT",idQuit);
    MakeGadget(108+X1,174+Y1,"ICONIFY",idIconify);
    MakeGadget(210+X1,174+Y1,"UNDO",idUndo);

    i := 0; WHILE i < 8 DO
      MakeStrGadget(380+X2,107+Y1+i*10,192,idStr+i);
    INC(i) END;

    i := 0; WHILE i < 8 DO
      MakeGadget(580,107+Y1+i*10,nos,idMod+i);
    INC(i) END;

    I.RefreshGList(s.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

  win := NIL; font := NIL; seg := NIL;
  lastKeyGad := NIL; keyModified := FALSE;
  rawCode := -1; reloTabPtr := 0; mapModified := FALSE;
  iconX := 50; iconY := 50;
  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^,s.SIZE(zz^));
  e.CopyMem(KmeIconData,kmeIconData^,s.SIZE(kmeIconData^));
  e.CopyMem(KmePicData,kmePicData^,s.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 := s.ADR(loTypes);
  dfltKeyMap.hiKeyMapTypes := s.ADR(hiTypes);
  dfltKeyMap.loKeyMap := s.ADR(loMap);
  dfltKeyMap.hiKeyMap := s.ADR(hiMap);
  dfltKeyMap.loCapsable := s.ADR(loCaps);
  dfltKeyMap.hiCapsable := s.ADR(hiCaps);
  dfltKeyMap.loRepeatable := s.ADR(loRepeat);
  dfltKeyMap.hiRepeatable := s.ADR(hiRepeat);
  deadLen := 18;

  keyMap := s.ADR(dfltKeyMap);

  attr := g.TextAttr(s.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;

  nw := I.NewWindow(0,0,640,200,-1,-1,
                    LONGSET{I.closeWindow,I.gadgetUp,I.rawKey},
                    LONGSET{I.windowDepth,I.windowDrag,I.windowClose,I.activate},
                    NIL,NIL, s.ADR("KME"),NIL,NIL,90,40,-1,-1,{I.wbenchScreen});


  SetUp(TRUE);

  LOOP
    e.WaitPort(win.userPort);
    REPEAT
      msg := e.GetMsg(win.userPort);
    UNTIL msg # NIL;
    mes := msg^;
    e.ReplyMsg(msg);

    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)    &
              (gadget.userData # mes.code)   DO
          gadget := gadget.nextGadget;
        END;
        IF 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(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;

      | 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(clickedGad.userData);
        IF keyModified THEN
          SetKey(oldCode);
        END;
        GetKey(rawCode);
        keyModified := FALSE;

      | 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;
              dummy := seg;
              keyMap := dummy + 4 + s.SIZE(e.Node);
              GetDeadLen;
              ClearGadgets;
              mapModified := FALSE;
            ELSE
              IF rq.Request(kmr,clk,nos,cncl) THEN END;
            END;
          END;
        END;

      | idSave:
        IF keyModified THEN
          SetKey(rawCode);
          keyModified := FALSE;
        END;
        IF fr.FileReq("Save keymap:",fileName) THEN
          Busy(win);
          SaveMap(keyMap,fileName);
          I.ClearPointer(win);
        END;

      | idUndo:
        IF keyModified THEN
          GetKey(rawCode);
          keyModified := FALSE;
        END;

      | 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);

      | idMod .. idMod + 7:
        keyModified := TRUE;
        clickedGad.userData := (SHORT(clickedGad.userData) + 1) MOD 3;
        SetModGads;

      | idAbout:
        IF rq.Request(kme,cprt,nos,ok) THEN END;

      | idStr..idStr+7:
        i := gadID - idStr;
        AsciiToRaw(buffer[i],string);
        gadget := FindGadget(idMod+i);
        RawToAscii(string,buffer[i],gadget.userData = 2);
        I.RefreshGList(FindGadget(idStr+i),win,NIL,1);
        keyModified := TRUE;

      | idIconify:
        nw.leftEdge := win.leftEdge;
        nw.topEdge  := win.topEdge;
        I.CloseWindow(win); win := NIL;
        ic.Iconify(iconX,iconY,s.ADR(kmeIcon));
        SetUp(FALSE);

      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 font # NIL THEN g.CloseFont(font) END;

END KME.