MODULE ShowPic;

(*======================================================================*)
(*                       ShowPic - Title Page Support                   *)
(*======================================================================*)
(*         © Copyright 1990 Robert Salesas, All Rights Reserved         *)
(*======================================================================*)
(*      Version: 2.00           Author : Robert Salesas                 *)
(*      Date   : 24-May-90      Changes: Original                       *)
(*======================================================================*)

FROM SYSTEM           IMPORT  ADR, ADDRESS, BYTE, SHIFT;
FROM TPExtDefs        IMPORT  DisplayListPtr, DLData, DLDataPtr;
FROM Memory           IMPORT  AllocMem, FreeMem, MemReqSet, MemReqs;
FROM Copper           IMPORT  UCopListPtr, UCopList, CWAIT, CMOVE, CEND;
FROM CustomHardware   IMPORT  custom;
FROM Interrupts       IMPORT  Forbid, Permit;
FROM RunTime          IMPORT  WBMsg, IntuitionBase;
FROM IntuitionBase    IMPORT  LockIBase, UnlockIBase, IntuitionBaseRecPtr;
FROM Workbench        IMPORT  WBStartupPtr, WBArg, WBArgPtr;
FROM CmdLineUtils     IMPORT  argc, argv;
FROM Intuition        IMPORT  WindowPtr, ScreenPtr, CloseWindow, CloseScreen,
                              Screen, CustomScreen, DisplayBeep, SimpleRefresh,
                              WBenchScreen, GetScreenData, RemakeDisplay,
                              ScreenFlags, ScreenFlagSet, ScreenToFront,
                              IDCMPFlagSet, IDCMPFlags, IntuiMessagePtr,
                              WindowFlagSet, WindowFlags, ActivateWindow;
FROM RSScreens        IMPORT  CreateScreen;
FROM EasyWindows      IMPORT  CreateWindow;
FROM Views            IMPORT  SetRGB4, LoadRGB4, ViewModes, ViewModeSet,
                              FreeVPortCopLists;
FROM Ports            IMPORT  WaitPort, GetMsg, ReplyMsg;
FROM BufferedDOS      IMPORT  BufOpen, BufClose, BufHandle;
FROM DOS              IMPORT  CurrentDir, FileHandle, FileLock,
                              ModeOldFile, ModeNewFile;
FROM PutString        IMPORT  Puts;
FROM RSReadPict       IMPORT  ILBMFrame, ReadPicture,
                              DListPtr, currentFrame, readState;
FROM Graphics         IMPORT  BitMapPtr;
FROM EasyPointers     IMPORT  AddBlankPointer;


