(*---------------------------------------------------------------------------
    :Program.     DisCopper.mod
    :Contents.	  Zeigt CopLists und CprLists des aktiven View
    :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  01-May-89
    :Bugs.	  none
    :Remark.	  Benutzt InOut, also Ausgabe via '>filename' umleiten!
    :Remark.	  Kein schönes Modul, aber es ist ja eigentlich ein
    :Reamrk.	  Wegwerfprodukt.
---------------------------------------------------------------------------*)
IMPLEMENTATION MODULE DisCopper;

FROM SYSTEM	IMPORT	CAST, BITSET, ADR, ADDRESS;
IMPORT Graphics;
FROM Graphics	IMPORT	CopListPtr, CopInsPtr, CopIns, move, wait, next,
			UCopListPtr, ViewModes, ViewModeSet, ViewPortPtr;
FROM InOut	IMPORT	Write, WriteString, WriteInt, WriteHex, WriteLn;

TYPE
     UByte = [0..255];
     MyCopIns = RECORD
		  CASE :CARDINAL OF
		  | 0: w1,w2:BITSET;
		  | 1: reg, data: CARDINAL; (* move *)
		  | 2: vPos, hPos, vEn, hEn: UByte; (* wait *)
		  END;
		END;
     MyCopInsPtr = POINTER TO MyCopIns;


VAR
  GfxBase: Graphics.GfxBasePtr;
  a: MyCopInsPtr;
  i,max:INTEGER;


PROCEDURE Spc(Anz:INTEGER);
VAR i:INTEGER;
BEGIN
  FOR i:=1 TO Anz DO Write(' ') END
END Spc;

PROCEDURE ShowMode(v: ViewModeSet);
BEGIN
  IF hires IN v THEN WriteString('hires,') END;
  IF sprites IN v THEN WriteString('sprites,') END;
  IF vpHide IN v THEN WriteString('vpHide,') END;
  IF ham IN v THEN WriteString('ham,') END;
  IF dualpf IN v THEN WriteString('dualpf,') END;
  IF extraHalfbrite IN v THEN WriteString('EHB,') END;
  IF pfba IN v THEN WriteString('pfba,') END;
  IF lace IN v THEN WriteString('lace,') END;
END ShowMode;

VAR
  LastVal: CARDINAL; (* für High-Werte HL *)

PROCEDURE ShowReg(reg,val:CARDINAL);
TYPE Double=RECORD
		CASE :INTEGER OF
		| 0: y,x:UByte;
		| 1: i: INTEGER;
		| 3: c: CARDINAL;
		| 2: b: BITSET;
		END
	    END;
VAR D: Double;

  PROCEDURE ShowVal;
  BEGIN
    WriteString(' ($');
    WriteHex(LastVal*65536+val,8);
    Write(')');
  END ShowVal;

