MODULE microuiDemo; (* A demonstration of the Modula-2 microui port rendered with tigr. The UI is modelled on microui's C SDL demo but everything is drawn with the tigr software renderer and its built-in font. Build (from this directory), after tigr.o, helper.o, microuiHelpers.o and microui.o have been built in modula2/: gm2 -fiso -I ../../ ../../tigr.o ../../helper.o \ ../../microuiHelpers.o ../../microui.o \ microui-demo.mod -o microui-demo -lGL -lX11 *) FROM SYSTEM IMPORT ADDRESS, ADR, CAST, ADDADR, BYTE; FROM tigr IMPORT TigrPtr, tigrWindow, tigrFree, tigrClosed, tigrClear, tigrUpdate, TPixelType, tfont, tigrPrint, tigrFillRect, tigrRect, tigrLine, tigrTextWidth, tigrTextHeight, tigrMouse, tigrKeyDown, tigrKeyHeld, tigrReadChar, tigrTime, tigrEncodeUTF8, tigrClip, tigrError, TK_ESCAPE, TK_LSHIFT, TK_RSHIFT, TK_LCONTROL, TK_RCONTROL, TK_LALT, TK_RALT, TK_RETURN, TK_BACKSPACE, TIGR_AUTO; FROM helper IMPORT tigrRGB, tigrRGBA; FROM microuiHelpers IMPORT BITAND, IntToStr, HexByte; IMPORT microui; TYPE CharArrayPtr = POINTER TO ARRAY [0..0] OF CHAR; TextCommandPtr = POINTER TO microui.TextCommand; RectCommandPtr = POINTER TO microui.RectCommand; IconCommandPtr = POINTER TO microui.IconCommand; ClipCommandPtr = POINTER TO microui.ClipCommand; CONST WIN_W = 800; WIN_H = 600; VAR ctx : microui.Context; (* big: kept at module scope, not on stack *) ctxPtr : microui.ContextPtr; bmp : TigrPtr; bg : ARRAY [0..2] OF SHORTREAL; logbuf : ARRAY [0..8191] OF CHAR; logbufUpd : BOOLEAN; inputBuf : ARRAY [0..127] OF CHAR; checks : ARRAY [0..2] OF INTEGER; lastLeft, lastRight, lastMiddle : BOOLEAN; prevShift, prevCtrl, prevAlt, prevReturn, prevBack : BOOLEAN; dummyF : SHORTREAL; (*========================================================================*) (* Small helpers *) (*========================================================================*) PROCEDURE Len(s : ARRAY OF CHAR) : INTEGER; VAR n : INTEGER; BEGIN n := 0; WHILE (n <= VAL(INTEGER, HIGH(s))) AND (s[n] # 0C) DO n := n + 1 END; RETURN n END Len; PROCEDURE HasBit(v, bit : CARDINAL) : BOOLEAN; BEGIN RETURN BITAND(v, bit) # 0 END HasBit; PROCEDURE ClampByte(v : SHORTREAL) : BYTE; VAR i : INTEGER; BEGIN i := TRUNC(v); IF i < 0 THEN i := 0 END; IF i > 255 THEN i := 255 END; RETURN VAL(BYTE, i) END ClampByte; PROCEDURE Pix(c : microui.Color) : TPixelType; VAR p : TPixelType; BEGIN p.r := c.r; p.g := c.g; p.b := c.b; p.a := c.a; RETURN p END Pix; PROCEDURE MaxI(a, b : INTEGER) : INTEGER; BEGIN IF a > b THEN RETURN a ELSE RETURN b END END MaxI; PROCEDURE MinI(a, b : INTEGER) : INTEGER; BEGIN IF a < b THEN RETURN a ELSE RETURN b END END MinI; (*========================================================================*) (* microui callbacks *) (*========================================================================*) PROCEDURE TextWidthCB(VAR a : microui.TextWidthArgs) : INTEGER; VAR src : CharArrayPtr; tmp : ARRAY [0..511] OF CHAR; n, i : INTEGER; BEGIN src := CAST(CharArrayPtr, a.str); IF a.len < 0 THEN n := 0; WHILE (src^[n] # 0C) AND (n < 511) DO tmp[n] := src^[n]; n := n + 1 END ELSE n := a.len; IF n > 511 THEN n := 511 END; FOR i := 0 TO n - 1 DO tmp[i] := src^[i] END END; tmp[n] := 0C; RETURN tigrTextWidth(tfont, tmp) END TextWidthCB; PROCEDURE TextHeightCB(VAR a : microui.TextHeightArgs) : INTEGER; BEGIN RETURN tigrTextHeight(tfont, "") END TextHeightCB; (*========================================================================*) (* tigr rendering of microui commands *) (*========================================================================*) PROCEDURE FillRectI(x, y, w, h : INTEGER; c : microui.Color); VAR x0, y0, x1, y1, bw, bh : INTEGER; BEGIN bw := VAL(INTEGER, bmp^.w); bh := VAL(INTEGER, bmp^.h); x0 := MaxI(x, 0); y0 := MaxI(y, 0); x1 := MinI(x + w, bw); y1 := MinI(y + h, bh); IF (x1 > x0) AND (y1 > y0) THEN (* tigrFillRect only fills the *interior* of a rect (it does x+1, y+1, w-2, h-2), so pair it with tigrRect to fill the whole rectangle - and to keep 1px-high/wide rects (microui borders). *) tigrRect(bmp, VAL(CARDINAL, x0), VAL(CARDINAL, y0), VAL(CARDINAL, x1 - x0), VAL(CARDINAL, y1 - y0), Pix(c)); tigrFillRect(bmp, VAL(CARDINAL, x0), VAL(CARDINAL, y0), VAL(CARDINAL, x1 - x0), VAL(CARDINAL, y1 - y0), Pix(c)) END END FillRectI; PROCEDURE SetClipI(r : microui.Rect); VAR x0, y0, x1, y1, bw, bh : INTEGER; BEGIN bw := VAL(INTEGER, bmp^.w); bh := VAL(INTEGER, bmp^.h); x0 := MaxI(r.x, 0); y0 := MaxI(r.y, 0); x1 := MinI(r.x + r.w, bw); y1 := MinI(r.y + r.h, bh); IF (x1 <= x0) OR (y1 <= y0) THEN (* empty clip: use a 1x1 off-screen rect at the top-left *) tigrClip(bmp, 0, 0, 0, 0) ELSE tigrClip(bmp, VAL(CARDINAL, x0), VAL(CARDINAL, y0), VAL(CARDINAL, x1 - x0), VAL(CARDINAL, y1 - y0)) END END SetClipI; PROCEDURE DrawTextCmd(tc : TextCommandPtr); VAR src : CharArrayPtr; x, y : INTEGER; BEGIN src := CAST(CharArrayPtr, ADDADR(CAST(ADDRESS, tc), SIZE(microui.TextCommand))); x := tc^.pos.x; y := tc^.pos.y; IF x < 0 THEN x := 0 END; IF y < 0 THEN y := 0 END; tigrPrint(bmp, tfont, VAL(CARDINAL, x), VAL(CARDINAL, y), Pix(tc^.color), src^) END DrawTextCmd; PROCEDURE DrawIconCmd(ic : IconCommandPtr); VAR r : microui.Rect; p : TPixelType; x0, y0, x1, y1 : CARDINAL; BEGIN r := ic^.rect; p := Pix(ic^.color); x0 := VAL(CARDINAL, MaxI(r.x, 0)); y0 := VAL(CARDINAL, MaxI(r.y, 0)); x1 := VAL(CARDINAL, MaxI(r.x + r.w - 1, 0)); y1 := VAL(CARDINAL, MaxI(r.y + r.h - 1, 0)); IF ic^.id = microui.ICON_CLOSE THEN tigrLine(bmp, x0 + 2, y0 + 2, x1 - 2, y1 - 2, p); tigrLine(bmp, x1 - 2, y0 + 2, x0 + 2, y1 - 2, p) ELSIF ic^.id = microui.ICON_CHECK THEN tigrLine(bmp, x0 + 2, y0 + (y1 - y0) DIV 2, x0 + 4, y1 - 3, p); tigrLine(bmp, x0 + 4, y1 - 3, x1 - 2, y0 + 3, p) ELSIF ic^.id = microui.ICON_COLLAPSED THEN tigrLine(bmp, x0 + 2, (y0 + y1) DIV 2, x1 - 2, (y0 + y1) DIV 2, p); tigrLine(bmp, (x0 + x1) DIV 2, y0 + 2, (x0 + x1) DIV 2, y1 - 2, p) ELSIF ic^.id = microui.ICON_EXPANDED THEN tigrLine(bmp, x0 + 2, (y0 + y1) DIV 2, x1 - 2, (y0 + y1) DIV 2, p) END END DrawIconCmd; PROCEDURE Render; VAR cmd : microui.CommandPtr; tcp : TextCommandPtr; rcp : RectCommandPtr; icp : IconCommandPtr; ccp : ClipCommandPtr; BEGIN tigrClip(bmp, 0, 0, bmp^.w, bmp^.h); tigrClear(bmp, tigrRGBA(ClampByte(bg[0]), ClampByte(bg[1]), ClampByte(bg[2]), VAL(BYTE, 255))); cmd := NIL; WHILE microui.nextCommand(ctxPtr, cmd) # 0 DO IF cmd^.type = microui.COMMAND_RECT THEN rcp := CAST(RectCommandPtr, cmd); FillRectI(rcp^.rect.x, rcp^.rect.y, rcp^.rect.w, rcp^.rect.h, rcp^.color) ELSIF cmd^.type = microui.COMMAND_TEXT THEN tcp := CAST(TextCommandPtr, cmd); DrawTextCmd(tcp) ELSIF cmd^.type = microui.COMMAND_ICON THEN icp := CAST(IconCommandPtr, cmd); DrawIconCmd(icp) ELSIF cmd^.type = microui.COMMAND_CLIP THEN ccp := CAST(ClipCommandPtr, cmd); SetClipI(ccp^.rect) END END; tigrClip(bmp, 0, 0, bmp^.w, bmp^.h) END Render; (*========================================================================*) (* Input *) (*========================================================================*) PROCEDURE FeedKey(key : CARDINAL; flag : INTEGER; VAR prev : BOOLEAN); VAR held : BOOLEAN; BEGIN held := tigrKeyHeld(bmp, key) # 0; IF held AND (NOT prev) THEN microui.inputKeydown(ctxPtr, flag) END; IF (NOT held) AND prev THEN microui.inputKeyup(ctxPtr, flag) END; prev := held END FeedKey; PROCEDURE FeedText; VAR c : CARDINAL; buf : ARRAY [0..7] OF CHAR; discard : ADDRESS; i : INTEGER; BEGIN LOOP c := tigrReadChar(bmp); IF c = 0 THEN EXIT END; FOR i := 0 TO 7 DO buf[i] := 0C END; discard := tigrEncodeUTF8(ADR(buf), VAL(INTEGER, c)); microui.inputText(ctxPtr, buf) END END FeedText; PROCEDURE FeedInput; VAR mx, my, buttons : CARDINAL; x, y : INTEGER; left, right, middle : BOOLEAN; BEGIN tigrMouse(bmp, mx, my, buttons); x := VAL(INTEGER, mx); y := VAL(INTEGER, my); microui.inputMousemove(ctxPtr, x, y); left := HasBit(buttons, VAL(CARDINAL, microui.MOUSE_LEFT)); right := HasBit(buttons, VAL(CARDINAL, microui.MOUSE_RIGHT)); middle := HasBit(buttons, VAL(CARDINAL, microui.MOUSE_MIDDLE)); IF left AND (NOT lastLeft) THEN microui.inputMousedown(ctxPtr, x, y, microui.MOUSE_LEFT) ELSIF (NOT left) AND lastLeft THEN microui.inputMouseup(ctxPtr, x, y, microui.MOUSE_LEFT) END; IF right AND (NOT lastRight) THEN microui.inputMousedown(ctxPtr, x, y, microui.MOUSE_RIGHT) ELSIF (NOT right) AND lastRight THEN microui.inputMouseup(ctxPtr, x, y, microui.MOUSE_RIGHT) END; IF middle AND (NOT lastMiddle) THEN microui.inputMousedown(ctxPtr, x, y, microui.MOUSE_MIDDLE) ELSIF (NOT middle) AND lastMiddle THEN microui.inputMouseup(ctxPtr, x, y, microui.MOUSE_MIDDLE) END; lastLeft := left; lastRight := right; lastMiddle := middle; FeedKey(TK_LSHIFT, microui.KEY_SHIFT, prevShift); FeedKey(TK_RSHIFT, microui.KEY_SHIFT, prevShift); FeedKey(TK_LCONTROL, microui.KEY_CTRL, prevCtrl); FeedKey(TK_RCONTROL, microui.KEY_CTRL, prevCtrl); FeedKey(TK_LALT, microui.KEY_ALT, prevAlt); FeedKey(TK_RALT, microui.KEY_ALT, prevAlt); FeedKey(TK_RETURN, microui.KEY_RETURN, prevReturn); FeedKey(TK_BACKSPACE, microui.KEY_BACKSPACE, prevBack); FeedText END FeedInput; (*========================================================================*) (* Log helpers *) (*========================================================================*) PROCEDURE WriteLog(s : ARRAY OF CHAR); VAR i, n, l : INTEGER; BEGIN l := Len(logbuf); IF l > 0 THEN logbuf[l] := CHR(10); l := l + 1 END; n := Len(s); i := 0; WHILE (i < n) AND (l < VAL(INTEGER, HIGH(logbuf))) DO logbuf[l] := s[i]; l := l + 1; i := i + 1 END; logbuf[l] := 0C; logbufUpd := TRUE END WriteLog; PROCEDURE FmtPair(VAR buf : ARRAY OF CHAR; a, b : INTEGER); VAR s : ARRAY [0..31] OF CHAR; n, i, p : INTEGER; BEGIN p := IntToStr(buf, a); buf[p] := ','; p := p + 1; buf[p] := ' '; p := p + 1; n := IntToStr(s, b); FOR i := 0 TO n - 1 DO buf[p] := s[i]; p := p + 1 END; buf[p] := 0C END FmtPair; PROCEDURE FmtHex(VAR buf : ARRAY OF CHAR; r, g, b : CARDINAL); VAR s : ARRAY [0..3] OF CHAR; n : CARDINAL; BEGIN buf[0] := '#'; buf[1] := 0C; n := HexByte(s, r); buf[1] := s[0]; buf[2] := s[1]; buf[3] := 0C; n := HexByte(s, g); buf[3] := s[0]; buf[4] := s[1]; buf[5] := 0C; n := HexByte(s, b); buf[5] := s[0]; buf[6] := s[1]; buf[7] := 0C END FmtHex; (*========================================================================*) (* Demo windows *) (*========================================================================*) PROCEDURE TestWindow; VAR win : microui.ContainerPtr; widths : ARRAY [0..3] OF INTEGER; buf : ARRAY [0..63] OF CHAR; hex : ARRAY [0..15] OF CHAR; preview : microui.Rect; res : INTEGER; cptr : microui.IntPtr; BEGIN IF microui.beginWindow(ctxPtr, "Demo Window", microui.rect(40, 40, 340, 480)) # 0 THEN win := microui.getCurrentContainer(ctxPtr); IF win^.rect.w < 240 THEN win^.rect.w := 240 END; IF win^.rect.h < 300 THEN win^.rect.h := 300 END; (* --- Window Info ------------------------------------------------ *) IF microui.header(ctxPtr, "Window Info") # 0 THEN win := microui.getCurrentContainer(ctxPtr); widths[0] := 64; widths[1] := -1; microui.layoutRow(ctxPtr, 2, ADR(widths), 0); microui.label(ctxPtr, "Position:"); FmtPair(buf, win^.rect.x, win^.rect.y); microui.label(ctxPtr, buf); microui.label(ctxPtr, "Size:"); FmtPair(buf, win^.rect.w, win^.rect.h); microui.label(ctxPtr, buf) END; (* --- Buttons + popup -------------------------------------------- *) IF microui.headerEx(ctxPtr, "Test Buttons", microui.OPT_EXPANDED) # 0 THEN widths[0] := 86; widths[1] := -110; widths[2] := -1; microui.layoutRow(ctxPtr, 3, ADR(widths), 0); microui.label(ctxPtr, "Test buttons 1:"); IF microui.button(ctxPtr, "Button 1") # 0 THEN WriteLog("Pressed button 1") END; IF microui.button(ctxPtr, "Button 2") # 0 THEN WriteLog("Pressed button 2") END; microui.label(ctxPtr, "Test buttons 2:"); IF microui.button(ctxPtr, "Button 3") # 0 THEN WriteLog("Pressed button 3") END; IF microui.button(ctxPtr, "Popup") # 0 THEN microui.openPopup(ctxPtr, "Test Popup") END; IF microui.beginPopup(ctxPtr, "Test Popup") # 0 THEN IF microui.button(ctxPtr, "Hello") # 0 THEN WriteLog("Pressed Hello") END; IF microui.button(ctxPtr, "World") # 0 THEN WriteLog("Pressed World") END; microui.endPopup(ctxPtr) END END; (* --- Tree + text ------------------------------------------------- *) IF microui.headerEx(ctxPtr, "Tree and Text", microui.OPT_EXPANDED) # 0 THEN widths[0] := 150; widths[1] := -1; microui.layoutRow(ctxPtr, 2, ADR(widths), 0); microui.layoutBeginColumn(ctxPtr); IF microui.beginTreenode(ctxPtr, "Test 1") # 0 THEN IF microui.beginTreenode(ctxPtr, "Test 1a") # 0 THEN microui.label(ctxPtr, "Hello"); microui.label(ctxPtr, "world"); microui.endTreenode(ctxPtr) END; IF microui.beginTreenode(ctxPtr, "Test 1b") # 0 THEN IF microui.button(ctxPtr, "Button 1") # 0 THEN WriteLog("Pressed button 1") END; IF microui.button(ctxPtr, "Button 2") # 0 THEN WriteLog("Pressed button 2") END; microui.endTreenode(ctxPtr) END; microui.endTreenode(ctxPtr) END; IF microui.beginTreenode(ctxPtr, "Test 2") # 0 THEN widths[0] := 54; widths[1] := 54; microui.layoutRow(ctxPtr, 2, ADR(widths), 0); IF microui.button(ctxPtr, "Button 3") # 0 THEN WriteLog("Pressed button 3") END; IF microui.button(ctxPtr, "Button 4") # 0 THEN WriteLog("Pressed button 4") END; IF microui.button(ctxPtr, "Button 5") # 0 THEN WriteLog("Pressed button 5") END; IF microui.button(ctxPtr, "Button 6") # 0 THEN WriteLog("Pressed button 6") END; microui.endTreenode(ctxPtr) END; IF microui.beginTreenode(ctxPtr, "Test 3") # 0 THEN cptr := CAST(microui.IntPtr, ADR(checks[0])); res := microui.checkbox(ctxPtr, "Checkbox 1", cptr); cptr := CAST(microui.IntPtr, ADR(checks[1])); res := microui.checkbox(ctxPtr, "Checkbox 2", cptr); cptr := CAST(microui.IntPtr, ADR(checks[2])); res := microui.checkbox(ctxPtr, "Checkbox 3", cptr); microui.endTreenode(ctxPtr) END; microui.layoutEndColumn(ctxPtr); microui.layoutBeginColumn(ctxPtr); widths[0] := -1; microui.layoutRow(ctxPtr, 1, ADR(widths), 0); microui.text(ctxPtr, "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Maecenas lacinia, sem eu lacinia molestie, mi risus faucibus ipsum, eu varius magna felis a nulla."); microui.layoutEndColumn(ctxPtr) END; (* --- Background color -------------------------------------------- *) IF microui.headerEx(ctxPtr, "Background Color", microui.OPT_EXPANDED) # 0 THEN widths[0] := -78; widths[1] := -1; microui.layoutRow(ctxPtr, 2, ADR(widths), 74); microui.layoutBeginColumn(ctxPtr); widths[0] := 46; widths[1] := -1; microui.layoutRow(ctxPtr, 2, ADR(widths), 0); microui.label(ctxPtr, "Red:"); res := microui.slider(ctxPtr, CAST(microui.RealPtr, ADR(bg[0])), 0.0, 255.0); microui.label(ctxPtr, "Green:"); res := microui.slider(ctxPtr, CAST(microui.RealPtr, ADR(bg[1])), 0.0, 255.0); microui.label(ctxPtr, "Blue:"); res := microui.slider(ctxPtr, CAST(microui.RealPtr, ADR(bg[2])), 0.0, 255.0); microui.layoutEndColumn(ctxPtr); win := microui.getCurrentContainer(ctxPtr); preview := microui.layoutNext(ctxPtr); microui.drawRect(ctxPtr, preview, microui.color(TRUNC(bg[0]), TRUNC(bg[1]), TRUNC(bg[2]), 255)); FmtHex(hex, VAL(CARDINAL, TRUNC(bg[0])), VAL(CARDINAL, TRUNC(bg[1])), VAL(CARDINAL, TRUNC(bg[2]))); microui.drawControlText(ctxPtr, hex, preview, microui.COLOR_TEXT, microui.OPT_ALIGNCENTER) END; microui.endWindow(ctxPtr) END END TestWindow; PROCEDURE LogWindow; VAR widths : ARRAY [0..2] OF INTEGER; panel : microui.ContainerPtr; submitted : BOOLEAN; res : INTEGER; BEGIN IF microui.beginWindow(ctxPtr, "Log Window", microui.rect(400, 40, 360, 240)) # 0 THEN widths[0] := -1; microui.layoutRow(ctxPtr, 1, ADR(widths), -25); microui.beginPanel(ctxPtr, "Log Output"); panel := microui.getCurrentContainer(ctxPtr); widths[0] := -1; microui.layoutRow(ctxPtr, 1, ADR(widths), -1); microui.text(ctxPtr, logbuf); microui.endPanel(ctxPtr); IF logbufUpd THEN panel^.scroll.y := panel^.contentSize.y; logbufUpd := FALSE END; widths[0] := -70; widths[1] := -1; microui.layoutRow(ctxPtr, 2, ADR(widths), 0); submitted := FALSE; res := microui.textbox(ctxPtr, ADR(inputBuf), SIZE(inputBuf)); IF BITAND(VAL(CARDINAL, res), VAL(CARDINAL, microui.RES_SUBMIT)) # 0 THEN microui.setFocus(ctxPtr, ctxPtr^.lastId); submitted := TRUE END; IF microui.button(ctxPtr, "Submit") # 0 THEN submitted := TRUE END; IF submitted THEN WriteLog(inputBuf); inputBuf[0] := 0C END; microui.endWindow(ctxPtr) END END LogWindow; (*========================================================================*) (* Main *) (*========================================================================*) BEGIN bmp := tigrWindow(WIN_W, WIN_H, "microui + tigr (Modula-2)", TIGR_AUTO); IF bmp = NIL THEN tigrError(NIL, "Cannot create window") END; ctxPtr := CAST(microui.ContextPtr, ADR(ctx)); microui.init(ctxPtr); ctxPtr^.textWidth := TextWidthCB; ctxPtr^.textHeight := TextHeightCB; ctxPtr^.style^.font := CAST(ADDRESS, tfont); bg[0] := 90.0; bg[1] := 95.0; bg[2] := 100.0; logbuf[0] := 0C; inputBuf[0] := 0C; checks[0] := 1; checks[1] := 0; checks[2] := 1; lastLeft := FALSE; lastRight := FALSE; lastMiddle := FALSE; prevShift := FALSE; prevCtrl := FALSE; prevAlt := FALSE; prevReturn := FALSE; prevBack := FALSE; WriteLog("microui port running"); WHILE (tigrClosed(bmp) = 0) AND (tigrKeyDown(bmp, TK_ESCAPE) = 0) DO dummyF := tigrTime(); FeedInput; microui.begin(ctxPtr); LogWindow; TestWindow; microui.end(ctxPtr); Render; tigrUpdate(bmp) END; tigrFree(bmp) END microuiDemo.