Graphics Plus/Graphics Plus.iso/amiga/convrtrs/supershm.lzh/src/SuperSHAM.Mod

Text File | 1989-10-04 | 6.8 KB | 224 lines

MODULE SuperSHAM;

(*======================================================================*)
(*                         SuperSHAM Version 3.10                       *)
(*======================================================================*)
(*         ⌐ 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.           *)
(*              You May NOT sell this pogram in any form!!!             *)
(*======================================================================*)
(*      Version: 3.10           Author : Robert Salesas                 *)
(*      Date   : 05-Oct-89      Changes: Original                       *)
(*======================================================================*)

FROM SYSTEM           IMPORT  ADR, BYTE, STRPTR;
FROM RunTime          IMPORT  WBMsg;
FROM CmdLineUtils     IMPORT  argc, argv;
FROM Workbench        IMPORT  WBStartupPtr, WBArgPtr, WBArg;
FROM LoadSHAM         IMPORT  LoadSHAMPicture, SHAMRegs, SHAMRegsPtr;
FROM BufferedDOS      IMPORT  BufHandle, BufOpen, BufClose, ModeOldFile;
FROM DOS              IMPORT  CurrentDir, FileLock;
FROM Intuition        IMPORT  ScreenPtr, ScreenFlagSet, NewScreen, CustomScreen,
                              OpenScreen, CloseScreen, WindowPtr, CloseWindow,
                              IDCMPFlagSet, IDCMPFlags, IntuiMessagePtr,
                              MenuDown, SelectDown,
                              WindowFlagSet, WindowFlags, SimpleRefresh,
                              ShowTitle;
FROM Ports            IMPORT  WaitPort, GetMsg, ReplyMsg;
FROM EasyWindows      IMPORT  CreateWindow;
FROM RSSystemReq      IMPORT  ErrorRequester;
FROM Puts             IMPORT  PutString;
FROM Support          IMPORT  Alert, PrintScreen;
FROM Views            IMPORT  ViewModes, ViewModeSet;
FROM Memory           IMPORT  AllocMem, FreeMem, MemReqSet, MemReqs;


