(*---------------------------------------------------------------------------
    :Program.    HotProg.mod
    :Contents.   Controll Your System, anywhere you are
    :Author.     Christian Ueberall
    :Address.    Urbanstr.171, 7300 Eßlingen West-Germany,
    :Phone.      0711/318310
    :Version     V1.0
    :Date        22.2.1990
    :Copyright.  PD
    :Language.   Modula-2
    :Translator. M2Amiga V3.2d
    :Imports.    HotKey    from Bernd Preusing      {AMOK #21}
    :Imports.    TurboFiles from Stefan Salewski    {AMOK #24}
    :Imports.    Process from Markus Peuckert       {AMOK #31}
    :Imports.    ARP library  from Fridtjof Siebert {AMOK #14}
    :Remarx      Thanx to all this guys above for their helpfull Modules
---------------------------------------------------------------------------*)

MODULE HotProg;
FROM SYSTEM  IMPORT ADR,ADDRESS;
FROM Exec    IMPORT GetMsg,ReplyMsg,WaitPort,MemReqs,MemReqSet;
FROM ARP     IMPORT Execute,ArpAllocMem,FileRequest, FileRequester, FileName,
                    DirName,FileReqFlags,FileReqFlagSet,ArpOpen,ProcessCtrlBlk,
                    PCBFlagSet,PCBFlags,Delay,Lock,CurrentDir,UnLock,TackOn;
FROM HotKey  IMPORT InstallKey;
FROM Str     IMPORT Length;
FROM Arts    IMPORT Assert;
FROM UserLib IMPORT GetComplementColors;
FROM Dos     IMPORT FileHandlePtr,ProcessPtr;
FROM Process IMPORT CreateFuncProcess;
FROM Intuition IMPORT IntuitionBase,IntuitionBasePtr,WindowPtr,ScreenPtr,
                   Window,OpenWindow,NewWindow,CloseWindow,OpenIntuition,
                   IDCMPFlagSet,WindowFlagSet,WindowFlags,customScreen,
                   IntuiMessage,IDCMPFlags,selectUp,WBenchToFront;
FROM InputEvent  IMPORT    Qualifiers, QualifierSet;
FROM Graphics    IMPORT Text,Move,jam2,jam1,DrawModeSet,DrawModes,SetDrMd,
                   SetAPen,SetBPen,ViewModes,ViewPort,RectFill;
FROM TurboFiles  IMPORT Lookup,CloseFile,TurboResult,File,FilePtr,ReadOnly,
                   TurboRead,TurboFileLength;
FROM Arguments   IMPORT NumArgs,GetArg;

TYPE String = ARRAY [0..79] OF CHAR;

CONST   bufferSize = 1024;
        topOffset  = 10;
        leftOffset = 0;
        rightOffset= 0;
        charWidth  = 8;
        height     = 9;

VAR menuName,filePath,
    initialMsg      : ARRAY [0..79] OF String;
    path,command    :  String;
    wbFlag          : ARRAY [0..59] OF BOOLEAN;
    filePtr         : FilePtr;
    result          : TurboResult;
    ok,config       : BOOLEAN;
    hotKey          : CARDINAL;
    qualifier       : QualifierSet;
    msgWindow       : NewWindow;
    msgWindowPtr    : WindowPtr;
    intuiBasePtr    : IntuitionBasePtr;
    activeScreenPtr : ScreenPtr;
    viewPort        : ViewPort;
    intuiMsgPtr     : POINTER TO IntuiMessage;
    class           : IDCMPFlagSet;
    msgCode            : CARDINAL;
    ProcPtr         : ProcessPtr;
    entries,
    maxLength,len,
    lines,mouseX,
    mouseY,
    myWindowWidth,
    myWindowHeight,
    i,msgLength,
    actualLength,
    interlace,hiRes : INTEGER;
    fileRequester   : FileRequester;
    fName           : FileName;
    dName           : DirName;
    configFile      : String;

PROCEDURE ReadConfig(configFile : ARRAY OF CHAR);

VAR wert        : ARRAY [0..14] OF CHAR;
    variable    : ARRAY [0..10] OF CHAR;
    len,actual  : LONGINT;
    buffer      : ADDRESS;
    charPtr     : POINTER TO CHAR;
    i           : INTEGER;
    trennung    : CHAR;
    configFile0,
    configFile1 : String;


PROCEDURE ReadVar();

BEGIN
    INC(charPtr);
    DEC(len);
    i := 0;
    WHILE (charPtr^#"=") AND (i<SIZE(variable)) DO
        variable[i] := charPtr^;
        INC(charPtr);
        DEC(len);
        INC(i);
    END;
    variable[i] := 0C;
    INC(charPtr);
    DEC(len);
    i := 0;
    WHILE (charPtr^#12C) DO
        wert[i]    := charPtr^;
        INC(i);
        INC(charPtr);
        DEC(len);
    END;
    wert[i] := 0C;
    CASE CAP(variable[0]) OF
        "T"    :
        trennung := wert[0];|
        "H" :
            CASE (CAP(wert[0])) OF
                "^"    :
                    hotKey := (ORD(wert[1])-48)*10+ORD(wert[2])-48;|
                "#"    :
                    hotKey := (ORD(wert[1])-48)*10+ORD(wert[2])-48;|
                "F"    :
                    hotKey := ORD(wert[1])+31;
                    IF ((hotKey < 80) OR (hotKey > 88)) THEN
                        hotKey := 89;
                    END;|
                "E" :
                    hotKey := 69;|
                "S" :
                    hotKey := 64;|
                "H"    :
                    hotKey := 95;|
                "L" :
                    CASE (CAP(wert[1])) OF
                        "C" :
                            hotKey := 102;|
                        "S" :
                            hotKey := 96;|
                        "A" :
                            hotKey := 100;|
                    ELSE
                        hotKey := 69;
                    END;|
                "R" :
                    CASE (CAP(wert[1])) OF
                        "C" :
                            hotKey := 103;|
                        "S" :
                            hotKey := 97;|
                        "A" :
                            hotKey := 101;|
                    ELSE
                        hotKey := 69;
                    END;|
                "C" :
                    hotKey := 99;|
            ELSE
                hotKey := 69;        (* DEFAULT HOTKEY ESC *)
            END;|
        "Q" :
            CASE CAP(wert[0]) OF
                "C" :
                    CASE CAP(wert[1]) OF
                        "O" :
                            qualifier := QualifierSet{control};|
                        "A" :
                            qualifier := QualifierSet{capsLock};|
                    ELSE
                        qualifier := QualifierSet{lAlt};
                    END;|
                "L" :
                    CASE CAP(wert[1]) OF
                        "S" :
                            qualifier := QualifierSet{lShift};|
                        "C" :
                            qualifier := QualifierSet{lCommand};|
                        "E" :
                            qualifier := QualifierSet{leftButton};|
                        "A" :
                            qualifier := QualifierSet{lAlt};|
                    ELSE
                        qualifier := QualifierSet{lAlt};
                    END;|
                "R" :
                    CASE CAP(wert[1]) OF
                        "S" :
                            qualifier := QualifierSet{rShift};|
                        "C" :
                            qualifier := QualifierSet{rCommand};|
                        "I" :
                            qualifier := QualifierSet{rightButton};|
                        "E" :
                            qualifier := QualifierSet{relativeMouse};|
                        "A" :
                            qualifier := QualifierSet{rAlt};|
                    ELSE
                        qualifier := QualifierSet{lAlt};
                    END;|
            ELSE
                qualifier := QualifierSet{lAlt};
            END;|
        ELSE
            qualifier := QualifierSet{lAlt};    (* default leftALT *)
            hotKey    := 69;                        (* default ESC *)
        END;
END ReadVar;

BEGIN
    entries := 0;
    lines   := 0;
    configFile0 := "HotProg.config";
    configFile1 := "SYS:s/HotProg.config";

    IF Length(configFile) = 0 THEN
        result := Lookup(filePtr,configFile0,bufferSize,ReadOnly);
        IF (result#done) THEN
            result := Lookup(filePtr,configFile1,bufferSize,ReadOnly);
        END;
    ELSE
        result := Lookup(filePtr,configFile,bufferSize,ReadOnly);
    END;

    IF (result=done) THEN                        (* ConfigFile vorhanden *)
        len    := TurboFileLength(filePtr);
        buffer := ArpAllocMem(len,MemReqSet{fast});
        IF (buffer#NIL) THEN                     (* genug Speicher *)
            TurboRead(filePtr,buffer,len,actual);
            CloseFile(filePtr);
            charPtr := buffer;
            WHILE (len > 0) DO
                IF (charPtr^="@") THEN            (* Kommentare überspringen *)
                    WHILE (charPtr^#12C) DO
                        INC(charPtr);
                        DEC(len);
                    END;
                ELSIF (charPtr^="%") THEN         (* Initial Message *)
                    INC(charPtr);
                    DEC(len);
                    i    := 0;
                    WHILE (charPtr^#12C) DO
                        initialMsg[lines][i] := charPtr^;
                        actualLength := i;
                        IF (actualLength > msgLength) THEN
                            msgLength := actualLength;
                        END;
                        INC(charPtr);
                        DEC(len);
                        INC(i);
                    END;
                    INC(lines);
                ELSIF (charPtr^="§") THEN
                    ReadVar(); (* HotKey,Quali und TrennChar einlesen *)
                ELSE
                    WHILE (charPtr^#12C) DO
                        i := 0;
                        WHILE (charPtr^#trennung) DO    (* menuName einlesen *)
                            menuName[entries][i] := charPtr^;
                            INC(charPtr);
                            Assert(charPtr^#12C,ADR("fehlende Trennung in config"));
                            DEC(len);
                            INC(i);
                            Assert(i < SIZE(menuName[entries]),ADR("menuName zu lang")) ;
                            actualLength := i;
                            IF (actualLength > maxLength) THEN
                                maxLength := actualLength;
                            END;
                        END;
                        menuName[entries][i] := 0C;
                        INC(charPtr);
                        DEC(len);
                        i    := 0;
                        WHILE (charPtr^#trennung) DO    (* MenuPfad einilesen *)
                            filePath[entries][i] := charPtr^;
                            INC(charPtr);
                            Assert(charPtr^#12C,ADR("fehlende Trennung in config"));
                            DEC(len);
                            INC(i);
                            Assert(i < SIZE(filePath[entries]),ADR("filePfad zu lang")) ;
                        END;
                        filePath[entries][i] := 0C;
                        INC(charPtr);
                        DEC(len);
                        IF CAP(charPtr^)="T" THEN        (* WBenchToFront ? *)
                            wbFlag[entries] := TRUE;
                        ELSE
                            wbFlag[entries] := FALSE;
                        END;
                        WHILE (charPtr^#trennung) AND (charPtr^#12C) DO
                            INC(charPtr);
                            IF (charPtr^=12C) THEN
                                DEC(charPtr);
                                charPtr^ :=trennung;
                            ELSE
                                DEC(len);
                            END;
                        END;
                        INC(charPtr);
                        DEC(len);
                        INC(entries);
                    END;
                    INC(charPtr);
                    DEC(len);
                END;
            END;
        END;
        config := TRUE;
    ELSE
        initialMsg[0] := "Habe leider kein File    ";
        initialMsg[1] := "s:HotProg.config gefunden";
        lines     := 2;
        msgLength := 25;
        config    := FALSE;
    END;
END ReadConfig;

PROCEDURE GetPath(command : String;VAR path : String);

VAR    i : INTEGER;

BEGIN

    i := 0;
    WHILE (command[i]#0C) AND (command[i]#40C) DO (* bis zum ersten Space *)
        path[i] := command[i];
        INC(i);
    END;
    path[i] := 0C;

END GetPath;

PROCEDURE StartProc;

VAR erg : LONGINT;

BEGIN
    erg := Execute(ADR(filePath[(mouseY DIV height)-1]),NIL,NIL);
END StartProc;

PROCEDURE NewConfig();
VAR activeWindowPtr : WindowPtr;

BEGIN
    fName    := "hotprog.config";
    dName     := "s:";
    activeWindowPtr := intuiBasePtr^.activeScreen^.firstWindow;

    WITH fileRequester DO
        hail      := ADR("File-Requester");
        ddef      := ADR(fName);
        ddir      := ADR(dName);
        wind      := ADR(activeWindowPtr^);
        funcFlags := FileReqFlagSet{doColor,newIDCMP};
        reserved1 := 0;
        function  := NIL;
        reserved2 := 0;
    END;

    IF FileRequest(ADR(fileRequester)) # NIL THEN
        TackOn(ADR(dName),ADR(fName));    (* fileName an Pfad fügen *)
        ReadConfig(dName);
    END;
END NewConfig;

PROCEDURE Hot();

VAR actWindowPtr: WindowPtr;
    winTitelPtr : POINTER TO String;
    winTitel    : String;
    oldMouseY,
    color0,
    color1,
    depth       : INTEGER;
    ok          : BOOLEAN;
    myWindow    : NewWindow;
    myWindowPtr : WindowPtr;
    activeScreenPtr : ScreenPtr;

BEGIN
    winTitel  := "";
    i         := 0;
    oldMouseY := 1000;
    ProcPtr   := NIL;

    myWindowWidth  := leftOffset+rightOffset+maxLength*charWidth;
    myWindowHeight := 2+topOffset+entries*height;

    activeScreenPtr := intuiBasePtr^.activeScreen;
    IF (myWindowHeight > activeScreenPtr^.height) THEN
        myWindowHeight := activeScreenPtr^.height;
        entries := (myWindowHeight-topOffset) DIV height;
    END;
    IF (myWindowWidth > activeScreenPtr^.width) THEN
        myWindowWidth := activeScreenPtr^.width;
    END;

    interlace := 1;
    hiRes     := 1;
    viewPort  := activeScreenPtr^.viewPort;
    IF (lace IN viewPort.modes) THEN                (* InterLace ? *)
          interlace := 2;
    END;
    IF NOT(hires IN viewPort.modes) THEN            (* LowRes ?  *)
        hiRes := 2;
    END;

      mouseX := (intuiBasePtr^.mouseX/hiRes)-myWindowWidth/2;
      mouseY := interlace*intuiBasePtr^.mouseY/2-myWindowHeight/2;
    IF (mouseX > activeScreenPtr^.width-myWindowWidth) THEN
        mouseX := activeScreenPtr^.width-myWindowWidth;
    END;
    IF (mouseX <0) THEN mouseX := 0 END;
    IF (mouseY > activeScreenPtr^.height-myWindowHeight) THEN
        mouseY := activeScreenPtr^.height-myWindowHeight;
    END;
    IF (mouseY <0) THEN mouseY := 0 END;

    WITH myWindow DO
        leftEdge    := mouseX;
        topEdge     := mouseY;
        width       := myWindowWidth;
        height      := myWindowHeight;
        detailPen   := 1;
        blockPen    := 0;
        idcmpFlags  := IDCMPFlagSet{inactiveWindow,mouseButtons,mouseMove,
                                    menuVerify,closeWindow};
        flags       := WindowFlagSet{activate,reportMouse,windowDrag,menuState,
                                    windowClose,windowDepth};
        firstGadget := NIL;
        checkMark   := NIL;
        title       := intuiBasePtr^.activeWindow^.title;
        screen      := activeScreenPtr;
        bitMap      := NIL;
        type        := customScreen;
    END;

    myWindowPtr := OpenWindow(myWindow);
    color0 := 1;
    color1 := 1;
    depth  := activeScreenPtr^.bitMap.depth;
    IF depth > 5 THEN depth := 5 END;
    IF depth > 1 THEN
        FOR i := 0 TO depth-1 DO
            color1    := 2*color1;
        END;
        color1 := color1-1;
        GetComplementColors(activeScreenPtr,color0,color1);
    ELSE
        color0 := 0;
    END;
    myWindowPtr^.rPort^.fgPen := color1;
    myWindowPtr^.rPort^.bgPen := color0;
    SetDrMd(myWindowPtr^.rPort,jam2);
    IF (myWindowPtr # NIL) THEN
        FOR i := 0 TO entries DO
            Move(myWindowPtr^.rPort,leftOffset,topOffset+height+i*height);
            Text(myWindowPtr^.rPort,ADR(menuName[i]),Length(menuName[i]));
        END;

        LOOP
            WaitPort(myWindowPtr^.userPort);
            intuiMsgPtr    := GetMsg(myWindowPtr^.userPort);


            WHILE (intuiMsgPtr # NIL) DO
                class  := intuiMsgPtr^.class;
                msgCode   := intuiMsgPtr^.code;
                mouseX := intuiMsgPtr^.mouseX;
                mouseY := intuiMsgPtr^.mouseY-1;

                ReplyMsg(intuiMsgPtr);
                IF (inactiveWindow IN class) OR (mouseY <0) OR
                    (mouseY > myWindowHeight) OR (mouseX < 0) OR
                    (mouseX > myWindowWidth) THEN
                    CloseWindow(myWindowPtr);
                    EXIT;
                END;
                IF (closeWindow IN class) THEN
                    CloseWindow(myWindowPtr);
                    InstallKey(hotKey,qualifier,Hot,ADR("HotProgPort1.0"));
                    EXIT;
                END;
                IF (mouseY >9) THEN
                    IF (mouseButtons IN class) THEN
                        IF (selectUp = msgCode) THEN
                            command    := filePath[(mouseY DIV height)-1];
                            GetPath(command,path);
                            result := Lookup(filePtr,path,bufferSize,ReadOnly);
                            IF (result=done) THEN
                                CloseFile(filePtr);
                                ProcPtr := CreateFuncProcess (menuName[(mouseY DIV height)-1],0,8000,ADR(StartProc));
                                IF wbFlag[(mouseY DIV height)-1] THEN
                                    ok := WBenchToFront();
                                END;
                            END;
                        END;
                    END;
                    IF (mouseMove IN class) THEN
                        IF (mouseY DIV height # oldMouseY DIV height)  THEN
                            IF (oldMouseY<1000) THEN
                                SetDrMd(myWindowPtr^.rPort,jam2);
                                Move(myWindowPtr^.rPort,leftOffset,(oldMouseY +topOffset-(oldMouseY MOD height)));
                                Text(myWindowPtr^.rPort,ADR(menuName[(oldMouseY DIV height)-1]),Length(menuName[(oldMouseY DIV height)-1]));
                            END;
                            SetDrMd(myWindowPtr^.rPort,DrawModeSet{inversvid}+jam2);
                            Move(myWindowPtr^.rPort,leftOffset,(mouseY +topOffset-(mouseY MOD height)));
                            Text(myWindowPtr^.rPort,ADR(menuName[(mouseY DIV height)-1]),Length(menuName[(mouseY DIV height)-1]));
                        END;
                    END;
                    IF menuVerify IN class THEN
                        CloseWindow(myWindowPtr);
                        NewConfig();
                        EXIT;
                    END;
                    oldMouseY := mouseY;
                END;
                intuiMsgPtr := GetMsg(myWindowPtr^.userPort);
            END;
        END;
    END;

END Hot;

PROCEDURE InitialMsgWindow();

BEGIN
    intuiBasePtr    := OpenIntuition();
    activeScreenPtr := intuiBasePtr^.activeScreen;
    interlace := 1;
    viewPort  := activeScreenPtr^.viewPort;
    IF (lace IN viewPort.modes) THEN
          interlace := 2;
    END;
    IF (lines=0) THEN
        initialMsg[0] := "HotProg gestartet";
        lines     := 1;
        msgLength := 17;
    END;
    myWindowWidth  := leftOffset+rightOffset+msgLength*charWidth+charWidth;
    myWindowHeight := 2+topOffset+lines*height;

    IF (myWindowHeight > activeScreenPtr^.height) THEN
        myWindowHeight := activeScreenPtr^.height;
        lines := (myWindowHeight-topOffset-2) DIV height;
    END;
    IF (myWindowWidth > activeScreenPtr^.width) THEN
        myWindowWidth := activeScreenPtr^.width;
    END;
      mouseX := intuiBasePtr^.mouseX-10;
      mouseY := interlace*intuiBasePtr^.mouseY/2-5;
    IF (mouseX > activeScreenPtr^.width-myWindowWidth) THEN
        mouseX := activeScreenPtr^.width-myWindowWidth;
    END;
    IF (mouseX <0) THEN mouseX := 0 END;
    IF (mouseY > activeScreenPtr^.height-myWindowHeight) THEN
        mouseY := activeScreenPtr^.height-myWindowHeight;
    END;
    IF (mouseY <0) THEN mouseY := 0 END;

    WITH msgWindow DO
        leftEdge    := mouseX;
        topEdge     := mouseY;
        width       := myWindowWidth;
        height      := myWindowHeight;
        detailPen   := 1;
        blockPen    := 0;
        idcmpFlags  := IDCMPFlagSet{closeWindow};
        flags       := WindowFlagSet{windowDrag,windowClose};
        firstGadget := NIL;
        checkMark   := NIL;
        title       := intuiBasePtr^.activeWindow^.title;
        screen      := activeScreenPtr;
        bitMap      := NIL;
        type        := customScreen;
    END;

    msgWindowPtr    := OpenWindow(msgWindow);

    IF (msgWindowPtr#NIL) THEN
        msgWindowPtr^.rPort^.fgPen := 1;
        RectFill(msgWindowPtr^.rPort,0,11,myWindowWidth,myWindowHeight);
        msgWindowPtr^.rPort^.fgPen := 2;
        SetDrMd(msgWindowPtr^.rPort,jam1);
        FOR i:= 0 TO lines DO
            Move(msgWindowPtr^.rPort,leftOffset,topOffset+height+i*height);
            Text(msgWindowPtr^.rPort,ADR(initialMsg[i]),Length(initialMsg[i]));
        END;
        LOOP
            WaitPort(msgWindowPtr^.userPort);
            intuiMsgPtr := GetMsg(msgWindowPtr^.userPort);


            WHILE (intuiMsgPtr # NIL) DO
                class := intuiMsgPtr^.class;

                ReplyMsg(intuiMsgPtr);
                IF (closeWindow IN class) THEN
                    CloseWindow(msgWindowPtr);
                    EXIT;
                END;
                intuiMsgPtr := GetMsg(msgWindowPtr^.userPort);
            END;
        END;
    END;

END InitialMsgWindow;

PROCEDURE ReadArgs(VAR string : ARRAY OF CHAR);
VAR args,len    : INTEGER;
    
BEGIN
    args    := NumArgs();
    IF NumArgs() > 0 THEN
        GetArg(1,string,len);
    END;
END ReadArgs;


BEGIN

    configFile := "";
    ReadArgs(configFile);
    ReadConfig(configFile);
    InitialMsgWindow();
    IF (config = TRUE) THEN
        InstallKey(hotKey,qualifier,Hot,ADR("HotProgPort1.0"));
    END;
END HotProg.