SimpleGui.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748
  1. MODULE SimpleGui;
  2. IMPORT G := Graph, Strings, Out;
  3. TYPE
  4. Widget* = POINTER TO WidgetDesc;
  5. Message* = RECORD END;
  6. DrawMsg* = RECORD(Message) x*, y*, w*, h*: INTEGER END;
  7. MouseMoveMsg* = RECORD(Message) x*, y*, btn*: INTEGER END;
  8. MouseDownMsg* = RECORD(Message) x*, y*, btn*: INTEGER END;
  9. MouseUpMsg* = RECORD(Message) x*, y*, btn*: INTEGER END;
  10. MouseEnterMsg* = RECORD(Message) END;
  11. MouseLeaveMsg* = RECORD(Message) END;
  12. ClickMsg* = RECORD(Message) END;
  13. GetFocusMsg* = RECORD(Message) END;
  14. LostFocusMsg* = RECORD(Message) END;
  15. KeyDownMsg* = RECORD(Message) key*: INTEGER END;
  16. KeyUpMsg* = RECORD(Message) key*: INTEGER END;
  17. CharMsg* = RECORD(Message)
  18. key*: INTEGER;
  19. ch*: CHAR;
  20. mod*: SET;
  21. repeat*: BOOLEAN
  22. END;
  23. Handler* = PROCEDURE (c: Widget; VAR msg: Message);
  24. WidgetDesc* = RECORD
  25. x*, y*, w*, h*: INTEGER;
  26. bgColor*, fgColor*: G.Color;
  27. focusable*: BOOLEAN; (** TRUE if widget can get focus *)
  28. focused*: BOOLEAN; (** TRUE if this widget is globally in focus *)
  29. hovered*: BOOLEAN; (** TRUE if mouse pointer is over the widget *)
  30. pressed*: BOOLEAN; (** TRUE if widget is held down with LMB *)
  31. body*: Widget; (** Ring *)
  32. prev*, next*, parent*: Widget;
  33. handle*: Handler;
  34. onMouseDown*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
  35. onMouseUp*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
  36. onMouseMove*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
  37. onMouseEnter*: PROCEDURE (c: Widget);
  38. onMouseLeave*: PROCEDURE (c: Widget);
  39. onClick*: PROCEDURE (c: Widget);
  40. onKeyDown*: PROCEDURE (c: Widget; key: INTEGER);
  41. onKeyUp*: PROCEDURE (c: Widget; key: INTEGER);
  42. onChar*: PROCEDURE (c: Widget; key: INTEGER; ch: CHAR; mod: SET; repeat: BOOLEAN);
  43. END;
  44. Panel* = POINTER TO PanelDesc;
  45. PanelDesc* = RECORD(WidgetDesc) END;
  46. Form* = POINTER TO FormDesc;
  47. FormDesc* = RECORD(PanelDesc) END;
  48. Button* = POINTER TO ButtonDesc;
  49. ButtonDesc* = RECORD(WidgetDesc)
  50. caption*: ARRAY 64 OF CHAR
  51. ;X*, Y*: INTEGER
  52. END;
  53. Edit* = POINTER TO EditDesc;
  54. EditDesc* = RECORD(WidgetDesc)
  55. text*: ARRAY 256 OF CHAR;
  56. len*: INTEGER; (** Length of text in characters *)
  57. pos*: INTEGER; (** Position of text carret, in range [0; len] *)
  58. off*: INTEGER (** Used to slide text that does not fit, normal is 0 *)
  59. END;
  60. ScrollBar* = POINTER TO ScrollBarDesc;
  61. ScrollBarDesc* = RECORD(WidgetDesc)
  62. vertical*: BOOLEAN; (** TRUE for vertical scroll, FALSE for horizontal *)
  63. min*, max*: INTEGER;
  64. value*: INTEGER; (** The position of the scroll, in range [min; max] *)
  65. inc*, bigInc*: INTEGER; (** A single increment of value, and a big one *)
  66. handlePos*, handleSize*: INTEGER; (** Size and position of handle, px *)
  67. handlePressed*: BOOLEAN;
  68. handlePressPos*: INTEGER; (** Where handle was pressed, offset in px *)
  69. onScroll*: PROCEDURE (c: Widget; value: INTEGER);
  70. END;
  71. VAR
  72. Done*: BOOLEAN; (** FALSE after a failed opration and before the next Init *)
  73. forms*: Widget;
  74. focusedWidget*: Widget; (** The widget with focus = TRUE *)
  75. font*: G.Font;
  76. quit: BOOLEAN; (** Main loop in procedure Run ends when TRUE *)
  77. hoveredWidget: Widget;
  78. pressedWidget: Widget;
  79. pressedX, pressedY: INTEGER;
  80. (** Widget **)
  81. PROCEDURE FindHoveredInList(list: Widget; x, y: INTEGER;
  82. forMouseDown: BOOLEAN): Widget;
  83. VAR c: Widget;
  84. BEGIN
  85. IF list # NIL THEN
  86. c := list.prev;
  87. WHILE (c # NIL) &
  88. ~((c.x <= x) & (x < c.x + c.w) &
  89. (c.y <= y) & (y < c.y + c.h))
  90. DO
  91. IF c = list THEN c := NIL ELSE c := c.prev END
  92. END;
  93. IF forMouseDown & (c # NIL) THEN
  94. INC(pressedX, c.x); INC(pressedY, c.y)
  95. END
  96. ELSE c := NIL
  97. END
  98. RETURN c END FindHoveredInList;
  99. PROCEDURE WidgetOnMouseEnter*(c: Widget);
  100. VAR msg: MouseEnterMsg;
  101. BEGIN
  102. IF pressedWidget = c THEN c.pressed := TRUE END;
  103. c.hovered := TRUE;
  104. c.handle(c, msg)
  105. END WidgetOnMouseEnter;
  106. PROCEDURE WidgetOnMouseLeave*(c: Widget);
  107. VAR msg: MouseLeaveMsg;
  108. BEGIN
  109. c.hovered := FALSE;
  110. c.pressed := FALSE;
  111. c.handle(c, msg)
  112. END WidgetOnMouseLeave;
  113. PROCEDURE WidgetOnMouseMove*(c: Widget; x, y, btn: INTEGER);
  114. VAR msg: MouseMoveMsg;
  115. BEGIN
  116. IF (0 <= x) & (x < c.w) & (0 <= y) & (y < c.h) THEN
  117. IF c # hoveredWidget THEN
  118. IF hoveredWidget # NIL THEN WidgetOnMouseLeave(hoveredWidget) END;
  119. hoveredWidget := c;
  120. WidgetOnMouseEnter(hoveredWidget)
  121. END
  122. ELSIF c = hoveredWidget THEN
  123. WidgetOnMouseLeave(c);
  124. hoveredWidget := NIL
  125. END;
  126. msg.x := x; msg.y := y; msg.btn := btn;
  127. c.handle(c, msg);
  128. IF c.onMouseMove # NIL THEN c.onMouseMove(c, x, y, btn) END
  129. END WidgetOnMouseMove;
  130. PROCEDURE WidgetHandleMouseMove*(c: Widget; x, y, btn: INTEGER);
  131. VAR p: Widget;
  132. BEGIN
  133. IF pressedWidget # NIL THEN
  134. WidgetOnMouseMove(pressedWidget, x - pressedX, y - pressedY, btn)
  135. ELSE
  136. p := FindHoveredInList(c.body, x, y, FALSE);
  137. IF p # NIL THEN
  138. WidgetHandleMouseMove(p, x - p.x, y - p.y, btn)
  139. ELSE
  140. WidgetOnMouseMove(c, x, y, btn)
  141. END
  142. END
  143. END WidgetHandleMouseMove;
  144. PROCEDURE Focus*(c: Widget);
  145. VAR get: GetFocusMsg;
  146. lost: LostFocusMsg;
  147. BEGIN
  148. IF c.focusable THEN
  149. IF focusedWidget # NIL THEN
  150. focusedWidget.focused := FALSE;
  151. focusedWidget.handle(focusedWidget, lost)
  152. END;
  153. c.focused := TRUE;
  154. focusedWidget := c;
  155. focusedWidget.handle(focusedWidget, get)
  156. END
  157. END Focus;
  158. PROCEDURE WidgetOnMouseDown*(c: Widget; x, y, btn: INTEGER);
  159. VAR msg: MouseDownMsg;
  160. BEGIN
  161. pressedWidget := c;
  162. Focus(c);
  163. msg.x := x; msg.y := y; msg.btn := btn;
  164. c.handle(c, msg);
  165. IF c.onMouseDown # NIL THEN c.onMouseDown(c, x, y, btn) END
  166. END WidgetOnMouseDown;
  167. PROCEDURE WidgetHandleMouseDown*(c: Widget; x, y, btn: INTEGER);
  168. VAR p: Widget;
  169. BEGIN
  170. p := FindHoveredInList(c.body, x, y, TRUE);
  171. IF p # NIL THEN
  172. WidgetHandleMouseDown(p, x - p.x, y - p.y, btn)
  173. ELSE
  174. WidgetOnMouseDown(c, x, y, btn)
  175. END
  176. END WidgetHandleMouseDown;
  177. PROCEDURE WidgetOnMouseUp*(c: Widget; x, y, btn: INTEGER);
  178. VAR msg: MouseUpMsg;
  179. BEGIN
  180. pressedWidget := NIL;
  181. msg.x := x; msg.y := y; msg.btn := btn;
  182. c.handle(c, msg);
  183. IF c.onMouseUp # NIL THEN c.onMouseUp(c, x, y, btn) END
  184. END WidgetOnMouseUp;
  185. PROCEDURE WidgetOnClick*(c: Widget);
  186. VAR msg: ClickMsg;
  187. BEGIN c.handle(c, msg);
  188. IF c.onClick # NIL THEN c.onClick(c) END
  189. END WidgetOnClick;
  190. PROCEDURE WidgetHandler*(c: Widget; VAR msg: Message);
  191. VAR x, y: INTEGER;
  192. BEGIN
  193. IF msg IS DrawMsg THEN
  194. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  195. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  196. G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor);
  197. G.Rect(x + 2, y + 2, x + c.w - 3, y + c.h - 3, c.fgColor)
  198. ELSIF msg IS MouseDownMsg THEN
  199. IF msg(MouseDownMsg).btn = 1 THEN c.pressed := TRUE END
  200. ELSIF msg IS MouseUpMsg THEN c.pressed := FALSE
  201. END
  202. END WidgetHandler;
  203. PROCEDURE DrawWidget*(c: Widget; x, y, w, h: INTEGER);
  204. VAR M: DrawMsg;
  205. BEGIN
  206. M.x := x; M.y := y; M.w := w; M.h := h;
  207. c.handle(c, M)
  208. END DrawWidget;
  209. PROCEDURE DrawBody*(c: Widget; x, y, w, h: INTEGER);
  210. VAR p: Widget;
  211. x2, y2, w2, h2: INTEGER;
  212. cx, cy, cw, ch: INTEGER;
  213. BEGIN
  214. p := c.body;
  215. IF p # NIL THEN
  216. REPEAT
  217. x2 := x + p.x; y2 := y + p.y;
  218. w2 := w - p.x; h2 := h - p.y;
  219. cx := x2; cy := y2; cw := p.w; ch := p.h;
  220. IF cx + cw > x + w THEN cw := x + w - cx END;
  221. IF cy + ch > y + h THEN ch := y + h - cy END;
  222. IF cx < x THEN DEC(cw, x - cx); cx := x END;
  223. IF cy < y THEN DEC(ch, y - cy); cy := y END;
  224. G.SetClip(cx, cy, cw, ch);
  225. DrawWidget(p, x2, y2, p.w, p.h);
  226. p := p.next
  227. UNTIL p = c.body;
  228. G.UnsetClip
  229. END
  230. END DrawBody;
  231. PROCEDURE SetBgColor*(c: Widget; color: G.Color);
  232. BEGIN c.bgColor := color
  233. END SetBgColor;
  234. PROCEDURE SetFgColor*(c: Widget; color: G.Color);
  235. BEGIN c.fgColor := color
  236. END SetFgColor;
  237. PROCEDURE SetOnMouseMove*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
  238. BEGIN c.onMouseMove := proc
  239. END SetOnMouseMove;
  240. PROCEDURE SetOnMouseDown*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
  241. BEGIN c.onMouseDown := proc
  242. END SetOnMouseDown;
  243. PROCEDURE SetOnMouseUp*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
  244. BEGIN c.onMouseUp := proc
  245. END SetOnMouseUp;
  246. PROCEDURE SetOnClick*(c: Widget; proc: PROCEDURE (c: Widget));
  247. BEGIN c.onClick := proc
  248. END SetOnClick;
  249. PROCEDURE InitWidget*(c: Widget; w, h: INTEGER);
  250. BEGIN c.x := 0; c.y := 0; c.w := w; c.h := h;
  251. c.focusable := FALSE; c.focused := FALSE;
  252. c.hovered := FALSE; c.pressed := FALSE;
  253. G.MakeCol(c.bgColor, 180, 180, 180);
  254. G.MakeCol(c.fgColor, 0, 0, 0);
  255. c.handle := WidgetHandler
  256. END InitWidget;
  257. PROCEDURE AppendToRing*(c: Widget; VAR ring: Widget);
  258. BEGIN
  259. IF ring = NIL THEN
  260. ring := c;
  261. c.prev := c; c.next := c
  262. ELSE
  263. c.next := ring; c.prev := ring.prev;
  264. ring.prev.next := c; ring.prev := c
  265. END
  266. END AppendToRing;
  267. PROCEDURE Put*(c, where: Widget; x, y: INTEGER);
  268. VAR p: Widget;
  269. BEGIN
  270. IF (c # NIL) & (where # NIL) THEN
  271. c.x := x; c.y := y;
  272. AppendToRing(c, where.body)
  273. END
  274. END Put;
  275. (** Panel **)
  276. PROCEDURE PanelHandler*(c: Widget; VAR msg: Message);
  277. VAR x, y: INTEGER;
  278. BEGIN
  279. IF msg IS DrawMsg THEN
  280. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  281. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  282. DrawBody(c, x, y, c.w, c.h)
  283. ELSE WidgetHandler(c, msg)
  284. END
  285. END PanelHandler;
  286. PROCEDURE InitPanel*(c: Panel; where: Widget; x, y, w, h: INTEGER);
  287. BEGIN InitWidget(c, w, h);
  288. c.handle := PanelHandler;
  289. Put(c, where, x, y)
  290. END InitPanel;
  291. PROCEDURE NewPanel*(where: Widget; x, y, w, h: INTEGER): Panel;
  292. VAR c: Panel;
  293. BEGIN NEW(c); InitPanel(c, where, x, y, w, h)
  294. RETURN c END NewPanel;
  295. (** Form **)
  296. PROCEDURE DrawForm*(c: Form);
  297. BEGIN
  298. G.FillRect(c.x, c.y, c.x + c.w - 1, c.y + c.h - 1, c.bgColor);
  299. DrawBody(c, c.x, c.y, c.w, c.h)
  300. END DrawForm;
  301. PROCEDURE FormHandler*(c: Widget; VAR msg: Message);
  302. BEGIN WidgetHandler(c, msg)
  303. END FormHandler;
  304. PROCEDURE InitForm*(c: Form; x, y, w, h: INTEGER);
  305. BEGIN InitPanel(c, NIL, x, y, w, h);
  306. c.handle := FormHandler;
  307. AppendToRing(c, forms)
  308. END InitForm;
  309. PROCEDURE NewForm*(x, y, w, h: INTEGER): Form;
  310. VAR c: Form;
  311. BEGIN NEW(c); InitForm(c, x, y, w, h);
  312. RETURN c END NewForm;
  313. (** Button **)
  314. PROCEDURE DrawButton*(c: Button; x, y, w, h: INTEGER);
  315. VAR fw, fh, tw, tx, ty: INTEGER;
  316. down: BOOLEAN;
  317. Z: G.Color;
  318. BEGIN
  319. down := c.pressed & c.hovered;
  320. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  321. ;G.MakeCol(Z, 255, 128, 0);
  322. ;G.Line(x + c.h DIV 4, y + c.h DIV 2, x + c.X, y + c.Y, Z);
  323. ;G.MakeCol(Z, 215, 0, 0);
  324. ;G.Line(x + c.h DIV 4, y + c.h DIV 2 + 1, x + c.X, y + c.Y + 1, Z);
  325. G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor);
  326. IF ~down THEN
  327. G.Rect(x, y, x + c.w - 2, y + c.h - 2, c.fgColor)
  328. END;
  329. G.GetMonoFontSize(font, fw, fh);
  330. tw := Strings.Length(c.caption) * fw;
  331. tx := x + (c.w - tw) DIV 2;
  332. ty := y + (c.h - fh) DIV 2;
  333. IF down THEN INC(tx); INC(ty) END;
  334. G.DrawString(c.caption, tx, ty, font, c.fgColor)
  335. END DrawButton;
  336. PROCEDURE BMM(c: Button; x, y: INTEGER);
  337. BEGIN
  338. c.X := x; c.Y := y
  339. END BMM;
  340. PROCEDURE ButtonHandler*(c: Widget; VAR msg: Message);
  341. VAR b: Button;
  342. BEGIN b := c(Button);
  343. IF msg IS DrawMsg THEN
  344. DrawButton(b, msg(DrawMsg).x, msg(DrawMsg).y,
  345. msg(DrawMsg).w, msg(DrawMsg).h)
  346. ELSIF msg IS MouseMoveMsg THEN BMM(b, msg(MouseMoveMsg).x, msg(MouseMoveMsg).y)
  347. ELSE WidgetHandler(c, msg)
  348. END
  349. END ButtonHandler;
  350. PROCEDURE InitButton*(c: Button; where: Widget;
  351. x, y, w, h: INTEGER; caption: ARRAY OF CHAR);
  352. BEGIN InitWidget(c, w, h);
  353. Strings.Copy(caption, c.caption);
  354. c.focusable := TRUE;
  355. c.handle := ButtonHandler;
  356. Put(c, where, x, y)
  357. ;c.X := 0; c.Y := 0;
  358. END InitButton;
  359. PROCEDURE NewButton*(where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR): Button;
  360. VAR c: Button;
  361. BEGIN NEW(c); InitButton(c, where, x, y, w, h, caption)
  362. RETURN c END NewButton;
  363. (** Edit **)
  364. PROCEDURE DrawEdit*(c: Edit; x, y, w, h: INTEGER);
  365. VAR fw, fh, tw, tx, ty: INTEGER;
  366. down: BOOLEAN;
  367. red: G.Color;
  368. BEGIN
  369. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  370. G.GetMonoFontSize(font, fw, fh);
  371. tw := Strings.Length(c.text) * fw;
  372. tx := x + 2 - c.off;
  373. ty := y + (c.h - fh) DIV 2;
  374. G.DrawString(c.text, tx, ty, font, c.fgColor);
  375. IF c.focused THEN
  376. G.MakeCol(red, 250, 0, 0);
  377. INC(tx, fw * c.pos - 1);
  378. G.VLine(tx, ty, ty + fh - 1, red);
  379. G.HLine(tx - 1, ty, tx + 1, red);
  380. G.HLine(tx - 1, ty + fh - 1, tx + 1, red)
  381. END;
  382. G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor)
  383. END DrawEdit;
  384. PROCEDURE EditOnMouseDown*(c: Edit; VAR msg: MouseDownMsg);
  385. VAR n, fw, fh: INTEGER;
  386. BEGIN
  387. IF (msg.btn = 1) & (msg.x > 0) & (msg.x < c.w - 1) &
  388. (msg.y > 0) & (msg.y < c.h - 1)
  389. THEN
  390. G.GetMonoFontSize(font, fw, fh);
  391. n := (msg.x - 2 + fw DIV 2) DIV fw;
  392. IF n < 0 THEN n := 0 ELSIF n > c.len THEN n := c.len END;
  393. c.pos := n
  394. END
  395. END EditOnMouseDown;
  396. PROCEDURE EditCheckOffset(c: Edit);
  397. VAR n, fw, fh: INTEGER;
  398. BEGIN
  399. G.GetMonoFontSize(font, fw, fh);
  400. n := c.pos * fw - c.off;
  401. IF c.len * fw <= c.w - 4 THEN c.off := 0
  402. ELSIF n < 0 THEN c.off := c.pos * fw
  403. ELSIF n >= c.w - 4 THEN c.off := c.pos * fw - c.w + 4
  404. ELSIF c.len * fw - c.off <= c.w - 4 THEN c.off := c.len * fw - c.w + 4
  405. END
  406. END EditCheckOffset;
  407. PROCEDURE EditOnChar*(c: Edit; VAR msg: CharMsg);
  408. VAR i: INTEGER;
  409. BEGIN
  410. IF msg.key = G.kBackspace THEN
  411. IF c.pos > 0 THEN
  412. Strings.Delete(c.text, c.pos - 1, 1);
  413. DEC(c.len); DEC(c.pos)
  414. END
  415. ELSIF msg.key = G.kDel THEN
  416. IF c.pos < c.len THEN
  417. Strings.Delete(c.text, c.pos, 1);
  418. DEC(c.len)
  419. END
  420. ELSIF msg.ch < ' ' THEN
  421. IF msg.key = G.kLeft THEN DEC(c.pos)
  422. ELSIF msg.key = G.kRight THEN INC(c.pos)
  423. ELSIF msg.key = G.kHome THEN c.pos := 0
  424. ELSIF msg.key = G.kEnd THEN c.pos := c.len
  425. END;
  426. IF c.pos < 0 THEN c.pos := 0 ELSIF c.pos > c.len THEN c.pos := c.len END
  427. ELSIF c.len < LEN(c.text) - 1 THEN
  428. c.text[c.len + 1] := 0X;
  429. i := c.len;
  430. WHILE i > c.pos DO
  431. c.text[i] := c.text[i - 1];
  432. DEC(i)
  433. END;
  434. c.text[c.pos] := msg.ch;
  435. INC(c.len); INC(c.pos)
  436. END;
  437. EditCheckOffset(c)
  438. END EditOnChar;
  439. PROCEDURE EditHandler*(c: Widget; VAR msg: Message);
  440. VAR e: Edit;
  441. BEGIN e := c(Edit);
  442. IF msg IS DrawMsg THEN
  443. DrawEdit(e, msg(DrawMsg).x, msg(DrawMsg).y,
  444. msg(DrawMsg).w, msg(DrawMsg).h)
  445. ELSIF msg IS MouseDownMsg THEN EditOnMouseDown(e, msg(MouseDownMsg))
  446. ELSIF msg IS CharMsg THEN EditOnChar(e, msg(CharMsg))
  447. ELSE WidgetHandler(c, msg)
  448. END
  449. END EditHandler;
  450. PROCEDURE InitEdit*(c: Edit; where: Widget; x, y, w, h: INTEGER);
  451. BEGIN InitWidget(c, w, h);
  452. c.focusable := TRUE;
  453. G.MakeCol(c.bgColor, 255, 255, 255);
  454. c.text := 'Привет'; c.len := 6; c.pos := 2; c.off := 0;
  455. c.handle := EditHandler;
  456. Put(c, where, x, y)
  457. END InitEdit;
  458. PROCEDURE NewEdit*(where: Widget; x, y, w, h: INTEGER): Edit;
  459. VAR c: Edit;
  460. BEGIN NEW(c); InitEdit(c, where, x, y, w, h)
  461. RETURN c END NewEdit;
  462. PROCEDURE EditSetText*(c: Edit; text: ARRAY OF CHAR);
  463. BEGIN Strings.Copy(text, c.text)
  464. END EditSetText;
  465. (** ScrollBar **)
  466. PROCEDURE DrawBox(x, y, w, h: INTEGER; bg, fg: G.Color);
  467. BEGIN
  468. G.FillRect(x, y, x + w - 1, y + h - 1, bg);
  469. G.Rect(x, y, x + w - 1, y + h - 1, fg)
  470. END DrawBox;
  471. PROCEDURE DrawScrollBar*(c: ScrollBar; x, y, w, h: INTEGER);
  472. VAR fw, fh, X, Y, hs, maxHs, pos, range: INTEGER;
  473. grey: G.Color;
  474. BEGIN
  475. G.MakeCol(grey, 80, 80, 80);
  476. DrawBox(x, y, c.w, c.h, grey, c.fgColor);
  477. DrawBox(x, y, c.h, c.h, c.bgColor, c.fgColor);
  478. DrawBox(x + c.w - c.h, y, c.h, c.h, c.bgColor, c.fgColor);
  479. X := x + c.h DIV 2; Y := y + c.h DIV 2;
  480. G.HLine(X - 4, Y, X + 4, c.fgColor);
  481. G.Line(X - 4, Y, X - 1, Y + 3, c.fgColor);
  482. G.Line(X - 4, Y, X - 1, Y - 3, c.fgColor);
  483. X := x + c.w - c.h DIV 2;
  484. G.HLine(X - 4, Y, X + 4, c.fgColor);
  485. G.Line(X + 4, Y, X + 1, Y + 3, c.fgColor);
  486. G.Line(X + 4, Y, X + 1, Y - 3, c.fgColor);
  487. hs := c.handleSize;
  488. maxHs := c.w - c.h * 2 + 2;
  489. IF hs > maxHs THEN hs := maxHs END;
  490. range := c.max - c.min;
  491. pos := c.value;
  492. IF pos < c.min THEN pos := c.min ELSIF pos > c.max THEN pos := c.max END;
  493. c.handlePos := c.h - 1 + ((maxHs - hs) * pos + range DIV 2) DIV range;
  494. DrawBox(x + c.handlePos, y, hs, c.h, c.bgColor, c.fgColor);
  495. END DrawScrollBar;
  496. PROCEDURE SetScrollBarValue*(c: ScrollBar; value: INTEGER);
  497. BEGIN
  498. IF value < c.min THEN value := c.min
  499. ELSIF value > c.max THEN value := c.max
  500. END;
  501. c.value := value;
  502. IF c.onScroll # NIL THEN c.onScroll(c, value) END
  503. END SetScrollBarValue;
  504. PROCEDURE HandleScrollBarMouseMove(c: ScrollBar; VAR msg: MouseMoveMsg);
  505. VAR n, x, size, btnSize, w: INTEGER;
  506. BEGIN
  507. IF c.handlePressed THEN
  508. x := msg.x; size := c.w; btnSize := c.h;
  509. w := size - btnSize * 2 - c.handleSize;
  510. n := x - c.handlePressPos - btnSize;
  511. n := (n * (c.max - c.min) + w DIV 2) DIV w + c.min;
  512. SetScrollBarValue(c, n)
  513. END
  514. END HandleScrollBarMouseMove;
  515. PROCEDURE HandleScrollBarMouseDown(c: ScrollBar; VAR msg: MouseDownMsg);
  516. VAR x, d, size, btnSize: INTEGER;
  517. BEGIN
  518. x := msg.x; size := c.w; btnSize := c.h;
  519. IF msg.btn = 2 THEN d := 1 ELSE d := c.inc END;
  520. IF x < btnSize THEN
  521. SetScrollBarValue(c, c.value - d)
  522. ELSIF x >= size - btnSize THEN
  523. SetScrollBarValue(c, c.value + d)
  524. ELSIF msg.btn = 1 THEN
  525. IF (c.handlePos <= x) & (x < c.handlePos + c.handleSize) THEN
  526. c.handlePressed := TRUE;
  527. c.handlePressPos := x - c.handlePos
  528. ELSIF x < c.handlePos THEN
  529. SetScrollBarValue(c, c.value - c.bigInc)
  530. ELSE
  531. SetScrollBarValue(c, c.value + c.bigInc)
  532. END
  533. END;
  534. WidgetHandler(c, msg)
  535. END HandleScrollBarMouseDown;
  536. PROCEDURE ScrollBarHandler*(c: Widget; VAR msg: Message);
  537. VAR s: ScrollBar;
  538. BEGIN s := c(ScrollBar);
  539. IF msg IS DrawMsg THEN
  540. DrawScrollBar(s, msg(DrawMsg).x, msg(DrawMsg).y,
  541. msg(DrawMsg).w, msg(DrawMsg).h)
  542. ELSIF msg IS MouseMoveMsg THEN HandleScrollBarMouseMove(s, msg(MouseMoveMsg))
  543. ELSIF msg IS MouseDownMsg THEN HandleScrollBarMouseDown(s, msg(MouseDownMsg))
  544. ELSIF msg IS MouseUpMsg THEN s.handlePressed := FALSE
  545. ELSE WidgetHandler(c, msg)
  546. END
  547. END ScrollBarHandler;
  548. PROCEDURE InitScrollBar*(c: ScrollBar; where: Widget;
  549. x, y, w, h: INTEGER);
  550. BEGIN InitWidget(c, w, h);
  551. c.handle := ScrollBarHandler;
  552. c.value := 0; c.min := 0; c.max := 100; c.inc := 5; c.bigInc := 20;
  553. c.handlePos := 0; c.handleSize := 24;
  554. Put(c, where, x, y)
  555. END InitScrollBar;
  556. PROCEDURE NewScrollBar*(where: Widget; x, y, w, h: INTEGER): ScrollBar;
  557. VAR c: ScrollBar;
  558. BEGIN NEW(c); InitScrollBar(c, where, x, y, w, h)
  559. RETURN c END NewScrollBar;
  560. PROCEDURE SetOnScroll*(c: ScrollBar; proc: PROCEDURE (c: Widget; value: INTEGER));
  561. BEGIN c.onScroll := proc
  562. END SetOnScroll;
  563. (** General **)
  564. PROCEDURE DrawAll*;
  565. VAR c: Widget;
  566. BEGIN
  567. c := forms;
  568. REPEAT
  569. DrawForm(c(Form));
  570. c := c.next
  571. UNTIL c = forms;
  572. G.Flip
  573. END DrawAll;
  574. PROCEDURE HandleMouseMove(VAR e: G.Event);
  575. VAR c: Widget;
  576. BEGIN
  577. c := FindHoveredInList(forms, e.x, e.y, FALSE);
  578. IF c # NIL THEN
  579. WidgetHandleMouseMove(c, e.x - c.x, e.y - c.y, e.button)
  580. END
  581. END HandleMouseMove;
  582. PROCEDURE HandleMouseDown(VAR e: G.Event);
  583. VAR c: Widget;
  584. BEGIN
  585. pressedX := 0; pressedY := 0;
  586. c := FindHoveredInList(forms, e.x, e.y, TRUE);
  587. IF c # NIL THEN
  588. WidgetHandleMouseDown(c, e.x - c.x, e.y - c.y, e.button)
  589. END
  590. END HandleMouseDown;
  591. PROCEDURE HandleMouseUp(VAR e: G.Event);
  592. VAR c: Widget;
  593. BEGIN
  594. IF pressedWidget # NIL THEN
  595. c := pressedWidget;
  596. IF ~c.hovered THEN c := NIL END;
  597. WidgetOnMouseUp(pressedWidget, e.x - pressedX, e.y - pressedY, e.button);
  598. IF (c # NIL) & (e.button = 1) THEN
  599. WidgetOnClick(c)
  600. END
  601. END
  602. END HandleMouseUp;
  603. PROCEDURE HandleKeyDown(VAR e: G.Event);
  604. VAR msg: KeyDownMsg;
  605. BEGIN
  606. IF focusedWidget # NIL THEN
  607. msg.key := e.key;
  608. focusedWidget.handle(focusedWidget, msg)
  609. END
  610. END HandleKeyDown;
  611. PROCEDURE HandleKeyUp(VAR e: G.Event);
  612. VAR msg: KeyUpMsg;
  613. BEGIN
  614. IF focusedWidget # NIL THEN
  615. msg.key := e.key;
  616. focusedWidget.handle(focusedWidget, msg)
  617. END
  618. END HandleKeyUp;
  619. PROCEDURE HandleChar(VAR e: G.Event);
  620. VAR msg: CharMsg;
  621. BEGIN
  622. IF focusedWidget # NIL THEN
  623. msg.key := e.key; msg.ch := e.ch;
  624. msg.mod := e.mod; msg.repeat := e.repeat;
  625. focusedWidget.handle(focusedWidget, msg)
  626. END
  627. END HandleChar;
  628. PROCEDURE HandleEvent(VAR e: G.Event);
  629. BEGIN
  630. IF e.type = G.quit THEN quit := TRUE
  631. ELSIF e.type = G.mouseMove THEN HandleMouseMove(e)
  632. ELSIF e.type = G.mouseDown THEN HandleMouseDown(e)
  633. ELSIF e.type = G.mouseUp THEN HandleMouseUp(e)
  634. ELSIF e.type = G.keyDown THEN HandleKeyDown(e)
  635. ELSIF e.type = G.keyUp THEN HandleKeyUp(e)
  636. ELSIF e.type = G.char THEN HandleChar(e)
  637. END
  638. END HandleEvent;
  639. PROCEDURE Run*;
  640. VAR e: G.Event;
  641. BEGIN
  642. quit := FALSE;
  643. REPEAT
  644. WHILE G.HasEvents() DO
  645. G.WaitEvent(e);
  646. HandleEvent(e)
  647. END;
  648. DrawAll
  649. UNTIL quit
  650. END Run;
  651. PROCEDURE Init*;
  652. BEGIN
  653. forms := NIL;
  654. font := G.LoadFont('Data/Fonts/Main');
  655. IF font = NIL THEN Out.String('SimpleGui: could not load font.'); Out.Ln END;
  656. Done := font # NIL;
  657. hoveredWidget := NIL; pressedWidget := NIL;
  658. pressedX := 0; pressedY := 0
  659. END Init;
  660. END SimpleGui.