(******************************************************************
  :Program.    ShowILBM.mod
  :Author.     Stefan Salewski
  :Address.    Stolper Weg 3, D-2160 Stade
  :Version.    1.1
  :Copyright.  Public Domain
  :Language.   Modula-2
  :Translator. M2Amiga AMSoft V3.2d
  :Imports.    ILBMHandler V1.1, MakeMenu
  :Contents.   Demo for ILBMHandler, shows ILBM-Pictures
  :History.    V1.1 1.Jul-89
*******************************************************************)

MODULE ShowILBM;
(*  
  Created:   14-16.3.89 by
             Stefan Salewski
             Stolper Weg 3
             2160 Stade   West-Germany
             Tel: 04141/61130
             
  Note: compiled with AMIGA Modula-2 System by AMSoft, Version 3.2d
   
  This Module may be freely copied. But please
  leave my name in. Thanks....Stefan 
*)
  FROM Intuition IMPORT ScreenPtr,NewScreen,OpenScreen,CloseScreen,
                        CurrentTime,ScreenToFront,IDCMPFlags,
                        IDCMPFlagSet,OpenWindow,CloseWindow,Menu,
                        SetMenuStrip,ClearMenuStrip,NewWindow,WindowPtr,
                        WindowFlags,WindowFlagSet,customScreen,MenuPtr,
                        IntuiMessagePtr,menuNull,MenuItemPtr,ItemAddress,
                        ActivateWindow,DisplayBeep,RememberPtr,ScreenFlags;
  FROM Dos IMPORT Delay;
  FROM Exec IMPORT GetMsg,ReplyMsg,UByte;
  FROM Arguments IMPORT NumArgs,GetArg;
  FROM Arts IMPORT TermProcedure,Assert,CurrentLevel;
  FROM SYSTEM IMPORT ADR;
  FROM ILBMHandler IMPORT InitScreen,ReadInfo,ReadBody,DimOn,DimOff,
                          StartCycling,EndCycling,ILBMInfo,MaskPlane,
                          CenterOverScanScreen;
  FROM MakeMenu IMPORT MenuRecord,InitMenu,FreeMenu,ItemNum;
  
  CONST
    TimeToWait=10;
  VAR
    myLevel:INTEGER;
    arg:ARRAY[0..80] OF CHAR;
    screenPtr:ARRAY BOOLEAN OF ScreenPtr;
    windowPtr:ARRAY BOOLEAN OF WindowPtr;
    info:ARRAY BOOLEAN OF ILBMInfo;
    cyclingIsOn:ARRAY BOOLEAN OF BOOLEAN;
    newScreen:NewScreen;
    newWindow:NewWindow;
    remKey:RememberPtr;
    numArgs,count,len:INTEGER;
    msgPtr:IntuiMessagePtr;
    menuIPtr:MenuItemPtr;
    class:IDCMPFlagSet;
    code:CARDINAL;
    itemNr:CARDINAL;
    bodyPos:LONGINT;
    tag:BOOLEAN;
    exit,wait,next,loop,cycling:BOOLEAN;
    firstMenu:MenuPtr;
    secs,oldSecs,micros:LONGCARD;

  PROCEDURE MakeItDark(t:BOOLEAN;v:UByte);
  BEGIN
    IF screenPtr[t]#NIL THEN
      IF windowPtr[t]#NIL THEN
        ClearMenuStrip(windowPtr[t]);
      END;
      IF cyclingIsOn[t] THEN
        EndCycling(info[t]);
        cyclingIsOn[t]:=FALSE;
      END;
      DimOff(screenPtr[t],info[t],v);
    END;
  END MakeItDark;
    
  PROCEDURE CloseAll(t:BOOLEAN);
  BEGIN
    IF screenPtr[t]#NIL THEN
      IF cyclingIsOn[t] THEN
        EndCycling(info[t]);
        cyclingIsOn[t]:=FALSE;
      END;
      IF windowPtr[t]#NIL THEN
        ClearMenuStrip(windowPtr[t]);
        CloseWindow(windowPtr[t]);
        windowPtr[t]:=NIL;
      END;
      CloseScreen(screenPtr[t]);
      screenPtr[t]:=NIL;
    END;
  END CloseAll;
  
  PROCEDURE CleanUp;
  BEGIN
    IF myLevel>=CurrentLevel() THEN
      IF exit THEN
        MakeItDark(tag,0)
      ELSE
        MakeItDark(tag,2)
      END;
      CloseAll(TRUE);
      CloseAll(FALSE);
      IF remKey#NIL THEN
        FreeMenu(remKey)
      END;
    END;
  END CleanUp;
  
  PROCEDURE InitMyMenu;
    VAR menurecords:ARRAY[0..0] OF MenuRecord;
  BEGIN
    WITH menurecords[0] DO
      mname:='© S.Salewski';
      anzahlItems:=5;
      WITH mItems[0] DO
        iname:='Wait/Go';
        commandKey:='W';
        anzahlSubitems:=0;
      END;
      WITH mItems[1] DO
        iname:='Next Picture';
        commandKey:='N';
        anzahlSubitems:=0;
      END;
      WITH mItems[2] DO
        iname:='Cycling On/Off';
        commandKey:='C';
        anzahlSubitems:=0;
      END;
      WITH mItems[3] DO
        iname:='Loop On/Off';
        commandKey:='L';
        anzahlSubitems:=0;
      END;
      WITH mItems[4] DO
        iname:='Exit';
        commandKey:='E';
        anzahlSubitems:=0;
      END;
    END;
    InitMenu(menurecords,firstMenu,remKey);
  END InitMyMenu;
  
  PROCEDURE InitWindow(s:ScreenPtr;VAR w:NewWindow);
  BEGIN
    WITH w DO
      leftEdge:=0;
      topEdge:=0;
      width:=s^.width;
      height:=s^.height;
      detailPen:=0;
      blockPen:=1;
      idcmpFlags:=IDCMPFlagSet{menuPick};
      flags:=WindowFlagSet{borderless,noCareRefresh};
      firstGadget:=NIL;
      checkMark:=NIL;
      title:=NIL;
      screen:=s;
      bitMap:=NIL;
      type:=customScreen;
    END;
  END InitWindow;
  
  PROCEDURE GetMenuMessage(t:BOOLEAN);
  BEGIN
    REPEAT
      IF windowPtr[t]#NIL THEN
        msgPtr:=GetMsg(windowPtr[t]^.userPort); 
        IF msgPtr#NIL THEN
          class:=msgPtr^.class;
          code:=msgPtr^.code;
          ReplyMsg(msgPtr);
          IF class=IDCMPFlagSet{menuPick} THEN
            WHILE code#menuNull DO
              itemNr:=ItemNum(code);
              CASE itemNr OF
                |0:wait:=NOT wait
                |1:next:=TRUE;
                |2:cycling:=NOT cycling;
                   IF cycling AND NOT cyclingIsOn[t] THEN
                     cyclingIsOn[t]:=StartCycling(info[t],screenPtr[t])
                   ELSE
                     IF cyclingIsOn[t] THEN
                       EndCycling(info[t]);
                       DimOn(screenPtr[t],info[t],0);
                       cyclingIsOn[t]:=FALSE
                     END
                   END;
                |3:loop:=NOT loop
                |4:exit:=TRUE;
              END;
              menuIPtr:=ItemAddress(firstMenu,code);
              code:=menuIPtr^.nextSelect;
            END;
          END
        END;
      END;
      Delay(10);
      CurrentTime(ADR(secs),ADR(micros));
    UNTIL ((secs>oldSecs+TimeToWait) AND (NOT wait)) OR exit OR next;
    next:=FALSE;
    oldSecs:=secs;
  END GetMenuMessage;

