(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: Display              Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1992 by Fridtjof Siebert                                            *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(*-------------------------------------------------------------------------

   Dieses Modul bietet grundlegende Grafikfunktionen und ermöglicht die
   einfache Benutzung der Routinen der graphics.library. Dabei werden
   Fenster und Screens nahezu gleich behandelt.

   Folgendes wird unterstützt:

    - Öffnen und schließen von Screens und Windows

    - Einfache Zeichenroutinen, wie Linie, Dot, Rechteck, Kreis, Text ...

    - Routinen zum Setzen der Pinselfarbe, des Zeichenmodus und des
      verwendeten Fonts.

    - Turtle-Graphics

    - einfache Textaus- und Eingabe.

-------------------------------------------------------------------------*)


MODULE Display;

IMPORT li*  := Lists,
       I *  := Intuition,
       u *  := Utility,
       g *  := Graphics,
       str  := Strings,
       df   := DiskFont,
       trans:= MathTrans,
       math := MathFFP,
       e *  := Exec,
       sys  := SYSTEM;

TYPE

  DispEl * = RECORD (li.Node)
               title  - : e.STRPTR;

               rp     - : g.RastPortPtr;
               font   - : g.TextFontPtr;
               width  - : INTEGER;
               height - : INTEGER;

               turtleX   - : REAL;
               turtleY   - : REAL;
               turtleDir - : REAL;
               pen       - : BOOLEAN;

               cursor    - : BOOLEAN;
               curX      - : INTEGER;
               curY      - : INTEGER;
               curXAbs   - : INTEGER;
               curYAbs   - : INTEGER;
               txtWidth  - : INTEGER;
               txtHeight - : INTEGER;

               gzz       - : BOOLEAN;

               left-, top- : INTEGER;

             END;

  Screen * = RECORD (DispEl)
               screen   - : I.ScreenPtr;
               backdrop - : I.WindowPtr;
             END;

  Window * = RECORD (DispEl)
               window - : I.WindowPtr;
               rastport : g.RastPort;   (* Window.rp points to this copy of the RP *)
             END;

  DispElPtr * = POINTER TO DispEl;
  ScreenPtr * = POINTER TO Screen;
  WindowPtr * = POINTER TO Window;

CONST

(* Parameter pat bei LinePattern *)

  line    * = -1;
  dots    * = 5555H;
  bigdots * = 3333H;
  broken  * = 0F0FH;

VAR
  Elements: li.List;
  n: li.NodePtr;

  WindowListSemaphore: e.SignalSemaphore;
                       (* Semaphore to access global variables of this
                        * module (to be compatible with Concurrency.mod)
                        *)


CONST
  ErrPtr = -1;  (* bei Fehler, erzeugt dann automatisch Adressfehler *)
  degtorad = 3.14159265358979323846/180;


PROCEDURE ^ Init*(d: DispElPtr); (* das brauchen wir gleich *)


(*------  OpenScreen:  ------*)


PROCEDURE OpenScreen*(scrn:       ScreenPtr;
                      title:      ARRAY OF CHAR;
                      x,y,w,h:    INTEGER;
                      d:          SHORTINT;
                      hires,lace: BOOLEAN): BOOLEAN;

VAR
  ns: I.NewScreen;
  top: INTEGER;
  nw: I.NewWindow;

BEGIN
  LOOP
    NEW(scrn.title);
    COPY(title,scrn.title^);
    ns.leftEdge     := x;    ns.topEdge      := y;
    IF w<=0 THEN w := g.gfx.normalDisplayColumns; IF ~ hires THEN w := w DIV 2 END END;
    IF h<=0 THEN h := g.gfx.normalDisplayRows;    IF   lace  THEN h := h *   2 END END;
    ns.width        := w;    ns.height       := h;
    ns.depth        := d;    ns.detailPen    := 0;
    ns.blockPen     := 1;    ns.viewModes    := {};
    ns.type         := I.customScreen;
    ns.font         := NIL;  ns.defaultTitle := scrn.title;
    ns.gadgets      := NIL;  ns.customBitMap := NIL;
    IF hires THEN INCL(ns.viewModes,g.hires) END;
    IF lace  THEN INCL(ns.viewModes,g.lace ) END;
    IF title="" THEN top :=  0; INCL(ns.type,I.screenQuiet) END;
    scrn.screen := I.OpenScreen(ns);
    IF scrn.screen=NIL THEN EXIT END;
    IF title#"" THEN top := scrn.screen.barHeight + 1 END;
    nw := I.NewWindow(0,0,0,0,-1,-1,LONGSET{},LONGSET{I.backDrop,I.borderless},NIL,NIL,NIL,NIL,NIL,0,0,-1,-1,I.customScreen);
    nw.width := w;
    nw.height := h;
    nw.screen := scrn.screen;
    scrn.backdrop := I.OpenWindow(nw);
    IF scrn.backdrop=NIL THEN EXIT END;
    scrn.rp := scrn.backdrop.rPort;
    scrn.gzz := FALSE;
    Init(scrn);
    e.ObtainSemaphore(WindowListSemaphore);
    li.AddHead(Elements,scrn);
    e.ReleaseSemaphore(WindowListSemaphore);
    RETURN TRUE;
  END;
  IF scrn.backdrop#NIL THEN I.CloseWindow(scrn.backdrop)  END;
  IF scrn.screen  #NIL THEN I.OldCloseScreen(scrn.screen) END;
  IF scrn.title   #NIL THEN DISPOSE(scrn.title)           END;
  RETURN FALSE;
END OpenScreen;


(*------  OpenWindow:  ------*)


PROCEDURE OpenWindow*(win:     WindowPtr;
                      title:   ARRAY OF CHAR;
                      x,y,w,h: INTEGER;
                      screen:  I.ScreenPtr): BOOLEAN;

VAR nw: I.NewWindow;

BEGIN
  LOOP
    NEW(win.title);
    COPY(title,win.title^);
    nw.leftEdge    := x;   nw.topEdge     := y;
    nw.width       := w;   nw.height      := h;
    nw.detailPen   := -1;  nw.blockPen    := -1;
    nw.idcmpFlags  := LONGSET{};
    nw.flags       := LONGSET{I.windowSizing, I.windowDrag, I.windowDepth,
                              I.windowClose, I.gimmeZeroZero, I.activate};
    nw.firstGadget := NIL; nw.checkMark   := NIL;
    nw.title       := win.title;
    nw.bitMap      := NIL;
    nw.minWidth    := 128; nw.minHeight   := 24;
    nw.maxWidth    := -1;  nw.maxHeight   := -1;
    nw.screen      := screen;
    IF screen=NIL THEN nw.type   := {I.wbenchScreen}
                  ELSE nw.type   := I.customScreen   END;
    win.window := I.OpenWindow(nw);
    IF win.window=NIL THEN EXIT END;
    win.rastport := win.window.rPort^;
    win.rp := sys.ADR(win.rastport);
    win.gzz := TRUE;
    Init(win);
    e.ObtainSemaphore(WindowListSemaphore);
    li.AddHead(Elements,win);
    e.ReleaseSemaphore(WindowListSemaphore);
    RETURN TRUE;
  END;
  IF win.title#NIL THEN DISPOSE(win.title) END;
  RETURN FALSE;
END OpenWindow;


(*------  OpenWindowTags:  ------*)


PROCEDURE OpenWindowTags* (win:     WindowPtr;
                           gadg:    I.GadgetPtr;
                           gzz:     BOOLEAN;
                           title:   ARRAY OF CHAR;
                           x,y,w,h: INTEGER;
                           screen:  I.ScreenPtr;
                           activate:BOOLEAN;
                           tags:    sys.ADDRESS): BOOLEAN;

VAR nw: I.NewWindow;

BEGIN
  LOOP
    NEW(win.title);
    COPY(title,win.title^);
    nw.leftEdge    := x;   nw.topEdge     := y;
    nw.width       := w;   nw.height      := h;
    nw.detailPen   := -1;  nw.blockPen    := -1;
    nw.idcmpFlags  := LONGSET{};
    nw.flags       := LONGSET{I.windowSizing, I.windowDrag, I.windowDepth, I.windowClose};
    IF activate THEN INCL(nw.flags,I.activate) END;
    IF gzz THEN INCL(nw.flags,I.gimmeZeroZero) END;
    nw.firstGadget := gadg; nw.checkMark   := NIL;
    nw.title       := win.title;
    nw.bitMap      := NIL;
    nw.minWidth    := 128; nw.minHeight   := 64;
    nw.maxWidth    := -1;  nw.maxHeight   := -1;
    nw.screen      := screen;
    IF screen=NIL THEN nw.type   := {I.wbenchScreen}
                  ELSE nw.type   := I.customScreen   END;
    IF I.int.libNode.version<37 THEN
      win.window := I.OpenWindow(nw);
    ELSE
      win.window := I.OpenWindowTags(nw,I.waAutoAdjust,I.LTRUE,
                                        u.more,        tags,
                                        u.done);
    END;
    IF win.window=NIL THEN EXIT END;
    win.rastport := win.window.rPort^;
    win.rp := sys.ADR(win.rastport);
    win.gzz := gzz;
    Init(win);
    e.ObtainSemaphore(WindowListSemaphore);
    li.AddHead(Elements,win);
    e.ReleaseSemaphore(WindowListSemaphore);
    RETURN TRUE;
  END;
  IF win.title#NIL THEN DISPOSE(win.title) END;
  RETURN FALSE;
END OpenWindowTags;


(*------  OpenWindowX:  ------*)


PROCEDURE OpenWindowX *(win     : WindowPtr;
                        gadg    : I.GadgetPtr;
                        gzz     : BOOLEAN;
                        title   : ARRAY OF CHAR;
                        x,y,w,h : INTEGER;
                        activate: BOOLEAN;
                        screen  : I.ScreenPtr): BOOLEAN;

BEGIN
  RETURN OpenWindowTags(win, gadg, gzz, title, x,y,w,h, screen, activate, NIL);
END OpenWindowX;


(*------  Close:  ------*)


PROCEDURE Close*(d: DispElPtr);

BEGIN
  e.ObtainSemaphore(WindowListSemaphore);
  li.Remove(Elements,d);
  e.ReleaseSemaphore(WindowListSemaphore);
  WITH d : Window DO
    I.CloseWindow(d(Window).window);
  | d : Screen DO
    I.CloseWindow(d.backdrop);
    I.OldCloseScreen(d.screen);
  END;
  IF d.font#NIL THEN g.CloseFont(d.font) END;
  IF d.title#NIL THEN DISPOSE(d.title) END;
END Close;


(*------  Init:  ------*)

PROCEDURE Init*(d: DispElPtr);
(* muß aufgerufen werden, wenn sich beim Fenster die Größe verändert hat *)
VAR
  w: I.WindowPtr;
  s: I.ScreenPtr;
BEGIN
  IF d IS Window THEN
    WITH d: Window DO
      w := d.window;
      IF d.gzz THEN
        d.width  := w.gzzWidth;
        d.height := w.gzzHeight;
        d.left := 0;
        d.top := 0;
      ELSE
        d.width  := w.width-w.borderLeft-w.borderRight;
        d.height := w.height-w.borderTop-w.borderBottom;
        d.left := w.borderLeft;
        d.top := w.borderTop;
      END;
      d.curX := 0;
      d.curY := 0;
      d.curXAbs := 0;
      d.curYAbs := 0;
      d.txtWidth := d.width DIV d.rp.font.xSize;
      d.txtHeight := d.height DIV d.rp.font.ySize;
    END;
  ELSIF d IS Screen THEN
    WITH d: Screen DO
      s := d.screen;
      d.width     := s.width;
      IF d.title^="" THEN d.height := s.height;
                     ELSE d.height := s.height-s.barHeight-1 END;
      d.left      := 0;
      d.top       := 0;
      d.curX      := 0;
      d.curY      := 0;
      d.curXAbs   := 0;
      d.curYAbs   := 0;
      d.txtWidth  := d.width DIV d.rp.font.xSize;
      d.txtHeight := d.height DIV d.rp.font.ySize;
    END;
  END;
END Init;


(*------  Colors:  ------*)


PROCEDURE SetColors*(s: ScreenPtr; VAR cols: ARRAY OF INTEGER);
BEGIN
  g.LoadRGB4(sys.ADR(s.screen.viewPort),cols,LEN(cols))
END SetColors;

PROCEDURE SetCol*(s: ScreenPtr; num,R,G,B: INTEGER);
BEGIN g.SetRGB4(sys.ADR(s.screen.viewPort),num,R,G,B) END SetCol;

PROCEDURE NumToRGB*(num: INTEGER; VAR r,g,b: INTEGER);
BEGIN
  b := num MOD 16; num := num DIV 16;
  g := num MOD 16; num := num DIV 16;
  r := num MOD 16;
END NumToRGB;

PROCEDURE RGBToNum*(r,g,b: INTEGER): INTEGER;
BEGIN RETURN b+16*(g+16*r) END RGBToNum;


(*------  Pens:  ------*)


PROCEDURE FrontPen*(d: DispElPtr; pen: SHORTINT);
BEGIN g.SetAPen(d.rp,pen) END FrontPen;

PROCEDURE BackPen*(d: DispElPtr; pen: SHORTINT);
BEGIN g.SetBPen(d.rp,pen) END BackPen;

PROCEDURE Jam1*(d: DispElPtr);
BEGIN g.SetDrMd(d.rp,g.jam1) END Jam1;

PROCEDURE Jam2*(d: DispElPtr);
BEGIN g.SetDrMd(d.rp,g.jam2) END Jam2;

PROCEDURE Complement*(d: DispElPtr);
BEGIN g.SetDrMd(d.rp,SHORTSET{g.complement}) END Complement;

PROCEDURE LinePattern*(d: DispElPtr; pat: INTEGER);
BEGIN g.SetDrPt(d.rp,pat) END LinePattern;


(*------  Draw:  ------*)

PROCEDURE Clear*(d: DispElPtr);
VAR
  oldmask: SHORTSET;
BEGIN
  oldmask := d.rp.mask;
  d.rp.mask := -SHORTSET{};
  Jam1(d); FrontPen(d,0);
  g.RectFill(d.rp,d.left,d.top,d.left+d.width-1,d.top+d.height-1);
  FrontPen(d,1);
  d.rp.mask := oldmask;
END Clear;

PROCEDURE Line*(d: DispElPtr; x1,y1,x2,y2: INTEGER);
BEGIN
  g.Move(d.rp,d.left+x1,d.top+y1);
  g.Draw(d.rp,d.left+x2,d.top+y2);
END Line;

PROCEDURE Dot*(d: DispElPtr; x,y: INTEGER);
BEGIN IF g.WritePixel(d.rp,d.left+x,d.top+y) THEN END END Dot;

PROCEDURE DotColor*(d: DispElPtr; x,y: INTEGER): INTEGER;
BEGIN RETURN SHORT(g.ReadPixel(d.rp,d.left+x,d.top+y)) END DotColor;

PROCEDURE Rect*(d: DispElPtr; x,y,w,h: INTEGER);
BEGIN
  DEC(w); DEC(h);
  INC(x,d.left); INC(y,d.top);
  g.Move(d.rp,x  ,y  );
  g.Draw(d.rp,x+w,y  );
  g.Draw(d.rp,x+w,y+h);
  g.Draw(d.rp,x  ,y+h);
  g.Draw(d.rp,x  ,y  );
END Rect;

PROCEDURE Box*(d: DispElPtr; x,y,w,h: INTEGER);
BEGIN INC(x,d.left); INC(y,d.top); g.RectFill(d.rp,x,y,x+w-1,y+h-1) END Box;

PROCEDURE Move*(d: DispElPtr; x,y: INTEGER);
BEGIN g.Move(d.rp,d.left+x,d.top+y) END Move;

PROCEDURE Draw*(d: DispElPtr; x,y: INTEGER);
BEGIN g.Draw(d.rp,d.left+x,d.top+y) END Draw;

PROCEDURE Text*(d: DispElPtr; x,y: INTEGER; s: ARRAY OF CHAR);
BEGIN
  g.Move(d.rp,d.left+x,d.top+y);
  g.Text(d.rp,s,str.Length(s))
END Text;

PROCEDURE Circle*(d: DispElPtr; x,y,r: INTEGER);
BEGIN g.DrawEllipse(d.rp,d.left+x,d.top+y,r,r) END Circle;

PROCEDURE Ellipse*(d: DispElPtr; x,y,rx,ry: INTEGER);
BEGIN g.DrawEllipse(d.rp,d.left+x,d.top+y,rx,ry) END Ellipse;


(*------  Font:  ------*)


PROCEDURE Font*(d: DispElPtr; name: ARRAY OF CHAR; height: INTEGER): BOOLEAN;
VAR
  attr: g.TextAttr;
  font: g.TextFontPtr;
BEGIN
  attr.name  := sys.ADR(name);
  attr.ySize := height;
  attr.style := SHORTSET{};
  attr.flags := SHORTSET{};
  font := df.OpenDiskFont(attr);
  IF font=NIL THEN RETURN FALSE END;
  IF d.font#NIL THEN g.CloseFont(d.font) END;
  g.SetFont(d.rp,font); d.font := font;
  d.curX := 0;
  d.curY := 0;
  d.curXAbs := 0;
  d.curYAbs := 0;
  d.txtWidth := d.width DIV d.rp.font.xSize;
  d.txtHeight := d.height DIV d.rp.font.ySize;
  RETURN TRUE;
END Font;


(*------  Turtle Graphics:  ------*)


PROCEDURE SetTurtlePos*(d: DispElPtr; x,y: REAL);
BEGIN
  d.turtleX := x;
  d.turtleY := y;
END SetTurtlePos;


PROCEDURE GetTurtlePos*(d: DispElPtr;VAR x,y: REAL);
BEGIN
  x := d.turtleX;
  y := d.turtleY;
END GetTurtlePos;


PROCEDURE SetTurtleDir*(d: DispElPtr; dir: REAL);
(*        0°
          A
          |
    90° <-+-> 270°
          |
          V
         180°       *)
BEGIN
  d.turtleDir := dir;
END SetTurtleDir;


PROCEDURE GetTurtleDir*(d: DispElPtr): REAL;
BEGIN
  RETURN d.turtleDir;
END GetTurtleDir;


PROCEDURE SetPen*(d: DispElPtr);
BEGIN d.pen := TRUE END SetPen;


PROCEDURE LiftPen*(d: DispElPtr);
BEGIN d.pen := FALSE END LiftPen;


PROCEDURE Forward*(d: DispElPtr; s: REAL);
VAR fromx,fromy,rad: REAL;
BEGIN
  fromx := d.turtleX;
  fromy := d.turtleY;
  rad := d.turtleDir * degtorad;
  d.turtleX := fromx - s * trans.Sin(rad);
  d.turtleY := fromy - s * trans.Cos(rad);
  IF d.pen THEN Line(d,SHORT(ENTIER(fromx)),
                       SHORT(ENTIER(fromy)),
                       SHORT(ENTIER(d.turtleX)),
                       SHORT(ENTIER(d.turtleY))) END;
END Forward;


PROCEDURE TurnLeft*(d: DispElPtr; alpha: REAL);
BEGIN
  d.turtleDir := d.turtleDir + alpha;
  IF d.turtleDir> 360 THEN d.turtleDir := d.turtleDir - 360 END;
END TurnLeft;


PROCEDURE TurnRight*(d: DispElPtr; alpha: REAL);
BEGIN
  d.turtleDir := d.turtleDir - alpha;
  IF d.turtleDir<-360 THEN d.turtleDir := d.turtleDir + 360 END;
END TurnRight;


(*------  Text Funktionen:  ------*)


PROCEDURE SetCursor*(d: DispElPtr; on: BOOLEAN): BOOLEAN;
VAR
  oldstate: BOOLEAN;
  oldmask: SHORTSET;
BEGIN
  oldstate := d.cursor;
  d.cursor := on;
  IF oldstate#on THEN
    oldmask := d.rp.mask; d.rp.mask := -SHORTSET{};
    Complement(d);
    Box(d,d.curXAbs,d.curYAbs,d.rp.font.xSize,d.rp.font.ySize);
    Jam2(d);
    d.rp.mask := oldmask;
  END;
  RETURN oldstate;
END SetCursor;


PROCEDURE CursorOn*(d: DispElPtr);
BEGIN IF SetCursor(d,TRUE) THEN END END CursorOn;


PROCEDURE CursorOff*(d: DispElPtr);
BEGIN IF SetCursor(d,FALSE) THEN END END CursorOff;


PROCEDURE Position*(d: DispElPtr; x,y: INTEGER);
VAR old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE);
  d.curX := x;
  d.curY := y;
  d.curXAbs := d.rp.font.xSize*d.curX;
  d.curYAbs := d.rp.font.ySize*d.curY;
  IF SetCursor(d,old) THEN END;
