SimpleGui.Mod 34 KB

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