(*---------------------------------------------------------------------------
    :Program.    : OberonPointer.mod
    :Author.     : Jochen P. Kupfer
    :Address.    : Buchenweg 22, D-4006 Erkrath 2
    :Phone.      : (0)2104-40673
    :Shortcut.   : SIGMA
    :Version.    : 1.0
    :Date.       : 31-Mai-90
    :Copyright.  : © 1989, Vertrieb nur auf der GetiT oder kostenlos!
    :Language.   : Oberon
    :Translator. : Oberon Compiler V0.9 01-Mar-90, sollte auch mit der
    :Translator. : Demo-Version 1.0 funktionieren
    :Contents.   : Demo zur Verwendung von C- und Assembler-Modulen
    :Contents.   : zusammen mit einem Oberon-Modul.
    :Contents.   : Zeigt die Anwendung symbolischer Adressen bei
    :Contents.   : Variablen und Prozeduren.
    :Remark.     : Start vom CLI: [RUN] OberonPointer <RETURN>
    :Remark.     : Start von der Wb: Doppelklick auf das Icon.
---------------------------------------------------------------------------*)

MODULE OberonPointer;
(* Oberon Compiler V0.9 01-Mar-90
   © 1989 by Fridtjof Siebert. [intern]
*)

IMPORT i : Intuition,      (* Abkürzungen *)
       g : Graphics,
       e : Exec,
       d : Dos,
       r : Requests,
       s : SYSTEM;

TYPE
  PDATA = ARRAY 18 OF LONGINT;

VAR
  BP["_SpriteData"]   : POINTER TO PDATA;  (* C-Datas *)
  wPtr                : i.WindowPtr;
  text["_IText1"]     : i.IntuiText;       (* C-Datas *)
  text2["_MText"]     : i.IntuiText;       (* C-Datas *)
  nw["MyWindow"]      : i.NewWindow;       (* asm-Datas *)
  rastPortPtr         : g.RastPortPtr;
  j                   : INTEGER;           (* Zähler  *)

PROCEDURE QuickNDirty{"Start"}; (* kleiner asm-Screenhack
                                   von der Disk MACRO-PD-SOFT # 9 *)

PROCEDURE Clear;  (* clear Text im Window *)
  BEGIN
    g.SetAPen(rastPortPtr,0);
    g.RectFill(rastPortPtr,2,11,410,105);
END Clear;

PROCEDURE ProcessIDCMP;
  VAR
    imPtr : i.IntuiMessagePtr;
    class : LONGSET;
  BEGIN
    LOOP
      e.WaitPort(wPtr.userPort);
      imPtr := e.GetMsg(wPtr.userPort);
      class:=imPtr.class;
      e.ReplyMsg(imPtr);
      IF i.newSize     IN class THEN Clear;
                       (* Text neu zeichnen, könnte gelöscht sein *)
                       i.PrintIText(rastPortPtr,s.ADR(text),0,0);
                       d.Delay(10);
                       i.RefreshWindowFrame(wPtr) END;
      IF j = 1 THEN j := 0 ELSE  (* make shure window doesn't quit *)
         IF i.closeWindow IN class THEN EXIT END;
      END;
    END;
END ProcessIDCMP;

BEGIN   (* main *)
  wPtr := NIL; j := 0;
  wPtr := i.OpenWindow(nw);  (* asm-Fenster öffnen     *)

  r.Assert(wPtr#NIL,"Sorry, Fenster geht nicht auf!");
  (* Kontrolle, ob Fenster geöffnet wurde *)

                          (*  h  w  xo yo  *)
  i.SetPointer(wPtr,s.ADR(BP),15,14, 0, 0);
                          (*  ^^^^^- diese Werte müssen
                                     stimmen, sonst geht die Grafik
                                     'kaputt'! *)
  rastPortPtr := wPtr.rPort;
  (* Zeiger auf den RastPort besorgen *)

  i.PrintIText(rastPortPtr,s.ADR(text),0,0);  (* C-Text *)
  (* Text ins Fenster schreiben *)

  ProcessIDCMP; (* Warten auf Close-Gadget *)

  (* hier 'hackt's' *)
  i.SetWindowTitles(wPtr,s.ADR(" Don't worry, be happy! "),NIL);
  j := 1;
  QuickNDirty;
  d.Delay(15);
  Clear;
  (* ein 2. Text *)
  i.PrintIText(rastPortPtr,s.ADR(text2),0,0);
  d.Delay(10);
  i.RefreshWindowFrame(wPtr);

  ProcessIDCMP; (* Warten auf Close-Gadget *)
  i.ClearPointer(wPtr);
  i.CloseWindow(wPtr);
  wPtr := NIL;

CLOSE

  IF wPtr  # NIL THEN i.CloseWindow(wPtr) END;

END OberonPointer.