2
0

SimpleGui.Mod 34 KB

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