(* ------------------------------------------------------------------------
  :Program.       makeMenu.original
  :Author.        Stefan Kraus
  :Address.       Am Rehsprung 20, 6113 Babenhausen
  :Phone.         06073/2656
  :Version.       1.1
  :Copyright.     Shareware
  :Language.      Modula-2
  :Translator.    M2Amiga 3.3d
  :Contents.      Originaldatei zu makeMenu.mod, da makeMenu.mod von
  :Contents.      jedem geaendert werden darf.
  :Contents.      Bitte diese Datei nicht aendern.
------------------------------------------------------------------------ *)
IMPLEMENTATION MODULE makeMenu;

FROM FileSystem  IMPORT File, Lookup, Close, WriteBytes, WriteChar;
FROM SYSTEM      IMPORT ADR;
FROM datstruk    IMPORT String, ItemPtr, FensterPtr, SubItemPtr;
FROM Str         IMPORT Concat,Length;
FROM Conversions IMPORT ValToStr;
FROM Intuition   IMPORT WindowPtr;


VAR file : File;
    f,anf: FensterPtr;
    tt,mt,ts: ItemPtr;
    str  : String;
    CR   : CHAR;
    MenuZaehler,ItemZaehler,ItemNr,subtE,itemtE,i : INTEGER;
    winPtr : WindowPtr;


PROCEDURE Write(str: ARRAY OF CHAR);
  VAR act: LONGINT;
BEGIN
  WriteBytes(file,ADR(str),Length(str),act);
END Write;


PROCEDURE WriteInt(zahl : INTEGER);
  VAR act: LONGINT;
      err: BOOLEAN;
BEGIN
  ValToStr(zahl,TRUE,str,10,0," ",err);
  WriteBytes(file,ADR(str),Length(str),act);
END WriteInt;

PROCEDURE cr;
BEGIN
  WriteChar(file,CR);
END cr;


PROCEDURE MacheModulKopf;
BEGIN

  cr;cr;
  Write("FROM SYSTEM    IMPORT ADR, LONGSET;");
  cr;
  Write("FROM Intuition IMPORT MenuItem,Menu,MenuItemFlags,MenuItemFlagSet,");
  cr;
  Write("                      IDCMPFlags, IDCMPFlagSet, SetMenuStrip,"); cr;
  Write("                      ClearMenuStrip, WindowPtr, NewWindow,"); cr;
  Write("                      IntuiMessage, IntuiText,");cr;
  Write("                      ScreenFlags, ScreenFlagSet, WindowFlags,");cr;
  Write("                      WindowFlagSet, OpenWindow, CloseWindow;"); cr;
  Write("FROM Graphics  IMPORT jam1;");cr;
  Write("FROM Exec      IMPORT GetMsg, ReplyMsg;");cr;
  cr;
  Write("VAR MenuWindowPtr  : WindowPtr;");cr;
  Write("    IntuiMsg       : POINTER TO IntuiMessage;");cr;
  Write("    class          : IDCMPFlagSet;");cr;
  Write("    code           : CARDINAL;");cr;
  Write("    Menustrip      : ARRAY[1..");
  WriteInt(MenuZaehler); Write("] OF Menu;"); cr;
  Write("    Item           : ARRAY[1..");
  WriteInt(ItemZaehler); Write("] OF MenuItem;");cr;
  Write("    ItemText       : ARRAY[1..");
  WriteInt(ItemZaehler); Write("] OF IntuiText;");cr;
  Write("    ok             : BOOLEAN;");cr;
  Write("    MenuWindow     : NewWindow;");cr;
  cr;
  Write("PROCEDURE InitMenu;");cr;
  Write("BEGIN");cr;
  Write("WITH MenuWindow DO");cr;
  Write("  leftEdge   :=0;   topEdge  :=0;");cr;
  Write("  width      :=640; height   :=256;");cr;
  Write("  detailPen  :=0;   blockPen :=1;");cr;
  Write("  idcmpFlags :=IDCMPFlagSet{ menuPick };");cr;
  Write("  flags      :=WindowFlagSet{ activate };");cr;
  Write("  firstGadget:=NIL; checkMark:=NIL;");cr;
  Write("  title      :=ADR('MenuWindow');");cr;
  Write("  bitMap     :=NIL;");cr;
  Write("  type       :=ScreenFlagSet{ wbenchScreen };");cr;
  Write("END (* WITH *);");cr;

