(* $R- $S- $V- *)

MODULE AnotherCycle;

(* Eine Variation des RainbowCycle-Programms. *)

FROM Arts      IMPORT Assert;
FROM SYSTEM    IMPORT ADR,INLINE,LONGSET;
FROM Intuition IMPORT RethinkDisplay,NewWindow,OpenWindow,CloseWindow,
                      WindowFlags,WindowFlagSet,IDCMPFlags,IDCMPFlagSet,
                      ScreenFlags,ScreenFlagSet,WindowPtr,ViewPortAddress,
                      RemakeDisplay;
FROM Graphics  IMPORT UCopListPtr,ViewPortPtr,FreeVPortCopLists,
                      CopListPtr,WaitTOF;
FROM GfxMacros IMPORT CMOVE,CWAIT,CEND;
FROM Hardware  IMPORT custom;
FROM Exec      IMPORT AllocMem,MemReqs,MemReqSet,SetSignal,Forbid,Permit;

VAR MyWindow    : NewWindow;
    MyWindowPtr : WindowPtr;
    ViewPort    : ViewPortPtr;
    MyCopperlist: UCopListPtr;
    Cols        : ARRAY[0..61] OF CARDINAL;
    i,j         : INTEGER;
    dsp,spr,clr : CopListPtr;
    Color       : CARDINAL;

BEGIN

  (* Window definieren ... *)

  WITH MyWindow DO
    leftEdge:=0; topEdge:=0; width:=640; height:=11;
    detailPen:=1; blockPen:=0; idcmpFlags:=IDCMPFlagSet{closeWindow};
    flags:=WindowFlagSet{windowDrag,windowDepth,windowClose};
    firstGadget:=NIL; checkMark:=NIL; title:=ADR("ANOTHER CYCLE!");
    screen:=NIL; bitMap:=NIL; minWidth:=0; maxWidth:=0; minHeight:=0;
    maxHeight:=0; type:=ScreenFlagSet{wbenchScreen};
  END;

  (* Farben definieren ... Silber- und Goldtöne! *)

  Cols[0]:=0000H; Cols[1]:=0111H; Cols[2]:=0222H; Cols[3]:=0333H;
  Cols[4]:=0444H; Cols[5]:=0555H; Cols[6]:=0666H; Cols[7]:=0777H;
  Cols[8]:=0888H; Cols[9]:=0999H; Cols[10]:=0AAAH; Cols[11]:=0BBBH;
  Cols[12]:=0CCCH; Cols[13]:=0DDDH; Cols[14]:=0EEEH; Cols[15]:=0FFFH;
  Cols[16]:=0EEEH; Cols[17]:=0DDDH; Cols[18]:=0CCCH; Cols[19]:=0BBBH;
  Cols[20]:=0AAAH; Cols[21]:=0999H; Cols[22]:=0888H; Cols[23]:=0777H;
  Cols[24]:=0666H; Cols[25]:=0555H; Cols[26]:=0444H; Cols[27]:=0333H;
  Cols[28]:=0222H; Cols[29]:=0111H; Cols[30]:=0000H; Cols[31]:=0110H;
  Cols[32]:=0220H; Cols[33]:=0330H; Cols[34]:=0440H; Cols[35]:=0550H;
  Cols[36]:=0660H; Cols[37]:=0770H; Cols[38]:=0880H; Cols[39]:=0990H;
  Cols[40]:=0AA0H; Cols[41]:=0BB0H; Cols[42]:=0CC0H; Cols[43]:=0DD0H;
  Cols[44]:=0EE0H; Cols[45]:=0FF0H; Cols[46]:=0EE0H; Cols[47]:=0DD0H;
  Cols[48]:=0CC0H; Cols[49]:=0BB0H; Cols[50]:=0AA0H; Cols[51]:=0990H;
  Cols[52]:=0880H; Cols[53]:=0770H; Cols[54]:=0660H; Cols[55]:=0550H;
  Cols[56]:=0440H; Cols[57]:=0330H; Cols[58]:=0220H; Cols[59]:=0110H;
  Cols[60]:=0000H;

  (* Window öffnen usw. *)

  MyWindowPtr:=OpenWindow(MyWindow);
  Assert(MyWindowPtr#NIL,ADR("Konnte Window nicht öffnen!"));

  ViewPort:=ViewPortAddress(MyWindowPtr);
  j:=1;

  (* Hier werden Copperlists generiert, bis der Benutzer das
     Schließsymbol des Windows angeklickt hat. *)

  WHILE NOT (MyWindowPtr^.userPort^.sigBit IN
             SetSignal(LONGSET{},LONGSET{}) ) DO

    (* Speicher beschaffen ... *)

    MyCopperlist:=AllocMem(SIZE(MyCopperlist^),MemReqSet{public,memClear});

    (* Hier wird eine Copperlist erstellt. *)

    FOR i:=0 TO 60 DO

      Color:=Cols[(i+j) MOD 61];
      CWAIT(MyCopperlist,i*(256 DIV 61),0);
      CMOVE(MyCopperlist,ADR(custom.color[1]),Color);

    END;

    CEND(MyCopperlist,0,0);
    INC(j);

    (* Die alten Intermediate-Lists müssen gerettet werden! *)

    dsp:=ViewPort^.dspIns;
    spr:=ViewPort^.sprIns;
    clr:=ViewPort^.clrIns;

    (* Multitasking abschalten - bei solchen
       Manipulationen immer ratsam! *)

    Forbid;

    (* Jetzt müssen die alten Instruktionslisten gelöscht werden! *)

    ViewPort^.dspIns:=NIL;
    ViewPort^.sprIns:=NIL;
    ViewPort^.clrIns:=NIL;

    (* Nur noch die eigene Copperlist wird freigegeben! *)

    FreeVPortCopLists(ViewPort);

    (* An dieser Stelle werden die alten *)
    (* Zwischen-Listen wieder gesetzt.   *)

    ViewPort^.dspIns:=dsp;
    ViewPort^.sprIns:=spr;
    ViewPort^.clrIns:=clr;

    (* Die eigene Copperlist wird eingebunden. *)

    ViewPort^.uCopIns:=MyCopperlist;

    (* Nun kann das Multitasking wieder eingeschaltet werden. *)

    Permit;

    (* Die eigene Copperlist sollte nach Möglichkeit
       auch dargestellt werden können. *)

    WaitTOF;
    RethinkDisplay;

  END;

  (* Das Ende ... *)

  FreeVPortCopLists(ViewPort);
  RemakeDisplay;

  CloseWindow(MyWindowPtr);

END AnotherCycle.