(* ------------------------------------------------------------------------
  :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.adsp.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)
  :History.       v1.7 [kai] 10-Apr-92 (+ AutoScroll only if necessary)
  :History.       v1.8 [kai] 25-Jun-92 (- FreeTagItem()-Bug/v39 fix)
  :History.       v1.9 [kai] 12-Jul-92 (+ ModeNotAvailable() check)
  :Copyright.     Freeware
  :Language.      Oberon
  :Translator.    AMIGA OBERON v2.38d
  :Remark.        Thanks to Peter Cherna
  :Remark.        Thanks to Franz Schwarz for telling me a possibility to
  :Remark.        remove illegal writes to the TagList and a lot more...
  :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; (* $Debug- *)
(* $IF SmallData *) Not possible (* $END *)

(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)

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.9 (12-Jul-92) by Kai Bolay (Debug)\r\n";
  (* $ELSE *)
  Version = "$VER: NTSC4NTSC v1.9 (12-Jul-92) by Kai Bolay\r\n";
  (* $END *)
  Template = "STDPAL/S,STDNTSC/S,USEAUTO/S,FORCENTSC/S,NEWLOOK/S";
  STDPAL    = 0;
  STDNTSC   = 1;
  USEAUTO   = 2;
  FORCENTSC = 3;
  NEWLOOK   = 4;
  NumOpts   = 5;
TYPE
  TagArrayPtr = UNTRACED POINTER TO ARRAY MAX (INTEGER) 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 e.APTR;
  RD: d.RDArgsPtr;
  StdHeightMonitorID: LONGINT;

PROCEDURE NewOpenScreenTags* (newScreen{8}: I.NewScreenPtr;
                              paraTagList{9}: TagArrayPtr): I.ScreenPtr;
TYPE
  PenArray = ARRAY 1 OF INTEGER;
CONST
  Pens = PenArray (-1);
  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;
  saLikeWorkbench = I.saDummy + 00027H;
VAR
  Base: I.IntuitionBasePtr;
  TState, Tag, DisplayTag, TypeTag, ScrollTag: u.TagItemPtr;
  Tags: ARRAY MaxTags OF u.TagItem;
  DisplayID: LONGINT;
  OScanRect: g.Rectangle;
  Height: INTEGER;
  Title: e.STRPTR;
  DoScroll, ScrollMagic, Patch: BOOLEAN;
  ListEnd: INTEGER;
  tagList, argTagList: TagArrayPtr;
  scrPtr: I.ScreenPtr;

  PROCEDURE GetMonitorID (ID: LONGINT): LONGINT;
  BEGIN
    (* $IF DoIt *)
    dio.WriteString ("GetMonitorID: ");
    dio.WriteHex (y.VAL (LONGINT, y.VAL (LONGSET, ID) *
                         y.VAL (LONGSET, g.monitorIDMask)), 8); dio.WriteLn;
    (* $END *)
    RETURN y.VAL (LONGINT, y.VAL (LONGSET, ID) *
                           y.VAL (LONGSET, g.monitorIDMask));
  END GetMonitorID;

  PROCEDURE SetMonitorID (ID: LONGINT; Monitor: LONGINT): LONGINT;
  BEGIN
    (* $IF DoIt *)
    dio.WriteString ("SetMonitorID: ");
    dio.WriteHex (ID, 8); dio.WriteString (" -> ");
    dio.WriteHex (y.VAL (LONGINT, y.VAL (LONGSET, ID) *
        (- y.VAL (LONGSET, g.monitorIDMask))) + Monitor, 8); dio.WriteLn;
    (* $END *)
    RETURN y.VAL (LONGINT, y.VAL (LONGSET, ID) *
                           (- y.VAL (LONGSET, g.monitorIDMask))) + Monitor;
  END SetMonitorID;