VAR
  Sp              :  ScreenPtr;
  Wp              :  WindowPtr;
  DList           :  DListPtr;
  LoResDefault,
  HiResDefault,
  NoLaceDefault,
  LaceDefault     :  INTEGER;
  IBase           :  IntuitionBaseRecPtr;
  IBLock          :   LONGCARD;
  ViewDx,
  IntuiVersion    :  INTEGER;


  PROCEDURE ReturnBitMap(VAR Frame : ILBMFrame) : BitMapPtr;

      PROCEDURE InitScreen(Width, Height : INTEGER;  Depth : BYTE;
                           Modes : ViewModeSet) : BOOLEAN;
      VAR
        X, Y  :  INTEGER;
      BEGIN
        IF (Width < 320) THEN
          Width := 320;
        END;
        IF (Height < 200) THEN
          Height := 200;
        END;

        IF (IntuiVersion <= 35) THEN
          X := 0;  Y := 0;
        ELSE
          X := (Width - LoResDefault) DIV 2;
          IF (HiRes IN Modes) THEN
            X := (Width - HiResDefault) DIV 2;
          END;
          Y := (Height - NoLaceDefault) DIV 2;
          IF (Lace IN Modes) THEN
            Y := (Height - LaceDefault) DIV 2;
          END;
        END;

        Sp := CreateScreen(-X, -Y, Width, Height, CARDINAL(Depth), Modes,
                           ScreenFlagSet{ScreenBehind} + CustomScreen, 0C);
        IF (Sp # NIL) THEN
          SetRGB4(ADR(Sp^.VPort), 0, 0, 0, 0);
          SetRGB4(ADR(Sp^.VPort), 1, 0, 0, 0);
          Wp := CreateWindow(0, 0, Width, Height, 0C, IDCMPFlagSet{MouseButtons},
                             WindowFlagSet{RMBTrap, Borderless} + SimpleRefresh,
                             Sp, NIL);
          IF (Wp # NIL) THEN
            AddBlankPointer(Wp);
            RETURN TRUE;
          END;
          CloseScreen(Sp);
        END;
        RETURN FALSE;
      END InitScreen;

  BEGIN
    WITH Frame DO
      IF foundCAMG THEN
        IF InitScreen(bmHdr.w, bmHdr.h, bmHdr.nPlanes, camgChunk.ViewModes) THEN
          RETURN ADR(Sp^.BMap);
        END;
      ELSE
        IF InitScreen(bmHdr.w, bmHdr.h, bmHdr.nPlanes, ViewModeSet{Lace, HiRes}) THEN
          RETURN ADR(Sp^.BMap);
        END;
      END;
      RETURN NIL;
    END;
  END ReturnBitMap;


  PROCEDURE ModifyCopList;
  VAR
    UCop        :  UCopListPtr;
    MyD,
    MyS, MyC    :  ADDRESS;
    L1          :  CARDINAL;
    DataPtr     :  DLDataPtr;
    Changed     :  BOOLEAN;
    MCL_DList   :  DisplayListPtr;

      PROCEDURE DeleteDList;
      BEGIN
        IF (MCL_DList # NIL) THEN
          FreeMem(MCL_DList^.Data, MCL_DList^.Rows * SIZE(DLData));
          FreeMem(MCL_DList, SIZE(MCL_DList^));
          MCL_DList := NIL;
        END;
      END DeleteDList;

  BEGIN
    IF (DList # NIL) THEN
      MCL_DList := ADDRESS(DList);

      UCop := AllocMem(SIZE(UCopList), MemReqSet{MemChip, MemClear});
      IF (UCop # NIL) THEN
        Changed := FALSE;

        DataPtr := MCL_DList^.Data;
        FOR L1 := 0 TO (DList^.Rows - 1) DO
          IF (DataPtr^.Back # -1) OR (DataPtr^.Fore # -1) THEN
            IF (Lace IN Sp^.VPort.Modes) THEN
              CWAIT(UCop, L1 + L1, 0);
            ELSE
              CWAIT(UCop, L1, 0);
            END;
            IF (DataPtr^.Back # -1) THEN
              CMOVE(UCop, ADR(custom^.color[0]), DataPtr^.Back);
              Changed := TRUE;
            END;
            IF (DataPtr^.Fore # -1) THEN
              CMOVE(UCop, ADR(custom^.color[DList^.ForePen]), DataPtr^.Fore);
            END;
          END;
          INC(DataPtr, SIZE(DLData));
        END;

        IF Changed THEN
          LoadRGB4(ADR(Sp^.VPort), ADR(DList^.BackRGB), 1);
        END;
        CEND(UCop);

        Forbid;
        WITH Sp^.VPort DO
          MyD := DspIns;
          MyS := SprIns;
          MyC := ClrIns;
        END;
        WITH Sp^.VPort DO
          DspIns := NIL;
          SprIns := NIL;
          ClrIns := NIL;
        END;
        FreeVPortCopLists(ADR(Sp^.VPort));
        WITH Sp^.VPort DO
          DspIns := MyD;
          SprIns := MyS;
          ClrIns := MyC;
        END;
        Sp^.VPort.UCopIns := UCop;
        Permit;
        RemakeDisplay;
      END;
      DeleteDList;
    END;
  END ModifyCopList;


  PROCEDURE HandleOverscan(Sp : ScreenPtr);
  VAR
    X, Y  :  INTEGER;
  BEGIN
    IF (IntuiVersion <= 35) THEN
      X := (Sp^.Width - LoResDefault) DIV 2;
      IF (HiRes IN Sp^.VPort.Modes) THEN
        X := (Sp^.Width - HiResDefault) DIV 2;
      END;
      Y := (Sp^.Height - NoLaceDefault) DIV 2;
      IF (Lace IN Sp^.VPort.Modes) THEN
        Y := (Sp^.Height - LaceDefault) DIV 2;
      END;

      DEC(Sp^.LeftEdge, X);
      DEC(Sp^.TopEdge, Y);
      DEC(Sp^.VPort.DxOffset, X);
      DEC(Sp^.VPort.DyOffset, Y);
      RemakeDisplay;
    END;
  END HandleOverscan;


  PROCEDURE ShowAPicture;
  VAR
    NewFh       :  BufHandle;
    CurArg,
    NumArgs     :  CARDINAL;
    Msg         :  IntuiMessagePtr;
    WBArgument  :  WBArgPtr;

    PROCEDURE ReadFile(Fh : BufHandle) : BOOLEAN;
    VAR
      State  :  BOOLEAN;
    BEGIN
      DList := NIL;
      State := FALSE;
      IF NOT ReadPicture(Fh, ReturnBitMap, TRUE, DList) THEN
        DisplayBeep(NIL);
      ELSE
        LoadRGB4(ADR(Sp^.VPort), ADR(currentFrame.colorMap), CARDINAL(currentFrame.nColorRegs));
        ModifyCopList;
        IF (IntuiVersion <= 35) THEN
          HandleOverscan(Sp);
        END;
        ScreenToFront(Sp);
        ActivateWindow(Wp);
        State := TRUE;
      END;
      RETURN State AND BufClose(Fh);
    END ReadFile;

    PROCEDURE InitArgs() : CARDINAL;
    VAR
      WBStartUp  :  WBStartupPtr;
    BEGIN
      IF (WBMsg = NIL) THEN
        IF (argc > 1) THEN
          RETURN (argc - 1);
        END;
      ELSE
        IF (WBStartUp^.smNumArgs > 1) THEN
          WBStartUp := WBMsg;
          WBArgument := WBStartUp^.smArgList;
          INC(WBArgument, SIZE(WBArg));
          RETURN (WBStartUp^.smNumArgs - 1);
        END;
      END;
      RETURN 0;
    END InitArgs;

    PROCEDURE GetNextFile(Arg : CARDINAL;  VAR Fh : BufHandle) : BOOLEAN;
    VAR
      OldLock  :  FileLock;
      State    :  BOOLEAN;
    BEGIN
      IF (WBMsg = NIL) THEN
        State := BufOpen(Fh, argv[Arg], 4096, ModeOldFile);
      ELSE
        OldLock := CurrentDir(WBArgument^.waLock);
        State := BufOpen(Fh, WBArgument^.waName, 4096, ModeOldFile);
        INC(WBArgument, SIZE(WBArg));
      END;
      RETURN State;
    END GetNextFile;

  BEGIN
    CurArg := 0;
    NumArgs := InitArgs();
    IF (NumArgs > 0) THEN
      REPEAT
        INC(CurArg);
        IF GetNextFile(CurArg, NewFh) THEN
          IF ReadFile(NewFh) THEN
            Msg := WaitPort(Wp^.UserPort);
            Msg := GetMsg(Wp^.UserPort);
            ReplyMsg(Msg);
            CloseWindow(Wp);
            CloseScreen(Sp);
          ELSE
            DisplayBeep(NIL);
          END;
        ELSE
          DisplayBeep(NIL);
        END;
      UNTIL (CurArg = NumArgs);
    ELSE
      DisplayBeep(NIL);
    END;
  END ShowAPicture;


  PROCEDURE AssignDefaults;
  VAR
    TempScreen  :  Screen;
  BEGIN
    LoResDefault := 320;
    HiResDefault := 640;
    NoLaceDefault := 200;
    LaceDefault := 400;
    IF GetScreenData(ADR(TempScreen), SIZE(TempScreen), WBenchScreen, NIL) THEN
      IF (TempScreen.Width > 800) THEN
        TempScreen.Width := TempScreen.Width DIV 2;
      END;
      IF (TempScreen.Height > 600) THEN
        TempScreen.Height := TempScreen.Height DIV 2;
      END;

      IF (HiRes IN TempScreen.VPort.Modes) THEN
        LoResDefault := TempScreen.Width DIV 2;
        HiResDefault := TempScreen.Width;
      ELSE
        LoResDefault := TempScreen.Width;
        HiResDefault := TempScreen.Width * 2;
      END;
      IF (Lace IN TempScreen.VPort.Modes) THEN
        NoLaceDefault := TempScreen.Height DIV 2;
        LaceDefault := TempScreen.Height;
      ELSE
        NoLaceDefault := TempScreen.Height;
        LaceDefault := TempScreen.Height * 2;
      END;
    END;
  END AssignDefaults;


BEGIN
  Puts("ShowPic V2.00 - © Copyright 1990 Robert Salesas");
  Puts("");

  IBLock := LockIBase(0);
  IBase := IntuitionBase;
  IntuiVersion := IBase^.LibNode.libVersion;
  ViewDx := IBase^.ViewLord.DxOffset;
  UnlockIBase(IBLock);

  AssignDefaults;
  ShowAPicture;
END ShowPic.