(*******************************************************************************
:Program.       Menu.mod
:Author.        Jan Behrens
:Address.       Hauptstraße 13, 2211 Holstenniendorf
:Copyright.     PD, siehe Menu.dok
:Language.      Modula-2
:Translator.    M2Amiga
:History.       V1.0 8.Aug.90, Hoffentlich nur wenige Fehler !
:Support.       Interruptroutine [fbs]
:Contents.      Menus, mit denen  auf einfache Weise mit Maus und Tastatur 
:Contents.      eine Auswahl getroffen werden kann
*******************************************************************************)

IMPLEMENTATION MODULE Menu;

FROM Graphics    IMPORT AllocRaster,BitMap,BltBitMap,DrawModes,DrawModeSet,
                        FreeRaster,InitBitMap,jam1,jam2,RastPortPtr,SetRGB4,
                        ViewPortPtr;
FROM Intuition   IMPORT Border,DrawBorder,DrawImage,IDCMPFlags,IDCMPFlagSet,
                        Image,IntuiMessagePtr,IntuiTextLength,IntuiText,
                        IntuiTextPtr,PrintIText,ViewPortAddress,WindowPtr;
FROM Exec        IMPORT WaitPort,GetMsg,ReplyMsg,MsgPortPtr,AllocMem,
                        MemReqs,MemReqSet,FreeMem,UByte,Interrupt,NodeType,
                        AddIntServer,RemIntServer;
FROM SYSTEM      IMPORT ADR,ADDRESS,INLINE;
FROM Arts        IMPORT Assert;

VAR  count,i:INTEGER;
     bool:BOOLEAN;
     vertb:Interrupt;
     vp:ViewPortPtr;

PROCEDURE ColorCycle();  (*Procedur die im VertB-Interrupt die Farben rotiert*)

  BEGIN
    INLINE(48E7H,3F3EH); 
    INC(i);
    IF i>2 THEN     
      i:=0;
      IF bool THEN  
        INC(count);
      ELSE
        DEC(count);
      END;
      IF (count=15) OR (count=0) THEN bool:=NOT(bool); END;
      SetRGB4(vp,4,count,count,count); 
    END;
    INLINE(4CDFH,7CFCH);
END ColorCycle;


PROCEDURE MakeBorder(WPtr:WindowPtr;x,y,width,height,color:CARDINAL);
(*Zeichnet mit den angegebenen Koordinaten einen Rahmen*)

  VAR border:Border;
      rect:ARRAY[0..9]OF INTEGER;
      oldcolor:CARDINAL;

  BEGIN (*MakeBorder*)
    rect[0]:=0;        rect[1]:=0;
    rect[2]:=width;    rect[3]:=0;
    rect[4]:=width;    rect[5]:=height;
    rect[6]:=0;        rect[7]:=height;
    rect[8]:=0;        rect[9]:=0;

    WITH border DO
      leftEdge:=x;
      topEdge:=y;
      frontPen:=color;
      backPen:=0;
      drawMode:=DrawModeSet{};
      count:=5;
      xy:=ADR(rect);
      nextBorder:=NIL;
    END;

    DrawBorder(WPtr^.rPort,ADR(border),0,0);
END MakeBorder;


PROCEDURE GetStandard(WPtr:WindowPtr):CARDINAL;
(*Gibt die Höhe des Standardtextes des Windows zurück*)

  BEGIN (*GetStandard*)
    RETURN WPtr^.iFont^.ySize;
  END GetStandard;


