Oberon-2

Példák



Példa programok:

Einstein Disk Puzzle
Hasító táblázat

Egy nagyobb példa

Az alábbi példában az Oberon System egy egyszerûsített változatának, az Oberon0-nak forráskódja látható. A kód rávilágít a helyes Oberon-2 programozás minden rejtelmére.

Definíciós állományok (automatikusan generált)

DEFINITION Oberon0;

  PROCEDURE Loop;

END Oberon0.

DEFINITION Viewers0;
  IMPORT OS;

  TYPE
  Frame = POINTER TO FrameDesc;
  FrameDesc = RECORD ( OS.ObjectDesc )
   x, y : INTEGER; (* left bottom in pixels relative to left bot. of 
			Screen *)
   w, h : INTEGER; (* width, height in pixels *)
		 PROCEDURE ( f : Frame ) Draw;
   PROCEDURE ( f : Frame ) Modify ( dy : INTEGER );
   PROCEDURE ( f : Frame ) Move ( dy : INTEGER );
   PROCEDURE ( f : Frame ) Copy () : Frame;
   PROCEDURE ( f : Frame ) HandleKey ( ch : CHAR );
   PROCEDURE ( f : Frame ) HandleMouse ( x, y : INTEGER; buttons : SET );
   PROCEDURE ( f : Frame ) Handle ( VAR m : OS.Message );
   PROCEDURE ( f : Frame ) Neutralize;
   PROCEDURE ( f : Frame ) SetFocus;
   PROCEDURE ( f : Frame ) Defocus;
  END;

  Viewer = POINTER TO ViewerDesc;
  ViewerDesc = RECORD ( FrameDesc )
   menu-, cont- : Frame;
   next- : Viewer;
   PROCEDURE ( v : Viewer ) Close;
  END;

  VAR
  focus- : Frame; (* the frame that gets the keyboard input *)

  PROCEDURE New ( menu, cont : Frame ) : Viewer;
  PROCEDURE ViewerAt ( y : INTEGER ) : Viewer;
  PROCEDURE Broadcast ( VAR m : OS.Message );
  PROCEDURE Close;
  PROCEDURE Copy;

END Viewers0.

DEFINITION AsciiTexts;
  IMPORT OS;

  TYPE
  Text = POINTER TO TextDesc;
  TextDesc = RECORD ( OS.ObjectDesc )
   len- : LONGINT; (* text length *)
   pos- : LONGINT; (* read/write position *)
   PROCEDURE ( t : Text ) Clear;
   PROCEDURE ( t : Text ) Insert ( at : LONGINT; t1 : Text; beg, 
				   end : LONGINT );
   PROCEDURE ( t : Text ) Delete ( beg, end : LONGINT );
   PROCEDURE ( t : Text ) SetPos ( pos : LONGINT );
   PROCEDURE ( t : Text ) Read ( VAR ch : CHAR );
   PROCEDURE ( t : Text ) Write ( ch : CHAR );
   PROCEDURE ( t : Text ) Load ( VAR r : OS.Rider );
   PROCEDURE ( t : Text ) Store ( VAR r : OS.Rider );
  END;

  NotifyInsMsg = RECORD ( OS.Message )
   t : Text;
   beg, end : LONGINT
  END;

  NotifyDelMsg = RECORD ( OS.Message )
   t : Text;
   beg, end : LONGINT
  END;

END AsciiTexts.

DEFINITION Texts0;
  IMPORT OS, AsciiTexts;

  TYPE
  Attribute = POINTER TO AttrDesc;
  Element = POINTER TO ElemDesc;

  Text = POINTER TO TextDesc;
  TextDesc = RECORD ( AsciiTexts.TextDesc )
   attr- : Attribute; (* attributes of previously read character *)
   PROCEDURE ( t : Text ) ChangeFont ( beg, end : LONGINT; 
				       fnt : OS.Font );
   PROCEDURE ( t : Text ) ReadNextElem ( VAR e: Element );
   PROCEDURE ( t : Text ) WriteElem ( e : Element );
   PROCEDURE ( t : Text ) ElemPos ( e : Element );
  END;

  AttrDesc = RECORD
   fnt- : OS.Font; (* font of this attribute segment *)
   elem- : Element (* if not NIL, the corresponding character 
		      is an element *)
  END;

  ElemDesc = RECORD ( OS.ObjectDesc )
   w, h : INTEGER; (* width and height of element in pixels *)
   dsc : INTEGER; (* descender (part below the base line) *)
   PROCEDURE ( e : Element ) Draw ( x, y : INTEGER );
   PROCEDURE ( e : Element ) HandleMouse ( frame : OS.Object; 
					   x, y : INTEGER );
   PROCEDURE ( e : Element ) Copy () : Element;
  END;

  NotifyDelMsg = AsciiTexts.NotifyDelMsg;
  NotifyInsMsg = AsciiTexts.NotityInsMsg;

  NotityReplMsg = RECORD ( OS.Message )
   t : Text;
   beg, end : LONGINT
  END;

END Texts0.

DEFINITION TextFrames0;
  IMPORT OS, Viewers0, Texts0;

  TYPE
  Position = RECORD  (* position of a character ch on the screen *)
   x-, y- : INTEGER; (* left point on base line *)
   dx- : INTEGER;  (* width of ch *)
   org- : LONGINT;  (* origin of Iine containing ch *)
   pos- : LONGINT  (* text position of ch *)
  END;

  Frame = POINTER TO FrameDesc;
  FrameDesc = RECORD ( Viewers0.FrameDesc )
   text : Texts0.Text; (* text displayed in this frame *)
   org- : LONGINT; (* origin: text pos. of first char. in frame *)
   caret- : Position; (* caret.pos < 0: no caret visible *)
   selBeg-, selEnd- : Position; (* seiBeg.pos < 0: no selection visible *)
   PROCEDURE ( f : Frame ) Draw;
   PROCEDURE ( f : Frame ) Defocus;
   PROCEDURE ( f : Frame ) Neutralize;
   PROCEDURE ( f : Frame ) Modify ( dy : INTEGER );
   PROCEDURE ( f : Frame ) HandleKey ( ch : CHAR );
   PROCEDURE ( f : Frame ) HandleMouse ( x, y : INTEGER; buttons : SET );
   PROCEDURE ( f : Frame ) Handle ( VAR m : OS.Message );
   PROCEDURE ( f : Frame ) SetCaret ( pos : LONGINT );
   PROCEDURE ( f : Frame ) RemoveCaret;
   PROCEDURE ( f : Frame ) SetSelection ( from, to : LONGINT );
   PROCEDURE ( f : Frame ) RemoveSelection;
   PROCEDURE ( f : Frame ) Copy () : Viewers0.Frame;
  END;

  VAR
  cmdFrame- : Frame; (* frame containing most recent command *)
  cmdPos- : LONGINT; (* text position after most recent command *)

  PROCEDURE New ( t : Texts0.Text ) : Frame;
  PROCEDURE NewMenu ( name, commands : ARRAY OF CHAR ) : Frame;
  PROCEDURE GetSelection ( VAR f : Frame );

END TextFrames0.

DEFINITION Edit0;

  PROCEDURE Open;
  PROCEDURE Store;
  PROCEDURE ChangeFont;
  
END Edit0.

DEFINITION Shapes0;
  IMPORT OS, Viewers0;

  TYPE
  Shape = POINTER TO ShapeDesc;
  ShapeDesc = RECORD ( OS.ObjectDesc )
   selected: BOOLEAN; (* TRUE: shape is selected *)
   PROCEDURE ( s : Shape ) SetBox ( x, y, w, h : INTEGER );
   PROCEDURE ( s : Shape ) GetBox ( VAR x, y, w, h : INTEGER );
   PROCEDURE ( s : Shape ) Draw ( f : Viewers0.Frame );
   PROCEDURE ( s : Shape ) Move ( dx, dy : INTEGER );
   PROCEDURE ( s : Shape ) Neutralize;
   PROCEDURE ( s : Shape ) SetSelection ( x, y, w, h : INTEGER );
   PROCEDURE ( s : Shape ) Copy () : Shape;
  END;

  Graphic = POINTER TO GraphicDesc;
  GraphicDesc = RECORD
   shapes : Shape;
   PROCEDURE ( g : Graphic ) Insert ( s : Shape );
   PROCEDURE ( g : Graphic ) DeleteSelected;
   PROCEDURE ( g : Graphic ) MoveSelected ( dx, dy : INTEGER );
   PROCEDURE ( g : Graphic ) Draw ( f : Viewers0.Frame );
   PROCEDURE ( g : Graphic ) Neutralize;
   PROCEDURE ( g : Graphic ) SetSelection ( x, y, w, h : INTEGER );
   PROCEDURE ( g : Graphic ) GetBox ( VAR x, y, w, h : INTEGER );
   PROCEDURE ( g : Graphic ) Copy () : Graphic;
   PROCEDURE ( g : Graphic ) Load ( VAR r : OS.Rider );
   PROCEDURE ( g : Graphic ) Store ( VAR r : OS.Rider );
  END;

  NotifyChangeMsg = RECORD ( OS.Message )
   g : Graphic
  END;

  VAR curShape : ARRAY 32 OF CHAR; (* name of current shape type*)

  PROCEDURE InitGraphic ( VAR g : Graphic );

END Shapes0.

DEFINITION GraphicFrames0;
  IMPORT Viewers0, OS, Shapes0;

  TYPE
  Frame = POINTER TO FrameDesc;
  FrameDesc = RECORD ( Viewers0.FrameDesc )
   orgX, orgY : INTEGER;
   graphic : Shapes0.Graphic;
   PROCEDURE ( f : Frame ) Draw;
   PROCEDURE ( f : Frame ) Neutralize;
   PROCEDURE ( f : Frame ) Modify ( y : INTEGER );
   PROCEDURE ( f : Frame ) Copy () : Viewers0.Frame;
   PROCEDURE ( f : Frame ) HandleMouse ( x, y : INTEGER; buttons : SET );
   PROCEDURE ( f : Frame ) Handle ( VAR m : OS.Message );
   PROCEDURE ( f : Frame ) InvertBlock ( x, y, w, h : INTEGER );
  END;

  PROCEDURE New ( graphic : ShapesO.Graphic ) : Frame;