END Position;


PROCEDURE Plain*(d: DispElPtr);
BEGIN d.rp.algoStyle := g.normal END Plain;

PROCEDURE UnderLinedOn*(d: DispElPtr);
BEGIN INCL(d.rp.algoStyle,g.underlined) END UnderLinedOn;

PROCEDURE UnderLinedOff*(d: DispElPtr);
BEGIN EXCL(d.rp.algoStyle,g.underlined) END UnderLinedOff;

PROCEDURE BoldOn*(d: DispElPtr);
BEGIN INCL(d.rp.algoStyle,g.bold) END BoldOn;

PROCEDURE BoldOff*(d: DispElPtr);
BEGIN EXCL(d.rp.algoStyle,g.bold) END BoldOff;

PROCEDURE ItalicOn*(d: DispElPtr);
BEGIN INCL(d.rp.algoStyle,g.italic) END ItalicOn;

PROCEDURE ItalicOff*(d: DispElPtr);
BEGIN EXCL(d.rp.algoStyle,g.italic) END ItalicOff;


PROCEDURE Home*(d: DispElPtr);
VAR old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE);
  d.curX := 0;
  d.curY := 0;
  d.curXAbs := 0;
  d.curYAbs := 0;
  d.rp.algoStyle := g.normal;
  IF SetCursor(d,old) THEN END;
