:Syntax10.Scn.FntSyntax10i.Scn.FntIStampElemsAlloc10 Oct 97pVersionElemsAllocBeg#Syntax10.Scn.Fnt""Debug NODebugging PowerMac WindowsWindowsDebug$Syntax10i.Scn.Fnt (* DEBUG *)NODebugging$Syntax10i.Scn.Fnt(* NO DEBUGGING *) PowerMac<Syntax10.Scn.FntSyntax10i.Scn.Fnt (* PowerMac *)Windows  pVersionElemsAllocEndSyntax10b.Scn.Fnt          #   "  V> 1 7/*-= !     #   ;&  iMarkElemsAllocP1<8FoldElemsNew8 "88NA 8 >88  8 8 +8g8 &Z F8+(N5A/}8 װ78&8 A88/q8 =V'18> *H^p#Syntax10.Scn.Fnt""Debug NODebugging Windows PowerMacWindowsDebugJSyntax10i.Scn.Fnt Syntax10.Scn.Fnt   (******) Out.String("removed$");NODebugging$Syntax10i.Scn.Fnt(* NO DEBUGGING *) Windows PowerMac p Ap#Syntax10.Scn.Fnt""Debug NODebugging Windows PowerMacWindowsDebugJSyntax10i.Scn.Fnt Syntax10.Scn.Fnt   (******) Out.String("removed$");NODebugging$Syntax10i.Scn.Fnt(* NO DEBUGGING *) Windows PowerMac p\8  A,#8T30LT8 A, 84Ac8  *84[X8 d  8B3;$?)98 a*8?8 18*Q8 AQ &8GX^>8 RT8lnh4=$;_s8 ݾ$8:X8 XG8;]8 `8:A :H8 ]8.  J8  8+`RJ8 `88?8* _RB8y*>3F8 o(8ZNMO?8 L8 8 r8<}8 ٠,8v&372!!LinkElemsAlloc*N5X8 (C8S0Q!*N58 k78H/8 8>+.8  sE8I8 9 G8G' %Ilm9Yl=68  784   8 e:8;s% 58 ҂W $8)8 R280 Q8Oo8)<[2<3> 22-8 a,8.2(R8  28@$8( Q18)* P;"7L78 oX58*. |8 8\25v*=8 ];78hn68 ^588o8 g3%8:6F8 ` 8f8 y 8M8 u 8gkD088= Ɣ!89R(8. ?o :8F28N88G#J%8$4w./!8 '3888&-G=^88|(,%`/9""$?48 88#Syntax10.Scn.Fnt try to resize this container ;688#Syntax10.Scn.Fnt container not resized 8Y8#Syntax10.Scn.Fnt hit inside a subframe ?8p#Syntax10.Scn.Fnt""Debug NODebugging Windows PowerMacWindowsDebug1Syntax10.Scn.Fnt Out.String("handle subframe$");NODebugging$Syntax10i.Scn.Fnt(* NO DEBUGGING *) Windows PowerMac p(,p#Syntax10.Scn.Fnt""Debug NODebugging Windows PowerMacWindowsDebug#Syntax10.Scn.FntShowSubFrames(f);NODebugging$Syntax10i.Scn.Fnt(* NO DEBUGGING *) Windows PowerMac p#8#Syntax10.Scn.Fnt$$ hits a case or frame has selection L8, : m^iq  p   a  0 %N .2848877888 +% 2823W:83*N520YR KI&'831(PR8 (789.$88 =o;8@ !>.P/;' "=58 K*8"12Nh8VMODULE ContainerElems; (* CE  *) (* Windows *) IMPORT Elems, Texts, Display, TextFrames, Fonts, Oberon, Viewers, Input, GU := GUtils, Files, TextPrinter, MenuViewers, Out, Modules; CONST ML = 2; MM = 1; MR = 0; DUnit = TextFrames.Unit; PUnit = TextPrinter.Unit; (** states of a case *) selected* = 1; (* notifyMsg id's *) elem = 1; (* refresh elem *) refresh = 2; clear = 3; (* area *) move = 4; (* selection *) TYPE Case* = POINTER TO CaseDesc; CaseDesc* = RECORD x*, y* : INTEGER; state* : SET; e* : Texts.Elem; next* : Case; END; Selection* = POINTER TO SelectionDesc; SelectionDesc* = RECORD c* : Case; next : Selection END; Container* = POINTER TO ContainerDesc; Frame* = POINTER TO FrameDesc; FrameDesc* = RECORD (Display.FrameDesc) container* : Container; hasCar* : BOOLEAN; oldY* : INTEGER; (** to recognize a shift (MenuViewers.ModifyMsg is handled in TextFrames.Handle) *) x, y : INTEGER; (* botleftcorner of container; X,Y are the visible coords *) selTime : LONGINT; END; Text* = POINTER TO TextDesc; TextDesc* = RECORD (Texts.TextDesc) base* : Container; END; ContainerDesc* = RECORD (Elems.ElemDesc) contents : Case; locked* : BOOLEAN; x*, y* : INTEGER; (** Caret position *) sel : Selection; last : Selection; dummyText : Text; (* TextElements expect to be placed in text *) END; SelElem = POINTER TO SelElemDesc; (* holds selected elems in selection text *) SelElemDesc = RECORD (Texts.ElemDesc) e : Texts.Elem END; SelectionMsg* = RECORD (Oberon.SelectionMsg) p* : Container; sel* : Selection END; CopyOverMsg* = RECORD (Oberon.CopyOverMsg) p* : Container; sel* : Selection END; NotifyMsg* = RECORD (Display.FrameMsg) c* : Container; id* : SET; (* elem, refresh, clear, move *) case : Case; elem* : Texts.Elem; x*, y*, w*, h* : INTEGER; (* area *) END; VAR W : Texts.Writer; dummyTextFrame : TextFrames.Frame; (* for messages to old text elems *) clp : INTEGER; (* AUXILIARY *) PROCEDURE ^UpdateArea* (c : Container; x, y, w, h : INTEGER; id : SET); PROCEDURE ^ToTop (p : Container; c : Case); PROCEDURE NoNotify (t : Texts.Text; op : INTEGER; beg, end : LONGINT); END NoNotify; PROCEDURE InArea (x, y, w, h, ex, ey, ew, eh : INTEGER) : BOOLEAN; BEGIN RETURN (ey <= y) & (ey - eh >= y - h) & (ex >= x) & (ex + ew <= x + w) (*RETURN (ey >= y) & (ey <= y + h) & (ex >= x) & (ex <= x + w)*) END InArea; PROCEDURE OverlapsArea (x, y, w, h, ex, ey, ew, eh : INTEGER) : BOOLEAN; BEGIN RETURN ( ( ((ex >= x) & (ex <= x + w - 1)) OR ((ex + ew - 1 >= x) & (ex + ew <= x + w)) OR ((ex <= x) & (ex + ew >= x + w)) ) & ( ((ey <= y) & (ey >= y - h + 1)) OR ((ey - eh + 1 <= y) & (ey - eh >= y - h)) OR ((ey >= y) & (ey - eh < y - h)) ) ) END OverlapsArea; PROCEDURE AdjustSubFrame* (f, sub : Display.Frame); BEGIN WITH sub : Frame DO sub.x := sub.X; sub.y := sub.Y; Elems.AdjustSubFrame(f, sub) END END AdjustSubFrame; PROCEDURE InBorder* (mX, mY, x, y, w, h : INTEGER) : BOOLEAN; BEGIN RETURN (mX < x + clp) OR (mX > x + w - clp) OR (mY < y + clp) OR (mY > y + h - clp) END InBorder; PROCEDURE InsertElem* (p : Container; new : Texts.Elem; fnt : Fonts.Font; col : SHORTINT); VAR c : Case; attr : Elems.AttrMsg; notifier : Texts.Notifier; BEGIN NEW(c); c.state := {}; c.next := p.contents; p.contents := c; (* get special set *) Elems.GetSet(new, Elems.special, c.state); (*attr.id := Elems.get; COPY("$#cstate", attr.name); new.handle(new, attr);*) (*IF attr.res = Elems.done THEN c.state := attr.set END;*) (*ToTop(p, c);*) c.e := new; c.x := p.x; c.y := p.y; notifier := p.dummyText.notify; p.dummyText.notify := NoNotify; Texts.SetFont(W, fnt); Texts.SetColor(W, col); Texts.WriteElem(W, new); Texts.Append(p.dummyText, W.buf); p.dummyText.notify := notifier; p.x := p.x + SHORT(new.W DIV DUnit) + 2; END InsertElem; PROCEDURE NotifySubFrames(f : Frame; VAR msg : Display.FrameMsg); VAR sub : Display.Frame; BEGIN sub := f.dsc; WHILE sub # NIL DO sub.handle(sub, msg); sub := sub.next END END NotifySubFrames; PROCEDURE ThisSubFrame(f : Frame; x, y : INTEGER) : Display.Frame; VAR sub : Display.Frame; done : BOOLEAN; BEGIN sub :=f.dsc; done := FALSE; WHILE (sub # NIL) & ~done DO IF (sub.X <= x) & (sub.X + sub.W >= x) & (sub.Y <= y) & (sub.Y + sub.H >= y) THEN done := TRUE ELSE sub := sub.next END; END; RETURN sub END ThisSubFrame; PROCEDURE RemoveSubFrames(f : Frame; x, y, w, h : INTEGER); VAR p, s : Display.Frame; msg : MenuViewers.ModifyMsg; BEGIN s := f.dsc; IF s # NIL THEN p := s; s := p.next END ; WHILE s # NIL DO IF OverlapsArea(x, y, w, h, s.X, s.Y, s.W, s.H) THEN p.next := s.next; msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0;  s.handle(s, msg) ELSE p := s END ; s := p.next END ; s := f.dsc; IF (s # NIL) & OverlapsArea(x, y, w, h, s.X, s.Y, s.W, s.H) THEN f.dsc := f.dsc.next;  msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0; s.handle(s, msg) END END RemoveSubFrames; (* CASE *) PROCEDURE ToBottom (p : Container; c : Case); VAR cc : Case; BEGIN IF (p.contents.next = NIL) OR (c.next = NIL) THEN RETURN END; IF (p.contents = c) & (p.contents.next # NIL) THEN p.contents := p.contents.next; cc := p.contents ELSE cc := p.contents; WHILE cc.next # c DO cc := cc.next END; cc.next := c.next END; WHILE cc.next # NIL DO cc := cc.next END; cc.next := c; c.next := NIL END ToBottom; PROCEDURE ToTop (p : Container; c : Case); VAR cc : Case; BEGIN IF Elems.back IN c.state THEN ToBottom(p, c) ELSE IF p.contents = c THEN RETURN END; cc := p.contents; WHILE cc.next # c DO cc := cc.next END; cc.next := c.next; c.next := p.contents; p.contents := c END END ToTop; PROCEDURE DeleteElem(p : Container; e : Texts.Elem); VAR pos : LONGINT; notifier : Texts.Notifier; BEGIN notifier := p.dummyText.notify; p.dummyText.notify := NoNotify; pos := Texts.ElemPos(e); Texts.Delete(p.dummyText, pos, pos + 1); p.dummyText.notify := notifier END DeleteElem; PROCEDURE DeleteCase* (p : Container; c : Case); VAR help : Case; (*ew, eh : INTEGER;*) BEGIN (*ew := SHORT(c.e.W DIV DUnit); eh := SHORT(c.e.H DIV DUnit);*) IF p.contents = c THEN p.contents := p.contents.next; DeleteElem(p, c.e); (*UpdateArea(p, c.x, c.y, ew, eh, {clear, refresh});*) RETURN END; help := p.contents; WHILE (help # NIL) & (help.next # c) DO help := help.next END; IF help # NIL THEN help.next := c.next; DeleteElem(p, c.e); (*UpdateArea(p, c.x, c.y, ew, eh, {clear, refresh})*) END END DeleteCase; PROCEDURE MyCase* (p : Container; e : Texts.Elem) : Case;  VAR c : Case; BEGIN c := p.contents; WHILE c # NIL DO IF c.e = e THEN RETURN c END; c := c.next END; RETURN NIL END MyCase; PROCEDURE ThisCase* (p : Container; x, y, x0, y0 : INTEGER) : Case; VAR c : Case; rx, ry, h : INTEGER; BEGIN h := SHORT(p.H DIV DUnit); rx := x - x0; ry := y0 + h - y; c := p.contents; WHILE c # NIL DO IF ((rx >= c.x) & (rx <= c.x + SHORT(c.e.W DIV DUnit))) & ((ry >= c.y - SHORT(c.e.H DIV DUnit)) & (ry <= c.y)) THEN RETURN c END; c := c.next END; RETURN NIL END ThisCase; PROCEDURE StoreCase* (VAR msg : Texts.FileMsg; c : Case); VAR identify : Texts.IdentifyMsg; fnt : Fonts.Font; col : SHORTINT; BEGIN Files.WriteInt(msg.r, c.x); Files.WriteInt(msg.r, c.y); Files.WriteSet(msg.r, c.state); Elems.GetLook(c.e, fnt, col); Files.WriteString(msg.r, fnt.name); Files.WriteInt(msg.r, col); Files.WriteLInt(msg.r, c.e.W); Files.WriteLInt(msg.r, c.e.H); (* Store Elem *) c.e.handle(c.e, identify); Files.WriteString(msg.r, identify.mod); Files.WriteString(msg.r, identify.proc); c.e.handle(c.e, msg); END StoreCase; PROCEDURE LoadCase* (VAR msg : Texts.FileMsg; VAR c : Case; VAR fnt : Fonts.Font; VAR col : SHORTINT); VAR mod, proc : ARRAY 32 OF CHAR; M : Modules.Module; cmd : Modules.Command; fntName : ARRAY 64 OF CHAR; i : INTEGER; w, h : LONGINT; BEGIN Files.ReadInt(msg.r, c.x); Files.ReadInt(msg.r, c.y); Files.ReadSet(msg.r, c.state); EXCL(c.state, selected); Files.ReadString(msg.r, fntName); fnt := Fonts.This(fntName); Files.ReadInt(msg.r, i); col := SHORT(i); Files.ReadLInt(msg.r, w); Files.ReadLInt(msg.r, h); (* load elem *) Files.ReadString(msg.r, mod); Files.ReadString(msg.r, proc); (* generate *) M := Modules.ThisMod(mod); IF M # NIL THEN cmd := Modules.ThisCommand(M, proc) ELSE Out.String("-- unknown module: "); Out.String(mod); Out.Ln END; IF cmd # NIL THEN cmd ELSE Out.String("-- unknown command : "); Out.String(mod); Out.Char("."); Out.String(proc); Out.Ln; END; ASSERT((cmd # NIL) & (M # NIL)); c.e := Texts.new; c.e.W := w; c.e.H := h; c.e.handle(c.e, msg); END LoadCase; (* SELECTION *) PROCEDURE InvertSelected(f : Frame; c : Case); VAR w, h : INTEGER; BEGIN w := SHORT(c.e.W DIV DUnit); h := SHORT(c.e.H DIV DUnit); GU.ReplConst(f, 0, f.X + c.x, f.Y + f.H - c.y, w, h, Display.invert) END InvertSelected; PROCEDURE AppendToSelection* (p : Container; c : Case); VAR s : Selection; BEGIN NEW(s); s.c := c; s.next := NIL; IF p.sel = NIL THEN p.sel := s ELSE p.last.next := s END; p.last := s END AppendToSelection; PROCEDURE RemoveFromSelection* (p : Container; c : Case); VAR s : Selection; BEGIN IF p.sel = NIL THEN RETURN END; IF p.sel.c = c THEN p.sel := p.sel.next; IF p.sel = NIL THEN p.last := NIL END ELSE s := p.sel; WHILE (s.next # NIL) & (s.next.c # c) DO s := s.next END; IF s.next # NIL THEN s.next := s.next.next; IF s.next = NIL THEN p.last := s END END END END RemoveFromSelection; PROCEDURE RemoveSelection* (f : Frame); VAR s : Selection; BEGIN s := f.container.sel; WHILE s # NIL DO EXCL(s.c.state, selected); (*InvertSelected(f, s.c);*) Elems.UpdateElem(s.c.e); (* to slow *) s := s.next END; f.container.sel := NIL; f.container.last := NIL END RemoveSelection; PROCEDURE DeleteSelection* (f : Frame); VAR s : Selection; ew, eh : INTEGER; BEGIN s := f.container.sel; WHILE s # NIL DO DeleteCase(f.container, s.c); ew := SHORT(s.c.e.W DIV DUnit); eh := SHORT(s.c.e.H DIV DUnit); UpdateArea(f.container, s.c.x, s.c.y, ew, eh, {clear, refresh}); s := s.next END; f.container.sel := NIL; f.container.last := NIL END DeleteSelection; PROCEDURE SelElemHandle (s : Texts.Elem; VAR msg : Texts.ElemMsg); BEGIN s(SelElem).e.handle(s(SelElem).e, msg) END SelElemHandle; (* forwards changes to original text *) PROCEDURE SelTextNotifier(t : Texts.Text; op : INTEGER; beg, end : LONGINT); VAR r : Texts.Reader; txt : Texts.Text; e : Texts.Elem; pos : LONGINT; BEGIN IF op # Texts.replace THEN RETURN END; (* 18.09.97 prevent duplicate display *) Texts.OpenReader(r, t, 0); Texts.ReadElem(r); txt := Texts.ElemBase(r.elem(SelElem).e); WHILE ~r.eot DO e := r.elem(SelElem).e; pos := Texts.ElemPos(e); Texts.ChangeLooks(txt, pos, pos + 1 , {0,1,2}, r.fnt, r.col, r.voff); Texts.ReadElem(r); END; END SelTextNotifier; PROCEDURE SelectionToText(f : Frame) : Texts.Text; VAR s : Selection; sel : SelElem; col : SHORTINT; fnt : Fonts.Font; t : Texts.Text; BEGIN t := TextFrames.Text(""); t.notify := SelTextNotifier; s := f.container.sel; WHILE s # NIL DO NEW(sel); sel.handle := SelElemHandle; sel.e := s.c.e; Elems.GetLook(sel.e, fnt, col); Texts.SetFont(W, fnt); Texts.SetColor(W, col); Texts.WriteElem(W, sel); Texts.Append(t, W.buf); s := s.next END; RETURN t END SelectionToText; PROCEDURE NextSel* (s : Selection) : Selection; BEGIN RETURN s.next END NextSel; PROCEDURE SendSelection (f : Frame); VAR msg : CopyOverMsg; BEGIN IF f.container.sel # NIL THEN msg.text := SelectionToText(f); msg.beg := 0; msg.end := msg.text.len; msg.p := f.container; msg.sel := f.container.sel; Viewers.Broadcast(msg) END END SendSelection; PROCEDURE SelToPanel (p : Container; sel : Selection); VAR s : Selection; copy : Texts.CopyMsg; fnt : Fonts.Font; col : SHORTINT; sx, sy, px, py : INTEGER; c : Case; BEGIN (* measure absolute block coords *) sx := MAX(INTEGER); sy := MIN(INTEGER); s := sel; WHILE s # NIL DO IF s.c.x < sx THEN sx := s.c.x END; IF s.c.y > sy THEN sy := s.c.y END; s := s.next END; (* insert *) px := p.x; py := p.y; s := sel; WHILE s # NIL DO Elems.GetLook(s.c.e, fnt, col); copy.e := NIL; s.c.e.handle(s.c.e, copy); p.x := px + (s.c.x - sx); p.y := py - (sy - s.c.y); InsertElem(p, copy.e, fnt, col); Elems.UpdateElem(copy.e); (* 7.6.97 because of *) c := MyCase(p, copy.e); c.state := s.c.state; EXCL(c.state, selected); s := s.next END END SelToPanel; PROCEDURE TextSelToPanel (p : Container; t : Texts.Text; beg, end : LONGINT); VAR r : Texts.Reader; copy : Texts.CopyMsg; fnt : Fonts.Font; col : SHORTINT; BEGIN Texts.OpenReader(r, t, beg); Texts.ReadElem(r); WHILE (Texts.Pos(r) <= end) & (r.elem # NIL) DO Elems.GetLook(r.elem, fnt, col); copy.e := NIL; r.elem.handle(r.elem, copy); InsertElem(p, copy.e, fnt, col); Elems.UpdateElem(copy.e); (* 7.6.97 because of *) Texts.ReadElem(r) END END TextSelToPanel; PROCEDURE CopyOver (p : Container; VAR msg : Oberon.CopyOverMsg); BEGIN IF msg IS CopyOverMsg THEN SelToPanel(p, msg(CopyOverMsg).sel) ELSE TextSelToPanel (p, msg.text, msg.beg, msg.end) END END CopyOver; PROCEDURE CopyInto (p : Container); VAR msg : SelectionMsg; BEGIN msg.p := NIL; msg.sel := NIL; msg.text := NIL; msg.time := 0; Viewers.Broadcast(msg); IF (msg.sel = NIL) & (msg.text # NIL) THEN TextSelToPanel(p, msg.text, msg.beg, msg.end) ELSIF msg.sel # NIL THEN SelToPanel(p, msg.sel) END END CopyInto; (* DRAW *) PROCEDURE FullyVisible (f : Display.Frame; c : Case; w, h : INTEGER) : BOOLEAN; BEGIN RETURN (c.x + w < f.W) & (c.y < f.H) & (h <= c.y) END FullyVisible; PROCEDURE DrawTextElem* (p : Container; e : Texts.Elem; f : Display.Frame; x0, y0 : INTEGER); VAR msg : TextFrames.DisplayMsg; w, h, wp, hp : INTEGER; c : Case; BEGIN c := MyCase(p, e); IF Elems.invisible IN c.state THEN RETURN END; wp := SHORT(p.W DIV DUnit); hp := SHORT(p.H DIV DUnit); w := SHORT(c.e.W DIV DUnit); h := SHORT(c.e.H DIV DUnit); IF (c.x > f.W) OR (c.y - h > f.H) THEN (* not visible *) RETURN END; (* add: checking of other cases *) Elems.GetLook(c.e, msg.fnt, msg.col); msg.X0 := c.x + x0; msg.Y0 := 0; IF c.e IS Elems.Elem THEN msg.frame := f ELSE msg.frame := dummyTextFrame; msg.frame.X := x0; msg.frame.Y := y0; msg.frame.W := wp; msg.frame.H := hp END; msg.prepare := TRUE; c.e.handle(c.e, msg); w := SHORT(c.e.W DIV DUnit); h := SHORT(c.e.H DIV DUnit); IF ~(c.e IS Elems.Elem) & ~FullyVisible(f, c, w, h) THEN (* draw dummy *) GU.ReplPattern(f, 2, Display.grey1, x0 + c.x, y0 + hp - c.y, w, h, 0, 0, Display.paint); RETURN END; msg.prepare := FALSE; msg.elemFrame := NIL; msg.Y0 := y0 + hp - c.y; c.e.handle(c.e, msg); IF selected IN c.state THEN InvertSelected(f(Frame), c) END; IF msg.elemFrame # NIL THEN (* new sub frame *) msg.elemFrame.next := f.dsc; f.dsc := msg.elemFrame END END DrawTextElem; PROCEDURE DrawContents* (p : Container; f : Display.Frame; x0, y0 : INTEGER); PROCEDURE Dr (c : Case); BEGIN IF c # NIL THEN EXCL(c.state, selected); Dr(c.next); DrawTextElem(p, c.e, f, x0, y0) END END Dr; BEGIN Dr(p.contents) END DrawContents; PROCEDURE PrintTextElem (p : Container; c : Case; x0, y0 : INTEGER); VAR msg : TextPrinter.PrintMsg; w, h, wp, hp : INTEGER; BEGIN wp := SHORT(p.W DIV PUnit); hp := SHORT(p.H DIV PUnit); w := SHORT(c.e.W DIV PUnit); h := SHORT(c.e.H DIV PUnit); IF (c.x > wp) OR (c.y - h > hp) THEN (* not visible *) RETURN END; Elems.GetLook(c.e, msg.fnt, msg.col); msg.X0 := SHORT(LONG(c.x) * DUnit DIV PUnit) + x0; msg.Y0 := 0; msg.prepare := TRUE; c.e.handle(c.e, msg); w := SHORT(c.e.W DIV PUnit); h := SHORT(c.e.H DIV PUnit); IF ~(c.e IS Elems.Elem) THEN (*IF ~FullyVisible(f, c, w, h) THEN RETURN END;*) END; msg.prepare := FALSE; msg.Y0 := y0 + hp - SHORT(LONG(c.y) * DUnit DIV PUnit); c.e.handle(c.e, msg); END PrintTextElem; PROCEDURE PrintContents* (p : Container; x0, y0 : INTEGER); VAR c : Case; BEGIN c := p.contents; WHILE c # NIL DO PrintTextElem(p, c, x0, y0); c := c.next END END PrintContents; PROCEDURE RefreshArea (f : Frame; VAR x, y, w, h : INTEGER); VAR c : Case; done : BOOLEAN; ew, eh : INTEGER; PROCEDURE ReDraw (c : Case); BEGIN IF c # NIL THEN ReDraw(c.next); ew := SHORT(c.e.W DIV DUnit); eh := SHORT(c.e.H DIV DUnit); IF InArea(x, y, w, h, c.x, c.y, ew, eh) THEN DrawTextElem(f.container, c.e, f, f.x, f.y) END END END ReDraw; BEGIN done := FALSE; WHILE ~done DO done := TRUE; c := f.container.contents; WHILE (c # NIL) & done DO ew := SHORT(c.e.W DIV DUnit); eh := SHORT(c.e.H DIV DUnit); IF ~InArea(x, y, w, h, c.x, c.y, ew, eh) & OverlapsArea(x, y, w, h, c.x, c.y, ew, eh) THEN done := FALSE; IF (c.x < x) THEN w := w + x - c.x; x := c.x END; IF (c.x + ew > x + w) THEN w := w + c.x + ew - (x + w) END; IF (c.y > y) THEN h := h + c.y - y; y := c.y END; IF (c.y - eh < y - h) THEN h := h + (y - h - (c.y - eh)) END; END; c := c.next END END; Oberon.RemoveMarks(f.x + x, f.Y + f.H - y, w, h); RemoveSubFrames(f, f.x + x, f.Y + f.H - y, w, h); ReDraw(f.container.contents) END RefreshArea; PROCEDURE ClearArea (f : Frame; x, y, w, h : INTEGER); VAR fnt : Fonts.Font; color : SHORTINT; BEGIN Oberon.RemoveMarks(f.x + x, f.Y + f.H - y, w, h); Elems.GetLook(f.container, fnt, color); GU.ReplConst(f, color, x + f.x, f.Y + f.H - y, w, h, Display.paint) END ClearArea; PROCEDURE UpdateArea* (c : Container; x, y, w, h : INTEGER; id : SET); VAR u : NotifyMsg; BEGIN u.id := id; u.c := c; u.x := x; u.y := y; u.w := w; u.h := h; Viewers.Broadcast(u) END UpdateArea; (* relative coords *) (* CONTAINER *) PROCEDURE ChangePos(f : Frame; c : Case; dx, dy : INTEGER); VAR s : Selection; x, y, h, w : INTEGER; BEGIN IF c = NIL THEN (* the selection *) s := f.container.sel; WHILE s # NIL DO ChangePos(f, s.c, dx, dy); s := s.next END ELSE h := SHORT(c.e.H DIV DUnit); w := SHORT(c.e.W DIV DUnit); x := c.x; y := c.y; ToTop(f.container, c); c.x := c.x + dx; c.y := c.y + dy; IF c.x < 0 THEN c.x := 0 END; IF c.y - h < 0 THEN c.y := h END; UpdateArea(f.container, x, y, w, h, {clear, refresh}); IF ~OverlapsArea(x, y, w, h, c.x, c.y, w, h) THEN Elems.UpdateElem(c.e) END (* ELSE Elem would be drawn twice (!! subframes) *) END END ChangePos; PROCEDURE InvertMoving (f : Frame; c : Case; dx, dy : INTEGER); VAR s : Selection; BEGIN IF c = NIL THEN s := f.container.sel; WHILE s # NIL DO InvertMoving (f, s.c, dx, dy); s := s.next END ELSE GU.Frame(NIL, 15, f.X + c.x + dx, f.Y + f.H - c.y - dy, SHORT(c.e.W DIV DUnit), SHORT(c.e.H DIV DUnit), 1, Display.invert); END END InvertMoving; PROCEDURE Move (f : Frame; c : Case); VAR keys, keysum : SET; begX, begY, dx, dy, X, Y, ox, oy : INTEGER; notify : NotifyMsg; BEGIN Input.Mouse(keys, begX, begY); keysum := {}; dx := 0; dy := 0; ox := -1; oy := -1; notify.c := f.container; notify.case := c; notify.id := {move}; notify.x := dx; notify.y := dy; Viewers.Broadcast(notify); REPEAT Input.Mouse(keys, X, Y); keysum := keysum + keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y); IF (ox # X) OR (oy # Y) THEN Viewers.Broadcast(notify); dx := X - begX; dy := begY - Y; ox := X; oy := Y; notify.x := dx; notify.y := dy; Viewers.Broadcast(notify) END UNTIL (keys = {}) OR (MR IN keysum); Viewers.Broadcast(notify); IF ~(MR IN keysum) THEN ChangePos(f, c, dx, dy) END END Move; (* container (dummyText) *) PROCEDURE Notify (T: Texts.Text; op: INTEGER; beg, end: LONGINT); VAR c : Case; r : Texts.Reader; w, h : INTEGER; BEGIN WITH T : Text DO Texts.OpenReader(r, T, beg); Texts.ReadElem(r); c := MyCase(T.base, r.elem); w := SHORT(c.e.W DIV DUnit); h := SHORT(c.e.H DIV DUnit); UpdateArea(T.base, c.x, c.y, w, h, {clear, refresh}); END END Notify; PROCEDURE Init* (p : Container); BEGIN Elems.Init(p); p.contents := NIL; p.locked := FALSE; NEW(p.dummyText); Texts.Open(p.dummyText, ""); p.dummyText.notify := Notify; p.dummyText.base := p; END Init; PROCEDURE InvertCaret (f : Frame);  VAR x, y : INTEGER; BEGIN x := f.container.x + f.X; y := f.Y + f.H - f.container.y; GU.ReplConst(f, 15, x - 5, y, 11, 1, Display.invert); GU.ReplConst(f, 15, x, y - 5, 1, 11, Display.invert); END InvertCaret; PROCEDURE SetCaret* (f : Frame; X, Y : INTEGER); (** x, y are relative coords *) BEGIN Oberon.PassFocus(Viewers.This(f.X, f.Y)); f.container.x := X; f.container.y := Y; f.hasCar := TRUE; InvertCaret(f) END SetCaret; PROCEDURE RemoveCaret* (f : Frame); BEGIN IF f.hasCar THEN InvertCaret(f); f.hasCar := FALSE END END RemoveCaret; PROCEDURE CopyContainer* (from, to : Container); VAR c : Case; copy : Texts.CopyMsg; fnt : Fonts.Font; col : SHORTINT; notifier : Texts.Notifier; BEGIN Elems.CopyElem(from, to); Init(to); to.locked := from.locked; notifier := to.dummyText.notify; to.dummyText.notify := NoNotify; (* copy contents *) c := from.contents; WHILE c # NIL DO to.x := c.x; to.y := c.y; copy.e := NIL; c.e.handle(c.e, copy); Elems.GetLook(c.e, fnt, col); InsertElem(to, copy.e, fnt, col); c := c.next END; to.dummyText.notify := notifier END CopyContainer; (* HANDLE *) (******************************************) PROCEDURE ShowSubFrames(f : Display.Frame); VAR s : Display.Frame; i, x, y : INTEGER; k : SET; BEGIN i := 0; s := f.dsc; WHILE s # NIL DO Display.ReplConst(1, s.X, s.Y, s.W, s.H, Display.replace); s := s.next; INC(i); END; Out.Int(i,0); Out.Ln; END ShowSubFrames; (*****************************************) PROCEDURE TrackRubberBand (f : Frame; ix, iy : INTEGER; keys : SET); VAR x, y, w, h, ox, oy, mx, my : INTEGER; keysum : SET; VAR c : Case; PROCEDURE CorrectCoords(VAR coord, exp : INTEGER); BEGIN IF exp < 0 THEN INC(coord, exp); exp := ABS(exp) END END CorrectCoords; PROCEDURE CheckSelection(); BEGIN CorrectCoords(x, w); CorrectCoords(y, h); c := f.container.contents; WHILE c # NIL DO IF InArea (x - f.X, f.Y + f.H - y, w, h, c.x, c.y, SHORT(c.e.W DIV DUnit), SHORT(c.e.H DIV DUnit)) THEN IF ~(selected IN c.state) THEN INCL(c.state, selected); AppendToSelection(f.container, c); InvertSelected(f, c) END ELSE IF selected IN c.state THEN EXCL(c.state, selected); RemoveFromSelection(f.container, c); InvertSelected(f, c) END END; c := c.next END END CheckSelection; BEGIN keysum := keys; ox := -1; oy := -1; REPEAT Input.Mouse(keys, mx, my); keysum := keysum + keys; IF (ox # mx) OR (oy # my) THEN GU.Frame(f, 0, x, y, w, h, 1, Display.invert); x := ix; y := iy; w := mx - ix; h := my - iy; ox := mx; oy := my; CheckSelection(); GU.Frame(f, 0, x, y, w, h, 1, Display.invert) END UNTIL keys = {}; GU.Frame(f, 0, x, y, w, h, 1, Display.invert); IF keysum = {MR, ML} THEN DeleteSelection(f) ELSIF keysum = {MR, MM} THEN SendSelection(f) ELSIF keysum = {ML, MM, MR} THEN RemoveSelection(f) END END TrackRubberBand; PROCEDURE HandleInput (f : Frame; VAR msg : Oberon.InputMsg); VAR X, Y, x, y, w, h : INTEGER; (*track : Elems.TrackMsg;*) track : TextFrames.TrackMsg; keysum : SET; c : Case; done : BOOLEAN; sub : Display.Frame; notifier : Texts.Notifier; BEGIN keysum := msg.keys; IF msg.id = Oberon.track THEN IF msg.keys = {ML} THEN  sub := ThisSubFrame(f, msg.X, msg.Y); IF sub # NIL THEN sub.handle(sub, msg) ELSIF ~f.container.locked THEN SetCaret(f, msg.X - f.X, f.Y + f.H - msg.Y); REPEAT Input.Mouse(msg.keys, msg.X, msg.Y); keysum := keysum + msg.keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y); UNTIL msg.keys = {}; IF keysum = {ML, MM} THEN InvertCaret(f); CopyInto(f.container); InvertCaret(f) END END ELSIF msg.keys = {MR} THEN (*RemoveCaret(f);*) f.selTime := Oberon.Time(); sub := ThisSubFrame(f, msg.X, msg.Y); c := ThisCase(f.container, msg.X, msg.Y, f.X, f.Y); IF (c = NIL) & ~f.container.locked THEN RemoveSelection(f); TrackRubberBand(f, msg.X, msg.Y, msg.keys); (* select with rubber band *) ELSIF ~f.container.locked & ((sub = NIL) OR InBorder(msg.X,msg.Y,sub.X,sub.Y,sub.W,sub.H)) THEN (* in border of subframe or in elem *) IF selected IN c.state THEN EXCL(c.state, selected) ELSE INCL(c.state, selected) END; (*InvertSelected(f, c);*) Elems.UpdateElem(c.e); IF selected IN c.state THEN AppendToSelection(f.container, c) ELSE RemoveFromSelection(f.container, c) END; REPEAT Input.Mouse(msg.keys, X, Y); keysum := keysum + msg.keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y) UNTIL msg.keys = {}; IF keysum = {MR, ML} THEN DeleteSelection(f) ELSIF keysum = {MR, MM} THEN SendSelection(f) END ELSIF sub # NIL THEN sub.handle(sub, msg) END (* *****) ELSIF msg.keys = {MM} THEN  track.X0 := f.X; track.Y0 := f.Y; track.X := msg.X; track.Y := msg.Y; track.keys := msg.keys; track.frame := f; done := FALSE; IF ~f.container.locked THEN Elems.Track(f.container, track, f.x, f.y, f.W, f.H, done); IF done THEN Elems.UpdateElem(f.container) END END; IF ~done THEN c := ThisCase(f.container, msg.X,msg.Y, f.x, f.y); sub := ThisSubFrame(f, msg.X, msg.Y); IF (sub # NIL) & ~InBorder(msg.X,msg.Y,sub.X, sub.Y, sub.W, sub.H) THEN (* forward to subframe *) (*IF (sub # NIL) & ((f.container.locked) OR ~InBorder(msg.X,msg.Y,sub.X, sub.Y, sub.W, sub.H)) THEN*)  (* normal handling of subframe *) sub.handle(sub, msg); ELSE (* no subframe or hit at the corner *)  (* try to hit a case *) RemoveCaret(f); IF ((c = NIL) & (f.container.sel # NIL)) OR ((c # NIL) & (selected IN c.state)) THEN (* handle sel *) IF f.container.sel # NIL THEN c := NIL END; Move(f, c) ELSIF c # NIL THEN w := SHORT(c.e.W DIV DUnit); h := SHORT(c.e.H DIV DUnit); IF ~f.container.locked & InBorder(msg.X, msg.Y, f.x + c.x, f.y - c.y + f.H, w, h) & ~Elems.InCorner(msg.X, msg.Y, f.x + c.x, f.y - c.y + f.H, w, c.e) THEN Move(f, c) ELSE Elems.GetLook(c.e, track.fnt, track.col); track.X0 := c.x + f.x; track.Y0 := f.y + f.H - c.y; (**************** dummytextframe evtl. dummytext setzen ********************) IF c.e IS Elems.Elem THEN track.frame := f ELSE track.frame := dummyTextFrame END; done := FALSE; IF Elems.InCorner(msg.X, msg.Y, f.x + c.x, f.y + f.H - c.y + 1, w, c.e) THEN IF ~f.container.locked THEN ToTop(f.container, c); x := c.x; y := c.y; w := SHORT(c.e.W DIV DUnit); h := SHORT(c.e.H DIV DUnit); notifier := f.container.dummyText.notify; f.container.dummyText.notify := NoNotify; Elems.Track(c.e, track, f.x, f.y, f.W, f.H, done); f.container.dummyText.notify := notifier; IF done THEN UpdateArea(f.container, x, y, w, h, {clear}); c.y := y + (SHORT(c.e.H DIV DUnit) - h); IF c.y < 0 THEN c.y := 0 END; UpdateArea(f.container, x, y, w, h, {refresh}); END ELSE (* 23.06.97 ***) done := TRUE END END; IF ~done THEN IF (c.e IS Elems.Elem) OR FullyVisible(f, c, w, h) THEN ToTop(f.container, c); c.e.handle(c.e, track) END END END END END END;  END ELSIF (msg.id = Oberon.consume) & f.hasCar THEN IF msg.ch = Elems.CRSL THEN ChangePos(f, NIL, -1, 0) ELSIF msg.ch = Elems.CRSR THEN ChangePos(f, NIL, 1, 0) ELSIF msg.ch = Elems.CRSD THEN ChangePos(f, NIL, 0, 1) ELSIF msg.ch = Elems.CRSU THEN ChangePos(f, NIL, 0, -1) END ELSE NotifySubFrames(f, msg) END END HandleInput; PROCEDURE FrameHandle* (f : Display.Frame; VAR msg : Display.FrameMsg); VAR sub : Display.Frame; BEGIN WITH f : Frame DO WITH msg : Oberon.InputMsg DO HandleInput(f, msg) | msg : Oberon.ControlMsg DO NotifySubFrames(f, msg); IF f.hasCar & (msg.id IN {Oberon.defocus, Oberon.neutralize}) THEN RemoveCaret(f) END; IF msg.id = Oberon.neutralize THEN RemoveSelection(f) END | msg : TextFrames.InsertElemMsg DO IF f.hasCar THEN InvertCaret(f); InsertElem(f.container, msg.e, Fonts.Default, 15); Elems.UpdateElem(msg.e); (* 7.6.97 because of *) InvertCaret(f); ELSE NotifySubFrames(f, msg) END | msg : Oberon.CopyOverMsg DO IF f.hasCar THEN InvertCaret(f); CopyOver(f.container, msg(Oberon.CopyOverMsg)); InvertCaret(f) ELSE NotifySubFrames(f, msg) END | msg : Oberon.SelectionMsg DO NotifySubFrames(f, msg); IF (f.container.sel # NIL) & (f.selTime > msg.time) THEN IF msg IS SelectionMsg THEN msg(SelectionMsg).p := f.container; msg(SelectionMsg).sel := f.container.sel ELSE msg.text := SelectionToText(f); msg.beg := 0; msg.end := msg.text.len END; msg.time := f.selTime END | msg : MenuViewers.ModifyMsg DO IF (f.oldY # f.Y) & (msg.H # 0) THEN (* shift *) sub := f.dsc; WHILE sub # NIL DO INC(sub.Y, f.Y - f.oldY); msg.Y := sub.Y; msg.H := sub.H; sub.handle(sub, msg); sub := sub.next END; INC(f.y, f.Y - f.oldY); f.oldY := f.Y END | msg : Elems.GetContextMsg DO IF (msg.p = f.container) & ((msg.fx = f.X) & (msg.fy = f.Y) OR (msg.fx < 0) & (msg.fy < 0)) THEN msg.context := f; msg.p := NIL ELSE NotifySubFrames(f, msg) END | msg : NotifyMsg DO IF msg.c = f.container THEN IF msg.id = {elem} THEN ToTop(f.container, MyCase(f.container, msg.elem)); DrawTextElem(f.container, msg.elem, f, f.X, f.Y) ELSIF msg.id = {move} THEN InvertMoving(f, msg.case, msg.x, msg.y) ELSE IF clear IN msg.id THEN ClearArea(f, msg.x, msg.y, msg.w, msg.h) END; IF refresh IN msg.id THEN RefreshArea(f, msg.x, msg.y, msg.w, msg.h) END END; ELSE NotifySubFrames(f, msg) END; ELSE NotifySubFrames(f, msg) END END END FrameHandle; PROCEDURE HandleAttrMsg (p : Container; VAR msg : Elems.AttrMsg); BEGIN msg.res := Elems.done; IF msg.id = Elems.get THEN IF msg.name = "Locked" THEN msg.b := p.locked; msg.class := Elems.Bool ELSE Elems.Handle(p, msg) END ELSIF msg.id = Elems.set THEN IF msg.name = "Locked" THEN IF msg.class = Elems.Bool THEN p.locked := msg.b END ELSE Elems.Handle(p, msg) END ELSIF msg.id = Elems.enum THEN Elems.Handle(p, msg); msg.enum("Locked", Elems.Bool); ELSE Elems.Handle(p, msg) END; END HandleAttrMsg; PROCEDURE HandleFileMsg (VAR p : Container; VAR msg : Texts.FileMsg); VAR c, last : Case; fnt : Fonts.Font; col : SHORTINT; eof : BOOLEAN; ch : CHAR; notifier : Texts.Notifier; BEGIN IF msg.id = Texts.load THEN notifier := p.dummyText.notify; p.dummyText.notify := NoNotify; Files.Read(msg.r, ch); (* version -> not used yet *) Files.ReadBool(msg.r, p.locked); Files.ReadBool(msg.r, eof); p.contents := NIL; last := NIL; WHILE ~eof DO NEW(c); LoadCase(msg, c, fnt, col); c.next := NIL; IF p.contents = NIL THEN p.contents := c ELSE last.next := c END; last := c; Texts.SetFont(W, fnt); Texts.SetColor(W, col); Texts.WriteElem(W, c.e); Texts.Append(p.dummyText, W.buf); Files.ReadBool(msg.r, eof) END; p.dummyText.notify := notifier; ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version *) Files.WriteBool(msg.r, p.locked); Files.WriteBool(msg.r, p.contents = NIL); c := p.contents; WHILE c # NIL DO StoreCase(msg, c); Files.WriteBool(msg.r, c.next = NIL); c := c.next END END END HandleFileMsg; PROCEDURE Handle* (p: Texts.Elem; VAR msg: Texts.ElemMsg); BEGIN WITH p : Container DO WITH msg : TextFrames.TrackMsg DO (* send to his frame *) Elems.ToFrame(p, msg) | msg : Elems.AttrMsg DO HandleAttrMsg(p, msg); | msg : Texts.FileMsg DO Elems.Handle(p, msg); HandleFileMsg(p, msg); | msg : TextFrames.FocusMsg DO Elems.Focusing(msg) | msg : TextFrames.DisplayMsg DO HALT(99) | msg : Texts.IdentifyMsg DO HALT(99) ELSE Elems.Handle(p, msg) END END END Handle; BEGIN clp := Elems.clp; Texts.OpenWriter(W); NEW(dummyTextFrame); dummyTextFrame.text := TextFrames.Text(""); END ContainerElems.