BEGIN
      D.c:=val;
      reg:=CAST(CARDINAL,CAST(BITSET,reg)-BITSET{9..15});
      CASE reg OF
      | 80H: WriteString('Cop1LcH');
      | 82H: WriteString('Cop1LcL');
      	     ShowVal;
      | 84H: WriteString('Cop2LcH');
      | 86H: WriteString('Cop2LcL');
      	     ShowVal;
      | 88H: WriteString('CopJmp1');
      | 8AH: WriteString('CopJmp2');
      | 8EH:	WriteString('DiWStrt (y=');
		WriteInt(val/256,0);
		WriteString(', x=');
		WriteInt(val REM 256,0);
		Write(')');
      | 90H:	WriteString('DiWStop (y=');
		IF D.y>=128 THEN
		  WriteInt(D.y,0);
		ELSE
		  WriteInt(D.y+256,0);
		END;
		WriteString(', x=');
		WriteInt(D.x+256,0);
		Write(')');
      | 92H: WriteString('DDFStrt');
      | 94H: WriteString('DDFStop');
      | 96H: WriteString('DMACon');
      | 9AH: WriteString('IntEna');
      | 9CH: WriteString('IntReq');
      | 0E0H..0FEH:
      		DEC(reg,0DCH);
      		WriteString('Bpl');
      		WriteInt(reg/4,1);
      		IF (reg REM 4) = 0 THEN
		  WriteString('PtH');
		ELSE
		  WriteString('PtL');
		  ShowVal;
		END;
      | 100H: WriteString('BplCon0 (');
		IF 15 IN D.b THEN
		  WriteString('HiRes, ');
		  EXCL(D.b,15);
		END;
		WriteInt(D.i/4096,0);
		WriteString(' Planes, ');
		IF 11 IN D.b THEN
		  WriteString('Ham, ');
		END;
		IF 10 IN D.b THEN
		  WriteString('DblPf, ');
		END;
		IF 9 IN D.b THEN
		  WriteString('Color, ');
		END;
		IF 2 IN D.b THEN
		  WriteString('Lace, ');
		END;
		Write(')');
      | 102H: WriteString('BplCon1 (Pf2H=');
		WriteInt(D.x/16,0);
		WriteString(', Pf1H=');
		WriteInt(D.x REM 16,0);
		Write(')');
      | 104H: WriteString('BplCon2 (');
		IF 6 IN D.b THEN
		  WriteString('Pf2Pri)');
		ELSE
		  WriteString('Pf1Pri)');
		END;
      | 108H: WriteString('Bpl1Mod (Val=');
      		WriteInt(D.i,0);
      		Write(')');
      | 10AH: WriteString('Bpl2Mod (Val=');
      		WriteInt(D.i,0);
      		Write(')');
      | 120H..13EH:
		DEC(reg,120H);
		WriteString('Spr');
		Write(CHAR(reg/4+30H));
		WriteString('Pt');
		IF (reg REM 4)=0 THEN
		  Write('H')
		ELSE
		  Write('L');
		  ShowVal;
		END;
      | 140H..17EH:
		DEC(reg,140H);
		WriteString('Spr');
		Write(CHAR(reg/8+30H));
		CASE reg REM 8 OF
		| 0: WriteString('Pos');
		| 2: WriteString('Ctl');
		| 4: WriteString('DatA');
		| 6: WriteString('DatB');
		END;
      | 180H..1BEH: WriteString('Color'); WriteInt((reg-180H)/2,1);
      | ELSE  WriteHex(reg,4);
      END; (* case *)
      LastVal:=val;
END ShowReg;

PROCEDURE ShowIns(i:CopInsPtr; Level:INTEGER); FORWARD;

