microui.mod 52 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685
  1. IMPLEMENTATION MODULE microui;
  2. (* Modula-2 port of microui v2.02 by rxi (MIT license).
  3. Ported to GNU Modula-2 (gm2 -fiso).
  4. The implementation follows microui.c as closely as the ISO language and
  5. the GM2 16.0.1 front end allow:
  6. - procedure types take a single argument record (see microui.def),
  7. - the command union is replaced by BaseCommand + CAST to the concrete
  8. command record,
  9. - bitwise operations go through microuiHelpers (ISO has no CARDINAL
  10. AND/OR/XOR/SHIFT). *)
  11. FROM SYSTEM IMPORT ADDRESS, ADR, CAST, ADDADR, BYTE;
  12. FROM microuiHelpers IMPORT BITAND, BITOR, BITXOR, BITNOT,
  13. StrLen, CopyBytes,
  14. IntToReal, CardToReal,
  15. RealToStr, StrToReal;
  16. CONST
  17. RELATIVE = 1;
  18. ABSOLUTE = 2;
  19. HASH_INITIAL = 2166136261;
  20. (* Named pointer aliases. GM2 16.0.1 rejects an inline `POINTER TO T` when it
  21. appears in a formal parameter list or in a CAST; a named type works. *)
  22. TYPE
  23. BytePtr = POINTER TO BYTE;
  24. CharPtr = POINTER TO CHAR;
  25. LayoutPtr = POINTER TO Layout;
  26. StylePtr = POINTER TO Style;
  27. PoolItemPtr = POINTER TO ARRAY [0..0] OF PoolItem;
  28. CharArrayPtr = POINTER TO ARRAY [0..0] OF CHAR;
  29. RootArrayPtr = POINTER TO ARRAY [0..ROOTLIST_SIZE - 1] OF ContainerPtr;
  30. JumpCommandPtr = POINTER TO JumpCommand;
  31. ClipCommandPtr = POINTER TO ClipCommand;
  32. RectCommandPtr = POINTER TO RectCommand;
  33. TextCommandPtr = POINTER TO TextCommand;
  34. IconCommandPtr = POINTER TO IconCommand;
  35. VAR
  36. negBigCoord : INTEGER;
  37. unclippedRect : Rect;
  38. defaultStyle : Style;
  39. (*========================================================================*)
  40. (* Small integer helpers (ISO has no bitwise CARDINAL operators) *)
  41. (*========================================================================*)
  42. PROCEDURE min(a, b : INTEGER) : INTEGER;
  43. BEGIN IF a < b THEN RETURN a ELSE RETURN b END END min;
  44. PROCEDURE max(a, b : INTEGER) : INTEGER;
  45. BEGIN IF a > b THEN RETURN a ELSE RETURN b END END max;
  46. PROCEDURE clamp(x, a, b : INTEGER) : INTEGER;
  47. BEGIN RETURN min(b, max(a, x)) END clamp;
  48. PROCEDURE clampR(x, a, b : Real) : Real;
  49. BEGIN
  50. IF x < a THEN RETURN a END;
  51. IF x > b THEN RETURN b END;
  52. RETURN x
  53. END clampR;
  54. PROCEDURE BitAndI(a, b : INTEGER) : INTEGER;
  55. BEGIN RETURN VAL(INTEGER, BITAND(VAL(CARDINAL, a), VAL(CARDINAL, b))) END BitAndI;
  56. PROCEDURE BitOrI(a, b : INTEGER) : INTEGER;
  57. BEGIN RETURN VAL(INTEGER, BITOR(VAL(CARDINAL, a), VAL(CARDINAL, b))) END BitOrI;
  58. PROCEDURE BitNotI(a : INTEGER) : INTEGER;
  59. BEGIN RETURN VAL(INTEGER, BITNOT(VAL(CARDINAL, a))) END BitNotI;
  60. PROCEDURE HasOpt(opt, flag : INTEGER) : BOOLEAN;
  61. BEGIN RETURN BITAND(VAL(CARDINAL, opt), VAL(CARDINAL, flag)) # 0 END HasOpt;
  62. PROCEDURE HasNoOpt(opt, flag : INTEGER) : BOOLEAN;
  63. BEGIN RETURN BITAND(VAL(CARDINAL, opt), VAL(CARDINAL, flag)) = 0 END HasNoOpt;
  64. PROCEDURE SetFlag(res, flag : INTEGER) : INTEGER;
  65. BEGIN RETURN BitOrI(res, flag) END SetFlag;
  66. PROCEDURE ClearFlag(res, flag : INTEGER) : INTEGER;
  67. BEGIN RETURN BitAndI(res, BitNotI(flag)) END ClearFlag;
  68. PROCEDURE FillZero(dst : ADDRESS; len : CARDINAL);
  69. VAR p : BytePtr;
  70. i : CARDINAL;
  71. BEGIN
  72. p := CAST(BytePtr, dst);
  73. IF len > 0 THEN
  74. FOR i := 0 TO len - 1 DO
  75. p^ := VAL(BYTE, 0);
  76. p := ADDADR(p, 1)
  77. END
  78. END
  79. END FillZero;
  80. (*========================================================================*)
  81. (* Geometry helpers *)
  82. (*========================================================================*)
  83. PROCEDURE expandRect(r : Rect; n : INTEGER) : Rect;
  84. BEGIN
  85. RETURN rect(r.x - n, r.y - n, r.w + n * 2, r.h + n * 2)
  86. END expandRect;
  87. PROCEDURE intersectRects(r1, r2 : Rect) : Rect;
  88. VAR x1, y1, x2, y2 : INTEGER;
  89. BEGIN
  90. x1 := max(r1.x, r2.x);
  91. y1 := max(r1.y, r2.y);
  92. x2 := min(r1.x + r1.w, r2.x + r2.w);
  93. y2 := min(r1.y + r1.h, r2.y + r2.h);
  94. IF x2 < x1 THEN x2 := x1 END;
  95. IF y2 < y1 THEN y2 := y1 END;
  96. RETURN rect(x1, y1, x2 - x1, y2 - y1)
  97. END intersectRects;
  98. PROCEDURE rectOverlapsVec2(r : Rect; p : Vec2) : BOOLEAN;
  99. BEGIN
  100. RETURN (p.x >= r.x) AND (p.x < r.x + r.w) AND
  101. (p.y >= r.y) AND (p.y < r.y + r.h)
  102. END rectOverlapsVec2;
  103. (*========================================================================*)
  104. (* Hash (32-bit FNV-1a) *)
  105. (*========================================================================*)
  106. PROCEDURE hash(VAR h : Id; data : ADDRESS; size : INTEGER);
  107. VAR p : BytePtr;
  108. i : INTEGER;
  109. BEGIN
  110. p := CAST(BytePtr, data);
  111. IF size > 0 THEN
  112. FOR i := 1 TO size DO
  113. h := BITXOR(h, VAL(CARDINAL, p^)) * 16777619;
  114. p := ADDADR(p, 1)
  115. END
  116. END
  117. END hash;
  118. PROCEDURE StrLenI(s : ARRAY OF CHAR) : INTEGER;
  119. BEGIN
  120. RETURN VAL(INTEGER, StrLen(s))
  121. END StrLenI;
  122. PROCEDURE CStrLen(p : ADDRESS) : INTEGER;
  123. VAR q : CharPtr;
  124. n : INTEGER;
  125. BEGIN
  126. q := CAST(CharPtr, p);
  127. n := 0;
  128. WHILE q^ # 0C DO
  129. n := n + 1;
  130. q := ADDADR(q, 1)
  131. END;
  132. RETURN n
  133. END CStrLen;
  134. (*========================================================================*)
  135. (* Callback adapters *)
  136. (*========================================================================*)
  137. PROCEDURE TextWidth(ctx : ContextPtr; font : Font;
  138. str : ADDRESS; len : INTEGER) : INTEGER;
  139. VAR a : TextWidthArgs;
  140. p : TextWidthProc;
  141. BEGIN
  142. a.ctx := CAST(ADDRESS, ctx);
  143. a.font := font;
  144. a.str := str;
  145. a.len := len;
  146. p := ctx^.textWidth;
  147. RETURN p(a)
  148. END TextWidth;
  149. PROCEDURE TextHeight(ctx : ContextPtr; font : Font) : INTEGER;
  150. VAR a : TextHeightArgs;
  151. p : TextHeightProc;
  152. BEGIN
  153. a.ctx := CAST(ADDRESS, ctx);
  154. a.font := font;
  155. p := ctx^.textHeight;
  156. RETURN p(a)
  157. END TextHeight;
  158. PROCEDURE DrawFrameBy(ctx : ContextPtr; r : Rect; colorid : INTEGER);
  159. VAR a : FrameArgs;
  160. p : DrawFrameProc;
  161. BEGIN
  162. a.ctx := CAST(ADDRESS, ctx);
  163. a.rect := r;
  164. a.colorid := colorid;
  165. p := ctx^.drawFrame;
  166. p(a)
  167. END DrawFrameBy;
  168. PROCEDURE IdOf(ctx : ContextPtr; s : ARRAY OF CHAR) : Id;
  169. BEGIN
  170. RETURN getId(ctx, ADR(s), StrLenI(s))
  171. END IdOf;
  172. (*========================================================================*)
  173. (* Constructors *)
  174. (*========================================================================*)
  175. PROCEDURE vec2(x, y : INTEGER) : Vec2;
  176. VAR v : Vec2;
  177. BEGIN v.x := x; v.y := y; RETURN v END vec2;
  178. PROCEDURE rect(x, y, w, h : INTEGER) : Rect;
  179. VAR r : Rect;
  180. BEGIN r.x := x; r.y := y; r.w := w; r.h := h; RETURN r END rect;
  181. PROCEDURE color(r, g, b, a : INTEGER) : Color;
  182. VAR c : Color;
  183. BEGIN
  184. c.r := VAL(BYTE, r);
  185. c.g := VAL(BYTE, g);
  186. c.b := VAL(BYTE, b);
  187. c.a := VAL(BYTE, a);
  188. RETURN c
  189. END color;
  190. (*========================================================================*)
  191. (* Default style / frame *)
  192. (*========================================================================*)
  193. PROCEDURE InitDefaultStyle;
  194. BEGIN
  195. defaultStyle.font := NIL;
  196. defaultStyle.size := vec2(68, 10);
  197. defaultStyle.padding := 5;
  198. defaultStyle.spacing := 4;
  199. defaultStyle.indent := 24;
  200. defaultStyle.titleHeight := 24;
  201. defaultStyle.scrollbarSize := 12;
  202. defaultStyle.thumbSize := 8;
  203. defaultStyle.colors[COLOR_TEXT] := color(230, 230, 230, 255);
  204. defaultStyle.colors[COLOR_BORDER] := color(25, 25, 25, 255);
  205. defaultStyle.colors[COLOR_WINDOWBG] := color(50, 50, 50, 255);
  206. defaultStyle.colors[COLOR_TITLEBG] := color(25, 25, 25, 255);
  207. defaultStyle.colors[COLOR_TITLETEXT] := color(240, 240, 240, 255);
  208. defaultStyle.colors[COLOR_PANELBG] := color(0, 0, 0, 0);
  209. defaultStyle.colors[COLOR_BUTTON] := color(75, 75, 75, 255);
  210. defaultStyle.colors[COLOR_BUTTONHOVER] := color(95, 95, 95, 255);
  211. defaultStyle.colors[COLOR_BUTTONFOCUS] := color(115, 115, 115, 255);
  212. defaultStyle.colors[COLOR_BASE] := color(30, 30, 30, 255);
  213. defaultStyle.colors[COLOR_BASEHOVER] := color(35, 35, 35, 255);
  214. defaultStyle.colors[COLOR_BASEFOCUS] := color(40, 40, 40, 255);
  215. defaultStyle.colors[COLOR_SCROLLBASE] := color(43, 43, 43, 255);
  216. defaultStyle.colors[COLOR_SCROLLTHUMB] := color(30, 30, 30, 255)
  217. END InitDefaultStyle;
  218. PROCEDURE defaultDrawFrame(VAR args : FrameArgs);
  219. VAR ctx : ContextPtr;
  220. r : Rect;
  221. colorid : INTEGER;
  222. BEGIN
  223. ctx := CAST(ContextPtr, args.ctx);
  224. r := args.rect;
  225. colorid := args.colorid;
  226. drawRect(ctx, r, ctx^.style^.colors[colorid]);
  227. IF (colorid = COLOR_SCROLLBASE) OR
  228. (colorid = COLOR_SCROLLTHUMB) OR
  229. (colorid = COLOR_TITLEBG) THEN
  230. RETURN
  231. END;
  232. IF ctx^.style^.colors[COLOR_BORDER].a # VAL(BYTE, 0) THEN
  233. drawBox(ctx, expandRect(r, 1), ctx^.style^.colors[COLOR_BORDER])
  234. END
  235. END defaultDrawFrame;
  236. (*========================================================================*)
  237. (* Core *)
  238. (*========================================================================*)
  239. PROCEDURE init(ctx : ContextPtr);
  240. BEGIN
  241. FillZero(CAST(ADDRESS, ctx), SIZE(Context));
  242. ctx^.drawFrame := defaultDrawFrame;
  243. ctx^._style := defaultStyle;
  244. ctx^.style := ADR(ctx^._style)
  245. END init;
  246. PROCEDURE setFocus(ctx : ContextPtr; id : Id);
  247. BEGIN
  248. ctx^.focus := id;
  249. ctx^.updatedFocus := 1
  250. END setFocus;
  251. PROCEDURE begin(ctx : ContextPtr);
  252. BEGIN
  253. ctx^.commandList.idx := 0;
  254. ctx^.rootList.idx := 0;
  255. ctx^.scrollTarget := NIL;
  256. ctx^.hoverRoot := ctx^.nextHoverRoot;
  257. ctx^.nextHoverRoot := NIL;
  258. ctx^.mouseDelta.x := ctx^.mousePos.x - ctx^.lastMousePos.x;
  259. ctx^.mouseDelta.y := ctx^.mousePos.y - ctx^.lastMousePos.y;
  260. ctx^.frame := ctx^.frame + 1
  261. END begin;
  262. PROCEDURE getId(ctx : ContextPtr; data : ADDRESS; size : INTEGER) : Id;
  263. VAR idx : INTEGER;
  264. res : Id;
  265. BEGIN
  266. idx := ctx^.idStack.idx;
  267. IF idx > 0 THEN
  268. res := ctx^.idStack.items[idx - 1]
  269. ELSE
  270. res := HASH_INITIAL
  271. END;
  272. hash(res, data, size);
  273. ctx^.lastId := res;
  274. RETURN res
  275. END getId;
  276. PROCEDURE pushId(ctx : ContextPtr; data : ADDRESS; size : INTEGER);
  277. BEGIN
  278. ctx^.idStack.items[ctx^.idStack.idx] := getId(ctx, data, size);
  279. ctx^.idStack.idx := ctx^.idStack.idx + 1
  280. END pushId;
  281. PROCEDURE popId(ctx : ContextPtr);
  282. BEGIN
  283. ctx^.idStack.idx := ctx^.idStack.idx - 1
  284. END popId;
  285. PROCEDURE pushClipRect(ctx : ContextPtr; r : Rect);
  286. VAR last : Rect;
  287. BEGIN
  288. last := getClipRect(ctx);
  289. ctx^.clipStack.items[ctx^.clipStack.idx] := intersectRects(r, last);
  290. ctx^.clipStack.idx := ctx^.clipStack.idx + 1
  291. END pushClipRect;
  292. PROCEDURE popClipRect(ctx : ContextPtr);
  293. BEGIN
  294. ctx^.clipStack.idx := ctx^.clipStack.idx - 1
  295. END popClipRect;
  296. PROCEDURE getClipRect(ctx : ContextPtr) : Rect;
  297. BEGIN
  298. RETURN ctx^.clipStack.items[ctx^.clipStack.idx - 1]
  299. END getClipRect;
  300. PROCEDURE checkClip(ctx : ContextPtr; r : Rect) : INTEGER;
  301. VAR cr : Rect;
  302. BEGIN
  303. cr := getClipRect(ctx);
  304. IF (r.x > cr.x + cr.w) OR (r.x + r.w < cr.x) OR
  305. (r.y > cr.y + cr.h) OR (r.y + r.h < cr.y) THEN
  306. RETURN CLIP_ALL
  307. END;
  308. IF (r.x >= cr.x) AND (r.x + r.w <= cr.x + cr.w) AND
  309. (r.y >= cr.y) AND (r.y + r.h <= cr.y + cr.h) THEN
  310. RETURN 0
  311. END;
  312. RETURN CLIP_PART
  313. END checkClip;
  314. PROCEDURE getCurrentContainer(ctx : ContextPtr) : ContainerPtr;
  315. BEGIN
  316. RETURN ctx^.containerStack.items[ctx^.containerStack.idx - 1]
  317. END getCurrentContainer;
  318. PROCEDURE bringToFront(ctx : ContextPtr; cnt : ContainerPtr);
  319. BEGIN
  320. ctx^.lastZindex := ctx^.lastZindex + 1;
  321. cnt^.zindex := ctx^.lastZindex
  322. END bringToFront;
  323. (*========================================================================*)
  324. (* Pool *)
  325. (*========================================================================*)
  326. PROCEDURE poolInit(ctx : ContextPtr; items : ADDRESS; len : INTEGER;
  327. id : Id) : INTEGER;
  328. VAR pool : PoolItemPtr;
  329. i, n, f : INTEGER;
  330. BEGIN
  331. pool := CAST(PoolItemPtr, items);
  332. n := -1;
  333. f := ctx^.frame;
  334. FOR i := 0 TO len - 1 DO
  335. IF pool^[i].lastUpdate < f THEN
  336. f := pool^[i].lastUpdate;
  337. n := i
  338. END
  339. END;
  340. IF n < 0 THEN n := 0 END; (* pool full: reuse slot 0 rather than crash *)
  341. pool^[n].id := id;
  342. poolUpdate(ctx, items, n);
  343. RETURN n
  344. END poolInit;
  345. PROCEDURE poolGet(ctx : ContextPtr; items : ADDRESS; len : INTEGER;
  346. id : Id) : INTEGER;
  347. VAR pool : PoolItemPtr;
  348. i : INTEGER;
  349. BEGIN
  350. pool := CAST(PoolItemPtr, items);
  351. FOR i := 0 TO len - 1 DO
  352. IF pool^[i].id = id THEN RETURN i END
  353. END;
  354. RETURN -1
  355. END poolGet;
  356. PROCEDURE poolUpdate(ctx : ContextPtr; items : ADDRESS; idx : INTEGER);
  357. VAR pool : PoolItemPtr;
  358. BEGIN
  359. pool := CAST(PoolItemPtr, items);
  360. pool^[idx].lastUpdate := ctx^.frame
  361. END poolUpdate;
  362. (*========================================================================*)
  363. (* Container lookup *)
  364. (*========================================================================*)
  365. PROCEDURE getContainerById(ctx : ContextPtr; id : Id; opt : INTEGER) : ContainerPtr;
  366. VAR cnt : ContainerPtr;
  367. idx : INTEGER;
  368. BEGIN
  369. idx := poolGet(ctx, ADR(ctx^.containerPool), CONTAINERPOOL_SIZE, id);
  370. IF idx >= 0 THEN
  371. IF (ctx^.containers[idx].open # 0) OR HasNoOpt(opt, OPT_CLOSED) THEN
  372. poolUpdate(ctx, ADR(ctx^.containerPool), idx)
  373. END;
  374. RETURN ADR(ctx^.containers[idx])
  375. END;
  376. IF HasOpt(opt, OPT_CLOSED) THEN RETURN NIL END;
  377. idx := poolInit(ctx, ADR(ctx^.containerPool), CONTAINERPOOL_SIZE, id);
  378. cnt := ADR(ctx^.containers[idx]);
  379. FillZero(CAST(ADDRESS, cnt), SIZE(Container));
  380. cnt^.open := 1;
  381. bringToFront(ctx, cnt);
  382. RETURN cnt
  383. END getContainerById;
  384. PROCEDURE getContainer(ctx : ContextPtr; name : ARRAY OF CHAR) : ContainerPtr;
  385. VAR id : Id;
  386. BEGIN
  387. id := getId(ctx, ADR(name), StrLenI(name));
  388. RETURN getContainerById(ctx, id, 0)
  389. END getContainer;
  390. (*========================================================================*)
  391. (* Command list *)
  392. (*========================================================================*)
  393. PROCEDURE pushCommand(ctx : ContextPtr; type, size : INTEGER) : CommandPtr;
  394. VAR cmd : CommandPtr;
  395. BEGIN
  396. cmd := CAST(CommandPtr, ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx));
  397. cmd^.type := type;
  398. cmd^.size := size;
  399. ctx^.commandList.idx := ctx^.commandList.idx + size;
  400. RETURN cmd
  401. END pushCommand;
  402. PROCEDURE nextCommand(ctx : ContextPtr; VAR cmd : CommandPtr) : INTEGER;
  403. VAR endAddr : ADDRESS;
  404. jp : JumpCommandPtr;
  405. BEGIN
  406. endAddr := ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx);
  407. IF cmd # NIL THEN
  408. cmd := CAST(CommandPtr, ADDADR(CAST(ADDRESS, cmd), cmd^.size))
  409. ELSE
  410. cmd := CAST(CommandPtr, ADR(ctx^.commandList.items))
  411. END;
  412. WHILE CAST(ADDRESS, cmd) # endAddr DO
  413. IF cmd^.type # COMMAND_JUMP THEN RETURN 1 END;
  414. jp := CAST(JumpCommandPtr, cmd);
  415. cmd := CAST(CommandPtr, jp^.dst)
  416. END;
  417. RETURN 0
  418. END nextCommand;
  419. PROCEDURE pushJump(ctx : ContextPtr; dst : CommandPtr) : CommandPtr;
  420. VAR cmd : CommandPtr;
  421. jp : JumpCommandPtr;
  422. BEGIN
  423. cmd := pushCommand(ctx, COMMAND_JUMP, SIZE(JumpCommand));
  424. jp := CAST(JumpCommandPtr, cmd);
  425. jp^.dst := dst;
  426. RETURN cmd
  427. END pushJump;
  428. PROCEDURE setClip(ctx : ContextPtr; r : Rect);
  429. VAR cmd : CommandPtr;
  430. cp : ClipCommandPtr;
  431. BEGIN
  432. cmd := pushCommand(ctx, COMMAND_CLIP, SIZE(ClipCommand));
  433. cp := CAST(ClipCommandPtr, cmd);
  434. cp^.rect := r
  435. END setClip;
  436. PROCEDURE drawRect(ctx : ContextPtr; r : Rect; c : Color);
  437. VAR cmd : CommandPtr;
  438. ir : Rect;
  439. rp : RectCommandPtr;
  440. BEGIN
  441. ir := intersectRects(r, getClipRect(ctx));
  442. IF (ir.w > 0) AND (ir.h > 0) THEN
  443. cmd := pushCommand(ctx, COMMAND_RECT, SIZE(RectCommand));
  444. rp := CAST(RectCommandPtr, cmd);
  445. rp^.rect := ir;
  446. rp^.color := c
  447. END
  448. END drawRect;
  449. PROCEDURE drawBox(ctx : ContextPtr; r : Rect; c : Color);
  450. BEGIN
  451. drawRect(ctx, rect(r.x + 1, r.y, r.w - 2, 1), c);
  452. drawRect(ctx, rect(r.x + 1, r.y + r.h - 1, r.w - 2, 1), c);
  453. drawRect(ctx, rect(r.x, r.y, 1, r.h), c);
  454. drawRect(ctx, rect(r.x + r.w - 1, r.y, 1, r.h), c)
  455. END drawBox;
  456. PROCEDURE drawText(ctx : ContextPtr; font : Font; str : ADDRESS; len : INTEGER;
  457. pos : Vec2; c : Color);
  458. VAR cmd : CommandPtr;
  459. r : Rect;
  460. clipped : INTEGER;
  461. dstAddr : ADDRESS;
  462. tc : TextCommandPtr;
  463. cp : CharPtr;
  464. BEGIN
  465. r := rect(pos.x, pos.y, TextWidth(ctx, font, str, len),
  466. TextHeight(ctx, font));
  467. clipped := checkClip(ctx, r);
  468. IF clipped = CLIP_ALL THEN RETURN END;
  469. IF clipped = CLIP_PART THEN setClip(ctx, getClipRect(ctx)) END;
  470. IF len < 0 THEN
  471. len := CStrLen(str)
  472. END;
  473. cmd := pushCommand(ctx, COMMAND_TEXT,
  474. VAL(INTEGER, SIZE(TextCommand)) + len + 1);
  475. dstAddr := ADDADR(CAST(ADDRESS, cmd), SIZE(TextCommand));
  476. CopyBytes(str, dstAddr, VAL(CARDINAL, len));
  477. cp := CAST(CharPtr, ADDADR(dstAddr, VAL(CARDINAL, len)));
  478. cp^ := 0C;
  479. tc := CAST(TextCommandPtr, cmd);
  480. tc^.pos := pos;
  481. tc^.color := c;
  482. tc^.font := font;
  483. IF clipped # 0 THEN setClip(ctx, unclippedRect) END
  484. END drawText;
  485. PROCEDURE drawIcon(ctx : ContextPtr; id : INTEGER; r : Rect; c : Color);
  486. VAR cmd : CommandPtr;
  487. clipped : INTEGER;
  488. ip : IconCommandPtr;
  489. BEGIN
  490. clipped := checkClip(ctx, r);
  491. IF clipped = CLIP_ALL THEN RETURN END;
  492. IF clipped = CLIP_PART THEN setClip(ctx, getClipRect(ctx)) END;
  493. cmd := pushCommand(ctx, COMMAND_ICON, SIZE(IconCommand));
  494. ip := CAST(IconCommandPtr, cmd);
  495. ip^.id := id;
  496. ip^.rect := r;
  497. ip^.color := c;
  498. IF clipped # 0 THEN setClip(ctx, unclippedRect) END
  499. END drawIcon;
  500. (*========================================================================*)
  501. (* Layout *)
  502. (*========================================================================*)
  503. PROCEDURE getLayout(ctx : ContextPtr) : LayoutPtr;
  504. VAR off : CARDINAL;
  505. BEGIN
  506. off := VAL(CARDINAL, ctx^.layoutStack.idx - 1) * SIZE(Layout);
  507. RETURN CAST(LayoutPtr, ADDADR(ADR(ctx^.layoutStack.items), off))
  508. END getLayout;
  509. PROCEDURE pushLayout(ctx : ContextPtr; body : Rect; scroll : Vec2);
  510. VAR layout : LayoutPtr;
  511. w : INTEGER;
  512. off : CARDINAL;
  513. BEGIN
  514. off := VAL(CARDINAL, ctx^.layoutStack.idx) * SIZE(Layout);
  515. layout := CAST(LayoutPtr, ADDADR(ADR(ctx^.layoutStack.items), off));
  516. FillZero(CAST(ADDRESS, layout), SIZE(Layout));
  517. layout^.body := rect(body.x - scroll.x, body.y - scroll.y, body.w, body.h);
  518. layout^.max := vec2(negBigCoord, negBigCoord);
  519. ctx^.layoutStack.idx := ctx^.layoutStack.idx + 1;
  520. w := 0;
  521. layoutRow(ctx, 1, ADR(w), 0)
  522. END pushLayout;
  523. PROCEDURE layoutRow(ctx : ContextPtr; items : INTEGER;
  524. widths : ADDRESS; height : INTEGER);
  525. VAR layout : LayoutPtr;
  526. src : IntPtr;
  527. i : INTEGER;
  528. BEGIN
  529. layout := getLayout(ctx);
  530. IF widths # NIL THEN
  531. src := CAST(IntPtr, widths);
  532. FOR i := 0 TO items - 1 DO
  533. layout^.widths[i] := src^;
  534. src := ADDADR(src, SIZE(INTEGER))
  535. END
  536. END;
  537. layout^.items := items;
  538. layout^.position := vec2(layout^.indent, layout^.nextRow);
  539. layout^.size.y := height;
  540. layout^.itemIndex := 0
  541. END layoutRow;
  542. PROCEDURE layoutWidth(ctx : ContextPtr; width : INTEGER);
  543. VAR layout : LayoutPtr;
  544. BEGIN
  545. layout := getLayout(ctx);
  546. layout^.size.x := width
  547. END layoutWidth;
  548. PROCEDURE layoutHeight(ctx : ContextPtr; height : INTEGER);
  549. VAR layout : LayoutPtr;
  550. BEGIN
  551. layout := getLayout(ctx);
  552. layout^.size.y := height
  553. END layoutHeight;
  554. PROCEDURE layoutBeginColumn(ctx : ContextPtr);
  555. BEGIN
  556. pushLayout(ctx, layoutNext(ctx), vec2(0, 0))
  557. END layoutBeginColumn;
  558. PROCEDURE layoutEndColumn(ctx : ContextPtr);
  559. VAR a, b : LayoutPtr;
  560. BEGIN
  561. b := getLayout(ctx);
  562. ctx^.layoutStack.idx := ctx^.layoutStack.idx - 1;
  563. a := getLayout(ctx);
  564. a^.position.x := max(a^.position.x, b^.position.x + b^.body.x - a^.body.x);
  565. a^.nextRow := max(a^.nextRow, b^.nextRow + b^.body.y - a^.body.y);
  566. a^.max.x := max(a^.max.x, b^.max.x);
  567. a^.max.y := max(a^.max.y, b^.max.y)
  568. END layoutEndColumn;
  569. PROCEDURE layoutSetNext(ctx : ContextPtr; r : Rect; relative : INTEGER);
  570. VAR layout : LayoutPtr;
  571. BEGIN
  572. layout := getLayout(ctx);
  573. layout^.next := r;
  574. IF relative # 0 THEN
  575. layout^.nextType := RELATIVE
  576. ELSE
  577. layout^.nextType := ABSOLUTE
  578. END
  579. END layoutSetNext;
  580. PROCEDURE layoutNext(ctx : ContextPtr) : Rect;
  581. VAR layout : LayoutPtr;
  582. st : StylePtr;
  583. res : Rect;
  584. typ : INTEGER;
  585. BEGIN
  586. layout := getLayout(ctx);
  587. st := CAST(StylePtr, ctx^.style);
  588. IF layout^.nextType # 0 THEN
  589. typ := layout^.nextType;
  590. layout^.nextType := 0;
  591. res := layout^.next;
  592. IF typ = ABSOLUTE THEN
  593. ctx^.lastRect := res;
  594. RETURN res
  595. END
  596. ELSE
  597. IF layout^.itemIndex = layout^.items THEN
  598. layoutRow(ctx, layout^.items, NIL, layout^.size.y)
  599. END;
  600. res.x := layout^.position.x;
  601. res.y := layout^.position.y;
  602. res.w := layout^.widths[layout^.itemIndex];
  603. IF layout^.items <= 0 THEN res.w := layout^.size.x END;
  604. res.h := layout^.size.y;
  605. IF res.w = 0 THEN
  606. res.w := st^.size.x + st^.padding * 2
  607. END;
  608. IF res.h = 0 THEN
  609. res.h := st^.size.y + st^.padding * 2
  610. END;
  611. IF res.w < 0 THEN
  612. res.w := res.w + layout^.body.w - res.x + 1
  613. END;
  614. IF res.h < 0 THEN
  615. res.h := res.h + layout^.body.h - res.y + 1
  616. END;
  617. layout^.itemIndex := layout^.itemIndex + 1
  618. END;
  619. layout^.position.x := res.w + layout^.position.x + st^.spacing;
  620. layout^.nextRow := max(layout^.nextRow, res.y + res.h + st^.spacing);
  621. res.x := res.x + layout^.body.x;
  622. res.y := res.y + layout^.body.y;
  623. layout^.max.x := max(layout^.max.x, res.x + res.w);
  624. layout^.max.y := max(layout^.max.y, res.y + res.h);
  625. ctx^.lastRect := res;
  626. RETURN res
  627. END layoutNext;
  628. (*========================================================================*)
  629. (* Controls *)
  630. (*========================================================================*)
  631. PROCEDURE inHoverRoot(ctx : ContextPtr) : INTEGER;
  632. VAR i : INTEGER;
  633. BEGIN
  634. i := ctx^.containerStack.idx;
  635. WHILE i > 0 DO
  636. i := i - 1;
  637. IF ctx^.containerStack.items[i] = ctx^.hoverRoot THEN RETURN 1 END;
  638. IF ctx^.containerStack.items[i]^.head # NIL THEN RETURN 0 END
  639. END;
  640. RETURN 0
  641. END inHoverRoot;
  642. PROCEDURE drawControlFrame(ctx : ContextPtr; id : Id; r : Rect;
  643. colorid, opt : INTEGER);
  644. BEGIN
  645. IF HasOpt(opt, OPT_NOFRAME) THEN RETURN END;
  646. IF ctx^.focus = id THEN
  647. colorid := colorid + 2
  648. ELSIF ctx^.hover = id THEN
  649. colorid := colorid + 1
  650. END;
  651. DrawFrameBy(ctx, r, colorid)
  652. END drawControlFrame;
  653. PROCEDURE drawControlText(ctx : ContextPtr; str : ARRAY OF CHAR;
  654. r : Rect; colorid, opt : INTEGER);
  655. VAR pos : Vec2;
  656. f : Font;
  657. tw : INTEGER;
  658. BEGIN
  659. f := ctx^.style^.font;
  660. tw := TextWidth(ctx, f, ADR(str), -1);
  661. pushClipRect(ctx, r);
  662. pos.y := r.y + (r.h - TextHeight(ctx, f)) DIV 2;
  663. IF HasOpt(opt, OPT_ALIGNCENTER) THEN
  664. pos.x := r.x + (r.w - tw) DIV 2
  665. ELSIF HasOpt(opt, OPT_ALIGNRIGHT) THEN
  666. pos.x := r.x + r.w - tw - ctx^.style^.padding
  667. ELSE
  668. pos.x := r.x + ctx^.style^.padding
  669. END;
  670. drawText(ctx, f, ADR(str), -1, pos, ctx^.style^.colors[colorid]);
  671. popClipRect(ctx)
  672. END drawControlText;
  673. PROCEDURE mouseOver(ctx : ContextPtr; r : Rect) : INTEGER;
  674. BEGIN
  675. IF rectOverlapsVec2(r, ctx^.mousePos) AND
  676. rectOverlapsVec2(getClipRect(ctx), ctx^.mousePos) AND
  677. (inHoverRoot(ctx) # 0) THEN
  678. RETURN 1
  679. END;
  680. RETURN 0
  681. END mouseOver;
  682. PROCEDURE updateControl(ctx : ContextPtr; id : Id; r : Rect; opt : INTEGER);
  683. VAR mouseover : INTEGER;
  684. BEGIN
  685. mouseover := mouseOver(ctx, r);
  686. IF ctx^.focus = id THEN ctx^.updatedFocus := 1 END;
  687. IF HasOpt(opt, OPT_NOINTERACT) THEN RETURN END;
  688. IF (mouseover # 0) AND (ctx^.mouseDown = 0) THEN ctx^.hover := id END;
  689. IF ctx^.focus = id THEN
  690. IF (ctx^.mousePressed # 0) AND (mouseover = 0) THEN setFocus(ctx, 0) END;
  691. IF (ctx^.mouseDown = 0) AND HasNoOpt(opt, OPT_HOLDFOCUS) THEN
  692. setFocus(ctx, 0)
  693. END
  694. END;
  695. IF ctx^.hover = id THEN
  696. IF ctx^.mousePressed # 0 THEN
  697. setFocus(ctx, id)
  698. ELSIF mouseover = 0 THEN
  699. ctx^.hover := 0
  700. END
  701. END
  702. END updateControl;
  703. (*========================================================================*)
  704. (* Widgets *)
  705. (*========================================================================*)
  706. PROCEDURE text(ctx : ContextPtr; str : ARRAY OF CHAR);
  707. VAR start, fin, p, slen : INTEGER;
  708. width, w, word : INTEGER;
  709. f : Font;
  710. c : Color;
  711. r : Rect;
  712. done : BOOLEAN;
  713. BEGIN
  714. width := -1;
  715. f := ctx^.style^.font;
  716. c := ctx^.style^.colors[COLOR_TEXT];
  717. slen := StrLenI(str);
  718. layoutBeginColumn(ctx);
  719. layoutRow(ctx, 1, ADR(width), TextHeight(ctx, f));
  720. p := 0;
  721. REPEAT
  722. r := layoutNext(ctx);
  723. w := 0;
  724. start := p;
  725. fin := p;
  726. done := FALSE;
  727. REPEAT
  728. word := p;
  729. WHILE (p < slen) AND (str[p] # ' ') AND (str[p] # CHR(10)) DO
  730. p := p + 1
  731. END;
  732. w := w + TextWidth(ctx, f, ADDADR(ADR(str), word), p - word);
  733. IF (w > r.w) AND (fin # start) THEN
  734. done := TRUE
  735. ELSE
  736. w := w + TextWidth(ctx, f, ADDADR(ADR(str), p), 1);
  737. fin := p;
  738. p := p + 1;
  739. IF (fin >= slen) OR (str[fin] = CHR(10)) THEN
  740. done := TRUE
  741. END
  742. END
  743. UNTIL done;
  744. IF fin > start THEN
  745. drawText(ctx, f, ADDADR(ADR(str), start), fin - start,
  746. vec2(r.x, r.y), c)
  747. END;
  748. p := fin + 1
  749. UNTIL fin >= slen;
  750. layoutEndColumn(ctx)
  751. END text;
  752. PROCEDURE label(ctx : ContextPtr; str : ARRAY OF CHAR);
  753. VAR r : Rect;
  754. BEGIN
  755. r := layoutNext(ctx);
  756. drawControlText(ctx, str, r, COLOR_TEXT, 0)
  757. END label;
  758. PROCEDURE buttonEx(ctx : ContextPtr; lbl : ARRAY OF CHAR;
  759. icon, opt : INTEGER) : INTEGER;
  760. VAR res : INTEGER;
  761. id : Id;
  762. r : Rect;
  763. slen: INTEGER;
  764. BEGIN
  765. res := 0;
  766. slen := StrLenI(lbl);
  767. IF slen > 0 THEN
  768. id := getId(ctx, ADR(lbl), slen)
  769. ELSE
  770. id := getId(ctx, ADR(icon), SIZE(INTEGER))
  771. END;
  772. r := layoutNext(ctx);
  773. updateControl(ctx, id, r, opt);
  774. IF (ctx^.mousePressed = MOUSE_LEFT) AND (ctx^.focus = id) THEN
  775. res := SetFlag(res, RES_SUBMIT)
  776. END;
  777. drawControlFrame(ctx, id, r, COLOR_BUTTON, opt);
  778. IF slen > 0 THEN
  779. drawControlText(ctx, lbl, r, COLOR_TEXT, opt)
  780. END;
  781. IF icon # 0 THEN
  782. drawIcon(ctx, icon, r, ctx^.style^.colors[COLOR_TEXT])
  783. END;
  784. RETURN res
  785. END buttonEx;
  786. PROCEDURE checkbox(ctx : ContextPtr; lbl : ARRAY OF CHAR;
  787. state : IntPtr) : INTEGER;
  788. VAR res : INTEGER;
  789. id : Id;
  790. r, box : Rect;
  791. BEGIN
  792. res := 0;
  793. id := getId(ctx, ADR(state), SIZE(ADDRESS));
  794. r := layoutNext(ctx);
  795. box := rect(r.x, r.y, r.h, r.h);
  796. updateControl(ctx, id, r, 0);
  797. IF (ctx^.mousePressed = MOUSE_LEFT) AND (ctx^.focus = id) THEN
  798. res := SetFlag(res, RES_CHANGE);
  799. IF state^ = 0 THEN state^ := 1 ELSE state^ := 0 END
  800. END;
  801. drawControlFrame(ctx, id, box, COLOR_BASE, 0);
  802. IF state^ # 0 THEN
  803. drawIcon(ctx, ICON_CHECK, box, ctx^.style^.colors[COLOR_TEXT])
  804. END;
  805. r := rect(r.x + box.w, r.y, r.w - box.w, r.h);
  806. drawControlText(ctx, lbl, r, COLOR_TEXT, 0);
  807. RETURN res
  808. END checkbox;
  809. PROCEDURE bufLen(buf : ADDRESS; bufsz : INTEGER) : INTEGER;
  810. VAR p : CharPtr;
  811. n : INTEGER;
  812. BEGIN
  813. p := CAST(CharPtr, buf);
  814. n := 0;
  815. WHILE (n < bufsz) AND (p^ # 0C) DO
  816. n := n + 1;
  817. p := ADDADR(p, 1)
  818. END;
  819. RETURN n
  820. END bufLen;
  821. PROCEDURE textboxRaw(ctx : ContextPtr; buf : ADDRESS; bufsz : INTEGER;
  822. id : Id; r : Rect; opt : INTEGER) : INTEGER;
  823. VAR res : INTEGER;
  824. bufStr : CharArrayPtr;
  825. len, n, inlen : INTEGER;
  826. font : Font;
  827. textW, textH, ofx, textx, texty : INTEGER;
  828. c : Color;
  829. BEGIN
  830. res := 0;
  831. bufStr := CAST(CharArrayPtr, buf);
  832. updateControl(ctx, id, r, BitOrI(opt, OPT_HOLDFOCUS));
  833. IF ctx^.focus = id THEN
  834. len := bufLen(buf, bufsz);
  835. inlen := StrLenI(ctx^.inputText);
  836. n := min(bufsz - len - 1, inlen);
  837. IF n > 0 THEN
  838. CopyBytes(ADR(ctx^.inputText), ADDADR(buf, len), VAL(CARDINAL, n));
  839. len := len + n;
  840. bufStr^[len] := 0C;
  841. res := SetFlag(res, RES_CHANGE)
  842. END;
  843. (* handle backspace, skipping UTF-8 continuation bytes *)
  844. IF HasOpt(ctx^.keyPressed, KEY_BACKSPACE) AND (len > 0) THEN
  845. len := len - 1;
  846. WHILE (len > 0) AND
  847. (BITAND(VAL(CARDINAL, ORD(bufStr^[len])), 0C0H) = 080H) DO
  848. len := len - 1
  849. END;
  850. bufStr^[len] := 0C;
  851. res := SetFlag(res, RES_CHANGE)
  852. END;
  853. IF HasOpt(ctx^.keyPressed, KEY_RETURN) THEN
  854. setFocus(ctx, 0);
  855. res := SetFlag(res, RES_SUBMIT)
  856. END
  857. END;
  858. drawControlFrame(ctx, id, r, COLOR_BASE, opt);
  859. IF ctx^.focus = id THEN
  860. c := ctx^.style^.colors[COLOR_TEXT];
  861. font := ctx^.style^.font;
  862. textW := TextWidth(ctx, font, buf, -1);
  863. textH := TextHeight(ctx, font);
  864. ofx := r.w - ctx^.style^.padding - textW - 1;
  865. textx := r.x + min(ofx, ctx^.style^.padding);
  866. texty := r.y + (r.h - textH) DIV 2;
  867. pushClipRect(ctx, r);
  868. drawText(ctx, font, buf, -1, vec2(textx, texty), c);
  869. drawRect(ctx, rect(textx + textW, texty, 1, textH), c);
  870. popClipRect(ctx)
  871. ELSE
  872. drawControlText(ctx, bufStr^, r, COLOR_TEXT, opt)
  873. END;
  874. RETURN res
  875. END textboxRaw;
  876. PROCEDURE textboxEx(ctx : ContextPtr; buf : ADDRESS;
  877. bufsz, opt : INTEGER) : INTEGER;
  878. VAR id : Id;
  879. r : Rect;
  880. BEGIN
  881. id := getId(ctx, ADR(buf), SIZE(ADDRESS));
  882. r := layoutNext(ctx);
  883. RETURN textboxRaw(ctx, buf, bufsz, id, r, opt)
  884. END textboxEx;
  885. PROCEDURE FormatReal(VAR buf : ARRAY OF CHAR; val : Real; fmt : ARRAY OF CHAR);
  886. VAR i, prec : INTEGER;
  887. ch : CHAR;
  888. scanning : BOOLEAN;
  889. discard : CARDINAL;
  890. hi : INTEGER;
  891. BEGIN
  892. prec := 2;
  893. i := 0;
  894. hi := VAL(INTEGER, HIGH(fmt));
  895. scanning := TRUE;
  896. WHILE scanning AND (i <= hi) AND (fmt[i] # 0C) DO
  897. IF fmt[i] = '.' THEN
  898. i := i + 1;
  899. prec := 0;
  900. WHILE (i <= hi) AND (fmt[i] >= '0') AND (fmt[i] <= '9') DO
  901. prec := prec * 10 + VAL(INTEGER, ORD(fmt[i]) - ORD('0'));
  902. i := i + 1
  903. END;
  904. scanning := FALSE
  905. ELSE
  906. i := i + 1
  907. END
  908. END;
  909. ch := 'f';
  910. scanning := TRUE;
  911. WHILE scanning AND (i <= hi) AND (fmt[i] # 0C) DO
  912. IF (fmt[i] = 'f') OR (fmt[i] = 'g') THEN
  913. ch := fmt[i];
  914. scanning := FALSE
  915. ELSE
  916. i := i + 1
  917. END
  918. END;
  919. IF ch = 'g' THEN
  920. discard := RealToStr(buf, val, 0 - prec)
  921. ELSE
  922. discard := RealToStr(buf, val, prec)
  923. END
  924. END FormatReal;
  925. PROCEDURE numberTextbox(ctx : ContextPtr; value : RealPtr;
  926. r : Rect; id : Id) : INTEGER;
  927. VAR res : INTEGER;
  928. discard : CARDINAL;
  929. BEGIN
  930. IF (ctx^.mousePressed = MOUSE_LEFT) AND HasOpt(ctx^.keyDown, KEY_SHIFT) AND
  931. (ctx^.hover = id) THEN
  932. ctx^.numberEdit := id;
  933. discard := RealToStr(ctx^.numberEditBuf, value^, 0 - 3)
  934. END;
  935. IF ctx^.numberEdit = id THEN
  936. res := textboxRaw(ctx, ADR(ctx^.numberEditBuf),
  937. SIZE(ctx^.numberEditBuf), id, r, 0);
  938. IF HasOpt(res, RES_SUBMIT) OR (ctx^.focus # id) THEN
  939. value^ := StrToReal(ctx^.numberEditBuf, NIL);
  940. ctx^.numberEdit := 0
  941. ELSE
  942. RETURN 1
  943. END
  944. END;
  945. RETURN 0
  946. END numberTextbox;
  947. PROCEDURE sliderEx(ctx : ContextPtr; value : RealPtr;
  948. low, high, step : Real;
  949. fmt : ARRAY OF CHAR; opt : INTEGER) : INTEGER;
  950. VAR buf : ARRAY [0..MAX_FMT + 1] OF CHAR;
  951. thumb : Rect;
  952. x, w : INTEGER;
  953. res : INTEGER;
  954. last : Real;
  955. v : Real;
  956. id : Id;
  957. base : Rect;
  958. BEGIN
  959. res := 0;
  960. id := getId(ctx, ADR(value), SIZE(ADDRESS));
  961. base := layoutNext(ctx);
  962. v := value^;
  963. last := v;
  964. IF numberTextbox(ctx, ADR(v), base, id) # 0 THEN RETURN res END;
  965. updateControl(ctx, id, base, opt);
  966. IF (ctx^.focus = id) AND
  967. (BitOrI(ctx^.mouseDown, ctx^.mousePressed) = MOUSE_LEFT) THEN
  968. v := low + IntToReal(ctx^.mousePos.x - base.x) *
  969. (high - low) / IntToReal(base.w);
  970. IF step # 0.0 THEN
  971. v := IntToReal(TRUNC(SHORTREAL((v + step / 2.0) / step))) * step
  972. END
  973. END;
  974. v := clampR(v, low, high);
  975. value^ := v;
  976. IF last # v THEN res := SetFlag(res, RES_CHANGE) END;
  977. drawControlFrame(ctx, id, base, COLOR_BASE, opt);
  978. w := ctx^.style^.thumbSize;
  979. x := TRUNC(SHORTREAL((v - low) * IntToReal(base.w - w) / (high - low)));
  980. thumb := rect(base.x + x, base.y, w, base.h);
  981. drawControlFrame(ctx, id, thumb, COLOR_BUTTON, opt);
  982. FormatReal(buf, v, fmt);
  983. drawControlText(ctx, buf, base, COLOR_TEXT, opt);
  984. RETURN res
  985. END sliderEx;
  986. PROCEDURE numberEx(ctx : ContextPtr; value : RealPtr;
  987. step : Real; fmt : ARRAY OF CHAR;
  988. opt : INTEGER) : INTEGER;
  989. VAR buf : ARRAY [0..MAX_FMT + 1] OF CHAR;
  990. res : INTEGER;
  991. id : Id;
  992. base: Rect;
  993. last: Real;
  994. BEGIN
  995. res := 0;
  996. id := getId(ctx, ADR(value), SIZE(ADDRESS));
  997. base := layoutNext(ctx);
  998. last := value^;
  999. IF numberTextbox(ctx, value, base, id) # 0 THEN RETURN res END;
  1000. updateControl(ctx, id, base, opt);
  1001. IF (ctx^.focus = id) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
  1002. value^ := value^ + IntToReal(ctx^.mouseDelta.x) * step
  1003. END;
  1004. IF value^ # last THEN res := SetFlag(res, RES_CHANGE) END;
  1005. drawControlFrame(ctx, id, base, COLOR_BASE, opt);
  1006. FormatReal(buf, value^, fmt);
  1007. drawControlText(ctx, buf, base, COLOR_TEXT, opt);
  1008. RETURN res
  1009. END numberEx;
  1010. PROCEDURE headerCalc(ctx : ContextPtr; lbl : ARRAY OF CHAR;
  1011. istreenode, opt : INTEGER) : INTEGER;
  1012. VAR id : Id;
  1013. idx : INTEGER;
  1014. active, expanded : INTEGER;
  1015. r : Rect;
  1016. width : INTEGER;
  1017. tmpIdx : INTEGER;
  1018. BEGIN
  1019. id := getId(ctx, ADR(lbl), StrLenI(lbl));
  1020. idx := poolGet(ctx, ADR(ctx^.treenodePool), TREENODEPOOL_SIZE, id);
  1021. width := -1;
  1022. layoutRow(ctx, 1, ADR(width), 0);
  1023. IF idx >= 0 THEN active := 1 ELSE active := 0 END;
  1024. IF HasOpt(opt, OPT_EXPANDED) THEN
  1025. IF active # 0 THEN expanded := 0 ELSE expanded := 1 END
  1026. ELSE
  1027. expanded := active
  1028. END;
  1029. r := layoutNext(ctx);
  1030. updateControl(ctx, id, r, 0);
  1031. IF (ctx^.mousePressed = MOUSE_LEFT) AND (ctx^.focus = id) THEN
  1032. active := 1 - active
  1033. END;
  1034. IF idx >= 0 THEN
  1035. IF active # 0 THEN
  1036. poolUpdate(ctx, ADR(ctx^.treenodePool), idx)
  1037. ELSE
  1038. FillZero(ADR(ctx^.treenodePool[idx]), SIZE(PoolItem))
  1039. END
  1040. ELSIF active # 0 THEN
  1041. tmpIdx := poolInit(ctx, ADR(ctx^.treenodePool), TREENODEPOOL_SIZE, id)
  1042. END;
  1043. IF istreenode # 0 THEN
  1044. IF ctx^.hover = id THEN
  1045. DrawFrameBy(ctx, r, COLOR_BUTTONHOVER)
  1046. END
  1047. ELSE
  1048. drawControlFrame(ctx, id, r, COLOR_BUTTON, 0)
  1049. END;
  1050. IF expanded # 0 THEN
  1051. drawIcon(ctx, ICON_EXPANDED, rect(r.x, r.y, r.h, r.h),
  1052. ctx^.style^.colors[COLOR_TEXT])
  1053. ELSE
  1054. drawIcon(ctx, ICON_COLLAPSED, rect(r.x, r.y, r.h, r.h),
  1055. ctx^.style^.colors[COLOR_TEXT])
  1056. END;
  1057. r.x := r.x + r.h - ctx^.style^.padding;
  1058. r.w := r.w - r.h + ctx^.style^.padding;
  1059. drawControlText(ctx, lbl, r, COLOR_TEXT, 0);
  1060. IF expanded # 0 THEN RETURN RES_ACTIVE ELSE RETURN 0 END
  1061. END headerCalc;
  1062. PROCEDURE headerEx(ctx : ContextPtr; lbl : ARRAY OF CHAR;
  1063. opt : INTEGER) : INTEGER;
  1064. BEGIN
  1065. RETURN headerCalc(ctx, lbl, 0, opt)
  1066. END headerEx;
  1067. PROCEDURE beginTreenodeEx(ctx : ContextPtr; lbl : ARRAY OF CHAR;
  1068. opt : INTEGER) : INTEGER;
  1069. VAR res : INTEGER;
  1070. layout : LayoutPtr;
  1071. BEGIN
  1072. res := headerCalc(ctx, lbl, 1, opt);
  1073. IF HasOpt(res, RES_ACTIVE) THEN
  1074. layout := getLayout(ctx);
  1075. layout^.indent := layout^.indent + ctx^.style^.indent;
  1076. ctx^.idStack.items[ctx^.idStack.idx] := ctx^.lastId;
  1077. ctx^.idStack.idx := ctx^.idStack.idx + 1
  1078. END;
  1079. RETURN res
  1080. END beginTreenodeEx;
  1081. PROCEDURE endTreenode(ctx : ContextPtr);
  1082. VAR layout : LayoutPtr;
  1083. BEGIN
  1084. layout := getLayout(ctx);
  1085. layout^.indent := layout^.indent - ctx^.style^.indent;
  1086. popId(ctx)
  1087. END endTreenode;
  1088. (*========================================================================*)
  1089. (* Scrollbars *)
  1090. (*========================================================================*)
  1091. PROCEDURE drawScrollbar(ctx : ContextPtr; cnt : ContainerPtr;
  1092. body : Rect; cs : Vec2; vertical : BOOLEAN);
  1093. VAR maxscroll : INTEGER;
  1094. base, thumb : Rect;
  1095. id : Id;
  1096. tsize, avail : INTEGER;
  1097. BEGIN
  1098. IF vertical THEN
  1099. maxscroll := cs.y - body.h
  1100. ELSE
  1101. maxscroll := cs.x - body.w
  1102. END;
  1103. IF (maxscroll > 0) AND (body.h > 0) AND (body.w > 0) THEN
  1104. base := body;
  1105. IF vertical THEN
  1106. base.x := body.x + body.w;
  1107. base.w := ctx^.style^.scrollbarSize
  1108. ELSE
  1109. base.y := body.y + body.h;
  1110. base.h := ctx^.style^.scrollbarSize
  1111. END;
  1112. IF vertical THEN
  1113. id := IdOf(ctx, "!scrollbarY")
  1114. ELSE
  1115. id := IdOf(ctx, "!scrollbarX")
  1116. END;
  1117. updateControl(ctx, id, base, 0);
  1118. IF (ctx^.focus = id) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
  1119. IF vertical THEN
  1120. cnt^.scroll.y := cnt^.scroll.y +
  1121. ctx^.mouseDelta.y * cs.y DIV base.h
  1122. ELSE
  1123. cnt^.scroll.x := cnt^.scroll.x +
  1124. ctx^.mouseDelta.x * cs.x DIV base.w
  1125. END
  1126. END;
  1127. IF vertical THEN
  1128. cnt^.scroll.y := clamp(cnt^.scroll.y, 0, maxscroll)
  1129. ELSE
  1130. cnt^.scroll.x := clamp(cnt^.scroll.x, 0, maxscroll)
  1131. END;
  1132. DrawFrameBy(ctx, base, COLOR_SCROLLBASE);
  1133. thumb := base;
  1134. tsize := ctx^.style^.thumbSize;
  1135. IF vertical THEN
  1136. avail := base.h;
  1137. IF tsize < avail * body.h DIV cs.y THEN
  1138. tsize := avail * body.h DIV cs.y
  1139. END;
  1140. thumb.h := tsize;
  1141. thumb.y := thumb.y +
  1142. cnt^.scroll.y * (avail - tsize) DIV maxscroll
  1143. ELSE
  1144. avail := base.w;
  1145. IF tsize < avail * body.w DIV cs.x THEN
  1146. tsize := avail * body.w DIV cs.x
  1147. END;
  1148. thumb.w := tsize;
  1149. thumb.x := thumb.x +
  1150. cnt^.scroll.x * (avail - tsize) DIV maxscroll
  1151. END;
  1152. DrawFrameBy(ctx, thumb, COLOR_SCROLLTHUMB);
  1153. IF mouseOver(ctx, body) # 0 THEN
  1154. ctx^.scrollTarget := cnt
  1155. END
  1156. ELSE
  1157. IF vertical THEN
  1158. cnt^.scroll.y := 0
  1159. ELSE
  1160. cnt^.scroll.x := 0
  1161. END
  1162. END
  1163. END drawScrollbar;
  1164. PROCEDURE scrollbars(ctx : ContextPtr; cnt : ContainerPtr; VAR body : Rect);
  1165. VAR sz : INTEGER;
  1166. cs : Vec2;
  1167. BEGIN
  1168. sz := ctx^.style^.scrollbarSize;
  1169. cs := cnt^.contentSize;
  1170. cs.x := cs.x + ctx^.style^.padding * 2;
  1171. cs.y := cs.y + ctx^.style^.padding * 2;
  1172. pushClipRect(ctx, body);
  1173. IF cs.y > cnt^.body.h THEN body.w := body.w - sz END;
  1174. IF cs.x > cnt^.body.w THEN body.h := body.h - sz END;
  1175. drawScrollbar(ctx, cnt, body, cs, TRUE);
  1176. drawScrollbar(ctx, cnt, body, cs, FALSE);
  1177. popClipRect(ctx)
  1178. END scrollbars;
  1179. PROCEDURE pushContainerBody(ctx : ContextPtr; cnt : ContainerPtr;
  1180. body : Rect; opt : INTEGER);
  1181. VAR b : Rect;
  1182. BEGIN
  1183. b := body;
  1184. IF HasNoOpt(opt, OPT_NOSCROLL) THEN
  1185. scrollbars(ctx, cnt, b)
  1186. END;
  1187. pushLayout(ctx, expandRect(b, 0 - ctx^.style^.padding), cnt^.scroll);
  1188. cnt^.body := b
  1189. END pushContainerBody;
  1190. PROCEDURE popContainer(ctx : ContextPtr);
  1191. VAR cnt : ContainerPtr;
  1192. layout : LayoutPtr;
  1193. BEGIN
  1194. cnt := getCurrentContainer(ctx);
  1195. layout := getLayout(ctx);
  1196. cnt^.contentSize := vec2(layout^.max.x - layout^.body.x,
  1197. layout^.max.y - layout^.body.y);
  1198. ctx^.containerStack.idx := ctx^.containerStack.idx - 1;
  1199. ctx^.layoutStack.idx := ctx^.layoutStack.idx - 1;
  1200. popId(ctx)
  1201. END popContainer;
  1202. PROCEDURE beginRootContainer(ctx : ContextPtr; cnt : ContainerPtr);
  1203. BEGIN
  1204. ctx^.containerStack.items[ctx^.containerStack.idx] := cnt;
  1205. ctx^.containerStack.idx := ctx^.containerStack.idx + 1;
  1206. ctx^.rootList.items[ctx^.rootList.idx] := cnt;
  1207. ctx^.rootList.idx := ctx^.rootList.idx + 1;
  1208. cnt^.head := pushJump(ctx, NIL);
  1209. IF rectOverlapsVec2(cnt^.rect, ctx^.mousePos) AND
  1210. ((ctx^.nextHoverRoot = NIL) OR
  1211. (cnt^.zindex > ctx^.nextHoverRoot^.zindex)) THEN
  1212. ctx^.nextHoverRoot := cnt
  1213. END;
  1214. (* clipping is reset here directly (not intersected) so that a root
  1215. container nested in another is not clipped to the outer one *)
  1216. ctx^.clipStack.items[ctx^.clipStack.idx] := unclippedRect;
  1217. ctx^.clipStack.idx := ctx^.clipStack.idx + 1
  1218. END beginRootContainer;
  1219. PROCEDURE endRootContainer(ctx : ContextPtr);
  1220. VAR cnt : ContainerPtr;
  1221. jp : JumpCommandPtr;
  1222. BEGIN
  1223. cnt := getCurrentContainer(ctx);
  1224. cnt^.tail := pushJump(ctx, NIL);
  1225. jp := CAST(JumpCommandPtr, cnt^.head);
  1226. jp^.dst := ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx);
  1227. popClipRect(ctx);
  1228. popContainer(ctx)
  1229. END endRootContainer;
  1230. (*========================================================================*)
  1231. (* Window *)
  1232. (*========================================================================*)
  1233. PROCEDURE beginWindowEx(ctx : ContextPtr; title : ARRAY OF CHAR;
  1234. r : Rect; opt : INTEGER) : INTEGER;
  1235. VAR body : Rect;
  1236. id : Id;
  1237. cnt : ContainerPtr;
  1238. tr : Rect;
  1239. sz : INTEGER;
  1240. rid : Id;
  1241. rr : Rect;
  1242. layout : LayoutPtr;
  1243. BEGIN
  1244. id := getId(ctx, ADR(title), StrLenI(title));
  1245. cnt := getContainerById(ctx, id, opt);
  1246. IF (cnt = NIL) OR (cnt^.open = 0) THEN RETURN 0 END;
  1247. ctx^.idStack.items[ctx^.idStack.idx] := id;
  1248. ctx^.idStack.idx := ctx^.idStack.idx + 1;
  1249. IF cnt^.rect.w = 0 THEN cnt^.rect := r END;
  1250. beginRootContainer(ctx, cnt);
  1251. body := cnt^.rect;
  1252. IF HasNoOpt(opt, OPT_NOFRAME) THEN
  1253. DrawFrameBy(ctx, body, COLOR_WINDOWBG)
  1254. END;
  1255. IF HasNoOpt(opt, OPT_NOTITLE) THEN
  1256. tr := body;
  1257. tr.h := ctx^.style^.titleHeight;
  1258. DrawFrameBy(ctx, tr, COLOR_TITLEBG);
  1259. rid := IdOf(ctx, "!title");
  1260. updateControl(ctx, rid, tr, opt);
  1261. drawControlText(ctx, title, tr, COLOR_TITLETEXT, opt);
  1262. IF (rid = ctx^.focus) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
  1263. cnt^.rect.x := cnt^.rect.x + ctx^.mouseDelta.x;
  1264. cnt^.rect.y := cnt^.rect.y + ctx^.mouseDelta.y
  1265. END;
  1266. body.y := body.y + tr.h;
  1267. body.h := body.h - tr.h;
  1268. IF HasNoOpt(opt, OPT_NOCLOSE) THEN
  1269. rid := IdOf(ctx, "!close");
  1270. rr := rect(tr.x + tr.w - tr.h, tr.y, tr.h, tr.h);
  1271. tr.w := tr.w - rr.w;
  1272. drawIcon(ctx, ICON_CLOSE, rr, ctx^.style^.colors[COLOR_TITLETEXT]);
  1273. updateControl(ctx, rid, rr, opt);
  1274. IF (ctx^.mousePressed = MOUSE_LEFT) AND (rid = ctx^.focus) THEN
  1275. cnt^.open := 0
  1276. END
  1277. END
  1278. END;
  1279. pushContainerBody(ctx, cnt, body, opt);
  1280. IF HasNoOpt(opt, OPT_NORESIZE) THEN
  1281. sz := ctx^.style^.titleHeight;
  1282. rid := IdOf(ctx, "!resize");
  1283. rr := rect(body.x + body.w - sz, body.y + body.h - sz, sz, sz);
  1284. updateControl(ctx, rid, rr, opt);
  1285. IF (rid = ctx^.focus) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
  1286. cnt^.rect.w := max(96, cnt^.rect.w + ctx^.mouseDelta.x);
  1287. cnt^.rect.h := max(64, cnt^.rect.h + ctx^.mouseDelta.y)
  1288. END
  1289. END;
  1290. IF HasOpt(opt, OPT_AUTOSIZE) THEN
  1291. layout := getLayout(ctx);
  1292. rr := layout^.body;
  1293. cnt^.rect.w := cnt^.contentSize.x + (cnt^.rect.w - rr.w);
  1294. cnt^.rect.h := cnt^.contentSize.y + (cnt^.rect.h - rr.h)
  1295. END;
  1296. IF HasOpt(opt, OPT_POPUP) AND (ctx^.mousePressed # 0) AND
  1297. (ctx^.hoverRoot # cnt) THEN
  1298. cnt^.open := 0
  1299. END;
  1300. pushClipRect(ctx, cnt^.body);
  1301. RETURN RES_ACTIVE
  1302. END beginWindowEx;
  1303. PROCEDURE endWindow(ctx : ContextPtr);
  1304. BEGIN
  1305. popClipRect(ctx);
  1306. endRootContainer(ctx)
  1307. END endWindow;
  1308. PROCEDURE openPopup(ctx : ContextPtr; name : ARRAY OF CHAR);
  1309. VAR cnt : ContainerPtr;
  1310. BEGIN
  1311. cnt := getContainer(ctx, name);
  1312. ctx^.hoverRoot := cnt;
  1313. ctx^.nextHoverRoot := cnt;
  1314. cnt^.rect := rect(ctx^.mousePos.x, ctx^.mousePos.y, 1, 1);
  1315. cnt^.open := 1;
  1316. bringToFront(ctx, cnt)
  1317. END openPopup;
  1318. PROCEDURE beginPopup(ctx : ContextPtr; name : ARRAY OF CHAR) : INTEGER;
  1319. VAR opt : INTEGER;
  1320. BEGIN
  1321. opt := SetFlag(SetFlag(SetFlag(SetFlag(SetFlag(OPT_POPUP, OPT_AUTOSIZE),
  1322. OPT_NORESIZE), OPT_NOSCROLL), OPT_NOTITLE), OPT_CLOSED);
  1323. RETURN beginWindowEx(ctx, name, rect(0, 0, 0, 0), opt)
  1324. END beginPopup;
  1325. PROCEDURE endPopup(ctx : ContextPtr);
  1326. BEGIN
  1327. endWindow(ctx)
  1328. END endPopup;
  1329. PROCEDURE beginPanelEx(ctx : ContextPtr; name : ARRAY OF CHAR;
  1330. opt : INTEGER);
  1331. VAR cnt : ContainerPtr;
  1332. BEGIN
  1333. pushId(ctx, ADR(name), StrLenI(name));
  1334. cnt := getContainerById(ctx, ctx^.lastId, opt);
  1335. cnt^.rect := layoutNext(ctx);
  1336. IF HasNoOpt(opt, OPT_NOFRAME) THEN
  1337. DrawFrameBy(ctx, cnt^.rect, COLOR_PANELBG)
  1338. END;
  1339. ctx^.containerStack.items[ctx^.containerStack.idx] := cnt;
  1340. ctx^.containerStack.idx := ctx^.containerStack.idx + 1;
  1341. pushContainerBody(ctx, cnt, cnt^.rect, opt);
  1342. pushClipRect(ctx, cnt^.body)
  1343. END beginPanelEx;
  1344. PROCEDURE endPanel(ctx : ContextPtr);
  1345. BEGIN
  1346. popClipRect(ctx);
  1347. popContainer(ctx)
  1348. END endPanel;
  1349. (*========================================================================*)
  1350. (* Input handlers *)
  1351. (*========================================================================*)
  1352. PROCEDURE inputMousemove(ctx : ContextPtr; x, y : INTEGER);
  1353. BEGIN
  1354. ctx^.mousePos := vec2(x, y)
  1355. END inputMousemove;
  1356. PROCEDURE inputMousedown(ctx : ContextPtr; x, y, btn : INTEGER);
  1357. BEGIN
  1358. inputMousemove(ctx, x, y);
  1359. ctx^.mouseDown := SetFlag(ctx^.mouseDown, btn);
  1360. ctx^.mousePressed := SetFlag(ctx^.mousePressed, btn)
  1361. END inputMousedown;
  1362. PROCEDURE inputMouseup(ctx : ContextPtr; x, y, btn : INTEGER);
  1363. BEGIN
  1364. inputMousemove(ctx, x, y);
  1365. ctx^.mouseDown := ClearFlag(ctx^.mouseDown, btn)
  1366. END inputMouseup;
  1367. PROCEDURE inputScroll(ctx : ContextPtr; x, y : INTEGER);
  1368. BEGIN
  1369. ctx^.scrollDelta.x := ctx^.scrollDelta.x + x;
  1370. ctx^.scrollDelta.y := ctx^.scrollDelta.y + y
  1371. END inputScroll;
  1372. PROCEDURE inputKeydown(ctx : ContextPtr; key : INTEGER);
  1373. BEGIN
  1374. ctx^.keyPressed := SetFlag(ctx^.keyPressed, key);
  1375. ctx^.keyDown := SetFlag(ctx^.keyDown, key)
  1376. END inputKeydown;
  1377. PROCEDURE inputKeyup(ctx : ContextPtr; key : INTEGER);
  1378. BEGIN
  1379. ctx^.keyDown := ClearFlag(ctx^.keyDown, key)
  1380. END inputKeyup;
  1381. PROCEDURE inputText(ctx : ContextPtr; txt : ARRAY OF CHAR);
  1382. VAR len, size, i : INTEGER;
  1383. BEGIN
  1384. len := StrLenI(ctx^.inputText);
  1385. size := StrLenI(txt) + 1;
  1386. IF (len + size) <= 32 THEN
  1387. FOR i := 0 TO size - 1 DO
  1388. ctx^.inputText[len + i] := txt[i]
  1389. END
  1390. END
  1391. END inputText;
  1392. (*========================================================================*)
  1393. (* end() *)
  1394. (*========================================================================*)
  1395. PROCEDURE sortRoots(ctx : ContextPtr);
  1396. VAR n, i, j : INTEGER;
  1397. tmp : ContainerPtr;
  1398. items : RootArrayPtr;
  1399. BEGIN
  1400. n := ctx^.rootList.idx;
  1401. items := ADR(ctx^.rootList.items);
  1402. FOR i := 1 TO n - 1 DO
  1403. tmp := items^[i];
  1404. j := i - 1;
  1405. WHILE (j >= 0) AND (items^[j]^.zindex > tmp^.zindex) DO
  1406. items^[j + 1] := items^[j];
  1407. j := j - 1
  1408. END;
  1409. items^[j + 1] := tmp
  1410. END
  1411. END sortRoots;
  1412. PROCEDURE end(ctx : ContextPtr);
  1413. VAR i, n : INTEGER;
  1414. cnt, prev : ContainerPtr;
  1415. items : RootArrayPtr;
  1416. firstCmd : CommandPtr;
  1417. jp : JumpCommandPtr;
  1418. BEGIN
  1419. IF ctx^.scrollTarget # NIL THEN
  1420. ctx^.scrollTarget^.scroll.x := ctx^.scrollTarget^.scroll.x +
  1421. ctx^.scrollDelta.x;
  1422. ctx^.scrollTarget^.scroll.y := ctx^.scrollTarget^.scroll.y +
  1423. ctx^.scrollDelta.y
  1424. END;
  1425. IF ctx^.updatedFocus = 0 THEN ctx^.focus := 0 END;
  1426. ctx^.updatedFocus := 0;
  1427. IF (ctx^.mousePressed # 0) AND (ctx^.nextHoverRoot # NIL) AND
  1428. (ctx^.nextHoverRoot^.zindex < ctx^.lastZindex) AND
  1429. (ctx^.nextHoverRoot^.zindex >= 0) THEN
  1430. bringToFront(ctx, ctx^.nextHoverRoot)
  1431. END;
  1432. ctx^.keyPressed := 0;
  1433. ctx^.inputText[0] := 0C;
  1434. ctx^.mousePressed := 0;
  1435. ctx^.scrollDelta := vec2(0, 0);
  1436. ctx^.lastMousePos := ctx^.mousePos;
  1437. sortRoots(ctx);
  1438. n := ctx^.rootList.idx;
  1439. items := ADR(ctx^.rootList.items);
  1440. FOR i := 0 TO n - 1 DO
  1441. cnt := items^[i];
  1442. IF i = 0 THEN
  1443. firstCmd := CAST(CommandPtr, ADR(ctx^.commandList.items));
  1444. jp := CAST(JumpCommandPtr, firstCmd);
  1445. jp^.dst := ADDADR(CAST(ADDRESS, cnt^.head), SIZE(JumpCommand))
  1446. ELSE
  1447. prev := items^[i - 1];
  1448. jp := CAST(JumpCommandPtr, prev^.tail);
  1449. jp^.dst := ADDADR(CAST(ADDRESS, cnt^.head), SIZE(JumpCommand))
  1450. END;
  1451. IF i = n - 1 THEN
  1452. jp := CAST(JumpCommandPtr, cnt^.tail);
  1453. jp^.dst := ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx)
  1454. END
  1455. END
  1456. END end;
  1457. (*========================================================================*)
  1458. (* Convenience wrappers (the C macros) *)
  1459. (*========================================================================*)
  1460. PROCEDURE button(ctx : ContextPtr; lbl : ARRAY OF CHAR) : INTEGER;
  1461. BEGIN
  1462. RETURN buttonEx(ctx, lbl, 0, OPT_ALIGNCENTER)
  1463. END button;
  1464. PROCEDURE textbox(ctx : ContextPtr; buf : ADDRESS; bufsz : INTEGER) : INTEGER;
  1465. BEGIN
  1466. RETURN textboxEx(ctx, buf, bufsz, 0)
  1467. END textbox;
  1468. PROCEDURE slider(ctx : ContextPtr; value : RealPtr;
  1469. low, high : Real) : INTEGER;
  1470. BEGIN
  1471. RETURN sliderEx(ctx, value, low, high, 0.0, SLIDER_FMT, OPT_ALIGNCENTER)
  1472. END slider;
  1473. PROCEDURE number(ctx : ContextPtr; value : RealPtr;
  1474. step : Real) : INTEGER;
  1475. BEGIN
  1476. RETURN numberEx(ctx, value, step, SLIDER_FMT, OPT_ALIGNCENTER)
  1477. END number;
  1478. PROCEDURE header(ctx : ContextPtr; lbl : ARRAY OF CHAR) : INTEGER;
  1479. BEGIN
  1480. RETURN headerEx(ctx, lbl, 0)
  1481. END header;
  1482. PROCEDURE beginTreenode(ctx : ContextPtr; lbl : ARRAY OF CHAR) : INTEGER;
  1483. BEGIN
  1484. RETURN beginTreenodeEx(ctx, lbl, 0)
  1485. END beginTreenode;
  1486. PROCEDURE beginWindow(ctx : ContextPtr; title : ARRAY OF CHAR;
  1487. r : Rect) : INTEGER;
  1488. BEGIN
  1489. RETURN beginWindowEx(ctx, title, r, 0)
  1490. END beginWindow;
  1491. PROCEDURE beginPanel(ctx : ContextPtr; name : ARRAY OF CHAR);
  1492. BEGIN
  1493. beginPanelEx(ctx, name, 0)
  1494. END beginPanel;
  1495. (*========================================================================*)
  1496. (* Module initialization *)
  1497. (*========================================================================*)
  1498. BEGIN
  1499. negBigCoord := 0 - 16777216;
  1500. unclippedRect := rect(0, 0, 16777216, 16777216);
  1501. InitDefaultStyle
  1502. END microui.