(* $SaveRegs+ Prepare to work in other tasks *)
BEGIN
  Base := y.REG (14);

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

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

  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;

  IF newScreen # NIL THEN
    Height := newScreen.height;
    Title := newScreen.defaultTitle;
    (* knock out bad bits! *)
    DisplayID := I.UIntToLong (y.VAL (INTEGER, newScreen.viewModes -
  SET {g.sprites, g.genlockAudio, g.genLockVideo, g.extendedMode, g.vpHide}));

    (*
    IF (newScreen.type * I.screenType # I.customScreen) AND
       (newScreen.type * I.screenType # SET {I.publicScreen}) THEN
      (* $IF DoIt *)
      dio.WriteString ("Type: "); dio.WriteHex (y.VAL (INTEGER, newScreen.type), 4);
      (* $END *)
      newScreen.type := newScreen.type + I.customScreen;
      (* $IF DoIt *)
      dio.WriteString (" -> "); dio.WriteHex (y.VAL (INTEGER, newScreen.type), 4); dio.WriteLn;
      (* $END *)
    END;
    *)

    (* $IF DoIt *)
    dio.WriteString ("NewScreen gibbet:\n");
    dio.WriteString ("Height: "); dio.WriteInt (Height, 4); dio.WriteLn;
    dio.WriteString ("ViewModes: "); dio.WriteHex (y.VAL (INTEGER, newScreen.viewModes), 4); dio.WriteLn;
    dio.WriteString ("DisplayID: "); dio.WriteHex (DisplayID, 8); dio.WriteLn;
    (* $END *)
  END; (* IF *)

  IF tagList # NIL THEN
    TState := y.ADR (tagList^[0]);
    LOOP
      Tag := u.NextTagItem (TState);
      IF Tag = NIL THEN EXIT END;
      (* $IF DoIt *)
      dio.WriteString ("Tag: "); dio.WriteHex (y.VAL (LONGINT, Tag.tag), 8);
      dio.WriteString (" Data: "); dio.WriteHex (y.VAL (LONGINT, Tag.data), 8); dio.WriteLn;
      (* $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;
      | saLikeWorkbench: Patch := (Tag.data # I.LTRUE);
      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;

  (* $IF DoIt *)
  dio.WriteString ("The DisplayID: "); dio.WriteHex (DisplayID, 8); dio.WriteLn;
  (* $END *)

  IF Patch THEN

    IF Opt[FORCENTSC] # 0 THEN
      DisplayID := SetMonitorID (DisplayID, g.defaultMonitorID);
    END;

    IF (GetMonitorID (DisplayID) = g.defaultMonitorID) AND
       (I.QueryOverscan (SetMonitorID (DisplayID, g.ntscMonitorID),
                         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 StdHeightMonitorID = g.defaultMonitorID THEN
          IF I.EasyRequest (NIL, y.ADR (ES), NIL, Title) = 1 THEN
            DisplayID := SetMonitorID (DisplayID, g.ntscMonitorID);
          ELSE
            DisplayID := SetMonitorID (DisplayID, g.palMonitorID);
          END;
        ELSE
          DisplayID := SetMonitorID (DisplayID, StdHeightMonitorID);
        END;
      ELSE
        IF (Height <= OScanRect.maxY - OScanRect.minY + 1) AND (Opt[STDPAL] = 0) THEN
          (* $IF DoIt *)
          dio.WriteString ("NTSC\n");
          (* $END *)
          DisplayID := SetMonitorID (DisplayID, g.ntscMonitorID);
        ELSE
          IF (Opt[USEAUTO] = 0) THEN
            (* $IF DoIt *)
            dio.WriteString ("PAL\n");
            (* $END *)
             DisplayID := SetMonitorID (DisplayID, g.palMonitorID);
          ELSE
            DoScroll :=  NOT (Height <= OScanRect.maxY - OScanRect.minY + 1);
            DisplayID := SetMonitorID (DisplayID, g.ntscMonitorID);
          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);
      ELSE
        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;
      IF ScrollMagic THEN
        Tags[ListEnd].tag := I.saOverscan; Tags[ListEnd].data := I.oScanText;
        INC (ListEnd);
      END;
    END;
  (* $IF DoIt *)
  ELSE
    dio.WriteString ("It's a WB!\n");
  (* $END *)
  END;

  IF ListEnd > 0 THEN
    IF tagList = NIL THEN
      (* $IF DoIt *)
      dio.WriteString ("New Tags alone!\n");
      (* $END *)
      Tags[ListEnd].tag := u.done; Tags[ListEnd].data := 0;
      INC (ListEnd);
    ELSE
      (* $IF DoIt *)
      dio.WriteString ("New & old Tags!\n");
      (* $END *)
      Tags[ListEnd].tag := u.more; Tags[ListEnd].data := tagList;
      INC (ListEnd);
    END;
    argTagList := y.ADR (Tags);
  ELSE
    (* $IF DoIt *)
    dio.WriteString ("Old Tags alone!\n");
    (* $END *)
    argTagList := tagList;
  END;

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

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

  y.SETREG (14, Base);
  RETURN scrPtr;
END NewOpenScreenTags;

PROCEDURE NewOpenScreen* (newScreen{8}: ExtNewScreenPtr): I.ScreenPtr;
VAR
  Base: I.IntuitionBasePtr;
  nScrPtr: I.NewScreenPtr;
  scrPtr: I.ScreenPtr;

(* $SaveRegs+ Prepare to work in other tasks *)
BEGIN
  Base := y.REG (14);
  (* $IF DoIt *)
  dio.WriteString ("\nMäthschick (StdOpenScreen)!!!");
  (* $END *)
  (* 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,
                                 y.VAL (TagArrayPtr, newScreen.extension));
    e.FreeVec (nScrPtr);
    y.SETREG (14, Base);
    RETURN scrPtr;
  ELSE
    y.SETREG (14, Base);
    RETURN NewOpenScreenTags (newScreen, NIL);
  END;
END NewOpenScreen;

BEGIN
  (* $IF DoIt *)
  dio.OpenIo;
  dio.WriteString ("Jappadappaduuu!\n");
  (* $END *)
  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.ModeNotAvailable (g.palMonitorID) # 0) OR
     (g.FindDisplayInfo (g.ntscMonitorID) = NIL) OR
     (g.ModeNotAvailable (g.ntscMonitorID) # 0) 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 StdHeightMonitorID := g.palMonitorID END;
  IF Opt[STDNTSC] # 0 THEN StdHeightMonitorID := g.ntscMonitorID 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;
  (* $IF DoIt *)
  dio.CloseIo;
  (* $END *)
CLOSE
  IF RD # NIL THEN d.FreeArgs (RD); RD := NIL END;
END NTSC4NTSC.