Tigr-m2/modula2/microui.def

DEFINITION MODULE microui;

(* Modula-2 port of microui v2.02 by rxi (MIT license).
   Rewrite of the C API in ISO Modula-2 for GNU Modula-2 (gm2 -fiso).

   Compilation (from modula2/):
       gm2 -fiso -I. -c microuiHelpers.mod
       gm2 -fiso -I. -c microui.mod

   GM2 notes:
   - GNU Modula-2 (GCC 16.0.1) only accepts procedure *types* whose formal
     parameter list is a single, unnamed type, e.g.
         PROCEDURE(VAR Args) : INTEGER
     Named and/or multiple parameters are rejected. The C callbacks taking
     several arguments are therefore called through small argument records
     (TextWidthArgs, FrameArgs).
   - The C `mu_Command` union is represented by a `BaseCommand` header plus
     fixed-layout record types; command buffers are accessed through
     `CAST(CommandPtr, ...)` to the relevant record type.
*)

FROM SYSTEM IMPORT ADDRESS, BYTE;

CONST
    VERSION = '2.02';

    COMMANDLIST_SIZE    = 262144;  (* 256 * 1024 *)
    ROOTLIST_SIZE       = 32;
    CONTAINERSTACK_SIZE = 32;
    CLIPSTACK_SIZE      = 32;
    IDSTACK_SIZE        = 32;
    LAYOUTSTACK_SIZE    = 16;
    CONTAINERPOOL_SIZE  = 48;
    TREENODEPOOL_SIZE   = 48;
    MAX_WIDTHS          = 16;
    MAX_FMT             = 127;

    (* Clip results *)
    CLIP_PART = 1;
    CLIP_ALL  = 2;

    (* Command types *)
    COMMAND_JUMP = 1;
    COMMAND_CLIP = 2;
    COMMAND_RECT = 3;
    COMMAND_TEXT = 4;
    COMMAND_ICON = 5;
    COMMAND_MAX  = 6;

    (* Color IDs *)
    COLOR_TEXT        = 0;
    COLOR_BORDER      = 1;
    COLOR_WINDOWBG    = 2;
    COLOR_TITLEBG     = 3;
    COLOR_TITLETEXT   = 4;
    COLOR_PANELBG     = 5;
    COLOR_BUTTON      = 6;
    COLOR_BUTTONHOVER = 7;
    COLOR_BUTTONFOCUS = 8;
    COLOR_BASE        = 9;
    COLOR_BASEHOVER   = 10;
    COLOR_BASEFOCUS   = 11;
    COLOR_SCROLLBASE  = 12;
    COLOR_SCROLLTHUMB = 13;
    COLOR_MAX         = 14;

    (* Icons *)
    ICON_CLOSE     = 1;
    ICON_CHECK     = 2;
    ICON_COLLAPSED = 3;
    ICON_EXPANDED  = 4;
    ICON_MAX       = 5;

    (* Result flags *)
    RES_ACTIVE = 1;
    RES_SUBMIT = 2;
    RES_CHANGE = 4;

    (* Option flags - one bit each *)
    OPT_ALIGNCENTER = 1;
    OPT_ALIGNRIGHT  = 2;
    OPT_NOINTERACT  = 4;
    OPT_NOFRAME     = 8;
    OPT_NORESIZE    = 16;
    OPT_NOSCROLL    = 32;
    OPT_NOCLOSE     = 64;
    OPT_NOTITLE     = 128;
    OPT_HOLDFOCUS   = 256;
    OPT_AUTOSIZE    = 512;
    OPT_POPUP       = 1024;
    OPT_CLOSED      = 2048;
    OPT_EXPANDED    = 4096;

    (* Mouse buttons *)
    MOUSE_LEFT   = 1;
    MOUSE_RIGHT  = 2;
    MOUSE_MIDDLE = 4;

    (* Key flags *)
    KEY_SHIFT     = 1;
    KEY_CTRL      = 2;
    KEY_ALT       = 4;
    KEY_BACKSPACE = 8;
    KEY_RETURN    = 16;

    (* mu_Real formatting, matching MU_REAL_FMT / MU_SLIDER_FMT *)
    REAL_FMT   = '%.3g';
    SLIDER_FMT = '%.2f';

TYPE
    Id   = CARDINAL;
    Real = SHORTREAL;
    Font = ADDRESS;
    IntPtr  = POINTER TO INTEGER;
    RealPtr = POINTER TO Real;

    Vec2 = RECORD
        x, y : INTEGER;
    END;

    Rect = RECORD
        x, y, w, h : INTEGER;
    END;

    Color = RECORD
        r, g, b, a : BYTE;
    END;

    PoolItem = RECORD
        id         : Id;
        lastUpdate : INTEGER;
    END;

