123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748 |
- MODULE SimpleGui;
- IMPORT G := Graph, Strings, Out;
- TYPE
- Widget* = POINTER TO WidgetDesc;
- Message* = RECORD END;
- DrawMsg* = RECORD(Message) x*, y*, w*, h*: INTEGER END;
- MouseMoveMsg* = RECORD(Message) x*, y*, btn*: INTEGER 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;
- 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; (** Ring *)
- prev*, next*, parent*: Widget;
- handle*: Handler;
- onMouseDown*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
- onMouseUp*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
- onMouseMove*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
- 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;
- Panel* = POINTER TO PanelDesc;
- PanelDesc* = RECORD(WidgetDesc) END;
- Form* = POINTER TO FormDesc;
- FormDesc* = RECORD(PanelDesc) END;
- Button* = POINTER TO ButtonDesc;
- ButtonDesc* = RECORD(WidgetDesc)
- caption*: ARRAY 64 OF CHAR
- ;X*, Y*: INTEGER
- 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 *)
- handlePos*, handleSize*: INTEGER; (** Size and position of handle, px *)
- handlePressed*: BOOLEAN;
- handlePressPos*: INTEGER; (** Where handle was pressed, offset in px *)
- onScroll*: PROCEDURE (c: Widget; value: INTEGER);
- END;
- VAR
- Done*: BOOLEAN; (** FALSE after a failed opration and before the next Init *)
- forms*: Widget;
- focusedWidget*: Widget; (** The widget with focus = TRUE *)
- font*: G.Font;
- quit: BOOLEAN; (** Main loop in procedure Run ends when TRUE *)
- hoveredWidget: Widget;
- pressedWidget: Widget;
- pressedX, pressedY: INTEGER;
- (** Widget **)
- PROCEDURE FindHoveredInList(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 FindHoveredInList;
- 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, btn: INTEGER);
- 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.btn := btn;
- c.handle(c, msg);
- IF c.onMouseMove # NIL THEN c.onMouseMove(c, x, y, btn) END
- END WidgetOnMouseMove;
- PROCEDURE WidgetHandleMouseMove*(c: Widget; x, y, btn: INTEGER);
- VAR p: Widget;
- BEGIN
- IF pressedWidget # NIL THEN
- WidgetOnMouseMove(pressedWidget, x - pressedX, y - pressedY, btn)
- ELSE
- p := FindHoveredInList(c.body, x, y, FALSE);
- IF p # NIL THEN
- WidgetHandleMouseMove(p, x - p.x, y - p.y, btn)
- ELSE
- WidgetOnMouseMove(c, x, y, btn)
- END
- END
- END WidgetHandleMouseMove;
- PROCEDURE Focus*(c: Widget);
- VAR get: GetFocusMsg;
- lost: LostFocusMsg;
- BEGIN
- IF c.focusable THEN
- IF focusedWidget # NIL THEN
- focusedWidget.focused := FALSE;
- focusedWidget.handle(focusedWidget, lost)
- END;
- c.focused := TRUE;
- focusedWidget := c;
- focusedWidget.handle(focusedWidget, get)
- END
- END Focus;
- 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 := FindHoveredInList(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
- x := msg(DrawMsg).x; y := msg(DrawMsg).y;
- 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)
- ELSIF msg IS MouseDownMsg THEN
- IF msg(MouseDownMsg).btn = 1 THEN c.pressed := TRUE END
- ELSIF msg IS MouseUpMsg THEN c.pressed := FALSE
- 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)
- END DrawWidget;
- PROCEDURE DrawBody*(c: Widget; x, y, w, h: INTEGER);
- VAR p: Widget;
- x2, y2, w2, h2: INTEGER;
- cx, cy, cw, ch: INTEGER;
- BEGIN
- p := c.body;
- IF p # NIL THEN
- REPEAT
- 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 > 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;
- G.SetClip(cx, cy, cw, ch);
- DrawWidget(p, x2, y2, p.w, p.h);
- 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 SetOnMouseMove*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
- 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.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;
- PROCEDURE AppendToRing*(c: Widget; VAR ring: Widget);
- BEGIN
- IF ring = NIL THEN
- ring := c;
- c.prev := c; c.next := c
- ELSE
- c.next := ring; c.prev := ring.prev;
- ring.prev.next := c; ring.prev := c
- END
- END AppendToRing;
- PROCEDURE Put*(c, where: Widget; x, y: INTEGER);
- VAR p: Widget;
- BEGIN
- IF (c # NIL) & (where # NIL) THEN
- c.x := x; c.y := y;
- AppendToRing(c, where.body)
- END
- END Put;
- (** Panel **)
- PROCEDURE PanelHandler*(c: Widget; VAR msg: Message);
- VAR x, y: INTEGER;
- BEGIN
- IF msg IS DrawMsg THEN
- x := msg(DrawMsg).x; y := msg(DrawMsg).y;
- G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
- DrawBody(c, x, y, c.w, c.h)
- ELSE WidgetHandler(c, msg)
- END
- END PanelHandler;
- PROCEDURE InitPanel*(c: Panel; where: Widget; x, y, w, h: INTEGER);
- BEGIN InitWidget(c, w, h);
- 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;
- (** Form **)
- PROCEDURE DrawForm*(c: Form);
- BEGIN
- G.FillRect(c.x, c.y, c.x + c.w - 1, c.y + c.h - 1, c.bgColor);
- DrawBody(c, c.x, c.y, c.w, c.h)
- 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 InitPanel(c, NIL, x, y, w, h);
- c.handle := FormHandler;
- AppendToRing(c, forms)
- 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 DrawButton*(c: Button; x, y, w, h: INTEGER);
- VAR fw, fh, tw, tx, ty: INTEGER;
- down: BOOLEAN;
- Z: G.Color;
- BEGIN
- down := c.pressed & c.hovered;
- G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
- ;G.MakeCol(Z, 255, 128, 0);
- ;G.Line(x + c.h DIV 4, y + c.h DIV 2, x + c.X, y + c.Y, Z);
- ;G.MakeCol(Z, 215, 0, 0);
- ;G.Line(x + c.h DIV 4, y + c.h DIV 2 + 1, x + c.X, y + c.Y + 1, Z);
- G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor);
- IF ~down THEN
- G.Rect(x, y, x + c.w - 2, y + c.h - 2, c.fgColor)
- END;
- 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 down THEN INC(tx); INC(ty) END;
- G.DrawString(c.caption, tx, ty, font, c.fgColor)
- END DrawButton;
- PROCEDURE BMM(c: Button; x, y: INTEGER);
- BEGIN
- c.X := x; c.Y := y
- END BMM;
- 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)
- ELSIF msg IS MouseMoveMsg THEN BMM(b, msg(MouseMoveMsg).x, msg(MouseMoveMsg).y)
- 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)
- ;c.X := 0; c.Y := 0;
- 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;
- (** Edit **)
- PROCEDURE DrawEdit*(c: Edit; x, y, w, h: INTEGER);
- VAR fw, fh, tw, tx, ty: INTEGER;
- down: BOOLEAN;
- red: G.Color;
- BEGIN
- 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
- G.MakeCol(red, 250, 0, 0);
- INC(tx, fw * c.pos - 1);
- G.VLine(tx, ty, ty + fh - 1, red);
- G.HLine(tx - 1, ty, tx + 1, red);
- G.HLine(tx - 1, ty + fh - 1, tx + 1, red)
- END;
- G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor)
- 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;
- c.pos := n
- 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)
- 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 := 'Привет'; c.len := 6; c.pos := 2; 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)
- END EditSetText;
- (** 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 DrawScrollBar*(c: ScrollBar; x, y, w, h: INTEGER);
- VAR fw, fh, X, Y, hs, maxHs, pos, range: INTEGER;
- grey: G.Color;
- BEGIN
- G.MakeCol(grey, 80, 80, 80);
- DrawBox(x, y, c.w, c.h, grey, c.fgColor);
- DrawBox(x, y, c.h, c.h, c.bgColor, c.fgColor);
- DrawBox(x + c.w - c.h, y, c.h, c.h, c.bgColor, c.fgColor);
- X := x + c.h DIV 2; Y := y + c.h DIV 2;
- 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 - c.h DIV 2;
- 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);
- hs := c.handleSize;
- maxHs := c.w - c.h * 2 + 2;
- IF hs > maxHs THEN hs := maxHs END;
- range := c.max - c.min;
- pos := c.value;
- IF pos < c.min THEN pos := c.min ELSIF pos > c.max THEN pos := c.max END;
- c.handlePos := c.h - 1 + ((maxHs - hs) * pos + range DIV 2) DIV range;
- DrawBox(x + c.handlePos, y, hs, c.h, c.bgColor, c.fgColor);
- END DrawScrollBar;
- PROCEDURE SetScrollBarValue*(c: ScrollBar; value: INTEGER);
- BEGIN
- IF value < c.min THEN value := c.min
- ELSIF value > c.max THEN value := c.max
- END;
- c.value := value;
- IF c.onScroll # NIL THEN c.onScroll(c, value) END
- END SetScrollBarValue;
- PROCEDURE HandleScrollBarMouseMove(c: ScrollBar; VAR msg: MouseMoveMsg);
- VAR n, x, size, btnSize, w: INTEGER;
- BEGIN
- IF c.handlePressed THEN
- x := msg.x; size := c.w; btnSize := c.h;
- w := size - btnSize * 2 - c.handleSize;
- n := x - c.handlePressPos - btnSize;
- n := (n * (c.max - c.min) + w DIV 2) DIV w + c.min;
- SetScrollBarValue(c, n)
- END
- END HandleScrollBarMouseMove;
- PROCEDURE HandleScrollBarMouseDown(c: ScrollBar; VAR msg: MouseDownMsg);
- VAR x, d, size, btnSize: INTEGER;
- BEGIN
- x := msg.x; size := c.w; btnSize := c.h;
- IF msg.btn = 2 THEN d := 1 ELSE d := c.inc END;
- IF x < btnSize THEN
- SetScrollBarValue(c, c.value - d)
- ELSIF x >= size - btnSize THEN
- SetScrollBarValue(c, c.value + d)
- ELSIF msg.btn = 1 THEN
- IF (c.handlePos <= x) & (x < c.handlePos + c.handleSize) THEN
- c.handlePressed := TRUE;
- c.handlePressPos := x - c.handlePos
- ELSIF x < c.handlePos THEN
- SetScrollBarValue(c, c.value - c.bigInc)
- ELSE
- SetScrollBarValue(c, c.value + c.bigInc)
- END
- END;
- WidgetHandler(c, msg)
- END HandleScrollBarMouseDown;
- 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 s.handlePressed := FALSE
- 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 := 24;
- 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 SetOnScroll*(c: ScrollBar; proc: PROCEDURE (c: Widget; value: INTEGER));
- BEGIN c.onScroll := proc
- END SetOnScroll;
- (** General **)
- PROCEDURE DrawAll*;
- VAR c: Widget;
- BEGIN
- c := forms;
- REPEAT
- DrawForm(c(Form));
- c := c.next
- UNTIL c = forms;
- G.Flip
- END DrawAll;
- PROCEDURE HandleMouseMove(VAR e: G.Event);
- VAR c: Widget;
- BEGIN
- c := FindHoveredInList(forms, e.x, e.y, FALSE);
- IF c # NIL THEN
- WidgetHandleMouseMove(c, e.x - c.x, e.y - c.y, e.button)
- END
- END HandleMouseMove;
- PROCEDURE HandleMouseDown(VAR e: G.Event);
- VAR c: Widget;
- BEGIN
- pressedX := 0; pressedY := 0;
- c := FindHoveredInList(forms, 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 Run*;
- VAR e: G.Event;
- BEGIN
- quit := FALSE;
- REPEAT
- WHILE G.HasEvents() DO
- G.WaitEvent(e);
- HandleEvent(e)
- END;
- DrawAll
- UNTIL quit
- END Run;
- PROCEDURE Init*;
- BEGIN
- forms := NIL;
- font := G.LoadFont('Data/Fonts/Main');
- IF font = NIL THEN Out.String('SimpleGui: could not load font.'); Out.Ln END;
- Done := font # NIL;
- hoveredWidget := NIL; pressedWidget := NIL;
- pressedX := 0; pressedY := 0
- END Init;
- END SimpleGui.
|