(*************************************************************************

  :Program.       StartupMenu
  :Author.        Martin Horneffer
  :Address.       Semester: Süsterfeldstr.30, 5100 Aachen
  :Address.       sonst:    Stenzelbergstr.23, 5330 Königswinter 41
  :Address.       Zerberus-Net: KOX@MIDI.ZER
  :Address.       Maus-Net: Martin Horneffer @ BN
  :Address.              &  Martin Horneffer @ BN2
  :History.       V1.0 ??-Apr-1989 Martin Horneffer
  :Copyright.     PD
  :Language.      MODULA-II
  :Translator.    M2Amiga 3.11d
  :Imports.       IntuiStruct1.3 [bne]

  :Contents.      Intuitiongesteuertes Zusammenstellen einer Batch-Datei
  :Contents.      aus vorgegebenen Teilen mit Hilfe von Boolean-Gadgets,
  :Contents.      die sich gegenseitig ausschließen können

  :Remark.        Nützlich für alle, die für gewöhnlich auch verschiedene
  :Remark.        Anwendungen von einer einzigen Diskette oder FESTPLATTE
  :Remark.        booten und beim "startup" verschiedene Einstellungen
  :Remark.        vornehmen möchten.

*************************************************************************)

(*            Achtung !!!
      Leute, bei denen englisch/deutsch gemischte Bezeichner
   Übelkeit hervorrufen, sollten besser nicht weiterlesen.
   Der Quell-(Quäl-?)Text wäre gesundheitsgefährdend.

      Wer sich hingegen von "treffenden" Bezeichnern wie 'TitelFontName',
   oder 'AnzahlGadgets' nicht abschrecken lassen, kann immerhin sehen,
   wie man auch ohne 'RefreshGList()' mutual-exclude-Gadgets implementiert,
   oder wie man Modula-2 beibringt, dieselbe Variable mal als LONGCARD,
   mal als POINTER TO CHAR, ADDRESS, oder POINTER TO ARRAY OF CHAR zu
   betrachten, und kann durch einfaches Ändern von Konstanten das
   ganze Window-Design neu gestalten.
*)

MODULE StartupMenu ;

FROM DiskFont   IMPORT  OpenDiskFont;
FROM SYSTEM     IMPORT  ADDRESS, ADR, LONGSET, CAST;
FROM InOut      IMPORT  WriteString, WriteLn, WriteCard, Write, WriteHex;
FROM Arts       IMPORT  Assert, TermProcedure, Terminate;
FROM Arguments  IMPORT  NumArgs, GetArg;
FROM FileSystem IMPORT  File, Lookup, Close, ReadChar, WriteChar,
                        Response, Length, ReadBytes, WriteBytes;
IMPORT Strings ;
FROM IntuiStruct IMPORT StructWindow, StructText, StructGadget,
                        AllocProc, DeallocProc, StructBorder, Rectangle,
                        BorderEnd, FreeBorder;
FROM Heap       IMPORT  AllocMem, Deallocate;
FROM Intuition  IMPORT  NewWindow, WindowPtr, IDCMPFlags, IDCMPFlagSet,
                        WindowFlags, WindowFlagSet, OpenWindow, CloseWindow,
                        Gadget, GadgetPtr, GadgetFlags, GadgetFlagSet,
                        ActivationFlags, ActivationFlagSet, IntuiText,
                        boolGadget, ScreenFlags, ScreenFlagSet, Border,
                        AddGadget, RefreshGadgets, IntuiMessagePtr,
                        PrintIText ;
FROM Graphics   IMPORT  DrawModeSet, DrawModes, jam1, TextLength, Text,
                        RastPortPtr, TextAttr, FontStyleSet, FontStyles,
                        FontFlagSet, FontFlags, CloseFont, AddFont, Draw,
                        TextFontPtr, SetFont, Move, SetAPen, SetSoftStyle,
                        RectFill;
FROM Exec       IMPORT  WaitPort, GetMsg, ReplyMsg ;

CONST   MaxKnopf        = 22 ;
        eolc            = 12C ;
        Titel           = "Startup - Menu" ;
        TitelFontName   = "courier.font" ;
        TitelFontSize   =  24 ;
        TitelTop        =   8 ;
        WinX            = 600 ;
        WinY            = 220 ;
        WinTop          =  20 ;
        WinLeft         =  20 ;
        GadTop          =  40 ;
        GadLeft1        =  35 ;
        GadLeft2        = 360 ;
        GadX            = 203 ;
        GadY            =  10 ;
        GadDY           =  16 ;
        EndGadText      = "Fertig" ;
        EndGadLeft      = 270 ;
        EndGadTop       =  GadTop ;
        EndGadX         =  60 ;
        doubleKlick     = 500 ;

