mirror of https://git.sr.ht/~rabbits/thuesday
Connected display
This commit is contained in:
Devine Lu Linvega
parent
aba84bc847
commit
c5b975bc1a
|
|
@ -0,0 +1,22 @@
|
|||
AlignAfterOpenBracket: DontAlign
|
||||
AlignEscapedNewlines: DontAlign
|
||||
AlignOperands: DontAlign
|
||||
AllowShortBlocksOnASingleLine: Always
|
||||
AllowShortCaseLabelsOnASingleLine: true
|
||||
AllowShortEnumsOnASingleLine: true
|
||||
AllowShortIfStatementsOnASingleLine: true
|
||||
AllowShortLoopsOnASingleLine: true
|
||||
AlwaysBreakAfterDefinitionReturnType: TopLevel
|
||||
BreakBeforeTernaryOperators: false
|
||||
BinPackArguments: false
|
||||
BinPackParameters: false
|
||||
BreakBeforeBraces: WebKit
|
||||
IndentCaseLabels: false
|
||||
TabWidth: 4
|
||||
IndentWidth: 4
|
||||
ContinuationIndentWidth: 4
|
||||
UseTab: ForContinuationAndIndentation
|
||||
ColumnLimit: 0
|
||||
ReflowComments: false
|
||||
SortIncludes: false
|
||||
SpaceBeforeParens: false
|
||||
30
LICENSE
30
LICENSE
|
|
@ -1,13 +1,21 @@
|
|||
Copyright (c) 2020 Devine Lu Linvega
|
||||
MIT License
|
||||
|
||||
Permission to use, copy, modify, and distribute this software for any
|
||||
purpose with or without fee is hereby granted, provided that the above
|
||||
copyright notice and this permission notice appear in all copies.
|
||||
Copyright (c) Devine Lu Linvega
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
|
|
|
|||
28
README.md
28
README.md
|
|
@ -1,25 +1,31 @@
|
|||
# Thuesday
|
||||
|
||||
[Thuesday](https://wiki.xxiivv.com/site/thue.html) is a Thue virtual machine, written in [Uxntal](https://wiki.xxiivv.com/site/uxntal.html).
|
||||
An ordinator for the [Modal semi-thue](https://wiki.xxiivv.com/site/modal.html), written in ANSI C. The emulator contains a few linux specific utilities in the Console device to allow for it to interface with the unix systems.
|
||||
|
||||
## Build
|
||||
## Building
|
||||
|
||||
You must have an [Uxntal](https://git.sr.ht/~rabbits/uxn) assembler.
|
||||
### Graphical
|
||||
|
||||
All you need is X11.
|
||||
|
||||
```sh
|
||||
uxnasm src/thuesday.tal bin/thuesday.rom
|
||||
gcc -Os -DNDEBUG -g0 -s src/modal.c src/thuesday.c -o bin/thuesday -lX11
|
||||
```
|
||||
|
||||
If do not wish to assemble it yourself, you can download [thuesday.rom](https://rabbits.srht.site/thuesday/thuesday.rom).
|
||||
## Usage
|
||||
|
||||
## Run
|
||||
|
||||
You must have a Varvara emulator.
|
||||
The first parameter is the modal file, the subsequent arguments will be accessible to the read register.
|
||||
|
||||
```sh
|
||||
uxnemu bin/thuesday.rom
|
||||
bin/thuesday etc/hello.modal
|
||||
```
|
||||
|
||||
## Manual
|
||||
## Need a hand?
|
||||
|
||||
Source files may not have blank lines, linebreaks use `backtick` instead of `0x0a` or `0x0d`.
|
||||
The following resources are a good place to start:
|
||||
|
||||
* [Modal Reference](https://wiki.xxiivv.com/site/modal.html)
|
||||
|
||||
## Contributing
|
||||
|
||||
Submit patches using [`git send-email`](https://git-send-email.io/) to the [~rabbits/public-inbox mailing list](https://lists.sr.ht/~rabbits/public-inbox).
|
||||
|
|
|
|||
26
build.sh
26
build.sh
|
|
@ -1,26 +0,0 @@
|
|||
#!/bin/sh -e
|
||||
|
||||
echo "Cleaning.."
|
||||
rm -rf bin
|
||||
mkdir bin
|
||||
|
||||
if [ -e "$HOME/roms/uxnlin.rom" ]
|
||||
then
|
||||
echo "Linting.."
|
||||
uxncli $HOME/roms/uxnlin.rom src/thuesday.tal
|
||||
uxncli $HOME/roms/uxnlin.rom src/thuesday-cli.tal
|
||||
fi
|
||||
|
||||
echo "Assembling.."
|
||||
uxnasm src/thuesday-cli.tal bin/thuesday-cli.rom
|
||||
uxnasm src/thuesday.tal bin/thuesday.rom
|
||||
|
||||
if [ -d "$HOME/roms" ] && [ -e ./bin/thuesday.rom ]
|
||||
then
|
||||
cp ./bin/thuesday.rom $HOME/roms
|
||||
echo "Installed in $HOME/roms"
|
||||
fi
|
||||
|
||||
echo "Running.."
|
||||
uxncli bin/thuesday-cli.rom etc/sierpinski.t
|
||||
uxn11 bin/thuesday.rom etc/boing.t
|
||||
11
etc/boing.t
11
etc/boing.t
|
|
@ -1,11 +0,0 @@
|
|||
|>-::=|->
|
||||
>-::=->
|
||||
->|::=@*|
|
||||
@::=~ping!
|
||||
*|::=<-|
|
||||
-<::=<-
|
||||
|<::=|*&
|
||||
&::=~pong!
|
||||
|*::=|->
|
||||
::=
|
||||
|>----------|
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
?(?-) (This example prints to the console and demonstrates how to delay the execution of a rule.)
|
||||
|
||||
<> (NAME) (Modal)
|
||||
<> (?: print String) (?:)
|
||||
<> (String ?x) (?x String)
|
||||
|
||||
String (Welcome to NAME \nHave fun!\n\n) print
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
print::=~Hello World!
|
||||
::=
|
||||
[print]
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
1_::=1++
|
||||
0_::=1
|
||||
01++::=10
|
||||
11++::=1++0
|
||||
_0::=_
|
||||
_1++::=10
|
||||
::=
|
||||
_1111111111_
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
X::=~_
|
||||
Y::=~*
|
||||
Z::=~`
|
||||
_.::=._X
|
||||
_*::=*_Y
|
||||
._|::=.Z-|
|
||||
*_|::=Z
|
||||
..-::=.-.
|
||||
**-::=*-.
|
||||
*.-::=*-*
|
||||
.*-::=.-*
|
||||
@.-::=@_.
|
||||
@*-::=@_*
|
||||
::=
|
||||
@_*...............................|
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
|
||||
EMU_src=src/thuesday.c
|
||||
|
||||
RELEASE_flags=-DNDEBUG -O2 -g0 -s
|
||||
DEBUG_flags=-std=c99 -D_POSIX_C_SOURCE=199309L -DDEBUG -Wall -Wno-unknown-pragmas -Wpedantic -Wshadow -Wextra -Werror=implicit-int -Werror=incompatible-pointer-types -Werror=int-conversion -Wvla -g -Og -fsanitize=address -fsanitize=undefined
|
||||
|
||||
.PHONY: all debug dest run test install uninstall format clean archive
|
||||
|
||||
all: dest
|
||||
|
||||
dest:
|
||||
@ mkdir -p bin
|
||||
run: all bin/thuesday
|
||||
@ bin/thuesday etc/hello.modal
|
||||
debug: bin/thuesday-debug
|
||||
@ bin/thuesday-debug etc/hello.modal
|
||||
install: all
|
||||
@ cp bin/thuesday ~/bin/
|
||||
uninstall:
|
||||
@ rm -f ~/bin/thuesday
|
||||
format:
|
||||
@ clang-format -i src/modal.c src/thuesday.c
|
||||
clean:
|
||||
@ rm -fr bin
|
||||
|
||||
bin/thuesday: ${EMU_src}
|
||||
@ cc ${RELEASE_flags} ${CFLAGS} ${EMU_src} -lX11 -lutil -o bin/thuesday
|
||||
bin/thuesday-debug: ${EMU_src}
|
||||
@ cc ${DEBUG_flags} ${CFLAGS} ${EMU_src} -lX11 -lutil -o bin/thuesday-debug
|
||||
|
|
@ -0,0 +1,332 @@
|
|||
#include <stdio.h>
|
||||
|
||||
typedef struct {
|
||||
unsigned int id, refs;
|
||||
char *a, *b;
|
||||
} Rule;
|
||||
|
||||
static unsigned char rmin = 0xff, rmax = 0x00;
|
||||
static int flip, quiet, debug, cycles = 0x10000;
|
||||
static Rule rules[0x1000], *rules_ = rules, lambda;
|
||||
static char dict[0x8000], *dict_ = dict, empty;
|
||||
static char bank_a[0x4000], *src_ = bank_a;
|
||||
static char bank_b[0x4000], *dst_ = bank_b;
|
||||
static char *regs[0x100];
|
||||
|
||||
#define spacer(c) (c <= ' ' || c == '(' || c == ')')
|
||||
|
||||
static char *
|
||||
walk(char *s)
|
||||
{
|
||||
char c;
|
||||
int depth = 0;
|
||||
if(*s == '(') {
|
||||
while((c = *s++)) {
|
||||
if(c == '(') depth++;
|
||||
if(c == ')') --depth;
|
||||
if(!depth) return s;
|
||||
}
|
||||
}
|
||||
while((c = *s) && !spacer(c)) s++;
|
||||
return s;
|
||||
}
|
||||
|
||||
static int
|
||||
sint(char *s)
|
||||
{
|
||||
char c;
|
||||
int r = 0, n = 1;
|
||||
if(*s == '-') { n = -1, s++; }
|
||||
while((c = *s++) && c > 0x20) r = r * 10 + c - '0';
|
||||
return r * n;
|
||||
}
|
||||
|
||||
static void
|
||||
device_write(char *s)
|
||||
{
|
||||
char c = *s, *cap = walk(s), **reg = regs + '0';
|
||||
/* phase: ALU */
|
||||
if(*reg) {
|
||||
int acc = sint(*reg++);
|
||||
/* clang-format off */
|
||||
switch(c) {
|
||||
case '+': while(*reg) acc += sint(*reg++); break;
|
||||
case '-': while(*reg) acc -= sint(*reg++); break;
|
||||
case '*': while(*reg) acc *= sint(*reg++); break;
|
||||
case '/': while(*reg) acc /= sint(*reg++); break;
|
||||
case '%': while(*reg) acc %= sint(*reg++); break;
|
||||
case '&': while(*reg) acc &= sint(*reg++); break;
|
||||
case '^': while(*reg) acc ^= sint(*reg++); break;
|
||||
case '|': while(*reg) acc |= sint(*reg++); break;
|
||||
case '=': while(*reg) acc = acc == sint(*reg++); break;
|
||||
case '!': while(*reg) acc = acc != sint(*reg++); break;
|
||||
case '>': while(*reg) acc = acc > sint(*reg++); break;
|
||||
case '<': while(*reg) acc = acc < sint(*reg++); break;
|
||||
}
|
||||
/* clang-format on */
|
||||
dst_ += snprintf(dst_, 0x10, "%d", acc);
|
||||
return;
|
||||
}
|
||||
/* phase: string */
|
||||
if(*s == '(') s++, --cap;
|
||||
while(s < cap) {
|
||||
c = *s++;
|
||||
if(c == '\\') {
|
||||
switch(*s++) {
|
||||
case 't': putc(0x09, stdout); break;
|
||||
case 'n': putc(0x0a, stdout); break;
|
||||
case 's': putc(0x20, stdout); break;
|
||||
}
|
||||
} else
|
||||
putc(c, stdout);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
device_read(void)
|
||||
{
|
||||
char c, *origin = dst_;
|
||||
while(fread(&c, 1, 1, stdin) && c >= ' ')
|
||||
*dst_++ = c;
|
||||
if(feof(stdin))
|
||||
*dst_++ = 'E', *dst_++ = 'O', *dst_++ = 'F';
|
||||
if(dst_ - origin == 0)
|
||||
dst_--;
|
||||
}
|
||||
|
||||
static void
|
||||
write_reg(char r, char *reg)
|
||||
{
|
||||
char c, *cap = walk(reg);
|
||||
switch(r) {
|
||||
case '>': /* op: output */
|
||||
case ':': device_write(reg); return;
|
||||
case '<': /* op: input */
|
||||
case '~': device_read(); return;
|
||||
case '^': /* op: join */
|
||||
if(*reg == '(') reg++, --cap;
|
||||
while(reg < cap && (c = *reg++))
|
||||
if(!spacer(c)) *dst_++ = c;
|
||||
return;
|
||||
case '.': /* op: unwrap */
|
||||
if(*reg == '(') reg++, --cap;
|
||||
while(reg < cap) *dst_++ = *reg++;
|
||||
return;
|
||||
case '*': { /* op: explode */
|
||||
int i, depth = 0;
|
||||
if(*reg == '(' && reg[1] != ')') { /* tuple */
|
||||
reg++;
|
||||
while(reg < cap) {
|
||||
while((c = *reg) && !spacer(c))
|
||||
*dst_++ = c, reg++;
|
||||
*dst_++ = ' ';
|
||||
*dst_++ = '(', reg++, depth++;
|
||||
}
|
||||
} else /* token */
|
||||
while((c = *reg++) && !spacer(c))
|
||||
*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
|
||||
for(i = 0; i < depth; i++) *dst_++ = ')';
|
||||
return;
|
||||
}
|
||||
default:
|
||||
while(reg < cap) *dst_++ = *reg++;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
write_tail(char *s, Rule *r)
|
||||
{
|
||||
while((*dst_++ = *s++))
|
||||
;
|
||||
*dst_ = 0;
|
||||
if((flip = !flip))
|
||||
src_ = bank_b, dst_ = bank_a;
|
||||
else
|
||||
src_ = bank_a, dst_ = bank_b;
|
||||
if(!quiet && r) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int
|
||||
apply_rule(Rule *r, char *s)
|
||||
{
|
||||
unsigned char i, rid;
|
||||
char c, *a = r->a, *b = r->b, *origin = dst_, *reg;
|
||||
/* phase: clean regs */
|
||||
if(rmax) {
|
||||
for(i = 0; i <= rmax; i++)
|
||||
regs[i] = 0;
|
||||
rmin = 0xff, rmax = 0x00;
|
||||
}
|
||||
/* phase: match rule */
|
||||
while((c = *a++)) {
|
||||
if(c == '?') {
|
||||
char *pcap = walk(s);
|
||||
rid = *a++;
|
||||
if((reg = regs[rid])) { /* reg cmp */
|
||||
char *rcap = walk(reg), *pp = s;
|
||||
while(reg < rcap || pp < pcap)
|
||||
if(*reg++ != *pp++) return 0;
|
||||
} else { /* reg set */
|
||||
regs[rid] = s;
|
||||
if(rid < rmin) rmin = rid;
|
||||
if(rid > rmax) rmax = rid;
|
||||
}
|
||||
s = pcap;
|
||||
} else if(c != *s++)
|
||||
return 0;
|
||||
}
|
||||
c = *s;
|
||||
if(!spacer(c)) return 0;
|
||||
/* phase: write rule */
|
||||
while((c = *b++)) {
|
||||
if(c == '?') {
|
||||
rid = *b;
|
||||
if((reg = regs[rid]))
|
||||
b++, write_reg(rid, reg);
|
||||
else
|
||||
*dst_++ = c;
|
||||
} else
|
||||
*dst_++ = c;
|
||||
}
|
||||
if(dst_ == origin) {
|
||||
while(*s == ' ') s++;
|
||||
if(*s == ')' && *(dst_ - 1) == ' ') dst_--;
|
||||
}
|
||||
return write_tail(s, r);
|
||||
}
|
||||
|
||||
static char *
|
||||
parse_frag(char **side, char *src)
|
||||
{
|
||||
int wrapped;
|
||||
char c, *cap;
|
||||
while((c = *src) && c == ' ') src++;
|
||||
if(c == ')' || (c == '<' && src[1] == '>')) {
|
||||
*side = ∅
|
||||
return src;
|
||||
}
|
||||
*side = dict_, cap = walk(src), wrapped = c == '(';
|
||||
if(wrapped) src++, cap--;
|
||||
while(src < cap) c = *src, *dict_++ = *src++;
|
||||
src += wrapped, *dict_++ = 0;
|
||||
return src;
|
||||
}
|
||||
|
||||
static Rule *
|
||||
find_rule(char *s, char *cap)
|
||||
{
|
||||
Rule *r = rules;
|
||||
if(*s == '(') s++, cap--;
|
||||
while(r < rules_) {
|
||||
char *ss = s, *a = r->a;
|
||||
if(a)
|
||||
while(*ss++ == *a++)
|
||||
if(!*a && ss == cap) return r;
|
||||
r++;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int
|
||||
rewrite(void)
|
||||
{
|
||||
char c, last = 0, *cap, *s = src_;
|
||||
while(*s == ' ') s++;
|
||||
while((c = *s)) {
|
||||
if(c == '(' || spacer(last)) {
|
||||
Rule *r = NULL;
|
||||
/* phase: undefine */
|
||||
if(c == '>' && s[1] == '<') {
|
||||
s += 2;
|
||||
while(*s == ' ') s++;
|
||||
cap = walk(s), r = find_rule(s, cap);
|
||||
if(r != NULL) {
|
||||
if(!quiet) fprintf(stderr, ">< (%s) (%s)\n", r->a, r->b);
|
||||
r->a = 0;
|
||||
}
|
||||
while(*cap == ' ') cap++;
|
||||
return write_tail(cap, NULL);
|
||||
}
|
||||
/* phase: define */
|
||||
if(c == '<' && s[1] == '>') {
|
||||
r = rules_, r->id = rules_ - rules;
|
||||
s = parse_frag(&r->b, parse_frag(&r->a, s + 2));
|
||||
if(*r->a) {
|
||||
if(!quiet) fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
|
||||
rules_++;
|
||||
}
|
||||
while(*s == ' ') s++;
|
||||
return write_tail(s, NULL);
|
||||
}
|
||||
/* phase: lambda */
|
||||
if(c == '?' && s[1] == '(') {
|
||||
cap = walk(s + 1);
|
||||
r = &lambda, r->id = -1;
|
||||
parse_frag(&r->b, parse_frag(&r->a, s + 2));
|
||||
s = cap;
|
||||
while(*s == ' ') s++;
|
||||
if(!apply_rule(&lambda, s)) write_tail(s, r);
|
||||
return 1;
|
||||
}
|
||||
/* phase: match */
|
||||
for(r = rules; r < rules_; r++)
|
||||
if(r->a && apply_rule(r, s)) return 1;
|
||||
}
|
||||
*dst_++ = last = c;
|
||||
s++;
|
||||
}
|
||||
*dst_++ = 0;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
FILE *f;
|
||||
int i, pl = 0, pr = 0, rw = 0;
|
||||
char c, last = 0, *w = bank_a;
|
||||
if(argc < 2)
|
||||
return !printf("usage: modal [-vqn] source.modal\n");
|
||||
for(i = 1; i < argc && *argv[i] == '-'; i++) {
|
||||
switch(argv[i][1]) {
|
||||
case 'v': /* version */ return !printf("Modal Interpreter, 29 Apr 2024.\n");
|
||||
case 'q': /* quiet */ quiet = 1; break;
|
||||
case 'p': /* debug */ debug = 1; break;
|
||||
case 'n': /* infinite */ cycles = 0xffffffff; break;
|
||||
}
|
||||
}
|
||||
if(!(f = fopen(argv[i], "r")))
|
||||
return !printf("Modal file invalid: %s.\n", argv[i]);
|
||||
while(fread(&c, 1, 1, f)) {
|
||||
c = c <= 0x20 ? 0x20 : c;
|
||||
if(c == ' ' && last == '(') continue;
|
||||
if(c == ')' && last == ' ') w--;
|
||||
if(c == ' ' && last == ' ') w--;
|
||||
if(c == '(') pl++;
|
||||
if(c == ')') pr++;
|
||||
if(c == '(' && last != '?' && !spacer(last)) *w++ = ' ';
|
||||
if(last == ')' && !spacer(c)) *w++ = ' ';
|
||||
*w++ = last = c;
|
||||
}
|
||||
while(*(--w) <= ' ') *w = 0;
|
||||
fclose(f);
|
||||
if(pr != pl)
|
||||
return !fprintf(stderr, "Modal program imbalanced.\n");
|
||||
while(rewrite() && ++rw)
|
||||
if(!cycles--) return !fprintf(stderr, "Modal rewrites exceeded.\n");
|
||||
if(!quiet) {
|
||||
while(rules_-- > rules) {
|
||||
if(rules_->a) {
|
||||
if(!rules_->refs)
|
||||
fprintf(stderr, "-- Unused rule: %d <> (%s) (%s)\n", rules_->id, rules_->a, rules_->b);
|
||||
if(debug)
|
||||
fprintf(stderr, " (%s) (%s), %d times.\n", rules_->a, rules_->b, rules_->refs);
|
||||
}
|
||||
}
|
||||
if(rw)
|
||||
fprintf(stderr, "Completed in %d rewrites.\n", rw);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -1,155 +0,0 @@
|
|||
( thue interpreter
|
||||
usage: thue.rom source.t )
|
||||
|
||||
|10 @Console &vector $2 &read $1 &pad $5 &write $1
|
||||
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
||||
|
||||
|0000
|
||||
|
||||
@src $40
|
||||
@ptr $2
|
||||
@len $2
|
||||
|
||||
|0100 ( -> )
|
||||
|
||||
;on-console .Console/vector DEO2
|
||||
|
||||
BRK
|
||||
|
||||
@on-console ( -> )
|
||||
|
||||
;src STH2
|
||||
|
||||
( read )
|
||||
.Console/read DEI
|
||||
DUP #20 LTH OVR #7f GTH ORA ,&end JCN
|
||||
STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
|
||||
STH2r ;sput JSR2 BRK
|
||||
&end
|
||||
POP
|
||||
|
||||
( parse )
|
||||
STH2r .File/name DEO2
|
||||
#0001 .File/length DEO2
|
||||
;program .ptr STZ2
|
||||
&s
|
||||
;&buf .File/read DEO2
|
||||
.File/success DEI2 #0000 EQU2 ,&eof JCN
|
||||
[ LIT &buf $1 ] ;walk JSR2
|
||||
,&s JMP
|
||||
&eof
|
||||
|
||||
( assemble )
|
||||
;program/assembly .ptr STZ2
|
||||
;program
|
||||
&w
|
||||
( save ) DUP2 .ptr LDZ2 STA2
|
||||
( incr ) .ptr LDZ2k INC2 INC2 ROT STZ2
|
||||
( next ) &eos INC2 LDAk ,&eos JCN INC2
|
||||
LDAk ,&w JCN
|
||||
|
||||
( save acc )
|
||||
INC2 ;program/accumulator ;scpy JSR2
|
||||
|
||||
( run )
|
||||
&eval ,step JSR ,&eval JCN
|
||||
#010f DEO
|
||||
|
||||
BRK
|
||||
|
||||
@step ( -- done )
|
||||
|
||||
;program/assembly
|
||||
&while
|
||||
DUP2 ;run-rule JSR2 ,&found JCN
|
||||
#0004 ADD2 LDA2k ORA ,&while JCN
|
||||
POP2
|
||||
#00
|
||||
|
||||
JMP2r
|
||||
&found #01 JMP2r
|
||||
|
||||
@walk ( char -- )
|
||||
|
||||
.ptr LDZ2 STA
|
||||
|
||||
( check for left-side )
|
||||
.ptr LDZ2 #0002 SUB2 ;&marker ;scmp JSR2 #01 NEQ ,&no-marker JCN
|
||||
#00 .ptr LDZ2 #0002 SUB2 STA
|
||||
.ptr LDZ2k #0002 SUB2 ROT STZ2
|
||||
.len LDZ2k INC2 ROT STZ2
|
||||
&no-marker
|
||||
( check for right-side )
|
||||
.ptr LDZ2 LDA #0a NEQ ,&no-lb JCN
|
||||
#00 .ptr LDZ2 STA
|
||||
&no-lb
|
||||
.ptr LDZ2k INC2 ROT STZ2
|
||||
|
||||
JMP2r
|
||||
&marker "::= $1
|
||||
|
||||
@run-rule ( rule* -- )
|
||||
|
||||
LDA2k ,&a STR2
|
||||
INC2 INC2 LDA2 ,&b STR2
|
||||
|
||||
;program/accumulator
|
||||
&w
|
||||
[ LIT2 &a $2 ] OVR2 ;sseg JSR2 #01 NEQ ,&no-found JCN
|
||||
,&b LDR2 LDA LIT "~ EQU ,&output JCN
|
||||
( shift ) DUP2 [ ,&b LDR2 ;slen JSR2 ,&a LDR2 ;slen JSR2 SUB2 ] ;ssft JSR2
|
||||
( write ) [ LIT2 &b $2 ] SWP2 OVR2 ;slen JSR2 ;mcpy JSR2
|
||||
POP2 #01 JMP2r
|
||||
&no-found
|
||||
INC2 LDAk ,&w JCN
|
||||
POP2
|
||||
#00
|
||||
|
||||
JMP2r
|
||||
&output
|
||||
,&a LDR2 ;slen JSR2 #0000 SWP2 SUB2 ;ssft JSR2
|
||||
POP2 ,&b LDR2 INC2
|
||||
LDAk LIT "` NEQ ,&no-lb JCN
|
||||
#0a18 DEO #01 JMP2r
|
||||
&no-lb
|
||||
,print-str JSR #01
|
||||
JMP2r
|
||||
|
||||
@print-str ( str* -- )
|
||||
|
||||
&while
|
||||
LDAk #18 DEO
|
||||
INC2 LDAk ,&while JCN
|
||||
POP2
|
||||
|
||||
JMP2r
|
||||
|
||||
@ssft ( str* len* -- )
|
||||
|
||||
STH2 DUP2k ;slen JSR2 ADD2 STH2r
|
||||
DUP2 #8000 GTH2 ,&l JCN
|
||||
ORAk ,&r JCN
|
||||
POP2 POP2 POP2
|
||||
|
||||
JMP2r
|
||||
&l #8000 SWP2 SUB2 #8000 ADD2 ,msfl JSR JMP2r
|
||||
&r ,msfr JSR JMP2r
|
||||
|
||||
( stdlib )
|
||||
|
||||
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &l LDAk STH2kr STA INC2r INC2 GTH2k ,&l JCN POP2 POP2 POP2r JMP2r
|
||||
@msfl ( b* a* len* -- ) STH2 SWP2 EQU2k ,&e JCN &l DUP2k STH2kr ADD2 LDA ROT ROT STA INC2 GTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r
|
||||
@msfr ( b* a* len* -- ) STH2 EQU2k ,&e JCN &l DUP2 LDAk ROT ROT STH2kr ADD2 STA #0001 SUB2 LTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r
|
||||
|
||||
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
|
||||
@sput ( chr str* -- ) ,scap JSR STA JMP2r
|
||||
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
|
||||
@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r
|
||||
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ,&e JCN NEQk ,&e JCN POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU JMP2r
|
||||
@sseg ( a* b* -- f ) STH2 &l LDAk LDAkr STHr NEQ ,&e JCN INC2k LDA #00 EQU ,&e JCN INC2 INC2r ,&l JMP &e LDA LDAr STHr EQU JMP2r
|
||||
|
||||
$10
|
||||
|
||||
@program $4000
|
||||
&assembly $4000
|
||||
&accumulator $4000
|
||||
|
|
@ -0,0 +1,378 @@
|
|||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <X11/Xlib.h>
|
||||
#include <X11/Xutil.h>
|
||||
#include <X11/keysymdef.h>
|
||||
#include <sys/timerfd.h>
|
||||
#include <unistd.h>
|
||||
#include <poll.h>
|
||||
|
||||
typedef unsigned char Uint8;
|
||||
typedef signed char Sint8;
|
||||
typedef unsigned short Uint16;
|
||||
typedef signed short Sint16;
|
||||
typedef unsigned int Uint32;
|
||||
|
||||
/* #include "modal.h" */
|
||||
|
||||
/*
|
||||
Copyright (c) 2024 Devine Lu Linvega
|
||||
|
||||
Permission to use, copy, modify, and distribute this software for any
|
||||
purpose with or without fee is hereby granted, provided that the above
|
||||
copyright notice and this permission notice appear in all copies.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
WITH REGARD TO THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
static XImage *ximage;
|
||||
static Display *display;
|
||||
static Window window;
|
||||
|
||||
#define WIDTH (64 * 8)
|
||||
#define HEIGHT (40 * 8)
|
||||
#define PAD 2
|
||||
#define CONINBUFSIZE 256
|
||||
|
||||
typedef struct Viewport {
|
||||
int width, height, x1, y1, x2, y2, scale;
|
||||
Uint32 palette[4], *pixels;
|
||||
Uint8 *fg, *bg;
|
||||
} Viewport;
|
||||
|
||||
Viewport viewport;
|
||||
|
||||
int
|
||||
screen_changed(void)
|
||||
{
|
||||
if(viewport.x1 < 0)
|
||||
viewport.x1 = 0;
|
||||
else if(viewport.x1 >= viewport.width)
|
||||
viewport.x1 = viewport.width;
|
||||
if(viewport.y1 < 0)
|
||||
viewport.y1 = 0;
|
||||
else if(viewport.y1 >= viewport.height)
|
||||
viewport.y1 = viewport.height;
|
||||
if(viewport.x2 < 0)
|
||||
viewport.x2 = 0;
|
||||
else if(viewport.x2 >= viewport.width)
|
||||
viewport.x2 = viewport.width;
|
||||
if(viewport.y2 < 0)
|
||||
viewport.y2 = 0;
|
||||
else if(viewport.y2 >= viewport.height)
|
||||
viewport.y2 = viewport.height;
|
||||
return viewport.x2 > viewport.x1 && viewport.y2 > viewport.y1;
|
||||
}
|
||||
|
||||
void
|
||||
screen_change(int x1, int y1, int x2, int y2)
|
||||
{
|
||||
if(x1 < viewport.x1) viewport.x1 = x1;
|
||||
if(y1 < viewport.y1) viewport.y1 = y1;
|
||||
if(x2 > viewport.x2) viewport.x2 = x2;
|
||||
if(y2 > viewport.y2) viewport.y2 = y2;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
screen_fill(Uint8 *layer, int color)
|
||||
{
|
||||
int i, length = viewport.width * viewport.height;
|
||||
for(i = 0; i < length; i++)
|
||||
layer[i] = color;
|
||||
}
|
||||
|
||||
int
|
||||
emu_resize(int w, int h)
|
||||
{
|
||||
if(window) {
|
||||
static Visual *visual;
|
||||
w *= viewport.scale, h *= viewport.scale;
|
||||
visual = DefaultVisual(display, 0);
|
||||
ximage = XCreateImage(display, visual, DefaultDepth(display, DefaultScreen(display)), ZPixmap, 0, (char *)viewport.pixels, w, h, 32, 0);
|
||||
XResizeWindow(display, window, w + PAD * 2, h + PAD * 2);
|
||||
XMapWindow(display, window);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
void
|
||||
screen_resize(Uint16 width, Uint16 height, int scale)
|
||||
{
|
||||
Uint8 *bg, *fg;
|
||||
Uint32 *pixels = NULL;
|
||||
int dim_change = viewport.width != width || viewport.height != height;
|
||||
if(width < 0x8 || height < 0x8 || width >= 0x800 || height >= 0x800 || scale < 1 || scale >= 4)
|
||||
return;
|
||||
if(viewport.width == width && viewport.height == height && viewport.scale == scale)
|
||||
return;
|
||||
if(dim_change) {
|
||||
bg = malloc(width * height), fg = malloc(width * height);
|
||||
if(bg && fg)
|
||||
pixels = realloc(viewport.pixels, width * height * sizeof(Uint32) * scale * scale);
|
||||
if(!bg || !fg || !pixels) {
|
||||
free(bg), free(fg);
|
||||
return;
|
||||
}
|
||||
free(viewport.bg), free(viewport.fg);
|
||||
} else {
|
||||
bg = viewport.bg, fg = viewport.fg;
|
||||
pixels = realloc(viewport.pixels, width * height * sizeof(Uint32) * scale * scale);
|
||||
if(!pixels)
|
||||
return;
|
||||
}
|
||||
viewport.bg = bg, viewport.fg = fg;
|
||||
viewport.pixels = pixels;
|
||||
viewport.width = width, viewport.height = height, viewport.scale = scale;
|
||||
if(dim_change)
|
||||
screen_fill(viewport.bg, 0), screen_fill(viewport.fg, 0);
|
||||
emu_resize(width, height);
|
||||
screen_change(0, 0, width, height);
|
||||
}
|
||||
|
||||
void
|
||||
screen_rect(Uint8 *layer, Uint16 x1, Uint16 y1, Uint16 x2, Uint16 y2, int color)
|
||||
{
|
||||
int row, x, y, w = viewport.width, h = viewport.height;
|
||||
for(y = y1; y < y2 && y < h; y++)
|
||||
for(x = x1, row = y * w; x < x2 && x < w; x++)
|
||||
layer[x + row] = color;
|
||||
}
|
||||
|
||||
void
|
||||
screen_redraw(void)
|
||||
{
|
||||
int i, x, y, k, l, s = viewport.scale;
|
||||
Uint8 *fg = viewport.fg, *bg = viewport.bg;
|
||||
Uint16 w = viewport.width, h = viewport.height;
|
||||
Uint16 x1 = viewport.x1, y1 = viewport.y1;
|
||||
Uint16 x2 = viewport.x2 > w ? w : viewport.x2, y2 = viewport.y2 > h ? h : viewport.y2;
|
||||
Uint32 palette[16], *pixels = viewport.pixels;
|
||||
viewport.x1 = viewport.y1 = 9000;
|
||||
viewport.x2 = viewport.y2 = 0;
|
||||
for(i = 0; i < 16; i++)
|
||||
palette[i] = viewport.palette[(i >> 2) ? (i >> 2) : (i & 3)];
|
||||
for(y = y1; y < y2; y++) {
|
||||
int ys = y * s;
|
||||
int o = y * w;
|
||||
for(x = x1, i = x1 + o; x < x2; x++, i++) {
|
||||
int c = palette[fg[i] << 2 | bg[i]];
|
||||
for(k = 0; k < s; k++) {
|
||||
int oo = ((ys + k) * w + x) * s;
|
||||
for(l = 0; l < s; l++)
|
||||
pixels[oo + l] = c;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
clamp(int val, int min, int max)
|
||||
{
|
||||
return (val >= min) ? (val <= max) ? val : max : min;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void
|
||||
emu_restart(char *rom, int soft)
|
||||
{
|
||||
screen_resize(WIDTH, HEIGHT, viewport.scale);
|
||||
screen_rect(viewport.bg, 0, 0, viewport.width, viewport.height, 0);
|
||||
screen_rect(viewport.fg, 0, 0, viewport.width, viewport.height, 0);
|
||||
|
||||
}
|
||||
|
||||
static int
|
||||
emu_end(void)
|
||||
{
|
||||
XDestroyImage(ximage);
|
||||
XDestroyWindow(display, window);
|
||||
XCloseDisplay(display);
|
||||
exit(0);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static Uint8
|
||||
get_button(KeySym sym)
|
||||
{
|
||||
switch(sym) {
|
||||
case XK_Up: return 0x10;
|
||||
case XK_Down: return 0x20;
|
||||
case XK_Left: return 0x40;
|
||||
case XK_Right: return 0x80;
|
||||
case XK_Control_L: return 0x01;
|
||||
case XK_Alt_L: return 0x02;
|
||||
case XK_Shift_L: return 0x04;
|
||||
case XK_Home: return 0x08;
|
||||
case XK_Meta_L: return 0x02;
|
||||
}
|
||||
return 0x00;
|
||||
}
|
||||
|
||||
static void
|
||||
toggle_scale(void)
|
||||
{
|
||||
int s = viewport.scale + 1;
|
||||
if(s > 3) s = 1;
|
||||
screen_resize(viewport.width, viewport.height, s);
|
||||
}
|
||||
|
||||
static void
|
||||
emu_event(void)
|
||||
{
|
||||
XEvent ev;
|
||||
XNextEvent(display, &ev);
|
||||
switch(ev.type) {
|
||||
case Expose: {
|
||||
int w = viewport.width * viewport.scale;
|
||||
int h = viewport.height * viewport.scale;
|
||||
XResizeWindow(display, window, w + PAD * 2, h + PAD * 2);
|
||||
XPutImage(display, window, DefaultGC(display, 0), ximage, 0, 0, PAD, PAD, w, h);
|
||||
} break;
|
||||
case ClientMessage:
|
||||
/* u->dev[0x0f] = 0x80; */
|
||||
break;
|
||||
case KeyPress: {
|
||||
/* KeySym sym;
|
||||
char buf[7];
|
||||
XLookupString((XKeyPressedEvent *)&ev, buf, 7, &sym, 0);
|
||||
switch(sym) {
|
||||
case XK_F1: toggle_scale(); break;
|
||||
case XK_F2: u->dev[0x0e] = !u->dev[0x0e]; break;
|
||||
case XK_F4: emu_restart(boot_rom, 0); break;
|
||||
case XK_F5: emu_restart(boot_rom, 1); break;
|
||||
}
|
||||
controller_down(u, &u->dev[0x80], get_button(sym));
|
||||
controller_key(u, &u->dev[0x80], sym < 0x80 ? sym : (Uint8)buf[0]); */
|
||||
} break;
|
||||
case KeyRelease: {
|
||||
/*KeySym sym;
|
||||
char buf[7];
|
||||
XLookupString((XKeyPressedEvent *)&ev, buf, 7, &sym, 0);
|
||||
controller_up(u, &u->dev[0x80], get_button(sym)); */
|
||||
} break;
|
||||
case ButtonPress: {
|
||||
/* XButtonPressedEvent *e = (XButtonPressedEvent *)&ev;
|
||||
if(e->button == 4)
|
||||
mouse_scroll(u, &u->dev[0x90], 0, 1);
|
||||
else if(e->button == 5)
|
||||
mouse_scroll(u, &u->dev[0x90], 0, -1);
|
||||
else if(e->button == 6)
|
||||
mouse_scroll(u, &u->dev[0x90], 1, 0);
|
||||
else if(e->button == 7)
|
||||
mouse_scroll(u, &u->dev[0x90], -1, 0);
|
||||
else
|
||||
mouse_down(u, &u->dev[0x90], 0x1 << (e->button - 1)); */
|
||||
} break;
|
||||
case ButtonRelease: {
|
||||
/* XButtonPressedEvent *e = (XButtonPressedEvent *)&ev;
|
||||
mouse_up(u, &u->dev[0x90], 0x1 << (e->button - 1)); */
|
||||
} break;
|
||||
case MotionNotify: {
|
||||
/* XMotionEvent *e = (XMotionEvent *)&ev;
|
||||
int x = clamp((e->x - PAD) / viewport.scale, 0, viewport.width - 1);
|
||||
int y = clamp((e->y - PAD) / viewport.scale, 0, viewport.height - 1);
|
||||
mouse_pos(u, &u->dev[0x90], x, y); */
|
||||
} break;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
display_init(void)
|
||||
{
|
||||
Atom wmDelete;
|
||||
static Visual *visual;
|
||||
XColor black = {0};
|
||||
static char empty[] = {0};
|
||||
Pixmap bitmap;
|
||||
Cursor blank;
|
||||
display = XOpenDisplay(NULL);
|
||||
if(!display)
|
||||
return !printf("init Display failed");
|
||||
screen_resize(WIDTH, HEIGHT, 1);
|
||||
/* start window */
|
||||
visual = DefaultVisual(display, 0);
|
||||
if(visual->class != TrueColor)
|
||||
return !printf("init True-color visual failed");
|
||||
window = XCreateSimpleWindow(display, RootWindow(display, 0), 0, 0, viewport.width + PAD * 2, viewport.height + PAD * 2, 1, 0, 0);
|
||||
XSelectInput(display, window, ButtonPressMask | ButtonReleaseMask | PointerMotionMask | ExposureMask | KeyPressMask | KeyReleaseMask);
|
||||
wmDelete = XInternAtom(display, "WM_DELETE_WINDOW", True);
|
||||
XSetWMProtocols(display, window, &wmDelete, 1);
|
||||
XStoreName(display, window, "Thuesday");
|
||||
XMapWindow(display, window);
|
||||
ximage = XCreateImage(display, visual, DefaultDepth(display, DefaultScreen(display)), ZPixmap, 0, (char *)viewport.pixels, viewport.width, viewport.height, 32, 0);
|
||||
/* hide cursor */
|
||||
bitmap = XCreateBitmapFromData(display, window, empty, 1, 1);
|
||||
blank = XCreatePixmapCursor(display, bitmap, bitmap, &black, &black, 0, 0);
|
||||
XDefineCursor(display, window, blank);
|
||||
XFreeCursor(display, blank);
|
||||
XFreePixmap(display, bitmap);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int
|
||||
emu_run(void)
|
||||
{
|
||||
int i = 1, n;
|
||||
char expirations[8];
|
||||
char coninp[CONINBUFSIZE];
|
||||
struct pollfd fds[3];
|
||||
static const struct itimerspec screen_tspec = {{0, 16666666}, {0, 16666666}};
|
||||
/* timer */
|
||||
fds[0].fd = XConnectionNumber(display);
|
||||
fds[1].fd = timerfd_create(CLOCK_MONOTONIC, 0);
|
||||
timerfd_settime(fds[1].fd, 0, &screen_tspec, NULL);
|
||||
fds[2].fd = STDIN_FILENO;
|
||||
fds[0].events = fds[1].events = fds[2].events = POLLIN;
|
||||
/* main loop */
|
||||
while(1) {
|
||||
if(poll(fds, 3, 1000) <= 0)
|
||||
continue;
|
||||
while(XPending(display))
|
||||
emu_event();
|
||||
if(poll(&fds[1], 1, 0)) {
|
||||
read(fds[1].fd, expirations, 8);
|
||||
/* eval(u, u->dev[0x20] << 8 | u->dev[0x21]); */
|
||||
if(screen_changed()) {
|
||||
int x = viewport.x1 * viewport.scale, y = viewport.y1 * viewport.scale;
|
||||
int w = viewport.x2 * viewport.scale - x, h = viewport.y2 * viewport.scale - y;
|
||||
screen_redraw();
|
||||
XPutImage(display, window, DefaultGC(display, 0), ximage, x, y, x + PAD, y + PAD, w, h);
|
||||
}
|
||||
}
|
||||
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); */
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int modal_eval(void){
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
int i = 1;
|
||||
if(i != argc && argv[i][0] == '-' && argv[i][1] == 'v') {
|
||||
fprintf(stdout, "Thuesday - Graphical Modal Ordinator, 30 Apr 2024.\n");
|
||||
i++;
|
||||
}
|
||||
if(!display_init()) {
|
||||
fprintf(stdout, "Could not open display.\n");
|
||||
return 0;
|
||||
}
|
||||
/* Game Loop */
|
||||
if(modal_eval()) {
|
||||
/* console_listen(&u, i, argc, argv); */
|
||||
emu_run();
|
||||
}
|
||||
return emu_end();
|
||||
}
|
||||
316
src/thuesday.tal
316
src/thuesday.tal
|
|
@ -1,316 +0,0 @@
|
|||
( thue interpreter: usage thue.rom source.t )
|
||||
|
||||
|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|
||||
|10 @Console &vector $2 &read $1 &pad $5 &write $1
|
||||
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|
||||
|80 @Controller &vector $2 &button $1 &key $1
|
||||
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &chord $1
|
||||
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
||||
|
||||
|0000
|
||||
|
||||
@src $40
|
||||
@ptr $2
|
||||
@len $2
|
||||
@draw &x $2 &y $2
|
||||
@last $2
|
||||
|
||||
|0100 ( -> )
|
||||
|
||||
( theme )
|
||||
#0e6f .System/r DEO2
|
||||
#059f .System/g DEO2
|
||||
#02bf .System/b DEO2
|
||||
|
||||
#0010 .draw/x STZ2
|
||||
#0040 .draw/y STZ2
|
||||
|
||||
;on-console .Console/vector DEO2
|
||||
;on-frame .Screen/vector DEO2
|
||||
;on-button .Controller/vector DEO2
|
||||
|
||||
BRK
|
||||
|
||||
@on-console ( -> )
|
||||
|
||||
;src STH2
|
||||
|
||||
( read )
|
||||
.Console/read DEI
|
||||
DUP #20 LTH OVR #7f GTH ORA ,&end JCN
|
||||
STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
|
||||
STH2r ;sput JSR2 BRK
|
||||
&end
|
||||
POP
|
||||
|
||||
( parse )
|
||||
STH2r .File/name DEO2
|
||||
#0001 .File/length DEO2
|
||||
;program .ptr STZ2
|
||||
&s
|
||||
;&buf .File/read DEO2
|
||||
.File/success DEI2 #0000 EQU2 ,&eof JCN
|
||||
[ LIT &buf $1 ] ;walk JSR2
|
||||
,&s JMP
|
||||
&eof
|
||||
|
||||
( assemble )
|
||||
;program/assembly .ptr STZ2
|
||||
;program
|
||||
&w
|
||||
( save ) DUP2 .ptr LDZ2 STA2
|
||||
( incr ) .ptr LDZ2k INC2 INC2 ROT STZ2
|
||||
( next ) &eos INC2 LDAk ,&eos JCN INC2
|
||||
LDAk ,&w JCN
|
||||
|
||||
( save acc )
|
||||
INC2 ;program/accumulator ;scpy JSR2
|
||||
|
||||
;draw-program JSR2
|
||||
;draw-acc JSR2
|
||||
#03 ;draw-chr/color STA
|
||||
#0010 .Screen/x DEO2
|
||||
#0030 .Screen/y DEO2
|
||||
;&print-txt ;draw-str JSR2 POP2
|
||||
#0130 .Screen/x DEO2
|
||||
;&rules-txt ;draw-str JSR2 POP2
|
||||
|
||||
|
||||
BRK
|
||||
&print-txt "PRINT $1
|
||||
&rules-txt "RULES $1
|
||||
|
||||
@on-button ( -> )
|
||||
|
||||
.Controller/button DEI #01 JCN BRK
|
||||
|
||||
;step JSR2 POP
|
||||
;draw-acc JSR2
|
||||
;draw-program JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@on-frame ( -> )
|
||||
|
||||
( ;step JSR2 POP
|
||||
|
||||
;draw-acc JSR2
|
||||
;draw-program JSR2 )
|
||||
|
||||
BRK
|
||||
|
||||
@walk ( char -- )
|
||||
|
||||
.ptr LDZ2 STA
|
||||
|
||||
( check for left-side )
|
||||
.ptr LDZ2 #0002 SUB2 ;&marker ;scmp JSR2 #01 NEQ ,&no-marker JCN
|
||||
#00 .ptr LDZ2 #0002 SUB2 STA
|
||||
.ptr LDZ2k #0002 SUB2 ROT STZ2
|
||||
.len LDZ2k INC2 ROT STZ2
|
||||
&no-marker
|
||||
( check for right-side )
|
||||
.ptr LDZ2 LDA #0a NEQ ,&no-lb JCN
|
||||
#00 .ptr LDZ2 STA
|
||||
&no-lb
|
||||
.ptr LDZ2k INC2 ROT STZ2
|
||||
|
||||
JMP2r
|
||||
&marker "::= $1
|
||||
|
||||
@step ( -- done )
|
||||
|
||||
;program/assembly
|
||||
&while
|
||||
DUP2 ;program/assembly SUB2 #02 SFT2 .last STZ2
|
||||
DUP2 ;run-rule JSR2 ,&found JCN
|
||||
#0004 ADD2 LDA2k ORA ,&while JCN
|
||||
POP2
|
||||
#00
|
||||
|
||||
JMP2r
|
||||
&found #01 JMP2r
|
||||
|
||||
@run-rule ( rule* -- flag )
|
||||
|
||||
LDA2k ,&a STR2
|
||||
INC2 INC2 LDA2 ,&b STR2
|
||||
|
||||
;program/accumulator
|
||||
&w
|
||||
[ LIT2 &a $2 ] OVR2 ;sseg JSR2 #01 NEQ ,&no-found JCN
|
||||
,&b LDR2 LDA LIT "~ EQU ,&output JCN
|
||||
( shift ) DUP2 [ ,&b LDR2 ;slen JSR2 ,&a LDR2 ;slen JSR2 SUB2 ] ;ssft JSR2
|
||||
( write ) [ LIT2 &b $2 ] SWP2 OVR2 ;slen JSR2 ;mcpy JSR2
|
||||
POP2 #01 JMP2r
|
||||
&no-found
|
||||
INC2 LDAk ,&w JCN
|
||||
POP2
|
||||
#00
|
||||
|
||||
JMP2r
|
||||
&output
|
||||
,&a LDR2 ;slen JSR2 #0000 SWP2 SUB2 ;ssft JSR2
|
||||
POP2 ,&b LDR2 INC2
|
||||
LDAk LIT "` NEQ ,&no-lb JCN
|
||||
#0010 .draw/x STZ2
|
||||
.draw/y LDZ2k #0008 ADD2 ROT STZ2
|
||||
JMP2r
|
||||
&no-lb
|
||||
.draw/x LDZ2 .Screen/x DEO2
|
||||
.draw/y LDZ2 .Screen/y DEO2
|
||||
;draw-str JSR2 POP2
|
||||
.Screen/x DEI2 .draw/x STZ2
|
||||
.Screen/y DEI2 .draw/y STZ2
|
||||
#01
|
||||
JMP2r
|
||||
|
||||
@ssft ( str* len* -- )
|
||||
|
||||
STH2 DUP2k ;slen JSR2 ADD2 STH2r
|
||||
DUP2 #8000 GTH2 ,&l JCN
|
||||
ORAk ,&r JCN
|
||||
POP2 POP2 POP2
|
||||
|
||||
JMP2r
|
||||
&l #8000 SWP2 SUB2 #8000 ADD2 ;msfl JSR2 JMP2r
|
||||
&r ;msfr JSR2 JMP2r
|
||||
|
||||
( stdlib )
|
||||
|
||||
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
|
||||
@sput ( chr str* -- ) ,scap JSR STA JMP2r
|
||||
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
|
||||
@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r
|
||||
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ,&e JCN NEQk ,&e JCN POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU JMP2r
|
||||
@sseg ( a* b* -- f ) STH2 &l LDAk LDAkr STHr NEQ ,&e JCN INC2k LDA #00 EQU ,&e JCN INC2 INC2r ,&l JMP &e LDA LDAr STHr EQU JMP2r
|
||||
|
||||
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ,&l JCN POP2 POP2 JMP2r
|
||||
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &l LDAk STH2kr STA INC2r INC2 GTH2k ,&l JCN POP2 POP2 POP2r JMP2r
|
||||
@msfl ( b* a* len* -- ) STH2 SWP2 EQU2k ,&e JCN &l DUP2k STH2kr ADD2 LDA ROT ROT STA INC2 GTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r
|
||||
@msfr ( b* a* len* -- ) STH2 EQU2k ,&e JCN &l DUP2 LDAk ROT ROT STH2kr ADD2 STA #0001 SUB2 LTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r
|
||||
|
||||
@print ( short* -- )
|
||||
|
||||
SWP ,&byte JSR
|
||||
&byte ( byte -- ) DUP #04 SFT ,&char JSR
|
||||
&char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
||||
|
||||
JMP2r
|
||||
|
||||
@print-str ( str* -- )
|
||||
|
||||
&while
|
||||
LDAk #18 DEO
|
||||
INC2 LDAk ,&while JCN
|
||||
POP2
|
||||
|
||||
JMP2r
|
||||
|
||||
( drawing )
|
||||
|
||||
@draw-acc ( -- )
|
||||
|
||||
#0010 DUP2 .Screen/x DEO2 .Screen/y DEO2
|
||||
#03 ;draw-chr/color STA
|
||||
;&acc-txt ;draw-str JSR2 POP2
|
||||
#01 ;draw-chr/color STA
|
||||
;program/accumulator INC2 ;draw-str JSR2 POP2
|
||||
|
||||
JMP2r
|
||||
&acc-txt "ACC 20 $1
|
||||
|
||||
@draw-program ( -- )
|
||||
|
||||
#0130 .Screen/x DEO2
|
||||
#0040 .Screen/y DEO2
|
||||
;program/assembly
|
||||
&while
|
||||
DUP2 ;program/assembly SUB2 #02 SFT2 .last LDZ2 EQU2 #04 MUL INC INC ;draw-chr/color STA
|
||||
LDA2k ;draw-str JSR2 POP2
|
||||
#20 ;draw-chr JSR2
|
||||
;&spacer-txt ;draw-str JSR2 POP2
|
||||
INC2k INC2 LDA2 ;draw-str JSR2 POP2
|
||||
|
||||
#0130 .Screen/x DEO2
|
||||
.Screen/y DEI2k #0008 ADD2 ROT DEO2
|
||||
#0004 ADD2 LDA2k ORA ,&while JCN
|
||||
POP2
|
||||
|
||||
JMP2r
|
||||
&spacer-txt 20 "::= 20 $1
|
||||
|
||||
@draw-str ( str* -- str* )
|
||||
|
||||
LDAk #00 EQU ,&skip JCN
|
||||
#01 .Screen/auto DEO
|
||||
&while
|
||||
LDAk ,draw-chr JSR
|
||||
INC2 LDAk ,&while JCN
|
||||
&skip
|
||||
INC2
|
||||
|
||||
JMP2r
|
||||
|
||||
@draw-chr ( char -- )
|
||||
|
||||
#20 SUB #00 SWP #30 SFT2 ;font ADD2 .Screen/addr DEO2
|
||||
[ LIT &color 01 ] .Screen/sprite DEO
|
||||
|
||||
JMP2r
|
||||
|
||||
@font ( atari8 )
|
||||
0000 0000 0000 0000 6060 6060 6000 6000
|
||||
6666 6600 0000 0000 006c fe6c 6cfe 6c00
|
||||
183e 603c 067c 1800 0066 6c18 3066 4600
|
||||
386c 3870 decc 7600 6060 6000 0000 0000
|
||||
0e1c 1818 181c 0e00 7038 1818 1838 7000
|
||||
0066 3cff 3c66 0000 0018 187e 1818 0000
|
||||
0000 0000 0030 3060 0000 007e 0000 0000
|
||||
0000 0000 0018 1800 0206 0c18 3060 4000
|
||||
3c66 6e76 6666 3c00 1838 1818 1818 7e00
|
||||
3c66 060c 1830 7e00 7e0c 180c 0666 3c00
|
||||
0c1c 3c6c 7e0c 0c00 7e60 7c06 0666 3c00
|
||||
3c60 607c 6666 3c00 7e06 0c18 3030 3000
|
||||
3c66 663c 6666 3c00 3c66 663e 060c 3800
|
||||
0060 6000 6060 0000 0030 3000 3030 6000
|
||||
0c18 3060 3018 0c00 0000 7e00 007e 0000
|
||||
6030 180c 1830 6000 3c66 060c 1800 1800
|
||||
3c66 6e6a 6e60 3e00 183c 6666 7e66 6600
|
||||
7c66 667c 6666 7c00 3c66 6060 6066 3c00
|
||||
786c 6666 666c 7800 7e60 607c 6060 7e00
|
||||
7e60 607c 6060 6000 3e60 606e 6666 3e00
|
||||
6666 667e 6666 6600 7830 3030 3030 7800
|
||||
0606 0606 0666 3c00 666c 7870 786c 6600
|
||||
6060 6060 6060 7e00 c6ee fed6 c6c6 c600
|
||||
6676 7e7e 6e66 6600 3c66 6666 6666 3c00
|
||||
7c66 667c 6060 6000 3c66 6666 766c 3600
|
||||
7c66 667c 6c66 6600 3c66 603c 0666 3c00
|
||||
7e18 1818 1818 1800 6666 6666 6666 3e00
|
||||
6666 6666 663c 1800 c6c6 c6d6 feee c600
|
||||
6666 3c18 3c66 6600 6666 663c 1818 1800
|
||||
7e06 0c18 3060 7e00 7860 6060 6060 7800
|
||||
4060 3018 0c06 0200 7818 1818 1818 7800
|
||||
1038 6cc6 0000 0000 0000 0000 0000 fe00
|
||||
00c0 6030 0000 0000 0000 3c06 3e66 3e00
|
||||
6060 7c66 6666 7c00 0000 3c60 6060 3c00
|
||||
0606 3e66 6666 3e00 0000 3c66 7e60 3c00
|
||||
1c30 7c30 3030 3000 0000 3e66 663e 067c
|
||||
6060 7c66 6666 6600 1800 3818 1818 3c00
|
||||
1800 1818 1818 1870 6060 666c 786c 6600
|
||||
3818 1818 1818 3c00 0000 ecfe d6c6 c600
|
||||
0000 7c66 6666 6600 0000 3c66 6666 3c00
|
||||
0000 7c66 6666 7c60 0000 3e66 6666 3e06
|
||||
0000 7c66 6060 6000 0000 3e60 3c06 7c00
|
||||
0018 7e18 1818 0e00 0000 6666 6666 3e00
|
||||
0000 6666 663c 1800 0000 c6c6 d67c 6c00
|
||||
0000 663c 183c 6600 0000 6666 663e 067c
|
||||
0000 7e0c 1830 7e00 1c30 3060 3030 1c00
|
||||
6060 6060 6060 6060 7018 180c 1818 7000
|
||||
0060 f29e 0c00 0000 0018 1834 3462 7e00
|
||||
|
||||
$10
|
||||
|
||||
@program $4000
|
||||
&assembly $4000
|
||||
&accumulator $4000
|
||||
Loading…
Reference in New Issue