(* ------------------------------------------------------------------------
  :Program.       NTSC for NTSC
  :Contents.      Get 60 Hz for NTSC screens
  :Author.        Kai Bolay [kai]
  :Address.       Snail-Mail:              E-Mail:
  :Address.       Hoffmannstraße 168       UUCP: kai@amokle.tynet.sub.org
  :Address.       D-7250 Leonberg 1        FIDO: 2:247/706.3
  :History.       v1.0 [kai] 15-Aug-91 (started written history)
  :History.       v1.1 [kai] 16-Aug-91 (bug fixes)
  :History.       v1.2 [kai] 26-Sep-91 (+ improved stdHeight-handling)
  :History.       v1.3 [kai] 19-Nov-91 (+ AutoScroll, force)
  :History.       v1.4 [kai] 14-Dec-91 (+ tried to improve, no success)
  :History.       v1.5 [kai] 19-Jan-92 (+ removed illegal writes)
  :History.       v1.6 [kai] 24-Mar-92 (+ NEWLOOK for all screens)
  :Copyright.     Freeware
  :Language.      Oberon
  :Translator.    AMIGA OBERON v2.25d
  :Remark.        Thanks to Peter Cherna
  :Remark.        Thanks to Franz Schwarz for telling me a possibility to
  :Remark.        remove illegal writes to the TagList...
  :Remark.        NEWLOOK was inspired by Martin Berndt's TagScreens
  :Usage.         STDPAL/S,STDNTSC/S,USEAUTO/S,FORCENTSC/S,NEWLOOK/S
  :Usage.         The first two options describe behaviour for StdHeight-
  :Usage.         Screens. The third says use AutoScroll instead of PAL.
  :Usage.         The forth always forces NTSC, the last enables the 2.0
  :Usage.         look for all screens.
------------------------------------------------------------------------ *)
MODULE NTSC4NTSC;

IMPORT
  e: Exec, I: Intuition, g: Graphics, u: Utility, d: Dos, y: SYSTEM
  (* $IF DoIt *) ,dio: DebugIo (* $END *);

CONST
  OpenScreenOfs = -198;
  OpenScreenTagsOfs = -612;
  (* $IF DoIt *)
  Version = "$VER: NTSC4NTSC v1.6 (24-Mar-92) by Kai Bolay (Debug)\r\n";
  (* $ELSE *)
  Version = "$VER: NTSC4NTSC v1.6 (24-Mar-92) by Kai Bolay\r\n";
  (* $END *)
  Template = "STDPAL/S,STDNTSC/S,USEAUTO/S,FORCENTSC/S,NEWLOOK/S";
  ntscMonitorSet = y.VAL (LONGSET, g.ntscMonitorID);
  palMonitorSet = y.VAL (LONGSET, g.palMonitorID);
  STDPAL    = 0;
  STDNTSC   = 1;
  USEAUTO   = 2;
  FORCENTSC = 3;
  NEWLOOK   = 4;
  NumOpts   = 5;
TYPE
  TagArrayPtr = UNTRACED POINTER TO ARRAY 1 OF u.TagItem;
  ExtNewScreenPtr = UNTRACED POINTER TO I.ExtNewScreen;
  OpenScreenProc = PROCEDURE (newScreen{8}: ExtNewScreenPtr): I.ScreenPtr;
  OpenScreenTagsProc = PROCEDURE (newScreen{8}: I.NewScreenPtr;
                                  paraTagList{9}: TagArrayPtr): I.ScreenPtr;
VAR
  OldOpenScreen: OpenScreenProc;
  OldOpenScreenTags: OpenScreenTagsProc;
  OldNormRows: INTEGER;
  OScanRect: g.Rectangle;
  Opt: ARRAY NumOpts OF LONGINT;
  RD: d.RDArgsPtr;
  StdHeightMonitorSet: LONGSET;

(* $Debug- *)
(* $StackChk- $SaveRegs+ Prepare to work in other tasks *)
PROCEDURE NewOpenScreenTags* (newScreen{8}: I.NewScreenPtr;
                              paraTagList{9}: TagArrayPtr): I.ScreenPtr;
TYPE
  PenArray = ARRAY 1 OF INTEGER;
CONST
  Pens = PenArray (-1);
  Mask = LONGSET {0, 2, 5, 6, 7, 10, 11, 12, 15, 16, 17, 18};
  ES = I.EasyStruct (y.SIZE (I.EasyStruct), LONGSET {}, y.ADR ("NTSC4NTSC"),
  y.ADR ("Which Mode should be used for the\nscreen named \"%s\"?"),
  y.ADR ("NTSC|PAL"));
  MaxTags = 10;
