(*---------------------------------------------------------------------------
    :Program.    Rotate.mod
    :Author.     Fridtjof Siebert
    :Address.    Nobileweg 67, D-7-Stgt-40
    :Phone.      0711/822509
    :Shortcut.   [fbs]
    :Version.    0.1
    :Date.       19-Feb-88
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga v3.1d
    :Imports.    IFFSupport.mod   [fbs], AMOK #6
    :Imports.    ControlIntuition [fbs], AMOK #1
    :Contents.   Small Graphics Demonstration
    :Usage.      Rotate <IFF-Pic>
    :Bugs.       Eats about 3K of memory. Sorry!
---------------------------------------------------------------------------*)

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

MODULE Rotate;

FROM SYSTEM           IMPORT INLINE, ADDRESS, ADR, CAST;
FROM Arts             IMPORT TermProcedure, Terminate;
FROM Arguments        IMPORT NumArgs, GetArg;
FROM Exec             IMPORT FreeMem, AllocMem, MemReqs, MemReqSet;
FROM Graphics         IMPORT BitMapPtr, BitMap, WaitBOVP, ViewPort, RasInfo,
                             InitVPort, GetColorMap, FreeColorMap, View,
                             InitView, MakeVPort, MrgCop, LoadView, ViewPtr,
                             SetRGB4CM, FreeSprite, ViewModes, ViewModeSet,
                             UCopList, FreeCopList;
FROM GfxMacros        IMPORT CINIT, CMOVE, CWAIT, CEND;
FROM Hardware         IMPORT custom;
FROM Intuition        IMPORT ViewAddress, ScreenPtr, WindowPtr;
FROM IFFSupport       IMPORT ReadILBM, ReadILBMFlags, ReadILBMFlagSet, NuScreen,
                             IFFInfo;
FROM ControlIntuition IMPORT DisableIntuition, EnableIntuition;

(* I'm sorry for my choatic programming style. So don't look at this source
   if you want to keep your good style! *)

TYPE LI = LONGINT;

CONST
  D0 = 0;
  A0 = 8;
  A1 = 9;

VAR
  scr: ScreenPtr;
  win: WindowPtr;
  Name: ARRAY[0..79] OF CHAR;
  length: INTEGER;
  bitMap: BitMapPtr;
  vBitMap: BitMap;
  y,i,j,dx,p: LI;
  a,b: ADDRESS;
  Sinus: POINTER TO ARRAY[0..64] OF INTEGER;
  SmallSine: POINTER TO ARRAY[0..31] OF CARDINAL;
  MaxAdr: LI;
  Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb);
  vPort: ViewPort;
  rInfo: RasInfo;
  view: View;
  iview: ViewPtr;
  cList: UCopList;

PROCEDURE CopyBytes(num{D0}: INTEGER; from{A0},to{A1}: ADDRESS);
BEGIN INLINE(
  022D8H,051C8H,   (* loop: move.l (A0)+,(A1)+ *)
  0FFFCH       );  (*       dbra   D0,loop     *)
END CopyBytes;

(*------  Data:  ------*)

PROCEDURE Dat(); (* $E- Contains Data *)
BEGIN INLINE(
        0,  402,  804, 1205, 1606, 2006, 2404, 2801,   (*  0.. 7 *)
     3196, 3590, 3981, 4370, 4756, 5139, 5520, 5897,   (*  8..15 *)
     6270, 6640, 7005, 7366, 7723, 8076, 8423, 8765,   (* 16..23 *)
     9102, 9434, 9760,10080,10394,10702,11003,11297,   (* 24..31 *)
    11585,11866,12140,12406,12665,12916,13160,13395,   (* 32..39 *)
    13623,13842,14053,14255,14449,14635,14811,14978,   (* 40..47 *)
    15137,15286,15426,15557,15678,15790,15893,15986,   (* 48..55 *)
    16069,16143,16207,16261,16305,16340,16364,16379,   (* 56..63 *)
    16384);                                            (* 64     *)
END Dat;

PROCEDURE Dat2(); (* $E- *)
BEGIN
  INLINE(8,9,11,12,13,14,15,15,15,15,14,13,12,11,9,8);
  INLINE(7,6, 4, 3, 2, 1, 0, 0, 0, 0, 1, 2, 3, 4,6,7);

END Dat2;

(*------  CleanUp:  ------*)

PROCEDURE CleanUp();

VAR psize: LONGINT;

BEGIN
  IF bitMap#NIL THEN
    WITH bitMap^ DO
      psize := LI(bytesPerRow) * LI(rows);
      WHILE depth#0 DO DEC(depth); FreeMem(planes[depth],psize) END;
      IF vBitMap.planes[0]#NIL THEN FreeMem(vBitMap.planes[0],psize) END;
    END;
    FreeMem(bitMap,SIZE(BitMap));
  END;
  IF vPort.uCopIns#NIL THEN FreeCopList(vPort.uCopIns^.firstCopList) END;
  IF vPort.colorMap#NIL THEN FreeColorMap(vPort.colorMap) END;
  IF iview#NIL THEN LoadView(iview) END;
END CleanUp;

(*------  MAIN:  ------*)

