(* ------------------------------------------------------------------------
  :Program.       NTSC for NTSC
  :Contents.      Get 60 Hz for NTSC screens
  :Author.        Kai Bolay [kai]
  :Address.       Hoffmannstraße 168
  :Address.       D-7250 Leonberg 1
  :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)
  :Copyright.     Public Domain
  :Language.      Oberon
  :Translator.    AMIGA OBERON v2.09e, A+L AG
  :Remark.        Thanks to Peter Cherna
  :Usage.         NTSC4NTSC STDPAL/S,STDNTSC/S,USEAUTO/S
  :Usage.         The first to Options describe behaviour for StdHeight-
  :Usage.         Screens. The last says use AutoScroll instead of PAL
------------------------------------------------------------------------ *)
MODULE NTSC4NTSC;

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

CONST
  OpenScreenOfs = -198;
  OpenScreenTagsOfs = -612;
  Version = "$VER: NTSC4NTSC v1.2 (26-Sep-91) by Kai Bolay\r\n";
  Template = "STDPAL/S,STDNTSC/S,USEAUTO/S";
  ntscMonitorSet = s.VAL (LONGSET, g.ntscMonitorID);
  palMonitorSet = s.VAL (LONGSET, g.palMonitorID);
TYPE
  ExtNewScreenPtr = POINTER TO I.ExtNewScreen;
  OpenScreenProc = PROCEDURE (newScreen{8}: ExtNewScreenPtr): I.ScreenPtr;
  OpenScreenTagsProc = PROCEDURE (newScreen{8}: I.NewScreenPtr;
                                  tagList{9}: u.TagItemPtr): I.ScreenPtr;
VAR
  OldOpenScreen: OpenScreenProc;
  OldOpenScreenTags: OpenScreenTagsProc;
  OldNormRows: INTEGER;
  OScanRect: g.Rectangle;
  Opt: ARRAY 3 OF LONGINT;
  RD: d.RDArgsPtr;
  StdHeightMonitorSet: LONGSET;

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

