home *** CD-ROM | disk | FTP | other *** search
- 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.
-