| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685 |
- IMPLEMENTATION MODULE microui;
- (* Modula-2 port of microui v2.02 by rxi (MIT license).
- Ported to GNU Modula-2 (gm2 -fiso).
- The implementation follows microui.c as closely as the ISO language and
- the GM2 16.0.1 front end allow:
- - procedure types take a single argument record (see microui.def),
- - the command union is replaced by BaseCommand + CAST to the concrete
- command record,
- - bitwise operations go through microuiHelpers (ISO has no CARDINAL
- AND/OR/XOR/SHIFT). *)
- FROM SYSTEM IMPORT ADDRESS, ADR, CAST, ADDADR, BYTE;
- FROM microuiHelpers IMPORT BITAND, BITOR, BITXOR, BITNOT,
- StrLen, CopyBytes,
- IntToReal, CardToReal,
- RealToStr, StrToReal;
- CONST
- RELATIVE = 1;
- ABSOLUTE = 2;
- HASH_INITIAL = 2166136261;
- (* Named pointer aliases. GM2 16.0.1 rejects an inline `POINTER TO T` when it
- appears in a formal parameter list or in a CAST; a named type works. *)
- TYPE
- BytePtr = POINTER TO BYTE;
- CharPtr = POINTER TO CHAR;
- LayoutPtr = POINTER TO Layout;
- StylePtr = POINTER TO Style;
- PoolItemPtr = POINTER TO ARRAY [0..0] OF PoolItem;
- CharArrayPtr = POINTER TO ARRAY [0..0] OF CHAR;
- RootArrayPtr = POINTER TO ARRAY [0..ROOTLIST_SIZE - 1] OF ContainerPtr;
- JumpCommandPtr = POINTER TO JumpCommand;
- ClipCommandPtr = POINTER TO ClipCommand;
- RectCommandPtr = POINTER TO RectCommand;
- TextCommandPtr = POINTER TO TextCommand;
- IconCommandPtr = POINTER TO IconCommand;
- VAR
- negBigCoord : INTEGER;
- unclippedRect : Rect;
- defaultStyle : Style;
- (*========================================================================*)
- (* Small integer helpers (ISO has no bitwise CARDINAL operators) *)
- (*========================================================================*)
- PROCEDURE min(a, b : INTEGER) : INTEGER;
- BEGIN IF a < b THEN RETURN a ELSE RETURN b END END min;
- PROCEDURE max(a, b : INTEGER) : INTEGER;
- BEGIN IF a > b THEN RETURN a ELSE RETURN b END END max;
- PROCEDURE clamp(x, a, b : INTEGER) : INTEGER;
- BEGIN RETURN min(b, max(a, x)) END clamp;
- PROCEDURE clampR(x, a, b : Real) : Real;
- BEGIN
- IF x < a THEN RETURN a END;
- IF x > b THEN RETURN b END;
- RETURN x
- END clampR;
- PROCEDURE BitAndI(a, b : INTEGER) : INTEGER;
- BEGIN RETURN VAL(INTEGER, BITAND(VAL(CARDINAL, a), VAL(CARDINAL, b))) END BitAndI;
- PROCEDURE BitOrI(a, b : INTEGER) : INTEGER;
- BEGIN RETURN VAL(INTEGER, BITOR(VAL(CARDINAL, a), VAL(CARDINAL, b))) END BitOrI;
- PROCEDURE BitNotI(a : INTEGER) : INTEGER;
- BEGIN RETURN VAL(INTEGER, BITNOT(VAL(CARDINAL, a))) END BitNotI;
- PROCEDURE HasOpt(opt, flag : INTEGER) : BOOLEAN;
- BEGIN RETURN BITAND(VAL(CARDINAL, opt), VAL(CARDINAL, flag)) # 0 END HasOpt;
- PROCEDURE HasNoOpt(opt, flag : INTEGER) : BOOLEAN;
- BEGIN RETURN BITAND(VAL(CARDINAL, opt), VAL(CARDINAL, flag)) = 0 END HasNoOpt;
- PROCEDURE SetFlag(res, flag : INTEGER) : INTEGER;
- BEGIN RETURN BitOrI(res, flag) END SetFlag;
- PROCEDURE ClearFlag(res, flag : INTEGER) : INTEGER;
- BEGIN RETURN BitAndI(res, BitNotI(flag)) END ClearFlag;
- PROCEDURE FillZero(dst : ADDRESS; len : CARDINAL);
- VAR p : BytePtr;
- i : CARDINAL;
- BEGIN
- p := CAST(BytePtr, dst);
- IF len > 0 THEN
- FOR i := 0 TO len - 1 DO
- p^ := VAL(BYTE, 0);
- p := ADDADR(p, 1)
- END
- END
- END FillZero;
- (*========================================================================*)
- (* Geometry helpers *)
- (*========================================================================*)
- PROCEDURE expandRect(r : Rect; n : INTEGER) : Rect;
- BEGIN
- RETURN rect(r.x - n, r.y - n, r.w + n * 2, r.h + n * 2)
- END expandRect;
- PROCEDURE intersectRects(r1, r2 : Rect) : Rect;
- VAR x1, y1, x2, y2 : INTEGER;
- BEGIN
- x1 := max(r1.x, r2.x);
- y1 := max(r1.y, r2.y);
- x2 := min(r1.x + r1.w, r2.x + r2.w);
- y2 := min(r1.y + r1.h, r2.y + r2.h);
- IF x2 < x1 THEN x2 := x1 END;
- IF y2 < y1 THEN y2 := y1 END;
- RETURN rect(x1, y1, x2 - x1, y2 - y1)
- END intersectRects;
- PROCEDURE rectOverlapsVec2(r : Rect; p : Vec2) : BOOLEAN;
- BEGIN
- RETURN (p.x >= r.x) AND (p.x < r.x + r.w) AND
- (p.y >= r.y) AND (p.y < r.y + r.h)
- END rectOverlapsVec2;
- (*========================================================================*)
- (* Hash (32-bit FNV-1a) *)
- (*========================================================================*)
- PROCEDURE hash(VAR h : Id; data : ADDRESS; size : INTEGER);
- VAR p : BytePtr;
- i : INTEGER;
- BEGIN
- p := CAST(BytePtr, data);
- IF size > 0 THEN
- FOR i := 1 TO size DO
- h := BITXOR(h, VAL(CARDINAL, p^)) * 16777619;
- p := ADDADR(p, 1)
- END
- END
- END hash;
- PROCEDURE StrLenI(s : ARRAY OF CHAR) : INTEGER;
- BEGIN
- RETURN VAL(INTEGER, StrLen(s))
- END StrLenI;
- PROCEDURE CStrLen(p : ADDRESS) : INTEGER;
- VAR q : CharPtr;
- n : INTEGER;
- BEGIN
- q := CAST(CharPtr, p);
- n := 0;
- WHILE q^ # 0C DO
- n := n + 1;
- q := ADDADR(q, 1)
- END;
- RETURN n
- END CStrLen;
- (*========================================================================*)
- (* Callback adapters *)
- (*========================================================================*)
- PROCEDURE TextWidth(ctx : ContextPtr; font : Font;
- str : ADDRESS; len : INTEGER) : INTEGER;
- VAR a : TextWidthArgs;
- p : TextWidthProc;
- BEGIN
- a.ctx := CAST(ADDRESS, ctx);
- a.font := font;
- a.str := str;
- a.len := len;
- p := ctx^.textWidth;
- RETURN p(a)
- END TextWidth;
- PROCEDURE TextHeight(ctx : ContextPtr; font : Font) : INTEGER;
- VAR a : TextHeightArgs;
- p : TextHeightProc;
- BEGIN
- a.ctx := CAST(ADDRESS, ctx);
- a.font := font;
- p := ctx^.textHeight;
- RETURN p(a)
- END TextHeight;
- PROCEDURE DrawFrameBy(ctx : ContextPtr; r : Rect; colorid : INTEGER);
- VAR a : FrameArgs;
- p : DrawFrameProc;
- BEGIN
- a.ctx := CAST(ADDRESS, ctx);
- a.rect := r;
- a.colorid := colorid;
- p := ctx^.drawFrame;
- p(a)
- END DrawFrameBy;
- PROCEDURE IdOf(ctx : ContextPtr; s : ARRAY OF CHAR) : Id;
- BEGIN
- RETURN getId(ctx, ADR(s), StrLenI(s))
- END IdOf;
- (*========================================================================*)
- (* Constructors *)
- (*========================================================================*)
- PROCEDURE vec2(x, y : INTEGER) : Vec2;
- VAR v : Vec2;
- BEGIN v.x := x; v.y := y; RETURN v END vec2;
- PROCEDURE rect(x, y, w, h : INTEGER) : Rect;
- VAR r : Rect;
- BEGIN r.x := x; r.y := y; r.w := w; r.h := h; RETURN r END rect;
- PROCEDURE color(r, g, b, a : INTEGER) : Color;
- VAR c : Color;
- BEGIN
- c.r := VAL(BYTE, r);
- c.g := VAL(BYTE, g);
- c.b := VAL(BYTE, b);
- c.a := VAL(BYTE, a);
- RETURN c
- END color;
- (*========================================================================*)
- (* Default style / frame *)
- (*========================================================================*)
- PROCEDURE InitDefaultStyle;
- BEGIN
- defaultStyle.font := NIL;
- defaultStyle.size := vec2(68, 10);
- defaultStyle.padding := 5;
- defaultStyle.spacing := 4;
- defaultStyle.indent := 24;
- defaultStyle.titleHeight := 24;
- defaultStyle.scrollbarSize := 12;
- defaultStyle.thumbSize := 8;
- defaultStyle.colors[COLOR_TEXT] := color(230, 230, 230, 255);
- defaultStyle.colors[COLOR_BORDER] := color(25, 25, 25, 255);
- defaultStyle.colors[COLOR_WINDOWBG] := color(50, 50, 50, 255);
- defaultStyle.colors[COLOR_TITLEBG] := color(25, 25, 25, 255);
- defaultStyle.colors[COLOR_TITLETEXT] := color(240, 240, 240, 255);
- defaultStyle.colors[COLOR_PANELBG] := color(0, 0, 0, 0);
- defaultStyle.colors[COLOR_BUTTON] := color(75, 75, 75, 255);
- defaultStyle.colors[COLOR_BUTTONHOVER] := color(95, 95, 95, 255);
- defaultStyle.colors[COLOR_BUTTONFOCUS] := color(115, 115, 115, 255);
- defaultStyle.colors[COLOR_BASE] := color(30, 30, 30, 255);
- defaultStyle.colors[COLOR_BASEHOVER] := color(35, 35, 35, 255);
- defaultStyle.colors[COLOR_BASEFOCUS] := color(40, 40, 40, 255);
- defaultStyle.colors[COLOR_SCROLLBASE] := color(43, 43, 43, 255);
- defaultStyle.colors[COLOR_SCROLLTHUMB] := color(30, 30, 30, 255)
- END InitDefaultStyle;
- PROCEDURE defaultDrawFrame(VAR args : FrameArgs);
- VAR ctx : ContextPtr;
- r : Rect;
- colorid : INTEGER;
- BEGIN
- ctx := CAST(ContextPtr, args.ctx);
- r := args.rect;
- colorid := args.colorid;
- drawRect(ctx, r, ctx^.style^.colors[colorid]);
- IF (colorid = COLOR_SCROLLBASE) OR
- (colorid = COLOR_SCROLLTHUMB) OR
- (colorid = COLOR_TITLEBG) THEN
- RETURN
- END;
- IF ctx^.style^.colors[COLOR_BORDER].a # VAL(BYTE, 0) THEN
- drawBox(ctx, expandRect(r, 1), ctx^.style^.colors[COLOR_BORDER])
- END
- END defaultDrawFrame;
- (*========================================================================*)
- (* Core *)
- (*========================================================================*)
- PROCEDURE init(ctx : ContextPtr);
- BEGIN
- FillZero(CAST(ADDRESS, ctx), SIZE(Context));
- ctx^.drawFrame := defaultDrawFrame;
- ctx^._style := defaultStyle;
- ctx^.style := ADR(ctx^._style)
- END init;
- PROCEDURE setFocus(ctx : ContextPtr; id : Id);
- BEGIN
- ctx^.focus := id;
- ctx^.updatedFocus := 1
- END setFocus;
- PROCEDURE begin(ctx : ContextPtr);
- BEGIN
- ctx^.commandList.idx := 0;
- ctx^.rootList.idx := 0;
- ctx^.scrollTarget := NIL;
- ctx^.hoverRoot := ctx^.nextHoverRoot;
- ctx^.nextHoverRoot := NIL;
- ctx^.mouseDelta.x := ctx^.mousePos.x - ctx^.lastMousePos.x;
- ctx^.mouseDelta.y := ctx^.mousePos.y - ctx^.lastMousePos.y;
- ctx^.frame := ctx^.frame + 1
- END begin;
- PROCEDURE getId(ctx : ContextPtr; data : ADDRESS; size : INTEGER) : Id;
- VAR idx : INTEGER;
- res : Id;
- BEGIN
- idx := ctx^.idStack.idx;
- IF idx > 0 THEN
- res := ctx^.idStack.items[idx - 1]
- ELSE
- res := HASH_INITIAL
- END;
- hash(res, data, size);
- ctx^.lastId := res;
- RETURN res
- END getId;
- PROCEDURE pushId(ctx : ContextPtr; data : ADDRESS; size : INTEGER);
- BEGIN
- ctx^.idStack.items[ctx^.idStack.idx] := getId(ctx, data, size);
- ctx^.idStack.idx := ctx^.idStack.idx + 1
- END pushId;
- PROCEDURE popId(ctx : ContextPtr);
- BEGIN
- ctx^.idStack.idx := ctx^.idStack.idx - 1
- END popId;
- PROCEDURE pushClipRect(ctx : ContextPtr; r : Rect);
- VAR last : Rect;
- BEGIN
- last := getClipRect(ctx);
- ctx^.clipStack.items[ctx^.clipStack.idx] := intersectRects(r, last);
- ctx^.clipStack.idx := ctx^.clipStack.idx + 1
- END pushClipRect;
- PROCEDURE popClipRect(ctx : ContextPtr);
- BEGIN
- ctx^.clipStack.idx := ctx^.clipStack.idx - 1
- END popClipRect;
- PROCEDURE getClipRect(ctx : ContextPtr) : Rect;
- BEGIN
- RETURN ctx^.clipStack.items[ctx^.clipStack.idx - 1]
- END getClipRect;
- PROCEDURE checkClip(ctx : ContextPtr; r : Rect) : INTEGER;
- VAR cr : Rect;
- BEGIN
- cr := getClipRect(ctx);
- IF (r.x > cr.x + cr.w) OR (r.x + r.w < cr.x) OR
- (r.y > cr.y + cr.h) OR (r.y + r.h < cr.y) THEN
- RETURN CLIP_ALL
- END;
- IF (r.x >= cr.x) AND (r.x + r.w <= cr.x + cr.w) AND
- (r.y >= cr.y) AND (r.y + r.h <= cr.y + cr.h) THEN
- RETURN 0
- END;
- RETURN CLIP_PART
- END checkClip;
- PROCEDURE getCurrentContainer(ctx : ContextPtr) : ContainerPtr;
- BEGIN
- RETURN ctx^.containerStack.items[ctx^.containerStack.idx - 1]
- END getCurrentContainer;
- PROCEDURE bringToFront(ctx : ContextPtr; cnt : ContainerPtr);
- BEGIN
- ctx^.lastZindex := ctx^.lastZindex + 1;
- cnt^.zindex := ctx^.lastZindex
- END bringToFront;
- (*========================================================================*)
- (* Pool *)
- (*========================================================================*)
- PROCEDURE poolInit(ctx : ContextPtr; items : ADDRESS; len : INTEGER;
- id : Id) : INTEGER;
- VAR pool : PoolItemPtr;
- i, n, f : INTEGER;
- BEGIN
- pool := CAST(PoolItemPtr, items);
- n := -1;
- f := ctx^.frame;
- FOR i := 0 TO len - 1 DO
- IF pool^[i].lastUpdate < f THEN
- f := pool^[i].lastUpdate;
- n := i
- END
- END;
- IF n < 0 THEN n := 0 END; (* pool full: reuse slot 0 rather than crash *)
- pool^[n].id := id;
- poolUpdate(ctx, items, n);
- RETURN n
- END poolInit;
- PROCEDURE poolGet(ctx : ContextPtr; items : ADDRESS; len : INTEGER;
- id : Id) : INTEGER;
- VAR pool : PoolItemPtr;
- i : INTEGER;
- BEGIN
- pool := CAST(PoolItemPtr, items);
- FOR i := 0 TO len - 1 DO
- IF pool^[i].id = id THEN RETURN i END
- END;
- RETURN -1
- END poolGet;
- PROCEDURE poolUpdate(ctx : ContextPtr; items : ADDRESS; idx : INTEGER);
- VAR pool : PoolItemPtr;
- BEGIN
- pool := CAST(PoolItemPtr, items);
- pool^[idx].lastUpdate := ctx^.frame
- END poolUpdate;
- (*========================================================================*)
- (* Container lookup *)
- (*========================================================================*)
- PROCEDURE getContainerById(ctx : ContextPtr; id : Id; opt : INTEGER) : ContainerPtr;
- VAR cnt : ContainerPtr;
- idx : INTEGER;
- BEGIN
- idx := poolGet(ctx, ADR(ctx^.containerPool), CONTAINERPOOL_SIZE, id);
- IF idx >= 0 THEN
- IF (ctx^.containers[idx].open # 0) OR HasNoOpt(opt, OPT_CLOSED) THEN
- poolUpdate(ctx, ADR(ctx^.containerPool), idx)
- END;
- RETURN ADR(ctx^.containers[idx])
- END;
- IF HasOpt(opt, OPT_CLOSED) THEN RETURN NIL END;
- idx := poolInit(ctx, ADR(ctx^.containerPool), CONTAINERPOOL_SIZE, id);
- cnt := ADR(ctx^.containers[idx]);
- FillZero(CAST(ADDRESS, cnt), SIZE(Container));
- cnt^.open := 1;
- bringToFront(ctx, cnt);
- RETURN cnt
- END getContainerById;
- PROCEDURE getContainer(ctx : ContextPtr; name : ARRAY OF CHAR) : ContainerPtr;
- VAR id : Id;
- BEGIN
- id := getId(ctx, ADR(name), StrLenI(name));
- RETURN getContainerById(ctx, id, 0)
- END getContainer;
- (*========================================================================*)
- (* Command list *)
- (*========================================================================*)
- PROCEDURE pushCommand(ctx : ContextPtr; type, size : INTEGER) : CommandPtr;
- VAR cmd : CommandPtr;
- BEGIN
- cmd := CAST(CommandPtr, ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx));
- cmd^.type := type;
- cmd^.size := size;
- ctx^.commandList.idx := ctx^.commandList.idx + size;
- RETURN cmd
- END pushCommand;
- PROCEDURE nextCommand(ctx : ContextPtr; VAR cmd : CommandPtr) : INTEGER;
- VAR endAddr : ADDRESS;
- jp : JumpCommandPtr;
- BEGIN
- endAddr := ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx);
- IF cmd # NIL THEN
- cmd := CAST(CommandPtr, ADDADR(CAST(ADDRESS, cmd), cmd^.size))
- ELSE
- cmd := CAST(CommandPtr, ADR(ctx^.commandList.items))
- END;
- WHILE CAST(ADDRESS, cmd) # endAddr DO
- IF cmd^.type # COMMAND_JUMP THEN RETURN 1 END;
- jp := CAST(JumpCommandPtr, cmd);
- cmd := CAST(CommandPtr, jp^.dst)
- END;
- RETURN 0
- END nextCommand;
- PROCEDURE pushJump(ctx : ContextPtr; dst : CommandPtr) : CommandPtr;
- VAR cmd : CommandPtr;
- jp : JumpCommandPtr;
- BEGIN
- cmd := pushCommand(ctx, COMMAND_JUMP, SIZE(JumpCommand));
- jp := CAST(JumpCommandPtr, cmd);
- jp^.dst := dst;
- RETURN cmd
- END pushJump;
- PROCEDURE setClip(ctx : ContextPtr; r : Rect);
- VAR cmd : CommandPtr;
- cp : ClipCommandPtr;
- BEGIN
- cmd := pushCommand(ctx, COMMAND_CLIP, SIZE(ClipCommand));
- cp := CAST(ClipCommandPtr, cmd);
- cp^.rect := r
- END setClip;
- PROCEDURE drawRect(ctx : ContextPtr; r : Rect; c : Color);
- VAR cmd : CommandPtr;
- ir : Rect;
- rp : RectCommandPtr;
- BEGIN
- ir := intersectRects(r, getClipRect(ctx));
- IF (ir.w > 0) AND (ir.h > 0) THEN
- cmd := pushCommand(ctx, COMMAND_RECT, SIZE(RectCommand));
- rp := CAST(RectCommandPtr, cmd);
- rp^.rect := ir;
- rp^.color := c
- END
- END drawRect;
- PROCEDURE drawBox(ctx : ContextPtr; r : Rect; c : Color);
- BEGIN
- drawRect(ctx, rect(r.x + 1, r.y, r.w - 2, 1), c);
- drawRect(ctx, rect(r.x + 1, r.y + r.h - 1, r.w - 2, 1), c);
- drawRect(ctx, rect(r.x, r.y, 1, r.h), c);
- drawRect(ctx, rect(r.x + r.w - 1, r.y, 1, r.h), c)
- END drawBox;
- PROCEDURE drawText(ctx : ContextPtr; font : Font; str : ADDRESS; len : INTEGER;
- pos : Vec2; c : Color);
- VAR cmd : CommandPtr;
- r : Rect;
- clipped : INTEGER;
- dstAddr : ADDRESS;
- tc : TextCommandPtr;
- cp : CharPtr;
- BEGIN
- r := rect(pos.x, pos.y, TextWidth(ctx, font, str, len),
- TextHeight(ctx, font));
- clipped := checkClip(ctx, r);
- IF clipped = CLIP_ALL THEN RETURN END;
- IF clipped = CLIP_PART THEN setClip(ctx, getClipRect(ctx)) END;
- IF len < 0 THEN
- len := CStrLen(str)
- END;
- cmd := pushCommand(ctx, COMMAND_TEXT,
- VAL(INTEGER, SIZE(TextCommand)) + len + 1);
- dstAddr := ADDADR(CAST(ADDRESS, cmd), SIZE(TextCommand));
- CopyBytes(str, dstAddr, VAL(CARDINAL, len));
- cp := CAST(CharPtr, ADDADR(dstAddr, VAL(CARDINAL, len)));
- cp^ := 0C;
- tc := CAST(TextCommandPtr, cmd);
- tc^.pos := pos;
- tc^.color := c;
- tc^.font := font;
- IF clipped # 0 THEN setClip(ctx, unclippedRect) END
- END drawText;
- PROCEDURE drawIcon(ctx : ContextPtr; id : INTEGER; r : Rect; c : Color);
- VAR cmd : CommandPtr;
- clipped : INTEGER;
- ip : IconCommandPtr;
- BEGIN
- clipped := checkClip(ctx, r);
- IF clipped = CLIP_ALL THEN RETURN END;
- IF clipped = CLIP_PART THEN setClip(ctx, getClipRect(ctx)) END;
- cmd := pushCommand(ctx, COMMAND_ICON, SIZE(IconCommand));
- ip := CAST(IconCommandPtr, cmd);
- ip^.id := id;
- ip^.rect := r;
- ip^.color := c;
- IF clipped # 0 THEN setClip(ctx, unclippedRect) END
- END drawIcon;
- (*========================================================================*)
- (* Layout *)
- (*========================================================================*)
- PROCEDURE getLayout(ctx : ContextPtr) : LayoutPtr;
- VAR off : CARDINAL;
- BEGIN
- off := VAL(CARDINAL, ctx^.layoutStack.idx - 1) * SIZE(Layout);
- RETURN CAST(LayoutPtr, ADDADR(ADR(ctx^.layoutStack.items), off))
- END getLayout;
- PROCEDURE pushLayout(ctx : ContextPtr; body : Rect; scroll : Vec2);
- VAR layout : LayoutPtr;
- w : INTEGER;
- off : CARDINAL;
- BEGIN
- off := VAL(CARDINAL, ctx^.layoutStack.idx) * SIZE(Layout);
- layout := CAST(LayoutPtr, ADDADR(ADR(ctx^.layoutStack.items), off));
- FillZero(CAST(ADDRESS, layout), SIZE(Layout));
- layout^.body := rect(body.x - scroll.x, body.y - scroll.y, body.w, body.h);
- layout^.max := vec2(negBigCoord, negBigCoord);
- ctx^.layoutStack.idx := ctx^.layoutStack.idx + 1;
- w := 0;
- layoutRow(ctx, 1, ADR(w), 0)
- END pushLayout;
- PROCEDURE layoutRow(ctx : ContextPtr; items : INTEGER;
- widths : ADDRESS; height : INTEGER);
- VAR layout : LayoutPtr;
- src : IntPtr;
- i : INTEGER;
- BEGIN
- layout := getLayout(ctx);
- IF widths # NIL THEN
- src := CAST(IntPtr, widths);
- FOR i := 0 TO items - 1 DO
- layout^.widths[i] := src^;
- src := ADDADR(src, SIZE(INTEGER))
- END
- END;
- layout^.items := items;
- layout^.position := vec2(layout^.indent, layout^.nextRow);
- layout^.size.y := height;
- layout^.itemIndex := 0
- END layoutRow;
- PROCEDURE layoutWidth(ctx : ContextPtr; width : INTEGER);
- VAR layout : LayoutPtr;
- BEGIN
- layout := getLayout(ctx);
- layout^.size.x := width
- END layoutWidth;
- PROCEDURE layoutHeight(ctx : ContextPtr; height : INTEGER);
- VAR layout : LayoutPtr;
- BEGIN
- layout := getLayout(ctx);
- layout^.size.y := height
- END layoutHeight;
- PROCEDURE layoutBeginColumn(ctx : ContextPtr);
- BEGIN
- pushLayout(ctx, layoutNext(ctx), vec2(0, 0))
- END layoutBeginColumn;
- PROCEDURE layoutEndColumn(ctx : ContextPtr);
- VAR a, b : LayoutPtr;
- BEGIN
- b := getLayout(ctx);
- ctx^.layoutStack.idx := ctx^.layoutStack.idx - 1;
- a := getLayout(ctx);
- a^.position.x := max(a^.position.x, b^.position.x + b^.body.x - a^.body.x);
- a^.nextRow := max(a^.nextRow, b^.nextRow + b^.body.y - a^.body.y);
- a^.max.x := max(a^.max.x, b^.max.x);
- a^.max.y := max(a^.max.y, b^.max.y)
- END layoutEndColumn;
- PROCEDURE layoutSetNext(ctx : ContextPtr; r : Rect; relative : INTEGER);
- VAR layout : LayoutPtr;
- BEGIN
- layout := getLayout(ctx);
- layout^.next := r;
- IF relative # 0 THEN
- layout^.nextType := RELATIVE
- ELSE
- layout^.nextType := ABSOLUTE
- END
- END layoutSetNext;
- PROCEDURE layoutNext(ctx : ContextPtr) : Rect;
- VAR layout : LayoutPtr;
- st : StylePtr;
- res : Rect;
- typ : INTEGER;
- BEGIN
- layout := getLayout(ctx);
- st := CAST(StylePtr, ctx^.style);
- IF layout^.nextType # 0 THEN
- typ := layout^.nextType;
- layout^.nextType := 0;
- res := layout^.next;
- IF typ = ABSOLUTE THEN
- ctx^.lastRect := res;
- RETURN res
- END
- ELSE
- IF layout^.itemIndex = layout^.items THEN
- layoutRow(ctx, layout^.items, NIL, layout^.size.y)
- END;
- res.x := layout^.position.x;
- res.y := layout^.position.y;
- res.w := layout^.widths[layout^.itemIndex];
- IF layout^.items <= 0 THEN res.w := layout^.size.x END;
- res.h := layout^.size.y;
- IF res.w = 0 THEN
- res.w := st^.size.x + st^.padding * 2
- END;
- IF res.h = 0 THEN
- res.h := st^.size.y + st^.padding * 2
- END;
- IF res.w < 0 THEN
- res.w := res.w + layout^.body.w - res.x + 1
- END;
- IF res.h < 0 THEN
- res.h := res.h + layout^.body.h - res.y + 1
- END;
- layout^.itemIndex := layout^.itemIndex + 1
- END;
- layout^.position.x := res.w + layout^.position.x + st^.spacing;
- layout^.nextRow := max(layout^.nextRow, res.y + res.h + st^.spacing);
- res.x := res.x + layout^.body.x;
- res.y := res.y + layout^.body.y;
- layout^.max.x := max(layout^.max.x, res.x + res.w);
- layout^.max.y := max(layout^.max.y, res.y + res.h);
- ctx^.lastRect := res;
- RETURN res
- END layoutNext;
- (*========================================================================*)
- (* Controls *)
- (*========================================================================*)
- PROCEDURE inHoverRoot(ctx : ContextPtr) : INTEGER;
- VAR i : INTEGER;
- BEGIN
- i := ctx^.containerStack.idx;
- WHILE i > 0 DO
- i := i - 1;
- IF ctx^.containerStack.items[i] = ctx^.hoverRoot THEN RETURN 1 END;
- IF ctx^.containerStack.items[i]^.head # NIL THEN RETURN 0 END
- END;
- RETURN 0
- END inHoverRoot;
- PROCEDURE drawControlFrame(ctx : ContextPtr; id : Id; r : Rect;
- colorid, opt : INTEGER);
- BEGIN
- IF HasOpt(opt, OPT_NOFRAME) THEN RETURN END;
- IF ctx^.focus = id THEN
- colorid := colorid + 2
- ELSIF ctx^.hover = id THEN
- colorid := colorid + 1
- END;
- DrawFrameBy(ctx, r, colorid)
- END drawControlFrame;
- PROCEDURE drawControlText(ctx : ContextPtr; str : ARRAY OF CHAR;
- r : Rect; colorid, opt : INTEGER);
- VAR pos : Vec2;
- f : Font;
- tw : INTEGER;
- BEGIN
- f := ctx^.style^.font;
- tw := TextWidth(ctx, f, ADR(str), -1);
- pushClipRect(ctx, r);
- pos.y := r.y + (r.h - TextHeight(ctx, f)) DIV 2;
- IF HasOpt(opt, OPT_ALIGNCENTER) THEN
- pos.x := r.x + (r.w - tw) DIV 2
- ELSIF HasOpt(opt, OPT_ALIGNRIGHT) THEN
- pos.x := r.x + r.w - tw - ctx^.style^.padding
- ELSE
- pos.x := r.x + ctx^.style^.padding
- END;
- drawText(ctx, f, ADR(str), -1, pos, ctx^.style^.colors[colorid]);
- popClipRect(ctx)
- END drawControlText;
- PROCEDURE mouseOver(ctx : ContextPtr; r : Rect) : INTEGER;
- BEGIN
- IF rectOverlapsVec2(r, ctx^.mousePos) AND
- rectOverlapsVec2(getClipRect(ctx), ctx^.mousePos) AND
- (inHoverRoot(ctx) # 0) THEN
- RETURN 1
- END;
- RETURN 0
- END mouseOver;
- PROCEDURE updateControl(ctx : ContextPtr; id : Id; r : Rect; opt : INTEGER);
- VAR mouseover : INTEGER;
- BEGIN
- mouseover := mouseOver(ctx, r);
- IF ctx^.focus = id THEN ctx^.updatedFocus := 1 END;
- IF HasOpt(opt, OPT_NOINTERACT) THEN RETURN END;
- IF (mouseover # 0) AND (ctx^.mouseDown = 0) THEN ctx^.hover := id END;
- IF ctx^.focus = id THEN
- IF (ctx^.mousePressed # 0) AND (mouseover = 0) THEN setFocus(ctx, 0) END;
- IF (ctx^.mouseDown = 0) AND HasNoOpt(opt, OPT_HOLDFOCUS) THEN
- setFocus(ctx, 0)
- END
- END;
- IF ctx^.hover = id THEN
- IF ctx^.mousePressed # 0 THEN
- setFocus(ctx, id)
- ELSIF mouseover = 0 THEN
- ctx^.hover := 0
- END
- END
- END updateControl;
- (*========================================================================*)
- (* Widgets *)
- (*========================================================================*)
- PROCEDURE text(ctx : ContextPtr; str : ARRAY OF CHAR);
- VAR start, fin, p, slen : INTEGER;
- width, w, word : INTEGER;
- f : Font;
- c : Color;
- r : Rect;
- done : BOOLEAN;
- BEGIN
- width := -1;
- f := ctx^.style^.font;
- c := ctx^.style^.colors[COLOR_TEXT];
- slen := StrLenI(str);
- layoutBeginColumn(ctx);
- layoutRow(ctx, 1, ADR(width), TextHeight(ctx, f));
- p := 0;
- REPEAT
- r := layoutNext(ctx);
- w := 0;
- start := p;
- fin := p;
- done := FALSE;
- REPEAT
- word := p;
- WHILE (p < slen) AND (str[p] # ' ') AND (str[p] # CHR(10)) DO
- p := p + 1
- END;
- w := w + TextWidth(ctx, f, ADDADR(ADR(str), word), p - word);
- IF (w > r.w) AND (fin # start) THEN
- done := TRUE
- ELSE
- w := w + TextWidth(ctx, f, ADDADR(ADR(str), p), 1);
- fin := p;
- p := p + 1;
- IF (fin >= slen) OR (str[fin] = CHR(10)) THEN
- done := TRUE
- END
- END
- UNTIL done;
- IF fin > start THEN
- drawText(ctx, f, ADDADR(ADR(str), start), fin - start,
- vec2(r.x, r.y), c)
- END;
- p := fin + 1
- UNTIL fin >= slen;
- layoutEndColumn(ctx)
- END text;
- PROCEDURE label(ctx : ContextPtr; str : ARRAY OF CHAR);
- VAR r : Rect;
- BEGIN
- r := layoutNext(ctx);
- drawControlText(ctx, str, r, COLOR_TEXT, 0)
- END label;
- PROCEDURE buttonEx(ctx : ContextPtr; lbl : ARRAY OF CHAR;
- icon, opt : INTEGER) : INTEGER;
- VAR res : INTEGER;
- id : Id;
- r : Rect;
- slen: INTEGER;
- BEGIN
- res := 0;
- slen := StrLenI(lbl);
- IF slen > 0 THEN
- id := getId(ctx, ADR(lbl), slen)
- ELSE
- id := getId(ctx, ADR(icon), SIZE(INTEGER))
- END;
- r := layoutNext(ctx);
- updateControl(ctx, id, r, opt);
- IF (ctx^.mousePressed = MOUSE_LEFT) AND (ctx^.focus = id) THEN
- res := SetFlag(res, RES_SUBMIT)
- END;
- drawControlFrame(ctx, id, r, COLOR_BUTTON, opt);
- IF slen > 0 THEN
- drawControlText(ctx, lbl, r, COLOR_TEXT, opt)
- END;
- IF icon # 0 THEN
- drawIcon(ctx, icon, r, ctx^.style^.colors[COLOR_TEXT])
- END;
- RETURN res
- END buttonEx;
- PROCEDURE checkbox(ctx : ContextPtr; lbl : ARRAY OF CHAR;
- state : IntPtr) : INTEGER;
- VAR res : INTEGER;
- id : Id;
- r, box : Rect;
- BEGIN
- res := 0;
- id := getId(ctx, ADR(state), SIZE(ADDRESS));
- r := layoutNext(ctx);
- box := rect(r.x, r.y, r.h, r.h);
- updateControl(ctx, id, r, 0);
- IF (ctx^.mousePressed = MOUSE_LEFT) AND (ctx^.focus = id) THEN
- res := SetFlag(res, RES_CHANGE);
- IF state^ = 0 THEN state^ := 1 ELSE state^ := 0 END
- END;
- drawControlFrame(ctx, id, box, COLOR_BASE, 0);
- IF state^ # 0 THEN
- drawIcon(ctx, ICON_CHECK, box, ctx^.style^.colors[COLOR_TEXT])
- END;
- r := rect(r.x + box.w, r.y, r.w - box.w, r.h);
- drawControlText(ctx, lbl, r, COLOR_TEXT, 0);
- RETURN res
- END checkbox;
- PROCEDURE bufLen(buf : ADDRESS; bufsz : INTEGER) : INTEGER;
- VAR p : CharPtr;
- n : INTEGER;
- BEGIN
- p := CAST(CharPtr, buf);
- n := 0;
- WHILE (n < bufsz) AND (p^ # 0C) DO
- n := n + 1;
- p := ADDADR(p, 1)
- END;
- RETURN n
- END bufLen;
- PROCEDURE textboxRaw(ctx : ContextPtr; buf : ADDRESS; bufsz : INTEGER;
- id : Id; r : Rect; opt : INTEGER) : INTEGER;
- VAR res : INTEGER;
- bufStr : CharArrayPtr;
- len, n, inlen : INTEGER;
- font : Font;
- textW, textH, ofx, textx, texty : INTEGER;
- c : Color;
- BEGIN
- res := 0;
- bufStr := CAST(CharArrayPtr, buf);
- updateControl(ctx, id, r, BitOrI(opt, OPT_HOLDFOCUS));
- IF ctx^.focus = id THEN
- len := bufLen(buf, bufsz);
- inlen := StrLenI(ctx^.inputText);
- n := min(bufsz - len - 1, inlen);
- IF n > 0 THEN
- CopyBytes(ADR(ctx^.inputText), ADDADR(buf, len), VAL(CARDINAL, n));
- len := len + n;
- bufStr^[len] := 0C;
- res := SetFlag(res, RES_CHANGE)
- END;
- (* handle backspace, skipping UTF-8 continuation bytes *)
- IF HasOpt(ctx^.keyPressed, KEY_BACKSPACE) AND (len > 0) THEN
- len := len - 1;
- WHILE (len > 0) AND
- (BITAND(VAL(CARDINAL, ORD(bufStr^[len])), 0C0H) = 080H) DO
- len := len - 1
- END;
- bufStr^[len] := 0C;
- res := SetFlag(res, RES_CHANGE)
- END;
- IF HasOpt(ctx^.keyPressed, KEY_RETURN) THEN
- setFocus(ctx, 0);
- res := SetFlag(res, RES_SUBMIT)
- END
- END;
- drawControlFrame(ctx, id, r, COLOR_BASE, opt);
- IF ctx^.focus = id THEN
- c := ctx^.style^.colors[COLOR_TEXT];
- font := ctx^.style^.font;
- textW := TextWidth(ctx, font, buf, -1);
- textH := TextHeight(ctx, font);
- ofx := r.w - ctx^.style^.padding - textW - 1;
- textx := r.x + min(ofx, ctx^.style^.padding);
- texty := r.y + (r.h - textH) DIV 2;
- pushClipRect(ctx, r);
- drawText(ctx, font, buf, -1, vec2(textx, texty), c);
- drawRect(ctx, rect(textx + textW, texty, 1, textH), c);
- popClipRect(ctx)
- ELSE
- drawControlText(ctx, bufStr^, r, COLOR_TEXT, opt)
- END;
- RETURN res
- END textboxRaw;
- PROCEDURE textboxEx(ctx : ContextPtr; buf : ADDRESS;
- bufsz, opt : INTEGER) : INTEGER;
- VAR id : Id;
- r : Rect;
- BEGIN
- id := getId(ctx, ADR(buf), SIZE(ADDRESS));
- r := layoutNext(ctx);
- RETURN textboxRaw(ctx, buf, bufsz, id, r, opt)
- END textboxEx;
- PROCEDURE FormatReal(VAR buf : ARRAY OF CHAR; val : Real; fmt : ARRAY OF CHAR);
- VAR i, prec : INTEGER;
- ch : CHAR;
- scanning : BOOLEAN;
- discard : CARDINAL;
- hi : INTEGER;
- BEGIN
- prec := 2;
- i := 0;
- hi := VAL(INTEGER, HIGH(fmt));
- scanning := TRUE;
- WHILE scanning AND (i <= hi) AND (fmt[i] # 0C) DO
- IF fmt[i] = '.' THEN
- i := i + 1;
- prec := 0;
- WHILE (i <= hi) AND (fmt[i] >= '0') AND (fmt[i] <= '9') DO
- prec := prec * 10 + VAL(INTEGER, ORD(fmt[i]) - ORD('0'));
- i := i + 1
- END;
- scanning := FALSE
- ELSE
- i := i + 1
- END
- END;
- ch := 'f';
- scanning := TRUE;
- WHILE scanning AND (i <= hi) AND (fmt[i] # 0C) DO
- IF (fmt[i] = 'f') OR (fmt[i] = 'g') THEN
- ch := fmt[i];
- scanning := FALSE
- ELSE
- i := i + 1
- END
- END;
- IF ch = 'g' THEN
- discard := RealToStr(buf, val, 0 - prec)
- ELSE
- discard := RealToStr(buf, val, prec)
- END
- END FormatReal;
- PROCEDURE numberTextbox(ctx : ContextPtr; value : RealPtr;
- r : Rect; id : Id) : INTEGER;
- VAR res : INTEGER;
- discard : CARDINAL;
- BEGIN
- IF (ctx^.mousePressed = MOUSE_LEFT) AND HasOpt(ctx^.keyDown, KEY_SHIFT) AND
- (ctx^.hover = id) THEN
- ctx^.numberEdit := id;
- discard := RealToStr(ctx^.numberEditBuf, value^, 0 - 3)
- END;
- IF ctx^.numberEdit = id THEN
- res := textboxRaw(ctx, ADR(ctx^.numberEditBuf),
- SIZE(ctx^.numberEditBuf), id, r, 0);
- IF HasOpt(res, RES_SUBMIT) OR (ctx^.focus # id) THEN
- value^ := StrToReal(ctx^.numberEditBuf, NIL);
- ctx^.numberEdit := 0
- ELSE
- RETURN 1
- END
- END;
- RETURN 0
- END numberTextbox;
- PROCEDURE sliderEx(ctx : ContextPtr; value : RealPtr;
- low, high, step : Real;
- fmt : ARRAY OF CHAR; opt : INTEGER) : INTEGER;
- VAR buf : ARRAY [0..MAX_FMT + 1] OF CHAR;
- thumb : Rect;
- x, w : INTEGER;
- res : INTEGER;
- last : Real;
- v : Real;
- id : Id;
- base : Rect;
- BEGIN
- res := 0;
- id := getId(ctx, ADR(value), SIZE(ADDRESS));
- base := layoutNext(ctx);
- v := value^;
- last := v;
- IF numberTextbox(ctx, ADR(v), base, id) # 0 THEN RETURN res END;
- updateControl(ctx, id, base, opt);
- IF (ctx^.focus = id) AND
- (BitOrI(ctx^.mouseDown, ctx^.mousePressed) = MOUSE_LEFT) THEN
- v := low + IntToReal(ctx^.mousePos.x - base.x) *
- (high - low) / IntToReal(base.w);
- IF step # 0.0 THEN
- v := IntToReal(TRUNC(SHORTREAL((v + step / 2.0) / step))) * step
- END
- END;
- v := clampR(v, low, high);
- value^ := v;
- IF last # v THEN res := SetFlag(res, RES_CHANGE) END;
- drawControlFrame(ctx, id, base, COLOR_BASE, opt);
- w := ctx^.style^.thumbSize;
- x := TRUNC(SHORTREAL((v - low) * IntToReal(base.w - w) / (high - low)));
- thumb := rect(base.x + x, base.y, w, base.h);
- drawControlFrame(ctx, id, thumb, COLOR_BUTTON, opt);
- FormatReal(buf, v, fmt);
- drawControlText(ctx, buf, base, COLOR_TEXT, opt);
- RETURN res
- END sliderEx;
- PROCEDURE numberEx(ctx : ContextPtr; value : RealPtr;
- step : Real; fmt : ARRAY OF CHAR;
- opt : INTEGER) : INTEGER;
- VAR buf : ARRAY [0..MAX_FMT + 1] OF CHAR;
- res : INTEGER;
- id : Id;
- base: Rect;
- last: Real;
- BEGIN
- res := 0;
- id := getId(ctx, ADR(value), SIZE(ADDRESS));
- base := layoutNext(ctx);
- last := value^;
- IF numberTextbox(ctx, value, base, id) # 0 THEN RETURN res END;
- updateControl(ctx, id, base, opt);
- IF (ctx^.focus = id) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
- value^ := value^ + IntToReal(ctx^.mouseDelta.x) * step
- END;
- IF value^ # last THEN res := SetFlag(res, RES_CHANGE) END;
- drawControlFrame(ctx, id, base, COLOR_BASE, opt);
- FormatReal(buf, value^, fmt);
- drawControlText(ctx, buf, base, COLOR_TEXT, opt);
- RETURN res
- END numberEx;
- PROCEDURE headerCalc(ctx : ContextPtr; lbl : ARRAY OF CHAR;
- istreenode, opt : INTEGER) : INTEGER;
- VAR id : Id;
- idx : INTEGER;
- active, expanded : INTEGER;
- r : Rect;
- width : INTEGER;
- tmpIdx : INTEGER;
- BEGIN
- id := getId(ctx, ADR(lbl), StrLenI(lbl));
- idx := poolGet(ctx, ADR(ctx^.treenodePool), TREENODEPOOL_SIZE, id);
- width := -1;
- layoutRow(ctx, 1, ADR(width), 0);
- IF idx >= 0 THEN active := 1 ELSE active := 0 END;
- IF HasOpt(opt, OPT_EXPANDED) THEN
- IF active # 0 THEN expanded := 0 ELSE expanded := 1 END
- ELSE
- expanded := active
- END;
- r := layoutNext(ctx);
- updateControl(ctx, id, r, 0);
- IF (ctx^.mousePressed = MOUSE_LEFT) AND (ctx^.focus = id) THEN
- active := 1 - active
- END;
- IF idx >= 0 THEN
- IF active # 0 THEN
- poolUpdate(ctx, ADR(ctx^.treenodePool), idx)
- ELSE
- FillZero(ADR(ctx^.treenodePool[idx]), SIZE(PoolItem))
- END
- ELSIF active # 0 THEN
- tmpIdx := poolInit(ctx, ADR(ctx^.treenodePool), TREENODEPOOL_SIZE, id)
- END;
- IF istreenode # 0 THEN
- IF ctx^.hover = id THEN
- DrawFrameBy(ctx, r, COLOR_BUTTONHOVER)
- END
- ELSE
- drawControlFrame(ctx, id, r, COLOR_BUTTON, 0)
- END;
- IF expanded # 0 THEN
- drawIcon(ctx, ICON_EXPANDED, rect(r.x, r.y, r.h, r.h),
- ctx^.style^.colors[COLOR_TEXT])
- ELSE
- drawIcon(ctx, ICON_COLLAPSED, rect(r.x, r.y, r.h, r.h),
- ctx^.style^.colors[COLOR_TEXT])
- END;
- r.x := r.x + r.h - ctx^.style^.padding;
- r.w := r.w - r.h + ctx^.style^.padding;
- drawControlText(ctx, lbl, r, COLOR_TEXT, 0);
- IF expanded # 0 THEN RETURN RES_ACTIVE ELSE RETURN 0 END
- END headerCalc;
- PROCEDURE headerEx(ctx : ContextPtr; lbl : ARRAY OF CHAR;
- opt : INTEGER) : INTEGER;
- BEGIN
- RETURN headerCalc(ctx, lbl, 0, opt)
- END headerEx;
- PROCEDURE beginTreenodeEx(ctx : ContextPtr; lbl : ARRAY OF CHAR;
- opt : INTEGER) : INTEGER;
- VAR res : INTEGER;
- layout : LayoutPtr;
- BEGIN
- res := headerCalc(ctx, lbl, 1, opt);
- IF HasOpt(res, RES_ACTIVE) THEN
- layout := getLayout(ctx);
- layout^.indent := layout^.indent + ctx^.style^.indent;
- ctx^.idStack.items[ctx^.idStack.idx] := ctx^.lastId;
- ctx^.idStack.idx := ctx^.idStack.idx + 1
- END;
- RETURN res
- END beginTreenodeEx;
- PROCEDURE endTreenode(ctx : ContextPtr);
- VAR layout : LayoutPtr;
- BEGIN
- layout := getLayout(ctx);
- layout^.indent := layout^.indent - ctx^.style^.indent;
- popId(ctx)
- END endTreenode;
- (*========================================================================*)
- (* Scrollbars *)
- (*========================================================================*)
- PROCEDURE drawScrollbar(ctx : ContextPtr; cnt : ContainerPtr;
- body : Rect; cs : Vec2; vertical : BOOLEAN);
- VAR maxscroll : INTEGER;
- base, thumb : Rect;
- id : Id;
- tsize, avail : INTEGER;
- BEGIN
- IF vertical THEN
- maxscroll := cs.y - body.h
- ELSE
- maxscroll := cs.x - body.w
- END;
- IF (maxscroll > 0) AND (body.h > 0) AND (body.w > 0) THEN
- base := body;
- IF vertical THEN
- base.x := body.x + body.w;
- base.w := ctx^.style^.scrollbarSize
- ELSE
- base.y := body.y + body.h;
- base.h := ctx^.style^.scrollbarSize
- END;
- IF vertical THEN
- id := IdOf(ctx, "!scrollbarY")
- ELSE
- id := IdOf(ctx, "!scrollbarX")
- END;
- updateControl(ctx, id, base, 0);
- IF (ctx^.focus = id) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
- IF vertical THEN
- cnt^.scroll.y := cnt^.scroll.y +
- ctx^.mouseDelta.y * cs.y DIV base.h
- ELSE
- cnt^.scroll.x := cnt^.scroll.x +
- ctx^.mouseDelta.x * cs.x DIV base.w
- END
- END;
- IF vertical THEN
- cnt^.scroll.y := clamp(cnt^.scroll.y, 0, maxscroll)
- ELSE
- cnt^.scroll.x := clamp(cnt^.scroll.x, 0, maxscroll)
- END;
- DrawFrameBy(ctx, base, COLOR_SCROLLBASE);
- thumb := base;
- tsize := ctx^.style^.thumbSize;
- IF vertical THEN
- avail := base.h;
- IF tsize < avail * body.h DIV cs.y THEN
- tsize := avail * body.h DIV cs.y
- END;
- thumb.h := tsize;
- thumb.y := thumb.y +
- cnt^.scroll.y * (avail - tsize) DIV maxscroll
- ELSE
- avail := base.w;
- IF tsize < avail * body.w DIV cs.x THEN
- tsize := avail * body.w DIV cs.x
- END;
- thumb.w := tsize;
- thumb.x := thumb.x +
- cnt^.scroll.x * (avail - tsize) DIV maxscroll
- END;
- DrawFrameBy(ctx, thumb, COLOR_SCROLLTHUMB);
- IF mouseOver(ctx, body) # 0 THEN
- ctx^.scrollTarget := cnt
- END
- ELSE
- IF vertical THEN
- cnt^.scroll.y := 0
- ELSE
- cnt^.scroll.x := 0
- END
- END
- END drawScrollbar;
- PROCEDURE scrollbars(ctx : ContextPtr; cnt : ContainerPtr; VAR body : Rect);
- VAR sz : INTEGER;
- cs : Vec2;
- BEGIN
- sz := ctx^.style^.scrollbarSize;
- cs := cnt^.contentSize;
- cs.x := cs.x + ctx^.style^.padding * 2;
- cs.y := cs.y + ctx^.style^.padding * 2;
- pushClipRect(ctx, body);
- IF cs.y > cnt^.body.h THEN body.w := body.w - sz END;
- IF cs.x > cnt^.body.w THEN body.h := body.h - sz END;
- drawScrollbar(ctx, cnt, body, cs, TRUE);
- drawScrollbar(ctx, cnt, body, cs, FALSE);
- popClipRect(ctx)
- END scrollbars;
- PROCEDURE pushContainerBody(ctx : ContextPtr; cnt : ContainerPtr;
- body : Rect; opt : INTEGER);
- VAR b : Rect;
- BEGIN
- b := body;
- IF HasNoOpt(opt, OPT_NOSCROLL) THEN
- scrollbars(ctx, cnt, b)
- END;
- pushLayout(ctx, expandRect(b, 0 - ctx^.style^.padding), cnt^.scroll);
- cnt^.body := b
- END pushContainerBody;
- PROCEDURE popContainer(ctx : ContextPtr);
- VAR cnt : ContainerPtr;
- layout : LayoutPtr;
- BEGIN
- cnt := getCurrentContainer(ctx);
- layout := getLayout(ctx);
- cnt^.contentSize := vec2(layout^.max.x - layout^.body.x,
- layout^.max.y - layout^.body.y);
- ctx^.containerStack.idx := ctx^.containerStack.idx - 1;
- ctx^.layoutStack.idx := ctx^.layoutStack.idx - 1;
- popId(ctx)
- END popContainer;
- PROCEDURE beginRootContainer(ctx : ContextPtr; cnt : ContainerPtr);
- BEGIN
- ctx^.containerStack.items[ctx^.containerStack.idx] := cnt;
- ctx^.containerStack.idx := ctx^.containerStack.idx + 1;
- ctx^.rootList.items[ctx^.rootList.idx] := cnt;
- ctx^.rootList.idx := ctx^.rootList.idx + 1;
- cnt^.head := pushJump(ctx, NIL);
- IF rectOverlapsVec2(cnt^.rect, ctx^.mousePos) AND
- ((ctx^.nextHoverRoot = NIL) OR
- (cnt^.zindex > ctx^.nextHoverRoot^.zindex)) THEN
- ctx^.nextHoverRoot := cnt
- END;
- (* clipping is reset here directly (not intersected) so that a root
- container nested in another is not clipped to the outer one *)
- ctx^.clipStack.items[ctx^.clipStack.idx] := unclippedRect;
- ctx^.clipStack.idx := ctx^.clipStack.idx + 1
- END beginRootContainer;
- PROCEDURE endRootContainer(ctx : ContextPtr);
- VAR cnt : ContainerPtr;
- jp : JumpCommandPtr;
- BEGIN
- cnt := getCurrentContainer(ctx);
- cnt^.tail := pushJump(ctx, NIL);
- jp := CAST(JumpCommandPtr, cnt^.head);
- jp^.dst := ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx);
- popClipRect(ctx);
- popContainer(ctx)
- END endRootContainer;
- (*========================================================================*)
- (* Window *)
- (*========================================================================*)
- PROCEDURE beginWindowEx(ctx : ContextPtr; title : ARRAY OF CHAR;
- r : Rect; opt : INTEGER) : INTEGER;
- VAR body : Rect;
- id : Id;
- cnt : ContainerPtr;
- tr : Rect;
- sz : INTEGER;
- rid : Id;
- rr : Rect;
- layout : LayoutPtr;
- BEGIN
- id := getId(ctx, ADR(title), StrLenI(title));
- cnt := getContainerById(ctx, id, opt);
- IF (cnt = NIL) OR (cnt^.open = 0) THEN RETURN 0 END;
- ctx^.idStack.items[ctx^.idStack.idx] := id;
- ctx^.idStack.idx := ctx^.idStack.idx + 1;
- IF cnt^.rect.w = 0 THEN cnt^.rect := r END;
- beginRootContainer(ctx, cnt);
- body := cnt^.rect;
- IF HasNoOpt(opt, OPT_NOFRAME) THEN
- DrawFrameBy(ctx, body, COLOR_WINDOWBG)
- END;
- IF HasNoOpt(opt, OPT_NOTITLE) THEN
- tr := body;
- tr.h := ctx^.style^.titleHeight;
- DrawFrameBy(ctx, tr, COLOR_TITLEBG);
- rid := IdOf(ctx, "!title");
- updateControl(ctx, rid, tr, opt);
- drawControlText(ctx, title, tr, COLOR_TITLETEXT, opt);
- IF (rid = ctx^.focus) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
- cnt^.rect.x := cnt^.rect.x + ctx^.mouseDelta.x;
- cnt^.rect.y := cnt^.rect.y + ctx^.mouseDelta.y
- END;
- body.y := body.y + tr.h;
- body.h := body.h - tr.h;
- IF HasNoOpt(opt, OPT_NOCLOSE) THEN
- rid := IdOf(ctx, "!close");
- rr := rect(tr.x + tr.w - tr.h, tr.y, tr.h, tr.h);
- tr.w := tr.w - rr.w;
- drawIcon(ctx, ICON_CLOSE, rr, ctx^.style^.colors[COLOR_TITLETEXT]);
- updateControl(ctx, rid, rr, opt);
- IF (ctx^.mousePressed = MOUSE_LEFT) AND (rid = ctx^.focus) THEN
- cnt^.open := 0
- END
- END
- END;
- pushContainerBody(ctx, cnt, body, opt);
- IF HasNoOpt(opt, OPT_NORESIZE) THEN
- sz := ctx^.style^.titleHeight;
- rid := IdOf(ctx, "!resize");
- rr := rect(body.x + body.w - sz, body.y + body.h - sz, sz, sz);
- updateControl(ctx, rid, rr, opt);
- IF (rid = ctx^.focus) AND (ctx^.mouseDown = MOUSE_LEFT) THEN
- cnt^.rect.w := max(96, cnt^.rect.w + ctx^.mouseDelta.x);
- cnt^.rect.h := max(64, cnt^.rect.h + ctx^.mouseDelta.y)
- END
- END;
- IF HasOpt(opt, OPT_AUTOSIZE) THEN
- layout := getLayout(ctx);
- rr := layout^.body;
- cnt^.rect.w := cnt^.contentSize.x + (cnt^.rect.w - rr.w);
- cnt^.rect.h := cnt^.contentSize.y + (cnt^.rect.h - rr.h)
- END;
- IF HasOpt(opt, OPT_POPUP) AND (ctx^.mousePressed # 0) AND
- (ctx^.hoverRoot # cnt) THEN
- cnt^.open := 0
- END;
- pushClipRect(ctx, cnt^.body);
- RETURN RES_ACTIVE
- END beginWindowEx;
- PROCEDURE endWindow(ctx : ContextPtr);
- BEGIN
- popClipRect(ctx);
- endRootContainer(ctx)
- END endWindow;
- PROCEDURE openPopup(ctx : ContextPtr; name : ARRAY OF CHAR);
- VAR cnt : ContainerPtr;
- BEGIN
- cnt := getContainer(ctx, name);
- ctx^.hoverRoot := cnt;
- ctx^.nextHoverRoot := cnt;
- cnt^.rect := rect(ctx^.mousePos.x, ctx^.mousePos.y, 1, 1);
- cnt^.open := 1;
- bringToFront(ctx, cnt)
- END openPopup;
- PROCEDURE beginPopup(ctx : ContextPtr; name : ARRAY OF CHAR) : INTEGER;
- VAR opt : INTEGER;
- BEGIN
- opt := SetFlag(SetFlag(SetFlag(SetFlag(SetFlag(OPT_POPUP, OPT_AUTOSIZE),
- OPT_NORESIZE), OPT_NOSCROLL), OPT_NOTITLE), OPT_CLOSED);
- RETURN beginWindowEx(ctx, name, rect(0, 0, 0, 0), opt)
- END beginPopup;
- PROCEDURE endPopup(ctx : ContextPtr);
- BEGIN
- endWindow(ctx)
- END endPopup;
- PROCEDURE beginPanelEx(ctx : ContextPtr; name : ARRAY OF CHAR;
- opt : INTEGER);
- VAR cnt : ContainerPtr;
- BEGIN
- pushId(ctx, ADR(name), StrLenI(name));
- cnt := getContainerById(ctx, ctx^.lastId, opt);
- cnt^.rect := layoutNext(ctx);
- IF HasNoOpt(opt, OPT_NOFRAME) THEN
- DrawFrameBy(ctx, cnt^.rect, COLOR_PANELBG)
- END;
- ctx^.containerStack.items[ctx^.containerStack.idx] := cnt;
- ctx^.containerStack.idx := ctx^.containerStack.idx + 1;
- pushContainerBody(ctx, cnt, cnt^.rect, opt);
- pushClipRect(ctx, cnt^.body)
- END beginPanelEx;
- PROCEDURE endPanel(ctx : ContextPtr);
- BEGIN
- popClipRect(ctx);
- popContainer(ctx)
- END endPanel;
- (*========================================================================*)
- (* Input handlers *)
- (*========================================================================*)
- PROCEDURE inputMousemove(ctx : ContextPtr; x, y : INTEGER);
- BEGIN
- ctx^.mousePos := vec2(x, y)
- END inputMousemove;
- PROCEDURE inputMousedown(ctx : ContextPtr; x, y, btn : INTEGER);
- BEGIN
- inputMousemove(ctx, x, y);
- ctx^.mouseDown := SetFlag(ctx^.mouseDown, btn);
- ctx^.mousePressed := SetFlag(ctx^.mousePressed, btn)
- END inputMousedown;
- PROCEDURE inputMouseup(ctx : ContextPtr; x, y, btn : INTEGER);
- BEGIN
- inputMousemove(ctx, x, y);
- ctx^.mouseDown := ClearFlag(ctx^.mouseDown, btn)
- END inputMouseup;
- PROCEDURE inputScroll(ctx : ContextPtr; x, y : INTEGER);
- BEGIN
- ctx^.scrollDelta.x := ctx^.scrollDelta.x + x;
- ctx^.scrollDelta.y := ctx^.scrollDelta.y + y
- END inputScroll;
- PROCEDURE inputKeydown(ctx : ContextPtr; key : INTEGER);
- BEGIN
- ctx^.keyPressed := SetFlag(ctx^.keyPressed, key);
- ctx^.keyDown := SetFlag(ctx^.keyDown, key)
- END inputKeydown;
- PROCEDURE inputKeyup(ctx : ContextPtr; key : INTEGER);
- BEGIN
- ctx^.keyDown := ClearFlag(ctx^.keyDown, key)
- END inputKeyup;
- PROCEDURE inputText(ctx : ContextPtr; txt : ARRAY OF CHAR);
- VAR len, size, i : INTEGER;
- BEGIN
- len := StrLenI(ctx^.inputText);
- size := StrLenI(txt) + 1;
- IF (len + size) <= 32 THEN
- FOR i := 0 TO size - 1 DO
- ctx^.inputText[len + i] := txt[i]
- END
- END
- END inputText;
- (*========================================================================*)
- (* end() *)
- (*========================================================================*)
- PROCEDURE sortRoots(ctx : ContextPtr);
- VAR n, i, j : INTEGER;
- tmp : ContainerPtr;
- items : RootArrayPtr;
- BEGIN
- n := ctx^.rootList.idx;
- items := ADR(ctx^.rootList.items);
- FOR i := 1 TO n - 1 DO
- tmp := items^[i];
- j := i - 1;
- WHILE (j >= 0) AND (items^[j]^.zindex > tmp^.zindex) DO
- items^[j + 1] := items^[j];
- j := j - 1
- END;
- items^[j + 1] := tmp
- END
- END sortRoots;
- PROCEDURE end(ctx : ContextPtr);
- VAR i, n : INTEGER;
- cnt, prev : ContainerPtr;
- items : RootArrayPtr;
- firstCmd : CommandPtr;
- jp : JumpCommandPtr;
- BEGIN
- IF ctx^.scrollTarget # NIL THEN
- ctx^.scrollTarget^.scroll.x := ctx^.scrollTarget^.scroll.x +
- ctx^.scrollDelta.x;
- ctx^.scrollTarget^.scroll.y := ctx^.scrollTarget^.scroll.y +
- ctx^.scrollDelta.y
- END;
- IF ctx^.updatedFocus = 0 THEN ctx^.focus := 0 END;
- ctx^.updatedFocus := 0;
- IF (ctx^.mousePressed # 0) AND (ctx^.nextHoverRoot # NIL) AND
- (ctx^.nextHoverRoot^.zindex < ctx^.lastZindex) AND
- (ctx^.nextHoverRoot^.zindex >= 0) THEN
- bringToFront(ctx, ctx^.nextHoverRoot)
- END;
- ctx^.keyPressed := 0;
- ctx^.inputText[0] := 0C;
- ctx^.mousePressed := 0;
- ctx^.scrollDelta := vec2(0, 0);
- ctx^.lastMousePos := ctx^.mousePos;
- sortRoots(ctx);
- n := ctx^.rootList.idx;
- items := ADR(ctx^.rootList.items);
- FOR i := 0 TO n - 1 DO
- cnt := items^[i];
- IF i = 0 THEN
- firstCmd := CAST(CommandPtr, ADR(ctx^.commandList.items));
- jp := CAST(JumpCommandPtr, firstCmd);
- jp^.dst := ADDADR(CAST(ADDRESS, cnt^.head), SIZE(JumpCommand))
- ELSE
- prev := items^[i - 1];
- jp := CAST(JumpCommandPtr, prev^.tail);
- jp^.dst := ADDADR(CAST(ADDRESS, cnt^.head), SIZE(JumpCommand))
- END;
- IF i = n - 1 THEN
- jp := CAST(JumpCommandPtr, cnt^.tail);
- jp^.dst := ADDADR(ADR(ctx^.commandList.items), ctx^.commandList.idx)
- END
- END
- END end;
- (*========================================================================*)
- (* Convenience wrappers (the C macros) *)
- (*========================================================================*)
- PROCEDURE button(ctx : ContextPtr; lbl : ARRAY OF CHAR) : INTEGER;
- BEGIN
- RETURN buttonEx(ctx, lbl, 0, OPT_ALIGNCENTER)
- END button;
- PROCEDURE textbox(ctx : ContextPtr; buf : ADDRESS; bufsz : INTEGER) : INTEGER;
- BEGIN
- RETURN textboxEx(ctx, buf, bufsz, 0)
- END textbox;
- PROCEDURE slider(ctx : ContextPtr; value : RealPtr;
- low, high : Real) : INTEGER;
- BEGIN
- RETURN sliderEx(ctx, value, low, high, 0.0, SLIDER_FMT, OPT_ALIGNCENTER)
- END slider;
- PROCEDURE number(ctx : ContextPtr; value : RealPtr;
- step : Real) : INTEGER;
- BEGIN
- RETURN numberEx(ctx, value, step, SLIDER_FMT, OPT_ALIGNCENTER)
- END number;
- PROCEDURE header(ctx : ContextPtr; lbl : ARRAY OF CHAR) : INTEGER;
- BEGIN
- RETURN headerEx(ctx, lbl, 0)
- END header;
- PROCEDURE beginTreenode(ctx : ContextPtr; lbl : ARRAY OF CHAR) : INTEGER;
- BEGIN
- RETURN beginTreenodeEx(ctx, lbl, 0)
- END beginTreenode;
- PROCEDURE beginWindow(ctx : ContextPtr; title : ARRAY OF CHAR;
- r : Rect) : INTEGER;
- BEGIN
- RETURN beginWindowEx(ctx, title, r, 0)
- END beginWindow;
- PROCEDURE beginPanel(ctx : ContextPtr; name : ARRAY OF CHAR);
- BEGIN
- beginPanelEx(ctx, name, 0)
- END beginPanel;
- (*========================================================================*)
- (* Module initialization *)
- (*========================================================================*)
- BEGIN
- negBigCoord := 0 - 16777216;
- unclippedRect := rect(0, 0, 16777216, 16777216);
- InitDefaultStyle
- END microui.
|