BEGIN
  Base := s.REG (14);

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

  Height := I.stdScreenHeight; DisplayTag := NIL; DisplayID := 0;
  Title := s.ADR ("");

  IF newScreen # NIL THEN
    Height := newScreen.height;
    Title := newScreen.defaultTitle;
    DisplayID := I.UIntToLong (s.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 Tag.tag OF
      | I.saDisplayID: DisplayTag := Tag; DisplayID := Tag.data;
      | I.saType:      TypeTag := Tag;
      | I.saHeight:    Height := SHORT (Tag.data);
      | I.saTitle:     Title := Tag.data;
      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 := s.VAL (LONGSET, DisplayID) * Mask;
  (* $IF DoIt *)
  dio.WriteString ("The DisplayID: "); dio.WriteHex (s.VAL (LONGINT, DisplaySet), 8); dio.WriteLn;
  (* $END *)

  IF (palMonitorSet * DisplaySet # palMonitorSet) AND
     (ntscMonitorSet * DisplaySet # ntscMonitorSet) AND
     (I.QueryOverscan (s.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, s.ADR (ES), NIL, Title) = 1 THEN
          DisplayID := s.VAL (LONGINT, ntscMonitorSet + DisplaySet);
        ELSE
          DisplayID := s.VAL (LONGINT, palMonitorSet + DisplaySet);
        END;
      ELSE
        DisplayID := s.VAL (LONGINT, StdHeightMonitorSet + DisplaySet);
      END;
    ELSE
      IF (Height <= OScanRect.maxY - OScanRect.minY + 1) AND
         ((Height # -1) OR (Opt[0] = 0)) THEN
        (* $IF DoIt *)
        dio.WriteString ("NTSC\n");
        (* $END *)
        DisplayID := s.VAL (LONGINT, ntscMonitorSet + DisplaySet);
      ELSE
        IF (Opt[2] = 0) OR ((TypeTag = NIL) AND (newScreen = NIL)) THEN
          (* $IF DoIt *)
          dio.WriteString ("PAL\n");
          (* $END *)
          DisplayID := s.VAL (LONGINT, palMonitorSet + DisplaySet);
        ELSE
          DisplayID := s.VAL (LONGINT, ntscMonitorSet + DisplaySet);
          IF newScreen # NIL THEN
            INCL (newScreen.type, I.autoScroll);
          END;
          IF TypeTag # NIL THEN
            TypeTag.data := s.VAL (LONGINT, s.VAL (LONGSET, TypeTag.data) +
                                            LONGSET {I.autoScroll});
          END;
        END;
      END;
    END;
  END;

  IF DisplayTag # NIL THEN
    (* $IF DoIt *)
    dio.WriteString ("ab in den Tag!\n");
    (* $END *)
    DisplayTag.data := DisplayID;
  ELSE
    (* $IF DoIt *)
    dio.WriteString ("neue List: ");
    (* $END *)
    Tags[0].tag := I.saDisplayID;
    Tags[0].data := DisplayID;
    IF tagList = NIL THEN
      (* $IF DoIt *)
      dio.WriteString ("alone\n");
      (* $END *)
      Tags[1].tag := u.done;
    ELSE
      (* $IF DoIt *)
      dio.WriteString ("more\n");
      (* $END *)
      Tags[1].tag := u.more;
      Tags[1].data := tagList;
    END;
    tagList := s.ADR (Tags);
  END;

  s.SETREG (14, Base);
  RETURN OldOpenScreenTags (newScreen, tagList);
END NewOpenScreenTags;

(* $StackChk- $SaveRegs+ Prepare to work in other tasks *)
PROCEDURE NewOpenScreen* (newScreen{8}: ExtNewScreenPtr): I.ScreenPtr;
VAR
  Base: I.IntuitionBasePtr;
BEGIN
  Base := s.REG (14);
  (* Do the magic *)
  IF (I.nsExtended IN newScreen.ns.type) THEN
    EXCL (newScreen.ns.type, I.nsExtended);
    s.SETREG (14, Base);
    RETURN NewOpenScreenTags (newScreen, newScreen.extension);
  ELSE
    s.SETREG (14, Base);
    RETURN NewOpenScreenTags (newScreen, NIL);
  END;
END NewOpenScreen;
(* $Debug= *)

BEGIN
  (* $IF DoIt *)
  dio.OpenIo;
  dio.WriteString ("Jappadappaduuu!\n");
  (* $END *)
  (* $IF SmallData *)
  s.SETREG (0, d.Write (d.Output (), "No SmallData please!\n", 21));
  (* $ELSE *)
  s.SETREG (0, d.Write (d.Output (), Version[6], s.SIZE (Version)-6));
  (* 2.04 should be :-) *)
  IF I.int.libNode.version < 37 THEN
    IF d.Output () # NIL THEN
      s.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
    s.SETREG (0, d.PutStr ("Sorry, PAL & NTSC must be available!\n"));
    HALT (20);
  END;

  Opt[0] := 0; Opt[1] := 0; Opt[2] := 0;
  RD := d.ReadArgs (Template, Opt, NIL);
  IF RD # NIL THEN d.FreeArgs (RD); RD := NIL END;
  IF Opt[0] # 0 THEN StdHeightMonitorSet := palMonitorSet END;
  IF Opt[1] # 0 THEN StdHeightMonitorSet := ntscMonitorSet END;

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

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

  (* Unpatch *)
  e.Forbid;
  OldOpenScreen := s.VAL (OpenScreenProc,
                          e.SetFunction (I.int, OpenScreenOfs,
                                         s.VAL (e.PROC, OldOpenScreen)));
  OldOpenScreenTags := s.VAL (OpenScreenTagsProc,
                              e.SetFunction (I.int, OpenScreenTagsOfs,
                                             s.VAL (e.PROC, OldOpenScreenTags)));
  e.Permit;
  IF (s.VAL (e.PROC, OldOpenScreen) # s.VAL (e.PROC, NewOpenScreen)) OR
     (s.VAL (e.PROC, OldOpenScreenTags) # s.VAL (e.PROC, 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 *)
END NTSC4NTSC.