VAR
  Registers   :   SHAMRegsPtr;
  Fh          :   BufHandle;
  Sp          :   ScreenPtr;
  Wp          :   WindowPtr;
  ArgCnt, L   :   CARDINAL;
  WBArgument  :   WBArgPtr;
  Next        :   BOOLEAN;


  PROCEDURE GetInput() : BOOLEAN;
  VAR
    Msg         :   IntuiMessagePtr;
    Class       :   IDCMPFlagSet;
    Button      :   CARDINAL;
    NewScr      :   NewScreen;
    InputSp     :   ScreenPtr;
    Choice      :   BOOLEAN;
    GoOn        :   BOOLEAN;
    UseKey      :   BOOLEAN;
  BEGIN
    UseKey := TRUE;
    GoOn := FALSE;
    REPEAT
      Msg := GetMsg(Wp^.UserPort);
      IF (Msg # NIL) THEN
        ReplyMsg(Msg);
      END;
    UNTIL (Msg = NIL);
    REPEAT
      Msg := WaitPort(Wp^.UserPort);
      Msg := GetMsg(Wp^.UserPort);
      Class := Msg^.Class;
      Button := Msg^.Code;
      ReplyMsg(Msg);

      IF (MouseButtons IN Class) AND (Button = SelectDown) THEN
        UseKey := FALSE;
      ELSIF (MouseButtons IN Class) AND (Button = MenuDown) THEN
        Choice := Alert("SuperSHAM V3.1  ⌐ Copyright 1989  Robert Salesas",
                        "(Mouse buttons cancel print mode once it has been started)");
        GoOn := TRUE;
        REPEAT
          Msg := GetMsg(Wp^.UserPort);
          IF (Msg # NIL) THEN
            ReplyMsg(Msg);
          END;
        UNTIL (Msg = NIL);
      ELSIF (RawKey IN Class) AND UseKey THEN
        Choice := FALSE;
        GoOn := TRUE;
      END;
    UNTIL GoOn;
    RETURN Choice;
  END GetInput;

  PROCEDURE GetScreen(Laced : BOOLEAN) : ScreenPtr;
  VAR
    NewScr      :   NewScreen;
  BEGIN
    WITH NewScr DO
      LeftEdge     := 0;
      TopEdge      := 0;
      Width        := 320;
      Depth        := 6;
      DetailPen    := BYTE(0);
      BlockPen     := BYTE(1);
      Type         := CustomScreen;
      Font         := NIL;
      Gadgets      := NIL;
      CustomBitMap := NIL;
      DefaultTitle := NIL;
      IF Laced THEN
        Height     := 400;
        ViewModes    := ViewModeSet{Lace, HAM};
      ELSE
        Height     := 200;
        ViewModes    := ViewModeSet{HAM};
      END;
    END;
    Sp := OpenScreen(ADR(NewScr));
    IF (Sp # NIL) THEN
      Wp := CreateWindow(0, 0, NewScr.Width, NewScr.Height, 0C, IDCMPFlagSet{MouseButtons, RawKey},
                         WindowFlagSet{Activate, Borderless, BackDrop, RMBTrap} + SimpleRefresh,
                         Sp, NIL);
      IF (Wp # NIL) THEN
        ShowTitle(Sp, FALSE);
        RETURN Sp;
      END;
      CloseScreen(Sp);
    END;
    RETURN NIL;
  END GetScreen;

  PROCEDURE ShowSHAM(Fh : BufHandle) : BOOLEAN;
  VAR
    Succ      :  BOOLEAN;
  BEGIN
    Succ := LoadSHAMPicture(Fh, GetScreen, Registers);
    IF NOT Succ THEN
      Succ := BufClose(Fh);
      RETURN FALSE;
    END;
    Succ := BufClose(Fh);
    RETURN TRUE;
  END ShowSHAM;

  PROCEDURE InitArgs() : CARDINAL;
  VAR
    TFh         :   BufHandle;
    WBStartup   :   WBStartupPtr;

  BEGIN
    IF (WBMsg = NIL) THEN
      RETURN (argc - 1);
    ELSE
      WBStartup := WBMsg;
      WBArgument := WBStartup^.smArgList;
      INC(WBArgument, SIZE(WBArg));
      RETURN (WBStartup^.smNumArgs - 1);
    END;
  END InitArgs;

  PROCEDURE GetNextFile(Arg : CARDINAL) : BufHandle;
  VAR
    TFh         :   BufHandle;
    OldLock     :   FileLock;

  BEGIN
    IF (WBMsg = NIL) THEN
      IF BufOpen(TFh, argv[Arg], 9600, ModeOldFile) THEN
        RETURN TFh;
      END;
    ELSE
      OldLock := CurrentDir(WBArgument^.waLock);
      IF BufOpen(TFh, WBArgument^.waName, 4096, ModeOldFile) THEN
        INC(WBArgument, SIZE(WBArg));
        RETURN TFh;
      END;
    END;
    RETURN BufHandle(0);
  END GetNextFile;

BEGIN
  L := 0;
  ArgCnt := InitArgs();
  IF (ArgCnt > 0) THEN
    Registers := AllocMem(SIZE(Registers^), MemReqSet{MemClear});
    IF (Registers # NIL) THEN
      REPEAT
        INC(L);
        Fh := GetNextFile(L);
        IF (Fh # BufHandle(0)) THEN
          Sp := NIL;
          IF ShowSHAM(Fh) THEN
            REPEAT
              Next := TRUE;
              IF GetInput() THEN
                Next := PrintScreen(Wp, Registers);
              END;
            UNTIL (Next = TRUE);
          ELSE
            ErrorRequester(NIL, "Insufficient memory or not a SHAM file");
          END;
          IF (Sp # NIL) THEN
            CloseWindow(Wp);  CloseScreen(Sp);
          END;
        ELSE
          ErrorRequester(NIL, "Could not find requested file.");
        END;
      UNTIL (L = ArgCnt);
      FreeMem(Registers, SIZE(Registers^));
    ELSE
      ErrorRequester(NIL, "Could not allocate sufficient memory.");
    END;
  ELSE
    IF (WBMsg = NIL) THEN
      PutString(0C);
      PutString("SuperSHAM Version 3.1 - ⌐ Copyright 1989  Robert Salesas");
      PutString(0C);
      PutString("  USAGE:  SuperSHAM Filename1 Filename2...");
      PutString(0C);
    ELSE
      ErrorRequester(NIL, "No pictures available to display.");
    END;
  END;
END SuperSHAM.