home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / amiga / convrtrs / supershm.lzh / src / SuperSHAM.Mod < prev    next >
Encoding:
Text File  |  1989-10-04  |  6.8 KB  |  224 lines

  1. MODULE SuperSHAM;
  2.  
  3. (*======================================================================*)
  4. (*                         SuperSHAM Version 3.10                       *)
  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. (*              You May NOT sell this pogram in any form!!!             *)
  10. (*======================================================================*)
  11. (*      Version: 3.10           Author : Robert Salesas                 *)
  12. (*      Date   : 05-Oct-89      Changes: Original                       *)
  13. (*======================================================================*)
  14.  
  15. FROM SYSTEM           IMPORT  ADR, BYTE, STRPTR;
  16. FROM RunTime          IMPORT  WBMsg;
  17. FROM CmdLineUtils     IMPORT  argc, argv;
  18. FROM Workbench        IMPORT  WBStartupPtr, WBArgPtr, WBArg;
  19. FROM LoadSHAM         IMPORT  LoadSHAMPicture, SHAMRegs, SHAMRegsPtr;
  20. FROM BufferedDOS      IMPORT  BufHandle, BufOpen, BufClose, ModeOldFile;
  21. FROM DOS              IMPORT  CurrentDir, FileLock;
  22. FROM Intuition        IMPORT  ScreenPtr, ScreenFlagSet, NewScreen, CustomScreen,
  23.                               OpenScreen, CloseScreen, WindowPtr, CloseWindow,
  24.                               IDCMPFlagSet, IDCMPFlags, IntuiMessagePtr,
  25.                               MenuDown, SelectDown,
  26.                               WindowFlagSet, WindowFlags, SimpleRefresh,
  27.                               ShowTitle;
  28. FROM Ports            IMPORT  WaitPort, GetMsg, ReplyMsg;
  29. FROM EasyWindows      IMPORT  CreateWindow;
  30. FROM RSSystemReq      IMPORT  ErrorRequester;
  31. FROM Puts             IMPORT  PutString;
  32. FROM Support          IMPORT  Alert, PrintScreen;
  33. FROM Views            IMPORT  ViewModes, ViewModeSet;
  34. FROM Memory           IMPORT  AllocMem, FreeMem, MemReqSet, MemReqs;
  35.  
  36.  
  37. VAR
  38.   Registers   :   SHAMRegsPtr;
  39.   Fh          :   BufHandle;
  40.   Sp          :   ScreenPtr;
  41.   Wp          :   WindowPtr;
  42.   ArgCnt, L   :   CARDINAL;
  43.   WBArgument  :   WBArgPtr;
  44.   Next        :   BOOLEAN;
  45.  
  46.  
  47.   PROCEDURE GetInput() : BOOLEAN;
  48.   VAR
  49.     Msg         :   IntuiMessagePtr;
  50.     Class       :   IDCMPFlagSet;
  51.     Button      :   CARDINAL;
  52.     NewScr      :   NewScreen;
  53.     InputSp     :   ScreenPtr;
  54.     Choice      :   BOOLEAN;
  55.     GoOn        :   BOOLEAN;
  56.     UseKey      :   BOOLEAN;
  57.   BEGIN
  58.     UseKey := TRUE;
  59.     GoOn := FALSE;
  60.     REPEAT
  61.       Msg := GetMsg(Wp^.UserPort);
  62.       IF (Msg # NIL) THEN
  63.         ReplyMsg(Msg);
  64.       END;
  65.     UNTIL (Msg = NIL);
  66.     REPEAT
  67.       Msg := WaitPort(Wp^.UserPort);
  68.       Msg := GetMsg(Wp^.UserPort);
  69.       Class := Msg^.Class;
  70.       Button := Msg^.Code;
  71.       ReplyMsg(Msg);
  72.  
  73.       IF (MouseButtons IN Class) AND (Button = SelectDown) THEN
  74.         UseKey := FALSE;
  75.       ELSIF (MouseButtons IN Class) AND (Button = MenuDown) THEN
  76.         Choice := Alert("SuperSHAM V3.1  ⌐ Copyright 1989  Robert Salesas",
  77.                         "(Mouse buttons cancel print mode once it has been started)");
  78.         GoOn := TRUE;
  79.         REPEAT
  80.           Msg := GetMsg(Wp^.UserPort);
  81.           IF (Msg # NIL) THEN
  82.             ReplyMsg(Msg);
  83.           END;
  84.         UNTIL (Msg = NIL);
  85.       ELSIF (RawKey IN Class) AND UseKey THEN
  86.         Choice := FALSE;
  87.         GoOn := TRUE;
  88.       END;
  89.     UNTIL GoOn;
  90.     RETURN Choice;
  91.   END GetInput;
  92.  
  93.   PROCEDURE GetScreen(Laced : BOOLEAN) : ScreenPtr;
  94.   VAR
  95.     NewScr      :   NewScreen;
  96.   BEGIN
  97.     WITH NewScr DO
  98.       LeftEdge     := 0;
  99.       TopEdge      := 0;
  100.       Width        := 320;
  101.       Depth        := 6;
  102.       DetailPen    := BYTE(0);
  103.       BlockPen     := BYTE(1);
  104.       Type         := CustomScreen;
  105.       Font         := NIL;
  106.       Gadgets      := NIL;
  107.       CustomBitMap := NIL;
  108.       DefaultTitle := NIL;
  109.       IF Laced THEN
  110.         Height     := 400;
  111.         ViewModes    := ViewModeSet{Lace, HAM};
  112.       ELSE
  113.         Height     := 200;
  114.         ViewModes    := ViewModeSet{HAM};
  115.       END;
  116.     END;
  117.     Sp := OpenScreen(ADR(NewScr));
  118.     IF (Sp # NIL) THEN
  119.       Wp := CreateWindow(0, 0, NewScr.Width, NewScr.Height, 0C, IDCMPFlagSet{MouseButtons, RawKey},
  120.                          WindowFlagSet{Activate, Borderless, BackDrop, RMBTrap} + SimpleRefresh,
  121.                          Sp, NIL);
  122.       IF (Wp # NIL) THEN
  123.         ShowTitle(Sp, FALSE);
  124.         RETURN Sp;
  125.       END;
  126.       CloseScreen(Sp);
  127.     END;
  128.     RETURN NIL;
  129.   END GetScreen;
  130.  
  131.   PROCEDURE ShowSHAM(Fh : BufHandle) : BOOLEAN;
  132.   VAR
  133.     Succ      :  BOOLEAN;
  134.   BEGIN
  135.     Succ := LoadSHAMPicture(Fh, GetScreen, Registers);
  136.     IF NOT Succ THEN
  137.       Succ := BufClose(Fh);
  138.       RETURN FALSE;
  139.     END;
  140.     Succ := BufClose(Fh);
  141.     RETURN TRUE;   
  142.   END ShowSHAM;
  143.  
  144.   PROCEDURE InitArgs() : CARDINAL;
  145.   VAR
  146.     TFh         :   BufHandle;
  147.     WBStartup   :   WBStartupPtr;
  148.  
  149.   BEGIN
  150.     IF (WBMsg = NIL) THEN
  151.       RETURN (argc - 1);
  152.     ELSE
  153.       WBStartup := WBMsg;
  154.       WBArgument := WBStartup^.smArgList;
  155.       INC(WBArgument, SIZE(WBArg));
  156.       RETURN (WBStartup^.smNumArgs - 1);
  157.     END;
  158.   END InitArgs;
  159.  
  160.   PROCEDURE GetNextFile(Arg : CARDINAL) : BufHandle;
  161.   VAR
  162.     TFh         :   BufHandle;
  163.     OldLock     :   FileLock;
  164.  
  165.   BEGIN
  166.     IF (WBMsg = NIL) THEN
  167.       IF BufOpen(TFh, argv[Arg], 9600, ModeOldFile) THEN
  168.         RETURN TFh;
  169.       END;
  170.     ELSE
  171.       OldLock := CurrentDir(WBArgument^.waLock);
  172.       IF BufOpen(TFh, WBArgument^.waName, 4096, ModeOldFile) THEN
  173.         INC(WBArgument, SIZE(WBArg));
  174.         RETURN TFh;
  175.       END;
  176.     END;
  177.     RETURN BufHandle(0);
  178.   END GetNextFile;
  179.  
  180. BEGIN
  181.   L := 0;
  182.   ArgCnt := InitArgs();
  183.   IF (ArgCnt > 0) THEN
  184.     Registers := AllocMem(SIZE(Registers^), MemReqSet{MemClear});
  185.     IF (Registers # NIL) THEN
  186.       REPEAT
  187.         INC(L);
  188.         Fh := GetNextFile(L);
  189.         IF (Fh # BufHandle(0)) THEN
  190.           Sp := NIL;
  191.           IF ShowSHAM(Fh) THEN
  192.             REPEAT
  193.               Next := TRUE;
  194.               IF GetInput() THEN
  195.                 Next := PrintScreen(Wp, Registers);
  196.               END;
  197.             UNTIL (Next = TRUE);
  198.           ELSE
  199.             ErrorRequester(NIL, "Insufficient memory or not a SHAM file");
  200.           END;
  201.           IF (Sp # NIL) THEN
  202.             CloseWindow(Wp);  CloseScreen(Sp);
  203.           END;
  204.         ELSE
  205.           ErrorRequester(NIL, "Could not find requested file.");
  206.         END;
  207.       UNTIL (L = ArgCnt);
  208.       FreeMem(Registers, SIZE(Registers^)); 
  209.     ELSE
  210.       ErrorRequester(NIL, "Could not allocate sufficient memory.");
  211.     END;
  212.   ELSE
  213.     IF (WBMsg = NIL) THEN
  214.       PutString(0C);
  215.       PutString("SuperSHAM Version 3.1 - ⌐ Copyright 1989  Robert Salesas");
  216.       PutString(0C);
  217.       PutString("  USAGE:  SuperSHAM Filename1 Filename2...");
  218.       PutString(0C);
  219.     ELSE
  220.       ErrorRequester(NIL, "No pictures available to display.");
  221.     END;
  222.   END;
  223. END SuperSHAM.
  224.