ulisp-picocalc/ulisp-extensions.ino

168 lines
3.4 KiB
C++

/*
User Extensions
*/
// Utility functions
uint8_t
dec_to_bcd(uint8_t n)
{
uint8_t bcd = 0;
uint8_t tens = n / 10;
bcd = tens << 4;
tens *= 10;
bcd += (n - tens) & 0x0f;
return bcd;
}
uint8_t
bcd_to_dec(uint8_t n)
{
return ((n>>4) * 10) + (n&0x0f);
}
// Definitions
object *
fn_now(object *args, object *env)
{
(void) env;
static unsigned long Offset;
unsigned long now = millis()/1000;
int nargs = listlength(args);
// Set time
if (nargs == 3) {
Offset = (unsigned long)((checkinteger(first(args))*60 \
+ checkinteger(second(args)))*60 \
+ checkinteger(third(args)) - now);
} else if (nargs > 0) {
error2(PSTR("wrong number of arguments"));
}
// Return time
unsigned long secs = Offset + now;
object *seconds = number(secs%60);
object *minutes = number((secs/60)%60);
object *hours = number((secs/3600)%24);
return cons(hours, cons(minutes, cons(seconds, NULL)));
}
object *
fn_lambdap(object *arg, object *env)
{
(void) env;
if (consp(arg)) {
arg = car(arg);
}
if (builtin(arg->name) == LAMBDA) {
return tee;
}
return nil;
}
object *
sp_pform(object *args, object *env)
{
pfun_t pfun = pserial;
object *sym = car(args);
object *str = car(cdr(args));
object *obj;
if (!boundp(sym, env)) {
error2(PSTR("symbol isn't bound"));
}
if (str == nil) {
obj = startstring();
pfun = pstr;
} else if (!eq(str, tee)) {
pfun = pstreamfun(args);
}
#if defined(gfxsupport)
if (pfun == gfxwrite) ppwidth = GFXPPWIDTH;
#endif
pln(pfun);
object *pair = eval(sym, env);
object *var = car(pair);
object *val = cdr(pair);
if (consp(val)) {
pfstring(PSTR("consp val"), pfun); pln(pfun);
}
if (var->name == LAMBDA) {
pfstring(PSTR("var->name == LAMBDA"), pfun); pln(pfun);
}
if (builtin(val->name) == LAMBDA) {
pfstring(PSTR("builtin -> LAMBDA"), pfun); pln(pfun);
}
// if (consp(val) && symbolp(car(val)) && builtin(car(val)->name) == LAMBDA) {
// superprint(cons(bsymbol(DEFUN), cons(var, cdr(val))), 0, pfun);
// } else if (consp(val) && car(val)->type == CODE) {
// superprint(cons(bsymbol(DEFCODE), cons(var, cdr(val))), 0, pfun);
// } else if (consp(val) && var->name == LAMBDA) {
// superprint(cons(bsymbol(DEFUN), cons(sym, val)), 0, pfun);
// } else {
// superprint(cons(bsymbol(DEFVAR), cons(var, cons(quote(val), NULL))), 0, pfun);
// }
pln(pfun);
ppwidth = PPWIDTH;
if (str == nil) {
return obj;
}
return nil;
}
// Symbol names
const char stringlambdap[] PROGMEM = "lambdap";
const char stringnow[] PROGMEM = "now";
const char stringpform[] PROGMEM = "pform";
// Documentation strings
const char doclambdap[] PROGMEM = "(lambdap x)"
"Returns t if the form passed in is a lambda.";
const char docnow[] PROGMEM = "(now [hh mm ss])\n"
"Sets the current time, or with no arguments returns the current time\n"
"as a list of three integers (hh mm ss).";
const char docpform[] PROGMEM = "(pform form str)\n"
"Print a form to a stream in a manner suitable for writing to storage.";
// Symbol lookup table
const tbl_entry_t lookup_table2[] PROGMEM = {
{ stringlambdap, fn_lambdap, 0211, doclambdap },
{ stringnow, fn_now, 0203, docnow },
{ stringpform, sp_pform, 0322, docpform },
};
// Table cross-reference functions
tbl_entry_t *tables[] = {lookup_table, lookup_table2};
const unsigned int tablesizes[] = { arraysize(lookup_table), arraysize(lookup_table2) };
const tbl_entry_t *
table(int n)
{
return tables[n];
}
unsigned int
tablesize(int n)
{
return tablesizes[n];
}