END GraphicFramesO.

DEFINITION Draw0;

  PROCEDURE Open;
  PROCEDURE Store;

END Draw0.

DEFINITION Rectangles0;
  IMPORT Shapes0;

  TYPE
  Rectangle = POINTER TO RectDesc;
  RectDesc = RECORD ( Shapes0.ShapeDesc )
  END;

  PROCEDURE Set;

END Rectangles0.

DEFINITION GraphicElems0;
  IMPORT Texts0;

  TYPE
  Element = POINTER TO ElemDesc;
  ElemDesc = RECORD ( Texts0.ElemDesc )
  END;

  PROCEDURE Insert;
  PROCEDURE Update;

END GraphicElems0;





Modulok



MODULE Oberon0;
  IMPORT OS, Viewers0, Texts0, TextFrames0;

  CONST ESC = 1BX;

  PROCEDURE Loop*;
  VAR ch : CHAR;
    x, y : INTEGER;
    buttons : SET;
    v : Viewers0.Viewer;
    t : Texts0.Text;
  BEGIN
  NEW ( t );
  t.Clear;
  v := Viewers0.New ( TextFramesO.NewMenu ( "LOG", "Viewers0.Close" ), 
		      TextFrames0.New ( t )); (*open the log viewer*)
  LOOP (* wait for events *)
   IF OS.AvailChars() > 0 THEN
    OS.ReadKey ( ch );
    IF ch = ESC THEN
     EXIT
    ELSIF Viewers0.focus # NIL THEN
     Viewers0.focus.HandleKey ( ch )
    END
   ELSE
    OS.GetMouse ( buttons, x, y );
    v := Viewers0.ViewerAt ( y );
    IF v # NIL THEN
     v.HandleMouse ( x, y, buttons )
    ELSE
     OS.DrawCursor( x, y )
    END
   END
  END
  END Loop;

END Oberon0.

