2
0

SimpleGui.Mod 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412
  1. MODULE SimpleGui;
  2. IMPORT G := Graph, Strings, Out;
  3. TYPE
  4. Widget* = POINTER TO WidgetDesc;
  5. Message* = RECORD END;
  6. DrawMsg* = RECORD(Message) x*, y*, w*, h*: INTEGER END;
  7. MouseMoveMsg* = RECORD(Message) x*, y*: INTEGER END;
  8. MouseDownMsg* = RECORD(Message) x*, y*: INTEGER END;
  9. MouseUpMsg* = RECORD(Message) x*, y*: INTEGER END;
  10. MouseEnterMsg* = RECORD(Message) END;
  11. MouseLeaveMsg* = RECORD(Message) END;
  12. ClickMsg* = RECORD(Message) END;
  13. Handler* = PROCEDURE (c: Widget; VAR msg: Message);
  14. WidgetDesc* = RECORD
  15. x*, y*, w*, h*: INTEGER;
  16. bgColor*, fgColor*: G.Color;
  17. hovered*: BOOLEAN; (** TRUE if mouse pointer is over the widget *)
  18. pressed*: BOOLEAN; (** TRUE if widget is held down with LMB *)
  19. body*: Widget;
  20. next*: Widget;
  21. handle*: Handler;
  22. onMouseDown*: PROCEDURE (c: Widget; x, y: INTEGER);
  23. onMouseUp*: PROCEDURE (c: Widget; x, y: INTEGER);
  24. onMouseMove*: PROCEDURE (c: Widget; x, y: INTEGER);
  25. onMouseEnter*: PROCEDURE (c: Widget);
  26. onMouseLeave*: PROCEDURE (c: Widget);
  27. onClick*: PROCEDURE (c: Widget);
  28. END;
  29. Panel* = POINTER TO PanelDesc;
  30. PanelDesc* = RECORD(WidgetDesc) END;
  31. Form* = POINTER TO FormDesc;
  32. FormDesc* = RECORD(PanelDesc) END;
  33. Button* = POINTER TO ButtonDesc;
  34. ButtonDesc* = RECORD(WidgetDesc)
  35. caption*: ARRAY 64 OF CHAR
  36. ;X*, Y*: INTEGER
  37. END;
  38. VAR
  39. Done*: BOOLEAN; (** FALSE after a failed opration and before the next Init *)
  40. forms*: Form;
  41. font*: G.Font;
  42. quit: BOOLEAN; (** Main loop in procedure Run ends when TRUE *)
  43. hoveredWidget: Widget;
  44. pressedWidget: Widget;
  45. pressedX, pressedY: INTEGER;
  46. (** Widget **)
  47. PROCEDURE FindHoveredInList(list: Widget; x, y: INTEGER;
  48. forMouseDown: BOOLEAN): Widget;
  49. VAR c: Widget;
  50. BEGIN c := list;
  51. WHILE (c # NIL) &
  52. ~((c.x <= x) & (x < c.x + c.w) &
  53. (c.y <= y) & (y < c.y + c.h))
  54. DO c := c.next
  55. END;
  56. IF forMouseDown & (c # NIL) THEN
  57. INC(pressedX, c.x); INC(pressedY, c.y)
  58. END
  59. RETURN c END FindHoveredInList;
  60. PROCEDURE WidgetOnMouseEnter*(c: Widget);
  61. VAR msg: MouseEnterMsg;
  62. BEGIN
  63. IF pressedWidget = c THEN c.pressed := TRUE END;
  64. c.handle(c, msg)
  65. END WidgetOnMouseEnter;
  66. PROCEDURE WidgetOnMouseLeave*(c: Widget);
  67. VAR msg: MouseLeaveMsg;
  68. BEGIN
  69. c.pressed := FALSE;
  70. c.handle(c, msg)
  71. END WidgetOnMouseLeave;
  72. PROCEDURE WidgetOnMouseMove*(c: Widget; x, y: INTEGER);
  73. VAR msg: MouseMoveMsg;
  74. BEGIN
  75. IF (0 <= x) & (x < c.w) & (0 <= y) & (y < c.h) THEN
  76. IF c # hoveredWidget THEN
  77. IF hoveredWidget # NIL THEN WidgetOnMouseLeave(hoveredWidget) END;
  78. hoveredWidget := c;
  79. WidgetOnMouseEnter(hoveredWidget)
  80. END
  81. ELSIF c = hoveredWidget THEN
  82. WidgetOnMouseLeave(c);
  83. hoveredWidget := NIL
  84. END;
  85. msg.x := x; msg.y := y;
  86. c.handle(c, msg);
  87. IF c.onMouseMove # NIL THEN c.onMouseMove(c, x, y) END
  88. END WidgetOnMouseMove;
  89. PROCEDURE WidgetHandleMouseMove*(c: Widget; x, y: INTEGER);
  90. VAR p: Widget;
  91. BEGIN
  92. IF pressedWidget # NIL THEN
  93. WidgetOnMouseMove(pressedWidget, x - pressedX, y - pressedY)
  94. ELSE
  95. p := FindHoveredInList(c.body, x, y, FALSE);
  96. IF p # NIL THEN
  97. WidgetHandleMouseMove(p, x - p.x, y - p.y)
  98. ELSE
  99. WidgetOnMouseMove(c, x, y)
  100. END
  101. END
  102. END WidgetHandleMouseMove;
  103. PROCEDURE WidgetOnMouseDown*(c: Widget; x, y: INTEGER);
  104. VAR msg: MouseDownMsg;
  105. BEGIN
  106. pressedWidget := c;
  107. msg.x := x; msg.y := y;
  108. c.handle(c, msg)
  109. END WidgetOnMouseDown;
  110. PROCEDURE WidgetHandleMouseDown*(c: Widget; x, y: INTEGER);
  111. VAR p: Widget;
  112. BEGIN
  113. p := FindHoveredInList(c.body, x, y, TRUE);
  114. IF p # NIL THEN
  115. WidgetHandleMouseDown(p, x - p.x, y - p.y)
  116. ELSE
  117. WidgetOnMouseDown(c, x, y)
  118. END
  119. END WidgetHandleMouseDown;
  120. PROCEDURE WidgetOnMouseUp*(c: Widget; x, y: INTEGER);
  121. VAR msg: MouseUpMsg;
  122. BEGIN
  123. pressedWidget := NIL;
  124. msg.x := x; msg.y := y;
  125. c.handle(c, msg)
  126. END WidgetOnMouseUp;
  127. PROCEDURE WidgetOnClick*(c: Widget);
  128. VAR msg: ClickMsg;
  129. BEGIN c.handle(c, msg);
  130. IF c.onClick # NIL THEN c.onClick(c) END
  131. END WidgetOnClick;
  132. PROCEDURE WidgetHandler*(c: Widget; VAR msg: Message);
  133. VAR x, y: INTEGER;
  134. BEGIN
  135. IF msg IS DrawMsg THEN
  136. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  137. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  138. G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor);
  139. G.Rect(x + 2, y + 2, x + c.w - 3, y + c.h - 3, c.fgColor)
  140. END
  141. END WidgetHandler;
  142. PROCEDURE DrawWidget*(c: Widget; x, y, w, h: INTEGER);
  143. VAR M: DrawMsg;
  144. BEGIN
  145. M.x := x; M.y := y; M.w := w; M.h := h;
  146. c.handle(c, M)
  147. END DrawWidget;
  148. PROCEDURE DrawBody*(c: Widget; x, y, w, h: INTEGER);
  149. VAR p: Widget;
  150. x2, y2, w2, h2: INTEGER;
  151. Z: G.Color;
  152. BEGIN
  153. p := c.body;
  154. WHILE p # NIL DO
  155. x2 := x + p.x; y2 := y + p.y;
  156. w2 := w - p.x; h2 := h - p.y;
  157. (* !FIXME clip x2,y2,w2,h2 to not more than x,y,w,h*)
  158. (*G.UnsetClip; G.MakeCol(Z, 255, 0, 0); G.Rect(x2-1, y2-1, x2 + w2, y2 + h2,Z);*)
  159. G.SetClip(x2, y2, p.w, p.h);
  160. DrawWidget(p, x2, y2, p.w, p.h);
  161. p := p.next
  162. END;
  163. G.UnsetClip
  164. END DrawBody;
  165. PROCEDURE SetBgColor*(c: Widget; color: G.Color);
  166. BEGIN c.bgColor := color
  167. END SetBgColor;
  168. PROCEDURE SetFgColor*(c: Widget; color: G.Color);
  169. BEGIN c.fgColor := color
  170. END SetFgColor;
  171. PROCEDURE SetOnMouseMove*(c: Widget; proc: PROCEDURE (c: Widget; x, y: INTEGER));
  172. BEGIN c.onMouseMove := proc
  173. END SetOnMouseMove;
  174. PROCEDURE SetOnClick*(c: Widget; proc: PROCEDURE (c: Widget));
  175. BEGIN c.onClick := proc
  176. END SetOnClick;
  177. PROCEDURE InitWidget*(c: Widget; w, h: INTEGER);
  178. BEGIN c.x := 0; c.y := 0; c.w := w; c.h := h;
  179. G.MakeCol(c.bgColor, 180, 180, 180);
  180. G.MakeCol(c.fgColor, 0, 0, 0);
  181. c.handle := WidgetHandler;
  182. c.body := NIL; c.next := NIL
  183. END InitWidget;
  184. PROCEDURE Put*(c, where: Widget; x, y: INTEGER);
  185. BEGIN
  186. IF c # NIL THEN
  187. c.x := x; c.y := y;
  188. IF where # NIL THEN
  189. c.next := where.body;
  190. where.body := c
  191. END
  192. END
  193. END Put;
  194. (** Panel **)
  195. PROCEDURE PanelHandler*(c: Widget; VAR msg: Message);
  196. VAR x, y: INTEGER;
  197. BEGIN
  198. IF msg IS DrawMsg THEN
  199. x := msg(DrawMsg).x; y := msg(DrawMsg).y;
  200. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  201. DrawBody(c, x, y, c.w, c.h)
  202. ELSE WidgetHandler(c, msg)
  203. END
  204. END PanelHandler;
  205. PROCEDURE InitPanel*(c: Panel; where: Widget; x, y, w, h: INTEGER);
  206. BEGIN InitWidget(c, w, h);
  207. c.handle := PanelHandler;
  208. Put(c, where, x, y)
  209. END InitPanel;
  210. PROCEDURE NewPanel*(where: Widget; x, y, w, h: INTEGER): Panel;
  211. VAR c: Panel;
  212. BEGIN NEW(c); InitPanel(c, where, x, y, w, h)
  213. RETURN c END NewPanel;
  214. (** Form **)
  215. PROCEDURE DrawForm*(c: Form);
  216. BEGIN
  217. G.FillRect(c.x, c.y, c.x + c.w - 1, c.y + c.h - 1, c.bgColor);
  218. DrawBody(c, c.x, c.y, c.w, c.h)
  219. END DrawForm;
  220. PROCEDURE FormHandler*(c: Widget; VAR msg: Message);
  221. BEGIN WidgetHandler(c, msg)
  222. END FormHandler;
  223. PROCEDURE InitForm*(c: Form; x, y, w, h: INTEGER);
  224. BEGIN InitPanel(c, NIL, x, y, w, h);
  225. c.handle := FormHandler;
  226. c.next := forms; forms := c
  227. END InitForm;
  228. PROCEDURE NewForm*(x, y, w, h: INTEGER): Form;
  229. VAR c: Form;
  230. BEGIN NEW(c); InitForm(c, x, y, w, h);
  231. RETURN c END NewForm;
  232. (** Button **)
  233. PROCEDURE DrawButton*(c: Button; x, y, w, h: INTEGER);
  234. VAR cw, ch, tw, tx, ty: INTEGER;
  235. down: BOOLEAN;
  236. Z: G.Color;
  237. BEGIN
  238. down := c(Button).pressed & c(Button).hovered;
  239. G.FillRect(x, y, x + c.w - 1, y + c.h - 1, c.bgColor);
  240. ;G.MakeCol(Z, 255, 128, 0);
  241. ;G.Line(x + c.h DIV 4, y + c.h DIV 2, x + c(Button).X, y + c(Button).Y, Z);
  242. ;G.MakeCol(Z, 215, 0, 0);
  243. ;G.Line(x + c.h DIV 4, y + c.h DIV 2 + 1, x + c(Button).X, y + c(Button).Y + 1, Z);
  244. G.Rect(x, y, x + c.w - 1, y + c.h - 1, c.fgColor);
  245. IF ~down THEN
  246. G.Rect(x, y, x + c.w - 2, y + c.h - 2, c.fgColor)
  247. END;
  248. G.GetMonoFontSize(font, cw, ch);
  249. tw := Strings.Length(c.caption) * cw;
  250. tx := x + (c.w - tw) DIV 2;
  251. ty := y + (c.h - ch) DIV 2;
  252. IF down THEN INC(tx); INC(ty) END;
  253. G.DrawString(c.caption, tx, ty, font, c.fgColor)
  254. END DrawButton;
  255. PROCEDURE BMM(c: Button; x, y: INTEGER);
  256. BEGIN
  257. c.X := x; c.Y := y
  258. END BMM;
  259. PROCEDURE ButtonHandler*(c: Widget; VAR msg: Message);
  260. VAR b: Button;
  261. BEGIN b := c(Button);
  262. IF msg IS DrawMsg THEN
  263. DrawButton(b, msg(DrawMsg).x, msg(DrawMsg).y,
  264. msg(DrawMsg).w, msg(DrawMsg).h)
  265. ELSIF msg IS MouseMoveMsg THEN BMM(b, msg(MouseMoveMsg).x, msg(MouseMoveMsg).y)
  266. ELSIF msg IS MouseEnterMsg THEN b.hovered := TRUE
  267. ELSIF msg IS MouseLeaveMsg THEN b.hovered := FALSE
  268. ELSIF msg IS MouseDownMsg THEN b.pressed := TRUE
  269. ELSIF msg IS MouseUpMsg THEN b.pressed := FALSE
  270. ELSE WidgetHandler(c, msg)
  271. END
  272. END ButtonHandler;
  273. PROCEDURE InitButton*(c: Button; where: Widget;
  274. x, y, w, h: INTEGER; caption: ARRAY OF CHAR);
  275. BEGIN InitWidget(c, w, h);
  276. Strings.Copy(caption, c.caption);
  277. c.hovered := FALSE;
  278. c.pressed := FALSE;
  279. c.handle := ButtonHandler;
  280. Put(c, where, x, y)
  281. ;c.X := 0; c.Y := 0;
  282. END InitButton;
  283. PROCEDURE NewButton*(where: Widget; x, y, w, h: INTEGER; caption: ARRAY OF CHAR): Button;
  284. VAR c: Button;
  285. BEGIN NEW(c); InitButton(c, where, x, y, w, h, caption)
  286. RETURN c END NewButton;
  287. (** General **)
  288. PROCEDURE DrawAll*;
  289. VAR c: Widget;
  290. BEGIN
  291. c := forms;
  292. WHILE c # NIL DO
  293. DrawForm(c(Form));
  294. c := c.next
  295. END;
  296. G.Flip
  297. END DrawAll;
  298. PROCEDURE HandleMouseMove(VAR e: G.Event);
  299. VAR c: Widget;
  300. BEGIN
  301. c := FindHoveredInList(forms, e.x, e.y, FALSE);
  302. IF c # NIL THEN
  303. WidgetHandleMouseMove(c, e.x - c.x, e.y - c.y)
  304. END
  305. END HandleMouseMove;
  306. PROCEDURE HandleMouseDown(VAR e: G.Event);
  307. VAR c: Widget;
  308. BEGIN
  309. pressedX := 0; pressedY := 0;
  310. c := FindHoveredInList(forms, e.x, e.y, TRUE);
  311. IF c # NIL THEN
  312. WidgetHandleMouseDown(c, e.x - c.x, e.y - c.y)
  313. END
  314. END HandleMouseDown;
  315. PROCEDURE HandleMouseUp(VAR e: G.Event);
  316. VAR c: Widget;
  317. BEGIN
  318. IF pressedWidget # NIL THEN
  319. c := pressedWidget;
  320. IF ~c.hovered THEN c := NIL END;
  321. WidgetOnMouseUp(pressedWidget, e.x - pressedX, e.y - pressedY);
  322. IF c # NIL THEN
  323. WidgetOnClick(c)
  324. END
  325. END
  326. END HandleMouseUp;
  327. PROCEDURE HandleEvent(VAR e: G.Event);
  328. BEGIN
  329. IF e.type = G.quit THEN quit := TRUE
  330. ELSIF e.type = G.mouseMove THEN HandleMouseMove(e)
  331. ELSIF e.type = G.mouseDown THEN HandleMouseDown(e)
  332. ELSIF e.type = G.mouseUp THEN HandleMouseUp(e)
  333. END
  334. END HandleEvent;
  335. PROCEDURE Run*;
  336. VAR e: G.Event;
  337. BEGIN
  338. quit := FALSE;
  339. REPEAT
  340. WHILE G.HasEvents() DO
  341. G.WaitEvent(e);
  342. HandleEvent(e)
  343. END;
  344. DrawAll
  345. UNTIL quit
  346. END Run;
  347. PROCEDURE Init*;
  348. BEGIN
  349. forms := NIL;
  350. font := G.LoadFont('Data/Fonts/Main');
  351. IF font = NIL THEN Out.String('SimpleGui: could not load font.'); Out.Ln END;
  352. Done := font # NIL;
  353. hoveredWidget := NIL; pressedWidget := NIL;
  354. pressedX := 0; pressedY := 0
  355. END Init;
  356. END SimpleGui.