akbasic/src/runtime_input.c

/**
 * @file runtime_input.c
 * @brief The console input verbs: GET, GETKEY and SCNCLR.
 *
 * Same rule as the other two device files -- no SDL here, everything through the
 * akbasic_InputBackend record. The libakgl implementation behind it is
 * akgl_controller_poll_key(), which drains a ring the library fills from SDL
 * events the *host* pumps, so the interpreter answers "is there a key waiting"
 * without owning an event loop.
 *
 * GET and GETKEY differ in exactly one way and it is the interesting one. GET
 * takes whatever is there, including nothing. GETKEY waits -- and since the
 * library may not block, waiting is spelled as holding the step loop rather than
 * as sitting on the keyboard. See TODO.md section 5.
 */

#include <string.h>

#include <akerror.h>

#include <akbasic/error.h>
#include <akbasic/input.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 Refuse politely when the host lent us no input device. */
static akerr_ErrorContext *require_input(akbasic_Runtime *obj, const char *verb)
{
    PREPARE_ERROR(errctx);

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

/**
 * @brief Identify the variable a GET or GETKEY assigns into.
 *
 * A string variable receives the character; a numeric one receives the key code,
 * which is what a program testing for cursor keys or function keys wants.
 */
static akerr_ErrorContext *target_variable(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, akbasic_Variable **dest, bool *numeric)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL && numeric != NULL),
		     AKERR_NULLPOINTER, "NULL argument in target_variable");
    arg = akbasic_leaf_first_argument(expr);
    if ( arg == NULL ) {
	arg = expr->right;
    }
    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
		     "%s expected a variable", verb);
    FAIL_ZERO_RETURN(errctx,
		     (arg->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
		      arg->leaftype == AKBASIC_LEAF_IDENTIFIER_INT),
		     AKBASIC_ERR_TYPE,
		     "%s expected a string or integer variable", verb);
    *numeric = (arg->leaftype == AKBASIC_LEAF_IDENTIFIER_INT);
    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);
    SUCCEED_RETURN(errctx);
}

/** @brief Write a keystroke, or the absence of one, into the target variable. */
static akerr_ErrorContext *store_key(akbasic_Variable *variable, bool numeric, int keycode, bool available)
{
    PREPARE_ERROR(errctx);
    int64_t zerosubscript[1] = { 0 };
    char text[2];

    if ( numeric ) {
	/* No key is code zero, which is what a C128 reports too. */
	PASS(errctx, akbasic_variable_set_integer(variable, available ? (int64_t)keycode : 0,
						  zerosubscript, 1));
	SUCCEED_RETURN(errctx);
    }
    text[0] = (available && keycode > 0 && keycode < 128) ? (char)keycode : '\0';
    text[1] = '\0';
    PASS(errctx, akbasic_variable_set_string(variable, text, zerosubscript, 1));
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- GET --- */

akerr_ErrorContext *akbasic_cmd_get(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    bool numeric = false;
    bool available = false;
    int keycode = 0;

    (void)lval; (void)rval;
    PASS(errctx, require_input(obj, "GET"));
    PASS(errctx, target_variable(obj, expr, "GET", &variable, &numeric));

    /*
     * An empty buffer is success with the empty string, not an error. That is
     * what happens on most iterations of any GET loop ever written, and libakgl
     * is explicit that its poll reports it the same way.
     */
    PASS(errctx, obj->input->poll_key(obj->input, &keycode, &available));
    PASS(errctx, store_key(variable, numeric, keycode, available));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------------- GETKEY --- */

akerr_ErrorContext *akbasic_cmd_getkey(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;
    bool numeric = false;
    bool available = false;
    int keycode = 0;

    (void)lval; (void)rval;
    PASS(errctx, require_input(obj, "GETKEY"));
    PASS(errctx, target_variable(obj, expr, "GETKEY", &variable, &numeric));

    PASS(errctx, obj->input->poll_key(obj->input, &keycode, &available));
    if ( available ) {
	obj->input_state.waiting = false;
	PASS(errctx, store_key(variable, numeric, keycode, true));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    /*
     * Nothing typed yet. A C128 would sit here; the library may not, so instead
     * the step loop is told to stop advancing the program counter. The line
     * re-executes on each step until a key turns up, which looks the same to the
     * program and leaves the host its frame rate. TODO.md section 5.
     */
    arg = akbasic_leaf_first_argument(expr);
    if ( arg == NULL ) {
	arg = expr->right;
    }
    obj->input_state.waiting = true;
    obj->input_state.numeric = numeric;
    strncpy(obj->input_state.variable, arg->identifier,
	    sizeof(obj->input_state.variable) - 1);
    obj->input_state.variable[sizeof(obj->input_state.variable) - 1] = '\0';
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_input_service(akbasic_Runtime *obj, bool *blocked)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    bool available = false;
    int keycode = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && blocked != NULL), AKERR_NULLPOINTER,
		     "NULL argument in input_service");
    *blocked = false;
    if ( !obj->input_state.waiting ) {
	SUCCEED_RETURN(errctx);
    }
    /*
     * A host that takes the input device away while a GETKEY is holding would
     * otherwise wedge the script forever. Release it instead -- the variable
     * keeps whatever it had, which is the empty string.
     */
    if ( obj->input == NULL ) {
	obj->input_state.waiting = false;
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, obj->input->poll_key(obj->input, &keycode, &available));
    if ( !available ) {
	*blocked = true;
	SUCCEED_RETURN(errctx);
    }

    obj->input_state.waiting = false;
    PASS(errctx, akbasic_environment_get(obj->environment, obj->input_state.variable, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
		     "GETKEY could not reach the variable %s", obj->input_state.variable);
    PASS(errctx, store_key(variable, obj->input_state.numeric, keycode, true));
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------------- SCNCLR --- */

akerr_ErrorContext *akbasic_cmd_scnclr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in SCNCLR");

    /*
     * Clearing the text screen is the sink's job, not a device's -- the sink is
     * where PRINT already goes, and it is the only thing that knows what a
     * "screen" means for this host. The stdio sink treats it as a no-op, since
     * clearing a pipe means nothing.
     */
    PASS(errctx, obj->sink->clear(obj->sink));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}