VAR
  Base: I.IntuitionBasePtr;
  TState, Tag, DisplayTag, TypeTag, ScrollTag: u.TagItemPtr;
  Tags: ARRAY MaxTags OF u.TagItem;
  DisplayID: LONGINT;
  DisplaySet: LONGSET;
  OScanRect: g.Rectangle;
  Height: INTEGER;
  Title: e.STRPTR;
  DoScroll, ScrollMagic: BOOLEAN;
  ListEnd: INTEGER;
  tagList: u.TagItemPtr;
  scrPtr: I.ScreenPtr;

BEGIN
  Base := y.REG (14);

  (* $IF DoIt *)
  dio.WriteString ("\nHi Folks!\n");
  (* $END *)

  ListEnd := 0;

  IF paraTagList # NIL THEN
    tagList := u.CloneTagItems (paraTagList^);
    IF tagList = NIL THEN
      (* $IF DoIt *)
      dio.WriteString ("No Mem to clone!\n");
      (* $END *)
      y.SETREG (14, Base);
      RETURN OldOpenScreenTags (newScreen, paraTagList);
    END;
  ELSE
    tagList := NIL;
  END;

  Height := I.stdScreenHeight; DisplayTag := NIL; DisplayID := 0;
  ScrollMagic := TRUE; DoScroll := FALSE;
  Title := y.ADR ("");

  IF newScreen # NIL THEN
    Height := newScreen.height;
    Title := newScreen.defaultTitle;
    DisplayID := I.UIntToLong (y.VAL (INTEGER, newScreen.viewModes));
    (* $IF DoIt *)
    dio.WriteString ("NewScreen gibbet:\n");
    dio.WriteString ("Height: "); dio.WriteInt (Height, 4); dio.WriteLn;
    dio.WriteString ("DisplayID: "); dio.WriteHex (DisplayID, 8); dio.WriteLn;
    (* $END *)
  END; (* IF *)

  IF tagList # NIL THEN
    TState := tagList;
    LOOP
      Tag := u.NextTagItem (TState);
      IF Tag = NIL THEN EXIT END;
      CASE y.VAL (LONGINT, Tag.tag) OF
      | I.saDisplayID:  DisplayTag := Tag; DisplayID := Tag.data;
      | I.saType:       TypeTag := Tag;
      | I.saAutoScroll: ScrollTag := Tag;
      | I.saHeight:     Height := SHORT (y.VAL (LONGINT, Tag.data));
      | I.saTitle:      Title := Tag.data;
      | I.saOverscan:   ScrollMagic := FALSE;
      | I.saDClip:      ScrollMagic := FALSE;
      ELSE
      END;
    END;
    (* $IF DoIt *)
    dio.WriteString ("TagList gibbet:\n");
    dio.WriteString ("Height: "); dio.WriteInt (Height, 4); dio.WriteLn;
    dio.WriteString ("DisplayID: "); dio.WriteHex (DisplayID, 8); dio.WriteLn;
    (* $END *)
  END;

  DisplaySet := y.VAL (LONGSET, DisplayID) * Mask;
  (* $IF DoIt *)
  dio.WriteString ("The DisplayID: "); dio.WriteHex (y.VAL (LONGINT, DisplaySet), 8); dio.WriteLn;
  (* $END *)

  IF Opt[FORCENTSC] # 0 THEN
    DisplaySet := DisplaySet - palMonitorSet;
  END;

  IF (palMonitorSet * DisplaySet # palMonitorSet) AND
     (ntscMonitorSet * DisplaySet # ntscMonitorSet) AND
     (I.QueryOverscan (y.VAL (LONGINT, ntscMonitorSet + DisplaySet),
                       OScanRect, I.oScanText) # 0) THEN
    (* $IF DoIt *)
    dio.WriteString ("Let's patch: ");
    (* $END *)
    IF Height = I.stdScreenHeight THEN
      (* $IF DoIt *)
      dio.WriteString ("Std-Height\n");
      (* $END *)
      IF StdHeightMonitorSet = LONGSET {} THEN
        IF I.EasyRequest (NIL, y.ADR (ES), NIL, Title) = 1 THEN
          DisplayID := y.VAL (LONGINT, ntscMonitorSet + DisplaySet);
        ELSE
          DisplayID := y.VAL (LONGINT, palMonitorSet + DisplaySet);
        END;
      ELSE
        DisplayID := y.VAL (LONGINT, StdHeightMonitorSet + DisplaySet);
      END;
    ELSE
      IF (Height <= OScanRect.maxY - OScanRect.minY + 1) AND (Opt[STDPAL] = 0) THEN
        (* $IF DoIt *)
        dio.WriteString ("NTSC\n");
        (* $END *)
        DisplayID := y.VAL (LONGINT, ntscMonitorSet + DisplaySet);
      ELSE
        IF (Opt[USEAUTO] = 0) THEN
          (* $IF DoIt *)
          dio.WriteString ("PAL\n");
          (* $END *)
          DisplayID := y.VAL (LONGINT, palMonitorSet + DisplaySet);
        ELSE
          DoScroll := TRUE;
          DisplayID := y.VAL (LONGINT, ntscMonitorSet + DisplaySet);
          IF TypeTag # NIL THEN
            TypeTag.data := y.VAL (LONGINT, y.VAL (LONGSET, TypeTag.data) +
                                            LONGSET {I.autoScroll});
          END;
          IF ScrollTag # NIL THEN
            ScrollTag.data := I.LTRUE;
          END;
        END;
      END;
    END;
  END;

  IF Opt[NEWLOOK] # 0 THEN
    Tags[ListEnd].tag := I.saPens; Tags[ListEnd].data := y.ADR (Pens);
    INC (ListEnd);
(*
    Tags[ListEnd].tag := I.saFullPalette; Tags[ListEnd].data := I.LTRUE;
    INC (ListEnd);
*)
  END; (* IF *)

  IF DisplayTag # NIL THEN
    (* $IF DoIt *)
    dio.WriteString ("ab in den DispTag!\n");
    (* $END *)
    DisplayTag.data := DisplayID;
  ELSE
    Tags[ListEnd].tag := I.saDisplayID; Tags[ListEnd].data := DisplayID;
    INC (ListEnd);
  END;
  IF DoScroll THEN
    (* $IF DoIt *)
    dio.WriteString ("Schkroll!!\n");
    (* $END *)
    IF (TypeTag = NIL) AND (ScrollTag = NIL) THEN
      Tags[ListEnd].tag := I.saAutoScroll; Tags[ListEnd].data := I.LTRUE;
      INC (ListEnd);
    END;
    IF ScrollMagic THEN
      Tags[ListEnd].tag := I.saOverscan; Tags[ListEnd].data := I.oScanText;
      INC (ListEnd);
    END;
  END;
  IF ListEnd > 0 THEN
    (* $IF DoIt *)
    dio.WriteString ("Tags gibbet!\n");
    (* $END *)
    IF tagList = NIL THEN
      Tags[ListEnd].tag := u.done; Tags[ListEnd].data := 0;
      INC (ListEnd);
    ELSE
      Tags[ListEnd].tag := u.more; Tags[ListEnd].data := tagList;
      INC (ListEnd);
    END;
    tagList := y.ADR (Tags);
  END;

  (* $IF DoIt *)
  d.Delay (3*50);
  (* $END *)

  y.SETREG (14, Base);
  scrPtr := OldOpenScreenTags (newScreen, tagList);
  IF tagList # NIL THEN
    paraTagList := y.VAL (TagArrayPtr, tagList);
    u.FreeTagItems (paraTagList^);
  END;

  (* $IF DoIt *)
  d.Delay (3*50);
  (* $END *)

  RETURN scrPtr;
END NewOpenScreenTags;

(* $StackChk- $SaveRegs+ Prepare to work in other tasks *)
PROCEDURE NewOpenScreen* (newScreen{8}: ExtNewScreenPtr): I.ScreenPtr;
VAR
  Base: I.IntuitionBasePtr;
  nScrPtr: I.NewScreenPtr;
  scrPtr: I.ScreenPtr;

BEGIN
  (* $IF DoIt *)
  dio.WriteString ("Mäthschick!!!\n");
  (* $END *)
  Base := y.REG (14);
  (* Do the magic *)
  IF (I.nsExtended IN newScreen.ns.type) THEN
    nScrPtr := e.AllocVec (y.SIZE (I.NewScreen), LONGSET {});
    IF nScrPtr = NIL THEN
      y.SETREG (14, Base);
      RETURN OldOpenScreen (newScreen);
    END;
    e.CopyMem (newScreen^, nScrPtr^, y.SIZE (I.NewScreen));
    EXCL (nScrPtr.type, I.nsExtended);
    y.SETREG (14, Base);
    scrPtr := NewOpenScreenTags (nScrPtr, newScreen.extension);
    e.FreeVec (nScrPtr);
    RETURN scrPtr;
  ELSE
    y.SETREG (14, Base);
    RETURN NewOpenScreenTags (newScreen, NIL);
  END;
END NewOpenScreen;
(* $Debug= *)

BEGIN
  (* $IF DoIt *)
  dio.OpenIo;
  dio.WriteString ("Jappadappaduuu!\n");
  (* $END *)
  (* $IF SmallData *)
  y.SETREG (0, d.Write (d.Output (), "No SmallData please!\n", 21));
  (* $ELSE *)
  y.SETREG (0, d.Write (d.Output (), Version[6], y.SIZE (Version)-6));
  (* 2.04 should be :-) *)
  IF I.int.libNode.version < 37 THEN
    IF d.Output () # NIL THEN
      y.SETREG (0, d.Write (d.Output (), "Sorry, I need OS 2.04!\n", 23));
    END;
    HALT (20);
  END;

  (* NTSC & PAL available? *)
  IF (g.FindDisplayInfo (g.palMonitorID) = NIL) OR
     (g.FindDisplayInfo (g.ntscMonitorID) = NIL) THEN
    y.SETREG (0, d.PutStr ("Sorry, PAL & NTSC must be available!\n"));
    HALT (20);
  END;

  Opt[STDPAL] := 0; Opt[STDNTSC] := 0; Opt[USEAUTO] := 0;
  Opt[FORCENTSC] := 0; Opt[NEWLOOK] := 0;

  RD := d.ReadArgs (Template, Opt, NIL);
  IF RD = NIL THEN
    d.PrintF ("Usage: %s\n", y.ADR (Template));
    HALT (20);
  END; (* IF *)
  IF (Opt[FORCENTSC] # 0) THEN
    Opt[STDNTSC] := -1;
    Opt[USEAUTO] := -1;
  END;
  IF (Opt[STDPAL] # 0) AND (Opt[STDNTSC] # 0) THEN
    y.SETREG (0, d.PutStr ("Sorry, PAL & NTSC together is not possible!\n"));
    HALT (20);
  END;
  IF Opt[STDPAL]  # 0 THEN StdHeightMonitorSet := palMonitorSet END;
  IF Opt[STDNTSC] # 0 THEN StdHeightMonitorSet := ntscMonitorSet END;

  (* Patch *)
  e.Forbid;
  OldOpenScreen := y.VAL (OpenScreenProc,
                          e.SetFunction (I.int, OpenScreenOfs,
                                         y.VAL (e.PROC, NewOpenScreen)));
  OldOpenScreenTags := y.VAL (OpenScreenTagsProc,
                              e.SetFunction (I.int, OpenScreenTagsOfs,
                                             y.VAL (e.PROC, NewOpenScreenTags)));
  e.Permit;

  (* Wait for Break *)
  y.SETREG (0, e.Wait (LONGSET {d.ctrlC})); (* ... *)

  (* Unpatch *)
  e.Forbid;
  OldOpenScreen := y.VAL (OpenScreenProc,
                          e.SetFunction (I.int, OpenScreenOfs,
                                         y.VAL (e.PROC, OldOpenScreen)));
  OldOpenScreenTags := y.VAL (OpenScreenTagsProc,
                              e.SetFunction (I.int, OpenScreenTagsOfs,
                                             y.VAL (e.PROC, OldOpenScreenTags)));
  e.Permit;
  IF (y.VAL (y.ADDRESS, OldOpenScreen)     # y.VAL (y.ADDRESS, NewOpenScreen)    ) OR
     (y.VAL (y.ADDRESS, OldOpenScreenTags) # y.VAL (y.ADDRESS, NewOpenScreenTags)) THEN
    IF I.DisplayAlert (I.recoveryAlert,
                       "\x00\x10\x10Someone else patched too. Safety cannot be guarateed, please reboot!\o\n\x00\x10\x1A     -> Reboot <-                           -> Hope and pray <-     \o\o",
                       40) THEN
      e.ColdReboot;
    END;
  END;
  (* $END *)
  (* $IF DoIt *)
  dio.CloseIo;
  (* $END *)
CLOSE
  IF RD # NIL THEN d.FreeArgs (RD); RD := NIL END;
END NTSC4NTSC.