home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 200-299 / ff221a.lzh / IFFM2 / ViewILBM.mod < prev    next >
Text File  |  1989-06-24  |  11KB  |  279 lines
  1. MODULE ViewILBM;
  2.  
  3.  
  4. (*
  5.   ===========================================================================
  6.   ||                                                                       ||
  7.   ||   VIEWILBM - Amiga (r) version                                        ||
  8.   ||                                                                       ||
  9.   ||   Original Developers:  November 20, 1988, Greg Epley                 ||
  10.   ||                                                                       ||
  11.   ||   Program Version:  *   1.0.0, May 30, 1989, Greg Epley               ||
  12.   ||                         First implementation; loosely based on the    ||
  13.   ||                         programs ShowILBM and Display; compiled with  ||
  14.   ||                         M2AMIGA Rel. 3.1                              ||
  15.   ||                                                                       ||
  16.   ||                                                                       ||
  17.   ||              Copyright (c) 1988, 1989  Second Sight (tm)              ||
  18.   ||                                                                       ||
  19.   ||    Amiga is a registered trademark of Commodore-Amiga, Inc.  Second   ||
  20.   ||    Sight is a trademark of Second Sight, Lexington, North Carolina.   ||
  21.   ||                                                                       ||
  22.   ===========================================================================
  23. *)
  24.  
  25.  
  26. (*
  27. =================================  IMPORTS  =================================
  28. *)
  29. FROM Arguments        IMPORT NumArgs, GetArg;
  30. FROM Arts        IMPORT TermProcedure;
  31. FROM Conversions    IMPORT StrToVal;
  32. FROM Dos        IMPORT oldFile,
  33.                                Delay;
  34. FROM Exec        IMPORT GetMsg, ReplyMsg;
  35. FROM Graphics        IMPORT LoadRGB4,
  36.                                ViewModeSet,
  37.                                TextAttr,
  38.                                FontFlags, FontFlagSet,
  39.                                FontStyles, FontStyleSet;
  40. FROM IFFM2        IMPORT ID, IDFORM, IDILBM, IDBMHD, IDCMAP, IDBODY,
  41.                                  IDCAMG, IDEOFX,
  42.                                IFFFileFramePtr,
  43.                                MaxColorRegister,
  44.                                OpenIFF, CloseIFF,
  45.                                PrintIFFError,
  46.                                GetChunkHdr, GetType,
  47.                                GetPad, GetUnknown, GetBMHD, GetCMAP,
  48.                                  GetBODY, GetCAMG;
  49. FROM Intuition        IMPORT OpenScreen, CloseScreen, NewScreen,
  50.                                OpenWindow, CloseWindow, NewWindow,
  51.                                ScreenPtr, ScreenFlags, ScreenFlagSet,
  52.                                WindowPtr, WindowFlags, WindowFlagSet,
  53.                                IDCMPFlags, IDCMPFlagSet, IntuiMessagePtr,
  54.                                RemakeDisplay, SetPointer, ClearPointer,
  55.                                  ShowTitle,
  56.                                customScreen, selectDown;
  57. FROM SYSTEM        IMPORT ADR, INLINE;
  58. FROM Terminal        IMPORT WriteString, WriteLn, waitCloseGadget;
  59.  
  60.  
  61. VAR
  62.   picFrame    : IFFFileFramePtr;
  63.   chID        : ID;
  64.   chSize    : LONGINT;
  65.   okay        : BOOLEAN;
  66.   
  67.   sP        : ScreenPtr;
  68.   wP        : WindowPtr;
  69.   
  70.   (* these are for handling passed agruments *)
  71.   picName,
  72.   argv        : ARRAY [0..79] OF CHAR;
  73.   picDelay,
  74.   argc,
  75.   argl        : INTEGER;
  76.   l        : LONGINT;
  77.   sign        : BOOLEAN;
  78.   
  79.   (* general use *)
  80.   i        : INTEGER;
  81.   u        : ARRAY [0..5] OF ARRAY [0..65] OF CHAR;
  82.  
  83.  
  84. (*$E-*)  (* no entry/exit code since this is just data *)
  85. PROCEDURE BlankPtrData;
  86.   BEGIN
  87.     INLINE (0, 0, 0, 0, 0, 0);
  88. END BlankPtrData;
  89.  
  90.  
  91. PROCEDURE Cleanup;
  92.   BEGIN
  93.     IF picFrame # NIL THEN CloseIFF (picFrame) END;
  94.     IF wP # NIL THEN ClearPointer (wP); CloseWindow (wP) END;
  95.     IF sP # NIL THEN CloseScreen (sP) END;
  96. END Cleanup;
  97.  
  98.  
  99. PROCEDURE MakeDisplay () : BOOLEAN;
  100.   VAR
  101.     ns    : NewScreen;
  102.     nw    : NewWindow;
  103.     ta    : TextAttr;
  104.   BEGIN
  105.     (* force topaz 8 font *)
  106.     ta.name := ADR("topaz.font");  ta.flags := FontFlagSet {romFont};
  107.     ta.style := FontStyleSet {};  ta.ySize := 8;
  108.     
  109.     WITH ns DO
  110.       leftEdge := picFrame^.bmhd^.x;  topEdge := picFrame^.bmhd^.y;
  111.       width := picFrame^.bmhd^.w;  height := picFrame^.bmhd^.h;
  112.       depth := picFrame^.bmhd^.nPlanes;  viewModes := picFrame^.camg;
  113.       detailPen := 1;  blockPen := 0;  type := customScreen;
  114.       font := ADR(ta);  gadgets := NIL;
  115.       defaultTitle := ADR(" <- Close here after clicking below");
  116.     END;
  117.     sP := OpenScreen (ns);
  118.     IF sP = NIL THEN RETURN FALSE END;
  119.     LoadRGB4 (ADR(sP^.viewPort), ADR(picFrame^.cmap[0]), MaxColorRegister);
  120.     WITH nw DO
  121.       leftEdge := 0;  topEdge := 0;  width := sP^.width;  detailPen := 0;
  122.       height := sP^.height;  idcmpFlags := IDCMPFlagSet {mouseButtons};
  123.       flags := WindowFlagSet {borderless, backDrop, activate};
  124.       blockPen := 0;  firstGadget := NIL;  title := NIL;  screen := sP;
  125.       type := customScreen;
  126.     END;
  127.     wP := OpenWindow (nw);
  128.     IF wP = NIL THEN RETURN FALSE END;
  129.     
  130.     (* set display offsets [only applies if overscan] *)
  131.     sP^.viewPort.dxOffset :=
  132.       -(ABS(INTEGER(picFrame^.bmhd^.w)-picFrame^.bmhd^.pageWidth) DIV 2);
  133.     sP^.viewPort.dyOffset :=
  134.       -(ABS(INTEGER(picFrame^.bmhd^.h)-picFrame^.bmhd^.pageHeight) DIV 2);
  135.     picFrame^.bitmap := ADR(sP^.bitMap);
  136.     
  137.     (* makes the changes take effect and clears the title bar *)
  138.     RemakeDisplay();  ShowTitle (sP, FALSE);  RETURN TRUE;
  139. END MakeDisplay;
  140.  
  141.  
  142. PROCEDURE GetPicture () : BOOLEAN;
  143.   BEGIN
  144.     (* Use this as a general use reading parser, making changes only in the
  145.      * way that the display, color map, and viewmodes are handled for the
  146.      * display you would like; I preferred Intuition in this case. *)
  147.     picFrame := OpenIFF (picName, oldFile);
  148.     IF picFrame = NIL THEN
  149.       PrintIFFError();  RETURN FALSE;
  150.     ELSE  (* must have opened the file OK *)
  151.       chID := GetChunkHdr (picFrame, chSize);
  152.       IF chID = IDEOFX THEN
  153.         PrintIFFError();  RETURN FALSE;
  154.       ELSIF chID = IDFORM THEN  (* found FORM okay *)
  155.         chID := GetType (picFrame);
  156.         (* now find out what type of file this is *)
  157.         IF chID = IDEOFX THEN
  158.           PrintIFFError();  RETURN FALSE;
  159.         ELSIF chID = IDILBM THEN
  160.           LOOP  (* start of chunk parsing loop *)
  161.             chID := GetChunkHdr (picFrame, chSize);
  162.             IF chID = IDEOFX THEN
  163.               EXIT;  (* found EOF *)
  164.             ELSIF chID = IDBMHD THEN
  165.               okay := GetBMHD (picFrame, chSize);
  166.             ELSIF chID = IDCMAP THEN
  167.               okay := GetCMAP (picFrame, chSize);
  168.             ELSIF chID = IDBODY THEN
  169.               okay := GetBODY (picFrame, chSize);
  170.             ELSIF chID = IDCAMG THEN
  171.               okay := GetCAMG (picFrame, chSize);
  172.             ELSE  (* unrecognized file chunk *)
  173.               okay := GetUnknown (picFrame, chSize);
  174.             END;  (* end of chunk type parsing *)
  175.             IF NOT okay THEN PrintIFFError(); EXIT; END;
  176.             IF ODD(chSize) THEN
  177.               okay := GetPad (picFrame);
  178.               IF NOT okay THEN PrintIFFError(); EXIT; END;
  179.             END;  (* end of pad handling on weird chunks *)
  180.             IF chID = IDBMHD THEN
  181.               okay := MakeDisplay();
  182.               IF NOT okay THEN EXIT END;
  183.             ELSIF chID = IDCMAP THEN
  184.               LoadRGB4 (ADR(sP^.viewPort), ADR(picFrame^.cmap[0]),
  185.                 picFrame^.nColors);
  186.             ELSIF chID = IDCAMG THEN
  187.               sP^.viewPort.modes := picFrame^.camg;  RemakeDisplay();
  188.             END;
  189.           END;  (* end of chunk parsing loop *)
  190.           IF NOT okay THEN RETURN FALSE END;
  191.         ELSE  (* unrecognized file type chunk *)
  192.           PrintIFFError();  RETURN FALSE;
  193.         END;  (* end of file type chunk parsing *)
  194.       END;  (* end of FORM check *)
  195.     END;  (* end of file opening *)
  196.     RETURN TRUE;
  197. END GetPicture;
  198.  
  199.  
  200. PROCEDURE Monitor ();
  201.   VAR
  202.     msg        : IntuiMessagePtr;
  203.     class    : IDCMPFlagSet;
  204.     code    : CARDINAL;
  205.     mouseX,
  206.     mouseY    : INTEGER;
  207.     TBToggle,
  208.     Done    : BOOLEAN;
  209.   BEGIN
  210.     (* Message checking/handling and time delay operations specific to
  211.      * this program. *)
  212.     SetPointer (wP, ADR(BlankPtrData), 0, 0, 1, 1);
  213.     Done := FALSE;  TBToggle := FALSE;
  214.     
  215.     LOOP
  216.       msg := GetMsg (wP^.userPort);
  217.       IF msg # NIL THEN
  218.         class := msg^.class;  code := msg^.code;
  219.         mouseX := msg^.mouseX;  mouseY := msg^.mouseY;
  220.         ReplyMsg (msg);
  221.         IF (mouseButtons IN class) & (code = selectDown) THEN
  222.           IF (mouseX < 10) & (mouseY < 10) THEN
  223.             Done := TRUE;
  224.           ELSIF ((mouseY > 10) OR (mouseX > 10)) & NOT TBToggle THEN
  225.             TBToggle := TRUE;  ShowTitle (sP, TRUE);  ClearPointer (wP);
  226.           ELSIF (mouseY > 10) & TBToggle THEN
  227.             TBToggle := FALSE;  ShowTitle (sP, FALSE);
  228.             SetPointer (wP, ADR(BlankPtrData), 0, 0, 1, 1);
  229.           END;
  230.         END;
  231.       END;
  232.       IF picDelay # -1 THEN  (* if <delay> passed in *)
  233.         Delay (45);
  234.         IF picDelay > 0 THEN DEC(picDelay) ELSE Done := TRUE END;
  235.       END;
  236.       IF Done THEN EXIT END;
  237.     END;
  238. END Monitor;
  239.  
  240.  
  241.  
  242. (*=========================================================================
  243.   |                    _    _       __           _                        |
  244.   |                   | \  / |     /__\     ||  | \  ||                   |
  245.   |                   ||\\//||    //  \\    ||  ||\\ ||                   |
  246.   |                   || \/ ||   //====\\   ||  || \\||                   |
  247.   |                   ||    ||  //      \\  ||  ||  \_|                   |
  248.   |                                                                       |
  249.   =========================================================================*)
  250.  
  251. BEGIN
  252.   TermProcedure (Cleanup);  waitCloseGadget := FALSE;
  253.   
  254.   u[0] := "CLI Usage: ViewILBM <file> [<delay>]";
  255.   u[1] := "WB Usage:  Click ViewILBM, hold <SHIFT> key, and double-click";
  256.   u[2] := "           picture.";
  257.   u[3] := "The optional CLI <delay> is the number of seconds to display.";
  258.   u[4] := "Click below title bar to toggle drag bar.";
  259.   u[5] := "Click in upper left corner to close.";
  260.   
  261.   argc := NumArgs();
  262.   IF (argc < 1) OR (argc > 2) THEN  (* no args or more than 2 max. *)
  263.     FOR i := 0 TO 5 DO WriteString (u[i]); WriteLn; END;
  264.     waitCloseGadget := TRUE;
  265.   ELSE
  266.     FOR i := 1 TO argc DO
  267.       CASE i OF
  268.         1 : GetArg (1, picName, argl);  picDelay := -1;
  269.       | 2 : GetArg (2, argv, argl);
  270.             StrToVal (argv, l, sign, 10, okay);
  271.             picDelay := INTEGER(l);
  272.       END;
  273.     END;
  274.     okay := GetPicture();
  275.     IF okay THEN Monitor() END;
  276.   END;
  277.  
  278. END ViewILBM.
  279.