Lots of new BASIC features.

Makefile

@@ -218,9 +218,10 @@ deploy-sdk: tools apps
 	done
 	@# BASIC include files
 	@cp src/include/basic/*.bas $(SDKDIR)/include/basic/
-	@# BASIC sample: basdemo (project file + form + icon + help source)
+	@# BASIC sample: basdemo (project file + form + class module + icon + help source)
 	@cp src/apps/kpunch/basdemo/basdemo.dbp  $(SDKDIR)/samples/basic/basdemo/
 	@cp src/apps/kpunch/basdemo/basdemo.frm  $(SDKDIR)/samples/basic/basdemo/
+	@cp src/apps/kpunch/basdemo/shape.cls    $(SDKDIR)/samples/basic/basdemo/
 	@cp src/apps/kpunch/basdemo/basdemo.dhs  $(SDKDIR)/samples/basic/basdemo/
 	@cp src/apps/kpunch/basdemo/ICON32.BMP   $(SDKDIR)/samples/basic/basdemo/
 	@# BASIC sample: widshow (widget showcase)

docs/dvx_system_reference.html

@@ -367,6 +367,7 @@ img { max-width: 100%; }
 <li><a href="#user.clipboard">Clipboard</a></li>
 <li><a href="#lib.texthelp.onkey">Clipboard</a></li>
 <li><a href="#user.windows">Closing Windows</a></li>
+<li><a href="#api.dialog">Color Dialog</a></li>
 <li><a href="#api.types">ColorIdE</a></li>
 <li><a href="#user.settings">Colors</a></li>
 <li><a href="#arch.colors">Colors</a></li>
@@ -453,6 +454,7 @@ img { max-width: 100%; }
 <li><a href="#user.input">Double-click</a></li>
 <li><a href="#arch.events">Double-Click</a></li>
 <li><a href="#arch.overview">DPMI</a></li>
+<li><a href="#api.app">Drag Feedback</a></li>
 <li><a href="#lib.texthelp.dragupdate">Drag Select</a></li>
 <li><a href="#user.input">Dragging</a></li>
 <li><a href="#api.draw">drawArrowGlyph</a></li>
@@ -504,6 +506,7 @@ img { max-width: 100%; }
 <li><a href="#api.app">dvxClipboardClear</a></li>
 <li><a href="#api.app">dvxClipboardCopy</a></li>
 <li><a href="#api.app">dvxClipboardGet</a></li>
+<li><a href="#api.dialog">dvxColorDialog</a></li>
 <li><a href="#api.app">dvxColorLabel</a></li>
 <li><a href="#api.app">dvxColorName</a></li>
 <li><a href="#arch.layers">dvxComp</a></li>
@@ -520,6 +523,9 @@ img { max-width: 100%; }
 <li><a href="#api.dialog">dvxDialogEnd</a></li>
 <li><a href="#api.dialog">dvxDialogRun</a></li>
 <li><a href="#api.dialog">dvxDlg.h</a></li>
+<li><a href="#api.app">dvxDragFeedbackHide</a></li>
+<li><a href="#api.app">dvxDragImageShow</a></li>
+<li><a href="#api.app">dvxDragOutlineShow</a></li>
 <li><a href="#arch.layers">dvxDraw</a></li>
 <li><a href="#api.draw">dvxDraw.h</a></li>
 <li><a href="#api.driver">DvxDriverClassT</a></li>
@@ -4393,6 +4399,17 @@ bool dvxAppIsHung(const AppContextT *ctx, int32_t appId);</code></pre>
   ---------   -----------
   outLen      Output: length of clipboard text</pre>
 <p>Returns: Clipboard text, or NULL.</p>
+<h2>Drag Feedback</h2>
+<p>For programs that implement drag and drop: an outline or a picture that follows the mouse over every window (drawn under the cursor) until it is hidden. One is shown at a time; showing another replaces it. The program still tracks the mouse and decides where a drop lands; this only draws.</p>
+<h3>dvxDragOutlineShow</h3>
+<pre><code>void dvxDragOutlineShow(AppContextT *ctx, int32_t w, int32_t h, int32_t offX, int32_t offY);</code></pre>
+<p>Show a w x h dotted outline (two-tone, so it shows on any background) whose top-left corner stays (offX, offY) from the mouse pointer -- typically the dragged object's size and its offset from where it was grabbed.</p>
+<h3>dvxDragImageShow</h3>
+<pre><code>void dvxDragImageShow(AppContextT *ctx, const uint8_t *pixels, int32_t w, int32_t h, int32_t pitch, bool hasKey, uint32_t keyColor);</code></pre>
+<p>Show a picture centered on the mouse pointer. pixels are in the display's native format, as dvxLoadImage or dvxLoadImageAlpha return them, and must stay valid until the feedback is hidden or replaced. With hasKey, pixels of keyColor are transparent (pass dvxLoadImageAlpha's outputs).</p>
+<h3>dvxDragFeedbackHide</h3>
+<pre><code>void dvxDragFeedbackHide(AppContextT *ctx);</code></pre>
+<p>Remove the outline or picture.</p>
 <h2>Resource Loading</h2>
 <h3>dvxResLoadIcon</h3>
 <pre><code>uint8_t *dvxResLoadIcon(AppContextT *ctx, const char *dxePath, const char *resName, int32_t *outW, int32_t *outH, int32_t *outPitch);</code></pre>
@@ -5084,6 +5101,22 @@ int32_t pick = dvxButtonBox(ctx, &quot;Copy&quot;, &quot;The disk is full.&quot;
   defaultIdx    Initially highlighted item (-1 = none)
   outIdx        Output: selected index</pre>
 <p>Returns: true if a choice was made, false if cancelled.</p>
+<h2>Color Dialog</h2>
+<h3>dvxColorDialog</h3>
+<pre><code>bool dvxColorDialog(AppContextT *ctx, const char *title, uint32_t *rgbInOut);</code></pre>
+<p>Display a modal color picker: a palette of 48 basic colors, Red, Green and Blue sliders each paired with a number box (0-255), and a preview swatch. Clicking a basic color sets all three channels; the basic color matching the current color is framed. From the keyboard, Tab moves between the sliders and number boxes (the Red slider has the focus first), the arrow keys, Page Up/Down, Home and End move a slider, and Enter chooses OK. Works at every color depth; on 8-bit desktops the swatches show the nearest palette colors, but the chosen value is exact.</p>
+<pre>  Parameter     Description
+  ---------     -----------
+  ctx           Application context
+  title         Window title (NULL: &quot;Color&quot;)
+  rgbInOut      In: the starting color; out: the chosen color. Both 0x00RRGGBB, the layout of DVX BASIC's RGB()</pre>
+<p>Returns: true if OK was chosen, false if cancelled or closed (then *rgbInOut is unchanged).</p>
+<p>Macros for the 0x00RRGGBB layout: DVX_RGB(r, g, b) builds a color from three 0-255 channels, and DVX_RGB_RED(rgb), DVX_RGB_GREEN(rgb) and DVX_RGB_BLUE(rgb) take one apart.</p>
+<pre><code>uint32_t rgb = DVX_RGB(r, g, b);
+
+if (dvxColorDialog(ctx, &quot;Title Bar&quot;, &amp;rgb)) {
+    dvxSetColor(ctx, ColorActiveTitleBgE, DVX_RGB_RED(rgb), DVX_RGB_GREEN(rgb), DVX_RGB_BLUE(rgb));
+}</code></pre>
 <h2>Custom Dialogs</h2>
 <p>Any dialog built from widgets, with the behaviour of the boxes above: modal, Enter chooses OK (unless a button has the focus), Escape or closing the window cancels, a nested dialog (a Browse button, an error box) works, and the dialog ends cleanly if its program is ended meanwhile.</p>
 <pre><code>typedef bool (*DvxDialogOkFnT)(WindowT *dlg, void *userCtx);

src/apps/kpunch/Makefile

@@ -120,7 +120,7 @@ $(BINDIR)/kpunch/resedit/resedit.app: resedit/resedit.dbp resedit/resedit.frm re
 
 basdemo: $(BINDIR)/kpunch/basdemo/basdemo.app
 
-$(BINDIR)/kpunch/basdemo/basdemo.app: basdemo/basdemo.dbp basdemo/basdemo.frm basdemo/ICON32.BMP $(BASCOMP) | $(BINDIR)/kpunch/basdemo dvxbasic
+$(BINDIR)/kpunch/basdemo/basdemo.app: basdemo/basdemo.dbp basdemo/basdemo.frm basdemo/shape.cls basdemo/ICON32.BMP $(BASCOMP) | $(BINDIR)/kpunch/basdemo dvxbasic
 	$(BASCOMP) basdemo/basdemo.dbp -o $@ -release
 
 widshow: $(BINDIR)/kpunch/widshow/widshow.app

src/apps/kpunch/basdemo/basdemo.dbp

@@ -12,6 +12,10 @@ File0 = ../../../include/basic/commdlg.bas
 File1 = ../../../include/basic/help.bas
 Count = 2
 
+[Classes]
+File0 = shape.cls
+Count = 1
+
 [Forms]
 File0 = basdemo.frm
 Count = 1

src/apps/kpunch/basdemo/basdemo.dhs

@@ -73,6 +73,7 @@ The File I/O and INI examples create their files in the program's own data folde
   Demos   Graphics...            Open a window with a drawing. Draw paints shapes and text; Clear wipes it.
   Demos   Dynamic Form...        Open a window that the program builds while running, with a button that counts.
   Demos   Timer...               Open a window with a counter that ticks twice a second.
+  Demos   Objects                Make shapes from the Shape class module, keep them in a Collection and list them with FOR EACH.
   Help    Contents               Open this help.
   Help    About...               Show the program name and copyright.
 .endtable

src/apps/kpunch/basdemo/basdemo.frm

@@ -42,6 +42,9 @@ Begin Form BasicDemo
         Begin Menu mnuTimer
             Caption = "&Timer..."
         End
+        Begin Menu mnuObjects
+            Caption = "&Objects"
+        End
     End
 
     Begin Menu mnuHelp
@@ -281,6 +284,7 @@ SUB mnuRunAll_Click
     btnFileIO_Click
     btnSystem_Click
     btnIni_Click
+    mnuObjects_Click
     LblStatus.Caption = "All text demos complete."
 END SUB
 
@@ -941,3 +945,33 @@ SUB TimerForm_Unload
     timerOpen = False
     tickCount = 0
 END SUB
+
+
+SUB mnuObjects_Click
+    ' Objects: the Shape class module, NEW, a Collection and FOR EACH
+    Header "Objects"
+
+    DIM shapes AS NEW Collection
+    DIM s AS Shape
+    DIM item AS Shape
+    DIM total AS DOUBLE
+
+    SET s = NEW Shape
+    s.Size = 2
+    shapes.Add s, "small"
+
+    SET s = NEW Shape
+    s.Kind = "circle"
+    s.Size = 1.5
+    shapes.Add s, "round"
+
+    FOR EACH item IN shapes
+        Say item.Describe
+        total = total + item.Area
+    NEXT
+
+    Say "Shapes:" + STR$(shapes.Count) + ", total area" + STR$(total)
+    Say "The one called ROUND is a " + shapes("ROUND").Kind
+    Say "TypeName(s) = " + TypeName(s) + ", s Is shapes(2): " + IIf(s Is shapes(2), "yes", "no")
+    LblStatus.Caption = "Objects demo complete."
+END SUB

src/apps/kpunch/basdemo/shape.cls

@@ -0,0 +1,36 @@
+VERSION DVX 1.00 CLASS
+Attribute VB_Name = "Shape"
+
+' A shape for the Objects demo: its kind and size, and the area that
+' follows from them.  Every new Shape starts as a square of size 1.
+
+Public Kind As String
+Private mSize As Double
+
+Private Sub Class_Initialize()
+    Kind = "square"
+    mSize = 1
+End Sub
+
+Public Property Get Size() As Double
+    Size = mSize
+End Property
+
+Public Property Let Size(newSize As Double)
+    IF newSize < 0 THEN
+        ERROR 5
+    END IF
+    mSize = newSize
+End Property
+
+Public Function Area() As Double
+    IF Kind = "circle" THEN
+        Area = 3.14159 * mSize * mSize
+    ELSE
+        Area = mSize * mSize
+    END IF
+End Function
+
+Public Function Describe() As String
+    Describe = Kind + " of size" + STR$(mSize) + ", area" + STR$(Area)
+End Function

src/apps/kpunch/cpanel/cpanel.c

@@ -92,7 +92,6 @@
 #define CP_REVERT_PREFIX      "The old mode comes back in "
 #define CP_REVERT_SUFFIX      " seconds."
 #define CP_WPAPER_BTN_W       90
-#define CP_RGB_MAX            255
 #define CP_LABEL_BUF          48
 #define CP_FILTER_BUF         128
 #define CP_ENTRY_NAME_MAX     64
@@ -170,9 +169,6 @@ static WidgetT *sDblTestLbl    = NULL;
 
 // Colors tab widgets
 static WidgetT *sColorList     = NULL;
-static WidgetT *sRedSldr       = NULL;
-static WidgetT *sGreenSldr     = NULL;
-static WidgetT *sBlueSldr      = NULL;
 static WidgetT *sRedLbl        = NULL;
 static WidgetT *sGreenLbl      = NULL;
 static WidgetT *sBlueLbl       = NULL;
@@ -218,8 +214,8 @@ static void        onCancel(WidgetT *w);
 static void        onChooseWallpaper(WidgetT *w);
 static void        onClearWallpaper(WidgetT *w);
 static void        onClose(WindowT *win);
+static void        onColorChange(WidgetT *w);
 static void        onColorSelect(WidgetT *w);
-static void        onColorSlider(WidgetT *w);
 static void        onDblClickSlider(WidgetT *w);
 static void        onDblClickTest(WidgetT *w);
 static void        onMenu(WindowT *win, int32_t menuId);
@@ -241,11 +237,9 @@ static void        scanThemes(void);
 static void        scanWallpapers(void);
 static void        setIntLabel(WidgetT *lbl, const char *prefix, int32_t val, const char *suffix);
 static void        setWallpaperFromPath(const char *path);
-static void        updateColorSliders(void);
+static void        updateColorSwatch(void);
 static void        updateDblClickLabel(void);
-static void        updateRgbLabels(uint8_t r, uint8_t g, uint8_t b);
 static void        updateSpeedLabel(void);
-static void        updateSwatch(void);
 static void        updateWheelStepLabel(void);
 int32_t            appMain(DxeAppContextT *ctx);
 
@@ -320,7 +314,7 @@ void appShutdown(void) {
 
 
 static void buildColorsTab(WidgetT *page) {
-    // Color list on the left, sliders on the right
+    // Color list on the left, the selected color and Change... on the right
     WidgetT *hbox = wgtHBox(page);
     hbox->weight  = WGT_WEIGHT_FILL;
     hbox->spacing = wgtPixels(CP_SPACING);
@@ -340,8 +334,9 @@ static void buildColorsTab(WidgetT *page) {
     }
 
     sColorList = wgtListBox(leftVbox);
-    sColorList->weight   = WGT_WEIGHT_FILL;
+    sColorList->weight     = WGT_WEIGHT_FILL;
-    sColorList->onChange  = onColorSelect;
+    sColorList->onChange   = onColorSelect;
+    sColorList->onDblClick = onColorChange;
     wgtListBoxSetItems(sColorList, colorNames, ColorCountE);
     wgtListBoxSetSelected(sColorList, 0);
 
@@ -372,39 +367,27 @@ static void buildColorsTab(WidgetT *page) {
     resetBtn->onClick = onResetColors;
     resetBtn->prefW   = wgtPixels(CP_THEME_BTN_W);
 
-    // Right side: RGB sliders in a non-weighted inner box so they stay
+    // Right side: the selected color and its values, in a non-weighted
-    // at natural size.  The outer box absorbs extra vertical space.
+    // inner box so they stay at natural size; the outer box absorbs extra
+    // vertical space.  Change... picks a new color in the color dialog.
     WidgetT *rightVbox = wgtVBox(hbox);
     rightVbox->weight  = CP_HALF_WEIGHT;
 
-    WidgetT *sliderBox = wgtVBox(rightVbox);
+    WidgetT *colorBox = wgtVBox(rightVbox);
-    sliderBox->spacing = wgtPixels(CP_SPACING_SMALL);
+    colorBox->spacing = wgtPixels(CP_SPACING_SMALL);
 
-    wgtLabel(sliderBox, "Red:");
+    wgtLabel(colorBox, "Color:");
-    sRedSldr = wgtSlider(sliderBox, 0, CP_RGB_MAX);
+    sColorSwatch = wgtCanvas(colorBox, CP_SWATCH_W, CP_SWATCH_H);
-    sRedSldr->onChange = onColorSlider;
+    sRedLbl      = wgtLabel(colorBox, "");
-    sRedLbl = wgtLabel(sliderBox, "0");
+    sGreenLbl    = wgtLabel(colorBox, "");
-    wgtLabelSetAlign(sRedLbl, AlignEndE);
+    sBlueLbl     = wgtLabel(colorBox, "");
 
-    wgtLabel(sliderBox, "Green:");
+    WidgetT *changeBtn = wgtButton(colorBox, "Change...");
-    sGreenSldr = wgtSlider(sliderBox, 0, CP_RGB_MAX);
+    changeBtn->onClick = onColorChange;
-    sGreenSldr->onChange = onColorSlider;
-    sGreenLbl = wgtLabel(sliderBox, "0");
-    wgtLabelSetAlign(sGreenLbl, AlignEndE);
 
-    wgtLabel(sliderBox, "Blue:");
-    sBlueSldr = wgtSlider(sliderBox, 0, CP_RGB_MAX);
-    sBlueSldr->onChange = onColorSlider;
-    sBlueLbl = wgtLabel(sliderBox, "0");
-    wgtLabelSetAlign(sBlueLbl, AlignEndE);
-
-    wgtLabel(sliderBox, "Preview:");
-    sColorSwatch = wgtCanvas(sliderBox, CP_SWATCH_W, CP_SWATCH_H);
-
-    // Absorb remaining vertical space below the sliders
     wgtSpacer(rightVbox)->weight = WGT_WEIGHT_FILL;
 
-    updateColorSliders();
+    updateColorSwatch();
 }
 
 
@@ -634,7 +617,7 @@ static void onApplyTheme(WidgetT *w) {
     }
 
     dvxLoadTheme(sAc, sThemeEntries[sel].path);
-    updateColorSliders();
+    updateColorSwatch();
 }
 
 
@@ -658,7 +641,7 @@ static void onBrowseTheme(WidgetT *w) {
 
     if (dvxFileDialog(sAc, "Load Theme", FD_OPEN, THEME_DIR, sThemeFilters, DVX_ARRAY_LEN(sThemeFilters), path, sizeof(path))) {
         dvxLoadTheme(sAc, path);
-        updateColorSliders();
+        updateColorSwatch();
     }
 }
 
@@ -718,13 +701,9 @@ static void onClose(WindowT *win) {
 }
 
 
-static void onColorSelect(WidgetT *w) {
+// Change... (or a double-click on the list): pick a new color for the
-    (void)w;
+// selected entry.  It is applied at once, like every other change here.
-    updateColorSliders();
+static void onColorChange(WidgetT *w) {
-}
-
-
-static void onColorSlider(WidgetT *w) {
     (void)w;
 
     int32_t sel = wgtListBoxGetSelected(sColorList);
@@ -733,12 +712,25 @@ static void onColorSlider(WidgetT *w) {
         return;
     }
 
-    uint8_t r = (uint8_t)wgtSliderGetValue(sRedSldr);
+    uint8_t r;
-    uint8_t g = (uint8_t)wgtSliderGetValue(sGreenSldr);
+    uint8_t g;
-    uint8_t b = (uint8_t)wgtSliderGetValue(sBlueSldr);
+    uint8_t b;
+    dvxGetColor(sAc, (ColorIdE)sel, &r, &g, &b);
 
-    updateRgbLabels(r, g, b);
+    uint32_t rgb = DVX_RGB(r, g, b);
-    dvxSetColor(sAc, (ColorIdE)sel, r, g, b);
+
+    if (!dvxColorDialog(sAc, dvxColorLabel((ColorIdE)sel), &rgb)) {
+        return;
+    }
+
+    dvxSetColor(sAc, (ColorIdE)sel, DVX_RGB_RED(rgb), DVX_RGB_GREEN(rgb), DVX_RGB_BLUE(rgb));
+    updateColorSwatch();
+}
+
+
+static void onColorSelect(WidgetT *w) {
+    (void)w;
+    updateColorSwatch();
 }
 
 
@@ -852,7 +844,7 @@ static void onOk(WidgetT *w) {
 static void onResetColors(WidgetT *w) {
     (void)w;
     dvxResetColorScheme(sAc);
-    updateColorSliders();
+    updateColorSwatch();
 }
 
 
@@ -1176,7 +1168,8 @@ static void setWallpaperFromPath(const char *path) {
 }
 
 
-static void updateColorSliders(void) {
+// Shows the selected entry's color in the swatch and as numbers.
+static void updateColorSwatch(void) {
     int32_t sel = wgtListBoxGetSelected(sColorList);
 
     if (sel < 0 || sel >= ColorCountE) {
@@ -1188,10 +1181,10 @@ static void updateColorSliders(void) {
     uint8_t b;
     dvxGetColor(sAc, (ColorIdE)sel, &r, &g, &b);
 
-    wgtSliderSetValue(sRedSldr, r);
+    setIntLabel(sRedLbl, "Red ", r, "");
-    wgtSliderSetValue(sGreenSldr, g);
+    setIntLabel(sGreenLbl, "Green ", g, "");
-    wgtSliderSetValue(sBlueSldr, b);
+    setIntLabel(sBlueLbl, "Blue ", b, "");
-    updateRgbLabels(r, g, b);
+    wgtCanvasClear(sColorSwatch, packColor(&sAc->display, r, g, b));
 }
 
 
@@ -1200,34 +1193,11 @@ static void updateDblClickLabel(void) {
 }
 
 
-// Shows the RGB values next to the sliders and repaints the swatch.
-static void updateRgbLabels(uint8_t r, uint8_t g, uint8_t b) {
-    setIntLabel(sRedLbl, "", r, "");
-    setIntLabel(sGreenLbl, "", g, "");
-    setIntLabel(sBlueLbl, "", b, "");
-    updateSwatch();
-}
-
-
 static void updateSpeedLabel(void) {
     setIntLabel(sSpeedLbl, "", wgtSliderGetValue(sSpeedSldr), "");
 }
 
 
-static void updateSwatch(void) {
-    if (!sColorSwatch) {
-        return;
-    }
-
-    uint8_t r = (uint8_t)wgtSliderGetValue(sRedSldr);
-    uint8_t g = (uint8_t)wgtSliderGetValue(sGreenSldr);
-    uint8_t b = (uint8_t)wgtSliderGetValue(sBlueSldr);
-
-    uint32_t color = packColor(&sAc->display, r, g, b);
-    wgtCanvasClear(sColorSwatch, color);
-}
-
-
 static void updateWheelStepLabel(void) {
     setIntLabel(sWheelStepLbl, "", wgtSliderGetValue(sWheelStepSldr), "");
 }

src/apps/kpunch/cpanel/cpanel.dhs

@@ -108,7 +108,9 @@ If the pointer is hard to control, set Acceleration to Off and adjust Cursor Spe
 
 .h2 Changing One Color
 
-The System Colors list names every part of the screen that has a color, such as the desktop, title bars, menus and buttons. Click a name, then move the Red, Green and Blue sliders to mix a new color for it. Each slider goes from 0 (none of that color) to 255 (full). The Preview box and the screen itself change as you go.
+The System Colors list names every part of the screen that has a color, such as the desktop, title bars, menus and buttons. Click a name to see its color beside the list, with its red, green and blue amounts (each from 0, none of that color, to 255, full).
+
+To change it, click Change... (or double-click the name). A color box named after the part opens: click one of the basic colors, or mix your own with the Red, Green and Blue sliders or by typing the numbers, and watch the preview. Click OK and the screen changes to the new color at once; Cancel leaves it as it was.
 
 .h2 Themes
 

src/apps/kpunch/dvxbasic/Makefile

@@ -59,7 +59,7 @@ SYSTEMDIR = ../../../../bin/system
 # Sources every command-line build (bascomp, basrun, test_suite) links:
 # the build pipeline, the full compiler and the runtime without forms.
 COMP_SRCS    = compiler/lexer.c compiler/parser.c compiler/codegen.c compiler/symtab.c compiler/strip.c compiler/obfuscate.c compiler/compact.c
-VM_SRCS      = runtime/vm.c runtime/values.c runtime/serialize.c
+VM_SRCS      = runtime/vm.c runtime/values.c runtime/dates.c runtime/serialize.c runtime/gfx.c runtime/screen.c
 # Standalone programs that link the VM also need what libdvx provides it
 # at run time on the target (INI access through dvxPrefs).
 VM_LINK_SRCS = $(VM_SRCS) $(LIBDVX)/dvxPrefs.c
@@ -68,7 +68,7 @@ RES_SRCS     = $(LIBDVX)/dvxResource.c $(TOOLSDIR)/dvxResWrite.c
 CLI_SRCS     = basBuild.c $(COMP_SRCS) $(VM_LINK_SRCS) $(RES_SRCS) $(SUPPORT_SRCS)
 
 # Runtime library objects (VM + values + form runtime + serialization)
-RT_OBJS = $(OBJDIR)/vm.o $(OBJDIR)/values.o $(OBJDIR)/formrt.o $(OBJDIR)/frmParser.o $(OBJDIR)/basNativeDos.o $(OBJDIR)/serialize.o
+RT_OBJS = $(OBJDIR)/vm.o $(OBJDIR)/values.o $(OBJDIR)/dates.o $(OBJDIR)/gfx.o $(OBJDIR)/screen.o $(OBJDIR)/formrt.o $(OBJDIR)/formGfx.o $(OBJDIR)/frmParser.o $(OBJDIR)/basNativeDos.o $(OBJDIR)/serialize.o
 RT_TARGETDIR = $(LIBSDIR)/kpunch/basrt
 RT_TARGET    = $(RT_TARGETDIR)/basrt.lib
 
@@ -281,7 +281,7 @@ clean: host-basrt-clean
 # of the host build.
 HOSTRT_DIR      = $(HOST_OBJROOT)/basrt
 HOSTRT_TARGET   = $(HOST_OBJROOT)/basrt.a
-HOSTRT_SRCS     = $(COMP_SRCS) $(VM_SRCS) formrt/formrt.c formrt/frmParser.c formrt/basNativeHost.c
+HOSTRT_SRCS     = $(COMP_SRCS) $(VM_SRCS) formrt/formrt.c formrt/formGfx.c formrt/frmParser.c formrt/basNativeHost.c
 HOSTRT_OBJS     = $(patsubst %.c,$(HOSTRT_DIR)/%.o,$(notdir $(HOSTRT_SRCS)))
 HOSTRT_CFLAGS   = $(HOST_CFLAGS) -Wno-stringop-truncation $(DVX_INCLUDES) -I../../../widgets/kpunch -I../../../libs/kpunch/dvxshell -I../../../libs/kpunch/libtasks
 

src/apps/kpunch/dvxbasic/basBuild.c

@@ -77,7 +77,7 @@
 
 // Growth unit of the project source buffer.
 #define BAS_BUILD_SOURCE_CHUNK 8192
-// Room for a BEGINFORM "name" / ENDFORM wrapper around a form's code.
+// Room for a BEGINFORM "name" / BEGINCLASS "name" line.
 #define BAS_BUILD_WRAP_SLACK   (BAS_MAX_IDENT + 32)
 // Longest [Modules]/[Forms] key, "File" plus a decimal index.
 #define BAS_BUILD_KEY_LEN      32
@@ -89,15 +89,26 @@ static char sIconError[BAS_BUILD_ERROR_LEN];
 // basBuildConcatProject passes, in source order.
 typedef enum {
     BAS_BUILD_PASS_MODULES,
+    BAS_BUILD_PASS_CLASSES,
     BAS_BUILD_PASS_FORMS,
     BAS_BUILD_PASS_COUNT
 } BasBuildPassE;
 
+// The directives around a form's and a class module's code.
+static const char *const sWrapBegin[] = {
+    [BAS_BUILD_WRAP_FORM]  = "BEGINFORM",
+    [BAS_BUILD_WRAP_CLASS] = "BEGINCLASS"
+};
+static const char *const sWrapEnd[] = {
+    [BAS_BUILD_WRAP_FORM]  = "ENDFORM\n",
+    [BAS_BUILD_WRAP_CLASS] = "ENDCLASS\n"
+};
+
 // Function prototypes (alphabetical)
 static bool        appendSource(BasProjectSourceT *ps, const char *text, int32_t len);
 static int32_t     appendText(const char *path, const char *name, const char *value);
 const char        *basBuildApp(const char *outPath, const BasBuildSpecT *spec);
-bool               basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, const char *formName, int32_t *textLine, int32_t *textLines);
+bool               basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, BasBuildWrapE wrap, const char *name, int32_t *textLine, int32_t *textLines);
 bool               basBuildConcatProject(PrefsHandleT *prefs, const char *projectDir, BasProjectSourceT *out);
 void               basBuildDirOf(const char *path, char *out, int32_t outSize);
 void               basBuildFreeProject(BasProjectSourceT *out);
@@ -229,19 +240,17 @@ const char *basBuildApp(const char *outPath, const BasBuildSpecT *spec) {
 }
 
 
-bool basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, const char *formName, int32_t *textLine, int32_t *textLines) {
+bool basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, BasBuildWrapE wrap, const char *name, int32_t *textLine, int32_t *textLines) {
-    bool isForm = (formName && formName[0]);
+    if (wrap != BAS_BUILD_WRAP_NONE) {
+        char    line[BAS_BUILD_WRAP_SLACK];
+        int32_t n = snprintf(line, sizeof(line), "%s \"%s\"\n", sWrapBegin[wrap], name);
 
-    if (isForm) {
+        if (n < 0 || n >= (int32_t)sizeof(line)) {
-        char    wrap[BAS_BUILD_WRAP_SLACK];
+            snprintf(ps->error, sizeof(ps->error), "Name too long: %s", name);
-        int32_t n = snprintf(wrap, sizeof(wrap), "BEGINFORM \"%s\"\n", formName);
-
-        if (n < 0 || n >= (int32_t)sizeof(wrap)) {
-            snprintf(ps->error, sizeof(ps->error), "Form name too long: %s", formName);
             return false;
         }
 
-        if (!appendSource(ps, wrap, n)) {
+        if (!appendSource(ps, line, n)) {
             return false;
         }
     }
@@ -260,8 +269,8 @@ bool basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, co
         *textLines = ps->lineCount + 1 - startLine;
     }
 
-    if (isForm) {
+    if (wrap != BAS_BUILD_WRAP_NONE) {
-        return appendSource(ps, "ENDFORM\n", (int32_t)strlen("ENDFORM\n"));
+        return appendSource(ps, sWrapEnd[wrap], (int32_t)strlen(sWrapEnd[wrap]));
     }
 
     return true;
@@ -271,15 +280,17 @@ bool basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, co
 bool basBuildConcatProject(PrefsHandleT *prefs, const char *projectDir, BasProjectSourceT *out) {
     static const char *const sections[BAS_BUILD_PASS_COUNT] = {
         [BAS_BUILD_PASS_MODULES] = BAS_INI_SECTION_MODULES,
+        [BAS_BUILD_PASS_CLASSES] = BAS_INI_SECTION_CLASSES,
         [BAS_BUILD_PASS_FORMS]   = BAS_INI_SECTION_FORMS
     };
 
     memset(out, 0, sizeof(*out));
     out->optionExplicit = prefsGetBool(prefs, BAS_INI_SECTION_SETTINGS, BAS_INI_KEY_OPTIONEXPLICIT, false);
 
-    // .bas modules first, then .frm code sections.
+    // .bas modules first, then .cls class modules, then .frm code sections.
     for (int32_t pass = 0; pass < BAS_BUILD_PASS_COUNT; pass++) {
-        bool isForm = (pass == BAS_BUILD_PASS_FORMS);
+        bool isForm  = (pass == BAS_BUILD_PASS_FORMS);
+        bool isClass = (pass == BAS_BUILD_PASS_CLASSES);
 
         for (int32_t i = 0; ; i++) {
             char key[BAS_BUILD_KEY_LEN];
@@ -302,11 +313,27 @@ bool basBuildConcatProject(PrefsHandleT *prefs, const char *projectDir, BasProje
                 return false;
             }
 
-            const char *code                    = src;
+            const char   *code                    = src;
-            char        formName[BAS_MAX_IDENT] = "";
+            char          formName[BAS_MAX_IDENT] = "";
+            BasBuildWrapE wrap                    = BAS_BUILD_WRAP_NONE;
 
             entry.firstFileLine = 1;
 
+            if (isClass) {
+                // The class code follows the .cls header
+                if (!basExtractClassName(src, srcLen, val, formName, BAS_MAX_IDENT)) {
+                    snprintf(out->error, sizeof(out->error), "No class name for %s", entry.path);
+                    free(src);
+                    return false;
+                }
+
+                int32_t codeOff = basClassCodePos(src, srcLen);
+
+                code                = src + codeOff;
+                entry.firstFileLine = countLines(src, codeOff) + 1;
+                wrap                = BAS_BUILD_WRAP_CLASS;
+            }
+
             if (isForm) {
                 // A .frm without a Begin Form line would otherwise compile
                 // its code unwrapped, as if it were a module.
@@ -321,9 +348,10 @@ bool basBuildConcatProject(PrefsHandleT *prefs, const char *projectDir, BasProje
 
                 code                = src + codeOff;
                 entry.firstFileLine = countLines(src, codeOff) + 1;
+                wrap                = BAS_BUILD_WRAP_FORM;
             }
 
-            if (!basBuildAppendFile(out, code, (int32_t)strlen(code), formName, &entry.startLine, &entry.lineCount)) {
+            if (!basBuildAppendFile(out, code, (int32_t)strlen(code), wrap, formName, &entry.startLine, &entry.lineCount)) {
                 free(src);
                 return false;
             }

src/apps/kpunch/dvxbasic/basBuild.h

@@ -99,8 +99,10 @@ typedef struct {
 } BasSourceMapT;
 
 // A project's BASIC source as the compiler consumes it: every [Modules]
-// file in order, then the code section of every [Forms] file wrapped in
+// file in order, then the code of every [Classes] file wrapped in
-// BEGINFORM "name" / ENDFORM, each file ending on a newline.  frmPaths
+// BEGINCLASS "name" / ENDCLASS, then the code section of every [Forms]
+// file wrapped in BEGINFORM "name" / ENDFORM, each file ending on a
+// newline.  frmPaths
 // and frmTexts list the .frm files (path and full text, as read) in the
 // same order for the resource step; map locates each file's lines.
 typedef struct {
@@ -111,18 +113,25 @@ typedef struct {
     char         **frmPaths;        // stb_ds array of malloc'd paths
     char         **frmTexts;        // stb_ds array of malloc'd .frm texts
     BasSourceMapT *map;             // stb_ds array, one entry per file
-    int32_t        fileCount;       // modules + forms
+    int32_t        fileCount;       // modules + classes + forms
     bool           optionExplicit;  // [Settings] OptionExplicit
     char           error[BAS_BUILD_ERROR_LEN];
 } BasProjectSourceT;
 
+// What basBuildAppendFile wraps a file's text in.
+typedef enum {
+    BAS_BUILD_WRAP_NONE,    // a module: the text as it is
+    BAS_BUILD_WRAP_FORM,    // a form's code: BEGINFORM "name" / ENDFORM
+    BAS_BUILD_WRAP_CLASS    // a class module's code: BEGINCLASS "name" / ENDCLASS
+} BasBuildWrapE;
+
 // Appends one file's text to *ps (a zeroed struct is a valid empty
-// project) and makes sure it ends on a newline.  A non-empty formName
+// project) and makes sure it ends on a newline, wrapped as wrap says in
-// wraps the text in BEGINFORM "name" / ENDFORM.  textLine and textLines
+// the directives naming name.  textLine and textLines (either may be
-// (either may be NULL) receive the 1-based line the text starts on and
+// NULL) receive the 1-based line the text starts on and the number of
-// the number of lines it occupies, wrapper lines excluded -- what an IDE
+// lines it occupies, wrapper lines excluded -- what an IDE source map
-// source map needs.  Returns false with ps->error set on failure.
+// needs.  Returns false with ps->error set on failure.
-bool basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, const char *formName, int32_t *textLine, int32_t *textLines);
+bool basBuildAppendFile(BasProjectSourceT *ps, const char *text, int32_t len, BasBuildWrapE wrap, const char *name, int32_t *textLine, int32_t *textLines);
 
 // Reads the source files named by an open .dbp (paths relative to
 // projectDir) into *out.  Returns false with out->error set on failure;

src/apps/kpunch/dvxbasic/basRes.h

@@ -34,6 +34,7 @@
 #include <stdbool.h>
 #include <stddef.h> // NULL
 #include <stdint.h>
+#include <string.h>  // memchr, strlen
 #include <strings.h> // strncasecmp
 
 #include "formrt/frmParser.h" // FRM_KW_* .frm keyword spellings
@@ -65,8 +66,29 @@ const char *dvxSkipWs(const char *s);
 #define BAS_INI_KEY_STARTUPFORM     "StartupForm"
 #define BAS_INI_KEY_OPTIONEXPLICIT  "OptionExplicit"
 #define BAS_INI_SECTION_MODULES     "Modules"
+#define BAS_INI_SECTION_CLASSES     "Classes"
 #define BAS_INI_SECTION_FORMS       "Forms"
 
+// ------------------------------------------------------------
+// .cls class module files
+// ------------------------------------------------------------
+//
+// A class module is BASIC code with an optional VB-style header in front:
+//
+//   VERSION DVX 1.00 CLASS
+//   Attribute VB_Name = "Stack"
+//
+// Blank lines, a VERSION line, a BEGIN ... END block and Attribute VB_xxx
+// lines before the first line of code make up the header.  The class
+// takes its name from Attribute VB_Name, else from the file name.
+
+#define BAS_CLS_KW_VERSION   "VERSION"
+#define BAS_CLS_KW_BEGIN     "BEGIN"
+#define BAS_CLS_KW_ATTRIBUTE "Attribute"
+#define BAS_CLS_ATTR_PREFIX  "VB_"
+#define BAS_CLS_ATTR_NAME    "VB_Name"
+#define BAS_CLS_EXT          ".cls"
+
 // ------------------------------------------------------------
 // Resource names inside a compiled .app DXE
 // ------------------------------------------------------------
@@ -114,12 +136,122 @@ const char *dvxSkipWs(const char *s);
 // .frm scanners (shared by bascomp, basstub, basBuild and the obfuscator)
 // ------------------------------------------------------------
 
+static inline int32_t basClassCodePos(const char *text, int32_t len);
+static inline bool    basClassHeaderLine(const char *s, int32_t len);
+static inline bool    basExtractClassName(const char *text, int32_t len, const char *path, char *nameBuf, int32_t nameBufSize);
 static inline bool    basExtractFormName(const char *frmText, char *nameBuf, int32_t nameBufSize);
 static inline int32_t basFindFormEndPos(const char *text, int32_t len);
+static inline bool    basLineIsWord(const char *s, int32_t len, const char *word);
 static inline int32_t basMatchBeginForm(const char *s, int32_t len);
 static inline int32_t basMatchKeywordWs(const char *s, int32_t len, const char *kw, int32_t kwLen);
 
 
+// Offset of the first line of code in a .cls text (just past its header;
+// 0 when it has none).
+static inline int32_t basClassCodePos(const char *text, int32_t len) {
+    int32_t pos   = 0;
+    int32_t depth = 0;
+
+    while (pos < len) {
+        int32_t lineStart = pos;
+
+        while (pos < len && text[pos] != '\n') {
+            pos++;
+        }
+
+        int32_t lineEnd = pos;
+
+        if (pos < len) {
+            pos++;
+        }
+
+        while (lineEnd > lineStart && (text[lineEnd - 1] == '\r' || text[lineEnd - 1] == ' ' || text[lineEnd - 1] == '\t')) {
+            lineEnd--;
+        }
+
+        int32_t l = lineStart;
+
+        while (l < lineEnd && (text[l] == ' ' || text[l] == '\t')) {
+            l++;
+        }
+
+        // Inside BEGIN ... END everything belongs to the header
+        if (basLineIsWord(text + l, lineEnd - l, BAS_CLS_KW_BEGIN)) {
+            depth++;
+        } else if (depth > 0 && frmIsEndLine(text + l, lineEnd - l)) {
+            depth--;
+        } else if (depth == 0 && l < lineEnd && !basClassHeaderLine(text + l, lineEnd - l)) {
+            return lineStart;
+        }
+    }
+
+    return len;
+}
+
+
+// A .cls header line outside BEGIN ... END: VERSION ... or Attribute
+// VB_xxx (a member's Attribute Name.VB_xxx belongs to the code).
+static inline bool basClassHeaderLine(const char *s, int32_t len) {
+    if (basLineIsWord(s, len, BAS_CLS_KW_VERSION)) {
+        return true;
+    }
+
+    int32_t a = basMatchKeywordWs(s, len, BAS_CLS_KW_ATTRIBUTE, (int32_t)sizeof(BAS_CLS_KW_ATTRIBUTE) - 1);
+
+    return a >= 0 && len - a > (int32_t)sizeof(BAS_CLS_ATTR_PREFIX) - 1 && strncasecmp(s + a, BAS_CLS_ATTR_PREFIX, sizeof(BAS_CLS_ATTR_PREFIX) - 1) == 0;
+}
+
+
+// The class name of a .cls text: its Attribute VB_Name = "name" when the
+// header has one, else the base name of path (without directory and
+// extension).  Returns false when neither gives a name.
+static inline bool basExtractClassName(const char *text, int32_t len, const char *path, char *nameBuf, int32_t nameBufSize) {
+    int32_t codePos = basClassCodePos(text, len);
+    int32_t attrLen = (int32_t)sizeof(BAS_CLS_ATTR_NAME) - 1;
+
+    nameBuf[0] = '\0';
+
+    for (int32_t pos = 0; pos < codePos; pos++) {
+        if ((pos == 0 || text[pos - 1] == ' ' || text[pos - 1] == '\t') && codePos - pos > attrLen && strncasecmp(text + pos, BAS_CLS_ATTR_NAME, attrLen) == 0) {
+            const char *q = memchr(text + pos, '"', codePos - pos);
+
+            if (q) {
+                int32_t ni = 0;
+
+                for (q++; q < text + codePos && *q != '"' && *q != '\n' && ni < nameBufSize - 1; q++) {
+                    nameBuf[ni++] = *q;
+                }
+
+                nameBuf[ni] = '\0';
+            }
+
+            break;
+        }
+    }
+
+    if (nameBuf[0] == '\0' && path) {
+        const char *base = path;
+
+        for (const char *c = path; *c; c++) {
+            if (*c == '/' || *c == '\\' || *c == ':') {
+                base = c + 1;
+            }
+        }
+
+        int32_t ni = 0;
+
+        while (base[ni] && base[ni] != '.' && ni < nameBufSize - 1) {
+            nameBuf[ni] = base[ni];
+            ni++;
+        }
+
+        nameBuf[ni] = '\0';
+    }
+
+    return nameBuf[0] != '\0';
+}
+
+
 // Extract the form name from a "Begin Form <name>" line in .frm text.
 // Writes a NUL-terminated name into nameBuf (max nameBufSize bytes,
 // including the terminator) and returns true if a name was found.
@@ -233,6 +365,15 @@ static inline int32_t basFindFormEndPos(const char *text, int32_t len) {
 }
 
 
+// True when s[0..len) (left-trimmed) starts with word followed by the end
+// of the line or a space or tab.
+static inline bool basLineIsWord(const char *s, int32_t len, const char *word) {
+    int32_t wordLen = (int32_t)strlen(word);
+
+    return len >= wordLen && strncasecmp(s, word, wordLen) == 0 && (len == wordLen || s[wordLen] == ' ' || s[wordLen] == '\t');
+}
+
+
 // Match "Begin<ws>Form<ws>" at s[0..len) (s already left-trimmed).  The
 // single definition of the Begin Form syntax for basExtractFormName and
 // basFindFormEndPos.  Returns the offset of the form name, or -1.

src/apps/kpunch/dvxbasic/compiler/basEvents.h

@@ -74,6 +74,8 @@ typedef enum {
 #define BAS_EVT_SCROLL      "Scroll"
 #define BAS_EVT_REPOSITION  "Reposition"
 #define BAS_EVT_VALIDATE    "Validate"
+#define BAS_EVT_DRAGDROP    "DragDrop"
+#define BAS_EVT_DRAGOVER    "DragOver"
 
 #define BAS_EVENT_LIST(X) \
     X(BAS_EVT_LOAD,        BAS_EVT_SCOPE_FORM, "") \
@@ -96,7 +98,25 @@ typedef enum {
     X(BAS_EVT_MOUSEMOVE,   BAS_EVT_SCOPE_BOTH, "Button As Integer, X As Integer, Y As Integer") \
     X(BAS_EVT_SCROLL,      BAS_EVT_SCOPE_CTRL, "Delta As Integer") \
     X(BAS_EVT_REPOSITION,  BAS_EVT_SCOPE_CTRL, "") \
-    X(BAS_EVT_VALIDATE,    BAS_EVT_SCOPE_CTRL, "Cancel As Integer")
+    X(BAS_EVT_VALIDATE,    BAS_EVT_SCOPE_CTRL, "Cancel As Integer") \
+    X(BAS_EVT_DRAGDROP,    BAS_EVT_SCOPE_BOTH, "Source As Control, X As Integer, Y As Integer") \
+    X(BAS_EVT_DRAGOVER,    BAS_EVT_SCOPE_BOTH, "Source As Control, X As Integer, Y As Integer, State As Integer")
+
+// Drag and drop values, shared by the compiler's predefined vb*
+// constants and the form runtime: the DragMode property, the Drag
+// method's action and DragOver's State.
+#define BAS_DRAGMODE_MANUAL    0   // vbManual: the program calls Drag
+#define BAS_DRAGMODE_AUTOMATIC 1   // vbAutomatic: pressing the control starts a drag
+#define BAS_DRAG_CANCEL        0   // Drag 0: stop without dropping
+#define BAS_DRAG_BEGIN         1   // vbBeginDrag (the default)
+#define BAS_DRAG_END           2   // vbEndDrag: drop where the mouse is
+#define BAS_DRAG_ENTER         0   // vbEnter: the drag came onto the object
+#define BAS_DRAG_LEAVE         1   // vbLeave: the drag went off it
+#define BAS_DRAG_OVER          2   // vbOver: the drag moved over it
+
+// Clipboard formats (Clipboard.GetFormat / GetText / SetText): the DVX
+// clipboard holds text.
+#define BAS_CF_TEXT            1   // vbCFText
 
 // One row of BAS_EVENT_LIST, for consumers that want a runtime table
 // (e.g. `static const BasEventInfoT sEvents[] = { BAS_EVENT_LIST(BAS_EVENT_ROW) };`).

src/apps/kpunch/dvxbasic/compiler/basKeywords.h

@@ -28,15 +28,18 @@
 // BAS_KEYWORD(text, token, cls) before including this header to expand
 // the list; text is the uppercase word, token its TOK_* value (ignore it
 // outside the compiler) and cls its BasKeywordClassE.  The entries are in
-// strcmp order, so an expanded table can be searched with bsearch.
+// strcmp order, so an expanded table can be searched with bsearch.  An
+// entry whose token is TOK_IDENT is not reserved -- the lexer returns it
+// as an identifier and a program may use the name for its own things --
+// but colorizers still show it (built-in type names, Empty, Null, EACH).
 
 #ifndef DVXBASIC_BAS_KEYWORDS_H
 #define DVXBASIC_BAS_KEYWORDS_H
 
 typedef enum {
     BAS_KW_CLASS_OTHER   = 0,  // control-flow / statement / operator keyword
-    BAS_KW_CLASS_TYPE    = 1,  // INTEGER, LONG, SINGLE, DOUBLE, STRING, BOOLEAN
+    BAS_KW_CLASS_TYPE    = 1,  // INTEGER, LONG, SINGLE, DOUBLE, STRING, BOOLEAN, DATE, VARIANT, OBJECT, COLLECTION
-    BAS_KW_CLASS_LITERAL = 2   // TRUE, FALSE, NOTHING
+    BAS_KW_CLASS_LITERAL = 2   // TRUE, FALSE, NOTHING, EMPTY, NULL, EMPTY, NULL
 } BasKeywordClassE;
 
 #endif // DVXBASIC_BAS_KEYWORDS_H
@@ -57,12 +60,14 @@ BAS_KEYWORD("CASE",          TOK_CASE,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("CHDIR",         TOK_CHDIR,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("CHDRIVE",       TOK_CHDRIVE,       BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("CLOSE",         TOK_CLOSE,         BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("COLLECTION",    TOK_IDENT,         BAS_KW_CLASS_TYPE)
 BAS_KEYWORD("CONST",         TOK_CONST,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("CREATECONTROL", TOK_CREATECONTROL, BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("CREATEFORM",    TOK_CREATEFORM,    BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("CURDIR",        TOK_CURDIR,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("CURDIR$",       TOK_CURDIR,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("DATA",          TOK_DATA,          BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("DATE",          TOK_IDENT,         BAS_KW_CLASS_TYPE)
 BAS_KEYWORD("DECLARE",       TOK_DECLARE,       BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("DEF",           TOK_DEF,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("DEFDBL",        TOK_DEFDBL,        BAS_KW_CLASS_OTHER)
@@ -76,9 +81,12 @@ BAS_KEYWORD("DIR$",          TOK_DIR,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("DO",            TOK_DO,            BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("DOEVENTS",      TOK_DOEVENTS,      BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("DOUBLE",        TOK_DOUBLE,        BAS_KW_CLASS_TYPE)
+BAS_KEYWORD("EACH",          TOK_IDENT,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("ELSE",          TOK_ELSE,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("ELSEIF",        TOK_ELSEIF,        BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("EMPTY",         TOK_IDENT,         BAS_KW_CLASS_LITERAL)
 BAS_KEYWORD("END",           TOK_END,           BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("ENUM",          TOK_ENUM,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("EOF",           TOK_EOF_KW,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("EQV",           TOK_EQV,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("ERASE",         TOK_ERASE,         BAS_KW_CLASS_OTHER)
@@ -111,6 +119,7 @@ BAS_KEYWORD("IS",            TOK_IS,            BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("KILL",          TOK_KILL,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("LBOUND",        TOK_LBOUND,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("LET",           TOK_LET,           BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("LIBRARY",       TOK_IDENT,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("LINE",          TOK_LINE,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("LOAD",          TOK_LOAD,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("LONG",          TOK_LONG,          BAS_KW_CLASS_TYPE)
@@ -121,18 +130,25 @@ BAS_KEYWORD("MKDIR",         TOK_MKDIR,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("MOD",           TOK_MOD,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("MSGBOX",        TOK_MSGBOX,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("NAME",          TOK_NAME,          BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("NEW",           TOK_NEW,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("NEXT",          TOK_NEXT,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("NOT",           TOK_NOT,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("NOTHING",       TOK_NOTHING,       BAS_KW_CLASS_LITERAL)
+BAS_KEYWORD("NULL",          TOK_IDENT,         BAS_KW_CLASS_LITERAL)
+BAS_KEYWORD("OBJECT",        TOK_IDENT,         BAS_KW_CLASS_TYPE)
 BAS_KEYWORD("ON",            TOK_ON,            BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("OPEN",          TOK_OPEN,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("OPTION",        TOK_OPTION,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("OPTIONAL",      TOK_OPTIONAL,      BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("OR",            TOK_OR,            BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("OUTPUT",        TOK_OUTPUT,        BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("PARAMARRAY",    TOK_PARAMARRAY,    BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("PLAY",          TOK_PLAY,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("PRESERVE",      TOK_PRESERVE,      BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("PRINT",         TOK_PRINT,         BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("PRIVATE",       TOK_PRIVATE,       BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("PROPERTY",      TOK_PROPERTY,      BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("PUBLIC",        TOK_PUBLIC,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("PUT",           TOK_PUT,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("RANDOM",        TOK_RANDOM,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("RANDOMIZE",     TOK_RANDOMIZE,     BAS_KW_CLASS_OTHER)
@@ -157,6 +173,7 @@ BAS_KEYWORD("SLEEP",         TOK_SLEEP,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("SOUND",         TOK_SOUND,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("STATIC",        TOK_STATIC,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("STEP",          TOK_STEP,          BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("STOP",          TOK_IDENT,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("STRING",        TOK_STRING_KW,     BAS_KW_CLASS_TYPE)
 BAS_KEYWORD("SUB",           TOK_SUB,           BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("SWAP",          TOK_SWAP,          BAS_KW_CLASS_OTHER)
@@ -165,9 +182,11 @@ BAS_KEYWORD("TIMER",         TOK_TIMER,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("TO",            TOK_TO,            BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("TRUE",          TOK_TRUE_KW,       BAS_KW_CLASS_LITERAL)
 BAS_KEYWORD("TYPE",          TOK_TYPE,          BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("TYPEOF",        TOK_TYPEOF,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("UBOUND",        TOK_UBOUND,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("UNLOAD",        TOK_UNLOAD,        BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("UNTIL",         TOK_UNTIL,         BAS_KW_CLASS_OTHER)
+BAS_KEYWORD("VARIANT",       TOK_IDENT,         BAS_KW_CLASS_TYPE)
 BAS_KEYWORD("WEND",          TOK_WEND,          BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("WHILE",         TOK_WHILE,         BAS_KW_CLASS_OTHER)
 BAS_KEYWORD("WITH",          TOK_WITH,          BAS_KW_CLASS_OTHER)

src/apps/kpunch/dvxbasic/compiler/codegen.c

@@ -30,6 +30,7 @@
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
+#include <strings.h>
 
 
 // Function prototypes (alphabetical)
@@ -43,6 +44,7 @@ BasModuleT *basCodeGenBuildModuleWithProcs(BasCodeGenT *cg, void *symtab);
 void basCodeGenFree(BasCodeGenT *cg);
 void basCodeGenInit(BasCodeGenT *cg);
 void basCodeGenInsert(BasCodeGenT *cg, int32_t pos, const uint8_t *bytes, int32_t len);
+void basCodeGenTruncate(BasCodeGenT *cg, int32_t codeLen, int32_t constCount);
 int32_t basCodePos(const BasCodeGenT *cg);
 void basEmit16(BasCodeGenT *cg, int16_t v);
 void basEmit32(BasCodeGenT *cg, int32_t v);
@@ -51,10 +53,12 @@ static void basEmitBytes(BasCodeGenT *cg, const void *data, int32_t len);
 void basEmitDouble(BasCodeGenT *cg, double v);
 void basEmitU16(BasCodeGenT *cg, uint16_t v);
 void basPatch16(BasCodeGenT *cg, int32_t pos, int16_t val);
+static bool buildClasses(BasModuleT *mod, const BasSymTabT *tab);
 static uint32_t constantHash(const char *text, int32_t len);
 static bool copyDebugInfo(BasModuleT *mod, const BasCodeGenT *cg);
 static bool isEmittableProc(const BasSymbolT *s);
 static bool needsGlobalInit(const BasSymbolT *s);
+static int32_t procIndexAt(const BasModuleT *mod, int32_t codeAddr);
 
 
 uint16_t basAddConstant(BasCodeGenT *cg, const char *text, int32_t len) {
@@ -252,7 +256,7 @@ BasModuleT *basCodeGenBuildModuleWithProcs(BasCodeGenT *cg, void *symtab) {
     }
 
     if (procCount == 0) {
-        return mod;
+        return buildClasses(mod, tab) ? mod : NULL;
     }
 
     mod->procs = (BasProcEntryT *)malloc(procCount * sizeof(BasProcEntryT));
@@ -300,7 +304,7 @@ BasModuleT *basCodeGenBuildModuleWithProcs(BasCodeGenT *cg, void *symtab) {
     }
 
     mod->procCount = idx;
-    return mod;
+    return buildClasses(mod, tab) ? mod : NULL;
 }
 
 
@@ -345,6 +349,24 @@ void basCodeGenInsert(BasCodeGenT *cg, int32_t pos, const uint8_t *bytes, int32_
 }
 
 
+void basCodeGenTruncate(BasCodeGenT *cg, int32_t codeLen, int32_t constCount) {
+    arrsetlen(cg->code, codeLen);
+    cg->codeLen = codeLen;
+
+    // Newest first: an entry being dropped is always the head of its
+    // bucket once every newer entry is gone.
+    for (int32_t i = cg->constCount - 1; i >= constCount; i--) {
+        cg->constBuckets[cg->constHashes[i] & (BAS_CONST_BUCKETS - 1)] = cg->constNext[i];
+        basStringUnref(cg->constants[i]);
+    }
+
+    arrsetlen(cg->constants, constCount);
+    arrsetlen(cg->constHashes, constCount);
+    arrsetlen(cg->constNext, constCount);
+    cg->constCount = constCount;
+}
+
+
 int32_t basCodePos(const BasCodeGenT *cg) {
     return cg->codeLen;
 }
@@ -398,6 +420,74 @@ void basPatch16(BasCodeGenT *cg, int32_t pos, int16_t val) {
 }
 
 
+// Copies the class modules into mod->classes: each class's size, set-up
+// code and public members, procedures by their index in the (sorted)
+// procedure table.  Frees mod and returns false when memory runs out.
+static bool buildClasses(BasModuleT *mod, const BasSymTabT *tab) {
+    int32_t count = (int32_t)arrlen(tab->classes);
+
+    if (count == 0) {
+        return true;
+    }
+
+    mod->classes = (BasClassInfoT *)calloc(count, sizeof(BasClassInfoT));
+
+    if (!mod->classes) {
+        basModuleFree(mod);
+        return false;
+    }
+
+    mod->classCount = count;
+
+    for (int32_t c = 0; c < count; c++) {
+        const BasClassDefT *def  = &tab->classes[c];
+        BasClassInfoT      *info = &mod->classes[c];
+        int32_t             n    = (int32_t)arrlen(def->members);
+
+        snprintf(info->name, sizeof(info->name), "%s", def->name);
+        info->varCount      = def->varCount;
+        info->initCodeAddr  = def->initCodeAddr;
+        info->terminateProc = def->terminateSym ? procIndexAt(mod, def->terminateSym->codeAddr) : -1;
+
+        if (n == 0) {
+            continue;
+        }
+
+        info->members = (BasClassMemberT *)calloc(n, sizeof(BasClassMemberT));
+
+        if (!info->members) {
+            basModuleFree(mod);
+            return false;
+        }
+
+        info->memberCount = n;
+
+        for (int32_t i = 0; i < n; i++) {
+            const BasClassMemberDefT *md  = &def->members[i];
+            const BasSymbolT         *sym = md->sym;
+            BasClassMemberT          *m   = &info->members[i];
+
+            snprintf(m->name, sizeof(m->name), "%s", md->name);
+            m->kind           = md->kind;
+            m->dataType       = sym->dataType;
+            m->requiredParams = (uint8_t)sym->requiredParams;
+            m->index          = (md->kind == BAS_MEMBER_VAR) ? sym->index : procIndexAt(mod, sym->codeAddr);
+            memcpy(m->paramTypes, sym->paramTypes, DVX_MIN(sizeof(m->paramTypes), sizeof(sym->paramTypes)));
+
+            if (strcasecmp(md->name, def->defaultMember) == 0) {
+                m->flags |= BAS_MEMBER_DEFAULT;
+            }
+
+            if (sym->hasParamArray) {
+                m->flags |= BAS_MEMBER_PARAMARRAY;
+            }
+        }
+    }
+
+    return true;
+}
+
+
 // FNV-1a over the constant's bytes (case-sensitive: constants are exact).
 static uint32_t constantHash(const char *text, int32_t len) {
     uint32_t h = BAS_FNV1A_OFFSET;
@@ -483,3 +573,25 @@ static bool isEmittableProc(const BasSymbolT *s) {
 static bool needsGlobalInit(const BasSymbolT *s) {
     return s->scope == SCOPE_GLOBAL && s->kind == SYM_VARIABLE && s->dataType == BAS_TYPE_STRING && !s->isArray;
 }
+
+
+// Index into mod->procs (sorted by code address) of the procedure at
+// codeAddr, or -1.
+static int32_t procIndexAt(const BasModuleT *mod, int32_t codeAddr) {
+    int32_t lo = 0;
+    int32_t hi = mod->procCount - 1;
+
+    while (lo <= hi) {
+        int32_t mid = lo + (hi - lo) / 2;
+
+        if (mod->procs[mid].codeAddr < codeAddr) {
+            lo = mid + 1;
+        } else if (mod->procs[mid].codeAddr > codeAddr) {
+            hi = mid - 1;
+        } else {
+            return mid;
+        }
+    }
+
+    return -1;
+}

src/apps/kpunch/dvxbasic/compiler/codegen.h

@@ -104,6 +104,11 @@ void basPatch16(BasCodeGenT *cg, int32_t pos, int16_t val);
 // Insert len bytes at pos, moving the code after it up.
 void basCodeGenInsert(BasCodeGenT *cg, int32_t pos, const uint8_t *bytes, int32_t len);
 
+// Drop the code emitted after codeLen and the constants added after
+// constCount (both from an earlier basCodePos / constCount), e.g. the
+// code of a constant expression once it has been evaluated.
+void basCodeGenTruncate(BasCodeGenT *cg, int32_t codeLen, int32_t constCount);
+
 // Add a string to the constant pool. Returns the pool index.
 uint16_t basAddConstant(BasCodeGenT *cg, const char *text, int32_t len);
 

src/apps/kpunch/dvxbasic/compiler/compact.c

@@ -34,7 +34,8 @@
 // Address references:
 //   - BasProcEntryT::codeAddr (absolute)
 //   - BasFormVarInfoT::initCodeAddr (absolute, negative = no init)
-//   - OP_CALL operand (absolute uint16)
+//   - BasClassInfoT::initCodeAddr (absolute, negative = none)
+//   - OP_CALL / OP_CALL_ME operand (absolute uint16)
 //   - OP_JMP / OP_JMP_TRUE / OP_JMP_FALSE / OP_GOSUB operand (relative int16)
 //   - OP_FOR_INIT / OP_FOR_NEXT offset operand (relative int16)
 //   - OP_ON_ERROR handler operand (relative int16; 0 = disable, not remapped)
@@ -156,7 +157,8 @@ int32_t basCompactBytecode(BasModuleT *mod) {
         memcpy(newCode + newPc, oldCode + oldPc, instSize);
 
         switch (op) {
-            case OP_CALL: {
+            case OP_CALL:
+            case OP_CALL_ME: {
                 uint16_t oldAddr = basReadU16LE(oldCode + oldPc + BAS_ADDR_OPERAND_OFFSET);
 
                 ok = remapAbsU16(newCode, newPc, BAS_ADDR_OPERAND_OFFSET, oldAddr, remap, oldCodeLen);
@@ -240,6 +242,21 @@ int32_t basCompactBytecode(BasModuleT *mod) {
         mod->formVarInfo[i].initCodeLen  = newEnd - newAddr;
     }
 
+    // Rewrite class set-up code addresses (negative: none).
+    for (int32_t i = 0; i < mod->classCount; i++) {
+        int32_t oldAddr = mod->classes[i].initCodeAddr;
+
+        if (oldAddr > oldCodeLen) {
+            free(newCode);
+            free(remap);
+            return 0;
+        }
+
+        if (oldAddr >= 0) {
+            mod->classes[i].initCodeAddr = remap[oldAddr];
+        }
+    }
+
     // Rewrite entry point
     if (mod->entryPoint < 0 || mod->entryPoint > oldCodeLen) {
         free(newCode);

src/apps/kpunch/dvxbasic/compiler/lexer.c

@@ -30,6 +30,7 @@
 #include "lexer.h"
 #include "opcodes.h"
 #include "dvxTypes.h"
+#include "../runtime/dates.h"
 
 #include <ctype.h>
 #include <errno.h>
@@ -62,6 +63,11 @@ static const KeywordEntryT sKeywords[] = {
 #define LEX_BIN_BITS 1
 #define LEX_HEX_BITS 4
 
+// Date literals: the characters allowed between the '#'s besides letters
+// and digits, and those that mark the text as a date or time.
+#define LEX_DATE_LITERAL_CHARS " /-:,"
+#define LEX_DATE_SEPARATORS    "/-:"
+
 // First value of the hex letter digits A-F.
 #define LEX_HEX_LETTER_BASE 10
 
@@ -120,6 +126,7 @@ static char peekNext(const BasLexerT *lex);
 static void setError(BasLexerT *lex, const char *msg);
 static void skipLineComment(BasLexerT *lex);
 static void skipWhitespace(BasLexerT *lex);
+static bool tokenizeDateLiteral(BasLexerT *lex);
 static BasTokenTypeE tokenizeHexLiteral(BasLexerT *lex);
 static BasTokenTypeE tokenizeIdentOrKeyword(BasLexerT *lex);
 static BasTokenTypeE tokenizeNumber(BasLexerT *lex);
@@ -296,6 +303,12 @@ BasTokenTypeE basLexerNext(BasLexerT *lex) {
         }
     }
 
+    // Date literal #...#; any other '#' is the file-number sign
+    if (c == '#' && tokenizeDateLiteral(lex)) {
+        lex->token.type = TOK_DATE_LIT;
+        return TOK_DATE_LIT;
+    }
+
     // Identifier or keyword
     if (basIsIdentChar(c) && !isdigit((unsigned char)c)) {
         lex->token.type = tokenizeIdentOrKeyword(lex);
@@ -454,6 +467,8 @@ const char *basTokenName(BasTokenTypeE type) {
             return "float";
         case TOK_STRING_LIT:
             return "string";
+        case TOK_DATE_LIT:
+            return "date";
         case TOK_IDENT:
             return "identifier";
         case TOK_DOT:
@@ -695,6 +710,53 @@ static void skipWhitespace(BasLexerT *lex) {
 }
 
 
+// A date literal at the current '#': the text up to the closing '#' on
+// the same line must read as a date (see basDateParse) and hold a date
+// or time separator or a word, so file numbers such as CLOSE #1, 2, #3
+// never read as one.  On success the literal is consumed, the token text
+// holds what was between the '#'s and dblVal the serial; otherwise
+// nothing is consumed.
+static bool tokenizeDateLiteral(BasLexerT *lex) {
+    int32_t end          = lex->pos + 1;
+    bool    hasSeparator = false;
+
+    while (end < lex->sourceLen && lex->source[end] != '#') {
+        char c = lex->source[end];
+
+        if (c == '\0' || end - lex->pos > BAS_MAX_STRING_LEN || !(isalnum((unsigned char)c) || strchr(LEX_DATE_LITERAL_CHARS, c) != NULL)) {
+            return false;
+        }
+
+        hasSeparator = hasSeparator || isalpha((unsigned char)c) || strchr(LEX_DATE_SEPARATORS, c) != NULL;
+        end++;
+    }
+
+    int32_t len = end - lex->pos - 1;
+    char    text[BAS_MAX_TOKEN_LEN];
+    double  serial;
+
+    if (end >= lex->sourceLen || !hasSeparator) {
+        return false;
+    }
+
+    memcpy(text, lex->source + lex->pos + 1, len);
+    text[len] = '\0';
+
+    if (!basDateParse(text, &serial)) {
+        return false;
+    }
+
+    while (lex->pos <= end) {
+        advance(lex);
+    }
+
+    memcpy(lex->token.text, text, len + 1);
+    lex->token.textLen = len;
+    lex->token.dblVal  = serial;
+    return true;
+}
+
+
 static BasTokenTypeE tokenizeHexLiteral(BasLexerT *lex) {
     advance(lex);                       // skip &
     char base = basAsciiUpper(peek(lex));

src/apps/kpunch/dvxbasic/compiler/lexer.h

@@ -46,6 +46,7 @@ typedef enum {
     TOK_LONG_LIT,          // long literal (123&)
     TOK_FLOAT_LIT,         // float literal (3.14, 1.5E10)
     TOK_STRING_LIT,        // "string literal"
+    TOK_DATE_LIT,          // #1/2/2000# date literal (dblVal holds the serial)
 
     // Identifiers and symbols
     TOK_IDENT,             // variable/function name
@@ -102,6 +103,7 @@ typedef enum {
     TOK_ELSE,
     TOK_ELSEIF,
     TOK_END,
+    TOK_ENUM,
     TOK_EOF_KW,            // EOF (keyword, not end-of-file)
     TOK_EQV,
     TOK_ERASE,
@@ -134,6 +136,7 @@ typedef enum {
     TOK_MOD,
     TOK_INPUTBOX,
     TOK_MSGBOX,
+    TOK_NEW,
     TOK_NEXT,
     TOK_NOT,
     TOK_NOTHING,
@@ -143,9 +146,13 @@ typedef enum {
     TOK_OPTION,
     TOK_OR,
     TOK_OUTPUT,
+    TOK_PARAMARRAY,
     TOK_PLAY,
     TOK_PRESERVE,
     TOK_PRINT,
+    TOK_PRIVATE,
+    TOK_PROPERTY,
+    TOK_PUBLIC,
     TOK_PUT,
     TOK_RANDOMIZE,
     TOK_READ,
@@ -177,6 +184,7 @@ typedef enum {
     TOK_TO,
     TOK_TRUE_KW,
     TOK_TYPE,
+    TOK_TYPEOF,
     TOK_UBOUND,
     TOK_UNLOAD,
     TOK_UNTIL,

src/apps/kpunch/dvxbasic/compiler/obfuscate.c

@@ -110,6 +110,18 @@ bool basObfuscateNames(BasModuleT *mod, const char **frmTexts, const int32_t *fr
         }
     }
 
+    // Class and class member names are found by their spelling at run
+    // time (obj.Member), so a control that shares one keeps its name.
+    for (int32_t c = 0; ok && c < mod->classCount; c++) {
+        const BasClassInfoT *cls = &mod->classes[c];
+
+        ok = nameMapAdd(&reserved, cls->name) != NULL;
+
+        for (int32_t m = 0; ok && m < cls->memberCount; m++) {
+            ok = nameMapAdd(&reserved, cls->members[m].name) != NULL;
+        }
+    }
+
     for (int32_t i = 0; ok && i < names.count; i++) {
         if (!nameMapLookup(&reserved, names.entries[i].orig)) {
             ok = nameMapAdd(&map, names.entries[i].orig) != NULL;

src/apps/kpunch/dvxbasic/compiler/obfuscate.h

@@ -41,8 +41,9 @@ typedef struct {
 // Obfuscate form/control names in the module and all .frm texts.
 //
 // Reads original names from the Begin declarations in each .frm,
-// generates C1..Cn (skipping any name that is also a control type or a
+// generates C1..Cn (skipping any name that is also a control type, a
-// property key, since bytecode cannot tell those apart), then rewrites:
+// property key, a class or a class member, since bytecode cannot tell
+// those apart), then rewrites:
 //   - The .frm text (Begin-line names and property values naming a
 //     control, stripping the trailing BASIC code section after the
 //     outer form closes)

src/apps/kpunch/dvxbasic/compiler/opcodes.h

@@ -42,7 +42,8 @@
 typedef enum {
     SCOPE_GLOBAL = 0,
     SCOPE_LOCAL  = 1,
-    SCOPE_FORM   = 2        // per-form variable (persists while form is loaded)
+    SCOPE_FORM   = 2,       // per-form variable (persists while form is loaded)
+    SCOPE_MEMBER = 3        // class member variable of the running procedure's Me
 } BasScopeE;
 
 // ============================================================
@@ -74,6 +75,11 @@ typedef enum {
 #define BAS_TYPE_OBJECT    8  // opaque host object (form, control, etc.)
 #define BAS_TYPE_REF       9  // ByRef pointer to a BasValueT slot
 #define BAS_TYPE_ELEM_REF  10 // ByRef array element: counted BasArrayT* + flat index
+#define BAS_TYPE_DATE      11 // Double serial date (dates.h), held in dblVal
+#define BAS_TYPE_EMPTY     12 // Variant that holds nothing yet (Empty)
+#define BAS_TYPE_NULL      13 // Variant Null (no valid data)
+#define BAS_TYPE_INSTANCE  14 // ref-counted class instance or Collection (BasObjectT)
+#define BAS_TYPE_VARIANT   15 // declared type only (AS VARIANT, array element type): holds any value, never a value's tag
 
 // ============================================================
 // Stack operations
@@ -82,6 +88,7 @@ typedef enum {
 #define OP_NOP             0x00
 #define OP_PUSH_INT16      0x01  // [int16] push 16-bit integer
 #define OP_PUSH_INT32      0x02  // [int32] push 32-bit integer
+#define OP_PUSH_SPECIAL    0x03  // [uint8 BasSpecialValE] push Empty, Null or Nothing
 #define OP_PUSH_FLT64      0x04  // [float64] push 64-bit float
 #define OP_PUSH_STR        0x05  // [uint16 idx] push string from constant pool
 #define OP_PUSH_TRUE       0x06  // push boolean True (-1)
@@ -105,6 +112,9 @@ typedef enum {
 #define OP_PUSH_LOCAL_ADDR 0x1A  // [uint16 idx] push address of local (for ByRef)
 #define OP_PUSH_GLOBAL_ADDR 0x1B // [uint16 idx] push address of global (for ByRef)
 #define OP_STORE_ARRAY_FIELD 0x1C // [uint8 dims, uint16 fieldIdx] value, indices, array on stack
+#define OP_LOAD_MEMBER     0x14  // [uint16 idx] push member variable idx of the running procedure's Me
+#define OP_STORE_MEMBER    0x15  // [uint16 idx] pop to member variable idx of Me
+#define OP_PUSH_MEMBER_ADDR 0x1D // [uint16 idx] push address of member variable idx of Me (for ByRef)
 
 // ============================================================
 // Arithmetic (integer)
@@ -155,6 +165,8 @@ typedef enum {
 #define OP_CMP_GT          0x43
 #define OP_CMP_LE          0x44
 #define OP_CMP_GE          0x45
+#define OP_IS              0x46  // pop b, a (objects); push a Is b (the same object)
+#define OP_OBJ_CHECK       0x47  // [uint16 class] TOS must be an object (BAS_OBJ_CHECK_ANY) or an instance of class (Nothing passes); else error
 
 // ============================================================
 // Logical / bitwise
@@ -182,6 +194,7 @@ typedef enum {
 #define OP_FOR_NEXT        0x58  // [uint16 varIdx] [uint8 scope] [int16 loopTop]
 #define OP_FOR_POP         0x59  // pop top FOR stack entry (for EXIT FOR)
 #define OP_GOSUB           0x5A  // [int16 offset] push the next instruction's address on the GOSUB stack, jump
+#define OP_CALL_ME         0x5B  // [uint16 addr] [uint8 argc] [uint8 baseSlot] OP_CALL whose callee keeps the caller's Me (a class calling its own procedure)
 
 // ============================================================
 // Type conversion
@@ -193,6 +206,7 @@ typedef enum {
 #define OP_CONV_STR_INT    0x63  // string -> int (VAL)
 #define OP_CONV_STR_FLT    0x65  // any -> double (VAL, CDBL)
 #define OP_CONV_INT_LONG   0x66  // int16 -> int32
+#define OP_CONV_DATE       0x67  // any -> DATE (CDATE; a string is parsed as a date)
 
 // ============================================================
 // I/O
@@ -241,6 +255,7 @@ typedef enum {
 #define OP_FIND_CTRL       0x8C  // pop ctrlName, pop formRef, push controlRef
 #define OP_FIND_CTRL_IDX   0x8E  // pop index, pop ctrlName, pop formRef, push ctrlRef
 #define OP_LOAD_FORM_VAR   0x8F  // [uint16 idx] push currentFormVars[idx]
+#define OP_ME_OBJ          0x8D  // push the running procedure's Me (class module code)
 
 // ============================================================
 // Array / misc
@@ -260,6 +275,8 @@ typedef enum {
 #define OP_STORE_FORM_VAR  0x9B  // [uint16 idx] pop, store to currentFormVars[idx]
 #define OP_PUSH_FORM_ADDR  0x9C  // [uint16 idx] push &currentFormVars[idx] (ByRef)
 #define OP_CREATE_CTRL_EX  0x9D  // pop parentRef, pop name, pop type, pop formRef, push ctrlRef
+#define OP_NEW_OBJ         0x9E  // [uint16 class] push a new instance of class (BAS_NEW_COLLECTION: a Collection), running its initialisation
+#define OP_PROP_ASSIGN     0x9F  // [uint8 argc] [uint8 flags] pop value, args, memberName, objRef; assign obj.member(args) = value (BAS_ASSIGN_SET: Set)
 
 // ============================================================
 // Math built-ins (single opcode each for common functions)
@@ -429,6 +446,187 @@ typedef enum {
 #define OP_STRIG           0xD6  // pop n, push joystick button state (STRIG(n))
 #define OP_FRAME_WAIT      0xD7  // pop frames per second; wait for the next frame
 
+// ============================================================
+// Library functions without an opcode of their own
+// ============================================================
+
+// [uint8 BasBuiltinFnE] [uint8 argc] pop argc arguments (pushed in source
+// order), push the result.  Optional trailing arguments are omitted from
+// argc and take their defaults in the VM.
+#define OP_BUILTIN         0xD8
+
+// Most arguments one OP_BUILTIN call takes (CHOOSE: index + 31 choices).
+#define BAS_BUILTIN_MAX_ARGS 32
+
+// OP_BUILTIN function numbers.  Part of the bytecode ABI -- append only.
+typedef enum {
+    BAS_FN_REPLACE      = 0,   // REPLACE$(s, find, repl [, start [, count [, compare]]])
+    BAS_FN_SPLIT        = 1,   // SPLIT(s [, delim [, limit [, compare]]]) -> STRING array
+    BAS_FN_JOIN         = 2,   // JOIN$(array [, delim])
+    BAS_FN_INSTRREV     = 3,   // INSTRREV(s, find [, start [, compare]])
+    BAS_FN_STRCOMP      = 4,   // STRCOMP(a, b [, compare])
+    BAS_FN_STRREVERSE   = 5,   // STRREVERSE$(s)
+    BAS_FN_FILTER       = 6,   // FILTER(array, match [, include [, compare]]) -> STRING array
+    BAS_FN_LSET         = 7,   // LSET target = s: (current target, s) -> s left-justified in LEN(target)
+    BAS_FN_RSET         = 8,   // RSET target = s: (current target, s) -> s right-justified in LEN(target)
+    BAS_FN_IIF          = 9,   // IIF(cond, a, b)
+    BAS_FN_CHOOSE       = 10,  // CHOOSE(index, a [, b ...])
+    BAS_FN_NOW          = 11,  // NOW
+    BAS_FN_DATE         = 12,  // DATE
+    BAS_FN_TIME         = 13,  // TIME
+    BAS_FN_DATESERIAL   = 14,  // DATESERIAL(y, m, d)
+    BAS_FN_TIMESERIAL   = 15,  // TIMESERIAL(h, m, s)
+    BAS_FN_DATEVALUE    = 16,  // DATEVALUE(d)
+    BAS_FN_TIMEVALUE    = 17,  // TIMEVALUE(d)
+    BAS_FN_YEAR         = 18,  // YEAR(d)
+    BAS_FN_MONTH        = 19,  // MONTH(d)
+    BAS_FN_DAY          = 20,  // DAY(d)
+    BAS_FN_WEEKDAY      = 21,  // WEEKDAY(d [, firstDayOfWeek])
+    BAS_FN_HOUR         = 22,  // HOUR(d)
+    BAS_FN_MINUTE       = 23,  // MINUTE(d)
+    BAS_FN_SECOND       = 24,  // SECOND(d)
+    BAS_FN_DATEADD      = 25,  // DATEADD(interval, n, d)
+    BAS_FN_DATEDIFF     = 26,  // DATEDIFF(interval, d1, d2 [, firstDayOfWeek [, firstWeekOfYear]])
+    BAS_FN_DATEPART     = 27,  // DATEPART(interval, d [, firstDayOfWeek [, firstWeekOfYear]])
+    BAS_FN_ISDATE       = 28,  // ISDATE(v)
+    BAS_FN_MONTHNAME    = 29,  // MONTHNAME(m [, abbrev])
+    BAS_FN_WEEKDAYNAME  = 30,  // WEEKDAYNAME(w [, abbrev [, firstDayOfWeek]])
+    BAS_FN_PARAMARRAY   = 31,  // (elementType, v0, v1, ...) -> 0-based array of the values: a ParamArray argument (compiler-generated, no BASIC name)
+    // The program screen (runtime/screen.c): statements return 0, which
+    // the compiler pops.  Omitted arguments are pushed as 0 and flagged in
+    // a BAS_GIVEN_* / BAS_GFX_* mask pushed last.
+    BAS_FN_CLS          = 32,  // CLS [n]: (n, -1 when omitted)
+    BAS_FN_LOCATE       = 33,  // LOCATE [row] [, [col] [, cursor]]: (row, col, cursor, given)
+    BAS_FN_COLOR        = 34,  // COLOR [fore] [, back]: (fore, back, given)
+    BAS_FN_SCREEN       = 35,  // SCREEN mode
+    BAS_FN_WIDTH        = 36,  // WIDTH [cols] [, rows]: (cols, rows, given)
+    BAS_FN_PSET         = 37,  // PSET / PRESET [STEP](x, y) [, color]: (x, y, color, flags)
+    BAS_FN_LINE         = 38,  // LINE [[STEP](x1, y1)]-[STEP](x2, y2) [, color] [, B|BF] [, style]: (x1, y1, x2, y2, color, style, flags)
+    BAS_FN_CIRCLE       = 39,  // CIRCLE [STEP](x, y), r [, color [, start [, end [, aspect]]]]: (x, y, r, color, start, end, aspect, flags)
+    BAS_FN_PAINT        = 40,  // PAINT [STEP](x, y) [, paint [, border]]: (x, y, paint, border, flags)
+    BAS_FN_DRAW         = 41,  // DRAW macro$
+    BAS_FN_PALETTE      = 42,  // PALETTE [attr, color]: (attr, color, given)
+    BAS_FN_PALETTE_USING = 43, // PALETTE USING array[(first)]: (array, first, given)
+    BAS_FN_VIEW         = 44,  // VIEW [[SCREEN] (x1, y1)-(x2, y2) [, [fill] [, border]]]: (x1, y1, x2, y2, fill, border, flags)
+    BAS_FN_WINDOW       = 45,  // WINDOW [[SCREEN] (x1, y1)-(x2, y2)]: (x1, y1, x2, y2, flags)
+    BAS_FN_FULLSCREEN   = 46,  // FULLSCREEN [ON | OFF | expr]: (on)
+    BAS_FN_INKEY        = 47,  // INKEY$ -> "" / one character / CHR$(0) + scan code
+    BAS_FN_CSRLIN       = 48,  // CSRLIN -> cursor row
+    BAS_FN_POS          = 49,  // POS(n) -> cursor column
+    BAS_FN_POINT        = 50,  // POINT(x, y) -> colour (-1 outside the view); POINT(n) -> the last point
+    BAS_FN_SCREENFN     = 51,  // SCREEN(row, col [, colorflag]) -> character code or colour
+    BAS_FN_LINE_INPUT   = 52,  // LINE INPUT [prompt$;] v$: (prompt) -> the line typed
+    // Variants and objects
+    BAS_FN_VARTYPE      = 53,  // VARTYPE(v) -> vbEmpty .. vbArray + element type
+    BAS_FN_TYPENAME     = 54,  // TYPENAME(v) -> "Integer", "Nothing", class name ...
+    BAS_FN_ISEMPTY      = 55,  // ISEMPTY(v)
+    BAS_FN_ISNULL       = 56,  // ISNULL(v)
+    BAS_FN_ISNUMERIC    = 57,  // ISNUMERIC(v)
+    BAS_FN_ISOBJECT     = 58,  // ISOBJECT(v)
+    BAS_FN_ISARRAY      = 59,  // ISARRAY(v)
+    BAS_FN_CVAR         = 60,  // CVAR(v) -> v as it is
+    BAS_FN_TYPEOF       = 61,  // TYPEOF obj IS name: (obj, name) -> the object is of that type
+    BAS_FN_EACH_COUNT   = 62,  // FOR EACH (compiler-generated): (group) -> items in the array or Collection
+    BAS_FN_EACH_ITEM    = 63   // FOR EACH (compiler-generated): (group, i) -> item i (0-based)
+} BasBuiltinFnE;
+
+// The Variant and object functions are numbered BAS_FN_VARTYPE through
+// BAS_FN_EACH_ITEM.
+#define BAS_FN_OBJECT_FIRST BAS_FN_VARTYPE
+#define BAS_FN_OBJECT_LAST  BAS_FN_EACH_ITEM
+
+// OP_PUSH_SPECIAL operand.  Part of the bytecode ABI.
+typedef enum {
+    BAS_SPECIAL_EMPTY   = 0,
+    BAS_SPECIAL_NULL    = 1,
+    BAS_SPECIAL_NOTHING = 2
+} BasSpecialValE;
+
+// OP_NEW_OBJ / OP_OBJ_CHECK class operand values besides a class index.
+#define BAS_NEW_COLLECTION  0xFFFF  // OP_NEW_OBJ / OP_OBJ_CHECK: a Collection
+#define BAS_OBJ_CHECK_ANY   0xFFFE  // OP_OBJ_CHECK: any object
+
+// OP_PROP_ASSIGN flags.
+#define BAS_ASSIGN_SET      0x01   // Set obj.member = value (Property Set)
+
+// VARTYPE results (VB's vbEmpty .. vbArray).
+#define BAS_VT_EMPTY        0
+#define BAS_VT_NULL         1
+#define BAS_VT_INTEGER      2
+#define BAS_VT_LONG         3
+#define BAS_VT_SINGLE       4
+#define BAS_VT_DOUBLE       5
+#define BAS_VT_CURRENCY     6
+#define BAS_VT_DATE         7
+#define BAS_VT_STRING       8
+#define BAS_VT_OBJECT       9
+#define BAS_VT_ERROR        10
+#define BAS_VT_BOOLEAN      11
+#define BAS_VT_VARIANT      12
+#define BAS_VT_DATAOBJECT   13
+#define BAS_VT_USERTYPE     36
+#define BAS_VT_ARRAY        8192
+
+// The program-screen functions are numbered BAS_FN_CLS through
+// BAS_FN_LINE_INPUT (the VM hands them to runtime/screen.c).
+#define BAS_FN_SCREEN_FIRST BAS_FN_CLS
+#define BAS_FN_SCREEN_LAST  BAS_FN_LINE_INPUT
+
+// Given-argument masks of LOCATE, COLOR, WIDTH and PALETTE (bit n: the
+// n-th argument was written).
+#define BAS_GIVEN_1        0x01
+#define BAS_GIVEN_2        0x02
+#define BAS_GIVEN_3        0x04
+
+// Flags of the drawing argument blocks (PSET, LINE, CIRCLE, PAINT).  The
+// same blocks are the arguments of the Form / PictureBox PSet, Line and
+// Circle methods, so both compile and run through one path.
+#define BAS_GFX_STEP       0x01  // the (first) point is relative to the last point
+#define BAS_GFX_COLOR      0x02  // a colour was given
+#define BAS_GFX_PRESET     0x04  // PSET: PRESET (the default colour is the background)
+#define BAS_GFX_START      0x08  // LINE: the start point was given
+#define BAS_GFX_STEP2      0x10  // LINE: the end point is relative to the start point
+#define BAS_GFX_BOX        0x20  // LINE: ,B (a rectangle)
+#define BAS_GFX_BOX_FILL   0x40  // LINE: ,BF (a filled rectangle)
+#define BAS_GFX_STYLE      0x80  // LINE: a style mask was given
+#define BAS_GFX_ARC_START  0x08  // CIRCLE: a start angle was given
+#define BAS_GFX_ARC_END    0x10  // CIRCLE: an end angle was given
+#define BAS_GFX_ASPECT     0x20  // CIRCLE: an aspect was given
+#define BAS_GFX_BORDER     0x08  // PAINT: a border colour was given
+
+// Argument counts of the drawing blocks.
+#define BAS_GFX_PSET_ARGS   4
+#define BAS_GFX_LINE_ARGS   7
+#define BAS_GFX_CIRCLE_ARGS 8
+#define BAS_GFX_PAINT_ARGS  5
+
+// Argument counts of the other screen statements with optional parts.
+#define BAS_LOCATE_ARGS     4
+#define BAS_COLOR_ARGS      3
+#define BAS_WIDTH_ARGS      3
+#define BAS_PALETTE_ARGS    3
+#define BAS_VIEW_ARGS       7
+#define BAS_WINDOW_ARGS     5
+
+// VIEW / WINDOW flags.
+#define BAS_VIEW_COORDS    0x01  // a rectangle was given (none: reset)
+#define BAS_VIEW_SCREEN    0x02  // VIEW SCREEN / WINDOW SCREEN
+#define BAS_VIEW_FILL      0x04  // VIEW: a fill colour was given
+#define BAS_VIEW_BORDER    0x08  // VIEW: a border colour was given
+
+// Object Print (Form / PictureBox .Print): one method call per item with
+// (value, mode).
+#define BAS_OBJ_PRINT_TEXT    0  // the value's text
+#define BAS_OBJ_PRINT_NEWLINE 1  // end of the line (value unused)
+#define BAS_OBJ_PRINT_ZONE    2  // ',' : the next print zone (value unused)
+#define BAS_OBJ_PRINT_TAB     3  // TAB(n): column n
+#define BAS_OBJ_PRINT_SPC     4  // SPC(n): n spaces
+#define BAS_OBJ_PRINT_ARGS    2
+
+// Compare argument of the string functions: OPTION COMPARE decides when
+// it is omitted (vbUseCompareOption).
+#define BAS_COMPARE_USE_OPTION (-1)
+
 // ============================================================
 // Halt
 // ============================================================
@@ -498,6 +696,8 @@ typedef enum {
 // Byte offsets inside the FOR opcodes' BAS_OPERAND_FOR operand.
 #define BAS_FOR_OFFSET_OPERAND  (1 + BAS_OPERAND_U16 + BAS_OPERAND_U8)  // opcode-relative position of the int16 jump offset
 
+static inline bool basBuiltinArity(uint8_t fn, int32_t *minArgs, int32_t *maxArgs);
+static inline uint8_t basConvOpForStore(uint8_t dataType);
 static inline int32_t basOpcodeOperandSize(uint8_t op);
 static inline int16_t basReadI16LE(const uint8_t *p);
 static inline int32_t basReadI32LE(const uint8_t *p);
@@ -507,6 +707,181 @@ static inline void basWriteI32LE(uint8_t *p, int32_t v);
 static inline void basWriteU16LE(uint8_t *p, uint16_t v);
 
 
+// Argument counts an OP_BUILTIN function accepts (the compiler checks
+// calls against them, the VM checks the bytecode).  False for an unknown
+// function number.
+static inline bool basBuiltinArity(uint8_t fn, int32_t *minArgs, int32_t *maxArgs) {
+    switch (fn) {
+        case BAS_FN_NOW:        case BAS_FN_DATE:       case BAS_FN_TIME:
+        case BAS_FN_INKEY:      case BAS_FN_CSRLIN:
+            *minArgs = 0;
+            *maxArgs = 0;
+            return true;
+
+        case BAS_FN_STRREVERSE: case BAS_FN_DATEVALUE:  case BAS_FN_TIMEVALUE:
+        case BAS_FN_YEAR:       case BAS_FN_MONTH:      case BAS_FN_DAY:
+        case BAS_FN_HOUR:       case BAS_FN_MINUTE:     case BAS_FN_SECOND:
+        case BAS_FN_ISDATE:     case BAS_FN_CLS:        case BAS_FN_SCREEN:
+        case BAS_FN_DRAW:       case BAS_FN_FULLSCREEN: case BAS_FN_POS:
+        case BAS_FN_LINE_INPUT: case BAS_FN_VARTYPE:    case BAS_FN_TYPENAME:
+        case BAS_FN_ISEMPTY:    case BAS_FN_ISNULL:     case BAS_FN_ISNUMERIC:
+        case BAS_FN_ISOBJECT:   case BAS_FN_ISARRAY:    case BAS_FN_CVAR:
+        case BAS_FN_EACH_COUNT:
+            *minArgs = 1;
+            *maxArgs = 1;
+            return true;
+
+        case BAS_FN_POINT:
+            *minArgs = 1;
+            *maxArgs = 2;
+            return true;
+
+        case BAS_FN_SCREENFN:
+            *minArgs = 2;
+            *maxArgs = 3;
+            return true;
+
+        case BAS_FN_COLOR:
+            *minArgs = BAS_COLOR_ARGS;
+            *maxArgs = BAS_COLOR_ARGS;
+            return true;
+
+        case BAS_FN_WIDTH:
+            *minArgs = BAS_WIDTH_ARGS;
+            *maxArgs = BAS_WIDTH_ARGS;
+            return true;
+
+        case BAS_FN_PALETTE:    case BAS_FN_PALETTE_USING:
+            *minArgs = BAS_PALETTE_ARGS;
+            *maxArgs = BAS_PALETTE_ARGS;
+            return true;
+
+        case BAS_FN_LOCATE:
+            *minArgs = BAS_LOCATE_ARGS;
+            *maxArgs = BAS_LOCATE_ARGS;
+            return true;
+
+        case BAS_FN_WINDOW:
+            *minArgs = BAS_WINDOW_ARGS;
+            *maxArgs = BAS_WINDOW_ARGS;
+            return true;
+
+        case BAS_FN_VIEW:
+            *minArgs = BAS_VIEW_ARGS;
+            *maxArgs = BAS_VIEW_ARGS;
+            return true;
+
+        case BAS_FN_PSET:
+            *minArgs = BAS_GFX_PSET_ARGS;
+            *maxArgs = BAS_GFX_PSET_ARGS;
+            return true;
+
+        case BAS_FN_LINE:
+            *minArgs = BAS_GFX_LINE_ARGS;
+            *maxArgs = BAS_GFX_LINE_ARGS;
+            return true;
+
+        case BAS_FN_CIRCLE:
+            *minArgs = BAS_GFX_CIRCLE_ARGS;
+            *maxArgs = BAS_GFX_CIRCLE_ARGS;
+            return true;
+
+        case BAS_FN_PAINT:
+            *minArgs = BAS_GFX_PAINT_ARGS;
+            *maxArgs = BAS_GFX_PAINT_ARGS;
+            return true;
+
+        case BAS_FN_JOIN:       case BAS_FN_WEEKDAY:    case BAS_FN_MONTHNAME:
+            *minArgs = 1;
+            *maxArgs = 2;
+            return true;
+
+        case BAS_FN_WEEKDAYNAME:
+            *minArgs = 1;
+            *maxArgs = 3;
+            return true;
+
+        case BAS_FN_SPLIT:
+            *minArgs = 1;
+            *maxArgs = 4;
+            return true;
+
+        case BAS_FN_LSET:       case BAS_FN_RSET:       case BAS_FN_TYPEOF:
+        case BAS_FN_EACH_ITEM:
+            *minArgs = 2;
+            *maxArgs = 2;
+            return true;
+
+        case BAS_FN_STRCOMP:
+            *minArgs = 2;
+            *maxArgs = 3;
+            return true;
+
+        case BAS_FN_INSTRREV:   case BAS_FN_FILTER:     case BAS_FN_DATEPART:
+            *minArgs = 2;
+            *maxArgs = 4;
+            return true;
+
+        case BAS_FN_CHOOSE:
+            *minArgs = 2;
+            *maxArgs = BAS_BUILTIN_MAX_ARGS;
+            return true;
+
+        case BAS_FN_PARAMARRAY:
+            *minArgs = 1;
+            *maxArgs = BAS_BUILTIN_MAX_ARGS;
+            return true;
+
+        case BAS_FN_IIF:        case BAS_FN_DATESERIAL: case BAS_FN_TIMESERIAL:
+        case BAS_FN_DATEADD:
+            *minArgs = 3;
+            *maxArgs = 3;
+            return true;
+
+        case BAS_FN_DATEDIFF:
+            *minArgs = 3;
+            *maxArgs = 5;
+            return true;
+
+        case BAS_FN_REPLACE:
+            *minArgs = 3;
+            *maxArgs = 6;
+            return true;
+
+        default:
+            return false;
+    }
+}
+
+
+// The conversion a value goes through when it is stored where dataType
+// is declared: a numeric, BOOLEAN or DATE type is converted to it, every
+// other type (STRING, OBJECT, VARIANT, TYPE) stores the value as it is
+// (OP_NOP).  One source for the compiler's typed stores and the VM's
+// stores into class member variables.
+static inline uint8_t basConvOpForStore(uint8_t dataType) {
+    switch (dataType) {
+        case BAS_TYPE_INTEGER:
+            return OP_CONV_FLT_INT;
+
+        case BAS_TYPE_LONG:
+            return OP_CONV_INT_LONG;
+
+        case BAS_TYPE_SINGLE:
+            return OP_CONV_INT_FLT;
+
+        case BAS_TYPE_BOOLEAN:
+            return OP_CONV_BOOL;
+
+        case BAS_TYPE_DATE:
+            return OP_CONV_DATE;
+
+        default:
+            return OP_NOP;
+    }
+}
+
+
 // Returns operand byte count for op, or BAS_OPERAND_UNKNOWN.
 static inline int32_t basOpcodeOperandSize(uint8_t op) {
     switch (op) {
@@ -526,11 +901,13 @@ static inline int32_t basOpcodeOperandSize(uint8_t op) {
         case OP_CMP_GT:          case OP_CMP_LE:       case OP_CMP_GE:
         case OP_AND:             case OP_OR:           case OP_NOT:
         case OP_XOR:             case OP_EQV:          case OP_IMP:
+        case OP_IS:              case OP_ME_OBJ:
         case OP_GOSUB_RET:       case OP_RET:          case OP_RET_VAL:
         case OP_FOR_POP:
         case OP_CONV_INT_FLT:    case OP_CONV_FLT_INT:
         case OP_CONV_INT_STR:    case OP_CONV_STR_INT:
         case OP_CONV_STR_FLT:    case OP_CONV_INT_LONG:
+        case OP_CONV_DATE:
         case OP_PRINT:           case OP_PRINT_NL:     case OP_PRINT_TAB:
         case OP_INPUT:
         case OP_FILE_CLOSE:      case OP_FILE_PRINT:   case OP_FILE_INPUT:
@@ -584,6 +961,7 @@ static inline int32_t basOpcodeOperandSize(uint8_t op) {
         case OP_LBOUND:          case OP_UBOUND:
         case OP_COMPARE_MODE:    case OP_PRINT_USING:
         case OP_ERASE:           case OP_LPRINT:
+        case OP_PUSH_SPECIAL:
             return BAS_OPERAND_U8;
 
         case OP_PUSH_INT16:      case OP_PUSH_STR:
@@ -599,6 +977,11 @@ static inline int32_t basOpcodeOperandSize(uint8_t op) {
         case OP_ON_ERROR:
         case OP_STR_FIXLEN:
         case OP_LINE:
+        case OP_BUILTIN:
+        case OP_LOAD_MEMBER:     case OP_STORE_MEMBER:
+        case OP_PUSH_MEMBER_ADDR:
+        case OP_OBJ_CHECK:       case OP_NEW_OBJ:
+        case OP_PROP_ASSIGN:
             return BAS_OPERAND_U16;
 
         case OP_STORE_ARRAY_FIELD:
@@ -606,7 +989,7 @@ static inline int32_t basOpcodeOperandSize(uint8_t op) {
             return BAS_OPERAND_U8_U16;
 
         case OP_PUSH_INT32:
-        case OP_CALL:
+        case OP_CALL:            case OP_CALL_ME:
         case OP_STR_APPEND:
             return BAS_OPERAND_I32;
 

src/apps/kpunch/dvxbasic/compiler/parser.h

@@ -97,6 +97,7 @@ typedef struct {
     int32_t      errorLine;
     int32_t      prevLine;      // line of the previous token (for error reporting)
     int32_t      lastUdtTypeId;  // index of last resolved UDT type from resolveTypeName
+    int32_t      lastObjClass;   // class of the last object type resolveTypeName read (BAS_CLASS_NONE for Object / Control / Form)
     int32_t      tempCount;      // compiler temporaries created so far (names them uniquely)
     BasSymbolT **tempPool;       // stb_ds: temporaries of the current scope, reused from the start of every statement
     int32_t      tempPoolUsed;   // temporaries of tempPool taken by the current statement
@@ -105,6 +106,12 @@ typedef struct {
     int32_t      optionBase;         // default array lower bound (0 or 1)
     bool         optionExplicit;     // true = variables must be declared with DIM
     bool         currentProcIsFunction; // true while parsing a FUNCTION body (EXIT FUNCTION / return-value assignment)
+    bool         currentProcIsProperty; // true while parsing a Property Get / Let / Set body (EXIT PROPERTY)
+    int32_t      currentProcAddr;       // code address of the SUB / FUNCTION being parsed
+    bool         forIsEach;      // the innermost FOR loop is a FOR EACH (no VM FOR frame for EXIT FOR to drop)
+    bool         setAssign;      // parsing a SET statement: the target takes an object
+    int32_t      memberClass;    // class of the object the member access being parsed starts from (BAS_CLASS_NONE: unknown)
+    char       **formNames;      // stb_ds: every BEGINFORM name (the prescan collects them), malloc'd
     uint8_t      defType[BAS_DEFTYPE_LETTERS]; // default type per letter (A-Z), set by DEFINT etc.
     char         currentProc[BAS_MAX_TOKEN_LEN]; // name of current SUB/FUNCTION
     // Per-form init block tracking
@@ -136,6 +143,11 @@ typedef struct {
     int32_t      blockDepth;
     // Optional compile-time CtrlName.Member validator (IDE-only).
     const BasCtrlValidatorT *validator;
+    // Constant expressions (CONST, ENUM values) are compiled like any
+    // expression and run on this private VM, created on first use.
+    BasVmT      *constVm;
+    bool         inConstExpr;    // parsing a constant expression: only constants may be named
+    bool         compareText;    // OPTION COMPARE TEXT in effect (string comparisons in constant expressions)
 } BasParserT;
 
 // ============================================================

src/apps/kpunch/dvxbasic/compiler/symtab.c

@@ -25,6 +25,7 @@
 #include "symtab.h"
 #include "thirdparty/stb_ds_wrap.h"
 
+#include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
 
@@ -32,23 +33,29 @@
 // Function prototypes (alphabetical)
 static void basSymbolFree(BasSymbolT *sym);
 BasSymbolT *basSymTabAdd(BasSymTabT *tab, const char *name, BasSymKindE kind, uint8_t dataType);
+int32_t basSymTabAddClass(BasSymTabT *tab, const char *name);
 BasSymbolT *basSymTabAddGlobal(BasSymTabT *tab, const char *name, BasSymKindE kind, uint8_t dataType);
 BasSymbolT *basSymTabAddModuleVar(BasSymTabT *tab, const char *name, uint8_t dataType);
 int32_t basSymTabAllocGlobalSlot(BasSymTabT *tab);
 int32_t basSymTabAllocSlot(BasSymTabT *tab);
 BasScopeE basSymTabCurrentScope(const BasSymTabT *tab, BasSymKindE kind);
+void basSymTabEnterClassScope(BasSymTabT *tab, int32_t classIdx);
 void basSymTabEnterFormScope(BasSymTabT *tab, const char *formName);
 void basSymTabEnterLocal(BasSymTabT *tab);
 BasSymbolT *basSymTabFind(BasSymTabT *tab, const char *name);
+BasClassDefT *basSymTabFindClass(BasSymTabT *tab, const char *name, int32_t *outIdx);
 BasSymbolT *basSymTabFindGlobal(BasSymTabT *tab, const char *name);
 BasSymbolT *basSymTabFindLabel(BasSymTabT *tab, const char *name);
 BasSymbolT *basSymTabFindModuleVar(BasSymTabT *tab, const char *name);
 void basSymTabFree(BasSymTabT *tab);
 void basSymTabInit(BasSymTabT *tab);
+int32_t basSymTabLeaveClassScope(BasSymTabT *tab);
 int32_t basSymTabLeaveFormScope(BasSymTabT *tab);
 void basSymTabLeaveLocal(BasSymTabT *tab);
+bool basSymTabQualify(const BasSymTabT *tab, int32_t classIdx, const char *name, char *out, int32_t outSize);
 static BasSymbolT **bucketFor(BasSymTabT *tab, uint32_t hash);
 static BasSymbolT *findInScope(BasSymTabT *tab, const char *name, BasScopeE scope, bool isLabel);
+static BasSymbolT *findModuleSymbol(BasSymTabT *tab, const char *name, bool includeHidden);
 static BasSymbolT *findSymbol(BasSymTabT *tab, const char *name, bool includeHidden);
 static uint32_t nameHashCI(const char *name);
 static bool namesEqual(const char *a, const char *b);
@@ -71,6 +78,24 @@ BasSymbolT *basSymTabAdd(BasSymTabT *tab, const char *name, BasSymKindE kind, ui
 }
 
 
+int32_t basSymTabAddClass(BasSymTabT *tab, const char *name) {
+    BasSymbolT *sym = symTabAddScoped(tab, name, SYM_CLASS, BAS_TYPE_OBJECT, SCOPE_GLOBAL);
+
+    if (sym == NULL) {
+        return -1;
+    }
+
+    BasClassDefT def;
+
+    memset(&def, 0, sizeof(def));
+    snprintf(def.name, sizeof(def.name), "%s", name);
+    def.initCodeAddr = -1;
+    sym->index       = (int32_t)arrlen(tab->classes);
+    arrput(tab->classes, def);
+    return sym->index;
+}
+
+
 BasSymbolT *basSymTabAddGlobal(BasSymTabT *tab, const char *name, BasSymKindE kind, uint8_t dataType) {
     return symTabAddScoped(tab, name, kind, dataType, SCOPE_GLOBAL);
 }
@@ -98,6 +123,10 @@ int32_t basSymTabAllocSlot(BasSymTabT *tab) {
         return tab->nextLocalIdx++;
     }
 
+    if (tab->inClassScope) {
+        return tab->nextMemberIdx++;
+    }
+
     if (tab->inFormScope) {
         return tab->nextFormVarIdx++;
     }
@@ -106,13 +135,18 @@ int32_t basSymTabAllocSlot(BasSymTabT *tab) {
 }
 
 
-// Local > form > global.  Only variables get SCOPE_FORM; SUBs, FUNCTIONs,
+// Local > member > form > global.  Only variables get SCOPE_MEMBER or
-// CONSTs and labels declared in a form scope remain global.
+// SCOPE_FORM; SUBs, FUNCTIONs, CONSTs and labels declared in a class or
+// form scope remain global.
 BasScopeE basSymTabCurrentScope(const BasSymTabT *tab, BasSymKindE kind) {
     if (tab->inLocalScope) {
         return SCOPE_LOCAL;
     }
 
+    if (tab->inClassScope && kind == SYM_VARIABLE) {
+        return SCOPE_MEMBER;
+    }
+
     if (tab->inFormScope && kind == SYM_VARIABLE) {
         return SCOPE_FORM;
     }
@@ -121,6 +155,13 @@ BasScopeE basSymTabCurrentScope(const BasSymTabT *tab, BasSymKindE kind) {
 }
 
 
+void basSymTabEnterClassScope(BasSymTabT *tab, int32_t classIdx) {
+    tab->inClassScope  = true;
+    tab->classIdx      = classIdx;
+    tab->nextMemberIdx = 0;
+}
+
+
 void basSymTabEnterFormScope(BasSymTabT *tab, const char *formName) {
     tab->inFormScope = true;
     strncpy(tab->formScopeName, formName, BAS_MAX_IDENT - 1);
@@ -142,6 +183,21 @@ BasSymbolT *basSymTabFind(BasSymTabT *tab, const char *name) {
 }
 
 
+BasClassDefT *basSymTabFindClass(BasSymTabT *tab, const char *name, int32_t *outIdx) {
+    BasSymbolT *sym = findInScope(tab, name, SCOPE_GLOBAL, false);
+
+    if (sym == NULL || sym->kind != SYM_CLASS) {
+        return NULL;
+    }
+
+    if (outIdx != NULL) {
+        *outIdx = sym->index;
+    }
+
+    return &tab->classes[sym->index];
+}
+
+
 BasSymbolT *basSymTabFindGlobal(BasSymTabT *tab, const char *name) {
     return findInScope(tab, name, SCOPE_GLOBAL, false);
 }
@@ -170,6 +226,13 @@ void basSymTabFree(BasSymTabT *tab) {
     tab->symbols = NULL;
     tab->count   = 0;
     memset(tab->buckets, 0, sizeof(tab->buckets));
+
+    for (int32_t i = 0; i < (int32_t)arrlen(tab->classes); i++) {
+        arrfree(tab->classes[i].members);
+    }
+
+    arrfree(tab->classes);
+    tab->classes = NULL;
 }
 
 
@@ -178,6 +241,16 @@ void basSymTabInit(BasSymTabT *tab) {
 }
 
 
+int32_t basSymTabLeaveClassScope(BasSymTabT *tab) {
+    int32_t varCount = tab->nextMemberIdx;
+
+    tab->inClassScope  = false;
+    tab->classIdx      = 0;
+    tab->nextMemberIdx = 0;
+    return varCount;
+}
+
+
 int32_t basSymTabLeaveFormScope(BasSymTabT *tab) {
     int32_t varCount = tab->nextFormVarIdx;
 
@@ -220,6 +293,13 @@ void basSymTabLeaveLocal(BasSymTabT *tab) {
 }
 
 
+bool basSymTabQualify(const BasSymTabT *tab, int32_t classIdx, const char *name, char *out, int32_t outSize) {
+    int n = snprintf(out, outSize, "%s" BAS_CLASS_SEP "%s", tab->classes[classIdx].name, name);
+
+    return n > 0 && n < outSize;
+}
+
+
 static BasSymbolT **bucketFor(BasSymTabT *tab, uint32_t hash) {
     return &tab->buckets[hash & (BAS_SYMTAB_BUCKETS - 1)];
 }
@@ -240,29 +320,19 @@ static BasSymbolT *findInScope(BasSymTabT *tab, const char *name, BasScopeE scop
 }
 
 
-// Non-label lookup: local scope first, then form and global.  Chains run
+// Module-level (non-local, non-label) lookup of exactly name.  A module
-// newest first, so the most recent declaration wins.  A module variable
+// variable that is not SHARED is skipped inside a procedure unless
-// that is not SHARED is skipped inside a procedure unless includeHidden.
+// includeHidden; a class's member variables are always visible to it.
-static BasSymbolT *findSymbol(BasSymTabT *tab, const char *name, bool includeHidden) {
+static BasSymbolT *findModuleSymbol(BasSymTabT *tab, const char *name, bool includeHidden) {
-    uint32_t    h    = nameHashCI(name);
+    uint32_t h    = nameHashCI(name);
-    BasSymbolT *head = *bucketFor(tab, h);
+    bool     hide = tab->hideUnshared && !includeHidden;
 
-    if (tab->inLocalScope) {
+    for (BasSymbolT *s = *bucketFor(tab, h); s != NULL; s = s->hashNext) {
-        for (BasSymbolT *s = head; s != NULL; s = s->hashNext) {
-            if (s->nameHash == h && s->scope == SCOPE_LOCAL && s->kind != SYM_LABEL && namesEqual(s->name, name)) {
-                return s;
-            }
-        }
-    }
-
-    bool hide = tab->hideUnshared && !includeHidden;
-
-    for (BasSymbolT *s = head; s != NULL; s = s->hashNext) {
         if (s->nameHash != h || s->formScopeEnded || s->kind == SYM_LABEL || s->scope == SCOPE_LOCAL || !namesEqual(s->name, name)) {
             continue;
         }
 
-        if (hide && s->kind == SYM_VARIABLE && !s->isShared) {
+        if (hide && s->kind == SYM_VARIABLE && !s->isShared && s->scope != SCOPE_MEMBER) {
             continue;
         }
 
@@ -273,6 +343,34 @@ static BasSymbolT *findSymbol(BasSymTabT *tab, const char *name, bool includeHid
 }
 
 
+// Non-label lookup: local scope first, then (in a class module) the
+// class's own "Class.name", then form and global.  Chains run newest
+// first, so the most recent declaration wins.
+static BasSymbolT *findSymbol(BasSymTabT *tab, const char *name, bool includeHidden) {
+    if (tab->inLocalScope) {
+        uint32_t h = nameHashCI(name);
+
+        for (BasSymbolT *s = *bucketFor(tab, h); s != NULL; s = s->hashNext) {
+            if (s->nameHash == h && s->scope == SCOPE_LOCAL && s->kind != SYM_LABEL && namesEqual(s->name, name)) {
+                return s;
+            }
+        }
+    }
+
+    char qualified[BAS_MAX_IDENT];
+
+    if (tab->inClassScope && basSymTabQualify(tab, tab->classIdx, name, qualified, (int32_t)sizeof(qualified))) {
+        BasSymbolT *member = findModuleSymbol(tab, qualified, includeHidden);
+
+        if (member != NULL) {
+            return member;
+        }
+    }
+
+    return findModuleSymbol(tab, name, includeHidden);
+}
+
+
 // ============================================================
 // Case-insensitive FNV-1a hash used to accelerate symbol-table lookups.
 // Caller computes hash of search-name once; each entry stores its own
@@ -331,11 +429,13 @@ static BasSymbolT *symTabAddScoped(BasSymTabT *tab, const char *name, BasSymKind
     }
 
     strcpy(sym->name, name);
-    sym->nameHash  = nameHashCI(name);
+    sym->nameHash   = nameHashCI(name);
-    sym->kind      = kind;
+    sym->kind       = kind;
-    sym->scope     = scope;
+    sym->scope      = scope;
-    sym->dataType  = dataType;
+    sym->dataType   = dataType;
-    sym->isDefined = true;
+    sym->isDefined  = true;
+    sym->ownerClass = BAS_CLASS_NONE;
+    sym->objClass   = BAS_CLASS_NONE;
 
     // Record owning form for both SCOPE_FORM vars AND SUBs/FUNCTIONs
     // declared inside BEGINFORM...ENDFORM.  SUBs stay at SCOPE_GLOBAL

src/apps/kpunch/dvxbasic/compiler/symtab.h

@@ -48,9 +48,23 @@ typedef enum {
     SYM_SUB,
     SYM_FUNCTION,
     SYM_LABEL,
-    SYM_TYPE_DEF    // user-defined TYPE
+    SYM_TYPE_DEF,   // user-defined TYPE
+    SYM_ENUM,       // ENUM name (a LONG type); members are SYM_CONSTs
+    SYM_CLASS       // class module name (index = class number)
 } BasSymKindE;
 
+// objClass of an object variable declared As Collection (a class module
+// has its index there; BAS_CLASS_NONE: no class, e.g. As Object).
+#define BAS_CLASS_NONE         (-1)
+#define BAS_CLASS_COLLECTION   (-2)
+
+// Qualified names of class module symbols: "Class.Member", and the
+// Property Let / Set procedures of a property "Class.Member.Let" /
+// "Class.Member.Set" (Property Get takes the plain qualified name).
+#define BAS_CLASS_SEP          "."
+#define BAS_PROP_LET_SUFFIX    ".Let"
+#define BAS_PROP_SET_SUFFIX    ".Set"
+
 // BasScopeE moved to opcodes.h (shared with runtime).
 
 // ============================================================
@@ -93,6 +107,8 @@ typedef struct BasSymbolS {
     int32_t      udtTypeId;    // for variables of BAS_TYPE_UDT: index of TYPE_DEF symbol
     int32_t      fixedLen;     // for STRING * n: fixed length (0 = variable-length)
     int32_t      refLine;      // LABEL/SUB/FUNCTION: source line of the first reference made before the definition
+    int32_t      ownerClass;   // class module a procedure or member variable belongs to (BAS_CLASS_NONE: none)
+    int32_t      objClass;     // object variable / FUNCTION / Property Get declared As a class: its index, BAS_CLASS_COLLECTION, else BAS_CLASS_NONE
 
     // For SUB/FUNCTION: parameter info
     int32_t      paramCount;
@@ -107,6 +123,7 @@ typedef struct BasSymbolS {
         int32_t  constInt;
         double   constDbl;
     };
+    int32_t      constStrLen;  // STRING CONST: length of constStr (it may hold NULs)
 
     // For TYPE_DEF: field definitions
     BasFieldDefT *fields;     // stb_ds dynamic array
@@ -127,6 +144,12 @@ typedef struct BasSymbolS {
     bool         isTyped;      // variable declared with an explicit numeric type (suffix, AS clause or DEFxxx); stores convert to it
     bool         isAlias;      // procedure-local name for a module slot (STATIC backing variable or SHARED statement): lives in aliasScope slot 'index'
     uint8_t      aliasScope;   // BasScopeE of the slot an alias addresses (SCOPE_GLOBAL or SCOPE_FORM)
+    bool         hasParamArray;   // SUB/FUNCTION: the last parameter is a ParamArray (paramTypes[paramCount - 1] is its element type)
+    bool         paramArrayTyped; // the ParamArray has a declared type: each argument is converted to it (else it keeps its own type)
+    bool         isEnumMember;    // CONST that is the unqualified name of an ENUM member
+    bool         isAmbiguous;     // ENUM member name shared by two ENUMs: usable only qualified (EnumName.Member)
+    bool         isPrivate;       // class module member declared Private (not reachable through an object)
+    bool         isProperty;      // Property Get / Let / Set procedure
 
     char         name[BAS_MAX_IDENT];
     char         formName[BAS_MAX_IDENT]; // form name for SCOPE_FORM vars
@@ -136,6 +159,29 @@ typedef struct BasSymbolS {
     char         constStr[BAS_MAX_CONST_STR];
 } BasSymbolT;
 
+// ============================================================
+// Class modules
+// ============================================================
+
+// A public member of a class module, recorded as it is declared.
+typedef struct {
+    char        name[BAS_MAX_IDENT];  // as the program uses it (obj.name)
+    BasSymbolT *sym;                  // the procedure or member variable
+    uint8_t     kind;                 // BasMemberKindE
+} BasClassMemberDefT;
+
+// A class module (BEGINCLASS "name" ... ENDCLASS).  The prescan registers
+// every class so code before the class can use its name as a type.
+typedef struct {
+    char                name[BAS_MAX_IDENT];
+    char                defaultMember[BAS_MAX_IDENT]; // Attribute Name.VB_UserMemId = 0 ("" = none)
+    BasClassMemberDefT *members;      // stb_ds array, public members in declaration order
+    int32_t             varCount;     // member variables per instance (set at ENDCLASS)
+    int32_t             initCodeAddr; // instance set-up code (member variables, then Class_Initialize)
+    BasSymbolT         *terminateSym; // Class_Terminate, NULL = none
+    bool                defined;      // its BEGINCLASS was compiled (a second one is a duplicate)
+} BasClassDefT;
+
 // ============================================================
 // Symbol table
 // ============================================================
@@ -158,6 +204,10 @@ typedef struct {
     char        formScopeName[BAS_MAX_IDENT]; // current form name
     int32_t     nextFormVarIdx;   // next form-level variable slot
     int32_t     formScopeSymStart; // symbol count at BEGINFORM (for marking ended)
+    bool        inClassScope;     // true inside BEGINCLASS...ENDCLASS
+    int32_t     classIdx;         // the class being compiled (valid while inClassScope)
+    int32_t     nextMemberIdx;    // next member variable slot of that class
+    BasClassDefT *classes;        // stb_ds array, indexed by class number
 } BasSymTabT;
 
 // ============================================================
@@ -226,6 +276,27 @@ int32_t basSymTabAllocSlot(BasSymTabT *tab);
 // SCOPE_GLOBAL but the table is currently inside a SUB/FUNCTION or form.
 int32_t basSymTabAllocGlobalSlot(BasSymTabT *tab);
 
+// Register class module name (the prescan does, for every BEGINCLASS).
+// Returns its class number, or -1 (the name is taken, too long, or out
+// of memory).
+int32_t basSymTabAddClass(BasSymTabT *tab, const char *name);
+
+// Enter class scope (called at BEGINCLASS): module-level declarations
+// create member variables (SCOPE_MEMBER), and names are looked up as
+// "Class.name" first.
+void basSymTabEnterClassScope(BasSymTabT *tab, int32_t classIdx);
+
+// The class module named name, or NULL.
+BasClassDefT *basSymTabFindClass(BasSymTabT *tab, const char *name, int32_t *outIdx);
+
+// Leave class scope (called at ENDCLASS).  Returns the number of member
+// variables allocated.
+int32_t basSymTabLeaveClassScope(BasSymTabT *tab);
+
+// Write "Class.name" for class classIdx into out (outSize bytes); false
+// when it does not fit.
+bool basSymTabQualify(const BasSymTabT *tab, int32_t classIdx, const char *name, char *out, int32_t outSize);
+
 // Enter form scope (called at BEGINFORM). Form-level DIMs create SCOPE_FORM variables.
 void basSymTabEnterFormScope(BasSymTabT *tab, const char *formName);
 

src/apps/kpunch/dvxbasic/ctrlover.dhs

@@ -30,6 +30,12 @@
 .index Properties
 .index Events
 .index Methods
+.index DragMode
+.index DragIcon
+.index Drag
+.index DragDrop
+.index DragOver
+.index Drag and Drop
 
 .h1 Common Properties, Events, and Methods
 
@@ -57,6 +63,8 @@ Every control in DVX BASIC inherits a set of common properties, events, and meth
   TabIndex     Integer   R     Accepted for VB compatibility but ignored. DVX has no tab order.
   ToolTipText  String    R/W   Tooltip text shown after the mouse hovers over the control. Empty string or unset = no tooltip.
   HelpTopic    String    R/W   Help topic opened by F1 while the control has the focus. Empty = the form's HelpTopic. F1 uses the project's help file.
+  DragMode     Integer   R/W   vbManual (0, the default): the program starts a drag with the Drag method. vbAutomatic (1): pressing the left mouse button on the control starts a drag. See Drag and Drop below.
+  DragIcon     String    R/W   Picture file (BMP, PNG, JPEG or GIF) shown under the mouse while the control is dragged. Empty = a dotted outline the size of the control.
 .endtable
 
 Size properties (Width, Height and the Min/Max sizes) are limited to 0..32767.
@@ -80,6 +88,8 @@ These events are wired on every control loaded from a .frm file. Controls create
   MouseUp     Button As Integer, X As Integer, Y As Integer Fires when a mouse button is released over the control.
   MouseMove   Button As Integer, X As Integer, Y As Integer Fires when the mouse moves over the control.
   Scroll      Delta As Integer                              Fires when the control is scrolled (mouse wheel or scrollbar).
+  DragDrop    Source As Control, X As Integer, Y As Integer Fires when a dragged control is dropped on this control. Source is the dragged control; X and Y are where, in this control.
+  DragOver    Source As Control, X As Integer, Y As Integer, State As Integer   Fires while a dragged control moves over this control. State is vbEnter (0) when it comes onto the control, vbOver (2) as it moves across, vbLeave (1) when it goes off.
 .endtable
 
 .h2 Common Methods
@@ -89,13 +99,124 @@ These events are wired on every control loaded from a .frm file. Controls create
   --------   ----------   -------------------------------------------
   SetFocus   (none)       Gives keyboard focus to this control.
   Refresh    (none)       Forces the control to repaint.
+  Drag       [Action]     Starts or ends dragging this control: vbBeginDrag (1, the default) starts, vbEndDrag (2) drops it where the mouse is, 0 cancels the drag without a drop.
 .endtable
 
+.h2 Drag and Drop
+
+Any control can be dragged onto another control or onto a form, as in Visual Basic. While a control is dragged, a dotted outline of it (or its DragIcon picture) follows the mouse, and the controls and forms it passes over get DragOver events. Releasing the mouse button drops it: the control or form under the mouse gets a DragDrop event, with the dragged control as Source. Pressing Esc cancels the drag.
+
+With DragMode set to vbAutomatic, pressing the left mouse button on the control starts the drag, and the control gets no Click, MouseDown or MouseUp from the left button. With DragMode vbManual, start the drag yourself, usually in MouseDown. A drag started while the mouse button is up ends at the next click. During a drag no mouse events other than DragOver and DragDrop are raised.
+
+Drop targets only react: nothing is moved or copied for you. Use Source in DragDrop to decide what to do, for example read its Name or Caption, or check what kind of control it is with TypeOf Source Is TextBox (see Operators).
+
+Note that vbCancel is the MsgBox Cancel value (2), which as a Drag action means vbEndDrag; cancel a drag with Drag 0.
+
+.code
+' Label1 has DragMode = 1 (vbAutomatic) in the form designer.
+Sub List1_DragOver(Source As Control, X As Integer, Y As Integer, State As Integer)
+    If State = vbEnter Then Label2.Caption = "Drop to add " & Source.Caption
+End Sub
+
+Sub List1_DragDrop(Source As Control, X As Integer, Y As Integer)
+    List1.AddItem Source.Caption
+End Sub
+
+' DragMode vbManual: the button starts its own drag, left button only.
+Sub Command1_MouseDown(Button As Integer, X As Integer, Y As Integer)
+    If Button = 1 Then Command1.Drag vbBeginDrag
+End Sub
+.endcode
+
 .link ctrl.form Form
 .link ctrl.databinding Data Binding
 .link ctrl.frm FRM File Format
 
 
+.topic ctrl.drawing
+.title Drawing on Forms and PictureBoxes
+.toc 1 Drawing on Forms and PictureBoxes
+.index Drawing Methods
+.index Cls
+.index PSet method
+.index Line method
+.index Circle method
+.index Point method
+.index Print method
+.index PaintPicture
+.index TextWidth
+.index TextHeight
+.index CurrentX
+.index CurrentY
+.index DrawWidth
+.index FillColor
+.index FillStyle
+.index AutoRedraw
+.index ScaleWidth
+.index ScaleHeight
+
+.h1 Drawing on Forms and PictureBoxes
+
+Forms and PictureBoxes have Visual Basic's drawing methods. They draw with the same code as the QBasic graphics statements (see Console and Graphics in the language reference), in pixels, with colours as RGB values (RGB(255, 0, 0) or &HFF0000 is red). A PictureBox draws on its picture; a form gets a drawing area the size of its window the first time it draws, placed with its controls like a PictureBox (so draw on a form that has no controls, or use a PictureBox beside them).
+
+Drawings stay until they are drawn over or cleared: AutoRedraw is accepted, but a drawing always behaves as with AutoRedraw = True. In a form's own code, write Me.Line, Me.Circle and so on: Line, Circle and PSet without an object are the QBasic graphics statements (they draw on the program's screen), and Print without an object is the PRINT statement.
+
+.h2 Drawing Methods
+
+.table
+  Method                                                          Description
+  ------                                                          -----------
+  Cls                                                             Clears the drawing to BackColor; CurrentX and CurrentY go to 0.
+  PSet [Step](x, y) [, color]                                     Draws a point (DrawWidth wide).
+  Line [[Step](x1, y1)]-[Step](x2, y2) [, color] [, B | BF]         Draws a line, a box (B) or a filled box (BF). A box without F is filled with FillColor when FillStyle is 0.
+  Circle [Step](x, y), radius [, color [, start [, end [, aspect]]]]  Draws a circle, ellipse or arc, filled with FillColor when FillStyle is 0 (full circles).
+  Point(x, y)                                                     The colour of a pixel, -1 outside the picture.
+  Print items                                                     Writes text at CurrentX, CurrentY in ForeColor, with PRINT's ; , SPC and TAB; ends by moving to the next line unless the last item is followed by ; or ,.
+  PaintPicture picture, x, y [, width, height [, srcX, srcY, srcWidth, srcHeight]]   Copies a picture, stretched to width x height: an image file (BMP, PNG, JPEG or GIF), or a PictureBox given by its name as a string or by a Control variable.
+  TextWidth(text)                                                 Width of the text in pixels.
+  TextHeight(text)                                                Height of a line of text in pixels.
+.endtable
+
+Without a colour, drawing uses ForeColor. Step makes a point relative to CurrentX, CurrentY, which every drawing method leaves at its last point. A colour or angle out of range stops the program with an error.
+
+.h2 Drawing Properties
+
+.table
+  Property      Type      Default   Description
+  --------      ----      -------   -----------
+  ForeColor     Long      &H000000  Colour of drawing and printing.
+  BackColor     Long      &HFFFFFF  Colour Cls clears to. Setting it clears the drawing to the new colour.
+  CurrentX      Single    0         Where the next drawing or printing starts.
+  CurrentY      Single    0
+  DrawWidth     Integer   1         Pen width in pixels.
+  FillStyle     Integer   1         0 fills boxes and circles with FillColor; 1 (the default) leaves them empty. Other VB fill patterns draw as 1.
+  FillColor     Long      &H000000  Colour boxes and circles are filled with.
+  AutoRedraw    Boolean   False     Accepted; drawings always persist.
+  ScaleWidth    Long      (size)    Width of the drawing in pixels (read-only).
+  ScaleHeight   Long      (size)    Height of the drawing in pixels (read-only).
+.endtable
+
+.h2 Example
+
+.code
+Sub Command1_Click ()
+    Picture1.Resize 200, 150
+    Picture1.BackColor = RGB(255, 255, 255)
+    Picture1.DrawWidth = 2
+    Picture1.Line (10, 10)-(190, 140), RGB(0, 0, 255), B
+    Picture1.FillStyle = 0
+    Picture1.FillColor = RGB(255, 255, 0)
+    Picture1.Circle (100, 75), 40, RGB(255, 0, 0)
+    Picture1.CurrentX = 70
+    Picture1.CurrentY = 120
+    Picture1.Print "Hello!"
+End Sub
+.endcode
+
+.link ctrl.picturebox PictureBox
+.link ctrl.form Form
+
+
 .topic ctrl.databinding
 .title Data Binding
 .toc 1 Data Binding

src/apps/kpunch/dvxbasic/form.dhs

@@ -70,8 +70,12 @@ The Form is the top-level container representing a DVX window. It is declared in
   Resize        (none)                  Fires when the window is resized by the user.
   Activate      (none)                  Fires when the window gains focus.
   Deactivate    (none)                  Fires when the window loses focus.
+  DragDrop      Source As Control, X As Integer, Y As Integer                     Fires when a dragged control is dropped on an empty part of the form. X and Y are where, in the form.
+  DragOver      Source As Control, X As Integer, Y As Integer, State As Integer   Fires while a dragged control moves over an empty part of the form. State is vbEnter, vbLeave or vbOver.
 .endtable
 
+See Drag and Drop under Common Properties, Events, and Methods.
+
 .h2 Form Methods
 
 .table
@@ -84,6 +88,10 @@ The Form is the top-level container representing a DVX window. It is declared in
   FormName.Hide       Hide the form without unloading it.
 .endtable
 
+.h2 Drawing
+
+Forms have Visual Basic's drawing methods and properties (Cls, PSet, Line, Circle, Point, Print, PaintPicture, CurrentX, CurrentY, ForeColor, BackColor, DrawWidth, FillColor, FillStyle): see Drawing on Forms and PictureBoxes. In the form's own code use Me.Line, Me.Circle and so on.
+
 .h2 Example
 
 .code
@@ -104,4 +112,5 @@ End Sub
 .endcode
 
 .link ctrl.common.props Common Properties, Events, and Methods
+.link ctrl.drawing Drawing on Forms and PictureBoxes
 .link ctrl.frm FRM File Format

src/apps/kpunch/dvxbasic/formrt/formrt.c

@@ -37,7 +37,9 @@
 #include "../../../../libs/kpunch/music/music.h"
 #include "../../../../libs/kpunch/print/print.h"
 #include "dvxDlg.h"
+#include "dvxPlat.h"
 #include "dvxRes.h"
+#include "dvxWgtP.h"
 #include "dvxWm.h"
 #include "shellApp.h"
 // Widget headers below publish inline accessor macros over
@@ -95,6 +97,28 @@ DVX_ABI_STAMP(basrt);
 // clamped to [0, BAS_CTRL_MAX_DIM] before they become size hints.
 #define BAS_CTRL_MAX_DIM     32767
 
+// DlgColor: the RGB() bits of a color, and the result when cancelled.
+#define BAS_RGB_MASK             0xFFFFFF
+#define BAS_DLG_COLOR_CANCELLED  (-1)
+
+// The Clipboard object's name and methods.
+#define BAS_CLIPBOARD_NAME       "Clipboard"
+#define BAS_FORM_TYPE_NAME       "Form"      // TypeName / TypeOf of a form
+#define BAS_CLIP_CLEAR           "Clear"
+#define BAS_CLIP_GETFORMAT       "GetFormat"
+#define BAS_CLIP_GETTEXT         "GetText"
+#define BAS_CLIP_SETTEXT         "SetText"
+#define BAS_CLIP_SETTEXT_FORMAT  1     // SetText's optional format argument
+
+// The button number widget mouse callbacks give the left button.
+#define BAS_MOUSE_BUTTON_LEFT    1
+
+// DragDrop's arguments (Source, X, Y); DragOver adds State.  dragFire
+// takes BAS_DRAG_STATE_NONE for DragDrop.
+#define BAS_DRAG_DROP_ARGS       3
+#define BAS_DRAG_OVER_ARGS       4
+#define BAS_DRAG_STATE_NONE      (-1)
+
 // ResGetText result cap (static return buffer).
 #define BAS_RES_TEXT_LEN     1024
 
@@ -117,6 +141,32 @@ static bool sLoadingFrm = false;
 // on an empty field.
 static bool sLastInputBoxCancelled = false;
 
+// The Clipboard object: basFormRtFindCtrl hands out this address for the
+// name Clipboard when no control or form has it; only its address is used.
+static const uint8_t sClipboardObj = 0;
+
+// Drag and drop in progress.  There is one mouse, so one drag for every
+// program: the runtime, app and control it comes from (rt NULL: no drag),
+// the object last sent DragOver, the DragIcon picture, and the mouse
+// buttons at the last drag event.  forwarding is set while the drop's
+// button release is passed on to its window's own handler, whose BASIC
+// mouse events are dropped.
+typedef struct {
+    BasFormRtT  *rt;
+    AppContextT *ctx;
+    int32_t      appId;
+    BasControlT *source;
+    BasControlT *over;
+    uint8_t     *icon;
+    int32_t      prevButtons;
+    bool         forwarding;
+} BasDragT;
+
+static BasDragT sDrag;
+
+// dragAppEnded is registered with the shell (once, on the first drag).
+static bool sDragCleanupHooked = false;
+
 
 // ============================================================
 // Module-scope declarations
@@ -381,6 +431,8 @@ typedef enum {
     CTRL_PROP_DATASOURCE,
     CTRL_PROP_DATAFIELD,
     CTRL_PROP_LISTCOUNT,
+    CTRL_PROP_DRAGMODE,
+    CTRL_PROP_DRAGICON,
     CTRL_PROP_COUNT
 } BasCtrlPropE;
 
@@ -408,6 +460,8 @@ static const BasPropDescT sCtrlProps[CTRL_PROP_COUNT] = {
     [CTRL_PROP_DATASOURCE]  = { BAS_PROP_DATASOURCE,  WGT_IFACE_STRING, true, true  },
     [CTRL_PROP_DATAFIELD]   = { BAS_PROP_DATAFIELD,   WGT_IFACE_STRING, true, true  },
     [CTRL_PROP_LISTCOUNT]   = { BAS_PROP_LISTCOUNT,   WGT_IFACE_INT,    true, false },
+    [CTRL_PROP_DRAGMODE]    = { BAS_PROP_DRAGMODE,    WGT_IFACE_INT,    true, true  },
+    [CTRL_PROP_DRAGICON]    = { BAS_PROP_DRAGICON,    WGT_IFACE_STRING, true, true  },
 };
 
 // Menu item property ids (MenuName.Prop).  The .frm-only menu keys
@@ -444,6 +498,7 @@ static const char *const sCommonMethodNames[BAS_CM_COUNT] = {
     [BAS_CM_ADDSEPARATOR]     = "AddSeparator",
     [BAS_CM_CLEAR]            = "Clear",
     [BAS_CM_BUTTONCOUNT]      = "ButtonCount",
+    [BAS_CM_DRAG]             = "Drag",
 };
 
 
@@ -487,6 +542,7 @@ const BasPropDescT *basFormRtMenuProps(int32_t *count);
 int32_t basFormRtMsgBox(void *ctx, const char *message, int32_t flags, const char *title);
 void basFormRtRegisterFrm(BasFormRtT *rt, const char *formName, const char *source, int32_t sourceLen);
 void basFormRtRemoveCtrl(void *ctx, void *formRef, const char *ctrlName);
+BasControlT *basFormRtResolveCtrl(BasFormRtT *rt, void *ref);
 void basFormRtRunSimple(BasFormRtT *rt);
 void basFormRtRuntimeError(BasFormRtT *rt, const char *summary, const char *detailFmt, ...);
 void basFormRtSerialShutdown(void);
@@ -497,9 +553,11 @@ static void basFormRtTeardownForm(BasFormRtT *rt, BasFormT *form);
 #ifdef DVX_HOST_TEST
 void basFormRtTestReset(void);
 #endif
+const char *basFormRtTypeName(void *ctx, void *objRef);
 void basFormRtUnloadForm(void *ctx, void *formRef);
 static BasValueT callCommonMethod(BasFormRtT *rt, BasControlT *ctrl, const char *methodName, BasValueT *args, int32_t argc);
 static bool callEventProc(BasFormRtT *rt, BasFormT *form, const BasProcEntryT *proc, const BasValueT *args, int32_t argCount, BasValueT *outArgs, int32_t outArgCount);
+static BasValueT clipboardMethod(BasFormRtT *rt, const char *name, BasValueT *args, int32_t argc);
 void CommAttach(int32_t handle, const char *termCtrlName, int32_t channel, int32_t encrypt);
 void CommClose(int32_t handle);
 void CommDetach(int32_t handle);
@@ -535,16 +593,30 @@ static bool deviceSoundBusy(void *ctx);
 static int32_t deviceStick(void *ctx, int32_t n);
 static int32_t deviceStrig(void *ctx, int32_t n);
 int32_t DlgChoice(const char *title, const char *prompt, const char *items, int32_t defaultIdx);
+int32_t DlgColor(const char *title, int32_t defaultColor);
 const char *DlgFileOpen(const char *title, const char *filter);
 const char *DlgFileSave(const char *title, const char *filter);
 const char *DlgInputBox(const char *title, const char *prompt, const char *defaultText);
 int32_t DlgInputCancelled(void);
 int32_t DlgIntInput(const char *title, const char *prompt, int32_t defaultVal, int32_t minVal, int32_t maxVal);
 int32_t DlgPromptSave(const char *title);
+static void dragAppEnded(int32_t appId);
+static void dragBegin(BasFormRtT *rt, BasControlT *ctrl);
+static bool dragBlocksMouse(const BasControlT *ctrl, bool automaticBlocks);
+static void dragEnd(bool drop, WindowT *releaseWin, int32_t x, int32_t y, int32_t buttons);
+static void dragFire(BasFormRtT *rt, BasControlT *obj, BasControlT *source, const char *eventName, int32_t state);
+static void dragForget(BasFormRtT *rt, const BasFormT *form, const BasControlT *ctrl);
+static bool dragGoing(const BasControlT *obj, const BasFormT *form, const BasControlT *ctrl);
+static void dragHookForms(BasFormRtT *rt, bool hook);
+static void dragOnKey(WindowT *win, int32_t key, int32_t mod);
+static void dragOnMouse(WindowT *win, int32_t x, int32_t y, int32_t buttons);
+static void dragOverUpdate(void);
+static bool dragShowIcon(AppContextT *ctx, const char *path);
+static BasControlT *dragTargetAt(BasFormRtT *rt);
 static BasControlT *findCtrlByWidget(BasFormT *form, const WidgetT *w);
 static BasControlT *findCtrlInForm(BasFormT *form, const char *name);
 static WidgetT *findCtrlWidgetByName(const char *name);
-static BasFormT *findFormByWindow(const WindowT *win);
+static BasFormT *findFormByWindow(const BasFormRtT *rt, const WindowT *win);
 static BasControlT *findMenuProxyInForm(BasFormT *form, const char *name);
 static BasControlT *findNamedObjectInForm(BasFormT *form, const char *name);
 static BasFrmPopupMenuT *findPopupMenu(BasFormT *form, const char *name);
@@ -771,7 +843,8 @@ BasValueT basExternCall(void *ctx, void *funcPtr, const char *libName, const cha
                 break;
             }
 
-            case BAS_TYPE_DOUBLE: {
+            case BAS_TYPE_DOUBLE:
+            case BAS_TYPE_DATE: {
                 union { double d; uint32_t u[2]; } conv;
                 conv.d = args[i].dblVal;
                 nativeArgs[nativeCount++] = conv.u[0];
@@ -793,7 +866,7 @@ BasValueT basExternCall(void *ctx, void *funcPtr, const char *libName, const cha
         basFormRtRuntimeError(sFormRt, "Out of memory", "Out of memory marshalling arguments for external function '%s'.", funcName ? funcName : "?");
     } else {
         double   dblResult = 0.0;
-        bool     fpReturn  = (retType == BAS_TYPE_DOUBLE || retType == BAS_TYPE_SINGLE);
+        bool     fpReturn  = (retType == BAS_TYPE_DOUBLE || retType == BAS_TYPE_SINGLE || retType == BAS_TYPE_DATE);
         uint32_t rawResult = basNativeCall(funcPtr, nativeArgs, nativeCount, fpReturn, &dblResult);
 
         // The i386 ABI leaves the upper bits of a sub-32-bit return (bool,
@@ -801,6 +874,8 @@ BasValueT basExternCall(void *ctx, void *funcPtr, const char *libName, const cha
         // of trusting all of EAX.
         if (retType == BAS_TYPE_DOUBLE) {
             result = basValDouble(dblResult);
+        } else if (retType == BAS_TYPE_DATE) {
+            result = basValDate(dblResult);
         } else if (retType == BAS_TYPE_SINGLE) {
             result = basValSingle((float)dblResult);
         } else if (retType == BAS_TYPE_STRING) {
@@ -854,17 +929,24 @@ void basFormRtBindVm(BasFormRtT *rt) {
     ui.createCtrlEx = basFormRtCreateCtrlEx;
     ui.setEvent     = basFormRtSetEvent;
     ui.removeCtrl   = basFormRtRemoveCtrl;
+    ui.typeName     = basFormRtTypeName;
     ui.ctx          = rt;
 
     basVmSetUiCallbacks(rt->vm, &ui);
     printerBind(rt);
     gameBind(rt);
     deviceBind(rt);
+    basFormRtScreenBind(rt);
 }
 
 
 BasValueT basFormRtCallMethod(void *ctx, void *ctrlRef, const char *methodName, BasValueT *args, int32_t argc) {
     BasFormRtT  *rt   = (BasFormRtT *)ctx;
+
+    if (ctrlRef == &sClipboardObj) {
+        return clipboardMethod(rt, methodName, args, argc);
+    }
+
     BasControlT *ctrl = resolveCtrlRef(rt, ctrlRef);
 
     if (!ctrl) {
@@ -885,6 +967,13 @@ BasValueT basFormRtCallMethod(void *ctx, void *ctrlRef, const char *methodName,
         return zeroValue();
     }
 
+    // Drawing methods of forms and PictureBoxes
+    BasValueT drawResult;
+
+    if (basFormRtDrawMethod(rt, ctrl, methodName, args, argc, &drawResult)) {
+        return drawResult;
+    }
+
     // Interface descriptor methods
     const WgtIfaceT *iface = ctrl->iface;
 
@@ -1340,6 +1429,12 @@ void basFormRtDestroy(BasFormRtT *rt) {
         sFormRt = NULL;
     }
 
+    if (sDrag.rt == rt) {
+        dragEnd(false, NULL, 0, 0, 0);
+    }
+
+    basFormRtScreenClose(rt);
+
     // Close serial/secLink and drop the idle pollers before tearing down the
     // forms whose terminal widgets they reference.  Also invoked from the
     // stub's _appShutdown hook so a force-killed app gets the same cleanup.
@@ -1388,7 +1483,7 @@ void basFormRtEventLoop(BasFormRtT *rt) {
         return;
     }
 
-    while (rt->ctx->running && arrlen(rt->forms) > 0 && !rt->terminated) {
+    while (rt->ctx->running && basFormRtKeepsRunning(rt)) {
         if (!dvxUpdate(rt->ctx)) {
             break;
         }
@@ -1439,7 +1534,8 @@ void *basFormRtFindCtrl(void *ctx, void *formRef, const char *ctrlName) {
         }
     }
 
-    return NULL;
+    // VB's Clipboard object, unless a control or form has the name.
+    return (ctrlName && strcasecmp(ctrlName, BAS_CLIPBOARD_NAME) == 0) ? (void *)&sClipboardObj : NULL;
 }
 
 
@@ -1515,6 +1611,13 @@ const BasPropDescT *basFormRtFormProps(int32_t *count) {
 
 BasValueT basFormRtGetProp(void *ctx, void *ctrlRef, const char *propName) {
     BasFormRtT  *rt   = (BasFormRtT *)ctx;
+
+    // Clipboard.GetText and friends without parentheses read like a
+    // property: they are the methods called with no arguments.
+    if (ctrlRef == &sClipboardObj) {
+        return clipboardMethod(rt, propName, NULL, 0);
+    }
+
     BasControlT *ctrl = resolveCtrlRef(rt, ctrlRef);
 
     if (!ctrl) {
@@ -1567,6 +1670,13 @@ BasValueT basFormRtGetProp(void *ctx, void *ctrlRef, const char *propName) {
         return zeroValue();
     }
 
+    // Drawing properties of forms and PictureBoxes
+    BasValueT drawValue;
+
+    if (basFormRtDrawGetProp(rt, ctrl, propName, &drawValue)) {
+        return drawValue;
+    }
+
     // Form-level properties use the window and BasFormT, not the root widget
     if (ctrl->form && ctrl == &ctrl->form->formCtrl) {
         return getFormProp(rt, ctrl->form, propName);
@@ -2173,6 +2283,11 @@ void basFormRtRemoveCtrl(void *ctx, void *formRef, const char *ctrlName) {
 }
 
 
+BasControlT *basFormRtResolveCtrl(BasFormRtT *rt, void *ref) {
+    return resolveCtrlRef(rt, ref);
+}
+
+
 void basFormRtRunSimple(BasFormRtT *rt) {
     if (!rt || !rt->vm) {
         return;
@@ -2392,6 +2507,15 @@ void basFormRtSetEvent(void *ctx, void *ctrlRef, const char *eventName, const ch
 
 void basFormRtSetProp(void *ctx, void *ctrlRef, const char *propName, BasValueT value) {
     BasFormRtT  *rt   = (BasFormRtT *)ctx;
+
+    if (ctrlRef == &sClipboardObj) {
+        basFormRtRuntimeError(rt,
+            "Clipboard has no properties",
+            "Property: %s\nUse the Clipboard methods Clear, GetFormat, GetText and SetText.",
+            propName ? propName : "?");
+        return;
+    }
+
     BasControlT *ctrl = resolveCtrlRef(rt, ctrlRef);
 
     if (!ctrl) {
@@ -2451,6 +2575,11 @@ void basFormRtSetProp(void *ctx, void *ctrlRef, const char *propName, BasValueT
         return;
     }
 
+    // Drawing properties of forms and PictureBoxes
+    if (basFormRtDrawSetProp(rt, ctrl, propName, value)) {
+        return;
+    }
+
     // Form-level property assignment uses the window and BasFormT
     if (ctrl->form && ctrl == &ctrl->form->formCtrl) {
         setFormProp(rt, ctrl->form, propName, value);
@@ -2633,10 +2762,35 @@ void basFormRtTestReset(void) {
     sFormRt                = NULL;
     sLoadingFrm            = false;
     sLastInputBoxCancelled = false;
+    memset(&sDrag, 0, sizeof(sDrag));
+    sDragCleanupHooked = false;
 }
 #endif // DVX_HOST_TEST
 
 
+// TypeName / TypeOf of a host object: "Form" for a form, the control's
+// VB type name ("TextBox" ...) for a control, NULL when unknown.
+const char *basFormRtTypeName(void *ctx, void *objRef) {
+    BasFormRtT *rt = (BasFormRtT *)ctx;
+
+    if (objRef == (void *)&sClipboardObj) {
+        return BAS_CLIPBOARD_NAME;
+    }
+
+    BasControlT *obj = resolveCtrlRef(rt, objRef);
+
+    if (!obj) {
+        return NULL;
+    }
+
+    if (obj == &obj->form->formCtrl) {
+        return BAS_FORM_TYPE_NAME;
+    }
+
+    return obj->typeName[0] ? obj->typeName : NULL;
+}
+
+
 void basFormRtUnloadForm(void *ctx, void *formRef) {
     BasFormRtT *rt   = (BasFormRtT *)ctx;
     BasFormT   *form = resolveFormRef(rt, formRef);
@@ -2706,6 +2860,27 @@ static BasValueT callCommonMethod(BasFormRtT *rt, BasControlT *ctrl, const char
         return zeroValue();
     }
 
+    if (methodId == BAS_CM_DRAG) {
+        // Drag [action]: begin (the default), cancel, or drop where the
+        // mouse is.  Cancel and end only act on this control's own drag.
+        int32_t action = (argc >= 1) ? (int32_t)basValToNumber(args[0]) : BAS_DRAG_BEGIN;
+
+        if (action == BAS_DRAG_BEGIN) {
+            dragBegin(rt, ctrl);
+        } else if (action == BAS_DRAG_CANCEL || action == BAS_DRAG_END) {
+            if (sDrag.source == ctrl) {
+                dragEnd(action == BAS_DRAG_END, NULL, 0, 0, 0);
+            }
+        } else {
+            basFormRtRuntimeError(rt,
+                "Invalid Drag action",
+                "Control: %s\nAction: %d\nUse 0 (cancel), vbBeginDrag or vbEndDrag.",
+                ctrlDisplayName(ctrl), (int)action);
+        }
+
+        return zeroValue();
+    }
+
     // ========================================================
     // Popup / context menu methods
     // ========================================================
@@ -3103,6 +3278,51 @@ static bool callEventProc(BasFormRtT *rt, BasFormT *form, const BasProcEntryT *p
 }
 
 
+// The Clipboard object's methods (VB semantics; the DVX clipboard holds
+// text, vbCFText): Clear, GetFormat(format), GetText([format]) and
+// SetText text [, format].  Other formats are never present, read as "",
+// and cannot be set.
+static BasValueT clipboardMethod(BasFormRtT *rt, const char *name, BasValueT *args, int32_t argc) {
+    int32_t len = 0;
+
+    if (!name) {
+        name = "?";
+    }
+
+    if (strcasecmp(name, BAS_CLIP_CLEAR) == 0) {
+        dvxClipboardClear();
+        return zeroValue();
+    }
+
+    if (strcasecmp(name, BAS_CLIP_GETFORMAT) == 0) {
+        bool isText = argc >= 1 && (int32_t)basValToNumber(args[0]) == BAS_CF_TEXT;
+
+        return basValBool(isText && dvxClipboardGet(&len) != NULL);
+    }
+
+    if (strcasecmp(name, BAS_CLIP_GETTEXT) == 0) {
+        bool        isText = argc < 1 || (int32_t)basValToNumber(args[0]) == BAS_CF_TEXT;
+        const char *text   = isText ? dvxClipboardGet(&len) : NULL;
+
+        return basValStringFromC(text ? text : "");
+    }
+
+    if (strcasecmp(name, BAS_CLIP_SETTEXT) == 0 && argc >= 1 && (argc <= BAS_CLIP_SETTEXT_FORMAT || (int32_t)basValToNumber(args[BAS_CLIP_SETTEXT_FORMAT]) == BAS_CF_TEXT)) {
+        BasStringT *s = basValFormatString(args[0]);
+
+        dvxClipboardCopy(s->data, s->len);
+        basStringUnref(s);
+        return zeroValue();
+    }
+
+    basFormRtRuntimeError(rt,
+        "Clipboard method not supported",
+        "Method: %s\nThe Clipboard has Clear, GetFormat, GetText and SetText, for text (vbCFText).",
+        name);
+    return zeroValue();
+}
+
+
 void CommAttach(int32_t handle, const char *termCtrlName, int32_t channel, int32_t encrypt) {
     CommSlotT *slot = commGetSlot(handle);
 
@@ -3595,6 +3815,7 @@ static void destroyFormNow(BasFormRtT *rt, BasFormT *form) {
         dvxDestroyWindow(rt->ctx, form->window);
     }
 
+    basFormRtDrawFree(&form->formCtrl);
     free(form);
 }
 
@@ -3611,6 +3832,7 @@ static void destroyFormNow(BasFormRtT *rt, BasFormT *form) {
 // survivors at free time.
 static void detachFormForUnload(BasFormRtT *rt, BasFormT *form) {
     rt->refCacheKey = NULL;
+    dragForget(rt, form, NULL);
 
     for (int32_t i = 0; i < (int32_t)arrlen(rt->forms); i++) {
         if (rt->forms[i] == form) {
@@ -3770,6 +3992,19 @@ int32_t DlgChoice(const char *title, const char *prompt, const char *items, int3
 }
 
 
+// The color dialog: the chosen color as RGB() makes it, or -1 when
+// cancelled.  defaultColor is the starting color.
+int32_t DlgColor(const char *title, int32_t defaultColor) {
+    uint32_t rgb = (uint32_t)defaultColor & BAS_RGB_MASK;
+
+    if (sFormRt && dvxColorDialog(sFormRt->ctx, title, &rgb)) {
+        return (int32_t)rgb;
+    }
+
+    return BAS_DLG_COLOR_CANCELLED;
+}
+
+
 const char *DlgFileOpen(const char *title, const char *filter) {
     if (!sFormRt) {
         return "";
@@ -3862,6 +4097,293 @@ int32_t DlgPromptSave(const char *title) {
 }
 
 
+// Shell app-cleanup hook: a program that ends while its drag runs (it
+// was killed) has lost its windows already; drop the drag without
+// touching them or its runtime.
+static void dragAppEnded(int32_t appId) {
+    if (sDrag.rt && sDrag.appId == appId) {
+        dvxDragFeedbackHide(sDrag.ctx);
+        dvxFreeImage(sDrag.icon);
+        memset(&sDrag, 0, sizeof(sDrag));
+    }
+}
+
+
+// Start dragging ctrl (a DragMode automatic press, or its Drag method):
+// the program's form windows hand their mouse and keys to the drag, and
+// the DragIcon picture, else an outline of the control, follows the
+// mouse.  A drag already running (in any program) is cancelled first.
+static void dragBegin(BasFormRtT *rt, BasControlT *ctrl) {
+    AppContextT *ctx = rt->ctx;
+    WindowT     *win = ctrl->form ? ctrl->form->window : NULL;
+    WidgetT     *w   = ctrl->widget;
+
+    if (!win || !w) {
+        return;
+    }
+
+    dragEnd(false, NULL, 0, 0, 0);
+
+    // The shell is looked up at run time (the host tests have none).
+    if (!sDragCleanupHooked) {
+        void (*reg)(ShellAppCleanupFnT fn) = dlsym(NULL, DVX_SYM("shellRegisterAppCleanup"));
+
+        sDragCleanupHooked = true;
+
+        if (reg) {
+            reg(dragAppEnded);
+        }
+    }
+
+    sDrag.rt          = rt;
+    sDrag.ctx         = ctx;
+    sDrag.appId       = ctx->currentAppId;
+    sDrag.source      = ctrl;
+    sDrag.prevButtons = ctx->mouseButtons;
+    dragHookForms(rt, true);
+
+    if (!ctrl->dragIcon || !dragShowIcon(ctx, ctrl->dragIcon)) {
+        dvxDragOutlineShow(ctx, w->w, w->h, win->x + win->contentX + w->x - ctx->mouseX, win->y + win->contentY + w->y - ctx->mouseY);
+    }
+}
+
+
+// True when a control's BASIC mouse event must not fire: a drag is
+// running or its release is being passed on, or (automaticBlocks) the
+// control's DragMode is automatic, where the left button only drags.
+static bool dragBlocksMouse(const BasControlT *ctrl, bool automaticBlocks) {
+    return sDrag.rt || sDrag.forwarding || (automaticBlocks && ctrl->dragMode == BAS_DRAGMODE_AUTOMATIC);
+}
+
+
+// End the drag in progress (none: nothing happens).  The forms get their
+// own handlers back and the outline or picture goes.  releaseWin, when
+// given, is the window whose button release ended the drag: the release
+// is passed on to its own handler, so the pressed control lets go, with
+// the BASIC mouse events it would raise dropped.  With drop, DragDrop
+// then fires on the control or form under the mouse.
+static void dragEnd(bool drop, WindowT *releaseWin, int32_t x, int32_t y, int32_t buttons) {
+    BasFormRtT *rt = sDrag.rt;
+
+    if (!rt) {
+        return;
+    }
+
+    BasControlT *source  = sDrag.source;
+    BasFormT    *relForm = releaseWin ? findFormByWindow(rt, releaseWin) : NULL;
+    void       (*release)(WindowT *win, int32_t x, int32_t y, int32_t buttons) = relForm ? relForm->dragPrevOnMouse : NULL;
+
+    dragHookForms(rt, false);
+    dvxDragFeedbackHide(rt->ctx);
+    dvxFreeImage(sDrag.icon);
+    memset(&sDrag, 0, sizeof(sDrag));
+
+    if (release) {
+        sDrag.forwarding = true;
+        release(releaseWin, x, y, buttons);
+        sDrag.forwarding = false;
+    }
+
+    BasControlT *target = drop ? dragTargetAt(rt) : NULL;
+
+    if (target) {
+        dragFire(rt, target, source, BAS_EVT_DRAGDROP, BAS_DRAG_STATE_NONE);
+    }
+}
+
+
+// Raise DragDrop (state BAS_DRAG_STATE_NONE) or DragOver on obj -- a
+// control, or a form's formCtrl -- with Source, the mouse position in
+// obj's own coordinates and, for DragOver, State.
+static void dragFire(BasFormRtT *rt, BasControlT *obj, BasControlT *source, const char *eventName, int32_t state) {
+    BasFormT  *form = obj->form;
+    WindowT   *win  = form->window;
+    WidgetT   *w    = obj->widget;
+    BasValueT  args[BAS_DRAG_OVER_ARGS];
+    int32_t    argc = BAS_DRAG_DROP_ARGS;
+
+    args[0] = basValObject(source);
+    args[1] = basValLong(rt->ctx->mouseX - win->x - win->contentX - w->x - w->contentOffX);
+    args[2] = basValLong(rt->ctx->mouseY - win->y - win->contentY - w->y - w->contentOffY);
+
+    if (state != BAS_DRAG_STATE_NONE) {
+        args[argc++] = basValLong(state);
+    }
+
+    if (obj == &form->formCtrl) {
+        basFormRtFireEventArgs(rt, form, form->name, eventName, args, argc);
+    } else {
+        fireCtrlEvent(rt, obj, eventName, args, argc);
+    }
+}
+
+
+// A form (ctrl NULL) or one control is going away: it stops being the
+// DragOver object, and a drag from it is cancelled.
+static void dragForget(BasFormRtT *rt, const BasFormT *form, const BasControlT *ctrl) {
+    if (sDrag.rt != rt) {
+        return;
+    }
+
+    if (dragGoing(sDrag.over, form, ctrl)) {
+        sDrag.over = NULL;
+    }
+
+    if (dragGoing(sDrag.source, form, ctrl)) {
+        dragEnd(false, NULL, 0, 0, 0);
+    }
+}
+
+
+// dragForget helper: true when obj is ctrl, or (ctrl NULL) is on form.
+static bool dragGoing(const BasControlT *obj, const BasFormT *form, const BasControlT *ctrl) {
+    return obj && (ctrl ? obj == ctrl : obj->form == form);
+}
+
+
+// Hand every form window's mouse and keys to the drag (hook), or give
+// them back.  A form loaded during the drag was never hooked and keeps
+// its own handlers.
+static void dragHookForms(BasFormRtT *rt, bool hook) {
+    for (int32_t i = 0; i < (int32_t)arrlen(rt->forms); i++) {
+        BasFormT *form = rt->forms[i];
+        WindowT  *win  = form->window;
+
+        if (!win) {
+            continue;
+        }
+
+        if (hook) {
+            form->dragPrevOnMouse = win->onMouse;
+            form->dragPrevOnKey   = win->onKey;
+            win->onMouse          = dragOnMouse;
+            win->onKey            = dragOnKey;
+        } else if (win->onMouse == dragOnMouse) {
+            win->onMouse = form->dragPrevOnMouse;
+            win->onKey   = form->dragPrevOnKey;
+        }
+    }
+}
+
+
+// Keys during a drag: Escape cancels it, the rest go to the window as
+// usual.
+static void dragOnKey(WindowT *win, int32_t key, int32_t mod) {
+    if (key == KEY_ESCAPE) {
+        dragEnd(false, NULL, 0, 0, 0);
+        return;
+    }
+
+    BasFormT *form = findFormByWindow(sDrag.rt, win);
+
+    if (form && form->dragPrevOnKey) {
+        form->dragPrevOnKey(win, key, mod);
+    }
+}
+
+
+// The mouse during a drag.  The left button's release drops; a move
+// updates DragOver.  A drag started from code with the button up is
+// dropped by the next click: its press only arms the release.
+static void dragOnMouse(WindowT *win, int32_t x, int32_t y, int32_t buttons) {
+    bool wasDown = (sDrag.prevButtons & MOUSE_LEFT) != 0;
+    bool isDown  = (buttons & MOUSE_LEFT) != 0;
+
+    sDrag.prevButtons = buttons;
+
+    if (wasDown && !isDown) {
+        dragEnd(true, win, x, y, buttons);
+    } else if (wasDown == isDown) {
+        dragOverUpdate();
+    }
+}
+
+
+// The mouse moved during the drag: DragOver vbLeave on the object it
+// left, then vbEnter (new object) or vbOver on the one under it.  A
+// handler may end the drag or remove objects, so the target is looked up
+// again after the leave.
+static void dragOverUpdate(void) {
+    BasFormRtT  *rt     = sDrag.rt;
+    BasControlT *source = sDrag.source;
+    BasControlT *prev   = sDrag.over;
+
+    if (prev && prev != dragTargetAt(rt)) {
+        sDrag.over = NULL;
+        dragFire(rt, prev, source, BAS_EVT_DRAGOVER, BAS_DRAG_LEAVE);
+    }
+
+    BasControlT *target = (sDrag.source == source) ? dragTargetAt(rt) : NULL;
+
+    if (!target) {
+        return;
+    }
+
+    int32_t state = (target == sDrag.over) ? BAS_DRAG_OVER : BAS_DRAG_ENTER;
+
+    sDrag.over = target;
+    dragFire(rt, target, source, BAS_EVT_DRAGOVER, state);
+}
+
+
+// Show the DragIcon picture at path as the drag feedback; false when it
+// cannot be read (the outline is shown instead).
+static bool dragShowIcon(AppContextT *ctx, const char *path) {
+    int32_t  len    = 0;
+    char    *data   = platformReadFile(path, &len);
+    int32_t  w      = 0;
+    int32_t  h      = 0;
+    int32_t  pitch  = 0;
+    bool     hasKey = false;
+    uint32_t key    = 0;
+
+    if (!data) {
+        return false;
+    }
+
+    sDrag.icon = dvxLoadImageAlpha(ctx, (const uint8_t *)data, len, &w, &h, &pitch, &hasKey, &key);
+    free(data);
+
+    if (!sDrag.icon) {
+        return false;
+    }
+
+    dvxDragImageShow(ctx, sDrag.icon, w, h, pitch, hasKey, key);
+    return true;
+}
+
+
+// The object a drop at the mouse lands on: the innermost control of the
+// dragging runtime's form under the mouse, else that form (its formCtrl);
+// NULL off the program's forms.
+static BasControlT *dragTargetAt(BasFormRtT *rt) {
+    AppContextT *ctx  = rt->ctx;
+    int32_t      part = 0;
+    int32_t      idx  = wmHitTest(&ctx->stack, ctx->mouseX, ctx->mouseY, &part);
+
+    if (idx < 0 || part != HIT_CONTENT) {
+        return NULL;
+    }
+
+    WindowT  *win  = ctx->stack.windows[idx];
+    BasFormT *form = findFormByWindow(rt, win);
+
+    if (!form) {
+        return NULL;
+    }
+
+    for (WidgetT *w = widgetCallbackTarget(form->root, ctx->mouseX - win->x - win->contentX, ctx->mouseY - win->y - win->contentY); w; w = w->parent) {
+        BasControlT *ctrl = findCtrlByWidget(form, w);
+
+        if (ctrl) {
+            return ctrl;
+        }
+    }
+
+    return &form->formCtrl;
+}
+
+
 // Control whose live widget is exactly w, or NULL.
 static BasControlT *findCtrlByWidget(BasFormT *form, const WidgetT *w) {
     for (int32_t i = 0; i < (int32_t)arrlen(form->controls); i++) {
@@ -3909,16 +4431,12 @@ static WidgetT *findCtrlWidgetByName(const char *name) {
 }
 
 
-// Loaded form owning this window, or NULL.  Shared by every window
+// rt's loaded form owning this window, or NULL (also when rt is NULL).
-// callback (onForm*).
+// Shared by every window callback (onForm*) and the drag.
-static BasFormT *findFormByWindow(const WindowT *win) {
+static BasFormT *findFormByWindow(const BasFormRtT *rt, const WindowT *win) {
-    if (!sFormRt) {
+    for (int32_t i = 0; rt && i < (int32_t)arrlen(rt->forms); i++) {
-        return NULL;
+        if (rt->forms[i]->window == win) {
-    }
+            return rt->forms[i];
-
-    for (int32_t i = 0; i < (int32_t)arrlen(sFormRt->forms); i++) {
-        if (sFormRt->forms[i]->window == win) {
-            return sFormRt->forms[i];
         }
     }
 
@@ -4298,6 +4816,8 @@ static void freeControl(BasControlT *ctrl) {
     }
 
     free(ctrl->tooltip);
+    free(ctrl->dragIcon);
+    basFormRtDrawFree(ctrl);
     free(ctrl);
 }
 
@@ -4741,6 +5261,12 @@ static BasValueT getCommonProp(BasControlT *ctrl, const char *propName, bool *ha
             return basValLong(m ? ((int32_t (*)(const WidgetT *))m->fn)(w) : 0);
         }
 
+        case CTRL_PROP_DRAGMODE:
+            return basValLong(ctrl->dragMode);
+
+        case CTRL_PROP_DRAGICON:
+            return basValStringFromC(ctrl->dragIcon ? ctrl->dragIcon : "");
+
         case CTRL_PROP_COUNT:
             break;
     }
@@ -4749,10 +5275,16 @@ static BasValueT getCommonProp(BasControlT *ctrl, const char *propName, bool *ha
 }
 
 
-// FormName.Prop reads: window geometry/state plus the BasFormT flags.
+// FormName.Prop reads: window geometry/state plus the BasFormT flags; a
+// control of the form read by its name (Me.Text1) is the control.
 static BasValueT getFormProp(BasFormRtT *rt, BasFormT *frm, const char *propName) {
     WindowT            *win = frm->window;
     const BasPropDescT *pd  = basFormRtFindFormProp(propName);
+    BasControlT        *sub = pd ? NULL : findCtrlInForm(frm, propName);
+
+    if (sub) {
+        return basValObject(sub);
+    }
 
     if (!pd || !pd->readable) {
         char valid[BAS_PROP_LIST_LEN];
@@ -5001,7 +5533,7 @@ static void onFormActivate(WindowT *win) {
     // bridge (icon refresh, focus bookkeeping) never runs for forms.
     widgetOnFocus(win);
 
-    BasFormT *form = findFormByWindow(win);
+    BasFormT *form = findFormByWindow(sFormRt, win);
 
     if (form) {
         basFormRtFireEvent(sFormRt, form, form->name, BAS_EVT_ACTIVATE);
@@ -5014,7 +5546,7 @@ static void onFormActivate(WindowT *win) {
 // QueryUnload/Unload/teardown path (including the `unloading`
 // re-entrancy guard and deferred frees) as the UNLOAD statement.
 static void onFormClose(WindowT *win) {
-    BasFormT *form = findFormByWindow(win);
+    BasFormT *form = findFormByWindow(sFormRt, win);
 
     if (!form) {
         return;
@@ -5037,7 +5569,7 @@ static void onFormDeactivate(WindowT *win) {
     // data-binding write-back), which this override otherwise suppresses.
     widgetOnBlur(win);
 
-    BasFormT *form = findFormByWindow(win);
+    BasFormT *form = findFormByWindow(sFormRt, win);
 
     if (form) {
         basFormRtFireEvent(sFormRt, form, form->name, BAS_EVT_DEACTIVATE);
@@ -5047,7 +5579,7 @@ static void onFormDeactivate(WindowT *win) {
 
 // Dispatch menu clicks as ControlName_Click events.
 static void onFormMenu(WindowT *win, int32_t menuId) {
-    BasFormT *form = findFormByWindow(win);
+    BasFormT *form = findFormByWindow(sFormRt, win);
 
     if (!form) {
         return;
@@ -5066,7 +5598,7 @@ static void onFormResize(WindowT *win, int32_t newW, int32_t newH) {
     // Let the widget system re-evaluate scrollbars for the new size
     widgetOnResize(win, newW, newH);
 
-    BasFormT *form = findFormByWindow(win);
+    BasFormT *form = findFormByWindow(sFormRt, win);
 
     if (form) {
         basFormRtFireEvent(sFormRt, form, form->name, BAS_EVT_RESIZE);
@@ -5145,7 +5677,7 @@ static void onWidgetClick(WidgetT *w) {
     BasFormRtT  *rt;
     BasControlT *ctrl = ctrlFromWidget(w, &rt);
 
-    if (ctrl) {
+    if (ctrl && !dragBlocksMouse(ctrl, true)) {
         fireCtrlEvent(rt, ctrl, BAS_EVT_CLICK, NULL, 0);
     }
 }
@@ -5155,7 +5687,7 @@ static void onWidgetDblClick(WidgetT *w) {
     BasFormRtT  *rt;
     BasControlT *ctrl = ctrlFromWidget(w, &rt);
 
-    if (ctrl) {
+    if (ctrl && !dragBlocksMouse(ctrl, true)) {
         fireCtrlEvent(rt, ctrl, BAS_EVT_DBLCLICK, NULL, 0);
     }
 }
@@ -5213,7 +5745,14 @@ static void onWidgetMouseDown(WidgetT *w, int32_t button, int32_t x, int32_t y)
     BasFormRtT  *rt;
     BasControlT *ctrl = ctrlFromWidget(w, &rt);
 
-    if (ctrl) {
+    // DragMode automatic: the left button starts a drag instead of
+    // raising MouseDown.
+    if (ctrl && button == BAS_MOUSE_BUTTON_LEFT && ctrl->dragMode == BAS_DRAGMODE_AUTOMATIC && !sDrag.rt) {
+        dragBegin(rt, ctrl);
+        return;
+    }
+
+    if (ctrl && !dragBlocksMouse(ctrl, false)) {
         BasValueT args[3];
         args[0] = basValLong(button);
         args[1] = basValLong(x);
@@ -5227,7 +5766,7 @@ static void onWidgetMouseMove(WidgetT *w, int32_t button, int32_t x, int32_t y)
     BasFormRtT  *rt;
     BasControlT *ctrl = ctrlFromWidget(w, &rt);
 
-    if (ctrl) {
+    if (ctrl && !dragBlocksMouse(ctrl, false)) {
         BasValueT args[3];
         args[0] = basValLong(button);
         args[1] = basValLong(x);
@@ -5241,7 +5780,7 @@ static void onWidgetMouseUp(WidgetT *w, int32_t button, int32_t x, int32_t y) {
     BasFormRtT  *rt;
     BasControlT *ctrl = ctrlFromWidget(w, &rt);
 
-    if (ctrl) {
+    if (ctrl && !dragBlocksMouse(ctrl, button == BAS_MOUSE_BUTTON_LEFT)) {
         BasValueT args[3];
         args[0] = basValLong(button);
         args[1] = basValLong(x);
@@ -5492,6 +6031,8 @@ static void removeCtrlTree(BasFormRtT *rt, BasFormT *form, BasControlT *ctrl) {
             serDetached = true;
         }
 
+        dragForget(rt, form, c);
+
         c->widget = NULL;
         arrdel(form->controls, i);
         rt->refCacheKey = NULL;
@@ -6453,6 +6994,18 @@ static bool setCommonProp(BasControlT *ctrl, const char *propName, BasValueT val
             setControlString(ctrl->dataField, sizeof(ctrl->dataField), value);
             break;
 
+        case CTRL_PROP_DRAGMODE:
+            ctrl->dragMode = ((int32_t)basValToNumber(value) == BAS_DRAGMODE_AUTOMATIC) ? BAS_DRAGMODE_AUTOMATIC : BAS_DRAGMODE_MANUAL;
+            break;
+
+        case CTRL_PROP_DRAGICON: {
+            BasStringT *s = basValFormatString(value);
+            free(ctrl->dragIcon);
+            ctrl->dragIcon = (s->len > 0) ? strdup(s->data) : NULL;
+            basStringUnref(s);
+            break;
+        }
+
         case CTRL_PROP_NAME:
         case CTRL_PROP_LISTCOUNT:
         case CTRL_PROP_COUNT:

src/apps/kpunch/dvxbasic/formrt/formrt.h

@@ -45,6 +45,8 @@
 
 typedef struct BasFormT BasFormT;
 typedef struct BasControlT BasControlT;
+typedef struct BasDrawT BasDrawT;              // a Form's / PictureBox's drawing state (formGfx.c)
+typedef struct BasScreenWinT BasScreenWinT;    // the program screen's window (formGfx.c)
 
 // ============================================================
 // Limits
@@ -60,6 +62,7 @@ typedef struct BasControlT BasControlT;
 // Layout of a form or container that names none ("VBox" / "HBox" /
 // "WrapBox" are the box widgets' BASIC names).
 #define BAS_LAYOUT_VBOX          "VBox"
+#define BAS_PICTUREBOX_TYPE      "PictureBox"     // takes the drawing members, as forms do
 
 // ============================================================
 // Property names
@@ -82,6 +85,8 @@ typedef struct BasControlT BasControlT;
 #define BAS_PROP_DATAFIELD       "DataField"
 #define BAS_PROP_DATASOURCE      "DataSource"
 #define BAS_PROP_DETAILFIELD     "DetailField"
+#define BAS_PROP_DRAGICON        "DragIcon"
+#define BAS_PROP_DRAGMODE        "DragMode"
 #define BAS_PROP_ENABLED         "Enabled"
 #define BAS_PROP_FORECOLOR       "ForeColor"
 #define BAS_PROP_HEIGHT          "Height"
@@ -168,6 +173,7 @@ typedef enum {
     BAS_CM_ADDSEPARATOR,
     BAS_CM_CLEAR,
     BAS_CM_BUTTONCOUNT,
+    BAS_CM_DRAG,
     BAS_CM_COUNT
 } BasCommonMethodE;
 
@@ -216,6 +222,9 @@ typedef struct BasControlT {
     char              dataField[BAS_MAX_IDENT];  // column name for binding
     char              helpTopic[BAS_MAX_IDENT];  // help topic ID for F1
     char             *tooltip;                       // heap-owned tooltip text (NULL = none); wgtSetTooltip references this buffer, so it must outlive the widget
+    char             *dragIcon;                      // heap-owned DragIcon picture path (NULL = the drag shows an outline)
+    BasDrawT         *draw;                          // drawing state (forms and PictureBoxes that drew), NULL before
+    int32_t           dragMode;                      // DragMode: BAS_DRAGMODE_MANUAL or BAS_DRAGMODE_AUTOMATIC
     int32_t           menuId;                        // WM menu item ID (>0 for menu items, 0 for controls)
     BasEventOverrideT eventOverrides[BAS_MAX_EVENT_OVERRIDES];
     int32_t           eventOverrideCount;
@@ -276,6 +285,10 @@ typedef struct BasFormT {
     // (fireCtrlEvent drops events for it).  Distinct from `unloading`,
     // which is also true while QueryUnload/Unload still fire.
     bool              detached;
+    // The window's own mouse and key handlers, kept while a drag and
+    // drop has taken them over (see dragHookForms).
+    void            (*dragPrevOnMouse)(WindowT *win, int32_t x, int32_t y, int32_t buttons);
+    void            (*dragPrevOnKey)(WindowT *win, int32_t key, int32_t mod);
     // Synthetic control entry for the form itself, so that
     // FormName.Property works through the same getProp/setProp path.
     BasControlT       formCtrl;
@@ -357,6 +370,10 @@ typedef struct {
     GameFramePacerT   framePacer;
     int32_t           frameHz;
     uint64_t          frameDueUs;
+    // The program screen's window (made by the first console or graphics
+    // statement) and its caption: hosts set title to the program's name.
+    BasScreenWinT    *screenWin;
+    char              title[BAS_MAX_IDENT];
 } BasFormRtT;
 
 // ============================================================
@@ -381,6 +398,20 @@ void basFormRtRunSimple(BasFormRtT *rt);
 // Destroy the form runtime and all forms/controls.
 void basFormRtDestroy(BasFormRtT *rt);
 
+// True while the program is alive for its host's event loop: a form is
+// loaded or the program's screen window is open, and it was not stopped
+// (runtime error, screen window closed).
+bool basFormRtKeepsRunning(const BasFormRtT *rt);
+
+// The program screen's window, or NULL (none yet, or closed).
+WindowT *basFormRtScreenWindow(const BasFormRtT *rt);
+
+// True when name is a Form / PictureBox drawing method (Cls, PSet, Line,
+// Circle, Point, Print, PaintPicture, TextWidth, TextHeight) or, with
+// isProp, a drawing property (CurrentX, CurrentY, DrawWidth, FillColor,
+// FillStyle, ForeColor, BackColor, AutoRedraw, ScaleWidth, ScaleHeight).
+bool basFormRtIsDrawMember(const char *name, bool isProp);
+
 // Close all serial/secLink resources and unregister the idle pollers.
 // Called by basFormRtDestroy and by the stub's _appShutdown force-kill hook.
 void basFormRtSerialShutdown(void);
@@ -418,6 +449,7 @@ void     *basFormRtLoadForm(void *ctx, const char *formName);
 int32_t   basFormRtMsgBox(void *ctx, const char *message, int32_t flags, const char *title);
 void      basFormRtSetProp(void *ctx, void *ctrlRef, const char *propName, BasValueT value);
 void      basFormRtShowForm(void *ctx, void *formRef, bool modal);
+const char *basFormRtTypeName(void *ctx, void *objRef);
 void      basFormRtUnloadForm(void *ctx, void *formRef);
 
 // ---- Extern call callbacks (shared by IDE and stub) ----
@@ -493,4 +525,23 @@ bool basFormRtFireEventArgs(BasFormRtT *rt, BasFormT *form, const char *ctrlName
 
 BasFormT *basFormRtLoadFrm(BasFormRtT *rt, const char *source, int32_t sourceLen);
 
+// ============================================================
+// Between formrt.c and formGfx.c
+// ============================================================
+
+// Drawing members of forms and PictureBoxes: true when handled.
+bool basFormRtDrawGetProp(BasFormRtT *rt, BasControlT *ctrl, const char *name, BasValueT *out);
+bool basFormRtDrawMethod(BasFormRtT *rt, BasControlT *ctrl, const char *name, BasValueT *args, int32_t argc, BasValueT *result);
+bool basFormRtDrawSetProp(BasFormRtT *rt, BasControlT *ctrl, const char *name, BasValueT value);
+
+// Free a control's drawing state.
+void basFormRtDrawFree(BasControlT *ctrl);
+
+// The live control an object reference names, or NULL.
+BasControlT *basFormRtResolveCtrl(BasFormRtT *rt, void *ref);
+
+// Program screen: become the VM's screen host / close the screen window.
+void basFormRtScreenBind(BasFormRtT *rt);
+void basFormRtScreenClose(BasFormRtT *rt);
+
 #endif // DVXBASIC_FORMRT_H

src/apps/kpunch/dvxbasic/ide/ideDesigner.c

@@ -74,7 +74,8 @@ static const DsgnIntPropT sIntProps[] = {
     { BAS_PROP_MINHEIGHT, BAS_PROP_HEIGHT, offsetof(DsgnControlT, height),    DSGN_SAVE_ALWAYS      },
     { BAS_PROP_MAXWIDTH,  NULL,            offsetof(DsgnControlT, maxWidth),  DSGN_SAVE_IF_POSITIVE },
     { BAS_PROP_MAXHEIGHT, NULL,            offsetof(DsgnControlT, maxHeight), DSGN_SAVE_IF_POSITIVE },
-    { BAS_PROP_WEIGHT,    NULL,            offsetof(DsgnControlT, weight),    DSGN_SAVE_IF_POSITIVE }
+    { BAS_PROP_WEIGHT,    NULL,            offsetof(DsgnControlT, weight),    DSGN_SAVE_IF_POSITIVE },
+    { BAS_PROP_DRAGMODE,  NULL,            offsetof(DsgnControlT, dragMode),  DSGN_SAVE_IF_NONZERO  }
 };
 
 #define DSGN_INT_PROP_COUNT DVX_ARRAY_LEN(sIntProps)

src/apps/kpunch/dvxbasic/ide/ideDesigner.h

@@ -130,6 +130,7 @@ typedef struct {
     int32_t    maxWidth;    // 0 = no cap (stretch to fill)
     int32_t    maxHeight;   // 0 = no cap (stretch to fill)
     int32_t    weight;      // layout weight (0 = fixed size, >0 = share extra space)
+    int32_t    dragMode;    // DragMode (0 manual, 1 automatic)
     char       helpTopic[DSGN_MAX_NAME]; // help topic ID for F1
     bool       visible;     // design-time visibility (default true)
     bool       enabled;     // design-time enabled (default true)

src/apps/kpunch/dvxbasic/ide/ideProject.c

@@ -31,6 +31,9 @@
 //   File0 = MAIN.BAS
 //   File1 = UTILS.BAS
 //
+//   [Classes]
+//   File0 = STACK.CLS
+//
 //   [Forms]
 //   File0 = FORM1.FRM
 //
@@ -75,7 +78,7 @@
 #define PRJ_MODIFIED_SUFFIX " *"  // tree label suffix for an unsaved file
 #define PRJ_PLACEHOLDER_BPP 4 // bytes per pixel of the 1x1 icon placeholder
 #define PRJ_INI_KEY_LEN   16    // "FileNNN" INI key buffer size
-#define PRJ_FILE_KEY_FMT  "File%d"  // INI key for an indexed module/form path
+#define PRJ_FILE_KEY_FMT  "File%d"  // INI key for an indexed module/class/form path
 
 #define PPD_WIDTH    380
 #define PPD_HEIGHT   410
@@ -96,6 +99,23 @@ static PrjFileClickFnT  sOnClick     = NULL;
 static PrjSelChangeFnT  sOnSelChange = NULL;
 static char            **sLabels  = NULL; // stb_ds array of strdup'd strings
 
+// Per file kind: the .dbp section listing its files and its Project
+// window group.
+static const char *const sKindSections[PrjKindCountE] = {
+    [PrjKindModuleE] = BAS_INI_SECTION_MODULES,
+    [PrjKindClassE]  = BAS_INI_SECTION_CLASSES,
+    [PrjKindFormE]   = BAS_INI_SECTION_FORMS
+};
+
+static const char *const sKindGroups[PrjKindCountE] = {
+    [PrjKindModuleE] = "Modules",
+    [PrjKindClassE]  = "Classes",
+    [PrjKindFormE]   = "Forms"
+};
+
+// Project window group order
+static const PrjFileKindE sGroupOrder[PrjKindCountE] = { PrjKindFormE, PrjKindModuleE, PrjKindClassE };
+
 static struct {
     bool          done;
     bool          accepted;
@@ -134,10 +154,10 @@ static void     ppdOnOk(WidgetT *w);
 static void     ppdReadInput(WidgetT *input, char *dst, int32_t dstSize);
 static void     prjDeriveDir(PrjStateT *prj, const char *dbpPath);
 static int32_t  prjFileIndexByPath(const PrjStateT *prj, const char *path);
-static void     prjLoadFileSection(PrjStateT *prj, PrefsHandleT *h, const char *section, bool isForm);
+static void     prjLoadFileSection(PrjStateT *prj, PrefsHandleT *h, PrjFileKindE kind);
 static void     prjLoadString(PrefsHandleT *h, const char *section, const char *key, char *dst, int32_t dstSize);
 static const char *prjMakeRelative(const PrjStateT *prj, const char *path);
-static void     prjSaveFileSection(PrefsHandleT *h, const PrjStateT *prj, const char *section, bool isForm);
+static void     prjSaveFileSection(PrefsHandleT *h, const PrjStateT *prj, PrjFileKindE kind);
 static void     prjSaveOptional(PrefsHandleT *h, const char *key, const char *value);
 static bool     validateIcon(const char *fullPath, bool showErrors);
 
@@ -155,7 +175,7 @@ static void onTreeItemDblClick(WidgetT *w) {
     int32_t fileIdx = (int32_t)(intptr_t)w->userData;
 
     if (fileIdx >= 0 && fileIdx < prjFileCount(sPrj)) {
-        sOnClick(fileIdx, sPrj->files[fileIdx].isForm);
+        sOnClick(fileIdx);
     }
 }
 
@@ -340,17 +360,39 @@ static void ppdReadInput(WidgetT *input, char *dst, int32_t dstSize) {
 }
 
 
-int32_t prjAddFile(PrjStateT *prj, const char *relativePath, bool isForm) {
+int32_t prjAddFile(PrjStateT *prj, const char *relativePath, PrjFileKindE kind) {
     PrjFileT entry;
     memset(&entry, 0, sizeof(entry));
     snprintf(entry.path, sizeof(entry.path), "%s", relativePath);
-    entry.isForm = isForm;
+    entry.kind = (uint8_t)kind;
     arrput(prj->files, entry);
     prj->dirty = true;
     return prjFileCount(prj) - 1;
 }
 
 
+int32_t prjClassCodePos(const char *text, int32_t len, int32_t *outFirstLine) {
+    int32_t codePos = basClassCodePos(text, len);
+    int32_t line    = 1;
+
+    for (int32_t i = 0; i < codePos; i++) {
+        if (text[i] == '\n') {
+            line++;
+        }
+    }
+
+    *outFirstLine = line;
+    return codePos;
+}
+
+
+bool prjClassName(const PrjStateT *prj, int32_t fileIdx, const char *text, char *out, int32_t outSize) {
+    const char *src = text ? text : "";
+
+    return basExtractClassName(src, (int32_t)strlen(src), prj->files[fileIdx].path, out, outSize);
+}
+
+
 void prjClose(PrjStateT *prj) {
     for (int32_t i = 0; i < prjFileCount(prj); i++) {
         free(prj->files[i].buffer);
@@ -471,6 +513,21 @@ void prjInit(PrjStateT *prj) {
 }
 
 
+PrjFileKindE prjKindForPath(const char *path) {
+    const char *base = platformPathBaseName(path);
+
+    if (dvxHasExt(base, PRJ_FRM_EXT)) {
+        return PrjKindFormE;
+    }
+
+    if (dvxHasExt(base, BAS_CLS_EXT)) {
+        return PrjKindClassE;
+    }
+
+    return PrjKindModuleE;
+}
+
+
 bool prjLoad(PrjStateT *prj, const char *dbpPath) {
     // prefsLoad treats a missing file as an empty INI, so probe first or a
     // deleted .dbp would "open" as an empty project.
@@ -503,9 +560,10 @@ bool prjLoad(PrjStateT *prj, const char *dbpPath) {
     prjLoadString(h, BAS_INI_SECTION_PROJECT, BAS_INI_KEY_HELPFILE, prj->helpFile, sizeof(prj->helpFile));
     prjLoadString(h, BAS_INI_SECTION_PROJECT, BAS_INI_KEY_COMMANDARGS, prj->commandArgs, sizeof(prj->commandArgs));
 
-    // [Modules] and [Forms] sections -- File0, File1, ... (no cap)
+    // [Modules], [Classes] and [Forms] sections -- File0, File1, ... (no cap)
-    prjLoadFileSection(prj, h, BAS_INI_SECTION_MODULES, false);
+    for (int32_t kind = 0; kind < PrjKindCountE; kind++) {
-    prjLoadFileSection(prj, h, BAS_INI_SECTION_FORMS, true);
+        prjLoadFileSection(prj, h, (PrjFileKindE)kind);
+    }
 
     // [Settings] section
     prjLoadString(h, BAS_INI_SECTION_SETTINGS, BAS_INI_KEY_STARTUPFORM, prj->startupForm, sizeof(prj->startupForm));
@@ -537,7 +595,7 @@ void prjLoadAllFiles(PrjStateT *prj, AppContextT *ctx) {
         prj->files[i].buffer = buf;
 
         // Extract form name from .frm files
-        if (prj->files[i].isForm) {
+        if (prj->files[i].kind == PrjKindFormE) {
             basExtractFormName(buf, prj->files[i].formName, sizeof(prj->files[i].formName));
         }
 
@@ -549,20 +607,21 @@ void prjLoadAllFiles(PrjStateT *prj, AppContextT *ctx) {
 }
 
 
-// Load File0, File1, ... entries from an INI section, registering each as a
+// Load File0, File1, ... entries from the INI section of kind, registering
-// project file.  The loop ends at the first missing key (no fixed cap).
+// each as a project file.  The loop ends at the first missing key (no
-static void prjLoadFileSection(PrjStateT *prj, PrefsHandleT *h, const char *section, bool isForm) {
+// fixed cap).
+static void prjLoadFileSection(PrjStateT *prj, PrefsHandleT *h, PrjFileKindE kind) {
     for (int32_t i = 0; ; i++) {
         char key[PRJ_INI_KEY_LEN];
         snprintf(key, sizeof(key), PRJ_FILE_KEY_FMT, (int)i);
 
-        const char *val = prefsGetString(h, section, key, NULL);
+        const char *val = prefsGetString(h, sKindSections[kind], key, NULL);
 
         if (!val) {
             break;
         }
 
-        prjAddFile(prj, val, isForm);
+        prjAddFile(prj, val, kind);
     }
 }
 
@@ -592,6 +651,25 @@ static const char *prjMakeRelative(const PrjStateT *prj, const char *path) {
 }
 
 
+int32_t prjMapFileLine(const PrjStateT *prj, int32_t fileIdx, int32_t fileLine) {
+    if (fileIdx < 0 || fileIdx >= prjFileCount(prj)) {
+        return 0;
+    }
+
+    for (int32_t i = 0; i < (int32_t)arrlen(prj->sourceMap); i++) {
+        const BasSourceMapT *m = &prj->sourceMap[i];
+
+        if (strcmp(m->path, prj->files[fileIdx].path) == 0) {
+            int32_t offset = fileLine - m->firstFileLine;
+
+            return (offset >= 0 && offset < m->lineCount) ? m->startLine + offset : 0;
+        }
+    }
+
+    return 0;
+}
+
+
 bool prjMapLine(const PrjStateT *prj, int32_t concatLine, int32_t *outFileIdx, int32_t *outLocalLine) {
     const char *path      = NULL;
     int32_t     localLine = 0;
@@ -612,21 +690,6 @@ bool prjMapLine(const PrjStateT *prj, int32_t concatLine, int32_t *outFileIdx, i
 }
 
 
-int32_t prjMapStartLine(const PrjStateT *prj, int32_t fileIdx) {
-    if (fileIdx < 0 || fileIdx >= prjFileCount(prj)) {
-        return 0;
-    }
-
-    for (int32_t i = 0; i < (int32_t)arrlen(prj->sourceMap); i++) {
-        if (strcmp(prj->sourceMap[i].path, prj->files[fileIdx].path) == 0) {
-            return prj->sourceMap[i].startLine;
-        }
-    }
-
-    return 0;
-}
-
-
 void prjNew(PrjStateT *prj, const char *name, const char *directory, PrefsHandleT *prefs) {
     prjInit(prj);
     snprintf(prj->name, sizeof(prj->name), "%s", name);
@@ -711,7 +774,7 @@ bool prjPropertiesDialog(AppContextT *ctx, PrjStateT *prj, const char *appPath)
         int32_t selectedIdx = 0;
 
         for (int32_t i = 0; i < prjFileCount(prj); i++) {
-            if (!prj->files[i].isForm) {
+            if (prj->files[i].kind != PrjKindFormE) {
                 continue;
             }
 
@@ -936,25 +999,23 @@ void prjRebuildTree(PrjStateT *prj) {
     projNode->userData = (void *)(intptr_t)-1;
     wgtTreeItemSetExpanded(projNode, true);
 
-    // Forms and Modules groups
+    // One group per file kind (the group names are static text)
-    char *formsLabel = strdup("Forms");
+    WidgetT *groupNodes[PrjKindCountE];
-    arrput(sLabels, formsLabel);
-    WidgetT *formsNode = wgtTreeItem(projNode, formsLabel);
-    formsNode->userData = (void *)(intptr_t)-1;
-    wgtTreeItemSetExpanded(formsNode, true);
 
-    char *modsLabel = strdup("Modules");
+    for (int32_t g = 0; g < PrjKindCountE; g++) {
-    arrput(sLabels, modsLabel);
+        PrjFileKindE kind = sGroupOrder[g];
-    WidgetT *modsNode = wgtTreeItem(projNode, modsLabel);
+
-    modsNode->userData = (void *)(intptr_t)-1;
+        groupNodes[kind]           = wgtTreeItem(projNode, sKindGroups[kind]);
-    wgtTreeItemSetExpanded(modsNode, true);
+        groupNodes[kind]->userData = (void *)(intptr_t)-1;
+        wgtTreeItemSetExpanded(groupNodes[kind], true);
+    }
 
     for (int32_t i = 0; i < prjFileCount(prj); i++) {
         char buf[DVX_MAX_PATH + sizeof(PRJ_MODIFIED_SUFFIX)];
         snprintf(buf, sizeof(buf), "%s%s", prj->files[i].path, prj->files[i].modified ? PRJ_MODIFIED_SUFFIX : "");
         char *label = strdup(buf);
         arrput(sLabels, label);
-        WidgetT *item = wgtTreeItem(prj->files[i].isForm ? formsNode : modsNode, label);
+        WidgetT *item = wgtTreeItem(groupNodes[prj->files[i].kind], label);
         item->userData   = (void *)(intptr_t)i;
         item->onDblClick = onTreeItemDblClick;
     }
@@ -969,7 +1030,7 @@ void prjRemoveFile(PrjStateT *prj, int32_t idx) {
     }
 
     // A removed startup form is no longer a valid startup form.
-    if (prj->files[idx].isForm && prj->files[idx].formName[0] && strcasecmp(prj->files[idx].formName, prj->startupForm) == 0) {
+    if (prj->files[idx].kind == PrjKindFormE && prj->files[idx].formName[0] && strcasecmp(prj->files[idx].formName, prj->startupForm) == 0) {
         prj->startupForm[0] = '\0';
     }
 
@@ -1017,9 +1078,10 @@ bool prjSave(const PrjStateT *prj) {
     prjSaveOptional(h, BAS_INI_KEY_HELPFILE, prj->helpFile);
     prjSaveOptional(h, BAS_INI_KEY_COMMANDARGS, prj->commandArgs);
 
-    // [Modules] and [Forms] sections
+    // [Modules], [Classes] and [Forms] sections
-    prjSaveFileSection(h, prj, BAS_INI_SECTION_MODULES, false);
+    for (int32_t kind = 0; kind < PrjKindCountE; kind++) {
-    prjSaveFileSection(h, prj, BAS_INI_SECTION_FORMS, true);
+        prjSaveFileSection(h, prj, (PrjFileKindE)kind);
+    }
 
     // [Settings] section
     prefsSetString(h, BAS_INI_SECTION_SETTINGS, BAS_INI_KEY_STARTUPFORM, prj->startupForm);
@@ -1031,16 +1093,16 @@ bool prjSave(const PrjStateT *prj) {
 }
 
 
-// Write the project files whose isForm flag matches into an INI section as
+// Write the project files of kind into its INI section as File0, File1,
-// File0, File1, ...  (readers stop at the first missing key).
+// ...  (readers stop at the first missing key).
-static void prjSaveFileSection(PrefsHandleT *h, const PrjStateT *prj, const char *section, bool isForm) {
+static void prjSaveFileSection(PrefsHandleT *h, const PrjStateT *prj, PrjFileKindE kind) {
     int32_t idx = 0;
 
     for (int32_t i = 0; i < prjFileCount(prj); i++) {
-        if (prj->files[i].isForm == isForm) {
+        if (prj->files[i].kind == kind) {
             char key[PRJ_INI_KEY_LEN];
             snprintf(key, sizeof(key), PRJ_FILE_KEY_FMT, (int)idx++);
-            prefsSetString(h, section, key, prj->files[i].path);
+            prefsSetString(h, sKindSections[kind], key, prj->files[i].path);
         }
     }
 }

src/apps/kpunch/dvxbasic/ide/ideProject.h

@@ -59,6 +59,23 @@
 #define IDE_PREF_SECTION_EDITOR     "editor"
 #define IDE_PREF_KEY_OPTION_EXPLICIT "optionExplicit"
 
+// Form file extension; a class module's is BAS_CLS_EXT (basRes.h).  A
+// file's kind follows its extension (see prjKindForPath).
+#define PRJ_FRM_EXT        ".frm"
+
+// ============================================================
+// Project file kinds
+// ============================================================
+
+// The order is the compile order: modules, then class modules, then
+// forms (see basBuildConcatProject).
+typedef enum {
+    PrjKindModuleE,     // .bas: [Modules]
+    PrjKindClassE,      // .cls: [Classes]
+    PrjKindFormE,       // .frm: [Forms]
+    PrjKindCountE
+} PrjFileKindE;
+
 // ============================================================
 // Project file entry
 // ============================================================
@@ -68,7 +85,7 @@ typedef struct {
     char    *buffer;             // in-memory edit buffer (malloc'd, NULL = not loaded)
     char     path[DVX_MAX_PATH]; // relative path (8.3 DOS name)
     char     formName[BAS_MAX_IDENT]; // form object name (from "Begin Form <name>")
-    bool     isForm;             // true = .frm, false = .bas
+    uint8_t  kind;               // PrjFileKindE
     bool     modified;           // true = buffer has unsaved changes
 } PrjFileT;
 
@@ -79,7 +96,7 @@ typedef struct {
 typedef struct {
     // Fields are ordered by alignment to minimize struct padding.
     PrjFileT       *files;                      // stb_ds dynamic array (prjFileCount)
-    BasSourceMapT  *sourceMap;                  // stb_ds array: path = files[].path, firstFileLine = 1
+    BasSourceMapT  *sourceMap;                  // stb_ds array: path = files[].path, firstFileLine = first code line
     int32_t         activeFileIdx; // index of file open in editor (-1 = none)
     char            name[PRJ_MAX_NAME];
     char            projectPath[DVX_MAX_PATH]; // full path to .dbp file
@@ -102,11 +119,24 @@ typedef struct {
 // Project management
 // ============================================================
 
-int32_t prjAddFile(PrjStateT *prj, const char *relativePath, bool isForm);
+int32_t prjAddFile(PrjStateT *prj, const char *relativePath, PrjFileKindE kind);
+
+// Offset of the first line of code in the text of a class module (len
+// bytes), just past its header; *outFirstLine receives that line's
+// 1-based number.
+int32_t prjClassCodePos(const char *text, int32_t len, int32_t *outFirstLine);
+
+// The class name of project file fileIdx (a class module) given its
+// text: its Attribute VB_Name, else its file name.  False when neither
+// gives one.
+bool    prjClassName(const PrjStateT *prj, int32_t fileIdx, const char *text, char *out, int32_t outSize);
 void    prjClose(PrjStateT *prj);
 int32_t prjFileCount(const PrjStateT *prj);
 void    prjFullPath(const PrjStateT *prj, int32_t fileIdx, char *outPath, int32_t outSize);
 void    prjInit(PrjStateT *prj);
+
+// The kind of source file path names, by its file name's extension.
+PrjFileKindE prjKindForPath(const char *path);
 bool    prjLoad(PrjStateT *prj, const char *dbpPath);
 void    prjLoadAllFiles(PrjStateT *prj, AppContextT *ctx);
 void    prjNew(PrjStateT *prj, const char *name, const char *directory, PrefsHandleT *prefs);
@@ -136,15 +166,16 @@ void    prjSingleLine(char *dst, int32_t dstSize, const char *src);
 // outLocalLine to the originating file and line within that file.
 bool prjMapLine(const PrjStateT *prj, int32_t concatLine, int32_t *outFileIdx, int32_t *outLocalLine);
 
-// The concatenated line holding line 1 of file fileIdx's code, or 0 when
+// The concatenated line holding line fileLine of file fileIdx, or 0 when
-// the file is not in the map (not compiled since it was added).
+// the file is not in the map (not compiled since it was added) or the
-int32_t prjMapStartLine(const PrjStateT *prj, int32_t fileIdx);
+// line is not compiled code (e.g. a class module's header).
+int32_t prjMapFileLine(const PrjStateT *prj, int32_t fileIdx, int32_t fileLine);
 
 // ============================================================
 // Project window UI
 // ============================================================
 
-typedef void (*PrjFileClickFnT)(int32_t fileIdx, bool isForm);
+typedef void (*PrjFileClickFnT)(int32_t fileIdx);
 typedef void (*PrjSelChangeFnT)(void);
 
 WindowT *prjCreateWindow(AppContextT *ctx, PrjStateT *prj, PrjFileClickFnT onClick, PrjSelChangeFnT onSelChange);

src/apps/kpunch/dvxbasic/ideguide.dhs

@@ -88,6 +88,7 @@ The IDE compiles BASIC source into bytecode and runs it in an integrated virtual
 .index Close Project
 .index Project Properties
 .index Add File
+.index New Class Module
 .index Save File
 .index Save All
 .index Remove File
@@ -105,7 +106,8 @@ The IDE compiles BASIC source into bytecode and runs it in an integrated virtual
   ---
   Project Properties...             Edit project metadata (name, author, version, startup form, icon, etc.) and the command line arguments used when the program is run from the IDE.
   ---
-  Add File...            Ctrl+O     Add a .bas or .frm file to the project. If no project is open, creates an implicit project from the file. A file that cannot be read, or is 64 KB or larger, is refused with a message.
+  Add File...            Ctrl+O     Add a .bas, .frm or .cls file to the project. If no project is open, creates an implicit project from the file. A file that cannot be read, or is 64 KB or larger, is refused with a message.
+  New Class Module                  Add a new, empty class module (Class1.cls, Class2.cls, ...) to the project and open it in the Code Editor. See Class Modules under Project System.
   Save File              Ctrl+S     Save the active file to disk.
   Save All                          Save all modified files in the project.
   ---
@@ -116,7 +118,7 @@ The IDE compiles BASIC source into bytecode and runs it in an integrated virtual
   Exit                              Close the IDE (prompts to save unsaved changes).
 .endtable
 
-A project (.dbp) or source file (.bas, .frm) named on the IDE's command line opens when the IDE starts, so double-clicking one in the File Manager, or starting it from the Program Manager, opens it in the IDE.
+A project (.dbp) or source file (.bas, .frm, .cls) named on the IDE's command line opens when the IDE starts, so double-clicking one in the File Manager, or starting it from the Program Manager, opens it in the IDE.
 
 Files are saved exactly as edited (LF line endings). Each save writes a temporary file first and replaces the original only when the write succeeded. Opening a project that fails to load keeps the current project open and removes the failed entry from the Recent list.
 
@@ -380,7 +382,7 @@ The editor applies real-time syntax coloring as you type. Seven categories are h
   --------          --------
   Default Text      Identifiers, whitespace.
   Keywords          IF, THEN, FOR, NEXT, SUB, FUNCTION, DIM, PRINT, SELECT, CASE, DO, LOOP, WHILE, WEND, END, EXIT, CALL, GOSUB, GOTO, RETURN, DECLARE, CONST, TYPE, AND, OR, NOT, XOR, MOD, etc.
-  Types             INTEGER, LONG, SINGLE, DOUBLE, STRING, BOOLEAN, TRUE, FALSE
+  Types             INTEGER, LONG, SINGLE, DOUBLE, STRING, BOOLEAN, DATE, VARIANT, OBJECT, COLLECTION, TRUE, FALSE, NOTHING, EMPTY, NULL
   Strings           "Hello, World!"
   Comments          ' This is a comment, REM This is a comment
   Numbers           42, 3.14, &HFF
@@ -447,6 +449,9 @@ Forms have the following design-time properties: Name, Caption, Width, Height, L
 .index .dbp Files
 .index Project Explorer
 .index Source Map
+.index Class Modules in the IDE
+.index .cls Files
+.index Classes Section
 
 .h1 Project System
 
@@ -460,12 +465,29 @@ A DVX BASIC project is stored as a .dbp file (DVX BASIC Project). The project fi
 .item Metadata -- Author, Company, Version, Copyright, Description (a single line), and Icon Path (for compiled binaries).
 .item Arguments -- the command line the program gets (COMMAND$) when it is run from the IDE, for trying out a program that opens the file it is given. It is not built into the compiled program: there COMMAND$ returns whatever the program was started with.
 .item Help File -- a compiled help file (.hlp) for the program. It is copied next to the compiled program, and F1 in the running program opens it, at the HelpTopic of the focused control or, failing that, of the form. Add help.bas to the project and call HelpView to open it from a Help menu.
-.item File list -- relative paths of all .bas and .frm files in the project. Each entry tracks whether it is a form file.
+.item File list -- relative paths of all the project's files: modules (.bas) in the [Modules] section, class modules (.cls) in the [Classes] section and forms (.frm) in the [Forms] section.
 .endlist
 
+The file sections all have the same shape: one FileN line per file, numbered from 0, and a Count line:
+
+.code
+[Modules]
+File0 = main.bas
+Count = 1
+
+[Classes]
+File0 = account.cls
+File1 = ledger.cls
+Count = 2
+
+[Forms]
+File0 = form1.frm
+Count = 1
+.endcode
+
 .h2 How Projects are Compiled
 
-When the project is compiled, all source files are concatenated into a single source stream. The IDE tracks which lines belong to which file so error messages and debugger locations point to the correct .bas or .frm file. The code section of each .frm file is preceded by a hidden BEGINFORM marker that ties its code to its form.
+When the project is compiled, all source files are concatenated into a single source stream: the modules first, then the class modules, then the forms. The IDE tracks which lines belong to which file so error messages and debugger locations point to the correct .bas, .cls or .frm file. The code section of each .frm file is preceded by a hidden BEGINFORM marker that ties its code to its form, and the code of each class module is likewise marked with its class name; a class module's header lines are not compiled.
 
 .h2 Compile-Time Validation
 
@@ -478,7 +500,7 @@ Before the source is handed to the compiler, the IDE scans every .frm file and c
 .item Menu items -- only Name (read), Checked and Enabled can be used on a menu item in code; Caption, Visible and RadioCheck are design-time settings.
 .endlist
 
-These checks use the same metadata the Properties panel and Toolbox read from each widget DXE, so property and method names always match the current widget set without any separate list to maintain.
+These checks use the same metadata the Properties panel and Toolbox read from each installed control, so property and method names always match the current widget set without any separate list to maintain.
 
 .h2 Project Operations
 
@@ -489,14 +511,39 @@ These checks use the same metadata the Properties panel and Toolbox read from ea
   Open Project          Opens a .dbp file and loads all referenced files into memory. A project file that is 64 KB or larger, or cannot be read, is not loaded; opening it later reports "Cannot load <file>: unreadable or larger than 65535 bytes." Carriage returns are removed when files are loaded.
   Save Project          Writes the .dbp file to disk.
   Close Project         Closes the project, prompting to save unsaved changes.
-  Add File              Adds a .bas or .frm file to the project. Opening a file without a project auto-creates an implicit project.
+  Add File              Adds a .bas, .frm or .cls file to the project. Opening a file without a project auto-creates an implicit project.
+  New Class Module      Adds a new class module to the project and opens it (see Class Modules below).
   Remove File           Removes a file from the project (prompts to save if modified). Removing the startup form clears the Startup Form setting.
   Project Properties    Opens a dialog for editing project metadata (name, author, company, version, copyright, description, icon, help file, startup form) and the Arguments for runs from the IDE.
 .endtable
 
 .h2 Project Explorer
 
-The Project Explorer is a tree view window listing all project files. Double-click a file to open it: .bas files open in Code view, .frm files open in Design view. The selected file in the Project Explorer determines the target for View > Code and View > Designer commands.
+The Project Explorer is a tree view window listing all project files, in three groups: Forms, Modules and Classes. Double-click a file to open it: .bas and .cls files open in Code view, .frm files open in Design view. The selected file in the Project Explorer determines the target for View > Code and View > Designer commands.
+
+.h2 Class Modules
+
+A class module (.cls file) defines a kind of object for your program: its member variables, properties and methods. The BASIC Language Reference describes how to write one (see Objects and Class Modules); this section covers working with them in the IDE.
+
+.list
+.item Create -- choose File > New Class Module. The IDE adds a new class module named Class1 (Class2, and so on, when that name is taken) to the Classes group, saved in the project's directory as Class1.cls, and opens it in the Code Editor. The new file holds only its header and Option Explicit; it is written to disk when you save it.
+.item Add an existing one -- choose File > Add File and pick a .cls file (the Class Modules file type). Class files from Visual Basic can be added as they are.
+.item Open -- double-click it in the Project Explorer's Classes group. It opens in Code view; a class module has no designer.
+.item Save -- File > Save File or Save All, as for any other file. The project file lists class modules in its [Classes] section.
+.item Remove -- select it in the Project Explorer and choose File > Remove File. The file itself stays on disk.
+.item Rename -- a class's name is the one in its Attribute VB_Name line, not the file name. To rename the class, edit that line (and the code that uses the old name) and save; the file keeps its name. A class module without an Attribute VB_Name line takes its name from the file name.
+.endlist
+
+A new class module starts with these header lines:
+
+.code
+VERSION DVX 1.00 CLASS
+Attribute VB_Name = "Class1"
+
+Option Explicit
+.endcode
+
+Leave the VERSION and Attribute lines at the top of the file; they are not compiled as code. Each class name must be different from the other class names and the form names in the project.
 
 .link ide.overview Back to Overview
 
@@ -689,16 +736,19 @@ Shows variables for the current execution scope. Displayed as a three-column Lis
   Column   Content
   ------   -------
   Name     Variable name (internal mangled names like static variable placeholders are filtered out).
-  Type     Data type: Integer, Long, Single, Double, String, Boolean, Array, UDT. Array types show the element type (e.g., Integer()).
+  Type     Data type: Integer, Long, Single, Double, String, Boolean, Date, Variant, Array, UDT, or the type of object. Array types show the element type (e.g., Integer()).
   Value    Current value. Strings are shown in quotes. Booleans as True/False. Arrays show bounds and element count (e.g., Integer(0 To 9) [10]). Uninitialized arrays show (uninitialized).
 .endtable
 
+Variants show the value they currently hold, or Empty or Null. Object variables show Nothing, or which object they refer to: the class name of a class instance, a Collection with its number of items, or the form or control.
+
 The Locals window displays:
 
 .list
 .item Local variables of the current procedure, including its STATIC variables and the module variables it names in a SHARED statement.
 .item Module-level variables. While execution is paused inside a SUB or FUNCTION, only the variables declared with DIM SHARED (or REDIM SHARED) are listed, because the procedure cannot see the others. This also applies inside a DEF FN function, although a DEF FN can read every module variable.
 .item Form-scoped variables for the current form (if the program is executing within a form context), with the same SHARED rule.
+.item Member variables of the object, while execution is paused in a procedure of a class module: the variables of the very object the procedure was called for (Me), Private ones included.
 .endlist
 
 The Watch window and the Immediate window follow the same rules. The window is resizable.
@@ -860,6 +910,7 @@ If the assignment target cannot be resolved (unknown variable, out-of-bounds ind
 .toc 1 Output Window
 .index Output Window
 .index PRINT Output
+.index Program Screen Window
 .index Runtime Errors
 .index Compile Errors
 
@@ -868,14 +919,18 @@ If the assignment target cannot be resolved (unknown variable, out-of-bounds ind
 The Output window is a read-only TextArea at the bottom-left of the screen. It displays:
 
 .list
-.item PRINT output -- all PRINT statement output from the running program is appended here.
+.item PRINT output -- PRINT statement output from the running program is appended here, until the program uses a console or graphics statement (CLS, LOCATE, COLOR, SCREEN, LINE, INKEY$ and the others): from then on PRINT and INPUT use the program's own screen window instead (see Console and Graphics in the language reference).
 .item Runtime errors -- if the VM encounters a runtime error (division by zero, out-of-bounds, etc.), the error message and line number are displayed in the output with an Error on line N: prefix.
 .item Compile errors -- if compilation fails, the error message and location are shown.
 .endlist
 
 The output buffer holds up to 32,768 characters; when it is full the oldest lines are dropped. The window always shows the newest output. Use Run > Clear Output to clear it.
 
-INPUT statements prompt the user via a modal InputBox dialog; the prompt text is also echoed to the Output window.
+INPUT statements prompt the user via a modal InputBox dialog; the prompt text is also echoed to the Output window.  A program that has its own screen window types its INPUT there instead.
+
+.h2 The Program's Screen Window
+
+A program that uses the console or graphics statements gets a window of its own, the size of its screen mode (80x25 text, or 640x480 or 320x200 graphics), titled with the project's name. Alt+Enter in that window (or FULLSCREEN in the program) shows it on the whole screen; Alt+Tab brings the desktop back and the program continues. Keys typed in the window go to the program (INKEY$ and INPUT). The window stays open after the program's code has finished, so its output can be read; closing it ends the program.
 
 .link ide.overview Back to Overview
 
@@ -961,7 +1016,7 @@ These fields set the default values for new project metadata:
 
 .h2 Colors Tab
 
-Customizes the syntax-highlighting colors used in the code editor. The left side is a list of seven color entries (Default Text, Keywords, Strings, Comments, Numbers, Operators, Types). Select an entry and adjust its red, green, and blue components using the three sliders on the right. The Preview swatch shows the current color. Changes are applied to the open editor when you click OK.
+Customizes the syntax-highlighting colors used in the code editor. The left side is a list of seven color entries (Default Text, Keywords, Strings, Comments, Numbers, Operators, Types). Select an entry to see its color, and its red, green and blue amounts, on the right. Click Change... (or double-click the entry) to pick a new color in the color box: click a basic color or mix one with the Red, Green and Blue sliders or number boxes, then click OK. Changes are applied to the open editor when you click OK in the Preferences dialog.
 
 .link ide.overview Back to Overview
 
@@ -1058,6 +1113,24 @@ DVX BASIC now uses the QBasic scope rules. A SUB or FUNCTION sees a variable dec
 .item SHARED naming a variable that does not exist at module level creates it there; in a form's code it becomes a variable of that form, not a program-wide one.
 .endlist
 
+.h2 Objects, Classes and Variants
+
+.list
+.item New: class modules (.cls files) define your own objects, with Public and Private member variables, Subs and Functions, Property Get / Let / Set, Class_Initialize and Class_Terminate, Me and a default member. Objects are made with NEW (DIM x AS NEW Account, SET x = NEW Account), compared with Is and tested with TypeOf ... Is. An object is freed, and its Class_Terminate run, as soon as nothing refers to it any more.
+.item New: the Collection object (Add, Remove, Item, Count, with optional text keys) and FOR EACH ... NEXT over Collections and arrays.
+.item New: the Variant type (DIM v AS VARIANT) with the special values Empty and Null, and the functions VARTYPE, TYPENAME, ISEMPTY, ISNULL, ISNUMERIC, ISOBJECT, ISARRAY and CVAR, with the vb... VarType constants and vbObjectError.
+.item New: PUBLIC and PRIVATE at module level (PUBLIC x is DIM SHARED x, PRIVATE x is DIM x).
+.item New error numbers: 94 Invalid use of Null, 424 Object required, 438 Object doesn't support this property or method, 450 Wrong number of arguments or invalid property assignment, 451 Object not a collection, 457 duplicate Collection key.
+.item Changed: CHOOSE with an index outside its list returns Null instead of raising error 5.
+.item Changed: a PARAMARRAY without an AS clause is an array of Variants (TYPENAME "Variant()").
+.item A form or control name can be used directly wherever an object is expected: SET c = Text1, either side of Is, TypeOf, and an argument for an object parameter.
+.item NEW, PROPERTY, PUBLIC, PRIVATE and TYPEOF are now reserved words: a variable, SUB or FUNCTION with one of these names must be renamed. VARIANT, OBJECT, COLLECTION, EMPTY, NULL and EACH are colored like keywords but are not reserved.
+.item IDE: File > New Class Module, .cls files in Add File, a Classes group in the Project Explorer and a [Classes] section in the project file. The debugger shows Variants, objects and the member variables of the object whose code is running.
+.endlist
+
+.link lang.classes See: Objects and Class Modules
+.link lang.variants See: Variants
+
 .h2 Sound, Joysticks and Frames
 
 .list

src/apps/kpunch/dvxbasic/runtime/basErrors.h

@@ -61,7 +61,13 @@
 #define BAS_ERR_PATH_FILE_ACCESS   75
 #define BAS_ERR_PATH_NOT_FOUND     76
 #define BAS_ERR_OBJECT_NOT_SET     91
+#define BAS_ERR_INVALID_NULL       94
+#define BAS_ERR_OBJECT_REQUIRED    424
+#define BAS_ERR_NO_MEMBER          438
+#define BAS_ERR_WRONG_ARGS         450
+#define BAS_ERR_NOT_COLLECTION     451
 #define BAS_ERR_EXTERNAL_NOT_FOUND 453
+#define BAS_ERR_DUPLICATE_KEY      457
 #define BAS_ERR_NO_FORM_RUNTIME    1000  // form/control statement with no form runtime attached (headless run)
 
 #endif

src/apps/kpunch/dvxbasic/runtime/dates.h

@@ -0,0 +1,148 @@
+// The MIT License (MIT)
+//
+// Copyright (C) 2026 Scott Duensing
+//
+// Permission is hereby granted, free of charge, to any person obtaining a copy
+// of this software and associated documentation files (the "Software"), to
+// deal in the Software without restriction, including without limitation the
+// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+// sell copies of the Software, and to permit persons to whom the Software is
+// furnished to do so, subject to the following conditions:
+//
+// The above copyright notice and this permission notice shall be included in
+// all copies or substantial portions of the Software.
+//
+// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+// IN THE SOFTWARE.
+
+// dates.h -- DVX BASIC date arithmetic, parsing and formatting
+//
+// A DATE is a Double serial in the VB format: the whole part counts days
+// from 12/30/1899 (day 0) and the fraction is the time of day.  Days
+// before the epoch are negative, and their time fraction still counts
+// forward from midnight: -1.25 is 12/29/1899 6:00 AM.  "Linear" values
+// below are the same instants on a continuous number line (-1.25 is
+// linear -0.75), which is what arithmetic on instants needs.
+//
+// The proleptic Gregorian calendar covers the whole range, 1/1/100
+// through 12/31/9999.  Month and day names are English.
+//
+// Embeddable: no DVX dependencies, pure C.
+
+#ifndef DVXBASIC_DATES_H
+#define DVXBASIC_DATES_H
+
+#include <stdbool.h>
+#include <stdint.h>
+
+// Days of the week (Weekday results and firstDayOfWeek arguments).
+#define BAS_DATE_USE_SYSTEM_DAY  0   // vbUseSystemDayOfWeek: Sunday here
+#define BAS_DATE_SUNDAY          1
+#define BAS_DATE_SATURDAY        7
+#define BAS_DATE_DAYS_PER_WEEK   7
+
+// firstWeekOfYear arguments of DatePart / DateDiff.
+#define BAS_DATE_USE_SYSTEM_WEEK 0   // vbUseSystem: same as vbFirstJan1
+#define BAS_DATE_FIRST_JAN1      1   // the week holding January 1
+#define BAS_DATE_FIRST_FOUR_DAYS 2   // the first week with four days in the new year
+#define BAS_DATE_FIRST_FULL_WEEK 3   // the first full week
+
+#define BAS_DATE_MONTHS_PER_YEAR 12
+
+// Longest text basDateFormat can need for one named or general form.
+#define BAS_DATE_TEXT_LEN        64
+
+// DateAdd / DateDiff / DatePart interval.
+typedef enum {
+    BAS_DATE_IV_YEAR,        // "yyyy"
+    BAS_DATE_IV_QUARTER,     // "q"
+    BAS_DATE_IV_MONTH,       // "m"
+    BAS_DATE_IV_DAY_OF_YEAR, // "y"
+    BAS_DATE_IV_DAY,         // "d"
+    BAS_DATE_IV_WEEKDAY,     // "w"
+    BAS_DATE_IV_WEEK,        // "ww"
+    BAS_DATE_IV_HOUR,        // "h"
+    BAS_DATE_IV_MINUTE,      // "n"
+    BAS_DATE_IV_SECOND       // "s"
+} BasDateIntervalE;
+
+// A serial broken into calendar fields (time rounded to the second).
+typedef struct {
+    int32_t year;
+    int32_t month;       // 1-12
+    int32_t day;         // 1-31
+    int32_t hour;        // 0-23
+    int32_t minute;
+    int32_t second;
+    int32_t weekday;     // 1 = Sunday ... 7 = Saturday
+    int32_t dayOfYear;   // 1-366
+    int64_t dayNumber;   // days from 12/30/1899
+    int32_t secOfDay;    // seconds since midnight
+} BasDatePartsT;
+
+// DateAdd: count intervals added to serial.  False when the result falls
+// outside the DATE range.
+bool basDateAdd(BasDateIntervalE interval, int32_t count, double serial, double *out);
+
+// DateDiff: interval boundaries crossed from one serial to another.
+int64_t basDateDiff(BasDateIntervalE interval, double from, double to, int32_t firstDayOfWeek);
+
+// Format serial with a Format$ pattern, a named format ("Long Date") or,
+// with fmt NULL or empty, the general form ("1/2/2000 3:04:05 PM"; the
+// date alone at midnight, the time alone on day 0).  Returns the length
+// written; the output is truncated to bufSize - 1 characters.
+int32_t basDateFormat(double serial, const char *fmt, char *buf, int32_t bufSize);
+
+// Serial of a linear instant.  False when it falls outside the DATE range.
+bool basDateFromLinear(double linear, double *outSerial);
+
+// True when fmt is a named date format or holds a date/time token (d, w,
+// m, q, y, h, n, s, c, ttttt, AM/PM) outside quotes -- Format$ then formats its
+// value as a date instead of a number.
+bool basDateIsPattern(const char *fmt);
+
+// True when serial is a number inside the DATE range.
+bool basDateIsValid(double serial);
+
+// English month name (month 1-12), NULL when out of range.
+const char *basDateMonthName(int32_t month, bool abbrev);
+
+// Parse date and/or time text: m/d/y, m-d-y, y-m-d, month names ("Jan 5,
+// 2000", "5 January 2000"), m/d alone (current year), h:mm[:ss] with an
+// optional AM/PM, "3 PM".  Two-digit years map to 1930-2029.  False when
+// the text is not a valid date.
+bool basDateParse(const char *text, double *outSerial);
+
+// Parse a DateAdd / DateDiff / DatePart interval string.
+bool basDateParseInterval(const char *text, BasDateIntervalE *out);
+
+// DatePart: one field of serial.
+int32_t basDatePart(BasDateIntervalE interval, double serial, int32_t firstDayOfWeek, int32_t firstWeekOfYear);
+
+// DateSerial: VB rules (years 0-29 are 2000-2029 and 30-99 are 1930-1999,
+// months and days outside their range roll into the neighbouring ones).
+// False when the result falls outside the DATE range.
+bool basDateSerial(int32_t year, int32_t month, int32_t day, double *outSerial);
+
+// Break serial into calendar fields.
+void basDateSplit(double serial, BasDatePartsT *out);
+
+// Linear instant of a serial.
+double basDateToLinear(double serial);
+
+// Weekday of serial counted from firstDayOfWeek (1 = that day).
+int32_t basDateWeekday(double serial, int32_t firstDayOfWeek);
+
+// English weekday name (1 = Sunday), NULL when out of range.
+const char *basDateWeekdayName(int32_t weekday, bool abbrev);
+
+// TimeSerial: hours, minutes and seconds (any of them may overflow or be
+// negative) as a serial.  False when the result falls outside the range.
+bool basTimeSerial(int32_t hour, int32_t minute, int32_t second, double *outSerial);
+
+#endif // DVXBASIC_DATES_H

src/apps/kpunch/dvxbasic/runtime/gfx.h

@@ -0,0 +1,153 @@
+// The MIT License (MIT)
+//
+// Copyright (C) 2026 Scott Duensing
+//
+// Permission is hereby granted, free of charge, to any person obtaining a copy
+// of this software and associated documentation files (the "Software"), to
+// deal in the Software without restriction, including without limitation the
+// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+// sell copies of the Software, and to permit persons to whom the Software is
+// furnished to do so, subject to the following conditions:
+//
+// The above copyright notice and this permission notice shall be included in
+// all copies or substantial portions of the Software.
+//
+// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+// IN THE SOFTWARE.
+
+// gfx.h -- DVX BASIC drawing primitives
+//
+// One implementation of the QBasic / VB drawing statements (PSET, LINE,
+// CIRCLE, PAINT, DRAW, POINT, VIEW, WINDOW) for every drawing surface: the
+// program screen's 8-bit framebuffer (screen.c) and the Form / PictureBox
+// canvases (the form runtime).  A surface is a span writer and a pixel
+// reader in its own pixel format plus colour conversion; the drawing state
+// (last point, colours, view, window, DRAW pen) lives in BasGfxT.
+//
+// The statement functions take the argument blocks the compiler builds
+// (opcodes.h: BAS_GFX_* flags and counts) and return 0 or a BASIC error
+// number.
+
+#ifndef DVXBASIC_GFX_H
+#define DVXBASIC_GFX_H
+
+#include "values.h"
+
+#include <stdint.h>
+#include <stdbool.h>
+
+// Text glyphs: 8 pixels wide, 16 rows (the DVX font) or 8 rows (every
+// pair of rows of the tall glyph merged).
+#define BAS_GFX_GLYPH_W      8
+#define BAS_GFX_GLYPH_TALL   16
+#define BAS_GFX_GLYPH_SHORT  8
+#define BAS_GFX_GLYPHS       256
+
+// FillStyle values (VB): solid, or transparent (the default).
+#define BAS_GFX_FILL_SOLID       0
+#define BAS_GFX_FILL_TRANSPARENT 1
+
+// DRAW's S (scale) is in quarter pixels; S4 is one pixel a unit.
+#define BAS_GFX_DRAW_SCALE_ONE   4
+
+// A drawing surface.  span and get take pixel coordinates the caller has
+// already clipped to the surface.
+typedef struct {
+    void     *ctx;
+    int32_t   width;
+    int32_t   height;
+    uint32_t  colorMax;                                                    // largest colour number it takes (0: any value, e.g. RGB)
+    void     (*span)(void *ctx, int32_t x0, int32_t x1, int32_t y, uint32_t pixel);
+    uint32_t (*get)(const void *ctx, int32_t x, int32_t y);
+    uint32_t (*toPixel)(void *ctx, uint32_t color);                        // NULL: colours are pixels
+    uint32_t (*toColor)(const void *ctx, uint32_t pixel);                  // NULL: pixels are colours
+} BasGfxSurfaceT;
+
+// Drawing state of one surface.
+typedef struct {
+    BasGfxSurfaceT surf;
+    int32_t        viewX0;         // VIEW rectangle (inclusive pixels); the whole surface without VIEW
+    int32_t        viewY0;
+    int32_t        viewX1;
+    int32_t        viewY1;
+    bool           viewAbsolute;   // VIEW SCREEN: coordinates are not moved to the view's corner
+    bool           world;          // WINDOW is on
+    bool           worldDown;      // WINDOW SCREEN: y grows downwards
+    double         worldX1;
+    double         worldY1;
+    double         worldX2;
+    double         worldY2;
+    double         lastX;          // last point referenced (logical coordinates; VB CurrentX / CurrentY)
+    double         lastY;
+    uint32_t       fore;           // default drawing colour
+    uint32_t       back;           // background colour (PRESET, Cls)
+    uint32_t       fillColor;      // VB FillColor / FillStyle for boxes and circles
+    int32_t        fillStyle;
+    int32_t        drawWidth;      // pen size in pixels (VB DrawWidth)
+    double         aspect;         // CIRCLE aspect when none is given
+    int32_t        drawScale;      // DRAW S (quarter pixels a unit)
+    int32_t        drawTurn;       // DRAW A / TA (degrees)
+    bool           drawColorSet;   // DRAW C was used (else DRAW draws in fore)
+    uint32_t       drawColor;
+} BasGfxT;
+
+// CIRCLE block (BAS_GFX_CIRCLE_ARGS values).
+int32_t basGfxCircle(BasGfxT *g, const BasValueT *args);
+
+// Fill the view with color (CLS, Cls).
+int32_t basGfxClear(BasGfxT *g, BasValueT color);
+
+// A colour value checked against the surface's colour range.
+int32_t basGfxColorArg(const BasGfxT *g, BasValueT v, uint32_t *out);
+
+// DRAW macro language.
+int32_t basGfxDraw(BasGfxT *g, const char *macro, int32_t len);
+
+// One text glyph with its top-left corner at pixel (x, y), rows tall
+// (BAS_GFX_GLYPH_TALL or _SHORT), clipped to the surface (not the view).
+// opaque paints the background pixels too.  Without a font (basGfxSetFont)
+// only the background is drawn.
+void basGfxGlyph(BasGfxT *g, int32_t x, int32_t y, uint8_t ch, int32_t rows, uint32_t forePixel, uint32_t backPixel, bool opaque);
+
+// The last point goes to the centre of the view (QBasic after SCREEN,
+// VIEW, WINDOW and CLS).
+void basGfxHome(BasGfxT *g);
+
+// Start a surface's drawing state: whole-surface view, no WINDOW, last
+// point in the centre, pen 1 pixel, transparent fill.
+void basGfxInit(BasGfxT *g, const BasGfxSurfaceT *surf, uint32_t fore, uint32_t back, double aspect);
+
+// LINE block (BAS_GFX_LINE_ARGS values).
+int32_t basGfxLine(BasGfxT *g, const BasValueT *args);
+
+// PAINT block (BAS_GFX_PAINT_ARGS values).
+int32_t basGfxPaint(BasGfxT *g, const BasValueT *args);
+
+// The pixel colour of a surface colour value (the surface's toPixel).
+uint32_t basGfxPixel(const BasGfxT *g, uint32_t color);
+
+// POINT(x, y): the colour at a point, -1 outside the view.
+int32_t basGfxPoint(BasGfxT *g, BasValueT x, BasValueT y, BasValueT *out);
+
+// POINT(n): 0/1 the last point in view pixels, 2/3 in logical units.
+int32_t basGfxPointLast(const BasGfxT *g, BasValueT n, BasValueT *out);
+
+// PSET / PRESET block (BAS_GFX_PSET_ARGS values).
+int32_t basGfxPset(BasGfxT *g, const BasValueT *args);
+
+// The 8x16 glyph table (256 x 16 bytes, MSB = left pixel) text uses;
+// NULL draws backgrounds only.  Shared by every surface.
+void basGfxSetFont(const uint8_t *tallGlyphs);
+
+// VIEW block (BAS_VIEW_ARGS values).
+int32_t basGfxSetView(BasGfxT *g, const BasValueT *args);
+
+// WINDOW block (BAS_WINDOW_ARGS values).
+int32_t basGfxSetWindow(BasGfxT *g, const BasValueT *args);
+
+#endif // DVXBASIC_GFX_H

src/apps/kpunch/dvxbasic/runtime/screen.c

@@ -0,0 +1,996 @@
+// The MIT License (MIT)
+//
+// Copyright (C) 2026 Scott Duensing
+//
+// Permission is hereby granted, free of charge, to any person obtaining a copy
+// of this software and associated documentation files (the "Software"), to
+// deal in the Software without restriction, including without limitation the
+// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+// sell copies of the Software, and to permit persons to whom the Software is
+// furnished to do so, subject to the following conditions:
+//
+// The above copyright notice and this permission notice shall be included in
+// all copies or substantial portions of the Software.
+//
+// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+// IN THE SOFTWARE.
+
+// screen.c -- DVX BASIC program screen (see screen.h)
+
+#include "screen.h"
+#include "basErrors.h"
+#include "../compiler/opcodes.h"
+
+#include <stdlib.h>
+#include <string.h>
+
+// Mode geometry
+#define SCR_WIDE_W            640     // SCREEN 0 and 12 width
+#define SCR_WIDE_COLS         80
+#define SCR_TEXT_ROWS         25      // SCREEN 0 (8x16 glyphs); WIDTH 80, 50 uses 8x8
+#define SCR_TEXT_ROWS_SHORT   50
+#define SCR_VGA16_H           480
+#define SCR_VGA16_ROWS        30      // SCREEN 12 (8x16 glyphs); WIDTH 80, 60 uses 8x8
+#define SCR_VGA16_ROWS_SHORT  60
+#define SCR_VGA256_W          320
+#define SCR_VGA256_H          200
+#define SCR_VGA256_COLS       40
+#define SCR_VGA256_ROWS       25
+
+// Colours
+#define SCR_EGA_COLORS        16      // SCREEN 0 and 12 colours
+#define SCR_TEXT_FORE_MAX     31      // COLOR foreground in SCREEN 0 (16..31 blink in QBasic; shown steady)
+#define SCR_NIBBLE            0x0F
+#define SCR_BACK_SHIFT        4
+#define SCR_TEXT_FORE         7       // default COLOR in SCREEN 0
+#define SCR_GFX_FORE          15      // default COLOR in SCREEN 12 and 13
+#define SCR_DAC_MAX           63      // 6-bit VGA DAC component
+#define SCR_DAC_HIGH_SHIFT    2       // 6-bit -> 8-bit: v << 2 | v >> 4
+#define SCR_DAC_LOW_SHIFT     4
+#define SCR_VGA_GREEN_SHIFT   8       // PALETTE colour: blue * 65536 + green * 256 + red
+#define SCR_VGA_BLUE_SHIFT    16
+#define SCR_BYTE_MASK         0xFF
+#define SCR_EGA_COLOR_MAX     63      // PALETTE colour in SCREEN 0: an EGA colour number rgbRGB
+#define SCR_EGA_PRIMARY       42      // 6-bit level of the EGA primary bits
+#define SCR_EGA_SECONDARY     21      // 6-bit level of the EGA secondary bits
+#define SCR_EGA_BLUE          0x01
+#define SCR_EGA_GREEN         0x02
+#define SCR_EGA_RED           0x04
+#define SCR_EGA_BLUE_LOW      0x08
+#define SCR_EGA_GREEN_LOW     0x10
+#define SCR_EGA_RED_LOW       0x20
+#define SCR_PALETTE_KEEP      (-1)    // PALETTE USING: leave this attribute alone
+
+// The VGA default palette after the 16 EGA colours: 16 greys, then three
+// intensities x three saturations x 24 hues, then black.
+#define SCR_GREY_FIRST        16
+#define SCR_RAMP_FIRST        32
+#define SCR_RAMP_GROUPS       3
+#define SCR_RAMP_STEPS        5
+#define SCR_HUES              24
+
+// A screen is 4:3, so CIRCLE's default aspect is 4/3 * height / width.
+#define SCR_ASPECT_W          4.0
+#define SCR_ASPECT_H          3.0
+
+// Characters PRINT and INPUT treat specially
+#define SCR_CHAR_BELL         7
+#define SCR_CHAR_BACKSPACE    8
+#define SCR_CHAR_TAB          9
+#define SCR_CHAR_LF           10
+#define SCR_CHAR_CR           13
+#define SCR_CHAR_ESC          27
+#define SCR_CHAR_SPACE        ' '
+#define SCR_TAB_STOP          8
+#define SCR_CURSOR_ROWS       2       // the text cursor: the cell's bottom rows
+
+// CLS arguments
+#define SCR_CLS_OMITTED       (-1)
+#define SCR_CLS_ALL           0
+#define SCR_CLS_GRAPHICS      1
+#define SCR_CLS_TEXT          2
+
+// 6-bit EGA colours 0..15
+static const uint8_t sEgaPalette[SCR_EGA_COLORS][BAS_SCREEN_PAL_CHANNELS] = {
+    {  0,  0,  0 }, {  0,  0, 42 }, {  0, 42,  0 }, {  0, 42, 42 },
+    { 42,  0,  0 }, { 42,  0, 42 }, { 42, 21,  0 }, { 42, 42, 42 },
+    { 21, 21, 21 }, { 21, 21, 63 }, { 21, 63, 21 }, { 21, 63, 63 },
+    { 63, 21, 21 }, { 63, 21, 63 }, { 63, 63, 21 }, { 63, 63, 63 }
+};
+
+// 6-bit grey ramp, VGA entries 16..31
+static const uint8_t sGreyRamp[SCR_EGA_COLORS] = {
+    0, 5, 8, 11, 14, 17, 20, 24, 28, 32, 36, 40, 45, 50, 56, 63
+};
+
+// 6-bit levels of the hue ramps: [intensity][saturation][step]
+static const uint8_t sRampLevels[SCR_RAMP_GROUPS][SCR_RAMP_GROUPS][SCR_RAMP_STEPS] = {
+    { {  0, 16, 31, 47, 63 }, { 31, 39, 47, 55, 63 }, { 45, 49, 54, 58, 63 } },
+    { {  0,  7, 14, 21, 28 }, { 14, 17, 21, 24, 28 }, { 20, 22, 24, 26, 28 } },
+    { {  0,  4,  8, 12, 16 }, {  8, 10, 12, 14, 16 }, { 11, 12, 13, 15, 16 } }
+};
+
+// Step index of R, G and B round the hue ring: blue, magenta, red, yellow,
+// green, cyan and back towards blue.
+static const uint8_t sHueRing[SCR_HUES][BAS_SCREEN_PAL_CHANNELS] = {
+    { 0, 0, 4 }, { 1, 0, 4 }, { 2, 0, 4 }, { 3, 0, 4 }, { 4, 0, 4 }, { 4, 0, 3 }, { 4, 0, 2 }, { 4, 0, 1 },
+    { 4, 0, 0 }, { 4, 1, 0 }, { 4, 2, 0 }, { 4, 3, 0 }, { 4, 4, 0 }, { 3, 4, 0 }, { 2, 4, 0 }, { 1, 4, 0 },
+    { 0, 4, 0 }, { 0, 4, 1 }, { 0, 4, 2 }, { 0, 4, 3 }, { 0, 4, 4 }, { 0, 3, 4 }, { 0, 2, 4 }, { 0, 1, 4 }
+};
+
+// ============================================================
+// Prototypes
+// ============================================================
+
+static uint8_t     cellAttr(const BasScreenT *scr);
+static void        cellRender(BasScreenT *scr, int32_t r, int32_t c);
+static void        clearAll(BasScreenT *scr);
+static int32_t     cursorCol(const BasScreenT *scr);
+static void        cursorHide(BasScreenT *scr);
+static void        cursorShow(BasScreenT *scr);
+static int32_t     execCls(BasScreenT *scr, BasValueT n);
+static int32_t     execColor(BasScreenT *scr, const BasValueT *args);
+static int32_t     execLineInput(BasVmT *vm, BasValueT prompt, BasValueT *result);
+static int32_t     execLocate(BasScreenT *scr, const BasValueT *args);
+static int32_t     execPalette(BasScreenT *scr, const BasValueT *args);
+static int32_t     execPaletteUsing(BasScreenT *scr, const BasValueT *args);
+static int32_t     execScreenFn(const BasScreenT *scr, const BasValueT *args, int32_t argc, BasValueT *result);
+static int32_t     execSetMode(BasVmT *vm, BasScreenT *scr, int32_t mode, int32_t rows);
+static int32_t     execWidth(BasVmT *vm, BasScreenT *scr, const BasValueT *args);
+static uint8_t     expandDac(uint8_t v);
+static void        markDirty(BasScreenT *scr, int32_t x0, int32_t y0, int32_t x1, int32_t y1);
+static void        newLine(BasScreenT *scr);
+static int32_t     paletteColors(const BasScreenT *scr);
+static void        paletteDefault(BasScreenT *scr);
+static int32_t     paletteSet(BasScreenT *scr, int32_t attr, int32_t color);
+static int32_t     popKey(BasScreenT *scr);
+static void        putChar(BasScreenT *scr, uint8_t ch);
+static int32_t     rowsDefault(int32_t mode);
+static BasScreenT *screenEnsure(BasVmT *vm);
+static void        scrollUp(BasScreenT *scr);
+static int32_t     setMode(BasScreenT *scr, int32_t mode, int32_t rows);
+static uint32_t    surfGet(const void *ctx, int32_t x, int32_t y);
+static void        surfSpan(void *ctx, int32_t x0, int32_t x1, int32_t y, uint32_t pixel);
+static uint8_t     textBackPixel(const BasScreenT *scr);
+
+
+void basScreenClean(BasScreenT *scr) {
+    scr->dirty          = false;
+    scr->paletteChanged = false;
+}
+
+
+int32_t basScreenColumn(const BasScreenT *scr) {
+    return scr->col;
+}
+
+
+void basScreenDestroy(BasScreenT *scr) {
+    if (!scr) {
+        return;
+    }
+
+    free(scr->fb);
+    free(scr->chars);
+    free(scr->attrs);
+    free(scr);
+}
+
+
+int32_t basScreenExec(BasVmT *vm, uint8_t fn, BasValueT *args, int32_t argc, BasValueT *result) {
+    *result = basValInteger(0);
+
+    // LINE INPUT and POS work without a screen (the host's input and
+    // output); everything else makes one.
+    if (fn == BAS_FN_LINE_INPUT) {
+        return execLineInput(vm, args[0], result);
+    }
+
+    if (fn == BAS_FN_POS && !vm->screen) {
+        *result = basValInteger((int16_t)(vm->printColumn + 1));
+        return 0;
+    }
+
+    BasScreenT *scr = screenEnsure(vm);
+
+    if (!scr) {
+        return BAS_ERR_OUT_OF_MEMORY;
+    }
+
+    bool graphics = scr->mode != BAS_SCREEN_MODE_TEXT;
+
+    switch (fn) {
+        case BAS_FN_CLS:
+            return execCls(scr, args[0]);
+
+        case BAS_FN_LOCATE:
+            return execLocate(scr, args);
+
+        case BAS_FN_COLOR:
+            return execColor(scr, args);
+
+        case BAS_FN_SCREEN: {
+            int32_t mode = basValToInt32(args[0]);
+
+            return execSetMode(vm, scr, mode, rowsDefault(mode));
+        }
+
+        case BAS_FN_WIDTH:
+            return execWidth(vm, scr, args);
+
+        case BAS_FN_PALETTE:
+            return execPalette(scr, args);
+
+        case BAS_FN_PALETTE_USING:
+            return execPaletteUsing(scr, args);
+
+        case BAS_FN_FULLSCREEN: {
+            bool on = basValIsTruthy(args[0]);
+
+            if (vm->screenHost.fullScreen) {
+                vm->screenHost.fullScreen(vm->screenHost.ctx, scr, on);
+            } else {
+                scr->fullScreen = on;
+            }
+
+            return 0;
+        }
+
+        case BAS_FN_INKEY: {
+            char    key[2];
+            int32_t len  = 0;
+            int32_t code = popKey(scr);
+
+            if (code >= BAS_SCREEN_KEY_EXT) {
+                key[len++] = 0;
+                key[len++] = (char)(code & SCR_BYTE_MASK);
+            } else if (code >= 0) {
+                key[len++] = (char)code;
+            }
+
+            BasStringT *text = basStringNew(key, len);
+
+            *result = basValString(text);
+            basStringUnref(text);
+            return 0;
+        }
+
+        case BAS_FN_CSRLIN:
+            *result = basValInteger((int16_t)(scr->row + 1));
+            return 0;
+
+        case BAS_FN_POS:
+            *result = basValInteger((int16_t)(cursorCol(scr) + 1));
+            return 0;
+
+        case BAS_FN_SCREENFN:
+            return execScreenFn(scr, args, argc, result);
+
+        default:
+            break;
+    }
+
+    // Graphics statements and POINT: not in the text mode (QBasic's
+    // Illegal function call).
+    if (!graphics) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    switch (fn) {
+        case BAS_FN_PSET:
+            return basGfxPset(&scr->gfx, args);
+
+        case BAS_FN_LINE:
+            return basGfxLine(&scr->gfx, args);
+
+        case BAS_FN_CIRCLE:
+            return basGfxCircle(&scr->gfx, args);
+
+        case BAS_FN_PAINT:
+            return basGfxPaint(&scr->gfx, args);
+
+        case BAS_FN_DRAW: {
+            if (args[0].type != BAS_TYPE_STRING) {
+                return BAS_ERR_TYPE_MISMATCH;
+            }
+
+            return basGfxDraw(&scr->gfx, args[0].strVal->data, args[0].strVal->len);
+        }
+
+        case BAS_FN_VIEW:
+            return basGfxSetView(&scr->gfx, args);
+
+        case BAS_FN_WINDOW:
+            return basGfxSetWindow(&scr->gfx, args);
+
+        case BAS_FN_POINT:
+            return argc == 1 ? basGfxPointLast(&scr->gfx, args[0], result) : basGfxPoint(&scr->gfx, args[0], args[1], result);
+
+        default:
+            return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+}
+
+
+bool basScreenInput(BasVmT *vm, const char *prompt, char *buf, int32_t bufSize) {
+    BasScreenT *scr = vm->screen;
+    int32_t     len = 0;
+    bool        ok  = true;
+
+    basScreenPrint(scr, prompt, false);
+    scr->inputActive = true;
+    cursorShow(scr);
+
+    for (;;) {
+        if (scr->keyCount == 0) {
+            // Without an event pump no key can come: the line ends here.
+            if (!vm->doEventsFn) {
+                break;
+            }
+
+            if (!basVmDoEvents(vm)) {
+                ok = false;
+                break;
+            }
+
+            continue;
+        }
+
+        int32_t key = popKey(scr);
+
+        if (key == SCR_CHAR_CR) {
+            break;
+        }
+
+        cursorHide(scr);
+
+        // Backspace takes one character back, Esc the whole line.
+        int32_t erase = key == SCR_CHAR_BACKSPACE ? 1 : (key == SCR_CHAR_ESC ? len : 0);
+
+        for (int32_t i = 0; i < erase && len > 0; i++) {
+            len--;
+
+            if (scr->col > 0) {
+                scr->col--;
+            } else if (scr->row > 0) {
+                scr->row--;
+                scr->col = scr->cols - 1;
+            }
+
+            scr->chars[scr->row * scr->cols + scr->col] = SCR_CHAR_SPACE;
+            cellRender(scr, scr->row, scr->col);
+        }
+
+        if (key >= SCR_CHAR_SPACE && key < BAS_SCREEN_KEY_EXT && len < bufSize - 1) {
+            buf[len++] = (char)key;
+            putChar(scr, (uint8_t)key);
+        }
+
+        cursorShow(scr);
+    }
+
+    buf[len] = '\0';
+    cursorHide(scr);
+    scr->inputActive = false;
+    newLine(scr);
+    cursorShow(scr);
+    return ok;
+}
+
+
+void basScreenInvalidate(BasScreenT *scr) {
+    markDirty(scr, 0, 0, scr->width - 1, scr->height - 1);
+    scr->paletteChanged = true;
+}
+
+
+void basScreenPresent(BasVmT *vm) {
+    BasScreenT *scr = vm->screen;
+
+    if (scr && (scr->dirty || scr->paletteChanged) && vm->screenHost.present) {
+        vm->screenHost.present(vm->screenHost.ctx, scr);
+    }
+}
+
+
+void basScreenPrint(BasScreenT *scr, const char *text, bool newline) {
+    cursorHide(scr);
+
+    for (const uint8_t *c = (const uint8_t *)text; *c; c++) {
+        switch (*c) {
+            case SCR_CHAR_CR:
+            case SCR_CHAR_LF:
+                newLine(scr);
+                break;
+
+            case SCR_CHAR_TAB:
+                do {
+                    putChar(scr, SCR_CHAR_SPACE);
+                } while (scr->col % SCR_TAB_STOP != 0 && scr->col < scr->cols);
+
+                break;
+
+            case SCR_CHAR_BELL:
+                break;
+
+            default:
+                putChar(scr, *c);
+                break;
+        }
+    }
+
+    if (newline) {
+        newLine(scr);
+    }
+
+    cursorShow(scr);
+}
+
+
+void basScreenPushKey(BasScreenT *scr, int32_t code) {
+    if (scr->keyCount >= BAS_SCREEN_KEY_QUEUE) {
+        return;
+    }
+
+    scr->keys[(scr->keyHead + scr->keyCount) % BAS_SCREEN_KEY_QUEUE] = code;
+    scr->keyCount++;
+}
+
+
+// The attribute new text gets: SCREEN 0 fore | back << 4, else fore.
+static uint8_t cellAttr(const BasScreenT *scr) {
+    if (scr->mode == BAS_SCREEN_MODE_TEXT) {
+        return (uint8_t)((scr->fore & SCR_NIBBLE) | ((scr->back & SCR_NIBBLE) << SCR_BACK_SHIFT));
+    }
+
+    return scr->fore;
+}
+
+
+// Draw one text cell (and the cursor when it is there).
+static void cellRender(BasScreenT *scr, int32_t r, int32_t c) {
+    int32_t i    = r * scr->cols + c;
+    uint8_t attr = scr->attrs[i];
+    uint8_t fore = attr;
+    uint8_t back = 0;
+    int32_t x    = c * BAS_GFX_GLYPH_W;
+    int32_t y    = r * scr->cellH;
+
+    if (scr->mode == BAS_SCREEN_MODE_TEXT) {
+        fore = attr & SCR_NIBBLE;
+        back = attr >> SCR_BACK_SHIFT;
+    }
+
+    basGfxGlyph(&scr->gfx, x, y, scr->chars[i], scr->cellH, fore, back, true);
+
+    if (scr->cursorDrawn && r == scr->row && c == cursorCol(scr)) {
+        for (int32_t k = scr->cellH - SCR_CURSOR_ROWS; k < scr->cellH; k++) {
+            surfSpan(scr, x, x + BAS_GFX_GLYPH_W - 1, y + k, fore);
+        }
+    }
+}
+
+
+// Blank screen, text home.
+static void clearAll(BasScreenT *scr) {
+    memset(scr->fb, textBackPixel(scr), (size_t)scr->width * (size_t)scr->height);
+    memset(scr->chars, SCR_CHAR_SPACE, (size_t)(scr->rows * scr->cols));
+    memset(scr->attrs, cellAttr(scr), (size_t)(scr->rows * scr->cols));
+    scr->row = 0;
+    scr->col = 0;
+    markDirty(scr, 0, 0, scr->width - 1, scr->height - 1);
+}
+
+
+// The cell the cursor is in (a pending wrap stays in the last column).
+static int32_t cursorCol(const BasScreenT *scr) {
+    return scr->col < scr->cols ? scr->col : scr->cols - 1;
+}
+
+
+static void cursorHide(BasScreenT *scr) {
+    if (!scr->cursorDrawn) {
+        return;
+    }
+
+    scr->cursorDrawn = false;
+    cellRender(scr, scr->row, cursorCol(scr));
+}
+
+
+// The cursor shows in SCREEN 0 after LOCATE ,,1, and in every mode while
+// INPUT waits.
+static void cursorShow(BasScreenT *scr) {
+    scr->cursorDrawn = scr->inputActive || (scr->cursorVisible && scr->mode == BAS_SCREEN_MODE_TEXT);
+
+    if (scr->cursorDrawn) {
+        cellRender(scr, scr->row, cursorCol(scr));
+    }
+}
+
+
+// CLS: everything (and the text cursor home), or with n = 1 (or omitted
+// under a VIEW) the graphics view only.
+static int32_t execCls(BasScreenT *scr, BasValueT n) {
+    int32_t what     = basValToInt32(n);
+    bool    viewSet  = scr->gfx.viewX0 > 0 || scr->gfx.viewY0 > 0 || scr->gfx.viewX1 < scr->width - 1 || scr->gfx.viewY1 < scr->height - 1;
+    bool    graphics = scr->mode != BAS_SCREEN_MODE_TEXT;
+
+    if (what < SCR_CLS_OMITTED || what > SCR_CLS_TEXT) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    if (graphics && (what == SCR_CLS_GRAPHICS || (what == SCR_CLS_OMITTED && viewSet))) {
+        basGfxClear(&scr->gfx, basValInteger(0));
+        basGfxHome(&scr->gfx);
+        return 0;
+    }
+
+    cursorHide(scr);
+    clearAll(scr);
+    basGfxHome(&scr->gfx);
+    cursorShow(scr);
+    return 0;
+}
+
+
+// COLOR fore, back: SCREEN 0 takes both (fore 0..31, back 0..15); the
+// graphics modes only a foreground in their colour range.
+static int32_t execColor(BasScreenT *scr, const BasValueT *args) {
+    int32_t given = basValToInt32(args[2]);
+    int32_t fore  = basValToInt32(args[0]);
+    int32_t back  = basValToInt32(args[1]);
+    bool    text  = scr->mode == BAS_SCREEN_MODE_TEXT;
+    int32_t max   = text ? SCR_TEXT_FORE_MAX : (int32_t)scr->gfx.surf.colorMax;
+
+    if ((given & BAS_GIVEN_1) && (fore < 0 || fore > max)) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    if ((given & BAS_GIVEN_2) && (!text || back < 0 || back > SCR_NIBBLE)) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    if (given & BAS_GIVEN_1) {
+        scr->fore     = (uint8_t)fore;
+        scr->gfx.fore = (uint32_t)fore;
+    }
+
+    if (given & BAS_GIVEN_2) {
+        scr->back = (uint8_t)back;
+    }
+
+    return 0;
+}
+
+
+// LINE INPUT: the whole line as typed, on the screen when the program has
+// one, else through the host's input (no "? " added).
+static int32_t execLineInput(BasVmT *vm, BasValueT prompt, BasValueT *result) {
+    char        buf[BAS_INPUT_LINE_LEN];
+    BasValueT   text = basValToString(prompt);
+    const char *p    = text.strVal->data;
+    bool        ok   = false;
+
+    buf[0] = '\0';
+
+    if (vm->screen) {
+        ok = basScreenInput(vm, p, buf, sizeof(buf));
+    } else if (vm->inputFn) {
+        ok = vm->inputFn(vm->inputCtx, p, buf, sizeof(buf));
+    }
+
+    basValRelease(&text);
+    *result = basValStringFromC(ok ? buf : "");
+    return 0;
+}
+
+
+static int32_t execLocate(BasScreenT *scr, const BasValueT *args) {
+    int32_t given  = basValToInt32(args[3]);
+    int32_t row    = basValToInt32(args[0]);
+    int32_t col    = basValToInt32(args[1]);
+    int32_t cursor = basValToInt32(args[2]);
+
+    if (((given & BAS_GIVEN_1) && (row < 1 || row > scr->rows)) || ((given & BAS_GIVEN_2) && (col < 1 || col > scr->cols)) || ((given & BAS_GIVEN_3) && (cursor < 0 || cursor > 1))) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    cursorHide(scr);
+
+    if (given & BAS_GIVEN_1) {
+        scr->row = row - 1;
+    }
+
+    if (given & BAS_GIVEN_2) {
+        scr->col = col - 1;
+    }
+
+    if (given & BAS_GIVEN_3) {
+        scr->cursorVisible = cursor != 0;
+    }
+
+    cursorShow(scr);
+    return 0;
+}
+
+
+// PALETTE attr, color / PALETTE (every attribute back to the default).
+static int32_t execPalette(BasScreenT *scr, const BasValueT *args) {
+    if (!(basValToInt32(args[2]) & BAS_GIVEN_1)) {
+        paletteDefault(scr);
+        return 0;
+    }
+
+    return paletteSet(scr, basValToInt32(args[0]), basValToInt32(args[1]));
+}
+
+
+// PALETTE USING array(first): one colour per attribute from the array
+// (-1 keeps that attribute); the array must reach the last attribute.
+static int32_t execPaletteUsing(BasScreenT *scr, const BasValueT *args) {
+    if (args[0].type != BAS_TYPE_ARRAY || !args[0].arrVal) {
+        return BAS_ERR_TYPE_MISMATCH;
+    }
+
+    const BasArrayT *arr   = args[0].arrVal;
+    int32_t          first = (basValToInt32(args[2]) & BAS_GIVEN_2) ? basValToInt32(args[1]) : arr->lbound[0];
+    int32_t          start = first - arr->lbound[0];
+    int32_t          count = paletteColors(scr);
+
+    if (arr->dims != 1 || start < 0 || start + count > arr->totalElements) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    for (int32_t attr = 0; attr < count; attr++) {
+        int32_t color = basValToInt32(arr->elements[start + attr]);
+
+        if (color == SCR_PALETTE_KEEP) {
+            continue;
+        }
+
+        int32_t err = paletteSet(scr, attr, color);
+
+        if (err != 0) {
+            return err;
+        }
+    }
+
+    return 0;
+}
+
+
+// SCREEN(row, col [, colorflag]): the character there, or its colour.
+static int32_t execScreenFn(const BasScreenT *scr, const BasValueT *args, int32_t argc, BasValueT *result) {
+    int32_t row = basValToInt32(args[0]);
+    int32_t col = basValToInt32(args[1]);
+
+    if (row < 1 || row > scr->rows || col < 1 || col > scr->cols) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    int32_t i = (row - 1) * scr->cols + (col - 1);
+
+    *result = basValInteger(argc > 2 && basValIsTruthy(args[2]) ? scr->attrs[i] : scr->chars[i]);
+    return 0;
+}
+
+
+// SCREEN mode / WIDTH: a new mode (cleared), shown by the host.
+static int32_t execSetMode(BasVmT *vm, BasScreenT *scr, int32_t mode, int32_t rows) {
+    int32_t err = setMode(scr, mode, rows);
+
+    if (err == 0 && vm->screenHost.modeChanged) {
+        vm->screenHost.modeChanged(vm->screenHost.ctx, scr);
+    }
+
+    return err;
+}
+
+
+// WIDTH cols, rows: 80 columns in SCREEN 0 (25 or 50 rows) and SCREEN 12
+// (30 or 60 rows); SCREEN 13 has only 40x25.
+static int32_t execWidth(BasVmT *vm, BasScreenT *scr, const BasValueT *args) {
+    int32_t given = basValToInt32(args[2]);
+    int32_t cols  = (given & BAS_GIVEN_1) ? basValToInt32(args[0]) : scr->cols;
+    int32_t rows  = (given & BAS_GIVEN_2) ? basValToInt32(args[1]) : scr->rows;
+    bool    ok    = false;
+
+    switch (scr->mode) {
+        case BAS_SCREEN_MODE_TEXT:
+            ok = cols == SCR_WIDE_COLS && (rows == SCR_TEXT_ROWS || rows == SCR_TEXT_ROWS_SHORT);
+            break;
+
+        case BAS_SCREEN_MODE_VGA16:
+            ok = cols == SCR_WIDE_COLS && (rows == SCR_VGA16_ROWS || rows == SCR_VGA16_ROWS_SHORT);
+            break;
+
+        default:
+            ok = cols == SCR_VGA256_COLS && rows == SCR_VGA256_ROWS;
+            break;
+    }
+
+    if (!ok) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    return rows == scr->rows ? 0 : execSetMode(vm, scr, scr->mode, rows);
+}
+
+
+// 6-bit DAC level -> 8 bits.
+static uint8_t expandDac(uint8_t v) {
+    return (uint8_t)((v << SCR_DAC_HIGH_SHIFT) | (v >> SCR_DAC_LOW_SHIFT));
+}
+
+
+static void markDirty(BasScreenT *scr, int32_t x0, int32_t y0, int32_t x1, int32_t y1) {
+    if (!scr->dirty) {
+        scr->dirty   = true;
+        scr->dirtyX0 = x0;
+        scr->dirtyY0 = y0;
+        scr->dirtyX1 = x1;
+        scr->dirtyY1 = y1;
+        return;
+    }
+
+    scr->dirtyX0 = x0 < scr->dirtyX0 ? x0 : scr->dirtyX0;
+    scr->dirtyY0 = y0 < scr->dirtyY0 ? y0 : scr->dirtyY0;
+    scr->dirtyX1 = x1 > scr->dirtyX1 ? x1 : scr->dirtyX1;
+    scr->dirtyY1 = y1 > scr->dirtyY1 ? y1 : scr->dirtyY1;
+}
+
+
+// Next line, scrolling at the bottom.
+static void newLine(BasScreenT *scr) {
+    scr->col = 0;
+
+    if (scr->row < scr->rows - 1) {
+        scr->row++;
+    } else {
+        scrollUp(scr);
+    }
+}
+
+
+// Attributes PALETTE can change: 256 in SCREEN 13, else 16.
+static int32_t paletteColors(const BasScreenT *scr) {
+    return scr->mode == BAS_SCREEN_MODE_VGA256 ? BAS_SCREEN_PAL_ENTRIES : SCR_EGA_COLORS;
+}
+
+
+// The mode's default palette: the 16 EGA colours, and in SCREEN 13 the
+// rest of the VGA default palette.
+static void paletteDefault(BasScreenT *scr) {
+    uint8_t *pal = scr->palette;
+
+    memset(pal, 0, sizeof(scr->palette));
+
+    for (int32_t i = 0; i < SCR_EGA_COLORS; i++) {
+        for (int32_t ch = 0; ch < BAS_SCREEN_PAL_CHANNELS; ch++) {
+            pal[i * BAS_SCREEN_PAL_CHANNELS + ch] = expandDac(sEgaPalette[i][ch]);
+        }
+    }
+
+    if (scr->mode == BAS_SCREEN_MODE_VGA256) {
+        for (int32_t i = 0; i < SCR_EGA_COLORS; i++) {
+            memset(&pal[(SCR_GREY_FIRST + i) * BAS_SCREEN_PAL_CHANNELS], expandDac(sGreyRamp[i]), BAS_SCREEN_PAL_CHANNELS);
+        }
+
+        int32_t entry = SCR_RAMP_FIRST;
+
+        for (int32_t level = 0; level < SCR_RAMP_GROUPS; level++) {
+            for (int32_t sat = 0; sat < SCR_RAMP_GROUPS; sat++) {
+                for (int32_t hue = 0; hue < SCR_HUES; hue++) {
+                    for (int32_t ch = 0; ch < BAS_SCREEN_PAL_CHANNELS; ch++) {
+                        pal[entry * BAS_SCREEN_PAL_CHANNELS + ch] = expandDac(sRampLevels[level][sat][sHueRing[hue][ch]]);
+                    }
+
+                    entry++;
+                }
+            }
+        }
+    }
+
+    scr->paletteChanged = true;
+}
+
+
+// One attribute's colour: an EGA colour number (0..63) in SCREEN 0, else
+// blue * 65536 + green * 256 + red with 6-bit levels.
+static int32_t paletteSet(BasScreenT *scr, int32_t attr, int32_t color) {
+    uint8_t rgb[BAS_SCREEN_PAL_CHANNELS];
+
+    if (attr < 0 || attr >= paletteColors(scr) || color < 0) {
+        return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    if (scr->mode == BAS_SCREEN_MODE_TEXT) {
+        if (color > SCR_EGA_COLOR_MAX) {
+            return BAS_ERR_ILLEGAL_FUNC_CALL;
+        }
+
+        rgb[0] = (uint8_t)(((color & SCR_EGA_RED) ? SCR_EGA_PRIMARY : 0) + ((color & SCR_EGA_RED_LOW) ? SCR_EGA_SECONDARY : 0));
+        rgb[1] = (uint8_t)(((color & SCR_EGA_GREEN) ? SCR_EGA_PRIMARY : 0) + ((color & SCR_EGA_GREEN_LOW) ? SCR_EGA_SECONDARY : 0));
+        rgb[2] = (uint8_t)(((color & SCR_EGA_BLUE) ? SCR_EGA_PRIMARY : 0) + ((color & SCR_EGA_BLUE_LOW) ? SCR_EGA_SECONDARY : 0));
+    } else {
+        rgb[0] = (uint8_t)(color & SCR_BYTE_MASK);
+        rgb[1] = (uint8_t)((color >> SCR_VGA_GREEN_SHIFT) & SCR_BYTE_MASK);
+        rgb[2] = (uint8_t)((color >> SCR_VGA_BLUE_SHIFT) & SCR_BYTE_MASK);
+
+        if (rgb[0] > SCR_DAC_MAX || rgb[1] > SCR_DAC_MAX || (color >> SCR_VGA_BLUE_SHIFT) > SCR_DAC_MAX) {
+            return BAS_ERR_ILLEGAL_FUNC_CALL;
+        }
+    }
+
+    for (int32_t ch = 0; ch < BAS_SCREEN_PAL_CHANNELS; ch++) {
+        scr->palette[attr * BAS_SCREEN_PAL_CHANNELS + ch] = expandDac(rgb[ch]);
+    }
+
+    scr->paletteChanged = true;
+    return 0;
+}
+
+
+// The next key, or -1.
+static int32_t popKey(BasScreenT *scr) {
+    if (scr->keyCount == 0) {
+        return -1;
+    }
+
+    int32_t code = scr->keys[scr->keyHead];
+
+    scr->keyHead = (scr->keyHead + 1) % BAS_SCREEN_KEY_QUEUE;
+    scr->keyCount--;
+    return code;
+}
+
+
+static void putChar(BasScreenT *scr, uint8_t ch) {
+    if (scr->col >= scr->cols) {
+        newLine(scr);
+    }
+
+    int32_t i = scr->row * scr->cols + scr->col;
+
+    scr->chars[i] = ch;
+    scr->attrs[i] = cellAttr(scr);
+    cellRender(scr, scr->row, scr->col);
+    scr->col++;
+}
+
+
+static int32_t rowsDefault(int32_t mode) {
+    return mode == BAS_SCREEN_MODE_VGA16 ? SCR_VGA16_ROWS : SCR_TEXT_ROWS;
+}
+
+
+// The program's screen, made in SCREEN 0 by its first console or graphics
+// statement.
+static BasScreenT *screenEnsure(BasVmT *vm) {
+    if (vm->screen) {
+        return vm->screen;
+    }
+
+    BasScreenT *scr = (BasScreenT *)calloc(1, sizeof(BasScreenT));
+
+    if (!scr || setMode(scr, BAS_SCREEN_MODE_TEXT, SCR_TEXT_ROWS) != 0) {
+        basScreenDestroy(scr);
+        return NULL;
+    }
+
+    vm->screen = scr;
+
+    if (vm->screenHost.modeChanged) {
+        vm->screenHost.modeChanged(vm->screenHost.ctx, scr);
+    }
+
+    return scr;
+}
+
+
+// Text moves up a line; the new bottom line is blank.
+static void scrollUp(BasScreenT *scr) {
+    size_t  line  = (size_t)scr->cols;
+    size_t  band  = (size_t)scr->width * (size_t)scr->cellH;
+    int32_t last  = (scr->rows - 1) * scr->cols;
+
+    memmove(scr->chars, scr->chars + line, (size_t)last);
+    memmove(scr->attrs, scr->attrs + line, (size_t)last);
+    memset(scr->chars + last, SCR_CHAR_SPACE, line);
+    memset(scr->attrs + last, cellAttr(scr), line);
+    memmove(scr->fb, scr->fb + band, (size_t)scr->width * (size_t)scr->height - band);
+    memset(scr->fb + (size_t)scr->width * (size_t)scr->height - band, textBackPixel(scr), band);
+    markDirty(scr, 0, 0, scr->width - 1, scr->height - 1);
+}
+
+
+// Make the screen mode with rows text rows: cleared, default colours,
+// palette, view and cursor.
+static int32_t setMode(BasScreenT *scr, int32_t mode, int32_t rows) {
+    int32_t width  = SCR_WIDE_W;
+    int32_t height = 0;
+    int32_t cols   = SCR_WIDE_COLS;
+
+    switch (mode) {
+        case BAS_SCREEN_MODE_TEXT:
+            height = SCR_TEXT_ROWS * BAS_GFX_GLYPH_TALL;
+            break;
+
+        case BAS_SCREEN_MODE_VGA16:
+            height = SCR_VGA16_H;
+            break;
+
+        case BAS_SCREEN_MODE_VGA256:
+            width  = SCR_VGA256_W;
+            height = SCR_VGA256_H;
+            cols   = SCR_VGA256_COLS;
+            break;
+
+        default:
+            return BAS_ERR_ILLEGAL_FUNC_CALL;
+    }
+
+    uint8_t *fb    = (uint8_t *)realloc(scr->fb, (size_t)width * (size_t)height);
+    uint8_t *chars = fb ? (uint8_t *)realloc(scr->chars, (size_t)(rows * cols)) : NULL;
+    uint8_t *attrs = chars ? (uint8_t *)realloc(scr->attrs, (size_t)(rows * cols)) : NULL;
+
+    scr->fb    = fb ? fb : scr->fb;
+    scr->chars = chars ? chars : scr->chars;
+
+    if (!attrs) {
+        return BAS_ERR_OUT_OF_MEMORY;
+    }
+
+    BasGfxSurfaceT surf;
+
+    memset(&surf, 0, sizeof(surf));
+    surf.ctx      = scr;
+    surf.width    = width;
+    surf.height   = height;
+    surf.colorMax = mode == BAS_SCREEN_MODE_VGA256 ? BAS_SCREEN_PAL_ENTRIES - 1 : SCR_EGA_COLORS - 1;
+    surf.span     = surfSpan;
+    surf.get      = surfGet;
+
+    scr->attrs         = attrs;
+    scr->mode          = mode;
+    scr->width         = width;
+    scr->height        = height;
+    scr->cols          = cols;
+    scr->rows          = rows;
+    scr->cellH         = height / rows;
+    scr->fore          = mode == BAS_SCREEN_MODE_TEXT ? SCR_TEXT_FORE : SCR_GFX_FORE;
+    scr->back          = 0;
+    scr->cursorVisible = false;
+    scr->cursorDrawn   = false;
+    basGfxInit(&scr->gfx, &surf, scr->fore, 0, SCR_ASPECT_W / SCR_ASPECT_H * height / width);
+    paletteDefault(scr);
+    clearAll(scr);
+    return 0;
+}
+
+
+static uint32_t surfGet(const void *ctx, int32_t x, int32_t y) {
+    const BasScreenT *scr = (const BasScreenT *)ctx;
+
+    return scr->fb[y * scr->width + x];
+}
+
+
+static void surfSpan(void *ctx, int32_t x0, int32_t x1, int32_t y, uint32_t pixel) {
+    BasScreenT *scr = (BasScreenT *)ctx;
+
+    memset(scr->fb + y * scr->width + x0, (uint8_t)pixel, (size_t)(x1 - x0 + 1));
+    markDirty(scr, x0, y, x1, y);
+}
+
+
+// Blank text: the COLOR background in SCREEN 0, colour 0 in graphics modes.
+static uint8_t textBackPixel(const BasScreenT *scr) {
+    return scr->mode == BAS_SCREEN_MODE_TEXT ? (uint8_t)(scr->back & SCR_NIBBLE) : 0;
+}

src/apps/kpunch/dvxbasic/runtime/screen.h

@@ -0,0 +1,122 @@
+// The MIT License (MIT)
+//
+// Copyright (C) 2026 Scott Duensing
+//
+// Permission is hereby granted, free of charge, to any person obtaining a copy
+// of this software and associated documentation files (the "Software"), to
+// deal in the Software without restriction, including without limitation the
+// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+// sell copies of the Software, and to permit persons to whom the Software is
+// furnished to do so, subject to the following conditions:
+//
+// The above copyright notice and this permission notice shall be included in
+// all copies or substantial portions of the Software.
+//
+// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+// IN THE SOFTWARE.
+
+// screen.h -- DVX BASIC program screen (QBasic console and graphics)
+//
+// A program gets its screen with its first console or graphics statement
+// (CLS, LOCATE, COLOR, SCREEN, WIDTH, PSET, LINE, INKEY$, ...).  From then
+// on PRINT and INPUT use it too.  The screen is an 8-bit framebuffer with
+// its own palette in one of QBasic's modes:
+//
+//   SCREEN 0   text, 80x25 (WIDTH 80, 50: 80x50), 16 colours, 640x400 pixels
+//   SCREEN 12  640x480, 16 colours, 80x30 text (WIDTH 80, 60: 80x60)
+//   SCREEN 13  320x200, 256 colours (the VGA default palette), 40x25 text
+//
+// The VM keeps the screen (BasVmT.screen); the host shows it and feeds it
+// keys through BasScreenHostT (vm.h) and basScreenPushKey.  Everything
+// here works without a host too (the test harnesses read the framebuffer
+// and the text cells directly).
+
+#ifndef DVXBASIC_SCREEN_H
+#define DVXBASIC_SCREEN_H
+
+#include "gfx.h"
+#include "vm.h"
+
+#include <stdint.h>
+#include <stdbool.h>
+
+#define BAS_SCREEN_MODE_TEXT     0
+#define BAS_SCREEN_MODE_VGA16    12
+#define BAS_SCREEN_MODE_VGA256   13
+
+#define BAS_SCREEN_KEY_EXT       0x100   // a key without a character: BAS_SCREEN_KEY_EXT | scan code (INKEY$: CHR$(0) + CHR$(scan))
+#define BAS_SCREEN_KEY_QUEUE     64      // keys waiting for INKEY$ / INPUT
+#define BAS_SCREEN_PAL_ENTRIES   256
+#define BAS_SCREEN_PAL_CHANNELS  3       // R, G, B (8 bits each)
+
+typedef struct BasScreenT {
+    int32_t  mode;                 // BAS_SCREEN_MODE_*
+    int32_t  width;                // framebuffer size in pixels
+    int32_t  height;
+    uint8_t *fb;                   // width * height colour numbers
+    uint8_t  palette[BAS_SCREEN_PAL_ENTRIES * BAS_SCREEN_PAL_CHANNELS];
+    int32_t  cols;                 // text grid
+    int32_t  rows;
+    int32_t  cellH;                // glyph rows (BAS_GFX_GLYPH_TALL / _SHORT)
+    uint8_t *chars;                // rows * cols character codes
+    uint8_t *attrs;                // text mode: fore | back << 4; graphics modes: fore
+    int32_t  row;                  // text cursor, 0-based
+    int32_t  col;                  // == cols after the last column: the next character wraps first
+    bool     cursorVisible;        // LOCATE ,,1
+    bool     cursorDrawn;          // the cursor is on the screen now (visible, or INPUT waiting)
+    bool     inputActive;          // INPUT is reading (the cursor shows in every mode)
+    uint8_t  fore;                 // COLOR
+    uint8_t  back;
+    BasGfxT  gfx;                  // graphics state (graphics modes)
+    bool     dirty;                // pixels changed since the host showed the screen
+    int32_t  dirtyX0;
+    int32_t  dirtyY0;
+    int32_t  dirtyX1;
+    int32_t  dirtyY1;
+    bool     paletteChanged;       // the palette changed since the host showed the screen
+    bool     fullScreen;           // FULLSCREEN / Alt+Enter state (the host keeps it)
+    int32_t  keys[BAS_SCREEN_KEY_QUEUE];
+    int32_t  keyHead;
+    int32_t  keyCount;
+} BasScreenT;
+
+// The host has shown everything: forget the dirty rectangle and palette.
+void basScreenClean(BasScreenT *scr);
+
+// The column PRINT is at (0-based; cols while a wrap is pending).
+int32_t basScreenColumn(const BasScreenT *scr);
+
+// Free a screen (NULL is fine).
+void basScreenDestroy(BasScreenT *scr);
+
+// Run a program-screen built-in (BAS_FN_SCREEN_FIRST .. _LAST).  Returns 0
+// or a BASIC error number; *result is the function's value (0 for the
+// statements).
+int32_t basScreenExec(BasVmT *vm, uint8_t fn, BasValueT *args, int32_t argc, BasValueT *result);
+
+// INPUT / LINE INPUT on the screen: prompt, then the line typed (Enter
+// ends it; Backspace and Esc edit), keeping the host's events running.
+// False when the program is stopping.
+bool basScreenInput(BasVmT *vm, const char *prompt, char *buf, int32_t bufSize);
+
+// Everything must be shown again (the host's window or mode changed).
+void basScreenInvalidate(BasScreenT *scr);
+
+// Let the host show what changed (the VM calls this whenever it gives the
+// host a turn).
+void basScreenPresent(BasVmT *vm);
+
+// PRINT text at the cursor (CHR$(13) / CHR$(10) start a new line, CHR$(9)
+// goes to the next multiple of 8), then a new line when newline.
+void basScreenPrint(BasScreenT *scr, const char *text, bool newline);
+
+// A key for INKEY$ / INPUT: a character, or BAS_SCREEN_KEY_EXT | scan.
+// Dropped when the queue is full.
+void basScreenPushKey(BasScreenT *scr, int32_t code);
+
+#endif // DVXBASIC_SCREEN_H

src/apps/kpunch/dvxbasic/runtime/serialize.c

@@ -60,6 +60,20 @@
 //   globalInitCount  int32, then that many entries:
 //                    index        int32
 //                    dataType     uint8
+//
+//   classCount       int32, then that many class modules:
+//                    name          uint16 len + bytes
+//                    varCount      int32
+//                    initCodeAddr  int32
+//                    terminateProc int32 (-1 = none)
+//                    memberCount   int32, then that many members:
+//                      name           uint16 len + bytes
+//                      index          int32
+//                      kind           uint8
+//                      flags          uint8
+//                      dataType       uint8
+//                      requiredParams uint8
+//                      paramCount     uint8, then that many parameter types (uint8)
 
 #include "serialize.h"
 #include "../compiler/opcodes.h"
@@ -75,7 +89,7 @@
 // so both sides pull from the same definition.
 #define BAS_MOD_MAGIC        "DBXM"
 #define BAS_MOD_MAGIC_LEN    4
-#define BAS_MOD_VERSION      3  // 2: per-frame GOSUB stack (OP_GOSUB), OP_STR_APPEND; 3: BEEP / SOUND / PLAY / STICK / STRIG / FRAMEWAIT opcodes (runtime and stub rebuilt together)
+#define BAS_MOD_VERSION      7  // 2: per-frame GOSUB stack (OP_GOSUB), OP_STR_APPEND; 3: BEEP / SOUND / PLAY / STICK / STRIG / FRAMEWAIT opcodes (runtime and stub rebuilt together); 4: DATE type, OP_CONV_DATE, OP_BUILTIN; 5: BAS_FN_PARAMARRAY; 6: program screen built-ins (BAS_FN_CLS .. BAS_FN_LINE_INPUT); 7: Variants, objects and class modules (class table, OP_PUSH_SPECIAL .. OP_PROP_ASSIGN, BAS_FN_VARTYPE .. BAS_FN_EACH_ITEM)
 
 // Fixed header sizes on the wire.  BAS_MOD_HEADER_SIZE is magic(4) +
 // version(2) + 6 int32 header fields(24) = 30.  BAS_DBG_HEADER_SIZE is
@@ -90,6 +104,8 @@
 #define BAS_PROC_MIN_ENTRY        18
 #define BAS_FORMVAR_MIN_ENTRY     14
 #define BAS_GLOBALINIT_MIN_ENTRY  5
+#define BAS_CLASS_MIN_ENTRY       18
+#define BAS_MEMBER_MIN_ENTRY      11
 #define BAS_DEBUGVAR_MIN_ENTRY    15
 #define BAS_BUF_INIT_CAP          4096
 
@@ -126,6 +142,7 @@ static void bufWriteI32(BufT *b, int32_t v);
 static void bufWriteStr(BufT *b, const char *s, int32_t len);
 static void bufWriteU16(BufT *b, uint16_t v);
 static void bufWriteU8(BufT *b, uint8_t v);
+static bool classRangesValid(const BasModuleT *mod, const BasClassInfoT *cls);
 static bool countFits(ReaderT *r, int32_t count, int32_t minBytesPerEntry);
 static bool moduleRangesValid(const BasModuleT *mod);
 static int32_t readCount(ReaderT *r, int32_t minBytesPerEntry);
@@ -428,6 +445,64 @@ BasModuleT *basModuleDeserialize(const uint8_t *data, int32_t dataLen) {
         }
     }
 
+    // Class modules
+    int32_t classCount = readCount(&r, BAS_CLASS_MIN_ENTRY);
+
+    if (classCount > 0) {
+        mod->classes = (BasClassInfoT *)calloc(classCount, sizeof(BasClassInfoT));
+
+        if (!mod->classes) {
+            basModuleFree(mod);
+            return NULL;
+        }
+
+        mod->classCount = classCount;
+
+        for (int32_t c = 0; c < classCount && !r.err; c++) {
+            BasClassInfoT *cls = &mod->classes[c];
+
+            rStrInto(&r, cls->name, BAS_MAX_IDENT);
+            cls->varCount      = rI32(&r);
+            cls->initCodeAddr  = rI32(&r);
+            cls->terminateProc = rI32(&r);
+
+            int32_t memberCount = readCount(&r, BAS_MEMBER_MIN_ENTRY);
+
+            if (memberCount > 0) {
+                cls->members = (BasClassMemberT *)calloc(memberCount, sizeof(BasClassMemberT));
+
+                if (!cls->members) {
+                    basModuleFree(mod);
+                    return NULL;
+                }
+
+                cls->memberCount = memberCount;
+            }
+
+            for (int32_t i = 0; i < memberCount; i++) {
+                BasClassMemberT *m = &cls->members[i];
+
+                rStrInto(&r, m->name, BAS_MAX_IDENT);
+                m->index          = rI32(&r);
+                m->kind           = rU8(&r);
+                m->flags          = rU8(&r);
+                m->dataType       = rU8(&r);
+                m->requiredParams = rU8(&r);
+
+                int32_t paramCount = rU8(&r);
+
+                if (paramCount > BAS_VM_MAX_CALL_ARGS) {
+                    r.err = true;
+                    break;
+                }
+
+                for (int32_t k = 0; k < paramCount; k++) {
+                    m->paramTypes[k] = rU8(&r);
+                }
+            }
+        }
+    }
+
     // A latched read error means the stream was truncated or corrupt; the
     // reader returned benign defaults for everything past the fault, so the
     // module would load with zeroed proc/code addresses.  Reject it, and
@@ -485,6 +560,12 @@ void basModuleFree(BasModuleT *mod) {
     free(mod->globalInits);
     free(mod->debugVars);
 
+    for (int32_t i = 0; i < mod->classCount; i++) {
+        free(mod->classes[i].members);
+    }
+
+    free(mod->classes);
+
     if (mod->debugUdtDefs) {
         for (int32_t i = 0; i < mod->debugUdtDefCount; i++) {
             free(mod->debugUdtDefs[i].fields);
@@ -597,6 +678,35 @@ uint8_t *basModuleSerialize(const BasModuleT *mod, int32_t *outLen) {
         bufWriteU8(&b, mod->globalInits[i].dataType);
     }
 
+    // Class modules (runtime-essential: New and member access)
+    bufWriteI32(&b, mod->classCount);
+
+    for (int32_t c = 0; c < mod->classCount; c++) {
+        const BasClassInfoT *cls = &mod->classes[c];
+
+        bufWriteStr(&b, cls->name, (int32_t)strlen(cls->name));
+        bufWriteI32(&b, cls->varCount);
+        bufWriteI32(&b, cls->initCodeAddr);
+        bufWriteI32(&b, cls->terminateProc);
+        bufWriteI32(&b, cls->memberCount);
+
+        for (int32_t i = 0; i < cls->memberCount; i++) {
+            const BasClassMemberT *m = &cls->members[i];
+
+            bufWriteStr(&b, m->name, (int32_t)strlen(m->name));
+            bufWriteI32(&b, m->index);
+            bufWriteU8(&b, m->kind);
+            bufWriteU8(&b, m->flags);
+            bufWriteU8(&b, m->dataType);
+            bufWriteU8(&b, m->requiredParams);
+
+            int32_t paramCount = (m->kind == BAS_MEMBER_VAR || m->index < 0 || m->index >= mod->procCount) ? 0 : DVX_MIN(mod->procs[m->index].paramCount, BAS_VM_MAX_CALL_ARGS);
+
+            bufWriteU8(&b, (uint8_t)paramCount);
+            bufWrite(&b, m->paramTypes, paramCount);
+        }
+    }
+
     if (b.err) {
         free(b.buf);
         return NULL;
@@ -705,6 +815,27 @@ static void bufWriteU8(BufT *b, uint8_t v) {
 }
 
 
+// A class module read from a file: its set-up code inside the module
+// (-1: none), its procedures in the procedure table, member variables
+// among its own and member kinds known.
+static bool classRangesValid(const BasModuleT *mod, const BasClassInfoT *cls) {
+    if (cls->varCount < 0 || cls->initCodeAddr < -1 || cls->initCodeAddr >= mod->codeLen || cls->terminateProc < -1 || cls->terminateProc >= mod->procCount) {
+        return false;
+    }
+
+    for (int32_t i = 0; i < cls->memberCount; i++) {
+        const BasClassMemberT *m     = &cls->members[i];
+        int32_t                limit = (m->kind == BAS_MEMBER_VAR) ? cls->varCount : mod->procCount;
+
+        if (m->kind > BAS_MEMBER_SET || m->index < 0 || m->index >= limit) {
+            return false;
+        }
+    }
+
+    return true;
+}
+
+
 // True when count is non-negative and count entries of at least
 // minBytesPerEntry bytes each still fit in the remaining input.  Uses
 // division, not multiplication, to avoid overflow.
@@ -715,7 +846,7 @@ static bool countFits(ReaderT *r, int32_t count, int32_t minBytesPerEntry) {
 
 // Semantic checks on a module read from an untrusted file: every code
 // address and slot index must point inside the module, and every
-// procedure's local count must fit a call frame.  entryPoint may equal
+// procedure's local and parameter counts must fit a call frame.  entryPoint may equal
 // codeLen (an empty program halts at once); a negative initCodeAddr means
 // the form has no init code.
 static bool moduleRangesValid(const BasModuleT *mod) {
@@ -724,7 +855,9 @@ static bool moduleRangesValid(const BasModuleT *mod) {
     }
 
     for (int32_t i = 0; i < mod->procCount; i++) {
-        if (mod->procs[i].codeAddr < 0 || mod->procs[i].codeAddr >= mod->codeLen || mod->procs[i].localCount < 0 || mod->procs[i].localCount > BAS_VM_MAX_LOCALS) {
+        const BasProcEntryT *p = &mod->procs[i];
+
+        if (p->codeAddr < 0 || p->codeAddr >= mod->codeLen || p->localCount < 0 || p->localCount > BAS_VM_MAX_LOCALS || p->paramCount < 0 || p->paramCount > BAS_VM_MAX_CALL_ARGS) {
             return false;
         }
     }
@@ -747,6 +880,12 @@ static bool moduleRangesValid(const BasModuleT *mod) {
         }
     }
 
+    for (int32_t c = 0; c < mod->classCount; c++) {
+        if (!classRangesValid(mod, &mod->classes[c])) {
+            return false;
+        }
+    }
+
     return true;
 }
 

src/apps/kpunch/dvxbasic/runtime/values.c

@@ -27,6 +27,8 @@
 // decrements, zero frees. No garbage collector needed.
 
 #include "values.h"
+#include "basErrors.h"
+#include "dates.h"
 #include "../compiler/opcodes.h"
 #include "dvxTypes.h"
 
@@ -37,12 +39,13 @@
 #include <string.h>
 
 #define BAS_STRING_IMMORTAL_REFCOUNT 999999  // documents intent only: the empty string is never counted or freed (see basStringRef/Unref)
-#define BAS_NUM_FORMAT_BUF_LEN       64      // scratch for the widest %g rendering of a double
+#define BAS_NUM_FORMAT_BUF_LEN       64      // scratch for the widest %g rendering of a double or general date
 #define BAS_NUM_PARSE_BUF_LEN        64      // VAL: sign + mantissa digits + "e" + exponent
 #define BAS_NUM_MANTISSA_DIGITS      40      // VAL: significant digits kept (well past a double's 17)
 #define BAS_NUM_EXP_CLAMP            100000  // VAL: explicit exponents saturate here (far past a double's range)
 #define BAS_BOOL_TRUE_TEXT           "True"
 #define BAS_BOOL_FALSE_TEXT          "False"
+#define BAS_NULL_TEXT                "Null"  // PRINT / STR of a Null
 #define BAS_SINGLE_SIG_DIGITS        7       // significant digits shown for SINGLE (VB3)
 #define BAS_DOUBLE_SIG_DIGITS        15      // significant digits shown for DOUBLE (VB3)
 #define BAS_RADIX_HEX                16
@@ -62,13 +65,21 @@ BasStringT *basEmptyString = &sEmptyStringStorage.hdr;
 
 bool basStringAllocFailed = false;
 
+bool basValNullUsed = false;
+
 
 // Function prototypes (alphabetical)
 void basArrayFree(BasArrayT *arr);
 int32_t basArrayIndex(BasArrayT *arr, int32_t *indices, int32_t ndims);
 BasArrayT *basArrayNew(int32_t dims, int32_t *lbounds, int32_t *ubounds, uint8_t elementType);
+BasArrayT *basArrayNewEmpty(uint8_t elementType);
 BasArrayT *basArrayRef(BasArrayT *arr);
 void basArrayUnref(BasArrayT *arr);
+void basObjectClear(BasObjectT *obj);
+static void basObjectFree(BasObjectT *obj);
+BasObjectT *basObjectNew(int32_t classIdx, int32_t fieldCount, BasObjectT **liveList);
+BasObjectT *basObjectRef(BasObjectT *obj);
+void basObjectUnref(BasObjectT *obj);
 double basParseNumber(const char *s);
 BasStringT *basStringAlloc(int32_t cap);
 bool basStringAppend(BasStringT **dst, const BasStringT *b);
@@ -89,11 +100,16 @@ int32_t basValCompare(BasValueT a, BasValueT b);
 int32_t basValCompareCI(BasValueT a, BasValueT b);
 static int32_t basValCompareImpl(BasValueT a, BasValueT b, bool caseInsensitive);
 BasValueT basValCopy(BasValueT v);
+BasValueT basValDate(double serial);
 BasValueT basValDouble(double v);
+BasValueT basValEmpty(void);
 BasStringT *basValFormatString(BasValueT v);
+BasValueT basValInstance(BasObjectT *obj);
 BasValueT basValInteger(int16_t v);
+bool basValIsObject(BasValueT v);
 bool basValIsTruthy(BasValueT v);
 BasValueT basValLong(int32_t v);
+BasValueT basValNull(void);
 BasValueT basValObject(void *obj);
 void basValRelease(BasValueT *v);
 bool basValRoundToInt32(BasValueT v, int32_t lo, int32_t hi, int32_t *out);
@@ -101,6 +117,7 @@ BasValueT basValSingle(float v);
 BasValueT basValString(BasStringT *s);
 BasValueT basValStringFromC(const char *text);
 BasValueT basValToBool(BasValueT v);
+int32_t basValToDateSerial(BasValueT v, double *out);
 BasValueT basValToDouble(BasValueT v);
 int32_t basValToInt32(BasValueT v);
 BasValueT basValToInteger(BasValueT v);
@@ -206,9 +223,13 @@ BasArrayT *basArrayNew(int32_t dims, int32_t *lbounds, int32_t *ubounds, uint8_t
     // tag set; STRING elements additionally need a real (empty) string --
     // calloc leaves strVal NULL and the VM's string ops dereference it
     // unguarded, so an uninitialized string element would crash.
+    // A VARIANT element starts Empty (VARIANT is a declared type, never
+    // a value's tag).
+    uint8_t tag = (elementType == BAS_TYPE_VARIANT) ? BAS_TYPE_EMPTY : elementType;
+
     if (elementType != BAS_TYPE_INTEGER) {
         for (int32_t i = 0; i < arr->totalElements; i++) {
-            arr->elements[i].type = elementType;
+            arr->elements[i].type = tag;
 
             if (elementType == BAS_TYPE_STRING) {
                 arr->elements[i].strVal = basStringRef(basEmptyString);
@@ -220,6 +241,21 @@ BasArrayT *basArrayNew(int32_t dims, int32_t *lbounds, int32_t *ubounds, uint8_t
 }
 
 
+BasArrayT *basArrayNewEmpty(uint8_t elementType) {
+    BasArrayT *arr = (BasArrayT *)calloc(1, sizeof(BasArrayT));
+
+    if (!arr) {
+        return NULL;
+    }
+
+    arr->refCount    = 1;
+    arr->elementType = elementType;
+    arr->dims        = 1;
+    arr->ubound[0]   = -1;
+    return arr;
+}
+
+
 BasArrayT *basArrayRef(BasArrayT *arr) {
     if (arr) {
         arr->refCount++;
@@ -242,6 +278,123 @@ void basArrayUnref(BasArrayT *arr) {
 }
 
 
+void basObjectClear(BasObjectT *obj) {
+    // Detach the storage first: releasing a member can run into this
+    // object again (a cycle), which must then find nothing to release.
+    BasValueT    *fields     = obj->fields;
+    int32_t       fieldCount = obj->fieldCount;
+    BasCollItemT *items      = obj->items;
+    int32_t       itemCount  = obj->itemCount;
+
+    obj->fields     = NULL;
+    obj->fieldCount = 0;
+    obj->items      = NULL;
+    obj->itemCount  = 0;
+    obj->itemCap    = 0;
+
+    for (int32_t i = 0; i < fieldCount; i++) {
+        basValRelease(&fields[i]);
+    }
+
+    for (int32_t i = 0; i < itemCount; i++) {
+        basStringUnref(items[i].key);
+        basValRelease(&items[i].value);
+    }
+
+    free(fields);
+    free(items);
+}
+
+
+// Releases what the object holds, leaves its owner's live list and frees it.
+static void basObjectFree(BasObjectT *obj) {
+    basObjectClear(obj);
+
+    if (obj->liveList) {
+        if (obj->livePrev) {
+            obj->livePrev->liveNext = obj->liveNext;
+        } else {
+            *obj->liveList = obj->liveNext;
+        }
+
+        if (obj->liveNext) {
+            obj->liveNext->livePrev = obj->livePrev;
+        }
+    }
+
+    free(obj);
+}
+
+
+BasObjectT *basObjectNew(int32_t classIdx, int32_t fieldCount, BasObjectT **liveList) {
+    if (fieldCount < 0) {
+        return NULL;
+    }
+
+    BasObjectT *obj = (BasObjectT *)calloc(1, sizeof(BasObjectT));
+
+    if (!obj) {
+        return NULL;
+    }
+
+    if (fieldCount > 0) {
+        obj->fields = (BasValueT *)calloc(fieldCount, sizeof(BasValueT));
+
+        if (!obj->fields) {
+            free(obj);
+            return NULL;
+        }
+
+        for (int32_t i = 0; i < fieldCount; i++) {
+            obj->fields[i].type = BAS_TYPE_EMPTY;
+        }
+    }
+
+    obj->refCount   = 1;
+    obj->classIdx   = classIdx;
+    obj->fieldCount = fieldCount;
+    obj->liveList   = liveList;
+
+    if (liveList) {
+        obj->liveNext = *liveList;
+
+        if (*liveList) {
+            (*liveList)->livePrev = obj;
+        }
+
+        *liveList = obj;
+    }
+
+    return obj;
+}
+
+
+BasObjectT *basObjectRef(BasObjectT *obj) {
+    if (obj) {
+        obj->refCount++;
+    }
+
+    return obj;
+}
+
+
+void basObjectUnref(BasObjectT *obj) {
+    if (!obj || --obj->refCount > 0) {
+        return;
+    }
+
+    // Class_Terminate runs first; the finalizer keeps the object alive
+    // for it and frees it afterwards (it clears the hook, so the next
+    // time the count reaches zero the object is freed).
+    if (obj->finalize) {
+        obj->finalize(obj->finalizeCtx, obj);
+        return;
+    }
+
+    basObjectFree(obj);
+}
+
+
 // ============================================================
 // Number parsing (VAL)
 // ============================================================
@@ -667,6 +820,15 @@ int32_t basValCompareCI(BasValueT a, BasValueT b) {
 
 
 static int32_t basValCompareImpl(BasValueT a, BasValueT b, bool caseInsensitive) {
+    // Empty compares as "" with a string (as 0 with anything else)
+    if (a.type == BAS_TYPE_EMPTY && b.type == BAS_TYPE_STRING) {
+        a = basValString(NULL);
+    }
+
+    if (b.type == BAS_TYPE_EMPTY && a.type == BAS_TYPE_STRING) {
+        b = basValString(NULL);
+    }
+
     // String comparison
     if (a.type == BAS_TYPE_STRING && b.type == BAS_TYPE_STRING) {
         BasStringT *sa = a.strVal ? a.strVal : basEmptyString;
@@ -674,10 +836,25 @@ static int32_t basValCompareImpl(BasValueT a, BasValueT b, bool caseInsensitive)
         return caseInsensitive ? basStringCompareCI(sa, sb) : basStringCompare(sa, sb);
     }
 
-    // Numeric comparison
+    // Numeric comparison.  Against a DATE both sides compare as instants
+    // (a string holding a date as that date), so days before 12/30/1899
+    // order by time of day too.
     double na = basValToNumber(a);
     double nb = basValToNumber(b);
 
+    if (a.type == BAS_TYPE_DATE || b.type == BAS_TYPE_DATE) {
+        if (a.type == BAS_TYPE_STRING) {
+            basValToDateSerial(a, &na);
+        }
+
+        if (b.type == BAS_TYPE_STRING) {
+            basValToDateSerial(b, &nb);
+        }
+
+        na = basDateToLinear(na);
+        nb = basDateToLinear(nb);
+    }
+
     if (na < nb) {
         return -1;
     }
@@ -699,12 +876,22 @@ BasValueT basValCopy(BasValueT v) {
         basUdtRef(v.udtVal);
     } else if (v.type == BAS_TYPE_ELEM_REF) {
         basArrayRef(v.elemRef.arr);
+    } else if (v.type == BAS_TYPE_INSTANCE) {
+        basObjectRef(v.instVal);
     }
 
     return v;
 }
 
 
+BasValueT basValDate(double serial) {
+    BasValueT val;
+    val.type   = BAS_TYPE_DATE;
+    val.dblVal = serial;
+    return val;
+}
+
+
 BasValueT basValDouble(double v) {
     BasValueT val;
     val.type   = BAS_TYPE_DOUBLE;
@@ -713,6 +900,15 @@ BasValueT basValDouble(double v) {
 }
 
 
+BasValueT basValEmpty(void) {
+    BasValueT val;
+
+    memset(&val, 0, sizeof(val));
+    val.type = BAS_TYPE_EMPTY;
+    return val;
+}
+
+
 BasStringT *basValFormatString(BasValueT v) {
     char buf[BAS_NUM_FORMAT_BUF_LEN];
 
@@ -729,6 +925,9 @@ BasStringT *basValFormatString(BasValueT v) {
         case BAS_TYPE_DOUBLE:
             return basStringNew(buf, formatDouble(v.dblVal, BAS_DOUBLE_SIG_DIGITS, buf, sizeof(buf)));
 
+        case BAS_TYPE_DATE:
+            return basStringNew(buf, basDateFormat(v.dblVal, NULL, buf, sizeof(buf)));
+
         case BAS_TYPE_BOOLEAN:
             if (v.boolVal) {
                 return basStringNew(BAS_BOOL_TRUE_TEXT, (int32_t)sizeof(BAS_BOOL_TRUE_TEXT) - 1);
@@ -739,12 +938,23 @@ BasStringT *basValFormatString(BasValueT v) {
         case BAS_TYPE_STRING:
             return basStringRef(v.strVal ? v.strVal : basEmptyString);
 
+        case BAS_TYPE_NULL:
+            return basStringNew(BAS_NULL_TEXT, (int32_t)sizeof(BAS_NULL_TEXT) - 1);
+
         default:
             return basStringRef(basEmptyString);
     }
 }
 
 
+BasValueT basValInstance(BasObjectT *obj) {
+    BasValueT val;
+    val.type    = BAS_TYPE_INSTANCE;
+    val.instVal = obj;
+    return val;
+}
+
+
 BasValueT basValInteger(int16_t v) {
     BasValueT val;
     val.type   = BAS_TYPE_INTEGER;
@@ -753,6 +963,11 @@ BasValueT basValInteger(int16_t v) {
 }
 
 
+bool basValIsObject(BasValueT v) {
+    return v.type == BAS_TYPE_OBJECT || v.type == BAS_TYPE_INSTANCE;
+}
+
+
 bool basValIsTruthy(BasValueT v) {
     switch (v.type) {
         case BAS_TYPE_INTEGER:
@@ -765,6 +980,7 @@ bool basValIsTruthy(BasValueT v) {
             return v.sngVal != 0.0f;
 
         case BAS_TYPE_DOUBLE:
+        case BAS_TYPE_DATE:
             return v.dblVal != 0.0;
 
         case BAS_TYPE_BOOLEAN:
@@ -787,6 +1003,15 @@ BasValueT basValLong(int32_t v) {
 }
 
 
+BasValueT basValNull(void) {
+    BasValueT val;
+
+    memset(&val, 0, sizeof(val));
+    val.type = BAS_TYPE_NULL;
+    return val;
+}
+
+
 BasValueT basValObject(void *obj) {
     BasValueT val;
     val.type   = BAS_TYPE_OBJECT;
@@ -795,6 +1020,31 @@ BasValueT basValObject(void *obj) {
 }
 
 
+// PRINT / PRINT # text for one value: its string form, followed by the
+// space PRINT puts after every non-string value.
+BasStringT *basValPrintString(BasValueT val) {
+    BasStringT *text = basValFormatString(val);
+
+    // Strings, dates, Empty and Null print as they are; numbers take a
+    // trailing space
+    if (val.type == BAS_TYPE_STRING || val.type == BAS_TYPE_DATE || val.type == BAS_TYPE_EMPTY || val.type == BAS_TYPE_NULL) {
+        return text;
+    }
+
+    BasStringT *out = basStringAlloc(text->len + 2);
+
+    if (out->cap >= text->len + 2) {
+        memcpy(out->data, text->data, text->len);
+        out->data[text->len]     = ' ';
+        out->data[text->len + 1] = '\0';
+        out->len                 = text->len + 1;
+    }
+
+    basStringUnref(text);
+    return out;
+}
+
+
 void basValRelease(BasValueT *v) {
     if (v->type == BAS_TYPE_STRING) {
         basStringUnref(v->strVal);
@@ -808,6 +1058,13 @@ void basValRelease(BasValueT *v) {
     } else if (v->type == BAS_TYPE_ELEM_REF) {
         basArrayUnref(v->elemRef.arr);
         v->elemRef.arr = NULL;
+    } else if (v->type == BAS_TYPE_INSTANCE) {
+        BasObjectT *obj = v->instVal;
+
+        // Clear the slot before the object can run code (Class_Terminate)
+        // or free what points back here.
+        v->instVal = NULL;
+        basObjectUnref(obj);
     }
 }
 
@@ -864,6 +1121,42 @@ BasValueT basValToBool(BasValueT v) {
 }
 
 
+int32_t basValToDateSerial(BasValueT v, double *out) {
+    double serial;
+
+    switch (v.type) {
+        case BAS_TYPE_STRING:
+            if (!basDateParse(v.strVal ? v.strVal->data : "", &serial)) {
+                return BAS_ERR_TYPE_MISMATCH;
+            }
+            break;
+
+        case BAS_TYPE_INTEGER:
+        case BAS_TYPE_LONG:
+        case BAS_TYPE_SINGLE:
+        case BAS_TYPE_DOUBLE:
+        case BAS_TYPE_BOOLEAN:
+        case BAS_TYPE_DATE:
+        case BAS_TYPE_EMPTY:
+            serial = basValToNumber(v);
+            break;
+
+        case BAS_TYPE_NULL:
+            return BAS_ERR_INVALID_NULL;
+
+        default:
+            return BAS_ERR_TYPE_MISMATCH;
+    }
+
+    if (!basDateIsValid(serial)) {
+        return BAS_ERR_OVERFLOW;
+    }
+
+    *out = serial;
+    return 0;
+}
+
+
 BasValueT basValToDouble(BasValueT v) {
     return basValDouble(basValToNumber(v));
 }
@@ -923,6 +1216,7 @@ double basValToNumber(BasValueT v) {
             return (double)v.sngVal;
 
         case BAS_TYPE_DOUBLE:
+        case BAS_TYPE_DATE:
             return v.dblVal;
 
         case BAS_TYPE_BOOLEAN:
@@ -935,6 +1229,10 @@ double basValToNumber(BasValueT v) {
 
             return 0.0;
 
+        case BAS_TYPE_NULL:
+            basValNullUsed = true;
+            return 0.0;
+
         default:
             return 0.0;
     }
@@ -958,6 +1256,13 @@ BasValueT basValToString(BasValueT v) {
         return basValCopy(v);
     }
 
+    // Null has no text to convert (PRINT shows "Null" through
+    // basValFormatString; CSTR(Null) is an error).
+    if (v.type == BAS_TYPE_NULL) {
+        basValNullUsed = true;
+        return basValString(NULL);
+    }
+
     BasValueT result;
     result.type   = BAS_TYPE_STRING;
     result.strVal = basValFormatString(v);

src/apps/kpunch/dvxbasic/runtime/values.h

@@ -114,6 +114,11 @@ typedef struct {
 // Allocate a new array. refCount starts at 1.
 BasArrayT *basArrayNew(int32_t dims, int32_t *lbounds, int32_t *ubounds, uint8_t elementType);
 
+// Allocate a one-dimensional array with no elements (LBOUND 0, UBOUND -1),
+// what SPLIT and FILTER return when there is nothing to hold.  refCount
+// starts at 1; NULL when out of memory.
+BasArrayT *basArrayNewEmpty(uint8_t elementType);
+
 // Free all elements and release the array.
 void basArrayFree(BasArrayT *arr);
 
@@ -155,6 +160,35 @@ void basUdtUnref(BasUdtT *udt);
 // value semantics on assignment and BYVAL parameter passing.
 BasUdtT *basUdtClone(const BasUdtT *udt);
 
+// ============================================================
+// Reference-counted object (class instance or Collection)
+// ============================================================
+//
+// One structure for every object the VM makes itself: an instance of a
+// class module (member variables in fields) or a Collection (items).
+// Forms and controls are host objects (BAS_TYPE_OBJECT) and never use it.
+
+typedef struct BasObjectS BasObjectT;
+
+// Called once when the last reference to an object whose class has a
+// Class_Terminate goes away.  The callee takes over that (now zero) last
+// reference: it must bring refCount back to 1 before keeping the object.
+typedef void (*BasObjFinalizeFnT)(void *ctx, BasObjectT *obj);
+
+// classIdx of a Collection (user classes index the module's class table).
+#define BAS_OBJ_COLLECTION (-1)
+
+// Increment reference count.
+BasObjectT *basObjectRef(BasObjectT *obj);
+
+// Decrement reference count.  At zero the object is handed to its
+// finalizer when it has one, else freed (members and items released).
+void basObjectUnref(BasObjectT *obj);
+
+// Release every member variable and item (the object stays allocated,
+// empty).  Used to break reference cycles when a program ends.
+void basObjectClear(BasObjectT *obj);
+
 // ============================================================
 // Tagged value
 // ============================================================
@@ -165,12 +199,13 @@ struct BasValueTag {
         int16_t     intVal;    // BAS_TYPE_INTEGER
         int32_t     longVal;   // BAS_TYPE_LONG
         float       sngVal;    // BAS_TYPE_SINGLE
-        double      dblVal;    // BAS_TYPE_DOUBLE
+        double      dblVal;    // BAS_TYPE_DOUBLE, BAS_TYPE_DATE (serial, see dates.h)
         BasStringT *strVal;    // BAS_TYPE_STRING (ref-counted)
         int16_t     boolVal;   // BAS_TYPE_BOOLEAN (True=-1, False=0)
         BasArrayT  *arrVal;    // BAS_TYPE_ARRAY (ref-counted)
         BasUdtT    *udtVal;    // BAS_TYPE_UDT (ref-counted)
-        void       *objVal;    // BAS_TYPE_OBJECT (opaque host pointer)
+        void       *objVal;    // BAS_TYPE_OBJECT (opaque host pointer, NULL = Nothing)
+        BasObjectT *instVal;   // BAS_TYPE_INSTANCE (ref-counted class instance or Collection)
         BasValueT  *refVal;    // BAS_TYPE_REF (ByRef pointer to variable slot)
         struct {
             BasArrayT *arr;    // BAS_TYPE_ELEM_REF: array holding the element (a counted reference)
@@ -179,17 +214,59 @@ struct BasValueTag {
     };
 };
 
+// One Collection item: an optional key (NULL = none) and the value.
+typedef struct {
+    BasStringT *key;
+    BasValueT   value;
+} BasCollItemT;
+
+struct BasObjectS {
+    int32_t            refCount;
+    int32_t            classIdx;     // BAS_OBJ_COLLECTION, else index into the module's class table
+    int32_t            fieldCount;
+    int32_t            itemCount;
+    int32_t            itemCap;
+    BasValueT         *fields;       // class instance: member variables
+    BasCollItemT      *items;        // Collection: items in order
+    BasObjFinalizeFnT  finalize;     // Class_Terminate hook (NULL = free at once)
+    void              *finalizeCtx;
+    BasObjectT       **liveList;     // head of the owner's list of live objects (NULL = none)
+    BasObjectT        *livePrev;
+    BasObjectT        *liveNext;
+    BasObjectT        *termNext;     // next object waiting for Class_Terminate (owner's queue)
+};
+
+// Allocate an object with fieldCount member variables (each EMPTY until
+// the class's initialisation code runs).  refCount starts at 1; it joins
+// *liveList when that is non-NULL.  NULL when out of memory.
+BasObjectT *basObjectNew(int32_t classIdx, int32_t fieldCount, BasObjectT **liveList);
+
 // Create values.  Out-of-line so they can be resolved via the DXE
 // dynamic-symbol table when basrt.lib is loaded.
 BasValueT basValBool(bool v);
+BasValueT basValDate(double serial);
 BasValueT basValDouble(double v);
+BasValueT basValEmpty(void);
 BasValueT basValInteger(int16_t v);
 BasValueT basValLong(int32_t v);
+BasValueT basValNull(void);
 BasValueT basValObject(void *obj);
 BasValueT basValSingle(float v);
 BasValueT basValString(BasStringT *s);
 BasValueT basValStringFromC(const char *text);
 
+// Wraps an object the caller holds a reference to (the reference moves
+// into the value; no extra count).
+BasValueT basValInstance(BasObjectT *obj);
+
+// True for an object value: a host object (Nothing included) or a class
+// instance / Collection.
+bool basValIsObject(BasValueT v);
+
+// Set when a Null was converted to a number or a string (Invalid use of
+// Null).  The VM checks and clears it after every instruction.
+extern bool basValNullUsed;
+
 // Copy a value (increments string/array/udt refcount if applicable).
 BasValueT basValCopy(BasValueT v);
 
@@ -205,6 +282,12 @@ BasValueT basValToLong(BasValueT v);
 BasValueT basValToSingle(BasValueT v);
 BasValueT basValToString(BasValueT v);
 
+// DATE serial of a value: a DATE as it is, a number (or BOOLEAN) as a
+// serial, a string parsed as date text.  Returns 0 and sets *out, else
+// the BASIC error number: Type mismatch for anything else (a string that
+// is not a date included), Overflow outside the DATE range.
+int32_t basValToDateSerial(BasValueT v, double *out);
+
 // Get the numeric value as a double (for mixed-type arithmetic).
 double basValToNumber(BasValueT v);
 
@@ -226,11 +309,15 @@ double basParseNumber(const char *s);
 // Get the string representation. Returns a new ref-counted string.
 BasStringT *basValFormatString(BasValueT v);
 
+// PRINT's text for a value: its string form, numbers followed by a space.
+BasStringT *basValPrintString(BasValueT val);
+
 // Check if a value is truthy (non-zero number, non-empty string).
 bool basValIsTruthy(BasValueT v);
 
 // Compare two values. Returns -1, 0, or 1.
 // Numeric types are compared numerically. Strings lexicographically.
+// A DATE compared with a string compares with the date the string holds.
 int32_t basValCompare(BasValueT a, BasValueT b);
 
 // Compare two values case-insensitively (for OPTION COMPARE TEXT).

src/apps/kpunch/dvxbasic/runtime/vm.h

@@ -63,7 +63,10 @@
 
 #define BAS_RGB_COMPONENT_MAX     255    // RGB(r,g,b): max per-channel value
 #define BAS_PRINT_SPC_MAX         255    // PRINT SPC()/TAB(): max column count
+#define BAS_PRINT_ZONE_WIDTH      14     // PRINT comma: width of one print zone (columns)
+#define BAS_INPUT_LINE_LEN        1024   // INPUT / LINE INPUT: longest line read
 #define BAS_VM_ERROR_MSG_LEN      256    // runtime error description buffer
+#define BAS_VM_ERROR_TEXT_SEP     ": "   // ends the "Runtime error N ..." prefix of a runtime error message, before its text
 
 // ============================================================
 // Result codes
@@ -173,6 +176,11 @@ typedef void (*BasUiSetEventFnT)(void *ctx, void *ctrlRef, const char *eventName
 // Remove a control from a form by name.
 typedef void (*BasUiRemoveCtrlFnT)(void *ctx, void *formRef, const char *ctrlName);
 
+// Type name of a host object for TypeName / TypeOf: "Form" for a form,
+// the control's type ("TextBox", "CommandButton" ...) for a control, NULL
+// when unknown.
+typedef const char *(*BasUiTypeNameFnT)(void *ctx, void *objRef);
+
 // Collected UI callbacks
 typedef struct {
     BasUiGetPropFnT      getProp;
@@ -191,6 +199,7 @@ typedef struct {
     BasUiCreateCtrlExFnT createCtrlEx;
     BasUiSetEventFnT     setEvent;
     BasUiRemoveCtrlFnT   removeCtrl;
+    BasUiTypeNameFnT     typeName;
     void                *ctx;        // passed as first arg to all callbacks
 } BasUiCallbacksT;
 
@@ -274,6 +283,28 @@ typedef struct {
     void     *ctx;
 } BasDeviceCallbacksT;
 
+// ============================================================
+// Program screen callbacks (host-provided)
+// ============================================================
+//
+// The program screen (screen.h) lives in the VM from the program's first
+// console or graphics statement.  The host shows it: modeChanged when it
+// is made or changes mode (size, palette and text layout), present when
+// its pixels or palette changed (the VM calls it whenever it gives the
+// host a turn; the host shows the dirty rectangle, then basScreenClean),
+// fullScreen for FULLSCREEN ON / OFF (the host sets scr->fullScreen to
+// what it managed).  Keys reach INKEY$ and INPUT through basScreenPushKey.
+// Without callbacks the screen still works, unseen.
+
+struct BasScreenT;
+
+typedef struct {
+    void  (*modeChanged)(void *ctx, struct BasScreenT *scr);
+    void  (*present)(void *ctx, struct BasScreenT *scr);
+    void  (*fullScreen)(void *ctx, struct BasScreenT *scr, bool on);
+    void   *ctx;
+} BasScreenHostT;
+
 // ============================================================
 // External library callbacks (host-provided)
 // ============================================================
@@ -329,6 +360,8 @@ typedef struct {
     int32_t   savedStmtSp;            // caller's vm->stmtSp at call time (restored on return)
     int32_t   savedGosubDepth;        // vm->gosubDepth when this frame was pushed: its own GOSUB returns sit above it (restored on return)
     bool      inHandler;              // this frame's ON ERROR handler trapped an error and has not RESUMEd yet
+    bool      pushResult;             // a SUB or Property Let/Set reached through an object: push Empty when it returns (the caller expects a value)
+    BasValueT me;                     // class module code: the object the procedure runs for (a counted BAS_TYPE_INSTANCE), else zero
     BasValueT locals[BAS_VM_MAX_LOCALS];
 } BasCallFrameT;
 
@@ -413,6 +446,44 @@ typedef struct {
     int32_t initCodeLen;    // length of init bytecode
 } BasFormVarInfoT;
 
+// ============================================================
+// Class modules
+// ============================================================
+
+// What a public member of a class is.  Part of the module format.
+typedef enum {
+    BAS_MEMBER_VAR      = 0,  // Public variable
+    BAS_MEMBER_SUB      = 1,
+    BAS_MEMBER_FUNCTION = 2,
+    BAS_MEMBER_GET      = 3,  // Property Get
+    BAS_MEMBER_LET      = 4,  // Property Let
+    BAS_MEMBER_SET      = 5   // Property Set
+} BasMemberKindE;
+
+// BasClassMemberT flags.
+#define BAS_MEMBER_DEFAULT     0x01  // the default member (Attribute Name.VB_UserMemId = 0)
+#define BAS_MEMBER_PARAMARRAY  0x02  // the last parameter is a ParamArray
+
+// A public member, found by name when a program uses obj.Name.
+typedef struct {
+    char    name[BAS_MAX_IDENT];
+    int32_t index;           // BAS_MEMBER_VAR: member variable slot; else index into procs[]
+    uint8_t kind;            // BasMemberKindE
+    uint8_t flags;           // BAS_MEMBER_*
+    uint8_t dataType;        // BAS_MEMBER_VAR: declared type (stores convert to it)
+    uint8_t requiredParams;  // procedures: arguments that must be given (the rest are Optional)
+    uint8_t paramTypes[BAS_VM_MAX_CALL_ARGS]; // procedures: declared parameter types (an omitted Optional argument takes the type's zero)
+} BasClassMemberT;
+
+typedef struct {
+    char             name[BAS_MAX_IDENT];
+    int32_t          varCount;       // member variables per instance
+    int32_t          initCodeAddr;   // code that sets up a new instance (member variables, then Class_Initialize), ends with OP_RET
+    int32_t          terminateProc;  // index into procs[] of Class_Terminate, -1 = none
+    BasClassMemberT *members;        // public members (malloc'd)
+    int32_t          memberCount;
+} BasClassInfoT;
+
 // ============================================================
 // Compiled module (output of the compiler)
 // ============================================================
@@ -442,6 +513,8 @@ typedef struct {
     int32_t           formVarInfoCount;
     BasGlobalInitT   *globalInits;      // runtime global type init (survives stripping)
     int32_t           globalInitCount;
+    BasClassInfoT    *classes;          // class modules (runtime-essential)
+    int32_t           classCount;
     BasDebugVarT     *debugVars;       // variable names for debugger
     int32_t           debugVarCount;
     BasDebugUdtDefT  *debugUdtDefs;   // UDT type definitions for debugger
@@ -555,6 +628,13 @@ typedef struct {
     BasSqlCallbacksT     sql;
     BasPrinterCallbacksT printer;
     BasDeviceCallbacksT  device;
+    BasScreenHostT       screenHost;
+
+    // The program screen (NULL until the first console or graphics
+    // statement), and the host's request to stop the program (its screen
+    // window was closed): basVmRun and basVmDoEvents then halt.
+    struct BasScreenT   *screen;
+    bool                 stopRequested;
 
     // External library callbacks (set by host)
     BasExternCallbacksT ext;
@@ -564,6 +644,13 @@ typedef struct {
     BasExternCacheEntryT *externCache;
     int32_t               externCacheCount;
 
+    // Objects: every live class instance / Collection this VM made (so a
+    // program's reference cycles can be broken when it ends), and the
+    // instances whose Class_Terminate is waiting to run (linked through
+    // termNext).
+    BasObjectT *liveObjects;
+    BasObjectT *terminateQueue;
+
     // Current form reference (set during event dispatch)
     void      *currentForm;
     BasValueT *currentFormVars;     // points to current form's variable storage
@@ -610,6 +697,15 @@ BasVmResultE basVmStep(BasVmT *vm);
 // False when the copy cannot be allocated (COMMAND$ is then empty).
 bool basVmSetCommand(BasVmT *vm, const char *args);
 
+// Give the host a turn: show what changed on the program screen, then
+// the DoEvents callback.  False when the program must stop (the host said
+// so, or basVmRequestStop).
+bool basVmDoEvents(BasVmT *vm);
+
+// Ask the running program to stop at its next turn (basVmRun then
+// returns BAS_VM_HALTED).
+void basVmRequestStop(BasVmT *vm);
+
 // Set I/O callbacks.
 void basVmSetDoEventsCallback(BasVmT *vm, BasDoEventsFnT fn, void *ctx);
 void basVmSetInputCallback(BasVmT *vm, BasInputFnT fn, void *ctx);
@@ -622,6 +718,9 @@ void basVmSetPrinterCallbacks(BasVmT *vm, const BasPrinterCallbacksT *printer);
 // STRIG, FRAMEWAIT).
 void basVmSetDeviceCallbacks(BasVmT *vm, const BasDeviceCallbacksT *device);
 
+// Set the program screen callbacks.
+void basVmSetScreenHost(BasVmT *vm, const BasScreenHostT *host);
+
 // Set UI callbacks (for form/control system).
 void basVmSetSqlCallbacks(BasVmT *vm, const BasSqlCallbacksT *sql);
 void basVmSetUiCallbacks(BasVmT *vm, const BasUiCallbacksT *ui);