diff --git a/.gitignore b/.gitignore index ad2e80e..750642b 100644 --- a/.gitignore +++ b/.gitignore @@ -8,6 +8,8 @@ *.bak /*-test /screenshot-*.bmp +*.rom +*.rom.sym *snarf *theme diff --git a/console.txt b/console.txt index edd317b..7de956b 100644 --- a/console.txt +++ b/console.txt @@ -27,21 +27,26 @@ represents part of a response to a host-put (0x1f). the type (0x17) field explains how to interpret calls to the console vector (0x10) and where data can be read from: - - 0x00 - no input (n/a) + - 0x00 - no input (-) - 0x01 - stdin (stdin) - 0x02 - argument (stdin) - - 0x03 - argument spacer (stdin) - - 0x04 - argument end (stdin) + - 0x03 - argument spacer (-) + - 0x04 - argument end (-) - 0x05 - host response (host-get) - - 0x06 - host response end (host-get) - - 0x40 - child 0 exited (host-get contains exit code) - - 0x41 - child 1 exited (host-get contains exit code) - - 0x42 - child 2 exited (host-get contains exit code) - - 0x43 - child 3 exited (host-get contains exit code) - - 0x80 - child 0 sent data (proc-get) - - 0x81 - child 1 sent data (proc-get) - - 0x82 - child 2 sent data (proc-get) - - 0x83 - child 3 sent data (proc-get) + - 0x06 - host response end (-) + - 0x07 - stdin end (-) + - 0x20 - child 0 sent data (proc-get) + - 0x21 - child 1 sent data (proc-get) + - 0x22 - child 2 sent data (proc-get) + - 0x23 - child 3 sent data (proc-get) + - 0x40 - child 0 data end (proc-get) + - 0x41 - child 1 data end (proc-get) + - 0x42 - child 2 data end (proc-get) + - 0x43 - child 3 data end (proc-get) + - 0x80 - child 0 exited (host-get contains exit code) + - 0x81 - child 1 exited (host-get contains exit code) + - 0x82 - child 2 exited (host-get contains exit code) + - 0x83 - child 3 exited (host-get contains exit code) writing a byte to the stdout port (0x18) will send one byte of data to the emulator's stdout. @@ -74,6 +79,7 @@ using the host-put port (0x1f): + 0x01 - child 1 + 0x02 - child 2 + 0x03 - child 3 + - next 2 bits (0x0c) are unused - upper 4 bits control which pipes to use with execute: + 0x80 - use child's pty (implies 0x70) + 0x40 - read from child's stderr diff --git a/src/devices/console.c b/src/devices/console.c index 1c6174a..ed78f33 100644 --- a/src/devices/console.c +++ b/src/devices/console.c @@ -32,138 +32,254 @@ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE. */ -/* -CONSOLE DEVICE +static UxnSubprocess children[CONSOLE_MAX_CHILDREN]; +static char *fork_args[4] = {"/bin/sh", "-c", "", NULL}; +static int to_child_fd[2], from_child_fd[2]; +static char buf[16]; - 0x10 vector* 0x18 write byte* (stdout) - 0x11 (vector) 0x19 write byte* (stderr) - 0x12 read byte (stdin) 0x1a -- - 0x13 exec args 0x1b -- - 0x14 (exec args) 0x1c -- - 0x15 exec mode 0x1d -- - 0x16 exec action* 0x1e -- - 0x17 type 0x1f -- - -(* denotes a register that causes an immediate effect) - -when vector (0x10) fires, the type (0x17) field explains what kind of -event this (such as data being available to read on stdin) is and how -to handle it. - -the read byte (0x12) contains one byte of data to be read. it usually -occurs as the result of data being available on stdin, but may have -other meanings (such as an exit code from a finished process). - -exec args (0x13) is usually an address pointing to a string, which is -acted on by exec action (0x16). occasionally it may be used as an 8-bit -or 16-bit number instead (such as with exec actions 0x04-0x05). -the meaning of exec args depends on which action it is used with: - - 0x00 - unused - - 0x01 - address of a command string - - 0x02 - address of an environment variable name - - 0x03 - address of an environment variable name+value (e.g. "FOO=123") - - 0x04 - unsigned 16-bit integer - - 0x05 - unsigned 16-bit integer - - (all strings must be null-terminated) - -exec mode (0x015) provides context for exec actions (0x16): - - lower 2 bits control which child process to use: - + 0x00 - child 0 - + 0x01 - child 1 - + 0x02 - child 2 - + 0x03 - child 3 - - (next 2 bits unused) - - upper 4 bits control which pipes to use with execute: - + 0x80 - use child's pty (implies 0x70) - + 0x40 - read from child's stderr - + 0x20 - read from child's stdin - + 0x10 - write to child's stdin - -exec action (0x16) acts on the exec args address (0x13): - - 0x00 - nop, does nothing - - 0x01 - execute, starts a subprocess - - 0x02 - getenv, reads string (NAME) from exec args, overwrites value - - 0x03 - setenv, reads string (NAME=value) from exec, writes into env - - 0x04 - set-pty-height, reads u16 from exec args, updates winsize - - 0x05 - set-pty-width, reads u16 from exec args, updates winsize - -reading type (0x17) during vector: - - 0x00 - no input - - 0x01 - stdin - - 0x02 - argument - - 0x03 - argument spacer - - 0x04 - argument end - - 0x05 - action output - - 0x06 - action output end - - 0x40 - child 0 exited - - 0x41 - child 1 exited - - 0x42 - child 2 exited - - 0x43 - child 3 exited - - 0x81 - child 1 - - 0x82 - child 2 - - 0x83 - child 3 - - (child 0 uses 0x01, i.e. "stdin") - -for most types, the read byte(0x12) contains one byte of input data. -however, for exit notifications (0x40-0x43) it will intead contain an -unsigned 8-bit exit code. - - */ - -/* process */ -static char *fork_args[32]; -static int child_mode; -static int pty_fd; -static int to_child_fd[2]; -static int from_child_fd[2]; -static int saved_in; -static int saved_out; -static pid_t child_pid; -struct winsize ws = {24, 80, 8, 12}; - -/* new */ -static pid_t child_pids[4]; -static int child_modes[4]; -static int child_fd_ins[4] = {0, -1, -1, -1}; -static int child_fd_outs[4] = {1, -1, -1, -1}; -static int child_ptys[4] = {-1, -1, -1, -1}; - -static void -parse_args(Uxn *u, Uint8 *d) +static UxnSubprocess* +find_child_by_pid(pid_t pid) { - Uint8 *port_addr = d + 0x3; - int addr = PEEK2(port_addr); - char *pos = (char *)&u->ram[addr]; - int i = 0; - do { - fork_args[i++] = pos; - while(*pos != 0) pos++; - pos++; - } while(*pos != '\0'); - fork_args[i] = NULL; + for(int n = 0; n < CONSOLE_MAX_CHILDREN; n++) { + //fprintf(stderr, "child %d has pid %d [%d] (looking for %d)\n", n, children[n].pid, children[n].running, pid); + if(children[n].pid == pid) + return &children[n]; + } + return NULL; } -/* call after we're sure the process has exited */ +#define child_ptys(mode) (mode & CONSOLE_MODE_PTY) +#define child_reads(mode) (mode & CONSOLE_CHILD_READS) +#define child_writes(mode) (mode & CONSOLE_CHILD_WRITES) +#define child_writes_out(mode) (mode & CONSOLE_MODE_OUT) +#define child_writes_err(mode) (mode & CONSOLE_MODE_ERR) + static void -clean_after_child(int child) +handle_sigchld(int sig) { - int n = child & 0x3; - int is_pty = child_modes[n] >= 0x80; - if(!child_pids[n]) return; - if(is_pty) close(child_ptys[n]); - if(is_pty || child_mode & 0x1) close(child_fd_outs[n]); - if(is_pty || child_mode & 0x6) close(child_fd_ins[n]); - if(n == 0) { - if (is_pty || (child_modes[n] & 0x1)) dup2(saved_out, 1); - if (is_pty || (child_modes[n] & 0x6)) dup2(saved_in, 0); - saved_in = -1; - saved_out = -1; + pid_t pid; + int n, wstatus; + while((pid = waitpid(-1, &wstatus, WNOHANG)) > 0) { + //fprintf(stderr, "waitpid got something: %d\n", pid); + UxnSubprocess *child = find_child_by_pid(pid); + if (child != NULL) { + fprintf(stderr, "handle_sigchld: child %d (%d)\n", child->id, pid); + child->running = WEXITSTATUS(wstatus) - 256; + if(child_ptys(child->mode)) + close(child->pty); + else { + if(child_reads(child->mode)) close(child->fd_in); + if(child_writes(child->mode)) close(child->fd_out); + } + child->pid = child->mode = 0; + child->fd_out = child->fd_in = child->pty = -1; + return; + } + } + fprintf(stderr, "handle_sigchld: no child found", sig); +} + +static void +start_fork_pty(UxnSubprocess *child, int mode) +{ + int fd = -1; + pid_t pid = forkpty(&fd, NULL, NULL, NULL); + if(pid < 0) { /* failure */ + fprintf(stderr, "parent fork failure\n"); + } else if(pid == 0) { /* child */ + execvp(fork_args[0], fork_args); + fprintf(stderr, "child exec failure\n"); + } else { /*parent*/ + do { + child->pid = pid; + child->running = 1; + child->mode = mode; + child->pty = fd; + child->fd_in = fd; + child->fd_out = fd; + } while (child->pid != pid); + } +} + +static void +start_fork_pipe(UxnSubprocess *child, int mode) +{ + if(child_reads(mode)) { + /* parent writes to child's stdin */ + if(pipe(to_child_fd) == -1) { + fprintf(stderr, "pipe error: to child\n"); + return; + } + } + + if(child_writes(mode)) { + /* parent reads from child's stdout and/or stderr */ + if(pipe(from_child_fd) == -1) { + fprintf(stderr, "pipe error: from child\n"); + return; + } + } + + pid_t pid = fork(); + if(pid < 0) { /* failure */ + fprintf(stderr, "fork failure\n"); + } else if(pid == 0) { /* child */ + if(child_reads(mode)) { + dup2(to_child_fd[0], 0); + close(to_child_fd[1]); + } + if(child_writes(mode)) { + if(child_writes_out(mode)) dup2(from_child_fd[1], 1); + if(child_writes_err(mode)) dup2(from_child_fd[1], 2); + close(from_child_fd[0]); + } + execvp(fork_args[0], fork_args); + fprintf(stderr, "child exec failure\n"); + exit(1); + } else { /*parent*/ + do { + child->pid = pid; + child->mode = mode; + child->running = 1; + child->fd_in = child_reads(mode) ? to_child_fd[1] : -1; + child->fd_out = child_writes(mode) ? from_child_fd[0] : -1; + child->pty = -1; + } while (child->pid != pid); + fprintf(stderr, "child has pid %d\n", child->pid); + if(child_reads(mode)) close(to_child_fd[0]); + if(child_writes(mode)) close(from_child_fd[1]); + } +} + +static void +std_put(Uint8 c, FILE *fd) +{ + fputc(c, fd); + fflush(fd); +} + +static void +proc_put(Uxn *u, Uint8 *d) +{ + Uint8 c = d[0x2]; + int n = d[0xe] & 0x3; + write(children[n].fd_in, &c, 1); +} + +static void +host_execute(Uxn *u, Uint8 *d) +{ + int addr = PEEK2(d + 0xc); + int opts = d[0xe]; + int mode = opts & 0xf0; + char *cmd = (char *)&u->ram[addr]; + UxnSubprocess *child = &children[opts & 0x3]; + + fork_args[2] = cmd; + fprintf(stderr, "running execute: %s (#%02x)\n", cmd, opts); + if(child->pid) { + fprintf(stderr, " killing previous child: %d\n", child->pid); + kill(child->pid, 9); + } + + if(opts >= 0x80) + start_fork_pty(child, mode); + else + start_fork_pipe(child, mode); +} + +static void +host_response(Uxn *u, char *s) +{ + for(int i = 0;; i++) + console_input(u, s[i], CONSOLE_HOST); + console_input(u, '\0', CONSOLE_HOST_END); +} + +static void +host_getpid(Uxn *u, Uint8 *d) +{ + int n = d[0xe] & 0x3; + snprintf(buf, 16, "%d", children[n].pid); + host_response(u, buf); +} + +static void +host_kill(Uxn *u, Uint8 *d) +{ + int n = d[0xe] & 0x3; + kill(children[n].pid, 15); +} + +static void +host_getenv(Uxn *u, Uint8 *d) +{ + int addr = PEEK2(d + 0x3); + char *name = (char *)&u->ram[addr]; + host_response(u, getenv(name)); +} + +static void +host_setenv(Uxn *u, Uint8 *d) +{ + int addr = PEEK2(d + 0x3); + char *name = (char *)&u->ram[addr]; + int i = 0; + while (name[i] != '=') i++; + name[i] = '\0'; + char *value = &name[i+1]; + setenv(name, value, 1); +} + +static void +host_put(Uxn *u, Uint8 *d) +{ + switch(d[0xf]) { + case 0x0: /* nop */ break; + case 0x1: host_execute(u, d); break; + case 0x2: host_getpid(u, d); break; + case 0x3: host_kill(u, d); break; + case 0x10: host_getenv(u, d); break; + case 0x11: host_setenv(u, d); break; + } +} + +void +init_console(void) +{ + /* set up signal handler for SIGCHLD */ + struct sigaction sa; + sigemptyset(&sa.sa_mask); + sa.sa_flags = 0; + sa.sa_handler = handle_sigchld; + sigaction(SIGCHLD, &sa, NULL); + + /* initialize (halted) children */ + for(int i = 0; i < CONSOLE_MAX_CHILDREN; i++) { + UxnSubprocess *child = &children[i]; + child->id = i; + child->pid = child->mode = child->running = 0; + child->fd_in = child->fd_out = child->pty = -1; + } +} + +UxnSubprocess +*get_child(int n) +{ + return &children[n & 0x3]; +} + +void +console_monitor(Uxn *u) +{ + for(int n = 0; n < CONSOLE_MAX_CHILDREN; n++) { + UxnSubprocess *child = &children[n]; + if(child->running < 0) { + Uint8 status = child->running + 256; + child->running = 0; + console_input(u, status, CONSOLE_CHILD_EXIT | n); + } } - child_pids[n] = 0; - child_modes[n] = 0; - child_ptys[n] = -1; - child_fd_ins[n] = -1; - child_fd_outs[n] = -1; } int @@ -181,161 +297,28 @@ console_listen(Uxn *u, int i, int argc, char **argv) for(; i < argc; i++) { char *p = argv[i]; while(*p) console_input(u, *p++, CONSOLE_ARG); - console_input(u, '\n', i == argc - 1 ? CONSOLE_END : CONSOLE_EOA); + console_input(u, '\n', i == argc - 1 ? CONSOLE_ARG_END : CONSOLE_ARG_SPACER); } } -static void -start_fork_pty(Uint8 *d) -{ - int fd = -1; - pid_t pid = forkpty(&fd, NULL, NULL, NULL); - int n = d[0xa] & 0x3; - if(pid < 0) { /* failure */ - d[0x6] = 0xff; - fprintf(stderr, "fork failure\n"); - } else if(pid == 0) { /* child */ - setenv("TERM", "ansi", 1); /* TODO: configure these */ - execvp(fork_args[0], fork_args); - d[0x6] = 0xff; - fprintf(stderr, "exec failure\n"); - } else { /*parent*/ - child_pids[n] = pid; - child_ptys[n] = fd; - ioctl(fd, TIOCSWINSZ, &ws); - if(n == 0) { - saved_in = dup(0); - saved_out = dup(1); - dup2(fd, 0); - dup2(fd, 1); - } else { - child_fd_ins[n] = fd; - child_fd_outs[n] = fd; - } - } -} - -static void -start_fork_pipe(Uint8 *d) -{ - int n = d[0xa] & 0x3; - if(child_modes[n] & 0x01) { - /* parent writes to child's stdin */ - if(pipe(to_child_fd) == -1) { - d[0x6] = 0xff; - fprintf(stderr, "pipe error: to child\n"); - return; - } - } - - if(child_modes[n] & 0x06) { - /* parent reads from child's stdout and/or stderr */ - if(pipe(from_child_fd) == -1) { - d[0x6] = 0xff; - fprintf(stderr, "pipe error: from child\n"); - return; - } - } - - pid_t pid = fork(); - if(pid < 0) { /* failure */ - d[0x6] = 0xff; - fprintf(stderr, "fork failure\n"); - } else if(pid == 0) { /* child */ - if(child_modes[n] & 0x01) { - dup2(to_child_fd[0], 0); - close(to_child_fd[1]); - } - if(child_modes[n] & 0x06) { - if(child_modes[n] & 0x02) dup2(from_child_fd[1], 1); - if(child_modes[n] & 0x04) dup2(from_child_fd[1], 2); - close(from_child_fd[0]); - } - execvp(fork_args[0], fork_args); - d[0x6] = 0xff; - fprintf(stderr, "exec failure\n"); - } else { /*parent*/ - child_pids[n] = pid; - if(child_modes[n] & 0x01) { - child_fd_ins[n] = to_child_fd[1]; - if(n == 0) { - saved_out = dup(1); - dup2(to_child_fd[1], 1); - } - close(to_child_fd[0]); - } - if(child_modes[n] & 0x06) { - child_fd_outs[n] = from_child_fd[0]; - if(n == 0) { - saved_in = dup(0); - dup2(from_child_fd[0], 0); - } - close(from_child_fd[1]); - } - } -} - -static void -kill_child(Uint8 *d, int options) -{ - int n = d[0xa] & 0x3; - if(child_pids[n]) { - kill(child_pids[n], 9); - int wstatus; - if(waitpid(child_pids[n], &wstatus, options)) { - d[0x6] = 1; - d[0x7] = WEXITSTATUS(wstatus); - clean_after_child(n); - } - } -} - -static void -start_fork(Uxn *u, Uint8 *d) -{ - int n = d[0xa] & 0x3; - fflush(stderr); - kill_child(d, 0); - child_modes[n] = d[0x5]; - parse_args(u, d); - if(child_modes[n] >= 0x80) - start_fork_pty(d); - else - start_fork_pipe(d); -} - Uint8 console_dei(Uxn *u, Uint8 addr) { + /* for(int n = 0; n < 3; n++) */ + /* fprintf(stderr, "child %d has pid %d (%d)\n", n, children[n].pid, children[n].running); */ Uint8 port = addr & 0x0f, *d = &u->dev[addr & 0xf0]; - switch(port) { - case 0x6: - case 0x7: kill_child(d, WNOHANG); - } return d[port]; } void console_deo(Uxn *u, Uint8 *d, Uint8 port) { - FILE *fd = NULL; + /* for(int n = 0; n < 3; n++) */ + /* fprintf(stderr, "child %d has pid %d (%d)\n", n, children[n].pid, children[n].running); */ switch(port) { - case 0x5: /* Console/dead */ start_fork(u, d); break; - case 0x6: /* Console/exit*/ kill_child(d, 0); break; - case 0x8: fd = stdout; break; - case 0x9: fd = stderr; break; - } - if(fd) { - fputc(d[port], fd); - fflush(fd); - } -} - -void -update_pollfd(struct pollfd *fds) -{ - for(int i = 0; i < 16; i++) { - fds[i + 2].fd = child_fd_outs[i]; - fds[i + 2].events = POLLIN; + case 0x8: std_put(d[port], stdout); break; + case 0x9: std_put(d[port], stderr); break; + case 0xa: proc_put(u, d); break; + case 0xf: host_put(u, d); break; } } diff --git a/src/devices/console.h b/src/devices/console.h index 7adb96a..78fde89 100644 --- a/src/devices/console.h +++ b/src/devices/console.h @@ -11,13 +11,44 @@ WITH REGARD TO THIS SOFTWARE. #define CONSOLE_VERSION 1 -#define CONSOLE_STD 0x1 -#define CONSOLE_ARG 0x2 -#define CONSOLE_EOA 0x3 -#define CONSOLE_END 0x4 +#define CONSOLE_NONE 0x00 +#define CONSOLE_STDIN 0x01 +#define CONSOLE_ARG 0x02 +#define CONSOLE_ARG_SPACER 0x03 +#define CONSOLE_ARG_END 0x04 +#define CONSOLE_HOST 0x05 +#define CONSOLE_HOST_END 0x06 +#define CONSOLE_STDIN_END 0x07 +#define CONSOLE_CHILD_DATA 0x20 /* write from child-n: 0x20 | n */ +#define CONSOLE_CHILD_END 0x40 /* close from child-n: 0x40 | n */ +#define CONSOLE_CHILD_EXIT 0x80 /* exits from child-n: 0x80 | n */ + +typedef struct UxnSubprocess { + int id; /* identifier: 0-3 */ + pid_t pid; /* when running, pid > 0 */ + int mode; /* bit flags: CONSOLE_MODE_ */ + int running; /* 0=stopped, >0 running, <0 exiting */ + int fd_in; /* fd to send to child; -1 is unset */ + int fd_out; /* fd to read from child; -1 is unset */ + int pty; /* pty for child; -1 is unset */ +} UxnSubprocess; + +void init_console(void); +UxnSubprocess *get_child(int n); +void console_monitor(Uxn *u); int console_input(Uxn *u, char c, int type); void console_listen(Uxn *u, int i, int argc, char **argv); Uint8 console_dei(Uxn *u, Uint8 addr); void console_deo(Uxn *u, Uint8 *d, Uint8 port); -void update_pollfd(struct pollfd *fds); + +#define CONSOLE_MODE_PTY 0x80 +#define CONSOLE_MODE_ERR 0x40 +#define CONSOLE_MODE_OUT 0x20 +#define CONSOLE_MODE_INP 0x10 + +#define CONSOLE_CHILD_READS 0x90 /* CONSOLE_MODE_PTY | CONSOLE_MODE_INP */ +#define CONSOLE_CHILD_WRITES 0xe0 /* CONSOLE_MODE_PTY | CONSOLE_MODE_OUT | CONSOLE_MODE_ERR */ + +#define CONSOLE_MAX_CHILDREN 4 + diff --git a/src/uxn11.c b/src/uxn11.c index f6d3d07..97822dd 100644 --- a/src/uxn11.c +++ b/src/uxn11.c @@ -1,3 +1,4 @@ +#include #include #include #include @@ -118,6 +119,7 @@ emu_end(Uxn *u) XDestroyImage(ximage); XDestroyWindow(display, window); XCloseDisplay(display); + kill(0, 15); exit(0); return u->dev[0x0f] & 0x7f; } @@ -146,6 +148,23 @@ toggle_scale(Uxn *u) screen_resize(uxn_screen.width, uxn_screen.height, s); } +/* returns true if the fd ended (has been closed), false otherwise */ +static int +handle_input(Uxn *u, struct pollfd pollfd, char *coninp, int argdata, int argend) +{ + if((pollfd.revents & POLLIN) != 0) { + int n = read(pollfd.fd, coninp, CONINBUFSIZE - 1); + coninp[n] = 0; + if(n == 0) + console_input(u, 0, argend); + else + for(int i = 0; i < n; i++) + console_input(u, coninp[i], argdata); + return n == 0; + } else + return 0; +} + static void emu_event(Uxn *u) { @@ -211,16 +230,18 @@ emu_init(void) if(!display) return system_error("X11", "Could not open display"); screen_resize(WIDTH, HEIGHT, 1); + init_console(); return 1; } static int emu_run(Uxn *u, char *rom) { - int i = 1, n, s = uxn_screen.scale; + int i = 1, n, end, s = uxn_screen.scale, t; + int *child_fd_outs; char expirations[8]; char coninp[CONINBUFSIZE]; - struct pollfd fds[18]; + struct pollfd fds[3 + CONSOLE_MAX_CHILDREN]; static const struct itimerspec screen_tspec = {{0, 16666666}, {0, 16666666}}; loaded_rom = rom; @@ -245,7 +266,10 @@ emu_run(Uxn *u, char *rom) timerfd_settime(fds[1].fd, 0, &screen_tspec, NULL); fds[2].fd = STDIN_FILENO; fds[0].events = fds[1].events = fds[2].events = POLLIN; - update_pollfd(fds); + for(i = 0; i < 4; i++) { + fds[i + 3].fd = get_child(i)->fd_out; + fds[i + 3].events = POLLIN; + } /* main loop */ while(!u->dev[0x0f]) { @@ -263,13 +287,18 @@ emu_run(Uxn *u, char *rom) XPutImage(display, window, DefaultGC(display, 0), ximage, x1, y1, x1 + PAD, y1 + PAD, x2 - x1, y2 - y1); } } - if((fds[2].revents & POLLIN) != 0) { - n = read(fds[2].fd, coninp, CONINBUFSIZE - 1); - coninp[n] = 0; - for(i = 0; i < n; i++) - console_input(u, coninp[i], CONSOLE_STD); - } + + /* read input from stdin */ + handle_input(u, fds[2], coninp, CONSOLE_STDIN, CONSOLE_STDIN_END); + + /* read input from child processes */ + for(i = 0; i < 4; i++) + handle_input(u, fds[i + 3], coninp, CONSOLE_CHILD_DATA | i, CONSOLE_CHILD_END | i); + + /* check to see if any children exited */ + console_monitor(u); } + kill(0, 15); return 1; } diff --git a/src/uxncli.c b/src/uxncli.c index 68f2932..f42f8c3 100644 --- a/src/uxncli.c +++ b/src/uxncli.c @@ -1,5 +1,8 @@ #include #include +#include +#include +#include #include "uxn.h" #include "devices/system.h" @@ -42,16 +45,55 @@ emu_deo(Uxn *u, Uint8 addr, Uint8 value) } } +static void +handle_input(Uxn *u, int fd, int argdata, int argend) +{ + char buf[32]; + int n = read(fd, &buf, 32); + if(n == 0) + console_input(u, 0x00, argend); + else + for(int i = 0; i < n; i++) + console_input(u, buf[i], argdata); +} + +static int +init_rfds(fd_set *rfds) +{ + int i, nfds; + FD_ZERO(rfds); + FD_SET(0, rfds); + nfds = 1; + /* for(i = 0; i < 4; i++) { */ + /* int fd = get_child(i)->fd_out; */ + /* FD_SET(fd, rfds); */ + /* if (fd >= nfds) nfds = fd + 1; */ + /* } */ + return nfds; +} + static void emu_run(Uxn *u) { + int i; + struct timeval tv; + fd_set rfds; + init_console(); while(!u->dev[0x0f]) { - int c = fgetc(stdin); - if(c == EOF) { - console_input(u, 0x00, CONSOLE_END); - break; + int nfds = init_rfds(&rfds); + tv.tv_sec = 0; + tv.tv_usec = 1000; + int retval = select(nfds, &rfds, NULL, NULL, &tv); + if(retval <= 0) + continue; + if (FD_ISSET(0, &rfds)) + handle_input(u, 0, CONSOLE_STDIN, CONSOLE_STDIN_END); + for(i = 0; i < 4; i++) { + int fd = get_child(i)->fd_out; + if (fd > 2 && FD_ISSET(fd, &rfds)) + handle_input(u, fd, CONSOLE_CHILD_DATA | i, CONSOLE_CHILD_END | i); } - console_input(u, (Uint8)c, CONSOLE_STD); + console_monitor(u); } } diff --git a/test/make.tal b/test/make.tal new file mode 100644 index 0000000..5b875ef --- /dev/null +++ b/test/make.tal @@ -0,0 +1,38 @@ +|10 @Console [ + &vector $2 &stdin $1 &pad1 $1 &proc-get $1 &host-get $1 &pad2 $1 &type $1 + &stdout $1 &stderr $1 &proc-put $1 &pad3 $1 ¶m $2 &opts $1 &host-put $1 +] + +|0100 ( -- BRK ) + ;on-console .Console/vector DEO2 ( ; set up console vector callback ) + BRK ( ; do other initialization ) + +@on-console ( -- BRK ) + LIT "? .Console/stdout DEO + .Console/type DEI #81 EQU ?on-exit ( ; 0x41 signals child 1's exit ) + .Console/type DEI #01 EQU ?on-stdin ( ; handle stdin ) + BRK ( ; handle other console input ) + +@on-stdin + .Console/stdin DEI #0a NEQ + ?{ run-make } BRK + +@on-exit ( -- BRK ) + .Console/host-get DEI ( ; read child 1's exit code ) + ?{ display-success-msg BRK } ( ; zero exit code means success ) + display-failure-msg BRK ( ; non-zero exit code means failure ) + +@run-make ( -- ) + ;make-cmd .Console/param DEO2 ( ; set up make to run ) + #01 .Console/opts DEO ( ; use child without pipelines ) + #01 .Console/host-put DEO JMP2r ( ; run the command now and return ) + +@make-cmd "pwd 00 ( ; buffer containing cmd to run ) + +@display-success-msg + LIT ". .Console/stdout DEO + #0a .Console/stdout DEO JMP2r + +@display-failure-msg + LIT "! .Console/stdout DEO + #0a .Console/stdout DEO JMP2r diff --git a/test/term.tal b/test/term.tal new file mode 100644 index 0000000..2e4d2f7 --- /dev/null +++ b/test/term.tal @@ -0,0 +1,1375 @@ +( term.tal ) + +( TODO: ) +( 3. need to implement scrolling regions ) +( 5. need draw-line word, and need to use it more ) +( a. on delete, CSI-P ) +( b. on insert ) +( c. etc. ) +( 6. add more ansi control seqs ) +( 9. support shift+arrow and alt+arrow ) +( 10. crawl has screen-clearing issues ) +( 11. cursor hiding for cmatrix ) +( 12. clean up super ugly selection code ) +( 15. blinking text? ) +( 16. status line in femto, etc. is weird *** major bug ) +( 17. determ.terminfo ) + +( ANSI sequences ) +( ) +( set attributes: ESC [ x ; ... m -> 0:reset 1:bright 2:dim 7:reverse ) +( get cursor position: ESC [ 6 n -> ESC [ $row ; $col R ) +( set insert: ESC [ 4 h ) +( set replace (def): ESC [ 4 l ) +( enable line wrap: ESC [ 7 h ) +( disable line wrap: ESC [ 7 l ) +( ) +( move cursor home: ESC [ H ) +( move cursor: ESC [ $row ; $col H ) +( move to column: ESC [ $n G ) +( move to row: ESC [ $n d ) +( move up: ESC [ $n A ) +( move down: ESC [ $n B ) +( move forward: ESC [ $n C ) +( move back: ESC [ $n D ) +( move forward n tabs ESC [ $n I ) +( ) +( erase from cursor to end of line: ESC [ K ) +( erase from start of line to cursor: ESC [ 1 K ) +( erase line: ESC [ 2 K ) +( erase from current line to bottom: ESC [ J ) +( erase from current line to top: ESC [ 1 J ) +( erase screen: ESC [ 2 J ) +( ) +( insert lines: ESC [ $n L ) +( delete n characters: ESC [ $n P ) +( insert n blank characters: ESC [ $n @ ) +( ) +( show cursor: ESC [ ? 25 h ) +( hide cursor: ESC [ ? 25 l ) +( set bracketed paste mode: ESC [ ? 2004 h ) +( unset bracketed paste mode: ESC [ ? 2004 l ) +( ) +( SEMI-SUPPORTED ) +( select G0 charset ($c) ESC lpar $c ) +( save cursor ESC 7 ) +( restore cursor ESC 8 ) +( ) +( NOT SUPPORTED YET: ) +( end alt charset ESC [ 10 m ) +( end alt charset ESC [ 11 m ) + +( ESC [ $top $bot r -> set scrolling region [$top;$bot] ) +( ESC [ 7 h/l -> set/unset auto-wrap mode ) +( ESC [ 1 h/l -> set/unset application cursor keys [up: CSI A vs SS3 A] ) +( ESC = -> application keypad [use SS3 sequences] ) +( ESC M -> set ANSI conformance level 2 ) +( ESC > -> normal keypad [normal sequences] ) + +( ESC [ ? 1000 h/l -> send mouse X & Y on button press and release (X11 xterm mouse protocol) ) +( ESC [ ? 1002 h/l -> use cell motion mouse tracking, xterm ) +( ESC [ ? 1006 h/l -> SGR mouse mode, xterm ) +( ESC [ ? 1005 h/l -> UTF-8 mouse mode, xterm ) +( ESC [ ? 1015 h/l -> urxvt Mouse mode ) +( ESC [ ? 1051 l -> unset sun function key mode ) +( ESC [ ? 1052 l -> unset hp function key mode ) +( ESC [ ? 1060 l -> unset legacy keyboard emulation ) +( ESC [ ? 1061 h -> set VT220 keyboard emulation ) + +( special graphics [] changes 95-126 ) + +|00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ] +|10 @Console [ &vect $2 &stdin $1 &exec $2 &mode $1 &dead $1 &exit $1 &stdout $1 &stderr $1 &child $1 ] +|20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ] +|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ] +|90 @Mouse [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ] +|a0 @File1 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] +|b0 @File2 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] + +|0000 + @tint $1 ( draw mode. 01=regular, 04=inverted ) + @attr $1 ( 5 bits: RxxxBBFF ) + @dirty $1 ( screen needs redraw? ) + @lastkey $1 ( last button press ) + @rows $2 ( height in characters ) + @cols $2 ( width in characters ) + @cur-x $2 ( cursor x: 0 <= cur-x < cols ) + @cur-y $2 ( cursor y: 0 <= cur-y < rows ) + @cur-wrap $1 ( did cursor just wrap? ) + @max-x $2 ( cols-1 ) + @max-y $2 ( rows-1 ) + @saved-x $2 ( saved x coordinate ) + @saved-y $2 ( saved y coordinate ) + @col-bytes $2 ( 2*cols ) + @lastmouse-x $2 ( last mouse x ) + @lastmouse-y $2 ( last mouse y ) + @lastmouse-st $1 ( last mouse press ) + @is-lit $1 ( are we selecting an area? ) + @is-lit-flip $1 ( is the selection flipped? i.e. drawing left/up ) + @lit-click-x $2 ( x coord of starting selection click ) + @lit-click-y $2 ( y coord of starting selection click ) + @lit-drag-x $2 ( x coord of selection drag ) + @lit-drag-y $2 ( y coord of selection drag ) + @flash $1 ( visual bell flash timer ) + @pointer-ttl $1 ( visible cursor timer ) + + ( terminal settings ) + @ignored $1 ( ignored ) + @irm $1 ( 01: insert and move right, 00: replace and overwrite ) + @awm $1 ( 01: wrap chars at margin, 00: overwrite at margin ) + @tcem $1 ( 01: cursor is visible, 00: cursor is invisible ) + @paste $1 ( 01: bracketed paste is on, 00: is off ) + + ( margins ) + @margin-top $2 + @margin-bot $2 + + ( user configuration ) + @debug $1 ( use debug log? ) + @show-banner $1 ( show banner on startup? ) + @visual-bell $1 ( use visual belL? 01: visual bell, 00: do nothing ) + @border-pad $2 ( use border? must be either 0000 or 0010 ) + +|0100 + ( metadata ) + ;meta .System/metadata DEO2 + ;meta/name .System/title DEO2 + + ( user configuration defaults ) + #00 .debug STZ + #01 .show-banner STZ + #0000 .border-pad STZ2 + #01 .visual-bell STZ + + ( 80 cols x 24 rows by default ) + #0050 .cols STZ2 + #0018 DUP .rows STZ2 .margin-bot STZ2 + #0000 .margin-top STZ2 + + ( start cursor at origin - including border ) + .border-pad LDZ2 .Screen/x DEO2 + .border-pad LDZ2 .Screen/y DEO2 + + ( set colors ) + #07bf .System/r DEO2 + #07bf .System/g DEO2 + #07bf .System/b DEO2 + + load-theme ( optional theme sets colors/dimensions ) + + ;on-redraw .Screen/vect DEO2 ( set up screen callback ) + ;on-key .Controller/vect DEO2 ( set up keyboard callback ) + ;on-mouse .Mouse/vect DEO2 ( set up mouse callback ) + ;on-read .Console/vect DEO2 ( set up stdin callback ) + + setup-subprocess ( set up experimental subprocess support ) + reset-terminal ( initialize terminal state and settings ) + setup-debugging ( set up debugging if requested ) + draw-banner ( draw banner if requested ) + + BRK + +( these only work with a patched uxnemu ) +( on other emulators they should be no-ops ) +@setup-subprocess ( -> ) + ;shell .Console/exec DEO2 ( set up bash subprocess ) + #80 .Console/mode DEO ( start bash subprocess ) + JMP2r + +@setup-debugging ( -> ) + .debug LDZ ?&continue JMP2r &continue + ;debug-log .File1/name DEO2 + #01 .File1/append DEO + JMP2r + +@draw-banner ( -> ) + redraw ;banner-ascii + &loop LDAk DUP ?&ok POP POP2 JMP2r + &ok read INC2 !&loop + +@reset-terminal ( -> ) + ( set initial cursor ) + #0000 DUP2 .cur-x STZ2 .cur-y STZ2 + + ( confirm no buttons pressed yet ) + #00 .lastkey STZ + + ( calculate derived dimensions from cols/rows ) + update-dimensions + + ( set starting tint: reverse=0, bg=0, fg=2 ) + #02 .attr STZ update-tint + + ( set initial modes ) + #00 .irm STZ ( insert and move right ) + #01 .awm STZ ( wrap at margin ) + #01 .tcem STZ ( show cursor ) + #00 .paste STZ ( bracketed paste is off ) + + init-screen ( ; prepare for initial draw ) + draw-border ( ; draw border ) + JMP2r + +@update-dimensions ( -> ) + ( set col-bytes, frequently needed ) + .cols LDZ2 DUP2 ADD2 .col-bytes STZ2 + + ( set max row/col ) + .rows LDZ2 #0001 SUB2 .max-y STZ2 + .cols LDZ2 #0001 SUB2 .max-x STZ2 + + ( set screen height/width based on rows/cols + border padding ) + .border-pad LDZ2 DUP2 ADD2 DUP2 + .cols LDZ2 #30 SFT2 ADD2 .Screen/w DEO2 + .rows LDZ2 #000c MUL2 ADD2 .Screen/h DEO2 + JMP2r + +@shell "bash 00 "-i 00 00 + +@load-theme ( -> ) + ;&path .File1/name DEO2 + #0006 .File1/len DEO2 + ;&r .File1/r DEO2 + .File1/ok DEI2 ORA #01 [ JCN JMP2r ] + ,&r LDR2 .System/r DEO2 + ,&g LDR2 .System/g DEO2 + ,&b LDR2 .System/b DEO2 + #0002 .File1/len DEO2 + ;&x .File1/r DEO2 + .File1/ok DEI2 ORA #01 [ JCN JMP2r ] + #00 ,&x LDR .cols STZ2 + #00 ,&y LDR .rows STZ2 + JMP2r [ &path ".theme $1 &r $2 &g $2 &b $2 &x $1 &y $1 ] + +@first-addr ( -> ) + ;cells JMP2r + +@bol-addr ( -> addr* ) + .col-bytes LDZ2 .cur-y LDZ2 MUL2 ;cells ADD2 JMP2r + +@cur-addr ( -> addr* ) + .col-bytes LDZ2 .cur-y LDZ2 MUL2 .cur-x LDZ2 DUP2 ADD2 ADD2 ;cells ADD2 JMP2r + +@eol-addr ( -> addr* ) + .col-bytes LDZ2 .cur-y LDZ2 INC2 MUL2 ;cells ADD2 JMP2r + +@limit-addr ( -> ) + .col-bytes LDZ2 .rows LDZ2 MUL2 ;cells ADD2 JMP2r + +@min ( x* y* -> min* ) + LTH2k [ JMP SWP2 ] POP2 JMP2r + +@max ( x* y* -> max* ) + LTH2k [ JMP SWP2 ] NIP2 JMP2r + +( signed max ) +( #8000 < #8001 < ... < #ffff < #0000 < #0001 < ... < #7fff ) +@smax ( x* y* -> min* ) + EOR2k POP #80 AND ?min !max + +( initialize screen cells and prepare for first draw ) +@init-screen ( -> ) + first-addr limit-addr #0200 ( fall-through ) +@init ( start* limit* cell* -> ) + STH2 EQU2k ?&skip ( start* limit* [cell*] ) + #01 .dirty STZ OVR2 ( start* limit* start* [cell*] ) + #01 SFT2 SWP2 #01 SFT2 SUB2 ( start* -count* [cell*] ) + STH2 SWP2r STH2r SWP2 ( cell* start* [-count*] ) + &loop ( cell* addr* [-i*] ) + STA2k INC2 INC2 INC2r ( cell* addr+2* [-i+1*] ) + ORAkr STHr ?&loop ( cell* addr+2* [-i+1*] ) + &skip POP2 POP2 POP2r JMP2r ( ) + +( uses the existing .Screen/x and .Screen/y ) +( returns them to their starting values when finished ) +@erase-fg-cell ( -> ) + ;cp437/nul .Screen/addr DEO2 ( ; use nul character to erase ) + #43 .Screen/sprite DEO ( ; s/s<-40 ) + .Screen/y DEI2k STH2k ( zp^ y* [y*] ) + #0004 ADD2 ROT DEO2 ( [y*] ; s/y<-y+4 ) + #43 .Screen/sprite DEO STH2r ( y* ; s/s<-40 ) + .Screen/y DEO2 JMP2r ( ; s/y<-y ) + +@draw-border ( -> ) + .border-pad LDZ2 ORA ?{ JMP2r } + ;cp437/space .Screen/addr DEO2 + #04 .Screen/sprite + #0000 draw-border/row + #0008 draw-border/row + .rows LDZ2 #000c MUL2 #0010 ADD2 draw-border/row + .Screen/y DEI2 #0008 ADD2 draw-border/row + #0000 draw-border/col + #0008 draw-border/col + .cols LDZ2 #30 SFT2 #0010 ADD2 draw-border/col + .Screen/x DEI2 #0008 ADD2 draw-border/col + #00 .Screen/auto DEO POP2 !screen-to-cursor + + &row ( y* -> ) + .Screen/y DEO2 + #0000 .Screen/x DEO2 + #01 .Screen/auto DEO + #0000 .cols LDZ2 #0004 ADD2 SUB2 STH2 + !&loop + + &col ( x* -> ) + .Screen/x DEO2 + #0000 .Screen/y DEO2 + #02 .Screen/auto DEO + #0000 .rows LDZ2 #0003 MUL2 INC2 #01 SFT2 #0004 ADD2 SUB2 STH2 + !&loop + + &loop ( 04 sprite^ [-count] ) + DEOk INC2r STH2kr ORA ?&loop POP2r JMP2r + +@on-redraw ( -> ) + redraw BRK + +@redraw ( -> ) + .pointer-ttl LDZ #00 EQU ?&pointer-ok ( ) + .pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok + #01 .dirty STZ ( redraw without pointer ) + &pointer-ok + .dirty LDZ #00 EQU ?&done + LIT2r =cells ( [addr*] ) + .rows LDZ2 #0000 DUP2 .border-pad LDZ2 ADD2 .Screen/y DEO2 + &yloop + .cols LDZ2 #0000 DUP2 .border-pad LDZ2 ADD2 .Screen/x DEO2 + &xloop + STH2kr LDA2 draw-cell erase-fg-cell + .Screen/x DEI2k #0008 ( width ) ADD2 ROT DEO2 + INC2 INC2r INC2r GTH2k ?&xloop + POP2 POP2 + .Screen/y DEI2k #000c ( height ) ADD2 ROT DEO2 + INC2 GTH2k ?&yloop + POP2 POP2 POP2r + .is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally + &flashing .flash LDZ #00 EQU ?&pointer flash-bell !draw-cursor + &pointer draw-pointer + &finally draw-cursor #00 .dirty STZ + &done JMP2r + +@flash-bell ( -> ) + .flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 ) + #0000 DUP2 .lit-click-x STZ2 .lit-click-y STZ2 + .max-x LDZ2 .lit-drag-x STZ2 .max-y LDZ2 .lit-drag-y STZ2 + redraw-selection !clear-selection + +@screen-to-cell ( row* col* -> ) + #30 SFT2 ( width ) .border-pad LDZ2 ADD2 .Screen/x DEO2 + #000c MUL2 ( height ) .border-pad LDZ2 ADD2 .Screen/y DEO2 + JMP2r + +@screen-to-cursor ( -> ) + .cur-y LDZ2 .cur-x LDZ2 !screen-to-cell + +@clear-cursor ( -> ) + screen-to-cursor cur-addr LDA2 !draw-cell + +@draw-cursor ( -> ) + screen-to-cursor cur-addr LDA2 + .tcem LDZ #00 EQU ?&skip SWP reverse-tint SWP + &skip !draw-cell + +@on-button ( -> BRK ) + .lastkey LDZ ( last^ ) + .Controller/button DEI ( last^ button^ ) + STHk EOR ( last-xor-button^ [button^] ) + STHr AND ( last-xor-button&button^ ) + DUP #10 AND #00 EQU ?&no-n LIT "A arrow + &no-n DUP #20 AND #00 EQU ?&no-s LIT "B arrow + &no-s DUP #40 AND #00 EQU ?&no-w LIT "D arrow + &no-w DUP #80 AND #00 EQU ?&no-e LIT "C arrow + &no-e POP .Controller/button DEI .lastkey STZ BRK + +( send ESC [ $c ) +@arrow ( c^ -> ) + .Console/w STH + ( TODO: send ESC-$c in VT-52 mode ) + ( TODO: send ESC-O-$c in "cursor key mode set" ) + #1b STHkr DEO LIT "[ STHkr DEO STHr DEO + JMP2r + +@paste-from-buf ( size* -> ) + ;paste-buf SWP2 OVR2 ADD2 SWP2 ( limit* start* ) + &loop ( limit* pos* ) + LDAk .Console/w DEO INC2 ( limit* pos+1* ) + GTH2k ?&loop POP2 POP2 JMP2r + +@bracket-paste ( c^ -> ) + .Console/w STH + #1b STHkr DEO + LIT "[ STHkr DEO + LIT "2 STHkr DEO + LIT "0 STHkr DEO + ( c ) STHkr DEO + LIT "~ STHr DEO + JMP2r + +@paste-snarf ( -> ) + .paste LDZ #00 EQU ?&start LIT "0 bracket-paste &start + ;snarf .File2/name DEO2 ( ) + #0780 .File2/len DEO2 ( ) + &loop ( ) + ;paste-buf .File2/r DEO2 ( ) + .File2/ok DEI2 ( size* ) + DUP2 #0000 EQU2 ?&failed ( size* ) + DUP2 paste-from-buf ( size* ) + #0780 LTH2 ?&done ( ) + !&loop ( ) + &failed POP2 + &done + .paste LDZ #00 EQU ?&end LIT "1 bracket-paste &end + JMP2r + +@lit-first-y + .is-lit-flip LDZ ?&flip .lit-click-y LDZ2 JMP2r &flip .lit-drag-y LDZ2 JMP2r +@lit-first-x + .is-lit-flip LDZ ?&flip .lit-click-x LDZ2 JMP2r &flip .lit-drag-x LDZ2 JMP2r +@lit-last-y + .is-lit-flip LDZ ?&flip .lit-drag-y LDZ2 JMP2r &flip .lit-click-y LDZ2 JMP2r +@lit-last-x + .is-lit-flip LDZ ?&flip .lit-drag-x LDZ2 JMP2r &flip .lit-click-x LDZ2 JMP2r + +@redraw-selection ( -> ) + lit-first-y .cols LDZ2 MUL2 ( y0*cols* ) + lit-first-x ADD2 DUP2 ADD2 ( 2(y0*cols+x0)* ) + ;cells ADD2 STH2 ( [addr*] ) + lit-last-y INC2 lit-first-y ( yn* y0* [addr*] ) + DUP2 lit-first-x STH2k ( yn* y0* x0* [addr* x0*] ) + screen-to-cell ( yn* y0* [addr* x0*] ) + &yloop ( yn* y* [addr* x*] ) + OVR2 OVR2 INC2 GTH2 STH .cols LDZ2 ( yn* y* cols* [addr* x* last^] ) + lit-last-x INC2 ( yn* y* cols* xn* [addr* x* last^] ) + STHr [ JMP SWP2 ] POP2 STH2r ( yn* y* xlim* x* [addr*] ) + &xloop ( yn* y* xlim* x* [addr*] ) + STH2kr LDA2 highlight-cell ( yn* y* xlim* x* [addr*] ) + .Screen/x DEI2k #0008 ADD2 ROT DEO2 ( yn* y* xlim* x* [addr*] ) + INC2 INC2r INC2r ( yn* y* xlim* x+1* [addr+2*] ) + GTH2k ?&xloop ( yn* y* xlim* x+1* [addr+2*] ) + POP2 POP2 ( yn* y* [addr+2*] ) + .Screen/y DEI2k #000c ADD2 ROT DEO2 ( yn* y* [addr+2*] ) + .border-pad LDZ2 .Screen/x DEO2 ( yn* y* [addr+2*] ) + LIT2r 0000 INC2 GTH2k ?&yloop ( yn* y+1* [addr+2* 0*] ) + POP2 POP2 POP2r POP2r ( ) + JMP2r ( ) + +@y-point-to-row ( y* -> row* ) + .border-pad LDZ2 LTH2k ?&y0 SUB2 #000c DIV2 .max-y LDZ2 !min &y0 POP2 POP2 #0000 JMP2r + +@x-point-to-col ( x* -> col* ) + #0004 ADD2 .border-pad LDZ2 LTH2k ?&x0 SUB2 #03 SFT2 .max-x LDZ2 !min &x0 POP2 POP2 #0000 JMP2r + +@point-to-coord ( x* y* -> row* col* ) + y-point-to-row SWP2 !x-point-to-col + +@unset-wrap ( -> ) + #00 .cur-wrap STZ JMP2r + +@start-selection ( -> ) + #01 .is-lit STZ ( ) + .Mouse/x DEI2 .Mouse/y DEI2 ( x* y* ) + #00 .is-lit-flip STZ ( x* y* ) + point-to-coord ( row* col* ) + DUP2 .lit-click-x STZ2 .lit-drag-x STZ2 ( row* ) + DUP2 .lit-click-y STZ2 .lit-drag-y STZ2 ( ) + redraw-selection !draw-cursor ( ) + +@selection-is-empty ( -> bool^ ) + .lit-click-y LDZ2 .lit-drag-y LDZ2 EQU2 + .lit-click-x LDZ2 .lit-drag-x LDZ2 EQU2 AND JMP2r + +@find-natural-end ( y* -> xend* ) + DUP2 .cols LDZ2 MUL2 ( y* y*cols* ) + DUP2 ADD2 ;cells ADD2 INC2 ( y* edge* ) + DUP2 .max-x LDZ2 DUP2 ADD2 ADD2 ( y* edge* start=edge+2cols* ) + &loop ( y* edge* addr* ) + LDAk ?&done ( y* edge* addr* ) + #0002 SUB2 LTH2k ?&loop ( y* edge* addr-2* ) + &done ( y* edge* addr* ) + SWP2 SUB2 #01 SFT2 ( y* x* ) + NIP2 JMP2r ( x* ) + +@copy-line ( y* x1* x0* -> y* ) + STH2 STH2 DUP2 find-natural-end ( y* xend* [x0* x1*] ) + STH2r min ( y* xlim=min(xend,x1)* [x0*] ) + DUP2 STH2kr GTH2 ?&ok ( y* xlim* [x0*] ) + POP2 POP2r JMP2r ( y* ; return if line is empty ) + &ok OVR2 .cols LDZ2 MUL2 ( y* xlim* y*cols* [x0*] ) + STH2kr ADD2 DUP2 ADD2 ;cells ADD2 ( y* xlim* addr* [x0*] ) + INC2 STH2 SWP2r STH2r ( y* xlim* x0* [addr+1*] ) + SUB2 INC2 #0000 SWP2 SUB2 ( y* -count* [addr+1*] ) + &loop ( y* -i* [pos*] ) + LDAkr STHr copy-char ( y* -i* [pos*] ) + INC2 INC2r INC2r ORAk ?&loop ( y* -i+1* [pos+2*] ) + POP2 POP2r JMP2r ( y* ; done ) + +@copy-char ( c^ -> ) + DUP ?&ok POP #20 ( replace \0 with space ) + &ok STH ;paste-pos LDA2k ( pos* addr* [c^] ) + STH2k STAr INC2 SWP2 STA2 JMP2r ( ) + +@copy-selection ( -> ) + ;paste-buf ;paste-pos STA2 + lit-last-y INC2 lit-first-y ( ylim* y0* ) + DUP2 lit-first-x STH2k screen-to-cell ( yn* y0* [x0*] ) + &yloop ( yn* y* [x*] ) + OVR2 OVR2 INC2 GTH2 STH .max-x LDZ2 ( yn* y* maxx* [x* last^] ) + lit-last-x ( yn* y* maxx* xlast* [x* last^] ) + STHr [ JMP SWP2 ] POP2 STH2r ( yn* y* x1* x* ) + copy-line ( yn* y* ) + LIT2r 0000 INC2 GTH2k ?&next !&done ( yn* y+1* [0*] ) + &next ( ) + #0a copy-char !&yloop ( ) + &done ( ) + POP2 POP2 POP2r ( ) + ;snarf .File2/name DEO2 ( ) + ;paste-pos LDA2 ;paste-buf SUB2 ( len* ) + .File2/len DEO2 ( ) + ;paste-buf .File2/w DEO2 ( ) + JMP2r ( ) + +@handle-selection ( -> ) + selection-is-empty ?&skip copy-selection + &skip ( fall through to clear-selection ) +@clear-selection ( -> ) + #00 .is-lit STZ + #00 .is-lit-flip STZ + #01 .dirty STZ + #0000 DUP2 .lit-click-y STZ2 + DUP2 .lit-click-x STZ2 + DUP2 .lit-drag-y STZ2 + .lit-drag-x STZ2 JMP2r + +@update-selection ( -> ) + .Mouse/x DEI2 .Mouse/y DEI2 point-to-coord ( row* col* ) + OVR2 .lit-drag-y STZ2 DUP2 .lit-drag-x STZ2 ( row* col* ) + OVR2 .lit-click-y LDZ2 LTH2 ?&earlier ( row* col* ) + DUP2 .lit-click-x LDZ2 LTH2 ?&earlier ( row* col* ) + #00 !&done &earlier #01 ( row* col* ) + &done .is-lit-flip STZ POP2 POP2 JMP2r ( ) + +@end-selection ( -> ) + update-selection draw-cursor !handle-selection ( ) + +@on-click-down ( click^ -> ) + DUP #01 AND ?&left-click + DUP #02 AND ?&middle-click + !&done + &left-click POP !start-selection + &middle-click POP !paste-snarf + &done POP JMP2r + +@on-click-up ( unclick^ -> ) + #01 AND ?&left-click !&done + &left-click !end-selection + &done JMP2r + +@draw-at ( x* y* addr* -> ) + STH2k .Screen/addr DEO2 ( x* y* [addr*] ) + STH2k .Screen/y DEO2 ( x [addr* y*] ) + .Screen/x DEO2 ( [addr* y* x*] ) + #43 .Screen/sprite DEOk ( 43 sprite^ [addr* y* x*] ) + STH2r #0008 ADD2 .Screen/y DEO2 ( 43 sprite^ [addr*] ) + STH2r #0008 ADD2 .Screen/addr DEO2 ( 43 sprite^ ) + DEO JMP2r ( ) + +@draw-pointer ( -> ) + .lastmouse-x LDZ2 .lastmouse-y LDZ2 ( x* y* ) + .pointer-ttl LDZ ?&visible ;cp437/nul !draw-at + &visible ;cp437/rs !draw-at + +@on-move ( -> ) + #c4 .pointer-ttl STZ ( pointer visible for ~1 second ) + .Mouse/x DEI2 .lastmouse-x LDZ2 NEQ2 ?&redraw ( ) + .Mouse/y DEI2 .lastmouse-y LDZ2 NEQ2 ?&redraw ( ) + JMP2r ( ) + &redraw ( ) + .lastmouse-x LDZ2 .lastmouse-y LDZ2 ( lx* ly* ) + ;cp437/space draw-at ( ) + .is-lit LDZ #00 EQU ?&next ( ) + update-selection #01 .dirty STZ ( ) + &next ( ) + .Mouse/x DEI2 .Mouse/y DEI2 ( x* y* ) + .lastmouse-y STZ2 .lastmouse-x STZ2 ( ) + draw-pointer !screen-to-cursor ( ) + +@on-mouse ( -> BRK ) + .lastmouse-st LDZ ( last ) + .Mouse/state DEI ( last st ) + STHk OVR EOR STHkr AND ( last (last^st)&st [st] ) + on-click-down ( last [st] ) + DUP STHkr EOR AND ( last&(last^st) [st] ) + on-click-up ( [st] ) + STHr .lastmouse-st STZ ( ) + on-move BRK ( ) + +@on-key ( -> BRK ) + #00 .pointer-ttl STZ #01 .dirty STZ ( hide pointer ) + .Controller/key DEI ?&ok !on-button + &ok alt ?on-alt-key + ctrl ?on-ctrl-key + .Controller/key DEI + DUP #08 NEQ ?&done + POP #7f ( send DEL instead of BS ) + &done .Console/w DEO BRK + +@ctrl ( -> is-down? ) .Controller/button DEI #01 AND JMP2r +@alt ( -> is-down? ) .Controller/button DEI #02 AND JMP2r + +( alt-XYZ emits ESC and then emits XYZ ) +@on-alt-key ( -> BRK ) + #1b .Console/w DEO + ctrl ?on-ctrl-key + .Controller/key DEI .Console/w DEO BRK + +( control seqs: ) +( ctrl-sp -> 00 ) +( ctrl-@ -> 00 ) +( ctrl-a -> 01 ) +( ... ) +( ctrl-y -> 19 ) +( ctrl-z -> 1a ) +( ctrl-[ -> 1b ) +( esc -> 1b ) +( ctrl-\ -> 1c ) +( ctrl-] -> 1d ) +( ctrl-^ -> 1e ) +( ctrl-/ -> 1f ) +( ctrl-_ -> 1f ) + +( ctrl-$n emits: ) +( 0 <= $n < @ -> $n ) +( @ <= $n < ` -> $n #40 SUB ) +( ` <= $n <= #ff -> $n #60 SUB ) +@on-ctrl-key ( -> BRK ) + .Controller/key DEI + DUP #20 EQU ?&nul ( space ) + DUP #2d EQU ?&us ( '-' i.e. '_' ) + DUP #2f EQU ?&nul ( '/' ) + DUP #32 EQU ?&nul ( '2' i.e. '@' ) + DUP #36 EQU ?&rs ( '6' i.e. '^' ) + DUP LIT "@ LTH ?&done + DUP LIT "` LTH ?&c1 + LIT "` SUB !&done + &nul #00 !&done + &rs #1e !&done + &us #1f !&done + &c1 LIT "@ SUB + &done .Console/w DEO BRK + +@on-read-priv ( -> BRK ) + .Console/r DEI + DUP LIT "; EQU ?next-arg + DUP LIT "0 LTH ?end-arg-priv + DUP LIT "9 GTH ?end-arg-priv + !add-to-arg + +@start-priv ( -> BRK ) + POP ;on-read-priv .Console/vect DEO2 BRK + +@on-read-csi ( -> BRK ) + .Console/r DEI + DUP LIT "? EQU ?start-priv + DUP LIT "; EQU ?next-arg + DUP LIT "0 LTH ?end-arg + DUP LIT "9 GTH ?end-arg + !add-to-arg + +@on-read-osc ( -> BRK ) + .Console/r DEI + DUP #07 ( bell ) EQU ?&end-osc + #9c ( esc-\ ) EQU ?&end-osc BRK + &end-osc ;on-read .Console/vect DEO2 BRK + ( TODO: support 7-bit 1b 5c sequence? ) + +@debug-arg ( n* -> ) + &short SWP debug-arg/byte + &byte DUP #04 SFT debug-arg/char + &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD !scratch-write + +@debug-args ( -> ) + ;args/pos LDA2 ;args + &loop + #20 scratch-write + LDA2k debug-arg/short INC2 INC2 + LTH2k ?&done !&loop + &done POP2 POP2 JMP2r + +@debug-priv ( c^ -> ) + .debug LDZ ?&continue POP JMP2r &continue + reset-scratch + LIT2r =scratch-write + LIT "1 STH2kr JSR2 + LIT "b STH2kr JSR2 + #20 STH2kr JSR2 + LIT "[ STH2kr JSR2 + #20 STH2kr JSR2 + LIT "? STH2kr JSR2 + debug-args + #20 STH2kr JSR2 + STH2kr JSR2 + #0a STH2r JSR2 + scratch-len .File1/len DEO2 + ;scratch .File1/w DEO2 + JMP2r + +@end-arg-priv ( c^ -> BRK ) + ;on-read .Console/vect DEO2 + DUP LIT "h EQU ?exec-priv-set-or-unset + DUP LIT "l EQU ?exec-priv-set-or-unset + DUP debug-priv + ( TODO: handle these ) + POP BRK + +@exec-priv-set-or-unset ( c^ -> BRK ) + #0001 read-arg-1 ( c^ n* ) + DUP2 #0019 NEQ2 ?&!25 POP2 .tcem !&change + &!25 DUP2 #07d4 NEQ2 ?&!2004 POP2 .paste !&change + &!2004 POP2 debug-priv BRK + &change SWP LIT "h EQU SWP STZ BRK ( h is set, l is unset ) + +@debug-read ( c^ -> ) + .debug LDZ ?&continue POP JMP2r &continue + reset-scratch + debug-arg/byte + #0a scratch-write + scratch-len .File1/len DEO2 + ;scratch .File1/w DEO2 + JMP2r + +@debug-csi ( c^ -> ) + .debug LDZ ?&continue POP JMP2r &continue + reset-scratch + LIT2r =scratch-write + LIT "1 STH2kr JSR2 + LIT "b STH2kr JSR2 + #20 STH2kr JSR2 + LIT "[ STH2kr JSR2 + debug-args + #20 STH2kr JSR2 + STH2kr JSR2 + #0a STH2r JSR2 + scratch-len .File1/len DEO2 + ;scratch .File1/w DEO2 + JMP2r + +@end-arg ( c^ -> BRK ) + ;on-read .Console/vect DEO2 + DUP debug-csi + DUP LIT "@ EQU ?exec-ich ( ICH: insert blank characters ) + ( TODO ($n-sp-@) SL: shift left $n cols ) + DUP LIT "A EQU ?exec-cuu ( CUU: up ) + ( TODO ($n-sp-A) SR: shift right $n cols ) + DUP LIT "B EQU ?exec-cud ( CUD: down ) + DUP LIT "C EQU ?exec-cuf ( CUF: forward ) + DUP LIT "D EQU ?exec-cub ( CUB: back ) + DUP LIT "E EQU ?exec-cnl ( CNL: next line $n times ) + DUP LIT "F EQU ?exec-cpl ( CPL: prev line $n times ) + DUP LIT "G EQU ?exec-cha ( CHA: move cursor to abs col ) + DUP LIT "H EQU ?exec-cup ( CUP: move cursor [row;col] ) + DUP LIT "I EQU ?exec-cht ( CHT: forward by tab stops ) + DUP LIT "J EQU ?exec-ed ( ED: erase display ) + DUP LIT "K EQU ?exec-el ( EL: erase line ) + DUP LIT "L EQU ?exec-il ( IL: insert $n blank lines ) + DUP LIT "M EQU ?exec-dl ( DL: delete $n lines ) + DUP LIT "P EQU ?exec-dch ( DCH: delete n chars ) + DUP LIT "S EQU ?exec-su ( SU: scroll up ) + DUP LIT "T EQU ?exec-sd ( SD: scroll down ) + DUP LIT "X EQU ?exec-ech ( ECH: erase $n characters ) + DUP LIT "Z EQU ?exec-cbt ( CBT: backward by tab stops ) + DUP LIT "` EQU ?exec-hpa ( HPA: char pos abs col=$n ) + DUP LIT "a EQU ?exec-hpr ( HPR: char pos rel col=$n ) + ( TODO: b - REP: repeat previous graphic char $n times ) + ( TODO: c - DA: send device attributes ) + DUP LIT "d EQU ?exec-vpa ( VPA: move cursor to row ) + DUP LIT "e EQU ?exec-vpr ( VPR: line pos rel row+=$n ) + ( TODO: $r;$c f - HVP: horizontal/vertical position ) + DUP LIT "g EQU ?exec-tbc ( TBC: clear tab stops ) + DUP LIT "h EQU ?exec-sm ( SM: set mode ) + ( TODO: ?-$n-h - DECSET: set dec options ) + DUP LIT "l EQU ?exec-rm ( RM: reset mode ) + ( TODO: ?-$n-l - DECRST: reset dec options ) + DUP LIT "m EQU ?exec-sgr ( SGR: set graphical rendering ) + DUP LIT "n EQU ?exec-dsr ( DSR: device status reports ) + ( TODO: ?-$n-n - dec device status ) + ( TODO: $n-q - DECLL: load leds ) + DUP LIT "r EQU ?exec-set-scrolling-region ( [$top;$bot] DECSTM: set scrolling reg ) + DUP LIT "s EQU ?exec-scosc ( SCOSC: saved current cursor position ) + DUP LIT "u EQU ?exec-scorc ( SCORC: restore saved cursor position ) + ( = 0 C - normal cursor ) + ( = 1 C - bold cursor ) + debug-csi BRK + +( TODO ) +@exec-set-scrolling-region ( c^ -> BRK ) POP BRK + +@exec-tbc ( c^ -> BRK ) POP BRK + +@exec-scosc ( c^ -> BRK ) + POP .cur-x LDZ2 .saved-x STZ2 .cur-y LDZ2 .saved-y STZ2 BRK + +@exec-scorc ( c^ -> BRK ) + POP clear-cursor + .saved-x LDZ2 .cur-x STZ2 .saved-y LDZ2 .cur-y STZ2 + draw-cursor BRK + +@mode-addr ( n* -> zp^ ) + DUP2 #0004 NEQ2 ?{ POP2 .irm JMP2r } ( TODO: permanently reset ) + DUP2 #0007 NEQ2 ?{ POP2 .awm JMP2r } ( TODO: rename to DECAWM ) + ( TODO: 20 is LNM: line feed/newline mode ) + POP2 .ignored JMP2r + +@sm ( n* -> ) mode-addr #01 SWP STZ JMP2r +@rm ( n* -> ) mode-addr #00 SWP STZ JMP2r + +( other attributes: ) +( 10 - primary font ) +( 39 - default fg ) +( 49 - default bg ) +@read-attr ( attr* -> ) + DUP2 #0031 GTH2 ?&skip ( attr* ; skip > 49 ) + DUP2 ;sgr-fg ADD2 LDA ( attr* code^ ) + DUP #40 EQU ?&reset ( attr* code^ ) + DUP #80 EQU ?&invert ( attr* code^ ) + DUP #ff EQU ?&done ( attr* code^ ) + ROT ROT #0027 GTH2 ?&bg + .attr LDZ #fc !&update + &bg #20 SFT .attr LDZ #f3 + &update AND ORA .attr STZ !update-tint + + &reset #02 .attr STZ !&done + &invert .attr LDZ #80 ORA .attr STZ + &done update-tint POP &skip POP2 JMP2r + +@sgr-fg ( 0 1 2 3 4 5 6 7 8 9 a b c d e f ) + ( 00 ) 40 03 01 ff ff ff ff 80 ff ff ff ff ff ff ff ff + ( 10 ) ff ff ff ff ff ff ff ff ff ff ff ff ff ff 00 02 + ( 20 ) 02 02 02 02 02 03 ff 02 00 01 01 01 01 01 01 03 + ( 30 ) ff 00 + +@exec-sgr ( c^ -> BRK ) + POP + ;args/pos LDA2 ;args + &loop + LDA2k read-attr + INC2 INC2 + LTH2k ?&done !&loop + &done + POP2 POP2 BRK + +@exec0 ( addr* -> BRK ) STH2 #0000 read-arg-1 STH2r JSR2 BRK +@exec1 ( addr* -> BRK ) STH2 #0001 read-arg-1 STH2r JSR2 BRK + +@exec-cuu POP ;cuu !exec1 +@exec-cud POP ;cud !exec1 +@exec-cuf POP ;cuf !exec1 +@exec-cub POP ;cub !exec1 +@exec-ich POP ;ich !exec1 +@exec-dl POP ;dl !exec1 +@exec-dch POP ;dch !exec1 +@exec-il POP ;il !exec1 +@exec-cht POP ;cht !exec1 +@exec-cbt POP ;cbt !exec1 +@exec-cnl POP ;cnl !exec1 +@exec-cpl POP ;cpl !exec1 +@exec-su POP ;su !exec1 +@exec-ech POP ;ech !exec1 +@exec-hpa POP ;hpa !exec1 +@exec-hpr POP ;hpr !exec1 +@exec-vpr POP ;vpr !exec1 +@exec-sd POP BRK ( TODO ) +@exec-vpa POP ;vpa !exec1 +@exec-cha POP ;cha !exec1 +@exec-el POP ;el !exec0 +@exec-ed POP ;ed_ !exec0 +@exec-sm POP ;sm !exec1 +@exec-rm POP ;rm !exec1 +@exec-dsr POP ;dsr !exec1 + +@dsr ( n* -> ) + #0006 NEQ2 ?&done + #1b .Console/w DEO + LIT "[ .Console/w DEO + .cur-y LDZ2 INC2 emit-dec2 + LIT "; .Console/w DEO + .cur-x LDZ2 INC2 emit-dec2 + LIT "R .Console/w DEO + &done BRK + +@cnl ( n* -> ) clear-cursor #0000 .cur-x STZ2 !down-n +@cpl ( n* -> ) clear-cursor #0000 .cur-x STZ2 !up-n +@cub ( n* -> ) clear-cursor !back-n +@cud ( n* -> ) clear-cursor !down-n +@cuf ( n* -> ) clear-cursor !forward-n +@cuu ( n* -> ) clear-cursor !up-n +@hpa ( n* -> ) unset-wrap clear-cursor dec-floor .max-x LDZ2 min .cur-x STZ2 !draw-cursor +@hpr ( n* -> ) clear-cursor !forward-n +@vpr ( n* -> ) clear-cursor !down-n +@vpa ( n* -> ) dec-floor .cur-x LDZ2 !goto +@cha ( n* -> ) dec-floor .cur-y LDZ2 SWP !goto + +@su ( n* -> ) + #0000 SWP2 SUB2 STH2 clear-cursor ( [-count*] ) + &loop scroll INC2r ORAkr STHr ?&loop ( [-i+1*] ) + POP2r JMP2r ( ) + +@ech ( n* -> ) + #0000 SWP2 SUB2 STH2 ( [-count*] ) + #0200 cur-addr ( 0200 addr* [-count*] ) + &loop ( 0200 pos* [-i*] ) + STA2k INC2 INC2 ( 0200 pos+2* [-i*] ; pos<-0200 ) + INC2r ORAkr STHr ?&loop ( pos+2* [-i+1*] ) + POP2 POP2 POP2r ( ) + #01 .dirty STZ JMP2r ( ) + +@el ( n* -> ) + DUP2 #0000 EQU2 ?&erase-to-end + DUP2 #0001 EQU2 ?&erase-from-start + DUP2 #0002 EQU2 ?&erase-full + POP2 JMP2r + &erase-full POP2 bol-addr eol-addr !erase + &erase-to-end POP2 cur-addr eol-addr !erase + &erase-from-start POP2 bol-addr cur-addr !erase + +@ed_ ( n* -> ) + DUP2 #0000 EQU2 ?&erase-to-end + DUP2 #0001 EQU2 ?&erase-from-start + DUP2 #0002 EQU2 ?&erase-full + POP2 JMP2r + &erase-full POP2 first-addr limit-addr !erase + &erase-to-end POP2 bol-addr limit-addr !erase + &erase-from-start POP2 first-addr eol-addr ( fall-through ) +@erase ( start* end* -> ) #0200 !init + +@exec-cup ( c^ -> BRK ) + POP ( ) + #0001 read-arg-1 dec-floor ( row ) + #0001 read-arg-2 dec-floor ( col ) + goto BRK ( ) + +@dec-floor ( x* -> x==0 ? 0* : x-1* ) + #0001 SUB2 #0000 !smax + +@debug-esc ( c^ -> ) + .debug LDZ ?&continue POP JMP2r &continue + LIT2r =scratch + LIT "1 STH2kr STA INC2r + LIT "b STH2kr STA INC2r + #20 STH2kr STA INC2r + STH2kr STA INC2r + #0a STH2r STA + #0005 .File1/len DEO2 + ;scratch .File1/w DEO2 + JMP2r + +@on-read-esc ( -> BRK ) + .Console/r DEI + DUP debug-esc + &after + ( TODO: SP-F, SP-G, SP-L, SP-M, SP-N ) + ( TODO: #-3, #-4, #-5, #-6, #-8 ) + ( TODO: %-@, %-G ) + DUP LIT "D EQU ?exec-ind ( IND: index ) + DUP LIT "E EQU ?exec-nel ( NEL: next line ) + DUP LIT "H EQU ?exec-hts ( HTS: tab set ) + DUP LIT "M EQU ?exec-ri ( RI: reverse index ) + DUP LIT "P EQU ?exec-dcs ( DCS: device control string ) + DUP LIT "[ EQU ?start-csi ( CSI: control sequence introducer ) + DUP LIT "] EQU ?start-osc ( OSC: operating system command ) + DUP LIT "c EQU ?exec-ris ( RIS: full reset ) + DUP LIT "( EQU ?start-charset + DUP LIT ") EQU ?start-charset + DUP LIT "7 EQU ?&skip ( DECSC: save cursor ) + DUP LIT "8 EQU ?&skip ( DECRC: restore cursor ) + DUP LIT "> EQU ?&skip ( DECKPNM: normal keypad ) + DUP LIT "~ EQU ?&skip ( LS1R: invoke G1 charset as GR ) + DUP LIT "# EQU ?&skip ( TODO: DECALN, fill screen with Es ) + debug-esc + ;on-read .Console/vect DEO2 + !on-read + &skip POP ;on-read .Console/vect DEO2 BRK + +@exec-ind ( c^ -> ) POP clear-cursor down-or-scroll BRK +@exec-nel ( c^ -> ) POP cr BRK +@exec-hts ( c^ -> ) POP BRK ( TODO ) +@exec-ri ( c^ -> ) POP clear-cursor #0001 up-n BRK +@exec-dcs ( c^ -> ) POP BRK ( TODO ) + +@exec-ris ( c^ -> ) + POP first-addr limit-addr erase + reset-terminal BRK + +@on-read-skip ( -> BRK ) + ;on-read .Console/vect DEO2 + BRK + +( preceeded by '(' [G0] or ')' [G1] ) +( "A" -> UK ) +( "B" -> USASCII ) +( "0" -> DEC special graphics, line drawing ) +@start-charset ( c^ -> BRK ) + POP ;on-read-skip .Console/vect DEO2 BRK + +@start-csi ( c^ -> BRK ) + POP reset-args ;on-read-csi .Console/vect DEO2 BRK + +@start-osc ( c^ -> BRK ) + POP reset-args ;on-read-osc .Console/vect DEO2 BRK + +( TODO: 8-bit input not ready for prime time yet ) +@on-read ( -> BRK ) + .Console/r DEI ( DUP #7f GTH ?read-8bit ) read BRK + +@read-8bit ( c^ -> BRK ) + DUP debug-esc #80 SUB !on-read-esc/after + +@read ( c^ -> ) + DUP debug-read + DUP ?&ok POP JMP2r + &ok + DUP #20 LTH ?read-ctrl + DUP #7f EQU ?read-del + ( fall through to draw ) + +@draw ( c^ -> ) + .tint LDZ SWP DUP2 insert-cell draw-cell + .cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ + clear-cursor !forward + +@read-ctrl ( c^ -> ) + DUP #05 EQU ?&skip ( ENQ - return terminal status ) + DUP #07 EQU ?read-bel + DUP #08 EQU ?read-bs + DUP #09 EQU ?read-tab ( HT ) + DUP #0a EQU ?read-lf ( NL - LF ) + DUP #0b EQU ?read-lf ( VT - treated as LF ) + DUP #0c EQU ?read-lf ( FF - treated as LF ) + DUP #0d EQU ?read-cr ( CR ) +( DUP #0e EQU ?&skip ( TODO: SO - shift out; G0 charset ) ) +( DUP #0f EQU ?&skip ( TODO: SI - shift in; G1 charset ) ) + DUP #1b EQU ?read-esc + &skip POP JMP2r + +@read-bel ( 07 -> ) + POP .visual-bell LDZ #00 EQU ?&done + #06 .flash STZ #01 .dirty STZ + &done JMP2r + +( TODO: handle reverse wrap-around and dec auto-wrap ) +@read-bs ( 08 -> ) + POP clear-cursor #0001 !back-n + +@read-esc ( 1b -> ) + POP ;on-read-esc .Console/vect DEO2 JMP2r + +@read-del ( 7f -> ) + POP JMP2r + +( TODO: respect tab stops ) +@read-tab ( 09 -> ) + POP + .cur-x LDZ2 ( x* ) + NIP #07 AND #08 SUB ( i=(xlo&7)-8^ ) + &loop ( i^ ) + .tint LDZ #20 DUP2 ( i^ cell* cell* ) + cur-addr STA2 ( i^ cell* ; addr<-cell ) + draw-cell ( i^ ) + clear-cursor ( i^ ) + forward ( i^ ) + INC DUP ?&loop ( i+1^ ) + POP JMP2r ( ) + +@cr ( -> ) + clear-cursor #0000 .cur-x STZ2 !draw-cursor + +@read-cr ( 0d -> ) + POP .cur-wrap LDZ ?&skip cr &skip JMP2r + +@at-max-x ( -> true? ) .cur-x LDZ2 .max-x LDZ2 EQU2 JMP2r +@at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r + +@read-lf ( 0a -> ) + POP !lf + +( TODO: cur-wrap machinery not vt100 compliant. ) +( cursor should stay on previous line normally ) +@lf ( -> ) + .cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r + +@goto ( y* x* -> ) + unset-wrap + clear-cursor + .max-x LDZ2 min .cur-x STZ2 + .max-y LDZ2 min .cur-y STZ2 + !draw-cursor + +@forward-n ( n* -> ) + .cur-x LDZ2 ADD2 .max-x LDZ2 min .cur-x STZ2 !draw-cursor + +@back-n ( n* -> ) + unset-wrap + .cur-x LDZ2 SWP2 SUB2 #0000 smax .cur-x STZ2 !draw-cursor + +@up-n ( n* -> ) + .cur-y LDZ2 SWP2 SUB2 #0000 smax .cur-y STZ2 !draw-cursor + +@down-n ( n* -> ) + .cur-y LDZ2 ADD2 .max-y LDZ2 min .cur-y STZ2 !draw-cursor + +@forward ( -> ) #0001 !forward-n +@down ( -> ) #0001 !down-n + +@down-or-scroll ( -> ) at-max-y ?&s !down &s !scroll + +@maybe-autowrap ( -> ) + .cur-wrap LDZ #00 EQU ?&skip + #00 .cur-wrap STZ + clear-cursor + #0000 .cur-x STZ2 + at-max-y ?&scrolling + .cur-y LDZ2k INC2 ROT STZ2 + screen-to-cursor + &skip JMP2r + &scrolling !scroll + +@insert-cell ( cell* -> ) + maybe-autowrap ( cell* ) + .irm LDZ #00 EQU ?&replace ( cell* ) + cur-addr ( cell* lim* ) + eol-addr #0002 SUB2 ( cell* lim* last=eol-2* ) + &loop ( cell* lim* pos* ) + STH2k #0002 SUB2 LDA2k ( cell* lim* pos-2* cell* [pos*] ) + STH2r STA2 LTH2k ?&loop ( cell* lim* pos-2* ) + POP2 POP2 ( cell* ) + &replace ( cell* ) + cur-addr STA2 JMP2r ( ) + +@cht ( n* -> ) + clear-cursor + dec-floor #30 SFT2 ( i=(n-1)8* ) + #0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* ) + ADD2 !forward-n ( ) + +@cbt ( n* -> ) + unset-wrap + clear-cursor + dec-floor #30 SFT2 ( i=(n-1)8* ) + .cur-x LDZ2 #0007 AND2 ( i* cur%8* ) + ADD2 !back-n ( ) + +@il ( n* -> ) + .col-bytes LDZ2 MUL2 STH2 ( [i*] ) + bol-addr ( bound* [i*] ) + limit-addr STH2kr ( bound* limit* i* [i*] ) + INC2 INC2 SUB2 ( bound* start=limit-i-2* [i*] ) + &loop ( bound* pos* [i*] ) + LDA2k OVR2 STH2kr ADD2 ( bound* pos* x* pos+i* [i*] ) + STA2 ( bound* pos* [i*] ; pos+i<-x ) + #0200 OVR2 STA2 ( bound* pos* [i*] ; pos<-0200 ) + #0002 SUB2 ( bound* pos-2* [i*] ) + GTH2k #00 EQU ?&loop ( bound* pos-2* [i*] ) + POP2 POP2 POP2r ( ) + #01 .dirty STZ JMP2r ( ) + +@ich ( n* -> ) + STH2 ( [n*] ) + eol-addr #0001 SUB2 ( last* [n*] ) + STH2kr DUP2 ADD2 SUB2 ( start=last-2n* [n*] ) + cur-addr SWP2 ( end* start* [n*] ) + DUP2kr ADD2r ( end* start* [n* 2n*] ) + &loop ( end* pos* [n* 2n*] ) + LDA2k OVR2 STH2kr ADD2 ( end* pos* x* pos+2n* ) + STA2 #0002 SUB2 ( end* pos-2* [n* 2n*] ) + GTH2k #00 EQU ?&loop ( end* pos-2* [n* 2n*] ) + POP2 POP2 POP2r ( [n*] ) + LIT2r 0000 SWP2r SUB2r ( [-n*] ) + #0200 cur-addr ( 0200 cur* [-n*] ) + &loop2 ( 0200 pos* [-i*] ) + STA2k INC2 INC2 INC2r ( 0200 pos+2* [-i+1*] ) + ORAkr STHr ?&loop2 ( 0200 pos+2* [-i+1*] ) + POP2 POP2 POP2r ( ) + #01 .dirty STZ JMP2r ( ) + +( starts with cursor pos ) +@dch ( n* -> ) + DUP2 ADD2 STH2 ( [i=2n*] ) + eol-addr STH2kr SUB2 ( limit=eol-i* [i*] ) + cur-addr ( limit* start* [i*] ) + &loop ( limit* pos* [n*] ) + DUP2 STH2kr ADD2 LDA2k ( limit* pos* pos+i* x* [i*] ) + #0200 ROT2 STA2 ( limit* pos* x* [i*] ; pos+i<-0200 ) + OVR2 STA2 INC2 INC2 ( limit* pos+2* [i*] ; pos<-x ) + GTH2k ?&loop ( limit* pos+2* [i*] ) + POP2 POP2 POP2r ( ) + #01 .dirty STZ JMP2r ( ) + +( starts below current line ) +@dl ( n* -> ) + .col-bytes LDZ2 MUL2 STH2 ( [n*] ) + limit-addr STH2kr SUB2 ( limit* [n*] ) + eol-addr ( limit* start* [n*] ) + !dch/loop + +@scroll ( -> ) + limit-addr STH2 ( [lim*] ) + ;cells .col-bytes LDZ2 ADD2 STH2 ( [lim* addr*] ) + &loop ( [lim* pos*] ) + STH2kr LDA2 #0200 STH2kr STA2 ( cell* [lim* pos* cell*] ; pos<-0200 ) + STH2kr .col-bytes LDZ2 SUB2 STA2 ( [lim* pos*] ; pos-cb<-cell ) + INC2r INC2r GTH2kr STHr ?&loop ( [lim* pos+2*] ) + POP2r POP2r ( ) + #01 .dirty STZ ( ) + !draw-cursor ( ) + +( bits: Rx xx FF BB ) +( - R: reversed [0=normal, 1=reversed] ) +( - F: foreground [0:black, 1:dim, 2:normal, 3:bright] ) +( - B: background [0:black, 1:dim, 2:normal, 3:bright] ) +@update-tint ( -> ) + .attr LDZ + DUP #80 LTH ?&ok + #80 EOR DUP #02 SFT SWP #20 SFT #0c AND ORA + &ok .tint STZ JMP2r + +@reverse-tint ( tint^ -> tint^ ) + #0f AND ( x=tint&0f ) + DUP #02 SFT SWP ( x>>2 x ) + #03 AND #20 SFT ( x>>2 (x&3)<<2 ) + ORA ( res=40|x>>2|(x&3)<<2 ) + JMP2r ( res^ ) + +( to draw a 12 pixel high character we first draw the top ) +( 8 pixels and then we draw the bottom 8 pixels; there is ) +( an overlap of 4 pixels. we do this to avoid drawing too ) +( low which might overwrite characters on the next line. ) + +( cell* = tint^ c^ ) +@draw-cell ( cell* -> ) + SWP STH ( c^ [tint^] ) + #00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] ) + .Screen/addr DEO2k ( addr* s^ [tint^] ) + STHkr .Screen/sprite DEO ( addr* s^ [tint^] ) + .Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] ) + STH #0004 ADD2 STHr DEO2 ( [tint^] ) + STHr .Screen/sprite DEO ( ) + .Screen/y DEI2k #0004 SUB2 ROT DEO2 ( ) + JMP2r ( ) + +@highlight-cell ( cell* -> ) + NIP LITr 47 ( c^ [tint^] ) + #00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] ) + .Screen/addr DEO2k ( addr* s^ [tint^] ) + STHkr .Screen/sprite DEO ( addr* s^ [tint^] ) + .Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] ) + STH #0004 ADD2 STHr DEO2 ( [tint^] ) + STHr .Screen/sprite DEO ( ) + .Screen/y DEI2k #0004 SUB2 ROT DEO2 ( ) + JMP2r ( ) + +@next-arg ( c^ -> BRK ) + POP + ( TODO: check if we already have max args ) + ;args/pos LDA2k INC2 INC2 SWP2 STA2 BRK + +@add-to-arg ( c^ -> BRK ) + LIT "0 SUB LITr 00 STH ( [digit*] ) + ;args/pos LDA2 LDA2k ( addr* value* [digit*] ) + #000a MUL2 STH2r ADD2 ( addr* value*10+digit ) + SWP2 STA2 BRK + +@read-arg-1 ( default* -> n* ) ;args/arg1 LDA2 !max +@read-arg-2 ( default* -> n* ) ;args/arg2 ( INC2 INC2 ) LDA2 !max + +@reset-args ( -> ) + ;args ;args/pos STA2 + #0000 ;args LITr f8 + &loop STA2k INC2 INC2 + INCr STHkr ?&loop + POPr POP2 POP2 JMP2r + +( emit a signed short as a decimal ) +@emit-sdec2 ( n* -> ) + DUP2k #1f SFT2 EQUk ?&s LIT2 "- 18 DEO + &s MUL2 SUB2 ( fall-through to emit-dec2 ) + +( emit an unsigned short as a decimal ) +@emit-dec2 ( n* -> ) + LITr ff00 &read #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&read + POP2 &write NIP #30 ADD #18 DEO OVRr ADDr STHkr ?&write + POP2r JMP2r + +@debug-log "debug_term.log 00 +@scratch $40 &pos $2 + +@scratch-write ( c^ -> ) + ;scratch/pos LDA2 STA + ;scratch/pos LDA2k INC2 SWP2 STA2 JMP2r +@scratch-len ( -> n* ) + ;scratch/pos LDA2 ;scratch SUB2 JMP2r +@reset-scratch + ;scratch ;scratch/pos STA2 JMP2r + +( store up to 8 arguments for control sequences ) +( @args $10 &pos $2 ) +@args [ &arg1 $2 &arg2 $2 &rest $c &pos $2 ] + +( 256 chars x 2 tiles/char x 8 bytes/tile = 4096 bytes ) +( second tile only uses top 50% ) +@cp437 + ~cp437.tal + +@snarf ".snarf 00 + +@meta 00 &body + &name "determ 0a + &details "ansi 20 "terminal 20 "emulator 0a + &author "by 20 "d_m 0a + &date "13 20 "nov 20 "2023 00 + 02 + ( device mask ) 41 0d07 + ( 24x24 icon ) 83 =icon-2-bit + +@banner-ascii + 0d 0a + 20 20 c9 cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd bb 0d 0a + 20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a + 20 20 ba 20 20 "d "e "t "e "r "m 20 20 "v "1 "1 20 20 ba 0d 0a + 20 20 ba 20 20 20 20 "b "y 20 "d "_ "m 20 20 20 20 20 ba 0d 0a + 20 20 ba 20 20 "1 "3 20 "n "o "v 20 "2 "0 "2 "3 20 20 ba 0d 0a + 20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a + 20 20 c8 cd cd cb cd cd cd cd cd cd cd cd cd cb cd cd bc 0d 0a + 20 20 c9 cb cb ce cb cb cb cb cb cb cb cb cb ce cb cb bb 0d 0a + 20 20 c8 ca ca ca ca ca ca ca ca ca ca ca ca ca ca ca bc 0d 0a + 0d 0a 00 + +@icon-2-bit + 00 00 00 1f 3f 38 32 34 00 00 00 00 00 07 0f 0f + 00 00 00 ff ff 00 00 00 00 00 00 00 00 ff ff ff + 00 00 00 f8 fc 1c 4c 2c 00 00 00 00 00 e0 f0 f0 + 34 30 30 30 30 30 30 30 0f 0f 0f 0f 0f 0f 0f 0f + 00 00 00 00 00 00 00 00 ff ff ff ff ff ff ff ff + 2c 0c 0c 0c 0c 0c 0c 0c f0 f0 f0 f0 f0 f0 f0 f0 + 34 34 32 38 3f 1e 07 00 0f 0f 0f 07 00 03 00 00 + 00 00 00 00 ff a0 ff 00 ff ff ff ff 00 ff 00 00 + 2c 2c 4c 1c fc 38 e0 00 f0 f0 f0 e0 00 c0 00 00 + +( paste buffer ) +@paste-buf $0780 ( max 80 x 24 characters ) +@paste-pos $2 + +( TODO: tab stops ) + +( state ) +@setup + &alternate-keypad-mode 00 ( 00 numeric [DECKPNM], 01 application [DECKPAM] ) + &ansi-vt52 00 ( DECANM; 00 ansi, 01 vt-52 ) + &chars-per-line 00 ( DECCOLM; 00 80, 01 132 ) + &cursor-key-modes 00 ( DECCKM ) + &new-line 00 ( LNM; 00 return=CR, return=CRLF; ignored by IND/NEL ) + &origin-mode 00 ( DECOM; ) + &screen 00 ( DECSCNM; 00 normal, 01 reverse video ) + &wraparound 00 ( DECAWM; right margin 00 replace, 01 next line/scroll ) + &3-shifted "B ( SCS; character set selected; B is ASCII ) + +( store tint+char for each screen position ) +@cells ( width x height x 2 bytes ) diff --git a/test/xclock.tal b/test/xclock.tal new file mode 100644 index 0000000..bb34a26 --- /dev/null +++ b/test/xclock.tal @@ -0,0 +1,25 @@ +( xclock.tal ) +( ) +( runs 4 xclock processes. ) +( ) +( when one is killed it immediately restarts. ) +( when this program exits all xclocks also exit. ) + +|10 @Console [ + &vect $2 &stdin $1 &pad1 $1 &proc-get $1 &host-get $1 &pad2 $1 &type $1 + &stdout $1 &stderr $1 &proc-put $1 &pad3 $1 ¶m $2 &opts $1 &host-put $1 +] + +|0100 + #00 &loop DUP run-xclock INC DUP #04 LTH ?&loop POP + ;on-console .Console/vect DEO2 BRK + +@on-console ( -> BRK ) + .Console/type DEI DUP #80 AND ?{ POP BRK } #0f AND run-xclock BRK + +@run-xclock ( child^ -> ) + .Console/opts DEO + ;xclock .Console/param DEO2 + #01 .Console/host-put DEO JMP2r + +@xclock "xclock 00