END Home;


PROCEDURE ClrHome*(d: DispElPtr);
VAR old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE);
  Clear(d);
  d.curX := 0;
  d.curY := 0;
  d.curXAbs := 0;
  d.curYAbs := 0;
  d.rp.algoStyle := g.normal;
  IF SetCursor(d,old) THEN END;
END ClrHome;


PROCEDURE ScrollUp*(d: DispElPtr);
(* fügt unten eine Leerzeile an *)
VAR
  y: INTEGER;
  old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  g.ScrollRaster(d.rp,0,y,d.left,d.top,d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  IF SetCursor(d,old) THEN END;
END ScrollUp;


PROCEDURE ScrollUpN*(d: DispElPtr; n: INTEGER);
(* fügt unten n Leerzeilen an. d.txtHeight > n > 0 *)
VAR
  y: INTEGER;
  old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  g.ScrollRaster(d.rp,0,n*y,d.left,d.top,d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  IF SetCursor(d,old) THEN END;
END ScrollUpN;


PROCEDURE ScrollDown*(d: DispElPtr);
(* fügt oben eine Leerzeile an *)
VAR
  y: INTEGER;
  old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  g.ScrollRaster(d.rp,0,-y,d.left,d.top,d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  IF SetCursor(d,old) THEN END;
END ScrollDown;


PROCEDURE ScrollDownN*(d: DispElPtr; n: INTEGER);
(* fügt oben n Leerzeilen an. d.txtHeight > n > 0 *)
VAR
  y: INTEGER;
  old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  g.ScrollRaster(d.rp,0,-n*y,d.left,d.top,d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  IF SetCursor(d,old) THEN END;
END ScrollDownN;


PROCEDURE InsertLine*(d: DispElPtr; n: INTEGER);
(* fügt an Zeile n eine Leerzeile ein und scrollt den Rest nach unten *)
VAR
  y: INTEGER;
  old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  g.ScrollRaster(d.rp,0,-d.rp.font.ySize,d.left,d.top+n*y,
                     d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  IF SetCursor(d,old) THEN END;
END InsertLine;


PROCEDURE DeleteLine*(d: DispElPtr; n: INTEGER);
(* löscht an Zeile n eine Zeile ein und scrollt den Rest darunter hoch *)
VAR
  y: INTEGER;
  old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  g.ScrollRaster(d.rp,0,d.rp.font.ySize,d.left,d.top+n*y,
                     d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  IF SetCursor(d,old) THEN END;
END DeleteLine;


PROCEDURE WriteLn*(d: DispElPtr);
VAR old: BOOLEAN;
BEGIN
  old := SetCursor(d,FALSE);
  d.curX := 0; d.curXAbs := 0;
  INC(d.curY);
  IF d.curY=d.txtHeight THEN
    ScrollUp(d);
    DEC(d.curY);
  END;
  d.curYAbs := d.rp.font.ySize*d.curY;
  IF SetCursor(d,old) THEN END;
END WriteLn;


PROCEDURE Write*(d: DispElPtr; Str: ARRAY OF CHAR);
VAR
  old: BOOLEAN;
  len,max: LONGINT;
  index: LONGINT;
  cptr: UNTRACED POINTER TO ARRAY 1 OF CHAR;
BEGIN
  old := SetCursor(d,FALSE); index := 0;
  len := str.Length(Str);
  WHILE len>0 DO
    max := len;
    IF len+d.curX>d.txtWidth THEN
      IF d.curX=d.txtWidth THEN
        WriteLn(d);
        IF len<d.txtWidth THEN max:=len ELSE max:=d.txtWidth END;
      ELSE
        max := d.txtWidth-d.curX;
      END;
    END;
    g.Move(d.rp,d.left+d.curXAbs,d.top+d.curYAbs + d.rp.font.baseline);
    cptr := sys.ADR(Str[index]);
    g.Text(d.rp,cptr^,max);
    INC(d.curX,SHORT(max)); d.curXAbs := d.rp.font.xSize*d.curX;
    INC(index,SHORT(max));
    DEC(len,max);
  END;
  IF SetCursor(d,old) THEN END;
END Write;


(*-------------------------------------------------------------------------*)


BEGIN

  li.Init(Elements);

  e.InitSemaphore(WindowListSemaphore);

CLOSE

  e.ObtainSemaphore(WindowListSemaphore);

  LOOP
    n := li.Head(Elements);
    IF n=NIL THEN EXIT END;
    WHILE n IS Screen DO
      IF ~ li.Next(n) THEN EXIT END
    END;
    Close(n(DispEl));
  END;
  LOOP
    n := li.Head(Elements);
    IF n=NIL THEN EXIT END;
    Close(n(DispEl))
  END;

  e.ReleaseSemaphore(WindowListSemaphore);

END Display.