BEGIN
  numArgs:=NumArgs();
  Assert(numArgs#0,ADR('Use ILBM-File as Argument'));
  remKey:=NIL;
  screenPtr[TRUE]:=NIL;
  screenPtr[FALSE]:=NIL;
  windowPtr[TRUE]:=NIL;
  windowPtr[FALSE]:=NIL;
  cyclingIsOn[TRUE]:=FALSE;
  cyclingIsOn[FALSE]:=FALSE;
  myLevel:=CurrentLevel();
  TermProcedure(CleanUp);
  InitMyMenu;
  tag:=TRUE;
  exit:=FALSE;
  wait:=FALSE;
  next:=FALSE;
  cycling:=TRUE;
  loop:=FALSE;
  count:=0;
  CurrentTime(ADR(secs),ADR(micros));
  oldSecs:=secs-TimeToWait;
  REPEAT
    WHILE NOT exit AND ((count<numArgs) OR loop) DO
      count:=count MOD numArgs;
      INC(count);
      tag:=NOT tag;
      GetArg(count,arg,len);
      IF (len#0) AND ReadInfo(arg,info[tag],bodyPos) THEN
        InitScreen(newScreen,info[tag],TRUE);
        INCL(newScreen.type,screenBehind);
        screenPtr[tag]:=OpenScreen(newScreen);
        IF screenPtr[tag]#NIL THEN
          CenterOverScanScreen(screenPtr[tag]);
          InitWindow(screenPtr[tag],newWindow);
          windowPtr[tag]:=OpenWindow(newWindow);
          DimOff(screenPtr[tag],info[tag],0);
          IF ReadBody(arg,screenPtr[tag]^.rastPort.bitMap^,bodyPos,
                      info[tag].bmhd.width,
                      0,0,0,0,info[tag].bmhd.width,info[tag].bmhd.height,
                      MaskPlane(info[tag]),(info[tag].bmhd.compression=1)) THEN
            GetMenuMessage(NOT tag);
            MakeItDark(NOT tag,2);
            IF windowPtr[tag]#NIL THEN
              IF SetMenuStrip(windowPtr[tag],firstMenu) THEN END;
            END;
            ScreenToFront(screenPtr[tag]);
            CloseAll(NOT tag);
            IF NOT exit THEN
              DimOn(screenPtr[tag],info[tag],2);
              IF cycling THEN
                cyclingIsOn[tag]:=StartCycling(info[tag],screenPtr[tag])
              ELSE
                cyclingIsOn[tag]:=FALSE
              END;
              IF windowPtr[tag]#NIL THEN  
                ActivateWindow(windowPtr[tag])
              END;
            END
          END;
        END
      ELSE
        tag:=NOT tag
      END
    END;
    GetMenuMessage(tag);  
  UNTIL (NOT loop) OR exit;
END ShowILBM.