home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / graphics / viewers / mugiff / txt / mugiff.mod < prev    next >
Text File  |  1993-02-19  |  24KB  |  641 lines
  1. (*-------------------------------------------------------------------------
  2. :Program.       MUGiff
  3. :Contents.      IFF-Viewer for any ILBM plus 24bit preview and ANIM-player
  4. :Author.        Mark Rose [mug]
  5. :Copyright.     Freely distributable copyrighted software
  6. :Language.      Modula-2
  7. :Translator.    M2Amiga 4.1
  8. :Imports.            iff.library - Christian A. Weber
  9. :Imports.       reqtools.library - Nico François
  10. :Imports.       ReqTFileReq      - Frank Lömker(optimized&integrated by me)
  11. :History.       see file 'History.DEF'
  12. :Usage.         MUGiff [<file1> .. <fileN>]
  13. -------------------------------------------------------------------------*)
  14. (*$ NilChk      := FALSE ReturnChk   := FALSE CaseChk     := FALSE *)
  15. (*$ Volatile    := FALSE StackParms  := FALSE LargeVars   := FALSE *)
  16. (*$ StackChk    := FALSE RangeChk    := FALSE OverflowChk := FALSE *)
  17.  
  18. MODULE MUGiff;
  19.  
  20. FROM Arguments   IMPORT GetArg         , NumArgs        ;
  21. FROM Arts        IMPORT Exit           , kickVersion    ;
  22. FROM Break       IMPORT GetBreak       ;
  23.                  IMPORT d  : DosD      , ed : ExecD     , el : ExecL     ,
  24.                         gd : GraphicsD , gl : GraphicsL , id : IntuitionD,
  25.                         il : IntuitionL, R              , rt : ReqTools  ;
  26. FROM GraphicsD   IMPORT BitMap         , BitMapPtr      , ChipRevs       ,
  27.                         ChipRevSet     , ViewModes      , ViewModeSet    ;
  28. FROM History     IMPORT AUTHOR         , REVDATE        , REVISION       ,
  29.                         REVTIME        ;
  30. FROM IFFLib      IMPORT BitMapHeaderPtr, ChunkPtr       , CloseIFF       ,
  31.                         comprNone      , DecodePic      , errorOpen      ,
  32.                         errorNotIff    , FindChunk      , GetBMHD        ,
  33.                         GetColorTab    , GetViewModes   , HandlePtr      ,
  34.                         idANIM         , idFORM         , idILBM         ,
  35.                         IffError       , modeRead       , ModifyFrame    ,
  36.                         OpenIFF        , SaveBitMap     ;
  37. FROM IntuitionD  IMPORT IDCMPFlags     , IDCMPFlagSet   , ScreenFlags    ,
  38.                         ScreenFlagSet  , WindowFlags    , WindowFlagSet  ;
  39. FROM String      IMPORT Concat         , Length         ;
  40. FROM SYSTEM      IMPORT ADDRESS        , ADR            , ASSEMBLE       ,
  41.                         CAST           , LONGSET        , SHIFT          ,
  42.                         TAG            ;
  43. FROM Terminal    IMPORT WriteString    , Format         ;
  44.  
  45. TYPE
  46.       str110       = ARRAY [0..110] OF CHAR;
  47.       str110Ptr    = POINTER TO str110;
  48.       colorPtr     = POINTER TO colorType;
  49.       colorType    = ARRAY [0 .. 255] OF CARDINAL;
  50.  
  51. CONST
  52.       couldnt      = "Couldn't ";
  53.       version      = "MUGiff " + REVISION + " (" + REVDATE + ") " +
  54.                                                 REVTIME + " © " + AUTHOR;
  55.       versionStr   = ADR ("$VER: " + version);
  56.       HAM          = 080H;
  57.       agaChips     = ChipRevSet{hrAgnus, hrDenise, cr2, cr3, cr4};
  58.                      (*
  59.                      ** ^- These settings were reported to me by Jeff Hobbs
  60.                      **  (Since I don't have the 3.0 includes I had to read
  61.                      **  gfxBase.chipRevBits0 on a A4000 to get these).
  62.                      *)
  63.  
  64. VAR
  65.       bigBitMap    : gd.BitMap;
  66.       bigBitMapPtr : gd.BitMapPtr;
  67.       bmhd         : BitMapHeaderPtr;
  68.       dir          : str110Ptr;
  69.       dirDum       : str110;
  70.       i            : INTEGER;
  71.       iff          : HandlePtr;
  72.       len          : INTEGER;
  73.       maxX0,
  74.       maxY0        : INTEGER;
  75.       myArg        : str110;
  76.       myFileList   : rt.FileListPtr;
  77.       ns           : id.NewScreen;
  78.       nw           : id.NewWindow;
  79.       screen,
  80.       screen2      : id.ScreenPtr;
  81.       tBuf         : ARRAY [0 ..   2] OF LONGINT;
  82.       window       : id.WindowPtr;
  83.       y0           : INTEGER;
  84.  
  85.  
  86. (*$ CopyDyn := FALSE *) (* faster and shorter *)
  87. (*-----------------------------------------------------------------------*)
  88. PROCEDURE MUGerror (error : ARRAY OF CHAR);
  89. (*-----------------------------------------------------------------------*)
  90.  
  91. BEGIN
  92.   WriteString (error);
  93.   Exit (d.fail);
  94. END MUGerror;
  95.  
  96.  
  97. (*$ EntryExitCode := FALSE *)
  98. (*-----------------------------------------------------------------------*)
  99. PROCEDURE TrueColTab;
  100. (*-----------------------------------------------------------------------*
  101.  * The colours for 24bit preview. Thanks to Christian for the idea...    *
  102.  * But with my method you can preview bigger files (a bit more ugly)     *
  103.  *-----------------------------------------------------------------------*)
  104.  
  105. BEGIN
  106.   ASSEMBLE(DC.W $000,$111,$222,$333,$444,$555,$666,$777
  107.            DC.W $888,$999,$AAA,$BBB,$CCC,$DDD,$EEE,$FFF
  108.            END);
  109. END TrueColTab;
  110.  
  111.  
  112. (*-----------------------------------------------------------------------*)
  113. PROCEDURE Max (i{R.D0}, j{R.D1} : INTEGER) : INTEGER;
  114. (*-----------------------------------------------------------------------*)
  115.  
  116. BEGIN
  117.   IF (i > j) THEN RETURN i ELSE RETURN j END;
  118. END Max;
  119.  
  120.  
  121. (*-----------------------------------------------------------------------*)
  122. PROCEDURE Min (i{R.D0}, j{R.D1} : INTEGER) : INTEGER;
  123. (*-----------------------------------------------------------------------*)
  124.  
  125. BEGIN
  126.   IF (i < j) THEN RETURN i ELSE RETURN j END;
  127. END Min;
  128.  
  129.  
  130. (*-----------------------------------------------------------------------*)
  131. PROCEDURE MUGAllocBitMap (w{R.D4}, h{R.D5} : LONGCARD) : BOOLEAN;
  132. (*-----------------------------------------------------------------------*
  133.  * This one is based on the RKM: Libraries example.  It uses AllocRaster *
  134.  * as required by C=                                                     *
  135.  *-----------------------------------------------------------------------*)
  136.  
  137. VAR i{R.D2}         : SHORTCARD;
  138.     allocMaps{R.D3} : BOOLEAN;
  139.  
  140. BEGIN
  141.   i         := 0;
  142.   allocMaps := TRUE;
  143.   gl.InitBitMap (bigBitMap, ns.depth, w, h);
  144.   WHILE (i < SHORTCARD (ns.depth)) AND allocMaps DO
  145.     bigBitMapPtr^.planes[i] := gl.AllocRaster (w, h);
  146.     IF (bigBitMapPtr^.planes[i] = NIL) THEN allocMaps := FALSE; END;
  147.     INC (i);
  148.   END;
  149.   RETURN allocMaps;
  150. END MUGAllocBitMap;
  151.  
  152.  
  153. (*-----------------------------------------------------------------------*)
  154. PROCEDURE FileReq (VAR fName{R.A6} : str110Ptr);
  155. (*-----------------------------------------------------------------------*)
  156. (* This is an adapted  version  of  ReqTFileReq by Frank Lömker.  Please *
  157.  * note that  I  had  to  correct  ReqTools.def  to  allow  MultiSelect. *
  158.  * rt.FileRequest returned BOOLEAN (which is normally quite true) but in *
  159.  * MultiSelect mode it is in fact a FileListPtr...                       *
  160.  *-----------------------------------------------------------------------*)
  161.  
  162. VAR filereq{R.D4} : rt.FileRequesterPtr;
  163.  
  164. BEGIN
  165.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  166.   IF (filereq # NIL) THEN
  167.     INCL (filereq^.flags, rt.fReqMultiSelect);
  168.     myFileList := rt.FileRequest (filereq, fName, ADR (version), NIL);
  169.     IF (myFileList # NIL) THEN
  170.       fName^ := CAST (str110Ptr, (filereq^.dir))^;
  171.       IF (Length (fName^) > 0) AND (fName^[Length (fName^) - 1] # ':') THEN
  172.         Concat(fName^, '/');(* ReqTools doesn't append a '/' so we do it *)
  173.       END;
  174.     END;
  175.   END;
  176.   rt.FreeRequest (filereq);
  177. END FileReq;
  178.  
  179.  
  180. (*-----------------------------------------------------------------------*)
  181. PROCEDURE SavePic (fName{R.D2} : str110Ptr) : BOOLEAN;
  182. (*-----------------------------------------------------------------------*)
  183.  
  184. BEGIN
  185.   IF (ham IN screen^.viewPort.modes) THEN
  186.     RETURN SaveBitMap(fName, bigBitMapPtr,
  187.                     screen^.viewPort.colorMap^.colorTable, comprNone + HAM)
  188.   ELSE
  189.     RETURN SaveBitMap(fName, bigBitMapPtr,
  190.                     screen^.viewPort.colorMap^.colorTable, comprNone      )
  191.   END;
  192. END SavePic;
  193.  
  194.  
  195. (*-----------------------------------------------------------------------*)
  196. PROCEDURE MakeOverscan ();
  197. (*-----------------------------------------------------------------------*
  198.  * This is a tricky one.  I "borrowed" it from ShowIFF.c.  If you know a *
  199.  * better way (that is more compatible) feel free to contact me...       *
  200.  *-----------------------------------------------------------------------*)
  201.  
  202. VAR x{R.D0}, y{R.D1} : INTEGER;
  203.     gfxBasePtr{R.A2} : gd.GfxBasePtr;
  204.  
  205. BEGIN
  206.   gfxBasePtr := ADR (gl);
  207.   x := gfxBasePtr^.normalDisplayColumns;
  208.   y := gfxBasePtr^.normalDisplayRows;
  209.   IF NOT (hires IN screen^.viewPort.modes) THEN x := SHIFT (x, -1); END;
  210.   IF     (lace  IN screen^.viewPort.modes) THEN y := SHIFT (y,  1); END;
  211.   x := SHIFT ( (x - screen^.width ), -1);
  212.   y := SHIFT ( (y - screen^.height), -1);
  213.   IF (y > 0) THEN y := 0; END;
  214.   IF ( (gfxBasePtr^.actiView^.dyOffset + y) < 0) THEN
  215.     y := 0 - gfxBasePtr^.actiView^.dyOffset;
  216.   END;
  217.   (* Avoid OverScan HAM fringes *)
  218.   IF (ham IN screen^.viewPort.modes) THEN
  219.     IF ( (gfxBasePtr^.actiView^.dxOffset + x < 96)) THEN
  220.       x := 96 - gfxBasePtr^.actiView^.dxOffset;
  221.     END;
  222.   END;
  223.   screen^.viewPort.dxOffset := x;
  224.   screen^.viewPort.dyOffset := y;
  225.   il.MakeScreen (screen);
  226.   il.RethinkDisplay ();
  227. END MakeOverscan;
  228.  
  229.  
  230. (*-----------------------------------------------------------------------*)
  231. PROCEDURE ClosePicture ();
  232. (*-----------------------------------------------------------------------*
  233.  * Checks if resources were really allocated and frees them only then    *
  234.  *-----------------------------------------------------------------------*)
  235.  
  236. VAR i{R.D2} : SHORTCARD;
  237.  
  238. BEGIN
  239.   IF (window # NIL) THEN
  240.     il.CloseWindow (window);
  241.     window  := NIL;
  242.   END;
  243.   IF (screen # NIL) THEN
  244.     il.CloseScreen (screen);
  245.     screen  := NIL;
  246.   END;
  247.   IF (screen2 # NIL) THEN
  248.     il.CloseScreen (screen2);
  249.     screen2 := NIL;
  250.   END;
  251.   IF (bigBitMapPtr # NIL) AND (bmhd # NIL) THEN
  252.     IF (bigBitMap.depth # 0) THEN
  253.       FOR i := 0 TO bigBitMap.depth - 1 DO
  254.         IF (bigBitMap.planes[i] # NIL) THEN
  255.           gl.FreeRaster (bigBitMap.planes[i],
  256.                          SHIFT (bigBitMap.bytesPerRow, 3), bigBitMap.rows);
  257.           bigBitMap.planes[i] := NIL;
  258.         END;
  259.       END;
  260.     END;
  261.   END;
  262. END ClosePicture;
  263.  
  264.  
  265. (*-----------------------------------------------------------------------*)
  266. PROCEDURE OpenPicture () : BOOLEAN;
  267. (*-----------------------------------------------------------------------*
  268.  * This opens a screen and an apropriate window (for IDCMP-messages). It *
  269.  * also calculates the  width and height to center the picture. It has a *
  270.  * number of safety catches.  please note that I had to remove the check *
  271.  * for old broken DigiView pix because it reduced the size of colours to *
  272.  * 32 (would stop AGA support).                                          *
  273.  *-----------------------------------------------------------------------*)
  274.  
  275. VAR
  276.     colorCount{R.D3} : CARDINAL;
  277.     colorTab         : colorType;
  278.     dum       {R.D2} : INTEGER;
  279.     gfxBasePtr{R.A2} : gd.GfxBasePtr;
  280.  
  281. BEGIN
  282.   gfxBasePtr       := ADR (gl);
  283.   ClosePicture();
  284.   ns.width         := gfxBasePtr^.normalDisplayColumns;
  285.   ns.height        := gfxBasePtr^.normalDisplayRows;
  286.   ns.depth         := Max (1, bmhd^.nPlanes);
  287.   ns.viewModes     := GetViewModes (iff);
  288.   IF (ns.depth > 8) THEN
  289.     ns.depth := 4;    (* Hey, this is a 24bit file! Limit it to 4 planes *)
  290.     EXCL (ns.viewModes, ham);
  291.   ELSIF (ns.depth > 6) AND (gfxBasePtr^.chipRevBits0 # agaChips) THEN
  292.     ns.depth := 4; (* Someone wants to view a HAM8 or something on a     *)
  293.   END;             (* pre-AGA machine. We have to limit it to 4 planes...*)
  294.   ns.type          := id.customScreen + ScreenFlagSet {customBitMap,
  295.                                                 screenQuiet, screenBehind};
  296.   ns.customBitMap  := bigBitMapPtr;
  297.   IF (NOT (hires IN ns.viewModes)) THEN
  298.     ASSEMBLE( ASR.W ns.width(A4) END);
  299.   END;
  300.   IF      (lace  IN ns.viewModes)  THEN
  301.     ASSEMBLE( ASL.W ns.height(A4) END);
  302.   END;
  303.   ns.width         := Min (bmhd^.w, ns.width );
  304.  
  305.   ns.width         := Max (128    , ns.width );
  306.   ns.height        := Max (128    , ns.height);
  307.   IF (hires IN ns.viewModes) THEN dum := 768 ELSE dum := 384 END;
  308.   IF ( (CAST (INTEGER, bmhd^.w) > ns.width) AND
  309.                                      (CAST (INTEGER, bmhd^.w) <= dum)) THEN
  310.     ns.width := bmhd^.w;
  311.   END;
  312.   IF (lace  IN ns.viewModes) THEN dum :=  80 ELSE dum :=  40 END;
  313.   IF ( CAST (INTEGER, bmhd^.h) > ns.height) AND
  314.                         (CAST (INTEGER, bmhd^.h) <= (ns.height + dum)) THEN
  315.     ns.height  := bmhd^.h;
  316.   END;
  317.   IF MUGAllocBitMap (Max (bmhd^.w,ns.width), Max (bmhd^.h, ns.height)) THEN
  318.     screen           := il.OpenScreen (ns);
  319.     IF (screen # NIL) THEN
  320.       nw.screen      := screen;
  321.       nw.width       := ns.width;
  322.       nw.height      := ns.height;
  323.       nw.idcmpFlags  := id.IDCMPFlagSet  {mouseMove, deltaMove,
  324.                                                  mouseButtons, vanillaKey};
  325.       nw.flags       := id.WindowFlagSet {backDrop, simpleRefresh,
  326.                 borderless, activate, reportMouse, noCareRefresh, rmbTrap};
  327.       nw.type        := id.customScreen;
  328.       window         := il.OpenWindow (nw);
  329.       IF (window # NIL) THEN
  330.         y0    := SHIFT (CAST (CARDINAL, ns.height) - bmhd^.h, -1);
  331.         IF (y0 < 0) THEN y0 := 0; END;
  332.         maxX0 := CAST (INTEGER, bmhd^.w) - ns.width;
  333.         (*
  334.         **  ^--  Why this?  Because the generated code gives you a overflow
  335.         **  v--  with (bmhd^.w < ns.width). In C this won't happen :(
  336.         *)
  337.         maxY0 := CAST (INTEGER, bmhd^.h) - ns.height;
  338.         (*
  339.         ** In 2.0 is a RasInfo scrolling bug.  C= said they would fix it in
  340.         ** newer ROMs so an explicit version check is done
  341.         *)
  342.         IF (hires IN ns.viewModes) THEN
  343.           IF (gfxBasePtr^.libNode.version >= 36) AND
  344.                                    (gfxBasePtr^.libNode.version <= 38) THEN
  345.             ASSEMBLE( ASR.W maxX0(A4) END);
  346. (*            maxX0 := SHIFT (maxX0, -1);*)
  347.           END;
  348.         END;
  349.         IF (bmhd^.nPlanes = 24) THEN
  350.           (*
  351.           ** Not  using  a  dummy  results  in a compiler error 7032:  Gea:
  352.           ** adrtoload (Compilerfehler)    Very nice ?!
  353.           *)
  354.           colorTab   := CAST (colorPtr, ADR (TrueColTab))^;
  355.           colorCount := 16;
  356.         ELSE
  357.           colorCount := GetColorTab (iff, ADR (colorTab));
  358.           IF (colorCount = 0) THEN (* Provide colors for pix w/o CMAP *)
  359.             colorCount   := 2;
  360.             colorTab [0] := 0ECAH;
  361.             colorTab [1] := 000H;
  362.           END;
  363.         END;
  364.         gl.LoadRGB4 (ADR (screen^.viewPort), ADR (colorTab), colorCount);
  365.         MakeOverscan ();
  366.         RETURN TRUE;
  367.       END;
  368.     END;
  369.   END;
  370.   ClosePicture ();
  371.   RETURN FALSE;
  372. END OpenPicture;
  373.  
  374.  
  375. (*-----------------------------------------------------------------------*)
  376. PROCEDURE MUGidcmp (VAR name{R.A2} : str110Ptr) : BOOLEAN;
  377. (*-----------------------------------------------------------------------*
  378.  * Checks for mouseMovement, vanillaKey and mouseButtons. The loop is as *
  379.  * short as possible for faster reaction on 68000 based systems.         *
  380.  *-----------------------------------------------------------------------*)
  381.  
  382. VAR
  383.     signals        : LONGSET;
  384.     msg  {R.D3}    : id.IntuiMessagePtr;
  385.     xOff {R.D6}   ,
  386.     yOff {R.A3}    : POINTER TO INTEGER;
  387.     class{R.D5}    : IDCMPFlagSet;
  388.     moved{R.D4}    : BOOLEAN;
  389.     mouseX, mouseY : INTEGER;
  390.     code           : CARDINAL;
  391.  
  392. BEGIN
  393.   moved := FALSE;
  394.   xOff  := ADR (screen^.viewPort.rasInfo^.rxOffset);
  395.   yOff  := ADR (screen^.viewPort.rasInfo^.ryOffset);
  396.   LOOP
  397.     (*
  398.     ** In  2.0  is  a bug in WaitPort.  If used without FastMem (like stock
  399.     ** A500+)  it doesn't work!  Thanks to Andreas Krebs for information on
  400.     ** this.
  401.     *)
  402.     signals := el.Wait (CAST (LONGSET, (
  403.                                     SHIFT (1, window^.userPort^.sigBit))));
  404.     (*
  405.     ** ^-- That's how elegant Modula-2 is compared to C... :^((
  406.     *)
  407.     msg := el.GetMsg (window^.userPort);
  408.     WHILE (msg # NIL) DO
  409.       class  := msg^.class;
  410.       code   := msg^.code;
  411.       mouseX := msg^.mouseX;
  412.       mouseY := msg^.mouseY;
  413.       el.ReplyMsg (msg);
  414.       IF (vanillaKey IN class) THEN
  415.         IF (code = CAST (CARDINAL, 's')) THEN
  416.           IF SavePic (name) THEN
  417.             WriteString (" written");
  418.             RETURN TRUE;
  419.           ELSE
  420.             Format (couldnt + "write %s ! IffError: %ld",
  421.                                             TAG (tBuf, name, IffError ()));
  422.             RETURN FALSE;
  423.           END;
  424.         ELSE
  425.           RETURN TRUE;
  426.         END;
  427.       END;
  428.       IF (mouseButtons IN class) THEN
  429.         IF (msg^.code = id.menuDown) THEN RETURN FALSE;
  430.                                      ELSE RETURN TRUE;
  431.         END;
  432.       END;
  433.       IF (mouseMove IN class) THEN moved := TRUE; END;
  434.     msg := el.GetMsg (window^.userPort)
  435.     END; (* WHILE *)
  436.     IF moved THEN
  437.       moved := FALSE;
  438.       INC (xOff^, mouseX);
  439.       INC (yOff^, mouseY);
  440.       IF (xOff^ > maxX0) THEN xOff^ := maxX0; END;
  441.       IF (xOff^ < 0    ) THEN xOff^ := 0    ; END;
  442.       IF (yOff^ > maxY0) THEN yOff^ := maxY0; END;
  443.       IF (yOff^ < 0    ) THEN yOff^ := 0    ; END;
  444.       il.MakeScreen (screen);
  445.       il.RethinkDisplay();
  446.     END;
  447.   END; (* LOOP *)
  448. END MUGidcmp;
  449.  
  450.  
  451. (*-----------------------------------------------------------------------*)
  452. PROCEDURE ShowAnim() : BOOLEAN;
  453. (*-----------------------------------------------------------------------*
  454.  * This  procedure  does  some  VERY  dangerous  pointer  shifting  with *
  455.  * undocumented iff.library features.   Since  the author of iff.library *
  456.  * uses this way of programming in his own examples it seems to be legal *
  457.  *-----------------------------------------------------------------------*)
  458.  
  459. VAR
  460.     colorCount{R.D4} : CARDINAL;
  461.     colorTab         : colorType;
  462.     scrDummy{R.D2}   : id.ScreenPtr;
  463.     form    {R.A3},
  464.     loopform{R.D3}   : HandlePtr;
  465.     ns               : id.NewScreen;
  466.  
  467. BEGIN
  468.   form := CAST (HandlePtr, CAST (LONGCARD, iff) + 12);
  469.   (*
  470.   ** ^- Regarding   the   definition  of  IFFL_HANDLE  this  is  completely
  471.   **    senseless.   I've  got  the  suspicion  that the  library  makes an
  472.   **    internal  list of all chunks and that this construct results in the
  473.   **    next item
  474.   *)
  475.   bmhd := GetBMHD (form);
  476.   IF (bmhd = NIL) THEN
  477.     WriteString ("- no bitmap header!\n");
  478.     RETURN FALSE;
  479.   END;
  480.   ns.type      := id.customScreen + ScreenFlagSet {screenQuiet,
  481.                                                               screenBehind};
  482.   ns.width     := bmhd^.w;
  483.   ns.height    := bmhd^.h;
  484.   ns.depth     := bmhd^.nPlanes;
  485.   ns.viewModes := GetViewModes (form);
  486.   screen       := il.OpenScreen (ns);
  487.   screen2      := il.OpenScreen (ns);
  488.   IF (screen # NIL) AND (screen2 # NIL) THEN
  489.     colorCount   := GetColorTab (form, ADR (colorTab));
  490.     gl.LoadRGB4 (ADR (screen^.viewPort ), ADR (colorTab), colorCount);
  491.     gl.LoadRGB4 (ADR (screen2^.viewPort), ADR (colorTab), colorCount);
  492.     IF NOT DecodePic(form, screen^.rastPort.bitMap) THEN
  493.       WriteString (couldnt + "decode picture!\n");
  494.       RETURN FALSE;
  495.     END;
  496.     IF DecodePic(form, screen2^.rastPort.bitMap) THEN
  497.       il.ScreenToFront (screen2);
  498.       gl.WaitTOF();
  499.       form := CAST (HandlePtr, FindChunk (form, 0));
  500.       (*
  501.       ** ^- This  one  "converts"  a  *IFFL_HANDLE  to  a *IFFL_Chunk.  Not
  502.       **    recommended!  Children:  Do not try this at home! ]8^}
  503.       *)
  504.       IF NOT ModifyFrame(form, screen^.rastPort.bitMap) THEN
  505.         WriteString (couldnt + "decode frame 1!\n");
  506.         RETURN FALSE;
  507.       END;
  508.       il.ScreenToFront (screen);
  509.       loopform := CAST (HandlePtr, FindChunk (form, 0));
  510.       LOOP
  511.         form := loopform;
  512.         WHILE (CAST (LONGINT, form^.file) = idFORM) DO
  513.           (*
  514.           ** ^- Remember: this  is  not  a  IFFL_HANDLE anymore!  The first
  515.           **    entry in a IFFL_Chunk is ckID!
  516.           *)
  517.           IF (GetBreak() # LONGSET{}) THEN RETURN TRUE; END; (* CtrlC ?? *)
  518.           IF ModifyFrame(form, screen2^.rastPort.bitMap) THEN
  519.             scrDummy := screen;
  520.             screen   := screen2;
  521.             screen2  := scrDummy;
  522.             il.ScreenToFront (screen);
  523.           ELSE
  524.             WriteString (couldnt + "Decode Frame\n");
  525.             RETURN FALSE;
  526.           END;
  527.           form := CAST (HandlePtr, FindChunk (form, 0));
  528.         END;
  529.       END;
  530.     ELSE
  531.       WriteString (couldnt + "decode picture\n");
  532.       RETURN FALSE;
  533.     END;
  534.   ELSE
  535.     WriteString (couldnt + "open screens\n");
  536.     RETURN FALSE;
  537.   END;
  538.   WriteString ("- Done");
  539.   RETURN TRUE;
  540. END ShowAnim;
  541.  
  542.  
  543. (*-----------------------------------------------------------------------*)
  544. PROCEDURE ShowPicture (name : str110Ptr) : BOOLEAN;
  545. (*-----------------------------------------------------------------------*
  546.  * This  is  the main thing.  It determines wether it is a picture or an *
  547.  * ANIM and calls the apropriate ShowXXXX.                               *
  548.  *-----------------------------------------------------------------------*)
  549.  
  550. BEGIN
  551.   ClosePicture ();
  552.   Format ("\nShowing %-40s : ", ADR (name));
  553.   IF (iff # NIL) THEN CloseIFF (iff); END;
  554.   iff := OpenIFF (name, modeRead);
  555.   IF (iff = NIL) THEN
  556.     CASE IffError() OF
  557.       errorOpen  : WriteString (couldnt + "open file!\n");
  558.                    RETURN TRUE;
  559.     | errorNotIff: WriteString ("not IFF!\n"            );
  560.                    RETURN TRUE;
  561.     ELSE
  562.       WriteString ("not ILBM\n");
  563.       RETURN TRUE;
  564.     END;
  565.   END;
  566.   IF (iff^.chunkId = idANIM) THEN
  567.     WriteString (" ANIM ");
  568.     RETURN ShowAnim();
  569.   END;
  570.   bmhd := GetBMHD (iff);
  571.   IF (bmhd = NIL) THEN
  572.     WriteString ("Mangled IFF file\n");
  573.     RETURN TRUE;
  574.   END;
  575.   Format ("%4ld × %4ld × %2ld ", TAG (tBuf, bmhd^.w, bmhd^.h,
  576.                                                            bmhd^.nPlanes));
  577.   IF OpenPicture () THEN
  578.     IF DecodePic (iff, screen^.rastPort.bitMap) THEN
  579.       gl.ScrollRaster (ADR (screen^.rastPort), 0, -y0, 0, 0,
  580.                          SHIFT (bigBitMap.bytesPerRow, 3), bigBitMap.rows);
  581.       il.ScreenToFront (screen);
  582.       WriteString ("- Done");
  583.       RETURN MUGidcmp (name);
  584.     ELSE
  585.       ClosePicture ();
  586.       WriteString ("Decode error!\n");
  587.       RETURN TRUE;
  588.     END;
  589.   ELSE
  590.     MUGerror (couldnt + "open screen!\n");
  591.   END;
  592. END ShowPicture;
  593.  
  594. (*-----------------------------------------------------------------------*)
  595. PROCEDURE ChkBreakMsg();
  596. (*-----------------------------------------------------------------------*)
  597.  
  598. BEGIN
  599.   IF NOT ShowPicture (ADR (myArg)) THEN
  600.     MUGerror ("\n*** BREAK\n");
  601.   END;
  602. END ChkBreakMsg;
  603.  
  604.  
  605. (*=========================================================================
  606.                           M a i n   p r o g r a m
  607. =========================================================================*)
  608.  
  609. BEGIN
  610.   dir := ADR (dirDum);
  611.   bigBitMapPtr := ADR (bigBitMap);
  612.   GetArg (1, myArg, len);
  613.   IF (NumArgs() = 0) THEN    (* called without args. Is ReqTools there ? *)
  614.     IF (rt.reqToolsBase # NIL) THEN
  615.       FileReq (dir);
  616.       WHILE (myFileList # NIL) DO
  617.         myArg := dir^;
  618.         Concat(myArg, CAST (str110Ptr, (myFileList^.name))^);
  619.         ChkBreakMsg();
  620.         ClosePicture();
  621.         myFileList := myFileList^.next;
  622.       END;
  623.       Exit (d.ok);
  624.     ELSE
  625.       MUGerror (couldnt + "open 'reqtools.library' V38\n");
  626.     END;
  627.   END;
  628.   IF (myArg [0] = "?") THEN       (* Hey, someone wants to know about us *)
  629.     MUGerror (version + "\nUsage: MUGiff [<file1> .. <fileN>]\n");
  630.   END;
  631.   FOR i := 1 TO NumArgs() DO
  632.     GetArg (i, myArg, len);
  633.     ChkBreakMsg();
  634.   END;
  635. CLOSE
  636.   WriteString ("\nAll done\n");
  637.   ClosePicture ();
  638.   rt.FreeFileList (myFileList);
  639.   IF (iff # NIL) THEN CloseIFF (iff); END;
  640. END MUGiff.
  641.