MODULE SimpleGui; IMPORT G := Graph, Strings, Out; CONST (** Align **) alLeft* = 0; alCenter* = 1; alRight* = 2; TYPE Widget* = POINTER TO WidgetDesc; Message* = RECORD END; PutMsg* = RECORD(Message) what*: Widget; x*, y*: INTEGER END; DrawMsg* = RECORD(Message) x*, y*, w*, h*: INTEGER END; MouseMoveMsg* = RECORD(Message) x*, y*: INTEGER; btns*: SET END; MouseDownMsg* = RECORD(Message) x*, y*, btn*: INTEGER END; MouseUpMsg* = RECORD(Message) x*, y*, btn*: INTEGER END; MouseEnterMsg* = RECORD(Message) END; MouseLeaveMsg* = RECORD(Message) END; ClickMsg* = RECORD(Message) END; GetFocusMsg* = RECORD(Message) END; LostFocusMsg* = RECORD(Message) END; KeyDownMsg* = RECORD(Message) key*: INTEGER END; KeyUpMsg* = RECORD(Message) key*: INTEGER END; CharMsg* = RECORD(Message) key*: INTEGER; ch*: CHAR; mod*: SET; repeat*: BOOLEAN END; Handler* = PROCEDURE (c: Widget; VAR msg: Message); WidgetDesc* = RECORD x*, y*, w*, h*: INTEGER; bgColor*, fgColor*: G.Color; redraw*: BOOLEAN; (** TRUE if widget or it's insides need to be redrawn *) redrawSelf*: BOOLEAN; (** TRUE if widget itself needs to be redrawn *) visible*: BOOLEAN; enabled*: BOOLEAN; focusable*: BOOLEAN; (** TRUE if widget can get focus *) focused*: BOOLEAN; (** TRUE if this widget is globally in focus *) hovered*: BOOLEAN; (** TRUE if mouse pointer is over the widget *) pressed*: BOOLEAN; (** TRUE if widget is held down with LMB *) body*: Widget; (** A ring of widgets that this widget contains *) parent*: Widget; (** A widget that this widget is contained in *) prev*, next*: Widget; handle*: Handler; onPaint*: PROCEDURE (c: Widget; x, y, w, h: INTEGER); onMouseDown*: PROCEDURE (c: Widget; x, y, btn: INTEGER); onMouseUp*: PROCEDURE (c: Widget; x, y, btn: INTEGER); onMouseMove*: PROCEDURE (c: Widget; x, y: INTEGER; btns: SET); onMouseEnter*: PROCEDURE (c: Widget); onMouseLeave*: PROCEDURE (c: Widget); onClick*: PROCEDURE (c: Widget); onKeyDown*: PROCEDURE (c: Widget; key: INTEGER); onKeyUp*: PROCEDURE (c: Widget; key: INTEGER); onChar*: PROCEDURE (c: Widget; key: INTEGER; ch: CHAR; mod: SET; repeat: BOOLEAN); END; App* = POINTER TO AppDesc; AppDesc* = RECORD(WidgetDesc) END; Form* = POINTER TO FormDesc; FormDesc* = RECORD(WidgetDesc) END; Panel* = POINTER TO PanelDesc; PanelDesc* = RECORD(WidgetDesc) noBg*: BOOLEAN END; Button* = POINTER TO ButtonDesc; ButtonDesc* = RECORD(WidgetDesc) caption*: ARRAY 64 OF CHAR END; Label* = POINTER TO LabelDesc; LabelDesc* = RECORD(WidgetDesc) caption*: ARRAY 256 OF CHAR; align*: INTEGER; (** One of {alLeft, alCenter, alRight} *) END; Edit* = POINTER TO EditDesc; EditDesc* = RECORD(WidgetDesc) text*: ARRAY 256 OF CHAR; len*: INTEGER; (** Length of text in characters *) pos*: INTEGER; (** Position of text carret, in range [0; len] *) off*: INTEGER (** Used to slide text that does not fit, normal is 0 *) END; ScrollBar* = POINTER TO ScrollBarDesc; ScrollBarDesc* = RECORD(WidgetDesc) vertical*: BOOLEAN; (** TRUE for vertical scroll, FALSE for horizontal *) min*, max*: INTEGER; value*: INTEGER; (** The position of the scroll, in range [min; max] *) inc*, bigInc*: INTEGER; (** A single increment of value, and a big one *) btnSize*: INTEGER; (** Width or height (depending on vertical) of buttons *) handlePos*, handleSize*: INTEGER; (** Size and position of handle, px *) handlePressed*: BOOLEAN; handlePressPos*: INTEGER; (** Where handle was pressed, offset in px *) btnPressed*: INTEGER; (** 0-nothing, 1-less btn, 2-more btn, 3-handle *) onScroll*: PROCEDURE (c: ScrollBar; value: INTEGER); END; ScrollBox* = POINTER TO ScrollBoxDesc; ScrollBoxDesc* = RECORD(WidgetDesc) noBg*: BOOLEAN; outer*, inner*: Panel; scbHorz*, scbVert*: ScrollBar END; Canvas* = POINTER TO CanvasDesc; CanvasDesc = RECORD(WidgetDesc) bmp*: G.Bitmap END; VAR Done*: BOOLEAN; (** FALSE after a failed opration and before the next Init *) app*: App; focusedWidget*: Widget; (** The widget with focus = TRUE *) font*: G.Font; quit: BOOLEAN; (** Main loop in procedure Run ends when TRUE *) forceFlip: BOOLEAN; (** Becomes TRUE on mouse move and FALSE after Flip *) hoveredWidget: Widget; pressedWidget: Widget; pressedX, pressedY: INTEGER; (** Widget **) PROCEDURE Redraw*(c: Widget); VAR p: Widget; BEGIN c.redraw := TRUE; c.redrawSelf := TRUE; p := c.parent; WHILE (p # NIL) & ~p.redraw DO p.redraw := TRUE; p := p.parent END END Redraw; PROCEDURE Drawn*(c: Widget); BEGIN c.redraw := FALSE; c.redrawSelf := FALSE END Drawn; PROCEDURE FindHoveredInRing(list: Widget; x, y: INTEGER; forMouseDown: BOOLEAN): Widget; VAR c: Widget; BEGIN IF list # NIL THEN c := list.prev; WHILE (c # NIL) & ~((c.x <= x) & (x < c.x + c.w) & (c.y <= y) & (y < c.y + c.h)) DO IF c = list THEN c := NIL ELSE c := c.prev END END; IF forMouseDown & (c # NIL) THEN INC(pressedX, c.x); INC(pressedY, c.y) END ELSE c := NIL END RETURN c END FindHoveredInRing; PROCEDURE WidgetOnMouseEnter*(c: Widget); VAR msg: MouseEnterMsg; BEGIN IF pressedWidget = c THEN c.pressed := TRUE END; c.hovered := TRUE; c.handle(c, msg) END WidgetOnMouseEnter; PROCEDURE WidgetOnMouseLeave*(c: Widget); VAR msg: MouseLeaveMsg; BEGIN c.hovered := FALSE; c.pressed := FALSE; c.handle(c, msg) END WidgetOnMouseLeave; PROCEDURE WidgetOnMouseMove*(c: Widget; x, y: INTEGER; btns: SET); VAR msg: MouseMoveMsg; BEGIN IF (0 <= x) & (x < c.w) & (0 <= y) & (y < c.h) THEN IF c # hoveredWidget THEN IF hoveredWidget # NIL THEN WidgetOnMouseLeave(hoveredWidget) END; hoveredWidget := c; WidgetOnMouseEnter(hoveredWidget) END ELSIF c = hoveredWidget THEN WidgetOnMouseLeave(c); hoveredWidget := NIL END; msg.x := x; msg.y := y; msg.btns := btns; c.handle(c, msg); IF c.onMouseMove # NIL THEN c.onMouseMove(c, x, y, btns) END END WidgetOnMouseMove; PROCEDURE WidgetHandleMouseMove*(c: Widget; x, y: INTEGER; btns: SET); VAR p: Widget; BEGIN IF pressedWidget # NIL THEN WidgetOnMouseMove(pressedWidget, x - pressedX, y - pressedY, btns) ELSE p := FindHoveredInRing(c.body, x, y, FALSE); IF p # NIL THEN WidgetHandleMouseMove(p, x - p.x, y - p.y, btns) ELSE WidgetOnMouseMove(c, x, y, btns) END END END WidgetHandleMouseMove; PROCEDURE Resize*(c: Widget; w, h: INTEGER); BEGIN c.w := w; c.h := h END Resize; PROCEDURE Focus*(c: Widget); VAR get: GetFocusMsg; lost: LostFocusMsg; BEGIN IF ((c = NIL) OR c.focusable) & (focusedWidget # c) THEN IF focusedWidget # NIL THEN focusedWidget.focused := FALSE; focusedWidget.handle(focusedWidget, lost) END; IF c # NIL THEN c.focused := TRUE; focusedWidget := c; focusedWidget.handle(focusedWidget, get) END END END Focus; PROCEDURE Detach*(c: Widget); VAR p: Widget; BEGIN IF c.parent # NIL THEN IF c.prev = c THEN c.parent.body := NIL ELSE c.prev.next := c.next; c.next.prev := c.prev END; c.parent := NIL END; c.prev := NIL; c.next := NIL END Detach; PROCEDURE AppendTo*(c: Widget; container: Widget); VAR r: Widget; BEGIN Detach(c); c.parent := container; r := container.body; IF r = NIL THEN container.body := c; c.prev := c; c.next := c ELSE c.next := r; c.prev := r.prev; r.prev.next := c; r.prev := c END END AppendTo; PROCEDURE DirectPut*(c, where: Widget; x, y: INTEGER); BEGIN IF c # NIL THEN c.x := x; c.y := y; IF where # NIL THEN AppendTo(c, where) END END END DirectPut; PROCEDURE Put*(c, where: Widget; x, y: INTEGER); VAR msg: PutMsg; BEGIN IF c # NIL THEN c.x := x; c.y := y; IF where # NIL THEN msg.what := c; msg.x := x; msg.y := y; where.handle(where, msg) END END END Put; PROCEDURE WidgetOnMouseDown*(c: Widget; x, y, btn: INTEGER); VAR msg: MouseDownMsg; BEGIN pressedWidget := c; Focus(c); msg.x := x; msg.y := y; msg.btn := btn; c.handle(c, msg); IF c.onMouseDown # NIL THEN c.onMouseDown(c, x, y, btn) END END WidgetOnMouseDown; PROCEDURE WidgetHandleMouseDown*(c: Widget; x, y, btn: INTEGER); VAR p: Widget; BEGIN p := FindHoveredInRing(c.body, x, y, TRUE); IF p # NIL THEN WidgetHandleMouseDown(p, x - p.x, y - p.y, btn) ELSE WidgetOnMouseDown(c, x, y, btn) END END WidgetHandleMouseDown; PROCEDURE WidgetOnMouseUp*(c: Widget; x, y, btn: INTEGER); VAR msg: MouseUpMsg; BEGIN pressedWidget := NIL; msg.x := x; msg.y := y; msg.btn := btn; c.handle(c, msg); IF c.onMouseUp # NIL THEN c.onMouseUp(c, x, y, btn) END END WidgetOnMouseUp; PROCEDURE WidgetOnClick*(c: Widget); VAR msg: ClickMsg; BEGIN c.handle(c, msg); IF c.onClick # NIL THEN c.onClick(c) END END WidgetOnClick; PROCEDURE WidgetHandler*(c: Widget; VAR msg: Message); VAR x, y: INTEGER; BEGIN IF msg IS DrawMsg THEN IF c.redraw THEN IF c.redrawSelf THEN x := msg(DrawMsg).x; y := msg(DrawMsg).y; IF c.onPaint = NIL THEN G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor); G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor); G.Rect(x + 2, y + 2, x + c.w - 3, y + c.h - 3, c.fgColor) END; Drawn(c) END END ELSIF msg IS MouseDownMsg THEN IF msg(MouseDownMsg).btn = 1 THEN c.pressed := TRUE; Redraw(c) END ELSIF msg IS MouseUpMsg THEN c.pressed := FALSE; Redraw(c) ELSIF msg IS PutMsg THEN DirectPut(msg(PutMsg).what, c, msg(PutMsg).x, msg(PutMsg).y) ELSIF msg IS GetFocusMsg THEN Redraw(c) ELSIF msg IS LostFocusMsg THEN Redraw(c) END END WidgetHandler; PROCEDURE DrawWidget*(c: Widget; x, y, w, h: INTEGER); VAR M: DrawMsg; BEGIN M.x := x; M.y := y; M.w := w; M.h := h; c.handle(c, M); IF c.onPaint # NIL THEN c.onPaint(c, x, y, w, h); END END DrawWidget; PROCEDURE DrawBody*(c: Widget; x, y, w, h: INTEGER; forced: BOOLEAN); VAR p: Widget; x2, y2, w2, h2: INTEGER; cx, cy, cw, ch: INTEGER; CX, CY, CW, CH: INTEGER; BEGIN p := c.body; IF p # NIL THEN G.GetClip(CX, CY, CW, CH); IF CX + CW > x + w THEN CW := x + w - CX END; IF CY + CH > y + h THEN CH := y + h - CY END; IF CX < x THEN DEC(CW, x - CX); CX := x END; IF CY < y THEN DEC(CH, y - CY); CY := y END; REPEAT IF forced THEN p.redraw := TRUE; p.redrawSelf := TRUE END; IF p.redraw & p.visible THEN x2 := x + p.x; y2 := y + p.y; w2 := w - p.x; h2 := h - p.y; cx := x2; cy := y2; cw := p.w; ch := p.h; IF cx + cw > CX + CW THEN cw := CX + CW - cx END; IF cy + ch > CY + CH THEN ch := CY + CH - cy END; IF cx < CX THEN DEC(cw, CX - cx); cx := CX END; IF cy < CY THEN DEC(ch, CY - cy); cy := CY END; G.SetClip(cx, cy, cw, ch); DrawWidget(p, x2, y2, p.w, p.h) END; p := p.next UNTIL p = c.body; G.UnsetClip END END DrawBody; PROCEDURE SetBgColor*(c: Widget; color: G.Color); BEGIN c.bgColor := color END SetBgColor; PROCEDURE SetFgColor*(c: Widget; color: G.Color); BEGIN c.fgColor := color END SetFgColor; PROCEDURE SetVisible*(c: Widget; visible: BOOLEAN); BEGIN c.visible := visible END SetVisible; PROCEDURE SetEnabled*(c: Widget; enabled: BOOLEAN); BEGIN c.enabled := enabled END SetEnabled; PROCEDURE SetOnPaint*(c: Widget; proc: PROCEDURE (c: Widget; x, y, w, h: INTEGER)); BEGIN c.onPaint := proc END SetOnPaint; PROCEDURE SetOnMouseMove*(c: Widget; proc: PROCEDURE (c: Widget; x, y: INTEGER; btns: SET)); BEGIN c.onMouseMove := proc END SetOnMouseMove; PROCEDURE SetOnMouseDown*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER)); BEGIN c.onMouseDown := proc END SetOnMouseDown; PROCEDURE SetOnMouseUp*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER)); BEGIN c.onMouseUp := proc END SetOnMouseUp; PROCEDURE SetOnClick*(c: Widget; proc: PROCEDURE (c: Widget)); BEGIN c.onClick := proc END SetOnClick; PROCEDURE InitWidget*(c: Widget; w, h: INTEGER); BEGIN c.x := 0; c.y := 0; c.w := w; c.h := h; c.redraw := TRUE; c.redrawSelf := TRUE; c.visible := TRUE; c.enabled := TRUE; c.focusable := FALSE; c.focused := FALSE; c.hovered := FALSE; c.pressed := FALSE; G.MakeCol(c.bgColor, 180, 180, 180); G.MakeCol(c.fgColor, 0, 0, 0); c.handle := WidgetHandler END InitWidget; (** Creates and returns a new custom widget *) PROCEDURE NewWidget*(where: Widget; x, y, w, h: INTEGER): Widget; VAR c: Widget; BEGIN NEW(c); InitWidget(c, w, h); Put(c, where, x, y) RETURN c END NewWidget; (** Panel **) PROCEDURE PanelSetNoBg*(c: Panel; noBg: BOOLEAN); BEGIN c.noBg := noBg; Redraw(c) END PanelSetNoBg; PROCEDURE PanelHandler*(c: Widget; VAR msg: Message); VAR x, y: INTEGER; BEGIN IF msg IS DrawMsg THEN IF c.redraw THEN x := msg(DrawMsg).x; y := msg(DrawMsg).y; IF c.redrawSelf & ~c(Panel).noBg THEN G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor) END; DrawBody(c, x, y, c.w, c.h, c.redrawSelf); Drawn(c) END ELSE WidgetHandler(c, msg) END END PanelHandler; PROCEDURE InitPanel*(c: Panel; where: Widget; x, y, w, h: INTEGER); BEGIN InitWidget(c, w, h); c.noBg := FALSE; c.handle := PanelHandler; Put(c, where, x, y) END InitPanel; PROCEDURE NewPanel*(where: Widget; x, y, w, h: INTEGER): Panel; VAR c: Panel; BEGIN NEW(c); InitPanel(c, where, x, y, w, h) RETURN c END NewPanel; (** App **) PROCEDURE InitApp*(c: App); VAR W, H: INTEGER; BEGIN G.GetScreenSize(W, H); InitWidget(c, W, H) END InitApp; PROCEDURE NewApp*(): App; VAR c: App; BEGIN NEW(c); InitApp(c) RETURN c END NewApp; (** Form **) PROCEDURE DrawForm*(c: Form); BEGIN IF c.redraw THEN IF c.redrawSelf THEN G.FillRect(c.x, c.y, c.x + c.w - 1, c.y + c.h - 1, c.bgColor) END; DrawBody(c, c.x, c.y, c.w, c.h, c.redrawSelf); Drawn(c) END END DrawForm; PROCEDURE FormHandler*(c: Widget; VAR msg: Message); BEGIN WidgetHandler(c, msg) END FormHandler; PROCEDURE InitForm*(c: Form; x, y, w, h: INTEGER); BEGIN InitWidget(c, w, h); c.x := x; c.y := y; c.handle := FormHandler; AppendTo(c, app) END InitForm; PROCEDURE NewForm*(x, y, w, h: INTEGER): Form; VAR c: Form; BEGIN NEW(c); InitForm(c, x, y, w, h) RETURN c END NewForm; (** Button **) PROCEDURE MakeOrAndYw(bg: G.Color; VAR or, yw: G.Color); VAR r, g, b: INTEGER; BEGIN G.ColorToRGB(bg, r, g, b); G.MakeCol(yw, (r + 255 * 2) DIV 3, (g + 255 * 3) DIV 4, (b * 3 + 255) DIV 4); IF (r <= g) & (r <= b) THEN g := (g * 2 + 255 * 3) DIV 5; b := (b * 3 + 255) DIV 4 ELSIF (g <= r) & (g <= b) THEN r := (r * 2 + 255 * 3) DIV 5; b := (b * 3 + 255) DIV 4 ELSE r := (r * 2 + 255 * 3) DIV 5; g := (g * 3 + 255) DIV 4 END; G.MakeCol(or, r, g, b) END MakeOrAndYw; PROCEDURE DrawButtonBox(x, y, w, h: INTEGER; bg, parentBg: G.Color; down, glow: BOOLEAN); VAR wh, bl, g1, g2, or, yw: G.Color; X, Y: INTEGER; BEGIN G.MakeCol(bl, 0, 0, 0); G.MakeCol(wh, 255, 255, 255); G.MakeCol(g1, 140, 140, 140); G.MakeCol(g2, 80, 80, 80); MakeOrAndYw(parentBg, or, yw); X := x + w - 1; Y := y + h - 1; G.FillRect(x + 1, y + 1, X - 2, Y - 2, bg); G.HLine(x + 2, y, X - 1, bl); G.HLine(x, Y - 1, X - 4, bl); G.VLine(x, y + 2, Y - 1, bl); G.VLine(X - 1, y + 1, Y - 3, bl); IF ~down THEN G.HLine(x + 3, y + 1, X - 2, wh); G.HLine(x + 2, Y - 2, X - 4, g1); G.VLine(x + 1, y + 3, Y - 2, wh); G.VLine(X - 2, y + 2, Y - 3, g1); G.PutPixel(X - 3, Y - 3, g1); G.Line(X - 4, Y - 3, X - 3, Y - 4, g1); G.PutPixel(x + 2, y + 2, wh) END; G.Line(X - 3, Y - 2, X - 2, Y - 3, bl); G.Line(X - 3, Y - 1, X - 1, Y - 3, g2); G.Line(x + 1, y + 2, x + 2, y + 1, g1); G.PutPixel(x + 1, y + 1, bl); IF glow THEN G.Line(X - 2, Y - 1, X - 1, Y - 2, yw); G.HLine(x + 1, Y, X - 2, or); G.VLine(X, y + 1, Y - 2, or); G.PutPixel(X - 1, Y - 1, or) END END DrawButtonBox; PROCEDURE DrawButton*(c: Button; x, y, w, h: INTEGER); VAR fw, fh, tw, tx, ty: INTEGER; BEGIN IF c.redraw THEN DrawButtonBox(x, y, c.w, c.h, c.bgColor, c.parent.bgColor, c.pressed & c.hovered, TRUE); G.GetMonoFontSize(font, fw, fh); tw := Strings.Length(c.caption) * fw; tx := x + (c.w - tw) DIV 2; ty := y + (c.h - fh) DIV 2; IF c.pressed & c.hovered THEN INC(tx); INC(ty) END; G.DrawString(c.caption, tx, ty, font, c.fgColor); Drawn(c) END END DrawButton; PROCEDURE ButtonHandler*(c: Widget; VAR msg: Message); VAR b: Button; BEGIN b := c(Button); IF msg IS DrawMsg THEN DrawButton(b, msg(DrawMsg).x, msg(DrawMsg).y, msg(DrawMsg).w, msg(DrawMsg).h); ELSE WidgetHandler(c, msg) END END ButtonHandler; PROCEDURE InitButton*(c: Button; where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR); BEGIN InitWidget(c, w, h); Strings.Copy(caption, c.caption); c.focusable := TRUE; c.handle := ButtonHandler; Put(c, where, x, y) END InitButton; PROCEDURE NewButton*(where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR): Button; VAR c: Button; BEGIN NEW(c); InitButton(c, where, x, y, w, h, caption) RETURN c END NewButton; (** Label **) PROCEDURE DrawLabel*(c: Label; x, y, w, h: INTEGER); VAR fw, fh, tw, tx, ty: INTEGER; BEGIN IF c.redraw THEN G.GetMonoFontSize(font, fw, fh); tx := 0; IF c.align # alLeft THEN tw := Strings.Length(c.caption) * fw; IF c.align = alCenter THEN tx := (c.w - tw) DIV 2 ELSIF c.align = alRight THEN tx := c.w - tw END END; ty := y + (c.h - fh) DIV 2; G.DrawString(c.caption, tx, ty, font, c.fgColor); Drawn(c) END END DrawLabel; PROCEDURE LabelHandler*(c: Widget; VAR msg: Message); VAR e: Label; BEGIN e := c(Label); IF msg IS DrawMsg THEN DrawLabel(e, msg(DrawMsg).x, msg(DrawMsg).y, msg(DrawMsg).w, msg(DrawMsg).h) ELSE WidgetHandler(c, msg) END END LabelHandler; PROCEDURE InitLabel*(c: Label; where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR); BEGIN InitWidget(c, w, h); Strings.Copy(caption, c.caption); c.handle := LabelHandler; c.align := alLeft; Put(c, where, x, y) END InitLabel; PROCEDURE NewLabel*(where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR): Label; VAR c: Label; BEGIN NEW(c); InitLabel(c, where, x, y, w, h, caption) RETURN c END NewLabel; PROCEDURE LabelSetCaption*(c: Label; caption: ARRAY OF CHAR); BEGIN Strings.Copy(caption, c.caption); Redraw(c) END LabelSetCaption; PROCEDURE LabelSetAlign*(c: Label; align: INTEGER); BEGIN c.align := align; Redraw(c) END LabelSetAlign; (** Edit **) PROCEDURE DrawEdit*(c: Edit; x, y, w, h: INTEGER); VAR fw, fh, tw, tx, ty: INTEGER; or, yw: G.Color; BEGIN IF c.redraw THEN MakeOrAndYw(c.parent.bgColor, or, yw); G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor); G.GetMonoFontSize(font, fw, fh); tw := Strings.Length(c.text) * fw; tx := x + 2 - c.off; ty := y + (c.h - fh) DIV 2; G.DrawString(c.text, tx, ty, font, c.fgColor); IF c.focused THEN INC(tx, fw * c.pos - 1); G.VLine(tx, ty, ty + fh - 1, or); G.HLine(tx - 1, ty, tx + 1, or); G.HLine(tx - 1, ty + fh - 1, tx + 1, or) END; G.HLine(x, y, x + c.w - 2, c.fgColor); G.VLine(x, y, y + c.h - 1, c.fgColor); G.HLine(x + 1, y + c.h - 1, x + c.w - 1, or); G.VLine(x + c.w - 1, y, y + c.h - 1, or); Drawn(c) END END DrawEdit; PROCEDURE EditOnMouseDown*(c: Edit; VAR msg: MouseDownMsg); VAR n, fw, fh: INTEGER; BEGIN IF (msg.btn = 1) & (msg.x > 0) & (msg.x < c.w - 1) & (msg.y > 0) & (msg.y < c.h - 1) THEN G.GetMonoFontSize(font, fw, fh); n := (msg.x - 2 + fw DIV 2) DIV fw; IF n < 0 THEN n := 0 ELSIF n > c.len THEN n := c.len END; IF c.pos # n THEN c.pos := n; Redraw(c) END END END EditOnMouseDown; PROCEDURE EditCheckOffset(c: Edit); VAR n, fw, fh: INTEGER; BEGIN G.GetMonoFontSize(font, fw, fh); n := c.pos * fw - c.off; IF c.len * fw <= c.w - 4 THEN c.off := 0 ELSIF n < 0 THEN c.off := c.pos * fw ELSIF n >= c.w - 4 THEN c.off := c.pos * fw - c.w + 4 ELSIF c.len * fw - c.off <= c.w - 4 THEN c.off := c.len * fw - c.w + 4 END END EditCheckOffset; PROCEDURE EditOnChar*(c: Edit; VAR msg: CharMsg); VAR i: INTEGER; BEGIN IF msg.key = G.kBackspace THEN IF c.pos > 0 THEN Strings.Delete(c.text, c.pos - 1, 1); DEC(c.len); DEC(c.pos) END ELSIF msg.key = G.kDel THEN IF c.pos < c.len THEN Strings.Delete(c.text, c.pos, 1); DEC(c.len) END ELSIF msg.ch < ' ' THEN IF msg.key = G.kLeft THEN DEC(c.pos) ELSIF msg.key = G.kRight THEN INC(c.pos) ELSIF msg.key = G.kHome THEN c.pos := 0 ELSIF msg.key = G.kEnd THEN c.pos := c.len END; IF c.pos < 0 THEN c.pos := 0 ELSIF c.pos > c.len THEN c.pos := c.len END ELSIF c.len < LEN(c.text) - 1 THEN c.text[c.len + 1] := 0X; i := c.len; WHILE i > c.pos DO c.text[i] := c.text[i - 1]; DEC(i) END; c.text[c.pos] := msg.ch; INC(c.len); INC(c.pos) END; EditCheckOffset(c); Redraw(c) END EditOnChar; PROCEDURE EditHandler*(c: Widget; VAR msg: Message); VAR e: Edit; BEGIN e := c(Edit); IF msg IS DrawMsg THEN DrawEdit(e, msg(DrawMsg).x, msg(DrawMsg).y, msg(DrawMsg).w, msg(DrawMsg).h) ELSIF msg IS MouseDownMsg THEN EditOnMouseDown(e, msg(MouseDownMsg)) ELSIF msg IS CharMsg THEN EditOnChar(e, msg(CharMsg)) ELSE WidgetHandler(c, msg) END END EditHandler; PROCEDURE InitEdit*(c: Edit; where: Widget; x, y, w, h: INTEGER); BEGIN InitWidget(c, w, h); c.focusable := TRUE; G.MakeCol(c.bgColor, 255, 255, 255); c.text[0] := 0X; c.len := 0; c.pos := 0; c.off := 0; c.handle := EditHandler; Put(c, where, x, y) END InitEdit; PROCEDURE NewEdit*(where: Widget; x, y, w, h: INTEGER): Edit; VAR c: Edit; BEGIN NEW(c); InitEdit(c, where, x, y, w, h) RETURN c END NewEdit; PROCEDURE EditSetText*(c: Edit; text: ARRAY OF CHAR); BEGIN Strings.Copy(text, c.text); c.len := Strings.Length(text); c.pos := 0; c.off := 0; Redraw(c) END EditSetText; PROCEDURE EditGetText*(c: Edit; VAR text: ARRAY OF CHAR); BEGIN Strings.Copy(c.text, text) END EditGetText; (** ScrollBar **) PROCEDURE DrawBox(x, y, w, h: INTEGER; bg, fg: G.Color); BEGIN G.FillRect(x, y, x + w - 1, y + h - 1, bg); G.Rect(x, y, x + w - 1, y + h - 1, fg) END DrawBox; PROCEDURE ScrollBarCalcMetrics(c: ScrollBar; long, wide: INTEGER; VAR hs, bs: INTEGER); VAR maxHs, maxBs, pos, range: INTEGER; BEGIN maxBs := long DIV 2; IF maxBs > 20 THEN maxBs := 20 END; bs := wide; IF bs > maxBs THEN bs := maxBs END; c.btnSize := bs; maxHs := long - bs * 2 + 4; hs := c.handleSize; IF hs < bs THEN hs := bs END; IF hs > maxHs THEN hs := maxHs END; c.handleSize := hs; pos := c.value; IF pos < c.min THEN pos := c.min ELSIF pos > c.max THEN pos := c.max END; range := c.max - c.min; c.handlePos := bs - 2; IF range # 0 THEN INC(c.handlePos, (pos * (maxHs - hs) + range DIV 2) DIV range) END END ScrollBarCalcMetrics; PROCEDURE DrawHorzScrollBar(c: ScrollBar; x, y, w, h: INTEGER); VAR fw, fh, X, Y: INTEGER; hs, bs: INTEGER; (* Handle size and button size *) grey: G.Color; BEGIN G.MakeCol(grey, 140, 140, 140); DrawButtonBox(x, y, c.w, c.h, grey, c.parent.bgColor, TRUE, TRUE); ScrollBarCalcMetrics(c, w, h, hs, bs); DrawButtonBox(x, y, bs, c.h, c.bgColor, c.parent.bgColor, c.btnPressed = 1, FALSE); DrawButtonBox(x + c.w - bs, y, bs, c.h, c.bgColor, c.parent.bgColor, c.btnPressed = 2, TRUE); X := x + (bs - 1) DIV 2; Y := y + (bs - 1) DIV 2; IF c.btnPressed = 1 THEN INC(X); INC(Y) END; G.HLine(X - 4, Y, X + 4, c.fgColor); G.Line(X - 4, Y, X - 1, Y + 3, c.fgColor); G.Line(X - 4, Y, X - 1, Y - 3, c.fgColor); X := x + c.w - bs DIV 2 - 1; IF c.btnPressed = 1 THEN DEC(Y) END; IF c.btnPressed = 2 THEN INC(X); INC(Y) END; G.HLine(X - 4, Y, X + 4, c.fgColor); G.Line(X + 4, Y, X + 1, Y + 3, c.fgColor); G.Line(X + 4, Y, X + 1, Y - 3, c.fgColor); DrawButtonBox(x + c.handlePos, y, hs, c.h, c.bgColor, c.parent.bgColor, c.btnPressed = 3, FALSE) END DrawHorzScrollBar; PROCEDURE DrawVertScrollBar(c: ScrollBar; x, y, w, h: INTEGER); VAR fw, fh, X, Y: INTEGER; hs, bs: INTEGER; (* Handle size and button size *) grey: G.Color; BEGIN G.MakeCol(grey, 140, 140, 140); DrawButtonBox(x, y, c.w, c.h, grey, c.parent.bgColor, TRUE, TRUE); ScrollBarCalcMetrics(c, h, w, hs, bs); DrawButtonBox(x, y, c.w, bs, c.bgColor, c.parent.bgColor, c.btnPressed = 1, FALSE); DrawButtonBox(x, y + c.h - bs, c.w, bs, c.bgColor, c.parent.bgColor, c.btnPressed = 2, TRUE); X := x + (bs - 1) DIV 2; Y := y + (bs - 1) DIV 2; IF c.btnPressed = 1 THEN INC(X); INC(Y) END; G.VLine(X, Y - 4, Y + 4, c.fgColor); G.Line(X, Y - 4, X + 3, Y - 1, c.fgColor); G.Line(X, Y - 4, X - 3, Y - 1, c.fgColor); Y := y + c.h - bs DIV 2 - 1; IF c.btnPressed = 1 THEN DEC(X) END; IF c.btnPressed = 2 THEN INC(X); INC(Y) END; G.VLine(X, Y - 4, Y + 4, c.fgColor); G.Line(X, Y + 4, X + 3, Y + 1, c.fgColor); G.Line(X, Y + 4, X - 3, Y + 1, c.fgColor); DrawButtonBox(x, y + c.handlePos, c.w, hs, c.bgColor, c.parent.bgColor, c.btnPressed = 3, FALSE) END DrawVertScrollBar; PROCEDURE DrawScrollBar*(c: ScrollBar; x, y, w, h: INTEGER); BEGIN IF c.vertical THEN DrawVertScrollBar(c, x, y, w, h) ELSE DrawHorzScrollBar(c, x, y, w, h) END; Drawn(c) END DrawScrollBar; PROCEDURE ScrollBarSetVertical*(c: ScrollBar; vertical: BOOLEAN); BEGIN c.vertical := vertical; Redraw(c) END ScrollBarSetVertical; PROCEDURE ScrollBarSetHandleSize*(c: ScrollBar; size: INTEGER); BEGIN c.handleSize := size; Redraw(c) END ScrollBarSetHandleSize; PROCEDURE ScrollBarSetValue*(c: ScrollBar; value: INTEGER); BEGIN IF (value < c.min) OR (c.min >= c.max) THEN value := c.min ELSIF value > c.max THEN value := c.max END; IF c.value # value THEN c.value := value; IF c.onScroll # NIL THEN c.onScroll(c, value) END; Redraw(c) END END ScrollBarSetValue; PROCEDURE HandleScrollBarMouseMove(c: ScrollBar; VAR msg: MouseMoveMsg); VAR n, x, size, w: INTEGER; BEGIN IF c.handlePressed THEN IF c.vertical THEN x := msg.y; size := c.h ELSE x := msg.x; size := c.w END; w := size - c.btnSize * 2 - c.handleSize + 4; IF w = 0 THEN n := c.min ELSE n := x - c.handlePressPos - c.btnSize + 2; n := (n * (c.max - c.min) + w DIV 2) DIV w + c.min; END; ScrollBarSetValue(c, n) END END HandleScrollBarMouseMove; PROCEDURE HandleScrollBarMouseDown(c: ScrollBar; VAR msg: MouseDownMsg); VAR x, d, size: INTEGER; BEGIN IF c.vertical THEN x := msg.y; size := c.h ELSE x := msg.x; size := c.w END; IF msg.btn = 2 THEN d := 1 ELSE d := c.inc END; IF x < c.btnSize THEN c.btnPressed := 1(*Less btn*); ScrollBarSetValue(c, c.value - d); Redraw(c) ELSIF x >= size - c.btnSize THEN c.btnPressed := 2(*More btn*); ScrollBarSetValue(c, c.value + d); Redraw(c) ELSIF msg.btn = 1 THEN IF (c.handlePos <= x) & (x < c.handlePos + c.handleSize) THEN c.btnPressed := 3(*Handle*); c.handlePressed := TRUE; c.handlePressPos := x - c.handlePos ELSIF x < c.handlePos THEN ScrollBarSetValue(c, c.value - c.bigInc) ELSE ScrollBarSetValue(c, c.value + c.bigInc) END; Redraw(c) ELSE c.btnPressed := 0(*Nothing*); END; WidgetHandler(c, msg) END HandleScrollBarMouseDown; PROCEDURE HandleScrollBarMouseUp(c: ScrollBar; VAR msg: MouseUpMsg); BEGIN c.handlePressed := FALSE; c.btnPressed := 0(*Nothing*); Redraw(c) END HandleScrollBarMouseUp; PROCEDURE ScrollBarHandler*(c: Widget; VAR msg: Message); VAR s: ScrollBar; BEGIN s := c(ScrollBar); IF msg IS DrawMsg THEN DrawScrollBar(s, msg(DrawMsg).x, msg(DrawMsg).y, msg(DrawMsg).w, msg(DrawMsg).h) ELSIF msg IS MouseMoveMsg THEN HandleScrollBarMouseMove(s, msg(MouseMoveMsg)) ELSIF msg IS MouseDownMsg THEN HandleScrollBarMouseDown(s, msg(MouseDownMsg)) ELSIF msg IS MouseUpMsg THEN HandleScrollBarMouseUp(s, msg(MouseUpMsg)) ELSE WidgetHandler(c, msg) END END ScrollBarHandler; PROCEDURE InitScrollBar*(c: ScrollBar; where: Widget; x, y, w, h: INTEGER); BEGIN InitWidget(c, w, h); c.handle := ScrollBarHandler; c.value := 0; c.min := 0; c.max := 100; c.inc := 5; c.bigInc := 20; c.handlePos := 0; c.handleSize := 0; c.btnSize := 0; c.btnPressed := 0(*Nothing*); Put(c, where, x, y) END InitScrollBar; PROCEDURE NewScrollBar*(where: Widget; x, y, w, h: INTEGER): ScrollBar; VAR c: ScrollBar; BEGIN NEW(c); InitScrollBar(c, where, x, y, w, h) RETURN c END NewScrollBar; PROCEDURE ScrollBarSetOnScroll*(c: ScrollBar; proc: PROCEDURE (c: ScrollBar; value: INTEGER)); BEGIN c.onScroll := proc END ScrollBarSetOnScroll; (** ScrollBox **) PROCEDURE ScrollBoxSetNoBg*(c: ScrollBox; noBg: BOOLEAN); BEGIN PanelSetNoBg(c.inner, noBg) END ScrollBoxSetNoBg; PROCEDURE ScrollBoxHandler*(c: Widget; VAR msg: Message); BEGIN IF msg IS DrawMsg THEN IF c.redraw THEN DrawBody(c, msg(DrawMsg).x, msg(DrawMsg).y, c.w, c.h, c.redrawSelf); Drawn(c) END ELSIF msg IS PutMsg THEN DirectPut(msg(PutMsg).what, c(ScrollBox).inner, msg(PutMsg).x, msg(PutMsg).y) ELSE WidgetHandler(c, msg) END END ScrollBoxHandler; PROCEDURE ScrollBoxSetInnerSize*(c: ScrollBox; w, h: INTEGER); BEGIN Resize(c.inner, w, h); c.scbHorz.max := w - c.w + 16; c.scbVert.max := h - c.h + 16; IF (c.scbHorz.max > 0) & (w > 0) THEN SetVisible(c.scbHorz, TRUE); c.outer.h := c.h - c.scbHorz.h ELSE SetVisible(c.scbHorz, FALSE); c.outer.h := c.h END; c.scbVert.h := c.outer.h; IF (c.scbVert.max > 0) & (h > 0) THEN SetVisible(c.scbVert, TRUE); c.outer.w := c.w - c.scbVert.w ELSE SetVisible(c.scbVert, FALSE); c.outer.w := c.w END; c.scbHorz.w := c.outer.w; IF w > 0 THEN ScrollBarSetHandleSize(c.scbHorz, c.outer.w * (c.outer.w - 30) DIV w) END; IF h > 0 THEN ScrollBarSetHandleSize(c.scbVert, c.outer.h * (c.outer.h - 30) DIV h) END; Redraw(c) END ScrollBoxSetInnerSize; PROCEDURE ScrollBoxOnHorzScroll*(c: ScrollBar; value: INTEGER); VAR sbx: ScrollBox; BEGIN sbx := c.parent(ScrollBox); sbx.inner.x := -value; Redraw(sbx) END ScrollBoxOnHorzScroll; PROCEDURE ScrollBoxOnVertScroll*(c: ScrollBar; value: INTEGER); VAR sbx: ScrollBox; BEGIN sbx := c.parent(ScrollBox); sbx.inner.y := -value; Redraw(sbx) END ScrollBoxOnVertScroll; PROCEDURE InitScrollBox*(c: ScrollBox; where: Widget; x, y, w, h: INTEGER); BEGIN InitWidget(c, w, h); c.handle := ScrollBoxHandler; c.scbHorz := NewScrollBar(NIL, 0, 0, w - 16, 16); DirectPut(c.scbHorz, c, 0, h - 16); ScrollBarSetOnScroll(c.scbHorz, ScrollBoxOnHorzScroll); c.scbVert := NewScrollBar(NIL, 0, 0, 16, h - 16); ScrollBarSetVertical(c.scbVert, TRUE); DirectPut(c.scbVert, c, w - 16, 0); ScrollBarSetOnScroll(c.scbVert, ScrollBoxOnVertScroll); c.outer := NewPanel(NIL, 0, 0, w - 16, h - 16); DirectPut(c.outer, c, 0, 0); PanelSetNoBg(c.outer, TRUE); c.inner := NewPanel(c.outer, 0, 0, 1, 1); ScrollBoxSetInnerSize(c, c.outer.w, c.outer.h); Put(c, where, x, y) END InitScrollBox; PROCEDURE NewScrollBox*(where: Widget; x, y, w, h: INTEGER): ScrollBox; VAR c: ScrollBox; BEGIN NEW(c); InitScrollBox(c, where, x, y, w, h) RETURN c END NewScrollBox; (** Canvas **) PROCEDURE CanvasHandler*(c: Widget; VAR msg: Message); VAR x, y: INTEGER; BEGIN IF msg IS DrawMsg THEN IF c.redraw THEN x := msg(DrawMsg).x; y := msg(DrawMsg).y; IF c.redrawSelf THEN G.Draw(c(Canvas).bmp, x, y) END; DrawBody(c, x, y, c.w, c.h, c.redrawSelf); Drawn(c) END ELSE WidgetHandler(c, msg) END END CanvasHandler; PROCEDURE InitCanvas*(c: Canvas; where: Widget; x, y, w, h: INTEGER); VAR wh: G.Color; BEGIN InitWidget(c, w, h); c.bmp := G.NewBitmap(w, h); G.MakeCol(wh, 255, 255, 255); G.ClearBitmapToColor(c.bmp, wh); c.handle := CanvasHandler; Put(c, where, x, y) END InitCanvas; PROCEDURE NewCanvas*(where: Widget; x, y, w, h: INTEGER): Canvas; VAR c: Canvas; BEGIN NEW(c); InitCanvas(c, where, x, y, w, h) RETURN c END NewCanvas; (** General **) PROCEDURE DrawAll; VAR c: Widget; updated: BOOLEAN; BEGIN G.TargetScreen; updated := FALSE; c := app.body; REPEAT IF c.redraw THEN DrawForm(c(Form)); updated := TRUE END; c := c.next UNTIL c = app.body; IF updated OR forceFlip THEN G.Flip; G.Delay(4); forceFlip := FALSE ELSE G.Delay(4) END END DrawAll; PROCEDURE HandleMouseMove(VAR e: G.Event); VAR c: Widget; BEGIN forceFlip := TRUE; c := FindHoveredInRing(app.body, e.x, e.y, FALSE); IF c # NIL THEN WidgetHandleMouseMove(c, e.x - c.x, e.y - c.y, e.buttons) END END HandleMouseMove; PROCEDURE HandleMouseDown(VAR e: G.Event); VAR c: Widget; BEGIN pressedX := 0; pressedY := 0; c := FindHoveredInRing(app.body, e.x, e.y, TRUE); IF c # NIL THEN WidgetHandleMouseDown(c, e.x - c.x, e.y - c.y, e.button) END END HandleMouseDown; PROCEDURE HandleMouseUp(VAR e: G.Event); VAR c: Widget; BEGIN IF pressedWidget # NIL THEN c := pressedWidget; IF ~c.hovered THEN c := NIL END; WidgetOnMouseUp(pressedWidget, e.x - pressedX, e.y - pressedY, e.button); IF (c # NIL) & (e.button = 1) THEN WidgetOnClick(c) END END END HandleMouseUp; PROCEDURE HandleKeyDown(VAR e: G.Event); VAR msg: KeyDownMsg; BEGIN IF focusedWidget # NIL THEN msg.key := e.key; focusedWidget.handle(focusedWidget, msg) END END HandleKeyDown; PROCEDURE HandleKeyUp(VAR e: G.Event); VAR msg: KeyUpMsg; BEGIN IF focusedWidget # NIL THEN msg.key := e.key; focusedWidget.handle(focusedWidget, msg) END END HandleKeyUp; PROCEDURE HandleChar(VAR e: G.Event); VAR msg: CharMsg; BEGIN IF focusedWidget # NIL THEN msg.key := e.key; msg.ch := e.ch; msg.mod := e.mod; msg.repeat := e.repeat; focusedWidget.handle(focusedWidget, msg) END END HandleChar; PROCEDURE HandleEvent(VAR e: G.Event); BEGIN IF e.type = G.quit THEN quit := TRUE ELSIF e.type = G.mouseMove THEN HandleMouseMove(e) ELSIF e.type = G.mouseDown THEN HandleMouseDown(e) ELSIF e.type = G.mouseUp THEN HandleMouseUp(e) ELSIF e.type = G.keyDown THEN HandleKeyDown(e) ELSIF e.type = G.keyUp THEN HandleKeyUp(e) ELSIF e.type = G.char THEN HandleChar(e) END END HandleEvent; PROCEDURE Quit*; BEGIN quit := TRUE END Quit; PROCEDURE Run*; VAR e: G.Event; BEGIN quit := FALSE; REPEAT WHILE ~quit & G.HasEvents() DO G.WaitEvent(e); HandleEvent(e) END; DrawAll UNTIL quit END Run; PROCEDURE InitCursor; VAR m: G.Bitmap; bl, wh: G.Color; i: INTEGER; BEGIN m := G.NewBitmap(10, 16); G.ClearBitmap(m); G.Target(m); G.MakeCol(bl, 0, 0, 0); G.MakeCol(wh, 255, 255, 255); G.PutPixel(1, 1, wh); FOR i := 2 TO 8 DO G.HLine(1, i, i, wh) END; G.HLine(1, 9, 5, wh); G.HLine(1, 10, 5, wh); G.PutPixel(1, 11, wh); G.HLine(5, 11, 6, wh); G.HLine(5, 12, 6, wh); G.HLine(6, 13, 7, wh); G.HLine(6, 14, 7, wh); G.Line(1, 0, 9, 8, bl); G.VLine(0, 1, 12, bl); G.Line(1, 12, 3, 10, bl); G.Line(4, 11, 5, 14, bl); G.HLine(6, 15, 7, bl); G.Line(6, 9, 8, 14, bl); G.HLine(7, 9, 9, bl); G.SetNewCursor(m, 0, 0) END InitCursor; PROCEDURE Init*; BEGIN font := G.LoadFont('Data/Fonts/Main'); IF font = NIL THEN font := G.LoadFont('../Data/Fonts/Main') END; IF font = NIL THEN Out.String('SimpleGui: Could not load font.'); Out.Ln END; InitCursor; Done := font # NIL; app := NewApp(); hoveredWidget := NIL; pressedWidget := NIL; forceFlip := TRUE; pressedX := 0; pressedY := 0 END Init; END SimpleGui.