SimpleGui.Mod 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265
  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; forced: BOOLEAN);
  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 forced THEN p.redraw := TRUE; p.redrawSelf := TRUE END;
  336. IF p.redraw THEN
  337. x2 := x + p.x; y2 := y + p.y;
  338. w2 := w - p.x; h2 := h - p.y;
  339. cx := x2; cy := y2; cw := p.w; ch := p.h;
  340. IF cx + cw > CX + CW THEN cw := CX + CW - cx END;
  341. IF cy + ch > CY + CH THEN ch := CY + CH - cy END;
  342. IF cx < CX THEN DEC(cw, CX - cx); cx := CX END;
  343. IF cy < CY THEN DEC(ch, CY - cy); cy := CY END;
  344. G.SetClip(cx, cy, cw, ch);
  345. DrawWidget(p, x2, y2, p.w, p.h)
  346. END;
  347. p := p.next
  348. UNTIL p = c.body;
  349. G.UnsetClip
  350. END
  351. END DrawBody;
  352. PROCEDURE SetBgColor*(c: Widget; color: G.Color);
  353. BEGIN c.bgColor := color
  354. END SetBgColor;
  355. PROCEDURE SetFgColor*(c: Widget; color: G.Color);
  356. BEGIN c.fgColor := color
  357. END SetFgColor;
  358. PROCEDURE SetOnPaint*(c: Widget; proc: PROCEDURE (c: Widget; x, y, w, h: INTEGER));
  359. BEGIN c.onPaint := proc
  360. END SetOnPaint;
  361. PROCEDURE SetOnMouseMove*(c: Widget; proc: PROCEDURE (c: Widget; x, y: INTEGER; btns: SET));
  362. BEGIN c.onMouseMove := proc
  363. END SetOnMouseMove;
  364. PROCEDURE SetOnMouseDown*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
  365. BEGIN c.onMouseDown := proc
  366. END SetOnMouseDown;
  367. PROCEDURE SetOnMouseUp*(c: Widget; proc: PROCEDURE (c: Widget; x, y, btn: INTEGER));
  368. BEGIN c.onMouseUp := proc
  369. END SetOnMouseUp;
  370. PROCEDURE SetOnClick*(c: Widget; proc: PROCEDURE (c: Widget));
  371. BEGIN c.onClick := proc
  372. END SetOnClick;
  373. PROCEDURE InitWidget*(c: Widget; w, h: INTEGER);
  374. BEGIN c.x := 0; c.y := 0; c.w := w; c.h := h;
  375. c.redraw := TRUE; c.redrawSelf := TRUE;
  376. c.focusable := FALSE; c.focused := FALSE;
  377. c.hovered := FALSE; c.pressed := FALSE;
  378. G.MakeCol(c.bgColor, 180, 180, 180);
  379. G.MakeCol(c.fgColor, 0, 0, 0);
  380. c.handle := WidgetHandler
  381. END InitWidget;
  382. (** Creates and returns a new custom widget *)
  383. PROCEDURE NewWidget*(where: Widget; x, y, w, h: INTEGER): Widget;
  384. VAR c: Widget;
  385. BEGIN NEW(c); InitWidget(c, w, h);
  386. Put(c, where, x, y)
  387. RETURN c END NewWidget;
  388. (** Panel **)
  389. PROCEDURE PanelSetNoBg*(c: Panel; noBg: BOOLEAN);
  390. BEGIN c.noBg := noBg; Redraw(c)
  391. END PanelSetNoBg;
  392. PROCEDURE PanelHandler*(c: Widget; VAR msg: Message);
  393. VAR x, y: INTEGER;
  394. BEGIN
  395. IF msg IS DrawMsg THEN
  396. IF c.redraw THEN
  397. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  398. IF c.redrawSelf & ~c(Panel).noBg THEN
  399. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor)
  400. END;
  401. DrawBody(c, x, y, c.w, c.h, c.redrawSelf);
  402. Drawn(c)
  403. END
  404. ELSE WidgetHandler(c, msg)
  405. END
  406. END PanelHandler;
  407. PROCEDURE InitPanel*(c: Panel; where: Widget; x, y, w, h: INTEGER);
  408. BEGIN InitWidget(c, w, h);
  409. c.noBg := FALSE;
  410. c.handle := PanelHandler;
  411. Put(c, where, x, y)
  412. END InitPanel;
  413. PROCEDURE NewPanel*(where: Widget; x, y, w, h: INTEGER): Panel;
  414. VAR c: Panel;
  415. BEGIN NEW(c); InitPanel(c, where, x, y, w, h)
  416. RETURN c END NewPanel;
  417. (** App **)
  418. PROCEDURE InitApp*(c: App);
  419. VAR W, H: INTEGER;
  420. BEGIN
  421. G.GetScreenSize(W, H);
  422. InitWidget(c, W, H)
  423. END InitApp;
  424. PROCEDURE NewApp*(): App;
  425. VAR c: App;
  426. BEGIN NEW(c); InitApp(c)
  427. RETURN c END NewApp;
  428. (** Form **)
  429. PROCEDURE DrawForm*(c: Form);
  430. BEGIN
  431. IF c.redraw THEN
  432. IF c.redrawSelf THEN
  433. G.FillRect(c.x, c.y, c.x + c.w - 1, c.y + c.h - 1, c.bgColor)
  434. END;
  435. DrawBody(c, c.x, c.y, c.w, c.h, c.redrawSelf);
  436. Drawn(c)
  437. END
  438. END DrawForm;
  439. PROCEDURE FormHandler*(c: Widget; VAR msg: Message);
  440. BEGIN WidgetHandler(c, msg)
  441. END FormHandler;
  442. PROCEDURE InitForm*(c: Form; x, y, w, h: INTEGER);
  443. BEGIN InitWidget(c, w, h);
  444. c.x := x; c.y := y;
  445. c.handle := FormHandler;
  446. AppendTo(c, app)
  447. END InitForm;
  448. PROCEDURE NewForm*(x, y, w, h: INTEGER): Form;
  449. VAR c: Form;
  450. BEGIN NEW(c); InitForm(c, x, y, w, h)
  451. RETURN c END NewForm;
  452. (** Button **)
  453. PROCEDURE MakeOrAndYw(bg: G.Color; VAR or, yw: G.Color);
  454. VAR r, g, b: INTEGER;
  455. BEGIN
  456. G.ColorToRGB(bg, r, g, b);
  457. G.MakeCol(yw, (r + 255 * 2) DIV 3, (g + 255 * 3) DIV 4, (b * 3 + 255) DIV 4);
  458. IF (r <= g) & (r <= b) THEN
  459. g := (g * 2 + 255 * 3) DIV 5;
  460. b := (b * 3 + 255) DIV 4
  461. ELSIF (g <= r) & (g <= b) THEN
  462. r := (r * 2 + 255 * 3) DIV 5;
  463. b := (b * 3 + 255) DIV 4
  464. ELSE
  465. r := (r * 2 + 255 * 3) DIV 5;
  466. g := (g * 3 + 255) DIV 4
  467. END;
  468. G.MakeCol(or, r, g, b)
  469. END MakeOrAndYw;
  470. PROCEDURE DrawButtonBox(x, y, w, h: INTEGER; bg, parentBg: G.Color;
  471. down, glow: BOOLEAN);
  472. VAR wh, bl, g1, g2, or, yw: G.Color;
  473. X, Y: INTEGER;
  474. BEGIN
  475. G.MakeCol(bl, 0, 0, 0);
  476. G.MakeCol(wh, 255, 255, 255);
  477. G.MakeCol(g1, 140, 140, 140);
  478. G.MakeCol(g2, 80, 80, 80);
  479. MakeOrAndYw(parentBg, or, yw);
  480. X := x + w - 1; Y := y + h - 1;
  481. G.FillRect(x + 1, y + 1, X - 2, Y - 2, bg);
  482. G.HLine(x + 2, y, X - 1, bl);
  483. G.HLine(x, Y - 1, X - 4, bl);
  484. G.VLine(x, y + 2, Y - 1, bl);
  485. G.VLine(X - 1, y + 1, Y - 4, bl);
  486. IF ~down THEN
  487. G.HLine(x + 3, y + 1, X - 2, wh);
  488. G.HLine(x + 2, Y - 2, X - 4, g1);
  489. G.VLine(x + 1, y + 3, Y - 2, wh);
  490. G.VLine(X - 2, y + 2, Y - 4, g1);
  491. G.PutPixel(X - 3, Y - 3, g1);
  492. G.Line(X - 4, Y - 3, X - 3, Y - 4, g1);
  493. G.PutPixel(x + 2, y + 2, wh)
  494. END;
  495. G.Line(X - 3, Y - 2, X - 2, Y - 3, bl);
  496. G.Line(X - 3, Y - 1, X - 1, Y - 3, g2);
  497. G.Line(x + 1, y + 2, x + 2, y + 1, g1);
  498. G.PutPixel(x + 1, y + 1, bl);
  499. IF glow THEN
  500. G.Line(X - 2, Y - 1, X - 1, Y - 2, yw);
  501. G.HLine(x + 1, Y, X - 2, or);
  502. G.VLine(X, y + 1, Y - 2, or);
  503. G.PutPixel(X - 1, Y - 1, or)
  504. END
  505. END DrawButtonBox;
  506. PROCEDURE DrawButton*(c: Button; x, y, w, h: INTEGER);
  507. VAR fw, fh, tw, tx, ty: INTEGER;
  508. BEGIN
  509. IF c.redraw THEN
  510. DrawButtonBox(x, y, c.w, c.h, c.bgColor, c.parent.bgColor,
  511. c.pressed & c.hovered, TRUE);
  512. G.GetMonoFontSize(font, fw, fh);
  513. tw := Strings.Length(c.caption) * fw;
  514. tx := x + (c.w - tw) DIV 2;
  515. ty := y + (c.h - fh) DIV 2;
  516. IF c.pressed & c.hovered THEN INC(tx); INC(ty) END;
  517. G.DrawString(c.caption, tx, ty, font, c.fgColor);
  518. Drawn(c)
  519. END
  520. END DrawButton;
  521. PROCEDURE ButtonHandler*(c: Widget; VAR msg: Message);
  522. VAR b: Button;
  523. BEGIN b := c(Button);
  524. IF msg IS DrawMsg THEN
  525. DrawButton(b, msg(DrawMsg).x, msg(DrawMsg).y,
  526. msg(DrawMsg).w, msg(DrawMsg).h);
  527. ELSE WidgetHandler(c, msg)
  528. END
  529. END ButtonHandler;
  530. PROCEDURE InitButton*(c: Button; where: Widget;
  531. x, y, w, h: INTEGER; caption: ARRAY OF CHAR);
  532. BEGIN InitWidget(c, w, h);
  533. Strings.Copy(caption, c.caption);
  534. c.focusable := TRUE;
  535. c.handle := ButtonHandler;
  536. Put(c, where, x, y)
  537. END InitButton;
  538. PROCEDURE NewButton*(where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR): Button;
  539. VAR c: Button;
  540. BEGIN NEW(c); InitButton(c, where, x, y, w, h, caption)
  541. RETURN c END NewButton;
  542. (** Label **)
  543. PROCEDURE DrawLabel*(c: Label; x, y, w, h: INTEGER);
  544. VAR fw, fh, tw, tx, ty: INTEGER;
  545. BEGIN
  546. IF c.redraw THEN
  547. G.GetMonoFontSize(font, fw, fh);
  548. tx := 0;
  549. IF c.align # alLeft THEN
  550. tw := Strings.Length(c.caption) * fw;
  551. IF c.align = alCenter THEN
  552. tx := (c.w - tw) DIV 2
  553. ELSIF c.align = alRight THEN
  554. tx := c.w - tw
  555. END
  556. END;
  557. ty := y + (c.h - fh) DIV 2;
  558. G.DrawString(c.caption, tx, ty, font, c.fgColor);
  559. Drawn(c)
  560. END
  561. END DrawLabel;
  562. PROCEDURE LabelHandler*(c: Widget; VAR msg: Message);
  563. VAR e: Label;
  564. BEGIN e := c(Label);
  565. IF msg IS DrawMsg THEN
  566. DrawLabel(e, msg(DrawMsg).x, msg(DrawMsg).y,
  567. msg(DrawMsg).w, msg(DrawMsg).h)
  568. ELSE WidgetHandler(c, msg)
  569. END
  570. END LabelHandler;
  571. PROCEDURE InitLabel*(c: Label; where: Widget; x, y, w, h: INTEGER;
  572. caption: ARRAY OF CHAR);
  573. BEGIN InitWidget(c, w, h);
  574. Strings.Copy(caption, c.caption);
  575. c.handle := LabelHandler;
  576. c.align := alLeft;
  577. Put(c, where, x, y)
  578. END InitLabel;
  579. PROCEDURE NewLabel*(where: Widget; x, y, w, h: INTEGER;
  580. caption: ARRAY OF CHAR): Label;
  581. VAR c: Label;
  582. BEGIN NEW(c); InitLabel(c, where, x, y, w, h, caption)
  583. RETURN c END NewLabel;
  584. PROCEDURE LabelSetCaption*(c: Label; caption: ARRAY OF CHAR);
  585. BEGIN Strings.Copy(caption, c.caption); Redraw(c)
  586. END LabelSetCaption;
  587. PROCEDURE LabelSetAlign*(c: Label; align: INTEGER);
  588. BEGIN c.align := align; Redraw(c)
  589. END LabelSetAlign;
  590. (** Edit **)
  591. PROCEDURE DrawEdit*(c: Edit; x, y, w, h: INTEGER);
  592. VAR fw, fh, tw, tx, ty: INTEGER;
  593. or, yw: G.Color;
  594. BEGIN
  595. IF c.redraw THEN
  596. MakeOrAndYw(c.parent.bgColor, or, yw);
  597. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  598. G.GetMonoFontSize(font, fw, fh);
  599. tw := Strings.Length(c.text) * fw;
  600. tx := x + 2 - c.off;
  601. ty := y + (c.h - fh) DIV 2;
  602. G.DrawString(c.text, tx, ty, font, c.fgColor);
  603. IF c.focused THEN
  604. INC(tx, fw * c.pos - 1);
  605. G.VLine(tx, ty, ty + fh - 1, or);
  606. G.HLine(tx - 1, ty, tx + 1, or);
  607. G.HLine(tx - 1, ty + fh - 1, tx + 1, or)
  608. END;
  609. G.HLine(x, y, x + c.w - 2, c.fgColor);
  610. G.VLine(x, y, y + c.h - 1, c.fgColor);
  611. G.HLine(x + 1, y + c.h - 1, x + c.w - 1, or);
  612. G.VLine(x + c.w - 1, y, y + c.h - 1, or);
  613. Drawn(c)
  614. END
  615. END DrawEdit;
  616. PROCEDURE EditOnMouseDown*(c: Edit; VAR msg: MouseDownMsg);
  617. VAR n, fw, fh: INTEGER;
  618. BEGIN
  619. IF (msg.btn = 1) & (msg.x > 0) & (msg.x < c.w - 1) &
  620. (msg.y > 0) & (msg.y < c.h - 1)
  621. THEN
  622. G.GetMonoFontSize(font, fw, fh);
  623. n := (msg.x - 2 + fw DIV 2) DIV fw;
  624. IF n < 0 THEN n := 0 ELSIF n > c.len THEN n := c.len END;
  625. IF c.pos # n THEN
  626. c.pos := n;
  627. Redraw(c)
  628. END
  629. END
  630. END EditOnMouseDown;
  631. PROCEDURE EditCheckOffset(c: Edit);
  632. VAR n, fw, fh: INTEGER;
  633. BEGIN
  634. G.GetMonoFontSize(font, fw, fh);
  635. n := c.pos * fw - c.off;
  636. IF c.len * fw <= c.w - 4 THEN c.off := 0
  637. ELSIF n < 0 THEN c.off := c.pos * fw
  638. ELSIF n >= c.w - 4 THEN c.off := c.pos * fw - c.w + 4
  639. ELSIF c.len * fw - c.off <= c.w - 4 THEN c.off := c.len * fw - c.w + 4
  640. END
  641. END EditCheckOffset;
  642. PROCEDURE EditOnChar*(c: Edit; VAR msg: CharMsg);
  643. VAR i: INTEGER;
  644. BEGIN
  645. IF msg.key = G.kBackspace THEN
  646. IF c.pos > 0 THEN
  647. Strings.Delete(c.text, c.pos - 1, 1);
  648. DEC(c.len); DEC(c.pos)
  649. END
  650. ELSIF msg.key = G.kDel THEN
  651. IF c.pos < c.len THEN
  652. Strings.Delete(c.text, c.pos, 1);
  653. DEC(c.len)
  654. END
  655. ELSIF msg.ch < ' ' THEN
  656. IF msg.key = G.kLeft THEN DEC(c.pos)
  657. ELSIF msg.key = G.kRight THEN INC(c.pos)
  658. ELSIF msg.key = G.kHome THEN c.pos := 0
  659. ELSIF msg.key = G.kEnd THEN c.pos := c.len
  660. END;
  661. IF c.pos < 0 THEN c.pos := 0 ELSIF c.pos > c.len THEN c.pos := c.len END
  662. ELSIF c.len < LEN(c.text) - 1 THEN
  663. c.text[c.len + 1] := 0X;
  664. i := c.len;
  665. WHILE i > c.pos DO
  666. c.text[i] := c.text[i - 1];
  667. DEC(i)
  668. END;
  669. c.text[c.pos] := msg.ch;
  670. INC(c.len); INC(c.pos)
  671. END;
  672. EditCheckOffset(c);
  673. Redraw(c)
  674. END EditOnChar;
  675. PROCEDURE EditHandler*(c: Widget; VAR msg: Message);
  676. VAR e: Edit;
  677. BEGIN e := c(Edit);
  678. IF msg IS DrawMsg THEN
  679. DrawEdit(e, msg(DrawMsg).x, msg(DrawMsg).y,
  680. msg(DrawMsg).w, msg(DrawMsg).h)
  681. ELSIF msg IS MouseDownMsg THEN EditOnMouseDown(e, msg(MouseDownMsg))
  682. ELSIF msg IS CharMsg THEN EditOnChar(e, msg(CharMsg))
  683. ELSE WidgetHandler(c, msg)
  684. END
  685. END EditHandler;
  686. PROCEDURE InitEdit*(c: Edit; where: Widget; x, y, w, h: INTEGER);
  687. BEGIN InitWidget(c, w, h);
  688. c.focusable := TRUE;
  689. G.MakeCol(c.bgColor, 255, 255, 255);
  690. c.text[0] := 0X; c.len := 0; c.pos := 0; c.off := 0;
  691. c.handle := EditHandler;
  692. Put(c, where, x, y)
  693. END InitEdit;
  694. PROCEDURE NewEdit*(where: Widget; x, y, w, h: INTEGER): Edit;
  695. VAR c: Edit;
  696. BEGIN NEW(c); InitEdit(c, where, x, y, w, h)
  697. RETURN c END NewEdit;
  698. PROCEDURE EditSetText*(c: Edit; text: ARRAY OF CHAR);
  699. BEGIN
  700. Strings.Copy(text, c.text);
  701. c.len := Strings.Length(text);
  702. c.pos := 0;
  703. c.off := 0;
  704. Redraw(c)
  705. END EditSetText;
  706. (** ScrollBar **)
  707. PROCEDURE DrawBox(x, y, w, h: INTEGER; bg, fg: G.Color);
  708. BEGIN
  709. G.FillRect(x, y, x + w - 1, y + h - 1, bg);
  710. G.Rect(x, y, x + w - 1, y + h - 1, fg)
  711. END DrawBox;
  712. PROCEDURE DrawHorizScrollBar(c: ScrollBar; x, y, w, h: INTEGER);
  713. VAR fw, fh, X, Y, hs, maxHs, pos, range: INTEGER;
  714. bs: INTEGER; (** Button size *)
  715. grey: G.Color;
  716. BEGIN
  717. G.MakeCol(grey, 80, 80, 80);
  718. DrawButtonBox(x, y, c.w, c.h, c.bgColor, c.parent.bgColor, TRUE, TRUE);
  719. hs := c.handleSize;
  720. bs := c.h;
  721. IF bs > 20 THEN bs := 20 END;
  722. c.btnSize := bs;
  723. maxHs := c.w - bs * 2 + 4;
  724. IF hs > maxHs THEN hs := maxHs END;
  725. c.handleSize := hs;
  726. range := c.max - c.min;
  727. pos := c.value;
  728. IF pos < c.min THEN pos := c.min ELSIF pos > c.max THEN pos := c.max END;
  729. c.handlePos := bs - 2 + (pos * (maxHs - hs) + range DIV 2) DIV range;
  730. DrawButtonBox(x, y, bs, c.h, c.bgColor,
  731. c.parent.bgColor, c.btnPressed = 1, FALSE);
  732. DrawButtonBox(x + c.w - bs, y, bs, c.h, c.bgColor,
  733. c.parent.bgColor, c.btnPressed = 2, TRUE);
  734. X := x + (bs - 1) DIV 2; Y := y + (bs - 1) DIV 2;
  735. IF c.btnPressed = 1 THEN INC(X); INC(Y) END;
  736. G.HLine(X - 4, Y, X + 4, c.fgColor);
  737. G.Line(X - 4, Y, X - 1, Y + 3, c.fgColor);
  738. G.Line(X - 4, Y, X - 1, Y - 3, c.fgColor);
  739. X := x + c.w - bs DIV 2 - 1;
  740. IF c.btnPressed = 1 THEN DEC(Y) END;
  741. IF c.btnPressed = 2 THEN INC(X); INC(Y) END;
  742. G.HLine(X - 4, Y, X + 4, c.fgColor);
  743. G.Line(X + 4, Y, X + 1, Y + 3, c.fgColor);
  744. G.Line(X + 4, Y, X + 1, Y - 3, c.fgColor);
  745. DrawButtonBox(x + c.handlePos, y, hs, c.h, c.bgColor,
  746. c.parent.bgColor, c.btnPressed = 3, FALSE)
  747. END DrawHorizScrollBar;
  748. PROCEDURE DrawVertScrollBar(c: ScrollBar; x, y, w, h: INTEGER);
  749. VAR fw, fh, X, Y, hs, maxHs, pos, range: INTEGER;
  750. bs: INTEGER; (** Button size *)
  751. grey: G.Color;
  752. BEGIN
  753. G.MakeCol(grey, 80, 80, 80);
  754. DrawButtonBox(x, y, c.w, c.h, c.bgColor, c.parent.bgColor, TRUE, TRUE);
  755. hs := c.handleSize;
  756. bs := c.w;
  757. IF bs > 20 THEN bs := 20 END;
  758. c.btnSize := bs;
  759. maxHs := c.h - bs * 2 + 4;
  760. IF hs > maxHs THEN hs := maxHs END;
  761. range := c.max - c.min;
  762. pos := c.value;
  763. IF pos < c.min THEN pos := c.min ELSIF pos > c.max THEN pos := c.max END;
  764. c.handlePos := bs - 2 + ((maxHs - hs) * pos + range DIV 2) DIV range;
  765. DrawButtonBox(x, y, c.w, bs, c.bgColor,
  766. c.parent.bgColor, c.btnPressed = 1, FALSE);
  767. DrawButtonBox(x, y + c.h - bs, c.w, bs, c.bgColor,
  768. c.parent.bgColor, c.btnPressed = 2, TRUE);
  769. X := x + (bs - 1) DIV 2; Y := y + (bs - 1) DIV 2;
  770. IF c.btnPressed = 1 THEN INC(X); INC(Y) END;
  771. G.VLine(X, Y - 4, Y + 4, c.fgColor);
  772. G.Line(X, Y - 4, X + 3, Y - 1, c.fgColor);
  773. G.Line(X, Y - 4, X - 3, Y - 1, c.fgColor);
  774. Y := y + c.h - bs DIV 2 - 1;
  775. IF c.btnPressed = 1 THEN DEC(X) END;
  776. IF c.btnPressed = 2 THEN INC(X); INC(Y) END;
  777. G.VLine(X, Y - 4, Y + 4, c.fgColor);
  778. G.Line(X, Y + 4, X + 3, Y + 1, c.fgColor);
  779. G.Line(X, Y + 4, X - 3, Y + 1, c.fgColor);
  780. DrawButtonBox(x, y + c.handlePos, c.w, hs, c.bgColor,
  781. c.parent.bgColor, c.btnPressed = 3, FALSE)
  782. END DrawVertScrollBar;
  783. PROCEDURE DrawScrollBar*(c: ScrollBar; x, y, w, h: INTEGER);
  784. BEGIN
  785. IF c.vertical THEN
  786. DrawVertScrollBar(c, x, y, w, h)
  787. ELSE
  788. DrawHorizScrollBar(c, x, y, w, h)
  789. END;
  790. Drawn(c)
  791. END DrawScrollBar;
  792. PROCEDURE ScrollBarSetVertical*(c: ScrollBar; vertical: BOOLEAN);
  793. BEGIN c.vertical := vertical; Redraw(c)
  794. END ScrollBarSetVertical;
  795. PROCEDURE ScrollBarSetValue*(c: ScrollBar; value: INTEGER);
  796. BEGIN
  797. IF value < c.min THEN value := c.min
  798. ELSIF value > c.max THEN value := c.max
  799. END;
  800. IF c.value # value THEN
  801. c.value := value;
  802. IF c.onScroll # NIL THEN c.onScroll(c, value) END;
  803. Redraw(c)
  804. END
  805. END ScrollBarSetValue;
  806. PROCEDURE HandleScrollBarMouseMove(c: ScrollBar; VAR msg: MouseMoveMsg);
  807. VAR n, x, size, w: INTEGER;
  808. BEGIN
  809. IF c.handlePressed THEN
  810. IF c.vertical THEN x := msg.y; size := c.h
  811. ELSE x := msg.x; size := c.w
  812. END;
  813. w := size - c.btnSize * 2 - c.handleSize;
  814. n := x - c.handlePressPos - c.btnSize;
  815. n := (n * (c.max - c.min) + w DIV 2) DIV w + c.min;
  816. ScrollBarSetValue(c, n)
  817. END
  818. END HandleScrollBarMouseMove;
  819. PROCEDURE HandleScrollBarMouseDown(c: ScrollBar; VAR msg: MouseDownMsg);
  820. VAR x, d, size: INTEGER;
  821. BEGIN
  822. IF c.vertical THEN x := msg.y; size := c.h
  823. ELSE x := msg.x; size := c.w
  824. END;
  825. IF msg.btn = 2 THEN d := 1 ELSE d := c.inc END;
  826. IF x < c.btnSize THEN
  827. c.btnPressed := 1(*Less btn*);
  828. ScrollBarSetValue(c, c.value - d);
  829. Redraw(c)
  830. ELSIF x >= size - c.btnSize THEN
  831. c.btnPressed := 2(*More btn*);
  832. ScrollBarSetValue(c, c.value + d);
  833. Redraw(c)
  834. ELSIF msg.btn = 1 THEN
  835. IF (c.handlePos <= x) & (x < c.handlePos + c.handleSize) THEN
  836. c.btnPressed := 3(*Handle*);
  837. c.handlePressed := TRUE;
  838. c.handlePressPos := x - c.handlePos
  839. ELSIF x < c.handlePos THEN
  840. ScrollBarSetValue(c, c.value - c.bigInc)
  841. ELSE
  842. ScrollBarSetValue(c, c.value + c.bigInc)
  843. END;
  844. Redraw(c)
  845. ELSE c.btnPressed := 0(*Nothing*);
  846. END;
  847. WidgetHandler(c, msg)
  848. END HandleScrollBarMouseDown;
  849. PROCEDURE HandleScrollBarMouseUp(c: ScrollBar; VAR msg: MouseUpMsg);
  850. BEGIN
  851. c.handlePressed := FALSE;
  852. c.btnPressed := 0(*Nothing*);
  853. Redraw(c)
  854. END HandleScrollBarMouseUp;
  855. PROCEDURE ScrollBarHandler*(c: Widget; VAR msg: Message);
  856. VAR s: ScrollBar;
  857. BEGIN s := c(ScrollBar);
  858. IF msg IS DrawMsg THEN
  859. DrawScrollBar(s, msg(DrawMsg).x, msg(DrawMsg).y,
  860. msg(DrawMsg).w, msg(DrawMsg).h)
  861. ELSIF msg IS MouseMoveMsg THEN HandleScrollBarMouseMove(s, msg(MouseMoveMsg))
  862. ELSIF msg IS MouseDownMsg THEN HandleScrollBarMouseDown(s, msg(MouseDownMsg))
  863. ELSIF msg IS MouseUpMsg THEN HandleScrollBarMouseUp(s, msg(MouseUpMsg))
  864. ELSE WidgetHandler(c, msg)
  865. END
  866. END ScrollBarHandler;
  867. PROCEDURE InitScrollBar*(c: ScrollBar; where: Widget;
  868. x, y, w, h: INTEGER);
  869. BEGIN InitWidget(c, w, h);
  870. c.handle := ScrollBarHandler;
  871. c.value := 0; c.min := 0; c.max := 100; c.inc := 5; c.bigInc := 20;
  872. c.handlePos := 0; c.handleSize := 24; c.btnSize := 0;
  873. c.btnPressed := 0(*Nothing*);
  874. Put(c, where, x, y)
  875. END InitScrollBar;
  876. PROCEDURE NewScrollBar*(where: Widget; x, y, w, h: INTEGER): ScrollBar;
  877. VAR c: ScrollBar;
  878. BEGIN NEW(c); InitScrollBar(c, where, x, y, w, h)
  879. RETURN c END NewScrollBar;
  880. PROCEDURE ScrollBarSetOnScroll*(c: ScrollBar; proc: PROCEDURE (c: ScrollBar; value: INTEGER));
  881. BEGIN c.onScroll := proc
  882. END ScrollBarSetOnScroll;
  883. (** ScrollBox **)
  884. PROCEDURE ScrollBoxSetNoBg*(c: ScrollBox; noBg: BOOLEAN);
  885. BEGIN PanelSetNoBg(c.inner, noBg)
  886. END ScrollBoxSetNoBg;
  887. PROCEDURE ScrollBoxHandler*(c: Widget; VAR msg: Message);
  888. BEGIN
  889. IF msg IS DrawMsg THEN
  890. IF c.redraw THEN
  891. DrawBody(c, msg(DrawMsg).x, msg(DrawMsg).y, c.w, c.h, c.redrawSelf);
  892. Drawn(c)
  893. END
  894. ELSIF msg IS PutMsg THEN
  895. DirectPut(msg(PutMsg).what, c(ScrollBox).inner,
  896. msg(PutMsg).x, msg(PutMsg).y)
  897. ELSE WidgetHandler(c, msg)
  898. END
  899. END ScrollBoxHandler;
  900. PROCEDURE ScrollBoxSetInnerSize*(c: ScrollBox; w, h: INTEGER);
  901. BEGIN
  902. Resize(c.inner, w, h);
  903. c.scbHoriz.max := w - c.outer.w;
  904. c.scbVert.max := h - c.outer.h;
  905. Redraw(c)
  906. END ScrollBoxSetInnerSize;
  907. PROCEDURE ScrollBoxOnHorizScroll*(c: ScrollBar; value: INTEGER);
  908. VAR sbx: ScrollBox;
  909. BEGIN
  910. sbx := c.parent(ScrollBox);
  911. sbx.inner.x := -value;
  912. Redraw(sbx)
  913. END ScrollBoxOnHorizScroll;
  914. PROCEDURE ScrollBoxOnVertScroll*(c: ScrollBar; value: INTEGER);
  915. VAR sbx: ScrollBox;
  916. BEGIN
  917. sbx := c.parent(ScrollBox);
  918. sbx.inner.y := -value;
  919. Redraw(sbx)
  920. END ScrollBoxOnVertScroll;
  921. PROCEDURE InitScrollBox*(c: ScrollBox; where: Widget; x, y, w, h: INTEGER);
  922. BEGIN InitWidget(c, w, h);
  923. c.handle := ScrollBoxHandler;
  924. c.scbHoriz := NewScrollBar(NIL, 0, 0, w - 16, 16);
  925. DirectPut(c.scbHoriz, c, 0, h - 16);
  926. ScrollBarSetOnScroll(c.scbHoriz, ScrollBoxOnHorizScroll);
  927. c.scbVert := NewScrollBar(NIL, 0, 0, 16, h - 16);
  928. ScrollBarSetVertical(c.scbVert, TRUE);
  929. DirectPut(c.scbVert, c, w - 16, 0);
  930. ScrollBarSetOnScroll(c.scbVert, ScrollBoxOnVertScroll);
  931. c.outer := NewPanel(NIL, 0, 0, w - 16, h - 16);
  932. DirectPut(c.outer, c, 0, 0);
  933. PanelSetNoBg(c.outer, TRUE);
  934. c.inner := NewPanel(c.outer, 0, 0, 1, 1);
  935. ScrollBoxSetInnerSize(c, w * 2, h * 3);
  936. Put(c, where, x, y)
  937. END InitScrollBox;
  938. PROCEDURE NewScrollBox*(where: Widget; x, y, w, h: INTEGER): ScrollBox;
  939. VAR c: ScrollBox;
  940. BEGIN NEW(c); InitScrollBox(c, where, x, y, w, h)
  941. RETURN c END NewScrollBox;
  942. (** Canvas **)
  943. PROCEDURE CanvasHandler*(c: Widget; VAR msg: Message);
  944. VAR x, y: INTEGER;
  945. BEGIN
  946. IF msg IS DrawMsg THEN
  947. IF c.redraw THEN
  948. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  949. IF c.redrawSelf THEN G.Draw(c(Canvas).bmp, x, y) END;
  950. DrawBody(c, x, y, c.w, c.h, c.redrawSelf);
  951. Drawn(c)
  952. END
  953. ELSE WidgetHandler(c, msg)
  954. END
  955. END CanvasHandler;
  956. PROCEDURE InitCanvas*(c: Canvas; where: Widget; x, y, w, h: INTEGER);
  957. VAR wh: G.Color;
  958. BEGIN InitWidget(c, w, h);
  959. c.bmp := G.NewBitmap(w, h);
  960. G.MakeCol(wh, 255, 255, 255);
  961. G.ClearBitmapToColor(c.bmp, wh);
  962. c.handle := CanvasHandler;
  963. Put(c, where, x, y)
  964. END InitCanvas;
  965. PROCEDURE NewCanvas*(where: Widget; x, y, w, h: INTEGER): Canvas;
  966. VAR c: Canvas;
  967. BEGIN NEW(c); InitCanvas(c, where, x, y, w, h)
  968. RETURN c END NewCanvas;
  969. (** General **)
  970. PROCEDURE DrawCursor;
  971. BEGIN
  972. IF mouseX >= 0 THEN
  973. G.Draw(mouseCursor, mouseX, mouseY)
  974. END
  975. END DrawCursor;
  976. PROCEDURE DrawAll;
  977. VAR c: Widget;
  978. BEGIN
  979. G.TargetScreen;
  980. c := app.body;
  981. REPEAT
  982. DrawForm(c(Form));
  983. c := c.next
  984. UNTIL c = app.body;
  985. DrawCursor;
  986. G.Flip
  987. END DrawAll;
  988. PROCEDURE HandleMouseMove(VAR e: G.Event);
  989. VAR c: Widget;
  990. BEGIN
  991. mouseX := e.x; mouseY := e.y;
  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 CreateArrowCursor(): G.Bitmap;
  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. RETURN m END CreateArrowCursor;
  1096. PROCEDURE InitCursor;
  1097. BEGIN
  1098. mouseCursor := CreateArrowCursor();
  1099. mouseX := -1; mouseY := 0;
  1100. G.ShowMouse(FALSE)
  1101. END InitCursor;
  1102. PROCEDURE Init*;
  1103. BEGIN
  1104. font := G.LoadFont('Data/Fonts/Main');
  1105. IF font = NIL THEN font := G.LoadFont('../Data/Fonts/Main') END;
  1106. IF font = NIL THEN Out.String('SimpleGui: could not load font.'); Out.Ln END;
  1107. InitCursor;
  1108. Done := font # NIL;
  1109. app := NewApp();
  1110. hoveredWidget := NIL; pressedWidget := NIL;
  1111. pressedX := 0; pressedY := 0
  1112. END Init;
  1113. END SimpleGui.