IMPLEMENTATION MODULE LoadSHAM;

(*======================================================================*)
(*                    Amiga M2Sprint Support Routines                   *)
(*======================================================================*)
(*         © Copyright 1989 Robert Salesas, All Rights Reserved         *)
(*        Re-Distribute as you wish but DO NOT alter the contents       *)
(*            of this file.  Moral Rights remain my property.           *)
(*======================================================================*)
(*      Version: 3.10           Author : Robert Salesas                 *)
(*      Date   : 29-Sept-89     Changes: Original                       *)
(*======================================================================*)

(*$L+*)

FROM SYSTEM           IMPORT  ADR, ADDRESS, BYTE, SHIFT, TSIZE, WORD;
FROM RunTime          IMPORT  IntuitionBase;
FROM Intuition        IMPORT  ScreenPtr, RethinkDisplay;
FROM IntuitionBase    IMPORT  LockIBase, UnlockIBase, IntuitionBaseRecPtr;
FROM Graphics         IMPORT  BitMap;
FROM Views            IMPORT  ColorTable, ColorTablePtr, LoadRGB4, SetRGB4,
                              ViewModes, ViewModeSet;
FROM BufferedDOS      IMPORT  BufHandle, BufRead,
                              BufSeek, OffsetBeginning, OffsetCurrent;
FROM IFF              IMPORT  FORM, GroupHeader, ChunkHeader;
FROM ILBM             IMPORT  IDILBM, IDBMHD, IDCAMG, IDCMAP, IDBODY,
                              Compression, BitMapHeader, Masking,
                              ColorRegister;
