From ae2aef01199d9793d74bd851a551ce23cd2d9c9b Mon Sep 17 00:00:00 2001 From: Scott Duensing Date: Wed, 4 Mar 2026 18:35:54 -0600 Subject: [PATCH] Add remote forms system: DFM converter, server library, and client engine Text-based protocol for serving Delphi-designed forms over serial. dfm2form converts binary DFM (TPF0) to protocol commands on Linux. formsrv loads .form files and sends/receives via pluggable transport. formcli creates native Win 3.1 controls and routes events back to server. Co-Authored-By: Claude Opus 4.6 --- forms/dfm2form.c | 976 ++++++++++++++++++++++++++++++++++ forms/formcli.pas | 1290 +++++++++++++++++++++++++++++++++++++++++++++ forms/formsrv.c | 388 ++++++++++++++ forms/formsrv.h | 83 +++ forms/makefile | 16 + forms/protocol.md | 135 +++++ 6 files changed, 2888 insertions(+) create mode 100644 forms/dfm2form.c create mode 100644 forms/formcli.pas create mode 100644 forms/formsrv.c create mode 100644 forms/formsrv.h create mode 100644 forms/makefile create mode 100644 forms/protocol.md diff --git a/forms/dfm2form.c b/forms/dfm2form.c new file mode 100644 index 0000000..3f35b8c --- /dev/null +++ b/forms/dfm2form.c @@ -0,0 +1,976 @@ +// dfm2form.c - Convert Delphi 1.0 binary DFM (TPF0) to .form protocol text +// +// Usage: dfm2form [-i ] [output.form] +// +// Reads a binary DFM file, extracts the form and control definitions, +// and outputs protocol commands (FORM.CREATE, CTRL.CREATE, EVENT.BIND, +// FORM.SHOW) suitable for the remote forms system. + +#include +#include +#include +#include +#include +#include +#include + +// --------------------------------------------------------------------------- +// Types +// --------------------------------------------------------------------------- + +typedef enum { + ctUnknown = 0, + ctLabel, + ctEdit, + ctButton, + ctCheckBox, + ctListBox, + ctComboBox, + ctMemo +} CtrlTypeE; + +typedef struct { + char name[64]; + CtrlTypeE type; + int32_t left; + int32_t top; + int32_t width; + int32_t height; + char caption[256]; + char text[4096]; + char items[4096]; + int32_t checked; + int32_t enabled; + int32_t visible; + int32_t maxLength; + int32_t readOnly; + int32_t scrollBars; + int32_t tabOrder; + int32_t itemIndex; + bool hasCaption; + bool hasText; + bool hasItems; + bool hasChecked; + bool hasEnabled; + bool hasVisible; + bool hasMaxLength; + bool hasReadOnly; + bool hasScrollBars; + bool hasTabOrder; + bool hasItemIndex; + bool hasOnClick; + bool hasOnChange; + bool hasOnDblClick; + bool hasOnEnter; + bool hasOnExit; + bool hasOnKeyDown; + bool hasOnKeyUp; + bool hasOnMouseDown; + bool hasOnMouseUp; +} DfmCtrlT; + +typedef struct { + char name[64]; + int32_t width; + int32_t height; + char caption[256]; + DfmCtrlT ctrls[256]; + int32_t ctrlCount; +} DfmFormT; + +// DFM value type tags +enum { + vaNull = 0x00, + vaList = 0x01, + vaInt8 = 0x02, + vaInt16 = 0x03, + vaInt32 = 0x04, + vaExtended = 0x05, + vaString = 0x06, + vaIdent = 0x07, + vaFalse = 0x08, + vaTrue = 0x09, + vaBinary = 0x0A, + vaSet = 0x0B, + vaLString = 0x0C, + vaNil = 0x0D, + vaCollection = 0x0E +}; + +// --------------------------------------------------------------------------- +// Prototypes +// --------------------------------------------------------------------------- + +static void emitCtrl(FILE *out, int32_t formId, int32_t ctrlId, DfmCtrlT *ctrl); +static void emitForm(FILE *out, int32_t formId, DfmFormT *form); +static void escapeStr(const char *src, char *dst, int32_t dstSize); +static void initCtrl(DfmCtrlT *ctrl); +static void initForm(DfmFormT *form); +static CtrlTypeE mapClassName(const char *className); +static bool parseComponent(const uint8_t *data, int32_t size, int32_t *pos, DfmFormT *form, bool isRoot); +static void parseProperties(const uint8_t *data, int32_t size, int32_t *pos, DfmFormT *form, DfmCtrlT *ctrl, bool isForm); +static int32_t readByte(const uint8_t *data, int32_t size, int32_t *pos); +static int32_t readInt16LE(const uint8_t *data, int32_t size, int32_t *pos); +static int32_t readInt32LE(const uint8_t *data, int32_t size, int32_t *pos); +static int32_t readIntValue(const uint8_t *data, int32_t size, int32_t *pos, uint8_t tag); +static bool readStr(const uint8_t *data, int32_t size, int32_t *pos, char *buf, int32_t bufSize); +static void skipValue(const uint8_t *data, int32_t size, int32_t *pos, uint8_t tag); +static int stricmp_local(const char *a, const char *b); +static void usage(const char *progName); + + +// --------------------------------------------------------------------------- +// Low-level DFM readers +// --------------------------------------------------------------------------- + +static int32_t readByte(const uint8_t *data, int32_t size, int32_t *pos) +{ + if (*pos >= size) { + fprintf(stderr, "Error: unexpected end of file at offset %d\n", *pos); + exit(1); + } + return data[(*pos)++]; +} + + +static int32_t readInt16LE(const uint8_t *data, int32_t size, int32_t *pos) +{ + if (*pos + 2 > size) { + fprintf(stderr, "Error: unexpected end of file at offset %d\n", *pos); + exit(1); + } + int16_t val = (int16_t)(data[*pos] | (data[*pos + 1] << 8)); + *pos += 2; + return val; +} + + +static int32_t readInt32LE(const uint8_t *data, int32_t size, int32_t *pos) +{ + if (*pos + 4 > size) { + fprintf(stderr, "Error: unexpected end of file at offset %d\n", *pos); + exit(1); + } + int32_t val = (int32_t)(data[*pos] | (data[*pos + 1] << 8) | + (data[*pos + 2] << 16) | (data[*pos + 3] << 24)); + *pos += 4; + return val; +} + + +static bool readStr(const uint8_t *data, int32_t size, int32_t *pos, char *buf, int32_t bufSize) +{ + int32_t len = readByte(data, size, pos); + if (*pos + len > size) { + fprintf(stderr, "Error: string overflows file at offset %d\n", *pos); + exit(1); + } + int32_t copyLen = (len < bufSize - 1) ? len : bufSize - 1; + memcpy(buf, data + *pos, copyLen); + buf[copyLen] = '\0'; + *pos += len; + return true; +} + + +static int32_t readIntValue(const uint8_t *data, int32_t size, int32_t *pos, uint8_t tag) +{ + switch (tag) { + case vaInt8: + return (int8_t)readByte(data, size, pos); + case vaInt16: + return readInt16LE(data, size, pos); + case vaInt32: + return readInt32LE(data, size, pos); + default: + return 0; + } +} + + +// --------------------------------------------------------------------------- +// Skip unknown property values +// --------------------------------------------------------------------------- + +static void skipValue(const uint8_t *data, int32_t size, int32_t *pos, uint8_t tag) +{ + int32_t len; + char buf[256]; + + switch (tag) { + case vaNull: + break; + case vaList: + // skip items until vaNull + while (*pos < size) { + uint8_t itemTag = readByte(data, size, pos); + if (itemTag == vaNull) { + break; + } + skipValue(data, size, pos, itemTag); + } + break; + case vaInt8: + *pos += 1; + break; + case vaInt16: + *pos += 2; + break; + case vaInt32: + *pos += 4; + break; + case vaExtended: + *pos += 10; + break; + case vaString: + len = readByte(data, size, pos); + *pos += len; + break; + case vaIdent: + len = readByte(data, size, pos); + *pos += len; + break; + case vaFalse: + case vaTrue: + case vaNil: + break; + case vaBinary: + len = readInt32LE(data, size, pos); + *pos += len; + break; + case vaSet: + // repeated strings, empty string terminates + while (*pos < size) { + readStr(data, size, pos, buf, sizeof(buf)); + if (buf[0] == '\0') { + break; + } + } + break; + case vaLString: + len = readInt32LE(data, size, pos); + *pos += len; + break; + case vaCollection: + // items bracketed by vaList/vaNull + while (*pos < size) { + uint8_t itemTag = readByte(data, size, pos); + if (itemTag == vaNull) { + break; + } + skipValue(data, size, pos, itemTag); + } + break; + default: + fprintf(stderr, "Warning: unknown value tag 0x%02X at offset %d\n", tag, *pos); + break; + } +} + + +// --------------------------------------------------------------------------- +// Case-insensitive string compare +// --------------------------------------------------------------------------- + +static int stricmp_local(const char *a, const char *b) +{ + while (*a && *b) { + int ca = tolower((unsigned char)*a); + int cb = tolower((unsigned char)*b); + if (ca != cb) { + return ca - cb; + } + a++; + b++; + } + return (unsigned char)*a - (unsigned char)*b; +} + + +// --------------------------------------------------------------------------- +// Map Delphi class name to control type +// --------------------------------------------------------------------------- + +static CtrlTypeE mapClassName(const char *className) +{ + if (stricmp_local(className, "TLabel") == 0) { + return ctLabel; + } + if (stricmp_local(className, "TEdit") == 0) { + return ctEdit; + } + if (stricmp_local(className, "TButton") == 0) { + return ctButton; + } + if (stricmp_local(className, "TCheckBox") == 0) { + return ctCheckBox; + } + if (stricmp_local(className, "TListBox") == 0) { + return ctListBox; + } + if (stricmp_local(className, "TComboBox") == 0) { + return ctComboBox; + } + if (stricmp_local(className, "TMemo") == 0) { + return ctMemo; + } + return ctUnknown; +} + + +// --------------------------------------------------------------------------- +// Init helpers +// --------------------------------------------------------------------------- + +static void initCtrl(DfmCtrlT *ctrl) +{ + memset(ctrl, 0, sizeof(DfmCtrlT)); + ctrl->enabled = 1; + ctrl->visible = 1; + ctrl->itemIndex = -1; + ctrl->tabOrder = -1; +} + + +static void initForm(DfmFormT *form) +{ + memset(form, 0, sizeof(DfmFormT)); +} + + +// --------------------------------------------------------------------------- +// Parse properties from DFM binary +// --------------------------------------------------------------------------- + +static void parseProperties(const uint8_t *data, int32_t size, int32_t *pos, + DfmFormT *form, DfmCtrlT *ctrl, bool isForm) +{ + char propName[64]; + char strBuf[4096]; + + while (*pos < size) { + // Property name (empty = end of properties) + int32_t nameLen = readByte(data, size, pos); + if (nameLen == 0) { + break; + } + + // Read the property name + (*pos)--; // back up, readStr reads the length byte + readStr(data, size, pos, propName, sizeof(propName)); + + // Read value tag + uint8_t tag = readByte(data, size, pos); + + // Match known properties + if (isForm && stricmp_local(propName, "Caption") == 0) { + if (tag == vaString) { + readStr(data, size, pos, form->caption, sizeof(form->caption)); + } else if (tag == vaLString) { + int32_t len = readInt32LE(data, size, pos); + int32_t copyLen = (len < (int32_t)sizeof(form->caption) - 1) ? len : (int32_t)sizeof(form->caption) - 1; + memcpy(form->caption, data + *pos, copyLen); + form->caption[copyLen] = '\0'; + *pos += len; + } else { + skipValue(data, size, pos, tag); + } + } else if (isForm && stricmp_local(propName, "ClientWidth") == 0) { + form->width = readIntValue(data, size, pos, tag); + } else if (isForm && stricmp_local(propName, "ClientHeight") == 0) { + form->height = readIntValue(data, size, pos, tag); + } else if (isForm && stricmp_local(propName, "Width") == 0 && form->width == 0) { + form->width = readIntValue(data, size, pos, tag); + } else if (isForm && stricmp_local(propName, "Height") == 0 && form->height == 0) { + form->height = readIntValue(data, size, pos, tag); + } else if (!isForm && stricmp_local(propName, "Left") == 0) { + ctrl->left = readIntValue(data, size, pos, tag); + } else if (!isForm && stricmp_local(propName, "Top") == 0) { + ctrl->top = readIntValue(data, size, pos, tag); + } else if (!isForm && stricmp_local(propName, "Width") == 0) { + ctrl->width = readIntValue(data, size, pos, tag); + } else if (!isForm && stricmp_local(propName, "Height") == 0) { + ctrl->height = readIntValue(data, size, pos, tag); + } else if (!isForm && stricmp_local(propName, "Caption") == 0) { + if (tag == vaString) { + readStr(data, size, pos, ctrl->caption, sizeof(ctrl->caption)); + } else if (tag == vaLString) { + int32_t len = readInt32LE(data, size, pos); + int32_t copyLen = (len < (int32_t)sizeof(ctrl->caption) - 1) ? len : (int32_t)sizeof(ctrl->caption) - 1; + memcpy(ctrl->caption, data + *pos, copyLen); + ctrl->caption[copyLen] = '\0'; + *pos += len; + } else { + skipValue(data, size, pos, tag); + } + ctrl->hasCaption = true; + } else if (!isForm && stricmp_local(propName, "Text") == 0) { + if (tag == vaString) { + readStr(data, size, pos, ctrl->text, sizeof(ctrl->text)); + } else if (tag == vaLString) { + int32_t len = readInt32LE(data, size, pos); + int32_t copyLen = (len < (int32_t)sizeof(ctrl->text) - 1) ? len : (int32_t)sizeof(ctrl->text) - 1; + memcpy(ctrl->text, data + *pos, copyLen); + ctrl->text[copyLen] = '\0'; + *pos += len; + } else { + skipValue(data, size, pos, tag); + } + ctrl->hasText = true; + } else if (!isForm && stricmp_local(propName, "Items.Strings") == 0 && tag == vaList) { + // List of strings for ListBox/ComboBox + ctrl->items[0] = '\0'; + int32_t itemsLen = 0; + while (*pos < size) { + uint8_t itemTag = readByte(data, size, pos); + if (itemTag == vaNull) { + break; + } + if (itemTag == vaString) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else if (itemTag == vaLString) { + int32_t len = readInt32LE(data, size, pos); + int32_t copyLen = (len < (int32_t)sizeof(strBuf) - 1) ? len : (int32_t)sizeof(strBuf) - 1; + memcpy(strBuf, data + *pos, copyLen); + strBuf[copyLen] = '\0'; + *pos += len; + } else { + skipValue(data, size, pos, itemTag); + continue; + } + int32_t slen = (int32_t)strlen(strBuf); + if (itemsLen + slen + 2 < (int32_t)sizeof(ctrl->items)) { + if (itemsLen > 0) { + ctrl->items[itemsLen++] = '\n'; + } + memcpy(ctrl->items + itemsLen, strBuf, slen); + itemsLen += slen; + ctrl->items[itemsLen] = '\0'; + } + } + ctrl->hasItems = true; + } else if (!isForm && stricmp_local(propName, "Checked") == 0) { + if (tag == vaTrue) { + ctrl->checked = 1; + } else if (tag == vaFalse) { + ctrl->checked = 0; + } else { + ctrl->checked = readIntValue(data, size, pos, tag); + } + ctrl->hasChecked = true; + } else if (!isForm && stricmp_local(propName, "State") == 0) { + // TCheckBox.State: cbUnchecked=0, cbChecked=1, cbGrayed=2 + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + if (stricmp_local(strBuf, "cbChecked") == 0) { + ctrl->checked = 1; + } else { + ctrl->checked = 0; + } + } else { + ctrl->checked = readIntValue(data, size, pos, tag); + } + ctrl->hasChecked = true; + } else if (!isForm && stricmp_local(propName, "Enabled") == 0) { + if (tag == vaTrue) { + ctrl->enabled = 1; + } else if (tag == vaFalse) { + ctrl->enabled = 0; + } else { + ctrl->enabled = readIntValue(data, size, pos, tag); + } + ctrl->hasEnabled = true; + } else if (!isForm && stricmp_local(propName, "Visible") == 0) { + if (tag == vaTrue) { + ctrl->visible = 1; + } else if (tag == vaFalse) { + ctrl->visible = 0; + } else { + ctrl->visible = readIntValue(data, size, pos, tag); + } + ctrl->hasVisible = true; + } else if (!isForm && stricmp_local(propName, "MaxLength") == 0) { + ctrl->maxLength = readIntValue(data, size, pos, tag); + ctrl->hasMaxLength = true; + } else if (!isForm && stricmp_local(propName, "ReadOnly") == 0) { + if (tag == vaTrue) { + ctrl->readOnly = 1; + } else if (tag == vaFalse) { + ctrl->readOnly = 0; + } else { + ctrl->readOnly = readIntValue(data, size, pos, tag); + } + ctrl->hasReadOnly = true; + } else if (!isForm && stricmp_local(propName, "ScrollBars") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + if (stricmp_local(strBuf, "ssNone") == 0) { + ctrl->scrollBars = 0; + } else if (stricmp_local(strBuf, "ssHorizontal") == 0) { + ctrl->scrollBars = 1; + } else if (stricmp_local(strBuf, "ssVertical") == 0) { + ctrl->scrollBars = 2; + } else if (stricmp_local(strBuf, "ssBoth") == 0) { + ctrl->scrollBars = 3; + } else { + ctrl->scrollBars = 0; + } + } else { + ctrl->scrollBars = readIntValue(data, size, pos, tag); + } + ctrl->hasScrollBars = true; + } else if (!isForm && stricmp_local(propName, "TabOrder") == 0) { + ctrl->tabOrder = readIntValue(data, size, pos, tag); + ctrl->hasTabOrder = true; + } else if (!isForm && stricmp_local(propName, "ItemIndex") == 0) { + ctrl->itemIndex = readIntValue(data, size, pos, tag); + ctrl->hasItemIndex = true; + } else if (stricmp_local(propName, "OnClick") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnClick = true; + } + } else if (stricmp_local(propName, "OnChange") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnChange = true; + } + } else if (stricmp_local(propName, "OnDblClick") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnDblClick = true; + } + } else if (stricmp_local(propName, "OnEnter") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnEnter = true; + } + } else if (stricmp_local(propName, "OnExit") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnExit = true; + } + } else if (stricmp_local(propName, "OnKeyDown") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnKeyDown = true; + } + } else if (stricmp_local(propName, "OnKeyUp") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnKeyUp = true; + } + } else if (stricmp_local(propName, "OnMouseDown") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnMouseDown = true; + } + } else if (stricmp_local(propName, "OnMouseUp") == 0) { + if (tag == vaIdent) { + readStr(data, size, pos, strBuf, sizeof(strBuf)); + } else { + skipValue(data, size, pos, tag); + } + if (!isForm) { + ctrl->hasOnMouseUp = true; + } + } else { + skipValue(data, size, pos, tag); + } + } +} + + +// --------------------------------------------------------------------------- +// Parse a component (form or child control) recursively +// --------------------------------------------------------------------------- + +static bool parseComponent(const uint8_t *data, int32_t size, int32_t *pos, + DfmFormT *form, bool isRoot) +{ + // Check for flags byte (Delphi 1.0 rarely uses this but handle it) + uint8_t peek = data[*pos]; + if ((peek & 0xF0) == 0xF0) { + uint8_t flags = readByte(data, size, pos); + if (flags & 0x02) { + // ffChildPos: skip tagged integer + uint8_t childTag = readByte(data, size, pos); + readIntValue(data, size, pos, childTag); + } + } + + // Class name + char className[64]; + readStr(data, size, pos, className, sizeof(className)); + + // Instance name + char instName[64]; + readStr(data, size, pos, instName, sizeof(instName)); + + if (isRoot) { + // This is the form itself + snprintf(form->name, sizeof(form->name), "%s", instName); + parseProperties(data, size, pos, form, NULL, true); + + // Parse child components + while (*pos < size) { + peek = data[*pos]; + if (peek == 0x00) { + (*pos)++; // consume terminator + break; + } + parseComponent(data, size, pos, form, false); + } + } else { + // Child control + CtrlTypeE type = mapClassName(className); + if (type == ctUnknown) { + fprintf(stderr, "Warning: unknown control class '%s' (%s), skipping\n", className, instName); + // Still need to parse properties and children to advance pos + DfmCtrlT dummy; + initCtrl(&dummy); + parseProperties(data, size, pos, form, &dummy, false); + // Skip nested children + while (*pos < size) { + peek = data[*pos]; + if (peek == 0x00) { + (*pos)++; + break; + } + parseComponent(data, size, pos, form, false); + } + return true; + } + + if (form->ctrlCount >= 256) { + fprintf(stderr, "Error: too many controls (max 256)\n"); + exit(1); + } + + DfmCtrlT *ctrl = &form->ctrls[form->ctrlCount]; + initCtrl(ctrl); + ctrl->type = type; + snprintf(ctrl->name, sizeof(ctrl->name), "%s", instName); + + parseProperties(data, size, pos, form, ctrl, false); + form->ctrlCount++; + + // Skip nested children (controls within controls, e.g., panels) + while (*pos < size) { + peek = data[*pos]; + if (peek == 0x00) { + (*pos)++; + break; + } + parseComponent(data, size, pos, form, false); + } + } + + return true; +} + + +// --------------------------------------------------------------------------- +// Escape a string for protocol output +// --------------------------------------------------------------------------- + +static void escapeStr(const char *src, char *dst, int32_t dstSize) +{ + int32_t di = 0; + + for (int32_t si = 0; src[si] != '\0' && di < dstSize - 2; si++) { + char c = src[si]; + if (c == '"') { + if (di + 2 >= dstSize - 1) { break; } + dst[di++] = '\\'; + dst[di++] = '"'; + } else if (c == '\\') { + if (di + 2 >= dstSize - 1) { break; } + dst[di++] = '\\'; + dst[di++] = '\\'; + } else if (c == '\n') { + if (di + 2 >= dstSize - 1) { break; } + dst[di++] = '\\'; + dst[di++] = 'n'; + } else if (c == '\r') { + if (di + 2 >= dstSize - 1) { break; } + dst[di++] = '\\'; + dst[di++] = 'r'; + } else if (c == '\t') { + if (di + 2 >= dstSize - 1) { break; } + dst[di++] = '\\'; + dst[di++] = 't'; + } else { + dst[di++] = c; + } + } + + dst[di] = '\0'; +} + + +// --------------------------------------------------------------------------- +// Emit protocol commands for a single control +// --------------------------------------------------------------------------- + +static void emitCtrl(FILE *out, int32_t formId, int32_t ctrlId, DfmCtrlT *ctrl) +{ + static const char *typeNames[] = { + "Unknown", "Label", "Edit", "Button", + "CheckBox", "ListBox", "ComboBox", "Memo" + }; + char escaped[8192]; + + fprintf(out, "CTRL.CREATE %d %d %s %d %d %d %d", + formId, ctrlId, typeNames[ctrl->type], + ctrl->left, ctrl->top, ctrl->width, ctrl->height); + + // Inline properties + if (ctrl->hasCaption) { + escapeStr(ctrl->caption, escaped, sizeof(escaped)); + fprintf(out, " Caption=\"%s\"", escaped); + } + if (ctrl->hasText) { + escapeStr(ctrl->text, escaped, sizeof(escaped)); + fprintf(out, " Text=\"%s\"", escaped); + } + if (ctrl->hasItems) { + escapeStr(ctrl->items, escaped, sizeof(escaped)); + fprintf(out, " Items=\"%s\"", escaped); + } + if (ctrl->hasChecked) { + fprintf(out, " Checked=%d", ctrl->checked); + } + if (ctrl->hasEnabled && ctrl->enabled == 0) { + fprintf(out, " Enabled=0"); + } + if (ctrl->hasVisible && ctrl->visible == 0) { + fprintf(out, " Visible=0"); + } + if (ctrl->hasMaxLength && ctrl->maxLength > 0) { + fprintf(out, " MaxLength=%d", ctrl->maxLength); + } + if (ctrl->hasReadOnly && ctrl->readOnly) { + fprintf(out, " ReadOnly=1"); + } + if (ctrl->hasScrollBars && ctrl->scrollBars != 0) { + fprintf(out, " ScrollBars=%d", ctrl->scrollBars); + } + if (ctrl->hasTabOrder && ctrl->tabOrder >= 0) { + fprintf(out, " TabOrder=%d", ctrl->tabOrder); + } + if (ctrl->hasItemIndex && ctrl->itemIndex >= 0) { + fprintf(out, " ItemIndex=%d", ctrl->itemIndex); + } + + fprintf(out, "\n"); + + // Emit EVENT.BIND for non-auto-wired events + // Auto-wired: Button/CheckBox→Click, Edit→Change, ListBox→Select, + // ComboBox→Select+Change, Memo→Change + + bool autoClick = (ctrl->type == ctButton || ctrl->type == ctCheckBox); + bool autoChange = (ctrl->type == ctEdit || ctrl->type == ctComboBox || ctrl->type == ctMemo); + bool autoSelect = (ctrl->type == ctListBox || ctrl->type == ctComboBox); + + if (ctrl->hasOnClick && !autoClick) { + fprintf(out, "EVENT.BIND %d %d Click\n", formId, ctrlId); + } + if (ctrl->hasOnChange && !autoChange) { + fprintf(out, "EVENT.BIND %d %d Change\n", formId, ctrlId); + } + if (ctrl->hasOnDblClick) { + fprintf(out, "EVENT.BIND %d %d DblClick\n", formId, ctrlId); + } + if (ctrl->hasOnEnter) { + fprintf(out, "EVENT.BIND %d %d Enter\n", formId, ctrlId); + } + if (ctrl->hasOnExit) { + fprintf(out, "EVENT.BIND %d %d Exit\n", formId, ctrlId); + } + if (ctrl->hasOnKeyDown) { + fprintf(out, "EVENT.BIND %d %d KeyDown\n", formId, ctrlId); + } + if (ctrl->hasOnKeyUp) { + fprintf(out, "EVENT.BIND %d %d KeyUp\n", formId, ctrlId); + } + if (ctrl->hasOnMouseDown) { + fprintf(out, "EVENT.BIND %d %d MouseDown\n", formId, ctrlId); + } + if (ctrl->hasOnMouseUp) { + fprintf(out, "EVENT.BIND %d %d MouseUp\n", formId, ctrlId); + } + + // Suppress unused variable warning for autoSelect + (void)autoSelect; +} + + +// --------------------------------------------------------------------------- +// Emit the complete form +// --------------------------------------------------------------------------- + +static void emitForm(FILE *out, int32_t formId, DfmFormT *form) +{ + char escaped[512]; + + escapeStr(form->caption, escaped, sizeof(escaped)); + fprintf(out, "FORM.CREATE %d %d %d \"%s\"\n", + formId, form->width, form->height, escaped); + + for (int32_t i = 0; i < form->ctrlCount; i++) { + emitCtrl(out, formId, i + 1, &form->ctrls[i]); + } + + fprintf(out, "FORM.SHOW %d\n", formId); +} + + +// --------------------------------------------------------------------------- +// Usage +// --------------------------------------------------------------------------- + +static void usage(const char *progName) +{ + fprintf(stderr, "Usage: %s [-i ] [output.form]\n", progName); + fprintf(stderr, " -i Set form ID (default: 1)\n"); + exit(1); +} + + +// --------------------------------------------------------------------------- +// Main +// --------------------------------------------------------------------------- + +int main(int argc, char *argv[]) +{ + int32_t formId = 1; + const char *inputPath = NULL; + const char *outputPath = NULL; + + // Parse arguments + int32_t i = 1; + while (i < argc) { + if (strcmp(argv[i], "-i") == 0) { + if (i + 1 >= argc) { + usage(argv[0]); + } + formId = atoi(argv[++i]); + if (formId <= 0) { + fprintf(stderr, "Error: form ID must be positive\n"); + exit(1); + } + } else if (argv[i][0] == '-') { + usage(argv[0]); + } else if (inputPath == NULL) { + inputPath = argv[i]; + } else if (outputPath == NULL) { + outputPath = argv[i]; + } else { + usage(argv[0]); + } + i++; + } + + if (inputPath == NULL) { + usage(argv[0]); + } + + // Read input file + FILE *fin = fopen(inputPath, "rb"); + if (fin == NULL) { + fprintf(stderr, "Error: cannot open '%s': %s\n", inputPath, strerror(errno)); + exit(1); + } + + fseek(fin, 0, SEEK_END); + long fileSize = ftell(fin); + fseek(fin, 0, SEEK_SET); + + uint8_t *data = (uint8_t *)malloc(fileSize); + if (data == NULL) { + fprintf(stderr, "Error: out of memory\n"); + fclose(fin); + exit(1); + } + + if ((long)fread(data, 1, fileSize, fin) != fileSize) { + fprintf(stderr, "Error: failed to read '%s'\n", inputPath); + free(data); + fclose(fin); + exit(1); + } + fclose(fin); + + // Verify TPF0 signature + if (fileSize < 4 || memcmp(data, "TPF0", 4) != 0) { + fprintf(stderr, "Error: '%s' is not a Delphi binary DFM (missing TPF0 signature)\n", inputPath); + free(data); + exit(1); + } + + // Parse + DfmFormT form; + initForm(&form); + int32_t pos = 4; // skip TPF0 + parseComponent(data, (int32_t)fileSize, &pos, &form, true); + + // Default caption if empty + if (form.caption[0] == '\0') { + snprintf(form.caption, sizeof(form.caption), "%s", form.name); + } + + // Output + FILE *fout; + if (outputPath != NULL) { + fout = fopen(outputPath, "w"); + if (fout == NULL) { + fprintf(stderr, "Error: cannot create '%s': %s\n", outputPath, strerror(errno)); + free(data); + exit(1); + } + } else { + fout = stdout; + } + + emitForm(fout, formId, &form); + + if (fout != stdout) { + fclose(fout); + } + + free(data); + return 0; +} diff --git a/forms/formcli.pas b/forms/formcli.pas new file mode 100644 index 0000000..23c084a --- /dev/null +++ b/forms/formcli.pas @@ -0,0 +1,1290 @@ +unit FormCli; + +{ FormCli - Remote forms client engine for Delphi 1.0. } +{ } +{ Receives form/control commands from a server via a transport interface, } +{ creates native Windows 3.1 controls, and sends user events back. } +{ } +{ Transport is abstracted: TFormTransport defines ReadMessage/WriteMessage. } +{ The caller provides a concrete descendant (e.g., serial or string list). } +{ } +{ Call ProcessMessages from the main loop to pump incoming commands. } + +interface + +uses + SysUtils, Classes, Controls, Forms, StdCtrls, WinTypes, WinProcs; + +const + MaxMsgLen = 4096; + +type + { Transport interface - override in descendant } + TFormTransport = class(TObject) + public + function ReadMessage(Buf: PChar; BufSize: Integer): Integer; virtual; abstract; + procedure WriteMessage(Buf: PChar; Len: Integer); virtual; abstract; + end; + + TCtrlTypeE = (ctUnknown, ctLabel, ctEdit, ctButton, + ctCheckBox, ctListBox, ctComboBox, ctMemo); + + { Bound event flags } + TBoundEvent = (beDblClick, beKeyDown, beKeyUp, + beEnter, beExit, beMouseDown, beMouseUp, beMouseMove); + TBoundEvents = set of TBoundEvent; + + { Per-control record } + PFormCtrlRec = ^TFormCtrlRec; + TFormCtrlRec = record + CtrlId: Integer; + CtrlType: TCtrlTypeE; + Control: TControl; + Bound: TBoundEvents; + end; + + { Per-form record } + PFormRec = ^TFormRec; + TFormRec = record + FormId: Integer; + Form: TForm; + Ctrls: TList; { of PFormCtrlRec } + end; + + { Client engine } + TFormClient = class(TObject) + private + FTransport: TFormTransport; + FForms: TList; { of PFormRec } + FMsgBuf: PChar; { read buffer } + FTmpBuf: PChar; { scratch buffer for outgoing messages } + + { Command dispatch } + procedure DoCtrlCreate(P: PChar); + procedure DoCtrlSet(P: PChar); + procedure DoEventBind(P: PChar); + procedure DoEventUnbind(P: PChar); + procedure DoFormCreate(P: PChar); + procedure DoFormDestroy(P: PChar); + procedure DoFormHide(P: PChar); + procedure DoFormShow(P: PChar); + procedure DispatchCommand(Buf: PChar); + + { Form/control lookup } + function FindForm(FormId: Integer): PFormRec; + function FindCtrl(FR: PFormRec; CtrlId: Integer): PFormCtrlRec; + procedure FreeFormRec(FR: PFormRec); + procedure FreeCtrlRec(CR: PFormCtrlRec); + + { Property application } + procedure ApplyProp(CR: PFormCtrlRec; Key, Value: PChar); + procedure ApplyInlineProps(CR: PFormCtrlRec; P: PChar); + + { Event wiring } + procedure WireAutoEvents(CR: PFormCtrlRec); + procedure WireOptEvent(CR: PFormCtrlRec; const EventName: string); + procedure UnwireOptEvent(CR: PFormCtrlRec; const EventName: string); + + { Event handlers } + procedure HandleButtonClick(Sender: TObject); + procedure HandleCheckBoxClick(Sender: TObject); + procedure HandleComboBoxChange(Sender: TObject); + procedure HandleComboBoxSelect(Sender: TObject); + procedure HandleDblClick(Sender: TObject); + procedure HandleEditChange(Sender: TObject); + procedure HandleEnter(Sender: TObject); + procedure HandleExit(Sender: TObject); + procedure HandleFormClose(Sender: TObject; var Action: TCloseAction); + procedure HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure HandleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure HandleListBoxSelect(Sender: TObject); + procedure HandleMemoChange(Sender: TObject); + procedure HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + + { Outgoing event helpers } + procedure SendEvent(FormId, CtrlId: Integer; const EventName: string; const Data: string); + + { String parsing } + function ParseToken(var P: PChar; Buf: PChar; BufSize: Integer): Boolean; + function ParseInt(var P: PChar): Integer; + procedure UnescapeString(Src, Dst: PChar; DstSize: Integer); + procedure EscapeString(Src, Dst: PChar; DstSize: Integer); + public + constructor Create(ATransport: TFormTransport); + destructor Destroy; override; + procedure ProcessMessages; + property Transport: TFormTransport read FTransport; + end; + +implementation + +{ ----- String parsing helpers --------------------------------------------- } + +function TFormClient.ParseToken(var P: PChar; Buf: PChar; BufSize: Integer): Boolean; +var + I: Integer; + C: Char; +begin + Result := False; + { Skip whitespace } + while (P^ = ' ') or (P^ = #9) do + Inc(P); + + if P^ = #0 then + Exit; + + I := 0; + + if P^ = '"' then + begin + { Quoted string } + Inc(P); + while (P^ <> #0) and (P^ <> '"') do + begin + if (P^ = '\') and ((P + 1)^ <> #0) then + begin + Inc(P); + C := P^; + case C of + 'n': C := #10; + 'r': C := #13; + 't': C := #9; + '"': C := '"'; + '\': C := '\'; + end; + if I < BufSize - 1 then + begin + Buf[I] := C; + Inc(I); + end; + end + else + begin + if I < BufSize - 1 then + begin + Buf[I] := P^; + Inc(I); + end; + end; + Inc(P); + end; + if P^ = '"' then + Inc(P); + end + else + begin + { Bare token } + while (P^ <> #0) and (P^ <> ' ') and (P^ <> #9) do + begin + if I < BufSize - 1 then + begin + Buf[I] := P^; + Inc(I); + end; + Inc(P); + end; + end; + + Buf[I] := #0; + Result := I > 0; +end; + + +function TFormClient.ParseInt(var P: PChar): Integer; +var + Tok: array[0..31] of Char; +begin + if ParseToken(P, Tok, SizeOf(Tok)) then + Result := StrToIntDef(StrPas(Tok), 0) + else + Result := 0; +end; + + +procedure TFormClient.UnescapeString(Src, Dst: PChar; DstSize: Integer); +var + I: Integer; + C: Char; +begin + I := 0; + while (Src^ <> #0) and (I < DstSize - 1) do + begin + if (Src^ = '\') and ((Src + 1)^ <> #0) then + begin + Inc(Src); + C := Src^; + case C of + 'n': C := #10; + 'r': C := #13; + 't': C := #9; + '"': C := '"'; + '\': C := '\'; + end; + Dst[I] := C; + Inc(I); + end + else + begin + Dst[I] := Src^; + Inc(I); + end; + Inc(Src); + end; + Dst[I] := #0; +end; + + +procedure TFormClient.EscapeString(Src, Dst: PChar; DstSize: Integer); +var + I: Integer; +begin + I := 0; + while (Src^ <> #0) and (I < DstSize - 2) do + begin + case Src^ of + '"': + begin + if I + 2 > DstSize - 1 then Break; + Dst[I] := '\'; Inc(I); + Dst[I] := '"'; Inc(I); + end; + '\': + begin + if I + 2 > DstSize - 1 then Break; + Dst[I] := '\'; Inc(I); + Dst[I] := '\'; Inc(I); + end; + #10: + begin + if I + 2 > DstSize - 1 then Break; + Dst[I] := '\'; Inc(I); + Dst[I] := 'n'; Inc(I); + end; + #13: + begin + if I + 2 > DstSize - 1 then Break; + Dst[I] := '\'; Inc(I); + Dst[I] := 'r'; Inc(I); + end; + #9: + begin + if I + 2 > DstSize - 1 then Break; + Dst[I] := '\'; Inc(I); + Dst[I] := 't'; Inc(I); + end; + else + Dst[I] := Src^; + Inc(I); + end; + Inc(Src); + end; + Dst[I] := #0; +end; + + +{ ----- Form/control lookup ------------------------------------------------ } + +function TFormClient.FindForm(FormId: Integer): PFormRec; +var + I: Integer; + FR: PFormRec; +begin + Result := nil; + for I := 0 to FForms.Count - 1 do + begin + FR := PFormRec(FForms[I]); + if FR^.FormId = FormId then + begin + Result := FR; + Exit; + end; + end; +end; + + +function TFormClient.FindCtrl(FR: PFormRec; CtrlId: Integer): PFormCtrlRec; +var + I: Integer; + CR: PFormCtrlRec; +begin + Result := nil; + for I := 0 to FR^.Ctrls.Count - 1 do + begin + CR := PFormCtrlRec(FR^.Ctrls[I]); + if CR^.CtrlId = CtrlId then + begin + Result := CR; + Exit; + end; + end; +end; + + +procedure TFormClient.FreeCtrlRec(CR: PFormCtrlRec); +begin + if CR^.Control <> nil then + CR^.Control.Free; + Dispose(CR); +end; + + +procedure TFormClient.FreeFormRec(FR: PFormRec); +var + I: Integer; +begin + for I := 0 to FR^.Ctrls.Count - 1 do + FreeCtrlRec(PFormCtrlRec(FR^.Ctrls[I])); + FR^.Ctrls.Free; + if FR^.Form <> nil then + FR^.Form.Free; + Dispose(FR); +end; + + +{ ----- Constructor / Destructor ------------------------------------------- } + +constructor TFormClient.Create(ATransport: TFormTransport); +begin + inherited Create; + FTransport := ATransport; + FForms := TList.Create; + GetMem(FMsgBuf, MaxMsgLen); + GetMem(FTmpBuf, MaxMsgLen); +end; + + +destructor TFormClient.Destroy; +var + I: Integer; +begin + for I := 0 to FForms.Count - 1 do + FreeFormRec(PFormRec(FForms[I])); + FForms.Free; + FreeMem(FMsgBuf, MaxMsgLen); + FreeMem(FTmpBuf, MaxMsgLen); + inherited Destroy; +end; + + +{ ----- ID encoding in Tag ------------------------------------------------ } +{ Tag := (FormId shl 16) or CtrlId } + +{ ----- Event handlers ----------------------------------------------------- } + +procedure TFormClient.SendEvent(FormId, CtrlId: Integer; + const EventName: string; const Data: string); +var + Msg: string; +begin + if Data = '' then + Msg := 'EVENT ' + IntToStr(FormId) + ' ' + IntToStr(CtrlId) + ' ' + EventName + else + Msg := 'EVENT ' + IntToStr(FormId) + ' ' + IntToStr(CtrlId) + ' ' + EventName + ' ' + Data; + + StrPCopy(FTmpBuf, Msg); + FTransport.WriteMessage(FTmpBuf, Length(Msg)); +end; + + +procedure TFormClient.HandleButtonClick(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'Click', ''); +end; + + +procedure TFormClient.HandleCheckBoxClick(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'Click', ''); +end; + + +procedure TFormClient.HandleEditChange(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; + Escaped: array[0..4095] of Char; + Txt: string; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + Txt := (Sender as TEdit).Text; + StrPCopy(FTmpBuf, Txt); + EscapeString(FTmpBuf, Escaped, SizeOf(Escaped)); + SendEvent(FormId, CtrlId, 'Change', '"' + StrPas(Escaped) + '"'); +end; + + +procedure TFormClient.HandleMemoChange(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; + Escaped: array[0..4095] of Char; + Txt: string; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + Txt := (Sender as TMemo).Text; + StrPCopy(FTmpBuf, Txt); + EscapeString(FTmpBuf, Escaped, SizeOf(Escaped)); + SendEvent(FormId, CtrlId, 'Change', '"' + StrPas(Escaped) + '"'); +end; + + +procedure TFormClient.HandleComboBoxChange(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; + Escaped: array[0..4095] of Char; + Txt: string; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + Txt := (Sender as TComboBox).Text; + StrPCopy(FTmpBuf, Txt); + EscapeString(FTmpBuf, Escaped, SizeOf(Escaped)); + SendEvent(FormId, CtrlId, 'Change', '"' + StrPas(Escaped) + '"'); +end; + + +procedure TFormClient.HandleListBoxSelect(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; + Idx: Integer; + Escaped: array[0..4095] of Char; + Txt: string; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + Idx := (Sender as TListBox).ItemIndex; + if Idx >= 0 then + Txt := (Sender as TListBox).Items[Idx] + else + Txt := ''; + StrPCopy(FTmpBuf, Txt); + EscapeString(FTmpBuf, Escaped, SizeOf(Escaped)); + SendEvent(FormId, CtrlId, 'Select', + IntToStr(Idx) + ' "' + StrPas(Escaped) + '"'); +end; + + +procedure TFormClient.HandleComboBoxSelect(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; + Idx: Integer; + Escaped: array[0..4095] of Char; + Txt: string; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + Idx := (Sender as TComboBox).ItemIndex; + if Idx >= 0 then + Txt := (Sender as TComboBox).Items[Idx] + else + Txt := ''; + StrPCopy(FTmpBuf, Txt); + EscapeString(FTmpBuf, Escaped, SizeOf(Escaped)); + SendEvent(FormId, CtrlId, 'Select', + IntToStr(Idx) + ' "' + StrPas(Escaped) + '"'); +end; + + +procedure TFormClient.HandleDblClick(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'DblClick', ''); +end; + + +procedure TFormClient.HandleEnter(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'Enter', ''); +end; + + +procedure TFormClient.HandleExit(Sender: TObject); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'Exit', ''); +end; + + +procedure TFormClient.HandleKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'KeyDown', IntToStr(Key)); +end; + + +procedure TFormClient.HandleKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'KeyUp', IntToStr(Key)); +end; + + +procedure TFormClient.HandleMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; + Btn: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + Btn := Ord(Button); + SendEvent(FormId, CtrlId, 'MouseDown', + IntToStr(X) + ' ' + IntToStr(Y) + ' ' + IntToStr(Btn)); +end; + + +procedure TFormClient.HandleMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; + Btn: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + Btn := Ord(Button); + SendEvent(FormId, CtrlId, 'MouseUp', + IntToStr(X) + ' ' + IntToStr(Y) + ' ' + IntToStr(Btn)); +end; + + +procedure TFormClient.HandleMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); +var + Tag: Longint; + FormId: Integer; + CtrlId: Integer; +begin + Tag := (Sender as TControl).Tag; + FormId := Tag shr 16; + CtrlId := Tag and $FFFF; + SendEvent(FormId, CtrlId, 'MouseMove', + IntToStr(X) + ' ' + IntToStr(Y) + ' 0'); +end; + + +procedure TFormClient.HandleFormClose(Sender: TObject; + var Action: TCloseAction); +var + Tag: Longint; + FormId: Integer; +begin + Tag := (Sender as TForm).Tag; + FormId := Tag shr 16; + SendEvent(FormId, 0, 'Close', ''); + Action := caNone; { Server decides whether to destroy } +end; + + +{ ----- Event wiring ------------------------------------------------------- } + +procedure TFormClient.WireAutoEvents(CR: PFormCtrlRec); +begin + case CR^.CtrlType of + ctButton: + (CR^.Control as TButton).OnClick := HandleButtonClick; + ctCheckBox: + (CR^.Control as TCheckBox).OnClick := HandleCheckBoxClick; + ctEdit: + (CR^.Control as TEdit).OnChange := HandleEditChange; + ctMemo: + (CR^.Control as TMemo).OnChange := HandleMemoChange; + ctListBox: + (CR^.Control as TListBox).OnClick := HandleListBoxSelect; + ctComboBox: + begin + (CR^.Control as TComboBox).OnClick := HandleComboBoxSelect; + (CR^.Control as TComboBox).OnChange := HandleComboBoxChange; + end; + end; +end; + + +procedure TFormClient.WireOptEvent(CR: PFormCtrlRec; const EventName: string); +begin + if EventName = 'DblClick' then + begin + (CR^.Control as TControl).OnDblClick := HandleDblClick; + CR^.Bound := CR^.Bound + [beDblClick]; + end + else if EventName = 'Enter' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnEnter := HandleEnter; + CR^.Bound := CR^.Bound + [beEnter]; + end + else if EventName = 'Exit' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnExit := HandleExit; + CR^.Bound := CR^.Bound + [beExit]; + end + else if EventName = 'KeyDown' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnKeyDown := HandleKeyDown; + CR^.Bound := CR^.Bound + [beKeyDown]; + end + else if EventName = 'KeyUp' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnKeyUp := HandleKeyUp; + CR^.Bound := CR^.Bound + [beKeyUp]; + end + else if EventName = 'MouseDown' then + begin + (CR^.Control as TControl).OnMouseDown := HandleMouseDown; + CR^.Bound := CR^.Bound + [beMouseDown]; + end + else if EventName = 'MouseUp' then + begin + (CR^.Control as TControl).OnMouseUp := HandleMouseUp; + CR^.Bound := CR^.Bound + [beMouseUp]; + end + else if EventName = 'MouseMove' then + begin + (CR^.Control as TControl).OnMouseMove := HandleMouseMove; + CR^.Bound := CR^.Bound + [beMouseMove]; + end; +end; + + +procedure TFormClient.UnwireOptEvent(CR: PFormCtrlRec; const EventName: string); +begin + if EventName = 'DblClick' then + begin + (CR^.Control as TControl).OnDblClick := nil; + CR^.Bound := CR^.Bound - [beDblClick]; + end + else if EventName = 'Enter' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnEnter := nil; + CR^.Bound := CR^.Bound - [beEnter]; + end + else if EventName = 'Exit' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnExit := nil; + CR^.Bound := CR^.Bound - [beExit]; + end + else if EventName = 'KeyDown' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnKeyDown := nil; + CR^.Bound := CR^.Bound - [beKeyDown]; + end + else if EventName = 'KeyUp' then + begin + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).OnKeyUp := nil; + CR^.Bound := CR^.Bound - [beKeyUp]; + end + else if EventName = 'MouseDown' then + begin + (CR^.Control as TControl).OnMouseDown := nil; + CR^.Bound := CR^.Bound - [beMouseDown]; + end + else if EventName = 'MouseUp' then + begin + (CR^.Control as TControl).OnMouseUp := nil; + CR^.Bound := CR^.Bound - [beMouseUp]; + end + else if EventName = 'MouseMove' then + begin + (CR^.Control as TControl).OnMouseMove := nil; + CR^.Bound := CR^.Bound - [beMouseMove]; + end; +end; + + +{ ----- Property application ----------------------------------------------- } + +procedure TFormClient.ApplyProp(CR: PFormCtrlRec; Key, Value: PChar); +var + S: string; + Unesc: array[0..4095] of Char; + N: Integer; + Lines: TStringList; + P: PChar; + Start: PChar; +begin + S := StrPas(Key); + + if S = 'Caption' then + begin + UnescapeString(Value, Unesc, SizeOf(Unesc)); + case CR^.CtrlType of + ctLabel: (CR^.Control as TLabel).Caption := StrPas(Unesc); + ctButton: (CR^.Control as TButton).Caption := StrPas(Unesc); + ctCheckBox: (CR^.Control as TCheckBox).Caption := StrPas(Unesc); + end; + end + else if S = 'Text' then + begin + UnescapeString(Value, Unesc, SizeOf(Unesc)); + case CR^.CtrlType of + ctEdit: (CR^.Control as TEdit).Text := StrPas(Unesc); + ctComboBox: (CR^.Control as TComboBox).Text := StrPas(Unesc); + ctMemo: + begin + { Convert \n to Lines } + (CR^.Control as TMemo).Lines.Clear; + Lines := TStringList.Create; + try + P := Unesc; + Start := P; + while P^ <> #0 do + begin + if P^ = #10 then + begin + P^ := #0; + Lines.Add(StrPas(Start)); + Inc(P); + Start := P; + end + else if (P^ = #13) and ((P + 1)^ = #10) then + begin + P^ := #0; + Lines.Add(StrPas(Start)); + Inc(P, 2); + Start := P; + end + else + Inc(P); + end; + if Start^ <> #0 then + Lines.Add(StrPas(Start)); + (CR^.Control as TMemo).Lines.Assign(Lines); + finally + Lines.Free; + end; + end; + end; + end + else if S = 'Items' then + begin + UnescapeString(Value, Unesc, SizeOf(Unesc)); + case CR^.CtrlType of + ctListBox: + begin + (CR^.Control as TListBox).Items.Clear; + P := Unesc; + Start := P; + while P^ <> #0 do + begin + if P^ = #10 then + begin + P^ := #0; + (CR^.Control as TListBox).Items.Add(StrPas(Start)); + Inc(P); + Start := P; + end + else + Inc(P); + end; + if Start^ <> #0 then + (CR^.Control as TListBox).Items.Add(StrPas(Start)); + end; + ctComboBox: + begin + (CR^.Control as TComboBox).Items.Clear; + P := Unesc; + Start := P; + while P^ <> #0 do + begin + if P^ = #10 then + begin + P^ := #0; + (CR^.Control as TComboBox).Items.Add(StrPas(Start)); + Inc(P); + Start := P; + end + else + Inc(P); + end; + if Start^ <> #0 then + (CR^.Control as TComboBox).Items.Add(StrPas(Start)); + end; + end; + end + else if S = 'Checked' then + begin + N := StrToIntDef(StrPas(Value), 0); + if CR^.CtrlType = ctCheckBox then + (CR^.Control as TCheckBox).Checked := (N <> 0); + end + else if S = 'Enabled' then + begin + N := StrToIntDef(StrPas(Value), 1); + CR^.Control.Enabled := (N <> 0); + end + else if S = 'Visible' then + begin + N := StrToIntDef(StrPas(Value), 1); + CR^.Control.Visible := (N <> 0); + end + else if S = 'MaxLength' then + begin + N := StrToIntDef(StrPas(Value), 0); + if CR^.CtrlType = ctEdit then + (CR^.Control as TEdit).MaxLength := N; + end + else if S = 'ReadOnly' then + begin + N := StrToIntDef(StrPas(Value), 0); + case CR^.CtrlType of + ctEdit: (CR^.Control as TEdit).ReadOnly := (N <> 0); + ctMemo: (CR^.Control as TMemo).ReadOnly := (N <> 0); + end; + end + else if S = 'ScrollBars' then + begin + N := StrToIntDef(StrPas(Value), 0); + if CR^.CtrlType = ctMemo then + (CR^.Control as TMemo).ScrollBars := TScrollStyle(N); + end + else if S = 'TabOrder' then + begin + N := StrToIntDef(StrPas(Value), 0); + if CR^.Control is TWinControl then + (CR^.Control as TWinControl).TabOrder := N; + end + else if S = 'ItemIndex' then + begin + N := StrToIntDef(StrPas(Value), -1); + case CR^.CtrlType of + ctListBox: (CR^.Control as TListBox).ItemIndex := N; + ctComboBox: (CR^.Control as TComboBox).ItemIndex := N; + end; + end; +end; + + +procedure TFormClient.ApplyInlineProps(CR: PFormCtrlRec; P: PChar); +var + Token: array[0..4095] of Char; + Key: array[0..63] of Char; + Value: array[0..4095] of Char; + Eq: PChar; +begin + { Parse Key="value" or Key=number pairs } + while ParseToken(P, Token, SizeOf(Token)) do + begin + { Find '=' in token } + Eq := StrScan(Token, '='); + if Eq = nil then + Continue; + + { Split at '=' } + Eq^ := #0; + StrCopy(Key, Token); + + { Value might be quoted (already unquoted by ParseToken if entire token + was quoted). But here Key=Value is a single bare token, so the value + part after '=' needs special handling. } + + { Back up P to re-parse the value part properly } + { Actually, the token was read as "Key=value" or "Key="value"" } + { For Key="value", the quote is part of the remaining stream. } + { Let's handle both cases: } + Inc(Eq); + if Eq^ = '"' then + begin + { Value starts with quote - was not consumed by ParseToken since the + whole thing was read as bare token up to space. Actually ParseToken + reads bare tokens up to space, so Key="val" with no spaces reads as + one token: Key="val". Strip quotes manually. } + Inc(Eq); + StrCopy(Value, Eq); + { Strip trailing quote } + if StrLen(Value) > 0 then + begin + if Value[StrLen(Value) - 1] = '"' then + Value[StrLen(Value) - 1] := #0; + end; + end + else + begin + StrCopy(Value, Eq); + end; + + ApplyProp(CR, Key, Value); + end; +end; + + +{ ----- Control type mapping ----------------------------------------------- } + +function MapTypeName(Name: PChar): TCtrlTypeE; +var + S: string; +begin + S := StrPas(Name); + if S = 'Label' then + Result := ctLabel + else if S = 'Edit' then + Result := ctEdit + else if S = 'Button' then + Result := ctButton + else if S = 'CheckBox' then + Result := ctCheckBox + else if S = 'ListBox' then + Result := ctListBox + else if S = 'ComboBox' then + Result := ctComboBox + else if S = 'Memo' then + Result := ctMemo + else + Result := ctUnknown; +end; + + +{ ----- Command handlers --------------------------------------------------- } + +procedure TFormClient.DoFormCreate(P: PChar); +var + FR: PFormRec; + FormId: Integer; + W: Integer; + H: Integer; + Title: array[0..255] of Char; +begin + FormId := ParseInt(P); + W := ParseInt(P); + H := ParseInt(P); + if not ParseToken(P, Title, SizeOf(Title)) then + Title[0] := #0; + + New(FR); + FR^.FormId := FormId; + FR^.Form := TForm.CreateNew(Application); + FR^.Ctrls := TList.Create; + + FR^.Form.Caption := StrPas(Title); + FR^.Form.ClientWidth := W; + FR^.Form.ClientHeight := H; + FR^.Form.Position := poScreenCenter; + FR^.Form.Tag := Longint(FormId) shl 16; + FR^.Form.OnClose := HandleFormClose; + + FForms.Add(FR); +end; + + +procedure TFormClient.DoFormShow(P: PChar); +var + FormId: Integer; + FR: PFormRec; +begin + FormId := ParseInt(P); + FR := FindForm(FormId); + if FR <> nil then + FR^.Form.Show; +end; + + +procedure TFormClient.DoFormHide(P: PChar); +var + FormId: Integer; + FR: PFormRec; +begin + FormId := ParseInt(P); + FR := FindForm(FormId); + if FR <> nil then + FR^.Form.Hide; +end; + + +procedure TFormClient.DoFormDestroy(P: PChar); +var + FormId: Integer; + FR: PFormRec; + Idx: Integer; +begin + FormId := ParseInt(P); + FR := FindForm(FormId); + if FR = nil then + Exit; + + Idx := FForms.IndexOf(FR); + if Idx >= 0 then + FForms.Delete(Idx); + + FreeFormRec(FR); +end; + + +procedure TFormClient.DoCtrlCreate(P: PChar); +var + FormId: Integer; + CtrlId: Integer; + TypeName: array[0..31] of Char; + Left: Integer; + Top: Integer; + Width: Integer; + Height: Integer; + FR: PFormRec; + CR: PFormCtrlRec; + CType: TCtrlTypeE; + Ctrl: TControl; +begin + FormId := ParseInt(P); + CtrlId := ParseInt(P); + if not ParseToken(P, TypeName, SizeOf(TypeName)) then + Exit; + Left := ParseInt(P); + Top := ParseInt(P); + Width := ParseInt(P); + Height := ParseInt(P); + + FR := FindForm(FormId); + if FR = nil then + Exit; + + CType := MapTypeName(TypeName); + if CType = ctUnknown then + Exit; + + { Create the control } + Ctrl := nil; + case CType of + ctLabel: + begin + Ctrl := TLabel.Create(FR^.Form); + (Ctrl as TLabel).AutoSize := False; + end; + ctEdit: + Ctrl := TEdit.Create(FR^.Form); + ctButton: + Ctrl := TButton.Create(FR^.Form); + ctCheckBox: + Ctrl := TCheckBox.Create(FR^.Form); + ctListBox: + Ctrl := TListBox.Create(FR^.Form); + ctComboBox: + Ctrl := TComboBox.Create(FR^.Form); + ctMemo: + Ctrl := TMemo.Create(FR^.Form); + end; + + if Ctrl = nil then + Exit; + + { Set parent and geometry } + if Ctrl is TWinControl then + (Ctrl as TWinControl).Parent := FR^.Form + else + Ctrl.Parent := FR^.Form; + + Ctrl.Left := Left; + Ctrl.Top := Top; + Ctrl.Width := Width; + Ctrl.Height := Height; + Ctrl.Tag := (Longint(FormId) shl 16) or CtrlId; + + { Create control record } + New(CR); + CR^.CtrlId := CtrlId; + CR^.CtrlType := CType; + CR^.Control := Ctrl; + CR^.Bound := []; + + FR^.Ctrls.Add(CR); + + { Wire auto events } + WireAutoEvents(CR); + + { Apply inline properties } + ApplyInlineProps(CR, P); +end; + + +procedure TFormClient.DoCtrlSet(P: PChar); +var + FormId: Integer; + CtrlId: Integer; + FR: PFormRec; + CR: PFormCtrlRec; +begin + FormId := ParseInt(P); + CtrlId := ParseInt(P); + + FR := FindForm(FormId); + if FR = nil then + Exit; + + CR := FindCtrl(FR, CtrlId); + if CR = nil then + Exit; + + ApplyInlineProps(CR, P); +end; + + +procedure TFormClient.DoEventBind(P: PChar); +var + FormId: Integer; + CtrlId: Integer; + EventName: array[0..63] of Char; + FR: PFormRec; + CR: PFormCtrlRec; +begin + FormId := ParseInt(P); + CtrlId := ParseInt(P); + if not ParseToken(P, EventName, SizeOf(EventName)) then + Exit; + + FR := FindForm(FormId); + if FR = nil then + Exit; + + CR := FindCtrl(FR, CtrlId); + if CR = nil then + Exit; + + WireOptEvent(CR, StrPas(EventName)); +end; + + +procedure TFormClient.DoEventUnbind(P: PChar); +var + FormId: Integer; + CtrlId: Integer; + EventName: array[0..63] of Char; + FR: PFormRec; + CR: PFormCtrlRec; +begin + FormId := ParseInt(P); + CtrlId := ParseInt(P); + if not ParseToken(P, EventName, SizeOf(EventName)) then + Exit; + + FR := FindForm(FormId); + if FR = nil then + Exit; + + CR := FindCtrl(FR, CtrlId); + if CR = nil then + Exit; + + UnwireOptEvent(CR, StrPas(EventName)); +end; + + +{ ----- Command dispatch --------------------------------------------------- } + +procedure TFormClient.DispatchCommand(Buf: PChar); +var + P: PChar; + Cmd: array[0..31] of Char; +begin + P := Buf; + if not ParseToken(P, Cmd, SizeOf(Cmd)) then + Exit; + + if StrComp(Cmd, 'FORM.CREATE') = 0 then + DoFormCreate(P) + else if StrComp(Cmd, 'FORM.SHOW') = 0 then + DoFormShow(P) + else if StrComp(Cmd, 'FORM.HIDE') = 0 then + DoFormHide(P) + else if StrComp(Cmd, 'FORM.DESTROY') = 0 then + DoFormDestroy(P) + else if StrComp(Cmd, 'CTRL.CREATE') = 0 then + DoCtrlCreate(P) + else if StrComp(Cmd, 'CTRL.SET') = 0 then + DoCtrlSet(P) + else if StrComp(Cmd, 'EVENT.BIND') = 0 then + DoEventBind(P) + else if StrComp(Cmd, 'EVENT.UNBIND') = 0 then + DoEventUnbind(P); +end; + + +{ ----- Main loop entry point ---------------------------------------------- } + +procedure TFormClient.ProcessMessages; +var + BytesRead: Integer; +begin + repeat + BytesRead := FTransport.ReadMessage(FMsgBuf, MaxMsgLen - 1); + if BytesRead > 0 then + begin + FMsgBuf[BytesRead] := #0; + DispatchCommand(FMsgBuf); + end; + until BytesRead <= 0; +end; + +end. diff --git a/forms/formsrv.c b/forms/formsrv.c new file mode 100644 index 0000000..2028876 --- /dev/null +++ b/forms/formsrv.c @@ -0,0 +1,388 @@ +// formsrv.c - Remote forms server library implementation + +#define _POSIX_C_SOURCE 200809L + +#include "formsrv.h" + +#include +#include +#include +#include + +// --------------------------------------------------------------------------- +// Constants +// --------------------------------------------------------------------------- + +#define MAX_FORMS 64 +#define MAX_LINES 1024 +#define MAX_MSG_LEN 4096 + +// --------------------------------------------------------------------------- +// Types +// --------------------------------------------------------------------------- + +typedef struct { + int32_t formId; + char *lines[MAX_LINES]; + int32_t lineCount; +} FormDataT; + +struct FormServerS { + FormTransportT *transport; + EventCallbackT eventCallback; + void *eventUserData; + FormDataT forms[MAX_FORMS]; + int32_t formCount; + char msgBuf[MAX_MSG_LEN]; +}; + +// --------------------------------------------------------------------------- +// Prototypes +// --------------------------------------------------------------------------- + +static FormDataT *findForm(FormServerT *server, int32_t formId); +static void freeFormData(FormDataT *fd); +static int32_t parseFormId(const char *line); +static void sendCommand(FormServerT *server, const char *fmt, ...); +static bool skipSpaces(const char **p); +static bool parseToken(const char **p, char *buf, int32_t bufSize); + + +// --------------------------------------------------------------------------- +// Internal helpers +// --------------------------------------------------------------------------- + +static FormDataT *findForm(FormServerT *server, int32_t formId) +{ + for (int32_t i = 0; i < server->formCount; i++) { + if (server->forms[i].formId == formId) { + return &server->forms[i]; + } + } + return NULL; +} + + +static void freeFormData(FormDataT *fd) +{ + for (int32_t i = 0; i < fd->lineCount; i++) { + free(fd->lines[i]); + fd->lines[i] = NULL; + } + fd->lineCount = 0; + fd->formId = 0; +} + + +static int32_t parseFormId(const char *line) +{ + // Skip command prefix (e.g., "FORM.CREATE "), then read first integer + const char *p = line; + // Skip non-space command name + while (*p && *p != ' ') { + p++; + } + // Skip space + while (*p == ' ') { + p++; + } + // Parse integer + return (int32_t)atoi(p); +} + + +static bool skipSpaces(const char **p) +{ + while (**p == ' ' || **p == '\t') { + (*p)++; + } + return **p != '\0'; +} + + +static bool parseToken(const char **p, char *buf, int32_t bufSize) +{ + skipSpaces(p); + if (**p == '\0') { + return false; + } + + int32_t i = 0; + + if (**p == '"') { + // Quoted string — read until closing quote + (*p)++; + while (**p != '\0' && **p != '"') { + if (**p == '\\' && *(*p + 1) != '\0') { + (*p)++; + char c = **p; + switch (c) { + case 'n': c = '\n'; break; + case 'r': c = '\r'; break; + case 't': c = '\t'; break; + case '"': c = '"'; break; + case '\\': c = '\\'; break; + default: break; + } + if (i < bufSize - 1) { + buf[i++] = c; + } + } else { + if (i < bufSize - 1) { + buf[i++] = **p; + } + } + (*p)++; + } + if (**p == '"') { + (*p)++; + } + } else { + // Bare token — read until whitespace + while (**p != '\0' && **p != ' ' && **p != '\t') { + if (i < bufSize - 1) { + buf[i++] = **p; + } + (*p)++; + } + } + + buf[i] = '\0'; + return i > 0; +} + + +#include + +static void sendCommand(FormServerT *server, const char *fmt, ...) +{ + char buf[MAX_MSG_LEN]; + va_list args; + + va_start(args, fmt); + vsnprintf(buf, sizeof(buf), fmt, args); + va_end(args); + + server->transport->writeMessage(buf, server->transport->ctx); +} + + +// --------------------------------------------------------------------------- +// Public API +// --------------------------------------------------------------------------- + +FormServerT *formServerCreate(FormTransportT *transport) +{ + FormServerT *server = (FormServerT *)calloc(1, sizeof(FormServerT)); + if (server == NULL) { + return NULL; + } + server->transport = transport; + return server; +} + + +void formServerDestroy(FormServerT *server) +{ + if (server == NULL) { + return; + } + for (int32_t i = 0; i < server->formCount; i++) { + freeFormData(&server->forms[i]); + } + free(server); +} + + +int32_t formServerLoadFile(FormServerT *server, const char *path) +{ + FILE *f = fopen(path, "r"); + if (f == NULL) { + fprintf(stderr, "formsrv: cannot open '%s': %s\n", path, strerror(errno)); + return -1; + } + + if (server->formCount >= MAX_FORMS) { + fprintf(stderr, "formsrv: too many forms (max %d)\n", MAX_FORMS); + fclose(f); + return -1; + } + + FormDataT *fd = &server->forms[server->formCount]; + memset(fd, 0, sizeof(FormDataT)); + + char lineBuf[MAX_MSG_LEN]; + int32_t formId = -1; + + while (fgets(lineBuf, sizeof(lineBuf), f) != NULL) { + // Strip trailing newline + int32_t len = (int32_t)strlen(lineBuf); + while (len > 0 && (lineBuf[len - 1] == '\n' || lineBuf[len - 1] == '\r')) { + lineBuf[--len] = '\0'; + } + + // Skip empty lines + if (len == 0) { + continue; + } + + if (fd->lineCount >= MAX_LINES) { + fprintf(stderr, "formsrv: too many lines in '%s' (max %d)\n", path, MAX_LINES); + freeFormData(fd); + fclose(f); + return -1; + } + + fd->lines[fd->lineCount] = strdup(lineBuf); + if (fd->lines[fd->lineCount] == NULL) { + fprintf(stderr, "formsrv: out of memory\n"); + freeFormData(fd); + fclose(f); + return -1; + } + fd->lineCount++; + + // Extract form ID from first FORM.CREATE line + if (formId == -1 && strncmp(lineBuf, "FORM.CREATE ", 12) == 0) { + formId = parseFormId(lineBuf); + } + } + + fclose(f); + + if (formId <= 0) { + fprintf(stderr, "formsrv: no FORM.CREATE found in '%s'\n", path); + freeFormData(fd); + return -1; + } + + fd->formId = formId; + server->formCount++; + return formId; +} + + +void formServerSendForm(FormServerT *server, int32_t formId) +{ + FormDataT *fd = findForm(server, formId); + if (fd == NULL) { + return; + } + + for (int32_t i = 0; i < fd->lineCount; i++) { + server->transport->writeMessage(fd->lines[i], server->transport->ctx); + } +} + + +void formServerShowForm(FormServerT *server, int32_t formId) +{ + sendCommand(server, "FORM.SHOW %d", formId); +} + + +void formServerHideForm(FormServerT *server, int32_t formId) +{ + sendCommand(server, "FORM.HIDE %d", formId); +} + + +void formServerDestroyForm(FormServerT *server, int32_t formId) +{ + sendCommand(server, "FORM.DESTROY %d", formId); + + // Remove from form store + for (int32_t i = 0; i < server->formCount; i++) { + if (server->forms[i].formId == formId) { + freeFormData(&server->forms[i]); + // Shift remaining forms down + for (int32_t j = i; j < server->formCount - 1; j++) { + server->forms[j] = server->forms[j + 1]; + } + server->formCount--; + break; + } + } +} + + +void formServerSetProp(FormServerT *server, int32_t formId, int32_t ctrlId, + const char *prop, const char *value) +{ + sendCommand(server, "CTRL.SET %d %d %s=%s", formId, ctrlId, prop, value); +} + + +void formServerBindEvent(FormServerT *server, int32_t formId, int32_t ctrlId, + const char *eventName) +{ + sendCommand(server, "EVENT.BIND %d %d %s", formId, ctrlId, eventName); +} + + +void formServerUnbindEvent(FormServerT *server, int32_t formId, int32_t ctrlId, + const char *eventName) +{ + sendCommand(server, "EVENT.UNBIND %d %d %s", formId, ctrlId, eventName); +} + + +void formServerSetEventCallback(FormServerT *server, EventCallbackT cb, + void *userData) +{ + server->eventCallback = cb; + server->eventUserData = userData; +} + + +bool formServerPollEvent(FormServerT *server) +{ + int bytesRead = server->transport->readMessage( + server->msgBuf, MAX_MSG_LEN - 1, server->transport->ctx); + + if (bytesRead <= 0) { + return false; + } + + server->msgBuf[bytesRead] = '\0'; + + // Parse: EVENT [] + const char *p = server->msgBuf; + char token[256]; + + if (!parseToken(&p, token, sizeof(token))) { + return false; + } + if (strcmp(token, "EVENT") != 0) { + return false; + } + + // formId + if (!parseToken(&p, token, sizeof(token))) { + return false; + } + int32_t formId = (int32_t)atoi(token); + + // ctrlId + if (!parseToken(&p, token, sizeof(token))) { + return false; + } + int32_t ctrlId = (int32_t)atoi(token); + + // eventName + char eventName[64]; + if (!parseToken(&p, eventName, sizeof(eventName))) { + return false; + } + + // Remaining data (rest of line after skipping spaces) + skipSpaces(&p); + const char *data = p; + + if (server->eventCallback != NULL) { + server->eventCallback(formId, ctrlId, eventName, data, + server->eventUserData); + } + + return true; +} diff --git a/forms/formsrv.h b/forms/formsrv.h new file mode 100644 index 0000000..c0b8fab --- /dev/null +++ b/forms/formsrv.h @@ -0,0 +1,83 @@ +// formsrv.h - Remote forms server library +// +// Loads .form files (protocol command sequences) and sends them to a +// remote client via a transport interface. Receives EVENT messages +// from the client and dispatches them to a callback. + +#ifndef FORMSRV_H +#define FORMSRV_H + +#include +#include + +// --------------------------------------------------------------------------- +// Transport interface +// --------------------------------------------------------------------------- + +typedef struct { + // Read a complete message into buf. Returns bytes read, 0 if no + // message is available. Must not block. + int (*readMessage)(char *buf, int32_t maxLen, void *ctx); + + // Write a null-terminated message string. Transport adds framing + // (e.g., CR+LF for serial). + void (*writeMessage)(const char *buf, void *ctx); + + // Opaque context pointer passed to readMessage/writeMessage. + void *ctx; +} FormTransportT; + +// --------------------------------------------------------------------------- +// Event callback +// --------------------------------------------------------------------------- + +typedef void (*EventCallbackT)(int32_t formId, int32_t ctrlId, + const char *eventName, const char *data, + void *userData); + +// --------------------------------------------------------------------------- +// Server handle (opaque) +// --------------------------------------------------------------------------- + +typedef struct FormServerS FormServerT; + +// --------------------------------------------------------------------------- +// API +// --------------------------------------------------------------------------- + +FormServerT *formServerCreate(FormTransportT *transport); +void formServerDestroy(FormServerT *server); + +// Load a .form file into the server's form store. Returns the form ID +// parsed from the first FORM.CREATE line, or -1 on error. +int32_t formServerLoadFile(FormServerT *server, const char *path); + +// Send all commands for a loaded form to the client. +void formServerSendForm(FormServerT *server, int32_t formId); + +// Send FORM.SHOW / FORM.HIDE / FORM.DESTROY commands. +void formServerShowForm(FormServerT *server, int32_t formId); +void formServerHideForm(FormServerT *server, int32_t formId); +void formServerDestroyForm(FormServerT *server, int32_t formId); + +// Send a CTRL.SET command to update a property on a control. +void formServerSetProp(FormServerT *server, int32_t formId, + int32_t ctrlId, const char *prop, + const char *value); + +// Send an EVENT.BIND command. +void formServerBindEvent(FormServerT *server, int32_t formId, + int32_t ctrlId, const char *eventName); + +// Send an EVENT.UNBIND command. +void formServerUnbindEvent(FormServerT *server, int32_t formId, + int32_t ctrlId, const char *eventName); + +// Set the callback for incoming events. +void formServerSetEventCallback(FormServerT *server, + EventCallbackT cb, void *userData); + +// Poll for one incoming event. Returns true if an event was processed. +bool formServerPollEvent(FormServerT *server); + +#endif // FORMSRV_H diff --git a/forms/makefile b/forms/makefile new file mode 100644 index 0000000..69b929e --- /dev/null +++ b/forms/makefile @@ -0,0 +1,16 @@ +CC = gcc +CFLAGS = -Wall -Wextra -std=c99 -O2 +LDFLAGS = + +all: dfm2form formsrv.o + +dfm2form: dfm2form.c + $(CC) $(CFLAGS) -o $@ $< $(LDFLAGS) + +formsrv.o: formsrv.c formsrv.h + $(CC) $(CFLAGS) -c -o $@ formsrv.c + +clean: + rm -f dfm2form formsrv.o + +.PHONY: all clean diff --git a/forms/protocol.md b/forms/protocol.md new file mode 100644 index 0000000..627144e --- /dev/null +++ b/forms/protocol.md @@ -0,0 +1,135 @@ +# Remote Forms Protocol + +## Overview + +Text-based protocol for remote GUI. A C server on Linux sends form/control +commands over a transport layer; a Delphi 1.0 client on Windows 3.1 creates +native controls and sends user events back. + +## Message Format + +- One command per message. +- Transport delivers whole messages (today: newline-delimited over serial). +- Strings are double-quoted with escapes: `\"` `\\` `\n` `\r` `\t`. +- Bare tokens (IDs, numbers, type names) are whitespace-delimited. +- IDs are positive integers assigned by the server. + +## Server → Client Commands + +### FORM.CREATE + + FORM.CREATE "" + +Create a new form with the given dimensions and title. The form is not +shown until FORM.SHOW is sent. + +### FORM.SHOW + + FORM.SHOW <formId> + +### FORM.HIDE + + FORM.HIDE <formId> + +### FORM.DESTROY + + FORM.DESTROY <formId> + +Free the form and all its controls. + +### CTRL.CREATE + + CTRL.CREATE <formId> <ctrlId> <type> <left> <top> <width> <height> [Key="val" ...] + +Create a control on the specified form. Inline key/value properties are +applied immediately after creation. See Control Types and Properties below. + +### CTRL.SET + + CTRL.SET <formId> <ctrlId> Key="val" [Key="val" ...] + +Update one or more properties on an existing control. + +### EVENT.BIND + + EVENT.BIND <formId> <ctrlId> <eventName> + +Wire an opt-in event handler. Auto-wired events do not need explicit binding. + +### EVENT.UNBIND + + EVENT.UNBIND <formId> <ctrlId> <eventName> + +Remove an event handler. + +## Client → Server Events + + EVENT <formId> <ctrlId> <eventName> [<data>] + +Event data varies by event type: + +| Event | Data | +|-----------|-------------------------------| +| Click | (none) | +| DblClick | (none) | +| Change | `"new text"` | +| Select | `<index> "selected text"` | +| KeyDown | `<vkCode>` | +| KeyUp | `<vkCode>` | +| MouseDown | `<x> <y> <button>` | +| MouseUp | `<x> <y> <button>` | +| MouseMove | `<x> <y> <button>` | +| Enter | (none) | +| Exit | (none) | +| Close | (none) | + +## Control Types + +| Type | Delphi Class | Auto-wired Events | +|----------|-------------|-------------------| +| Label | TLabel | (none) | +| Edit | TEdit | Change | +| Button | TButton | Click | +| CheckBox | TCheckBox | Click | +| ListBox | TListBox | Select | +| ComboBox | TComboBox | Select, Change | +| Memo | TMemo | Change | + +Opt-in events (require EVENT.BIND): DblClick, KeyDown, KeyUp, Enter, Exit, +MouseDown, MouseUp, MouseMove. + +## Properties + +| Property | Applies To | Value Format | +|------------|-------------------------------|-------------------------------------------| +| Caption | Label, Button, CheckBox | Quoted string | +| Text | Edit, ComboBox, Memo | Quoted string (`\n` for line breaks) | +| Items | ListBox, ComboBox | Quoted string (`\n`-delimited) | +| Checked | CheckBox | 0 or 1 | +| Enabled | All | 0 or 1 | +| Visible | All | 0 or 1 | +| MaxLength | Edit | Integer | +| ReadOnly | Edit, Memo | 0 or 1 | +| ScrollBars | Memo | 0-3 (ssNone..ssBoth) | +| ItemIndex | ListBox, ComboBox | Integer (-1 = none) | +| TabOrder | All windowed controls | Integer | + +## String Encoding + +- Strings in the protocol are always double-quoted. +- Escape sequences: `\"` (literal quote), `\\` (literal backslash), + `\n` (newline), `\r` (carriage return), `\t` (tab). +- Multi-line values (Memo text, ListBox items) use `\n` within a single + quoted string. + +## Transport Layer + +The protocol is transport-agnostic. Messages are delivered via: + +``` +int ReadMessage(char *buf, int maxLen); // returns bytes read, 0 = none +void WriteMessage(const char *buf); // sends complete message +``` + +Current transport: newline-delimited serial (messages terminated by CR+LF). +The transport handles framing; protocol layer never sees delimiters.