Files
akbasic/src/runtime_graphics.c
Andrew Kesterson 8594d8471d Honour a subscript in SSHAPE and GSHAPE
`shape_variable()` took the identifier off the leaf and looked the variable up
without ever evaluating the subscript, and both verbs then addressed element
zero with a literal. So `SSHAPE SH$(2), ...` wrote the handle into `SH$(0)` and
`GSHAPE SH$(2)` stamped whatever was in `SH$(0)`.

Ordinary assignment and `PRINT` honour the subscript, which is what made this
expensive: a program keeping several saved shapes in an array got every one of
them resolving to the same element, silently, and the only symptom was that
every stamp came out as the last shape captured. The Breakout in examples/ keeps
its six brick stamps in six separate scalars for exactly this reason.

`SPRSAV` was the counter-example and is the model -- it evaluates its argument
and handles an array element correctly. The subscript resolution itself is now
shared: `collect_subscripts()` comes out of src/environment.c as
`akbasic_environment_collect_subscripts()`, so a verb taking a variable by name
resolves a subscript the same way assignment does rather than each verb deciding
for itself.

tests/graphics_verbs.c covers TODO.md's reduction -- which used to print
"[SHAPE:0] []" and now prints "[] [SHAPE:0]" -- and the case a program actually
wants: two shapes captured into two elements, each stamped back through its own,
asserted against the device log so a fix that merely made the strings look right
would not pass.

Chapter 18's trap 4 becomes history, and Chapter 6 says an array works.

TODO.md section 9 item 6, struck.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
2026-08-02 00:10:24 -04:00