FROM Memory           IMPORT  AllocMem, MemReqSet, MemReqs;
FROM Copper           IMPORT  UCopListPtr, UCopList, CWAIT, CMOVE, CEND;
FROM CustomHardware   IMPORT  custom;


  PROCEDURE LoadSHAMPicture(Fh : BufHandle;  GetScreen : GetScreenProc;
                            Registers : SHAMRegsPtr) : BOOLEAN;
  CONST
    IDSHAM = 5348414DH;

  VAR
    IORet             :   LONGINT;
    gpH               :   GroupHeader;
    ckH               :   ChunkHeader;
    BMHeader          :   BitMapHeader;
    BodySize          :   LONGINT;
    Sp                :   ScreenPtr;


    PROCEDURE ProcessBMHD() : BOOLEAN;
    BEGIN
      IF (BufRead(Fh, ADR(BMHeader), ckH.ckSize) = ckH.ckSize) THEN
        IF (BMHeader.compression <= cmpByteRun1) THEN
          IF (BMHeader.masking = mskNone) OR (BMHeader.masking = mskHasTransparentColor)  THEN
            RETURN FALSE
          END;
        END;
      END;
      RETURN TRUE;
    END ProcessBMHD;

    PROCEDURE ProcessSHAM() : BOOLEAN;
    VAR
      Version   :   CARDINAL;
      I, J      :   CARDINAL;
      UCop      :   UCopListPtr;
      IBase     :   IntuitionBaseRecPtr;
      IBLock    :   LONGCARD;
      ViewDx    :   CARDINAL;

    BEGIN
      IORet := BufRead(Fh, ADR(Version), 2);
      IF (Version = 0) THEN
        IF (BufRead(Fh, Registers, SIZE(Registers^)) = SIZE(Registers^)) THEN

          IBLock := LockIBase(0);
          IBase := IntuitionBase;
          ViewDx := IBase^.ViewLord.DxOffset;
          UnlockIBase(IBLock);

          SetRGB4(ADR(Sp^.VPort), 0, 0, 0, 0);
          FOR I := 1 TO 15 DO
            SetRGB4(ADR(Sp^.VPort), I, Registers^[0, I] DIV 256,
                                       Registers^[0, I] DIV 16 MOD 16,
                                       Registers^[0, I] MOD 16);
          END;

          UCop := AllocMem(TSIZE(UCopList), MemReqSet{MemChip,MemClear});
          IF (UCop # NIL) THEN
            FOR I := 1 TO 199 DO
              IF (BMHeader.h > 200) THEN
                IF (ViewDx < 114) THEN
                  CWAIT(UCop, I + I - 2, (SHIFT(ViewDx, -2) + 188) MOD 228);
                ELSIF (ViewDx < 129) THEN
                  CWAIT(UCop, I + I - 2, (SHIFT(ViewDx, -2) + 192) MOD 228);
                ELSE
                  CWAIT(UCop, I + I, (SHIFT(ViewDx, -2) +196) MOD 228);
                END;
              ELSE
                IF (ViewDx < 128) THEN
                  CWAIT(UCop, I - 1, (SHIFT(ViewDx, -2) + 188) MOD 228);
                ELSE
                  CWAIT(UCop, I, (SHIFT(ViewDx, -2) + 196) MOD 228);
                END;
              END;
              FOR J := 1 TO 15 DO
                CMOVE(UCop, ADR(custom^.color[J]), Registers^[I, J]);
              END;
            END;
            CEND(UCop);
            Sp^.VPort.UCopIns := UCop;
            RethinkDisplay;
            RETURN FALSE;
          END;
        END;
      END;
      RETURN TRUE;
    END ProcessSHAM;

    PROCEDURE ProcessCMAP;
    VAR
      Table           :   ColorTablePtr;
      TableCnt        :   CARDINAL;
      CTemp           :   ColorRegister;
      L1              :   CARDINAL;

    BEGIN
      Table := Sp^.VPort.ColorMap^.ColorTable;
      TableCnt := ckH.ckSize DIV 3;
      IF (TableCnt > 32) THEN
        TableCnt := 32;
      END;
      FOR L1 := 0 TO (TableCnt - 1) DO
        IORet := BufRead(Fh, ADR(CTemp), 3);
        Table^[L1] := (CARDINAL(CTemp.red) DIV 16) * 256 +
                      (CARDINAL(CTemp.green) DIV 16) * 16 +
                      (CARDINAL(CTemp.blue) DIV 16);
      END;
      IORet := BufSeek(Fh, ckH.ckSize - LONGINT(TableCnt * 3), OffsetCurrent);
      LoadRGB4(ADR(Sp^.VPort), Table, TableCnt);
    END ProcessCMAP;

    PROCEDURE GetBODY() : BOOLEAN;
    VAR
      R, P, N,
      DRowSize        :   INTEGER;
      RowSize         :   INTEGER;
      SrcByte         :   BYTE;
      SrcSize         :   LONGINT;
      BMap            :   BitMap;
      DestPtr         :   POINTER TO BYTE;

    BEGIN
      IF (BodySize = 0) THEN
        RETURN TRUE;
      END;
      SrcSize := BodySize;
      BMap := Sp^.BMap;
      DRowSize := (INTEGER(BMHeader.w) + 7) DIV 8;
      FOR R := 0 TO INTEGER(BMHeader.h - 1) DO
        FOR P := 0 TO (INTEGER(BMHeader.nPlanes) - 1) DO
          RowSize := DRowSize;
          IF ((RowSize MOD 2) # 0) THEN
            INC(RowSize, 1);
          END;
          DestPtr := BMap.Planes[P] + ADDRESS((R * DRowSize));
          IF (BMHeader.compression = cmpNone) THEN
            IF (BufRead(Fh, DestPtr, RowSize) = -1) THEN
              RETURN FALSE;
            END;
          ELSE
            REPEAT
              DEC(SrcSize);
              IF (BufRead(Fh, ADR(SrcByte), 1) = -1) OR (SrcSize <= 0) THEN
                RETURN FALSE;
              END;
              N := INTEGER(SrcByte);
              IF (N > 127) THEN
                INC(N, 0FF00H);
              END;
              IF (N < 0) THEN
                IF (N # -128) THEN
                  N := ABS(N) + 1;
                  DEC(SrcSize);
                  IF (BufRead(Fh, ADR(SrcByte), 1) = -1) THEN
                    RETURN FALSE;
                  END;
                  REPEAT
                    DestPtr^ := SrcByte;
                    DEC(N); INC(DestPtr); DEC(RowSize);
                  UNTIL (N <= 0);
                END;
              ELSE
                INC(N);
                REPEAT
                  DEC(SrcSize);
                  IF (BufRead(Fh, ADR(SrcByte), 1) = -1) THEN
                    RETURN FALSE;
                  END;
                  DestPtr^ := SrcByte;
                  DEC(N); INC(DestPtr); DEC(RowSize);
                UNTIL (N <= 0);
              END;
            UNTIL (RowSize <= 0) OR (SrcSize <= 0);
          END;
        END;
      END;
      RETURN TRUE;
    END GetBODY;

    PROCEDURE ProcessChunks() : BOOLEAN;
    VAR
      ckError       :   BOOLEAN;

    BEGIN
      ckError := FALSE;
      IORet := BufRead(Fh, ADR(gpH), 12);
      IF (gpH.ckID = FORM) AND (gpH.grpSubID = IDILBM) THEN
        REPEAT
          IORet := BufRead(Fh, ADR(ckH), 8);
          IF (ckH.ckID = IDBMHD) THEN
            ckError := ProcessBMHD();
            IF (NOT ckError) THEN
              Sp := GetScreen(BMHeader.h > 200);
              IF (Sp = NIL) THEN
                ckError := TRUE;
              END;
            END;
          ELSIF (ckH.ckID = IDCMAP) THEN
            ProcessCMAP;
          ELSIF (ckH.ckID = IDSHAM) THEN
            ckError := ProcessSHAM();
          ELSIF (ckH.ckID = IDBODY) THEN
            BodySize := ckH.ckSize;
            RETURN GetBODY();
          ELSE
            IF ((ckH.ckSize MOD 2) # 0) THEN
              INC(ckH.ckSize, 1);
            END;
            IF (BufSeek(Fh, ckH.ckSize, OffsetCurrent) = -1) THEN
              RETURN FALSE;
            END;
          END;
        UNTIL (ckError = TRUE);
      END;
      RETURN FALSE;
    END ProcessChunks;

  BEGIN
    IF (Registers # NIL) THEN
      RETURN ProcessChunks();
    END;
    RETURN FALSE;
  END LoadSHAMPicture;

END LoadSHAM.