}Oberon10.Scn.FntOberon10i.Scn.Fnt;_<%Oberon10m.Scn.Fnt"!*% 8FoldElemsNew>Lm88 "888$8N T888 8 8 8I88|wm/ QN8 8 m WD EL[P8 86/ 2P'8KM@MODULE PopupElems; (** Original by Michael Franz, 27.1.92, SHML, MH, CM 3 Apr 96 *) (* new file format, added Version tag and options, drop down menu by CM, Uni Linz, use of module Host *) (* Linz PopupElems but with ETH look-and-feel, SHML 29 Nov 96 *) IMPORT Host, Oberon, Input, Display, Viewers, Files, Fonts, Printer, Texts, TextFrames, MenuViewers, TextPrinter; CONST CR = 0DX; ElemDW = 3; ElemDH = 2; MenuDW = 3; MenuDH = 1; (* margins of element box and menu box *) MenuElemDW = 2; (* margins around menu element *) DUnit = TextFrames.Unit; PUnit = TextPrinter.Unit; MR = 0; MM = 1; ML = 2; cancel = {ML, MM, MR}; white = Display.white; black = Display.black; paint = Display.paint; replace = Display.replace; invert = Display.invert; TYPE Elem* = POINTER TO ElemDesc; ElemDesc* = RECORD (Texts.ElemDesc) name*: ARRAY 32 OF CHAR; menu*: Texts.Text; small*: BOOLEAN; (** TRUE if elem displays itself small *) def*: INTEGER; (** default item; first item = 0 *) beg, end: LONGINT; (* displayed text stretch in menu *) n: INTEGER; (* number of items *) wid, lsp, dsc: INTEGER (* width, line space, descender of item lines *) END; ExecMsg* = RECORD (Texts.ElemMsg) frame*: Display.Frame; pos*: LONGINT; keys*: SET END; EditFrame = POINTER TO EditFrameDesc; EditFrameDesc = RECORD (TextFrames.FrameDesc) elem: Elem END; VAR wr: Texts.Writer; buf: Texts.Buffer; PROCEDURE Str(s: ARRAY OF CHAR); BEGIN Texts.WriteString(wr, s) END Str; PROCEDURE Ln; BEGIN Texts.WriteLn(wr) END Ln; (* auxiliary *)  PROCEDURE Min(x, y: INTEGER): INTEGER; BEGIN IF x < y THEN RETURN x ELSE RETURN y END END Min; PROCEDURE Max(x, y: INTEGER): INTEGER; BEGIN IF x > y THEN RETURN x ELSE RETURN y END END Max; PROCEDURE CopyText(from: Texts.Text): Texts.Text; VAR to: Texts.Text; BEGIN Texts.Save(from, 0, from.len, buf); to := TextFrames.Text(""); Texts.Append(to, buf); RETURN to END CopyText; PROCEDURE DefaultMenu(e: Elem); BEGIN IF e.menu.len > 0 THEN Texts.Delete(e.menu, 0, e.menu.len) END; Str("right interclick to edit menu"); Ln; Texts.Append(e.menu, wr.buf) END DefaultMenu; PROCEDURE GetName(e: Elem; t: Texts.Text; pos: LONGINT); VAR s: Texts.Scanner; BEGIN Texts.OpenScanner(s, t, pos); Texts.Scan(s); IF ~(s.class IN {Texts.Name, Texts.String}) OR (s.s[0] = 0X) THEN e.name := "Popup" ELSE COPY(s.s, e.name) END END GetName; PROCEDURE StrDispWidth(fnt: Fonts.Font; s: ARRAY OF CHAR): LONGINT; VAR pat: Display.Pattern; width, i, dx, x, y, w, h: INTEGER; BEGIN width := 0; i := 0; WHILE s[i] # 0X DO Display.GetChar(fnt.raster, s[i], dx, x, y, w, h, pat); INC(width, dx); INC(i) END; RETURN LONG(width)*DUnit END StrDispWidth; PROCEDURE DispStr(fnt: Fonts.Font; s: ARRAY OF CHAR; col, x0, y0: INTEGER); VAR pat: Display.Pattern; i, dx, x, y, w, h: INTEGER; BEGIN i := 0; WHILE s[i] # 0X DO Display.GetChar(fnt.raster, s[i], dx, x, y, w, h, pat); Display.CopyPattern(col, pat, x0+x, y0+y, paint); INC(i); INC(x0, dx) END END DispStr;  (* change propagation *)  PROCEDURE PrepareDraw(e: Elem; fnt: Fonts.Font; VAR dy: INTEGER); VAR width, dh: INTEGER; BEGIN IF e.small THEN width := 2*MenuElemDW; dh := 0; dy := fnt.minY; IF dy > -2 THEN dy := -2 END ELSE width := 2*ElemDW+4; dh := -fnt.minY+2*ElemDH+2 END; e.W := LONG(width)*DUnit+StrDispWidth(fnt, e.name)+DUnit; e.H := LONG(fnt.maxY-fnt.minY+dh)*DUnit END PrepareDraw; PROCEDURE MeasureMenu*(E: Elem); (** compute E.n, E.def, E.wid, E.lsp, E.dsc*) VAR r: Texts.Reader; ch, oldCh: CHAR; wid, dx, x, y, w, h: INTEGER; p: LONGINT; BEGIN IF E.menu.len = 0 THEN DefaultMenu(E); MeasureMenu(E) END; E.wid := 0; E.n := 1; E.lsp := 0; wid := 0; oldCh := 0X; E.def := 0; Texts.OpenReader(r, E.menu, 0); Texts.Read(r, ch); WHILE ~r.eot DO IF ch = CR THEN E.wid := Max(E.wid, wid); wid := 0; INC(E.n) ELSIF r.elem # NIL THEN E.lsp := Max(E.lsp, SHORT(r.elem.H DIV TextFrames.Unit)); INC(wid, SHORT(r.elem.W DIV TextFrames.Unit)) ELSE E.lsp := Max(E.lsp, r.fnt.height); E.dsc := Min(E.dsc, r.fnt.minY); Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(wid, dx) END; oldCh := ch; Texts.Read(r, ch) END; IF oldCh = CR THEN DEC(E.n) END; E.wid := Max(E.wid, wid); INC(E.lsp) END MeasureMenu;   (* interactive editing of popup menus *)  PROCEDURE HandleEdit(f: Display.Frame; VAR msg: Display.FrameMsg); VAR f1: EditFrame; BEGIN TextFrames.Handle(f, msg); WITH f: EditFrame DO IF msg IS Oberon.CopyMsg THEN NEW(f1); TextFrames.Open(f1, f.text, f.org); f1.handle := f.handle; f1.elem := f.elem; msg(Oberon.CopyMsg).F := f1 END END END HandleEdit; PROCEDURE OpenEditor(e: Elem); CONST menu = "System.Close Edit.Search Edit.Replace PopupElems.Toggle PopupElems.Update "; VAR v: MenuViewers.Viewer; f: EditFrame; x, y, i: INTEGER; name: ARRAY 34 OF CHAR; BEGIN name[0] := 22X; i := 0; (* 22X = " *) WHILE e.name[i] # 0X DO name[i+1] := e.name[i]; INC(i) END; name[i+1] := 22X; name[i+2] := 0X; Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); NEW(f); f.elem := e; TextFrames.Open(f, CopyText(e.menu), 0); f.handle := HandleEdit; v := MenuViewers.New(TextFrames.NewMenu(name, menu), f, TextFrames.menuH, x, y) END OpenEditor;  (* file input/output *)  PROCEDURE Load(VAR r: Files.Rider; e: Elem); CONST VersionTag = 01X; menuElem = 0; VAR ch: CHAR; val: LONGINT; options: SET; BEGIN Files.Read(r, ch); IF ch = VersionTag THEN Files.ReadString(r, e.name); Files.ReadNum(r, val); Files.ReadSet(r, options); e.small := menuElem IN options ELSE Files.Set(r, Files.Base(r), Files.Pos(r)-1); Files.ReadString(r, e.name); Files.ReadBool(r, e.small) END; e.menu := TextFrames.Text(""); Texts.Load(r, e.menu) END Load; PROCEDURE Store(VAR r: Files.Rider; e: Elem); BEGIN Files.WriteString(r, e.name); Files.WriteBool(r, e.small); Texts.Store(r, e.menu) END Store;  (* graphics *)  PROCEDURE Box(col, bkgnd, X, Y, W, H: INTEGER); BEGIN Display.ReplConst(col, X+1, Y+1, W-2, 1, replace); Display.ReplConst(col, X+1, Y+H-2, W-2, 1, replace); Display.ReplConst(col, X+1, Y+2, 1, H-4, replace); Display.ReplConst(col, X+W-2, Y+2, 1, H-4, replace); Display.ReplConst(col, X+4, Y, W-4, 1, replace); Display.ReplConst(col, X+W-1, Y+1, 1, H-4, replace); Display.ReplConst(bkgnd, X+2, Y+2, W-4, H-4, replace) END Box; PROCEDURE Underline(f: Display.Frame; col, X, Y, W: INTEGER); BEGIN Display.ReplPatternC(f, white, Display.grey1, X+MenuElemDW, Y, W-2*MenuElemDW, 1, X, Y, invert) END Underline; PROCEDURE DrawElem(e: Elem; f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; col, X, Y: INTEGER); VAR beg: LONGINT; parc: TextFrames.Parc; bkgndCol: INTEGER; BEGIN IF f IS TextFrames.Frame THEN bkgndCol := f(TextFrames.Frame).col ELSE bkgndCol := black END; IF e.small THEN TextFrames.ParcBefore(Texts.ElemBase(e), pos, parc, beg); IF bkgndCol = col THEN col := ABS(white-col) END; INC(Y, SHORT(parc.dsr DIV DUnit)); DispStr(fnt, e.name, col, X+MenuElemDW, Y); Underline(f, col, X, Y-2, SHORT(e.W DIV DUnit)) ELSE Box(col, bkgndCol, X, Y, SHORT((e.W-1) DIV DUnit), SHORT(e.H DIV DUnit)); DispStr(fnt, e.name, col, X+ElemDW+2, Y+ElemDH+2-fnt.minY) END END DrawElem; PROCEDURE PrintElem(e: Elem; fnt: Fonts.Font; X, Y: INTEGER); VAR W, H: INTEGER; BEGIN W := SHORT((e.W-1) DIV PUnit); H := SHORT(e.H DIV PUnit); IF e.small THEN Printer.String(X, Y, e.name, fnt.name); Printer.ReplConst(X, Y-2, W, 1) ELSE Printer.ReplConst(X+1, Y+1, W-2, 1); Printer.ReplConst(X+1, Y+H-2, W-2, 1); Printer.ReplConst(X+1, Y+2, 1, H-4); Printer.ReplConst(X+W-2, Y+2, 1, H-4); Printer.ReplConst(X+4, Y, W-4, 1); Printer.ReplConst(X+W-1, Y+1, 1, H-4); Printer.String(X + (ElemDW+2) * DUnit DIV PUnit, Y + SHORT(LONG(ElemDH+2-fnt.minY)*DUnit DIV PUnit), e.name, fnt.name ) END END PrintElem; PROCEDURE DrawMenu(e: Elem; X, Y, W, H: INTEGER); VAR r: Texts.Reader; ch: CHAR; X0, dx, x, y, w, h: INTEGER; p: LONGINT; BEGIN Box(white, black, X, Y, W, H); X0 := X+MenuDW+2; X := X0; Y := Y+H-e.lsp-e.dsc-MenuDH-2; Texts.OpenReader(r, e.menu, 0); Texts.Read(r, ch); WHILE ~r.eot DO IF ch = CR THEN Y := Y-e.lsp; X := X0 ELSE Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); Display.CopyPattern(r.col, p, X+x, Y+y, paint); INC(X, dx) END; Texts.Read(r, ch) END END DrawMenu;  (* actions *)  PROCEDURE ExecCmd(E: Elem; F: Display.Frame; pos: LONGINT; keys: SET); VAR s: Texts.Scanner; par: Oberon.ParList; res, i, j: INTEGER; ch: CHAR; m: TextFrames.TrackMsg; err: ARRAY 128 OF CHAR; BEGIN Texts.OpenScanner(s, E.menu, pos); Texts.Scan(s); IF (s.class = Texts.Name) & (s.line = 0) THEN i := 0; WHILE (i < s.len) & (s.s[i] # ".") DO INC(i) END; j := i + 1; WHILE (j < s.len) & (s.s[j] # ".") DO INC(j) END; IF (j >= s.len) & (s.s[i] = ".") THEN NEW(par); par.frame := F; par.vwr := Viewers.This(F.X, F.Y); par.text := E.menu; par.pos := Texts.Pos(s)-1; Oberon.Call(s.s, par, ML IN keys, res); (* left interclick -> unload module *) IF res # 0 THEN Host.CallError(s.s, res, err); Texts.WriteString(wr, err); Texts.WriteLn(wr); Texts.Append(Oberon.Log, wr.buf) END END ELSIF (s.class = Texts.Char) & (s.c = Texts.ElemChar) & (s.line = 0) THEN Texts.OpenReader(s, E.menu, pos); Texts.Read(s, ch); m.frame := NIL; m.keys := {MM}; s.elem.handle(s.elem, m) END END ExecCmd;  PROCEDURE Show(f: Display.Frame; e: Elem; pos: LONGINT; X, Y: INTEGER; VAR cmd: INTEGER; VAR keySum: SET); VAR eX, eY, eW, eH, W, H, w, newY, mx, my, top, bot, left, right, newCmd: INTEGER; keys: SET; parc: TextFrames.Parc; beg: LONGINT; default: BOOLEAN; PROCEDURE FlipLine; BEGIN Display.ReplConst(white, eX+MenuElemDW, eY, eW-2*MenuElemDW, 2, invert) END FlipLine; PROCEDURE Flip(cmd: INTEGER); BEGIN IF cmd >= 0 THEN Display.ReplConst(white, left, top-(cmd+1)*e.lsp, right-left, e.lsp, invert) END END Flip; BEGIN eX := X; eY := Y; eW := SHORT(e.W DIV DUnit); eH := SHORT(e.H DIV DUnit); IF e.small & (e.n = 1) THEN (* one_liner MenuElem *) TextFrames.ParcBefore(Texts.ElemBase(e), pos, parc, beg); newY := eY+SHORT(parc.dsr DIV DUnit); Underline(f, white, eX, newY-2, eW); FlipLine; newCmd := cmd; REPEAT Input.Mouse(keys, mx, my); keySum := keySum+keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my); IF (keySum = cancel) OR (mx < eX) OR (mx >= eX+eW) OR (my < eY) OR (my >= eY+eH) THEN newCmd := -1 ELSIF (cmd = -1) & (eX <= mx) & (mx < eX+eW) & (eY <= my) & (my < eY+eH) THEN newCmd := e.def END; IF newCmd # cmd THEN FlipLine; cmd := newCmd END UNTIL keys = {}; IF cmd # -1 THEN FlipLine END; Underline(f, white, eX, newY-2, eW) ELSE Input.Mouse(keys, mx, my); W := e.wid + 2*MenuDW + 4; H := e.n*e.lsp + 2*MenuDH + 4; IF (W > Oberon.DisplayWidth(X)) OR (H > Oberon.DisplayHeight(X)) THEN Str("PopupElem too big!"); Ln; Texts.Append(Oberon.Log, wr.buf); REPEAT Input.Mouse(keys, mx, my); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my) UNTIL keys = {}; keySum := cancel; cmd := -1 ELSE w := Oberon.DisplayWidth(X); left := Display.Left; IF (X >= Display.Left+Display.Width) THEN (* adjust if on secondary *) INC(w, Display.Width); left := Display.Left+Display.Width END; X := Min(w-W, Max(mx-W DIV 2, left)); (* X >= left & X+W <= w *) newY := my-((e.n-cmd)*e.lsp-e.lsp DIV 2); IF (newY >= Display.Bottom) & (newY+H <= Oberon.DisplayHeight(X)) THEN (* popup at mouse pos *) Y := newY; default := FALSE ELSE (* drop down *) IF Y-H > Display.Bottom THEN Y := Y-H ELSE Y := Y+eH END; IF Y+H > Oberon.DisplayHeight(X) THEN Y := Display.Bottom END; default := TRUE END; left := X+3; right := X+W-3; bot := Y+MenuDH+3; top := Y+H-MenuDH-2; Oberon.RemoveMarks(X, Y, W, H); Oberon.FadeCursor(Oberon.Mouse); Host.Backup(X, Y, W, H); (* save background *) DrawMenu(e, X, Y, W, H); Flip(cmd); keySum := {}; REPEAT Input.Mouse(keys, mx, my); keySum := keySum+keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my); IF keySum = cancel THEN cmd := -1 ELSIF (mx >= left) & (mx <= right) & (my >= bot) & (my <= top) THEN newCmd := (top-my) DIV e.lsp; IF newCmd # cmd THEN default := FALSE; Flip(cmd); Flip(newCmd); cmd := newCmd END ELSIF default THEN IF (eX <= mx) & (mx < eX+eW) & (eY <= my) & (my < eY+eH) THEN IF cmd # e.def THEN cmd := e.def; Flip(cmd) END ELSE Flip(cmd); cmd := -1 END ELSIF ~default THEN Flip(cmd); cmd := -1 END UNTIL keys = {}; Oberon.FadeCursor(Oberon.Mouse); Host.Restore(X, Y, W, H) (* restore background *) END END END Show; PROCEDURE Popup(e: Elem; msg: TextFrames.TrackMsg); VAR cmd: INTEGER; r: Texts.Reader; ch: CHAR; keys: SET; exec: ExecMsg; BEGIN keys := msg.keys; cmd := e.def; Show(msg.frame, e, msg.pos, msg.X0, msg.Y0, cmd, keys); IF keys = {MM, MR} THEN OpenEditor(e) ELSIF (keys # cancel) & (cmd > -1) THEN e.def := cmd; Texts.OpenReader(r, e.menu, 0); Texts.Read(r, ch); WHILE cmd > 0 DO IF ch = CR THEN DEC(cmd) END; Texts.Read(r, ch) END; exec.frame := msg.frame; exec.pos := Texts.Pos(r)-1; exec.keys := keys; e.handle(e, exec) END END Popup;  (* element *) PROCEDURE Handle*(e: Texts.Elem; VAR msg: Texts.ElemMsg); VAR copy: Elem; BEGIN WITH e: Elem DO WITH msg: TextFrames.DisplayMsg DO IF msg.prepare THEN PrepareDraw(e, msg.fnt, msg.Y0) ELSE DrawElem(e, msg.frame, msg.pos, msg.fnt, msg.col, msg.X0, msg.Y0) END | msg: TextPrinter.PrintMsg DO IF ~msg.prepare THEN PrintElem(e, msg.fnt, msg.X0, msg.Y0) END | msg: Texts.CopyMsg DO IF msg.e = NIL THEN NEW(copy); msg.e := copy ELSE copy := msg.e(Elem) END; Texts.CopyElem(e, copy); copy.name := e.name; copy.menu := CopyText(e.menu); copy.n := e.n; copy.def := e.def; copy.wid := e.wid; copy.lsp := e.lsp; copy.dsc := e.dsc; copy.small := e.small; msg.e := copy | msg: Texts.IdentifyMsg DO msg.mod := "PopupElems"; msg.proc := "Alloc" | msg: Texts.FileMsg DO IF msg.id = Texts.load THEN Load(msg.r, e); MeasureMenu(e) ELSIF msg.id = Texts.store THEN Store(msg.r, e) END | msg: TextFrames.TrackMsg DO IF msg.keys = {MM} THEN Popup(e, msg); msg.keys := {} END | msg: ExecMsg DO ExecCmd(e, msg.frame, msg.pos, msg.keys) ELSE END END END Handle; PROCEDURE Alloc*; VAR e: Elem; BEGIN NEW(e); e.handle := Handle; Texts.new := e END Alloc;  (** commands **)  PROCEDURE insert(small: BOOLEAN); VAR e: Elem; ins: TextFrames.InsertElemMsg; BEGIN NEW(e); GetName(e, Oberon.Par.text, Oberon.Par.pos); e.small := small; e.menu := TextFrames.Text(""); DefaultMenu(e); MeasureMenu(e); e.handle := Handle; ins.e := e; Viewers.Broadcast(ins) END insert; PROCEDURE Insert*; BEGIN insert(FALSE) END Insert; PROCEDURE InsertMenu*; BEGIN insert(TRUE) END InsertMenu; PROCEDURE Toggle*; (** "Menu" | "Line" Change option of element(s) in frame below or in selected text *) VAR E: Elem; t: Texts.Text; pos: LONGINT; BEGIN IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN E := Oberon.Par.frame.next(EditFrame).elem; E.small := ~E.small; t := Texts.ElemBase(E); pos := Texts.ElemPos(E); t.notify(t, Texts.replace, pos, pos+1) END END Toggle; PROCEDURE Update*; VAR f: EditFrame; e: Elem; s: Texts.Scanner; menuText, text: Texts.Text; pos: LONGINT; BEGIN IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN f := Oberon.Par.frame.next(EditFrame); e := f.elem; menuText := Oberon.Par.frame(TextFrames.Frame).text; GetName(e, menuText, 0); Texts.OpenScanner(s, menuText, 0); Texts.Scan(s); IF ~(s.class IN {Texts.Name, Texts.String}) OR (s.s[0] = 0X) THEN s.s := "Popup" END; COPY(s.s, e.name); e.menu := CopyText(f.text); MeasureMenu(e); text := Texts.ElemBase(e); IF text # NIL THEN pos := Texts.ElemPos(e); text.notify(text, Texts.replace, pos, pos+1); Texts.OpenReader(s, menuText, menuText.len-1); Texts.Read(s, s.c); IF s.c = "!" THEN Texts.Delete(menuText, menuText.len-1, menuText.len) END END END END Update; BEGIN NEW(buf); Texts.OpenBuf(buf); Texts.OpenWriter(wr) END PopupElems.