akbasic/src/runtime_graphics.c

/**
 * @file runtime_graphics.c
 * @brief The group G verb implementations: GRAPHIC, COLOR, DRAW, BOX, CIRCLE,
 *        PAINT, SCALE, SSHAPE, GSHAPE and LOCATE.
 *
 * Nothing here includes an SDL or a libakgl header. Every drawing call goes
 * through the akbasic_GraphicsBackend record the host attached, which is what
 * lets the whole group be tested in a build with no SDL on the machine.
 *
 * These verbs are not in the Go reference -- it lists all of them as
 * unimplemented -- so the semantics come from Commodore BASIC 7.0 rather than
 * from a port. Where 7.0 does something a modern renderer cannot, the deviation
 * is recorded in TODO.md section 5 rather than papered over here.
 */

#include <math.h>
#include <stdio.h>
#include <string.h>

#include <akerror.h>

#include <akbasic/convert.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>

#include "verbs.h"

/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest)			\
    do {						\
	*(__dest) = &(__obj)->staticTrueValue;		\
    } while ( 0 )

/** @brief What SSHAPE writes into the string variable, ahead of the slot number. */
#define SHAPE_PREFIX		"SHAPE:"

/** @brief CIRCLE's default arc increment, in degrees. BASIC 7.0 uses two. */
#define CIRCLE_DEFAULT_INC	2.0

/**
 * @brief Refuse politely when the host lent us no graphics device.
 *
 * Every verb in this file opens with it. The standalone driver attaches no
 * backend at all, so this is the common path rather than an edge case, and it
 * has to name the verb -- "no graphics device" on its own tells a program author
 * nothing about which line to look at.
 */
static akerr_ErrorContext *require_graphics(akbasic_Runtime *obj, const char *verb)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && verb != NULL), AKERR_NULLPOINTER,
		     "NULL argument in require_graphics");
    FAIL_ZERO_RETURN(errctx, (obj->graphics != NULL), AKBASIC_ERR_DEVICE,
		     "%s needs a graphics device and this runtime has none", verb);
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Collect a verb's arguments into an array, evaluating each one.
 *
 * The graphics verbs all take a short positional list with optional trailing
 * members, so every handler wants the same thing: how many arguments arrived,
 * and their numeric values. Strings are refused here rather than in each verb --
 * SSHAPE and GSHAPE, which do take one, read their leaf directly instead.
 *
 * @param obj Runtime to evaluate against.
 * @param expr The command leaf.
 * @param verb Name to use in a diagnostic.
 * @param values Where to put the evaluated arguments.
 * @param max Capacity of `values`.
 * @param count Output destination populated by the function.
 */
static akerr_ErrorContext *collect_numbers(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, double *values, int max, int *count)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Value *value = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && values != NULL && count != NULL),
		     AKERR_NULLPOINTER, "NULL argument in collect_numbers");
    *count = 0;
    arg = akbasic_leaf_first_argument(expr);
    /*
     * A loop, so CATCH and the _BREAK macros are banned in here -- they expand to
     * a C break and would leave the loop with an error still pending. PASS and
     * the _RETURN forms only.
     */
    while ( arg != NULL ) {
	FAIL_NONZERO_RETURN(errctx, (*count >= max), AKBASIC_ERR_SYNTAX,
			    "%s takes at most %d arguments", verb, max);
	PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING),
			    AKBASIC_ERR_TYPE,
			    "%s expected a number in argument %d", verb, *count + 1);
	if ( value->valuetype == AKBASIC_TYPE_FLOAT ) {
	    values[*count] = value->floatval;
	} else {
	    values[*count] = (double)value->intval;
	}
	*count += 1;
	arg = arg->right;
    }
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Map a user coordinate onto the 320x200 space the backend receives.
 *
 * With SCALE off this is the identity. With it on, BASIC's user coordinates run
 * 0..xmax across the same screen, so the ratio is all there is to it.
 */
