2
0

SimpleGui.Mod 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251
  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. hoveredWidget: Widget;
  108. pressedWidget: Widget;
  109. pressedX, pressedY: INTEGER;
  110. mouseCursor: G.Bitmap;
  111. mouseX, mouseY: INTEGER;
  112. (** Widget **)
  113. PROCEDURE Redraw*(c: Widget);
  114. VAR p: Widget;
  115. BEGIN
  116. c.redraw := TRUE; c.redrawSelf := TRUE;
  117. p := c.parent;
  118. WHILE p # NIL DO p.redraw := TRUE; p := p.parent END
  119. END Redraw;
  120. PROCEDURE Drawn*(c: Widget);
  121. BEGIN c.redraw := FALSE; c.redrawSelf := FALSE
  122. END Drawn;
  123. PROCEDURE FindHoveredInRing(list: Widget; x, y: INTEGER;
  124. forMouseDown: BOOLEAN): Widget;
  125. VAR c: Widget;
  126. BEGIN
  127. IF list # NIL THEN
  128. c := list.prev;
  129. WHILE (c # NIL) &
  130. ~((c.x <= x) & (x < c.x + c.w) &
  131. (c.y <= y) & (y < c.y + c.h))
  132. DO
  133. IF c = list THEN c := NIL ELSE c := c.prev END
  134. END;
  135. IF forMouseDown & (c # NIL) THEN
  136. INC(pressedX, c.x); INC(pressedY, c.y)
  137. END
  138. ELSE c := NIL
  139. END
  140. RETURN c END FindHoveredInRing;
  141. PROCEDURE WidgetOnMouseEnter*(c: Widget);
  142. VAR msg: MouseEnterMsg;
  143. BEGIN
  144. IF pressedWidget = c THEN c.pressed := TRUE END;
  145. c.hovered := TRUE;
  146. c.handle(c, msg)
  147. END WidgetOnMouseEnter;
  148. PROCEDURE WidgetOnMouseLeave*(c: Widget);
  149. VAR msg: MouseLeaveMsg;
  150. BEGIN
  151. c.hovered := FALSE;
  152. c.pressed := FALSE;
  153. c.handle(c, msg)
  154. END WidgetOnMouseLeave;
  155. PROCEDURE WidgetOnMouseMove*(c: Widget; x, y: INTEGER; btns: SET);
  156. VAR msg: MouseMoveMsg;
  157. BEGIN
  158. IF (0 <= x) & (x < c.w) & (0 <= y) & (y < c.h) THEN
  159. IF c # hoveredWidget THEN
  160. IF hoveredWidget # NIL THEN WidgetOnMouseLeave(hoveredWidget) END;
  161. hoveredWidget := c;
  162. WidgetOnMouseEnter(hoveredWidget)
  163. END
  164. ELSIF c = hoveredWidget THEN
  165. WidgetOnMouseLeave(c);
  166. hoveredWidget := NIL
  167. END;
  168. msg.x := x; msg.y := y; msg.btns := btns;
  169. c.handle(c, msg);
  170. IF c.onMouseMove # NIL THEN c.onMouseMove(c, x, y, btns) END
  171. END WidgetOnMouseMove;
  172. PROCEDURE WidgetHandleMouseMove*(c: Widget; x, y: INTEGER; btns: SET);
  173. VAR p: Widget;
  174. BEGIN
  175. IF pressedWidget # NIL THEN
  176. WidgetOnMouseMove(pressedWidget, x - pressedX, y - pressedY, btns)
  177. ELSE
  178. p := FindHoveredInRing(c.body, x, y, FALSE);
  179. IF p # NIL THEN
  180. WidgetHandleMouseMove(p, x - p.x, y - p.y, btns)
  181. ELSE
  182. WidgetOnMouseMove(c, x, y, btns)
  183. END
  184. END
  185. END WidgetHandleMouseMove;
  186. PROCEDURE Resize*(c: Widget; w, h: INTEGER);
  187. BEGIN
  188. c.w := w;
  189. c.h := h
  190. END Resize;
  191. PROCEDURE Focus*(c: Widget);
  192. VAR get: GetFocusMsg;
  193. lost: LostFocusMsg;
  194. BEGIN
  195. IF ((c = NIL) OR c.focusable) & (focusedWidget # c) THEN
  196. IF focusedWidget # NIL THEN
  197. focusedWidget.focused := FALSE;
  198. focusedWidget.handle(focusedWidget, lost)
  199. END;
  200. IF c # NIL THEN
  201. c.focused := TRUE;
  202. focusedWidget := c;
  203. focusedWidget.handle(focusedWidget, get)
  204. END
  205. END
  206. END Focus;
  207. PROCEDURE Detach*(c: Widget);
  208. VAR p: Widget;
  209. BEGIN
  210. IF c.parent # NIL THEN
  211. IF c.prev = c THEN
  212. c.parent.body := NIL
  213. ELSE
  214. c.prev.next := c.next;
  215. c.next.prev := c.prev
  216. END;
  217. c.parent := NIL
  218. END;
  219. c.prev := NIL; c.next := NIL
  220. END Detach;
  221. PROCEDURE AppendTo*(c: Widget; container: Widget);
  222. VAR r: Widget;
  223. BEGIN
  224. Detach(c);
  225. c.parent := container;
  226. r := container.body;
  227. IF r = NIL THEN
  228. container.body := c;
  229. c.prev := c; c.next := c
  230. ELSE
  231. c.next := r; c.prev := r.prev;
  232. r.prev.next := c; r.prev := c
  233. END
  234. END AppendTo;
  235. PROCEDURE DirectPut*(c, where: Widget; x, y: INTEGER);
  236. BEGIN
  237. IF c # NIL THEN
  238. c.x := x; c.y := y;
  239. IF where # NIL THEN
  240. AppendTo(c, where)
  241. END
  242. END
  243. END DirectPut;
  244. PROCEDURE Put*(c, where: Widget; x, y: INTEGER);
  245. VAR msg: PutMsg;
  246. BEGIN
  247. IF c # NIL THEN
  248. c.x := x; c.y := y;
  249. IF where # NIL THEN
  250. msg.what := c;
  251. msg.x := x;
  252. msg.y := y;
  253. where.handle(where, msg)
  254. END
  255. END
  256. END Put;
  257. PROCEDURE WidgetOnMouseDown*(c: Widget; x, y, btn: INTEGER);
  258. VAR msg: MouseDownMsg;
  259. BEGIN
  260. pressedWidget := c;
  261. Focus(c);
  262. msg.x := x; msg.y := y; msg.btn := btn;
  263. c.handle(c, msg);
  264. IF c.onMouseDown # NIL THEN c.onMouseDown(c, x, y, btn) END
  265. END WidgetOnMouseDown;
  266. PROCEDURE WidgetHandleMouseDown*(c: Widget; x, y, btn: INTEGER);
  267. VAR p: Widget;
  268. BEGIN
  269. p := FindHoveredInRing(c.body, x, y, TRUE);
  270. IF p # NIL THEN
  271. WidgetHandleMouseDown(p, x - p.x, y - p.y, btn)
  272. ELSE
  273. WidgetOnMouseDown(c, x, y, btn)
  274. END
  275. END WidgetHandleMouseDown;
  276. PROCEDURE WidgetOnMouseUp*(c: Widget; x, y, btn: INTEGER);
  277. VAR msg: MouseUpMsg;
  278. BEGIN
  279. pressedWidget := NIL;
  280. msg.x := x; msg.y := y; msg.btn := btn;
  281. c.handle(c, msg);
  282. IF c.onMouseUp # NIL THEN c.onMouseUp(c, x, y, btn) END
  283. END WidgetOnMouseUp;
  284. PROCEDURE WidgetOnClick*(c: Widget);
  285. VAR msg: ClickMsg;
  286. BEGIN c.handle(c, msg);
  287. IF c.onClick # NIL THEN c.onClick(c) END
  288. END WidgetOnClick;
  289. PROCEDURE WidgetHandler*(c: Widget; VAR msg: Message);
  290. VAR x, y: INTEGER;
  291. BEGIN
  292. IF msg IS DrawMsg THEN
  293. IF c.redraw THEN
  294. IF c.redrawSelf THEN
  295. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  296. IF c.onPaint # NIL THEN
  297. c.onPaint(c, x, y, msg(DrawMsg).w, msg(DrawMsg).h)
  298. ELSE
  299. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  300. G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor);
  301. G.Rect(x + 2, y + 2, x + c.w - 3, y + c.h - 3, c.fgColor)
  302. END;
  303. Drawn(c)
  304. END
  305. END
  306. ELSIF msg IS MouseDownMsg THEN
  307. IF msg(MouseDownMsg).btn = 1 THEN c.pressed := TRUE END
  308. ELSIF msg IS MouseUpMsg THEN c.pressed := FALSE
  309. ELSIF msg IS PutMsg THEN
  310. DirectPut(msg(PutMsg).what, c, msg(PutMsg).x, msg(PutMsg).y)
  311. ELSIF msg IS GetFocusMsg THEN Redraw(c)
  312. ELSIF msg IS LostFocusMsg THEN Redraw(c)
  313. END
  314. END WidgetHandler;
  315. PROCEDURE DrawWidget*(c: Widget; x, y, w, h: INTEGER);
  316. VAR M: DrawMsg;
  317. BEGIN
  318. M.x := x; M.y := y; M.w := w; M.h := h;
  319. c.handle(c, M)
  320. END DrawWidget;
  321. PROCEDURE DrawBody*(c: Widget; x, y, w, h: INTEGER);
  322. VAR p: Widget;
  323. x2, y2, w2, h2: INTEGER;
  324. cx, cy, cw, ch: INTEGER;
  325. CX, CY, CW, CH: INTEGER;
  326. BEGIN
  327. p := c.body;
  328. IF p # NIL THEN
  329. G.GetClip(CX, CY, CW, CH);
  330. IF CX + CW > x + w THEN CW := x + w - CX END;
  331. IF CY + CH > y + h THEN CH := y + h - CY END;
  332. IF CX < x THEN DEC(CW, x - CX); CX := x END;
  333. IF CY < y THEN DEC(CH, y - CY); CY := y END;
  334. REPEAT
  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);
  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);
  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. ELSIF x >= size - c.btnSize THEN
  829. c.btnPressed := 2(*More btn*);
  830. ScrollBarSetValue(c, c.value + d)
  831. ELSIF msg.btn = 1 THEN
  832. IF (c.handlePos <= x) & (x < c.handlePos + c.handleSize) THEN
  833. c.btnPressed := 3(*Handle*);
  834. c.handlePressed := TRUE;
  835. c.handlePressPos := x - c.handlePos
  836. ELSIF x < c.handlePos THEN
  837. ScrollBarSetValue(c, c.value - c.bigInc)
  838. ELSE
  839. ScrollBarSetValue(c, c.value + c.bigInc)
  840. END
  841. ELSE c.btnPressed := 0(*Nothing*);
  842. END;
  843. WidgetHandler(c, msg)
  844. END HandleScrollBarMouseDown;
  845. PROCEDURE ScrollBarHandler*(c: Widget; VAR msg: Message);
  846. VAR s: ScrollBar;
  847. BEGIN s := c(ScrollBar);
  848. IF msg IS DrawMsg THEN
  849. DrawScrollBar(s, msg(DrawMsg).x, msg(DrawMsg).y,
  850. msg(DrawMsg).w, msg(DrawMsg).h)
  851. ELSIF msg IS MouseMoveMsg THEN HandleScrollBarMouseMove(s, msg(MouseMoveMsg))
  852. ELSIF msg IS MouseDownMsg THEN HandleScrollBarMouseDown(s, msg(MouseDownMsg))
  853. ELSIF msg IS MouseUpMsg THEN s.handlePressed := FALSE; s.btnPressed := 0(*Nothing*)
  854. ELSE WidgetHandler(c, msg)
  855. END
  856. END ScrollBarHandler;
  857. PROCEDURE InitScrollBar*(c: ScrollBar; where: Widget;
  858. x, y, w, h: INTEGER);
  859. BEGIN InitWidget(c, w, h);
  860. c.handle := ScrollBarHandler;
  861. c.value := 0; c.min := 0; c.max := 100; c.inc := 5; c.bigInc := 20;
  862. c.handlePos := 0; c.handleSize := 24; c.btnSize := 0;
  863. c.btnPressed := 0(*Nothing*);
  864. Put(c, where, x, y)
  865. END InitScrollBar;
  866. PROCEDURE NewScrollBar*(where: Widget; x, y, w, h: INTEGER): ScrollBar;
  867. VAR c: ScrollBar;
  868. BEGIN NEW(c); InitScrollBar(c, where, x, y, w, h)
  869. RETURN c END NewScrollBar;
  870. PROCEDURE ScrollBarSetOnScroll*(c: ScrollBar; proc: PROCEDURE (c: ScrollBar; value: INTEGER));
  871. BEGIN c.onScroll := proc
  872. END ScrollBarSetOnScroll;
  873. (** ScrollBox **)
  874. PROCEDURE ScrollBoxSetNoBg*(c: ScrollBox; noBg: BOOLEAN);
  875. BEGIN PanelSetNoBg(c.inner, noBg)
  876. END ScrollBoxSetNoBg;
  877. PROCEDURE ScrollBoxHandler*(c: Widget; VAR msg: Message);
  878. BEGIN
  879. IF msg IS DrawMsg THEN
  880. DrawBody(c, msg(DrawMsg).x, msg(DrawMsg).y, c.w, c.h)
  881. ELSIF msg IS PutMsg THEN
  882. DirectPut(msg(PutMsg).what, c(ScrollBox).inner,
  883. msg(PutMsg).x, msg(PutMsg).y)
  884. ELSE WidgetHandler(c, msg)
  885. END
  886. END ScrollBoxHandler;
  887. PROCEDURE ScrollBoxSetInnerSize*(c: ScrollBox; w, h: INTEGER);
  888. BEGIN
  889. Resize(c.inner, w, h);
  890. c.scbHoriz.max := w - c.outer.w;
  891. c.scbVert.max := h - c.outer.h;
  892. Redraw(c)
  893. END ScrollBoxSetInnerSize;
  894. PROCEDURE ScrollBoxOnHorizScroll*(c: ScrollBar; value: INTEGER);
  895. VAR sbx: ScrollBox;
  896. BEGIN
  897. sbx := c.parent(ScrollBox);
  898. sbx.inner.x := -value;
  899. Redraw(c)
  900. END ScrollBoxOnHorizScroll;
  901. PROCEDURE ScrollBoxOnVertScroll*(c: ScrollBar; value: INTEGER);
  902. VAR sbx: ScrollBox;
  903. BEGIN
  904. sbx := c.parent(ScrollBox);
  905. sbx.inner.y := -value;
  906. Redraw(c)
  907. END ScrollBoxOnVertScroll;
  908. PROCEDURE InitScrollBox*(c: ScrollBox; where: Widget; x, y, w, h: INTEGER);
  909. BEGIN InitWidget(c, w, h);
  910. c.handle := ScrollBoxHandler;
  911. c.scbHoriz := NewScrollBar(NIL, 0, 0, w - 16, 16);
  912. DirectPut(c.scbHoriz, c, 0, h - 16);
  913. ScrollBarSetOnScroll(c.scbHoriz, ScrollBoxOnHorizScroll);
  914. c.scbVert := NewScrollBar(NIL, 0, 0, 16, h - 16);
  915. ScrollBarSetVertical(c.scbVert, TRUE);
  916. DirectPut(c.scbVert, c, w - 16, 0);
  917. ScrollBarSetOnScroll(c.scbVert, ScrollBoxOnVertScroll);
  918. c.outer := NewPanel(NIL, 0, 0, w - 16, h - 16);
  919. DirectPut(c.outer, c, 0, 0);
  920. PanelSetNoBg(c.outer, TRUE);
  921. c.inner := NewPanel(c.outer, 0, 0, 1, 1);
  922. ScrollBoxSetInnerSize(c, w * 2, h * 3);
  923. Put(c, where, x, y)
  924. END InitScrollBox;
  925. PROCEDURE NewScrollBox*(where: Widget; x, y, w, h: INTEGER): ScrollBox;
  926. VAR c: ScrollBox;
  927. BEGIN NEW(c); InitScrollBox(c, where, x, y, w, h)
  928. RETURN c END NewScrollBox;
  929. (** Canvas **)
  930. PROCEDURE CanvasHandler*(c: Widget; VAR msg: Message);
  931. VAR x, y: INTEGER;
  932. BEGIN
  933. IF msg IS DrawMsg THEN
  934. IF c.redraw THEN
  935. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  936. IF c.redrawSelf THEN G.Draw(c(Canvas).bmp, x, y) END;
  937. DrawBody(c, x, y, c.w, c.h);
  938. Drawn(c)
  939. END
  940. ELSE WidgetHandler(c, msg)
  941. END
  942. END CanvasHandler;
  943. PROCEDURE InitCanvas*(c: Canvas; where: Widget; x, y, w, h: INTEGER);
  944. VAR wh: G.Color;
  945. BEGIN InitWidget(c, w, h);
  946. c.bmp := G.NewBitmap(w, h);
  947. G.MakeCol(wh, 255, 255, 255);
  948. G.ClearBitmapToColor(c.bmp, wh);
  949. c.handle := CanvasHandler;
  950. Put(c, where, x, y)
  951. END InitCanvas;
  952. PROCEDURE NewCanvas*(where: Widget; x, y, w, h: INTEGER): Canvas;
  953. VAR c: Canvas;
  954. BEGIN NEW(c); InitCanvas(c, where, x, y, w, h)
  955. RETURN c END NewCanvas;
  956. (** General **)
  957. PROCEDURE DrawCursor;
  958. BEGIN
  959. IF mouseX >= 0 THEN
  960. G.Draw(mouseCursor, mouseX, mouseY)
  961. END
  962. END DrawCursor;
  963. PROCEDURE DrawAll;
  964. VAR c: Widget;
  965. BEGIN
  966. G.TargetScreen;
  967. c := app.body;
  968. REPEAT
  969. DrawForm(c(Form));
  970. c := c.next
  971. UNTIL c = app.body;
  972. DrawCursor;
  973. G.Flip
  974. END DrawAll;
  975. PROCEDURE HandleMouseMove(VAR e: G.Event);
  976. VAR c: Widget;
  977. BEGIN
  978. mouseX := e.x; mouseY := e.y;
  979. c := FindHoveredInRing(app.body, e.x, e.y, FALSE);
  980. IF c # NIL THEN
  981. WidgetHandleMouseMove(c, e.x - c.x, e.y - c.y, e.buttons)
  982. END
  983. END HandleMouseMove;
  984. PROCEDURE HandleMouseDown(VAR e: G.Event);
  985. VAR c: Widget;
  986. BEGIN
  987. pressedX := 0; pressedY := 0;
  988. c := FindHoveredInRing(app.body, e.x, e.y, TRUE);
  989. IF c # NIL THEN
  990. WidgetHandleMouseDown(c, e.x - c.x, e.y - c.y, e.button)
  991. END
  992. END HandleMouseDown;
  993. PROCEDURE HandleMouseUp(VAR e: G.Event);
  994. VAR c: Widget;
  995. BEGIN
  996. IF pressedWidget # NIL THEN
  997. c := pressedWidget;
  998. IF ~c.hovered THEN c := NIL END;
  999. WidgetOnMouseUp(pressedWidget, e.x - pressedX, e.y - pressedY, e.button);
  1000. IF (c # NIL) & (e.button = 1) THEN
  1001. WidgetOnClick(c)
  1002. END
  1003. END
  1004. END HandleMouseUp;
  1005. PROCEDURE HandleKeyDown(VAR e: G.Event);
  1006. VAR msg: KeyDownMsg;
  1007. BEGIN
  1008. IF focusedWidget # NIL THEN
  1009. msg.key := e.key;
  1010. focusedWidget.handle(focusedWidget, msg)
  1011. END
  1012. END HandleKeyDown;
  1013. PROCEDURE HandleKeyUp(VAR e: G.Event);
  1014. VAR msg: KeyUpMsg;
  1015. BEGIN
  1016. IF focusedWidget # NIL THEN
  1017. msg.key := e.key;
  1018. focusedWidget.handle(focusedWidget, msg)
  1019. END
  1020. END HandleKeyUp;
  1021. PROCEDURE HandleChar(VAR e: G.Event);
  1022. VAR msg: CharMsg;
  1023. BEGIN
  1024. IF focusedWidget # NIL THEN
  1025. msg.key := e.key; msg.ch := e.ch;
  1026. msg.mod := e.mod; msg.repeat := e.repeat;
  1027. focusedWidget.handle(focusedWidget, msg)
  1028. END
  1029. END HandleChar;
  1030. PROCEDURE HandleEvent(VAR e: G.Event);
  1031. BEGIN
  1032. IF e.type = G.quit THEN quit := TRUE
  1033. ELSIF e.type = G.mouseMove THEN HandleMouseMove(e)
  1034. ELSIF e.type = G.mouseDown THEN HandleMouseDown(e)
  1035. ELSIF e.type = G.mouseUp THEN HandleMouseUp(e)
  1036. ELSIF e.type = G.keyDown THEN HandleKeyDown(e)
  1037. ELSIF e.type = G.keyUp THEN HandleKeyUp(e)
  1038. ELSIF e.type = G.char THEN HandleChar(e)
  1039. END
  1040. END HandleEvent;
  1041. PROCEDURE Quit*;
  1042. BEGIN quit := TRUE
  1043. END Quit;
  1044. PROCEDURE Run*;
  1045. VAR e: G.Event;
  1046. BEGIN
  1047. quit := FALSE;
  1048. REPEAT
  1049. WHILE ~quit & G.HasEvents() DO
  1050. G.WaitEvent(e);
  1051. HandleEvent(e)
  1052. END;
  1053. DrawAll
  1054. UNTIL quit
  1055. END Run;
  1056. PROCEDURE CreateArrowCursor(): G.Bitmap;
  1057. VAR m: G.Bitmap;
  1058. bl, wh: G.Color;
  1059. i: INTEGER;
  1060. BEGIN
  1061. m := G.NewBitmap(10, 16);
  1062. G.ClearBitmap(m);
  1063. G.Target(m);
  1064. G.MakeCol(bl, 0, 0, 0);
  1065. G.MakeCol(wh, 255, 255, 255);
  1066. G.PutPixel(1, 1, wh);
  1067. FOR i := 2 TO 8 DO G.HLine(1, i, i, wh) END;
  1068. G.HLine(1, 9, 5, wh);
  1069. G.HLine(1, 10, 5, wh);
  1070. G.PutPixel(1, 11, wh);
  1071. G.HLine(5, 11, 6, wh);
  1072. G.HLine(5, 12, 6, wh);
  1073. G.HLine(6, 13, 7, wh);
  1074. G.HLine(6, 14, 7, wh);
  1075. G.Line(1, 0, 9, 8, bl);
  1076. G.VLine(0, 1, 12, bl);
  1077. G.Line(1, 12, 3, 10, bl);
  1078. G.Line(4, 11, 5, 14, bl);
  1079. G.HLine(6, 15, 7, bl);
  1080. G.Line(6, 9, 8, 14, bl);
  1081. G.HLine(7, 9, 9, bl);
  1082. RETURN m END CreateArrowCursor;
  1083. PROCEDURE InitCursor;
  1084. BEGIN
  1085. mouseCursor := CreateArrowCursor();
  1086. mouseX := -1; mouseY := 0;
  1087. G.ShowMouse(FALSE)
  1088. END InitCursor;
  1089. PROCEDURE Init*;
  1090. BEGIN
  1091. font := G.LoadFont('Data/Fonts/Main');
  1092. IF font = NIL THEN font := G.LoadFont('../Data/Fonts/Main') END;
  1093. IF font = NIL THEN Out.String('SimpleGui: could not load font.'); Out.Ln END;
  1094. InitCursor;
  1095. Done := font # NIL;
  1096. app := NewApp();
  1097. hoveredWidget := NIL; pressedWidget := NIL;
  1098. pressedX := 0; pressedY := 0
  1099. END Init;
  1100. END SimpleGui.