TYPE    KnopfNum        = [0..MaxKnopf-1] ;
        StrPtr          = RECORD CASE :CARDINAL OF
                              0 :  p:POINTER TO ARRAY [0..32000] OF CHAR |
                              1 :  a:ADDRESS |
                              2 :  w:LONGINT |
                              3 :  c:POINTER TO CHAR |
                          END ; END ;

VAR     mNWindow        : NewWindow ;
        mWindow         : WindowPtr ;
        rp              : RastPortPtr ;
        mBorder, EndGadBorder
                        : Border ;
        message         : IntuiMessagePtr ;
        t1, t2          : LONGCARD ;
        klasse          : IDCMPFlagSet ;
        taste           : CARDINAL ;
        TTextAttr       : TextAttr ;
        TText1, TText2  : IntuiText ;
        TitelLeft, TitelLen
                        : INTEGER ;
        TitelFont       : TextFontPtr ;
        firstGadget, iadr1, iadr2
                        : GadgetPtr ;
        EndGad          : Gadget ;
        EndGadY         : INTEGER ;
        EndGadITxt      : IntuiText ;
        gadget          : ARRAY KnopfNum OF Gadget ;
        gtext           : ARRAY KnopfNum OF IntuiText ;
        gname           : ARRAY KnopfNum OF StrPtr ;
        excludes        : ARRAY KnopfNum OF StrPtr ;
        commands        : ARRAY KnopfNum OF StrPtr ;
        AnzahlGadgets   : CARDINAL ;
        text            : StrPtr ;
        textLen         : LONGINT ;

        dummyi          : INTEGER ;
        dummyl          : LONGINT ;
        dummys          : FontStyleSet ;
        f, cf           : File ;

PROCEDURE Ende ;
  BEGIN
    IF mWindow # NIL THEN
      CloseWindow(mWindow); END ;
    IF TitelFont#NIL THEN CloseFont(TitelFont)  END ;
    Close(f) ;
    Close(cf) ;
  END Ende ;

PROCEDURE Rect( x1,y1,x2,y2, col : INTEGER ; fill : BOOLEAN );
  BEGIN
    SetAPen( rp, col);
    IF fill THEN
      RectFill( rp, x1,y1,x2,y2);
    ELSE
      Move( rp, x1,y1);
      Draw( rp, x2,y1); Draw( rp, x2,y2); Draw( rp, x1, y2); Draw( rp, x1,y1);
    END ;
  END Rect ;

PROCEDURE ExcludeGadget(Gadgets:GadgetPtr;Window:WindowPtr;
                Requester:ADDRESS;Mask:LONGSET);
VAR     TempPtr:GadgetPtr;
        Bit:INTEGER;
