(**************************************************************
 *
 * :Program.    MakeKickRes.mod
 * :Author.     Holger Gzella
 * :Address.    Freischöffenweg 12  D-4600 Dortmund 16
 * :Phone.      (0231) 85 16 02
 * :Version.    1.0
 * :Date.       9/7/89  22:57:50
 * :Copyright.  PD
 * :Language.   Modula-2
 * :Translator. M2Amiga v3.2d
 * :Contents.   Make your own programs reset-resident!
 * :Remark.     This may be useful for assembler-freaks.
 * :Remark.     Notice that all programs have to be pc-relative!
 *
 **************************************************************)

MODULE MakeKickRes;

FROM Arts        IMPORT Assert,TermProcedure;
FROM SYSTEM      IMPORT ADR,ADDRESS,LONGSET;
FROM Dos         IMPORT FileHandlePtr,Read,Close,Open,oldFile;
FROM Exec        IMPORT AllocMem,GetMsg,MemReqs,MemReqSet,ReplyMsg,FreeMem,
                        WaitPort,NodeType,Node,NodePtr,Resident,matchword,
                        ResidentPtr,ResidentFlags,ResidentFlagSet,execBase,
                        SumKickData,MemEntry;
FROM Graphics    IMPORT jam1,Text,Move,SetAPen,RastPortPtr;
FROM Hardware    IMPORT ciaa,CiaaPraFlags,CiaaPraFlagSet;
FROM Intuition   IMPORT NewWindow,WindowPtr,OpenWindow,CloseWindow,WindowFlags,
                        WindowFlagSet,IDCMPFlags,IDCMPFlagSet,IntuiText,Gadget,
                        GadgetPtr,IntuiMessagePtr,Border,GadgetFlags,boolGadget,
                        GadgetFlagSet,ActivationFlags,ActivationFlagSet,
                        ScreenFlags,ScreenFlagSet,StringInfo,strGadget;

(* Hier werden die nötigen Typen definiert *)

TYPE PtrTable=RECORD                        (* Zwei Zeiger für KickTagPtr *)
       adr1: ADDRESS;
       adr2: ADDRESS;
     END;

     PtrTablePtr=POINTER TO PtrTable;

     MemList=RECORD                         (* Eigene MemList für KickMemPtr *)
       node      : Node;
       numEntries: CARDINAL;
       me        : ARRAY[0..3] OF MemEntry;
     END;

     MemListPtr=POINTER TO MemList;

VAR WhichGad : GadgetPtr;
    class    : IDCMPFlagSet;
    WDaten,RD: NewWindow;
    Fenster,R: WindowPtr;
    Gadgets  : ARRAY[0..3] OF Gadget;
    Texte    : ARRAY[0..2] OF IntuiText;
    Rahmen,RB: Border;
    xyFeld,RF: ARRAY[0..9] OF INTEGER;
    Info     : StringInfo;
    Nachricht: IntuiMessagePtr;
    rp       : RastPortPtr;
    FileName : ARRAY[0..60] OF CHAR;
    UndoBuf  : ARRAY[0..60] OF CHAR;
    buffer   : ADDRESS;
    i        : INTEGER;
    Datei    : FileHandlePtr;
    MyMemList: MemListPtr;
    MyResi   : ResidentPtr;
    Table    : PtrTablePtr;
    Summe    : LONGINT;
    Rubbish  : ADDRESS;

(* Das hier ist die TermProcedure. *)
PROCEDURE CleanUp;
  BEGIN
    IF Fenster#NIL THEN CloseWindow(Fenster); END;
  END CleanUp;

(* Diese Prozedur initialisiert Gadgets, Windows usw. *)