END MacheModulKopf;

PROCEDURE BildeMenuStruktur;
BEGIN
  ItemNr:=1;
  FOR i:=1 TO MenuZaehler DO
    Write("WITH Menustrip["); WriteInt(i); Write("] DO");cr;
    Write("  nextMenu:=");
    IF f^.next = NIL THEN
      Write("NIL;");
    ELSE
      Write("ADR(Menustrip["); WriteInt(i+1); Write("]);");
    END;
    cr;
    Write("  leftEdge:="); WriteInt(f^.winPtr[TRUE]^.leftEdge);
    Write("; topEdge:=0;");cr;
    Write("  width:=");  WriteInt(f^.winPtr[TRUE]^.width - 20);
    Write("; height:=9;"); cr;
    Write("  flags:={0};");cr;
    Write("  menuName:=ADR('"); Write(f^.name); Write("');");cr;
    Write("  firstItem:=ADR(Item["); WriteInt(ItemNr); Write("]);");cr;
    Write("END (* WITH *);");cr;
    cr;
    ItemNr:=ItemNr + f^.AnzItem;
    tt:=f^.PtoItem;
    WHILE tt # NIL DO
      IF tt^.SubItem # NIL THEN
        ItemNr:=ItemNr + f^.PtoItem^.SubItem^.AnzItem;
      END;
      tt:=tt^.next;
    END;
    f:=f^.next;
  END (* FOR *);

