SimpleGui.Mod 19 KB

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