MODULE Viewers0;
  IMPORT OS;

  TYPE
  Frame* = POINTER TO FrameDesc;
  FrameDesc* = RECORD ( OS.ObjectDesc )
   x*, y* : INTEGER; (* Ieft bottom in pixels relative to Ieft bot. 
			of screen *)
   w*, h* : INTEGER  (* width, height in pixels *)
  END;

  Viewer* = POINTER TO ViewerDesc;
  ViewerDesc* = RECORD ( FrameDesc )
   menu-, cont- : Frame; (* menu frame, contents frame *)
   next- : Viewer;
  END;

  VAR
  focus- : Frame; (* the frame that gets the keyboard input *)
  viewers : Viewer; (* root for list of viewers on the screen *)
  barH : INTEGER; (* default height of title bar *)
  minH : INTEGER; (* minimal height of a viewer *)

  PROCEDURE ( f : Frame ) Draw*;
  END Draw;

  PROCEDURE ( f : Frame ) Copy* () : Frame;
  END Copy;

  PROCEDURE ( f : Frame ) Neutralize*;
  END Neutralize;

  PROCEDURE ( f : Frame ) HandleKey* ( ch : CHAR );
  END HandleKey;

  PROCEDURE ( f : Frame ) HandleMouse* ( x, y : INTEGER; buttons : SET );
  END HandleMouse;

  PROCEDURE ( f : Frame ) Handle* ( VAR m : OS.Message );
  END Handle;

  PROCEDURE ( f : Frame ) Modify* ( dy : INTEGER );
  BEGIN
  INC ( f.y, dy );
  DEC( f.h, dy )
  END Modify;

  PROCEDURE ( f : Frame ) Move* ( dy : INTEGER );
  BEGIN
  INC ( f.y, dy )
  END Move;

  PROCEDURE ( f : Frame ) Defocus*;
  BEGIN
  focus := NIL
  END Defocus;

  PROCEDURE ( f : Frame ) SetFocus*;
  BEGIN
  IF focus # NIL THEN
   focus.Defocus
  END;
  focus := f
  END SetFocus;

  PROCEDURE ( v : Viewer ) Erase ( h : INTEGER );
  BEGIN
  IF h > O THEN (* clear bottom block and draw Ieft and right border *)
   OS.EraseBlock ( v.x, v.y, v.w, h );
   OS.FillBlock ( v.x, v.y, 1, h );
   OS.FillBlock ( v.x + v.w - 1, v.y, 1, h )
  END;
  OS.FillBlock ( v.x, v.y, OS.screenW, 1 )
  END Erase;

  PROCEDURE ( v : Viewer ) FlipTitleBar;
  BEGIN
  OS.InvertBlock ( v.x + 1, v.y + v.h - barH, OS.screenW - 2, barH )
  END FlipTitleBar;

  PROCEDURE ( v : Viewer ) Neutralize*;
  BEGIN
  v.menu.Neutralize;
  v.cont.Neutralize
  END Neutralize;

  PROCEDURE ( v : Viewer ) Modify* ( dy : INTEGER );
  BEGIN
  v.Neutralize;
  v.ModifyA ( dy );
  v.Erase ( - dy + 1 );
  v.cont.Modify ( dy )
  END Modify;

  PROCEDURE ( v : Viewer ) Move* ( dy : INTEGER );
  BEGIN
  v.Neutralize;
  v.menu.Move ( dy );
  v.cont.Move ( dy );
  OS.CopyBlock ( v.x, v.y + 1, v.w, v.h - 1, v.x, v.y + dy + 1 );
  INC ( v.y, dy )
  END Move;

  PROCEDURE ( v : Viewer ) Draw*;
  BEGIN
  OS.FadeCursor;
  v.Erase ( v.h );
  v.menu.Draw;
  v.cont.Draw;
  v.FlipTitleBar
  END Draw;

  PROCEDURE ( v : Viewer ) HandleMouse* ( x, y : INTEGER; buttons: SET );
  VAR b : SET;
    x1, y1: INTEGER;
    dy, maxUp, maxDown: INTEGER;
  BEGIN
  OS.DrawCursor( x, y );
  IF y > v.menu.y THEN
   IF OS.left IN buttons THEN (* left click in menu bar => resize viewer *)
    (* ----- track mouse movements*)
    v.FlipTitleBar;
    REPEAT
     OS.GetMouse( b, x1, y1 );
     OS.DrawCursor( x1, y1 )
    UNTIL b = {};
    v.FlipTitleBar;
    (* ----- compute how far v can be moved up or down *)
    dy := y1 -y;
    maxDown := v.h - minH;
    IF v.next = NIL THEN
     maxUp := OS.screenH - v.y - v.h
    ELSE
     maxUp := v.next.h - minH;
     v.next.Neutralize
    END;
    IF dy < - maxDown THEN
     dy := - maxDown
    ELSIF dy > maxUp THEN
     dy := maxUp
    END;
    (* ----- move v up or down and adjust neighbor viewers *)
    OS.FadeCursor;
    v.Neutralize;
    IF dy < O THEN (* move down *)
     v.Modify ( - dy );
     v.Move ( dy )
    ELSE (* move up *)
     v.Move ( dy );
     v.Modify ( - dy )
    END;
    IF v.next # NIL THEN
     v.next.Modify ( dy )
    ELSE
     OS.EraseBlock ( v.x, v.y + v.h, v.w, OS.screenH - v.y - v.h )
    END
   ELSE
    v.menu.HandleMouse( x, y, buttons )
   END
  ELSE
   v.cont.HandleMouse ( x, y, buttons )
  END
  END HandleMouse;

  PROCEDURE ( v : Viewer ) Handle* ( VAR m : OS.Message );
  BEGIN
  v.menu.Handle ( m );
  v.cont.Handle ( m )
  END Handle;

  PROCEDURE ( v : Viewer ) Close*;
  VAR x: Viewer;
  BEGIN
  OS.FadeCursor;
  v.Neutralize;
  IF v.next # NIL THEN
   v.next.Modify ( - v.h )
  ELSE
   OS.EraseBlock ( v.x, v.y, v.w, v.h )
  END;
  IF viewers = v THEN
   viewers := v.next
  ELSE
   x := viewers;
   WHILE x.next # v DO
    x := x.next
   END;
   x.next := v.next
  END
  END Close;

  PROCEDURE ViewerAt* ( y : INTEGER ) : Viewer;
  VAR v : Viewer;
  BEGIN
  v := viewers;
  WHILE ( v # NIL ) & ( y > v.y + v.h ) DO
   v := v.next
  END;
  RETURN v
  END ViewerAt;

  PROCEDURE New* ( menu, cont : Frame ) : Viewer;
  VAR below, above, v, w: Viewer;
    top: INTEGER;
  BEGIN
  (* ----- compute position of new viewer *)
  IF ViewerAt ( OS.screenH ) = NIL THEN
   top := OS.screenH
  ELSE
   w := viewers;
   v := viewers.next;
   WHILE v # NIL DO
    IF v.h > w.h THEN
     w := v
    END;
    v := v.next
   END;
   top := w.y + w.h DIV 2
  END;
  (* ----- generate new viewer and link it into viewer list *)
  above := viewers;
  below := NIL;
  WHILE ( above # NIL ) & ( top > above.y + above.h ) DO
   below := above;
   above := above.next
  END;
  NEW(v);
  v.x := 0;
  v.w := OS.screenW;
  v.next := above;
  IF below = NIL THEN
   v.y := 0;
   v.h := top
  ELSE
   v.y := below.y + below.h;
   v.h := top -v.y
  END;
  IF v.h < minH THEN
   RETURN NIL
  END;
  v.menu := menu;
  v.cont := cont;
  menu.x := v.x + 1;
  menu.y := v.y + v.h - barH;
  menu.w := v.w - 2;
  menu.h := barH - 1;
  cont.x := v.x + 1;
  cont.y := v.y + 1;
  cont.w := v.w - 2;
  cont.h := menu.y - v.y - 1;
  IF below = NIL THEN
   viewers := v
  ELSE
   below.next := v
  END;
  IF above # NIL THEN
   above.Modify(v.h)
  END;
  v.Draw;
  RETURN v
  END New;

  PROCEDURE Broadcast* ( VAR m : OS.Message );
  VAR v : Viewer;
  BEGIN
  v := viewers;
  WHILE v # NIL DO
   v.Handle ( m );
   v := v.next
  END
  END Broadcast;

  PROCEDURE Close*;
  VAR x, y : INTEGER;
    buttons : SET;
    v : Viewer;
  BEGIN
  OS.GetMouse ( buttons, x, y );
  v := ViewerAt ( y );
  v.Close
  END Close;

  PROCEDURE Copy*;
  VAR v : Viewer;
    x, y : INTEGER;
    buttons : SET;
  BEGIN
  OS.GetMouse ( buttons, x, y );
  v := ViewerAt ( y );
  v := New ( v.menu.Copy (). v.cont.Copy ())
  END Copy;

  PROCEDURE Init;
  VAR f : OS.Font;
  BEGIN
  viewers := NIL;
  focus := NIL;
  f := OS.DefaultFont ();
  barH := f.height + 2;
  minH := barH + 2;
  END Init;

BEGIN (* Viewers0 *)
  Init
END Viewers0.

MODULE AsciiTexts;
  IMPORT OS, Viewers0;

  CONST minBufLen = 32;

  TYPE
  Buffer = POINTER TO ARRAY OF CHAR;
  Text* = POINTER TO TextDesc;
  TextDesc* = RECORD ( OS.ObjectDesc )
   Len- : LONGINT; (* text length *)
   pos- : LONGINT; (* read/write position *)
   buf : Buffer; (* text buffer *)
   gap : LONGINT (* index of first byte in gap *)
  END;

  NotifyInsMsg* = RECORD ( OS.Message )
   t* : Text;
   beg*, end* : LONGINT
  END;

  NotifyDelMsg* = RECORD ( OS.Message )
   t* : Text;
   beg*, end* : LONGINT
  END;

  PROCEDURE ( t : Text ) MoveGap ( to : LONGINT );
  VAR n, gapLen : LONGINT;
  BEGIN
  n := ABS ( to - t.gap );
  gapLen := LEN ( t.buf^ ) - t.len;
  IF to > t.gap THEN
   OS.Move ( t.buf^, t.gap + gapLen, t.buf^, t.gap, n )
  ELSIF to < t.gap THEN
   OS.Move ( t.buf^, t.gap - n, t.buf^, t.gap + gapLen - n, n )
  END;
  t.gap := to
  END MoveGap;

  PROCEDURE ( t : Text ) Grow ( size : LONGINT );
  VAR bufLen : LONGINT; old : Buffer;
  BEGIN
  bufLen := LEN ( t.buf^ );
  IF size > bufLen THEN
   t.MoveGap ( t.len );
   WHILE bufLen < size DO
    bufLen := 2 * bufLen
   END;
   old := t.buf;
   NEW ( t.buf, bufLen );
   OS.Move ( old^, 0, t.buf^, 0, t.len )
  END
  END Grow;

  PROCEDURE ( t : Text ) Shrink;
  VAR bufLen : LONGINT;
    old : Buffer;
  BEGIN
  bufLen := LEN ( t.buf^ );
  t.MoveGap ( t.len );
  WHILE ( bufLen >= 2 * t.len ) & ( bufLen > minBufLen ) DO
   bufLen := bufLen DIV 2
  END;
  old := t.buf;
  NEW( t.buf, bufLen );
  OS.Move( old^, 0, t.buf^, 0, t.len )
  END Shrink;

  PROCEDURE ( t : Text ) Clear*;
  BEGIN
  NEW( t.buf, minBufLen );
  t.gap := 0;
  t.pos := 0;
  t.len := 0
  END Clear;

  PROCEDURE ( t : Text ) Insert* ( at : LONGINT; t1 : Text; 
				   beg, end : LONGINT );
  VAR len : LONGINT;
    rn : NotifylnsMsg; t0: Text;
  BEGIN
  IF t = t1 THEN
   NEW ( t0 );
   t0.Clear;
   t0.Insert ( 0, t1, beg, end );
   t.Insert( at, t0, 0, t0.len )
  ELSE
   len := end - beg;
   IF t.len + len > LEN ( t.buf^ ) THEN
    t.Grow ( t.len + len )
   END;
   t.MoveGap ( at );
   t1.MoveGap ( end );
   OS.Move ( t1.buf^, beg, t.buf^, t.gap, len );
   INC ( t.gap, len );
   INC ( t.len, len );
   m.t := t;
   m.beg := at;
   m.end := at + len;
   Viewers0.Broadcast ( m )
  END
  END Insert;

  PROCEDURE ( t : Text ) Delete* ( beg, end : LONGINT );
  VAR rn : NotifyDelMsg;
  BEGIN
  t.MoveGap ( end );
  t.gap := beg;
  DEC ( t.len, end - beg );
  IF ( t.len * 2 < LEN ( t.buf^ )) & ( LEN ( t.buf^ ) > minBufLen ) THEN
   t.Shrink
  END;
  m.t := t;
  m.beg := beg;
  m.end := end;
  Viewers0.Broadcast ( m )
  END Delete;

  PROCEDURE ( t : Text ) SetPos* ( pos : LONGINT );
  BEGIN
  t.pos := pos
  END SetPos;

  PROCEDURE ( t : Text ) Read* ( VAR ch : CHAR );
  VAR i : LONGINT;
  BEGIN
  i := t.pos;
  IF t.pos >= t.gap THEN
   INC ( i, LEN ( t.buf^ ) - t.len )
  END;
  IF t.pos < t.len THEN
   ch := t.buf [ i ];
   INC ( t.pos )
  ELSE
   ch := 0X
  END
  END Read;

  PROCEDURE ( t : Text ) Write* ( ch : CHAR );
  VAR rn : NotifyInsMsg;
  BEGIN
  IF t.len = LEN ( t.buf^ ) THEN
   t.Grow ( t.len + 1 )
  END;
  IF t.pos # t.gap THEN
   t.MoveGap ( t.pos )
  END;
  t.buf [ t.gap ] := ch;
  INC ( t.gap );
  INC ( t.pos );
  INC ( t.len );
  m.t := t;
  m.beg := t.gap - 1;
  m.end := t.gap;
  Viewers0.Broadcast ( m )
  END Write;

  PROCEDURE ( t : Text ) Load* ( VAR r : OS.Rider );
  VAR len : LONGINT;
  BEGIN
  t.Clear;
  r.ReadLInt ( len );
  t.Grow ( len );
  r.ReadChars ( t.buf^, len);
  t.gap := len;
  t.len := len
  END Load;

  PROCEDURE ( t : Text) Store* ( VAR r : OS.Rider );
  BEGIN
  t.MoveGap ( t.len );
  r.WriteLInt ( t.len );
  r.WriteChars ( t.buf^, t.len )
  END Store;

END AsciiTexts.

MODULE Texts0;
  IMPORT OS, AsciiTexts, Viewers0;

  CONST ELEM = 1CX;

  TYPE
  Element* = POINTER TO ElemDesc;
  Attribute* = POINTER TO AttrDesc;

  Text* = POINTER TO TextDesc;
  TextDesc* = RECORD ( AsciiTexts.TextDesc )
   attr- : Attribute; (* attributes of previously read character *)
   firstAttr : Attribute; (* to attribute first (first node is dummy) *)
   attrRes t: LONGINT (* unread bytes in current attribute segment *)
  END;

  AttrDesc* = RECORD
   len : LONGINT; (* length of attribute segment *)
   fnt- : OS.Font; (* font of this attribute segment *)
   elem- : Element; (* pointer to element descriptor or NIL *)
   next : Attribute
  END;

  ElemDesc* = RECORD ( OS.ObjectDesc )
   w*, h* : INTEGER; (* width and height in pixels *)
   dsc* : INTEGER (* descender (part under the base fine) *)
  END;

  NotifyInsMsg* = AsciiTexts.NotifyInsMsg;
  NotifyDelMsg* = AsciiTexts.NotityDelMsg;

  NotifyReplMsg* = RECORD ( OS.Message )
   t* : Text;
   beg*, end* : LONGINT
  END;

  PROCEDURE ( e : Element ) Draw* ( x, y : INTEGER );
  END Draw;

  PROCEDURE ( e : Element ) HandleMouse* ( f : OS.Object; x, y : INTEGER );
  END HandleMouse;

  PROCEDURE ( e : Element ) Copy* () : Element;
  END Copy;

  PROCEDURE ( e : Element ) Load* ( VAR r : OS.Rider );
  BEGIN
  r.ReadInt ( e.w );
  r.ReadInt ( e.h );
  r.ReadInt ( e.dsc )
  END Load;

  PROCEDURE ( e : Element ) Store* ( VAR r : OS.Rider );
  BEGIN
  r.WriteInt ( e.w );
  r.WriteInt ( e.h );
  r.WriteInt ( e.dsc )
  END Store;

  PROCEDURE ( t : Text ) Split ( pos : LONGINT; VAR prev : Attribute );
  VAR a, b : Attribute;
  BEGIN
  a := t.firstAttr;
  WHILE ( a # NIL ) & ( pos >= a.len ) DO
   DEC ( pos, a.len );
   prev := a;
   a := a.next
  END;
  IF ( a # NIL ) & ( pos > 0 ) THEN
   NEW ( b );
   b.elem := a.elem;
   b.fnt := a.fnt;
   b.len := a.len - pos;
   a.len := pos;
   b.next := a.next;
   a.next := b;
   prev := a
  END
  END Split;

  PROCEDURE ( t : Text ) Merge ( a : Attribute );
  VAR b : Attribute;
  BEGIN
  b := a.next;
  IF ( b # NIL ) & ( a.fnt = b.fnt ) & ( a.len > 0 ) & 
     ( a.elem = NIL ) & ( b.elem = NIL ) THEN
   INC ( a.len, b.len );
   a.next := b.next
  END
  END Merge;

  PROCEDURE ( t : Text ) Insert* ( at : LONGINT; t1 : AsciiTexts.Text; 
				   beg, end : LONGINT );
  VAR a, b, c, d, i, j, k : Attribute;
    t0 : Text;
  BEGIN
  IF t = t1 THEN
   NEW(t0);
   t0.Clear;
   t0.Insert ( 0, t1, beg, end );
   t.Insert ( at, t0, 0, t0.len )
  ELSE
   WITH t1 : Text DO
    t1.Split ( beg, a );
    t1.Split ( end, b );
    t.Split ( at, c );
    d := c.next;
    i := a;
    j := c;
    WHILE i # b DO
     i := i.next;
     NEW ( k );
     k^ := i^;
     IF i.elem # NIL THEN
      k.elem := i.elem.Copy()
     END;
     j.next := k;
     j := k
    END;
    j.next := d;
    t1.Merge ( b );
    t1.Merge ( a );
    t.Merge ( j );
    t.Merge ( c );
    t.Insert^ ( at, t1 , beg, end )
   END
  END
  END Insert;

  PROCEDURE ( t : Text ) Delete* ( beg, end : LONGINT );
  VAR a, b : Attribute;
  BEGIN
  t.Split ( beg, a );
  t.Split ( end, b );
  a.next := b.next;
  t.Merge ( a );
  t.Delete^ ( beg, end )
  END Delete;

  PROCEDURE ( t : Text ) SetPos* ( pos : LONGINT );
  VAR prev, a: Attribute;
  BEGIN
  t.SetPos^ ( pos );
  a := t.firstAttr;
  WHILE ( a # NIL ) & ( pos >= a.len ) DO
   DEC ( pos, a.len );
   prev := a;
   a := a.next
  END;
  IF ( a = NIL ) OR ( pos = 0 ) THEN
   t.attr := prev;
   t.attrRest := 0
  ELSE
   t.attr := a;
   t.attrRest := a.len - pos
  END
  END SetPos;

  PROCEDURE ( t : Text ) Read* ( VAR ch: CHAR );
  BEGIN
  t.Read^ ( ch );
  IF ( t.attrRest = 0 ) & ( t.attr.next # NIL ) THEN
   t.attr := t.attr.next;
   t.attrRest := t.attr.len
  END;
  DEC ( t.attrRest )
  END Read;

  PROCEDURE ( t : Text ) Write* ( ch : CHAR );
  VAR a, prev : Attribute;
    at : LONGINT;
  BEGIN
  a := t.firstAttr;
  at := t.pos;
  WHILE ( a # NIL ) & ( at >= a.len ) DO
   DEC ( at, a.len );
   prev := a;
   a := a.next
  END;
  IF ( a = NIL ) OR ( at = 0 ) THEN (* insert at end of attribute segment *)
   IF ( prev = t.firstAttr ) OR ( prev.elem # NIL ) THEN
    NEW ( a );
    a.elem := NIL;
    a.fnt := prev.fnt;
    a.len := 1;
    a.next := prev.next;
    prev.next := a;
    t.Merge( a )
   ELSE
    INC ( prev.len )
   END
  ELSE
   INC ( a.len )
  END;
  t.Write^ ( ch )
  END Write;

  PROCEDURE ( t : Text ) ReadNextElem* ( VAR e : Element );
  VAR pos : LONGINT;
    a : Attribute;
  BEGIN
  pos := t.pos + t.attrRest;
  a := t.attr.next;
  WHILE ( a # NIL ) & ( a.elem = NIL ) DO
   pos := pos + a.len;
   a := a.next
  END;
  IF a # NIL THEN
   e := a.elem;
   t.SetPos( pos + 1 )
  ELSE
   e := NIL;
   t.SetPos ( t.len )
  END
  END ReadNextElem;

  PROCEDURE ( t : Text ) WriteElem* ( e : Element );
  VAR x, y : Attribute;
    m : NotifyReplMsg;
  BEGIN
  t.Write ( ELEM );
  t.Split ( t.pos - 1, x);
  t.Split ( t.pos, y );
  y.elem := e;
  m.t := t;
  m.beg := t.pos - 1;
  m.end := t.pos;
  Viewers0.Broadcast( m )
  END WriteElem;

  PROCEDURE ( t : Text ) ElemPos* ( e : Element ) : LONGINT;
  VAR pos : LONGINT;
    a: Attribute;
  BEGIN
  a := t.firstAttr;
  pos := 0;
  WHILE ( a # NIL ) & ( a.elem # e ) DO
   pos := pos + a.len;
   a := a.next
  END;
  RETURN pos
  END ElemPos;

  PROCEDURE ( t : Text ) ChangeFont* ( beg, end: LONGINT; fnt : OS.Font );
  VAR a, b : Attribute;
  m : NotifyReplMsg;

  PROCEDURE Change( a : Attribute );
  BEGIN
   a.fnt := fnt;
   IF a # b THEN
    Change ( a.next )
   END;
   t.Merge ( a )
  END Change;

  BEGIN
  IF end > beg THEN
   t.Split ( beg, a );
   t.Split ( end, b );
   Change ( a.next );
   t.Merge ( a );
   m.t := t;
   m.beg := beg;
   m.end := end;
   Viewers0.Broadcast ( m )
  END
  END ChangeFont;

  PROCEDURE ( t : Text ) Clear*;
  BEGIN
  t.Clear^;
  NEW ( t.firstAttr );
  t.firstAttr.elem := NIL;
  t.firstAttr.next := NIL;
  t.firstAttr.fnt := OS.DefaultFont ();
  t.firstAttr.len := 0;
  t.SetPos ( 0 )
  END Clear;

  PROCEDURE ( t : Text ) Store* ( VAR r : OS.Rider );
  VAR a : Attribute;
  BEGIN
  t.Store^ ( r );
  a := t.firstAttr.next;
  WHILE a # NIL DO
   r.WriteString ( a.fnt.name );
   r.WriteObj ( a.elem );
   r.WriteLInt ( a.len );
   a := a.next
  END;
  r.Write ( 0X ) (*empty font name terminates attribute list *)
  END Store;

  PROCEDURE ( t : Text) Load* ( VAR r : OS.Rider );
  VAR prev, a: Attribute;
    name: ARRAY 32 OF CHAR;
    x : OS.Object;
  BEGIN
  t.Load^ ( r );
  prev := t.firstAttr;
  LOOP
   r.ReadString ( name );
   IF name = "" THEN
    EXIT
   END;
   NEW ( a );
   a.fnt := OS.FontWithName ( name );
   r.ReadObj ( x );
   r.ReadLInt( a.len );
   IF x = NIL THEN
    a.elem := NIL
   ELSE
    a.elem := x ( Element )
   END;
   prev.next := a;
   prev := a
  END;
  prev.next := NIL
  END Load;

END Texts0.

MODULE TextFrames0;
  IMPORT OS, Viewers0, Texts0;

  CONST
  EOL = 0DX;  (* end of line character *)
  DEL = 7FX;  (* delete character *)
  scrollW = 12; (* width of scroll bat *)

  TYPE
  Line = POINTER TO LineDesc;
  LineDesc = RECORD
   len, wid, asc, dsc : INTEGER; (* length, width, ascender, descendet *)
   eol : BOOLEAN;      (* TRUE if line is terminated with EOL *)
   next: Line
  END;

  Position* = RECORD (* position of a character c on the screen*)
   x-, y-, dx- : INTEGER; (* (x,y) = left point on base line; 
			     dx = width of c *)
   org-, pos- : LONGINT;  (* origin of line containing c; text position of c *)
   L : Line (* line containing c *)
  END;

  Frame* = POINTER TO FrameDesc;
  FrameDesc* = RECORD ( Viewers0.FrameDesc )
   text* : Texts0.Text;
   org- : LONGINT;     (* index of first character in the frame *)
   caret- : Position;    (* caret; visible if caret.pos >= 0 *)
   selBeg-, selEnd- : Position; (* selection; visible if selBeg.pos >= 0 *)
   seiTime : LONGINT;    (* time stamp of selection *)
   lsp : INTEGER;     (* space between lines *)
   margin : INTEGER;    (* space between frame border and text *)
   lines : Line      (* list of lines in frame (first line in dummy) *)
  END;

  SelectionMsg = RECORD ( OS.Message )
   f : Frame
  END;

  VAR
  cmdFrame- : Frame; (* frame containing the most recent command *)
  cmdPos- : LONGINT; (*text position after the most recent command*)

  PROCEDURE GetMetric ( at : Texts0.Attribute; 
  ch : CHAR; VAR dx, x, y, asc, dsc : INTEGER; VAR pat : OS.Pattern);
  VAR w, h : INTEGER;
  BEGIN
  IF at.elem = NIL THEN
   OS.GetCharMetric ( at.fnt, ch, dx, x, y, w, h, pat );
   asc := at.fnt.maxY;
   dsc := - at.fnt.minY
  ELSE
   dx := at.elem.w;
   x := 0;
   y := 0;
   dsc := at.elem.dsc;
   asc := at.elem.h - dsc
  END
  END GetMetric;

  PROCEDURE MeasureLine ( t : Texts0.Text; VAR L : Line);
  VAR ch : CHAR;
  dx, x, y, asc, dsc : INTEGER;
  pat : OS.Pattern;
  BEGIN
  L.len := 0;
  L.wid := 0;
  L.asc := 0;
  L.dsc := 0;
  ch := " ";
  WHILE ( ch # EOL ) & ( t.pos < t.len ) DO
   t.Read ( ch );
   INC ( L.len );
   GetMetric ( t.attr, ch, dx, x, y, asc, dsc, pat );
   INC ( L.wid, dx );
   IF asc > L.asc THEN
    L.asc := asc
   END;
   IF dsc > L.dsc THEN
    L.dsc := dsc
   END
  END;
  L.eol := ch = EOL
  END MeasureLine;

  PROCEDURE DrawLine ( t : Texts0.Text; len, left, right, base : INTEGER );
  VAR ch : CHAR; dx, X, y, w, h : INTEGER;
    pat : OS.Pattern;
  BEGIN
  WHILE len > 0 DO
   t.Read ( ch );
   DEC ( len );
   IF t.attr.elem = NIL THEN
    OS.GetCharMetric ( t.attr.fnt, ch, dx, x, y, w, h, pat );
    IF left + dx < right THEN
     OS.DrawPattern ( pat, left + x, base + y )
    END
   ELSE
    dx := t.attr.elem.w;
    IF left + dx < right THEN
     t.attr.elem.Draw ( left, base )
    END
   END;
   INC ( left, dx )
  END
  END DrawLine;

  PROCEDURE ( f : Frame ) FlipCaret;
  BEGIN
  OS.DrawPattern ( OS.Caret, f.caret.x, f.caret.y - 10 )
  END FlipCaret;

  PROCEDURE ( f : Frame) FlipSelection ( a, b : Position );
  VAR x, y : INTEGER;
    L : Line;
  BEGIN
  L := a.L;
  x := a.x;
  y := a.y - L.dsc;
  WHILE L # b.L DO
   OS.InvertBlock ( x, y, f.x + f.w - x, L.asc + L.dsc );
   L := L.next;
   x := f.x + scrolIW + f.margin;
   y := y - f.lsp - L.asc - L.dsc
  END;
  OS.InvertBlock ( x, y, b.x - x, L.asc + L.dsc )
  END FlipSelection;

  PROCEDURE ( f : Frame ) RedrawFrom ( top : INTEGER );
  VAR t : Texts0.Text;
    L, L0 : Line;
    y: INTEGER;
    org: LONGINT;
  BEGIN
  (* ----- find first line to be redrawn *)
  y := f.y + f.h - f.margin;
  org := f.org;
  L0 := f.lines;
  L := L0.next;
  WHILE ( L # f.lines ) & ( y - L.asc - L.dsc >= top ) DO
   DEC ( y, L.asc + L.dsc + f.lsp );
   org := org + L.len;
   L0 := L;
   L := L.next
  END;
  IF y > top THEN
   top := y
  END;
  OS.FadeCursor;
  OS.EraseBlock ( f.x, f.y, f.w, top - f.y );
  IF f.margin > 0 THEN (* draw scroll bar *)
   OS.InvertBlock ( f.x + scrollW, f.y, 1 , top - f.y )
  END;
  (* ----- redraw lines and rebuild line descriptors;
  L0 is last valid line descriptor *)
  t := f.text;
  LOOP
   NEW ( L );
   t.SetPos ( org );
   MeasureLine ( t, L );
   IF ( L.len = 0 ) OR ( y - L.asc - L.dsc < f.y + f.margin ) THEN
    EXIT
   END;
   t.SetPos ( org );
   DrawLine ( t, L.len, f.x + scrollW + f.margin, f.x + f.w - f.margin, 
	      y - L.asc );
   org := org + L.len;
   DEC ( y, L.asc + L.dsc + f.lsp);
   L0.next := L;
   L0 := L;
   IF t.pos >= t.len THEN
    EXIT
   END
  END;
  L0.next := f.lines
  END RedrawFrom;

  PROCEDURE ( f : Frame ) GetPointPos ( x0, y0 : INTEGER; VAR p : Position );
  VAR t : Texts0.Text;
    ch: CHAR;
    L: Line;
    dx, x, y, asc, dsc: INTEGER;
    pat: OS.Pattern;
  BEGIN
  (* ----- find line containing y0 *)
  L := f.lines.next;
  p.y := f.y + f.h - f.margin;
  p.org := f.org;
  WHILE ( L # f.lines ) & ( y0 < p.y - L.asc - L.dsc - f.lsp ) & L.eol DO
   DEC ( p.y, L.asc + L.dsc + f.lsp );
   p.org := p.org + L.len;
   L := L.next
  END;
  DEC ( p.y, L.asc );
  (* ----- find character containing x0 *)
  p.x := f.x + scrollW + f.margin;
  p.L := L;
  p.pos := p.org;
  t := f.text;
  t.SetPos ( p.pos );
  LOOP
   IF p.pos >= t.len THEN
    p.dx := 0;
    EXIT
   END;
   t.Read ( ch );
   GetMetric ( t.attr, ch, dx, x, y, asc, dsc, pat );
   IF ( ch = EOL ) OR ( p.x + dx > x0 ) THEN
    p.dx := dx;
    EXIT
   ELSE
    INC ( p.pos );
    INC ( p.x, dx )
   END;
  END
  END GetPointPos;

  PROCEDURE ( f : Frame ) GetCharPos ( pos : LONGINT; VAR p : Position );
  VAR t : Texts0.Text;
    ch : CHAR;
    L : Line;
    dx, x, y, asc, dsc : INTEGER;
    pat : OS.Pattern;
    i : LONGINT;
  BEGIN
  (* ----- find line containing pos *)
  L := f.lines.next;
  p.y := f.y + f.h - f.margin;
  p.org := f.org;
  p.pos := pos;
  WHILE ( L # f.lines ) & ( pos >= p.org + L.len ) & L.eol DO
   p.org := p.org + L.len;
   DEC ( p.y, L.asc + L.dsc + f.lsp );
   L := L.next
  END;
  DEC ( p.y, L.asc );
  p.L := L;
  (* ----- find character at pos *)
  p.x := f.x + scrollW + f.margin;
  t := f.text;
  t.SetPos ( p.org );
  FOR i := 1 TO p.pos - p.org DO
   t.Read ( ch ); GetMetric ( t.attr, ch, dx, x, y, asc, dsc, pat );
   INC ( p.x, dx )
  END;
  IF t.pos >= t.len THEN
   p.dx := 0
  ELSE
   t.Read ( ch );
   GetMetric ( t.attr, ch, p.dx, x, y, asc, dsc, pat )
  END
  END GetCharPos;

  PROCEDURE ( f : Frame ) CallCommand;
  VAR x, y, i : INTEGER;
    buttons : SET;
    p : Position;
    t : Texts0.Text;
    ch : CHAR;
    cmd : ARRAY 64 OF CHAR;
  BEGIN
  REPEAT
   OS.GetMouse ( buttons, x, y )
  UNTIL buttons = {};
  f.GetPointPos ( x, y, p );
  t := f.text;
  t.SetPos ( p.org );
  t.Read ( ch );
  REPEAT
   WHILE ( t.pos < t.len ) & ( ch # EOL ) & (( CAP ( ch ) < "A" ) 
   OR ( CAP ( ch ) > "Z" )) DO
    t.Read(ch)
   END;
   i := 0;
   WHILE ( CAP ( ch ) >= "A" ) & ( CAP ( ch ) <= "Z" ) 
   OR ( ch >= "0" ) & ( ch <= "9" ) OR ( ch = "." ) DO
    cmd [ i ] := ch;
    INC ( i );
    t.Read ( ch )
   END;
   cmd [ i ] := 0X;
  UNTIL ( t.pos >= t.len ) OR ( ch = EOL ) OR ( t.pos > p.pos );
  cmdFrame := f;
  cmdPos := t.pos;
  OS.Call ( cmd )
  END CallCommand;

  PROCEDURE ( f : Frame ) RemoveCaret*;
  BEGIN
  IF f.caret.pos >= 0 THEN
   f.FlipCaret;
   f.caret.pos := - 1
  END
  END RemoveCaret;

  PROCEDURE ( f : Frame ) SetCaret* ( pos : LONGINT );
  VAR p : Position;
  BEGIN
  IF pos < O THEN
   pos := O
  ELSIF pos > f.text.len THEN
   pos := f.text.len
  END;
  f.SetFocus;
  f.GetCharPos ( pos, p );
  IF p.x < f.x + f.w - f.margin THEN
   f.caret := p;
   f.FlipCaret
  END
  END SetCaret;

  PROCEDURE ( f : Frame) RemoveSelection*;
  BEGIN
  IF f.selBeg.pos >= O THEN
   f.FlipSelection ( f.selBeg, f.selEnd);
   f.selBeg.pos := - 1
  END
  END RemoveSelection;

  PROCEDURE ( f : Frame ) SetSelection* ( from, to : LONGINT );
  BEGIN
  f.RemoveSelection;
  f.GetCharPos ( from, f.selBeg );
  f.GetCharPos ( to, f.selEnd );
  f.FlipSelection ( f.selBeg, f.selEnd);
  f.selTime := OS.Time ()
  END SetSelection;

  PROCEDURE ( f : Frame ) Defocus*;
  BEGIN
  f.RemoveCaret;
  f.Defocus^
  END Defocus;

  PROCEDURE ( f : Frame ) Neutralize*;
  BEGIN
  f.RemoveCaret;
  f.RemoveSelection
  END Neutralize;

  PROCEDURE ( f : Frame ) Draw*;
  BEGIN
  f.RedrawFrom ( f.y + f.h )
  END Draw;

  PROCEDURE ( f : Frame ) Modify* ( dy : INTEGER);
  VAR y : INTEGER;
  BEGIN
  y := f.y;
  f.Modify^ ( dy );
  IF y > f.y THEN
   f.RedrawFrom ( y )
  ELSE
   f.RedrawFrom ( f.y )
  END
  END Modify;

  PROCEDURE ( f : Frame ) HandleMouse* ( x, y : INTEGER; buttons : SET );
  VAR p : Position;
    b : SET;
    t : Texts0.Text;
    ch : CHAR;
    f1 : Frame;
  BEGIN
  f.HandleMouse^ ( x, y, buttons );
  t := f.text;
  IF ( x < f.x + scrollW ) & ( buttons # {} ) 
  THEN (* handle click in scroll bar *)
   REPEAT
    OS.GetMouse ( b, x, y );
    buttons := buttons + b
   UNTIL b = {};
   f.Neutralize;
   IF OS.left IN buttons THEN
    f.GetPointPos ( x, y, p );
    f.org := p.org
   ELSIF OS.right IN buttons THEN
    f.org := O
   ELSIF OS.middle IN buttons THEN
    t.SetPos (( f.y + f.h - y ) * f.text.len DIV f.h );
    REPEAT
     t.Read ( ch )
    UNTIL ( ch = EOL ) OR ( t.pos >= t.len );
    f.org := t.pos
   END;
   f.RedrawFrom ( f.y + f.h )
  ELSE (* handle click in text area *)
   f.GetPointPos ( x, y, p );
   IF OS.left IN buttons THEN
    IF p.pos # f.caret.pos THEN
     f.SetCaret ( p.pos )
    END
   ELSIF OS.middle IN buttons THEN
    t.SetPos ( p.pos );
    t.Read ( ch );
    IF t.attr.elem = NIL THEN
     f.CallCommand
    ELSE
     t.attr.elem.HandleMouse ( f, x, y )
    END
   ELSIF OS.right IN buttons THEN
    f.RemoveSelection;
    f.selBeg := p;
    f.selEnd := p;
    f.selTime := OS.Time ();
    LOOP
     OS.GetMouse ( b, x, y );
     buttons := buttons + b;
     IF b = {} THEN
      EXIT
     END;
     OS.DrawCursor ( x, y );
     f.GetPointPos ( x, y, p );
     IF p.pos < f.selBeg.pos THEN
      p := f.selBeg
     END;
     IF p.pos < t.len THEN
      INC ( p.pos );
      INC ( p.x, p.dx )
     END;
     IF p.pos # f.selEnd.pos THEN
      IF p.pos > f.selEnd.pos THEN
       f.FlipSelection ( f.selEnd, p )
      ELSE
       f.FlipSelection ( p, f.selEnd )
      END;
      f.selEnd := p
     END
    END;
    (* ----- check for right-left or right-middle click *)
    IF OS.left IN buttons THEN
     t.Delete ( f.selBeg.pos, f.selEnd.pos )
    ELSIF ( OS.middle IN buttons ) & ( Viewers0.focus # NIL ) 
	& ( Viewers0.focus IS Frame ) THEN
     f1 := Viewers0.focus ( Frame );
     IF f1.caret.pos >= O THEN
      f1.text.Insert ( f1.caret.pos, t, f.selBeg.pos, f.selEnd.pos )
     END
    END
   END
  END
  END HandleMouse;

  PROCEDURE ( f : Frame) HandleKey* ( ch : CHAR );
  VAR pos : LONGINT;
  BEGIN
  pos := f.caret.pos;
  IF pos >= O THEN
   IF ch = DEL THEN
    IF pos > O THEN
     f.text.Delete ( pos - 1, pos );
     f.SetCaret ( pos - 1 )
    END
   ELSE
    f.text.SetPos ( pos );
    f.text.Write ( ch );
    f.SetCaret ( pos + 1 )
   END
  END
  END HandleKey;

  PROCEDURE ( f : Frame ) Handle* ( VAR m : OS.Message );
  VAR t : Texts0.Text;
    ch: CHAR;
    dx, x, y, asc, dsc : INTEGER;
    pat: OS.Pattern; p: Position;
  BEGIN
  t := f.text;
  WITH m : Texts0.NotifyInsMsg DO
   IF m.t = t THEN
    IF m.beg < f.org THEN
     f.org := f.org + ( m.end - m.beg )
    ELSE
     f.Neutralize;
     OS.FadeCursor;
     f.GetCharPos ( m.beg, p );
     t.SetPos ( m.beg );
     t.Read ( ch );
     GetMetric ( t.attr, ch, dx, x, y, asc, dsc, pat );
     IF ( m.end = m.beg + 1 ) & ( ch # EOL ) & ( p.L # f.lines )
	 & ( asc + dsc <= p.L.asc + p.L.dsc ) THEN
      IF p.x + dx <= f.x + f.w - f.margin THEN
       OS.CopyBlock ( p.x, p.y - p.L.dsc, f.x + f.w - f.margin - dx - p.x,
           p.L.asc + p.L.dsc, p.x + dx, p.y - p.L.dsc );
       OS.EraseBlock ( p.x, p.y - p.L.dsc, dx, p.L.asc + p.L.dsc );
       IF t.attr.elem = NIL THEN
        OS.DrawPattern ( pat, p.x + x, p.y + y )
       ELSE
        t.attr.elem.Draw ( p.x, p.y )
       END
      ELSE
       OS.EraseBlock( p.x, p.y - p.L.dsc, f.x + f.w - p.x, 
		      p.L.asc + p.L.dsc )
      END;
      INC ( p.L.len );
      INC ( p.L.wid, dx )
     ELSE
      f.RedrawFrom ( p.y + p.L.asc )
     END
    END
   END
  | m : Texts0.NotifyDelMsg DO
   IF m.t = t THEN
    IF m.end <= f.org THEN
     f.org := f.org - ( m.end - m.beg )
    ELSE
     f.Neutralize;
     IF m.beg < f.org THEN
      f.org := m.beg;
      f.RedrawFrom ( f.y + f.h )
     ELSE
      f.GetCharPos ( m.beg, p );
      f.RedrawFrom ( p.y + p.L.asc )
     END
    END
   END
  | m : Texts0.NotifyReplMsg DO
   IF ( m.t = t ) & ( m.end > f.org ) THEN
    f.Neutralize;
    IF m.beg < f.org THEN
     m.beg := f.org
    END;
    f.GetCharPos ( m.beg, p );
    f.RedrawFrom ( p.y + p.L.asc )
   END
  | m: SelectionMsg DO
   IF ( f.selBeg.pos >= 0 ) & (( m.f = NIL ) OR 
   ( m.f.selTime < f.selTime )) THEN
    m.f := f
   END
  ELSE
  END
  END Handle;

  PROCEDURE New* ( t : Texts0.Text ) : Frame;
  VAR f : Frame;
    fnt : OS.Font;
  BEGIN
  NEW ( f );
  f.text := t;
  f.org := 0;
  f.caret.pos := - 1;
  f.selBeg.pos := - 1;
  f.lsp := 2;
  f.margin := 5;
  NEW ( f.lines );
  f.lines.next := f.lines;
  fnt := OS.DefaultFont ();
  f.lines.asc := fnt.maxY;
  f.lines.dsc := - fnt.minY;
  f.lines.len := 0;
  RETURN f
  END New;

  PROCEDURE NewMenu* ( name, menu : ARRAY OF CHAR ) : Frame;
  VAR t : Texts0.Text;
    f : Frame;
    i : INTEGER;
  BEGIN
  NEW ( t );
  t.Clear;
  i := 0;
  WHILE name [ i ] # 0X DO t.Write ( name [ i ] );
   INC(i)
  END;
  t.Write ( " " );
  t.Write ( "|" );
  t.Write ( " " );
  i := 0;
  WHILE menu [ i ] # 0X DO
   t.Write ( menu [ i ] );
   INC ( i )
  END;
  f := New ( t );
  f.margin := 0;
  RETURN f
  END NewMenu;

  PROCEDURE ( f : Frame ) Copy* (): Viewers0.Frame;
  VAR f1 : Frame;
  BEGIN
  f1 := New ( f.text );
  f1.margin := f.margin;
  RETURN f1
  END Copy;

  PROCEDURE GetSelection* ( VAR f : Frame );
  VAR m : SelectionMsg;
  BEGIN
  m.f := NIL;
  Viewers0.Broadcast ( m );
  f := m.f
  END GetSelection;

END TextFrames0.

MODULE Edit0;
  IMPORT OS, IO, TextFrames0, Texts0, Viewers0;

  PROCEDURE Open*;
  VAR s : IO.Scanner;
    t : Texts0.Text;
    menu, cont : TextFrames0.Frame;
    v : Viewers0.Viewer;
    f : OS.File;
    r : OS.Rider;
  BEGIN
  s.SetToParameters;
  s.Read;
  IF s.class = IO.name THEN
   menu := TextFrames0.NewMenu ( s.str, 
			        "Viewers0.Close Viewers0.Copy Edit0.Store" );
   NEW( t );
   f := OS.OldFile ( s.str );
   IF f = NIL THEN
    t.Clear
   ELSE
    OS.InitRider ( r );
    r.Set ( f, 0 );
    t.Load ( r )
   END;
   cont := TextFrames0.New ( t );
   v := Viewers0.New ( menu, cont )
  END
  END Open;

  PROCEDURE Store*;
  VAR v : Viewers0.Viewer;
    s : IO.Scanner;
    f : OS.File;
    r : OS.Rider;
  BEGIN
  v := Viewers0.ViewerAt ( TextFrames0.cmdFrame.y );
  s.Set ( v.menu ( TextFrames0.Frame ).text, 0 );
  s.Read; (* read viewer name*)
  IF s.class = IO.name THEN
   v.Neutralize;
   f := OS.NewFile ( s.str );
   OS.InitRider ( r );
   r.Set ( f, 0 );
   v.cont ( TextFrames0.Frame ).text.Store ( r );
   OS.Register ( f )
  END
  END Store;

  PROCEOURE ChangeFont*;
  VAR s : IO.Scanner;
    f : TextFrames0.Frame;
  BEGIN
  s.SetToParameters;
  s.Read;
  TextFrames0.GetSelection ( f );
  IF ( f # NIL ) & ( s.class = IO.name ) THEN
   f.text.ChangeFont ( f.selBeg.pos, f.selEnd.pos, OS.FontWithName ( s.str ))
  END
  END ChangeFont;
END Edit0.

MODULE Shapes0;
  IMPORT OS, Viewers0;

  TYPE
  Shape* = POINTER TO ShapeDesc;
  ShapeDesc* = RECORD ( OS.ObjectDesc )
   selected* : BOOLEAN; (* TRUE: shape is selected *)
   next : Shape
  END;

  Graphic* = POINTER TO GraphicDesc;
  GraphicDesc* = RECORD
   shapes* : Shape
  END;

  NotifyChangeMsg* = RECORD ( OS.Message )
   g* : Graphic
  END;

  VAR
  curShape* : ARRAY 32 OF CHAR; (* name of current shape type *)

  PROCEDURE ( s : Shape ) SetBox* ( x. y. w. h : INTEGER );
  BEGIN
  s.selected := FALSE;
  END SetBox;

  PROCEDURE ( s : Shape ) Draw* ( f : Viewers0.Frame );
  END Draw;

  PROCEDURE ( s : Shape ) Move* ( dx, dy: INTEGER );
  END Move;

  PROCEDURE ( s : Shape ) SetSelection* ( x, y, w, h : INTEGER );
  END SetSelection;

  PROCEDURE ( s : Shape ) Neutralize*;
  BEGIN
  s.selected := FALSE
  END Neutralize;

  PROCEDURE ( s : Shape ) GetBox* ( VAR x, y, w, h : INTEGER );
  END GetBox;

  PROCEDURE ( s : Shape ) Copy* () : Shape;
  END Copy;

  PROCEDURE InitGraphic* ( VAR g : Graphic );
  BEGIN
  g.shapes := NIL
  END InitGraphic;

  PROCEDURE ( g : Graphic ) Insert* ( s : Shape );
  VAR msg : NotifyChangeMsg;
  BEGIN
  s.next := g.shapes;
  g.shapes := s;
  msg.g := g;
  Viewers0.Broadcast ( msg )
  END Insert;

  PROCEDURE ( g : Graphic ) DeleteSelected*;
  VAR s, s0 : Shape;
    msg : NotifyChangeMsg;
  BEGIN
  s := g.shapes;
  s0 := NIL;
  WHILE s # NIL DO
   IF s.selected THEN
    IF s0 = NIL THEN
     g.shapes := s.next
    ELSE
     s0.next := s.next
    END
   ELSE
    s0 := s
   END;
   s := s.next
  END;
  msg.g := g;
  Viewers0.Broadcast ( msg )
  END DeleteSelected;

  PROCEDURE ( g : Graphic) MoveSelected* ( dx, dy : INTEGER );
  VAR s : Shape;
    msg : NotifyChangeMsg;
  BEGIN
  s := g.shapes;
  WHILE s # NIL DO
   IF s.selected THEN
    s.Move ( dx, dy )
   END;
   s := s.next
  END;
  msg.g := g;
  Viewers0.Broadcast ( msg )
  END MoveSelected;

  PROCEDURE ( g : Graphic ) Draw* ( f : Viewers0.Frame );
  VAR s : Shape;
  BEGIN
  s := g.shapes;
  WHILE.s # NIL DO
   s.Draw ( f );
   s := s.next
  END
  END Draw;

  PROCEDURE ( g : Graphic) Neutralize*;
  VAR s : Shape;
    msg : NotifyChangeMsg;
    changed : BOOLEAN;
  BEGIN
  s := g.shapes;
  changed := FALSE;
  WHILE s # NIL DO
   changed := changed OR s.selected;
   s.Neutralize;
   s := s.next
  END;
  IF changed THEN
   msg.g := g;
   Viewers0.Broadcast ( msg )
  END
  END Neutralize;

  PROCEDURE ( g : Graphic ) SetSelection* ( x, y, w, h : INTEGER );
  VAR s : Shape;
    msg : NotifyChangeMsg;
  BEGIN
  s := g.shapes;
  WHILE s # NIL DO s.SetSelection ( x, y, w, h );
   s := s.next
  END;
  msg.g := g;
  Viewers0.Broadcast ( msg )
  END SetSelection;

  PROCEDURE ( g : Graphic ) GetBox* ( VAR x, y, w, h : INTEGER );
  VAR x0, y0, w0, h0: INTEGER; s: Shape;
  BEGIN
  x := 0; y := 0; w := 12; h := 12;
  s := g.shapes;
  IF s # NIL THEN
   s.GetBox ( x, y, w, h );
   s := s.next
  END;
  WHILE s # NIL DO
   s.GetBox ( x0, y0, w0, h0 );
   IF x0 < x THEN
    INC ( w, x -x0 );
    x := x0
   END;
   IF y0 < y THEN
    INC ( h, y - y0 );
    y := y0
   END;
   IF x0 + w0 > x + w THEN
    w := x0 + w0 - x
   END;
   IF y0 + h0 > y + h THEN
    h := y0 + h0 - y
   END;
   s := s.next
  END;
  END GetBox;

  PROCEDURE ( g : Graphic ) Copy* () : Graphic;
  VAR s, a, b : Shape;
    g1 : Graphic;
  BEGIN
  NEW ( g1 );
  g1.shapes := NIL;
  s := g.shapes;
  WHILE s # NIL DO
   a := s.Copy0;
   a.next := NIL;
   IF g1.shapes = NIL THEN
    g1.shapes := a
   ELSE
    b.next := a
   END;
   b := a;
   s := s.next
  END;
  RETURN g1
  END Copy;

  PROCEDURE ( g : Graphic ) Load* ( VAR r : OS.Rider );
  VAR s, last : Shape;
    x : OS.Object;
  BEGIN
  last := NIL;
  REPEAT
   r.ReadObj ( x );
   IF x = NIL THEN
    s := NIL
   ELSE
    s := x ( Shape )
   END;
   IF last = NIL THEN
    g.shapes := s
   ELSE
    last.next := s
   END;
   last := s
  UNTIL x = NIL (* terminated by a NIL shape *)
  END Load;

  PROCEDURE ( g : Graphic ) Store* ( VAR r : OS.Rider );
  VAR s : Shape;
  BEGIN
  s := g.shapes;
  WHILE s # NIL DO
   r.WriteObj ( s );
   s := s.next
  END;
  r.WriteObj ( NIL )
  END Store;

BEGIN
  curShape := ""
END Shapes0.

MODULE GraphicFrames0;
  IMPORT OS, Viewers0, Shapes0;

  TYPE
  Frame* = POINTER TO FrameDesc;
  FrameDesc* = RECORD ( Viewers0.FrameDesc )
   orgX*, orgY* : INTEGER;  (* origin *)
   graphic* : Shapes0.Graphic (* shapes in this frame *)
  END;

  PROCEDURE ( f : Frame ) InvertBlock* ( x, y, w, h : INTEGER );
  BEGIN
  INC ( x, f.x + f.orgX );
  INC ( y, f.y + f.orgY );
  IF x < f.x THEN
   DEC ( w, f.x - x );
   x := f.x
  END;
  IF x + w > f.x + f.w THEN
   w := f.x + f.w - x
  END;
  IF y < f.y THEN
   DEC ( h, f.y - y );
   y := f.y
  END;
  IF y + h > f.y + f.h THEN
   h := f.y + f.h - y
  END;
  IF ( w > 0 ) & ( h > 0 ) THEN
   OS.InvertBlock ( x, y, w, h )
  END
  END InvertBlock;

  PROCEDURE ( f : Frame ) Draw*;
  BEGIN
  OS.FadeCursor;
  OS.EraseBlock ( f.x, f.y, f.w, f.h );
  f.graphic.Draw ( f )
  END Draw;

  PROCEDURE ( f : Frame ) Modify* ( y : INTEGER );
  BEGIN
  f.Modify^ (y);
  f.Draw
  END Modify;

  PROCEDURE ( f : Frame ) HandleMouse* ( x, y : INTEGER; buttons : SET );
  VAR w, h, dx, dy: INTEGER;
    obj : OS.Object;
    s : Shapes0.Shape;
    changed: BOOLEAN;

  PROCEDURE Track( VAR x, y, w, h, dx, dy : INTEGER; VAR buttons : SET );
   VAR b : SET;
    x1, y1 : INTEGER;
  BEGIN
   REPEAT
    OS.GetMouse ( b, x1 , y1 );
    buttons := buttons + b;
    OS.DrawCursor ( x1, y1 )
   UNTIL b = {};
   dx := x1 - x;
   dy := y1 -y;
   w := ABS(dx);
   h := ABS(dy);
   IF x1 < x THEN
    x := x1
   END;
   IF y1 < y THEN
    y := y1
   END;
   DEC ( x, f.x + f.orgX );
   DEC ( y, f.y + f.orgY )
  END Track;

  BEGIN
  changed := FALSE;
  IF OS.left IN buttons THEN
   Track ( x, y, w, h, dx, dy, buttons );
   (* ----- generate new shape with type curShape *)
   OS.NameToObj ( Shapes0.curShape, obj );
   IF obj # NIL THEN
    s := obj ( Shapes0.Shape );
    s.SetBox ( x, y, w, h );
    f.graphic.Insert ( s )
   END
  ELSIF OS.middle IN buttons THEN
   Track ( x, y, w, h, dx, dy, buttons );
   IF OS.left IN buttons THEN (* ----- MM+ML click: move selected figures *)
    f.graphic.MoveSelected ( dx, dy )
   ELSE (* ----- MM click: move origin *)
    INC ( f.orgX, dx );
    INC ( f.orgY, dy );
    f.Draw
   END
  ELSIF OS.right IN buttons THEN
   f.Neutralize;
   Track ( x, y, w, h, dx, dy, buttons );
   f.graphic.SetSelection ( x, y, w, h );
   IF OS.left IN buttons THEN (* ----- MR+ML click: delete selected shapes *)
    f.graphic.DeleteSelected
   END
  END
  END HandleMouse;

  PROCEDURE ( f: Frame ) Handle* ( VAR m : OS.Message);
  BEGIN
  WITH m : Shapes0.NotifyChangeMsg DO
   IF f.graphic = m.g THEN
    f.Draw
   END
  ELSE
  END
  END Handle;

  PROCEDURE ( f : Frame ) Neutralize*;
  BEGIN
  f.graphic.Neutralize
  END Neutralize;

  PROCEDURE New* ( graphic : Shapes0.Graphic ) : Frame;
  VAR f: Frame;
  BEGIN
  NEW ( f );
  f.graphic := graphic;
  f.orgX := 0;
  f.orgY := 0;
  RETURN f
  END New;

  PROCEDURE ( f : Frame ) Copy* (): Viewers0.Frame;
  VAR f1 : Frame;
  BEGIN
  f1 := New ( f.graphic );
  f1.orgX := f.orgX;
  f1.orgY := f.orgY;
  RETURN f1
  END Copy;

END GraphicFrames0.

MODULE Draw0;
  IMPORT OS, IO, Texts0, TextFrames0, Shapes0, GraphicFrames0, Viewers0;
  
  PROCEDURE Open*;
  VAR s : IO.Scanner;
    v : Viewers0.Viewer;
    menu : TextFrames0.Frame;
    cont : GraphicFrames0.Frame;
    file : OS.File;
    r : OS.Rider;
    g : Shapes0.Graphic;
  BEGIN
  s.SetToParameters;
  s.Read;
  IF s.class = IO.name THEN
   menu := TextFrames0.NewMenu ( s.str, 
			        "Viewers0.Close Viewers0.Copy Draw0.Store" );
   NEW ( g );
   Shapes0.InitGraphic ( g );
   file := OS.OldFile ( s.str );
   IF file # NIL THEN
    OS.InitRider ( r );
    r.Set ( file, 0 );
    g.Load ( r )
   END;
   cont := GraphicFrames0.New ( g );
   v := Viewers0.New ( menu, cont )
  END
  END Open;

  PROCEDURE Store*;
  VAR v : Viewers0.Viewer;
    s : IO.Scanner;
    file : OS.File;
    r : OS.Rider;
  BEGIN
  v := Viewers0.ViewerAt ( TextFrames0.cmdFrame.y );
  s.Set ( v.menu ( TextFrames0.Frame ).text, 0);
  s.Read;
  IF s.class = IO.name THEN
   file := OS.NewFile ( s.str );
   OS.InitRider ( r );
   r.Set ( file, 0 );
   v.cont ( GraphicFrames0.Frame ).graphic.Store ( r );
   OS.Register ( file )
  END
  END Store;

END Draw0.

MODULE Rectangles0;
  IMPORT OS, Viewers0, Shapes0, GraphicFrames0;

  TYPE
  Rectangle* = POINTER TO RectDesc;
  RectDesc* = RECORD ( Shapes0.ShapeDesc )
   x, y, w, h : INTEGER
  END;

  PROCEDURE ( r : Rectangle ) SetBox* ( x, y, w, h : INTEGER );
  BEGIN
  r.SetBox^ ( x, y, w, h );
  r.x := x;
  r.y := y;
  r.w := w;
  r.h := h
  END SetBox;

  PROCEDURE ( r: Rectangle ) Draw* ( f : Viewers0.Frame );
  BEGIN
  WITH f : GraphicFrames0.Frame DO
   IF r.selected THEN
    f.InvertBlock ( r.x, r.y, r.w, r.h )
   ELSE
    f.InvertBlock ( r.x, r.y, r.w, 1 );
    f.InvertBlock ( r.x, r.y + r.h - 1, r.w, 1 );
    f.InvertBlock ( r.x, r.y + 1, 1, r.h - 2 );
    f.InvertBlock ( r.x + r.w - 1, r.y + 1, 1, r.h - 2 )
   END
  END
  END Draw;

  PROCEDURE ( r : Rectangle ) Move* ( dx, dy : INTEGER );
  BEGIN
  INC ( r.x, dx );
  INC ( r.y, dy )
  END Move;

  PROCEDURE ( r : Rectangle ) SetSelection* ( x, y, w, h : INTEGER );
  BEGIN
  r.selected := ( r.x >= x ) & ( r.x + r.w <= x + w )
  & ( r.y >= y ) & ( r.y + r.h <= y + h )
  END SetSelection;

  PROCEDURE ( r : Rectangle ) GetBox* ( VAR x, y, w, h : INTEGER );
  BEGIN
  x := r.x;
  y := r.y;
  w := r.w;
  h := r.h
  END GetBox;

  PROCEDURE ( r : Rectangle ) Copy* () : Shapes0.Shape;
  VAR r1 : Rectangle;
  BEGIN
  NEW ( r1 );
  r1.selected := r.selected;
  r1.x := r.x;
  r1.y := r.y;
  r1.w := r.w;
  r1.h := r.h;
  RETURN r1
  END Copy;

  PROCEDURE ( r : Rectangle ) Load* ( VAR R : OS.Rider );
  BEGIN
  R.ReadInt ( r.x );
  R.ReadInt ( r.y );
  R.ReadInt ( r.w );
  R.ReadInt ( r.h )
  END Load;

  PROCEDURE ( r : Rectangle ) Store* ( VAR R : OS.Rider );
  BEGIN
  R.WriteInt ( r.x );
  R.WriteInt ( r.y );
  R.WriteInt ( r.w );
  R.WriteInt ( r.h )
  END Store;

  PROCEDURE Set*;
  BEGIN
  Shapes0.curShape := "Rectangles0.RectDesc"
  END Set;

END Rectangles0.

MODULE GraphicElems0;
  IMPORT OS, Texts0, Shapes0, GraphicFrames0, TextFrames0, Viewers0;

  TYPE
  Element* = POINTER TO ElemDesc;
  ElemDesc* = RECORD ( Texts0.ElemDesc )
   orgX, orgY : INTEGER;
   graphic : Shapes0.Graphic;
  END;

  UpdateFrame = POINTER TO UpdateFrameDesc;
  UpdateFrameDesc = RECORD ( GraphicFrames0.FrameDesc) 
   text : Texts0.Text;
   e : Element
  END;

  VAR f : GraphicFrames0.Frame;
   (* - reused within a text frame whenever 
	a graphic element has to be redrawn *)

  PROCEDURE ( e : Element ) Copy* () : Texts0.Element;
  VAR res : Element;
  BEGIN
  NEW ( res );
  res^ := e^;
  res.graphic := e.graphic.Copy ();
  RETURN res
  END Copy;

  PROCEDURE ( e : Element ) Draw* ( x, y : INTEGER );
  BEGIN
  f.x := x;
  f.y := y;
  f.w := e.w;
  f.h := e.h;
  f.orgX := e.orgX;
  f.orgY := e.orgY;
  f.graphic := e.graphic;
  f.Draw
  END Draw;

  PROCEDURE ( e : Element ) HandleMouse* ( f : OS.Object; x, y: INTEGER);
  VAR v : Viewers0.Viewer;
    menu : TextFrames0.Frame;
    cont : UpdateFrame;
    buttons : SET;
  BEGIN
  REPEAT
   OS.GetMouse ( buttons, x, y )
  UNTIL buttons = {};
  menu := TextFrames0.NewMenu ( "", 
	  "Viewers0.Close Viewers0.Copy GraphicElems0.Update" );
  NEW ( cont );
  cont.graphic := e.graphic;
  cont.orgX := e.orgX + 10;
  cont.orgY := e.orgY + 10;
  cont.text := f ( TextFrames0.Frame ).text;
  cont.e := e;
  v := Viewers0.New ( menu, cont )
  END HandleMouse;

  PROCEDURE ( e : Element) Load* ( VAR r : OS.Rider );
  BEGIN
  e.load^ ( r );
  r.ReadInt ( e.orgX );
  r.ReadInt ( e.orgY );
  NEW ( e.graphic );
  Shapes0.InitGraphic ( e.graphic );
  e.graphic.load ( r )
  END Load;

  PROCEDURE ( e : Element ) Store* ( VAR r : OS.Rider );
  BEGIN
  e.Store^ (r);
  r.WriteInt ( e.orgX );
  r.WriteInt ( e.orgY );
  e.graphic.Store ( r )
  END Store;

  PROCEDURE Insert*;
  VAR e : Element;
    f : TextFrames0.Frame;
  BEGIN
  IF Viewers0.focus # NIL THEN
   f := Viewers0.focus ( TextFrames0.Frame );
   IF ( f # NIL ) & ( f.caret.pos >= 0 ) THEN
    NEW ( e );
    e.w := 12;
    e.h := 12;
    e.dsc := 0;
    NEW ( e.graphic );
    Shapes0.InitGraphic ( e.graphic );
    e.orgX := 0;
    e.orgY := 0;
    f.text.SetPos ( f.caret.pos );
    f.text.WriteElem ( e )
   END
  END
  END Insert;

  PROCEDURE Update*;
  VAR v : Viewers0.Viewer;
    f : UpdateFrame;
    e : Element;
    m : Texts0.NotifyReplMsg;
    x, y : INTEGER;
    pos: LONGINT;
  BEGIN
  v := Viewers0.ViewerAt ( TextFrames0.cmdFrame.y );
  f := v.cont ( UpdateFrame );
  e := f.e;
  pos := f.text.ElemPos ( e );
  IF pos < f.text.len THEN
   f.graphic.GetBox ( x, y, e.w, e.h );
   e.graphic := f.graphic;
   e.orgX := - x;
   e.orgY := - y;
   m.t := f.text;
   m.beg := pos;
   m.end := pos + 1;
   Viewers0.Broadcast ( m )
  END
  END Update;

  PROCEDURE Init;
  VAR g : Shapes0.Graphic;
  BEGIN
  NEW ( g );
  Shapes0.InitGraphic ( g );
  f := GraphicFrames0.New ( g )
  END Init;

BEGIN
  Init
END GraphicElems0.