786 lines
30 KiB
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 <akstdlib.h>
#include <akbasic/args.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, and ask its size.
*
* 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.
*
* It is also where the drawing surface's size is refreshed, which is why the two
* jobs are one function: the size is wanted by every verb that draws, every verb
* that draws already opens with this, and a window can be resized between two
* statements. A backend with no `size` -- it is the record's one optional entry
* point -- keeps whatever akbasic_graphics_state_init() left, which is 320x200.
*/
static akerr_ErrorContext *require_graphics(akbasic_Runtime *obj, const char *verb)
{
PREPARE_ERROR(errctx);
int width = 0;
int height = 0;
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);
if ( obj->graphics->size != NULL ) {
PASS(errctx, obj->graphics->size(obj->graphics, &width, &height));
/*
* A device reporting nothing useful is not an error -- an SDL window
* mid-resize legitimately measures zero -- but it must not become the
* space a program draws into, because dividing by it in scale_point
* would send every scaled coordinate to infinity.
*/
if ( width > 0 && height > 0 ) {
obj->gfx.devwidth = width;
obj->gfx.devheight = height;
}
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Map a user coordinate onto the device pixels the backend receives.
*
* With SCALE off this is the identity, and a coordinate is a device pixel: the
* whole of the host's window is reachable from BASIC. With SCALE on, the
* program's coordinates run 0..xmax across the same surface, so the ratio is all
* there is to it -- and the surface is however big the device last said it was,
* which is what makes `SCALE 1, 319, 199` the way to run a C128 listing full
* screen.
*
* **`xmax` maps onto the last pixel, not onto the width**, which is a
* one-character difference and the whole difference between that sentence being
* true and being nearly true. Dividing by the width sends `SCALE 1, 319, 199`
* plus `DRAW 1, 319, 199` to (width, height) -- one past the bottom-right
* corner, off the surface, drawing nothing. A user maximum is a coordinate the
* program is entitled to plot, the same way 7.0's own `SCALE 1` then
* `DRAW 1, 1023, 1023` reaches the corner of a C128 screen rather than missing it.
*/
static void scale_point(akbasic_GraphicsState *gfx, double *x, double *y)
{
if ( !gfx->scaling ) {
return;
}
if ( gfx->xmax > 0.0 && gfx->devwidth > 1 ) {
*x = (*x / gfx->xmax) * (double)(gfx->devwidth - 1);
}
if ( gfx->ymax > 0.0 && gfx->devheight > 1 ) {
*y = (*y / gfx->ymax) * (double)(gfx->devheight - 1);
}
}
/**
* @brief Draw a line `WIDTH` pixels thick.
*
* BASIC 7.0's `WIDTH` sets the thickness of the lines the graphics verbs draw,
* and the backend record has no thickness argument -- neither does libakgl's
* akgl_draw_line, which is what it would have to reach. So a thick line is drawn
* as parallel passes, offset perpendicular to whichever axis the line runs along.
* That is what a C128 does in effect and it needs nothing new from the device.
*
* Approximate for a diagonal, where offsetting along one axis leaves the passes a
* fraction under a pixel apart. At WIDTH 2 -- the only other value the verb
* accepts -- that is not visible; a general thickness would want a real
* perpendicular offset and an API that takes one.
*/
static akerr_ErrorContext *draw_line(akbasic_Runtime *obj, double x1, double y1, double x2, double y2, akbasic_Color color)
{
PREPARE_ERROR(errctx);
double dx = (x2 > x1 ? x2 - x1 : x1 - x2);
double dy = (y2 > y1 ? y2 - y1 : y1 - y2);
bool steep = (dy > dx);
int pass = 0;
int width = (obj->gfx.linewidth > 0 ? obj->gfx.linewidth : 1);
/*
* 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.
*/
for ( pass = 0; pass < width; pass++ ) {
double offset = (double)pass;
if ( steep ) {
PASS(errctx, obj->graphics->line(obj->graphics, x1 + offset, y1,
x2 + offset, y2, color));
} else {
PASS(errctx, obj->graphics->line(obj->graphics, x1, y1 + offset,
x2, y2 + offset, color));
}
}
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------- 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, akbasic_args_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, akbasic_args_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, akbasic_args_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, akbasic_args_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);
}
/* ----------------------------------------------------------------- RGR --- */
akerr_ErrorContext *akbasic_fn_rgr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *out = NULL;
double args[1];
int count = 0;
int field = 0;
int columns = 0;
int rows = 0;
int cellw = 0;
int cellh = 0;
int64_t answer = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in RGR");
PASS(errctx, akbasic_args_numbers(obj, expr, "RGR", args, 1, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX, "RGR expected a field number");
field = (int)args[0];
/*
* Field 0 is BASIC 7.0's whole RGR: the current GRAPHIC mode. It answers
* from state and works with no device, because a program can ask what mode
* it set without a screen to set it on.
*
* Fields 1 and 2 are ours, and they are the half of item 9 a program can
* see: the drawing surface's real width and height in pixels, so a listing
* can fill whatever window the host opened instead of assuming 320x200.
* They go through require_graphics(), which is both the refusal when there
* is no device -- asking how big the screen is when there is no screen is a
* program bug worth reporting -- and the refresh that makes the answer
* current rather than whatever it was at attach.
*
* Fields 3 and 4 are ours too, and come from the text sink rather than the
* graphics device; see the comment on them below.
*/
switch ( field ) {
case 0:
answer = (int64_t)obj->gfx.mode;
break;
case 1:
PASS(errctx, require_graphics(obj, "RGR"));
answer = (int64_t)obj->gfx.devwidth;
break;
case 2:
PASS(errctx, require_graphics(obj, "RGR"));
answer = (int64_t)obj->gfx.devheight;
break;
/*
* Fields 3 and 4 are the character cell, in the same pixels fields 1 and 2
* are in -- so a program can place a character and a sprite at the same spot
* without hardcoding a size measured against the host's font. They come from
* the *sink*, which is where a grid lives, and the grid is a text device's
* property rather than a graphics one: hence a separate refusal, naming the
* text device rather than the graphics one.
*
* `RWINDOW` answers the other half -- how many columns and rows there are --
* and it is the C128's own function for that question. This is here rather
* than on RWINDOW because a cell size is a fact about the surface, and
* because RWINDOW reports the current *window*, which makes dividing the
* surface by the column count wrong the moment a program calls `WINDOW`.
*/
case 3:
case 4:
FAIL_ZERO_RETURN(errctx, (obj->sink != NULL), AKBASIC_ERR_DEVICE,
"RGR needs a text device and this runtime has none");
FAIL_ZERO_RETURN(errctx, (obj->sink->grid != NULL), AKBASIC_ERR_DEVICE,
"RGR needs a text device with a character grid, and this one has none");
PASS(errctx, obj->sink->grid(obj->sink, &columns, &rows, &cellw, &cellh));
answer = (field == 3 ? (int64_t)cellw : (int64_t)cellh);
break;
default:
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS, "RGR: field %d is outside 0..4", field);
}
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
PASS(errctx, akbasic_value_zero(out));
out->valuetype = AKBASIC_TYPE_INTEGER;
out->intval = answer;
*dest = out;
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, akbasic_args_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, draw_line(obj, 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, akbasic_args_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, draw_line(obj, 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, akbasic_args_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, draw_line(obj, 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, akbasic_args_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, and its subscript.
*
* 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 akbasic_args_numbers().
*
* **The subscript is evaluated**, which it was not: this used to hand back the
* variable and both verbs then addressed element zero with a literal, so
* `SSHAPE SH$(2), ...` wrote the handle into `SH$(0)` and `GSHAPE SH$(2)`
* stamped whatever was in `SH$(0)`. Ordinary assignment and `PRINT` honour the
* subscript, so a program keeping several saved shapes in an array got every one
* of them resolving to the same element -- silently, the symptom being that
* every stamp came out as the last shape captured. TODO.md section 9 item 6.
*
* `SPRSAV` was the counter-example and is the model: it evaluates its argument
* (`src/runtime_sprite.c`) and handles an array element correctly.
*/
static akerr_ErrorContext *shape_variable(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, akbasic_Variable **dest, int64_t *subscripts, int *subscriptcount, 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");
FAIL_ZERO_RETURN(errctx, (subscripts != NULL && subscriptcount != NULL),
AKERR_NULLPOINTER, "NULL subscript output 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);
PASS(errctx, akbasic_environment_collect_subscripts(obj->environment, arg,
subscripts, subscriptcount));
*rest = arg->next;
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 subscripts[AKBASIC_MAX_ARRAY_DEPTH];
int subscriptcount = 0;
(void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "SSHAPE"));
PASS(errctx, shape_variable(obj, expr, "SSHAPE", &variable,
subscripts, &subscriptcount, &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->next;
}
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, subscripts, subscriptcount));
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;
long long converted = 0;
double x = 0.0;
double y = 0.0;
int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH];
int subscriptcount = 0;
(void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "GSHAPE"));
PASS(errctx, shape_variable(obj, expr, "GSHAPE", &variable,
subscripts, &subscriptcount, &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->next;
}
x = (count >= 1) ? coords[0] : obj->gfx.x;
y = (count >= 2) ? coords[1] : obj->gfx.y;
PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &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, aksl_atoll(stored->stringval + strlen(SHAPE_PREFIX), &converted));
handle = (int64_t)converted;
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);
}