SimpleGui.Mod 34 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258
  1. MODULE SimpleGui;
  2. IMPORT G := Graph, Strings, Out;
  3. CONST
  4. (** Align **)
  5. alLeft* = 0;
  6. alCenter* = 1;
  7. alRight* = 2;
  8. TYPE
  9. Widget* = POINTER TO WidgetDesc;
  10. Message* = RECORD END;
  11. PutMsg* = RECORD(Message) what*: Widget; x*, y*: INTEGER END;
  12. DrawMsg* = RECORD(Message) x*, y*, w*, h*: INTEGER END;
  13. MouseMoveMsg* = RECORD(Message) x*, y*: INTEGER; btns*: SET END;
  14. MouseDownMsg* = RECORD(Message) x*, y*, btn*: INTEGER END;
  15. MouseUpMsg* = RECORD(Message) x*, y*, btn*: INTEGER END;
  16. MouseEnterMsg* = RECORD(Message) END;
  17. MouseLeaveMsg* = RECORD(Message) END;
  18. ClickMsg* = RECORD(Message) END;
  19. GetFocusMsg* = RECORD(Message) END;
  20. LostFocusMsg* = RECORD(Message) END;
  21. KeyDownMsg* = RECORD(Message) key*: INTEGER END;
  22. KeyUpMsg* = RECORD(Message) key*: INTEGER END;
  23. CharMsg* = RECORD(Message)
  24. key*: INTEGER;
  25. ch*: CHAR;
  26. mod*: SET;
  27. repeat*: BOOLEAN
  28. END;
  29. Handler* = PROCEDURE (c: Widget; VAR msg: Message);
  30. WidgetDesc* = RECORD
  31. x*, y*, w*, h*: INTEGER;
  32. bgColor*, fgColor*: G.Color;
  33. redraw*: BOOLEAN; (** TRUE if widget or it's insides need to be redrawn *)
  34. redrawSelf*: BOOLEAN; (** TRUE if widget itself needs to be redrawn *)
  35. focusable*: BOOLEAN; (** TRUE if widget can get focus *)
  36. focused*: BOOLEAN; (** TRUE if this widget is globally in focus *)
  37. hovered*: BOOLEAN; (** TRUE if mouse pointer is over the widget *)
  38. pressed*: BOOLEAN; (** TRUE if widget is held down with LMB *)
  39. body*: Widget; (** A ring of widgets that this widget contains *)
  40. parent*: Widget; (** A widget that this widget is contained in *)
  41. prev*, next*: Widget;
  42. handle*: Handler;
  43. onPaint*: PROCEDURE (c: Widget; x, y, w, h: INTEGER);
  44. onMouseDown*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
  45. onMouseUp*: PROCEDURE (c: Widget; x, y, btn: INTEGER);
  46. onMouseMove*: PROCEDURE (c: Widget; x, y: INTEGER; btns: SET);
  47. onMouseEnter*: PROCEDURE (c: Widget);
  48. onMouseLeave*: PROCEDURE (c: Widget);
  49. onClick*: PROCEDURE (c: Widget);
  50. onKeyDown*: PROCEDURE (c: Widget; key: INTEGER);
  51. onKeyUp*: PROCEDURE (c: Widget; key: INTEGER);
  52. onChar*: PROCEDURE (c: Widget; key: INTEGER; ch: CHAR; mod: SET; repeat: BOOLEAN);
  53. END;
  54. App* = POINTER TO AppDesc;
  55. AppDesc* = RECORD(WidgetDesc) END;
  56. Form* = POINTER TO FormDesc;
  57. FormDesc* = RECORD(WidgetDesc) END;
  58. Panel* = POINTER TO PanelDesc;
  59. PanelDesc* = RECORD(WidgetDesc)
  60. noBg*: BOOLEAN
  61. END;
  62. Button* = POINTER TO ButtonDesc;
  63. ButtonDesc* = RECORD(WidgetDesc)
  64. caption*: ARRAY 64 OF CHAR
  65. END;
  66. Label* = POINTER TO LabelDesc;
  67. LabelDesc* = RECORD(WidgetDesc)
  68. caption*: ARRAY 256 OF CHAR;
  69. align*: INTEGER; (** One of {alLeft, alCenter, alRight} *)
  70. END;
  71. Edit* = POINTER TO EditDesc;
  72. EditDesc* = RECORD(WidgetDesc)
  73. text*: ARRAY 256 OF CHAR;
  74. len*: INTEGER; (** Length of text in characters *)
  75. pos*: INTEGER; (** Position of text carret, in range [0; len] *)
  76. off*: INTEGER (** Used to slide text that does not fit, normal is 0 *)
  77. END;
  78. ScrollBar* = POINTER TO ScrollBarDesc;
  79. ScrollBarDesc* = RECORD(WidgetDesc)
  80. vertical*: BOOLEAN; (** TRUE for vertical scroll, FALSE for horizontal *)
  81. min*, max*: INTEGER;
  82. value*: INTEGER; (** The position of the scroll, in range [min; max] *)
  83. inc*, bigInc*: INTEGER; (** A single increment of value, and a big one *)
  84. btnSize*: INTEGER; (** Width or height (depending on vertical) of buttons *)
  85. handlePos*, handleSize*: INTEGER; (** Size and position of handle, px *)
  86. handlePressed*: BOOLEAN;
  87. handlePressPos*: INTEGER; (** Where handle was pressed, offset in px *)
  88. btnPressed*: INTEGER; (** 0-nothing, 1-less btn, 2-more btn, 3-handle *)
  89. onScroll*: PROCEDURE (c: ScrollBar; value: INTEGER);
  90. END;
  91. ScrollBox* = POINTER TO ScrollBoxDesc;
  92. ScrollBoxDesc* = RECORD(WidgetDesc)
  93. noBg*: BOOLEAN;
  94. outer*, inner*: Panel;
  95. scbHoriz*, scbVert*: ScrollBar
  96. END;
  97. Canvas* = POINTER TO CanvasDesc;
  98. CanvasDesc = RECORD(WidgetDesc)
  99. bmp*: G.Bitmap
  100. END;
  101. VAR
  102. Done*: BOOLEAN; (** FALSE after a failed opration and before the next Init *)
  103. app*: App;
  104. focusedWidget*: Widget; (** The widget with focus = TRUE *)
  105. font*: G.Font;
  106. quit: BOOLEAN; (** Main loop in procedure Run ends when TRUE *)
  107. forceFlip: BOOLEAN; (** Becomes TRUE on mouse move and FALSE after Flip *)
  108. hoveredWidget: Widget;
  109. pressedWidget: Widget;
  110. pressedX, pressedY: INTEGER;
  111. (** Widget **)
  112. PROCEDURE Redraw*(c: Widget);
  113. VAR p: Widget;
  114. BEGIN
  115. c.redraw := TRUE; c.redrawSelf := TRUE;
  116. p := c.parent;
  117. WHILE (p # NIL) & ~p.redraw DO p.redraw := TRUE; p := p.parent END
  118. END Redraw;
  119. PROCEDURE Drawn*(c: Widget);
  120. BEGIN c.redraw := FALSE; c.redrawSelf := FALSE
  121. END Drawn;
  122. PROCEDURE FindHoveredInRing(list: Widget; x, y: INTEGER;
  123. forMouseDown: BOOLEAN): Widget;
  124. VAR c: Widget;
  125. BEGIN
  126. IF list # NIL THEN
  127. c := list.prev;
  128. WHILE (c # NIL) &
  129. ~((c.x <= x) & (x < c.x + c.w) &
  130. (c.y <= y) & (y < c.y + c.h))
  131. DO
  132. IF c = list THEN c := NIL ELSE c := c.prev END
  133. END;
  134. IF forMouseDown & (c # NIL) THEN
  135. INC(pressedX, c.x); INC(pressedY, c.y)
  136. END
  137. ELSE c := NIL
  138. END
  139. RETURN c END FindHoveredInRing;
  140. PROCEDURE WidgetOnMouseEnter*(c: Widget);
  141. VAR msg: MouseEnterMsg;
  142. BEGIN
  143. IF pressedWidget = c THEN c.pressed := TRUE END;
  144. c.hovered := TRUE;
  145. c.handle(c, msg)
  146. END WidgetOnMouseEnter;
  147. PROCEDURE WidgetOnMouseLeave*(c: Widget);
  148. VAR msg: MouseLeaveMsg;
  149. BEGIN
  150. c.hovered := FALSE;
  151. c.pressed := FALSE;
  152. c.handle(c, msg)
  153. END WidgetOnMouseLeave;
  154. PROCEDURE WidgetOnMouseMove*(c: Widget; x, y: INTEGER; btns: SET);
  155. VAR msg: MouseMoveMsg;
  156. BEGIN
  157. IF (0 <= x) & (x < c.w) & (0 <= y) & (y < c.h) THEN
  158. IF c # hoveredWidget THEN
  159. IF hoveredWidget # NIL THEN WidgetOnMouseLeave(hoveredWidget) END;
  160. hoveredWidget := c;
  161. WidgetOnMouseEnter(hoveredWidget)
  162. END
  163. ELSIF c = hoveredWidget THEN
  164. WidgetOnMouseLeave(c);
  165. hoveredWidget := NIL
  166. END;
  167. msg.x := x; msg.y := y; msg.btns := btns;
  168. c.handle(c, msg);
  169. IF c.onMouseMove # NIL THEN c.onMouseMove(c, x, y, btns) END
  170. END WidgetOnMouseMove;
  171. PROCEDURE WidgetHandleMouseMove*(c: Widget; x, y: INTEGER; btns: SET);
  172. VAR p: Widget;
  173. BEGIN
  174. IF pressedWidget # NIL THEN
  175. WidgetOnMouseMove(pressedWidget, x - pressedX, y - pressedY, btns)
  176. ELSE
  177. p := FindHoveredInRing(c.body, x, y, FALSE);
  178. IF p # NIL THEN
  179. WidgetHandleMouseMove(p, x - p.x, y - p.y, btns)
  180. ELSE
  181. WidgetOnMouseMove(c, x, y, btns)
  182. END
  183. END
  184. END WidgetHandleMouseMove;
  185. PROCEDURE Resize*(c: Widget; w, h: INTEGER);
  186. BEGIN
  187. c.w := w;
  188. c.h := h
  189. END Resize;
  190. PROCEDURE Focus*(c: Widget);
  191. VAR get: GetFocusMsg;
  192. lost: LostFocusMsg;
  193. BEGIN
  194. IF ((c = NIL) OR c.focusable) & (focusedWidget # c) THEN
  195. IF focusedWidget # NIL THEN
  196. focusedWidget.focused := FALSE;
  197. focusedWidget.handle(focusedWidget, lost)
  198. END;
  199. IF c # NIL THEN
  200. c.focused := TRUE;
  201. focusedWidget := c;
  202. focusedWidget.handle(focusedWidget, get)
  203. END
  204. END
  205. END Focus;
  206. PROCEDURE Detach*(c: Widget);
  207. VAR p: Widget;
  208. BEGIN
  209. IF c.parent # NIL THEN
  210. IF c.prev = c THEN
  211. c.parent.body := NIL
  212. ELSE
  213. c.prev.next := c.next;
  214. c.next.prev := c.prev
  215. END;
  216. c.parent := NIL
  217. END;
  218. c.prev := NIL; c.next := NIL
  219. END Detach;
  220. PROCEDURE AppendTo*(c: Widget; container: Widget);
  221. VAR r: Widget;
  222. BEGIN
  223. Detach(c);
  224. c.parent := container;
  225. r := container.body;
  226. IF r = NIL THEN
  227. container.body := c;
  228. c.prev := c; c.next := c
  229. ELSE
  230. c.next := r; c.prev := r.prev;
  231. r.prev.next := c; r.prev := c
  232. END
  233. END AppendTo;
  234. PROCEDURE DirectPut*(c, where: Widget; x, y: INTEGER);
  235. BEGIN
  236. IF c # NIL THEN
  237. c.x := x; c.y := y;
  238. IF where # NIL THEN
  239. AppendTo(c, where)
  240. END
  241. END
  242. END DirectPut;
  243. PROCEDURE Put*(c, where: Widget; x, y: INTEGER);
  244. VAR msg: PutMsg;
  245. BEGIN
  246. IF c # NIL THEN
  247. c.x := x; c.y := y;
  248. IF where # NIL THEN
  249. msg.what := c;
  250. msg.x := x;
  251. msg.y := y;
  252. where.handle(where, msg)
  253. END
  254. END
  255. END Put;
  256. PROCEDURE WidgetOnMouseDown*(c: Widget; x, y, btn: INTEGER);
  257. VAR msg: MouseDownMsg;
  258. BEGIN
  259. pressedWidget := c;
  260. Focus(c);
  261. msg.x := x; msg.y := y; msg.btn := btn;
  262. c.handle(c, msg);
  263. IF c.onMouseDown # NIL THEN c.onMouseDown(c, x, y, btn) END
  264. END WidgetOnMouseDown;
  265. PROCEDURE WidgetHandleMouseDown*(c: Widget; x, y, btn: INTEGER);
  266. VAR p: Widget;
  267. BEGIN
  268. p := FindHoveredInRing(c.body, x, y, TRUE);
  269. IF p # NIL THEN
  270. WidgetHandleMouseDown(p, x - p.x, y - p.y, btn)
  271. ELSE
  272. WidgetOnMouseDown(c, x, y, btn)
  273. END
  274. END WidgetHandleMouseDown;
  275. PROCEDURE WidgetOnMouseUp*(c: Widget; x, y, btn: INTEGER);
  276. VAR msg: MouseUpMsg;
  277. BEGIN
  278. pressedWidget := NIL;
  279. msg.x := x; msg.y := y; msg.btn := btn;
  280. c.handle(c, msg);
  281. IF c.onMouseUp # NIL THEN c.onMouseUp(c, x, y, btn) END
  282. END WidgetOnMouseUp;
  283. PROCEDURE WidgetOnClick*(c: Widget);
  284. VAR msg: ClickMsg;
  285. BEGIN c.handle(c, msg);
  286. IF c.onClick # NIL THEN c.onClick(c) END
  287. END WidgetOnClick;
  288. PROCEDURE WidgetHandler*(c: Widget; VAR msg: Message);
  289. VAR x, y: INTEGER;
  290. BEGIN
  291. IF msg IS DrawMsg THEN
  292. IF c.redraw THEN
  293. IF c.redrawSelf THEN
  294. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  295. IF c.onPaint # NIL THEN
  296. c.onPaint(c, x, y, msg(DrawMsg).w, msg(DrawMsg).h)
  297. ELSE
  298. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  299. G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor);
  300. G.Rect(x + 2, y + 2, x + c.w - 3, y + c.h - 3, c.fgColor)
  301. END;
  302. Drawn(c)
  303. END
  304. END
  305. ELSIF msg IS MouseDownMsg THEN
  306. IF msg(MouseDownMsg).btn = 1 THEN c.pressed := TRUE; Redraw(c) END
  307. ELSIF msg IS MouseUpMsg THEN c.pressed := FALSE; Redraw(c)
  308. ELSIF msg IS PutMsg THEN
  309. DirectPut(msg(PutMsg).what, c, msg(PutMsg).x, msg(PutMsg).y)
  310. ELSIF msg IS GetFocusMsg THEN Redraw(c)
  311. ELSIF msg IS LostFocusMsg THEN Redraw(c)
  312. END
  313. END WidgetHandler;
  314. PROCEDURE DrawWidget*(c: Widget; x, y, w, h: INTEGER);
  315. VAR M: DrawMsg;
  316. BEGIN
  317. M.x := x; M.y := y; M.w := w; M.h := h;
  318. c.handle(c, M)
  319. END DrawWidget;
  320. PROCEDURE DrawBody*(c: Widget; x, y, w, h: INTEGER; forced: BOOLEAN);
  321. VAR p: Widget;
  322. x2, y2, w2, h2: INTEGER;
  323. cx, cy, cw, ch: INTEGER;
  324. CX, CY, CW, CH: INTEGER;
  325. BEGIN
  326. p := c.body;
  327. IF p # NIL THEN
  328. G.GetClip(CX, CY, CW, CH);
  329. IF CX + CW > x + w THEN CW := x + w - CX END;
  330. IF CY + CH > y + h THEN CH := y + h - CY END;
  331. IF CX < x THEN DEC(CW, x - CX); CX := x END;
  332. IF CY < y THEN DEC(CH, y - CY); CY := y END;
  333. REPEAT
  334. IF forced THEN p.redraw := TRUE; p.redrawSelf := TRUE END;
  335. IF p.redraw THEN
  336. x2 := x + p.x; y2 := y + p.y;
  337. w2 := w - p.x; h2 := h - p.y;
  338. cx := x2; cy := y2; cw := p.w; ch := p.h;
  339. IF cx + cw > CX + CW THEN cw := CX + CW - cx END;
  340. IF cy + ch > CY + CH THEN ch := CY + CH - cy END;
  341. IF cx < CX THEN DEC(cw, CX - cx); cx := CX END;
  342. IF cy < CY THEN DEC(ch, CY - cy); cy := CY END;
  343. G.SetClip(cx, cy, cw, ch);
  344. DrawWidget(p, x2, y2, p.w, p.h)
  345. END;
  346. p := p.next
  347. UNTIL p = c.body;
  348. G.UnsetClip
  349. END
  350. END DrawBody;
  351. PROCEDURE SetBgColor*(c: Widget; color: G.Color);
  352. BEGIN c.bgColor := color
  353. END SetBgColor;
  354. PROCEDURE SetFgColor*(c: Widget; color: G.Color);
  355. BEGIN c.fgColor := color
  356. END SetFgColor;
  357. PROCEDURE SetOnPaint*(c: Widget; proc: PROCEDURE (c: Widget; x, y, w, h: INTEGER));
  358. BEGIN c.onPaint := proc
  359. END SetOnPaint;
  360. PROCEDURE SetOnMouseMove*(c: Widget; proc: PROCEDURE (c: Widget; x, y: INTEGER; btns: SET));
  361. BEGIN c.onMouseMove := proc
  362. END SetOnMouseMove;
  363. PROCEDURE SetOnMouseDown*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
  364. BEGIN c.onMouseDown := proc
  365. END SetOnMouseDown;
  366. PROCEDURE SetOnMouseUp*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
  367. BEGIN c.onMouseUp := proc
  368. END SetOnMouseUp;
  369. PROCEDURE SetOnClick*(c: Widget; proc: PROCEDURE (c: Widget));
  370. BEGIN c.onClick := proc
  371. END SetOnClick;
  372. PROCEDURE InitWidget*(c: Widget; w, h: INTEGER);
  373. BEGIN c.x := 0; c.y := 0; c.w := w; c.h := h;
  374. c.redraw := TRUE; c.redrawSelf := TRUE;
  375. c.focusable := FALSE; c.focused := FALSE;
  376. c.hovered := FALSE; c.pressed := FALSE;
  377. G.MakeCol(c.bgColor, 180, 180, 180);
  378. G.MakeCol(c.fgColor, 0, 0, 0);
  379. c.handle := WidgetHandler
  380. END InitWidget;
  381. (** Creates and returns a new custom widget *)
  382. PROCEDURE NewWidget*(where: Widget; x, y, w, h: INTEGER): Widget;
  383. VAR c: Widget;
  384. BEGIN NEW(c); InitWidget(c, w, h);
  385. Put(c, where, x, y)
  386. RETURN c END NewWidget;
  387. (** Panel **)
  388. PROCEDURE PanelSetNoBg*(c: Panel; noBg: BOOLEAN);
  389. BEGIN c.noBg := noBg; Redraw(c)
  390. END PanelSetNoBg;
  391. PROCEDURE PanelHandler*(c: Widget; VAR msg: Message);
  392. VAR x, y: INTEGER;
  393. BEGIN
  394. IF msg IS DrawMsg THEN
  395. IF c.redraw THEN
  396. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  397. IF c.redrawSelf & ~c(Panel).noBg THEN
  398. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor)
  399. END;
  400. DrawBody(c, x, y, c.w, c.h, c.redrawSelf);
  401. Drawn(c)
  402. END
  403. ELSE WidgetHandler(c, msg)
  404. END
  405. END PanelHandler;
  406. PROCEDURE InitPanel*(c: Panel; where: Widget; x, y, w, h: INTEGER);
  407. BEGIN InitWidget(c, w, h);
  408. c.noBg := FALSE;
  409. c.handle := PanelHandler;
  410. Put(c, where, x, y)
  411. END InitPanel;
  412. PROCEDURE NewPanel*(where: Widget; x, y, w, h: INTEGER): Panel;
  413. VAR c: Panel;
  414. BEGIN NEW(c); InitPanel(c, where, x, y, w, h)
  415. RETURN c END NewPanel;
  416. (** App **)
  417. PROCEDURE InitApp*(c: App);
  418. VAR W, H: INTEGER;
  419. BEGIN
  420. G.GetScreenSize(W, H);
  421. InitWidget(c, W, H)
  422. END InitApp;
  423. PROCEDURE NewApp*(): App;
  424. VAR c: App;
  425. BEGIN NEW(c); InitApp(c)
  426. RETURN c END NewApp;
  427. (** Form **)
  428. PROCEDURE DrawForm*(c: Form);
  429. BEGIN
  430. IF c.redraw THEN
  431. IF c.redrawSelf THEN
  432. G.FillRect(c.x, c.y, c.x + c.w - 1, c.y + c.h - 1, c.bgColor)
  433. END;
  434. DrawBody(c, c.x, c.y, c.w, c.h, c.redrawSelf);
  435. Drawn(c)
  436. END
  437. END DrawForm;
  438. PROCEDURE FormHandler*(c: Widget; VAR msg: Message);
  439. BEGIN WidgetHandler(c, msg)
  440. END FormHandler;
  441. PROCEDURE InitForm*(c: Form; x, y, w, h: INTEGER);
  442. BEGIN InitWidget(c, w, h);
  443. c.x := x; c.y := y;
  444. c.handle := FormHandler;
  445. AppendTo(c, app)
  446. END InitForm;
  447. PROCEDURE NewForm*(x, y, w, h: INTEGER): Form;
  448. VAR c: Form;
  449. BEGIN NEW(c); InitForm(c, x, y, w, h)
  450. RETURN c END NewForm;
  451. (** Button **)
  452. PROCEDURE MakeOrAndYw(bg: G.Color; VAR or, yw: G.Color);
  453. VAR r, g, b: INTEGER;
  454. BEGIN
  455. G.ColorToRGB(bg, r, g, b);
  456. G.MakeCol(yw, (r + 255 * 2) DIV 3, (g + 255 * 3) DIV 4, (b * 3 + 255) DIV 4);
  457. IF (r <= g) & (r <= b) THEN
  458. g := (g * 2 + 255 * 3) DIV 5;
  459. b := (b * 3 + 255) DIV 4
  460. ELSIF (g <= r) & (g <= b) THEN
  461. r := (r * 2 + 255 * 3) DIV 5;
  462. b := (b * 3 + 255) DIV 4
  463. ELSE
  464. r := (r * 2 + 255 * 3) DIV 5;
  465. g := (g * 3 + 255) DIV 4
  466. END;
  467. G.MakeCol(or, r, g, b)
  468. END MakeOrAndYw;
  469. PROCEDURE DrawButtonBox(x, y, w, h: INTEGER; bg, parentBg: G.Color;
  470. down, glow: BOOLEAN);
  471. VAR wh, bl, g1, g2, or, yw: G.Color;
  472. X, Y: INTEGER;
  473. BEGIN
  474. G.MakeCol(bl, 0, 0, 0);
  475. G.MakeCol(wh, 255, 255, 255);
  476. G.MakeCol(g1, 140, 140, 140);
  477. G.MakeCol(g2, 80, 80, 80);
  478. MakeOrAndYw(parentBg, or, yw);
  479. X := x + w - 1; Y := y + h - 1;
  480. G.FillRect(x + 1, y + 1, X - 2, Y - 2, bg);
  481. G.HLine(x + 2, y, X - 1, bl);
  482. G.HLine(x, Y - 1, X - 4, bl);
  483. G.VLine(x, y + 2, Y - 1, bl);
  484. G.VLine(X - 1, y + 1, Y - 4, bl);
  485. IF ~down THEN
  486. G.HLine(x + 3, y + 1, X - 2, wh);
  487. G.HLine(x + 2, Y - 2, X - 4, g1);
  488. G.VLine(x + 1, y + 3, Y - 2, wh);
  489. G.VLine(X - 2, y + 2, Y - 4, g1);
  490. G.PutPixel(X - 3, Y - 3, g1);
  491. G.Line(X - 4, Y - 3, X - 3, Y - 4, g1);
  492. G.PutPixel(x + 2, y + 2, wh)
  493. END;
  494. G.Line(X - 3, Y - 2, X - 2, Y - 3, bl);
  495. G.Line(X - 3, Y - 1, X - 1, Y - 3, g2);
  496. G.Line(x + 1, y + 2, x + 2, y + 1, g1);
  497. G.PutPixel(x + 1, y + 1, bl);
  498. IF glow THEN
  499. G.Line(X - 2, Y - 1, X - 1, Y - 2, yw);
  500. G.HLine(x + 1, Y, X - 2, or);
  501. G.VLine(X, y + 1, Y - 2, or);
  502. G.PutPixel(X - 1, Y - 1, or)
  503. END
  504. END DrawButtonBox;
  505. PROCEDURE DrawButton*(c: Button; x, y, w, h: INTEGER);
  506. VAR fw, fh, tw, tx, ty: INTEGER;
  507. BEGIN
  508. IF c.redraw THEN
  509. DrawButtonBox(x, y, c.w, c.h, c.bgColor, c.parent.bgColor,
  510. c.pressed & c.hovered, TRUE);
  511. G.GetMonoFontSize(font, fw, fh);
  512. tw := Strings.Length(c.caption) * fw;
  513. tx := x + (c.w - tw) DIV 2;
  514. ty := y + (c.h - fh) DIV 2;
  515. IF c.pressed & c.hovered THEN INC(tx); INC(ty) END;
  516. G.DrawString(c.caption, tx, ty, font, c.fgColor);
  517. Drawn(c)
  518. END
  519. END DrawButton;
  520. PROCEDURE ButtonHandler*(c: Widget; VAR msg: Message);
  521. VAR b: Button;
  522. BEGIN b := c(Button);
  523. IF msg IS DrawMsg THEN
  524. DrawButton(b, msg(DrawMsg).x, msg(DrawMsg).y,
  525. msg(DrawMsg).w, msg(DrawMsg).h);
  526. ELSE WidgetHandler(c, msg)
  527. END
  528. END ButtonHandler;
  529. PROCEDURE InitButton*(c: Button; where: Widget;
  530. x, y, w, h: INTEGER; caption: ARRAY OF CHAR);
  531. BEGIN InitWidget(c, w, h);
  532. Strings.Copy(caption, c.caption);
  533. c.focusable := TRUE;
  534. c.handle := ButtonHandler;
  535. Put(c, where, x, y)
  536. END InitButton;
  537. PROCEDURE NewButton*(where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR): Button;
  538. VAR c: Button;
  539. BEGIN NEW(c); InitButton(c, where, x, y, w, h, caption)
  540. RETURN c END NewButton;
  541. (** Label **)
  542. PROCEDURE DrawLabel*(c: Label; x, y, w, h: INTEGER);
  543. VAR fw, fh, tw, tx, ty: INTEGER;
  544. BEGIN
  545. IF c.redraw THEN
  546. G.GetMonoFontSize(font, fw, fh);
  547. tx := 0;
  548. IF c.align # alLeft THEN
  549. tw := Strings.Length(c.caption) * fw;
  550. IF c.align = alCenter THEN
  551. tx := (c.w - tw) DIV 2
  552. ELSIF c.align = alRight THEN
  553. tx := c.w - tw
  554. END
  555. END;
  556. ty := y + (c.h - fh) DIV 2;
  557. G.DrawString(c.caption, tx, ty, font, c.fgColor);
  558. Drawn(c)
  559. END
  560. END DrawLabel;
  561. PROCEDURE LabelHandler*(c: Widget; VAR msg: Message);
  562. VAR e: Label;
  563. BEGIN e := c(Label);
  564. IF msg IS DrawMsg THEN
  565. DrawLabel(e, msg(DrawMsg).x, msg(DrawMsg).y,
  566. msg(DrawMsg).w, msg(DrawMsg).h)
  567. ELSE WidgetHandler(c, msg)
  568. END
  569. END LabelHandler;
  570. PROCEDURE InitLabel*(c: Label; where: Widget; x, y, w, h: INTEGER;
  571. caption: ARRAY OF CHAR);
  572. BEGIN InitWidget(c, w, h);
  573. Strings.Copy(caption, c.caption);
  574. c.handle := LabelHandler;
  575. c.align := alLeft;
  576. Put(c, where, x, y)
  577. END InitLabel;
  578. PROCEDURE NewLabel*(where: Widget; x, y, w, h: INTEGER;
  579. caption: ARRAY OF CHAR): Label;
  580. VAR c: Label;
  581. BEGIN NEW(c); InitLabel(c, where, x, y, w, h, caption)
  582. RETURN c END NewLabel;
  583. PROCEDURE LabelSetCaption*(c: Label; caption: ARRAY OF CHAR);
  584. BEGIN Strings.Copy(caption, c.caption); Redraw(c)
  585. END LabelSetCaption;
  586. PROCEDURE LabelSetAlign*(c: Label; align: INTEGER);
  587. BEGIN c.align := align; Redraw(c)
  588. END LabelSetAlign;
  589. (** Edit **)
  590. PROCEDURE DrawEdit*(c: Edit; x, y, w, h: INTEGER);
  591. VAR fw, fh, tw, tx, ty: INTEGER;
  592. or, yw: G.Color;
  593. BEGIN
  594. IF c.redraw THEN
  595. MakeOrAndYw(c.parent.bgColor, or, yw);
  596. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  597. G.GetMonoFontSize(font, fw, fh);
  598. tw := Strings.Length(c.text) * fw;
  599. tx := x + 2 - c.off;
  600. ty := y + (c.h - fh) DIV 2;
  601. G.DrawString(c.text, tx, ty, font, c.fgColor);
  602. IF c.focused THEN
  603. INC(tx, fw * c.pos - 1);
  604. G.VLine(tx, ty, ty + fh - 1, or);
  605. G.HLine(tx - 1, ty, tx + 1, or);
  606. G.HLine(tx - 1, ty + fh - 1, tx + 1, or)
  607. END;
  608. G.HLine(x, y, x + c.w - 2, c.fgColor);
  609. G.VLine(x, y, y + c.h - 1, c.fgColor);
  610. G.HLine(x + 1, y + c.h - 1, x + c.w - 1, or);
  611. G.VLine(x + c.w - 1, y, y + c.h - 1, or);
  612. Drawn(c)
  613. END
  614. END DrawEdit;
  615. PROCEDURE EditOnMouseDown*(c: Edit; VAR msg: MouseDownMsg);
  616. VAR n, fw, fh: INTEGER;
  617. BEGIN
  618. IF (msg.btn = 1) & (msg.x > 0) & (msg.x < c.w - 1) &
  619. (msg.y > 0) & (msg.y < c.h - 1)
  620. THEN
  621. G.GetMonoFontSize(font, fw, fh);
  622. n := (msg.x - 2 + fw DIV 2) DIV fw;
  623. IF n < 0 THEN n := 0 ELSIF n > c.len THEN n := c.len END;
  624. IF c.pos # n THEN
  625. c.pos := n;
  626. Redraw(c)
  627. END
  628. END
  629. END EditOnMouseDown;
  630. PROCEDURE EditCheckOffset(c: Edit);
  631. VAR n, fw, fh: INTEGER;
  632. BEGIN
  633. G.GetMonoFontSize(font, fw, fh);
  634. n := c.pos * fw - c.off;
  635. IF c.len * fw <= c.w - 4 THEN c.off := 0
  636. ELSIF n < 0 THEN c.off := c.pos * fw
  637. ELSIF n >= c.w - 4 THEN c.off := c.pos * fw - c.w + 4
  638. ELSIF c.len * fw - c.off <= c.w - 4 THEN c.off := c.len * fw - c.w + 4
  639. END
  640. END EditCheckOffset;
  641. PROCEDURE EditOnChar*(c: Edit; VAR msg: CharMsg);
  642. VAR i: INTEGER;
  643. BEGIN
  644. IF msg.key = G.kBackspace THEN
  645. IF c.pos > 0 THEN
  646. Strings.Delete(c.text, c.pos - 1, 1);
  647. DEC(c.len); DEC(c.pos)
  648. END
  649. ELSIF msg.key = G.kDel THEN
  650. IF c.pos < c.len THEN
  651. Strings.Delete(c.text, c.pos, 1);
  652. DEC(c.len)
  653. END
  654. ELSIF msg.ch < ' ' THEN
  655. IF msg.key = G.kLeft THEN DEC(c.pos)
  656. ELSIF msg.key = G.kRight THEN INC(c.pos)
  657. ELSIF msg.key = G.kHome THEN c.pos := 0
  658. ELSIF msg.key = G.kEnd THEN c.pos := c.len
  659. END;
  660. IF c.pos < 0 THEN c.pos := 0 ELSIF c.pos > c.len THEN c.pos := c.len END
  661. ELSIF c.len < LEN(c.text) - 1 THEN
  662. c.text[c.len + 1] := 0X;
  663. i := c.len;
  664. WHILE i > c.pos DO
  665. c.text[i] := c.text[i - 1];
  666. DEC(i)
  667. END;
  668. c.text[c.pos] := msg.ch;
  669. INC(c.len); INC(c.pos)
  670. END;
  671. EditCheckOffset(c);
  672. Redraw(c)
  673. END EditOnChar;
  674. PROCEDURE EditHandler*(c: Widget; VAR msg: Message);
  675. VAR e: Edit;
  676. BEGIN e := c(Edit);
  677. IF msg IS DrawMsg THEN
  678. DrawEdit(e, msg(DrawMsg).x, msg(DrawMsg).y,
  679. msg(DrawMsg).w, msg(DrawMsg).h)
  680. ELSIF msg IS MouseDownMsg THEN EditOnMouseDown(e, msg(MouseDownMsg))
  681. ELSIF msg IS CharMsg THEN EditOnChar(e, msg(CharMsg))
  682. ELSE WidgetHandler(c, msg)
  683. END
  684. END EditHandler;
  685. PROCEDURE InitEdit*(c: Edit; where: Widget; x, y, w, h: INTEGER);
  686. BEGIN InitWidget(c, w, h);
  687. c.focusable := TRUE;
  688. G.MakeCol(c.bgColor, 255, 255, 255);
  689. c.text[0] := 0X; c.len := 0; c.pos := 0; c.off := 0;
  690. c.handle := EditHandler;
  691. Put(c, where, x, y)
  692. END InitEdit;
  693. PROCEDURE NewEdit*(where: Widget; x, y, w, h: INTEGER): Edit;
  694. VAR c: Edit;
  695. BEGIN NEW(c); InitEdit(c, where, x, y, w, h)
  696. RETURN c END NewEdit;
  697. PROCEDURE EditSetText*(c: Edit; text: ARRAY OF CHAR);
  698. BEGIN
  699. Strings.Copy(text, c.text);
  700. c.len := Strings.Length(text);
  701. c.pos := 0;
  702. c.off := 0;
  703. Redraw(c)
  704. END EditSetText;
  705. (** ScrollBar **)
  706. PROCEDURE DrawBox(x, y, w, h: INTEGER; bg, fg: G.Color);
  707. BEGIN
  708. G.FillRect(x, y, x + w - 1, y + h - 1, bg);
  709. G.Rect(x, y, x + w - 1, y + h - 1, fg)
  710. END DrawBox;
  711. PROCEDURE DrawHorizScrollBar(c: ScrollBar; x, y, w, h: INTEGER);
  712. VAR fw, fh, X, Y, hs, maxHs, pos, range: INTEGER;
  713. bs: INTEGER; (** Button size *)
  714. grey: G.Color;
  715. BEGIN
  716. G.MakeCol(grey, 80, 80, 80);
  717. DrawButtonBox(x, y, c.w, c.h, c.bgColor, c.parent.bgColor, TRUE, TRUE);
  718. hs := c.handleSize;
  719. bs := c.h;
  720. IF bs > 20 THEN bs := 20 END;
  721. c.btnSize := bs;
  722. maxHs := c.w - bs * 2 + 4;
  723. IF hs > maxHs THEN hs := maxHs END;
  724. c.handleSize := hs;
  725. range := c.max - c.min;
  726. pos := c.value;
  727. IF pos < c.min THEN pos := c.min ELSIF pos > c.max THEN pos := c.max END;
  728. c.handlePos := bs - 2 + (pos * (maxHs - hs) + range DIV 2) DIV range;
  729. DrawButtonBox(x, y, bs, c.h, c.bgColor,
  730. c.parent.bgColor, c.btnPressed = 1, FALSE);
  731. DrawButtonBox(x + c.w - bs, y, bs, c.h, c.bgColor,
  732. c.parent.bgColor, c.btnPressed = 2, TRUE);
  733. X := x + (bs - 1) DIV 2; Y := y + (bs - 1) DIV 2;
  734. IF c.btnPressed = 1 THEN INC(X); INC(Y) END;
  735. G.HLine(X - 4, Y, X + 4, c.fgColor);
  736. G.Line(X - 4, Y, X - 1, Y + 3, c.fgColor);
  737. G.Line(X - 4, Y, X - 1, Y - 3, c.fgColor);
  738. X := x + c.w - bs DIV 2 - 1;
  739. IF c.btnPressed = 1 THEN DEC(Y) END;
  740. IF c.btnPressed = 2 THEN INC(X); INC(Y) END;
  741. G.HLine(X - 4, Y, X + 4, c.fgColor);
  742. G.Line(X + 4, Y, X + 1, Y + 3, c.fgColor);
  743. G.Line(X + 4, Y, X + 1, Y - 3, c.fgColor);
  744. DrawButtonBox(x + c.handlePos, y, hs, c.h, c.bgColor,
  745. c.parent.bgColor, c.btnPressed = 3, FALSE)
  746. END DrawHorizScrollBar;
  747. PROCEDURE DrawVertScrollBar(c: ScrollBar; x, y, w, h: INTEGER);
  748. VAR fw, fh, X, Y, hs, maxHs, pos, range: INTEGER;
  749. bs: INTEGER; (** Button size *)
  750. grey: G.Color;
  751. BEGIN
  752. G.MakeCol(grey, 80, 80, 80);
  753. DrawButtonBox(x, y, c.w, c.h, c.bgColor, c.parent.bgColor, TRUE, TRUE);
  754. hs := c.handleSize;
  755. bs := c.w;
  756. IF bs > 20 THEN bs := 20 END;
  757. c.btnSize := bs;
  758. maxHs := c.h - bs * 2 + 4;
  759. IF hs > maxHs THEN hs := maxHs END;
  760. range := c.max - c.min;
  761. pos := c.value;
  762. IF pos < c.min THEN pos := c.min ELSIF pos > c.max THEN pos := c.max END;
  763. c.handlePos := bs - 2 + ((maxHs - hs) * pos + range DIV 2) DIV range;
  764. DrawButtonBox(x, y, c.w, bs, c.bgColor,
  765. c.parent.bgColor, c.btnPressed = 1, FALSE);
  766. DrawButtonBox(x, y + c.h - bs, c.w, bs, c.bgColor,
  767. c.parent.bgColor, c.btnPressed = 2, TRUE);
  768. X := x + (bs - 1) DIV 2; Y := y + (bs - 1) DIV 2;
  769. IF c.btnPressed = 1 THEN INC(X); INC(Y) END;
  770. G.VLine(X, Y - 4, Y + 4, c.fgColor);
  771. G.Line(X, Y - 4, X + 3, Y - 1, c.fgColor);
  772. G.Line(X, Y - 4, X - 3, Y - 1, c.fgColor);
  773. Y := y + c.h - bs DIV 2 - 1;
  774. IF c.btnPressed = 1 THEN DEC(X) END;
  775. IF c.btnPressed = 2 THEN INC(X); INC(Y) END;
  776. G.VLine(X, Y - 4, Y + 4, c.fgColor);
  777. G.Line(X, Y + 4, X + 3, Y + 1, c.fgColor);
  778. G.Line(X, Y + 4, X - 3, Y + 1, c.fgColor);
  779. DrawButtonBox(x, y + c.handlePos, c.w, hs, c.bgColor,
  780. c.parent.bgColor, c.btnPressed = 3, FALSE)
  781. END DrawVertScrollBar;
  782. PROCEDURE DrawScrollBar*(c: ScrollBar; x, y, w, h: INTEGER);
  783. BEGIN
  784. IF c.vertical THEN
  785. DrawVertScrollBar(c, x, y, w, h)
  786. ELSE
  787. DrawHorizScrollBar(c, x, y, w, h)
  788. END;
  789. Drawn(c)
  790. END DrawScrollBar;
  791. PROCEDURE ScrollBarSetVertical*(c: ScrollBar; vertical: BOOLEAN);
  792. BEGIN c.vertical := vertical; Redraw(c)
  793. END ScrollBarSetVertical;
  794. PROCEDURE ScrollBarSetValue*(c: ScrollBar; value: INTEGER);
  795. BEGIN
  796. IF value < c.min THEN value := c.min
  797. ELSIF value > c.max THEN value := c.max
  798. END;
  799. IF c.value # value THEN
  800. c.value := value;
  801. IF c.onScroll # NIL THEN c.onScroll(c, value) END;
  802. Redraw(c)
  803. END
  804. END ScrollBarSetValue;
  805. PROCEDURE HandleScrollBarMouseMove(c: ScrollBar; VAR msg: MouseMoveMsg);
  806. VAR n, x, size, w: INTEGER;
  807. BEGIN
  808. IF c.handlePressed THEN
  809. IF c.vertical THEN x := msg.y; size := c.h
  810. ELSE x := msg.x; size := c.w
  811. END;
  812. w := size - c.btnSize * 2 - c.handleSize;
  813. n := x - c.handlePressPos - c.btnSize;
  814. n := (n * (c.max - c.min) + w DIV 2) DIV w + c.min;
  815. ScrollBarSetValue(c, n)
  816. END
  817. END HandleScrollBarMouseMove;
  818. PROCEDURE HandleScrollBarMouseDown(c: ScrollBar; VAR msg: MouseDownMsg);
  819. VAR x, d, size: INTEGER;
  820. BEGIN
  821. IF c.vertical THEN x := msg.y; size := c.h
  822. ELSE x := msg.x; size := c.w
  823. END;
  824. IF msg.btn = 2 THEN d := 1 ELSE d := c.inc END;
  825. IF x < c.btnSize THEN
  826. c.btnPressed := 1(*Less btn*);
  827. ScrollBarSetValue(c, c.value - d);
  828. Redraw(c)
  829. ELSIF x >= size - c.btnSize THEN
  830. c.btnPressed := 2(*More btn*);
  831. ScrollBarSetValue(c, c.value + d);
  832. Redraw(c)
  833. ELSIF msg.btn = 1 THEN
  834. IF (c.handlePos <= x) & (x < c.handlePos + c.handleSize) THEN
  835. c.btnPressed := 3(*Handle*);
  836. c.handlePressed := TRUE;
  837. c.handlePressPos := x - c.handlePos
  838. ELSIF x < c.handlePos THEN
  839. ScrollBarSetValue(c, c.value - c.bigInc)
  840. ELSE
  841. ScrollBarSetValue(c, c.value + c.bigInc)
  842. END;
  843. Redraw(c)
  844. ELSE c.btnPressed := 0(*Nothing*);
  845. END;
  846. WidgetHandler(c, msg)
  847. END HandleScrollBarMouseDown;
  848. PROCEDURE HandleScrollBarMouseUp(c: ScrollBar; VAR msg: MouseUpMsg);
  849. BEGIN
  850. c.handlePressed := FALSE;
  851. c.btnPressed := 0(*Nothing*);
  852. Redraw(c)
  853. END HandleScrollBarMouseUp;
  854. PROCEDURE ScrollBarHandler*(c: Widget; VAR msg: Message);
  855. VAR s: ScrollBar;
  856. BEGIN s := c(ScrollBar);
  857. IF msg IS DrawMsg THEN
  858. DrawScrollBar(s, msg(DrawMsg).x, msg(DrawMsg).y,
  859. msg(DrawMsg).w, msg(DrawMsg).h)
  860. ELSIF msg IS MouseMoveMsg THEN HandleScrollBarMouseMove(s, msg(MouseMoveMsg))
  861. ELSIF msg IS MouseDownMsg THEN HandleScrollBarMouseDown(s, msg(MouseDownMsg))
  862. ELSIF msg IS MouseUpMsg THEN HandleScrollBarMouseUp(s, msg(MouseUpMsg))
  863. ELSE WidgetHandler(c, msg)
  864. END
  865. END ScrollBarHandler;
  866. PROCEDURE InitScrollBar*(c: ScrollBar; where: Widget;
  867. x, y, w, h: INTEGER);
  868. BEGIN InitWidget(c, w, h);
  869. c.handle := ScrollBarHandler;
  870. c.value := 0; c.min := 0; c.max := 100; c.inc := 5; c.bigInc := 20;
  871. c.handlePos := 0; c.handleSize := 24; c.btnSize := 0;
  872. c.btnPressed := 0(*Nothing*);
  873. Put(c, where, x, y)
  874. END InitScrollBar;
  875. PROCEDURE NewScrollBar*(where: Widget; x, y, w, h: INTEGER): ScrollBar;
  876. VAR c: ScrollBar;
  877. BEGIN NEW(c); InitScrollBar(c, where, x, y, w, h)
  878. RETURN c END NewScrollBar;
  879. PROCEDURE ScrollBarSetOnScroll*(c: ScrollBar; proc: PROCEDURE (c: ScrollBar; value: INTEGER));
  880. BEGIN c.onScroll := proc
  881. END ScrollBarSetOnScroll;
  882. (** ScrollBox **)
  883. PROCEDURE ScrollBoxSetNoBg*(c: ScrollBox; noBg: BOOLEAN);
  884. BEGIN PanelSetNoBg(c.inner, noBg)
  885. END ScrollBoxSetNoBg;
  886. PROCEDURE ScrollBoxHandler*(c: Widget; VAR msg: Message);
  887. BEGIN
  888. IF msg IS DrawMsg THEN
  889. IF c.redraw THEN
  890. DrawBody(c, msg(DrawMsg).x, msg(DrawMsg).y, c.w, c.h, c.redrawSelf);
  891. Drawn(c)
  892. END
  893. ELSIF msg IS PutMsg THEN
  894. DirectPut(msg(PutMsg).what, c(ScrollBox).inner,
  895. msg(PutMsg).x, msg(PutMsg).y)
  896. ELSE WidgetHandler(c, msg)
  897. END
  898. END ScrollBoxHandler;
  899. PROCEDURE ScrollBoxSetInnerSize*(c: ScrollBox; w, h: INTEGER);
  900. BEGIN
  901. Resize(c.inner, w, h);
  902. c.scbHoriz.max := w - c.outer.w;
  903. c.scbVert.max := h - c.outer.h;
  904. Redraw(c)
  905. END ScrollBoxSetInnerSize;
  906. PROCEDURE ScrollBoxOnHorizScroll*(c: ScrollBar; value: INTEGER);
  907. VAR sbx: ScrollBox;
  908. BEGIN
  909. sbx := c.parent(ScrollBox);
  910. sbx.inner.x := -value;
  911. Redraw(sbx)
  912. END ScrollBoxOnHorizScroll;
  913. PROCEDURE ScrollBoxOnVertScroll*(c: ScrollBar; value: INTEGER);
  914. VAR sbx: ScrollBox;
  915. BEGIN
  916. sbx := c.parent(ScrollBox);
  917. sbx.inner.y := -value;
  918. Redraw(sbx)
  919. END ScrollBoxOnVertScroll;
  920. PROCEDURE InitScrollBox*(c: ScrollBox; where: Widget; x, y, w, h: INTEGER);
  921. BEGIN InitWidget(c, w, h);
  922. c.handle := ScrollBoxHandler;
  923. c.scbHoriz := NewScrollBar(NIL, 0, 0, w - 16, 16);
  924. DirectPut(c.scbHoriz, c, 0, h - 16);
  925. ScrollBarSetOnScroll(c.scbHoriz, ScrollBoxOnHorizScroll);
  926. c.scbVert := NewScrollBar(NIL, 0, 0, 16, h - 16);
  927. ScrollBarSetVertical(c.scbVert, TRUE);
  928. DirectPut(c.scbVert, c, w - 16, 0);
  929. ScrollBarSetOnScroll(c.scbVert, ScrollBoxOnVertScroll);
  930. c.outer := NewPanel(NIL, 0, 0, w - 16, h - 16);
  931. DirectPut(c.outer, c, 0, 0);
  932. PanelSetNoBg(c.outer, TRUE);
  933. c.inner := NewPanel(c.outer, 0, 0, 1, 1);
  934. ScrollBoxSetInnerSize(c, w * 2, h * 3);
  935. Put(c, where, x, y)
  936. END InitScrollBox;
  937. PROCEDURE NewScrollBox*(where: Widget; x, y, w, h: INTEGER): ScrollBox;
  938. VAR c: ScrollBox;
  939. BEGIN NEW(c); InitScrollBox(c, where, x, y, w, h)
  940. RETURN c END NewScrollBox;
  941. (** Canvas **)
  942. PROCEDURE CanvasHandler*(c: Widget; VAR msg: Message);
  943. VAR x, y: INTEGER;
  944. BEGIN
  945. IF msg IS DrawMsg THEN
  946. IF c.redraw THEN
  947. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  948. IF c.redrawSelf THEN G.Draw(c(Canvas).bmp, x, y) END;
  949. DrawBody(c, x, y, c.w, c.h, c.redrawSelf);
  950. Drawn(c)
  951. END
  952. ELSE WidgetHandler(c, msg)
  953. END
  954. END CanvasHandler;
  955. PROCEDURE InitCanvas*(c: Canvas; where: Widget; x, y, w, h: INTEGER);
  956. VAR wh: G.Color;
  957. BEGIN InitWidget(c, w, h);
  958. c.bmp := G.NewBitmap(w, h);
  959. G.MakeCol(wh, 255, 255, 255);
  960. G.ClearBitmapToColor(c.bmp, wh);
  961. c.handle := CanvasHandler;
  962. Put(c, where, x, y)
  963. END InitCanvas;
  964. PROCEDURE NewCanvas*(where: Widget; x, y, w, h: INTEGER): Canvas;
  965. VAR c: Canvas;
  966. BEGIN NEW(c); InitCanvas(c, where, x, y, w, h)
  967. RETURN c END NewCanvas;
  968. (** General **)
  969. PROCEDURE DrawAll;
  970. VAR c: Widget;
  971. updated: BOOLEAN;
  972. BEGIN
  973. G.TargetScreen;
  974. updated := FALSE;
  975. c := app.body;
  976. REPEAT
  977. IF c.redraw THEN
  978. DrawForm(c(Form));
  979. updated := TRUE
  980. END;
  981. c := c.next
  982. UNTIL c = app.body;
  983. IF updated OR forceFlip THEN
  984. G.Flip;
  985. forceFlip := FALSE
  986. END
  987. END DrawAll;
  988. PROCEDURE HandleMouseMove(VAR e: G.Event);
  989. VAR c: Widget;
  990. BEGIN
  991. forceFlip := TRUE;
  992. c := FindHoveredInRing(app.body, e.x, e.y, FALSE);
  993. IF c # NIL THEN
  994. WidgetHandleMouseMove(c, e.x - c.x, e.y - c.y, e.buttons)
  995. END
  996. END HandleMouseMove;
  997. PROCEDURE HandleMouseDown(VAR e: G.Event);
  998. VAR c: Widget;
  999. BEGIN
  1000. pressedX := 0; pressedY := 0;
  1001. c := FindHoveredInRing(app.body, e.x, e.y, TRUE);
  1002. IF c # NIL THEN
  1003. WidgetHandleMouseDown(c, e.x - c.x, e.y - c.y, e.button)
  1004. END
  1005. END HandleMouseDown;
  1006. PROCEDURE HandleMouseUp(VAR e: G.Event);
  1007. VAR c: Widget;
  1008. BEGIN
  1009. IF pressedWidget # NIL THEN
  1010. c := pressedWidget;
  1011. IF ~c.hovered THEN c := NIL END;
  1012. WidgetOnMouseUp(pressedWidget, e.x - pressedX, e.y - pressedY, e.button);
  1013. IF (c # NIL) & (e.button = 1) THEN
  1014. WidgetOnClick(c)
  1015. END
  1016. END
  1017. END HandleMouseUp;
  1018. PROCEDURE HandleKeyDown(VAR e: G.Event);
  1019. VAR msg: KeyDownMsg;
  1020. BEGIN
  1021. IF focusedWidget # NIL THEN
  1022. msg.key := e.key;
  1023. focusedWidget.handle(focusedWidget, msg)
  1024. END
  1025. END HandleKeyDown;
  1026. PROCEDURE HandleKeyUp(VAR e: G.Event);
  1027. VAR msg: KeyUpMsg;
  1028. BEGIN
  1029. IF focusedWidget # NIL THEN
  1030. msg.key := e.key;
  1031. focusedWidget.handle(focusedWidget, msg)
  1032. END
  1033. END HandleKeyUp;
  1034. PROCEDURE HandleChar(VAR e: G.Event);
  1035. VAR msg: CharMsg;
  1036. BEGIN
  1037. IF focusedWidget # NIL THEN
  1038. msg.key := e.key; msg.ch := e.ch;
  1039. msg.mod := e.mod; msg.repeat := e.repeat;
  1040. focusedWidget.handle(focusedWidget, msg)
  1041. END
  1042. END HandleChar;
  1043. PROCEDURE HandleEvent(VAR e: G.Event);
  1044. BEGIN
  1045. IF e.type = G.quit THEN quit := TRUE
  1046. ELSIF e.type = G.mouseMove THEN HandleMouseMove(e)
  1047. ELSIF e.type = G.mouseDown THEN HandleMouseDown(e)
  1048. ELSIF e.type = G.mouseUp THEN HandleMouseUp(e)
  1049. ELSIF e.type = G.keyDown THEN HandleKeyDown(e)
  1050. ELSIF e.type = G.keyUp THEN HandleKeyUp(e)
  1051. ELSIF e.type = G.char THEN HandleChar(e)
  1052. END
  1053. END HandleEvent;
  1054. PROCEDURE Quit*;
  1055. BEGIN quit := TRUE
  1056. END Quit;
  1057. PROCEDURE Run*;
  1058. VAR e: G.Event;
  1059. BEGIN
  1060. quit := FALSE;
  1061. REPEAT
  1062. WHILE ~quit & G.HasEvents() DO
  1063. G.WaitEvent(e);
  1064. HandleEvent(e)
  1065. END;
  1066. DrawAll
  1067. UNTIL quit
  1068. END Run;
  1069. PROCEDURE InitCursor;
  1070. VAR m: G.Bitmap;
  1071. bl, wh: G.Color;
  1072. i: INTEGER;
  1073. BEGIN
  1074. m := G.NewBitmap(10, 16);
  1075. G.ClearBitmap(m);
  1076. G.Target(m);
  1077. G.MakeCol(bl, 0, 0, 0);
  1078. G.MakeCol(wh, 255, 255, 255);
  1079. G.PutPixel(1, 1, wh);
  1080. FOR i := 2 TO 8 DO G.HLine(1, i, i, wh) END;
  1081. G.HLine(1, 9, 5, wh);
  1082. G.HLine(1, 10, 5, wh);
  1083. G.PutPixel(1, 11, wh);
  1084. G.HLine(5, 11, 6, wh);
  1085. G.HLine(5, 12, 6, wh);
  1086. G.HLine(6, 13, 7, wh);
  1087. G.HLine(6, 14, 7, wh);
  1088. G.Line(1, 0, 9, 8, bl);
  1089. G.VLine(0, 1, 12, bl);
  1090. G.Line(1, 12, 3, 10, bl);
  1091. G.Line(4, 11, 5, 14, bl);
  1092. G.HLine(6, 15, 7, bl);
  1093. G.Line(6, 9, 8, 14, bl);
  1094. G.HLine(7, 9, 9, bl);
  1095. G.SetCursor(m)
  1096. END InitCursor;
  1097. PROCEDURE Init*;
  1098. BEGIN
  1099. font := G.LoadFont('Data/Fonts/Main');
  1100. IF font = NIL THEN font := G.LoadFont('../Data/Fonts/Main') END;
  1101. IF font = NIL THEN Out.String('SimpleGui: Could not load font.'); Out.Ln END;
  1102. InitCursor;
  1103. Done := font # NIL;
  1104. app := NewApp();
  1105. hoveredWidget := NIL; pressedWidget := NIL;
  1106. forceFlip := TRUE;
  1107. pressedX := 0; pressedY := 0
  1108. END Init;
  1109. END SimpleGui.