(* --- command records (mirror the C structs, no `str` field in TextCommand) *)

    BaseCommand = RECORD
        type, size : INTEGER;
    END;

    JumpCommand = RECORD
        base : BaseCommand;
        dst  : ADDRESS;
    END;

    ClipCommand = RECORD
        base : BaseCommand;
        rect : Rect;
    END;

    RectCommand = RECORD
        base  : BaseCommand;
        rect  : Rect;
        color : Color;
    END;

    TextCommand = RECORD
        base  : BaseCommand;
        font  : Font;
        pos   : Vec2;
        color : Color;
        (* the NUL-terminated string follows at offset SIZE(TextCommand) *)
    END;

    IconCommand = RECORD
        base  : BaseCommand;
        rect  : Rect;
        id    : INTEGER;
        color : Color;
    END;

    CommandPtr = POINTER TO BaseCommand;

    Layout = RECORD
        body      : Rect;
        next      : Rect;
        position  : Vec2;
        size      : Vec2;
        max       : Vec2;
        widths    : ARRAY [0..MAX_WIDTHS - 1] OF INTEGER;
        items     : INTEGER;
        itemIndex : INTEGER;
        nextRow   : INTEGER;
        nextType  : INTEGER;
        indent    : INTEGER;
    END;

    Container = RECORD
        head, tail  : CommandPtr;
        rect        : Rect;
        body        : Rect;
        contentSize : Vec2;
        scroll      : Vec2;
        zindex      : INTEGER;
        open        : INTEGER;
    END;
    ContainerPtr = POINTER TO Container;

    Style = RECORD
        font          : Font;
        size          : Vec2;
        padding       : INTEGER;
        spacing       : INTEGER;
        indent        : INTEGER;
        titleHeight   : INTEGER;
        scrollbarSize : INTEGER;
        thumbSize     : INTEGER;
        colors        : ARRAY [0..COLOR_MAX - 1] OF Color;
    END;

(* --- callbacks ----------------------------------------------------------
   The context is carried as ADDRESS to keep the argument records free of a
   forward reference to ContextPtr. *)

    TextWidthArgs = RECORD
        ctx  : ADDRESS;
        font : Font;
        str  : ADDRESS;
        len  : INTEGER;
    END;

    TextHeightArgs = RECORD
        ctx  : ADDRESS;
        font : Font;
    END;

    FrameArgs = RECORD
        ctx     : ADDRESS;
        rect    : Rect;
        colorid : INTEGER;
    END;

    TextWidthProc  = PROCEDURE(VAR TextWidthArgs) : INTEGER;
    TextHeightProc = PROCEDURE(VAR TextHeightArgs) : INTEGER;
    DrawFrameProc  = PROCEDURE(VAR FrameArgs);

    ContainerStack = RECORD
        idx   : INTEGER;
        items : ARRAY [0..CONTAINERSTACK_SIZE - 1] OF ContainerPtr;
    END;

    ClipStack = RECORD
        idx   : INTEGER;
        items : ARRAY [0..CLIPSTACK_SIZE - 1] OF Rect;
    END;

    IdStack = RECORD
        idx   : INTEGER;
        items : ARRAY [0..IDSTACK_SIZE - 1] OF Id;
    END;

    LayoutStack = RECORD
        idx   : INTEGER;
        items : ARRAY [0..LAYOUTSTACK_SIZE - 1] OF Layout;
    END;

    RootStack = RECORD
        idx   : INTEGER;
        items : ARRAY [0..ROOTLIST_SIZE - 1] OF ContainerPtr;
    END;

    CommandStack = RECORD
        idx   : INTEGER;
        items : ARRAY [0..COMMANDLIST_SIZE - 1] OF CHAR;
    END;

    Context = RECORD
        (* callbacks *)
        textWidth    : TextWidthProc;
        textHeight   : TextHeightProc;
        drawFrame    : DrawFrameProc;
        (* core state *)
        _style        : Style;
        style         : POINTER TO Style;
        hover         : Id;
        focus         : Id;
        lastId        : Id;
        lastRect      : Rect;
        lastZindex    : INTEGER;
        updatedFocus  : INTEGER;
        frame         : INTEGER;
        hoverRoot     : ContainerPtr;
        nextHoverRoot : ContainerPtr;
        scrollTarget  : ContainerPtr;
        numberEditBuf : ARRAY [0..MAX_FMT] OF CHAR;
        numberEdit    : Id;
        (* stacks *)
        commandList    : CommandStack;
        rootList       : RootStack;
        containerStack : ContainerStack;
        clipStack      : ClipStack;
        idStack        : IdStack;
        layoutStack    : LayoutStack;
        (* retained state pools *)
        containerPool : ARRAY [0..CONTAINERPOOL_SIZE - 1] OF PoolItem;
        containers    : ARRAY [0..CONTAINERPOOL_SIZE - 1] OF Container;
        treenodePool  : ARRAY [0..TREENODEPOOL_SIZE - 1] OF PoolItem;
        (* input state *)
        mousePos     : Vec2;
        lastMousePos : Vec2;
        mouseDelta   : Vec2;
        scrollDelta  : Vec2;
        mouseDown    : INTEGER;
        mousePressed : INTEGER;
        keyDown      : INTEGER;
        keyPressed   : INTEGER;
        inputText    : ARRAY [0..31] OF CHAR;
    END;
    ContextPtr = POINTER TO Context;