PROCEDURE DisCopList(c:CopListPtr; Level:INTEGER);
BEGIN
  Spc(Level);
  WriteString('CopList: ');WriteHex(ADR(c^),8); WriteLn;
  IF c#NIL THEN
    IF c^.copIns#NIL THEN
     Spc(Level+2); WriteString('copIns:'); WriteLn;
     ShowIns(c^.copIns,Level+2);
    END;
  END; (* if #NIL *)
  Spc(Level); WriteString('End CopList'); WriteLn;
END DisCopList;

PROCEDURE ShowIns(i:CopInsPtr; Level:INTEGER);
VAR op: CARDINAL;
BEGIN
  Spc(Level); WriteString('CopIns: ');WriteHex(ADR(i^),8); WriteLn;
  IF i#NIL THEN
   LOOP
    Spc(Level+2);
    WITH i^ DO
      op:=opCode;
      IF 15 IN CAST(BITSET,op) THEN
        EXCL(CAST(BITSET,op),15);
        WriteString('lof');
      END;
      IF 14 IN CAST(BITSET,op) THEN
        EXCL(CAST(BITSET,op),14);
        WriteString('sht');
      END;
      CASE op OF
      | move:	WriteString('Move $');
      		WriteHex(CAST(CARDINAL,destData),4);
      		Write(',');
      		ShowReg(CAST(CARDINAL,destAddr),CAST(CARDINAL,destData));
      		WriteLn;
      | wait:	WriteString('Wait ');
      		WriteInt(vWaitPos,3);
      		Write(',');
      		WriteInt(hWaitPos,3);
      		WriteLn;
      		IF vWaitPos>1000 THEN EXIT END;
      | next:	WriteString('next:'); WriteLn;
      		i:=nxtlist^.copIns;
      		DEC(i,SIZE(CopIns)); (* wird gleich wieder erhöht *)
      END;
    END; (* with *);
    INC(i,SIZE(CopIns));
   END; (* LOOP *)
   Spc(Level); WriteString('End CopIns');
   WriteLn;
  END; (* if #NIL *)
END ShowIns;

PROCEDURE Dis(cop: MyCopInsPtr):BOOLEAN; (* true = ende hwait -1 *)
VAR Blit, Last:BOOLEAN;
    My: MyCopIns;
BEGIN
  My:=cop^;
  Last:=TRUE;
  WriteString('  ');
  WITH My DO
    IF 0 IN w1 THEN
      IF 15 IN w2 THEN
        Blit:=TRUE;
      ELSE
        Blit:=FALSE;
        INCL(w2,15);
      END;
      EXCL(w1,0);
      IF 0 IN w2 THEN (* skip *)
        EXCL(w2,0);
        WriteString('SKIP ');
      ELSE (* wait *)
        WriteString('WAIT ');
        Last:=(hPos#254);
      END;
      WriteInt(vPos,3); Write(',');
      WriteInt(hPos,3); WriteString(',$');
      WriteHex(vEn,2);
      WriteHex(hEn,2);
      IF Blit THEN
        (* WriteString(', no_Blitter'); *)
      ELSE
        WriteString(', wait_Blitter');
      END;
    ELSE (* move *)
      WriteString('MOVE $');
      WriteHex(data,4);
      Write(',');
      ShowReg(reg,data);
    END; (* if IN *)
  END; (* with My *)
  WriteLn;
  RETURN Last;
END Dis;

PROCEDURE ShowIt;
VAR u: UCopListPtr;
    v: ViewPortPtr;
BEGIN
  GfxBase:=ADR(Graphics);
  a:=GfxBase^.actiView^.lofCprList^.start;
  IF a#NIL THEN
    WriteString('View.lofCprLst:'); WriteLn;
    WHILE Dis(a) (* AND (i<50)*) DO
      INC(a,4);
    END;
  END;
  IF Graphics.lace IN GfxBase^.actiView^.modes THEN
    a:=GfxBase^.actiView^.shfCprList^.start;
    IF a#NIL THEN
      WriteString('View.shfCprLst:'); WriteLn;
      WHILE Dis(a) (* AND (i<50)*) DO
        INC(a,4);
      END;
    END;
  END;
  WriteLn;
  v:=GfxBase^.actiView^.viewPort;
  WHILE v#NIL DO
    WriteString('ViewPort: '); WriteHex(CAST(LONGINT,v),8); WriteLn;
    WITH v^ DO
      WriteString('dWidth:'); WriteInt(dWidth,4); WriteLn;
      WriteString('dHeight:'); WriteInt(dHeight,4); WriteLn;
      WriteString('dxOffset:'); WriteInt(dxOffset,4); WriteLn;
      WriteString('dyOffset:'); WriteInt(dyOffset,4); WriteLn;
      WriteString('modes: '); ShowMode(modes); WriteLn;
      IF vpHide IN modes THEN
        WriteString('Hidden!'); WriteLn;
      ELSE
        WriteString('dspIns:'); WriteLn;
        DisCopList(dspIns,0); WriteLn;
        WriteString('sprIns:'); WriteLn;
        DisCopList(sprIns,0); WriteLn;
        WriteString('clrIns:'); WriteLn;
        DisCopList(clrIns,0); WriteLn;
        WriteString('uCopIns:'); WriteLn;
        u:=uCopIns;
        IF u=NIL THEN WriteString('NIL'); WriteLn; END;
        WHILE u#NIL DO
          DisCopList(u^.firstCopList,0);
          u:=u^.next
        END;
      END;
    END; (* with viewPort *)
    WriteLn;
    v:=v^.next;
  END;
END ShowIt;

END DisCopper.mod