PROCEDURE Invert(WPtr:WindowPtr;x,y,w,h:INTEGER);   
(*Invertiert mit Hilfe des Blitters den durch die Kordinaten 
  bestimmten Abschnitt*)


  VAR status:LONGCARD;
      mem:ADDRESS;
      size:LONGINT;

  BEGIN
    size:=LONGINT(w)*LONGINT(h) DIV 8;
    mem:=AllocMem(size,MemReqSet{chip,memClear});
    Assert(mem#NIL,ADR("Kein Speicher !!!"));
    status:=BltBitMap(WPtr^.rPort^.bitMap,x,y,WPtr^.rPort^.bitMap,
                      x,y,w,h,50H,255,mem);
    Assert(status#0,ADR("Blitten hat nicht geklappt !!!"));
    FreeMem(mem,size);
END Invert;


PROCEDURE GetPlace(WPtr:WindowPtr;MPtr:MenuPtr;
                   VAR top,bottom,left,right:CARDINAL;number:CARDINAL);
(*Gibt die Koordinaten des durch number bestimmten Items zurück*)

  VAR text:IntuiTextPtr;
      i,textHeight:INTEGER;

  BEGIN
    text:=MPtr^.firstText;
    FOR i:=1 TO number DO    (*Text mit der angegebenen Nummer suchen*)
      IF text^.nextText=NIL THEN
        Assert(text^.nextText#NIL,ADR("MenuItem-Fehler !!!"));
      ELSE
        text:=text^.nextText;
      END (*IF*);
    END;
    IF text^.iTextFont#NIL THEN
      textHeight:=text^.iTextFont^.ySize;
    ELSE
      textHeight:=GetStandard(WPtr);
    END;
    top:=MPtr^.topEdge+text^.topEdge-2;
    bottom:=MPtr^.topEdge+textHeight+text^.topEdge+1;
    left:=MPtr^.leftEdge+text^.leftEdge-2;
    right:=MPtr^.leftEdge+IntuiTextLength(text)+6;
END GetPlace;


PROCEDURE GetNumber(WPtr:WindowPtr;MPtr:MenuPtr):CARDINAL;
(*Gibt die Nummer des Items zurück, in dessen Bereich der 
  Mauszeiger sich befindet*)
 
  VAR text:IntuiTextPtr;
      textHeight,standard:INTEGER;
      count:CARDINAL;
      y:INTEGER;

  BEGIN
    y:=WPtr^.mouseY;
    standard:=GetStandard(WPtr);
    text:=MPtr^.firstText;
    count:=0;
    IF text^.iTextFont#NIL THEN
      textHeight:=text^.iTextFont^.ySize;
    ELSE
      textHeight:=standard;
    END;
    WHILE (y>text^.topEdge+MPtr^.topEdge+textHeight+2) AND 
          (text^.nextText#NIL) DO
      text:=text^.nextText;
      IF text^.iTextFont#NIL THEN
        textHeight:=text^.iTextFont^.ySize;
      ELSE
        textHeight:=standard;
      END;
      INC(count);
    END (*WHILE*);
    RETURN count;
 END GetNumber;


PROCEDURE GetText(MPtr:MenuPtr;VAR txt:IntuiText;number:CARDINAL);
(*Gibt durch txt den IntuiText zurück, der durch number bestimmt ist*)

  VAR i:CARDINAL;
      actual:IntuiTextPtr;

  BEGIN
    actual:=MPtr^.firstText;
    FOR i:=1 TO number DO
      actual:=actual^.nextText
    END (*FOR*);
    WITH txt DO
      backPen:=actual^.backPen;
      drawMode:=jam2;
      leftEdge:=actual^.leftEdge;
      topEdge:=actual^.topEdge;
      iTextFont:=actual^.iTextFont;
      iText:=actual^.iText;
      nextText:=NIL;
    END (*WITH*);
END GetText;


PROCEDURE Cycle(WPtr:WindowPtr;MPtr:MenuPtr;number,oldnumber:CARDINAL);
(*Zeichnet aktives Item in einer anderen Farbe, 
  bei cycleItems rotieren die Farben*)
 
    VAR txt:IntuiText;

    BEGIN
      IF oldnumber#65535 THEN
        GetText(MPtr,txt,oldnumber);
        txt.frontPen:=1;
        PrintIText(WPtr^.rPort,ADR(txt),MPtr^.leftEdge,MPtr^.topEdge);
      END (*IF*);
      GetText(MPtr,txt,number);
      txt.frontPen:=4;
      PrintIText(WPtr^.rPort,ADR(txt),MPtr^.leftEdge,MPtr^.topEdge);
END Cycle;


PROCEDURE DoSelect(WPtr:WindowPtr;MPtr:MenuPtr;
                   VAR top,bottom,left,right,number,
                       oldtop,oldbottom,oldleft,oldright,oldnumber:CARDINAL);
(*Führt die jeweiligen Aktionen je nach gewählten Flags aus*)
  
  VAR width,oldwidth:CARDINAL;

  BEGIN
    GetPlace(WPtr,MPtr,top,bottom,left,right,number);
    IF (standardWidth IN MPtr^.flags) THEN
      width:=MPtr^.standWidth;
      oldwidth:=width
    ELSE
      width:=right-left;
      oldwidth:=oldright-oldleft
    END (*IF*);      
    IF (oldnumber#65535) THEN
      IF (borderItems IN MPtr^.flags) THEN
        MakeBorder(WPtr,oldleft,oldtop,oldwidth,
                   oldbottom-oldtop,0);
      ELSIF (invertItems IN MPtr^.flags) THEN 
        Invert(WPtr,oldleft+CARDINAL(WPtr^.leftEdge),
               oldtop+CARDINAL(WPtr^.topEdge),
               oldwidth,oldbottom-oldtop);
      END (*IF*);
    END (*IF*);
    IF (borderItems IN MPtr^.flags) THEN
      MakeBorder(WPtr,left,top,width,bottom-top,2);
    ELSIF (invertItems IN MPtr^.flags) THEN
      Invert(WPtr,left+CARDINAL(WPtr^.leftEdge),
             top+CARDINAL(WPtr^.topEdge),
             width,bottom-top);
    ELSIF (cycleItems IN MPtr^.flags) OR (changeColorItems IN MPtr^.flags) THEN
      Cycle(WPtr,MPtr,number,oldnumber);      
    END (*IF*);
    oldtop:=top;
    oldbottom:=bottom;
    oldleft:=left;
    oldright:=right;
    oldnumber:=number;
END DoSelect;


PROCEDURE CopyBitMap(WPtr:WindowPtr;MPtr:MenuPtr;bm:BitMap);
(*Kopiert den Bereich des Menus in eine BitMap*)

  VAR status:INTEGER;
  
  BEGIN
    status:=BltBitMap(WPtr^.rPort^.bitMap,MPtr^.leftEdge,MPtr^.topEdge,
                      ADR(bm),
                      0,0,MPtr^.width,MPtr^.height,0C0H,255,NIL);
    Assert(status#0,ADR("Blitten hat nicht geklappt !!!"));
END CopyBitMap;


PROCEDURE InsertOldBitMap(WPtr:WindowPtr;MPtr:MenuPtr;bm:BitMap);
(*Kopiert die BitMap in den Bereich des Menus zurück*)

  VAR status:INTEGER;
  
  BEGIN
    status:=BltBitMap(ADR(bm),0,0,
                      WPtr^.rPort^.bitMap,MPtr^.leftEdge,MPtr^.topEdge,
                      MPtr^.width,MPtr^.height,0C0H,255,NIL);
    Assert(status#0,ADR("Blitten hat nicht geklappt !!!"));
END InsertOldBitMap;


PROCEDURE ClearMenu(WPtr:WindowPtr;MPtr:MenuPtr);
(*Löscht mittels des Blitters den Bereich des Windows in dem sich das
  Menu befindet*)

  VAR size:LONGCARD;
      mem:ADDRESS;
      status:LONGCARD;

  BEGIN
    size:=LONGCARD(MPtr^.width)*LONGCARD(MPtr^.height) DIV 8;
    mem:=AllocMem(size,MemReqSet{chip,memClear});
    Assert(mem#NIL,ADR("Kein Speicher !!!"));
    status:=BltBitMap(WPtr^.rPort^.bitMap,MPtr^.leftEdge,MPtr^.topEdge,
                      WPtr^.rPort^.bitMap,
                      MPtr^.leftEdge,MPtr^.topEdge,MPtr^.width,
                      MPtr^.height,40H,255,mem);
    Assert(status#0,ADR("Blitten hat nicht geklappt !!!"));
    FreeMem(mem,size);
END ClearMenu;


PROCEDURE DrawMenu(WPtr:WindowPtr;MPtr:MenuPtr):CARDINAL;
(*Hauptfunktion*)

  TYPE CardPtr=POINTER TO CARDINAL;  (*Wird von ChipCopy benötigt*)

  VAR standardCheck:CardPtr;

(*$E-*)
  PROCEDURE idata;
  (*INLINE-Code des Standard Check-Marks*)

    BEGIN
      INLINE(0000H,007EH,00C0H,4180H,6300H,3600H,1C00H,0C00H,0000H,0000H);
  END idata;


  PROCEDURE ChipCopy;
  (*Kopiert das Standard Check-Mark ins Chip-Mem*)

    VAR i:CARDINAL;
         source,dest:CardPtr;

    BEGIN
      standardCheck:=AllocMem(20,MemReqSet{chip});
      Assert(standardCheck#NIL,ADR("Kein Speicher für Image !!!"));
      source:=ADR(idata);
      dest:=standardCheck;
      FOR i:=0 TO 10 DO
        dest^:=source^;
        INC(dest,2);INC(source,2);
      END (*FOR*);
   END ChipCopy;


PROCEDURE MakeAction(WPtr:WindowPtr;MPtr:MenuPtr):CARDINAL;
(*Kontrolliert den userPort des Windows, und führt die daraus resultierenden
  Aktionen aus*)

  VAR top,bottom,left,right,number,oldnumber,
      oldtop,oldbottom,oldleft,oldright,code,oldcode:CARDINAL;
      message:IntuiMessagePtr;
      class:IDCMPFlagSet;
      y:CARDINAL;
      mouse:BOOLEAN;  

  PROCEDURE drawImage(top:CARDINAL;plane:UByte);
  (*Zeichnet das Standard Check-Mark*)

    VAR image:Image;

      BEGIN
        WITH image DO
          leftEdge:=MPtr^.leftEdge+MPtr^.width-18;
          topEdge:=top-1;
          width:=16;
          height:=10;
          depth:=1;
          imageData:=standardCheck;
          planePick:=plane;
          planeOnOff:=0;
          nextImage:=NIL
        END (*WITH*);
        DrawImage(WPtr^.rPort,ADR(image),0,0);
    END drawImage;


  PROCEDURE DrawCheck(number:CARDINAL);
  (*Führt die Aktionen durch, wenn ein Check-Item "angeklickt" wurde*)

      VAR plane:UByte;

      BEGIN
        IF (number IN MPtr^.selectedItems) THEN
          plane:=0;
          EXCL(MPtr^.selectedItems,number);
        ELSE
          plane:=2;
          INCL(MPtr^.selectedItems,number);
        END (*IF*);
        IF (customCheckMark IN MPtr^.flags) THEN
          DrawImage(WPtr^.rPort,MPtr^.checkMark,MPtr^.leftEdge,top);
        ELSE
          drawImage(top+2,plane);
        END (*IF*);
   END DrawCheck;

  
  BEGIN (*MakeAction*)
    oldright:=0;
    oldleft:=0;
    oldnumber:=65535;
    number:=GetNumber(WPtr,MPtr);
    IF MPtr^.type=checkMenu THEN             (*Setzt die durch selectedItems*)      FOR i:=1 TO MPtr^.numItems-1 DO
        IF i IN MPtr^.selectedItems THEN     (*definierten Haken            *)
          EXCL(MPtr^.selectedItems,i);
          GetPlace(WPtr,MPtr,top,bottom,left,right,i);
          DrawCheck(i);
        END (*IF*);
      END (*FOR*); 
    END (*IF*);
    DoSelect(WPtr,MPtr,top,bottom,left,right,number,
             oldtop,oldbottom,oldleft,oldright,oldnumber);
    REPEAT
      message:=GetMsg(WPtr^.userPort);            (*Sorgt dafür, das keine*) 
      IF message#NIL THEN ReplyMsg(message) END;  (*alten Nachrichten das Menu*)
    UNTIL message=NIL;                            (*beeinflussen*)
    mouse:=TRUE;
    LOOP
      WaitPort(WPtr^.userPort);
      message:=GetMsg(WPtr^.userPort);
      class:=message^.class;
      ReplyMsg(message);
      IF (mouseButtons IN class) THEN
        IF (MPtr^.type=selectMenu) OR (number=MPtr^.numItems-1) THEN
          RETURN number;
        ELSIF mouse THEN
            DrawCheck(number);
        END (*IF*);
        mouse:=NOT(mouse);
      ELSIF (rawKey IN class) THEN
        code:=message^.code;
        IF (code=4DH) OR (code=64) THEN       (*UP*)
          IF number=MPtr^.numItems-1 THEN
            number:=0;
          ELSE
            INC(number);
          END (*IF*);
          IF number=MPtr^.numItems THEN number:=0 END;
          DoSelect(WPtr,MPtr,top,bottom,left,right,number,
                   oldtop,oldbottom,oldleft,oldright,oldnumber);
        ELSIF code=4CH THEN    (*DOWN*)
          IF number>0 THEN
            DEC(number);
          ELSE
            number:=MPtr^.numItems-1
          END (*IF*);
          DoSelect(WPtr,MPtr,top,bottom,left,right,number,
                   oldtop,oldbottom,oldleft,oldright,oldnumber);
        ELSIF (code#oldcode+128) THEN (*SELECT*)
          IF (MPtr^.type=selectMenu) OR (number=MPtr^.numItems-1) THEN
            RETURN number;
          ELSE
            DrawCheck(number);
          END (*IF*);
        END (*IF*);
        oldcode:=code;
      ELSIF (mouseMove IN class) THEN
        number:=GetNumber(WPtr,MPtr);
        IF oldnumber#number THEN
          DoSelect(WPtr,MPtr,top,bottom,left,right,number,
                   oldtop,oldbottom,oldleft,oldright,oldnumber);
        END;
      END;
    END (*LOOP*);
END MakeAction;

  
  VAR i,selectedItem:CARDINAL;
      text:IntuiTextPtr;
      bm:BitMap;

  BEGIN (*DrawMenu*)
    IF (saveBack IN MPtr^.flags) THEN
      InitBitMap(bm,WPtr^.rPort^.bitMap^.depth,MPtr^.width,MPtr^.height);
      FOR i:=0 TO WPtr^.rPort^.bitMap^.depth-1 DO
        bm.planes[i]:=AllocRaster(MPtr^.width,MPtr^.height);
      END (*FOR*);
      CopyBitMap(WPtr,MPtr,bm);
    END (*IF*);
    IF (clearFirst IN MPtr^.flags) THEN
      ClearMenu(WPtr,MPtr);
    END (*IF*);
    IF (menuBorder IN MPtr^.flags) THEN
      MakeBorder(WPtr,MPtr^.leftEdge,MPtr^.topEdge,MPtr^.width-1,
                 MPtr^.height-1,3);
    END;
    
    IF (MPtr^.type=checkMenu) AND NOT(customCheckMark IN MPtr^.flags) THEN
      ChipCopy();             (*Daten für CheckMark ins Chip-Ram kopieren*)
    END (*IF*);
    IF (cycleItems IN MPtr^.flags) THEN
      vp:=ViewPortAddress(WPtr);      (*Color-Cycling starten*)
      WITH vertb DO
        node.type := interrupt;
        node.pri := -60;
        node.name := ADR("Cycle"); 
        data := NIL;     
        code := ADR(ColorCycle);
      END;
      bool:=TRUE; 
      count:=0; 
      i:=0;
      AddIntServer(5H,ADR(vertb));
    END (*IF*);

    text:=MPtr^.firstText;             (*Menu aufbauen*)
    PrintIText(WPtr^.rPort,text,MPtr^.leftEdge,MPtr^.topEdge);
    IF MPtr^.hailText#NIL THEN         (*Falls vorhanden, Überschrift setzen*)
      PrintIText(WPtr^.rPort,MPtr^.hailText,MPtr^.leftEdge,MPtr^.topEdge)
    END (*IF*);
    selectedItem:=MakeAction(WPtr,MPtr);  
    IF (cycleItems IN MPtr^.flags) THEN 
      RemIntServer(5H,ADR(vertb));
    END (*IF*);
    ClearMenu(WPtr,MPtr);
    IF (saveBack IN MPtr^.flags) THEN
      InsertOldBitMap(WPtr,MPtr,bm);
      FOR i:=0 TO WPtr^.rPort^.bitMap^.depth-1 DO
        FreeRaster(bm.planes[i],MPtr^.width,MPtr^.height);
      END (*FOR*);
    END (*IF*);
    RETURN selectedItem;
END DrawMenu;

END Menu.