PROCEDURE SetUpStuff;
  BEGIN
    xyFeld[0]:=0; xyFeld[1]:=0; xyFeld[2]:=99; xyFeld[3]:=0; xyFeld[4]:=99;
    xyFeld[5]:=11; xyFeld[6]:=0; xyFeld[7]:=11; xyFeld[8]:=0; xyFeld[9]:=0;

    RF[0]:=0; RF[1]:=0; RF[2]:=189; RF[3]:=0; RF[4]:=189; RF[5]:=11;
    RF[6]:=0; RF[7]:=11; RF[8]:=0; RF[9]:=0;

    WITH Rahmen DO
      leftEdge:=-1; topEdge:=-1; frontPen:=1; backPen:=0; drawMode:=jam1;
      count:=5; xy:=ADR(xyFeld); nextBorder:=NIL;
    END;

    WITH RB DO
      leftEdge:=-1; topEdge:=-1; frontPen:=1; backPen:=0; drawMode:=jam1;
      count:=5; xy:=ADR(RF); nextBorder:=NIL;
    END;

    FOR i:=0 TO 2 DO
      WITH Texte[i] DO
        frontPen:=1; backPen:=0; drawMode:=jam1; leftEdge:=1; topEdge:=2;
        nextText:=NIL; iTextFont:=NIL; iText:=NIL;
      END;
    END;
    Texte[0].iText:=ADR("    INFO    "); Texte[1].iText:=ADR(" Install it ");
    Texte[2].iText:=ADR("    EXIT    ");

    WITH Info DO
      buffer:=ADR(FileName); undoBuffer:=ADR(UndoBuf); maxChars:=60;
      dispPos:=0; undoPos:=0; numChars:=0; dispCount:=0; cLeft:=0; cTop:=0;
      layerPtr:=NIL; longInt:=0; altKeyMap:=NIL;
    END;

    WITH Gadgets[3] DO
      nextGadget:=NIL; leftEdge:=50; topEdge:=65;
      width:=98; height:=10; flags:=GadgetFlagSet{}; gadgetType:=boolGadget;
      activation:=ActivationFlagSet{gadgImmediate,relVerify};
      gadgetRender:=ADR(Rahmen); selectRender:=NIL; gadgetText:=ADR(Texte[2]);
      specialInfo:=NIL; gadgetID:=3; userData:=NIL;
    END;

    WITH Gadgets[2] DO
      nextGadget:=ADR(Gadgets[3]); leftEdge:=50; topEdge:=50;
      width:=98; height:=10; flags:=GadgetFlagSet{}; gadgetType:=boolGadget;
      activation:=ActivationFlagSet{gadgImmediate,relVerify};
      gadgetRender:=ADR(Rahmen); selectRender:=NIL; gadgetText:=ADR(Texte[1]);
      specialInfo:=NIL; gadgetID:=2; userData:=NIL;
    END;

    WITH Gadgets[1] DO
      nextGadget:=ADR(Gadgets[2]); leftEdge:=50; topEdge:=35;
      width:=98; height:=10; flags:=GadgetFlagSet{}; gadgetType:=boolGadget;
      activation:=ActivationFlagSet{gadgImmediate,relVerify};
      gadgetRender:=ADR(Rahmen); selectRender:=NIL; gadgetText:=ADR(Texte[0]);
      specialInfo:=NIL; gadgetID:=1; userData:=NIL;
    END;

    WITH Gadgets[0] DO
      nextGadget:=ADR(Gadgets[1]); leftEdge:=5; topEdge:=20;
      width:=190; height:=10; flags:=GadgetFlagSet{}; gadgetType:=strGadget;
      activation:=ActivationFlagSet{gadgImmediate,relVerify,stringCenter};
      gadgetRender:=ADR(RB); selectRender:=NIL; gadgetText:=NIL; userData:=NIL;
      specialInfo:=ADR(Info); gadgetID:=0;
    END;

    WITH WDaten DO
      leftEdge:=210; topEdge:=78; width:=200; height:=80; detailPen:=0;
      blockPen:=1; idcmpFlags:=IDCMPFlagSet{gadgetUp}; checkMark:=NIL;
      flags:=WindowFlagSet{windowDrag,windowDepth,activate}; bitMap:=NIL;
      firstGadget:=ADR(Gadgets[0]); type:=ScreenFlagSet{wbenchScreen};
      title:=ADR("MakeKickRes v1.0"); screen:=NIL;
    END;

    WITH RD DO
      leftEdge:=160; topEdge:=53; width:=320; height:=140; detailPen:=0;
      blockPen:=1; idcmpFlags:=IDCMPFlagSet{gadgetUp}; checkMark:=NIL;
      flags:=WindowFlagSet{windowDrag,windowDepth,activate}; bitMap:=NIL;
      firstGadget:=NIL; type:=ScreenFlagSet{wbenchScreen}; screen:=NIL;
      title:=ADR("INFO über MakeKickRes ...");
    END;

    Fenster:=OpenWindow(WDaten);
    Assert(Fenster#NIL,ADR("Konnte Fenster nicht öffnen."));
  END SetUpStuff;

(* Diese Prozedur ist für das Info-Fenster. Nix bedeutendes. *)

PROCEDURE DisplayInfo;
  BEGIN
    R:=OpenWindow(RD);
    Assert(R#NIL,ADR("Konnte Info-Fenster nicht öffnen."));
    rp:=R^.rPort;

    SetAPen(rp,3);
    Move(rp,64,20);
    Text(rp,ADR("*** MakeKickRes v1.0 ***"),24);
    SetAPen(rp,1);
    Move(rp,68,29);
    Text(rp,ADR("by HOLGER GZELLA / 1989"),23);
    Move(rp,56,40);
    Text(rp,ADR("Installiert ein beliebiges"),26);
    Move(rp,40,49);
    Text(rp,ADR("Objekt-File resetfest im Spei-"),30);
    Move(rp,52,58);
    Text(rp,ADR("cher, wobei die EXEC-Zeiger"),27);
    Move(rp,44,67);
    Text(rp,ADR("KickMemPtr und KickTagPtr be-"),29);
    Move(rp,40,76);
    Text(rp,ADR("nutzt werden. Zu beachten ist,"),30);
    Move(rp,24,85);
    Text(rp,ADR("daß das Programm PC-relativ assem-"),34);
    Move(rp,28,94);
    Text(rp,ADR("bliert und als Linkable oder Exec"),33);
    Move(rp,32,103);
    Text(rp,ADR("utable) vorliegen muß. Dann kann"),32);
    Move(rp,40,112);
    Text(rp,ADR("eigentlich nichts schiefgehen."),30);
    Move(rp,40,121);
    Text(rp,ADR("MakeKickRes ist Public-Domain."),30);

    REPEAT UNTIL NOT (gamePort0 IN ciaa.pra);

    CloseWindow(R);
  END DisplayInfo;

(* AHA: hier wird's interessant: Installation eines Programms *)

PROCEDURE Install;
  BEGIN

    (* Rubbish=Abfallspeicher für den Dateiheader des zu installierenden
       Programms. *)

    Rubbish:=AllocMem(40,MemReqSet{chip});
    Assert(Rubbish#NIL,ADR("Keine 40 Bytes CHIP mehr frei!!"));

    (* Buffer=Speicher für das zu installierende Programm (max. 20K). *)

    buffer:=AllocMem(20000,MemReqSet{memClear,chip,public});
    Assert(buffer#NIL,ADR("Keine 20K CHIP-Memory mehr frei!!"));

    (* Datei öffnen *)

    Datei:=Open(ADR(FileName),oldFile);
    Assert(Datei#NIL,ADR("Datei nicht gefunden!!"));

    (* Header überlesen *)

    i:=Read(Datei,Rubbish,40);

    (* Maximal 20K Programmcode lesen *)

    i:=Read(Datei,buffer,20000);

    (* Abfallspeicher freigeben und Datei schließen *)

    FreeMem(Rubbish,40);

    Assert(i#0,ADR("!¿! Das klappte was nicht !¿!"));
    Close(Datei);

    (* Speicher für eigene MemList bereitstellen u. initialisieren *)

    MyMemList:=AllocMem(SIZE(MemList),MemReqSet{memClear,chip,public});
    Assert(MyMemList#NIL,ADR("WAS??? Keine 48 Bytes mehr???"));

    MyMemList^.node.type:=memory;       (* Node-Type: Memory-Node *)
    MyMemList^.numEntries:=1;           (* nur ein Programm resetfest *)
    MyMemList^.me[0].addr:=buffer;      (* und zwar das eingelesene *)
    MyMemList^.me[0].length:=i;         (* mit unbekannter Länge *)

    (* Speicher für Resident-Struktur bereitstellen u. fertigmachen *)

    MyResi:=AllocMem(SIZE(Resident),MemReqSet{memClear,chip,public});
    Assert(MyResi#NIL,ADR("REBOOT! Keine 26 Bytes mehr!!"));

    MyResi^.init:=buffer;               (* eingelesene Programm resetfest *)
    MyResi^.matchWord:=matchword;       (* Schlüsselword f. Kick-Reset *)
    MyResi^.matchTag:=MyResi;           (* Zeiger auf sich selbst *)
    MyResi^.endSkip:=LONGINT(MyResi)+LONGINT(SIZE(Resident));
                                        (* Zeiger auf eigenes Ende *)
    MyResi^.flags:=ResidentFlagSet{coldstart};
                                        (* Flag: Programm soll resetfest sein *)
    MyResi^.pri:=-1;                    (* Priorität: als letztes ausführen *)

    (* MemList-Einträge initialisieren *)

    MyMemList^.me[1].addr:=MyResi;      (* 2. Eintrag: Resident-Struktur *)
    MyMemList^.me[1].length:=SIZE(Resident); (* Länge: ich glaub' 26 Bytes *)

    (* TagPtr-Tabelle mit zwei Einträgen bereitstellen (einer wird belegt) *)

    Table:=AllocMem(8,MemReqSet{memClear,chip,public});
    Assert(Table#NIL,ADR("8 Bytes sind zuviel ..."));

    Table^.adr1:=MyResi;                (* Resident-Struktur in Tag-Table *)

    MyMemList^.me[2].addr:=Table;       (* Table: 3. Eintrag der MemList *)
    MyMemList^.me[2].length:=8;         (* Länge: 8 Bytes *)

    MyMemList^.me[3].addr:=MyMemList;        (* 4. Eintrag: MemList selbst *)
    MyMemList^.me[3].length:=SIZE(MemList);  (* Länge: ich mein' 48 Bytes *)

    execBase^.kickMemPtr:=MyMemList;    (* MemList eintragen *)
    execBase^.kickTagPtr:=Table;        (* TagTable eintragen *)

    Summe:=SumKickData();               (* Prüfsumme berechnen *)
    execBase^.kickCheckSum:=Summe;      (* und eintragen *)

  END Install;                          (* fertig - keep resident! *)

(* Das sollte zwar das Hauptprogramm sein, aber mehr als die Gadget-Abfrage
   tut es nicht ... das worauf's ankommt, ist die "INSTALL"-Prozedur. *)

BEGIN
  TermProcedure(CleanUp);
  SetUpStuff;

  LOOP
    WaitPort(Fenster^.userPort);
    Nachricht:=GetMsg(Fenster^.userPort);
    WHILE Nachricht#NIL DO
      class:=Nachricht^.class;
      WhichGad:=Nachricht^.iAddress;
      ReplyMsg(Nachricht);
      IF (gadgetUp IN class) THEN CASE WhichGad^.gadgetID OF
                                    0: |
                                    1: DisplayInfo |
                                    2: Install |
                                    3: EXIT |
                                  END;
      END;
      Nachricht:=GetMsg(Fenster^.userPort);
    END;
  END;
END MakeKickRes.