(* ======================================================================== *)
(*  Constructors                                                            *)
(* ======================================================================== *)

PROCEDURE vec2(x, y : INTEGER) : Vec2;
PROCEDURE rect(x, y, w, h : INTEGER) : Rect;
PROCEDURE color(r, g, b, a : INTEGER) : Color;

(* ======================================================================== *)
(*  Core                                                                    *)
(* ======================================================================== *)

PROCEDURE init(ctx : ContextPtr);
PROCEDURE begin(ctx : ContextPtr);
PROCEDURE end(ctx : ContextPtr);
PROCEDURE setFocus(ctx : ContextPtr; id : Id);
PROCEDURE getId(ctx : ContextPtr; data : ADDRESS; size : INTEGER) : Id;
PROCEDURE pushId(ctx : ContextPtr; data : ADDRESS; size : INTEGER);
PROCEDURE popId(ctx : ContextPtr);
PROCEDURE pushClipRect(ctx : ContextPtr; r : Rect);
PROCEDURE popClipRect(ctx : ContextPtr);
PROCEDURE getClipRect(ctx : ContextPtr) : Rect;
PROCEDURE checkClip(ctx : ContextPtr; r : Rect) : INTEGER;
PROCEDURE getCurrentContainer(ctx : ContextPtr) : ContainerPtr;
PROCEDURE getContainer(ctx : ContextPtr; name : ARRAY OF CHAR) : ContainerPtr;
PROCEDURE bringToFront(ctx : ContextPtr; cnt : ContainerPtr);

(* ======================================================================== *)
(*  Pool                                                                    *)
(* ======================================================================== *)

PROCEDURE poolInit(ctx : ContextPtr; items : ADDRESS; len : INTEGER;
                   id : Id) : INTEGER;
PROCEDURE poolGet(ctx : ContextPtr; items : ADDRESS; len : INTEGER;
                  id : Id) : INTEGER;
PROCEDURE poolUpdate(ctx : ContextPtr; items : ADDRESS; idx : INTEGER);

(* ======================================================================== *)
(*  Input                                                                   *)
(* ======================================================================== *)

PROCEDURE inputMousemove(ctx : ContextPtr; x, y : INTEGER);
PROCEDURE inputMousedown(ctx : ContextPtr; x, y, btn : INTEGER);
PROCEDURE inputMouseup(ctx : ContextPtr; x, y, btn : INTEGER);
PROCEDURE inputScroll(ctx : ContextPtr; x, y : INTEGER);
PROCEDURE inputKeydown(ctx : ContextPtr; key : INTEGER);
PROCEDURE inputKeyup(ctx : ContextPtr; key : INTEGER);
PROCEDURE inputText(ctx : ContextPtr; text : ARRAY OF CHAR);

(* ======================================================================== *)
(*  Command list                                                            *)
(* ======================================================================== *)

PROCEDURE pushCommand(ctx : ContextPtr; type, size : INTEGER) : CommandPtr;
PROCEDURE nextCommand(ctx : ContextPtr; VAR cmd : CommandPtr) : INTEGER;
PROCEDURE setClip(ctx : ContextPtr; r : Rect);
PROCEDURE drawRect(ctx : ContextPtr; r : Rect; color : Color);
PROCEDURE drawBox(ctx : ContextPtr; r : Rect; color : Color);
PROCEDURE drawText(ctx : ContextPtr; font : Font; str : ADDRESS; len : INTEGER;
                   pos : Vec2; color : Color);
PROCEDURE drawIcon(ctx : ContextPtr; id : INTEGER; r : Rect; color : Color);

(* ======================================================================== *)
(*  Layout                                                                  *)
(* ======================================================================== *)

