home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / Display.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  20.5 KB  |  803 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  Amiga Oberon Library Module: Display              Date: 02-Nov-92      *)
  4. (*                                                                         *)
  5. (*   © 1992 by Fridtjof Siebert                                            *)
  6. (*                                                                         *)
  7. (*-------------------------------------------------------------------------*)
  8.  
  9. (*-------------------------------------------------------------------------
  10.  
  11.    Dieses Modul bietet grundlegende Grafikfunktionen und ermöglicht die
  12.    einfache Benutzung der Routinen der graphics.library. Dabei werden
  13.    Fenster und Screens nahezu gleich behandelt.
  14.  
  15.    Folgendes wird unterstützt:
  16.  
  17.     - Öffnen und schließen von Screens und Windows
  18.  
  19.     - Einfache Zeichenroutinen, wie Linie, Dot, Rechteck, Kreis, Text ...
  20.  
  21.     - Routinen zum Setzen der Pinselfarbe, des Zeichenmodus und des
  22.       verwendeten Fonts.
  23.  
  24.     - Turtle-Graphics
  25.  
  26.     - einfache Textaus- und Eingabe.
  27.  
  28. -------------------------------------------------------------------------*)
  29.  
  30.  
  31. MODULE Display;
  32.  
  33. IMPORT li*  := Lists,
  34.        I *  := Intuition,
  35.        u *  := Utility,
  36.        g *  := Graphics,
  37.        str  := Strings,
  38.        df   := DiskFont,
  39.        trans:= MathTrans,
  40.        math := MathFFP,
  41.        e *  := Exec,
  42.        sys  := SYSTEM;
  43.  
  44. TYPE
  45.  
  46.   DispEl * = RECORD (li.Node)
  47.                title  - : e.STRPTR;
  48.  
  49.                rp     - : g.RastPortPtr;
  50.                font   - : g.TextFontPtr;
  51.                width  - : INTEGER;
  52.                height - : INTEGER;
  53.  
  54.                turtleX   - : REAL;
  55.                turtleY   - : REAL;
  56.                turtleDir - : REAL;
  57.                pen       - : BOOLEAN;
  58.  
  59.                cursor    - : BOOLEAN;
  60.                curX      - : INTEGER;
  61.                curY      - : INTEGER;
  62.                curXAbs   - : INTEGER;
  63.                curYAbs   - : INTEGER;
  64.                txtWidth  - : INTEGER;
  65.                txtHeight - : INTEGER;
  66.  
  67.                gzz       - : BOOLEAN;
  68.  
  69.                left-, top- : INTEGER;
  70.  
  71.              END;
  72.  
  73.   Screen * = RECORD (DispEl)
  74.                screen   - : I.ScreenPtr;
  75.                backdrop - : I.WindowPtr;
  76.              END;
  77.  
  78.   Window * = RECORD (DispEl)
  79.                window - : I.WindowPtr;
  80.                rastport : g.RastPort;   (* Window.rp points to this copy of the RP *)
  81.              END;
  82.  
  83.   DispElPtr * = POINTER TO DispEl;
  84.   ScreenPtr * = POINTER TO Screen;
  85.   WindowPtr * = POINTER TO Window;
  86.  
  87. CONST
  88.  
  89. (* Parameter pat bei LinePattern *)
  90.  
  91.   line    * = -1;
  92.   dots    * = 5555H;
  93.   bigdots * = 3333H;
  94.   broken  * = 0F0FH;
  95.  
  96. VAR
  97.   Elements: li.List;
  98.   n: li.NodePtr;
  99.  
  100.   WindowListSemaphore: e.SignalSemaphore;
  101.                        (* Semaphore to access global variables of this
  102.                         * module (to be compatible with Concurrency.mod)
  103.                         *)
  104.  
  105.  
  106. CONST
  107.   ErrPtr = -1;  (* bei Fehler, erzeugt dann automatisch Adressfehler *)
  108.   degtorad = 3.14159265358979323846/180;
  109.  
  110.  
  111. PROCEDURE ^ Init*(d: DispElPtr); (* das brauchen wir gleich *)
  112.  
  113.  
  114. (*------  OpenScreen:  ------*)
  115.  
  116.  
  117. PROCEDURE OpenScreen*(scrn:       ScreenPtr;
  118.                       title:      ARRAY OF CHAR;
  119.                       x,y,w,h:    INTEGER;
  120.                       d:          SHORTINT;
  121.                       hires,lace: BOOLEAN): BOOLEAN;
  122.  
  123. VAR
  124.   ns: I.NewScreen;
  125.   top: INTEGER;
  126.   nw: I.NewWindow;
  127.  
  128. BEGIN
  129.   LOOP
  130.     NEW(scrn.title);
  131.     COPY(title,scrn.title^);
  132.     ns.leftEdge     := x;    ns.topEdge      := y;
  133.     IF w<=0 THEN w := g.gfx.normalDisplayColumns; IF ~ hires THEN w := w DIV 2 END END;
  134.     IF h<=0 THEN h := g.gfx.normalDisplayRows;    IF   lace  THEN h := h *   2 END END;
  135.     ns.width        := w;    ns.height       := h;
  136.     ns.depth        := d;    ns.detailPen    := 0;
  137.     ns.blockPen     := 1;    ns.viewModes    := {};
  138.     ns.type         := I.customScreen;
  139.     ns.font         := NIL;  ns.defaultTitle := scrn.title;
  140.     ns.gadgets      := NIL;  ns.customBitMap := NIL;
  141.     IF hires THEN INCL(ns.viewModes,g.hires) END;
  142.     IF lace  THEN INCL(ns.viewModes,g.lace ) END;
  143.     IF title="" THEN top :=  0; INCL(ns.type,I.screenQuiet) END;
  144.     scrn.screen := I.OpenScreen(ns);
  145.     IF scrn.screen=NIL THEN EXIT END;
  146.     IF title#"" THEN top := scrn.screen.barHeight + 1 END;
  147.     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);
  148.     nw.width := w;
  149.     nw.height := h;
  150.     nw.screen := scrn.screen;
  151.     scrn.backdrop := I.OpenWindow(nw);
  152.     IF scrn.backdrop=NIL THEN EXIT END;
  153.     scrn.rp := scrn.backdrop.rPort;
  154.     scrn.gzz := FALSE;
  155.     Init(scrn);
  156.     e.ObtainSemaphore(WindowListSemaphore);
  157.     li.AddHead(Elements,scrn);
  158.     e.ReleaseSemaphore(WindowListSemaphore);
  159.     RETURN TRUE;
  160.   END;
  161.   IF scrn.backdrop#NIL THEN I.CloseWindow(scrn.backdrop)  END;
  162.   IF scrn.screen  #NIL THEN I.OldCloseScreen(scrn.screen) END;
  163.   IF scrn.title   #NIL THEN DISPOSE(scrn.title)           END;
  164.   RETURN FALSE;
  165. END OpenScreen;
  166.  
  167.  
  168. (*------  OpenWindow:  ------*)
  169.  
  170.  
  171. PROCEDURE OpenWindow*(win:     WindowPtr;
  172.                       title:   ARRAY OF CHAR;
  173.                       x,y,w,h: INTEGER;
  174.                       screen:  I.ScreenPtr): BOOLEAN;
  175.  
  176. VAR nw: I.NewWindow;
  177.  
  178. BEGIN
  179.   LOOP
  180.     NEW(win.title);
  181.     COPY(title,win.title^);
  182.     nw.leftEdge    := x;   nw.topEdge     := y;
  183.     nw.width       := w;   nw.height      := h;
  184.     nw.detailPen   := -1;  nw.blockPen    := -1;
  185.     nw.idcmpFlags  := LONGSET{};
  186.     nw.flags       := LONGSET{I.windowSizing, I.windowDrag, I.windowDepth,
  187.                               I.windowClose, I.gimmeZeroZero, I.activate};
  188.     nw.firstGadget := NIL; nw.checkMark   := NIL;
  189.     nw.title       := win.title;
  190.     nw.bitMap      := NIL;
  191.     nw.minWidth    := 128; nw.minHeight   := 24;
  192.     nw.maxWidth    := -1;  nw.maxHeight   := -1;
  193.     nw.screen      := screen;
  194.     IF screen=NIL THEN nw.type   := {I.wbenchScreen}
  195.                   ELSE nw.type   := I.customScreen   END;
  196.     win.window := I.OpenWindow(nw);
  197.     IF win.window=NIL THEN EXIT END;
  198.     win.rastport := win.window.rPort^;
  199.     win.rp := sys.ADR(win.rastport);
  200.     win.gzz := TRUE;
  201.     Init(win);
  202.     e.ObtainSemaphore(WindowListSemaphore);
  203.     li.AddHead(Elements,win);
  204.     e.ReleaseSemaphore(WindowListSemaphore);
  205.     RETURN TRUE;
  206.   END;
  207.   IF win.title#NIL THEN DISPOSE(win.title) END;
  208.   RETURN FALSE;
  209. END OpenWindow;
  210.  
  211.  
  212. (*------  OpenWindowTags:  ------*)
  213.  
  214.  
  215. PROCEDURE OpenWindowTags* (win:     WindowPtr;
  216.                            gadg:    I.GadgetPtr;
  217.                            gzz:     BOOLEAN;
  218.                            title:   ARRAY OF CHAR;
  219.                            x,y,w,h: INTEGER;
  220.                            screen:  I.ScreenPtr;
  221.                            activate:BOOLEAN;
  222.                            tags:    sys.ADDRESS): BOOLEAN;
  223.  
  224. VAR nw: I.NewWindow;
  225.  
  226. BEGIN
  227.   LOOP
  228.     NEW(win.title);
  229.     COPY(title,win.title^);
  230.     nw.leftEdge    := x;   nw.topEdge     := y;
  231.     nw.width       := w;   nw.height      := h;
  232.     nw.detailPen   := -1;  nw.blockPen    := -1;
  233.     nw.idcmpFlags  := LONGSET{};
  234.     nw.flags       := LONGSET{I.windowSizing, I.windowDrag, I.windowDepth, I.windowClose};
  235.     IF activate THEN INCL(nw.flags,I.activate) END;
  236.     IF gzz THEN INCL(nw.flags,I.gimmeZeroZero) END;
  237.     nw.firstGadget := gadg; nw.checkMark   := NIL;
  238.     nw.title       := win.title;
  239.     nw.bitMap      := NIL;
  240.     nw.minWidth    := 128; nw.minHeight   := 64;
  241.     nw.maxWidth    := -1;  nw.maxHeight   := -1;
  242.     nw.screen      := screen;
  243.     IF screen=NIL THEN nw.type   := {I.wbenchScreen}
  244.                   ELSE nw.type   := I.customScreen   END;
  245.     IF I.int.libNode.version<37 THEN
  246.       win.window := I.OpenWindow(nw);
  247.     ELSE
  248.       win.window := I.OpenWindowTags(nw,I.waAutoAdjust,I.LTRUE,
  249.                                         u.more,        tags,
  250.                                         u.done);
  251.     END;
  252.     IF win.window=NIL THEN EXIT END;
  253.     win.rastport := win.window.rPort^;
  254.     win.rp := sys.ADR(win.rastport);
  255.     win.gzz := gzz;
  256.     Init(win);
  257.     e.ObtainSemaphore(WindowListSemaphore);
  258.     li.AddHead(Elements,win);
  259.     e.ReleaseSemaphore(WindowListSemaphore);
  260.     RETURN TRUE;
  261.   END;
  262.   IF win.title#NIL THEN DISPOSE(win.title) END;
  263.   RETURN FALSE;
  264. END OpenWindowTags;
  265.  
  266.  
  267. (*------  OpenWindowX:  ------*)
  268.  
  269.  
  270. PROCEDURE OpenWindowX *(win     : WindowPtr;
  271.                         gadg    : I.GadgetPtr;
  272.                         gzz     : BOOLEAN;
  273.                         title   : ARRAY OF CHAR;
  274.                         x,y,w,h : INTEGER;
  275.                         activate: BOOLEAN;
  276.                         screen  : I.ScreenPtr): BOOLEAN;
  277.  
  278. BEGIN
  279.   RETURN OpenWindowTags(win, gadg, gzz, title, x,y,w,h, screen, activate, NIL);
  280. END OpenWindowX;
  281.  
  282.  
  283. (*------  Close:  ------*)
  284.  
  285.  
  286. PROCEDURE Close*(d: DispElPtr);
  287.  
  288. BEGIN
  289.   e.ObtainSemaphore(WindowListSemaphore);
  290.   li.Remove(Elements,d);
  291.   e.ReleaseSemaphore(WindowListSemaphore);
  292.   WITH d : Window DO
  293.     I.CloseWindow(d(Window).window);
  294.   | d : Screen DO
  295.     I.CloseWindow(d.backdrop);
  296.     I.OldCloseScreen(d.screen);
  297.   END;
  298.   IF d.font#NIL THEN g.CloseFont(d.font) END;
  299.   IF d.title#NIL THEN DISPOSE(d.title) END;
  300. END Close;
  301.  
  302.  
  303. (*------  Init:  ------*)
  304.  
  305. PROCEDURE Init*(d: DispElPtr);
  306. (* muß aufgerufen werden, wenn sich beim Fenster die Größe verändert hat *)
  307. VAR
  308.   w: I.WindowPtr;
  309.   s: I.ScreenPtr;
  310. BEGIN
  311.   IF d IS Window THEN
  312.     WITH d: Window DO
  313.       w := d.window;
  314.       IF d.gzz THEN
  315.         d.width  := w.gzzWidth;
  316.         d.height := w.gzzHeight;
  317.         d.left := 0;
  318.         d.top := 0;
  319.       ELSE
  320.         d.width  := w.width-w.borderLeft-w.borderRight;
  321.         d.height := w.height-w.borderTop-w.borderBottom;
  322.         d.left := w.borderLeft;
  323.         d.top := w.borderTop;
  324.       END;
  325.       d.curX := 0;
  326.       d.curY := 0;
  327.       d.curXAbs := 0;
  328.       d.curYAbs := 0;
  329.       d.txtWidth := d.width DIV d.rp.font.xSize;
  330.       d.txtHeight := d.height DIV d.rp.font.ySize;
  331.     END;
  332.   ELSIF d IS Screen THEN
  333.     WITH d: Screen DO
  334.       s := d.screen;
  335.       d.width     := s.width;
  336.       IF d.title^="" THEN d.height := s.height;
  337.                      ELSE d.height := s.height-s.barHeight-1 END;
  338.       d.left      := 0;
  339.       d.top       := 0;
  340.       d.curX      := 0;
  341.       d.curY      := 0;
  342.       d.curXAbs   := 0;
  343.       d.curYAbs   := 0;
  344.       d.txtWidth  := d.width DIV d.rp.font.xSize;
  345.       d.txtHeight := d.height DIV d.rp.font.ySize;
  346.     END;
  347.   END;
  348. END Init;
  349.  
  350.  
  351. (*------  Colors:  ------*)
  352.  
  353.  
  354. PROCEDURE SetColors*(s: ScreenPtr; VAR cols: ARRAY OF INTEGER);
  355. BEGIN
  356.   g.LoadRGB4(sys.ADR(s.screen.viewPort),cols,LEN(cols))
  357. END SetColors;
  358.  
  359. PROCEDURE SetCol*(s: ScreenPtr; num,R,G,B: INTEGER);
  360. BEGIN g.SetRGB4(sys.ADR(s.screen.viewPort),num,R,G,B) END SetCol;
  361.  
  362. PROCEDURE NumToRGB*(num: INTEGER; VAR r,g,b: INTEGER);
  363. BEGIN
  364.   b := num MOD 16; num := num DIV 16;
  365.   g := num MOD 16; num := num DIV 16;
  366.   r := num MOD 16;
  367. END NumToRGB;
  368.  
  369. PROCEDURE RGBToNum*(r,g,b: INTEGER): INTEGER;
  370. BEGIN RETURN b+16*(g+16*r) END RGBToNum;
  371.  
  372.  
  373. (*------  Pens:  ------*)
  374.  
  375.  
  376. PROCEDURE FrontPen*(d: DispElPtr; pen: SHORTINT);
  377. BEGIN g.SetAPen(d.rp,pen) END FrontPen;
  378.  
  379. PROCEDURE BackPen*(d: DispElPtr; pen: SHORTINT);
  380. BEGIN g.SetBPen(d.rp,pen) END BackPen;
  381.  
  382. PROCEDURE Jam1*(d: DispElPtr);
  383. BEGIN g.SetDrMd(d.rp,g.jam1) END Jam1;
  384.  
  385. PROCEDURE Jam2*(d: DispElPtr);
  386. BEGIN g.SetDrMd(d.rp,g.jam2) END Jam2;
  387.  
  388. PROCEDURE Complement*(d: DispElPtr);
  389. BEGIN g.SetDrMd(d.rp,SHORTSET{g.complement}) END Complement;
  390.  
  391. PROCEDURE LinePattern*(d: DispElPtr; pat: INTEGER);
  392. BEGIN g.SetDrPt(d.rp,pat) END LinePattern;
  393.  
  394.  
  395. (*------  Draw:  ------*)
  396.  
  397. PROCEDURE Clear*(d: DispElPtr);
  398. VAR
  399.   oldmask: SHORTSET;
  400. BEGIN
  401.   oldmask := d.rp.mask;
  402.   d.rp.mask := -SHORTSET{};
  403.   Jam1(d); FrontPen(d,0);
  404.   g.RectFill(d.rp,d.left,d.top,d.left+d.width-1,d.top+d.height-1);
  405.   FrontPen(d,1);
  406.   d.rp.mask := oldmask;
  407. END Clear;
  408.  
  409. PROCEDURE Line*(d: DispElPtr; x1,y1,x2,y2: INTEGER);
  410. BEGIN
  411.   g.Move(d.rp,d.left+x1,d.top+y1);
  412.   g.Draw(d.rp,d.left+x2,d.top+y2);
  413. END Line;
  414.  
  415. PROCEDURE Dot*(d: DispElPtr; x,y: INTEGER);
  416. BEGIN IF g.WritePixel(d.rp,d.left+x,d.top+y) THEN END END Dot;
  417.  
  418. PROCEDURE DotColor*(d: DispElPtr; x,y: INTEGER): INTEGER;
  419. BEGIN RETURN SHORT(g.ReadPixel(d.rp,d.left+x,d.top+y)) END DotColor;
  420.  
  421. PROCEDURE Rect*(d: DispElPtr; x,y,w,h: INTEGER);
  422. BEGIN
  423.   DEC(w); DEC(h);
  424.   INC(x,d.left); INC(y,d.top);
  425.   g.Move(d.rp,x  ,y  );
  426.   g.Draw(d.rp,x+w,y  );
  427.   g.Draw(d.rp,x+w,y+h);
  428.   g.Draw(d.rp,x  ,y+h);
  429.   g.Draw(d.rp,x  ,y  );
  430. END Rect;
  431.  
  432. PROCEDURE Box*(d: DispElPtr; x,y,w,h: INTEGER);
  433. BEGIN INC(x,d.left); INC(y,d.top); g.RectFill(d.rp,x,y,x+w-1,y+h-1) END Box;
  434.  
  435. PROCEDURE Move*(d: DispElPtr; x,y: INTEGER);
  436. BEGIN g.Move(d.rp,d.left+x,d.top+y) END Move;
  437.  
  438. PROCEDURE Draw*(d: DispElPtr; x,y: INTEGER);
  439. BEGIN g.Draw(d.rp,d.left+x,d.top+y) END Draw;
  440.  
  441. PROCEDURE Text*(d: DispElPtr; x,y: INTEGER; s: ARRAY OF CHAR);
  442. BEGIN
  443.   g.Move(d.rp,d.left+x,d.top+y);
  444.   g.Text(d.rp,s,str.Length(s))
  445. END Text;
  446.  
  447. PROCEDURE Circle*(d: DispElPtr; x,y,r: INTEGER);
  448. BEGIN g.DrawEllipse(d.rp,d.left+x,d.top+y,r,r) END Circle;
  449.  
  450. PROCEDURE Ellipse*(d: DispElPtr; x,y,rx,ry: INTEGER);
  451. BEGIN g.DrawEllipse(d.rp,d.left+x,d.top+y,rx,ry) END Ellipse;
  452.  
  453.  
  454. (*------  Font:  ------*)
  455.  
  456.  
  457. PROCEDURE Font*(d: DispElPtr; name: ARRAY OF CHAR; height: INTEGER): BOOLEAN;
  458. VAR
  459.   attr: g.TextAttr;
  460.   font: g.TextFontPtr;
  461. BEGIN
  462.   attr.name  := sys.ADR(name);
  463.   attr.ySize := height;
  464.   attr.style := SHORTSET{};
  465.   attr.flags := SHORTSET{};
  466.   font := df.OpenDiskFont(attr);
  467.   IF font=NIL THEN RETURN FALSE END;
  468.   IF d.font#NIL THEN g.CloseFont(d.font) END;
  469.   g.SetFont(d.rp,font); d.font := font;
  470.   d.curX := 0;
  471.   d.curY := 0;
  472.   d.curXAbs := 0;
  473.   d.curYAbs := 0;
  474.   d.txtWidth := d.width DIV d.rp.font.xSize;
  475.   d.txtHeight := d.height DIV d.rp.font.ySize;
  476.   RETURN TRUE;
  477. END Font;
  478.  
  479.  
  480. (*------  Turtle Graphics:  ------*)
  481.  
  482.  
  483. PROCEDURE SetTurtlePos*(d: DispElPtr; x,y: REAL);
  484. BEGIN
  485.   d.turtleX := x;
  486.   d.turtleY := y;
  487. END SetTurtlePos;
  488.  
  489.  
  490. PROCEDURE GetTurtlePos*(d: DispElPtr;VAR x,y: REAL);
  491. BEGIN
  492.   x := d.turtleX;
  493.   y := d.turtleY;
  494. END GetTurtlePos;
  495.  
  496.  
  497. PROCEDURE SetTurtleDir*(d: DispElPtr; dir: REAL);
  498. (*        0°
  499.           A
  500.           |
  501.     90° <-+-> 270°
  502.           |
  503.           V
  504.          180°       *)
  505. BEGIN
  506.   d.turtleDir := dir;
  507. END SetTurtleDir;
  508.  
  509.  
  510. PROCEDURE GetTurtleDir*(d: DispElPtr): REAL;
  511. BEGIN
  512.   RETURN d.turtleDir;
  513. END GetTurtleDir;
  514.  
  515.  
  516. PROCEDURE SetPen*(d: DispElPtr);
  517. BEGIN d.pen := TRUE END SetPen;
  518.  
  519.  
  520. PROCEDURE LiftPen*(d: DispElPtr);
  521. BEGIN d.pen := FALSE END LiftPen;
  522.  
  523.  
  524. PROCEDURE Forward*(d: DispElPtr; s: REAL);
  525. VAR fromx,fromy,rad: REAL;
  526. BEGIN
  527.   fromx := d.turtleX;
  528.   fromy := d.turtleY;
  529.   rad := d.turtleDir * degtorad;
  530.   d.turtleX := fromx - s * trans.Sin(rad);
  531.   d.turtleY := fromy - s * trans.Cos(rad);
  532.   IF d.pen THEN Line(d,SHORT(ENTIER(fromx)),
  533.                        SHORT(ENTIER(fromy)),
  534.                        SHORT(ENTIER(d.turtleX)),
  535.                        SHORT(ENTIER(d.turtleY))) END;
  536. END Forward;
  537.  
  538.  
  539. PROCEDURE TurnLeft*(d: DispElPtr; alpha: REAL);
  540. BEGIN
  541.   d.turtleDir := d.turtleDir + alpha;
  542.   IF d.turtleDir> 360 THEN d.turtleDir := d.turtleDir - 360 END;
  543. END TurnLeft;
  544.  
  545.  
  546. PROCEDURE TurnRight*(d: DispElPtr; alpha: REAL);
  547. BEGIN
  548.   d.turtleDir := d.turtleDir - alpha;
  549.   IF d.turtleDir<-360 THEN d.turtleDir := d.turtleDir + 360 END;
  550. END TurnRight;
  551.  
  552.  
  553. (*------  Text Funktionen:  ------*)
  554.  
  555.  
  556. PROCEDURE SetCursor*(d: DispElPtr; on: BOOLEAN): BOOLEAN;
  557. VAR
  558.   oldstate: BOOLEAN;
  559.   oldmask: SHORTSET;
  560. BEGIN
  561.   oldstate := d.cursor;
  562.   d.cursor := on;
  563.   IF oldstate#on THEN
  564.     oldmask := d.rp.mask; d.rp.mask := -SHORTSET{};
  565.     Complement(d);
  566.     Box(d,d.curXAbs,d.curYAbs,d.rp.font.xSize,d.rp.font.ySize);
  567.     Jam2(d);
  568.     d.rp.mask := oldmask;
  569.   END;
  570.   RETURN oldstate;
  571. END SetCursor;
  572.  
  573.  
  574. PROCEDURE CursorOn*(d: DispElPtr);
  575. BEGIN IF SetCursor(d,TRUE) THEN END END CursorOn;
  576.  
  577.  
  578. PROCEDURE CursorOff*(d: DispElPtr);
  579. BEGIN IF SetCursor(d,FALSE) THEN END END CursorOff;
  580.  
  581.  
  582. PROCEDURE Position*(d: DispElPtr; x,y: INTEGER);
  583. VAR old: BOOLEAN;
  584. BEGIN
  585.   old := SetCursor(d,FALSE);
  586.   d.curX := x;
  587.   d.curY := y;
  588.   d.curXAbs := d.rp.font.xSize*d.curX;
  589.   d.curYAbs := d.rp.font.ySize*d.curY;
  590.   IF SetCursor(d,old) THEN END;
  591. END Position;
  592.  
  593.  
  594. PROCEDURE Plain*(d: DispElPtr);
  595. BEGIN d.rp.algoStyle := g.normal END Plain;
  596.  
  597. PROCEDURE UnderLinedOn*(d: DispElPtr);
  598. BEGIN INCL(d.rp.algoStyle,g.underlined) END UnderLinedOn;
  599.  
  600. PROCEDURE UnderLinedOff*(d: DispElPtr);
  601. BEGIN EXCL(d.rp.algoStyle,g.underlined) END UnderLinedOff;
  602.  
  603. PROCEDURE BoldOn*(d: DispElPtr);
  604. BEGIN INCL(d.rp.algoStyle,g.bold) END BoldOn;
  605.  
  606. PROCEDURE BoldOff*(d: DispElPtr);
  607. BEGIN EXCL(d.rp.algoStyle,g.bold) END BoldOff;
  608.  
  609. PROCEDURE ItalicOn*(d: DispElPtr);
  610. BEGIN INCL(d.rp.algoStyle,g.italic) END ItalicOn;
  611.  
  612. PROCEDURE ItalicOff*(d: DispElPtr);
  613. BEGIN EXCL(d.rp.algoStyle,g.italic) END ItalicOff;
  614.  
  615.  
  616. PROCEDURE Home*(d: DispElPtr);
  617. VAR old: BOOLEAN;
  618. BEGIN
  619.   old := SetCursor(d,FALSE);
  620.   d.curX := 0;
  621.   d.curY := 0;
  622.   d.curXAbs := 0;
  623.   d.curYAbs := 0;
  624.   d.rp.algoStyle := g.normal;
  625.   IF SetCursor(d,old) THEN END;
  626. END Home;
  627.  
  628.  
  629. PROCEDURE ClrHome*(d: DispElPtr);
  630. VAR old: BOOLEAN;
  631. BEGIN
  632.   old := SetCursor(d,FALSE);
  633.   Clear(d);
  634.   d.curX := 0;
  635.   d.curY := 0;
  636.   d.curXAbs := 0;
  637.   d.curYAbs := 0;
  638.   d.rp.algoStyle := g.normal;
  639.   IF SetCursor(d,old) THEN END;
  640. END ClrHome;
  641.  
  642.  
  643. PROCEDURE ScrollUp*(d: DispElPtr);
  644. (* fügt unten eine Leerzeile an *)
  645. VAR
  646.   y: INTEGER;
  647.   old: BOOLEAN;
  648. BEGIN
  649.   old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  650.   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);
  651.   IF SetCursor(d,old) THEN END;
  652. END ScrollUp;
  653.  
  654.  
  655. PROCEDURE ScrollUpN*(d: DispElPtr; n: INTEGER);
  656. (* fügt unten n Leerzeilen an. d.txtHeight > n > 0 *)
  657. VAR
  658.   y: INTEGER;
  659.   old: BOOLEAN;
  660. BEGIN
  661.   old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  662.   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);
  663.   IF SetCursor(d,old) THEN END;
  664. END ScrollUpN;
  665.  
  666.  
  667. PROCEDURE ScrollDown*(d: DispElPtr);
  668. (* fügt oben eine Leerzeile an *)
  669. VAR
  670.   y: INTEGER;
  671.   old: BOOLEAN;
  672. BEGIN
  673.   old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  674.   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);
  675.   IF SetCursor(d,old) THEN END;
  676. END ScrollDown;
  677.  
  678.  
  679. PROCEDURE ScrollDownN*(d: DispElPtr; n: INTEGER);
  680. (* fügt oben n Leerzeilen an. d.txtHeight > n > 0 *)
  681. VAR
  682.   y: INTEGER;
  683.   old: BOOLEAN;
  684. BEGIN
  685.   old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  686.   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);
  687.   IF SetCursor(d,old) THEN END;
  688. END ScrollDownN;
  689.  
  690.  
  691. PROCEDURE InsertLine*(d: DispElPtr; n: INTEGER);
  692. (* fügt an Zeile n eine Leerzeile ein und scrollt den Rest nach unten *)
  693. VAR
  694.   y: INTEGER;
  695.   old: BOOLEAN;
  696. BEGIN
  697.   old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  698.   g.ScrollRaster(d.rp,0,-d.rp.font.ySize,d.left,d.top+n*y,
  699.                      d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  700.   IF SetCursor(d,old) THEN END;
  701. END InsertLine;
  702.  
  703.  
  704. PROCEDURE DeleteLine*(d: DispElPtr; n: INTEGER);
  705. (* löscht an Zeile n eine Zeile ein und scrollt den Rest darunter hoch *)
  706. VAR
  707.   y: INTEGER;
  708.   old: BOOLEAN;
  709. BEGIN
  710.   old := SetCursor(d,FALSE); y := d.rp.font.ySize;
  711.   g.ScrollRaster(d.rp,0,d.rp.font.ySize,d.left,d.top+n*y,
  712.                      d.left+d.txtWidth*d.rp.font.xSize-1,d.top+d.txtHeight*y-1);
  713.   IF SetCursor(d,old) THEN END;
  714. END DeleteLine;
  715.  
  716.  
  717. PROCEDURE WriteLn*(d: DispElPtr);
  718. VAR old: BOOLEAN;
  719. BEGIN
  720.   old := SetCursor(d,FALSE);
  721.   d.curX := 0; d.curXAbs := 0;
  722.   INC(d.curY);
  723.   IF d.curY=d.txtHeight THEN
  724.     ScrollUp(d);
  725.     DEC(d.curY);
  726.   END;
  727.   d.curYAbs := d.rp.font.ySize*d.curY;
  728.   IF SetCursor(d,old) THEN END;
  729. END WriteLn;
  730.  
  731.  
  732. PROCEDURE Write*(d: DispElPtr; Str: ARRAY OF CHAR);
  733. VAR
  734.   old: BOOLEAN;
  735.   len,max: LONGINT;
  736.   index: LONGINT;
  737.   cptr: UNTRACED POINTER TO ARRAY 1 OF CHAR;
  738. BEGIN
  739.   old := SetCursor(d,FALSE); index := 0;
  740.   len := str.Length(Str);
  741.   WHILE len>0 DO
  742.     max := len;
  743.     IF len+d.curX>d.txtWidth THEN
  744.       IF d.curX=d.txtWidth THEN
  745.         WriteLn(d);
  746.         IF len<d.txtWidth THEN max:=len ELSE max:=d.txtWidth END;
  747.       ELSE
  748.         max := d.txtWidth-d.curX;
  749.       END;
  750.     END;
  751.     g.Move(d.rp,d.left+d.curXAbs,d.top+d.curYAbs + d.rp.font.baseline);
  752.     cptr := sys.ADR(Str[index]);
  753.     g.Text(d.rp,cptr^,max);
  754.     INC(d.curX,SHORT(max)); d.curXAbs := d.rp.font.xSize*d.curX;
  755.     INC(index,SHORT(max));
  756.     DEC(len,max);
  757.   END;
  758.   IF SetCursor(d,old) THEN END;
  759. END Write;
  760.  
  761.  
  762. (*-------------------------------------------------------------------------*)
  763.  
  764.  
  765. BEGIN
  766.  
  767.   li.Init(Elements);
  768.  
  769.   e.InitSemaphore(WindowListSemaphore);
  770.  
  771. CLOSE
  772.  
  773.   e.ObtainSemaphore(WindowListSemaphore);
  774.  
  775.   LOOP
  776.     n := li.Head(Elements);
  777.     IF n=NIL THEN EXIT END;
  778.     WHILE n IS Screen DO
  779.       IF ~ li.Next(n) THEN EXIT END
  780.     END;
  781.     Close(n(DispEl));
  782.   END;
  783.   LOOP
  784.     n := li.Head(Elements);
  785.     IF n=NIL THEN EXIT END;
  786.     Close(n(DispEl))
  787.   END;
  788.  
  789.   e.ReleaseSemaphore(WindowListSemaphore);
  790.  
  791. END Display.
  792.  
  793.  
  794.  
  795.  
  796.  
  797.  
  798.  
  799.  
  800.  
  801.  
  802.  
  803.