home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / amiga / convrtrs / supershm.lzh / src / LoadSHAM.Mod < prev    next >
Encoding:
Modula Implementation  |  1989-10-04  |  8.4 KB  |  254 lines
  1. IMPLEMENTATION MODULE LoadSHAM;
  2.  
  3. (*======================================================================*)
  4. (*                    Amiga M2Sprint Support Routines                   *)
  5. (*======================================================================*)
  6. (*         ⌐ Copyright 1989 Robert Salesas, All Rights Reserved         *)
  7. (*        Re-Distribute as you wish but DO NOT alter the contents       *)
  8. (*            of this file.  Moral Rights remain my property.           *)
  9. (*======================================================================*)
  10. (*      Version: 3.10           Author : Robert Salesas                 *)
  11. (*      Date   : 29-Sept-89     Changes: Original                       *)
  12. (*======================================================================*)
  13.  
  14. (*$L+*)
  15.  
  16. FROM SYSTEM           IMPORT  ADR, ADDRESS, BYTE, SHIFT, TSIZE, WORD;
  17. FROM RunTime          IMPORT  IntuitionBase;
  18. FROM Intuition        IMPORT  ScreenPtr, RethinkDisplay;
  19. FROM IntuitionBase    IMPORT  LockIBase, UnlockIBase, IntuitionBaseRecPtr;
  20. FROM Graphics         IMPORT  BitMap;
  21. FROM Views            IMPORT  ColorTable, ColorTablePtr, LoadRGB4, SetRGB4,
  22.                               ViewModes, ViewModeSet;
  23. FROM BufferedDOS      IMPORT  BufHandle, BufRead,
  24.                               BufSeek, OffsetBeginning, OffsetCurrent;
  25. FROM IFF              IMPORT  FORM, GroupHeader, ChunkHeader;
  26. FROM ILBM             IMPORT  IDILBM, IDBMHD, IDCAMG, IDCMAP, IDBODY,
  27.                               Compression, BitMapHeader, Masking,
  28.                               ColorRegister;
  29. FROM Memory           IMPORT  AllocMem, MemReqSet, MemReqs;
  30. FROM Copper           IMPORT  UCopListPtr, UCopList, CWAIT, CMOVE, CEND;
  31. FROM CustomHardware   IMPORT  custom;
  32.  
  33.  
  34.   PROCEDURE LoadSHAMPicture(Fh : BufHandle;  GetScreen : GetScreenProc;
  35.                             Registers : SHAMRegsPtr) : BOOLEAN;
  36.   CONST
  37.     IDSHAM = 5348414DH;
  38.  
  39.   VAR
  40.     IORet             :   LONGINT;
  41.     gpH               :   GroupHeader;
  42.     ckH               :   ChunkHeader;
  43.     BMHeader          :   BitMapHeader;
  44.     BodySize          :   LONGINT;
  45.     Sp                :   ScreenPtr;
  46.  
  47.  
  48.     PROCEDURE ProcessBMHD() : BOOLEAN;
  49.     BEGIN
  50.       IF (BufRead(Fh, ADR(BMHeader), ckH.ckSize) = ckH.ckSize) THEN
  51.         IF (BMHeader.compression <= cmpByteRun1) THEN
  52.           IF (BMHeader.masking = mskNone) OR (BMHeader.masking = mskHasTransparentColor)  THEN
  53.             RETURN FALSE
  54.           END;
  55.         END;
  56.       END;
  57.       RETURN TRUE;
  58.     END ProcessBMHD;
  59.  
  60.     PROCEDURE ProcessSHAM() : BOOLEAN;
  61.     VAR
  62.       Version   :   CARDINAL;
  63.       I, J      :   CARDINAL;
  64.       UCop      :   UCopListPtr;
  65.       IBase     :   IntuitionBaseRecPtr;
  66.       IBLock    :   LONGCARD;
  67.       ViewDx    :   CARDINAL;
  68.  
  69.     BEGIN
  70.       IORet := BufRead(Fh, ADR(Version), 2);
  71.       IF (Version = 0) THEN
  72.         IF (BufRead(Fh, Registers, SIZE(Registers^)) = SIZE(Registers^)) THEN
  73.  
  74.           IBLock := LockIBase(0);
  75.           IBase := IntuitionBase;
  76.           ViewDx := IBase^.ViewLord.DxOffset;
  77.           UnlockIBase(IBLock);
  78.  
  79.           SetRGB4(ADR(Sp^.VPort), 0, 0, 0, 0);
  80.           FOR I := 1 TO 15 DO
  81.             SetRGB4(ADR(Sp^.VPort), I, Registers^[0, I] DIV 256,
  82.                                        Registers^[0, I] DIV 16 MOD 16,
  83.                                        Registers^[0, I] MOD 16);
  84.           END;
  85.  
  86.           UCop := AllocMem(TSIZE(UCopList), MemReqSet{MemChip,MemClear});
  87.           IF (UCop # NIL) THEN
  88.             FOR I := 1 TO 199 DO
  89.               IF (BMHeader.h > 200) THEN
  90.                 IF (ViewDx < 114) THEN
  91.                   CWAIT(UCop, I + I - 2, (SHIFT(ViewDx, -2) + 188) MOD 228);
  92.                 ELSIF (ViewDx < 129) THEN
  93.                   CWAIT(UCop, I + I - 2, (SHIFT(ViewDx, -2) + 192) MOD 228);
  94.                 ELSE
  95.                   CWAIT(UCop, I + I, (SHIFT(ViewDx, -2) +196) MOD 228);
  96.                 END;
  97.               ELSE
  98.                 IF (ViewDx < 128) THEN
  99.                   CWAIT(UCop, I - 1, (SHIFT(ViewDx, -2) + 188) MOD 228);
  100.                 ELSE
  101.                   CWAIT(UCop, I, (SHIFT(ViewDx, -2) + 196) MOD 228);
  102.                 END;
  103.               END;
  104.               FOR J := 1 TO 15 DO
  105.                 CMOVE(UCop, ADR(custom^.color[J]), Registers^[I, J]);
  106.               END;
  107.             END;
  108.             CEND(UCop);
  109.             Sp^.VPort.UCopIns := UCop;
  110.             RethinkDisplay;
  111.             RETURN FALSE;
  112.           END;
  113.         END;
  114.       END;
  115.       RETURN TRUE;
  116.     END ProcessSHAM;
  117.  
  118.     PROCEDURE ProcessCMAP;
  119.     VAR
  120.       Table           :   ColorTablePtr;
  121.       TableCnt        :   CARDINAL;
  122.       CTemp           :   ColorRegister;
  123.       L1              :   CARDINAL;
  124.  
  125.     BEGIN
  126.       Table := Sp^.VPort.ColorMap^.ColorTable;
  127.       TableCnt := ckH.ckSize DIV 3;
  128.       IF (TableCnt > 32) THEN
  129.         TableCnt := 32;
  130.       END;
  131.       FOR L1 := 0 TO (TableCnt - 1) DO
  132.         IORet := BufRead(Fh, ADR(CTemp), 3);
  133.         Table^[L1] := (CARDINAL(CTemp.red) DIV 16) * 256 +
  134.                       (CARDINAL(CTemp.green) DIV 16) * 16 +
  135.                       (CARDINAL(CTemp.blue) DIV 16);
  136.       END;
  137.       IORet := BufSeek(Fh, ckH.ckSize - LONGINT(TableCnt * 3), OffsetCurrent);
  138.       LoadRGB4(ADR(Sp^.VPort), Table, TableCnt);
  139.     END ProcessCMAP;
  140.  
  141.     PROCEDURE GetBODY() : BOOLEAN;
  142.     VAR
  143.       R, P, N,
  144.       DRowSize        :   INTEGER;
  145.       RowSize         :   INTEGER;
  146.       SrcByte         :   BYTE;
  147.       SrcSize         :   LONGINT;
  148.       BMap            :   BitMap;
  149.       DestPtr         :   POINTER TO BYTE;
  150.  
  151.     BEGIN
  152.       IF (BodySize = 0) THEN
  153.         RETURN TRUE;
  154.       END;
  155.       SrcSize := BodySize;
  156.       BMap := Sp^.BMap;
  157.       DRowSize := (INTEGER(BMHeader.w) + 7) DIV 8;
  158.       FOR R := 0 TO INTEGER(BMHeader.h - 1) DO
  159.         FOR P := 0 TO (INTEGER(BMHeader.nPlanes) - 1) DO
  160.           RowSize := DRowSize;
  161.           IF ((RowSize MOD 2) # 0) THEN
  162.             INC(RowSize, 1);
  163.           END;
  164.           DestPtr := BMap.Planes[P] + ADDRESS((R * DRowSize));
  165.           IF (BMHeader.compression = cmpNone) THEN
  166.             IF (BufRead(Fh, DestPtr, RowSize) = -1) THEN
  167.               RETURN FALSE;
  168.             END;
  169.           ELSE
  170.             REPEAT
  171.               DEC(SrcSize);
  172.               IF (BufRead(Fh, ADR(SrcByte), 1) = -1) OR (SrcSize <= 0) THEN
  173.                 RETURN FALSE;
  174.               END;
  175.               N := INTEGER(SrcByte);
  176.               IF (N > 127) THEN
  177.                 INC(N, 0FF00H);
  178.               END;
  179.               IF (N < 0) THEN
  180.                 IF (N # -128) THEN
  181.                   N := ABS(N) + 1;
  182.                   DEC(SrcSize);
  183.                   IF (BufRead(Fh, ADR(SrcByte), 1) = -1) THEN
  184.                     RETURN FALSE;
  185.                   END;
  186.                   REPEAT
  187.                     DestPtr^ := SrcByte;
  188.                     DEC(N); INC(DestPtr); DEC(RowSize);
  189.                   UNTIL (N <= 0);
  190.                 END;
  191.               ELSE
  192.                 INC(N);
  193.                 REPEAT
  194.                   DEC(SrcSize);
  195.                   IF (BufRead(Fh, ADR(SrcByte), 1) = -1) THEN
  196.                     RETURN FALSE;
  197.                   END;
  198.                   DestPtr^ := SrcByte;
  199.                   DEC(N); INC(DestPtr); DEC(RowSize);
  200.                 UNTIL (N <= 0);
  201.               END;
  202.             UNTIL (RowSize <= 0) OR (SrcSize <= 0);
  203.           END;
  204.         END;
  205.       END;
  206.       RETURN TRUE;
  207.     END GetBODY;
  208.  
  209.     PROCEDURE ProcessChunks() : BOOLEAN;
  210.     VAR
  211.       ckError       :   BOOLEAN;
  212.  
  213.     BEGIN
  214.       ckError := FALSE;
  215.       IORet := BufRead(Fh, ADR(gpH), 12);
  216.       IF (gpH.ckID = FORM) AND (gpH.grpSubID = IDILBM) THEN
  217.         REPEAT
  218.           IORet := BufRead(Fh, ADR(ckH), 8);
  219.           IF (ckH.ckID = IDBMHD) THEN
  220.             ckError := ProcessBMHD();
  221.             IF (NOT ckError) THEN
  222.               Sp := GetScreen(BMHeader.h > 200);
  223.               IF (Sp = NIL) THEN
  224.                 ckError := TRUE;
  225.               END;
  226.             END;
  227.           ELSIF (ckH.ckID = IDCMAP) THEN
  228.             ProcessCMAP;
  229.           ELSIF (ckH.ckID = IDSHAM) THEN
  230.             ckError := ProcessSHAM();
  231.           ELSIF (ckH.ckID = IDBODY) THEN
  232.             BodySize := ckH.ckSize;
  233.             RETURN GetBODY();
  234.           ELSE
  235.             IF ((ckH.ckSize MOD 2) # 0) THEN
  236.               INC(ckH.ckSize, 1);
  237.             END;
  238.             IF (BufSeek(Fh, ckH.ckSize, OffsetCurrent) = -1) THEN
  239.               RETURN FALSE;
  240.             END;
  241.           END;
  242.         UNTIL (ckError = TRUE);
  243.       END;
  244.       RETURN FALSE;
  245.     END ProcessChunks;
  246.  
  247.   BEGIN
  248.     IF (Registers # NIL) THEN
  249.       RETURN ProcessChunks();
  250.     END;
  251.     RETURN FALSE;
  252.   END LoadSHAMPicture;
  253.  
  254. END LoadSHAM.