(* ab hier beginnt die ItemStruktur *)
  f:=anf;
  tt:=f^.PtoItem;
  FOR i:=1 TO ItemZaehler DO
    Write("WITH Item["); WriteInt(i); Write("] DO");cr;
    Write("  nextItem:=");
    IF tt^.next # NIL THEN
      Write("ADR(Item[");
      IF tt^.SubItem # NIL THEN
        WriteInt(tt^.SubItem^.AnzItem + i + 1);
      ELSE
        WriteInt(i+1);
      END;
      Write("]);");
    ELSE
      Write("NIL;");
    END;
    cr;
    Write("  leftEdge:=");
    IF tt^.inSubItem THEN
      WriteInt(mt^.SubItem^.winPtr^.leftEdge
                     - f^.winPtr[TRUE]^.leftEdge - 20);
    ELSE
      WriteInt(f^.winPtr[FALSE]^.leftEdge - f^.winPtr[TRUE]^.leftEdge);
    END;
    Write("; topEdge:=");
    IF tt^.inSubItem THEN
      WriteInt(mt^.SubItem^.winPtr^.topEdge + subtE -
               (f^.winPtr[FALSE]^.topEdge + itemtE ));
      subtE:=subtE + 10;
    ELSE
      WriteInt(itemtE);
      itemtE:=itemtE + 10;
    END;
    Write(";");cr;
    Write("  width:=");
    IF tt^.inSubItem THEN
      WriteInt(mt^.SubItem^.winPtr^.width-20);
    ELSE
      WriteInt(f^.winPtr[FALSE]^.width-20);
    END;
    Write("; height:=9;");cr;
    Write("  flags:=MenuItemFlagSet{highComp,itemText,itemEnabled};");cr;
    Write("  mutualExclude:=LONGSET{};");cr;
    Write("  itemFill:=ADR(ItemText["); WriteInt(i); Write("]);");cr;
    Write("  selectFill:=NIL;");cr;
    Write("  subItem:=");
    IF tt^.SubItem = NIL THEN
      Write("NIL;");
      IF tt^.next = NIL THEN
        IF tt^.inSubItem THEN
          tt:=mt;
          winPtr:=f^.winPtr[FALSE];
          tt^.inSubItem:=FALSE;
        END;
        IF tt^.next = NIL THEN
          f:=f^.next;
          tt:=f^.PtoItem;
          winPtr:=f^.winPtr[FALSE];
          itemtE:=0;
          subtE :=0;
        ELSE
          tt:=tt^.next;
        END;
      ELSE
        tt:=tt^.next;
      END;
    ELSE
      subtE:=0;
      Write("ADR(Item["); WriteInt(i+1); Write("]);");
      winPtr:=tt^.SubItem^.winPtr;
      mt:=tt;
      tt:=tt^.SubItem^.PtoItem;
      tt^.inSubItem:=TRUE;
    END;
    cr;
    Write("END (* WITH *); ");
    cr;cr;
  END (* FOR *);

  (* ab hier beginnt die Textstruktur *)
  f:=anf;
  tt:=f^.PtoItem;
  cr;
  FOR i:=1 TO ItemZaehler DO
    Write("WITH ItemText["); WriteInt(i); Write("] DO");cr;
    Write("  nextText:=NIL;");cr;
    Write("  frontPen:=0; backPen:=0;");cr;
    Write("  drawMode:=jam1;");cr;
    Write("  leftEdge:=0; topEdge:=0;");cr;
    Write("  iTextFont:=NIL;");cr;
    Write("  iText:=ADR('"); Write(tt^.txt); Write("');");cr;
    IF tt^.SubItem = NIL THEN
      IF tt^.next = NIL THEN
        IF tt^.inSubItem THEN
          tt:=mt;
          tt^.inSubItem:=FALSE;
        END;
        IF tt^.next = NIL THEN
          f:=f^.next;
          tt:=f^.PtoItem;
        ELSE
          tt:=tt^.next;
        END;
      ELSE
        tt:=tt^.next;
      END;
    ELSE
      mt:=tt;
      tt:=tt^.SubItem^.PtoItem;
      tt^.inSubItem:=TRUE;
    END;
    Write("END (* WITH *);");cr;cr;

  END (* FOR *);
  Write("MenuWindowPtr:=OpenWindow(MenuWindow);");cr;
  Write("ok:=SetMenuStrip(MenuWindowPtr,ADR(Menustrip[1]) );");cr;
  Write("END InitMenu;");cr;
END BildeMenuStruktur;


PROCEDURE MacheHauptmodul;
  VAR Mza,Iza,Sza : CARDINAL;  (* Zaehler *)
