Gui.Mod 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293
  1. MODULE Gui;
  2. IMPORT G := Graph, Strings, Out;
  3. TYPE
  4. Caption* = POINTER TO CaptionDesc;
  5. CaptionDesc* = RECORD
  6. s*: ARRAY 100 OF CHAR
  7. END;
  8. DrawHandler* = PROCEDURE (W: Widget; x, y: INTEGER);
  9. MouseDownHandler* = PROCEDURE (W: Widget; x, y, btn: INTEGER);
  10. MouseUpHandler* = PROCEDURE (W: Widget; x, y, btn: INTEGER);
  11. ClickHandler* = PROCEDURE (W: Widget);
  12. Message* = POINTER TO MsgDesc;
  13. MsgDesc* = RECORD END;
  14. Handler* = PROCEDURE (W: Widget; VAR msg: Message);
  15. Widget* = POINTER TO WidgetDesc;
  16. WidgetDesc* = RECORD
  17. x*, y*, w*, h*: INTEGER;
  18. tag*: INTEGER;
  19. body*: Widget;
  20. text*: Caption;
  21. bmp*: G.Bitmap;
  22. parent*: Widget;
  23. prev*, next*: Widget;
  24. draw*: DrawHandler;
  25. (* Event Handlers *)
  26. onMouseDown*: MouseDownHandler;
  27. onMouseUp*: MouseUpHandler;
  28. onClick*: ClickHandler;
  29. (* Message Handler *)
  30. handle*: Handler
  31. END;
  32. Window* = POINTER TO WindowDesc;
  33. WindowDesc* = RECORD(WidgetDesc)
  34. win*: G.Window;
  35. curMouseDownWidget*: Widget (* Widget under mouse down event is saved here *)
  36. END;
  37. VAR
  38. Done*: BOOLEAN;
  39. exitRunLoop: BOOLEAN; (* See procedure Run *)
  40. font: G.Font;
  41. newWindowSettings: SET;
  42. ZZZ: INTEGER;
  43. globalWin: Window; (* !FIXME *)
  44. (* Widget *)
  45. PROCEDURE SetOnMouseDown*(W: Widget; handler: MouseDownHandler);
  46. BEGIN
  47. W.onMouseDown := handler
  48. END SetOnMouseDown;
  49. PROCEDURE SetOnMouseUp*(W: Widget; handler: MouseUpHandler);
  50. BEGIN
  51. W.onMouseUp := handler
  52. END SetOnMouseUp;
  53. PROCEDURE SetOnClick*(W: Widget; handler: ClickHandler);
  54. BEGIN
  55. W.onClick := handler;
  56. END SetOnClick;
  57. PROCEDURE InitWidget*(w: Widget);
  58. BEGIN
  59. w.x := 0; w.y := 0; w.w := 24; w.h := 24;
  60. w.tag := 0;
  61. w.draw := NIL;
  62. w.onMouseDown := NIL;
  63. w.onMouseUp := NIL;
  64. w.onClick := NIL;
  65. (* Замок *)
  66. NEW(w.body); w.body.prev := w.body; w.body.next := w.body
  67. END InitWidget;
  68. PROCEDURE SetText*(w: Widget; s: ARRAY OF CHAR);
  69. BEGIN
  70. IF w.text = NIL THEN NEW(w.text) END;
  71. Strings.Copy(s, w.text.s)
  72. END SetText;
  73. PROCEDURE Place*(where, what: Widget; x, y: INTEGER);
  74. BEGIN
  75. what.x := x; what.y := y;
  76. (* Добавление в кольцо с замком *)
  77. what.prev := where.body.prev;
  78. what.next := where.body;
  79. where.body.prev.next := what;
  80. where.body.prev := what
  81. END Place;
  82. (* Window *)
  83. PROCEDURE NewWindowSettings*(settings: SET);
  84. BEGIN
  85. newWindowSettings := settings
  86. END NewWindowSettings;
  87. PROCEDURE DrawWidget(W: Widget; x, y: INTEGER);
  88. BEGIN
  89. W.draw(W, x + W.x, y + W.y)
  90. END DrawWidget;
  91. PROCEDURE DrawBody*(W: Widget; x, y: INTEGER);
  92. VAR p: Widget;
  93. BEGIN
  94. p := W.body.next;
  95. WHILE p # W.body DO
  96. DrawWidget(p, x, y);
  97. p := p.next
  98. END
  99. END DrawBody;
  100. PROCEDURE DrawWindow*(W: Widget; x, y: INTEGER);
  101. VAR c: G.Color;
  102. w, h: INTEGER;
  103. BEGIN
  104. G.MakeCol(c, ZZZ * 40 MOD 256, 120, 120);
  105. G.ClearToColor(c);
  106. G.MakeCol(c, 0, 0, ZZZ * 20 MOD 256);
  107. G.GetScreenSize(w, h);
  108. G.Rect(5, 5, w - 6, h - 6, c);
  109. DrawBody(W, x, y)
  110. END DrawWindow;
  111. PROCEDURE InitWindow*(win: Window; w, h: INTEGER);
  112. BEGIN
  113. InitWidget(win);
  114. win.win := G.NewWindow(-1, -1, w, h,
  115. 'Window', newWindowSettings);
  116. win.x := 0; win.y := 0;
  117. win.w := win.win.w; win.h := win.win.h;
  118. win.curMouseDownWidget := NIL;
  119. win.draw := DrawWindow
  120. END InitWindow;
  121. PROCEDURE NewWindow*(w, h: INTEGER): Window;
  122. VAR win: Window;
  123. BEGIN
  124. NEW(win);
  125. InitWindow(win, w, h);
  126. globalWin := win
  127. RETURN win END NewWindow;
  128. (* Draw *)
  129. PROCEDURE DrawAll;
  130. BEGIN
  131. globalWin.draw(globalWin, 0, 0);
  132. G.Flip
  133. END DrawAll;
  134. (* Fonts *)
  135. PROCEDURE GetFont*(W: Widget): G.Font;
  136. RETURN font END GetFont;
  137. (* General *)
  138. PROCEDURE TriggerOnMouseDown*(W: Widget; x, y, btn: INTEGER);
  139. BEGIN
  140. IF (W # NIL) & (W.onMouseDown # NIL) THEN
  141. W.onMouseDown(W, x, y, btn)
  142. END
  143. END TriggerOnMouseDown;
  144. PROCEDURE TriggerOnMouseUp*(W: Widget; x, y, btn: INTEGER);
  145. BEGIN
  146. IF (W # NIL) & (W.onMouseUp # NIL) THEN
  147. W.onMouseUp(W, x, y, btn)
  148. END
  149. END TriggerOnMouseUp;
  150. PROCEDURE TriggerOnClick*(W: Widget);
  151. BEGIN
  152. IF (W # NIL) & (W.onClick # NIL) THEN
  153. W.onClick(W)
  154. END
  155. END TriggerOnClick;
  156. PROCEDURE FindWidgetUnderMouse*(W: Widget; VAR x, y: INTEGER): Widget;
  157. VAR p: Widget;
  158. BEGIN
  159. IF W = NIL THEN p := W
  160. ELSIF W.body # NIL THEN
  161. p := W.body.prev;
  162. WHILE (p # W.body) &
  163. ~((p.x <= x) & (x < p.x + p.w) &
  164. (p.y <= y) & (y < p.y + p.h))
  165. DO p := p.prev
  166. END;
  167. IF p = W.body THEN p := W
  168. ELSE DEC(x, p.x); DEC(y, p.y);
  169. p := FindWidgetUnderMouse(p, x, y)
  170. END
  171. ELSE p := W
  172. END
  173. RETURN p END FindWidgetUnderMouse;
  174. (** Input: (x; y) relative to window.
  175. Output: (x; y) relative to widget. *)
  176. PROCEDURE WindowToWidgetXY*(W: Widget; VAR x, y: INTEGER);
  177. BEGIN
  178. WHILE (W # NIL) & ~(W IS Window) DO
  179. DEC(x, W.x); DEC(y, W.y);
  180. W := W.parent
  181. END
  182. END WindowToWidgetXY;
  183. PROCEDURE HandleMouseDownEvent*(e: G.Event);
  184. VAR W: Widget;
  185. x, y: INTEGER;
  186. BEGIN
  187. x := e.x; y := e.y;
  188. W := FindWidgetUnderMouse(globalWin, x, y);
  189. IF W # NIL THEN
  190. globalWin.curMouseDownWidget := W (* Save for future mouse up event *)
  191. END;
  192. TriggerOnMouseDown(W, x, y, e.button)
  193. END HandleMouseDownEvent;
  194. PROCEDURE HandleMouseUpEvent*(e: G.Event);
  195. VAR W: Widget;
  196. x, y: INTEGER;
  197. BEGIN
  198. x := e.x; y := e.y;
  199. W := globalWin.curMouseDownWidget;
  200. WindowToWidgetXY(W, x, y);
  201. TriggerOnMouseUp(W, x, y, e.button);
  202. IF (x >= 0) & (y >= 0) & (W.w > x) & (W.h > y) THEN
  203. TriggerOnClick(W)
  204. END
  205. END HandleMouseUpEvent;
  206. PROCEDURE HandleEvent(e: G.Event);
  207. BEGIN
  208. IF e.type = G.mouseDown THEN
  209. HandleMouseDownEvent(e)
  210. ELSIF e.type = G.mouseUp THEN
  211. HandleMouseUpEvent(e)
  212. ELSIF e.type = G.keyDown THEN
  213. IF e.key = G.kEsc THEN exitRunLoop := TRUE END;
  214. INC(ZZZ)
  215. ELSIF e.type = G.quit THEN
  216. exitRunLoop := TRUE
  217. END
  218. END HandleEvent;
  219. PROCEDURE Run*;
  220. VAR e: G.Event;
  221. BEGIN
  222. exitRunLoop := FALSE;
  223. REPEAT
  224. WHILE G.HasEvents() DO
  225. G.WaitEvent(e);
  226. HandleEvent(e)
  227. END;
  228. DrawAll
  229. UNTIL exitRunLoop
  230. END Run;
  231. PROCEDURE Init*;
  232. BEGIN
  233. G.Settings(0, 0, {G.manual});
  234. G.Init;
  235. IF G.Done THEN
  236. font := G.LoadFont('../Data/Fonts/Main');
  237. IF font = NIL THEN
  238. Out.String('Gui: Could not load font.'); Out.Ln;
  239. Done := FALSE
  240. END
  241. ELSE Done := FALSE
  242. END
  243. END Init;
  244. PROCEDURE Close*;
  245. BEGIN
  246. G.Close
  247. END Close;
  248. BEGIN
  249. Done := TRUE;
  250. ZZZ := 0
  251. END Gui.