Tigr-m2/modula2/examples/microui-demo/microui-headless.mod

MODULE microuiHeadless;

(* Off-screen smoke test for the Modula-2 microui port: builds a representative
   UI, renders it with tigr into a bitmap and writes microui-demo.png.

   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-headless.mod -o microui-headless -lGL -lX11
*)

FROM SYSTEM IMPORT ADDRESS, ADR, CAST, ADDADR, BYTE;
FROM tigr IMPORT TigrPtr, tigrBitmap, tigrClear, tigrPrint, tigrSaveImage,
                 tigrFree, tigrFillRect, tigrRect, tigrTextWidth, tigrTextHeight,
                 tfont, TPixelType;
FROM microuiHelpers IMPORT BITAND;
FROM helper IMPORT tigrRGB;
IMPORT microui;
FROM InOut IMPORT WriteString, WriteLn;

TYPE
    CharArrayPtr   = POINTER TO ARRAY [0..0] OF CHAR;
    TextCommandPtr = POINTER TO microui.TextCommand;
    RectCommandPtr = POINTER TO microui.RectCommand;

CONST
    WIN_W = 760;
    WIN_H = 520;

VAR
    ctx    : microui.Context;
    ctxPtr : microui.ContextPtr;
    bmp    : TigrPtr;
    ok     : INTEGER;

PROCEDURE MinI(a, b : INTEGER) : INTEGER;
BEGIN IF a < b THEN RETURN a ELSE RETURN b END END MinI;

PROCEDURE MaxI(a, b : INTEGER) : INTEGER;
BEGIN IF a > b THEN RETURN a ELSE RETURN b END END MaxI;

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 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;

PROCEDURE FillRectI(x, y, w, h : INTEGER; c : microui.Color);
    VAR x0, y0, x1, y1 : INTEGER;
BEGIN
    x0 := MaxI(x, 0);
    y0 := MaxI(y, 0);
    x1 := MinI(x + w, WIN_W);
    y1 := MinI(y + h, WIN_H);
    IF (x1 > x0) AND (y1 > y0) THEN
        (* tigrFillRect only fills the interior; pair it with tigrRect so the
           whole rect (including 1px borders) is drawn, with clipping/blending *)
        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 BuildUI;
    VAR widths : ARRAY [0..3] OF INTEGER;
        inputBuf : ARRAY [0..63] OF CHAR;
        checks : ARRAY [0..1] OF INTEGER;
        dummy : INTEGER;
        cptr : microui.IntPtr;
        bgv : SHORTREAL;