static void scale_point(akbasic_GraphicsState *gfx, double *x, double *y)
{
    if ( !gfx->scaling ) {
	return;
    }
    if ( gfx->xmax > 0.0 ) {
	*x = (*x / gfx->xmax) * (double)AKBASIC_GRAPHICS_WIDTH;
    }
    if ( gfx->ymax > 0.0 ) {
	*y = (*y / gfx->ymax) * (double)AKBASIC_GRAPHICS_HEIGHT;
    }
}

/* ------------------------------------------------------------- GRAPHIC --- */

akerr_ErrorContext *akbasic_cmd_graphic(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[2];
    int count = 0;
    int mode = 0;
    akbasic_Color background;

    (void)lval; (void)rval;
    PASS(errctx, require_graphics(obj, "GRAPHIC"));
    PASS(errctx, collect_numbers(obj, expr, "GRAPHIC", args, 2, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX, "GRAPHIC expected a mode");

    mode = (int)args[0];
    /*
     * BASIC 7.0 numbers five modes plus a CLR. They differ in bitmap resolution
     * and in whether the bottom of the screen stays text, neither of which means
     * anything against a host's renderer -- so the mode is recorded and only its
     * one observable consequence is honoured: mode 0 is text, and text mode does
     * not draw. Refusing an out-of-range mode still matters, because that is a
     * typo the program author can fix.
     */
    FAIL_ZERO_RETURN(errctx, (mode >= 0 && mode <= 5), AKBASIC_ERR_BOUNDS,
		     "GRAPHIC mode %d out of range (0 to 5)", mode);
    if ( mode == 5 ) {
	/* GRAPHIC CLR: drop the saved shapes and go back to text. */
	PASS(errctx, obj->graphics->free_shapes(obj->graphics));
	PASS(errctx, akbasic_graphics_state_init(&obj->gfx));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    obj->gfx.mode = mode;
    if ( count >= 2 && args[1] != 0.0 ) {
	PASS(errctx, akbasic_graphics_source_color(&obj->gfx, 0, &background));
	PASS(errctx, obj->graphics->clear(obj->graphics, background));
	obj->gfx.x = 0.0;
	obj->gfx.y = 0.0;
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* --------------------------------------------------------------- COLOR --- */

akerr_ErrorContext *akbasic_cmd_color(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[2];
    int count = 0;
    int source = 0;
    int index = 0;

    (void)lval; (void)rval;
    /*
     * COLOR is the one verb in the group that does not touch the device: it
     * binds a source to a palette index and the drawing verbs resolve that later.
     * So it works with no graphics backend attached, which lets a program set its
     * colors up before the host has lent it a renderer.
     */
    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in COLOR");
    PASS(errctx, collect_numbers(obj, expr, "COLOR", args, 2, &count));
    FAIL_ZERO_RETURN(errctx, (count == 2), AKBASIC_ERR_SYNTAX,
		     "COLOR expected a source and a color");

    source = (int)args[0];
    index = (int)args[1];
    FAIL_ZERO_RETURN(errctx, (source >= 0 && source < AKBASIC_COLOR_SOURCES),
		     AKBASIC_ERR_BOUNDS, "COLOR source %d out of range (0 to %d)",
		     source, AKBASIC_COLOR_SOURCES - 1);
    FAIL_ZERO_RETURN(errctx, (index >= 1 && index <= 16), AKBASIC_ERR_BOUNDS,
		     "COLOR %d out of range (1 to 16)", index);
    obj->gfx.source[source] = index;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------------- LOCATE --- */

akerr_ErrorContext *akbasic_cmd_locate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[2];
    int count = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in LOCATE");
    PASS(errctx, collect_numbers(obj, expr, "LOCATE", args, 2, &count));
    FAIL_ZERO_RETURN(errctx, (count == 2), AKBASIC_ERR_SYNTAX, "LOCATE expected X, Y");

    /*
     * LOCATE moves the *graphics* pixel cursor -- the point a DRAW with no
     * starting coordinate begins from. The text cursor is CHAR's business. It
     * needs no device, so it works before a renderer is attached.
     */
    obj->gfx.x = args[0];
    obj->gfx.y = args[1];
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* --------------------------------------------------------------- SCALE --- */

akerr_ErrorContext *akbasic_cmd_scale(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[3];
    int count = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in SCALE");
    PASS(errctx, collect_numbers(obj, expr, "SCALE", args, 3, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX, "SCALE expected 0 or 1");

    /* Pure coordinate arithmetic -- nothing reaches the device. */
    obj->gfx.scaling = (args[0] != 0.0);
    if ( count >= 3 ) {
	FAIL_ZERO_RETURN(errctx, (args[1] > 0.0 && args[2] > 0.0), AKBASIC_ERR_VALUE,
			 "SCALE maxima must be positive");
	obj->gfx.xmax = args[1];
	obj->gfx.ymax = args[2];
    } else if ( obj->gfx.scaling ) {
	/* BASIC 7.0's default scaled space. */
	obj->gfx.xmax = 1023.0;
	obj->gfx.ymax = 1023.0;
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- DRAW --- */

akerr_ErrorContext *akbasic_cmd_draw(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[32];
    int count = 0;
    int i = 0;
    akbasic_Color color;
    double x = 0.0;
    double y = 0.0;
    double px = 0.0;
    double py = 0.0;

    (void)lval; (void)rval;
    PASS(errctx, require_graphics(obj, "DRAW"));
    PASS(errctx, collect_numbers(obj, expr, "DRAW", args, 32, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX,
		     "DRAW expected a color source");
    FAIL_NONZERO_RETURN(errctx, (count > 1 && (count % 2) == 0), AKBASIC_ERR_SYNTAX,
			"DRAW expected coordinates in X,Y pairs");
    PASS(errctx, akbasic_graphics_source_color(&obj->gfx, (int)args[0], &color));

    if ( count == 1 ) {
	/* DRAW with no coordinates plots the pixel cursor, as 7.0 does. */
	x = obj->gfx.x;
	y = obj->gfx.y;
	scale_point(&obj->gfx, &x, &y);
	PASS(errctx, obj->graphics->point(obj->graphics, x, y, color));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    if ( count == 3 ) {
	/* A single pair is a point, not a line from wherever the cursor was. */
	x = args[1];
	y = args[2];
	scale_point(&obj->gfx, &x, &y);
	PASS(errctx, obj->graphics->point(obj->graphics, x, y, color));
	obj->gfx.x = args[1];
	obj->gfx.y = args[2];
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    /* Two or more pairs is a polyline. Scale each end, never the segment. */
    for ( i = 1; i + 3 < count + 1; i += 2 ) {
	px = args[i];
	py = args[i + 1];
	x = args[i + 2];
	y = args[i + 3];
	scale_point(&obj->gfx, &px, &py);
	scale_point(&obj->gfx, &x, &y);
	PASS(errctx, obj->graphics->line(obj->graphics, px, py, x, y, color));
    }
    obj->gfx.x = args[count - 2];
    obj->gfx.y = args[count - 1];
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- BOX --- */

akerr_ErrorContext *akbasic_cmd_box(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[6];
    int count = 0;
    int corner = 0;
    akbasic_Color color;
    double x1 = 0.0;
    double y1 = 0.0;
    double x2 = 0.0;
    double y2 = 0.0;
    double angle = 0.0;
    double cx = 0.0;
    double cy = 0.0;
    double radians = 0.0;
    double xs[4];
    double ys[4];
    double rx = 0.0;
    double ry = 0.0;

    (void)lval; (void)rval;
    PASS(errctx, require_graphics(obj, "BOX"));
    PASS(errctx, collect_numbers(obj, expr, "BOX", args, 6, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 3), AKBASIC_ERR_SYNTAX,
		     "BOX expected a color source and at least one corner");
    PASS(errctx, akbasic_graphics_source_color(&obj->gfx, (int)args[0], &color));

    x1 = args[1];
    y1 = args[2];
    x2 = (count >= 5) ? args[3] : obj->gfx.x;
    y2 = (count >= 5) ? args[4] : obj->gfx.y;
    angle = (count >= 6) ? args[5] : 0.0;

    scale_point(&obj->gfx, &x1, &y1);
    scale_point(&obj->gfx, &x2, &y2);

    if ( angle == 0.0 ) {
	/*
	 * BASIC 7.0's last argument selects outline or fill. It is the sixth,
	 * and the fifth is the rotation, so a filled box is BOX s,x1,y1,x2,y2,a,1
	 * -- seven arguments, one more than this collects. Filling is therefore
	 * reached by the rotation being absent and is spelled with a negative
	 * angle; that is a deviation and is recorded in TODO.md section 5.
	 */
	PASS(errctx, obj->graphics->rect(obj->graphics, x1, y1, x2, y2, color));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    /*
     * A rotated box is four lines, because a renderer's rectangle is axis-aligned
     * by construction. Rotation is about the box's own center, which is what 7.0
     * does, and the angle is clockwise in degrees.
     */
    cx = (x1 + x2) / 2.0;
    cy = (y1 + y2) / 2.0;
    rx = (x2 - x1) / 2.0;
    ry = (y2 - y1) / 2.0;
    radians = angle * (M_PI / 180.0);

    xs[0] = -rx; ys[0] = -ry;
    xs[1] =  rx; ys[1] = -ry;
    xs[2] =  rx; ys[2] =  ry;
    xs[3] = -rx; ys[3] =  ry;
    for ( corner = 0; corner < 4; corner++ ) {
	double ox = xs[corner];
	double oy = ys[corner];
	xs[corner] = cx + (ox * cos(radians)) - (oy * sin(radians));
	ys[corner] = cy + (ox * sin(radians)) + (oy * cos(radians));
    }
    for ( corner = 0; corner < 4; corner++ ) {
	PASS(errctx, obj->graphics->line(obj->graphics,
					 xs[corner], ys[corner],
					 xs[(corner + 1) % 4], ys[(corner + 1) % 4],
					 color));
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------------- CIRCLE --- */

akerr_ErrorContext *akbasic_cmd_circle(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[9];
    int count = 0;
    akbasic_Color color;
    double cx = 0.0;
    double cy = 0.0;
    double xr = 0.0;
    double yr = 0.0;
    double start = 0.0;
    double end = 360.0;
    double rotation = 0.0;
    double inc = CIRCLE_DEFAULT_INC;
    double theta = 0.0;
    double px = 0.0;
    double py = 0.0;
    double x = 0.0;
    double y = 0.0;
    bool first = true;

    (void)lval; (void)rval;
    PASS(errctx, require_graphics(obj, "CIRCLE"));
    PASS(errctx, collect_numbers(obj, expr, "CIRCLE", args, 9, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 4), AKBASIC_ERR_SYNTAX,
		     "CIRCLE expected a color source, a center and a radius");
    PASS(errctx, akbasic_graphics_source_color(&obj->gfx, (int)args[0], &color));

    cx = args[1];
    cy = args[2];
    xr = args[3];
    yr = (count >= 5) ? args[4] : xr;
    if ( count >= 7 ) {
	start = args[5];
	end = args[6];
    }
    rotation = (count >= 8) ? args[7] : 0.0;
    inc = (count >= 9) ? args[8] : CIRCLE_DEFAULT_INC;

    FAIL_ZERO_RETURN(errctx, (xr >= 0.0 && yr >= 0.0), AKBASIC_ERR_VALUE,
		     "CIRCLE radius must not be negative");
    FAIL_ZERO_RETURN(errctx, (inc > 0.0), AKBASIC_ERR_VALUE,
		     "CIRCLE arc increment must be positive");

    /*
     * Drawn as a polygon of `inc`-degree segments rather than through the
     * renderer's circle primitive. That is not a workaround for a missing API:
     * BASIC 7.0's CIRCLE takes two radii, an arc range and a rotation, and is
     * specified as an inc-degree polygon. A midpoint circle could only serve the
     * one case where all of those are default, and a shape that changed
     * character depending on whether the radii happened to be equal would be
     * worse than one that is uniformly a polygon. TODO.md section 5.
     */
    for ( theta = start; ; theta += inc ) {
	double t = (theta > end) ? end : theta;
	double radians = t * (M_PI / 180.0);
	double ox = xr * sin(radians);
	double oy = -yr * cos(radians);
	double rot = rotation * (M_PI / 180.0);

	x = cx + (ox * cos(rot)) - (oy * sin(rot));
	y = cy + (ox * sin(rot)) + (oy * cos(rot));
	scale_point(&obj->gfx, &x, &y);
	if ( !first ) {
	    PASS(errctx, obj->graphics->line(obj->graphics, px, py, x, y, color));
	}
	first = false;
	px = x;
	py = y;
	if ( t >= end ) {
	    break;
	}
    }
    obj->gfx.x = cx;
    obj->gfx.y = cy;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* --------------------------------------------------------------- PAINT --- */

akerr_ErrorContext *akbasic_cmd_paint(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[4];
    int count = 0;
    akbasic_Color color;
    double x = 0.0;
    double y = 0.0;
    bool partial = false;

    (void)lval; (void)rval;
    PASS(errctx, require_graphics(obj, "PAINT"));
    PASS(errctx, collect_numbers(obj, expr, "PAINT", args, 4, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 3), AKBASIC_ERR_SYNTAX,
		     "PAINT expected a color source and a coordinate");
    PASS(errctx, akbasic_graphics_source_color(&obj->gfx, (int)args[0], &color));

    x = args[1];
    y = args[2];
    scale_point(&obj->gfx, &x, &y);

    /*
     * The akgl flood fill walks spans from a fixed stack and reports
     * AKERR_OUTOFBOUNDS when it runs out, having filled *part* of the region.
     * Reporting that to the program is the whole point: a screen that came back
     * half-painted with no diagnostic is worse than an error, because the
     * program cannot tell it happened.
     */
    ATTEMPT {
	CATCH(errctx, obj->graphics->paint(obj->graphics, (int)x, (int)y, color));
    } CLEANUP {
    } PROCESS(errctx) {
    } HANDLE(errctx, AKERR_OUTOFBOUNDS) {
	partial = true;
    } FINISH(errctx, true);

    /*
     * Raised out here rather than inside the HANDLE block. HANDLE sets
     * handled = true on the context, and a FAIL_RETURN from inside it hands the
     * caller a context already marked handled -- whose FINISH_LOGIC then declines
     * to pass it up and releases it instead. The error vanishes and PAINT looks
     * like it worked. Flag inside, raise outside.
     */
    FAIL_NONZERO_RETURN(errctx, partial, AKBASIC_ERR_DEVICE,
			"PAINT filled only part of the region: the device ran out of fill space");

    obj->gfx.x = args[1];
    obj->gfx.y = args[2];
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------- SSHAPE and GSHAPE --- */

/**
 * @brief Find the string variable a shape verb reads or writes.
 *
 * SSHAPE and GSHAPE are the only two verbs in the group whose first argument is
 * an identifier rather than a number, so they walk the leaf themselves instead
 * of going through collect_numbers().
 */
static akerr_ErrorContext *shape_variable(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, akbasic_Variable **dest, akbasic_ASTLeaf **rest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL && rest != NULL),
		     AKERR_NULLPOINTER, "NULL argument in shape_variable");
    arg = akbasic_leaf_first_argument(expr);
    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
		     "%s expected a string variable", verb);
    FAIL_ZERO_RETURN(errctx, (arg->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING),
		     AKBASIC_ERR_TYPE, "%s expected a string variable", verb);
    PASS(errctx, akbasic_environment_get(obj->environment, arg->identifier, dest));
    FAIL_ZERO_RETURN(errctx, (*dest != NULL), AKBASIC_ERR_UNDEFINED,
		     "%s could not reach the variable %s", verb, arg->identifier);
    *rest = arg->right;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_sshape(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Value *value = NULL;
    double coords[4];
    int count = 0;
    int handle = -1;
    char encoded[AKBASIC_MAX_STRING_LENGTH];
    int64_t zerosubscript[1] = { 0 };

    (void)lval; (void)rval;
    PASS(errctx, require_graphics(obj, "SSHAPE"));
    PASS(errctx, shape_variable(obj, expr, "SSHAPE", &variable, &arg));

    while ( arg != NULL && count < 4 ) {
	PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING),
			    AKBASIC_ERR_TYPE, "SSHAPE expected a number in argument %d", count + 2);
	coords[count] = (value->valuetype == AKBASIC_TYPE_FLOAT)
	    ? value->floatval : (double)value->intval;
	count += 1;
	arg = arg->right;
    }
    FAIL_ZERO_RETURN(errctx, (count >= 2), AKBASIC_ERR_SYNTAX,
		     "SSHAPE expected A$, X1, Y1");
    if ( count < 4 ) {
	coords[2] = obj->gfx.x;
	coords[3] = obj->gfx.y;
    }

    PASS(errctx, obj->graphics->save_shape(obj->graphics,
					   (int)coords[0], (int)coords[1],
					   (int)coords[2], (int)coords[3], &handle));

    /*
     * A real C128 packs the pixels into the string. Here a value's string is a
     * fixed 256 bytes and the region is a device surface, so what goes in is a
     * handle to it. A program can still pass the string to GSHAPE, which is all
     * BASIC ever does with it; what it can no longer do is save it to disk or
     * take its LEN and get a size. TODO.md section 5.
     */
    snprintf(encoded, sizeof(encoded), "%s%d", SHAPE_PREFIX, handle);
    PASS(errctx, akbasic_variable_set_string(variable, encoded, zerosubscript, 1));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_gshape(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Value *value = NULL;
    akbasic_Value *stored = NULL;
    double coords[2];
    int count = 0;
    int64_t handle = 0;
    double x = 0.0;
    double y = 0.0;
    int64_t zerosubscript[1] = { 0 };

    (void)lval; (void)rval;
    PASS(errctx, require_graphics(obj, "GSHAPE"));
    PASS(errctx, shape_variable(obj, expr, "GSHAPE", &variable, &arg));

    while ( arg != NULL && count < 2 ) {
	PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING),
			    AKBASIC_ERR_TYPE, "GSHAPE expected a number in argument %d", count + 2);
	coords[count] = (value->valuetype == AKBASIC_TYPE_FLOAT)
	    ? value->floatval : (double)value->intval;
	count += 1;
	arg = arg->right;
    }
    x = (count >= 1) ? coords[0] : obj->gfx.x;
    y = (count >= 2) ? coords[1] : obj->gfx.y;

    PASS(errctx, akbasic_variable_get_subscript(variable, zerosubscript, 1, &stored));
    FAIL_ZERO_RETURN(errctx,
		     (strncmp(stored->stringval, SHAPE_PREFIX, strlen(SHAPE_PREFIX)) == 0),
		     AKBASIC_ERR_VALUE,
		     "GSHAPE was given a string that did not come from SSHAPE");
    PASS(errctx, akbasic_str_to_int64(stored->stringval + strlen(SHAPE_PREFIX), 10, &handle));

    scale_point(&obj->gfx, &x, &y);
    PASS(errctx, obj->graphics->paste_shape(obj->graphics, (int)handle, x, y));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}