BEGIN
  Bit:=0;
  WHILE (Gadgets#NIL)AND(Bit<32) DO
    IF (Bit IN Mask)AND(selected IN Gadgets^.flags) THEN
      WITH Gadgets^ DO
        Rect( leftEdge, topEdge, leftEdge+width, topEdge+height, 0, TRUE);
        flags:=flags-GadgetFlagSet{selected};
        TempPtr:=nextGadget;
        nextGadget:=NIL;
        RefreshGadgets(Gadgets,Window,Requester);
        nextGadget:=TempPtr;
      END;
    END;
    Gadgets:=Gadgets^.nextGadget;
    INC(Bit);
  END;
END ExcludeGadget;

PROCEDURE suche(VAR p:StrPtr; c:CHAR) : BOOLEAN ;
  BEGIN
    WHILE ( p.c^ # c ) AND ( p.w-text.w < textLen ) DO  INC(p.w)  END ;
    RETURN ( p.w-text.w < textLen ) ;
  END suche ;

PROCEDURE MakeGadget( n:CARDINAL) ;
  VAR   i, l, length    : INTEGER ;
        c               : CHAR ;
        sel             : GadgetFlagSet ;
        wasEol          : BOOLEAN ;
        pos             : StrPtr ;
  BEGIN
    pos.w := gname[n].w - 1 ;
    IF pos.c^ = '+' THEN sel := GadgetFlagSet{selected} ;
    ELSE sel := GadgetFlagSet{}; END ;

    length := TextLength( rp, gname[n].a, Strings.Length(gname[n].p^) ) ;

      (* Excludes *)
    pos := excludes[n] ;
    WHILE pos.w < commands[n].w DO
      Assert( suche( pos, eolc), ADR("Datei unvollständig (Excludes)") ) ;
      IF pos.w < commands[n].w THEN
        pos.c^ := 0C ;
        l := pos.w - excludes[n].w ;
        FOR i := 0 TO AnzahlGadgets-1 DO
          IF Strings.Compare( excludes[n].p^, 0, l, gname[i].p^, FALSE ) = 0
            THEN
              INCL( gadget[n].mutualExclude, i) ;
              INCL( gadget[i].mutualExclude, n)
            END ;
        END ; (* FOR *)
        INC( pos.w ) ;
        excludes[n].w := pos.w ;
      END ; (* IF *)
    END ; (* WHILE *)

    StructText( gtext[n], 1,0, jam1, (GadX-length) DIV 2,1,
                ADR(gname[n].p^), NIL);
    StructGadget( gadget[n], GadLeft1,(n DIV 2)*GadDY+GadTop, GadX, GadY,
                  GadgetFlagSet{}+sel,
                  ActivationFlagSet{gadgImmediate,toggleSelect, relVerify},
                  boolGadget, ADR(mBorder), ADR(gtext[n]),
                  gadget[n].mutualExclude, n, NIL);
    IF n MOD 2 = 1 THEN
      gadget[n].leftEdge := GadLeft2; END ;
    dummyi :=  AddGadget( mWindow, ADR(gadget[n]), -1 ) ;
  END MakeGadget ;

PROCEDURE TextLesen ;
  VAR   Filename        : ARRAY [1..200] OF CHAR ;
        dummyp          : StrPtr ;
  BEGIN
    Assert( NumArgs()=2, ADR("Bitte zwei Dateinamen abgeben !"));
    GetArg( 1, Filename, dummyi);
    Lookup( f, Filename, 512, FALSE);
    Assert( f.res=done, ADR("Datei läßt sich nicht lesen !"));

    Length(f, textLen) ;
    AllocMem( text.a, textLen+2, FALSE) ;
    Assert( text.a#NIL, ADR("Nicht genug RAM !")) ;

    ReadBytes( f, text.a, textLen, dummyl) ;
    Assert( textLen=dummyl, ADR("Fehler beim Lesen der Datei !")) ;

    dummyp.w := textLen+text.w ;
    dummyp.c^ := 0C ;
  END TextLesen ;

PROCEDURE EintraegeSuchen ;
  VAR   pos     : StrPtr ;
  BEGIN
    pos := text ;
    AnzahlGadgets := 0 ;
    WHILE suche( pos, '#' )  DO
      pos.c^ := 0C ;
      gname[AnzahlGadgets].w := pos.w+2 ;
      Assert( suche(pos,eolc), ADR("Falsches Format: Knopfname")) ;
      pos.c^ := 0C ;
      excludes[AnzahlGadgets].w := pos.w+1 ;
      Assert( suche(pos,'%'), ADR("Falsches Format: Excludes")) ;
      pos.c^ := 0C ;
      commands[AnzahlGadgets].w := pos.w+1 ;
      INC( AnzahlGadgets ) ;
    END ;
  END EintraegeSuchen ;

PROCEDURE Gadgets ;
  VAR   c               : CHAR ;
        i               : CARDINAL ;
        newGadget       : GadgetPtr ;
  BEGIN
    AllocProc := AllocMem;
    DeallocProc := Deallocate;
    mBorder.xy := NIL ;

    StructBorder(mBorder, -1,-1, 2, jam1, 4, NIL);
    Rectangle( GadX+2, GadY+2);
    BorderEnd;

    TextLesen ;
    EintraegeSuchen ;
    FOR i:=0 TO AnzahlGadgets-1 DO
      MakeGadget(i) ;
    END ;

    firstGadget := ADR(gadget[0]);

    EndGadY := ((AnzahlGadgets+1) DIV 2) * GadDY - GadDY + GadY ;
    StructBorder(EndGadBorder, -1, -1, 2, jam1, 4, NIL);
    Rectangle( EndGadX+2, EndGadY+2);
    BorderEnd;
    StructText(EndGadITxt,1,0,jam1, 6,EndGadY DIV 2 -4,ADR(EndGadText),NIL);
    StructGadget( EndGad, EndGadLeft, EndGadTop, EndGadX, EndGadY,
                GadgetFlagSet{}, ActivationFlagSet{gadgImmediate, relVerify},
                boolGadget, ADR(EndGadBorder), ADR(EndGadITxt),
                LONGSET{}, MaxKnopf+1, NIL);
    dummyi := AddGadget( mWindow, ADR(EndGad), -1);

    RefreshGadgets( firstGadget, mWindow, NIL);

    WITH TTextAttr DO
      name:=ADR(TitelFontName);
      ySize:=TitelFontSize;
      style:=FontStyleSet{italic, bold};
      flags:=FontFlagSet{diskFont};
    END;
    TitelFont := OpenDiskFont(ADR(TTextAttr));
    SetFont( rp,TitelFont);
    TitelLen := TextLength( rp, ADR(Titel), SIZE(Titel)) ;
    TitelLeft := (WinX-TitelLen) DIV 2 ;
    StructText( TText1, 2,0, jam1, 0, 0, ADR(Titel), NIL);
    StructText( TText2, 1,0, jam1, -3, -2, ADR(Titel), NIL);
    TText1.iTextFont := ADR(TTextAttr) ;
    TText2.iTextFont := ADR(TTextAttr) ;

    Rect( TitelLeft-11, TitelTop-1, TitelLeft+TitelLen+14,
          TitelTop+TitelFontSize+1, 2, TRUE) ;
    Rect( TitelLeft-9, TitelTop, TitelLeft+TitelLen+12,
          TitelTop+TitelFontSize, 3, TRUE) ;

    PrintIText( rp, ADR(TText1), TitelLeft, TitelTop);
    PrintIText( rp, ADR(TText2), TitelLeft, TitelTop);

    Rect( 1, 1, WinX-2, WinY-2, 2, FALSE);
    Rect( 2, 1, WinX-3, WinY-2, 2, FALSE);
    Rect( 3, 2, WinX-4, WinY-3, 1, FALSE);

  END Gadgets ;

PROCEDURE FensterOeffnen ;
  BEGIN
    StructWindow( mNWindow, WinLeft, WinTop, WinX, WinY, 0, 1,
                IDCMPFlagSet{closeWindow,vanillaKey,gadgetUp,gadgetDown},
                WindowFlagSet{activate},
                NIL, NIL, ScreenFlagSet{wbenchScreen} );
    mWindow := OpenWindow( mNWindow);
    Assert( mWindow#NIL, ADR("Kein Fenster !"));
    rp := mWindow^.rPort;
  END FensterOeffnen ;

PROCEDURE ScriptAusgeben ;
  VAR   g       : GadgetPtr ;
        n, i    : CARDINAL ;
        Filename: ARRAY [1..80] OF CHAR;
  BEGIN
    GetArg( 2, Filename, dummyi);
    Lookup( cf, Filename, 512, TRUE);
    Assert( cf.res=done, ADR("Datei läßt sich nicht erzeugen !"));

    g:=firstGadget;
    WHILE g # NIL DO
      IF selected IN g^.flags THEN
        n := g^.gadgetID ; i := 0 ;
        WHILE commands[n].p^[i] # 0C DO
          WriteChar( cf, commands[n].p^[i]);
          INC(i);
        END ;
      END ;
    g := g^.nextGadget;
    END ;
  END ScriptAusgeben ;

BEGIN (* main *)
  TermProcedure( Ende) ;
  FensterOeffnen ;
  Gadgets ;

  LOOP
    WaitPort(mWindow^.userPort) ;
    message := GetMsg(mWindow^.userPort) ;
    WITH message^ DO
      t1 := (seconds MOD 1000) * 1000 + (micros DIV 1000) ;
      iadr1 := iAddress ;
      klasse := class ;
      taste := code ;
    END ;
    ReplyMsg(message) ;
    IF (gadgetDown IN klasse) AND (selected IN iadr1^.flags) THEN
      ExcludeGadget( firstGadget, mWindow, NIL, iadr1^.mutualExclude) ;
    END ;
    IF (gadgetDown IN klasse) AND (t1 < t2 + doubleKlick) AND
       (iadr1 = iadr2)  THEN
      INCL(iadr1^.flags, selected) ;
      EXIT ;
    END ;
    IF (gadgetUp IN klasse) AND (iadr1=ADR(EndGad))  OR
       (vanillaKey IN klasse) AND (taste=13) THEN  EXIT
    END ;
    t2 := t1 ;
    iadr2 := iadr1 ;
  END ; (* LOOP *)

  ScriptAusgeben;
END StartupMenu .