BEGIN
  Sinus := ADR(Dat);
  SmallSine := ADR(Dat2);
  bitMap := NIL; vBitMap.planes[0] := NIL; vPort.colorMap := NIL;
  iview := NIL; vPort.uCopIns := NIL;
  TermProcedure(CleanUp);

  IF NumArgs()#0 THEN GetArg(1,Name,length) ELSE Terminate(0) END;

  IF NOT ReadILBM(Name,ReadILBMFlagSet{front,dontopen,visible},scr,win) THEN
    Terminate(0) END;

  bitMap := NuScreen.customBitMap;
  WITH bitMap^ DO
    vBitMap := bitMap^;
    vBitMap.depth := 1;
    vBitMap.planes[0] := AllocMem(LI(bytesPerRow)*LI(rows),MemReqSet{chip,memClear});
    IF vBitMap.planes[0]=NIL THEN Terminate(0) END;

    InitVPort(vPort);
    WITH vPort DO
      next     := NIL;
      colorMap := GetColorMap(2);
      IF colorMap=NIL THEN Terminate(0) END;
      WITH IFFInfo.CMAP DO
        SetRGB4CM(colorMap,0,red[0],green[0],blue[0]);
        SetRGB4CM(colorMap,1,red[1],green[1],blue[1]);
      END;
      dWidth   := NuScreen.width;
      dHeight  := NuScreen.height;
      modes    := NuScreen.viewModes;
      dxOffset := 0;
      dyOffset := 0;
      rasInfo  := ADR(rInfo);
      WITH rInfo DO
        next     := NIL;
        bitMap   := ADR(vBitMap);
        rxOffset := 0;
        ryOffset := 0;
      END;
      uCopIns := ADR(cList);

      WITH IFFInfo.CMAP DO
        CINIT(uCopIns,800);
        FOR i:=0 TO 7 DO
          FOR j:=0 TO 15 DO
            CWAIT(uCopIns,i*32+j,0);
            CMOVE(uCopIns,ADR(custom.color[0]),
              (15-j)*LI(red[0])/15*256+(15-j)*LI(green[0])/15*16+(15-j)*LI(blue[0])/15);
            CMOVE(uCopIns,ADR(custom.color[1]),
              j*LI(red[1])/15*256+j*LI(green[1])/15*16+j*LI(blue[1])/15);
          END;
          FOR j:=0 TO 15 DO
            CWAIT(uCopIns,i*32+j+16,0);
            CMOVE(uCopIns,ADR(custom.color[0]),
              j*LI(red[0])/15*256+j*LI(green[0])/15*16+j*LI(blue[0])/15);
            CMOVE(uCopIns,ADR(custom.color[1]),
              (15-j)*LI(red[1])/15*256+(15-j)*LI(green[1])/15*16+(15-j)*LI(blue[1])/15);
          END;
        END;
        CEND(uCopIns,1000,255);
      END;
    END;

    InitView(view);
    view.modes := view.modes-ViewModeSet{sprites};
    view.viewPort := ADR(vPort);

    iview := ViewAddress();
    MakeVPort(ADR(view),ADR(vPort));
    MrgCop(ADR(view));
    LoadView(ADR(view));

    DisableIntuition; FreeSprite(0);

    MaxAdr := LI(vBitMap.planes[0]) + LI(bytesPerRow) * LI(rows);
    LOOP
      FOR i:=0 TO 63 BY 2 DO
        a := planes[0]; b := vBitMap.planes[0];
        dx:= Sinus^[64-i]; p := 0; y := rows;
        INC(b,LI(bytesPerRow)*((LI(rows) - LI(rows) * LI(dx) / 16384)/2));
        WHILE (y>0) AND (LI(b)<MaxAdr) DO
          CopyBytes((bytesPerRow-4)/4,a,b);
          INC(b,bytesPerRow);
          INC(p,16384);
          WHILE (p>dx) AND (y>0) DO
            DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
          END;
        END;
        IF NOT(lmb IN Ciapra) THEN EXIT END;
        LoadView(ADR(view));
      END;
      FOR i:=0 TO 63 BY 2 DO
        a := planes[0]; b := vBitMap.planes[0];
        dx:= Sinus^[i]; p := 0; y := rows;
        INC(b,LI(bytesPerRow)*(LI(rows) * (16384 + LI(dx)) / 32768));
        WHILE (y>0) AND (LI(b)>LI(planes[0])) DO
          DEC(b,bytesPerRow);
          CopyBytes((bytesPerRow-4)/4,a,b);
          INC(p,16384);
          WHILE (p>dx) AND (y>0) DO
            DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
          END;
        END;
        IF NOT(lmb IN Ciapra) THEN EXIT END;
        LoadView(ADR(view));
      END;
      FOR i:=0 TO 63 BY 2 DO
        a := planes[0]; b := vBitMap.planes[0];
        dx:= Sinus^[64-i]; p := 0; y := rows;
        INC(b,LI(bytesPerRow)*(LI(rows) * (16384 + LI(dx)) / 32768));
        WHILE (y>0) AND (LI(b)>LI(planes[0])) DO
          DEC(b,bytesPerRow);
          CopyBytes((bytesPerRow-4)/4,a,b);
          INC(p,16384);
          WHILE (p>dx) AND (y>0) DO
            DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
          END;
        END;
        IF NOT(lmb IN Ciapra) THEN EXIT END;
        LoadView(ADR(view));
      END;
      FOR i:=0 TO 63 BY 2 DO
        a := planes[0]; b := vBitMap.planes[0];
        dx:= Sinus^[i]; p := 0; y := rows;
        INC(b,LI(bytesPerRow)*(LI(rows) * (16384 - LI(dx)) / 32768));
        WHILE (y>0) AND (LI(b)<MaxAdr) DO
          CopyBytes((bytesPerRow-4)/4,a,b);
          INC(b,bytesPerRow); INC(p,16384);
          WHILE (p>dx) AND (y>0) DO
            DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
          END;
        END;
        IF NOT(lmb IN Ciapra) THEN EXIT END;
        LoadView(ADR(view));
      END;
    END;
  END;

  EnableIntuition;

END Rotate.