PROCEDURE layoutRow(ctx : ContextPtr; items : INTEGER;
                    widths : ADDRESS; height : INTEGER);
PROCEDURE layoutWidth(ctx : ContextPtr; width : INTEGER);
PROCEDURE layoutHeight(ctx : ContextPtr; height : INTEGER);
PROCEDURE layoutBeginColumn(ctx : ContextPtr);
PROCEDURE layoutEndColumn(ctx : ContextPtr);
PROCEDURE layoutSetNext(ctx : ContextPtr; r : Rect; relative : INTEGER);
PROCEDURE layoutNext(ctx : ContextPtr) : Rect;

(* ======================================================================== *)
(*  Controls                                                                *)
(* ======================================================================== *)

PROCEDURE drawControlFrame(ctx : ContextPtr; id : Id; r : Rect;
                           colorid, opt : INTEGER);
PROCEDURE drawControlText(ctx : ContextPtr; str : ARRAY OF CHAR;
                          r : Rect; colorid, opt : INTEGER);
PROCEDURE mouseOver(ctx : ContextPtr; r : Rect) : INTEGER;
PROCEDURE updateControl(ctx : ContextPtr; id : Id; r : Rect; opt : INTEGER);

(* ======================================================================== *)
(*  Widgets                                                                 *)
(* ======================================================================== *)

PROCEDURE text(ctx : ContextPtr; str : ARRAY OF CHAR);
PROCEDURE label(ctx : ContextPtr; str : ARRAY OF CHAR);
PROCEDURE buttonEx(ctx : ContextPtr; label : ARRAY OF CHAR;
                   icon, opt : INTEGER) : INTEGER;
PROCEDURE checkbox(ctx : ContextPtr; label : ARRAY OF CHAR;
                   state : IntPtr) : INTEGER;
PROCEDURE textboxRaw(ctx : ContextPtr; buf : ADDRESS; bufsz : INTEGER;
                     id : Id; r : Rect; opt : INTEGER) : INTEGER;
PROCEDURE textboxEx(ctx : ContextPtr; buf : ADDRESS;
                    bufsz, opt : INTEGER) : INTEGER;
PROCEDURE sliderEx(ctx : ContextPtr; value : RealPtr;
                   low, high, step : Real;
                   fmt : ARRAY OF CHAR; opt : INTEGER) : INTEGER;
PROCEDURE numberEx(ctx : ContextPtr; value : RealPtr;
                   step : Real; fmt : ARRAY OF CHAR;
                   opt : INTEGER) : INTEGER;
PROCEDURE headerEx(ctx : ContextPtr; label : ARRAY OF CHAR;
                   opt : INTEGER) : INTEGER;
PROCEDURE beginTreenodeEx(ctx : ContextPtr; label : ARRAY OF CHAR;
                          opt : INTEGER) : INTEGER;
PROCEDURE endTreenode(ctx : ContextPtr);
PROCEDURE beginWindowEx(ctx : ContextPtr; title : ARRAY OF CHAR;
                        r : Rect; opt : INTEGER) : INTEGER;
PROCEDURE endWindow(ctx : ContextPtr);
PROCEDURE openPopup(ctx : ContextPtr; name : ARRAY OF CHAR);
PROCEDURE beginPopup(ctx : ContextPtr; name : ARRAY OF CHAR) : INTEGER;
PROCEDURE endPopup(ctx : ContextPtr);
PROCEDURE beginPanelEx(ctx : ContextPtr; name : ARRAY OF CHAR;
                       opt : INTEGER);
PROCEDURE endPanel(ctx : ContextPtr);

(* ======================================================================== *)
(*  Convenience wrappers (the C macros)                                     *)
(* ======================================================================== *)

PROCEDURE button(ctx : ContextPtr; label : ARRAY OF CHAR) : INTEGER;
PROCEDURE textbox(ctx : ContextPtr; buf : ADDRESS; bufsz : INTEGER) : INTEGER;
PROCEDURE slider(ctx : ContextPtr; value : RealPtr;
                 low, high : Real) : INTEGER;
PROCEDURE number(ctx : ContextPtr; value : RealPtr;
                 step : Real) : INTEGER;
PROCEDURE header(ctx : ContextPtr; label : ARRAY OF CHAR) : INTEGER;
PROCEDURE beginTreenode(ctx : ContextPtr; label : ARRAY OF CHAR) : INTEGER;
PROCEDURE beginWindow(ctx : ContextPtr; title : ARRAY OF CHAR;
                      r : Rect) : INTEGER;
PROCEDURE beginPanel(ctx : ContextPtr; name : ARRAY OF CHAR);

END microui.