BEGIN
  Write("PROCEDURE MenuNum(Code : CARDINAL): CARDINAL;");cr;
  Write("BEGIN");cr;
  Write("  RETURN Code MOD 0020H;");cr;
  Write("END MenuNum;");cr;cr;

  Write("PROCEDURE ItemNum(Code : CARDINAL): CARDINAL;");cr;
  Write("BEGIN");cr;
  Write("  RETURN Code DIV 0020H MOD 0040H;");cr;
  Write("END ItemNum;");cr;cr;

  Write("PROCEDURE SubNum(Code : CARDINAL): CARDINAL;");cr;
  Write("BEGIN");cr;
  Write("  RETURN Code DIV 0800H;");cr;
  Write("END SubNum;");cr;cr;

  Write("PROCEDURE MenuAbfrage;");cr;
  Write("BEGIN");cr;
  Write("  LOOP");cr;
  Write("    IntuiMsg:=GetMsg(MenuWindowPtr^.userPort);");cr;
  Write("    WHILE IntuiMsg # NIL DO");cr;
  Write("      class:=IntuiMsg^.class;");cr;
  Write("      code :=IntuiMsg^.code;");cr;
  Write("      ReplyMsg(IntuiMsg);");cr;
  Write("      IF (menuPick IN class) THEN");cr;
  Write("        CASE MenuNum(code) OF");cr;
  Mza:=0;
  f:=anf;
  WHILE f # NIL DO
    Write("            ");
    WriteInt(Mza);
    Write(": CASE ItemNum(code) OF");cr;
    tt:=f^.PtoItem;
    Iza:=0;
    WHILE tt # NIL DO
      Write("                 ");
      WriteInt(Iza);
      IF tt^.SubItem = NIL THEN
        Write(": (* Prozedur fuer "); Write(tt^.txt); Write(" *)     |");cr;
      ELSE
        Sza:=0;
        Write(": CASE SubNum(code) OF");cr;
        ts:=tt^.SubItem^.PtoItem;
        WHILE ts # NIL DO
          Write("                      ");
          WriteInt(Sza);
          Write(": (* Prozedur fuer "); Write(ts^.txt); Write("*)      |");cr;
          ts:=ts^.next;
          Sza:=Sza+1;
        END;
        Write("                    ELSE");cr;
        Write("                    END (* CASE SubNum *);     |");cr;
      END;
      Iza:=Iza+1;
      tt:=tt^.next;
    END;
    Write("               ELSE");cr;
    Write("               END (* CASE ItemNum *);    |");cr;
    f:=f^.next;
    Mza:=Mza+1;
  END;
  Write("        ELSE");cr;
  Write("        END (* CASE MenuNum *)   ");cr;
  Write("      END (* IF *);");cr;
  Write("      IntuiMsg:=GetMsg(MenuWindowPtr^.userPort);");cr;
  Write("    END (* WHILE *);");cr;
  Write("  END (* LOOP *);");cr;
  Write("END MenuAbfrage;");cr;
  cr;
  Write("PROCEDURE CloseMenu;");cr;
  Write("BEGIN");cr;
  Write("  ClearMenuStrip(MenuWindowPtr);");cr;
  Write("  CloseWindow(MenuWindowPtr);");cr;
  Write("END CloseMenu;");cr;
  cr;
  Write("BEGIN");cr;

END MacheHauptmodul;


PROCEDURE makeMenu(anfang: FensterPtr; Modulname: String);
  VAR Mname: String;
BEGIN
  Mname:=Modulname;
  Concat(Mname,".mod");
  anf:=anfang;
  Lookup(file,Mname,300,TRUE);
  MenuZaehler:=0;
  ItemZaehler:=0;
  f:=anf;
  WHILE f # NIL DO
    f:=f^.next;
    INC(MenuZaehler);
  END;
  f:=anf;
  WHILE f # NIL DO
    ItemZaehler:=ItemZaehler + f^.AnzItem;
    tt:=f^.PtoItem;
    WHILE tt # NIL DO
      IF tt^.SubItem # NIL THEN
        ItemZaehler:=ItemZaehler + tt^.SubItem^.AnzItem;
      END;
      tt:=tt^.next;
    END;
    f:=f^.next;
  END;
  f:=anf;
  Write("IMPLEMENTATION MODULE ");
  Write(Modulname);
  Write(";");
  MacheModulKopf;
  BildeMenuStruktur;
  MacheHauptmodul;
  Write("END ");
  Write(Modulname);
  Write(".");
  Close(file);
  Mname:=Modulname;
  Concat(Mname,".def");
  Lookup(file,Mname,300,TRUE);
  Write("DEFINITION MODULE ");
  Write(Modulname);
  Write(";");cr;
  Write("PROCEDURE InitMenu;");cr;
  Write("PROCEDURE MenuAbfrage;");cr;
  Write("PROCEDURE CloseMenu;");cr;
  Write("END ");
  Write(Modulname);
  Write(".");
  Close(file);
END makeMenu;


BEGIN
  CR:=CHAR(0AH);

END makeMenu.