(*---------------------------------------------------------------------------
    :Program.     Copper.mod
    :Contents.	  Spielerei und Test für DisCopper und PatchMrg
    :Author.      Bernd Preusing
    :Address.	  Gerhardstr. 16  D-2200 Elmshorn
    :Phone.	  04121/22486
    :Copyright.	  Public Domain
    :Language.	  Modula-2
    :Translator.  M2Amiga V3.2e
    :History.	  V 1.0   May 89   Preusing
    :Imports.	  DisCopper 1.0 (Preusing) BackDrop 1.0 (Preusing)
    :Usage.	  'Copper'
---------------------------------------------------------------------------*)
MODULE Copper;

FROM SYSTEM	IMPORT	ADR;
FROM Arts	IMPORT	Assert;
FROM Exec	IMPORT	AllocMem, FreeMem, AllocAbs, MemReqs, MemReqSet,
			Forbid, Permit;
FROM Graphics	IMPORT	UCopListPtr, CMove, CWait, CBump, Move, Draw,
			FreeCopList, UCopperListInit;
FROM GfxMacros	IMPORT	CMOVE, CWAIT, CEND;
FROM Intuition	IMPORT	ScreenPtr, OpenWorkBench, RethinkDisplay;
FROM BackDrop	IMPORT	OpenBackDrop, CloseBackDrop, BdRp, BdScreen;
FROM Hardware	IMPORT	custom;
FROM Dos	IMPORT	Delay;
FROM DisCopper	IMPORT	ShowIt;
FROM InOut	IMPORT	WriteString, ReadInt, Read, OpenOutput;


VAR ActScreen: ScreenPtr;
    U: UCopListPtr;
    DEPTH, WIDTH, HEIGHT, WH:INTEGER;
    OwnS:INTEGER;
    i: INTEGER;


PROCEDURE MakeUCopList():UCopListPtr;
VAR u: UCopListPtr;
BEGIN
  u:=AllocMem(SIZE(u^),MemReqSet{public, memClear});
  Assert(u#NIL,ADR('no mem for UCopList'));
  UCopperListInit(u,16); (* Größe völlig egal! *)
  RETURN u
END MakeUCopList;

PROCEDURE FreeUCopList(VAR UPtr:UCopListPtr; u:UCopListPtr);
VAR temp: UCopListPtr;
BEGIN
  Forbid;
  temp:=ADR(UPtr); (* Trick: erster gleich UCopList (.next = erste Comp.!) *)
  WHILE (temp#NIL) AND (temp^.next#u) DO
    temp:=temp^.next;
  END;
  IF temp#NIL THEN
    temp^.next:=temp^.next^.next; (* auslinken *)
    FreeCopList(u^.firstCopList);
    FreeMem(u,SIZE(u^));
  END;
  Permit;
END FreeUCopList;

PROCEDURE LinkUCopList(VAR UPtr: UCopListPtr; u: UCopListPtr);
VAR temp: UCopListPtr;
BEGIN
  Forbid;
  IF UPtr=NIL THEN
    UPtr:=u
  ELSE
    temp:=UPtr;
    WHILE temp^.next#NIL DO
      temp:=temp^.next
    END;
    temp^.next:=u;
  END;
  Permit;
END LinkUCopList;

PROCEDURE AskValues;
BEGIN
  OwnS:=0;
  WriteString('Own Screen (1=ja)?'); ReadInt(OwnS);
  IF OwnS=1 THEN
    WriteString('DEPTH?'); ReadInt(DEPTH);
    WriteString('WIDTH?'); ReadInt(WIDTH);
    WriteString('HEIGHT?'); ReadInt(HEIGHT);
    WH:=HEIGHT-12;
  END;
  WriteString('Outputfile? ');
  OpenOutput('');
END AskValues;

BEGIN
  AskValues;
  IF OwnS#1 THEN
    ActScreen:=OpenWorkBench();
    WIDTH:=640; HEIGHT:=256; DEPTH:=2;
  ELSE
    OpenBackDrop(DEPTH,WIDTH,HEIGHT-12,ADR('meiner'));
    Move(BdRp,0,0);
    Draw(BdRp,WIDTH-1,WH-1);
    Move(BdRp,0,0);
    Draw(BdRp,WIDTH-1,0);
    Draw(BdRp,WIDTH-1,WH-1);
    Draw(BdRp,0,WH-1);
    Draw(BdRp,0,0);
    ActScreen:=BdScreen;
  END;

  U:=MakeUCopList();
  CWAIT(U,HEIGHT/4,10);
  CMOVE(U,ADR(custom.color[0]),00F0H);
  CWAIT(U,HEIGHT/2,20);
  CWAIT(U,HEIGHT/2,20); (* Test auf doppeltes Wait *)
  CMOVE(U,ADR(custom.color[0]),0F00H);
  CWAIT(U,3*HEIGHT/4,20);
  CMOVE(U,ADR(custom.color[0]),000FH);
  CWAIT(U,3*HEIGHT/4,180);
  CMOVE(U,ADR(custom.color[0]),0001H);
  CWAIT(U,256,0);
  CEND(U,0,0);
  LinkUCopList(ActScreen^.viewPort.uCopIns,U);
  RethinkDisplay;

  Delay(10*50);
  ShowIt;
  IF OwnS#1 THEN (* sonst automatisch! *)
    FreeUCopList(ActScreen^.viewPort.uCopIns,U);
    RethinkDisplay;
  END;

(* CloseBackDrop; Rest vom SpeicherTest 
  Delay(1*50);
  Assert(AllocAbs(SIZE(U^),U)=U,ADR('UCopList nicht freigegeben!'));
  FreeMem(U,SIZE(U^));
*)
END Copper.