BEGIN
    inputBuf := "Hello, microui!";
    checks[0] := 1; checks[1] := 0;
    bgv := 120.0;

    IF microui.beginWindow(ctxPtr, "Demo Window",
                           microui.rect(30, 30, 330, 440)) # 0 THEN
        IF microui.headerEx(ctxPtr, "Window Info", microui.OPT_EXPANDED) # 0 THEN
            widths[0] := 64; widths[1] := -1;
            microui.layoutRow(ctxPtr, 2, ADR(widths), 0);
            microui.label(ctxPtr, "Position:");
            microui.label(ctxPtr, "30, 30");
            microui.label(ctxPtr, "Size:");
            microui.label(ctxPtr, "330, 440")
        END;

        IF microui.headerEx(ctxPtr, "Widgets", microui.OPT_EXPANDED) # 0 THEN
            widths[0] := 100; widths[1] := -1;
            microui.layoutRow(ctxPtr, 2, ADR(widths), 0);
            microui.label(ctxPtr, "Button:");
            dummy := microui.button(ctxPtr, "Press me");
            microui.label(ctxPtr, "Slider:");
            dummy := microui.slider(ctxPtr, CAST(microui.RealPtr, ADR(bgv)),
                                    0.0, 255.0);
            microui.label(ctxPtr, "Checkbox:");
            cptr := CAST(microui.IntPtr, ADR(checks[0]));
            dummy := microui.checkbox(ctxPtr, "Enabled", cptr);
            microui.label(ctxPtr, "Text box:");
            dummy := microui.textbox(ctxPtr, ADR(inputBuf), SIZE(inputBuf))
        END;

        IF microui.headerEx(ctxPtr, "Tree", microui.OPT_EXPANDED) # 0 THEN
            IF microui.beginTreenode(ctxPtr, "Node A") # 0 THEN
                microui.label(ctxPtr, "child one");
                microui.label(ctxPtr, "child two");
                microui.endTreenode(ctxPtr)
            END;
            IF microui.beginTreenode(ctxPtr, "Node B") # 0 THEN
                dummy := microui.button(ctxPtr, "Inside B");
                microui.endTreenode(ctxPtr)
            END
        END;

        IF microui.headerEx(ctxPtr, "Text", microui.OPT_EXPANDED) # 0 THEN
            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.");
            microui.layoutRow(ctxPtr, 1, ADR(widths), 0);
            microui.text(ctxPtr, "The quick brown fox jumps over the lazy dog.")
        END;

        microui.endWindow(ctxPtr)
    END;

    IF microui.beginWindow(ctxPtr, "Second Window",
                           microui.rect(380, 30, 340, 160)) # 0 THEN
        widths[0] := -1;
        microui.layoutRow(ctxPtr, 1, ADR(widths), 0);
        microui.text(ctxPtr, "A second window to check z-ordering and colours.");
        widths[0] := -1; widths[1] := 120;
        microui.layoutRow(ctxPtr, 2, ADR(widths), 0);
        microui.label(ctxPtr, "Disabled:");
        dummy := microui.buttonEx(ctxPtr, "Nope", 0, microui.OPT_NOINTERACT);
        microui.endWindow(ctxPtr)
    END
END BuildUI;

PROCEDURE Render;
    VAR cmd : microui.CommandPtr;
        tcp : TextCommandPtr;
        rcp : RectCommandPtr;
        src : CharArrayPtr;
        x, y : INTEGER;
BEGIN
    tigrClear(bmp, tigrRGB(90, 95, 100));
    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);
            src := CAST(CharArrayPtr,
                        ADDADR(CAST(ADDRESS, tcp), SIZE(microui.TextCommand)));
            x := MaxI(tcp^.pos.x, 0);
            y := MaxI(tcp^.pos.y, 0);
            tigrPrint(bmp, tfont, VAL(CARDINAL, x), VAL(CARDINAL, y),
                      Pix(tcp^.color), src^)
        END
    END
END Render;

BEGIN
    bmp := tigrBitmap(WIN_W, WIN_H);
    ctxPtr := CAST(microui.ContextPtr, ADR(ctx));
    microui.init(ctxPtr);
    ctxPtr^.textWidth := TextWidthCB;
    ctxPtr^.textHeight := TextHeightCB;
    ctxPtr^.style^.font := CAST(ADDRESS, tfont);

    (* Run a few frames with synthetic input so hover/focus/drag paths are
       exercised before the final frame is saved. *)
    microui.inputMousemove(ctxPtr, 120, 100);
    microui.begin(ctxPtr);
    BuildUI;
    microui.end(ctxPtr);

    microui.inputMousedown(ctxPtr, 120, 100, microui.MOUSE_LEFT);
    microui.begin(ctxPtr);
    BuildUI;
    microui.end(ctxPtr);

    microui.inputMousemove(ctxPtr, 160, 130);
    microui.begin(ctxPtr);
    BuildUI;
    microui.end(ctxPtr);
    microui.inputMouseup(ctxPtr, 160, 130, microui.MOUSE_LEFT);

    microui.inputMousemove(ctxPtr, 60, 60);
    microui.begin(ctxPtr);
    BuildUI;
    microui.end(ctxPtr);
    Render;

    ok := tigrSaveImage("microui-demo.png", bmp);
    IF ok = 0 THEN
        WriteString("tigrSaveImage failed");
        WriteLn
    ELSE
        WriteString("wrote microui-demo.png");
        WriteLn
    END;
    tigrFree(bmp)
END microuiHeadless.