home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Oberon0 / Texts0.Mod < prev    next >
Encoding:
Text File  |  1994-06-16  |  5.7 KB  |  193 lines
  1. MODULE Texts0;  (* HM Mar-25-92*)
  2. IMPORT OS, AsciiTexts, Viewers0;
  3.  
  4. CONST ELEM = 1CX;
  5.   
  6. TYPE
  7.   Element* = POINTER TO ElemDesc;
  8.   Attribute* = POINTER TO AttrDesc;
  9.   AttrDesc* = RECORD
  10.     fnt-: OS.Font;
  11.     elem-: Element;
  12.     len: LONGINT;
  13.     next: Attribute
  14.   END;
  15.   ElemDesc* = RECORD (OS.ObjectDesc)
  16.     w*, h*, dsc*: INTEGER
  17.   END;
  18.   Text* = POINTER TO TextDesc;
  19.   TextDesc* = RECORD (AsciiTexts.TextDesc)
  20.     attr-: Attribute;  (*attributes of previously read character*)
  21.     firstAttr: Attribute;  (*to attribute list*)
  22.     attrRest: LONGINT  (*unread bytes in current attribute block*)
  23.   END;
  24.   NotifyInsMsg* = AsciiTexts.NotifyInsMsg;
  25.   NotifyDelMsg* = AsciiTexts.NotifyDelMsg;
  26.   NotifyReplMsg* = RECORD (OS.Message) t*: Text; beg*, end*: LONGINT END;
  27.  
  28. (*methods of class Element*)
  29.  
  30. PROCEDURE (e: Element) Draw* (x, y: INTEGER); END Draw;
  31. PROCEDURE (e: Element) HandleMouse* (f: OS.Object; x, y: INTEGER); END HandleMouse;
  32. PROCEDURE (e: Element) Copy* (): Element; END Copy;
  33.  
  34. PROCEDURE (e: Element) Load* (VAR r: OS.Rider);
  35. BEGIN r.ReadInt(e.w); r.ReadInt(e.h); r.ReadInt(e.dsc)
  36. END Load;
  37.  
  38. PROCEDURE (e: Element) Store* (VAR r: OS.Rider);
  39. BEGIN r.WriteInt(e.w); r.WriteInt(e.h); r.WriteInt(e.dsc)
  40. END Store;
  41.  
  42. (*methods of class Text*)
  43.  
  44. PROCEDURE (t: Text) Split (pos: LONGINT; VAR prev: Attribute);
  45.   VAR a, b: Attribute;
  46. BEGIN a := t.firstAttr;
  47.   WHILE (a # NIL) & (pos >= a.len) DO DEC(pos, a.len); prev := a; a := a.next
  48. END;
  49.   IF (a # NIL) & (pos > 0) THEN
  50.     NEW(b); b.elem := a.elem; b.fnt := a.fnt; b.len := a.len - pos; a.len :=
  51. pos;
  52.     b.next := a.next; a.next := b; prev := a
  53.   END
  54. END Split;
  55.  
  56. PROCEDURE (t: Text) Merge (a: Attribute);
  57.   VAR b: Attribute;
  58. BEGIN b := a.next;
  59.   IF (b # NIL) & (a.fnt = b.fnt) & (a.len > 0) & (a.elem = NIL) & (b.elem =
  60. NIL) THEN
  61.     INC(a.len, b.len); a.next := b.next
  62.   END
  63. END Merge;
  64.  
  65. PROCEDURE (t: Text) Insert* (at: LONGINT; t1: AsciiTexts.Text; beg, end: LONGINT);
  66.   VAR a, b, c, d, i, j, k: Attribute; t0: Text;
  67. BEGIN
  68.   IF t = t1 THEN NEW(t0); t0.Clear; t0.Insert(0, t1, beg, end); t.Insert(at,
  69. t0, 0, t0.len)
  70.   ELSE
  71.     WITH t1: Text DO t1.Split(beg, a); t1.Split(end, b); t.Split(at, c); d :=
  72. c.next; 
  73.       i := a; j := c;
  74.       WHILE i # b DO i := i.next; NEW(k); k^ := i^;
  75.         IF i.elem # NIL THEN k.elem := i.elem.Copy() END;
  76.         j.next := k; j := k
  77.       END;
  78.       j.next := d; t1.Merge(b); t1.Merge(a); t.Merge(j); t.Merge(c); 
  79.       t.Insert^ (at, t1, beg, end)
  80.     END
  81.   END
  82. END Insert;
  83.  
  84. PROCEDURE (t: Text) Delete* (beg, end: LONGINT);
  85.   VAR a, b: Attribute;
  86. BEGIN t.Split(beg, a); t.Split(end, b); a.next := b.next; t.Merge(a);
  87.   t.Delete^ (beg, end)
  88. END Delete;
  89.  
  90. PROCEDURE (t: Text) SetPos* (pos: LONGINT);
  91.   VAR prev, a: Attribute;
  92. BEGIN t.SetPos^(pos);
  93.   a := t.firstAttr;
  94.   WHILE (a # NIL) & (pos >= a.len) DO DEC(pos, a.len); prev := a; a := a.next
  95. END;
  96.   IF (a = NIL) OR (pos = 0) THEN t.attr := prev; t.attrRest := 0 ELSE t.attr
  97. := a; t.attrRest := a.len-pos END
  98. END SetPos;
  99.  
  100. PROCEDURE (t: Text) Read* (VAR ch: CHAR);
  101. BEGIN t.Read^(ch);
  102.   IF (t.attrRest = 0) & (t.attr.next # NIL) THEN t.attr := t.attr.next; t.attrRest
  103. := t.attr.len END;
  104.   DEC(t.attrRest)
  105. END Read;
  106.  
  107. PROCEDURE (t: Text) Write* (ch: CHAR);
  108.   VAR a, prev: Attribute; at: LONGINT;
  109. BEGIN a := t.firstAttr; at := t.pos;
  110.   WHILE (a # NIL) & (at >= a.len) DO DEC(at, a.len); prev := a; a := a.next
  111. END;
  112.   IF (a = NIL) OR (at = 0) THEN (*insert at end of attribute stretch*)
  113.     IF (prev = t.firstAttr) OR (prev.elem # NIL) THEN
  114.       NEW(a); a.elem := NIL; a.fnt := prev.fnt; a.len := 1; a.next := prev.next;
  115. prev.next := a; t.Merge(a)
  116.     ELSE INC(prev.len)
  117.     END
  118.   ELSE INC(a.len)
  119.   END;
  120.   t.Write^ (ch)
  121. END Write;
  122.  
  123. PROCEDURE (t: Text) ReadNextElem* (VAR e: Element);
  124.   VAR pos: LONGINT; a: Attribute;
  125. BEGIN
  126.   pos := t.pos + t.attrRest; a := t.attr.next;
  127.   WHILE (a # NIL) & (a.elem = NIL) DO pos := pos + a.len; a := a.next END;
  128.   IF a # NIL THEN e := a.elem; t.SetPos(pos+1) ELSE e := NIL; t.SetPos(t.len)
  129. END
  130. END ReadNextElem;
  131.  
  132. PROCEDURE (t: Text) WriteElem* (e: Element);
  133.   VAR x, y: Attribute; m: NotifyReplMsg;
  134. BEGIN t.Write(ELEM); t.Split(t.pos - 1, x); t.Split(t.pos, y); y.elem := e;
  135.   m.t := t; m.beg := t.pos-1; m.end := t.pos; Viewers0.Broadcast(m)
  136. END WriteElem;
  137.  
  138. PROCEDURE (t: Text) ElemPos* (e: Element): LONGINT;
  139.   VAR pos: LONGINT; a: Attribute;
  140. BEGIN
  141.   a := t.firstAttr; pos := 0;
  142.   WHILE (a # NIL) & (a.elem # e) DO pos := pos + a.len; a := a.next END;
  143.   RETURN pos
  144. END ElemPos;
  145.  
  146. PROCEDURE (t: Text) ChangeFont* (beg, end: LONGINT; fnt: OS.Font);
  147.   VAR a, b: Attribute; m: NotifyReplMsg;
  148.   
  149.   PROCEDURE Change(a: Attribute);
  150.   BEGIN a.fnt := fnt; 
  151.     IF a # b THEN Change(a.next) END;
  152.     t.Merge(a)
  153.   END Change;
  154.   
  155. BEGIN
  156.   IF end > beg THEN
  157.     t.Split(beg, a); t.Split(end, b); Change(a.next); t.Merge(a);
  158.     m.t := t; m.beg := beg; m.end := end; Viewers0.Broadcast(m)
  159.   END
  160. END ChangeFont;
  161.  
  162. PROCEDURE (t: Text) Clear*;
  163. BEGIN
  164.   t.Clear^;
  165.   NEW(t.firstAttr); t.firstAttr.elem := NIL; t.firstAttr.next := NIL;
  166.   t.firstAttr.fnt := OS.DefaultFont(); t.firstAttr.len := 0; t.SetPos(0)
  167. END Clear;
  168.  
  169. PROCEDURE (t: Text) Store* (VAR r: OS.Rider);
  170.   VAR a: Attribute;
  171. BEGIN t.Store^(r); a := t.firstAttr.next;
  172.   WHILE a # NIL DO
  173.     r.WriteString(a.fnt.name); r.WriteObj(a.elem); r.WriteLInt(a.len);
  174.     a := a.next
  175.   END;
  176.   r.Write(0X) (*empty font name terminates attribute list*)
  177. END Store;
  178.  
  179. PROCEDURE (t: Text) Load* (VAR r: OS.Rider);
  180.   VAR prev, a: Attribute; name: ARRAY 32 OF CHAR; x: OS.Object;
  181. BEGIN t.Load^(r);
  182.   prev := t.firstAttr;
  183.   LOOP
  184.     r.ReadString(name); IF name = "" THEN EXIT END;
  185.     NEW(a); a.fnt := OS.FontWithName(name); r.ReadObj(x); r.ReadLInt(a.len);
  186.     IF x = NIL THEN a.elem := NIL ELSE a.elem := x(Element) END;
  187.     prev.next := a; prev := a
  188.   END;
  189.   prev.next := NIL
  190. END Load;
  191.  
  192. END Texts0.
  193.