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.