etc
/
uxn
mirror of https://git.sr.ht/~rabbits/uxn
0
1
Fork 0
Code Issues Projects Releases Wiki Activity

Merge branch 'main' into android

This commit is contained in:
Sigrid Solveig Haflínudóttir 2023-02-11 15:48:45 +01:00
parent 6a927e4f2f c11dcc3771
commit 2b6a49f252
118 changed files with 6370 additions and 6371 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
.build.yml
View File

@ -4,10 +4,11 @@ packages:
- build-essential
- libsdl2-dev
- rsync
- wget
- zip
oauth: pages.sr.ht/PAGES:RW
environment:
SITE: rabbits.srht.site
SITE: rabbits.srht.site/uxn
SSH_HOST_KEYS: |
[w1.uxn-build.ald.nu]:2222 ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIP+IYCB4JrKklFjWSMRkPBTqUjBqUuhlDQy6/X3l8xj5
[m1.uxn-build.ald.nu]:2223 ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIDvWVqlHh3XQ5ziEbT55K896/mW2BVDdkU6hWgIfU9md
@ -18,8 +19,8 @@ sources:
- https://git.sr.ht/~rabbits/uxn
tasks:
- prepare: |
rm -f out
mkdir -p out
rm -f out build
mkdir -p out build/uxn-lin64 build/uxn-win64 build/uxn-mac64 build/essentials/uxn
umask 077
mkdir -p ~/.ssh
printf '%s\n' "${SSH_HOST_KEYS}" > ~/.ssh/known_hosts
@ -27,12 +28,10 @@ tasks:
- build-linux: |
cd uxn
./build.sh --no-run
mv bin uxn
tar -czf ../out/uxn-linux-amd64.tar.gz uxn
cd ..
- build-rompack: |
mkdir -p rompack/uxn
for F in uxn/projects/software/calc.tal uxn/projects/software/launcher.tal uxn/projects/examples/demos/piano.tal uxn/projects/examples/demos/clock.tal catclock/src/main.tal dexe/src/main.tal donsol/src/main.tal left/src/main.tal nasu/src/main.tal noodle/src/main.tal orca-toy/src/main.tal:orca.rom turye/src/main.tal; do
cp bin/asma.rom ../out/
mv bin ../build/uxn-lin64/uxn
- build-essentials: |
for F in uxn/projects/software/calc.tal uxn/projects/software/launcher.tal uxn/projects/examples/demos/piano.tal uxn/projects/examples/software/clock.tal catclock/src/catclock.tal dexe/src/dexe.tal donsol/src/main.tal left/src/left.tal nasu/src/nasu.tal noodle/src/noodle.tal orca-toy/src/orca.tal:orca.rom turye/src/turye.tal; do
PROJECT="${F%%/*}"
if [ "${F}" = "${F%:*}" ]; then
ROMNAME="${F##*/}"
@ -43,20 +42,39 @@ tasks:
F="${F%:*}"
fi
[ -d "${PROJECT}" ] || git clone "https://git.sr.ht/~rabbits/${PROJECT}"
( cd "${PROJECT}" && ../uxn/uxn/uxnasm "${F#*/}" "../rompack/uxn/${ROMNAME}" || rm -f "../rompack/uxn/${ROMNAME}" )
( cd "${PROJECT}" && ../build/uxn-lin64/uxn/uxnasm "${F#*/}" "../build/essentials/uxn/${ROMNAME}" || rm -f "../build/essentials/uxn/${ROMNAME}" )
done
tar -czf out/uxn-rompack.tar.gz -C rompack uxn
( cd rompack && zip -qr ../out/uxn-rompack.zip uxn )
[ -e ~/.ssh/id_rsa ] || complete-build
- build-windows: |
ssh win "rm -f uxn-windows-64bit.zip; export PATH=\"\${PATH}:/mingw64/bin\"; set -ex; cd uxn; git fetch; git checkout .; git clean -xfd; git checkout $(cd uxn && git rev-parse HEAD); MSYSTEM=MSYS ./build.sh --no-run; mv bin uxn; zip -qr ../uxn-windows-64bit.zip uxn"
rsync win:uxn-windows-64bit.zip out/
if ssh -o ConnectTimeout=10 win true; then
ssh win "export PATH=\"\${PATH}:/mingw64/bin\"; set -ex; cd uxn; git fetch; git checkout .; git clean -xfd; git checkout $(cd uxn && git rev-parse HEAD); MSYSTEM=MSYS ./build.sh --no-run"
rsync -rp win:uxn/bin/ build/uxn-win64/uxn/
else
wget -nv -NP out "https://${SITE}/"uxn{,-essentials}-win64.{tar.gz,zip} || true
touch out/needs-solar-build
fi
- build-macos: |
ssh mac "rm -f uxn-macos.tar.gz; export PATH=\"\${PATH}:/usr/local/bin\"; set -ex; cd uxn; git fetch; git checkout .; git clean -xfd; git checkout $(cd uxn && git rev-parse HEAD); ./build.sh --no-run; mv bin uxn; tar -zcf ../uxn-macos.tar.gz uxn"
rsync mac:uxn-macos.tar.gz out/
if ssh -o ConnectTimeout=10 mac true; then
ssh mac "export PATH=\"\${PATH}:/usr/local/bin\"; set -ex; cd uxn; git fetch; git checkout .; git clean -xfd; git checkout $(cd uxn && git rev-parse HEAD); ./build.sh --no-run"
rsync -rp mac:uxn/bin/ build/uxn-mac64/uxn/
else
wget -nv -NP out "https://${SITE}/"uxn{,-essentials}-mac64.{tar.gz,zip} || true
touch out/needs-solar-build
fi
- archive: |
for PROJECT in uxn-lin64 uxn-win64 uxn-mac64 essentials; do
[ -d "build/${PROJECT}/uxn" ] || continue
tar -czf "out/${PROJECT}.tar.gz" -C "build/${PROJECT}" uxn
( cd "build/${PROJECT}" && zip -qr "../../out/${PROJECT}.zip" uxn )
if [ "${PROJECT}" != essentials ]; then
cp build/essentials/uxn/* "build/${PROJECT}/uxn/"
tar -czf "out/uxn-essentials-${PROJECT#uxn-}.tar.gz" -C "build/${PROJECT}" uxn
( cd "build/${PROJECT}" && zip -qr "../../out/uxn-essentials-${PROJECT#uxn-}.zip" uxn )
fi
done
- upload: |
if [ "$(cd uxn && git rev-parse HEAD)" != "$(cd uxn && git rev-parse origin/main)" ]; then exit; fi
ls -l out
if [ "$(cd uxn && git rev-parse HEAD)" != "$(cd uxn && git rev-parse origin/main)" ]; then exit; fi
tar -czf out.tar.gz -C out .
acurl() {
set +x
@ -66,4 +84,6 @@ tasks:
acurl -fsS "https://pages.sr.ht/publish/${SITE}" -Fcontent=@out.tar.gz
acurl -fsS "https://pages.sr.ht/publish/${SITE}" -Fcontent=@out.tar.gz -Fprotocol=GEMINI
- build-9front: |
ssh 9front "$(cd uxn && git rev-parse HEAD)"
if ssh -o ConnectTimeout=10 9front true; then
ssh 9front "$(cd uxn && git rev-parse HEAD)"
fi

1
.gitignore vendored
View File

@ -13,5 +13,6 @@
*theme
*.rom
*.rom.sym
*.[o0125678vqki]

7
README.md
View File

@ -4,7 +4,7 @@ An assembler and emulator for the [Uxn stack-machine](https://wiki.xxiivv.com/si
## Download binaries
Binaries are available for 64-bit x86 computers running [Linux](https://rabbits.srht.site/uxn-linux-amd64.tar.gz), [Windows](https://rabbits.srht.site/uxn-windows-64bit.zip) and [macOS](https://rabbits.srht.site/uxn-macos.tar.gz).
Binaries are available for 64-bit x86 computers running [Linux](https://rabbits.srht.site/uxn/uxn-essentials-lin64.tar.gz), [Windows](https://rabbits.srht.site/uxn/uxn-essentials-win64.zip) and [macOS](https://rabbits.srht.site/uxn/uxn-essentials-mac64.tar.gz).
## Build
@ -25,6 +25,7 @@ Build the assembler and emulator by running the `build.sh` script. The assembler
./build.sh
--debug # Add debug flags to compiler
--format # Format source code
--install # Copy to ~/bin
```
If you wish to build the emulator without graphics mode:
@ -108,11 +109,9 @@ uxnemu orca.rom | shim
The following resources are a good place to start:
* [XXIIVV — uxntal](https://wiki.xxiivv.com/site/uxntal.html)
* [XXIIVV — uxntal cheatsheet](https://wiki.xxiivv.com/site/uxntal_cheatsheet.html)
* [XXIIVV — uxntal reference](https://wiki.xxiivv.com/site/uxntal_reference.html)
* [compudanzas — uxn tutorial](https://compudanzas.net/uxn_tutorial.html)
You can also find us in [`#uxn` on irc.esper.net](ircs://irc.esper.net:6697/#uxn).
* [Fediverse — #uxn tag](https://merveilles.town/tags/uxn)
## Contributing

30
build.sh
View File

@ -2,6 +2,7 @@
format=0
console=0
install=0
debug=0
norun=0
@ -17,6 +18,11 @@ while [ $# -gt 0 ]; do
shift
;;
--install)
install=1
shift
;;
--debug)
debug=1
shift
@ -33,19 +39,13 @@ while [ $# -gt 0 ]; do
done
echo "Cleaning.."
rm -f ./bin/uxnasm
rm -f ./bin/uxnemu
rm -f ./bin/uxncli
rm -f ./bin/launcher.rom
rm -f ./bin/asma.rom
rm -f ./bin/*
# When clang-format is present
if [ $format = 1 ];
then
echo "Formatting.."
clang-format -i src/uxn.h
clang-format -i src/uxn.c
clang-format -i src/devices/system.h
clang-format -i src/devices/system.c
clang-format -i src/devices/screen.h
@ -70,6 +70,7 @@ CC="${CC:-clang}"
CFLAGS="${CFLAGS:--std=c89 -Wall -Wno-unknown-pragmas}"
case "$(uname -s 2>/dev/null)" in
MSYS_NT*|MINGW*) # MSYS2 on Windows
FILE_LDFLAGS="-liberty"
if [ $console = 1 ];
then
UXNEMU_LDFLAGS="-static $(sdl2-config --cflags --static-libs | sed -e 's/ -mwindows//g')"
@ -98,10 +99,10 @@ fi
echo "Building.."
${CC} ${CFLAGS} src/uxnasm.c -o bin/uxnasm
${CC} ${CFLAGS} ${CORE} src/devices/system.c src/devices/file.c src/devices/datetime.c src/devices/mouse.c src/devices/controller.c src/devices/screen.c src/devices/audio.c src/uxnemu.c ${UXNEMU_LDFLAGS} -o bin/uxnemu
${CC} ${CFLAGS} ${CORE} src/devices/system.c src/devices/file.c src/devices/datetime.c src/uxncli.c -o bin/uxncli
${CC} ${CFLAGS} ${CORE} src/devices/system.c src/devices/file.c src/devices/datetime.c src/devices/mouse.c src/devices/controller.c src/devices/screen.c src/devices/audio.c src/uxnemu.c ${UXNEMU_LDFLAGS} ${FILE_LDFLAGS} -o bin/uxnemu
${CC} ${CFLAGS} ${CORE} src/devices/system.c src/devices/file.c src/devices/datetime.c src/uxncli.c ${FILE_LDFLAGS} -o bin/uxncli
if [ -d "$HOME/bin" ]
if [ $install = 1 ]
then
echo "Installing in $HOME/bin"
cp bin/uxnemu bin/uxnasm bin/uxncli $HOME/bin/
@ -118,11 +119,14 @@ do
bin/uxncli bin/asma.rom $f bin/`basename ${f%.tal}`.rom 2> /dev/null
done
<<<<<<< HEAD
if [ $norun = 1 ]; then exit; fi
=======
echo "Assembling(piano).."
./bin/uxnasm projects/software/piano.tal bin/piano.rom
>>>>>>> main
echo "Running.."
cd bin
./uxnemu piano.rom
./bin/uxnemu bin/piano.rom
echo "Done."
cd ..

45
etc/asma-test.sh
View File

@ -10,11 +10,16 @@ expect_failure() {
if ! grep -qF "${1}" asma-test/asma.log; then
echo "error: asma didn't report error ${1} in faulty code"
cat asma-test/asma.log
exit 1
fi
}
echo 'Assembling asma with uxnasm'
bin/uxnasm projects/software/asma.tal asma-test/asma.rom > asma-test/uxnasm.log
if ! bin/uxnasm projects/software/asma.tal asma-test/asma.rom > asma-test/uxnasm.log; then
echo 'Failed to assemble asma!'
cat asma-test/uxnasm.log
exit 1
fi
for F in $(find projects -path projects/library -prune -false -or -path projects/assets -prune -false -or -type f -name '*.tal' | sort); do
echo "Comparing assembly of ${F}"
@ -52,21 +57,25 @@ EOD
expect_failure 'Invalid hexadecimal: #000' <<'EOD'
|1000 #000
EOD
expect_failure 'Unrecognised token: 0' <<'EOD'
expect_failure 'Label not found: 0' <<'EOD'
|1000 0
EOD
expect_failure 'Unrecognised token: 000' <<'EOD'
expect_failure 'Label not found: 000' <<'EOD'
|1000 000
EOD
expect_failure 'Address not in zero page: .hello' <<'EOD'
|1000 @hello
.hello
EOD
expect_failure 'Address not in zero page: -hello' <<'EOD'
|1000 @hello
-hello
EOD
expect_failure 'Address outside range: ,hello' <<'EOD'
|1000 @hello
|2000 ,hello
EOD
expect_failure 'Unrecognised token: hello' <<'EOD'
expect_failure 'Label not found: hello' <<'EOD'
hello
EOD
expect_failure 'Macro already exists: %me' <<'EOD'
@ -77,22 +86,34 @@ expect_failure 'Memory overwrite: SUB' <<'EOD'
|2000 ADD
|1000 SUB
EOD
expect_failure 'Recursion level too deep:' <<'EOD'
%me { you }
%you { me }
|1000 me
EOD
expect_failure 'Recursion level too deep: ~asma-test/in.tal' <<'EOD'
~asma-test/in.tal
EOD
# expect_failure 'Recursion level too deep:' <<'EOD'
# %me { you }
# %you { me }
# |1000 me
# EOD
# expect_failure 'Recursion level too deep: ~asma-test/in.tal' <<'EOD'
# ~asma-test/in.tal
# EOD
expect_failure 'Label not found: ;blah' <<'EOD'
|1000 ;blah
EOD
expect_failure 'Label not found: :blah' <<'EOD'
|1000 :blah
EOD
expect_failure 'Label not found: =blah' <<'EOD'
|1000 =blah
EOD
expect_failure 'Label not found: -blah' <<'EOD'
|1000 -blah
EOD
expect_failure 'Label not found: ,blah' <<'EOD'
|1000 ,blah
EOD
expect_failure 'Label not found: .blah' <<'EOD'
|1000 .blah
EOD
expect_failure "Label not found: 'a" <<'EOD'
|1000 'a
EOD
echo 'All OK'

269
etc/asma.lua
View File

@ -1,196 +1,103 @@
local spairs
spairs = function(t)
local keys
local output = assert(io.open('.asma.tal', 'w'))
local process_subtree
process_subtree = function(items)
local middle = math.floor(#items / 2 + 1.25)
local node = items[middle]
if not node then
return
end
node.left = process_subtree((function()
local _accum_0 = { }
local _len_0 = 1
for i, item in ipairs(items) do
if i < middle then
_accum_0[_len_0] = item
_len_0 = _len_0 + 1
end
end
return _accum_0
end)())
node.right = process_subtree((function()
local _accum_0 = { }
local _len_0 = 1
for i, item in ipairs(items) do
if i > middle then
_accum_0[_len_0] = item
_len_0 = _len_0 + 1
end
end
return _accum_0
end)())
return node
end
local process_tree
process_tree = function(items)
local sorted_items
do
local _accum_0 = { }
local _len_0 = 1
for k in pairs(t) do
_accum_0[_len_0] = k
for _index_0 = 1, #items do
local item = items[_index_0]
_accum_0[_len_0] = item
_len_0 = _len_0 + 1
end
keys = _accum_0
sorted_items = _accum_0
end
table.sort(keys)
local i = 0
return function()
i = i + 1
return keys[i], t[keys[i]]
table.sort(sorted_items, function(a, b)
return a.order < b.order
end);
(process_subtree(sorted_items)).label = '&_entry'
for _index_0 = 1, #items do
local item = items[_index_0]
output:write(('\t%-11s %-10s %-12s %s%s\n'):format(item.label, item.left and item.left.ref or ' $2', (item.right and item.right.ref or ' $2') .. item.extra, item.key, item.rest))
end
end
local trees = {
['asma-opcodes'] = { }
}
local opcodes_in_order = { }
do
local wanted = false
for l in assert(io.lines('src/uxnasm.c')) do
if l == 'static char ops[][4] = {' then
wanted = true
elseif wanted then
if l == '};' then
break
end
for w in l:gmatch('[^%s",][^%s",][^%s",]') do
if w ~= '---' then
trees['asma-opcodes'][w] = {
('"%s 00'):format(w),
''
}
end
table.insert(opcodes_in_order, w)
end
local parse_tree
parse_tree = function(it)
local items = { }
for l in it do
if l == '' then
process_tree(items)
output:write('\n')
return
end
end
assert(#opcodes_in_order == 32, 'didn\'t find 32 opcodes in assembler code!')
end
do
local representation = setmetatable({
['&'] = '26 00 ( & )'
}, {
__index = function(self, c)
return ("'%s 00"):format(c)
local item = {
extra = ''
}
item.key, item.rest = l:match('^%s*%S+%s+%S+%s+%S+%s+(%S+)(.*)')
if item.key:match('^%&') then
item.extra = (' %s'):format(item.key)
item.key, item.rest = item.rest:match('^%s+(%S+)(.*)')
end
})
local process
process = function(label, t)
trees[label] = { }
for k, v in pairs(t) do
trees[label][('%02x'):format(k:byte())] = {
representation[k],
(':%s'):format(v)
}
end
end
process('asma-first-char-normal', {
['%'] = 'asma-macro-define',
['|'] = 'asma-pad-absolute',
['$'] = 'asma-pad-relative',
['@'] = 'asma-label-define',
['&'] = 'asma-sublabel-define',
['#'] = 'asma-literal-hex',
['.'] = 'asma-literal-zero-addr',
[','] = 'asma-literal-rel-addr',
[';'] = 'asma-literal-abs-addr',
[':'] = 'asma-abs-addr',
["'"] = 'asma-raw-char',
['"'] = 'asma-raw-word',
['{'] = 'asma-ignore',
['}'] = 'asma-ignore',
['['] = 'asma-ignore',
[']'] = 'asma-ignore',
['('] = 'asma-comment-start',
[')'] = 'asma-comment-end',
['~'] = 'asma-include'
})
process('asma-first-char-macro', {
['('] = 'asma-comment-start',
[')'] = 'asma-comment-end',
['{'] = 'asma-ignore',
['}'] = 'asma-macro-end'
})
process('asma-first-char-comment', {
['('] = 'asma-comment-more',
[')'] = 'asma-comment-less'
})
end
local traverse_node
traverse_node = function(t, min, max, lefts, rights)
local i = math.ceil((min + max) / 2)
if min < i then
lefts[t[i]] = (':&%s'):format(traverse_node(t, min, i - 1, lefts, rights))
end
if i < max then
rights[t[i]] = (':&%s'):format(traverse_node(t, i + 1, max, lefts, rights))
end
return t[i]
end
local traverse_tree
traverse_tree = function(t)
local lefts, rights = { }, { }
local keys
do
local _accum_0 = { }
local _len_0 = 1
for k in pairs(t) do
_accum_0[_len_0] = k
_len_0 = _len_0 + 1
end
keys = _accum_0
end
table.sort(keys)
return lefts, rights, traverse_node(keys, 1, #keys, lefts, rights)
end
local ptr
ptr = function(s)
if s then
return (':&%s'):format(s)
end
return ' $2'
end
local ordered_opcodes
ordered_opcodes = function(t)
local i = 0
return function()
i = i + 1
local v = opcodes_in_order[i]
if t[v] then
return v, t[v]
elseif v then
return false, {
'"--- 00',
''
}
end
end
end
local printout = true
local fmt
fmt = function(...)
return (('\t%-11s %-10s %-12s %-14s %s '):format(...):gsub(' +$', '\n'))
end
do
local _with_0 = assert(io.open('projects/library/asma.tal.tmp', 'w'))
for l in assert(io.lines('projects/library/asma.tal')) do
if l:match('--- cut here ---') then
break
end
_with_0:write(l)
_with_0:write('\n')
end
_with_0:write('( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- )\n')
_with_0:write('( automatically generated code below )\n')
_with_0:write('( see etc/asma.moon for instructions )\n')
_with_0:write('\n(')
_with_0:write(fmt('label', 'less', 'greater', 'key', 'binary'))
_with_0:write(fmt('', 'than', 'than', 'string', 'data )'))
_with_0:write('\n')
for name, tree in spairs(trees) do
_with_0:write(('@%s\n'):format(name))
local lefts, rights, entry = traverse_tree(tree)
local sort_fn
if name == 'asma-opcodes' then
if rights[opcodes_in_order[1]] then
rights[opcodes_in_order[1]] = rights[opcodes_in_order[1]] .. ' &_disasm'
else
rights[opcodes_in_order[1]] = ' $2 &_disasm'
end
sort_fn = ordered_opcodes
if item.key:match('^%"') then
item.order = item.key:sub(2)
elseif item.key:match('^%x%x') then
item.order = string.char(tonumber(item.key, 16))
else
sort_fn = spairs
error(('unknown key: %q'):format(item.key))
end
for k, v in sort_fn(tree) do
local label
if k == entry then
label = '&_entry'
elseif k then
label = ('&%s'):format(k)
else
label = ''
end
_with_0:write(fmt(label, lefts[k] or ' $2', rights[k] or ' $2', unpack(v)))
if item.order:match('^%a') then
item.label = ('&%s'):format(item.order)
elseif item.order:match('^.$') then
item.label = ('&%x'):format(item.order:byte())
else
error(('unknown label: %q'):format(item.order))
end
_with_0:write('\n')
item.ref = (':%s'):format(item.label)
table.insert(items, item)
end
_with_0:close()
end
return os.execute('mv projects/library/asma.tal.tmp projects/library/asma.tal')
local it = assert(io.lines('projects/library/asma.tal'))
local waiting_for_cut = true
for l in it do
output:write(l)
output:write('\n')
if l:find('--- cut here ---', 1, true) then
waiting_for_cut = false
end
if not waiting_for_cut and '@' == l:sub(1, 1) then
parse_tree(it)
end
end
output:close()
return os.execute('mv .asma.tal projects/library/asma.tal')

194
etc/asma.moon
View File

@ -1,10 +1,7 @@
--
-- Asma tree helper script
--
-- This script updates the trees at the end of projects/library/asma.tal when
-- Uxn's opcode set changes or new runes (first character of tokens) are
-- created, so that new changes in the C assembler can be incorporated rapidly
-- into asma.
-- This script balances the trees at the end of projects/library/asma.tal.
--
-- To run, you need Lua or LuaJIT, and just run etc/asma.lua from the top
-- directory of Uxn's git repository:
@ -18,145 +15,60 @@
-- file changes.
--
spairs = (t) ->
keys = [ k for k in pairs t ]
table.sort keys
i = 0
->
i = i + 1
keys[i], t[keys[i]]
output = assert io.open '.asma.tal', 'w'
trees = {
['asma-opcodes']: {}
}
process_subtree = (items) ->
middle = math.floor #items / 2 + 1.25
node = items[middle]
if not node
return
node.left = process_subtree [ item for i, item in ipairs items when i < middle ]
node.right = process_subtree [ item for i, item in ipairs items when i > middle ]
node
opcodes_in_order = {}
process_tree = (items) ->
sorted_items = [ item for item in *items ]
table.sort sorted_items, (a, b) -> a.order < b.order
(process_subtree sorted_items).label = '&_entry'
for item in *items
output\write '\t%-11s %-10s %-12s %s%s\n'\format item.label, item.left and item.left.ref or ' $2', (item.right and item.right.ref or ' $2') .. item.extra, item.key, item.rest
do -- opcodes
wanted = false
for l in assert io.lines 'src/uxnasm.c'
if l == 'static char ops[][4] = {'
wanted = true
elseif wanted
if l == '};'
break
for w in l\gmatch '[^%s",][^%s",][^%s",]'
if w != '---'
trees['asma-opcodes'][w] = {
'"%s 00'\format w
''
}
table.insert opcodes_in_order, w
assert #opcodes_in_order == 32, 'didn\'t find 32 opcodes in assembler code!'
parse_tree = (it) ->
items = {}
for l in it
if l == ''
process_tree items
output\write '\n'
return
item = { extra: '' }
item.key, item.rest = l\match '^%s*%S+%s+%S+%s+%S+%s+(%S+)(.*)'
if item.key\match '^%&'
item.extra = ' %s'\format item.key
item.key, item.rest = item.rest\match '^%s+(%S+)(.*)'
if item.key\match '^%"'
item.order = item.key\sub 2
elseif item.key\match '^%x%x'
item.order = string.char tonumber item.key, 16
else
error 'unknown key: %q'\format item.key
if item.order\match '^%a'
item.label = '&%s'\format item.order
elseif item.order\match '^.$'
item.label = '&%x'\format item.order\byte!
else
error 'unknown label: %q'\format item.order
item.ref = ':%s'\format item.label
table.insert items, item
do -- first characters
representation = setmetatable {
'&': '26 00 ( & )'
},
__index: (c) => "'%s 00"\format c
process = (label, t) ->
trees[label] = {}
for k, v in pairs t
trees[label]['%02x'\format k\byte!] = {
representation[k]
':%s'\format v
}
process 'asma-first-char-normal',
'%': 'asma-macro-define'
'|': 'asma-pad-absolute'
'$': 'asma-pad-relative'
'@': 'asma-label-define'
'&': 'asma-sublabel-define'
'#': 'asma-literal-hex'
'.': 'asma-literal-zero-addr'
',': 'asma-literal-rel-addr'
';': 'asma-literal-abs-addr'
':': 'asma-abs-addr'
"'": 'asma-raw-char'
'"': 'asma-raw-word'
'{': 'asma-ignore'
'}': 'asma-ignore'
'[': 'asma-ignore'
']': 'asma-ignore'
'(': 'asma-comment-start'
')': 'asma-comment-end'
'~': 'asma-include'
process 'asma-first-char-macro',
'(': 'asma-comment-start'
')': 'asma-comment-end'
'{': 'asma-ignore'
'}': 'asma-macro-end'
process 'asma-first-char-comment',
'(': 'asma-comment-more'
')': 'asma-comment-less'
traverse_node = (t, min, max, lefts, rights) ->
i = math.ceil (min + max) / 2
if min < i
lefts[t[i]] = ':&%s'\format traverse_node t, min, i - 1, lefts, rights
if i < max
rights[t[i]] = ':&%s'\format traverse_node t, i + 1, max, lefts, rights
return t[i]
traverse_tree = (t) ->
lefts, rights = {}, {}
keys = [ k for k in pairs t ]
table.sort keys
lefts, rights, traverse_node keys, 1, #keys, lefts, rights
ptr = (s) ->
if s
return ':&%s'\format s
return ' $2'
ordered_opcodes = (t) ->
i = 0
->
i = i + 1
v = opcodes_in_order[i]
if t[v]
return v, t[v]
elseif v
return false, { '"--- 00', '' }
printout = true
fmt = (...) ->
('\t%-11s %-10s %-12s %-14s %s '\format(...)\gsub ' +$', '\n')
with assert io.open 'projects/library/asma.tal.tmp', 'w'
for l in assert io.lines 'projects/library/asma.tal'
if l\match '--- cut here ---'
break
\write l
\write '\n'
\write '( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- )\n'
\write '( automatically generated code below )\n'
\write '( see etc/asma.moon for instructions )\n'
\write '\n('
\write fmt 'label', 'less', 'greater', 'key', 'binary'
\write fmt '', 'than', 'than', 'string', 'data )'
\write '\n'
for name, tree in spairs trees
\write '@%s\n'\format name
lefts, rights, entry = traverse_tree tree
sort_fn = if name == 'asma-opcodes'
if rights[opcodes_in_order[1]]
rights[opcodes_in_order[1]] ..= ' &_disasm'
else
rights[opcodes_in_order[1]] = ' $2 &_disasm'
ordered_opcodes
else
spairs
for k, v in sort_fn tree
label = if k == entry
'&_entry'
elseif k
'&%s'\format k
else
''
\write fmt label, lefts[k] or ' $2', rights[k] or ' $2', unpack v
\write '\n'
\close!
os.execute 'mv projects/library/asma.tal.tmp projects/library/asma.tal'
it = assert io.lines 'projects/library/asma.tal'
waiting_for_cut = true
for l in it
output\write l
output\write '\n'
if l\find '--- cut here ---', 1, true
waiting_for_cut = false
if not waiting_for_cut and '@' == l\sub 1, 1
parse_tree it
output\close!
os.execute 'mv .asma.tal projects/library/asma.tal'

4
etc/syntax-highlight/tal.sublime-syntax
View File

@ -118,9 +118,9 @@ contexts:
- match: '\}'
pop: true
- match: '\( '
- match: '\s\(\s'
scope: comment
push:
- meta_scope: comment.line
- match: ' \)'
- match: '\s\)\s'
pop: true

2
etc/tables/build.sh
View File

@ -8,7 +8,7 @@ rm -f ../../bin/tables
echo "Building.."
mkdir -p ../../bin
cc -std=c89 -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 -lm tables.c -o ../../bin/tables
cc -lm tables.c -o ../../bin/tables
echo "Assembling.."
../../bin/tables

11
etc/tables/tables.c
View File

@ -25,12 +25,13 @@ clamp(int val, int min, int max)
int
main()
{
int i;
printf("60 points on a circle128(bytex,bytey):\n\n");
for(i = 0; i < 60; ++i) {
int seg = 1024, offset = seg / 4, i;
double segf = 1024.0;
printf("%d points on a circle128:\n\n", seg);
for(i = 0; i < seg; ++i) {
double cx = 128, cy = 128, r = 128;
double pos = (i - 15) % 60;
double deg = (pos / 60.0) * 360.0;
double pos = (i - offset) % seg;
double deg = (pos / segf) * 360.0;
double rad = deg * (PI / 180);
double x = cx + r * cos(rad);
double y = cy + r * sin(rad);

59
projects/examples/blank.tal
View File

@ -1,27 +1,5 @@
( a blank file )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 }
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }
%2MOD { #01 AND } %2MOD2 { #0001 AND2 }
%4MOD { #03 AND } %4MOD2 { #0003 AND2 }
%8MOD { #07 AND } %8MOD2 { #0007 AND2 }
%10MOD { #0f AND } %10MOD2 { #000f AND2 }
%DEBUG { ;print-hex/byte JSR2 #0a18 DEO }
%DEBUG2 { ;print-hex JSR2 #0a18 DEO }
%RTN { JMP2r }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
@ -31,8 +9,9 @@
|60 @Audio3 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1 &func $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|a0 @File0 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @File1 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
( variables )
@ -49,33 +28,19 @@
BRK
@print-hex ( value* -- )
SWP ,&byte JSR
&byte ( byte -- )
STHk #04 SFT ,&parse JSR #18 DEO
STHr #0f AND ,&parse JSR #18 DEO
RTN
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 + RTN
&above #57 + RTN
@print ( short* -- )
RTN
SWP ,&byte JSR
&byte ( byte -- ) DUP #04 SFT ,&char JSR
&char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
@print-dec ( value* -- )
JMP2r
#2710 DIV2k DUP #30 ADD #18 DEO MUL2 SUB2
#03e8 DIV2k DUP #30 ADD #18 DEO MUL2 SUB2
#0064 DIV2k DUP #30 ADD #18 DEO MUL2 SUB2
#000a DIV2k DUP #30 ADD #18 DEO MUL2 SUB2
#30 ADD #18 DEO POP
@print-str ( str* -- )
RTN
@print-str ( string* -- )
#0001 --
&while
INC2 LDAk DUP #18 DEO ,&while JCN
LDAk #18 DEO
INC2 LDAk ,&while JCN
POP2
RTN
JMP2r

304
projects/examples/demos/amiga.tal Normal file
View File

@ -0,0 +1,304 @@
( Boing )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0000
@ball &x $2 &y $2 &vx $2 &vy $2
@timer $1
@frame $1
(
@|vectors )
|0100
( vectors )
;on-frame .Screen/vector DEO2
( theme )
#aff5 .System/r DEO2
#af00 .System/g DEO2
#af05 .System/b DEO2
( screen size )
#0140 .Screen/width DEO2
#0100 .Screen/height DEO2
( inital position )
#0020 .ball/x STZ2
#0020 .ball/y STZ2
( initial velocity )
#0008 .ball/vx STZ2
#0000 .ball/vy STZ2
( once )
make-shadow
draw-background
BRK
@on-frame ( -> )
( every 4th frame )
.timer LDZ INC .timer STZk POP #03 EQU JMP [ BRK ]
( reset timer )
#00 .timer STZ
( 12 frames animation )
.frame LDZ INC DUP #0c NEQ MUL .frame STZ
move-ball
BRK
(
@|core )
@check-flip-vx ( x -- x )
( left ) DUP2 #0010 LTH2 ?&flip
( right ) DUP2 .Screen/width DEI2 #0050 SUB2 GTH2 ?&flip ,&else JMP
&flip .ball/vx LDZ2k #ffff EOR2 ( INC2 ) ROT STZ2
&else
JMP2r
@check-flip-vy ( y -- y )
( bottom ) DUP2 .Screen/height DEI2 #0050 SUB2 GTH2 ?&flip ,&else JMP
&flip .ball/vy LDZ2k #ffff EOR2 ( INC2 ) ROT STZ2
&else
JMP2r
@move-ball ( -- )
( clear )
.ball/x LDZ2 .Screen/x DEO2
.ball/y LDZ2 .Screen/y DEO2
#76 .Screen/auto DEO
#0800
&loop-bg
#40 .Screen/sprite DEO
INC GTHk ?&loop-bg
POP2
.ball/vx LDZ2k STH2k ROT STZ2
.ball/x LDZ2k STH2r ADD2 check-flip-vx ROT STZ2
.ball/vy LDZ2k INC2 STH2k ROT STZ2
.ball/y LDZ2k STH2r ADD2 check-flip-vy ROT STZ2
@draw-ball ( -- )
( shadow )
.ball/x LDZ2 #0008 ADD2 .Screen/x DEO2
.ball/y LDZ2 #0008 ADD2 .Screen/y DEO2
;shadow .Screen/addr DEO2
#66 .Screen/auto DEO
#0700
&loop-shadow
#4f .Screen/sprite DEO
INC GTHk ?&loop-shadow
POP2
.frame LDZ
( bg )
DUP #06 DIV INC #05 MUL #40 ADD STH
.ball/x LDZ2 .Screen/x DEO2
.ball/y LDZ2 .Screen/y DEO2
;bg .Screen/addr DEO2
#66 .Screen/auto DEO
#0700
&loop-bg
STHkr .Screen/sprite DEO
INC GTHk ?&loop-bg
POP2
POPr
( fg )
DUP #06 DIV #00 EQU INC #05 MUL #40 ADD STH
.ball/x LDZ2 .Screen/x DEO2
.ball/y LDZ2 .Screen/y DEO2
#06 DIVk MUL SUB #00 SWP #0188 MUL2 ;ball-icn ADD2 .Screen/addr DEO2
#66 .Screen/auto DEO
#0700
&loop-fg
STHkr .Screen/sprite DEO
INC GTHk ?&loop-fg
POP2
POPr
JMP2r
@draw-background ( -- )
( hor lines )
#01 .Screen/auto DEO
;hor-icn .Screen/addr DEO2
.Screen/height DEI2 #04 SFT2 NIP #04 SUB #00
&horver
#0020 .Screen/x DEO2
#00 OVR #40 SFT2 #0020 ADD2 .Screen/y DEO2
.Screen/width DEI2 #03 SFT2 NIP #08 SUB #00
&horhor
#0f .Screen/sprite DEO
INC GTHk ?&horhor
POP2
INC GTHk ?&horver
POP2
( ver lines )
#02 .Screen/auto DEO
;ver-icn .Screen/addr DEO2
.Screen/width DEI2 #04 SFT2 NIP #03 SUB #00
&verver
#0027 .Screen/y DEO2
#00 OVR #40 SFT2 #0019 ADD2 .Screen/x DEO2
.Screen/height DEI2 #03 SFT2 NIP #0a SUB #00
&verhor
#0f .Screen/sprite DEO
INC GTHk ?&verhor
POP2
INC GTHk ?&verver
POP2
JMP2r
@make-shadow ( -- )
;bg ;shadow #0188 mcpy
#0188 #0000
&loop
DUP2 ;shadow ADD2 LDA2k #aa55 AND2 SWP2 STA2
INC2 INC2 GTH2k ?&loop
POP2 POP2
JMP2r
@mcpy ( src* dst* len* -- )
SWP2 STH2
OVR2 ADD2 SWP2
&loop
LDAk STH2kr STA INC2r
INC2 GTH2k ?&loop
POP2 POP2
POP2r
JMP2r
(
@|assets )
@hor-icn
0000 0000 0000 00ff
@ver-icn
0101 0101 0101 0101
@ball-icn ( 56 x 56 )
( 00 )
0000 0000 0000 0000 0000 0000 0304 0830 0000 073f 180c 1f3f 00f4 c103 070f bf8f
0040 0cfc e2c1 c1c1 0000 0000 80a0 e0e4 0000 0000 0000 0000 0000 0000 0101 0303
60c0 01e3 fbf0 f0e0 7fff fefe fc78 000f 8100 0000 0001 0103 8040 f8ff ffff ffff
f2f1 f9f8 1c00 0303 0000 8080 4020 b0e0 0707 0f1f 2720 2060 e0c0 c080 8000 e0fc
0f1f 1f3f 3f3f 7f7f e3ff f8f8 f8f0 f0f0 fefe 7e0e 0001 0103 0101 0101 01c1 f9fe
e0e0 e0f0 f0f0 f0f8 6060 4041 4141 0139 ffff ffff fefe fefe 7f0f 0100 0000 0000
e0e0 e000 3c3f 7f7f 0303 0707 0787 fff1 fefe fefc fcfc fcfc 1804 0606 0e0e 0e0e
3e1e 1e1e 1e0e 0f0f fe1c 0003 0303 0303 0000 0080 f1ff fefe 7fff ffff ffff 3f07
f0e0 e0e0 c0c0 8080 3800 070f 0f1f 1f3f 0e0c 0cfc e0c0 c080 0f09 0400 0001 0000
0303 c37b 3c3c 9e1e fcfc fcfc f818 040f 0000 0101 0303 078f 80e0 feff fffe fcf8
3f7f 7f3e 0603 070e 8000 0000 0000 0000 0000 0000 0000 0000 0e1e 0500 0000 0000
0f0f 0f4f 2703 0200 ffe1 c080 030f 1e00 f0e0 00f9 f8c0 0000 3c70 e0c0 0000 0000
0000 0000 0000 0000
( 01 )
0000 0000 0000 0000 0000 0000 0204 0800 0001 0f7c 101c 3fff 00e7 8307 0f3f ff0f
0040 0cdc c083 8101 0000 0000 80a0 c0e4 0000 0000 0000 0000 0000 0003 0103 0307
4183 07ef f3e0 e0c0 fefe fcf8 f070 181f 0101 0103 0303 0707 01c1 f9fe fefc fcfc
e2f3 f1f8 1804 0707 0000 0080 4060 b0c0 070f 3f1f 2721 0101 c080 8000 0000 e1fd
3f3f 7f7f ffff ffff eff3 f0e0 e0c0 c0c0 fcfc 7c0c 0607 0707 0303 0303 03c3 fbfc
c0e0 e0e4 e0e0 f0f0 4141 4343 4343 433b fefe fcfc fcfc f8f8 7f0f 0100 0000 0001
8080 80c0 fcff ffff 0f0f 0f1f 1f9f efc1 fcf8 f8f8 f8f8 f0f0 100c 0e0e 0e1e 1e1e
3c3c 3c1c 3c1e 0e0e f818 0407 0707 0707 0101 0383 f3f9 f8f8 ffff ffff ffff 3f06
c0c0 8080 0000 0000 3008 1f1f 3f3f 7f7f 1c1c 1cfc c0c4 8000 0e08 0400 0000 0000
0707 c7ff 7838 bc1c f8f8 f0f0 f010 1c1f 0103 0307 070f 0f9f 00e0 fefe fcf8 f0e0
7ffe fe3c 0407 0f1e 0000 0000 4000 0000 0000 0000 0000 0000 0c1e 0400 0000 0000
1f1f 1fdf 2607 0200 cfc1 8001 071f 1c00 e0c0 41fb f080 0000 38f0 e0c0 0000 0000
0000 0000 0000 0000
( 02 )
0000 0000 0000 0000 0000 0000 0000 0001 0001 1ff8 003c fefe 00e7 030f 3f7f 7f0e
0000 1cd8 8003 0303 0000 0000 80c0 c0c4 0000 0000 0000 0000 0000 0103 0307 070f
0307 0fff e3c0 c080 fcf8 f0f0 e040 787f 0203 0707 0f0f 1f1f 03c3 fbf8 f8f8 f8f8
e6e3 e1f1 100c 0f0f 0000 0080 c060 e0c0 0f1f 3f3e 0403 0303 8000 0001 0103 e3fb
7fff ffff ffff ffff ffc3 c080 8080 0000 f8f0 7000 0e1f 1f1f 0f0f 0707 07c7 fff0
c8c0 c0c4 e0e0 e0e2 0303 0707 0707 477f f8f8 f8f8 f0f0 f0f0 7f0e 0001 0303 0307
0000 00c0 fcff ffff 1f3f 3f3f 7fff 8f01 f0f0 f0f0 e0e0 e0e0 001c 1e1e 1e1c 3c3c
7838 3838 3c1c 1c1c f000 1c1f 1f1f 0f0f 0707 078f fff1 f0e0 ffff fefe fefc 3c00
0000 0000 0000 0001 2038 3f7f 7fff fffe 3c3c 3cdc 8004 0800 0c00 0100 0000 0000
0f0f cff7 7078 3818 e0e0 e0e0 e020 3c3f 0707 0f0f 1f1f 3fbf 01e1 fdf8 f0f0 e0c0
fefc fc38 000f 1e3c 1000 2000 4000 0000 0000 0000 0000 0000 1c1c 0400 0000 0000
3f3f 3ffe 6407 0300 8f01 0103 0f3f 1800 8080 c3ff e008 0000 78f0 c080 0000 0000
0000 0000 0000 0000
( 03 )
0000 0000 0000 0000 0000 0000 0000 0003 0001 1ef0 207d fcf8 00c7 071f 7ffe 7c0c
0080 1c9a 0407 0707 0000 0000 80c0 80cc 0000 0000 0000 0000 0000 0103 0307 070f
070f 1fdf c380 8001 f8f0 e0c0 8080 f8ff 060f 0f1f 1f3f 3f7f 07c7 f7f0 f0f0 e0e0
c6c2 e3e1 001c 1f1f 0000 0080 c0c0 e080 0f1e 3c3c 0007 0707 0101 0303 0707 eff3
ffff ffff fefe fcfc 9f03 0000 0000 0000 e0e0 6030 3e3f 7f7f 1f1f 1f1f 1fdf e7e0
8888 80c4 c4c0 c0c2 0707 070f 0f0f 4f77 f0f0 e0e0 e0e0 e0c0 7c08 0607 070f 0f0f
0000 00c0 fcfe fefe 7fff ffff ff7f 0f01 e0e0 c0c0 c0c0 8080 223c 3c3c 3c3c 7c7c
7030 3838 3818 181c c020 3c3f 3f3f 3f3f 1f1f 1f9f cfc1 c0c0 fcfc fcf8 f8f0 3008
0000 0000 0101 0303 4078 ffff fffe fefc 7c7c 7818 0404 0810 0c02 0101 0000 0000
1f1f dfe7 e070 3038 c0c0 c080 8060 7c7f 1f1f 3f3f 3f7f 7f7f 07e7 f1f0 e0c0 8080
fcf8 f830 081f 3e7c 1020 2040 4080 0000 0000 0000 0000 0000 181c 0200 0000 0000
7f7e 3efc 440f 0100 0f00 030f 1f3e 1800 0003 c7f7 c108 0000 f8e0 c080 0000 0000
0000 0000 0000 0000
( 04 )
0000 0000 0000 0000 0000 0000 0000 0103 0001 1ce0 60ff f8f0 0087 0f3f fefc 7800
0080 3c1a 0d0f 0f0f 0000 0000 8040 808c 0000 0000 0000 0000 0000 0103 0307 070e
0f1f 3f9f 8301 0103 e0c0 8000 0080 f8fe 0e1f 3f3f 7f7f ffff 0fdf e7e0 c0c0 c0c0
8686 c3c3 213c 3f3f 0000 0080 c0c0 6000 0e1c 3c38 000f 0f0f 0307 070f 0f1f ffe3
fefe fcfc f8f8 f8f0 1f03 0000 0000 0001 8080 0070 feff ffff 3f3f 3f3f 3fff c780
0808 8884 8484 8482 0f0f 0f0f 1f1f 5f67 c0c0 c0c0 c080 8080 7000 1e1f 1f1f 3f3f
0101 03c3 fff8 f8f8 ffff ffff ff7f 0f01 8080 8080 0000 0000 627e 7c7c 7cfc f8f8
6030 3030 3018 1818 8060 7c7f 7f7f 7f7f 3f7f 7fff 8f81 8080 f0f0 f0e0 e0e0 0038
0101 0303 0307 070f c0f8 fffe fefc fcf8 f8f8 f818 040c 1810 0802 0301 0000 0000
3f3f ffc7 e060 7030 0000 0000 00e0 fdfe 3f7f 7fff ffff ff7e 0fff e1c0 8080 0001
f8f0 f020 387f fcf8 3020 6040 c080 0000 0000 0000 0000 0000 1818 0200 0000 0000
7c7c 7cb8 400f 0100 0e02 0f1f 3f7c d000 0307 cfe7 0318 8000 f0e0 c000 0000 0000
0000 0000 0000 0000
( 05 )
0000 0000 0000 0000 0000 0000 0001 0307 0001 18c0 e1fb f0e0 0087 1f7e fcf8 7010
0080 7012 0d1f 1f1f 0000 0000 0040 100c 0000 0000 0000 0000 0000 0103 0306 060c
0f3f 7f9e 0003 0707 c080 0000 0081 fbfc 3e7f 7fff ffff ffff 3fff c780 8080 0000
0c86 8783 637d 7e7e 0000 0080 80c0 6010 0c18 3830 080f 0f1f 0f0f 1f1f 3f3f 9f83
f8f8 f8f0 f0e0 e0e0 1f02 0101 0303 0307 0000 80f0 feff ffff 7e7f 7f7f 7f3f 0700
1808 080c 0c04 0406 1f1f 1f1f 1f1f 7f67 8080 8080 0000 0000 4030 3e7f 7f7f 7fff
0707 0fcf f3f0 e0e0 fffe fefe fe7c 0c02 0000 0000 0101 0101 e6fe f8f8 f8f8 f8f8
6020 2030 3010 1018 00e0 fcfe fefe fe7e ffff ff7f 0f01 0000 e0c0 c0c0 8080 40f8
0707 070f 0f1f 1f1f c1f9 fcfc f8f8 f0f0 f8f0 f010 0c1c 1830 0806 0301 0100 0000
7e7e bec6 c1e1 6130 0000 0101 01e3 fffc ffff ffff fffe fe7c 3fdf 8100 0000 0103
e0e0 c000 79fe fcf0 3060 60c0 c080 0000 0000 0000 0000 0000 3008 0200 0000 0000
f8f8 f8b0 480e 0100 080e 1f3f 7ef8 e100 070f df87 0318 8000 e0c0 8000 0000 0000
0000 0000 0000 0000
@bg
0000 0000 0000 0000 0000 0000 0307 0f3f
0001 1fff ffff ffff 00ff ffff ffff ffff
00c0 fcfe ffff ffff 0000 0000 80e0 f8fc
0000 0000 0000 0000 0000 0103 0307 070f
7fff ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
feff ffff ffff ffff 0000 8080 c0e0 f0f0
0f1f 3f3f 3f3f 7f7f ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
f8f8 f8fc fcfc fcfe 7f7f 7f7f 7f7f 7f7f
ffff ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff ffff fefe fefe fefe fefe
7f3f 3f3f 3f1f 1f1f ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
fefe fcfc fcfc f8f0 0f0f 0703 0101 0000
ffff ffff ffff ff7f ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff fffe f0e0 e0c0 c080 0000
0000 0000 0000 0000 3f1f 0701 0000 0000
ffff ffff 7f3f 0300 ffff ffff ffff ff00
ffff ffff fff8 8000 fcf0 e0c0 0000 0000
0000 0000 0000 0000
@shadow $0188

119
projects/examples/demos/automata.tal
View File

@ -1,119 +0,0 @@
( Project by Alex Schroeder - https://alexschroeder.ch )
%RTN { JMP2r }
%INCR { SWP INC SWP }
%CELL { #1000 }
%NEXT { #2000 }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|0000
( program )
@seed [ &x $1 &w $2 &s $2 ]
|0100 ( -> )
( theme )
#2aac .System/r DEO2
#269b .System/g DEO2
#378d .System/b DEO2
;seed-line JSR2
( run for a few generations )
#00 #ff
&loop
OVR #00 SWP ;print-line JSR2
;compute-next JSR2
;copy-next JSR2
( incr ) INCR
( loop ) LTHk ,&loop JCN
POP2
BRK
@print-line ( y -- )
( set ) .Screen/y DEO2
( loop through cells )
#00 #ff
&loop
( copy ) OVR #00 SWP DUP2
( pos ) .Screen/x DEO2
( addr ) CELL ADD2
( draw ) LDA .Screen/pixel DEO
( incr ) INCR
( loop ) LTHk ,&loop JCN
POP2
RTN
@compute-next ( -- )
( loop through 62 cells )
#01 #fe
&loop
OVR DUP DUP ( three copies of the counter )
#01 SUB #00 SWP CELL ADD2 LDA
SWP
INC #00 SWP CELL ADD2 LDA
( the cell dies if the neighbors are either both dead or both alive, i.e. Rule 90 )
NEQ
( one copy of the counter and the life value )
SWP #00 SWP NEXT ADD2 STA
( incr ) INCR
( loop ) LTHk ,&loop JCN
POP2
RTN
@copy-next ( -- )
( loop through cells )
#00 #ff
&loop
OVR DUP ( two copies of the counter )
#00 SWP NEXT ADD2 LDA ( one copy of the counter and the value )
SWP #00 SWP CELL ADD2 STA
( incr ) INCR
( loop ) LTHk ,&loop JCN
POP2
RTN
@seed-line ( -- )
.DateTime/second DEI .seed/x STZ
#0000 .seed/w STZ2
#e2a9 .seed/s STZ2
( loop through cells )
#01 #fe
&loop
OVR ( one copy of the counter )
;rand JSR2
#10 AND ( pick a bit )
SWP #00 SWP CELL ADD2 STA
( incr ) INCR
( loop ) LTHk ,&loop JCN
POP2
RTN
( https://en.wikipedia.org/wiki/Middle-square_method )
@rand ( -- 1 )
.seed/x LDZ #00 SWP DUP2 MUL2
.seed/w LDZ2 .seed/s LDZ2 ADD2
DUP2 .seed/w STZ2
ADD2
#04 SFT SWP #40 SFT ADD
DUP .seed/x STZ
RTN

131
projects/examples/demos/bifurcan.tal
View File

@ -1,33 +1,17 @@
(
Bifurcan
Every second, the Labyrinth reorganize itself to display the time.
)
%RTN { JMP2r }
%MOD { DUP2 DIV MUL SUB }
%TOS { #00 SWP }
%2// { #01 SFT2 }
%8** { #30 SFT2 }
( devices )
( Bifurcan )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
( variables )
|0000
@last $1
@style $1
@pointer [ &x $2 &y $2 ]
@center [ &x $2 &y $2 ]
@anchor [ &x $2 &y $2 ]
( program )
|0100 ( -> )
@ -35,16 +19,13 @@
#0f3a .System/r DEO2
#0fda .System/g DEO2
#0faa .System/b DEO2
( vectors )
;on-frame .Screen/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-button .Controller/vector DEO2
( find center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
.Screen/width DEI2 #01 SFT2 .center/x STZ2
.Screen/height DEI2 #01 SFT2 .center/y STZ2
( background )
;tiles ;cover-pattern JSR2
;redraw JSR2
@ -54,8 +35,7 @@ BRK
@on-frame ( -> )
( only draw once per second )
.DateTime/second DEI .last LDZ NEQ #01 JCN [ BRK ]
.DateTime/second DEI .last LDZ NEQ JMP [ BRK ]
.DateTime/second DEI .last STZ
;redraw JSR2
@ -65,26 +45,27 @@ BRK
;draw-cursor JSR2
.Mouse/state DEI #00 EQU ,&no-touch JCN
( incr ) .style LDZ INC #03 MOD .style STZ
( bg ) ;tiles .style LDZ #40 SFT TOS ADD2 ;cover-pattern JSR2
( fg ) ;redraw JSR2
( release ) #00 .Mouse/state DEO
&no-touch
.Mouse/state DEI #00 NEQ JMP BRK
,select JSR
BRK
@on-button ( -> )
.Controller/button DEI #00 EQU ,&no-touch JCN
( incr ) .style LDZ INC #03 MOD .style STZ
( bg ) ;tiles .style LDZ #40 SFT TOS ADD2 ;cover-pattern JSR2
( fg ) ;redraw JSR2
( release ) #00 .Mouse/state DEO
&no-touch
.Controller/button DEI #00 NEQ JMP BRK
,select JSR
BRK
@select ( -- )
( incr ) .style LDZ INC #03 ;mod JSR2 .style STZ
( bg ) ;tiles [ #00 .style LDZ #40 SFT ] ADD2 ;cover-pattern JSR2
( fg ) ;redraw JSR2
( release ) #0000 .Mouse/state DEO .Controller/button DEO
JMP2r
@redraw ( -- )
( hrs )
@ -93,14 +74,14 @@ BRK
.DateTime/hour DEI #0a DIV ;draw-number JSR2
[ .center/x LDZ2 #0008 ADD2 ]
[ .center/y LDZ2 #0048 SUB2 ]
.DateTime/hour DEI #0a MOD ;draw-number JSR2
.DateTime/hour DEI #0a ;mod JSR2 ;draw-number JSR2
( min )
[ .center/x LDZ2 #0018 SUB2 ]
[ .center/y LDZ2 #0018 SUB2 ]
.DateTime/minute DEI #0a DIV ;draw-number JSR2
[ .center/x LDZ2 #0008 ADD2 ]
[ .center/y LDZ2 #0018 SUB2 ]
.DateTime/minute DEI #0a MOD ;draw-number JSR2
.DateTime/minute DEI #0a ;mod JSR2 ;draw-number JSR2
( sec )
[ .center/x LDZ2 #0018 SUB2 ]
[ .center/y LDZ2 #0018 ADD2 ]
@ -108,50 +89,44 @@ BRK
;draw-number JSR2
[ .center/x LDZ2 #0008 ADD2 ]
[ .center/y LDZ2 #0018 ADD2 ]
.DateTime/second DEI #0a MOD
;draw-number JSR2
RTN
.DateTime/second DEI #0a ;mod JSR2
@draw-number ( x* y* n -- )
STH
( save pos ) .anchor/y STZ2 .anchor/x STZ2
#00 #0f
,&digit STR ,&y STR2 ,&x STR2
#0f00
&loop
( save-x ) OVR #03 MOD TOS 8** .anchor/x LDZ2 ADD2 .Screen/x DEO2
( save-y ) OVR #03 DIV TOS 8** .anchor/y LDZ2 ADD2 .Screen/y DEO2
( get digit* ) OVR STHkr DUP ADD TOS ;digits ADD2 LDA2
( save-x ) DUP #03 ;mod JSR2 #00 SWP #30 SFT2 [ LIT2 &x $2 ] ADD2 .Screen/x DEO2
( save-y ) DUP #03 DIV #00 SWP #30 SFT2 [ LIT2 &y $2 ] ADD2 .Screen/y DEO2
( get digit* ) DUP [ LIT &digit $1 ] DUP ADD #00 SWP ;digits ADD2 LDA2
( get bit ) ROT #0e SWP SUB SFT2 #0001 AND2
( set tile ) 8** ;tiles ADD2
( set style ) .style LDZ #40 SFT TOS ADD2
.Screen/addr DEO2
( set tile ) #30 SFT2 ;tiles ADD2
( set style ) .style LDZ #40 SFT #00 SWP ADD2
.Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
( incr ) SWP INC SWP
LTHk ,&loop JCN
INC GTHk ,&loop JCN
POP2
POPr
RTN
JMP2r
@cover-pattern ( addr* -- )
( load ) .Screen/addr DEO2
#0000 .Screen/height DEI2
.Screen/addr DEO2
.Screen/height DEI2 #03 SFT2 NIP ,&h STR
.Screen/width DEI2 #03 SFT2 NIP ,&w STR
[ LIT &h $1 ] #00
&ver
( save ) OVR2 .Screen/y DEO2
#0000 .Screen/width DEI2
#00 OVR #30 SFT2 .Screen/y DEO2
[ LIT &w $1 ] #00
&hor
( save ) OVR2 .Screen/x DEO2
( draw ) #01 .Screen/sprite DEO
( incr ) SWP2 #0008 ADD2 SWP2
LTH2k ,&hor JCN
POP2 POP2
( incr ) SWP2 #0008 ADD2 SWP2
LTH2k ,&ver JCN
POP2 POP2
#00 OVR #30 SFT2 .Screen/x DEO2
#01 .Screen/sprite DEO
INC GTHk ,&hor JCN
POP2
INC GTHk ,&ver JCN
POP2
RTN
JMP2r
@draw-cursor ( -- )
@ -166,20 +141,22 @@ RTN
( colorize on state )
#41 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
RTN
JMP2r
@cursor [
80c0 e0f0 f8e0 1000 ]
@mod DIVk MUL SUB JMP2r
@digits [
@cursor
80c0 e0f0 f8e0 1000
@digits
7b6f 2492 73e7 73cf
5bc9 79cf 49ef 7249
7bef 7bc9 ]
7bef 7bc9
@tiles [
@tiles
0102 0408 1020 4080
8040 2010 0804 0201
0718 2040 4080 8080
0101 0102 0204 18e0
0808 0810 e304 0808
0808 0804 e310 0808 ]
0808 0804 e310 0808

125
projects/examples/demos/logic.tal → projects/examples/demos/bitwise.tal
View File

@ -1,31 +1,4 @@
( a blank file )
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT }
%4* { #20 SFT } %4/ { #02 SFT }
%8* { #30 SFT } %8/ { #03 SFT }
%10* { #40 SFT } %10/ { #04 SFT }
%20* { #50 SFT } %20/ { #05 SFT }
%2** { #10 SFT2 } %2// { #01 SFT2 }
%4** { #20 SFT2 } %4// { #02 SFT2 }
%8** { #30 SFT2 } %8// { #03 SFT2 }
%10** { #40 SFT2 } %10// { #04 SFT2 }
%20** { #50 SFT2 } %20// { #05 SFT2 }
%RELEASE-MOUSE { #0096 DEO }
%AUTO-X { #01 .Screen/auto DEO }
%AUTO-X-ADDR { #05 .Screen/auto DEO }
%AUTO-NONE { #00 .Screen/auto DEO }
%RTN { JMP2r }
%TOS { #00 SWP }
( devices )
( bitwise )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
@ -37,7 +10,7 @@
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
@ -63,13 +36,13 @@
;on-mouse .Mouse/vector DEO2
.Screen/width DEI2 2//
DUP2 #0040 -- .a-frame/x STZ2 DUP2 #0040 ++ .a-frame/x2 STZ2
DUP2 #0040 -- .b-frame/x STZ2 #0040 ++ .b-frame/x2 STZ2
.Screen/width DEI2 #01 SFT2
DUP2 #0040 SUB2 .a-frame/x STZ2 DUP2 #0040 ADD2 .a-frame/x2 STZ2
DUP2 #0040 SUB2 .b-frame/x STZ2 #0040 ADD2 .b-frame/x2 STZ2
.Screen/height DEI2 2// #0020 --
DUP2 #0010 -- .a-frame/y STZ2 DUP2 #0000 ++ .a-frame/y2 STZ2
DUP2 .b-frame/y STZ2 #0010 ++ .b-frame/y2 STZ2
.Screen/height DEI2 #01 SFT2 #0020 SUB2
DUP2 #0010 SUB2 .a-frame/y STZ2 DUP2 .a-frame/y2 STZ2
DUP2 .b-frame/y STZ2 #0010 ADD2 .b-frame/y2 STZ2
;redraw JSR2
@ -79,7 +52,7 @@ BRK
;draw-cursor JSR2
.Mouse/state DEI #00 ! JMP [ BRK ]
.Mouse/state DEI #00 NEQ JMP [ BRK ]
.Mouse/x DEI2 .Mouse/y DEI2 .a-frame ;within-rect JSR2
;on-touch-a JCN2
@ -90,29 +63,29 @@ BRK
@on-touch-a ( -> )
.Mouse/x DEI2 .a-frame/x LDZ2 --
10// NIP #07 SWP - STH
.Mouse/x DEI2 .a-frame/x LDZ2 SUB2
#04 SFT2 NIP #07 SWP SUB STH
.input/a LDZ
#01 [ STHr #40 SFT ] SFT EOR
.input/a STZ
;redraw JSR2
RELEASE-MOUSE
#00 .Mouse/state DEO
BRK
@on-touch-b ( -> )
.Mouse/x DEI2 .b-frame/x LDZ2 --
10// NIP #07 SWP - STH
.Mouse/x DEI2 .b-frame/x LDZ2 SUB2
#04 SFT2 NIP #07 SWP SUB STH
.input/b LDZ
#01 [ STHr #40 SFT ] SFT EOR
.input/b STZ
;redraw JSR2
RELEASE-MOUSE
#00 .Mouse/state DEO
BRK
@ -127,82 +100,82 @@ BRK
.input/b LDZ #01 ;draw-byte JSR2
.b-frame/x LDZ2 .Screen/x DEO2
.Screen/y DEI2 #000d ++ .Screen/y DEO2
.Screen/y DEI2 #000d ADD2 .Screen/y DEO2
.input LDZ2 AND #03 ;draw-byte JSR2
.b-frame/x LDZ2 .Screen/x DEO2
.Screen/y DEI2 #000d ++ .Screen/y DEO2
.Screen/y DEI2 #000d ADD2 .Screen/y DEO2
.input LDZ2 ORA #03 ;draw-byte JSR2
.b-frame/x LDZ2 .Screen/x DEO2
.Screen/y DEI2 #000d ++ .Screen/y DEO2
.Screen/y DEI2 #000d ADD2 .Screen/y DEO2
.input LDZ2 EOR #03 ;draw-byte JSR2
( labels )
AUTO-X-ADDR
.b-frame/x LDZ2 #0020 -- .Screen/x DEO2
#05 .Screen/auto DEO
.b-frame/x LDZ2 #0020 SUB2 .Screen/x DEO2
;names-icn/and .Screen/addr DEO2
.b-frame/y2 LDZ2 #0004 ++ .Screen/y DEO2
.b-frame/y2 LDZ2 #0004 ADD2 .Screen/y DEO2
,&draw-label JSR
.b-frame/y2 LDZ2 #0014 ++ .Screen/y DEO2
.b-frame/y2 LDZ2 #0014 ADD2 .Screen/y DEO2
,&draw-label JSR
.b-frame/y2 LDZ2 #0024 ++ .Screen/y DEO2
.b-frame/y2 LDZ2 #0024 ADD2 .Screen/y DEO2
,&draw-label JSR
AUTO-NONE
#00 .Screen/auto DEO
RTN
JMP2r
&draw-label
.b-frame/x LDZ2 #0020 -- .Screen/x DEO2
.b-frame/x LDZ2 #0020 SUB2 .Screen/x DEO2
#03 .Screen/sprite DEOk DEOk DEO
RTN
JMP2r
@draw-byte ( value -- )
STH STH
#0800
&loop
DUP #07 SWP -
#07 OVR SUB
STHkr SWP SFT #01 AND OVRr STHr ;draw-bit JSR2
INC GTHk ,&loop JCN
POP2
.Screen/y DEI2 #0003 ++ .Screen/y DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
.Screen/y DEI2 #0003 ADD2 .Screen/y DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
STHr ;draw-hex JSR2
POPr
RTN
JMP2r
@draw-bit ( value color -- )
STH STH
AUTO-X-ADDR
;button-icns/off [ #00 STHkr 20* ++ ] .Screen/addr DEO2
#05 .Screen/auto DEO
;button-icns/off [ #00 STHkr #50 SFT ADD2 ] .Screen/addr DEO2
OVRr STHr .Screen/sprite DEO
OVRr STHr .Screen/sprite DEO
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
.Screen/x DEI2 #0010 -- .Screen/x DEO2
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
.Screen/x DEI2 #0010 SUB2 .Screen/x DEO2
OVRr STHr .Screen/sprite DEO
OVRr STHr .Screen/sprite DEO
AUTO-NONE
.Screen/y DEI2 #0008 -- .Screen/y DEO2
#00 .Screen/auto DEO
.Screen/y DEI2 #0008 SUB2 .Screen/y DEO2
POPr POPr
POP2r
RTN
JMP2r
@draw-hex ( value -- )
AUTO-X
#01 .Screen/auto DEO
DUP #04 SFT ,&draw JSR
#0f AND ,&draw JSR
AUTO-X
#01 .Screen/auto DEO
RTN
JMP2r
&draw
TOS 8** ;font-hex ++ .Screen/addr DEO2
#00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
RTN
JMP2r
@draw-cursor ( -- )
@ -215,26 +188,26 @@ RTN
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
( colorize on state )
#42 [ .Mouse/state DEI #00 ! ] + .Screen/sprite DEO
#42 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
RTN
JMP2r
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
RTN
JMP2r
&skip
POP2 POP2 POPr
#00
RTN
JMP2r
@cursor
80c0 e0f0 f8e0 1000

277
projects/examples/demos/bunnymark.tal Normal file
View File

@ -0,0 +1,277 @@
( bunnymark.tal )
( November 2021, Kira Oakley )
( March 2022, Devine Lu Linvega )
|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
|c0 @Date &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|0000
@frames $2
@last $1
|0100 ( -> )
( set system colors )
#2ce9 .System/r DEO2
#01c0 .System/g DEO2
#2ce5 .System/b DEO2
( interrupts )
;on-frame .Screen/vector DEO2
( draw "FPS:" and "BUNNIES:" and instructions labels )
.Screen/width DEI2 #0046 SUB2 #0008 ;text/fps #42 ;draw-str JSR2
#0004 #0008 ;text/bunnies #42 ;draw-str JSR2
.Screen/width DEI2 #01 SFT2 #0050 SUB2 #0008 ;text/instructions #43 ;draw-str JSR2
#0028 #0008 #0000 ;draw-dec JSR2
( seed prng )
#04 ;rand/a STA
BRK
@on-frame ( -> )
( frames++ )
.frames LDZ2k INC2 ROT STZ2
.Date/second DEI .last LDZ EQU ,&post-fps-update JCN
( fps update )
( update last-secs ) .Date/second DEI .last STZ
( update fps label ) .Screen/width DEI2 #002b SUB2 #0008 .frames LDZ2 ;draw-dec JSR2
( reset frames counter ) #0000 .frames STZ2
&post-fps-update
( mouse input to add/remove bunnies )
.Mouse/state DEI #01 EQU ,&add JCN
.Mouse/state DEI #01 GTH ,&remove JCN
,&done JMP
&add
;add-bunny JSR2 ,&done JMP
&remove
;remove-bunny JSR2 ,&done JMP
&done
( loop from 0 to ;sprite/length to make all ;draw-bunny calls )
[ ;sprite/length LDA2 ] #0000
&loop
EQU2k ,&bail JCN
DUP2 ,draw-bunny JSR
INC2 ,&loop JMP
&bail
POP2 POP2
BRK
@draw-bunny ( idx -- )
( compute the offset to the beginning of this bunny's data )
[ #30 SFT2 ;sprite/array ADD2 ]
( clear the old sprite location )
( top )
[ LDA2k ] #05 SFT2 .Screen/x DEO2
[ INC2k INC2 LDA2 ] #05 SFT2 .Screen/y DEO2
#00 ;draw-sprite JSR2
( move the sprite by its velocity )
[ LDA2k ] [ OVR2 #0004 ADD2 LDA2 ] ADD2 OVR2 STA2
[ INC2k INC2 LDA2 ] [ OVR2 #0006 ADD2 LDA2 ] ADD2 OVR2 INC2 INC2 STA2
( check for right wall collision + bounce x )
[ DUP2 #0004 ADD2 LDA2 ] #0f SFT2 #0001 EQU2 ,&skip-max-x JCN
[ LDA2k ] #05 SFT2 #0008 ADD2 [ .Screen/width DEI2 ] LTH2 ,&skip-max-x JCN
[ DUP2 #0004 ADD2 LDA2 ] #ffff MUL2 [ OVR2 #0004 ADD2 STA2 ]
&skip-max-x
( check for left wall collision + bounce x )
[ LDA2k ] #0f SFT2 #0000 EQU2 ,&skip-min-x JCN
[ DUP2 #0004 ADD2 LDA2 ] #ffff MUL2 [ OVR2 #0004 ADD2 STA2 ]
&skip-min-x
( check for bottom wall collision + bounce y )
[ DUP2 #0006 ADD2 LDA2 ] #0f SFT2 #0001 EQU2 ,&skip-max-y JCN
[ INC2k INC2 LDA2 ] #05 SFT2 #0008 ADD2 [ .Screen/height DEI2 ] LTH2 ,&skip-max-y JCN
[ DUP2 #0006 ADD2 LDA2 ] #ffff MUL2 [ OVR2 #0006 ADD2 STA2 ]
,&skip-gravity JMP
&skip-max-y
( check for top wall collision + bounce x )
[ INC2k INC2 LDA2 ] #0f SFT2 #0000 EQU2 ,&skip-min-y JCN
[ DUP2 #0006 ADD2 LDA2 ] #ffff MUL2 [ OVR2 #0006 ADD2 STA2 ]
,&skip-gravity JMP
&skip-min-y
( apply gravity )
[ DUP2 #0006 ADD2 LDA2 ] #0004 ADD2 OVR2 #0006 ADD2 STA2
&skip-gravity
( draw the sprite )
( top )
[ LDA2k ] #05 SFT2 .Screen/x DEO2
[ INC2 INC2 LDA2 ] #05 SFT2 .Screen/y DEO2
#85 ,draw-sprite ( .. )
JMP
@draw-sprite ( color -- )
#15 .Screen/auto DEO
;bunny-chr .Screen/addr DEO2
.Screen/sprite DEO
#00 .Screen/auto DEO
JMP2r
@add-bunny ( -- )
;sprite/length LDA2
( cap bunny count at 65535 )
DUP2 #ffff EQU2 ,&bail JCN
( compute the offset to the beginning of this new bunny's data )
DUP2 #30 SFT2 ;sprite/array ADD2
( populate the new bunny's x/y/xvel/yvel with random values )
#00 [ ;rand JSR2 ] OVR2 STA2
[ ;rand JSR2 #1f AND ] [ ;rand JSR2 ] OVR2 INC2 INC2 STA2
#00 [ ;rand JSR2 #7f AND ] OVR2 #0004 ADD2 STA2
#00 [ ;rand JSR2 #7f AND ] OVR2 #0006 ADD2 STA2
( pop ptr to bunny data ) POP2
( write new increased array length )
INC2 DUP2 ;sprite/length STA2
( update label )
STH2k #0028 #0008 STH2r ;draw-dec JSR2
&bail
( pop sprite/length ) POP2
JMP2r
@draw-str ( x* y* text* color -- )
#01 .Screen/auto DEO
STH
SWP2 .Screen/y DEO2
SWP2 .Screen/x DEO2
&loop
LDAk #20 SUB #00 SWP #30 SFT2 ;font ADD2 .Screen/addr DEO2
STHkr .Screen/sprite DEO
INC2 LDAk ,&loop JCN
POP2
STHr POP
#00 .Screen/auto DEO
JMP2r
@draw-dec ( x* y* num* -- )
#01 .Screen/auto DEO
SWP2 .Screen/y DEO2
SWP2 .Screen/x DEO2
#2710 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
#03e8 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
#0064 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 NIP
#0a DIVk DUP ,&digit JSR MUL SUB
,&digit JSR
#00 .Screen/auto DEO
JMP2r
&digit ( num -- )
#30 SFT #00 SWP ;font/num ADD2 .Screen/addr DEO2
#41 .Screen/sprite DEO
JMP2r
@remove-bunny ( -- )
;sprite/length LDA2
( don't let length go below 0 )
ORAk #00 EQU ,&bail JCN
( clear the old sprite location )
DUP2 #0001 SUB2 #30 SFT2 ;sprite/array ADD2
( top )
[ LDA2k ] #05 SFT2 .Screen/x DEO2
[ INC2k INC2 LDA2 ] #05 SFT2 .Screen/y DEO2
( clear )
#00 ;draw-sprite JSR2
POP2
#0001 SUB2 DUP2 ;sprite/length STA2
( update label )
STH2k #0028 #0008 STH2r ;draw-dec JSR2
&bail
POP2
JMP2r
( PRNG code taken from flappy.tal -- thanks! )
@rand ( -- number )
( local vars )
#04 JMP
&x $1 &y $1 &z $1 &a $1
( 8-bit PRNG https://github.com/edrosten/8bit_rng )
( t = x ^ (x << 4) )
,&x LDR DUP #40 SFT EOR
( x = y )
,&y LDR ,&x STR
( y = z )
,&z LDR ,&y STR
( z = a )
,&a LDR DUP ,&z STR
( a = z ^ t ^ (z >> 1) ^ (t << 1) )
DUPk ADD EOR SWP DUP #01 SFT EOR EOR
DUP ,&a STR
JMP2r
( static string data )
@text
&fps "FPS: 00
&bunnies "BUNS: 00
&instructions "CLICK 20 "TO 20 "ADD 20 "BUNNIES! 00
@font ( atari8.uf1 )
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
&num
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
@bunny-chr
2466 6600 2424 003c 4200 007e 7e7e 7e7e
1818 3c3c 1800 0000 ff66 4242 667e 4242
( beginning of sprite pixel data + array )
@sprite
&length $2
&array
&x 0600
&y 0500
&xvel 0060
&yvel 0010

134
projects/examples/demos/cube3d.tal Normal file
View File

@ -0,0 +1,134 @@
( Cube3d:
Just a cube, y'know )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0000
@timer $1
@color $1
@cube &v0 $8 &v4 $8
@line &x $2 &y $2 &dx $2 &dy $2 &e1 $2
@center &x $2 &y $2
( program )
|0100 ( -> )
( theme )
#4fcd .System/r DEO2
#4fc3 .System/g DEO2
#dfc2 .System/b DEO2
( center )
.Screen/width DEI2 #01 SFT2 #0040 SUB2 .center/x STZ2
.Screen/height DEI2 #01 SFT2 #0040 SUB2 .center/y STZ2
( begin. )
;on-frame .Screen/vector DEO2
@on-frame ( -> )
#00 ;draw-cube JSR2
.timer LDZk INC SWP STZ
#05 ;draw-cube JSR2
BRK
@draw-cube ( frame color -- )
.color STZ
( create box )
#0800
&loop
STHk
#00 .timer LDZ [ #00 STHkr INC #07 AND #60 SFT ADD2 ] #00ff AND2 ;table ADD2 LDA #01 SFT
#00 .timer LDZ [ #00 STHkr #60 SFT ADD2 ] #00ff AND2 ;table ADD2 LDA #02 SFT [ #00 STHkr #62 SFT2 ADD2 ]
.cube/v0 STHr DUP ADD ADD STZ2
INC GTHk ,&loop JCN
POP2
( vertices )
#0800
&ver-loop
DUP DUP ADD .cube ADD LDZ2 ;draw-vertex JSR2
INC GTHk ,&ver-loop JCN
POP2
( lines )
#0400
&line-loop
STHk
.cube/v0 STHkr DUP ADD ADD .cube/v0 STHkr INC #03 AND DUP ADD ADD ,trace JSR
.cube/v0 STHkr DUP ADD ADD .cube/v4 STHkr DUP ADD ADD ,trace JSR
.cube/v4 STHkr DUP ADD ADD .cube/v4 STHr INC #03 AND DUP ADD ADD ,trace JSR
INC GTHk ,&line-loop JCN
POP2
JMP2r
@trace ( a b -- )
STH STH
#00 STHkr LDZ .center/x LDZ2 ADD2 #00 STHr INC LDZ .center/y LDZ2 ADD2
#00 STHkr LDZ .center/x LDZ2 ADD2 #00 STHr INC LDZ .center/y LDZ2 ADD2
.color LDZ ;draw-line JSR2
JMP2r
@draw-vertex ( x y -- )
#00 SWP #0004 SUB2 .center/y LDZ2 ADD2 .Screen/y DEO2
#00 SWP #0003 SUB2 .center/x LDZ2 ADD2 .Screen/x DEO2
;&icn .Screen/addr DEO2
.color LDZ .Screen/sprite DEO
JMP2r
&icn 0000 387c 7c7c 3800
@draw-line ( x1* y1* x2* y2* color -- )
( load ) STH ,&y STR2 ,&x STR2 .line/y STZ2 .line/x STZ2
,&x LDR2 .line/x LDZ2 SUB2 ;abs2 JSR2 .line/dx STZ2
#0000 ,&y LDR2 .line/y LDZ2 SUB2 ;abs2 JSR2 SUB2 .line/dy STZ2
#ffff #00 .line/x LDZ2 ,&x LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sx STR2
#ffff #00 .line/y LDZ2 ,&y LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sy STR2
.line/dx LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
&loop
.line/x LDZ2 DUP2 .Screen/x DEO2 [ LIT2 &x $2 ] EQU2
.line/y LDZ2 DUP2 .Screen/y DEO2 [ LIT2 &y $2 ] EQU2
STHkr .Screen/pixel DEO
AND ,&end JCN
.line/e1 LDZ2 DUP2 ADD2 DUP2
.line/dy LDZ2 ;lts2 JSR2 ,&skipy JCN
.line/e1 LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
.line/x LDZ2 [ LIT2 &sx $2 ] ADD2 .line/x STZ2
&skipy
.line/dx LDZ2 ;gts2 JSR2 ,&skipx JCN
.line/e1 LDZ2 .line/dx LDZ2 ADD2 .line/e1 STZ2
.line/y LDZ2 [ LIT2 &sy $2 ] ADD2 .line/y STZ2
&skipx
,&loop JMP
&end
POPr
JMP2r
@abs2 DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 SUB2 JMP2r
@lts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r
@gts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r
@table ( 256 xy )
f7f8 f9fa fbfc fcfd fefe ffff ffff ffff
ffff ffff fffe fefd fcfc fbfa f9f8 f7f6
f5f3 f2f0 efed ecea e8e6 e4e2 e0de dcda
d8d5 d3d1 cecc c9c7 c4c1 bfbc b9b6 b3b0
aeab a8a5 a29f 9c98 9592 8f8c 8986 8380
7c79 7673 706d 6a67 6360 5d5a 5754 514f
4c49 4643 403e 3b38 3633 312e 2c2a 2725
2321 1f1d 1b19 1715 1312 100f 0d0c 0a09
0807 0605 0403 0302 0101 0000 0000 0000
0000 0000 0001 0102 0303 0405 0607 0809
0a0c 0d0f 1012 1315 1719 1b1d 1f21 2325
272a 2c2e 3133 3638 3b3e 4043 4649 4c4f
5154 575a 5d60 6367 6a6d 7073 7679 7c7f
8386 898c 8f92 9598 9c9f a2a5 a8ab aeb0
b3b6 b9bc bfc1 c4c7 c9cc ced1 d3d5 d8da
dcde e0e2 e4e6 e8ea eced eff0 f2f3 f5f6

12
projects/examples/demos/drool.tal
View File

@ -8,7 +8,7 @@
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
@ -22,12 +22,12 @@
#00 .DateTime/minute DEI #60 SFT2 EOR2
#00 .DateTime/hour DEI #c0 SFT2 EOR2 ;prng/x STA2
#00 .DateTime/hour DEI #04 SFT2
#00 .DateTime/day DEI #10 SFT2 EOR2
#00 .DateTime/day DEI DUP2 ADD2 EOR2
#00 .DateTime/month DEI #60 SFT2 EOR2
.DateTime/year DEI2 #a0 SFT2 EOR2 ;prng/y STA2
;prng/x LDA2 ;prng/y LDA2 EOR2
;rabbits STH2 #0f05 &loop-x
LIT2r =rabbits #0f05 &loop-x
#0f05 &loop-y
ROTk SWP STH2kr STA2 POP
INC2r INC2r
@ -93,7 +93,7 @@
DUP2 #00 ,set-occupied JSR
;&possible-moves ( x y possible* / addr* )
OVR2 #01 SUB ,&check-move JSR ( up )
OVR2 #01 ADD ,&check-move JSR ( down )
OVR2 INC INC ,&check-move JSR ( down )
OVR2 #0100 SUB2 ,&check-move JSR ( left )
OVR2 #0100 ADD2 ,&check-move JSR ( right )
;&possible-moves SUB2 ( x y num-possible-times-2* / addr* )
@ -160,7 +160,7 @@
( rabbit is in-between two frames )
#08 OVR SUB ,&from-weight STR
,&to-weight STR ( color n / frame )
#00 SWP #10 SFT2 ;rabbits ADD2 #00c8 #00 STHr MUL2 ADD2 ( color from-addr* )
#00 SWP DUP2 ADD2 ;rabbits ADD2 #00c8 #00 STHr MUL2 ADD2 ( color from-addr* )
LDA2k STH2 #00c8 ADD2 LDA2
&draw ( color to-x to-y / from-x from-y )
STHr ,&mix JSR LIT2 &yoffset $2 ADD2 .Screen/y DEO2
@ -181,7 +181,7 @@
&static ( color n counter / frame )
INCr
POP
#00 SWP #10 SFT2 ;rabbits ADD2 #00c8 #00 STHr MUL2 ADD2
#00 SWP DUP2 ADD2 ;rabbits ADD2 #00c8 #00 STHr MUL2 ADD2
LDA2 STH2k
,&draw JMP

726
projects/examples/demos/drum-rack.tal
View File

@ -1,726 +0,0 @@
( drum rack )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2** { #10 SFT2 } %2// { #01 SFT2 }
%4** { #20 SFT2 } %4// { #02 SFT2 }
%8** { #30 SFT2 } %8// { #03 SFT2 }
%10** { #40 SFT2 }
%TOB { NIP } %TOS { #00 SWP }
%RTN { JMP2r }
%MOD { DUP2 / * - }
%LTS2 { #8000 ++ SWP2 #8000 ++ >> } %GTS2 { #8000 ++ SWP2 #8000 ++ << }
%PAD-WIDTH { #0030 }
%PAD-HEIGHT { #0020 }
( devices )
|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 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|40 @Audio1 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|50 @Audio2 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|60 @Audio3 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|70 @Midi [ &vector $2 &channel $1 &note $1 &velocity $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
( variables )
|0000
@center [ &x $2 &y $2 ]
@pointer [ &x $2 &y $2 ]
@piano [ &last $1 &octave $1 ]
@pads [ &last $1 ]
@frame [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@pad-view [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@mix-view [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@oct-view [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@wav-view [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
( TODO: remove )
@color $1
@rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@modes [ $1 $1 $1 $1 ] ( single/repeat )
( program )
|0100 ( -> )
( theme )
#0fe5 .System/r DEO2
#0fc5 .System/g DEO2
#0f25 .System/b DEO2
( vectors )
;on-control .Controller/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-frame .Screen/vector DEO2
;on-message .Console/vector DEO2
( channel defaults )
#dd .Audio0/volume DEO
#0118 .Audio0/adsr DEO2
#0200 .Audio0/length DEO2
#ce .Audio1/volume DEO
#0334 .Audio1/adsr DEO2
#0800 .Audio1/length DEO2
#ec .Audio2/volume DEO
#0414 .Audio2/adsr DEO2
#0800 .Audio2/length DEO2
#ee .Audio3/volume DEO
#022c .Audio3/adsr DEO2
#1000 .Audio3/length DEO2
( defaults )
#01 .modes STZ
#01 .piano/octave STZ
( find center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
( place frame )
.center/x LDZ2 PAD-WIDTH #0003 ** -- #0010 -- .frame/x1 STZ2
.center/y LDZ2 #0050 -- .frame/y1 STZ2
.center/x LDZ2 PAD-WIDTH #0003 ** ++ #0010 ++ .frame/x2 STZ2
.frame/y1 LDZ2 PAD-HEIGHT 4** ++ #0028 ++ .frame/y2 STZ2
( place pad-view )
.frame/x1 LDZ2 .pad-view/x1 STZ2
.frame/y1 LDZ2 .pad-view/y1 STZ2
.pad-view/x1 LDZ2 #0004 PAD-WIDTH ** ++ .pad-view/x2 STZ2
.pad-view/y1 LDZ2 #0004 PAD-HEIGHT ** ++ .pad-view/y2 STZ2
( place mix-view )
.pad-view/x2 LDZ2 #0006 ++ .mix-view/x1 STZ2
.pad-view/y1 LDZ2 .mix-view/y1 STZ2
.mix-view/x1 LDZ2 #007a ++ .mix-view/x2 STZ2
.pad-view/y2 LDZ2 .mix-view/y2 STZ2
( place oct-view )
.frame/x1 LDZ2 .oct-view/x1 STZ2
.mix-view/y2 LDZ2 #0004 ++ .oct-view/y1 STZ2
.oct-view/x1 LDZ2 #0050 ++ .oct-view/x2 STZ2
.oct-view/y1 LDZ2 #0018 ++ .oct-view/y2 STZ2
( place wav-view )
.oct-view/x2 LDZ2 .wav-view/x1 STZ2
.mix-view/y2 LDZ2 #0004 ++ .wav-view/y1 STZ2
.frame/x2 LDZ2 .wav-view/x2 STZ2
.wav-view/y1 LDZ2 #0020 ++ .wav-view/y2 STZ2
( draw outlines )
.mix-view/x1 LDZ2 #0004 --
.mix-view/y1 LDZ2 #0000 --
.mix-view/x2 LDZ2 #0002 --
.mix-view/y2 LDZ2 #0002 --
#01 ;line-rect JSR2
.wav-view/x1 LDZ2 #0000 --
.wav-view/y1 LDZ2 #0002 --
.wav-view/x2 LDZ2 #0002 --
.wav-view/y2 LDZ2 #0002 ++
#01 ;line-rect JSR2
( initial draw )
#00 #10
&draw-pads
( load sample )
OVR TOS #0019 ** ;pad-path ++ .File/name DEO2
OVR #04 / #40 SFT .Audio0/length + DEI2 .File/length DEO2
OVR TOS 2** ;pad-addr ++ LDA2 .File/read DEO2
( draw pad )
OVR #01 ;draw-pad JSR2
( draw mixer )
OVR #04 / ;draw-mixer JSR2
( incr ) SWP INC SWP
LTHk ,&draw-pads JCN
POP2
;draw-octave JSR2
BRK
@on-message ( -> )
.Console/read DEI #0f AND ;play-pad JSR2
BRK
@on-frame ( -> )
( update VU monitors )
#00 #04
&loop
OVR STH
( x ) .mix-view/x1 LDZ2 #0074 ++
( y ) .mix-view/y1 LDZ2 PAD-HEIGHT STHkr TOS ** ++ #0002 ++
( output ) .Audio0/output STHr #40 SFT + DEI
;draw-monitor JSR2
( incr ) SWP INC SWP
LTHk ,&loop JCN
POP2
BRK
@on-mouse ( -> )
;draw-cursor JSR2
.Mouse/state DEI #00 ! #01 JCN [ BRK ]
.Mouse/x DEI2 DUP2 .pad-view/x1 LDZ2 >> ROT ROT .pad-view/x2 LDZ2 INC2 << #0101 ==
.Mouse/y DEI2 DUP2 .pad-view/y1 LDZ2 >> ROT ROT .pad-view/y2 LDZ2 << #0101 ==
#0101 == ;on-touch-pad JCN2
.Mouse/x DEI2 DUP2 .mix-view/x1 LDZ2 >> ROT ROT .mix-view/x2 LDZ2 INC2 << #0101 ==
.Mouse/y DEI2 DUP2 .mix-view/y1 LDZ2 >> ROT ROT .mix-view/y2 LDZ2 << #0101 ==
#0101 == ;on-touch-mix JCN2
.Mouse/x DEI2 DUP2 .oct-view/x1 LDZ2 >> ROT ROT .oct-view/x2 LDZ2 INC2 << #0101 ==
.Mouse/y DEI2 DUP2 .oct-view/y1 LDZ2 >> ROT ROT .oct-view/y2 LDZ2 << #0101 ==
#0101 == ;on-touch-oct JCN2
BRK
@on-control ( -> )
.Controller/key DEI #00 ! #01 JCN [ BRK ]
.Controller/key DEI
DUP #31 ! ,&no-0 JCN #00 ;play-pad JSR2 &no-0
DUP #32 ! ,&no-1 JCN #01 ;play-pad JSR2 &no-1
DUP #33 ! ,&no-2 JCN #02 ;play-pad JSR2 &no-2
DUP #34 ! ,&no-3 JCN #03 ;play-pad JSR2 &no-3
DUP #71 ! ,&no-4 JCN #04 ;play-pad JSR2 &no-4
DUP #77 ! ,&no-5 JCN #05 ;play-pad JSR2 &no-5
DUP #65 ! ,&no-6 JCN #06 ;play-pad JSR2 &no-6
DUP #72 ! ,&no-7 JCN #07 ;play-pad JSR2 &no-7
DUP #61 ! ,&no-8 JCN #08 ;play-pad JSR2 &no-8
DUP #73 ! ,&no-9 JCN #09 ;play-pad JSR2 &no-9
DUP #64 ! ,&no-a JCN #0a ;play-pad JSR2 &no-a
DUP #66 ! ,&no-b JCN #0b ;play-pad JSR2 &no-b
DUP #7a ! ,&no-c JCN #0c ;play-pad JSR2 &no-c
DUP #78 ! ,&no-d JCN #0d ;play-pad JSR2 &no-d
DUP #63 ! ,&no-e JCN #0e ;play-pad JSR2 &no-e
DUP #76 ! ,&no-f JCN #0f ;play-pad JSR2 &no-f
POP
BRK
@on-touch-pad ( -> )
( x ) .Mouse/x DEI2 .pad-view/x1 LDZ2 -- PAD-WIDTH // TOB
( y ) .Mouse/y DEI2 .pad-view/y1 LDZ2 -- PAD-HEIGHT // TOB #20 SFT +
DUP SWP ;play-pad JSR2
;draw-waveform JSR2
( release ) #00 .Mouse/state DEO
BRK
@on-touch-mix ( -> )
( channel ) .Mouse/y DEI2 .mix-view/y1 LDZ2 -- PAD-HEIGHT // TOB STH
( knob ) .Mouse/x DEI2 .mix-view/x1 LDZ2 -- #0010 // TOB
( adsr )
DUP #00 ! ,&no-a JCN
.Audio0/adsr [ STHkr #40 SFT + ] DEI
#10 .Mouse/state DEI #10 = #e0 * + +
.Audio0/adsr [ STHkr #40 SFT + ] DEO &no-a
DUP #01 ! ,&no-d JCN
.Audio0/adsr [ STHkr #40 SFT + ] DEI
DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
.Audio0/adsr [ STHkr #40 SFT + ] DEO &no-d
DUP #02 ! ,&no-s JCN
.Audio0/adsr [ STHkr #40 SFT + ] INC DEI
#10 .Mouse/state DEI #10 = #e0 * + +
.Audio0/adsr [ STHkr #40 SFT + ] INC DEO &no-s
DUP #03 ! ,&no-r JCN
.Audio0/adsr [ STHkr #40 SFT + ] INC DEI
DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
.Audio0/adsr [ STHkr #40 SFT + ] INC DEO &no-r
( modes )
DUP #04 ! ,&no-repeat JCN
.modes [ STHkr + ] LDZ
#00 =
.modes [ STHkr + ] STZ &no-repeat
( volume )
DUP #05 ! ,&no-left JCN
.Audio0/volume [ STHkr #40 SFT + ] DEI
#10 .Mouse/state DEI #10 = #e0 * + +
.Audio0/volume [ STHkr #40 SFT + ] DEO &no-left
DUP #06 ! ,&no-right JCN
.Audio0/volume [ STHkr #40 SFT + ] DEI
DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
.Audio0/volume [ STHkr #40 SFT + ] DEO &no-right
POP
( release ) #00 .Mouse/state DEO
STHkr ;draw-mixer JSR2
POPr
BRK
@on-touch-oct ( -> )
.Mouse/x DEI2 .oct-view/x1 LDZ2 -- 8// TOB #08 ! ,&no-mod JCN
.Mouse/y DEI2 .oct-view/y1 LDZ2 -- 8// TOB
DUP #00 ! ,&no-incr JCN
.piano/octave LDZ INC .piano/octave STZ &no-incr
DUP #02 ! ,&no-decr JCN
.piano/octave LDZ #01 - .piano/octave STZ &no-decr
POP
( release ) #00 .Mouse/state DEO
;draw-octave JSR2
BRK
&no-mod
.Mouse/x DEI2 .oct-view/x1 LDZ2 -- 8// TOB #06 GTH ,&no-key JCN
.Mouse/x DEI2 .oct-view/x1 LDZ2 -- 8//
( set pitch of pad )
DUP2 ;notes ++ LDA .pads/last LDZ SWP .piano/octave LDZ #02 - #0c * +
( save ) SWP TOS ;pad-pitch ++ STA
( record last note )
TOB .piano/last STZ
.pads/last LDZ ;play-pad JSR2
( release ) #00 .Mouse/state DEO
;draw-octave JSR2
&no-key
BRK
@play-pad ( pad -- )
( unselect last )
.pads/last LDZ #01 ;draw-pad JSR2
DUP .pads/last STZ
( highlight )
DUP #02 ;draw-pad JSR2
( addr )
DUP TOS 2** ;pad-addr ++ LDA2 STH2
DUP #04 / #40 SFT .Audio0/addr + STH2r ROT DEO2
( pitch )
DUP TOS ;pad-pitch ++ LDA STH
DUP #04 / .modes + LDZ #00 = #70 SFT STH ADDr
DUP #04 / #40 SFT .Audio0/pitch + STHr SWP DEO
#04 / ;draw-mixer JSR2
RTN
@draw-waveform ( pad -- )
( stash address )
DUP ADD #00 SWP ;pad-addr ++ LDA2 STH2
( clear )
.wav-view/x1 LDZ2 #0002 ++
.wav-view/y1 LDZ2
.wav-view/x2 LDZ2 #0002 --
.wav-view/y2 LDZ2
#00 ;fill-rect JSR2
.wav-view/x1 LDZ2 #0002 ++ .Screen/x DEO2
( waveform )
#00 #e8
&loop
( dotted line )
OVR #01 AND ,&no-dot JCN
.wav-view/y1 LDZ2 #0010 ++ .Screen/y DEO2
#01 .Screen/pixel DEO
&no-dot
OVR TOS 10** [ DUP2r STH2r ] ++ LDA
#02 /
TOS 4// .wav-view/y1 LDZ2 ++ .Screen/y DEO2
.Screen/x DEI2 INC2 .Screen/x DEO2
( draw ) #02 .Screen/pixel DEO
( incr ) SWP INC SWP
LTHk ,&loop JCN
POP2
POP2r
RTN
@draw-mixer ( mixer -- )
STHk #00 SWP PAD-HEIGHT ** .mix-view/y1 LDZ2 ++ #0003 ++
( adsr )
DUP2 .mix-view/x1 LDZ2 SWP2
.Audio0/adsr [ STHkr #40 SFT + ] DEI #04 SFT ;draw-knob JSR2
DUP2 .mix-view/x1 LDZ2 #0010 ++ SWP2
.Audio0/adsr [ STHkr #40 SFT + ] DEI #0f AND ;draw-knob JSR2
DUP2 .mix-view/x1 LDZ2 #0020 ++ SWP2
.Audio0/adsr [ STHkr #40 SFT + ] INC DEI #04 SFT ;draw-knob JSR2
DUP2 .mix-view/x1 LDZ2 #0030 ++ SWP2
.Audio0/adsr [ STHkr #40 SFT + ] INC DEI #0f AND ;draw-knob JSR2
( once/repeat )
DUP2 .mix-view/x1 LDZ2 #0040 ++ SWP2
.modes [ STHkr + ] LDZ ;draw-switch JSR2
( volume )
DUP2 .mix-view/x1 LDZ2 #0050 ++ SWP2
.Audio0/volume [ STHkr #40 SFT + ] DEI #04 SFT ;draw-knob JSR2
DUP2 .mix-view/x1 LDZ2 #0060 ++ SWP2
.Audio0/volume [ STHkr #40 SFT + ] DEI #0f AND ;draw-knob JSR2
POP2
POPr
RTN
@draw-pad ( pad color -- )
STH STH
STHkr
DUP #04 / SWP #03 AND TOS PAD-WIDTH ** ( center ) .pad-view/x1 LDZ2 ++
ROT TOS PAD-HEIGHT ** ( center ) .pad-view/y1 LDZ2 ++
( draw outline )
OVR2 OVR2
OVR2 PAD-WIDTH #0002 -- ++
OVR2 PAD-HEIGHT #0002 -- ++
OVRr STHr ;line-rect JSR2
( draw name )
OVR2 #0002 ++
OVR2 #0002 ++
;pad-name STHkr TOS #0005 ** ++
#00 OVRr STHr +
;draw-label JSR2
( draw note )
OVR2 #0003 ++ .Screen/x DEO2
DUP2 #0014 ++ .Screen/y DEO2
( get pitch ) STHkr TOS ;pad-pitch ++ LDA
#0c / TOS 8** ;font-hex ++ .Screen/addr DEO2
#01 .Screen/sprite DEO
( draw octave )
OVR2 #000b ++ .Screen/x DEO2
DUP2 #0014 ++ .Screen/y DEO2
( get pitch ) STHkr TOS ;pad-pitch ++ LDA
#0c MOD TOS 8** ;font-notes ++ .Screen/addr DEO2
#01 .Screen/sprite DEO
POP2 POP2
POPr POPr
RTN
@draw-octave ( -- )
.oct-view/x1 LDZ2 .oct-view/y1 LDZ2
OVR2 OVR2 ;keys-left-icns #01 .piano/last LDZ #00 = + ;draw-key JSR2
OVR2 #0008 ++ OVR2 ;keys-middle-icns #01 .piano/last LDZ #01 = + ;draw-key JSR2
OVR2 #0010 ++ OVR2 ;keys-right-icns #01 .piano/last LDZ #02 = + ;draw-key JSR2
OVR2 #0018 ++ OVR2 ;keys-left-icns #01 .piano/last LDZ #03 = + ;draw-key JSR2
OVR2 #0020 ++ OVR2 ;keys-middle-icns #01 .piano/last LDZ #04 = + ;draw-key JSR2
OVR2 #0028 ++ OVR2 ;keys-middle-icns #01 .piano/last LDZ #05 = + ;draw-key JSR2
SWP2 #0030 ++ SWP2 ;keys-right-icns #01 .piano/last LDZ #06 = + ;draw-key JSR2
.oct-view/x1 LDZ2 #0040 ++ .Screen/x DEO2
;arrow-icns .Screen/addr DEO2
.oct-view/y1 LDZ2 .Screen/y DEO2
#01 .Screen/sprite DEO
;arrow-icns #0008 ++ .Screen/addr DEO2
.oct-view/y1 LDZ2 #0010 ++ .Screen/y DEO2
#01 .Screen/sprite DEO
;font-hex .piano/octave LDZ #03 + #00 SWP 8** ++ .Screen/addr DEO2
.oct-view/y1 LDZ2 #0008 ++ .Screen/y DEO2
#03 .Screen/sprite DEO
RTN
@draw-monitor ( x* y* stereo -- )
STH
.Screen/y DEO2
.Screen/x DEO2
#00 #0f
&loop
OVR #10 SWP - STHkr #0f AND < INC .Screen/pixel DEO
.Screen/x DEI2 #0002 ++ .Screen/x DEO2
OVR #10 SWP - STHkr #04 SFT < INC .Screen/pixel DEO
.Screen/x DEI2 #0002 -- .Screen/x DEO2
.Screen/y DEI2 #0002 ++ .Screen/y DEO2
( incr ) SWP INC SWP
LTHk ,&loop JCN
POP2
POPr
RTN
@draw-key ( x* y* addr* color -- )
STH
.Screen/addr DEO2
SWP2 .Screen/x DEO2
DUP2 #0018 ++
&loop
( move ) OVR2 .Screen/y DEO2
( draw ) STHkr .Screen/sprite DEO
( incr ) .Screen/addr DEI2 #0008 ++ .Screen/addr DEO2
( incr ) SWP2 #0008 ++ SWP2
LTH2k ,&loop JCN
POP2 POP2
POPr
RTN
@draw-cursor ( -- )
( clear last cursor )
;cursor-icn .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( record pointer positions )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
( colorize on state )
#43 [ .Mouse/state DEI #00 ! ] - .Screen/sprite DEO
RTN
@draw-knob ( x* y* value -- )
( load ) STH .Screen/y DEO2 .Screen/x DEO2
;knob-icns .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
;knob-icns #0008 ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
;knob-icns #0018 ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0008 -- .Screen/x DEO2
;knob-icns #0010 ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0004 ++ .Screen/x DEO2
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
;font-hex #00 STHkr #30 SFT ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0004 -- #00 #00 STHkr ;knob-offsetx ++ LDA ++ .Screen/x DEO2
.Screen/y DEI2 #0010 -- #00 #00 STHr ;knob-offsety ++ LDA ++ .Screen/y DEO2
;knob-icns #0020 ++ .Screen/addr DEO2
( draw ) #05 .Screen/sprite DEO
RTN
@draw-switch ( x* y* value -- )
STH .Screen/y DEO2 .Screen/x DEO2
STHkr #50 SFT #00 SWP ;switch-icns ++
DUP2 .Screen/addr DEO2
( draw ) #01 STHkr + .Screen/sprite DEO
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
DUP2 #0008 ++ .Screen/addr DEO2
( draw ) #01 STHkr + .Screen/sprite DEO
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
.Screen/x DEI2 #0008 -- .Screen/x DEO2
DUP2 #0010 ++ .Screen/addr DEO2
( draw ) #01 STHkr + .Screen/sprite DEO
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
#0018 ++ .Screen/addr DEO2
( draw ) #01 STHr + .Screen/sprite DEO
RTN
@line-rect ( x1* y1* x2* y2* color -- )
( load ) .color STZ STH2k .rect/y2 STZ2 .rect/x2 STZ2 STH2k .rect/y1 STZ2 .rect/x1 STZ2
STH2r INC2 STH2r
&ver
( save ) OVR2 .Screen/y DEO2
( draw ) .rect/x1 LDZ2 .Screen/x DEO2 .color LDZ DUP .Screen/pixel DEO
( draw ) .rect/x2 LDZ2 .Screen/x DEO2 .Screen/pixel DEO
( incr ) SWP2 INC2 SWP2
OVR2 OVR2 LTS2 ,&ver JCN
POP2 POP2
.rect/x1 LDZ2 INC2 .rect/x2 LDZ2 #0001 --
&hor
( save ) OVR2 .Screen/x DEO2
( draw ) .rect/y1 LDZ2 .Screen/y DEO2 .color LDZ DUP .Screen/pixel DEO
( draw ) .rect/y2 LDZ2 .Screen/y DEO2 .Screen/pixel DEO
( incr ) SWP2 INC2 SWP2
OVR2 OVR2 INC2 LTS2 ,&hor JCN
POP2 POP2
RTN
@draw-label ( x* y* addr* color -- )
( load ) STH STH2 .Screen/y DEO2 .Screen/x DEO2
STH2r
&loop
LDAk #00 SWP #0030 -- 8** ;font-num-uc ++ .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
( incr ) INC2
( incr ) .Screen/x DEI2 #0008 ++ .Screen/x DEO2
LDAk #00 ! ,&loop JCN
POP2
POPr
RTN
@fill-rect ( x1* y1* x2* y2* color -- )
.color STZ
( x1 x2 y1 y2 ) ROT2 SWP2
&ver
( save ) OVR2 .Screen/y DEO2
STH2 STH2 OVR2 OVR2
&hor
( save ) OVR2 .Screen/x DEO2
( draw ) .color LDZ .Screen/pixel DEO
( incr ) SWP2 INC2 SWP2
OVR2 OVR2 LTS2 ,&hor JCN
POP2 POP2 STH2r STH2r
( incr ) SWP2 INC2 SWP2
OVR2 OVR2 LTS2 ,&ver JCN
POP2 POP2 POP2 POP2
RTN
@pad-name [
"PAD1 $1 "SYN1 $1 "SYN2 $1 "CYM1 $1 ( short )
"HHAT $1 "OHAT $1 "CHAT $1 "RIDE $1
"SID1 $1 "SNR1 $1 "SNR2 $1 "SID2 $1 ( long )
"BDR1 $1 "KCK1 $1 "KCK2 $1 "SUB1 $1 ]
@pad-addr [
6000 6400 6800 6c00
7000 7800 8000 8800
9000 9800 a000 a800
b000 c000 d000 e000 $2 ]
@pad-pitch [
30 30 30 30
30 30 30 30
30 30 30 30
30 30 30 30 ]
@pad-path [
"projects/sounds/pad1.pcm $1 "projects/sounds/syn1.pcm $1 "projects/sounds/syn2.pcm $1 "projects/sounds/pad2.pcm $1
"projects/sounds/hhat.pcm $1 "projects/sounds/ohat.pcm $1 "projects/sounds/chat.pcm $1 "projects/sounds/ride.pcm $1
"projects/sounds/sid1.pcm $1 "projects/sounds/snr1.pcm $1 "projects/sounds/snr2.pcm $1 "projects/sounds/sid2.pcm $1
"projects/sounds/bdr1.pcm $1 "projects/sounds/kck1.pcm $1 "projects/sounds/kck2.pcm $1 "projects/sounds/sub1.pcm $1 ]
@notes [
3c 3e 40 41 43 45 47
48 4a 4c 4d 4f 51 53 ]
@cursor-icn [
80c0 e0f0 f8e0 1000 ]
@keys-left-icns [
7c7c 7c7c 7c7c 7c7c
7c7c 7c7c 7c7c 7e7f
7f7f 7f7f 7f7f 3e00 ]
@keys-middle-icns [
1c1c 1c1c 1c1c 1c1c
1c1c 1c1c 1c1c 3e7f
7f7f 7f7f 7f7f 3e00 ]
@keys-right-icns [
1f1f 1f1f 1f1f 1f1f
1f1f 1f1f 1f1f 3f7f
7f7f 7f7f 7f7f 3e00 ]
@arrow-icns [
0010 387c fe10 1000
0010 1010 fe7c 3810 ]
@switch-icns [
001f 2040 4040 4040
00f8 0402 0202 0202
404f 5f5f 4f20 1f00
02f2 fafa f204 f800
001f 204f 5f5f 4f40
00f8 04f2 fafa f202
4040 4040 4020 1f00
0202 0202 0204 f800 ]
@knob-icns [
0003 0c10 2020 4040
00c0 3008 0404 0202
4040 2020 100c 0300
0202 0404 0830 c000
0000 183c 3c18 0000 ]
@knob-offsetx [
01 00 00 00 00 01 02 03
05 06 07 08 08 08 08 07 ]
@knob-offsety [
07 06 05 03 02 01 00 00
00 00 01 02 03 05 06 07 ]
@font-notes [
003e 4140 4040 413e 40ae 4100 4040 413e
007e 4141 4141 417e 40ae 4101 4141 417e
003e 4140 7c40 413e 003f 4040 7e40 4040
40af 4000 7e40 4040 003e 4140 5f41 413e
40ae 4100 5f41 413e 003e 4141 7f41 4141
40ae 4101 7f41 4141 007e 4141 7e41 417e
]
@font-hex ( 0-F )
[
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
007c 8280 fc82 827c 007c 8202 1e02 0202
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
]
@font-num-uc [
003e 4141 4141 413e 0018 0808 0808 081c
003e 4101 3e40 407f 003e 4101 1f01 413e
0011 2141 7f01 0101 007f 4040 7e01 413e
003e 4140 7e41 413e 003e 4101 0102 0408
003e 4141 3e41 413e 003e 4141 3f01 0102
0000 0800 0000 0800 0000 0800 0000 0800
0000 0800 0000 0810 0000 0408 1008 0400
0000 001c 001c 0000 0000 1008 0408 1000
0000 0000 0000 0000 003e 4101 3f41 413f
007e 4141 7e41 417e 003e 4140 4040 413e
007e 4141 4141 417e 007f 4040 7e40 407f
007f 4040 7e40 4040 003e 4140 5e41 413e
0041 4141 7f41 4141 0008 0808 0808 0808
007f 0101 0101 413e 0041 4244 7844 4241
0040 4040 4040 403f 0076 4949 4949 4949
005e 6141 4141 4141 003e 4141 4141 413e
007e 4141 7e40 4040 003e 4141 4145 423d
007e 4141 7e41 4141 003e 4140 3e01 413e
007f 0808 0808 0808 0041 4141 4141 433d
0041 4141 4122 1408 0049 4949 4949 4976
0041 2214 0814 2241 0041 4141 3f01 413e
007f 0101 3e40 407f ]

64
projects/examples/demos/dvd.tal Normal file
View File

@ -0,0 +1,64 @@
( DVD Bounce )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0000
@dvd &x $2 &y $2 &dx $1 &dy $1
|0100 ( -> )
( theme )
#4cfd .System/r DEO2
#4cf3 .System/g DEO2
#dcf2 .System/b DEO2
( vectors )
;on-frame .Screen/vector DEO2
( starting position )
.Screen/width DEI2 #01 SFT2 .dvd/x STZ2
.Screen/height DEI2 #01 SFT2 .dvd/y STZ2
( set collisions )
.Screen/width DEI2 #0020 SUB2 ;on-frame/hit-hor STA2
.Screen/height DEI2 #0010 SUB2 ;on-frame/hit-ver STA2
( drawing mode )
#36 .Screen/auto DEO
#01 ,draw-dvd JSR
BRK
@on-frame ( -> )
#00 ,draw-dvd JSR
( x )
.dvd/x LDZ2
STH2k #0000 EQU2 ,&flip-x JCN
STH2kr [ LIT2 &hit-hor $2 ] EQU2 ,&flip-x JCN
&no-x
STH2r [ #00 .dvd/dx LDZ ] DUP2 ADD2 ADD2 #ffff ADD2 .dvd/x STZ2
( y )
.dvd/y LDZ2
STH2k #0000 EQU2 ,&flip-y JCN
STH2kr [ LIT2 &hit-ver $2 ] EQU2 ,&flip-y JCN
&no-y
STH2r [ #00 .dvd/dy LDZ ] DUP2 ADD2 ADD2 #ffff ADD2 .dvd/y STZ2
#01 ,draw-dvd JSR
BRK
&flip-x .dvd/dx LDZk #00 EQU SWP STZ ,&no-x JMP
&flip-y .dvd/dy LDZk #00 EQU SWP STZ ,&no-y JMP
@draw-dvd ( color -- )
;dvd_icn .Screen/addr DEO2
.dvd/x LDZ2 .Screen/x DEO2
.dvd/y LDZ2 .Screen/y DEO2
.Screen/sprite DEOk DEO
JMP2r
@dvd_icn ( 4 x 2 )
001f 3f38 3838 787f 00fe fe7e 7777 e3c3
000f 1f3b 7b77 e7c7 00fc fe8f 8707 0efc
7f00 000f ff7f 0700 0301 00ff f0f8 ff00
8700 00ff 7f7f ff00 f000 00e0 fcfc 8000

501
projects/examples/demos/life.tal
View File

@ -1,356 +1,279 @@
( Game Of Life
( Game Of Life:
Any live cell with fewer than two live neighbours dies, as if by underpopulation.
Any live cell with two or three live neighbours lives on to the next generation.
Any live cell with more than three live neighbours dies, as if by overpopulation.
Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction. )
%+ { ADD } %- { SUB }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2/ { #01 SFT }
%8/ { #03 SFT }
%2// { #01 SFT2 } %8// { #03 SFT2 }
%2** { #10 SFT2 } %8** { #30 SFT2 }
%40** { #60 SFT2 }
%8MOD { #07 AND } %2MOD { #01 AND }
%TOS { #00 SWP }
%RTN { JMP2r }
%SFL { #40 SFT SFT }
%WIDTH { #40 } %HEIGHT { #40 }
%WIDTH-MOD { #3f AND } %HEIGHT-MOD { #3f AND }
%IN-RANGE { INCk SWP SUB2 GTH }
%BANK1 { #8000 } %BANK2 { #a000 }
%GET-SIZE { WIDTH TOS 8// 40** }
%GET-ITERATORS { SWP2k POP NIP }
%GET-ITER { OVR2 NIP OVR SWP }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
( variables )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
|0000
@world [ &frame $1 &count $2 ]
@anchor [ &x $2 &y $2 ]
@pointer [ &x $2 &y $2 ]
@rle [ &x $1 &y $1 &n $1 ]
( program )
@world &frame $1 &count $2
@anchor &x $2 &y $2 &x2 $2 &y2 $2
@pointer &x $2 &y $2
|0100 ( -> )
( theme )
#02cf .System/r DEO2
#02ff .System/g DEO2
( theme )
#02cf .System/r DEO2
#02ff .System/g DEO2
#024f .System/b DEO2
( resize )
#00c0 .Screen/width DEO2
#00c0 .Screen/height DEO2
( vectors )
;on-input .Console/vector DEO2
;on-frame .Screen/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-frame .Screen/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-control .Controller/vector DEO2
( glider )
#07 #03 ;set-cell JSR2
#07 #04 ;set-cell JSR2
#05 #04 ;set-cell JSR2
#07 #05 ;set-cell JSR2
#06 #05 ;set-cell JSR2
.Screen/width DEI2 2// WIDTH TOS -- .anchor/x STZ2
.Screen/height DEI2 2// HEIGHT TOS -- .anchor/y STZ2
BRK
@on-frame-paused ( -> )
#0703 ;set-cell JSR2
#0704 ;set-cell JSR2
#0504 ;set-cell JSR2
#0705 ;set-cell JSR2
#0605 ;set-cell JSR2
( center )
.Screen/width DEI2 #01 SFT2 #0040 SUB2
DUP2 .anchor/x STZ2
#007e ADD2 .anchor/x2 STZ2
.Screen/height DEI2 #01 SFT2 #0040 SUB2
DUP2 .anchor/y STZ2
#007e ADD2 .anchor/y2 STZ2
BRK
@on-frame ( -> )
.Mouse/state DEI #00 = #01 JCN [ BRK ]
( incr frame ) .world/frame LDZ INC [ DUP ] .world/frame STZ
( reset count ) #0000 .world/count STZ2
#03 AND #00 = #01 JCN [ BRK ]
( clear buffer )
BANK2 STH2k GET-SIZE ++ STH2r
&clear-loop
DUP2 #0000 SWP2 STA2
INC2 INC2 GTH2k ,&clear-loop JCN
POP2 POP2
( run grid )
#00 HEIGHT
&ver
#00 WIDTH
&hor
GET-ITERATORS
( x y ) DUP2
( neighbours ) DUP2 ;get-neighbours JSR2
( state ) ROT ROT ;get-cell JSR2
,run-cell JSR
SWP INC SWP
LTHk ,&hor JCN
POP2
SWP INC SWP
LTHk ,&ver JCN
POP2
( move buffer )
BANK2 DUP2 GET-SIZE ++ SWP2
&copy-loop
DUP2 LDA2k
SWP2 #2000 -- STA2
INC2 INC2 GTH2k ,&copy-loop JCN
POP2 POP2
;draw-grid JSR2
.Mouse/state DEI #00 EQU #01 JCN [ BRK ]
#0000 .world/count STZ2
.world/frame LDZ INC
DUP .world/frame STZ
#03 AND #00 EQU #01 JCN [ BRK ]
;run JSR2
&paused
BRK
@run-cell ( x y neighbours state -- )
#00 = ,&dead JCN
&alive
DUP #02 < ,&dies JCN
DUP #03 > ,&dies JCN
&lives POP ,save-cell JSR RTN
&dies POP POP2 RTN
&dead
DUP #03 = ,&birth JCN POP POP2 RTN
&birth POP ,save-cell JSR RTN
RTN
@save-cell ( x y -- )
( get index )
HEIGHT-MOD SWP WIDTH-MOD SWP
TOS 8** ROT 8/ TOS ++ [ BANK2 ++ ]
( incr count )
.world/count LDZ2 INC2 .world/count STZ2
( save in buffer )
STH2
DUP2 POP 8MOD #01 SWP SFL
LDAkr STHr SWP ORA
STH2r STA
RTN
@on-mouse ( -> )
( clear last cursor )
;cursor .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
;cursor .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( record pointer positions )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
( colorize on state )
#42 [ .Mouse/state DEI #00 ! ] + .Screen/sprite DEO
.Mouse/state DEI #00 ! #01 JCN [ BRK ]
.Mouse/x DEI2 DUP2 .anchor/x LDZ2 >> ROT ROT .anchor/x LDZ2 WIDTH DUP ADD TOS ++ INC2 << #0101 ==
.Mouse/y DEI2 DUP2 .anchor/y LDZ2 >> ROT ROT .anchor/y LDZ2 HEIGHT DUP ADD TOS ++ << #0101 ==
#0101 == #01 JCN [ BRK ]
.Mouse/x DEI2 .anchor/x LDZ2 SUB2 2/ NIP
.Mouse/y DEI2 .anchor/y LDZ2 SUB2 2/ NIP
;set-cell JSR2
#42 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
( on touch in rect )
.Mouse/state DEI #00 NEQ #01 JCN [ BRK ]
.Mouse/x DEI2 .Mouse/y DEI2 .anchor ;within-rect JSR2 JMP [ BRK ]
( paint )
.Mouse/x DEI2 .anchor/x LDZ2 SUB2 #01 SFT NIP
.Mouse/y DEI2 .anchor/y LDZ2 SUB2 #01 SFT NIP
;set-cell JSR2
( draw )
;draw-grid JSR2
BRK
@on-control ( -> )
.Controller/key DEI #00 ! #01 JCN [ BRK ]
.Controller/key DEI #20 ! ,&no-toggle JCN
( toggle play )
.Controller/key DEI #20 NEQ ,&no-toggle JCN
;on-frame
.Screen/vector DEI2 ;on-frame-paused == ,&swap JCN
POP2 ;on-frame-paused
.Screen/vector DEI2 ;on-frame/paused EQU2 ,&swap JCN
POP2 ;on-frame/paused
&swap
.Screen/vector DEO2
&no-toggle
( clear on home )
.Controller/button DEI #08 NEQ ,&no-reset JCN
;bank1 #0400 ;mclr JSR2
&no-reset
BRK
@run ( -- )
( clear buffer )
;bank2 #1000 ;mclr JSR2
( run grid )
#4000
&ver
STHk
#4000
&hor
DUP STHkr ,run-cell JSR
INC GTHk ,&hor JCN
POP2
POPr
INC GTHk ,&ver JCN
POP2
( move buffer )
;bank2 ;bank1 #1000 ;mcpy JSR2
( draw )
;draw-grid ( .. )
JMP2
@run-cell ( x y -- )
( x y ) DUP2k
( neighbours ) ;get-neighbours JSR2
( state ) ROT ROT ;get-cell JSR2
#00 EQU ,&dead JCN
DUP #02 LTH ,&dies JCN
DUP #03 GTH ,&dies JCN
POP ;&save JMP2
&dies POP POP2 JMP2r
&dead
DUP #03 EQU ,&birth JCN POP POP2 JMP2r
&birth POP ;&save ( .. )
JMP2
&save ( x y -- )
STH2 #01 STH2r ,get-index JSR [ #1000 ADD2 ] STA
.world/count LDZ2 INC2 .world/count STZ2
JMP2r
@get-index ( x y -- index* )
( y ) #3f AND #00 SWP #60 SFT2
( x ) ROT #3f AND #00 SWP ADD2
;bank1 ADD2
JMP2r
@set-cell ( x y -- )
STH2 #01 STH2r ,get-index JSR STA
JMP2r
@get-cell ( x y -- cell )
,get-index JSR LDA
JMP2r
@get-neighbours ( x y -- neighbours )
,&origin STR2
LITr 00
#0800
&loop
#00 OVRk ADD2 ;&mask ADD2 LDA2 [ LIT2 &origin $2 ]
ROT ADD STH ADD STHr ;get-cell JSR2 STH ADDr
INC GTHk ,&loop JCN
POP2
STHr
JMP2r
&mask ffff 00ff 01ff ff00 0100 ff01 0001 0101
@draw-grid ( -- )
( draw cell count )
.anchor/x LDZ2 .Screen/x DEO2
.anchor/y LDZ2 HEIGHT DUP ADD TOS ++ .Screen/y DEO2
.world/count LDZ2 #03 ;draw-short JSR2
HEIGHT #00
.anchor/y2 LDZ2 #0008 ADD2 .Screen/y DEO2
#01 .Screen/auto DEO
.world/count LDZ2 ;draw-short JSR2
#00 .Screen/auto DEO
#4000
&ver
DUP TOS 2** .anchor/y LDZ2 ++ .Screen/y DEO2
WIDTH #00
#00 OVRk ADD2 .anchor/y LDZ2 ADD2 .Screen/y DEO2
STHk
#4000
&hor
DUP TOS 2** .anchor/x LDZ2 ++ .Screen/x DEO2
GET-ITER ,get-cell JSR INC .Screen/pixel DEO
#00 OVRk ADD2 .anchor/x LDZ2 ADD2 .Screen/x DEO2
DUP STHkr ;get-cell JSR2 INC .Screen/pixel DEO
INC GTHk ,&hor JCN
POP2
POPr
INC GTHk ,&ver JCN
POP2
RTN
JMP2r
@get-index ( x y -- index* )
@draw-short ( short* -- )
SWP ,draw-byte JSR
@draw-byte ( byte color -- )
DUP #04 SFT ,draw-hex JSR #0f AND
@draw-hex ( char color -- )
#00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
#03 .Screen/sprite DEO
JMP2r
@within-rect ( x* y* rect -- flag )
HEIGHT-MOD SWP WIDTH-MOD SWP
TOS 8** ROT 8/ TOS ++ [ BANK1 ++ ]
STH
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
JMP2r
&skip
POP2 POP2 POPr
#00
RTN
JMP2r
@set-cell ( x y -- )
DUP2 ,get-index JSR STH2
POP 8MOD #01 SWP SFL
LDAkr STHr SWP ORA
STH2r STA
@mclr ( addr* len* -- )
RTN
OVR2 ADD2 SWP2
&loop
STH2k #00 STH2r STA
INC2 GTH2k ,&loop JCN
POP2 POP2
@unset-cell ( x y -- )
DUP2 ,get-index JSR STH2
POP 8MOD #01 SWP SFL #ff EOR
LDAkr STHr SWP AND
STH2r STA
JMP2r
RTN
@mcpy ( src* dst* len* -- )
@get-cell ( x y -- cell )
DUP2 ,get-index JSR LDA
NIP SWP
8MOD
SFT 2MOD
SWP2 STH2
OVR2 ADD2 SWP2
&loop
LDAk STH2kr STA INC2r
INC2 GTH2k ,&loop JCN
POP2 POP2
POP2r
RTN
JMP2r
@get-neighbours ( x y -- neighbours )
( -1,-1 ) DUP2 #01 - [ SWP #01 - SWP ] ,get-cell JSR STH
( 0,-1 ) DUP2 #01 - ,get-cell JSR STH ADDr
( +1,-1 ) DUP2 #01 - [ SWP INC SWP ] ,get-cell JSR STH ADDr
( -1, 0 ) DUP2 [ SWP #01 - SWP ] ,get-cell JSR STH ADDr
( +1, 0 ) DUP2 [ SWP INC SWP ] ,get-cell JSR STH ADDr
( -1,+1 ) DUP2 INC [ SWP #01 - SWP ] ,get-cell JSR STH ADDr
( 0,+1 ) DUP2 INC ,get-cell JSR STH ADDr
( +1,+1 ) INC [ SWP INC SWP ] ,get-cell JSR STH ADDr
STHr
RTN
@draw-short ( short* color -- )
STH SWP
DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHr .Screen/sprite DEO
RTN
@on-input ( -> )
,&main JSR
BRK
&main
.Console/read DEI #20 GTH JMP JMP2r ( ignore whitespace )
.Console/read DEI LIT 'b EQU ,unset-run JCN
.Console/read DEI LIT 'o EQU ,set-run JCN
.Console/read DEI LIT '$ EQU ,input-eol JCN
.Console/read DEI LIT '! EQU ,input-eop JCN
LIT2 '0 '9 .Console/read DEI IN-RANGE ,input-number JCN
;on-ignore-until-eol .Console/vector DEO2
JMP2r
@unset-run ( -- )
;unset-cell ,run JMP ( tail call )
@set-run ( -- )
;set-cell ( fall through )
@run ( cell-fn* -- )
STH2
;on-frame-paused .Screen/vector DEO2
.rle/n LDZk #00 ROT STZ
DUP #00 NEQ JMP INC
&loop ( count / cell-fn* )
DUP #00 EQU ,&end JCN
.rle/x LDZ .rle/y LDZ STH2kr JSR2
.rle/x LDZk INC SWP STZ
#01 SUB
,&loop JMP
&end
POP POP2r
JMP2r
@input-number ( -- )
.rle/n LDZk #0a MUL
.Console/read DEI LIT '0 SUB
ADD SWP STZ
JMP2r
@input-eol ( -- )
WIDTH .rle/x LDZ SUB .rle/n STZ
,unset-run JSR
#00 .rle/x STZ
.rle/y LDZk INC SWP STZ
JMP2r
@input-eop ( -- )
,input-eol JSR
HEIGHT .rle/y LDZ GTH ,input-eop JCN
;on-frame .Screen/vector DEO2
#00 .rle/y STZ
BRK
@on-ignore-until-eol ( -> )
.Console/read DEI #0a EQU JMP BRK
;on-input .Console/vector DEO2
BRK
@cursor
@cursor
80c0 e0f0 f8e0 1000
@font-hex
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
007c 8280 fc82 827c 007c 8202 1e02 0202
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
7c82 8282 8282 7c00
3010 1010 1010 3800
7c82 027c 8080 fe00
7c82 021c 0282 7c00
2242 82fe 0202 0200
fe80 807c 0282 7c00
7c82 80fc 8282 7c00
fe82 0408 0810 1000
7c82 827c 8282 7c00
7c82 827e 0202 0200
7c82 82fe 8282 8200
fc82 82fc 8282 fc00
7c82 8080 8082 7c00
fc82 8282 8282 fc00
fe80 80f0 8080 fe00
fe80 80f0 8080 8000
@bank1 $1000 @bank2

104
projects/examples/demos/mandelbrot.tal Normal file
View File

@ -0,0 +1,104 @@
( mandelbrot )
%GTS2 { #8000 ADD2 SWP2 #8000 ADD2 LTH2 }
%AUTO-X { #01 .Screen/auto DEO }
%NEXT-LINE { #0000 .Screen/x DEO2 .Screen/y DEI2k INC2 ROT DEO2 }
%WIDTH { #0280 }
%HEIGHT { #01e0 }
%XMIN { #de69 } ( -8601 )
%XMAX { #0b33 } ( 2867 )
%YMIN { #ecc7 } ( -4915 )
%YMAX { #1333 } ( 4915 )
%MAXI { #20 } ( 32 )
%DX { XMAX XMIN SUB2 WIDTH DIV2 } ( (XMAX-XMIN)/W )
%DY { YMAX YMIN SUB2 HEIGHT DIV2 } ( (YMAX-YMIN)/H )
%X { .x LDZ2 } %Y { .y LDZ2 }
%X2 { .x2 LDZ2 } %Y2 { .y2 LDZ2 }
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0000 ( zero-page )
@x $2 @y $2
@x2 $2 @y2 $2
|0100 ( -> )
( theme )
#0f0f .System/r DEO2
#0ff0 .System/g DEO2
#00ff .System/b DEO2
WIDTH .Screen/width DEO2 ( 640 )
HEIGHT .Screen/height DEO2 ( 480 )
AUTO-X
;draw-mandel JSR2
BRK
@draw-mandel ( -- )
YMAX YMIN
&ver
DUP2 ,&y STR2
XMAX XMIN
&hor
DUP2 ,&x STR2
#0000 DUP2k DUP2 .x STZ2 .y STZ2 .x2 STZ2 .y2 STZ2
MAXI #00
&loop
X Y ;smul2 JSR2 DUP2 ADD2 [ LIT2 &y $2 ] ADD2 .y STZ2
X2 Y2 SUB2 [ LIT2 &x $2 ] ADD2 .x STZ2
X DUP2 ;smul2 JSR2 .x2 STZ2
Y DUP2 ;smul2 JSR2 .y2 STZ2
X2 Y2 ADD2 #4000 GTH2 ,&end JCN
INC GTHk ,&loop JCN
&end
NIP .Screen/pixel DEO
DX ADD2 OVR2 OVR2 GTS2 ;&hor JCN2
POP2 POP2
NEXT-LINE
DY ADD2 OVR2 OVR2 GTS2 ;&ver JCN2
POP2 POP2
JMP2r
@smul2 ( a* b* -- c* )
LITr 00
DUP2 #8000 LTH2 ,&b-positive JCN
INCr DUP2k EOR2 SWP2 SUB2
&b-positive
SWP2
DUP2 #8000 LTH2 ,&a-positive JCN
INCr DUP2k EOR2 SWP2 SUB2
&a-positive
( ahi alo bhi blo )
LITr 00 STH ( ahi alo bhi / blo* )
OVRr STH ( ahi alo / blo* bhi* )
OVRr STH ( ahi / blo* bhi* alo* )
OVRr STH ( asign / blo* bhi* alo* ahi* )
ROT2r MUL2kr STH2r ( asign ahi-bhi* / blo* alo* ahi* bhi* )
ROT2r MUL2kr STH2r ( asign ahi-bhi* alo-bhi* / blo* ahi* bhi* alo* )
NIP2r ( asign ahi-bhi* alo-bhi* / blo* ahi* alo* )
ROT2r MUL2kr STH2r ( asign ahi-bhi* alo-bhi* alo-blo* / ahi* alo* blo* )
ROT2r MUL2r STH2r POP2r ( asign ahi-bhi* alo-bhi* alo-blo* ahi-blo* )
SWP2 ( asign ahi-bhi* alo-bhi* ahi-blo* alo-blo* )
( 32-bit result is [ r3 r2 r1 r0 ] )
POP #00 SWP ( asign ahi-bhi* alo-bhi* ahi-blo* r21* )
( r21 max is 00fe, ahi-blo max is 7e81, max sum is 7f7f )
ADD2 ( asign ahi-bhi* alo-bhi* r21'* )
( r21' max is 7f7f, alo-bhi max is 7e81, max sum is fe00 )
ADD2 ( asign ahi-bhi* r21"* )
( The result we want is bits 27-12 due to the fixed point representation we use. )
#04 SFT2 SWP2 #40 SFT2 ADD2
( saturate to +/-7.fff )
#7fff GTH2k JMP SWP2 NIP2
STHr #01 NEQ ,&result-positive JCN
DUP2k EOR2 SWP2 SUB2
&result-positive
JMP2r

124
projects/examples/demos/move.tal
View File

@ -1,89 +1,73 @@
( dev/controller/buttons )
( Move:
Use controller arrows, leave a slime. )
%++ { INC2 }
%-- { #0001 SUB2 }
%2// { #01 SFT2 }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
( variables )
|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|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
|0000
@slime $1
( init )
@hello &x $2 &y $2
|0100 ( -> )
( theme )
#0daf .System/r DEO2
#02ff .System/g DEO2
#035f .System/b DEO2
( vectors )
( theme )
#c0f4 .System/r DEO2
#c0fc .System/g DEO2
#c0f7 .System/b DEO2
( vectors )
;on-frame .Screen/vector DEO2
( set origin )
.Screen/width DEI2 2// .Screen/x DEO2
.Screen/height DEI2 2// .Screen/y DEO2
;default_icn .Screen/addr DEO2
#41 .Screen/sprite DEO
#0a .slime STZ
.Screen/width DEI2 #01 SFT2 .hello/x STZ2
.Screen/height DEI2 #01 SFT2 .hello/y STZ2
( drawing mode )
#16 .Screen/auto DEO
( defaults )
#00 ;on-frame/draw JMP2
BRK
@on-frame ( -> )
#0a .slime STZ
;default_icn .Screen/addr DEO2
( hold ctrl key to change slime color )
.Controller/button DEI #0f AND
DUP #01 NEQ ,&no-ctrl JCN #05 .slime STZ &no-ctrl
DUP #02 NEQ ,&no-alt JCN #0f .slime STZ &no-alt
POP
( clear ) #40 .Screen/sprite DEO
( detect movement )
.Controller/button DEI #f0 AND
DUP #04 SFT #01 AND #01 NEQ ,&no-up JCN
( move )
.Screen/y DEI2 -- .Screen/y DEO2
;up_icn .Screen/addr DEO2 &no-up
DUP #05 SFT #01 AND #01 NEQ ,&no-down JCN
( move )
.Screen/y DEI2 ++ .Screen/y DEO2
;down_icn .Screen/addr DEO2 &no-down
DUP #06 SFT #01 AND #01 NEQ ,&no-left JCN
( move )
.Screen/x DEI2 -- .Screen/x DEO2
;left_icn .Screen/addr DEO2 &no-left
DUP #07 SFT #01 AND #01 NEQ ,&no-right JCN
( move )
.Screen/x DEI2 ++ .Screen/x DEO2
;right_icn .Screen/addr DEO2 &no-right
POP
( draw face )
#41 .Screen/sprite DEO
.Controller/button DEI
DUP ,&continue JCN
POP BRK
&continue
( clear )
#40 .Screen/sprite DEO
( movement )
DUP #10 AND #00 EQU ,&no-u JCN .hello/y LDZ2k #0001 SUB2 ROT STZ2 &no-u
DUP #20 AND #00 EQU ,&no-d JCN .hello/y LDZ2k INC2 ROT STZ2 &no-d
DUP #40 AND #00 EQU ,&no-l JCN .hello/x LDZ2k #0001 SUB2 ROT STZ2 &no-l
DUP #80 AND #00 EQU ,&no-r JCN .hello/x LDZ2k INC2 ROT STZ2 &no-r
&draw
( draw hello )
.hello/x LDZ2 STH2k .Screen/x DEO2
.hello/y LDZ2 STH2k .Screen/y DEO2
;hello-chr .Screen/addr DEO2
#c1 .Screen/sprite DEOk DEO
( draw slime )
;slime_icn .Screen/addr DEO2
.slime LDZ .Screen/sprite DEO
STH2r .Screen/y DEO2
STH2r .Screen/x DEO2
;slime-icn .Screen/addr DEO2
,get-slime JSR .Screen/sprite DEOk DEO
BRK
@default_icn [ 3c7e ffdb ffe7 7e3c ]
@up_icn [ 2466 e7db ffff 7e3c ]
@down_icn [ 3c7e ffff dbe7 6624 ]
@left_icn [ 3c7e ef1f 1fef 7e3c ]
@right_icn [ 3c7e f7f8 f8f7 7e3c ]
@slime_icn [ 0000 183c 3c18 0000 ]
@get-slime ( button -- color )
#0f AND
DUP #01 NEQ ,&no-ctrl JCN POP #05 JMP2r &no-ctrl
DUP #02 NEQ ,&no-alt JCN POP #0a JMP2r &no-alt
POP #0f
JMP2r
@hello-chr
0007 1820 2040 4044 0000 071f 1f3f 3f3b
00e0 1804 0402 0222 0000 e0f8 f8fc fcdc
4040 4423 2018 0700 3f3f 3b1c 1f07 0000
0202 22c4 0418 e000 fcfc dc38 f8e0 0000
@slime-icn
0000 0000 0003 0707 0000 0000 00c0 e0e0
0707 0300 0000 0000 e0e0 c000 0000 0000

232
projects/examples/demos/nametable.tal
View File

@ -1,232 +0,0 @@
(
uxnasm projects/examples/demos/nametable.tal bin/nametable.rom
uxnemu bin/nametable.rom
)
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2** { #10 SFT2 } %2// { #01 SFT2 }
%8** { #30 SFT2 } %8// { #03 SFT2 }
%10** { #40 SFT2 } %10// { #04 SFT2 }
%MOD2 { DIV2k MUL2 SUB2 }
%MOD { DIVk MUL SUB }
%RTN { JMP2r }
%WIDTH { #0037 }
%HEIGHT { #0029 } ( 08cf )
%LENGTH { WIDTH HEIGHT MUL2 10** }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $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 &wheel $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
( variables )
|0000
( program )
@tiles-frame
&x $2 &y $2
@nametable-frame
&x $2 &y $2
@buffer $10
|0100 ( -> )
( theme )
#34cd .System/r DEO2
#28ac .System/g DEO2
#297b .System/b DEO2
WIDTH 8** #0010 ++ .Screen/width DEO2
#01e8 .Screen/height DEO2
#0008 .tiles-frame/x STZ2
HEIGHT 8** #0008 ++ .tiles-frame/y STZ2
#0008 .nametable-frame/x STZ2
#0008 .nametable-frame/y STZ2
;input-name
DUP2 ,load JSR
;assoc JSR2
;draw-tiles JSR2
;draw-nametable JSR2
;draw-short JSR2
BRK
@load ( filename* -- )
LIT2r 0000
.File/name DEO2
&stream
#0010 .File/length DEO2
;buffer
DUP2 .File/read DEO2
,find-tile JSR #ffff !! ,&skip JCN
;buffer ;add-tile JSR2
&skip
INC2r
.File/success DEI2 #0000 !! ,&stream JCN
STH2r #0001 -- ;result/tiles STA2
RTN
@find-tile ( addr* -- addr* )
STH2
;result/length LDA2 #0000
&loop
DUP2 10** ;result/data ++ STH2kr ;tiles-equal JSR2 #00 = ,&continue JCN
NIP2 POP2r RTN
&continue
INC2 GTH2k ,&loop JCN
POP2 POP2 POP2r
( default ) #ffff
RTN
@tiles-equal ( a* b* -- bool )
STH2
DUP2 #0010 ++ SWP2
&loop
LDAk LDAkr STHr = ,&continue JCN
POP2 POP2 POP2r #00 RTN
&continue
INC2r
INC2 GTH2k ,&loop JCN
POP2 POP2 POP2r #01
RTN
@add-tile ( addr* -- addr* )
STH2
#0010 #0000
&loop
( addr* ) DUP2 ;result/length LDA2 10** ;result/data ++ ++
( data ) OVR2 STH2kr ++ LDA
( order ) ROT ROT STA
INC2 GTH2k ,&loop JCN
POP2 POP2
POP2r
( incr ) ;result/length LDA2 INC2 ;result/length STA2
RTN
@assoc ( -- length )
LIT2r 0000
.File/name DEO2
&stream
#0010 .File/length DEO2
;buffer
DUP2 .File/read DEO2
;find-tile JSR2 STH2kr SWP2 ;set-tile JSR2
INC2r
.File/success DEI2 #0000 !! ,&stream JCN
POP2r
RTN
( draw )
@draw-tiles ( -- )
.tiles-frame/x LDZ2 .Screen/x DEO2
.tiles-frame/y LDZ2 .Screen/y DEO2
;result/data .Screen/addr DEO2
( width ) LITr 00
( auto x addr ) #05 .Screen/auto DEO
;result/data ;result/length LDA2 10** ++ ;result/data
&loop
STHkr WIDTH NIP MOD ,&continue JCN
.tiles-frame/x LDZ2 .Screen/x DEO2
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
POPr LITr 00
&continue
INCr
#81 .Screen/sprite DEO
#0010 ++ GTH2k ,&loop JCN
POP2 POP2
( auto none ) #00 .Screen/auto DEO
POPr
RTN
@set-tile ( id* addr* -- )
SWP2 2** ;result/data ++ ;result/length LDA2 10** ++ STA2
RTN
@get-tile ( id* -- addr* )
2** ;result/length LDA2 10** ;result/data ++ ++ LDA2
RTN
@draw-nametable ( -- )
;result/tiles LDA2 #0000
&loop
DUP2 WIDTH MOD2 8** .nametable-frame/x LDZ2 ++ .Screen/x DEO2
DUP2 WIDTH DIV2 8** .nametable-frame/y LDZ2 ++ .Screen/y DEO2
DUP2 ;get-tile JSR2 10** ;result/data ++ .Screen/addr DEO2
#81 .Screen/sprite DEO
INC2 GTH2k ,&loop JCN
POP2 POP2
RTN
@draw-short ( -- )
#0008 .Screen/x DEO2
#0008 .Screen/y DEO2
#01 .Screen/auto DEO
;result/length LDA2 SWP
( high ) ,&draw-byte JSR
( low ) ,&draw-byte JSR
#05 .Screen/auto DEO
RTN
&draw-byte ( byte -- )
DUP
( high ) #04 SFT ,&draw-char JSR
( low ) #0f AND ,&draw-char JSR
RTN
&draw-char ( num -- )
#30 SFT #00 SWP ;font-hex ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
RTN
@input-name "projects/pictures/bulma37x29.chr $1
@font-hex ( 0-F )
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
007c 8280 fc82 827c 007c 8202 1e02 0202
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
@result
&length $2
&tiles $2
&data

619
projects/examples/demos/piano.tal
View File

@ -1,619 +0,0 @@
( piano )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%!~ { NEQk NIP }
%HALT { #010f DEO }
%RTN { JMP2r }
%TOS { #00 SWP }
%MOD { DUP2 / * - }
%GTS2 { #8000 ++ SWP2 #8000 ++ << }
%2/ { #01 SFT }
%2// { #01 SFT2 }
%4// { #02 SFT2 }
%8// { #03 SFT2 }
%8** { #30 SFT2 }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|20 @Screen &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
( variables )
|0000
@last-note $1
@octave $1
@pointer
&x $2 &y $2
@center
&x $2 &y $2
@adsr-view
&x1 $2 &y1 $2 &x2 $2 &y2 $2
@wave-view
&x1 $2 &y1 $2 &x2 $2 &y2 $2
@octave-view
&x1 $2 &y1 $2 &x2 $2 &y2 $2
( program )
|0100 ( -> )
( theme )
#0fe5 .System/r DEO2
#0fc5 .System/g DEO2
#0f25 .System/b DEO2
( vectors )
;on-frame .Screen/vector DEO2
;on-control .Controller/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-message .Console/vector DEO2
( find center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
( place octave )
.center/x LDZ2 #0080 -- .octave-view/x1 STZ2
.center/y LDZ2 #0008 ++ .octave-view/y1 STZ2
.octave-view/x1 LDZ2 #0050 ++ .octave-view/x2 STZ2
.octave-view/y1 LDZ2 #0018 ++ .octave-view/y2 STZ2
( place adsr )
.center/x LDZ2 #0020 -- .adsr-view/x1 STZ2
.center/y LDZ2 #0008 ++ .adsr-view/y1 STZ2
.adsr-view/x1 LDZ2 #00a0 ++ .adsr-view/x2 STZ2
.adsr-view/y1 LDZ2 #0018 ++ .adsr-view/y2 STZ2
( place waveform )
.center/x LDZ2 #0080 -- .wave-view/x1 STZ2
.center/y LDZ2 #0020 -- .wave-view/y1 STZ2
.wave-view/x1 LDZ2 #0100 ++ .wave-view/x2 STZ2
.wave-view/y1 LDZ2 #0020 ++ .wave-view/y2 STZ2
( default settings )
#ff .last-note STZ
#041c .Audio0/adsr DEO2
#dd .Audio0/volume DEO
;sin-pcm .Audio0/addr DEO2
#0100 .Audio0/length DEO2
( inital drawing )
;draw-octave JSR2
;draw-adsr JSR2
;draw-wave JSR2
BRK
@on-frame ( -> )
.adsr-view/y2 LDZ2 #0020 -- .Screen/y DEO2
#10 #00
&loop
.adsr-view/x2 LDZ2 #003a -- .Screen/x DEO2
#10 OVR - .Audio0/output DEI #0f AND < .Screen/pixel DEO
.adsr-view/x2 LDZ2 #003a -- INC2 INC2 .Screen/x DEO2
#10 OVR - .Audio0/output DEI #04 SFT < .Screen/pixel DEO
.Screen/y DEI2 INC2 INC2 .Screen/y DEO2
INC GTHk ,&loop JCN
POP2
BRK
@on-control ( -> )
( clear last cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
.Controller/key DEI
[ LIT 'a ] !~ ,&no-c JCN
#30 .octave LDZ #0c * + ;play JSR2 &no-c
[ LIT 's ] !~ ,&no-d JCN
#32 .octave LDZ #0c * + ;play JSR2 &no-d
[ LIT 'd ] !~ ,&no-e JCN
#34 .octave LDZ #0c * + ;play JSR2 &no-e
[ LIT 'f ] !~ ,&no-f JCN
#35 .octave LDZ #0c * + ;play JSR2 &no-f
[ LIT 'g ] !~ ,&no-g JCN
#37 .octave LDZ #0c * + ;play JSR2 &no-g
[ LIT 'h ] !~ ,&no-a JCN
#39 .octave LDZ #0c * + ;play JSR2 &no-a
[ LIT 'j ] !~ ,&no-b JCN
#3b .octave LDZ #0c * + ;play JSR2 &no-b
[ LIT 'k ] !~ ,&no-c2 JCN
#3c .octave LDZ #0c * + ;play JSR2 &no-c2
[ #1b ] !~ ,&no-esc JCN HALT &no-esc
POP
( release )
#00 .Controller/key DEO
.Controller/button DEI
DUP #11 ! ,&cu JCN #3c ;play JSR2 &cu
DUP #21 ! ,&cd JCN #3d ;play JSR2 &cd
DUP #41 ! ,&cl JCN #3e ;play JSR2 &cl
DUP #81 ! ,&cr JCN #3f ;play JSR2 &cr
DUP #12 ! ,&au JCN #40 ;play JSR2 &au
DUP #22 ! ,&ad JCN #41 ;play JSR2 &ad
DUP #42 ! ,&al JCN #42 ;play JSR2 &al
DUP #82 ! ,&ar JCN #43 ;play JSR2 &ar
DUP #14 ! ,&su JCN #44 ;play JSR2 &su
DUP #24 ! ,&sd JCN #45 ;play JSR2 &sd
DUP #44 ! ,&sl JCN #46 ;play JSR2 &sl
DUP #84 ! ,&sr JCN #47 ;play JSR2 &sr
DUP #40 ! ,&l JCN .Audio0/addr DEI2 #0010 -- .Audio0/addr DEO2 &l
DUP #80 ! ,&r JCN .Audio0/addr DEI2 #0010 ++ .Audio0/addr DEO2 &r
POP
;draw-octave JSR2
;draw-wave JSR2
BRK
@on-message ( -> )
.Console/read DEI ;play JSR2
;draw-octave JSR2
BRK
@on-mouse ( -> )
;draw-cursor JSR2
.Mouse/state DEI #00 ! #01 JCN [ BRK ]
.Mouse/x DEI2 .Mouse/y DEI2 .wave-view ;within-rect JSR2
;on-touch-wave-view JCN2
.Mouse/x DEI2 .Mouse/y DEI2 .adsr-view ;within-rect JSR2
;on-touch-adsr-view JCN2
.Mouse/x DEI2 .Mouse/y DEI2 .octave-view ;within-rect JSR2
;on-touch-octave-view JCN2
BRK
@on-touch-wave-view ( -> )
.Mouse/x DEI2 .wave-view/x1 LDZ2 -- .Audio0/length DEO2
;draw-wave JSR2
;draw-cursor JSR2
BRK
@on-touch-octave-view ( -> )
.Mouse/x DEI2 .octave-view/x1 LDZ2 -- 8// NIP #09 ! ,&no-mod JCN
.Mouse/y DEI2 .octave-view/y1 LDZ2 -- 8// NIP
[ #00 ] !~ ,&no-incr JCN
.octave LDZ #03 = ,&no-incr JCN
.octave LDZ INC .octave STZ &no-incr
[ #02 ] !~ ,&no-decr JCN
.octave LDZ #ff = ,&no-decr JCN
.octave LDZ #01 - .octave STZ &no-decr
POP
( release ) #00 .Mouse/state DEO
;draw-octave JSR2
BRK
&no-mod
.Mouse/x DEI2 .octave-view/x1 LDZ2 -- 8// NIP #06 > ,&no-key JCN
.Mouse/x DEI2 .octave-view/x1 LDZ2 -- 8// ;notes ++ LDA .octave LDZ #0c * + ;play JSR2
( release ) #00 .Mouse/state DEO
;draw-octave JSR2
&no-key
BRK
@on-touch-adsr-view ( -> )
.Mouse/x DEI2 .adsr-view/x1 LDZ2 -- 8// NIP #03 /
[ #00 ] !~ ,&no-a JCN
.Audio0/adsr DEI
#10 .Mouse/state DEI #10 = #e0 * + +
.Audio0/adsr DEO &no-a
[ #01 ] !~ ,&no-d JCN
.Audio0/adsr DEI
DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
.Audio0/adsr DEO &no-d
[ #02 ] !~ ,&no-s JCN
.Audio0/adsr INC DEI
#10 .Mouse/state DEI #10 = #e0 * + +
.Audio0/adsr INC DEO &no-s
[ #03 ] !~ ,&no-r JCN
.Audio0/adsr INC DEI
DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
.Audio0/adsr INC DEO &no-r
[ #05 ] !~ ,&no-left JCN
.Audio0/volume DEI
#10 .Mouse/state DEI #10 = #e0 * + +
.Audio0/volume DEO &no-left
[ #06 ] !~ ,&no-right JCN
.Audio0/volume DEI
DUP #f0 AND STH #01 .Mouse/state DEI #10 = #0e * + + #0f AND STHr +
.Audio0/volume DEO &no-right
POP
( release ) #00 .Mouse/state DEO
;draw-adsr JSR2
;draw-cursor JSR2
BRK
@play ( pitch -- )
DUP #0c MOD .last-note STZ
.Audio0/pitch DEO
RTN
@draw-cursor ( -- )
( clear last cursor )
;cursor .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( record pointer positions )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
( colorize on state )
#41 [ .Mouse/state DEI #00 ! ] + .Screen/sprite DEO
RTN
@draw-octave ( -- )
.octave-view/x1 LDZ2 .octave-view/y1 LDZ2
OVR2 OVR2 ;keys-left-icns .last-note LDZ #00 = INC ;draw-key JSR2
OVR2 #0008 ++ OVR2 ;keys-middle-icns .last-note LDZ #02 = INC ;draw-key JSR2
OVR2 #0010 ++ OVR2 ;keys-right-icns .last-note LDZ #04 = INC ;draw-key JSR2
OVR2 #0018 ++ OVR2 ;keys-left-icns .last-note LDZ #05 = INC ;draw-key JSR2
OVR2 #0020 ++ OVR2 ;keys-middle-icns .last-note LDZ #07 = INC ;draw-key JSR2
OVR2 #0028 ++ OVR2 ;keys-middle-icns .last-note LDZ #09 = INC ;draw-key JSR2
SWP2 #0030 ++ SWP2 ;keys-right-icns .last-note LDZ #0b = INC ;draw-key JSR2
.octave-view/x1 LDZ2 #0048 ++ .Screen/x DEO2
;arrow-icns .Screen/addr DEO2
.octave-view/y1 LDZ2 .Screen/y DEO2
#01 .Screen/sprite DEO
;arrow-icns #0008 ++ .Screen/addr DEO2
.octave-view/y1 LDZ2 #0010 ++ .Screen/y DEO2
#01 .Screen/sprite DEO
;font-hex .octave LDZ #03 + #00 SWP 8** ++ .Screen/addr DEO2
.octave-view/y1 LDZ2 #0008 ++ .Screen/y DEO2
#03 .Screen/sprite DEO
RTN
@draw-key ( x* y* addr* color -- )
STH
.Screen/addr DEO2
SWP2 .Screen/x DEO2
DUP2 #0018 ++ SWP2
&loop
( move ) DUP2 .Screen/y DEO2
( draw ) STHkr .Screen/sprite DEO
( incr ) .Screen/addr DEI2 #0008 ++ .Screen/addr DEO2
#0008 ++ GTH2k ,&loop JCN
POP2 POP2
POPr
RTN
@draw-adsr ( -- )
( adsr )
.adsr-view/x1 LDZ2 .adsr-view/y1 LDZ2
.Audio0/adsr DEI #04 SFT
;draw-knob JSR2
.adsr-view/x1 LDZ2 #0018 ++ .adsr-view/y1 LDZ2
.Audio0/adsr DEI #0f AND
;draw-knob JSR2
.adsr-view/x1 LDZ2 #0030 ++ .adsr-view/y1 LDZ2
.Audio0/adsr INC DEI #04 SFT
;draw-knob JSR2
.adsr-view/x1 LDZ2 #0048 ++ .adsr-view/y1 LDZ2
.Audio0/adsr INC DEI #0f AND
;draw-knob JSR2
( volume )
.adsr-view/x2 LDZ2 #0028 -- .adsr-view/y1 LDZ2
.Audio0/volume DEI #04 SFT
;draw-knob JSR2
.adsr-view/x2 LDZ2 #0010 -- .adsr-view/y1 LDZ2
.Audio0/volume DEI #0f AND
;draw-knob JSR2
RTN
@draw-wave ( -- )
( clear )
.wave-view/x1 LDZ2
.wave-view/y1 LDZ2
.wave-view/x2 LDZ2 INC2
.wave-view/y2 LDZ2
#00 ;fill-rect JSR2
#01 ;draw-wave-length JSR2
.wave-view/x1 LDZ2 .Screen/x DEO2
( waveform )
#ff #00
&loop
( dotted line )
DUP #01 AND ,&no-dot JCN
.wave-view/y1 LDZ2 #0010 ++ .Screen/y DEO2
#03 .Screen/pixel DEO
&no-dot
DUP TOS .Audio0/addr DEI2 ++ LDA
2/
TOS 4// .wave-view/y1 LDZ2 ++ .Screen/y DEO2
.Screen/x DEI2 INC2 .Screen/x DEO2
( draw ) DUP
.Audio0/length DEI2 NIP >
.Audio0/length DEI2 #0100 !! #0101 == DUP ADD INC .Screen/pixel DEO
INC GTHk ,&loop JCN
POP2
( range )
.wave-view/x1 LDZ2 .Screen/x DEO2
.wave-view/y1 LDZ2 #0010 -- .Screen/y DEO2
.Audio0/addr DEI2 #02 ;draw-short JSR2
.wave-view/x2 LDZ2 #0020 -- .Screen/x DEO2
.Audio0/length DEI2 #02 ;draw-short JSR2
RTN
@draw-wave-length ( color -- )
STH
.wave-view/x1 LDZ2 .Audio0/length DEI2 ++ .Screen/x DEO2
.wave-view/y1 LDZ2 DUP2 #0020 ++ SWP2
&loop
DUP2 .Screen/y DEO2
( draw ) STHkr .Screen/pixel DEO
INC2 GTH2k ,&loop JCN
POP2 POP2
POPr
RTN
@draw-knob ( x* y* value -- )
( load ) STH .Screen/y DEO2 .Screen/x DEO2
;knob-icns .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
;knob-icns #0008 ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
;knob-icns #0018 ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0008 -- .Screen/x DEO2
;knob-icns #0010 ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0004 ++ .Screen/x DEO2
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
;font-hex #00 STHkr #30 SFT ++ .Screen/addr DEO2
( draw ) #01 .Screen/sprite DEO
.Screen/x DEI2 #0004 -- #00 #00 STHkr ;knob-offsetx ++ LDA ++ .Screen/x DEO2
.Screen/y DEI2 #0010 -- #00 #00 STHr ;knob-offsety ++ LDA ++ .Screen/y DEO2
;knob-icns #0020 ++ .Screen/addr DEO2
( draw ) #05 .Screen/sprite DEO
RTN
@draw-short ( short* color -- )
STH SWP
DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHr .Screen/sprite DEO
RTN
@fill-rect ( x1* y1* x2* y2* color -- )
,&color STR
( x1 x2 y1 y2 ) ROT2
&ver
( save ) DUP2 .Screen/y DEO2
STH2 STH2 OVR2 OVR2 SWP2
&hor
( save ) DUP2 .Screen/x DEO2
( draw ) ,&color LDR .Screen/pixel DEO
( incr ) INC2
OVR2 OVR2 GTS2 ,&hor JCN
POP2 POP2 STH2r STH2r
( incr ) INC2
OVR2 OVR2 GTS2 ,&ver JCN
POP2 POP2 POP2 POP2
RTN
&color $1
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
RTN
&skip
POP2 POP2 POPr
#00
RTN
@cursor
80c0 e0f0 f8e0 1000
@arrow-icns
0010 387c fe10 1000
0010 1010 fe7c 3810
@notes
30 32 34 35
37 39 3b 3c
@keys-left-icns
7c7c 7c7c 7c7c 7c7c
7c7c 7c7c 7c7c 7e7f
7f7f 7f7f 7f7f 3e00
@keys-middle-icns
1c1c 1c1c 1c1c 1c1c
1c1c 1c1c 1c1c 3e7f
7f7f 7f7f 7f7f 3e00
@keys-right-icns
1f1f 1f1f 1f1f 1f1f
1f1f 1f1f 1f1f 3f7f
7f7f 7f7f 7f7f 3e00
@knob-icns
0003 0c10 2020 4040
00c0 3008 0404 0202
4040 2020 100c 0300
0202 0404 0830 c000
0000 183c 3c18 0000
@knob-offsetx
01 00 00 00 00 01 02 03
05 06 07 08 08 08 08 07
@knob-offsety
07 06 05 03 02 01 00 00
00 00 01 02 03 05 06 07
@font-hex ( 0-F )
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
007c 8280 fc82 827c 007c 8202 1e02 0202
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
@piano-pcm
8182 8588 8d91 959b a1a6 aaad b2b5 b8bd
c1c7 cbd0 d5d9 dde1 e5e5 e4e4 e1dc d7d1
cbc5 bfb8 b2ac a6a2 9c97 928d 8884 807c
7977 7574 7372 7272 7273 7372 706d 6964
605b 5650 4d49 4643 4342 4244 4548 4a4d
5052 5556 5758 5554 5150 4c4a 4744 423f
3d3c 3a38 3835 3431 3030 2f31 3336 393e
4449 4e54 5a60 666b 7175 7b82 8990 989e
a6ab b1b6 babd bebf bfbe bbb9 b6b3 b0ae
aaa8 a6a3 a19e 9c9a 9997 9696 9798 9b9e
a1a4 a6a9 a9ac adad adae aeaf b0b0 b1b1
b3b3 b4b4 b4b3 b3b1 b0ad abab a9a9 a8a8
a7a5 a19d 9891 8b84 7e77 726e 6b6b 6b6c
6f71 7477 7776 7370 6c65 5e56 4e48 423f
3d3c 3b3a 3a39 3838 3839 393a 3c3e 4146
4a50 575b 6064 686a 6e70 7274 7677 7a7d
@violin-pcm
8186 8d94 9ba0 a3a7 acb1 b5bc c2c7 cacc
cecf d0d1 d3d5 d8db dee1 e3e5 e6e5 e5e3
dfdc d7d0 c8c2 bbb2 a99f 968c 847c 746e
675f 5851 4b43 3e3a 3533 312e 2c2b 2826
2422 2122 2327 2d34 3c44 4c57 5f68 7075
7b80 8487 8789 8a8c 8d90 9397 999c 9ea0
a2a2 a2a0 9c97 9491 8f8e 908f 918f 8e88
827a 726a 6058 5047 423f 3f40 4245 4748
4949 4746 4545 4a4f 5863 717f 8b9a a6b1
b8be c1c1 bfbd bab5 b1af acac aeb1 b7bc
c2c9 cfd3 d5d4 d3d3 d1ce cbc6 c0ba b3ab
a39a 8f85 7b72 6c67 6462 605f 5e5d 5b58
5550 4d49 4848 4949 4a4d 5052 5558 5b5e
6164 686c 7074 7677 7979 7a7b 7b7a 7977
7473 6f6e 6b69 696b 6f72 7576 7574 716b
655d 554e 4742 3f3f 4045 4b52 5a62 6b74
@sin-pcm
8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad
b0b3 b6b9 bbbe c1c3 c6c9 cbce d0d2 d5d7
d9db dee0 e2e4 e6e7 e9eb ecee f0f1 f2f4
f5f6 f7f8 f9fa fbfb fcfd fdfe fefe fefe
fffe fefe fefe fdfd fcfb fbfa f9f8 f7f6
f5f4 f2f1 f0ee eceb e9e7 e6e4 e2e0 dedb
d9d7 d5d2 d0ce cbc9 c6c3 c1be bbb9 b6b3
b0ad aaa7 a4a1 9e9b 9895 928f 8c89 8683
807d 7a77 7471 6e6b 6865 625f 5c59 5653
504d 4a47 4542 3f3d 3a37 3532 302e 2b29
2725 2220 1e1c 1a19 1715 1412 100f 0e0c
0b0a 0908 0706 0505 0403 0302 0202 0202
0102 0202 0202 0303 0405 0506 0708 090a
0b0c 0e0f 1012 1415 1719 1a1c 1e20 2225
2729 2b2e 3032 3537 3a3d 3f42 4547 4a4d
5053 5659 5c5f 6265 686b 6e71 7477 7a7d
@tri-pcm
8082 8486 888a 8c8e 9092 9496 989a 9c9e
a0a2 a4a6 a8aa acae b0b2 b4b6 b8ba bcbe
c0c2 c4c6 c8ca ccce d0d2 d4d6 d8da dcde
e0e2 e4e6 e8ea ecee f0f2 f4f6 f8fa fcfe
fffd fbf9 f7f5 f3f1 efed ebe9 e7e5 e3e1
dfdd dbd9 d7d5 d3d1 cfcd cbc9 c7c5 c3c1
bfbd bbb9 b7b5 b3b1 afad aba9 a7a5 a3a1
9f9d 9b99 9795 9391 8f8d 8b89 8785 8381
7f7d 7b79 7775 7371 6f6d 6b69 6765 6361
5f5d 5b59 5755 5351 4f4d 4b49 4745 4341
3f3d 3b39 3735 3331 2f2d 2b29 2725 2321
1f1d 1b19 1715 1311 0f0d 0b09 0705 0301
0103 0507 090b 0d0f 1113 1517 191b 1d1f
2123 2527 292b 2d2f 3133 3537 393b 3d3f
4143 4547 494b 4d4f 5153 5557 595b 5d5f
6163 6567 696b 6d6f 7173 7577 797b 7d7f
@saw-pcm
8282 8183 8384 8685 8888 8889 8a8b 8c8c
8e8e 8f90 9092 9193 9494 9596 9699 9899
9b9a 9c9c 9c9d 9ea0 a1a0 a2a2 a3a5 a4a6
a7a7 a9a8 a9aa aaac adad aeae b0b0 b1b3
b2b4 b5b5 b6b7 b9b8 b9bb babc bdbc bdbe
bfc1 bfc1 c3c1 c4c5 c5c6 c6c7 c9c7 cbca
cbcc cdcd cfcf d2d0 d2d2 d2d5 d4d5 d6d7
d8d8 d9dc d9df dadf dce1 dde5 dce6 dceb
cb1f 1b1e 1c21 1c21 1f23 2025 2127 2329
2529 2829 2a2b 2b2e 2d2f 302f 3231 3234
3334 3536 3836 3939 3a3b 3b3d 3e3d 3f40
4042 4242 4444 4646 4748 474a 4a4b 4d4c
4e4e 4f50 5052 5252 5554 5557 5759 5959
5b5b 5c5d 5d5f 5e60 6160 6264 6365 6566
6867 6969 6a6c 6c6d 6d6e 706f 7071 7174
7475 7576 7777 797a 7a7c 7b7c 7e7d 7f7f

108
projects/examples/demos/polycat.tal
View File

@ -1,31 +1,21 @@
( polycat )
( Polycat:
A cat with one eye, and the hind and tail of a lizard.
Original character by Rekka Bellum )
%2// { #01 SFT2 }
%!~ { NEQk NIP }
%AUTO-XADDR { #05 .Screen/auto DEO }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
( variables )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixeld $1 &sprite $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
|0000
@cat
&x $2 &y $2 &timer $1
@pointer
&x $2 &y $2
( program )
@cat &x $2 &y $2 &timer $1
@pointer &x $2 &y $2
|0100 ( -> )
( theme )
#0a3f .System/r DEO2
#05df .System/g DEO2
( theme )
#0a3f .System/r DEO2
#05df .System/g DEO2
#0caf .System/b DEO2
( DOS resolution )
#0140 .Screen/width DEO2
@ -33,30 +23,22 @@
( vectors )
;on-mouse .Mouse/vector DEO2
( find center )
.Screen/width DEI2 2// .cat/x STZ2
.Screen/height DEI2 2// .cat/y STZ2
( set screen mode )
AUTO-XADDR
( init )
#ff ;draw-eye/last STA
#ff ;draw-tail/last STA
,draw-polycat JSR
,draw-ground JSR
BRK
@draw-ground ( -- )
.Screen/width DEI2 #01 SFT2 .cat/x STZ2
.Screen/height DEI2 #01 SFT2 .cat/y STZ2
( draw ground )
#f6 .Screen/auto DEO
.cat/y LDZ2 #0018 ADD2 .Screen/y DEO2
.cat/x LDZ2 #0010 SUB2 .Screen/x DEO2
;ground .Screen/addr DEO2
#1000
&loop
#01 .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
#01 .Screen/sprite DEO
( init )
#ff ;draw-eye/last STA
#ff ;draw-tail/last STA
( set screen mode auto-x )
#05 .Screen/auto DEO
,draw-polycat JSR
JMP2r
BRK
@draw-polycat ( -- )
@ -72,9 +54,9 @@ JMP2r
#81 .Screen/sprite DEO
( eye/tail )
#00 ,draw-eye JSR
#00 ,draw-tail JSR
#00 ;draw-tail ( .. )
JMP2r
JMP2
@on-mouse ( -> )
@ -92,8 +74,7 @@ BRK
DUP ,&last LDR NEQ ,&changed JCN
POP JMP2r &changed
( only redraw on change )
DUP
#00 SWP ;eye ADD2 .Screen/addr DEO2
#00 OVR ;eye ADD2 .Screen/addr DEO2
.cat/y LDZ2 #0008 ADD2 .Screen/y DEO2
.cat/x LDZ2 #0008 SUB2 .Screen/x DEO2
#81 .Screen/sprite DEOk DEO
@ -104,12 +85,11 @@ JMP2r
@draw-tail ( frame -- )
DUP ,&last LDR NEQ ,&changed JCN
POP JMP2r &changed
STHk ,&last LDR NEQ ,&changed JCN
POPr JMP2r &changed
( only redraw on change )
DUP
;frames ROT #00 SWP ADD2 LDA
#00 SWP #40 SFT2 ;body/tail ADD2
STHr #00 OVR ;frames ADD2 LDA
#00 SWP #40 SFT2 ;body/tail ADD2
.Screen/addr DEO2
.cat/x LDZ2 .Screen/x DEO2
.cat/y LDZ2 #0010 ADD2 .Screen/y DEO2
@ -122,27 +102,27 @@ JMP2r
@draw-cursor ( -- )
( last cursor )
;cursor STH2k .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
;cursor STH2k .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( new cursor )
STH2r .Screen/addr DEO2
STH2r .Screen/addr DEO2
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#41 .Mouse/state DEI #00 NEQ ADD .Screen/sprite DEO
JMP2r
@cursor
80c0 e0f0 f8e0 1000
@cursor
80c0 e0f0 f8e0 1000
@frames
00 01 02 03 02 01 00 00
00 00 00 00 00 00 00 00
@ears
@ears
081c 3e3e 7f7f ffff 081c 3e3e 7f7f fffc
081c 3c3e 7e7e ffff 081c 3c3e 7e7e ff1f
@eye
081c 3c3e 7e7e ffff 081c 3c3e 7e7e ff1f
@eye
ffff ffff ff7f 3f0f f7ef cfe7 f07c 3f0f
ffff ffff fffe fcf0 87c3 c183 071e fcf0
ffff ffff ff7f 3f0f f0e1 c1e0 f07c 3f0f
@ -151,7 +131,7 @@ JMP2r
ffff ffff fffe fcf0 0783 c1c3 871e fcf0
ffff ffff ff7f 3f0f f0e0 c1e1 f07c 3f0f
ffff ffff fffe fcf0 07f3 f9fb f71e fcf0
@body
@body
0707 0707 0302 0200 0107 0707 0300 0000
&tail
e0f0 f0e0 e080 8000 c0f2 f9f9 fef8 b000
@ -159,7 +139,7 @@ JMP2r
e0f0 f0e0 e080 8000 c0f2 faf9 fef8 b000
e0f0 f0e0 e080 8000 c0f1 faf9 fef8 b000
0707 0707 0f08 1000 0307 0707 0f00 0000
e0e0 e0e0 e080 8000 f2f9 f9fe b884 8400
@ground
e0e0 e0e0 e080 8000 f2f9 f9fe b884 8400
@ground
bf00 5c02 0202 020c ef10 6f90 8080 8074
ff00 fe01 0100 0116 fd00 3c40 4040 4028
ff00 fe01 0100 0116 fd00 3c40 4040 4028

102
projects/examples/demos/snake.tal
View File

@ -1,20 +1,5 @@
( uxnasm projects/examples/demos/snake.tal bin/snake.rom && uxnemu bin/snake.rom )
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2/ { #01 SFT } %2* { #10 SFT }
%8// { #03 SFT2 } %8** { #30 SFT2 }
%MOD { DIVk MUL SUB }
%MAX { LTHk JMP SWP POP }
%RTN { JMP2r }
%TOS { #00 SWP }
%BRK? { #01 JCN BRK }
%DIFFICULTY { #06 }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
@ -22,7 +7,7 @@
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
@ -55,8 +40,8 @@
#0100 .Screen/height DEO2
( set arena )
.Screen/width DEI2 8// NIP .arena/w STZ
.Screen/height DEI2 8// NIP .arena/h STZ
.Screen/width DEI2 #03 SFT2 NIP .arena/w STZ
.Screen/height DEI2 #03 SFT2 NIP .arena/h STZ
;reset JSR2
@ -65,11 +50,12 @@ BRK
@on-frame ( -> )
.arena/timer LDZ INC DUP .arena/timer STZ
DIFFICULTY = BRK?
#06 ( difficulty - lower value produces faster gameplay )
EQU JMP BRK
( clear ) #00 ;draw-snake JSR2
( update ) ;move JSR2
( draw ) #02 .snake/dead LDZ + ;draw-snake JSR2
( draw ) #02 .snake/dead LDZ ADD ;draw-snake JSR2
#83 ;draw-apple JSR2
( score ) .snake/length LDZ #41 ;draw-score JSR2
( reset ) #00 .arena/timer STZ
@ -79,10 +65,10 @@ BRK
@on-button ( -> )
.Controller/button DEI
DUP #08 ! ,&no-escape JCN
DUP #08 NEQ ,&no-escape JCN
;reset JSR2
&no-escape
#04 SFT DUP #00 = ,&skip JCN
#04 SFT DUP #00 EQU ,&skip JCN
DUP .snake/direction STZ
&skip
POP
@ -94,8 +80,8 @@ BRK
#00 ;draw-snake JSR2
#00 ;draw-apple JSR2
.arena/w LDZ 2/ #01 - .snake/x STZ
.arena/h LDZ 2/ #01 - .snake/y STZ
.arena/w LDZ #01 SFT #01 SUB .snake/x STZ
.arena/h LDZ #01 SFT #01 SUB .snake/y STZ
#00 .snake/dead STZ
#00 .snake/length STZ
#00 .snake/direction STZ
@ -103,7 +89,7 @@ BRK
#03 ;draw-snake JSR2
;add-apple JSR2
RTN
JMP2r
@move ( -- )
@ -111,33 +97,33 @@ RTN
.snake/x LDZ2 STH2
.snake/length LDZ #00
&loop
( pop ) DUP 2* .snake/tail + LDZ2 STH2 SWP2r
( push ) DUP 2* .snake/tail + STH2r ROT STZ2
( pop ) DUPk ADD .snake/tail ADD LDZ2 STH2 SWP2r
( push ) DUPk ADD .snake/tail ADD STH2r ROT STZ2
INC GTHk ,&loop JCN
POP2
POP2r
.snake/dead LDZ #00 = JMP RTN
.snake/dead LDZ #00 EQU JMP JMP2r
.snake/direction LDZ
DUP #01 ! ,&no-up JCN
.snake/y LDZ #01 -
.arena/h LDZ MAX
DUP #01 NEQ ,&no-up JCN
.snake/y LDZ #01 SUB
.arena/h LDZ LTHk JMP SWP POP
.snake/y STZ
&no-up
DUP #02 ! ,&no-down JCN
DUP #02 NEQ ,&no-down JCN
.snake/y LDZ INC
.arena/h LDZ MOD
.arena/h LDZ DIVk MUL SUB
.snake/y STZ
&no-down
DUP #04 ! ,&no-left JCN
.snake/x LDZ #01 -
.arena/w LDZ MAX
DUP #04 NEQ ,&no-left JCN
.snake/x LDZ #01 SUB
.arena/w LDZ LTHk JMP SWP POP
.snake/x STZ
&no-left
DUP #08 ! ,&no-right JCN
DUP #08 NEQ ,&no-right JCN
.snake/x LDZ INC
.arena/w LDZ MOD
.arena/w LDZ DIVk MUL SUB
.snake/x STZ
&no-right
POP
@ -152,7 +138,7 @@ RTN
.snake/length LDZ #01
&loop-body
( pop ) DUP 2* .snake/tail + LDZ2
( pop ) DUPk ADD .snake/tail ADD LDZ2
.snake/x LDZ2 NEQ2 ,&no-collision-body JCN
#01 .snake/dead STZ
#03 ;draw-snake JSR2
@ -160,16 +146,16 @@ RTN
INC GTHk ,&loop-body JCN
POP2
RTN
JMP2r
@add-apple ( -- )
.DateTime/hour DEI2 .DateTime/minute DEI2 MUL2 #1234 MUL2 +
.arena/w LDZ MOD .apple/x STZ
.DateTime/hour DEI2 .DateTime/minute DEI2 MUL2 #abcd MUL2 +
.arena/h LDZ MOD .apple/y STZ
.DateTime/hour DEI2 .DateTime/minute DEI2 MUL2 #1234 MUL2 ADD
.arena/w LDZ DIVk MUL SUB .apple/x STZ
.DateTime/hour DEI2 .DateTime/minute DEI2 MUL2 #abcd MUL2 ADD
.arena/h LDZ DIVk MUL SUB .apple/y STZ
RTN
JMP2r
@draw-snake ( color -- )
@ -178,41 +164,41 @@ RTN
;snake-icns .Screen/addr DEO2
.snake/length LDZ #00
&loop
DUP 2* .snake/tail + LDZ TOS 8** .Screen/x DEO2
DUP 2* .snake/tail + INC LDZ TOS 8** .Screen/y DEO2
DUPk ADD .snake/tail ADD LDZ #0005 SFT2 .Screen/x DEO2
DUPk ADD .snake/tail ADD INC LDZ #0005 SFT2 .Screen/y DEO2
STHkr .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
( draw head )
.snake/x LDZ TOS 8** .Screen/x DEO2
.snake/y LDZ TOS 8** .Screen/y DEO2
.snake/x LDZ #0005 SFT2 .Screen/x DEO2
.snake/y LDZ #0005 SFT2 .Screen/y DEO2
;snake-icns/face .Screen/addr DEO2
STHr .Screen/sprite DEO
RTN
JMP2r
@draw-apple ( color -- )
.apple/x LDZ TOS 8** .Screen/x DEO2
.apple/y LDZ TOS 8** .Screen/y DEO2
.apple/x LDZ #0005 SFT2 .Screen/x DEO2
.apple/y LDZ #0005 SFT2 .Screen/y DEO2
;apple-chr .Screen/addr DEO2
.Screen/sprite DEO
RTN
JMP2r
@draw-score ( score color -- )
STH
#0010 .Screen/x DEO2
#0010 .Screen/y DEO2
DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
DUP #04 SFT #0005 SFT2 ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
#0f AND #0005 SFT2 ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
( draw ) STHr .Screen/sprite DEO
RTN
JMP2r
( assets )

417
projects/examples/demos/theme.tal
View File

@ -1,417 +0,0 @@
( Dev/Screen )
%RTN { JMP2r }
%++ { INC2 }
%2// { #01 SFT2 }
%4// { #02 SFT2 }
%4** { #20 SFT2 }
%8** { #30 SFT2 }
%8+ { #0008 ADD2 }
%STEP8 { #33 SFT2 }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
( variables )
|0000
@color $1
@selection $1
@center [ &x $2 &y $2 ]
@pointer [ &x $2 &y $2 ]
@rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@window [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 &w $2 &h $2 ]
@slider [ &x1 $2 &y $2 &x2 $2 &pos $2 ]
@theme [
&r1 $1 &r2 $1 &r3 $1 &r4 $1
&g1 $1 &g2 $1 &g3 $1 &g4 $1
&b1 $1 &b2 $1 &b3 $1 &b4 $1
]
( program )
|0100 ( -> )
( theme )
#027f .System/r DEO2
#04e7 .System/g DEO2
#06c4 .System/b DEO2
( vectors )
;on-mouse .Mouse/vector DEO2
( size window )
#00b0 .window/w STZ2
#0050 .window/h STZ2
( center window )
.Screen/width DEI2 2// .window/w LDZ2 2// SUB2 .window/x1 STZ2
.Screen/height DEI2 2// .window/h LDZ2 2// SUB2 .window/y1 STZ2
#01 .theme/r1 STZ #02 .theme/g1 STZ #03 .theme/b1 STZ
#04 .theme/r2 STZ #06 .theme/g2 STZ #07 .theme/b2 STZ
#0a .theme/r3 STZ #09 .theme/g3 STZ #08 .theme/b3 STZ
#0c .theme/r4 STZ #0b .theme/g4 STZ #0d .theme/b4 STZ
( find screen center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
;update-theme JSR2
;draw-background JSR2
;draw-window JSR2
BRK
@on-mouse ( -> )
;draw-cursor JSR2
.Mouse/state DEI #01 JCN [ BRK ]
.Mouse/y DEI2 .window/y1 LDZ2 SUB2 STEP8
DUP2 #0010 NEQ2 ,&no-touch-red JCN
.Mouse/x DEI2 .window/x1 LDZ2 #0060 ADD2 LTH2 ,&no-touch-red JCN
.Mouse/x DEI2 .window/x1 LDZ2 #009c ADD2 GTH2 ,&no-touch-red JCN
( get new value ) .Mouse/x DEI2 .window/x1 LDZ2 SUB2 #0060 SUB2 4// NIP ;theme/r1 #00 .selection LDZ ADD2 STA
&no-touch-red
DUP2 #0020 NEQ2 ,&no-touch-green JCN
.Mouse/x DEI2 .window/x1 LDZ2 #0060 ADD2 LTH2 ,&no-touch-green JCN
.Mouse/x DEI2 .window/x1 LDZ2 #009c ADD2 GTH2 ,&no-touch-green JCN
( get new value ) .Mouse/x DEI2 .window/x1 LDZ2 SUB2 #0060 SUB2 4// NIP ;theme/g1 #00 .selection LDZ ADD2 STA
&no-touch-green
DUP2 #0030 NEQ2 ,&no-touch-blue JCN
.Mouse/x DEI2 .window/x1 LDZ2 #0060 ADD2 LTH2 ,&no-touch-blue JCN
.Mouse/x DEI2 .window/x1 LDZ2 #009c ADD2 GTH2 ,&no-touch-blue JCN
( get new value ) .Mouse/x DEI2 .window/x1 LDZ2 SUB2 #0060 SUB2 4// NIP ;theme/b1 #00 .selection LDZ ADD2 STA
&no-touch-blue
DUP2 #0040 NEQ2 ,&no-touch-radio JCN
.Mouse/x DEI2 .window/x1 LDZ2 #0050 ADD2 LTH2 ,&no-touch-radio JCN
.Mouse/x DEI2 .window/x1 LDZ2 #008c ADD2 GTH2 ,&no-touch-radio JCN
.Mouse/x DEI2 .window/x1 LDZ2 SUB2 #0050 SUB2 STEP8 2// #0008 DIV2 NIP .selection STZ
&no-touch-radio
POP2
;update-theme JSR2
;draw-cursor JSR2
;draw-background JSR2
;draw-window JSR2
BRK
@update-theme ( -- )
#08 DEI #0f AND .theme/r1 LDZ #40 SFT ADD #08 DEO
#0a DEI #0f AND .theme/g1 LDZ #40 SFT ADD #0a DEO
#0c DEI #0f AND .theme/b1 LDZ #40 SFT ADD #0c DEO
#08 DEI #f0 AND .theme/r2 LDZ ADD #08 DEO
#0a DEI #f0 AND .theme/g2 LDZ ADD #0a DEO
#0c DEI #f0 AND .theme/b2 LDZ ADD #0c DEO
#09 DEI #0f AND .theme/r3 LDZ #40 SFT ADD #09 DEO
#0b DEI #0f AND .theme/g3 LDZ #40 SFT ADD #0b DEO
#0d DEI #0f AND .theme/b3 LDZ #40 SFT ADD #0d DEO
#09 DEI #f0 AND .theme/r4 LDZ ADD #09 DEO
#0b DEI #f0 AND .theme/g4 LDZ ADD #0b DEO
#0d DEI #f0 AND .theme/b4 LDZ ADD #0d DEO
RTN
@draw-background ( -- )
( draw hor line )
#0000 .Screen/x DEO2 .center/y LDZ2 .Screen/y DEO2
.Screen/width DEI2 #0000 ( to/from )
&draw-hor
( draw ) #01 .Screen/pixel DEO
( incr ) #0002 ADD2 DUP2 .Screen/x DEO2
GTH2k ,&draw-hor JCN
POP2 POP2
( draw ver line )
.center/x LDZ2 .Screen/x DEO2 #0000 .Screen/y DEO2
.Screen/height DEI2 #0000 ( to/from )
&draw-ver
( draw ) #02 .Screen/pixel DEO
( incr ) #0002 ADD2 DUP2 .Screen/y DEO2
GTH2k ,&draw-ver JCN
POP2 POP2
( draw blending modes )
;preview_icn .Screen/addr DEO2
#0010 .Screen/y DEO2
#0800
&draw-pixel1
( move ) #00 OVR #30 SFT #0010 ADD2 .Screen/x DEO2
( draw ) DUP .Screen/pixel DEO
( incr ) INC
GTHk ,&draw-pixel1 JCN
POP2
#0018 .Screen/y DEO2
#0800
&draw-pixel2
( move ) #00 OVR #30 SFT #0010 ADD2 .Screen/x DEO2
( draw ) DUP #08 ADD .Screen/pixel DEO
( incr ) INC
GTHk ,&draw-pixel2 JCN
POP2
#0020 .Screen/y DEO2
#0800
&draw-icn1
( move ) #00 OVR #30 SFT #0010 ADD2 .Screen/x DEO2
( draw ) DUP .Screen/sprite DEO
( incr ) INC
GTHk ,&draw-icn1 JCN
POP2
#0028 .Screen/y DEO2
#0800
&draw-icn2
( move ) #00 OVR #30 SFT #0010 ADD2 .Screen/x DEO2
( draw ) DUP #08 ADD .Screen/sprite DEO
( incr ) INC
GTHk ,&draw-icn2 JCN
POP2
#0030 .Screen/y DEO2
#0800
&draw-chr1
( move ) #00 OVR #30 SFT #0010 ADD2 .Screen/x DEO2
( draw ) DUP #80 ADD .Screen/sprite DEO
( incr ) INC
GTHk ,&draw-chr1 JCN
POP2
#0038 .Screen/y DEO2
#0800
&draw-chr2
( move ) #00 OVR #30 SFT #0010 ADD2 .Screen/x DEO2
( draw ) DUP #88 ADD .Screen/sprite DEO
( incr ) INC
GTHk ,&draw-chr2 JCN
POP2
RTN
@draw-window ( -- )
.window/x1 LDZ2 .window/w LDZ2 ADD2 .window/x2 STZ2
.window/y1 LDZ2 .window/h LDZ2 ADD2 .window/y2 STZ2
.window/x1 LDZ2 .window/y1 LDZ2 .window/x2 LDZ2 .window/y2 LDZ2 #02 ;fill-rect JSR2
.window/x1 LDZ2 .window/y1 LDZ2 .window/x2 LDZ2 .window/y2 LDZ2 #01 ;line-rect JSR2
.window/x1 LDZ2 #0002 SUB2 .window/y1 LDZ2 #0002 SUB2 .window/x2 LDZ2 #0002 ADD2 .window/y2 LDZ2 #0002 ADD2 #01 ;line-rect JSR2
.window/x1 LDZ2 #0008 ADD2 .window/y1 LDZ2 #0010 ADD2 ;red_txt #05 ;draw-label JSR2
.window/x1 LDZ2 #0038 ADD2 .Screen/x DEO2
.System/r DEI2 #08 ;draw-short JSR2
.window/x1 LDZ2 #0008 ADD2 .window/y1 LDZ2 #0020 ADD2 ;green_txt #05 ;draw-label JSR2
.window/x1 LDZ2 #0038 ADD2 .Screen/x DEO2
.System/g DEI2 #08 ;draw-short JSR2
.window/x1 LDZ2 #0008 ADD2 .window/y1 LDZ2 #0030 ADD2 ;blue_txt #05 ;draw-label JSR2
.window/x1 LDZ2 #0038 ADD2 .Screen/x DEO2
.System/b DEI2 #08 ;draw-short JSR2
.window/x1 LDZ2 #0060 ADD2 .window/y1 LDZ2 #0010 ADD2 .window/x1 LDZ2 #0090 ADD2 #00 ;theme/r1 .selection LDZ ADD LDA 4** #01 ;draw-slider JSR2
.window/x1 LDZ2 #0060 ADD2 .window/y1 LDZ2 #0020 ADD2 .window/x1 LDZ2 #0090 ADD2 #00 ;theme/g1 .selection LDZ ADD LDA 4** #01 ;draw-slider JSR2
.window/x1 LDZ2 #0060 ADD2 .window/y1 LDZ2 #0030 ADD2 .window/x1 LDZ2 #0090 ADD2 #00 ;theme/b1 .selection LDZ ADD LDA 4** #01 ;draw-slider JSR2
.window/x1 LDZ2 #0050 ADD2 .Screen/x DEO2
.window/y1 LDZ2 #0040 ADD2 .Screen/y DEO2
;radio_icns #00 .selection LDZ #00 EQU 8** ADD2 .Screen/addr DEO2
#05 .Screen/sprite DEO
.window/x1 LDZ2 #0060 ADD2 .Screen/x DEO2
.window/y1 LDZ2 #0040 ADD2 .Screen/y DEO2
;radio_icns #00 .selection LDZ #01 EQU 8** ADD2 .Screen/addr DEO2
#05 .Screen/sprite DEO
.window/x1 LDZ2 #0070 ADD2 .Screen/x DEO2
.window/y1 LDZ2 #0040 ADD2 .Screen/y DEO2
;radio_icns #00 .selection LDZ #02 EQU 8** ADD2 .Screen/addr DEO2
#05 .Screen/sprite DEO
.window/x1 LDZ2 #0080 ADD2 .Screen/x DEO2
.window/y1 LDZ2 #0040 ADD2 .Screen/y DEO2
;radio_icns #00 .selection LDZ #03 EQU 8** ADD2 .Screen/addr DEO2
#05 .Screen/sprite DEO
RTN
@draw-cursor ( -- )
( clear last cursor )
;pointer_icn .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( record pointer positions )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#43 .Mouse/state DEI #00 NEQ DUP ADD SUB .Screen/sprite DEO
RTN
@draw-slider ( x1* y* x2* pos* color -- )
( load ) .color STZ .slider/pos STZ2 .slider/x2 STZ2 .slider/y STZ2 .slider/x1 STZ2
.slider/x1 LDZ2 .Screen/x DEO2
.slider/y LDZ2 .Screen/y DEO2
;halftone_icn .Screen/addr DEO2
;slidera_icn .Screen/addr DEO2
( draw ) #05 .Screen/sprite DEO
;sliderb_icn .Screen/addr DEO2
&loop
( incr ) .Screen/x DEI2 8+ .Screen/x DEO2
( draw ) #05 .Screen/sprite DEO
.Screen/x DEI2 .slider/x2 LDZ2 #0008 ADD2 LTH2 ,&loop JCN
( incr ) .Screen/x DEI2 #0004 ADD2 .Screen/x DEO2
;sliderc_icn .Screen/addr DEO2
( draw ) #05 .Screen/sprite DEO
.slider/x1 LDZ2 .slider/pos LDZ2 ADD2 .Screen/x DEO2
;sliderd_icn .Screen/addr DEO2
( draw ) #0a .Screen/sprite DEO
RTN
@fill-rect ( x1* y1* x2* y2* color -- )
.color STZ
STH2 ROT2 ROT2 STH2 ( x2 x1 / y2 y1 )
&ver
( save ) STH2kr .Screen/y DEO2
OVR2 OVR2
&hor
( save ) DUP2 .Screen/x DEO2
( draw ) .color LDZ .Screen/pixel DEO
( incr ) INC2
GTH2k ,&hor JCN
POP2 POP2
( incr ) INC2r
GTH2kr STHr ,&ver JCN
POP2 POP2 POP2r POP2r
RTN
@line-rect ( x1* y1* x2* y2* color -- )
( load ) .color STZ .rect/y2 STZ2 .rect/x2 STZ2 DUP2 .Screen/y DEO2 .rect/y1 STZ2 DUP2 .Screen/x DEO2 .rect/x1 STZ2
&hor
( incr ) .Screen/x DEI2 ++ .Screen/x DEO2
( draw ) .rect/y1 LDZ2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO
( draw ) .rect/y2 LDZ2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO
.Screen/x DEI2 .rect/x2 LDZ2 LTH2 ,&hor JCN
.rect/y1 LDZ2 .Screen/y DEO2
&ver
( draw ) .rect/x1 LDZ2 .Screen/x DEO2 .color LDZ .Screen/pixel DEO
( draw ) .rect/x2 LDZ2 .Screen/x DEO2 .color LDZ .Screen/pixel DEO
( incr ) .Screen/y DEI2 ++ .Screen/y DEO2
.Screen/y DEI2 .rect/y2 LDZ2 ++ LTH2 ,&ver JCN
RTN
@draw-label ( x* y* addr* color -- )
STH STH2
.Screen/y DEO2
.Screen/x DEO2
STH2r
&loop
LDAk #00 SWP 8**
;font ADD2 .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
( incr ) ++
( incr ) .Screen/x DEI2 8+ .Screen/x DEO2
LDAk ,&loop JCN
POP2 POPr
RTN
@draw-short ( short* color -- )
STH SWP
DUP #04 SFT #00 SWP 8** ;font-hex ADD2 .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND #00 SWP 8** ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 8+ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
DUP #04 SFT #00 SWP 8** ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 8+ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND #00 SWP 8** ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 8+ .Screen/x DEO2
( draw ) STHr .Screen/sprite DEO
RTN
@red_txt [ "Red 00 ]
@green_txt [ "Green 00 ]
@blue_txt [ "Blue 00 ]
@pointer_icn [ 80c0 e0f0 f8e0 1000 ]
@halftone_icn [ aa55 aa55 aa55 aa55 ]
@slidera_icn [ 3f7f ffff ffff 7f3f ]
@sliderb_icn [ ffff ffff ffff ffff ]
@sliderc_icn [ fcfe ffff ffff fefc ]
@sliderd_icn [ 003c 7e7e 7e7e 3c00 ]
@preview_icn
183c 66db db66 3c18
0000 183c 3c18 0000
@radio_icns
3c42 8181 8181 423c
3c42 99bd bd99 423c
@font-hex
003c 464a 5262 3c00 0018 0808 0808 1c00
003c 4202 3c40 7e00 003c 421c 0242 3c00
000c 1424 447e 0400 007e 407c 0242 3c00
003c 407c 4242 3c00 007e 0204 0810 1000
003c 423c 4242 3c00 003c 4242 3e02 3c00
003c 4242 7e42 4200 007c 427c 4242 7c00
003c 4240 4042 3c00 007c 4242 4242 7c00
007e 4078 4040 7e00 007e 4078 4040 4000
@font ( spectrum-zx font )
0000 0000 0000 0000 0000 2400 7e3c 0000 0000 2400 3c42 0000 0000 6c7c 7c38 1000
0010 387c 7c38 1000 0038 387c 6c10 3800 0010 387c 7c10 3800 0000 0018 1800 0000
007e 4242 4242 7e00 0000 1824 2418 0000 0018 2442 4224 1800 001e 063a 4a48 3000
0038 446c 107c 1000 000c 0808 0838 3800 003e 2222 2266 6600 0000 0822 0022 0800
0000 1018 1c18 1000 0000 0818 3818 0800 0008 1c00 001c 0800 0028 2828 2800 2800
003e 4a4a 3a0a 0a00 000c 3046 620c 3000 0000 0000 0000 ffff 0010 3800 3810 0038
0008 1c2a 0808 0800 0008 0808 2a1c 0800 0000 0804 7e04 0800 0000 1020 7e20 1000
0000 4040 7e00 0000 0000 0024 6624 0000 0000 1038 7c00 0000 0000 007c 3810 0000
0000 0000 0000 0000 0008 0808 0800 0800 0014 1400 0000 0000 0024 7e24 247e 2400
0008 1e28 1c0a 3c08 0042 0408 1020 4200 0030 4832 4c44 3a00 0008 1000 0000 0000
0004 0808 0808 0400 0010 0808 0808 1000 0000 1408 3e08 1400 0000 0808 3e08 0800
0000 0000 0008 0810 0000 0000 3c00 0000 0000 0000 0000 0800 0000 0204 0810 2000
003c 464a 5262 3c00 0018 2808 0808 3e00 003c 4202 3c40 7e00 003c 421c 0242 3c00
0008 1828 487e 0800 007e 407c 0242 3c00 003c 407c 4242 3c00 007e 0204 0810 1000
003c 423c 4242 3c00 003c 4242 3e02 3c00 0000 0008 0000 0800 0000 0800 0008 0810
0000 0810 2010 0800 0000 003e 003e 0000 0000 1008 0408 1000 003c 4202 0c00 0800
003c 425a 5442 3c00 0018 2442 7e42 4200 007c 427c 4242 7c00 003c 4240 4042 3c00
0078 4442 4244 7800 007e 407c 4040 7e00 003e 4040 7c40 4000 003c 4240 4e42 3c00
0042 427e 4242 4200 003e 0808 0808 3e00 0002 0202 4242 3c00 0044 4870 4844 4200
0040 4040 4040 7e00 0042 665a 4242 4200 0042 6252 4a46 4200 003c 4242 4242 3c00
007c 4242 7c40 4000 003c 4242 524a 3c00 007c 4242 7c44 4200 003c 403c 0242 3c00
00fe 1010 1010 1000 0042 4242 4242 3c00 0042 4242 4224 1800 0042 4242 5a66 4200
0042 2418 1824 4200 0082 4428 1010 1000 007e 0408 1020 7e00 000c 0808 0808 0c00
0040 2010 0804 0200 0018 0808 0808 1800 0008 1422 0000 0000 0000 0000 0000 7e00
0008 0400 0000 0000 0000 1c02 1e22 1e00 0020 203c 2222 3c00 0000 1e20 2020 1e00
0002 021e 2222 1e00 0000 1c22 3c20 1e00 000c 101c 1010 1000 0000 1c22 221e 021c
0020 202c 3222 2200 0008 0018 0808 0400 0008 0008 0808 4830 0020 2428 3028 2400
0010 1010 1010 0c00 0000 6854 5454 5400 0000 5864 4444 4400 0000 3844 4444 3800
0000 7844 4478 4040 0000 3c44 443c 0406 0000 2c30 2020 2000 0000 3840 3804 7800
0010 103c 1010 0c00 0000 4444 4444 3800 0000 4444 2828 1000 0000 4454 5454 2800
0000 4428 1028 4400 0000 4444 443c 0438 0000 7c08 1020 7c00 000c 0810 1008 0c00
0008 0808 0808 0800 0030 1008 0810 3000 0000 0032 4c00 0000 3c42 99a1 a199 423c

255
projects/examples/demos/wireworld.tal Normal file
View File

@ -0,0 +1,255 @@
(
wireworld
A - conductor
B - tail
Sel - head
Start - clear
mouse1 - paint
mouse2 - erase
RULES:
- electron head<3>, becomes electron tail<2>
- electron tail<2>, becomes conductor<1>
- conductor<1>, becomes electron head<3>
if there are exactly 1 or 2 electron heads around it. )
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $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 &func $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2
|0000
@color $1
@pointer &x $2 &y $2
@timer &frame $1 &play $1
( program )
|0100 ( -> )
( theme )
#07fe .System/r DEO2
#07b6 .System/g DEO2
#0fc6 .System/b DEO2
( size )
#0100 .Screen/width DEO2
#0100 .Screen/height DEO2
( vectors )
;on-frame .Screen/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-button .Controller/vector DEO2
( setup )
#01 .timer/play STZ
#01 .color STZ
( start )
;world ;get-addr/current STA2
#1000 ;run/future STA2
;redraw JSR2
BRK
@on-frame ( -> )
.timer/play LDZ JMP BRK
( every 4th )
.timer/frame LDZk
#03 AND ,&no-run JCN
;run JSR2
&no-run
LDZk INC SWP STZ
BRK
@on-mouse ( -> )
;pointer-icn .Screen/addr DEO2
( clear last cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( draw new cursor )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#40 .color LDZ ADD .Screen/sprite DEO
( paint )
.Mouse/state DEI ,on-mouse-down JCN
BRK
@on-mouse-down ( -> )
.Mouse/x DEI2 #03 SFT2 NIP
.Mouse/y DEI2 #03 SFT2 NIP
#0202 NEQ2k NIP2 ,&no-color1 JCN
#01 .color STZ
#00 .Mouse/state DEO
POP2 BRK
&no-color1
#0302 NEQ2k NIP2 ,&no-color2 JCN
#02 .color STZ
#00 .Mouse/state DEO
POP2 BRK
&no-color2
#0402 NEQ2k NIP2 ,&no-color3 JCN
#03 .color STZ
#00 .Mouse/state DEO
POP2 BRK
&no-color3
#0602 NEQ2k NIP2 ,&no-toggle JCN
.timer/play LDZk #00 EQU SWP STZ
#00 .Mouse/state DEO
;draw-ui JSR2
POP2 BRK
&no-toggle
POP2
( color ) .color LDZ .Mouse/state DEI #01 GTH #00 EQU MUL
( cell* ) .Mouse/x DEI2 #02 SFT2 NIP .Mouse/y DEI2 #02 SFT2 NIP
;get-addr JSR2 STA
;redraw JSR2
BRK
@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
@on-button ( -> )
.Controller/button DEI
[ #01 ] NEQk NIP ,&no-a JCN #01 .color STZ &no-a
[ #02 ] NEQk NIP ,&no-b JCN #02 .color STZ &no-b
[ #04 ] NEQk NIP ,&no-select JCN #03 .color STZ &no-select
[ #08 ] NEQk NIP ,&no-start JCN ;world #2000 ;mclr JSR2 ;redraw JSR2 &no-start
POP
( space )
.Controller/key DEI #20 NEQ ,&no-space JCN .timer/play LDZk #00 EQU SWP STZ &no-space
BRK
@draw-ui ( -- )
( colors )
#01 .Screen/auto DEO
#0010 DUP2 .Screen/x DEO2 .Screen/y DEO2
;color-icn .Screen/addr DEO2
#01 .Screen/sprite DEO
#02 .Screen/sprite DEO
#03 .Screen/sprite DEO
( toggle )
#0030 .Screen/x DEO2
;toggle-icn #00 .timer/play LDZ #30 SFT2 ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
JMP2r
@redraw ( -- )
;cell-icn .Screen/addr DEO2
#4000
&ver
#00 OVR #20 SFT2 .Screen/y DEO2
STHk
#4000
&hor
#00 OVR #20 SFT2 .Screen/x DEO2
DUP STHkr ,get-addr JSR LDA .Screen/sprite DEO
INC GTHk ,&hor JCN
POP2
POPr
INC GTHk ,&ver JCN
POP2
;draw-ui JSR2
JMP2r
@run ( -- )
#40 #00
&ver
STHk
#40 #00
&hor
( x,y ) DUP STHkr
( cell ) DUP2 ,get-addr JSR STH2k LDA
( transform ) ,transform JSR STH2r [ LIT2 &future $2 ] ADD2 STA
INC GTHk ,&hor JCN
POP2
POPr
INC GTHk ,&ver JCN
POP2
( Swap worlds )
;get-addr/current LDA2k ;run/future LDA2 STH2k ADD2 SWP2 STA2
#0000 STH2r SUB2 ;run/future STA2
,redraw JSR
JMP2r
@get-addr ( x y -- addr* )
#00 SWP #60 SFT2 ROT #00 SWP ADD2 [ LIT2 &current $2 ] ADD2
JMP2r
@transform ( xy cell -- cell )
DUP ,&no-null JCN NIP NIP JMP2r &no-null
DUP #03 NEQ ,&no-head JCN POP POP2 #02 JMP2r &no-head
DUP #02 NEQ ,&no-tail JCN POP POP2 #01 JMP2r &no-tail
DUP #01 NEQ ,&no-cond JCN POP
LITr 00
DUP2 #01 SUB ,get-addr JSR
( tl ) #0001 SUB2 LDAk #03 NEQ JMP INCr
( tc ) INC2 LDAk #03 NEQ JMP INCr
( tr ) INC2 LDA #03 NEQ JMP INCr
DUP2 ,get-addr JSR
( ml ) #0001 SUB2 LDAk #03 NEQ JMP INCr
( mr ) INC2 INC2 LDA #03 NEQ JMP INCr
INC ,get-addr JSR
( bl ) #0001 SUB2 LDAk #03 NEQ JMP INCr
( bc ) INC2 LDAk #03 NEQ JMP INCr
( br ) INC2 LDA #03 NEQ JMP INCr
STHkr #02 EQU STHr #01 EQU ORA
DUP ADD INC JMP2r
&no-cond
( unknown )
NIP NIP
JMP2r
@mclr ( addr* len* -- )
OVR2 ADD2 SWP2
&loop
STH2k #00 STH2r STA
INC2 GTH2k ,&loop JCN
POP2 POP2
JMP2r
@pointer-icn
80c0 e0f0 f8e0 1000
@cell-icn
e0e0 e000 0000 0000
@color-icn
7cfe fefe fefe 7c00
@toggle-icn
( pause ) 6666 6666 6666 6600
( play ) 4666 767e 7666 4600
(
I live in the atom with the happy protons and neutrons.
I'm also so negative all the freakin time.
What do I do?
How do I find peace? )
@world

4
projects/examples/devices/audio.channels.tal
View File

@ -1,7 +1,5 @@
( dev/audio )
%MOD { DUP2 DIV MUL SUB }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
@ -57,7 +55,7 @@ BRK
( skip ) .timer LDZ #10 EQU #01 JCN [ BRK ]
( get note )
.counter LDZ #18 MOD #30 ADD
.counter LDZ #18 DIVk MUL SUB #30 ADD
.Audio0/pitch .counter LDZ #03 AND #40 SFT ADD DEO
.counter LDZ INC .counter STZ

38
projects/examples/devices/audio.tal
View File

@ -1,13 +1,7 @@
( dev/audio )
%2// { #01 SFT2 }
%4** { #20 SFT2 }
%8** { #30 SFT2 }
%20MOD { #1f AND }
%RTN { JMP2r }
%GET-NOTE { #00 SWP ;melody ADD2 LDA }
%GET-HEXCHAR { #00 SWP 8** ;font-hex ADD2 .Screen/addr DEO2 }
%GET-HEXCHAR { #00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2 }
( devices )
@ -44,8 +38,8 @@
#dd .Audio0/volume DEO ( TODO: turn ON )
( center )
.Screen/width DEI2 2// #0080 SUB2 .offset/x STZ2
.Screen/height DEI2 2// #0040 SUB2 .offset/y STZ2
.Screen/width DEI2 #01 SFT2 #0080 SUB2 .offset/x STZ2
.Screen/height DEI2 #01 SFT2 #0040 SUB2 .offset/y STZ2
;draw JSR2
#02 ;draw-selector JSR2
@ -71,12 +65,12 @@ BRK
&no-down
[ #04 ] NEQk NIP ,&no-left JCN
#00 ;draw-selector JSR2
.selection LDZ #01 SUB 20MOD .selection STZ
.selection LDZ #01 SUB #1f AND .selection STZ
#02 ;draw-selector JSR2
&no-left
[ #08 ] NEQk NIP ,&no-right JCN
#00 ;draw-selector JSR2
.selection LDZ INC 20MOD .selection STZ
.selection LDZ INC #1f AND .selection STZ
#02 ;draw-selector JSR2
&no-right
POP
@ -89,9 +83,9 @@ BRK
( skip ) .timer LDZ #10 EQU #01 JCN [ BRK ]
.progress LDZ
( play note ) DUP GET-NOTE .Audio0/pitch DEO
( erase last ) DUP #01 SUB 20MOD #01 ,draw-note JSR
( erase last ) DUP #01 SUB #1f AND #01 ,draw-note JSR
( draw current ) #01 ,draw-note JSR
( incr ) .progress LDZ INC 20MOD .progress STZ
( incr ) .progress LDZ INC #1f AND .progress STZ
#00 .timer STZ
BRK
@ -104,30 +98,30 @@ BRK
INC GTHk ,&loop JCN
POP2
RTN
JMP2r
@draw-note ( id color -- )
STH STH
( set x ) [ #00 STHkr ] 8** .offset/x LDZ2 ADD2 .Screen/x DEO2
( set y ) [ #00 #00 STHkr ;melody ADD2 LDA ] 4** #0100 SWP2 SUB2 .offset/y LDZ2 ADD2 #0080 ADD2 .Screen/y DEO2
( set x ) [ #00 STHkr ] #30 SFT2 .offset/x LDZ2 ADD2 .Screen/x DEO2
( set y ) [ #00 #00 STHkr ;melody ADD2 LDA ] #20 SFT2 #0100 SWP2 SUB2 .offset/y LDZ2 ADD2 #0080 ADD2 .Screen/y DEO2
( set addr ) ;marker-icn [ #00 .progress LDZ STHr EQU #08 MUL ADD2 ] .Screen/addr DEO2
( draw ) STHr .Screen/sprite DEO
RTN
JMP2r
@draw-selector ( color -- )
STH
[ #00 .selection LDZ ] 8** .offset/x LDZ2 ADD2 .Screen/x DEO2
[ #00 .selection LDZ ] #30 SFT2 .offset/x LDZ2 ADD2 .Screen/x DEO2
#0070 .offset/y LDZ2 ADD2 .Screen/y DEO2
;selector-icn .Screen/addr DEO2
STHkr .Screen/sprite DEO
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
.Screen/y DEI2k #0008 ADD2 ROT DEO2
.selection LDZ GET-NOTE STHr ,draw-byte JSR
RTN
JMP2r
@draw-byte ( byte color -- )
@ -139,7 +133,7 @@ RTN
#0f AND GET-HEXCHAR
( draw ) STHr .Screen/sprite DEO
RTN
JMP2r
@melody
54 52 54 4f 4b 4f 48 ff
@ -180,4 +174,4 @@ RTN
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
007c 8280 f080 827c 007c 8280 f080 8080

23
projects/examples/devices/console.echo.tal
View File

@ -1,23 +0,0 @@
( dev/console )
(
Copies data from stdin to both stdout and stderr.
)
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
( init )
|0100 ( -> )
;on-stdin .Console/vector DEO2
BRK
@on-stdin ( -> )
.Console/read DEI
DUP .Console/write DEO
.Console/error DEO
BRK

94
projects/examples/devices/console.lib.tal
View File

@ -1,94 +0,0 @@
( dev/console )
%RTN { JMP2r }
%PRINT { ;print JSR2 }
%BR { #0a .Console/write DEO }
( devices )
|10 @Console [ &pad $8 &write $1 ]
( variables )
|0000
@number [ &started $1 ]
( init )
|0100 ( -> )
;char-txt PRINT #42 .Console/write DEO BR
;byte-txt PRINT #ab ;print-byte JSR2 BR
;short-txt PRINT #cdef ;print-short JSR2 BR
;string-txt PRINT ;hello-word ;print JSR2 BR
;hello-word ;print JSR2
#ffff ;print-short JSR2
;is-word ;print JSR2
#ffff ;print-short-decimal JSR2
BRK
@print ( addr* -- )
&loop
( send ) LDAk .Console/write DEO
( incr ) INC2
( loop ) LDAk ,&loop JCN
POP2
RTN
@print-short ( short* -- )
LIT '0 .Console/write DEO
LIT 'x .Console/write DEO
OVR #04 SFT ,&hex JSR
SWP #0f AND ,&hex JSR
DUP #04 SFT ,&hex JSR
#0f AND ,&hex JMP
&hex
#30 ADD DUP #3a LTH ,&not-alpha JCN
#27 ADD
&not-alpha
.Console/write DEO
RTN
@print-byte ( byte -- )
LIT '0 .Console/write DEO
LIT 'x .Console/write DEO
DUP #04 SFT ,&hex JSR
#0f AND ,&hex JMP
&hex
#30 ADD DUP #39 GTH #27 MUL ADD .Console/write DEO
RTN
@print-short-decimal ( short -- )
#00 .number/started STZ
DUP2 #2710 DIV2 DUP2 ,&digit JSR #2710 MUL2 SUB2
DUP2 #03e8 DIV2 DUP2 ,&digit JSR #03e8 MUL2 SUB2
DUP2 #0064 DIV2 DUP2 ,&digit JSR #0064 MUL2 SUB2
DUP2 #000a DIV2 DUP2 ,&digit JSR #000a MUL2 SUB2
,&digit JSR
.number/started LDZ ,&end JCN
LIT '0 .Console/write DEO
&end
RTN
&digit
NIP
DUP .number/started LDZ ORA #02 JCN
POP JMP2r
LIT '0 ADD .Console/write DEO
#01 .number/started STZ
RTN
@char-txt "char: 20 $1
@byte-txt "byte: 20 $1
@short-txt "short: 20 $1
@string-txt "string: 20 $1
@hello-word "hello 20 "World! 0a 00
@is-word 20 "is 20 00

36
projects/examples/devices/console.tal
View File

@ -1,19 +1,37 @@
( dev/console )
( Console:
Prints Hello Uxn!, and listens for incoming stdin events on enter. )
%HALT { #010f DEO }
%EMIT { #18 DEO }
( init )
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|0100 ( -> )
;hello-word
( set vector )
;on-console .Console/vector DEO2
( print hello )
;hello-txt
&while
( send ) LDAk EMIT
LDAk .Console/write DEO
INC2 LDAk ,&while JCN
POP2
( stop ) HALT
BRK
@hello-word "Hello 20 "Uxn! $1
@on-console ( -> )
;yousaid-txt ,print-str JSR
.Console/read DEI .Console/write DEO
#0a .Console/write DEO
BRK
@print-str ( str* -- )
&while
LDAk #18 DEO
INC2 LDAk ,&while JCN
POP2
JMP2r
@hello-txt "Hello 20 "Uxn! $1
@yousaid-txt "You 20 "said: 20 $1

214
projects/examples/devices/controller.tal
View File

@ -1,67 +1,50 @@
( dev/controller/keys )
( Controller:
Buttons should highlight on press and display the button and key bytes. )
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%RTN { JMP2r }
%TOS { #00 SWP }
%LTS2 { #8000 ++ SWP2 #8000 ++ >> }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
( variables )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $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
|0000
@center
&x $2
&y $2
&x $2 &y $2
@frame
&w $2 &h $2
&x0 $2 &y0 $2
&x1 $2 &y1 $2
@color $1
@rect
&x1 $2 &y1 $2
&x2 $2 &y2 $2
( init )
&w $2 &h $2 &x0 $2 &y0 $2 &x1 $2 &y1 $2
|0100 ( -> )
( theme )
#0ff7 .System/r DEO2
#0f07 .System/g DEO2
#0f07 .System/b DEO2
( theme )
#0fff .System/r DEO2
#0f0f .System/g DEO2
#0f0f .System/b DEO2
( find center )
.Screen/width DEI2 #01 SFT2 .center/x STZ2
.Screen/height DEI2 #01 SFT2 .center/y STZ2
( place controller )
#0068 .frame/w STZ2
#0030 .frame/h STZ2
.center/x LDZ2 .frame/w LDZ2 #0002 // -- .frame/x0 STZ2
.center/y LDZ2 .frame/h LDZ2 #0002 // -- .frame/y0 STZ2
.frame/x0 LDZ2 .frame/w LDZ2 ++ .frame/x1 STZ2
.frame/y0 LDZ2 .frame/h LDZ2 ++ .frame/y1 STZ2
( vectors )
.center/x LDZ2 .frame/w LDZ2 #01 SFT2 SUB2 .frame/x0 STZ2
.center/y LDZ2 .frame/h LDZ2 #01 SFT2 SUB2 .frame/y0 STZ2
.frame/x0 LDZ2 .frame/w LDZ2 ADD2 .frame/x1 STZ2
.frame/y0 LDZ2 .frame/h LDZ2 ADD2 .frame/y1 STZ2
( vectors )
;on-button .Controller/vector DEO2
( frame )
.frame/x0 LDZ2 .frame/y0 LDZ2
.frame/x1 LDZ2 .frame/y1 LDZ2
#03 ;line-rect JSR2
;draw-controller JSR2
,draw-controller JSR
BRK
@on-button ( -> )
;draw-controller JSR2
,draw-controller JSR
( print stack on start button )
.Controller/button DEI #08 EQU [ JMP BRK ] #010e DEO
BRK
@ -69,101 +52,102 @@ BRK
.Controller/button DEI STH
( frame )
.frame/x0 LDZ2 .frame/y0 LDZ2
.frame/x1 LDZ2 .frame/y1 LDZ2
#01 ;line-rect JSR2
( d-pad )
.frame/x0 LDZ2 #0010 ++ .Screen/x DEO2
.frame/y0 LDZ2 #0010 ++ .Screen/y DEO2
.frame/x0 LDZ2 #0010 ADD2 .Screen/x DEO2
.frame/y0 LDZ2 #0010 ADD2 .Screen/y DEO2
;controller-icn/dpad-up .Screen/addr DEO2
#03 [ STHkr #04 SFT #01 AND DUP + - ] .Screen/sprite DEO
.Screen/y DEI2 #0010 ++ .Screen/y DEO2
#03 STHkr #04 SFT #01 AND SUB .Screen/sprite DEO
.Screen/y DEI2 #0010 ADD2 .Screen/y DEO2
;controller-icn/dpad-down .Screen/addr DEO2
#03 [ STHkr #05 SFT #01 AND DUP + - ] .Screen/sprite DEO
.Screen/y DEI2 #0008 -- .Screen/y DEO2
.Screen/x DEI2 #0008 -- .Screen/x DEO2
#03 STHkr #05 SFT #01 AND SUB .Screen/sprite DEO
.Screen/y DEI2 #0008 SUB2 .Screen/y DEO2
.Screen/x DEI2 #0008 SUB2 .Screen/x DEO2
;controller-icn/dpad-left .Screen/addr DEO2
#03 [ STHkr #06 SFT #01 AND DUP + - ] .Screen/sprite DEO
.Screen/x DEI2 #0010 ++ .Screen/x DEO2
#03 STHkr #06 SFT #01 AND SUB .Screen/sprite DEO
.Screen/x DEI2 #0010 ADD2 .Screen/x DEO2
;controller-icn/dpad-right .Screen/addr DEO2
#03 [ STHkr #07 SFT #01 AND DUP + - ] .Screen/sprite DEO
.Screen/x DEI2 #0008 -- .Screen/x DEO2
#03 STHkr #07 SFT #01 AND SUB .Screen/sprite DEO
.Screen/x DEI2 #0008 SUB2 .Screen/x DEO2
;controller-icn/dpad .Screen/addr DEO2
#03 .Screen/sprite DEO
( options )
.center/y LDZ2 #0009 ++ .Screen/y DEO2
.center/x LDZ2 #0009 -- .Screen/x DEO2
.center/y LDZ2 #0009 ADD2 .Screen/y DEO2
.center/x LDZ2 #0009 SUB2 .Screen/x DEO2
;controller-icn/option .Screen/addr DEO2
#03 [ STHkr #02 SFT #01 AND DUP + - ] .Screen/sprite DEO
.center/x LDZ2 #0004 ++ .Screen/x DEO2
#03 STHkr #03 SFT #01 AND SUB .Screen/sprite DEO
.center/x LDZ2 #0004 ADD2 .Screen/x DEO2
;controller-icn/option .Screen/addr DEO2
#03 [ STHkr #03 SFT #01 AND DUP + - ] .Screen/sprite DEO
#03 STHkr #02 SFT #01 AND SUB .Screen/sprite DEO
( buttons )
.center/y LDZ2 #0000 ++ .Screen/y DEO2
.center/x LDZ2 #0018 ++ .Screen/x DEO2
.center/y LDZ2 .Screen/y DEO2
.center/x LDZ2 #0018 ADD2 .Screen/x DEO2
;controller-icn/button .Screen/addr DEO2
#03 [ STHkr #01 SFT #01 AND - ] .Screen/sprite DEO
.Screen/y DEI2 #000a ++ .Screen/y DEO2
;font-hex #000b #30 SFT2 ++ .Screen/addr DEO2
#03 STHkr #01 SFT #01 AND SUB .Screen/sprite DEO
.Screen/y DEI2 #000a ADD2 .Screen/y DEO2
;font-hex/b .Screen/addr DEO2
#03 .Screen/sprite DEO
.center/y LDZ2 #0000 ++ .Screen/y DEO2
.center/x LDZ2 #0024 ++ .Screen/x DEO2
.center/y LDZ2 .Screen/y DEO2
.center/x LDZ2 #0024 ADD2 .Screen/x DEO2
;controller-icn/button .Screen/addr DEO2
#03 [ STHr #01 AND - ] .Screen/sprite DEO
.Screen/y DEI2 #000a ++ .Screen/y DEO2
;font-hex #000a #30 SFT2 ++ .Screen/addr DEO2
#03 STHr #01 AND SUB .Screen/sprite DEO
.Screen/y DEI2 #000a ADD2 .Screen/y DEO2
;font-hex/a .Screen/addr DEO2
#03 .Screen/sprite DEO
.center/x LDZ2 #0010 -- .Screen/x DEO2
.center/y LDZ2 #0010 -- .Screen/y DEO2
.Controller/button DEI2 #03 ;draw-short JSR2
.center/x LDZ2 #0010 SUB2 .Screen/x DEO2
.center/y LDZ2 #0010 SUB2 .Screen/y DEO2
#01 .Screen/auto DEO
.Controller/button DEI2 ,draw-short JSR
#00 .Screen/auto DEO
RTN
JMP2r
( generics )
@draw-short ( short* color -- )
@draw-short ( short* -- )
STH SWP
DUP #04 SFT TOS #30 SFT2 ;font-hex ++ .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND TOS #30 SFT2 ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
DUP #04 SFT TOS #30 SFT2 ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND TOS #30 SFT2 ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHr .Screen/sprite DEO
SWP ,draw-byte JSR
RTN
@draw-byte ( byte -- )
DUP #04 SFT ,draw-hex JSR
@draw-hex ( char -- )
#00 SWP #0f AND #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
#03 .Screen/sprite DEO
JMP2r
@line-rect ( x1* y1* x2* y2* color -- )
( load ) .color STZ DUP2 STH2 .rect/y2 STZ2 .rect/x2 STZ2 DUP2 STH2 .rect/y1 STZ2 .rect/x1 STZ2
STH2r INC2 STH2r
&ver
( save ) OVR2 .Screen/y DEO2
( draw ) .rect/x1 LDZ2 .Screen/x DEO2 .color LDZ DUP .Screen/pixel DEO
( draw ) .rect/x2 LDZ2 .Screen/x DEO2 .Screen/pixel DEO
( incr ) SWP2 INC2 SWP2
OVR2 OVR2 LTS2 ,&ver JCN
POP2 POP2
.rect/x1 LDZ2 INC2 .rect/x2 LDZ2 #0001 --
STH
DUP2 ,&ver-y2 STR2 ,&hor-y2 STR2
DUP2 ,&ver-x2 STR2 ,&hor-x2 STR2
DUP2 ,&ver-y1 STR2 ,&hor-y1 STR2
DUP2 ,&ver-x1 STR2 ,&hor-x1 STR2
( horizontal )
[ LIT2 &hor-x2 $2 ] INC2 [ LIT2 &hor-x1 $2 ]
&hor
( save ) OVR2 .Screen/x DEO2
( draw ) .rect/y1 LDZ2 .Screen/y DEO2 .color LDZ DUP .Screen/pixel DEO
( draw ) .rect/y2 LDZ2 .Screen/y DEO2 .Screen/pixel DEO
( incr ) SWP2 INC2 SWP2
OVR2 OVR2 INC2 LTS2 ,&hor JCN
DUP2 .Screen/x DEO2
[ LIT2 &hor-y1 $2 ] .Screen/y DEO2 STHkr .Screen/pixel DEOk
[ LIT2 &hor-y2 $2 ] .Screen/y DEO2 DEO
INC2 GTH2k ,&hor JCN
POP2 POP2
( vertical )
[ LIT2 &ver-y2 $2 ] [ LIT2 &ver-y1 $2 ]
&ver
DUP2 .Screen/y DEO2
[ LIT2 &ver-x1 $2 ] .Screen/x DEO2 STHkr .Screen/pixel DEOk
[ LIT2 &ver-x2 $2 ] .Screen/x DEO2 DEO
INC2 GTH2k ,&ver JCN
POP2 POP2
POPr
RTN
JMP2r
@controller-icn
&dpad ffff ffff ffff ffff
@ -174,12 +158,12 @@ RTN
&option 0000 7eff ff7e 0000
&button 3c7e ffff ffff 7e3c
@font-hex
003c 4242 4242 3c00 0018 0808 0808 1c00
003c 4202 3c40 7e00 003c 421c 0242 3c00
000c 1424 447e 0400 007e 407c 0242 3c00
003c 407c 4242 3c00 007e 0204 0810 1000
003c 423c 4242 3c00 003c 4242 3e02 3c00
003c 4242 7e42 4200 007c 427c 4242 7c00
003c 4240 4042 3c00 007c 4242 4242 7c00
007e 4078 4040 7e00 007e 4078 4040 4000
@font-hex
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
007c 8280 fc82 827c 00fe 0202 0408 1010
007c 8282 7c82 827c 007c 8282 7e02 827c
&a 007c 8202 7e82 827e &b 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
00fe 8080 fe80 80fe 00fe 8080 f080 8080

133
projects/examples/devices/file.load.tal
View File

@ -1,133 +0,0 @@
( simple Dev/File reading example )
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
( variables )
|0000
( program )
|0100 ( -> )
;try-load JSR2
BRK
@try-load ( -- )
( load contents from file )
#1000 .File/length DEO2
;filename .File/name DEO2
;contents .File/read DEO2
.File/success DEI2 ORA ,&success JCN
( failed to read: bright yellow background )
#f0f7 .System/r DEO2
#f0f7 .System/g DEO2
#00f7 .System/b DEO2
JMP2r
&success
( read successful: dark blue background, show contents )
#00f7 .System/r DEO2
#00f7 .System/g DEO2
#40f7 .System/b DEO2
;contents DUP2 .File/success DEI2 ADD2 SWP2 ;draw JSR2
JMP2r
@draw ( end-ptr* ptr* -- )
EQU2k ,&end JCN
LDAk
DUP #0a EQU ,&linefeed JCN
#0005 SFT2 ;font ADD2
.Screen/addr DEO2
#09 .Screen/sprite DEO
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
&next
INC2
,draw JMP
&linefeed
POP
#0000 .Screen/x DEO2
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
,&next JMP
&end
POP2 POP2
JMP2r
@get-x-advance ( font-char-addr* -- advance* )
( Save two 00 bytes for later use )
#0000 SWP2
( First, load the eight bytes that make up the character )
LDA2k SWP2 #0002 ADD2
LDA2k SWP2 #0002 ADD2
LDA2k SWP2 #0002 ADD2
LDA2
( OR all the bytes together, so we know which columns contain filled pixels )
ORA2 ORA2 ORA2 ORA
( Find the lowest set bit (using one of the 00 bytes at the top, but not consuming it) )
SUBk AND
( Convert the nine possible values (00-80) into an offset into the magic table (00-08). )
( They get jumbled up with these two operations, but each possible value remains unique )
#a3 MUL #16 DIV
( Load the byte from the magic table, return a short (consuming/returning the 00 bytes at the top) )
;&magic ADD2 LDA
JMP2r
( The magic table performs the last bit of arithmetic we want:
* the advance in x should be one more than the number of columns with filled pixels,
* with a maximum of 8, and
* a minimum of 3. )
&magic
03 ( lowest set bit is 00, 0 columns wide )
06 ( lowest set bit is 08, 5 columns wide )
05 ( lowest set bit is 10, 4 columns wide )
08 ( lowest set bit is 02, 7 columns wide )
04 ( lowest set bit is 20, 3 columns wide )
03 ( lowest set bit is 80, 1 column wide )
07 ( lowest set bit is 04, 6 columns wide )
08 ( lowest set bit is 01, 8 columns wide )
03 ( lowest set bit is 40, 2 columns wide )
@font ( spectrum-zx font )
[
0000 0000 0000 0000 0000 2400 7e3c 0000 0000 2400 3c42 0000 0000 6c7c 7c38 1000
0010 387c 7c38 1000 0038 387c 6c10 3800 0010 387c 7c10 3800 0000 0018 1800 0000
007e 4242 4242 7e00 0000 1824 2418 0000 0018 2442 4224 1800 001e 063a 4a48 3000
0038 446c 107c 1000 000c 0808 0838 3800 003e 2222 2266 6600 0000 0822 0022 0800
0000 1018 1c18 1000 0000 0818 3818 0800 0008 1c00 001c 0800 0028 2828 2800 2800
003e 4a4a 3a0a 0a00 000c 3046 620c 3000 0000 0000 0000 ffff 0010 3800 3810 0038
0008 1c2a 0808 0800 0008 0808 2a1c 0800 0000 0804 7e04 0800 0000 1020 7e20 1000
0000 4040 7e00 0000 0000 0024 6624 0000 0000 1038 7c00 0000 0000 007c 3810 0000
0000 0000 0000 0000 0008 0808 0800 0800 0014 1400 0000 0000 0024 7e24 247e 2400
0008 1e28 1c0a 3c08 0042 0408 1020 4200 0030 4832 4c44 3a00 0008 1000 0000 0000
0004 0808 0808 0400 0010 0808 0808 1000 0000 1408 3e08 1400 0000 0808 3e08 0800
0000 0000 0008 0810 0000 0000 3c00 0000 0000 0000 0000 0800 0000 0204 0810 2000
003c 464a 5262 3c00 0018 2808 0808 3e00 003c 4202 3c40 7e00 003c 421c 0242 3c00
0008 1828 487e 0800 007e 407c 0242 3c00 003c 407c 4242 3c00 007e 0204 0810 1000
003c 423c 4242 3c00 003c 4242 3e02 3c00 0000 0008 0000 0800 0000 0800 0008 0810
0000 0810 2010 0800 0000 003e 003e 0000 0000 1008 0408 1000 003c 4202 0c00 0800
003c 425a 5442 3c00 0018 2442 7e42 4200 007c 427c 4242 7c00 003c 4240 4042 3c00
0078 4442 4244 7800 007e 407c 4040 7e00 003e 4040 7c40 4000 003c 4240 4e42 3c00
0042 427e 4242 4200 003e 0808 0808 3e00 0002 0202 4242 3c00 0044 4870 4844 4200
0040 4040 4040 7e00 0042 665a 4242 4200 0042 6252 4a46 4200 003c 4242 4242 3c00
007c 4242 7c40 4000 003c 4242 524a 3c00 007c 4242 7c44 4200 003c 403c 0242 3c00
00fe 1010 1010 1000 0042 4242 4242 3c00 0042 4242 4224 1800 0042 4242 5a66 4200
0042 2418 1824 4200 0082 4428 1010 1000 007e 0408 1020 7e00 000c 0808 0808 0c00
0040 2010 0804 0200 0018 0808 0808 1800 0008 1422 0000 0000 0000 0000 0000 7e00
0008 0400 0000 0000 0000 1c02 1e22 1e00 0020 203c 2222 3c00 0000 1e20 2020 1e00
0002 021e 2222 1e00 0000 1c22 3c20 1e00 000c 101c 1010 1000 0000 1c22 221e 021c
0020 202c 3222 2200 0008 0018 0808 0400 0008 0008 0808 4830 0020 2428 3028 2400
0010 1010 1010 0c00 0000 6854 5454 5400 0000 5864 4444 4400 0000 3844 4444 3800
0000 7844 4478 4040 0000 3c44 443c 0406 0000 2c30 2020 2000 0000 3840 3804 7800
0010 103c 1010 0c00 0000 4444 4444 3800 0000 4444 2828 1000 0000 4454 5454 2800
0000 4428 1028 4400 0000 4444 443c 0438 0000 7c08 1020 7c00 000c 0810 1008 0c00
0008 0808 0808 0800 0030 1008 0810 3000 0000 0032 4c00 0000 3c42 99a1 a199 423c
]
@filename "hello.txt 00
@contents

41
projects/examples/devices/file.save.tal
View File

@ -1,41 +0,0 @@
( simple Dev/File writing example )
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
( variables )
|0000
( init )
|0100 ( -> )
;try-save JSR2
BRK
@try-save ( -- )
( save contents to file )
;contents/end ;contents SUB2 .File/length DEO2
;filename .File/name DEO2
;contents .File/write DEO2
.File/success DEI2 ORA ,&success JCN
( failed to write: bright yellow background )
#f0f7 .System/r DEO2
#f0f7 .System/g DEO2
#00f7 .System/b DEO2
JMP2r
&success
( write successful: dark blue background )
#00f7 .System/r DEO2
#00f7 .System/g DEO2
#40f7 .System/b DEO2
JMP2r
@filename "hello.txt 00
@contents "Hello 20 "world, 0a "how 20 "are 20 "you? 0a
&end

149
projects/examples/devices/file.tal
View File

@ -1,78 +1,97 @@
( Dev/File )
( File:
Creates a temporary file called file-output.txt,
then read it back in console, print length and delete it. )
%8+ { #0008 ADD2 }
%MEMORY { #1000 }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|10 @Console [ &pad $8 &write $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
( variables )
|0000
( init )
|a0 @File0 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @File1 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|0100 ( -> )
( theme )
#0efc .System/r DEO2
#03cc .System/g DEO2
#03ac .System/b DEO2
( load file )
#1000 .File/length DEO2
;srcpath .File/name DEO2
MEMORY .File/read DEO2
.File/success DEI2 ORA ;on-success JCN2
;failedtxt ;print-string JSR2
( write a file with file0 )
;filepath-txt .File0/name DEO2
;part1 ,append JSR
;part2 ,append JSR
( close file before changing device )
.File0/name DEI2k ROT DEO2
( read a file with file1 )
;filepath-txt .File1/name DEO2
,stream JSR
( delete file with file0 )
;filepath-txt .File0/delete DEO2
BRK
@on-success ( -> )
;successtxt ;print-string JSR2
@append ( part* -- )
( draw image )
MEMORY .Screen/addr DEO2
#0000 #0080
&ver
( save ) OVR2 .Screen/y DEO2
#0000 #0080
&hor
( save ) OVR2 .Screen/x DEO2
( draw ) #81 .Screen/sprite DEO
( incr ) .Screen/addr DEI2 #0010 ADD2 .Screen/addr DEO2
( incr ) SWP2 8+ SWP2
LTH2k ,&hor JCN
POP2 POP2
( incr ) SWP2 8+ SWP2
LTH2k ,&ver JCN
POP2 POP2
( save file )
#1000 .File/length DEO2
;dstpath .File/name DEO2
MEMORY .File/write DEO2
DUP2 ;print-str JSR2
DUP2 ;slen JSR2 STH2k .File0/length DEO2
.File0/write DEO2
( print result )
;saved-txt ;print-str JSR2
STH2r ;print JSR2 #2018 DEO
;bytes-txt ;print-str JSR2 #0a18 DEO
BRK
JMP2r
@print-string ( ptr* -- )
LDAk DUP ,&keep-going JCN
POP POP2 JMP2r
@stream ( -- )
&keep-going
.Console/write DEO
INC2
,print-string JMP
#0001 .File1/length DEO2
LIT2r 0000
&stream
;&buf DUP2 .File1/read DEO2 LDA #18 DEO INC2r
.File1/success DEI2 #0000 NEQ2 ,&stream JCN
( print result )
;loaded-txt ;print-str JSR2
STH2r ;print JSR2 #2018 DEO
;bytes-txt ;print-str JSR2 #0a18 DEO
@successtxt "Success! 09 $1
@failedtxt "Failed. 09 $1
JMP2r
&buf $1
@srcpath "projects/pictures/ako10x10.chr $1
@dstpath "bin/image-copy.chr $1
@slen ( str* -- len* )
DUP2 ,scap JSR SWP2 SUB2
JMP2r
@scap ( str* -- end* )
LDAk #00 NEQ JMP JMP2r
&while INC2 LDAk ,&while JCN
JMP2r
@print ( short* -- )
&short ( 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
@saved-txt "Saved 20 $1
@loaded-txt "Loaded 20 $1
@bytes-txt "bytes. $1
@filepath-txt "file-output.txt $1
@part1
596f 7572 2073 6163 7265 6420 706c 616e
7473 2c20 6966 2068 6572 6520 6265 6c6f
772c 0a4f 6e6c 7920 616d 6f6e 6720 7468
6520 706c 616e 7473 2077 696c 6c20 6772
6f77 2e0a 00
@part2
536f 6369 6574 7920 6973 2061 6c6c 2062
7574 2072 7564 652c 0a54 6f20 7468 6973
2064 656c 6963 696f 7573 2073 6f6c 6974
7564 652e 0a

192
projects/examples/devices/mouse.tal
View File

@ -1,120 +1,168 @@
( dev/mouse )
( Mouse:
Paint with 3 colors with each mouse button. )
%RTN { JMP2r }
%ABS2 { DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 SUB2 }
%LTS2 { #8000 ADD2 SWP2 #8000 ADD2 GTH2 }
%GTS2 { #8000 ADD2 SWP2 #8000 ADD2 LTH2 }
%2** { #10 SFT2 }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2
|0000
@color $1
@line
&x0 $2 &y0 $2 &x $2 &y $2 &sx $2 &sy $2 &dx $2 &dy $2 &e1 $2 &e2 $2
@pointer
&x $2 &y $2 &lastx $2 &lasty $2 &state $1
( program )
@line
&x $2 &y $2 &dx $2 &dy $2 &e1 $2
@length $2
@frame $2
@pen
&x $2 &y $2 &x2 $2 &y2 $2
@pointer
&x $2 &y $2 &lastx $2 &lasty $2 &state $1
|0100 ( -> )
( theme )
#f030 .System/r DEO2
#f04f .System/g DEO2
#f050 .System/b DEO2
( theme )
#4cfd .System/r DEO2
#4cf3 .System/g DEO2
#dcf2 .System/b DEO2
( vectors )
( vectors )
;on-mouse .Mouse/vector DEO2
;on-frame .Screen/vector DEO2
BRK
@on-frame ( -> )
.Mouse/state DEI ,&skip JCN
;run DUP2 JSR2 JSR2
&skip
BRK
@on-mouse ( -> )
;draw-cursor JSR2
;pointer-icn .Screen/addr DEO2
( clear last cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( draw new cursor )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#42 .Mouse/state DEI #00 NEQ ADD .Screen/sprite DEO
( on down )
.Mouse/state DEI #00 NEQ .pointer/state LDZ #00 EQU #0101 EQU2 ,on-mouse-down JCN
.Mouse/state DEI #00 NEQ .pointer/state LDZ #00 EQU AND ,on-mouse-down JCN
( on drag )
.Mouse/state DEI ,on-mouse-drag JCN
.Mouse/state DEI .pointer/state STZ
BRK
BRK
@on-mouse-down ( -> )
#0000 DUP2 .length STZ2 .frame STZ2
;clear-screen JSR2
( record start position )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .pointer/lastx STZ2
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .pointer/lastx STZ2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .pointer/lasty STZ2
.Mouse/state DEI .pointer/state STZ
BRK
@on-mouse-drag ( -> )
( draw line )
.pointer/lastx LDZ2
.pointer/lasty LDZ2
.pointer/x LDZ2
.pointer/y LDZ2
#01 [ .Mouse/state DEI #10 EQU DUP ADD ADD ]
;draw-line JSR2
( record )
;stroke .length LDZ2 #20 SFT2 ADD2 STH2
.pointer/x LDZ2 .pointer/lastx LDZ2 SUB2 STH2kr STA2
.pointer/y LDZ2 .pointer/lasty LDZ2 SUB2 STH2r INC2 INC2 STA2
( move ptr )
.length LDZ2 INC2 .length STZ2
( draw line )
.pointer/lastx LDZ2
.pointer/lasty LDZ2
.pointer/x LDZ2
.pointer/y LDZ2
#01
;draw-line JSR2
( record last position )
.Mouse/x DEI2 .pointer/lastx STZ2
.Mouse/y DEI2 .pointer/lasty STZ2
.Mouse/x DEI2
DUP2 .pointer/lastx STZ2
DUP2 .pen/x STZ2
.pen/x2 STZ2
.Mouse/y DEI2
DUP2 .pointer/lasty STZ2
DUP2 .pen/y STZ2
.pen/y2 STZ2
.Mouse/state DEI .pointer/state STZ
BRK
@draw-cursor ( -- )
;pointer-icn .Screen/addr DEO2
@run ( -- )
( clear last cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( read )
;stroke .frame LDZ2 #20 SFT2 ADD2 STH2
.pen/x LDZ2 STH2kr LDA2 ADD2 .pen/x STZ2
.pen/y LDZ2 STH2r INC2 INC2 LDA2 ADD2 .pen/y STZ2
( line )
.pen/x LDZ2 .pen/y LDZ2
.pen/x2 LDZ2 .pen/y2 LDZ2
.frame LDZ2 #01 SFT2 NIP #01 AND INC ;draw-line JSR2
( history )
.pen/x LDZ2 .pen/x2 STZ2
.pen/y LDZ2 .pen/y2 STZ2
( incr frame )
.frame LDZ2 INC2 .length LDZ2 INC2 ( mod2 ) DIV2k MUL2 SUB2 .frame STZ2
( draw new cursor )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#43 .Mouse/state DEI #00 NEQ DUP ADD SUB .Screen/sprite DEO
JMP2r
RTN
@draw-line ( x1* y1* x2* y2* color -- )
@draw-line ( x1 y1 x2 y2 color -- )
( load ) .color STZ .line/y0 STZ2 .line/x0 STZ2 .line/y STZ2 .line/x STZ2
.line/x0 LDZ2 .line/x LDZ2 SUB2 ABS2 .line/dx STZ2
.line/y0 LDZ2 .line/y LDZ2 SUB2 ABS2 #0000 SWP2 SUB2 .line/dy STZ2
#ffff #00 .line/x LDZ2 .line/x0 LDZ2 LTS2 2** ADD2 .line/sx STZ2
#ffff #00 .line/y LDZ2 .line/y0 LDZ2 LTS2 2** ADD2 .line/sy STZ2
( load ) STH ,&y STR2 ,&x STR2 .line/y STZ2 .line/x STZ2
,&x LDR2 .line/x LDZ2 SUB2 ;abs2 JSR2 .line/dx STZ2
#0000 ,&y LDR2 .line/y LDZ2 SUB2 ;abs2 JSR2 SUB2 .line/dy STZ2
#ffff #00 .line/x LDZ2 ,&x LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sx STR2
#ffff #00 .line/y LDZ2 ,&y LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sy STR2
.line/dx LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
&loop
.line/x LDZ2 .Screen/x DEO2
.line/y LDZ2 .Screen/y DEO2
.color LDZ .Screen/pixel DEO
[ .line/x LDZ2 .line/x0 LDZ2 EQU2 ]
[ .line/y LDZ2 .line/y0 LDZ2 EQU2 ] #0101 EQU2 ,&end JCN
.line/e1 LDZ2 2** .line/e2 STZ2
.line/e2 LDZ2 .line/dy LDZ2 LTS2 ,&skipy JCN
.line/x LDZ2 DUP2 .Screen/x DEO2 [ LIT2 &x $2 ] EQU2
.line/y LDZ2 DUP2 .Screen/y DEO2 [ LIT2 &y $2 ] EQU2
STHkr .Screen/pixel DEO
AND ,&end JCN
.line/e1 LDZ2 DUP2 ADD2 DUP2
.line/dy LDZ2 ;lts2 JSR2 ,&skipy JCN
.line/e1 LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
.line/x LDZ2 .line/sx LDZ2 ADD2 .line/x STZ2
.line/x LDZ2 [ LIT2 &sx $2 ] ADD2 .line/x STZ2
&skipy
.line/e2 LDZ2 .line/dx LDZ2 GTS2 ,&skipx JCN
.line/dx LDZ2 ;gts2 JSR2 ,&skipx JCN
.line/e1 LDZ2 .line/dx LDZ2 ADD2 .line/e1 STZ2
.line/y LDZ2 .line/sy LDZ2 ADD2 .line/y STZ2
.line/y LDZ2 [ LIT2 &sy $2 ] ADD2 .line/y STZ2
&skipx
;&loop JMP2
,&loop JMP
&end
POPr
RTN
JMP2r
@abs2 DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 SUB2 JMP2r
@lts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r
@gts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r
@clear-screen ( -- )
.Screen/height DEI2 #03 SFT2 NIP #00
&y
#00 OVR #30 SFT2 .Screen/y DEO2
.Screen/width DEI2 #03 SFT2 NIP #00
&x
#00 OVR #30 SFT2 .Screen/x DEO2
#00 .Screen/sprite DEO
INC GTHk ,&x JCN
POP2
INC GTHk ,&y JCN
POP2
JMP2r
@pointer-icn
80c0 e0f0 f8e0 1000
@stroke
@pointer-icn 80c0 e0f0 f8e0 1000

223
projects/examples/devices/screen.tal
View File

@ -1,172 +1,164 @@
( dev/screen )
( Screen:
Draws a table of all possible sprite arrangements. )
%RTN { JMP2r }
%2/ { #01 SFT }
%4/ { #02 SFT }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
( variables )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0000
@count $2
@center
&x $2 &y $2
( init )
@center &x $2 &y $2
|0100 ( -> )
( vector )
;on-frame .Screen/vector DEO2
( theme )
( theme )
#f07f .System/r DEO2
#f0e0 .System/g DEO2
#f0c0 .System/b DEO2
#f0e0 .System/g DEO2
#f0c0 .System/b DEO2
( gba screen size 00f0 x 00a0 )
( nds screen size 0100 x 00c0 )
#0100 .Screen/width DEO2
#00b0 .Screen/height DEO2
( find screen center )
.Screen/width DEI2 #01 SFT2 #0020 SUB2 .center/x STZ2
.Screen/width DEI2 #01 SFT2 .center/x STZ2
.Screen/height DEI2 #01 SFT2 .center/y STZ2
( draw )
;draw-table JSR2
;draw-size JSR2
;draw-sprites JSR2
;draw-1bpp JSR2
;draw-2bpp JSR2
;draw-pixels JSR2
BRK
(
@|vectors )
@on-frame ( -> )
.count LDZ2 INC2 [ DUP2 ] .count STZ2
.center/x LDZ2 #0048 ADD2 .Screen/x DEO2
.center/y LDZ2 #0050 SUB2 .Screen/y DEO2
( color ) #01 STH
SWP
DUP #04 SFT [ #00 SWP ] #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND [ #00 SWP ] #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
DUP #04 SFT [ #00 SWP ] #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
( draw ) STHkr .Screen/sprite DEO
#0f AND [ #00 SWP ] #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
( draw ) STHr .Screen/sprite DEO
.center/x LDZ2 #0070 SUB2 .Screen/x DEO2
.center/y LDZ2 #0048 SUB2 .Screen/y DEO2
;anim-chr #00 [ LIT &f $1 ] INCk ,&f STR
#02 SFT #07 AND #40 SFT ADD2 .Screen/addr DEO2
#81 .Screen/sprite DEO
BRK
@draw-table ( -- )
#10 #00
&loop
DUP #30 SFT #00 SWP ;font-hex ADD2 .Screen/addr DEO2
( x-axis )
DUP #30 SFT #00 SWP
.center/x LDZ2 #0040 SUB2 ADD2 .Screen/x DEO2
.center/y LDZ2 #0050 SUB2 .Screen/y DEO2
( draw ) #01 .Screen/sprite DEO
( y-axis )
DUP #30 SFT #00 SWP
.center/y LDZ2 #0040 SUB2 ADD2 .Screen/y DEO2
.center/x LDZ2 #0050 SUB2 .Screen/x DEO2
( draw ) #01 .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
RTN
(
@|drawing )
@draw-sprites ( -- )
;preview_icn .Screen/addr DEO2
#00 #00
( horizontal )
.center/x LDZ2 #0060 SUB2 .Screen/x DEO2
.center/y LDZ2 #0048 SUB2 .Screen/y DEO2
;font-icn .Screen/addr DEO2
#f6 .Screen/auto DEO
#01 .Screen/sprite DEO
( vertical )
.center/x LDZ2 #0070 SUB2 .Screen/x DEO2
.center/y LDZ2 #0038 SUB2 .Screen/y DEO2
;font-icn .Screen/addr DEO2
#f5 .Screen/auto DEO
#01 .Screen/sprite DEO
( table )
#00 .Screen/auto DEO
;preview-chr .Screen/addr DEO2
#00
&loop
( move ) DUP #0f AND #40 SFT 2/ #00 SWP
.center/x LDZ2 #0040 SUB2 ADD2 .Screen/x DEO2
( move ) DUP #f0 AND 2/ #00 SWP
.center/y LDZ2 #0040 SUB2 ADD2 .Screen/y DEO2
( move ) #00 OVR #0f AND #30 SFT
.center/x LDZ2 #0060 SUB2 ADD2 .Screen/x DEO2
( move ) #00 OVR #f0 AND #01 SFT
.center/y LDZ2 #0038 SUB2 ADD2 .Screen/y DEO2
( draw ) DUP .Screen/sprite DEO
INC NEQk ,&loop JCN
POP2
INC DUP ,&loop JCN
POP
RTN
JMP2r
@draw-1bpp ( -- )
#10 #00
#1000
&loop
( color ) STHk
( y ) DUP 4/ [ #00 SWP ] #40 SFT2
[ .center/y LDZ2 #0040 SUB2 ADD2 ] STH2
( x ) DUP #03 AND [ #00 SWP ] #40 SFT2 #0040 ADD2
[ .center/x LDZ2 #0008 ADD2 ADD2 ]
STH2r STHr #00 ;draw-circle JSR2
( y ) #00 OVR #42 SFT2
.center/y LDZ2 #0038 SUB2 ADD2 STH2
( x ) #00 OVR #03 AND #40 SFT2 #0040 ADD2
.center/x LDZ2 #0010 SUB2 ADD2
STH2r STHr #00 ,draw-circle JSR
INC GTHk ,&loop JCN
POP2
RTN
JMP2r
@draw-2bpp ( -- )
#10 #00
#1000
&loop
( color ) STHk
( y ) DUP 4/ [ #00 SWP ] #40 SFT2
[ .center/y LDZ2 ADD2 ] STH2
( x ) DUP #03 AND [ #00 SWP ] #40 SFT2 #0040 ADD2
[ .center/x LDZ2 #0008 ADD2 ADD2 ]
STH2r STHr #80 ;draw-circle JSR2
( y ) #00 OVR #42 SFT2
.center/y LDZ2 #0008 ADD2 ADD2 STH2
( x ) #00 OVR #03 AND #40 SFT2 #0040 ADD2
.center/x LDZ2 #0010 SUB2 ADD2
STH2r STHr #80 ,draw-circle JSR
INC GTHk ,&loop JCN
POP2
RTN
JMP2r
@draw-circle ( x* y* color depth -- )
ADD STH
;preview_icn .Screen/addr DEO2
;preview-chr .Screen/addr DEO2
.Screen/y DEO2
.Screen/x DEO2
#01 .Screen/auto DEO
STHr .Screen/sprite DEOk
#02 .Screen/auto DEO
SWP #10 ADD SWP DEOk
.Screen/x DEI2k #0008 SUB2 ROT DEO2
#01 .Screen/auto DEO
SWP #10 ADD SWP DEOk
SWP #10 ADD SWP DEO
#00 STHkr ADD .Screen/sprite DEO
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
#10 STHkr ADD .Screen/sprite DEO
.Screen/x DEI2 #0008 SUB2 .Screen/x DEO2
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
#20 STHkr ADD .Screen/sprite DEO
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
#30 STHr ADD .Screen/sprite DEO
JMP2r
RTN
@draw-size ( -- )
@draw-pixels ( -- )
.center/y LDZ2 #0040 SUB2 .Screen/y DEO2
.center/x LDZ2 #0048 ADD2 .Screen/x DEO2
#00 .Screen/pixel DEO
.center/x LDZ2 #0049 ADD2 .Screen/x DEO2
#01 .Screen/pixel DEO
.center/x LDZ2 #004a ADD2 .Screen/x DEO2
#02 .Screen/pixel DEO
.center/x LDZ2 #004b ADD2 .Screen/x DEO2
#03 .Screen/pixel DEO
#01 .Screen/auto DEO
.center/x LDZ2 #0030 ADD2 .Screen/x DEO2
.center/y LDZ2 #0048 SUB2 .Screen/y DEO2
.Screen/width DEI2 ;draw-dec JSR2
;x-icn .Screen/addr DEO2
#01 .Screen/sprite DEO
.Screen/height DEI2
RTN
@draw-dec ( short* -- )
@preview_icn [
0f38 675f dfbf bfbf 0007 1820 2344 4848
#00 ,&z STR
#2710 ,&parse JSR
#03e8 ,&parse JSR
#0064 ,&parse JSR
#000a ,&parse JSR
NIP
&emit
DUP [ LIT &z $1 ] EQU ,&skip JCN
#ff ,&z STR #00 OVR #30 SFT ;font-icn ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
&skip
POP
@font-hex
JMP2r
&parse DIV2k DUP ,&emit JSR MUL2 SUB2 JMP2r
(
@|assets )
@x-icn
0000 0018 1800 0000
@preview-chr
0f38 675f dfbf bfbf 0007 1820 2344 4848
@font-icn ( 0-f )
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
@ -175,3 +167,10 @@ RTN
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
@anim-chr
0000 0018 1800 0000 c381 0000 0000 81c3 0000 183c 3c18 0000 0000 0000 0000 0000
0018 3c7e 7e3c 1800 0000 0000 0000 0000 3c7e ffe7 e7ff 7e3c 0000 0018 1800 0000
ffff e7c3 c3e7 ffff 0000 183c 3c18 0000 ffe7 c381 81c3 e7ff 0018 3c7e 7e3c 1800
c381 0000 0000 81c3 3c7e ffe7 e7ff 7e3c 0000 0000 0000 0000 ffff e7c3 c3e7 ffff
0000 0000 0000 0000 ffe7 c381 81c3 e7ff

16
projects/examples/devices/system.debugger.tal
View File

@ -1,16 +0,0 @@
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
( program )
|0100 @Reset ( -> )
~projects/library/debugger.tal
#0123 #4567 #89ab #cdef
LIT2r 1234 LIT2r 5678 LIT2r 9abc LIT2r def0
( BREAKPOINT )
( LIT2r 0000 DIVr )
&loop INCk ,&loop JMP
BRK

89
projects/examples/exercises/brainfuck.tal
View File

@ -1,92 +1,71 @@
( brainfuck interpreter )
%!~ { NEQk NIP }
%DEC { #01 SUB }
%DEC2 { #0001 SUB2 }
%DECr { LITr 01 SUBr }
%RTN { JMP2r }
%HALT { #0101 #0e DEO2 }
%EMIT { #18 DEO }
%MEMORY { #8000 }
|0000
@ptr $2
( Brainfuck:
> Move the pointer to the right
< Move the pointer to the left
+ Increment the memory cell at the pointer
- Decrement the memory cell at the pointer
. Output the character signified by the cell at the pointer
, Input a character and store it in the cell at the pointer
[ Jump past the matching ] if the cell at the pointer is 0
] Jump back to the matching [ if the cell at the pointer is nonzero )
|0100 ( -> )
MEMORY .ptr STZ2
;memory
;program
&while
LDAk ,op JSR
LDAk LIT "> NEQ ,&movr JCN [ SWP2 INC2 SWP2 ] &movr
LDAk LIT "< NEQ ,&movl JCN [ SWP2 #0001 SUB2 SWP2 ] &movl
LDAk LIT "+ NEQ ,&incr JCN [ OVR2 STH2k LDA INC STH2r STA ] &incr
LDAk LIT "- NEQ ,&decr JCN [ OVR2 STH2k LDA #01 SUB STH2r STA ] &decr
LDAk LIT ". NEQ ,&emit JCN [ OVR2 LDA #18 DEO ] &emit
LDAk LIT "[ NEQ ,&next JCN [ ,goto-next JSR ] &next
LDAk LIT "] NEQ ,&prev JCN [ ,goto-back JSR ] &prev
INC2 LDAk ,&while JCN
POP2
( halt )
#010f DEO
HALT
BRK
@op ( op -- )
( Move the pointer to the right )
LIT '> !~ ,&movr JCN [ .ptr LDZ2k INC2 ROT STZ2 POP RTN ] &movr
( Move the pointer to the left )
LIT '< !~ ,&movl JCN [ .ptr LDZ2k DEC2 ROT STZ2 POP RTN ] &movl
( Increment the memory cell at the pointer )
LIT '+ !~ ,&incr JCN [ .ptr LDZ2 STH2k LDA INC STH2r STA POP RTN ] &incr
( Decrement the memory cell at the pointer )
LIT '- !~ ,&decr JCN [ .ptr LDZ2 STH2k LDA DEC STH2r STA POP RTN ] &decr
( Output the character signified by the cell at the pointer )
LIT '. !~ ,&emit JCN [ .ptr LDZ2 LDA EMIT POP RTN ] &emit
( Jump past the matching ] if the cell at the pointer is 0 )
LIT '[ !~ ,&next JCN [ POP ,goto-next JSR RTN ] &next
( Jump back to the matching [ if the cell at the pointer is nonzero )
LIT '] !~ ,&prev JCN [ POP ,goto-back JSR RTN ] &prev
POP
RTN
@goto-next ( -- )
.ptr LDZ2 LDA #00 EQU JMP RTN
OVR2 LDA #00 EQU JMP JMP2r
( depth ) LITr 00
INC2
&loop
LDAk LIT '[ NEQ JMP INCr
LDAk LIT '] NEQ ,&no-end JCN
LDAk LIT "[ NEQ JMP INCr
LDAk LIT "] NEQ ,&no-end JCN
STHkr #00 EQU ,&end JCN
DECr
LITr 01 SUBr
&no-end
INC2 LDAk ,&loop JCN
&end
( depth ) POPr
RTN
JMP2r
@goto-back ( -- )
.ptr LDZ2 LDA #00 NEQ JMP RTN
OVR2 LDA #00 NEQ JMP JMP2r
( depth ) LITr 00
DEC2
#0001 SUB2
&loop
LDAk LIT '] NEQ JMP INCr
LDAk LIT '[ NEQ ,&no-end JCN
LDAk LIT "] NEQ JMP INCr
LDAk LIT "[ NEQ ,&no-end JCN
STHkr #00 EQU ,&end JCN
DECr
LITr 01 SUBr
&no-end
DEC2 LDAk ,&loop JCN
#0001 SUB2 LDAk ,&loop JCN
&end
( depth ) POPr
RTN
JMP2r
@program ( Hello World! )
"++++++++[>++++[>++>+++>+++>+<<<<
"-]>+>+>->>+[<]<-]>>.>---.+++++++
"..+++.>>.<-.<.+++.------.-------
"-.>>+.>++.
"-.>>+.>++. $1
@memory

23
projects/examples/exercises/fib.tal Normal file
View File

@ -0,0 +1,23 @@
( Fibonacci:
A series of numbers where the next number
is made of the two numbers before it )
|0100 ( -> ) @reset
#0000 INC2k ADD2k
&loop
DUP2 ,print-hex JSR #0a18 DEO
ADD2k LTH2k ,&loop JCN
( halt )
#010f DEO
BRK
@print-hex ( 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

55
projects/examples/exercises/fizzbuzz.tal
View File

@ -1,43 +1,42 @@
( FizzBuzz: a program that prints the integers from 1 to 100.
( FizzBuzz:
A program that prints the integers from 1 to 100.
for multiples of three, print "Fizz"
for multiples of five, print "Buzz"
for multiples of both three and five, print "FizzBuzz" )
%MOD { DIVk MUL SUB }
%HALT { #01 #0f DEO }
%EMIT { #18 DEO }
%RTN { JMP2r }
@program
|0100 ( -> )
|0100 ( -> ) @reset
#6400
&loop
LITr 00
DUP #03 MOD ,&no3 JCN ;fizz-txt ;print-str JSR2 INCr &no3
DUP #05 MOD ,&no5 JCN ;buzz-txt ;print-str JSR2 INCr &no5
STHr ,&resume JCN
( print decimal )
DUPk #0a DIV #30 ADD EMIT
#0a MOD #30 ADD EMIT
&resume
( add linebreak ) #0a EMIT
( integer )
DUPk ,print-dec JSR #2018 DEO
( fizzbuzz )
DUP #03 ,mod JSR ,&no3 JCN ;s/fizz ,print-str JSR &no3
DUP #05 ,mod JSR ,&no5 JCN ;s/buzz ,print-str JSR &no5
#0a18 DEO
INC GTHk ,&loop JCN
POP2
HALT
( halt )
#010f DEO
BRK
@mod ( a b -- c )
DIVk MUL SUB
JMP2r
@print-dec ( num -- )
#0a DIV ,&emit JSR
#0a ,mod JSR
&emit
#30 ADD #18 DEO
JMP2r
@print-str ( addr* -- )
&loop
LDAk EMIT
INC2 LDAk ,&loop JCN
&while
LDAk #18 DEO
INC2 LDAk ,&while JCN
POP2
JMP2r
RTN
@fizz-txt "Fizz $1
@buzz-txt "Buzz $1
@s &fizz "Fizz $1 &buzz "Buzz $1

70
projects/examples/exercises/pig.tal Normal file
View File

@ -0,0 +1,70 @@
( Pig:
Each turn you roll a die and add the total to your points.
You can stop at any time and keep that total, or keep rolling.
If you ever roll a 1 you lose all the points you accrued. )
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|0000 @t $1 ( Total saved )
|0100 @game ( -> )
#00 .t STZ
;input-main .Console/vector DEO2
,input-main/main JMP
@roll ( -- dice )
[ LIT2 &r f793 ]
( 5*R+35 ) #0005 MUL2 #0023 ADD2
( R-R/6547*6547 ) DUP2 #1993 DIV2 #1993 MUL2 SUB2
DUP2 #c5 DEI2 ADD2 ,&r STR2 ADD ( mod ) #06 DIVk MUL SUB
JMP2r
@input-main ( -> )
.Console/read DEI
LIT "0 EQUk NIP ,&no JCN
LIT "1 EQUk NIP ,&yes JCN
( ignore other inputs )
POP
BRK
&no ( char -- )
POP ;score-txt ,pstr JSR .t LDZ ,pdec JSR ;byte-txt ,&halt JMP
&yes ( char -- )
POP ,roll JSR ;rolled-txt ,pstr JSR INCk ,pdec/d JSR DUP ,&not-bust JCN
&bust ( char -- )
POP ;bust-txt
&halt ( msg* -- )
,pstr JSR #0a .Console/write DEO #010f DEO BRK
&not-bust ( dice -- )
INC .t LDZ ADD .t STZ
&main ( -- )
;total-txt ,pstr JSR .t LDZ ,pdec JSR ;roll-txt ,pstr JSR BRK
@pdec ( value -- )
DUP #0a DIV ,&emit JSR
&d #0a DIVk MUL SUB ,&emit JSR
#0a .Console/write DEO
JMP2r
&emit #30 ADD .Console/write DEO JMP2r
@pstr ( str* -- )
&while
LDAk DUP LIT "_ EQU #3f MUL SUB .Console/write DEO
INC2 LDAk ,&while JCN
POP2
JMP2r
@total-txt "Your_current_total_is:_ $1
@roll-txt "Would_you_like_to_roll?_(0_no,_1_yes)_ $1
@score-txt "Your_score_is:_ $1
@rolled-txt "You_rolled:_ $1
@bust-txt "Busted! $1
@byte-txt "Goodbye. $1

58
projects/examples/exercises/primes.tal
View File

@ -1,57 +1,39 @@
(
An integer greater than one is called a prime number
( Primes:
An integer greater than one is called a prime number
if its only positive divisors are one and itself. )
%RTN { JMP2r }
%HALT { #0101 #0e DEO2 }
%MOD2 { DIV2k MUL2 SUB2 }
%EMIT { #18 DEO }
|0100 ( -> ) @reset
|0100 ( -> ) @main
#0000 #0001
#0000 INC2k
&loop
DUP2 ,is-prime JSR #00 EQU ,&skip JCN
DUP2 ,print-hex/short JSR
#20 EMIT
( print ) DUP2 ,print/short JSR
( space ) #2018 DEO
&skip
INC2 NEQ2k ,&loop JCN
POP2 POP2
HALT
( halt ) #010f DEO
BRK
@is-prime ( number* -- flag )
DUP2 #0001 NEQ2 ,&not-one JCN
POP2 #00 RTN
&not-one
STH2k
( range ) #01 SFT2 #0002
DUP2 ,&t STR2
( range ) #01 SFT2 #0002 LTH2k ,&fail JCN
&loop
STH2kr OVR2 MOD2 #0000 NEQ2 ,&continue JCN
POP2 POP2
POP2r #00 RTN
&continue
[ LIT2 &t $2 ] OVR2
( mod2 ) DIV2k MUL2 SUB2
ORA #00 EQU ,&fail JCN
INC2 GTH2k ,&loop JCN
POP2 POP2
POP2r #01
POP2 POP2 #01
RTN
JMP2r
&fail POP2 POP2 #00 JMP2r
@print-hex ( value* -- )
&short ( value* -- )
SWP ,&echo JSR
&byte ( value -- )
,&echo JSR
RTN
@print ( short* -- )
&echo ( value -- )
STHk #04 SFT ,&parse JSR EMIT
STHr #0f AND ,&parse JSR EMIT
RTN
&parse ( value -- char )
DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN
&short ( 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
RTN
JMP2r

49
projects/examples/exercises/subleq.tal
View File

@ -1,45 +1,46 @@
( Subleq:
The subleq instruction subtracts the contents at address a
from the contents at address b, stores the result at address b,
and then, if the result is not positive, jumps to address c.
If the result is positive, execution proceeds to the next instruction
in sequence. )
( uxnasm subleq.tal subleq.rom && uxncli subleq.rom )
|0000
%EMIT { #18 DEO }
%HALT { #0101 #0e DEO2 }
%RTN { JMP2r }
%GET { #10 SFT2 ;program ADD2 LDA2 }
%SET { #10 SFT2 ;program ADD2 STA2 }
@a $2 @b $2 @c $2
|0000 @a $2 @b $2 @c $2
|0100
|0100 ( -> ) @reset
( pointer ) #0000
#0000
&while
,eval JSR
DUP2 #8000 LTH2 ,&while JCN
POP2
HALT
( halt ) #010f DEO
BRK
@eval ( ip* -- ip* )
DUP2 GET .a STZ2
INC2 DUP2 GET .b STZ2
INC2 DUP2 GET .c STZ2
DUP2 ,&get JSR .a STZ2
INC2 DUP2 ,&get JSR .b STZ2
INC2 DUP2 ,&get JSR .c STZ2
INC2
( I/O )
.a LDZ2 #ffff NEQ2 ,&noin JCN
( nothing. ) ,&end JMP2 &noin
.b LDZ2 #ffff NEQ2 ,&noout JCN
.a LDZ2 GET NIP EMIT ,&end JMP &noout
.a LDZ2 #ffff EQU2 ,&input JCN
.b LDZ2 #ffff EQU2 ,&output JCN
( SUBLEQ )
.b LDZ2 GET .a LDZ2 GET SUB2 .b LDZ2 SET
.b LDZ2 STH2k ,&get JSR .a LDZ2 ,&get JSR SUB2 STH2r DUP2 ADD2 ;program ADD2 STA2
( SET )
.b LDZ2 GET #0001 SUB2 #8000 LTH2 ,&end JCN
POP2 .c LDZ2 &end
.b LDZ2 ,&get JSR #0001 SUB2 #8000 LTH2 ,&end JCN POP2 .c LDZ2 &end
RTN
JMP2r
&input ( -- ) JMP2r
&output ( -- ) .a LDZ2 ,&get JSR NIP #18 DEO JMP2r
&get ( a* -- b* ) DUP2 ADD2 ;program ADD2 LDA2 JMP2r
@program ( hello world )
000f 0011 ffff 0011 ffff ffff 0010 0001
ffff 0010 0003 ffff 000f 000f 0000 0000
ffff 0048 0065 006c 006c 006f 002c 0020
000f 0011 ffff 0011 ffff ffff 0010 0001
ffff 0010 0003 ffff 000f 000f 0000 0000
ffff 0048 0065 006c 006c 006f 002c 0020
0077 006f 0072 006c 0064 0021 000a 0000

83
projects/examples/gui/animation.tal
View File

@ -1,83 +0,0 @@
( GUI Animation )
%2// { #01 SFT2 }
%AUTO-XADDR { #05 .Screen/auto DEO }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0000
@dvd
&x $2 &y $2
&dx $1 &dy $1
( program )
|0100 ( -> )
( theme )
#4cfd .System/r DEO2
#4cf3 .System/g DEO2
#dcf2 .System/b DEO2
( vectors )
;on-frame .Screen/vector DEO2
( starting position )
.Screen/width DEI2 2// .dvd/x STZ2
.Screen/height DEI2 2// .dvd/y STZ2
AUTO-XADDR
#01 ;draw-dvd JSR2
BRK
@on-frame ( -> )
#00 ;draw-dvd JSR2
( case: hit-right ) .dvd/x LDZ2 .Screen/width DEI2 #0020 SUB2 EQU2
( case: hit-left ) .dvd/x LDZ2 #0000 EQU2
#0000 EQU2 ,&no-flipx JCN
.dvd/dx LDZk #00 EQU SWP STZ &no-flipx
( case: hit-bottom ) .dvd/y LDZ2 .Screen/height DEI2 #0010 SUB2 EQU2
( case: hit-top ) .dvd/y LDZ2 #0000 EQU2
#0000 EQU2 ,&no-flipy JCN
.dvd/dy LDZk #00 EQU SWP STZ &no-flipy
( incr ) .dvd/x LDZ2 #0001 #00 .dvd/dx LDZ #00 EQU DUP2 ADD2 SUB2 ADD2 .dvd/x STZ2
( incr ) .dvd/y LDZ2 #0001 #00 .dvd/dy LDZ #00 EQU DUP2 ADD2 SUB2 ADD2 .dvd/y STZ2
#01 ;draw-dvd JSR2
BRK
@draw-dvd ( color -- )
STH
;dvd_icn .Screen/addr DEO2
.dvd/x LDZ2 .Screen/x DEO2
.dvd/y LDZ2 .Screen/y DEO2
#0800
&loop
DUP #04 NEQ ,&no-lb JCN
.Screen/x DEI2k #0020 SUB2 ROT DEO2
.Screen/y DEI2k #0008 ADD2 ROT DEO2
&no-lb
STHkr .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
POPr
JMP2r
@dvd_icn ( 4 x 2 )
001f 3f38 3838 787f 00fe fe7e 7777 e3c3
000f 1f3b 7b77 e7c7 00fc fe8f 8707 0efc
7f00 000f ff7f 0700 0301 00ff f0f8 ff00
8700 00ff 7f7f ff00 f000 00e0 fcfc 8000

51
projects/examples/gui/hover.tal
View File

@ -1,10 +1,5 @@
( GUI Hover )
%RTN { JMP2r }
%GTS2 { #8000 ADD2 SWP2 #8000 ADD2 LTH2 }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
@ -15,7 +10,6 @@
@color $1
@pointer [ &x $2 &y $2 &sprite $2 ]
@rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@r1 [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@r2 [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@r3 [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
@ -80,43 +74,46 @@ BRK
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
RTN
JMP2r
&skip
POP2 POP2 POPr
#00
RTN
JMP2r
@line-rect ( x1* y1* x2* y2* color -- )
( load ) .color STZ
STH2k .rect/y2 STZ2 .rect/x2 STZ2
STH2k .rect/y1 STZ2 .rect/x1 STZ2
STH2r STH2r SWP2
&ver
( save ) DUP2 .Screen/y DEO2
( draw ) .rect/x1 LDZ2 .Screen/x DEO2 .color LDZ DUP .Screen/pixel DEO
( draw ) .rect/x2 LDZ2 .Screen/x DEO2 .Screen/pixel DEO
( incr ) INC2
OVR2 OVR2 GTS2 ,&ver JCN
POP2 POP2
.rect/x1 LDZ2 .rect/x2 LDZ2 SWP2
STH
DUP2 ,&ver-y2 STR2 ,&hor-y2 STR2
DUP2 ,&ver-x2 STR2 ,&hor-x2 STR2
DUP2 ,&ver-y1 STR2 ,&hor-y1 STR2
DUP2 ,&ver-x1 STR2 ,&hor-x1 STR2
( horizontal )
[ LIT2 &hor-x2 $2 ] INC2 [ LIT2 &hor-x1 $2 ]
&hor
( save ) DUP2 .Screen/x DEO2
( draw ) .rect/y1 LDZ2 .Screen/y DEO2 .color LDZ DUP .Screen/pixel DEO
( draw ) .rect/y2 LDZ2 .Screen/y DEO2 .Screen/pixel DEO
( incr ) INC2
OVR2 OVR2 GTS2 ,&hor JCN
DUP2 .Screen/x DEO2
[ LIT2 &hor-y1 $2 ] .Screen/y DEO2 STHkr .Screen/pixel DEOk
[ LIT2 &hor-y2 $2 ] .Screen/y DEO2 DEO
INC2 GTH2k ,&hor JCN
POP2 POP2
( vertical )
[ LIT2 &ver-y2 $2 ] [ LIT2 &ver-y1 $2 ]
&ver
DUP2 .Screen/y DEO2
[ LIT2 &ver-x1 $2 ] .Screen/x DEO2 STHkr .Screen/pixel DEOk
[ LIT2 &ver-x2 $2 ] .Screen/x DEO2 DEO
INC2 GTH2k ,&ver JCN
POP2 POP2
POPr
RTN
JMP2r
@pointer_icn [ 80c0 e0f0 f8e0 1000 ]
@hand_icn [ 4040 4070 f8f8 f870 ]

257
projects/examples/gui/label.tal
View File

@ -1,167 +1,83 @@
( GUI Labels )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%=~ { EQUk NIP } %!~ { NEQk NIP }
%<~ { LTHk NIP } %>~ { GTHk NIP }
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 }
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }
%IS-VALID { DUP #1f > SWP #7f < AND }
%RTN { JMP2r }
%TOS { #00 SWP }
%AUTO-NONE { #00 .Screen/auto DEO }
%AUTO-Y { #02 .Screen/auto DEO }
%AUTO-YADDR { #06 .Screen/auto DEO }
%HALT { #010f DEO }
%EMIT { #18 DEO }
%PRINT { ;print-str JSR2 #0a EMIT }
%DEBUG { ;print-hex/byte JSR2 #0a EMIT }
%DEBUG2 { ;print-hex JSR2 #0a EMIT }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
( variables )
|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|0000
@label [ &x $2 &y $2 &color $1 &addr $2 ]
@center [ &x $2 &y $2 ]
( program )
@center &x $2 &y $2
|0100
( theme )
#f0d7 .System/r DEO2
#f0de .System/g DEO2
#f0dc .System/b DEO2
( find screen center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
( ver )
AUTO-Y
( theme )
#a0dc .System/r DEO2
#a0dc .System/g DEO2
#a0dc .System/b DEO2
( find screen center )
.Screen/width DEI2 #01 SFT2 .center/x STZ2
.Screen/height DEI2 #01 SFT2 .center/y STZ2
( dashed line )
#02 .Screen/auto DEO
#0000 .Screen/y DEO2
.center/x LDZ2 .Screen/x DEO2
.Screen/height DEI2 #0000
&ver
#43 .Screen/pixel DEO
.Screen/y DEI2k INC2 ROT DEO2
DUP #01 AND .Screen/pixel DEO
INC2 GTH2k ,&ver JCN
POP2 POP2
( left )
.center/x LDZ2 .Screen/x DEO2
.center/y LDZ2 #0020 -- .Screen/y DEO2
;left-txt #09 ;draw-uf2 JSR2
.center/y LDZ2 #0018 SUB2 .Screen/y DEO2
;left-txt ,draw-uf2 JSR
( center )
.center/x LDZ2 .Screen/x DEO2
.center/y LDZ2 .Screen/y DEO2
;center-txt #09 ;draw-uf2-center JSR2
;center-txt ,draw-uf2-center JSR
( right )
.center/x LDZ2 .Screen/x DEO2
.center/y LDZ2 #0020 ++ .Screen/y DEO2
;right-txt #09 ;draw-uf2-right JSR2
.center/y LDZ2 #0018 ADD2 .Screen/y DEO2
;right-txt ,draw-uf2-right JSR
BRK
@draw-uf2-center ( text* color -- )
STH
DUP2 ,get-width JSR 2// .Screen/x DEI2 SWP2 -- .Screen/x DEO2
STHr ,draw-uf2 JSR
RTN
@draw-uf2-right ( text* color -- )
STH
DUP2 ,get-width JSR .Screen/x DEI2 SWP2 -- .Screen/x DEO2
STHr ,draw-uf2 JSR
RTN
@get-width ( text* -- width* )
@get-uf2-width ( text* -- width* )
LIT2r 0000
&while
LDAk TOS ;font ++ LDA TOS STH2 ADD2r
LDAk #0000 ROT ;font ADD2 LDA STH2 ADD2r
INC2 LDAk ,&while JCN
POP2
STH2r
RTN
JMP2r
@draw-uf2 ( text* color -- )
@draw-uf2-center ( text* -- )
STH
AUTO-YADDR
DUP2 ,get-uf2-width JSR #01 SFT2 STH2
.Screen/x DEI2k STH2r SUB2 ROT DEO2
,draw-uf2 JMP
@draw-uf2-right ( text* -- )
DUP2 ,get-uf2-width JSR STH2
.Screen/x DEI2k STH2r SUB2 ROT DEO2
@draw-uf2 ( text* -- )
#15 .Screen/auto DEO
&while
LDAk STHkr ,draw-glyph JSR
LDAk #20 SUB #00 SWP
DUP2 #50 SFT2 ;font/glyphs ADD2 .Screen/addr DEO2
;font ADD2 LDA STHk #00 SWP .Screen/x DEI2 ADD2
#01 .Screen/sprite DEOk STHr #08 LTH ,&thin JCN DEOk &thin POP2
.Screen/x DEO2
INC2 LDAk ,&while JCN
POP2 POPr
AUTO-NONE
RTN
@draw-glyph ( char color -- )
.Screen/x DEI2 STH2
.Screen/y DEI2 STH2
( glyph ) OVR ,get-glyph JSR .Screen/addr DEO2
DUP .Screen/sprite DEOk DEO
STH2kr .Screen/y DEO2
( get width ) SWP TOS ;font ++ LDA
DUP #09 < ,&narrow JCN
.Screen/x DEI2k #0008 ++ ROT DEO2
OVR .Screen/sprite DEOk DEO
STH2kr .Screen/y DEO2
&narrow
POP2r
( width ) TOS STH2r ++ .Screen/x DEO2
POP
RTN
@get-glyph ( char -- addr* )
#09 =~ ,&tab JCN ( tab )
#0a =~ ,&linebreak JCN ( linebreak )
#0d =~ ,&linebreak JCN ( linebreak )
DUP IS-VALID ,&valid JCN
POP ;unknown-icn RTN
&linebreak
POP ;linebreak-icn RTN
&tab
POP ;tab-icn RTN
&valid
TOS 20** ;font
#0100 ++ ++
RTN
@print-hex ( value* -- )
SWP ,&byte JSR
&byte ( byte -- )
STHk #04 SFT ,&parse JSR #18 DEO
STHr #0f AND ,&parse JSR #18 DEO
JMP2r
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r
&above #57 ADD JMP2r
POP2
JMP2r
@ -169,25 +85,7 @@ JMP2r
@center-txt "Center 20 "Aligned 20 "Label $1
@right-txt "Right 20 "Aligned 20 "Label $1
@unknown-icn
aa55 aa55 aa55 aa55
aa55 aa55 aa55 aa55
aa55 aa55 aa55 aa55
aa55 aa55 aa55 aa55
@tab-icn
0000 0000 0000 1008
1000 0000 0000 0000
0000 0000 0000 0000
0000 0000 0000 0000
@linebreak-icn
0000 0000 0000 1028
1000 0000 0000 0000
0000 0000 0000 0000
0000 0000 0000 0000
@font ( venice14 )
0000 0000 0000 0000 0009 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0505 0809 080c 0d05 0707 0a09 0609 0608
0808 0808 0908 0808 0808 0505 0708 0709
000d 0a08 0b0a 090a 0c08 070c 090e 0c09
@ -202,70 +100,7 @@ JMP2r
090c 0808 0505 0000 0907 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
&glyphs ( starting at #20 )
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 3030 3030 3030 3000 3030 0000 0000

25
projects/examples/gui/monospace.tal
View File

@ -1,13 +1,4 @@
( Draw a 8x8 font )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%AUTO-X { #01 .Screen/auto DEO }
( devices )
( GUI Monospace )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
@ -39,32 +30,34 @@ BRK
@draw-uf1 ( string* color -- )
AUTO-X
#01 .Screen/auto DEO
STH
&while
( get sprite ) LDAk #20 - #00 SWP #30 SFT2 ;font ++ .Screen/addr DEO2
( get sprite ) LDAk #20 SUB #00 SWP #30 SFT2 ;font ADD2 .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
INC2 LDAk ,&while JCN
POPr
POP2
JMP2r
@draw-uf1-linebreaks ( string* color -- )
.Screen/x DEI2 ,&anchor STR2
AUTO-X
#01 .Screen/auto DEO
STH
&while
LDAk #0a ! ,&no-lb JCN
LDAk #0a NEQ ,&no-lb JCN
( rewind ) LIT2 &anchor $2 .Screen/x DEO2
( skip line ) .Screen/y DEI2k #0008 ++ ROT DEO2
( skip line ) .Screen/y DEI2k #0008 ADD2 ROT DEO2
,&end JMP
&no-lb
( get sprite ) LDAk #20 - #00 SWP #30 SFT2 ;font ++ .Screen/addr DEO2
( get sprite ) LDAk #20 SUB #00 SWP #30 SFT2 ;font ADD2 .Screen/addr DEO2
( draw ) STHkr .Screen/sprite DEO
&end
INC2 LDAk ,&while JCN
POPr
POP2
JMP2r

172
projects/examples/gui/picture.tal
View File

@ -1,15 +1,5 @@
( GUI Picture )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%AUTO-NONE { #00 .Screen/auto DEO }
%AUTO-XADDR { #05 .Screen/auto DEO }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
@ -22,19 +12,23 @@
|0100
( theme )
#f0d7 .System/r DEO2
#f0de .System/g DEO2
#f0dc .System/b DEO2
#f0f7 .System/r DEO2
#f00e .System/g DEO2
#f00c .System/b DEO2
#0030 .Screen/x DEO2
#0030 .Screen/y DEO2
;picture-icn #20 #10 #01 ;draw-icn JSR2
#0100 .Screen/x DEO2
#0090 .Screen/y DEO2
#10 #10 ;dafu10x10 #0a ;draw-small JSR2
BRK
@draw-icn ( addr* width height color -- )
AUTO-XADDR
#05 .Screen/auto DEO
STH
( set bounds ) ,&height STR ,&width STR .Screen/addr DEO2
( set origin ) .Screen/x DEI2 ,&x STR2
@ -46,11 +40,27 @@ BRK
STHkr .Screen/sprite DEO
INC GTHk ,&hor JCN
POP2
.Screen/y DEI2k #0008 ++ ROT DEO2
.Screen/y DEI2k #0008 ADD2 ROT DEO2
INC GTHk ,&ver JCN
POP2
POPr
AUTO-NONE
#00 .Screen/auto DEO
JMP2r
( makes use of the auto byte )
@draw-small ( w h addr* color -- )
STH
.Screen/addr DEO2
SWP #01 SUB #40 SFT #06 ADD .Screen/auto DEO
#00
&loop
STHkr .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
POPr
JMP2r
@ -311,3 +321,133 @@ JMP2r
ffff ffff ffff ffff faff ffff ffff fbf7
bafd ffff bfdf ff5f ef7f ffff af5f af5f
ffff ffff ffff ffff ffff ffff ffff ffff
@dafu10x10
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0001 0000 0000 010f 7fff
0000 002f ffff ffff 0000 00fd ffff ffff
0000 0000 e0fc ffff 0000 0000 0000 00e0
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0107 071f
071f 3fff fffc f3cf ffff f8c7 3fff ffff
e82f fbfb fbfb fbfb 02ff ffff ffff ffff
bf41 feff ffff ffff fcff 1fe3 fcff ffff
00d0 fcff 7fd2 ffff 0000 00c0 f0f8 5efe
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0103 0f1f 3f7e 5f7e f9f3 cf9f 7fff
3f7f ffff ffff ffff ffff ffff ffff ffff
f9fb fbf9 fdf9 fdfd ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff feff fefe
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0001 002f 1f1f 1f1f
e907 ffff ffff ffff ffff ffff ffff ffff
ffff ffff ffff ffff ffff ffff ffff ffff
fdfd fdfd fcff fd45 ffff ffff ffff ed37
ffff ffff ffff b76c ffff ffff ffff ff0b
ffff ffff ffff ffff fefc fcfc f8fc f8f8
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 1f1f 1f0f 0f07 0703
ffff ffff ffff ffff ffff ffff fffe fdf5
ffff fceb 8fbf 7fff f48b 7fff ffff ffff
bffe fefa f8fc fdff ffff 7f3f 3f7f bfff
ffff ffff ffff ffff f8ff ffff ffff ffff
7fd7 ffff ffff ffff f0f0 f0e0 e0e0 e0e0
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0301 0100 0000 0000
ffff fffc 7d33 3f1f ef9f 7fff ffff ffff
ffff ffff ffff f4cb ffff ffff e807 ffff
ffff ffa0 00c0 0197 ffff 5007 1f03 5eff
ffff a5ff ff6d bfff ffff 4de8 ff7f 6fff
ffff ffbf a7fe fefe f0e0 f0e0 f0e0 b0d0
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
1f0f 0f0f 0f0e 0e12 fefa f5cf bfff ffff
3fff ffff ffff ffff ffff ffff ffff ffff
f8e0 e0c0 e040 c040 7f7f 5f2f 7b1b 0f0f
ffff ffff ffff ffff ffff ffff ffff ffff
ffff fcfd fbf5 f9d4 50f0 f0e0 f0f0 e060
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
1a1a 150f 0d07 1100 7fff ffff fdff ffe1
ffff ffff baff ff55 ffff ffaa fdff fe00
c040 d708 f0eb a800 0fa6 7f2f 3fd0 021a
d7bf fff7 086a b8b0 feff e914 a000 0000
ab20 e078 0000 0000 e0c0 d6e1 4084 0204
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0402 010a 0200 0000 7876 39b0 5078 9018
0892 71a9 2112 1210 aa00 ff01 7692 0000
a01e 3628 8488 4484 a5a0 0000 0080 8000
2003 070d 3815 0260 feff 7b69 9e60 0000
90e0 8080 0000 0000 c004 8020 8890 8888
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0300 0000 0000 0000 2848 8008 4428 0c04
1211 1201 1d14 2a29 1200 0016 dd55 22a9
4084 44ca 8a0d 5800 0000 0800 a02e d105
1000 0000 0080 6a11 0000 0000 0000 8865
0100 0100 0101 005e 2080 2040 4000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0600 0a05 0303 0300
50a0 8040 8000 8000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
ad00 0000 0000 0000 510a 0000 0000 0000
2214 0002 0200 0406 0000 0000 0000 0080
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0000 0000 0000 0000 0000 0000
0000 0000 0021 010f 0407 0812 2e5c de3e
4000 c060 f0f0 f878 0000 0000 0000 0000
0000 0000 0000 0000 0000 502d 0200 157f
0040 a000 0000 e0f8 0000 0000 0000 0000
060f 0f1f 1737 336b a01c e3f0 feff ffff
0000 407a 05c0 f0fc 0000 0000 807c 0300
0000 0000 0000 a05a 0000 0000 0000 0004
0000 0000 0000 030c 0001 0514 53a7 0f3f
265c 5df9 f3e7 c7cf fbfd fbfb fbfb fbfb
7c7e 7fbf bfff bfff 0000 0090 c0e0 f0f8
0101 0101 0001 0020 7fc8 ff1b c6f0 7f78
fc5c ec08 b858 30e0 0108 0001 0103 0707
6b5b dbdf bbbf bb7f ffff ffff ffff ffff
fefe fcfc f9f3 f3f7 6079 fffe fcfc f9f3
0540 823f 7fff ffff d02c 03f8 feff ffff
3040 800e 3f7f ffff 7f7f 7fff 7f7f 7f7f
9fdf 9f9f df9f 9fdf fbfb fbf3 fbfb fbfb
efff fff7 fffd ffff fefe ffff ffff ff7f
0000 80e0 f0fc ffff 1f02 0000 0001 01e1
c000 00a8 b050 590b 0f1f 1e7d 7dff ffff
7f7f ffff ffff ffff ffff ffff ffff ffff
e7ef cfdf 9f3f 7f3f f3e7 efcf dfbf bf3f
ffff ffff ffff ffff fffe fcf8 f0f0 e0c0
ffff ffff ffff ffff bfbf bfbf dfdf dfcf
9fcf 9fcf dfcf dfcf f7fb fbf7 fbfb fbfb
ffff ffff ffff ffff ffd7 f7fd feff ffff
ffff ffff 7f9e e8e0 ffff fff5 8000 0001
4f47 66a4 7056 4b43 fffe 8001 015f ffff
ffbf 1f7f ffff ffff fefe fcfe fdf9 fbfb
7fff feff fefe fcfe 7f7f 7f7f ffff ffff
ffff fffe fefc f8f8 8183 070f 1f3f 3f7f
ffff ffff 7f3f 9f8f efef eff7 f7f7 f7f7
dfcf efdf cfff cfef fbfb fbf9 fdfd fbfc
ffff fffe f4c0 8000 fffc e080 0000 0000
8000 0000 0000 0000 0506 0802 0300 0000
4925 2365 a2b2 1191 ffff ffff ff05 0000
ffff ffff ff7f 0307 fbfb ffff ffff ffff
fcfd fcfe fdfd fdfd ffff ffff ffff ffff
f0e0 e1c3 8387 0f1f ffff ffff ffff fffe

106
projects/examples/gui/shapes.tal
View File

@ -1,19 +1,8 @@
( GUI Shapes )
%RTN { JMP2r }
%8++ { #0008 ADD2 }
%2** { #10 SFT2 }
%4** { #20 SFT2 }
%2// { #01 SFT2 }
%4// { #02 SFT2 }
%ABS2 { DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 SUB2 }
%LTS2 { #8000 ADD2 SWP2 #8000 ADD2 GTH2 }
%GTS2 { #8000 ADD2 SWP2 #8000 ADD2 LTH2 }
%SIZE-TO-RECT {
STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2
} ( x y w h -- x1 y1 x2 y2 )
%WIDTH { #0100 } %HEIGHT { #00a0 }
( devices )
@ -41,24 +30,24 @@
#f03c .System/g DEO2
#f03f .System/b DEO2
( background ) ;checker_icn #03 ;cover-pattern JSR2
( background ) ;checker-icn #03 ;cover-pattern JSR2
.Screen/width DEI2 2// WIDTH 2// SUB2 #0008 ADD2
.Screen/height DEI2 2// HEIGHT 2// SUB2 #0008 ADD2
.Screen/width DEI2 #01 SFT2 WIDTH #01 SFT2 SUB2 #0008 ADD2
.Screen/height DEI2 #01 SFT2 HEIGHT #01 SFT2 SUB2 #0008 ADD2
WIDTH HEIGHT
SIZE-TO-RECT #02 ;fill-rect JSR2
STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2 #02 ;fill-rect JSR2
.Screen/width DEI2 2// WIDTH 2// SUB2
.Screen/height DEI2 2// HEIGHT 2// SUB2
.Screen/width DEI2 #01 SFT2 WIDTH #01 SFT2 SUB2
.Screen/height DEI2 #01 SFT2 HEIGHT #01 SFT2 SUB2
WIDTH HEIGHT
SIZE-TO-RECT #01 ;fill-rect JSR2
STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2 #01 ;fill-rect JSR2
.Screen/width DEI2 2// WIDTH 2// SUB2 #0008 ADD2
.Screen/height DEI2 2// HEIGHT 2// SUB2 #0008 ADD2
.Screen/width DEI2 #01 SFT2 WIDTH #01 SFT2 SUB2 #0008 ADD2
.Screen/height DEI2 #01 SFT2 HEIGHT #01 SFT2 SUB2 #0008 ADD2
WIDTH #0010 SUB2 HEIGHT #0010 SUB2
SIZE-TO-RECT #03 ;line-rect JSR2
STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2 #03 ;line-rect JSR2
.Screen/width DEI2 2// .Screen/height DEI2 2// WIDTH 4// #02 ;draw-circle JSR2
.Screen/width DEI2 #01 SFT2 .Screen/height DEI2 #01 SFT2 WIDTH #02 SFT2 #02 ;draw-circle JSR2
#0010 #0030 #0068 #02 ;line-hor JSR2
#0020 #0058 #0078 #02 ;line-ver JSR2
@ -70,13 +59,13 @@ BRK
( load ) .color STZ #0001 SUB2 .line/y0 STZ2 #0001 SUB2 .line/x0 STZ2 .line/y STZ2 .line/x STZ2
.line/x0 LDZ2 .line/x LDZ2 SUB2 ABS2 .line/dx STZ2
.line/y0 LDZ2 .line/y LDZ2 SUB2 ABS2 #0000 SWP2 SUB2 .line/dy STZ2
#ffff #00 .line/x LDZ2 .line/x0 LDZ2 LTS2 2** ADD2 .line/sx STZ2
#ffff #00 .line/y LDZ2 .line/y0 LDZ2 LTS2 2** ADD2 .line/sy STZ2
#ffff #00 .line/x LDZ2 .line/x0 LDZ2 LTS2 #10 SFT2 ADD2 .line/sx STZ2
#ffff #00 .line/y LDZ2 .line/y0 LDZ2 LTS2 #10 SFT2 ADD2 .line/sy STZ2
.line/dx LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
&loop
.line/x LDZ2 .Screen/x DEO2 .line/y LDZ2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO
.line/x LDZ2 .line/x0 LDZ2 EQU2 .line/y LDZ2 .line/y0 LDZ2 EQU2 #0101 EQU2 ,&end JCN
.line/e1 LDZ2 2** .line/e2 STZ2
.line/x LDZ2 .line/x0 LDZ2 EQU2 .line/y LDZ2 .line/y0 LDZ2 EQU2 AND ,&end JCN
.line/e1 LDZ2 #10 SFT2 .line/e2 STZ2
.line/e2 LDZ2 .line/dy LDZ2 LTS2 ,&skipy JCN
.line/e1 LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
.line/x LDZ2 .line/sx LDZ2 ADD2 .line/x STZ2
@ -89,32 +78,34 @@ BRK
&end
RTN
JMP2r
@line-rect ( x1* y1* x2* y2* color -- )
( load ) STH
STH2k ,&y2 STR2 ,&x2 STR2
STH2k ,&y1 STR2 ,&x1 STR2
STH2r STH2r SWP2
&ver
( save ) DUP2 .Screen/y DEO2
( draw ) ,&x1 LDR2 .Screen/x DEO2 STHkr .Screen/pixel DEO
( draw ) ,&x2 LDR2 .Screen/x DEO2 STHkr .Screen/pixel DEO
( incr ) INC2
OVR2 OVR2 GTS2 ,&ver JCN
POP2 POP2
,&x1 LDR2 ,&x2 LDR2 SWP2
STH
DUP2 ,&ver-y2 STR2 ,&hor-y2 STR2
DUP2 ,&ver-x2 STR2 ,&hor-x2 STR2
DUP2 ,&ver-y1 STR2 ,&hor-y1 STR2
DUP2 ,&ver-x1 STR2 ,&hor-x1 STR2
( horizontal )
[ LIT2 &hor-x2 $2 ] INC2 [ LIT2 &hor-x1 $2 ]
&hor
( save ) DUP2 .Screen/x DEO2
( draw ) ,&y1 LDR2 .Screen/y DEO2 STHkr .Screen/pixel DEO
( draw ) ,&y2 LDR2 .Screen/y DEO2 STHkr .Screen/pixel DEO
( incr ) INC2
OVR2 INC2 OVR2 GTS2 ,&hor JCN
POP2 POP2 POPr
DUP2 .Screen/x DEO2
[ LIT2 &hor-y1 $2 ] .Screen/y DEO2 STHkr .Screen/pixel DEOk
[ LIT2 &hor-y2 $2 ] .Screen/y DEO2 DEO
INC2 GTH2k ,&hor JCN
POP2 POP2
( vertical )
[ LIT2 &ver-y2 $2 ] [ LIT2 &ver-y1 $2 ]
&ver
DUP2 .Screen/y DEO2
[ LIT2 &ver-x1 $2 ] .Screen/x DEO2 STHkr .Screen/pixel DEOk
[ LIT2 &ver-x2 $2 ] .Screen/x DEO2 DEO
INC2 GTH2k ,&ver JCN
POP2 POP2
POPr
RTN
&x1 $2 &y1 $2 &x2 $2 &y2 $2
JMP2r
@fill-rect ( x1* y1* x2* y2* color -- )
@ -133,27 +124,27 @@ RTN
OVR2 OVR2 GTS2 ,&ver JCN
POP2 POP2 POP2 POP2
RTN
JMP2r
&color $1
@draw-circle ( xc yc r color -- )
( load ) .color STZ .circle/r STZ2 .circle/yc STZ2 .circle/xc STZ2
#0000 .circle/x STZ2 .circle/r LDZ2 .circle/y STZ2
.circle/r LDZ2 2** .circle/d STZ2
.circle/r LDZ2 #10 SFT2 .circle/d STZ2
( draw ) ;&seg JSR2
&loop
( incr ) .circle/x LDZ2 INC2 .circle/x STZ2
.circle/d LDZ2 #0001 LTS2 ,&else JCN
( decr ) .circle/y LDZ2 #0001 SUB2 .circle/y STZ2
.circle/x LDZ2 .circle/y LDZ2 SUB2 4** .circle/d LDZ2 ADD2 .circle/d STZ2
.circle/x LDZ2 .circle/y LDZ2 SUB2 #20 SFT2 .circle/d LDZ2 ADD2 .circle/d STZ2
;&end JMP2
&else
.circle/x LDZ2 4** .circle/d LDZ2 ADD2 .circle/d STZ2
.circle/x LDZ2 #20 SFT2 .circle/d LDZ2 ADD2 .circle/d STZ2
&end
( draw ) ;&seg JSR2
.circle/y LDZ2 .circle/x LDZ2 #0001 SUB2 GTS2 ,&loop JCN
RTN
JMP2r
&seg
.circle/xc LDZ2 .circle/x LDZ2 ADD2 .Screen/x DEO2 .circle/yc LDZ2 .circle/y LDZ2 ADD2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO
.circle/xc LDZ2 .circle/x LDZ2 SUB2 .Screen/x DEO2 .circle/yc LDZ2 .circle/y LDZ2 ADD2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO
@ -164,7 +155,7 @@ RTN
.circle/xc LDZ2 .circle/y LDZ2 ADD2 .Screen/x DEO2 .circle/yc LDZ2 .circle/x LDZ2 SUB2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO
.circle/xc LDZ2 .circle/y LDZ2 SUB2 .Screen/x DEO2 .circle/yc LDZ2 .circle/x LDZ2 SUB2 .Screen/y DEO2 .color LDZ .Screen/pixel DEO
RTN
JMP2r
@cover-pattern ( addr* color -- )
@ -182,7 +173,7 @@ RTN
POP2 POP2
POPr
RTN
JMP2r
@line-hor ( x0* x1* y* color -- )
@ -194,7 +185,7 @@ RTN
INC2 GTH2k ,&loop JCN
POP2 POP2 POPr
RTN
JMP2r
@line-ver ( x* y0* y1* color -- )
@ -206,6 +197,7 @@ RTN
INC2 GTH2k ,&loop JCN
POP2 POP2 POPr
RTN
JMP2r
@checker_icn [ f0f0 f0f0 0f0f 0f0f ]
@checker-icn
f0f0 f0f0 0f0f 0f0f

43
projects/examples/gui/terminal.tal
View File

@ -1,9 +1,4 @@
( gui/terminal )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
( GUI Terminal )
( devices )
@ -24,7 +19,7 @@
( theme )
#0f0f .System/r DEO2
#0ff0 .System/g DEO2
#00ff .System/b DEO2
#0fff .System/b DEO2
( vectors )
;on-button .Controller/vector DEO2
@ -39,22 +34,22 @@ BRK
@on-button ( -> )
.Controller/key DEI
DUP #00 ! ,&no-null JCN
DUP ,&no-null JCN
POP BRK
&no-null
DUP #0d ! ,&no-enter JCN
DUP #0d NEQ ,&no-enter JCN
#00 ;draw-input JSR2
;validate JSR2
;buffer #0080 ;mclr JSR2
#01 ;draw-input JSR2
&no-enter
DUP #08 ! ,&no-backspace JCN
DUP #08 NEQ ,&no-backspace JCN
#00 ;draw-input JSR2
;buffer ;spop JSR2
#01 ;draw-input JSR2
&no-backspace
DUP STHk #1f > STHr #7b < #0101 !! ,&no-valid JCN
;buffer ;slen JSR2 #007f >> ,&no-valid JCN
DUP STHk #1f GTH STHr #7b LTH #0101 NEQ2 ,&no-valid JCN
;buffer ;slen JSR2 #007f GTH2 ,&no-valid JCN
STHk ;buffer STHr ;sput JSR2
#01 ;draw-input JSR2
&no-valid
@ -65,7 +60,7 @@ BRK
@validate ( -- )
#0010 .Screen/x DEO2
.Screen/height DEI2 #0040 -- .Screen/y DEO2
.Screen/height DEI2 #0040 SUB2 .Screen/y DEO2
( clear )
#8000
@ -80,7 +75,7 @@ BRK
LIT 22 #02 ;draw-char JSR2
;buffer #03 ;draw-str JSR2
LIT 22 #02 ;draw-char JSR2
LIT '. #02 ;draw-char JSR2
LIT ". #02 ;draw-char JSR2
JMP2r
@ -88,9 +83,9 @@ JMP2r
STH
#0010 .Screen/x DEO2
.Screen/height DEI2 #0020 -- .Screen/y DEO2
.Screen/height DEI2 #0020 SUB2 .Screen/y DEO2
( marker ) LIT '> #03 ;draw-char JSR2
( marker ) LIT "> #03 ;draw-char JSR2
;buffer STHr ;draw-str JSR2
@ -110,10 +105,10 @@ JMP2r
@draw-char ( char color -- )
SWP
[ #20 - #00 SWP #40 SFT2 ;font ++ ] .Screen/addr DEO2
[ #20 SUB #00 SWP #40 SFT2 ;font ADD2 ] .Screen/addr DEO2
.Screen/sprite DEOk DEO
.Screen/y DEI2 #0010 -- .Screen/y DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
.Screen/y DEI2 #0010 SUB2 .Screen/y DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
JMP2r
@ -121,13 +116,13 @@ JMP2r
@slen ( str* -- len* )
DUP2 ,scap JSR SWP2 --
DUP2 ,scap JSR SWP2 SUB2
JMP2r
@scap ( str* -- str-end* )
( clamp ) LDAk #00 ! JMP JMP2r
( clamp ) LDAk #00 NEQ JMP JMP2r
&while INC2 LDAk ,&while JCN
JMP2r
@ -140,14 +135,14 @@ JMP2r
@spop ( str* -- )
( clamp ) LDAk #00 ! JMP JMP2r
#00 ROT ROT ,scap JSR #0001 -- STA
( clamp ) LDAk #00 NEQ JMP JMP2r
#00 ROT ROT ,scap JSR #0001 SUB2 STA
JMP2r
@mclr ( addr* len* -- )
OVR2 ++ SWP2
OVR2 ADD2 SWP2
&loop
STH2k #00 STH2r STA
INC2 GTH2k ,&loop JCN

63
projects/examples/gui/wallpaper.tal
View File

@ -1,63 +0,0 @@
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
( variables )
|0000
@scroll [ &x $2 &y $2 &wait $1 ]
|0100 ( -> )
#90ff .System/r DEO2 #9000 .System/g DEO2 #900f .System/b DEO2
#08e0 .Screen/width DEI2 #01 SFT2 SUB2 .scroll/x STZ2
#09b0 .scroll/y STZ2
;frame .Screen/vector DEO2
#30 .scroll/wait STZ
BRK
@frame ( -> )
#ffff
&loop
DUP2 ,row JSR
INC2
DUP2 .Screen/height DEI2 LTH2 ,&loop JCN
POP2
.scroll/wait LDZ ,&noscroll JCN
.scroll/y LDZ2 INC2 .scroll/y STZ2
BRK
&noscroll
.scroll/wait LDZ #01 SUB .scroll/wait STZ
BRK
@row ( y* -- )
DUP2 .Screen/y DEO2
.scroll/y LDZ2 ADD2
.Screen/width DEI2
&loop
#0001 SUB2
OVR2 OVR2 .scroll/x LDZ2 ADD2 EOR2 DUP2 #0013 DIV2 #0013 MUL2 SUB2
DUP #00 EQU ,&draw JCN
DUP #05 EQU ,&draw JCN
POP2
&rest
DUP2 ORA ,&loop JCN
POP2 POP2
JMP2r
#15 .Screen/pixel DEO
JMP2r
&draw
OVR2 .Screen/x DEO2
#05 ADD .Screen/pixel DEO
.Screen/y DEI2
DUP2 INC2 .Screen/y DEO2
#00 .Screen/pixel DEO
.Screen/y DEO2
POP
,&rest JMP

0
projects/examples/demos/asma-piano.tal → projects/examples/old/asma-piano.tal
View File

0
projects/examples/demos/darena.tal → projects/examples/old/darena.tal
View File

63
projects/examples/demos/dungeon.tal → projects/examples/old/dungeon.tal
View File

@ -1,20 +1,5 @@
( art by @ritualdust )
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%8** { #30 SFT2 }
%10** { #40 SFT2 }
%DEBUG { ;print-hex JSR2 #0a .Console/write DEO }
%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO }
%RTN { JMP2r }
%TOS { #00 SWP }
%DEC { #01 - }
%MOUSE { #82 }
( devices )
@ -29,7 +14,7 @@
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|0000
@ -45,8 +30,8 @@
#036f .System/g DEO2
#003f .System/b DEO2
.Screen/width DEI2 #01 SFT2 #0040 -- .room/x STZ2
.Screen/height DEI2 #01 SFT2 #0040 -- .room/y STZ2
.Screen/width DEI2 #01 SFT2 #0040 SUB2 .room/x STZ2
.Screen/height DEI2 #01 SFT2 #0040 SUB2 .room/y STZ2
( vectors )
;on-frame .Screen/vector DEO2
@ -64,28 +49,28 @@ BRK
@on-button ( -> )
.Controller/button DEI
DUP #00 ! ,&no-null JCN
DUP #00 NEQ ,&no-null JCN
POP BRK
&no-null
DUP #10 ! ,&no-up JCN
DUP #10 NEQ ,&no-up JCN
#00 .player/d STZ
#00 ;draw-mouse JSR2
.player/y LDZk DEC SWP STZ
.player/y LDZk #01 SUB SWP STZ
MOUSE ;draw-mouse JSR2
&no-up
DUP #20 ! ,&no-down JCN
DUP #20 NEQ ,&no-down JCN
#01 .player/d STZ
#00 ;draw-mouse JSR2
.player/y LDZk INC SWP STZ
MOUSE ;draw-mouse JSR2
&no-down
DUP #40 ! ,&no-left JCN
DUP #40 NEQ ,&no-left JCN
#02 .player/d STZ
#00 ;draw-mouse JSR2
.player/x LDZk DEC SWP STZ
.player/x LDZk #01 SUB SWP STZ
MOUSE ;draw-mouse JSR2
&no-left
DUP #80 ! ,&no-right JCN
DUP #80 NEQ ,&no-right JCN
#03 .player/d STZ
#00 ;draw-mouse JSR2
.player/x LDZk INC SWP STZ
@ -103,42 +88,42 @@ BRK
@draw-mouse ( color -- )
;spritesheet #29 .player/d LDZ + TOS DUP2 DEBUG2 10** ++ .Screen/addr DEO2
.player/x LDZ TOS 8** .room/x LDZ2 ++ .Screen/x DEO2
.player/y LDZ TOS 8** .room/y LDZ2 ++ .Screen/y DEO2
#40 + .Screen/sprite DEO
;spritesheet #29 .player/d LDZ ADD #0004 SFT2 ADD2 .Screen/addr DEO2
.player/x LDZ #0005 SFT2 .room/x LDZ2 ADD2 .Screen/x DEO2
.player/y LDZ #0005 SFT2 .room/y LDZ2 ADD2 .Screen/y DEO2
#40 ADD .Screen/sprite DEO
RTN
JMP2r
@draw-dungeon ( stage* -- )
STH2
#1000
&ver
DUP TOS 8** .room/y LDZ2 ++ .Screen/y DEO2
DUP #0005 SFT2 .room/y LDZ2 ADD2 .Screen/y DEO2
#1000
&hor
DUP TOS 8** .room/x LDZ2 ++ .Screen/x DEO2
( get id ) STH2 DUP STH2r ROT OVR SWP #40 SFT + TOS
( tile ) DUP2 STH2kr ++ LDA TOS 10** ;spritesheet ++ .Screen/addr DEO2
( color ) STH2kr #0100 ++ ++ LDA .Screen/sprite DEO
DUP #0005 SFT2 .room/x LDZ2 ADD2 .Screen/x DEO2
( get id ) STH2 DUP STH2r ROT OVR SWP #40 SFT ADD #00 SWP
( tile ) DUP2 STH2kr ADD2 LDA #0004 SFT2 ;spritesheet ADD2 .Screen/addr DEO2
( color ) STH2kr #0100 ADD2 ADD2 LDA .Screen/sprite DEO
INC GTHk ,&hor JCN
POP2
INC GTHk ,&ver JCN
POP2
POP2r
RTN
JMP2r
@print-hex ( value -- )
STHk #04 SFT ,&parse JSR .Console/write DEO
STHr #0f AND ,&parse JSR .Console/write DEO
RTN
JMP2r
&parse ( value -- char )
DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN
DUP #09 GTH ,&above JCN #30 ADD JMP2r &above #09 SUB #60 ADD JMP2r
RTN
JMP2r
@mouse-icn
ffff ffff ffff ffff 0000 0000 0000 0000

2
projects/examples/demos/prng.tal → projects/examples/old/prng.tal
View File

@ -6,7 +6,7 @@
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )

29
projects/examples/demos/rule110.tal → projects/examples/old/rule110.tal
View File

@ -2,11 +2,6 @@
( uxnasm rule110.tal rule110.rom && uxnemu rule110.rom )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 }
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
@ -18,8 +13,8 @@
%8MOD { #07 AND } %8MOD2 { #0007 AND2 }
%10MOD { #0f AND } %10MOD2 { #000f AND2 }
%ROL2 { DUP2 #0f SFT2 SWP2 #10 SFT2 ++ }
%ROR2 { DUP2 #f0 SFT2 SWP2 #01 SFT2 ++ }
%ROL2 { DUP2 #0f SFT2 SWP2 #10 SFT2 ADD2 }
%ROR2 { DUP2 #f0 SFT2 SWP2 #01 SFT2 ADD2 }
%DEBUG { ;print-hex/byte JSR2 #0a18 DEO }
%DEBUG2 { ;print-hex JSR2 #0a18 DEO }
@ -76,11 +71,11 @@ RTN
#1000
&loop
DUP #00 SWP 8** .Screen/x DEO2
( shift ) INCk #10 SWP -
( shift ) INCk #10 SWP SUB
( get address ) STHkr 2* LDZ2
( bit ) ROT SFT2 #0001 AND2
( get sprite ) 8** ;cell-icns ++ .Screen/addr DEO2
#01 STHkr #00 = + .Screen/sprite DEO
( get sprite ) 8** ;cell-icns ADD2 .Screen/addr DEO2
#01 STHkr #00 EQU ADD .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
POPr
@ -93,10 +88,10 @@ RTN
ROL2 STH2
#1000
&loop
( get 3-bits ) STH2kr #e000 AND2 #0d SFT2 ;rule ++ LDA STH
( get 3-bits ) STH2kr #e000 AND2 #0d SFT2 ;rule ADD2 LDA STH
( get result ) DUP #40 SFT #00 STHr ROT SFT2
( reset ) ROR2 ROR2 ROR2
( save ) ,&res LDR2 ++ ,&res STR2
( save ) ,&res LDR2 ADD2 ,&res STR2
STH2r ROR2 STH2
INC GTHk ,&loop JCN
POP2
@ -123,14 +118,14 @@ RTN
.Mouse/y DEI2 DUP2 ,&y STR2 .Screen/y DEO2
( colorize on state )
#43 [ .Mouse/state DEI #00 ! ] - .Screen/sprite DEO
#43 [ .Mouse/state DEI #00 NEQ ] SUB .Screen/sprite DEO
( on click )
.Mouse/state DEI #00 ! JMP BRK
.Mouse/state DEI #00 NEQ JMP BRK
( toggle bit )
.input LDZ2k
#0001 .Mouse/x DEI2 8// #000f SWP2 -- NIP #40 SFT SFT2 EOR2
#0001 .Mouse/x DEI2 8// #000f SWP2 SUB2 NIP #40 SFT SFT2 EOR2
ROT STZ2
;render JSR2
( release ) #00 .Mouse/state DEO
@ -145,8 +140,8 @@ BRK
STHk #04 SFT ,&parse JSR #18 DEO
STHr #0f AND ,&parse JSR #18 DEO
RTN
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 + RTN
&above #57 + RTN
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD RTN
&above #57 ADD RTN
RTN

BIN
projects/fonts/cream.uf2 Normal file
View File

Binary file not shown.

BIN
projects/fonts/diamond20.uf3
View File

Binary file not shown.

BIN
projects/fonts/geneva24.uf3
View File

Binary file not shown.

BIN
projects/fonts/helvetica24.uf3
View File

Binary file not shown.

BIN
projects/fonts/newyork24.uf3
View File

Binary file not shown.

BIN
projects/fonts/palatino24.uf3
View File

Binary file not shown.

BIN
projects/fonts/sans12-bold.uf2 Normal file
View File

Binary file not shown.

BIN
projects/fonts/sans12-regular.uf2 Normal file
View File

Binary file not shown.

BIN
projects/fonts/sans14-bold.uf2 Normal file
View File

Binary file not shown.

BIN
projects/fonts/sans14-regular.uf2 Normal file
View File

Binary file not shown.

BIN
projects/fonts/sapphire19.uf3
View File

Binary file not shown.

BIN
projects/fonts/times24.uf3
View File

Binary file not shown.

219
projects/library/asma.tal
View File

@ -11,12 +11,6 @@
examples of asma's usage and can be discarded.
)
(
Common macros for use later on.
)
%asma-IF-ERROR { ;asma/error LDA2 ORA }
(
Asma's public interface.
These routines are what are expected to be called from programs that bundle
@ -32,7 +26,7 @@
;asma-init-first-pass JSR2
;asma-flush-ignore ;asma/flush-fn STA2
;asma/src-filename LDA2 ;asma-assemble-file-pass JSR2
asma-IF-ERROR ,&error JCN
;asma/error LDA2 ORA ,&error JCN
;asma-init-next-pass JSR2
;asma-flush-to-file ;asma/flush-fn STA2
@ -40,7 +34,7 @@
;asma-flush-to-console ;asma/flush-fn STA2
&filename-present
;asma/src-filename LDA2 ;asma-assemble-file-pass JSR2
asma-IF-ERROR ,&error JCN
;asma/error LDA2 ORA ,&error JCN
( flush output buffer )
;asma-output/ptr LDA2 ;asma-write-buffer SUB2 ;asma/flush-fn LDA2 JSR2
@ -137,8 +131,8 @@
DUP2 ,asma-print-labels JSR
( here )
DUP2 #0004 ADD2
LDAk LIT 'A LTH ,&loop JCN
LDAk LIT 'Z GTH ,&loop JCN
LDAk LIT "A LTH ,&loop JCN
LDAk LIT "Z GTH ,&loop JCN
POP2
,&skip-device-label JMP
&loop
@ -169,8 +163,8 @@
,asma-print-string JMP
@asma-print-short ( short* -- )
LIT '0 .Console/error DEO
LIT 'x .Console/error DEO
LIT "0 .Console/error DEO
LIT "x .Console/error DEO
OVR #04 SFT ,&hex JSR
SWP #0f AND ,&hex JSR
DUP #04 SFT ,&hex JSR
@ -202,15 +196,18 @@
@asma-init-next-pass ( -- )
;asma/pass LDA INC ;asma/pass STA
;asma-write-buffer ;asma-output/ptr STA2
#0000 DUP2
;asma/addr STA2
#0100 DUP2 DUP ( 0100 0100 00 )
;asma/state STA
#01 SWP ( 0100 ) ;asma/written-addr STA2
;asma/addr STA2
;asma/written-addr STA2
;&preamble-end ;&preamble SUB2k ;asma-assemble-chunk JSR2 POP2 POP2
JMP2r
&preamble
"%BRK 20 '{ 20 "00 20 '} 20
"%BRK 20 "{ 20 "00 20 "} 20
"%[ 20 "{ 20 "} 20
"%] 20 "{ 20 "} 20
"@on-reset 20
&preamble-end
(
@ -222,9 +219,8 @@
;asma-read-buffer DUP2 ;asma-read-buffer/end ROT2 SUB2 ( func* line^ filename* buf* size^ )
ROT2 ( func* line^ buf* size^ filename* )
,file-read-chunks JSR
;asma-flush-lit JSR2
asma-IF-ERROR ,&error JCN
;asma/error LDA2 ORA ,&error JCN
&error
POP2 POP2 POP2 POP2 POP2
@ -316,7 +312,7 @@
LDAk #0a NEQ ( end-chunk* ws-char* not-newline / line^ start-of-token* )
#00 OVR2 STA
STH2r ,asma-assemble-token JSR ( end-chunk* ws-char* not-newline / line^ )
asma-IF-ERROR ,&error JCN
;asma/error LDA2 ORA ,&error JCN
,&not-newline JCN
,asma/lines LDR2 INC2 ,asma/lines STR2
&not-newline ( end-chunk* ws-char* / line^ )
@ -348,7 +344,7 @@
@asma [
&pass $1 &state $1 &line $2 &lines $2 &break $1 &eof $1
&comment-level $1
&token $2 &orig-token $2 &lit $1 &lit-present $1
&token $2 &orig-token $2
&addr $2 &written-addr $2 &flush-fn $2
&src-filename $2 &dest-filename $2
&error $2 &log-level $1
@ -360,9 +356,9 @@
asma/state contains several meaningful bits:
0x02 we are in a comment,
0x04 we are in a macro body,
0x10 we are in a macro body that we are ignoring
0x08 we are in a macro body that we are ignoring
(because the macro was already defined in a previous pass).
Since 0x10 never appears without 0x04, the lowest bit set in asma/state is
Since 0x08 never appears without 0x04, the lowest bit set in asma/state is
always 0x00, 0x02, or 0x04, which is very handy for use with jump tables.
The lowest bit set can be found easily by #00 (n) SUBk AND.
)
@ -447,7 +443,7 @@
,asma-parse-hex-digit JSR
DUP #f0 AND ,&fail JCN
LITr 40 SFT2r
#00 STH STH ADD2r
LITr 00 STH ADD2r
INC2
,&loop JMP
@ -493,15 +489,15 @@
JMP2r
&not-end
DUP LIT '2 NEQ ,&not-two JCN
DUP LIT "2 NEQ ,&not-two JCN
POP LIT &short-flag $1 ORA ,&loop JMP
&not-two
DUP LIT 'r NEQ ,&not-return JCN
DUP LIT "r NEQ ,&not-return JCN
POP LIT &return-flag $1 ORA ,&loop JMP
&not-return
LIT 'k NEQ ,&not-keep JCN
LIT "k NEQ ,&not-keep JCN
&set-keep LIT &keep-flag $1 ORA ,&loop JMP
&not-keep ( 00 byte / end* )
@ -511,37 +507,23 @@
POP2 #01
JMP2r
@asma-write-lit ( byte -- )
LIT LIT ,asma-write-byte JSR
,asma-write-byte JSR
JMP2r
@asma-advance-addr ( delta* -- )
;asma/addr LDA2k ( delta* ptr* value* )
ROT2 ADD2 ( ptr* new-value* )
SWP2 STA2
JMP2r
@asma-write-short ( short -- )
SWP
,asma-write-byte JSR
,asma-write-byte JMP ( tail call )
@asma-write-lit ( byte -- )
;asma/lit LDA2 ,&present JCN
POP #01 ;asma/lit STA2
;asma/addr LDA2k INC2 INC2 SWP2 STA2
JMP2r
&present
;asma/addr LDA2k #0002 SUB2 SWP2 STA2
LIT LIT2 ,asma-write-byte/raw JSR
,asma-write-byte/raw JSR
,asma-write-byte/raw JSR
#0000 ;asma/lit STA2
JMP2r
@asma-flush-lit ( -- )
;asma/lit LDA2 ,&present JCN
POP JMP2r
&present
;asma/addr LDA2k #0002 SUB2 SWP2 STA2
LIT LIT ,asma-write-byte/raw JSR
,asma-write-byte/raw JSR
#0000 ;asma/lit STA2
JMP2r
( fall through )
@asma-write-byte ( byte -- )
,asma-flush-lit JSR
&raw
;asma/addr LDA2 ;asma/written-addr LDA2
LTH2k ,&rewound JCN
&loop
@ -608,14 +590,11 @@
-body routines) tokens that fail to match any first letter in their tree.
)
%asma-STATE-SET { ;asma/state LDA ORA ;asma/state STA }
%asma-STATE-CLEAR { #ff EOR ;asma/state LDA AND ;asma/state STA }
@asma-comment-more
;asma/token LDA2 ;strlen JSR2 ORA ,asma-ignore JCN
@asma-comment-start
;asma/comment-level LDAk INC ROT ROT STA
#02 asma-STATE-SET
;asma/state LDA #02 ORA ;asma/state STA
@asma-ignore
JMP2r
@ -623,7 +602,7 @@
;asma/token LDA2 ;strlen JSR2 ORA ,asma-ignore JCN
;asma/comment-level LDAk #01 SUB DUP SWP2 STA ,asma-ignore JCN
@asma-comment-end
#02 asma-STATE-CLEAR
;asma/state LDA #0c AND ;asma/state STA
JMP2r
@asma-macro-define
@ -640,26 +619,25 @@
#0000 ;append-heap-short JSR2 ( less-than pointer )
#0000 ;append-heap-short JSR2 ( greater-than pointer )
;asma/token LDA2 ;append-heap-string JSR2 ( key )
#04 asma-STATE-SET
;asma/state LDA #04 ORA ;asma/state STA
JMP2r
&ignore-macro
#14 asma-STATE-SET
;asma/state LDA #0c ORA ;asma/state STA
JMP2r
@asma-macro-body
;asma/state LDA #10 AND ,&skip JCN
;asma/state LDA #08 AND ,&skip JCN
;asma/token LDA2 ;append-heap-string JSR2
&skip
JMP2r
@asma-macro-end
#00 ;append-heap-byte JSR2
#14 asma-STATE-CLEAR
;asma/state LDA #02 AND ;asma/state STA
JMP2r
@asma-label-define
;asma-flush-lit JSR2
;asma-trees/labels ,asma-label-helper JSR
,&already-existed JCN
@ -670,7 +648,6 @@
JMP2r
@asma-sublabel-define
;asma-flush-lit JSR2
;asma-trees/scope LDA2 ,asma-label-helper JSR
POP POP2
JMP2r
@ -700,29 +677,18 @@
#00 JMP2r
@asma-pad-absolute
;asma-flush-lit JSR2
#0000 ,asma-pad-helper JMP
@asma-pad-relative
;asma-flush-lit JSR2
;asma/addr LDA2
#0000 ;asma/addr STA2
( fall through )
@asma-pad-helper ( offset* -- )
@asma-pad-relative
#00 ;asma-parse-hex-string JSR2
,&valid JCN
;asma-msg-hex ;asma/error STA2
POP2
JMP2r
&valid
ADD2 ;asma/addr STA2
JMP2r
@asma-raw-char
;asma/token LDA2 LDA
;asma-write-byte JMP2 ( tail call )
;asma-advance-addr JMP2 ( tail call )
@asma-raw-word
;asma/token LDA2
@ -748,8 +714,12 @@
;asma-write-short JMP2 ( tail call )
@asma-literal-zero-addr
LIT LIT ;asma-write-byte JSR2
( fall through )
@asma-zero-addr
,asma-addr-helper JSR
;asma-write-lit JSR2
;asma-write-byte JSR2
,&not-zero-page JCN
JMP2r
@ -762,10 +732,28 @@
&ignore-error
JMP2r
@asma-literal-rel-addr
@asma-jci
#20 ,asma-jxi JMP ( tail call )
@asma-jmi
#40
( fall through )
@asma-jxi
;asma-write-byte JSR2
,asma-addr-helper JSR
;asma/addr LDA2 SUB2
#0003 ;asma/lit-present LDA SUB SUB2
#0002 SUB2
;asma-write-short JMP2 ( tail call )
@asma-literal-rel-addr
LIT LIT ;asma-write-byte JSR2
( fall through )
@asma-rel-addr
,asma-addr-helper JSR
;asma/addr LDA2 SUB2
#0002 SUB2
DUP2 #0080 LTH2 STH
DUP2 #ff7f GTH2 STHr ORA ,&in-bounds JCN
@ -775,7 +763,7 @@
JMP2r
&in-bounds
;asma-write-lit JSR2
;asma-write-byte JSR2
POP
JMP2r
@ -859,7 +847,6 @@
( hex short ) ,asma-short-helper/raw JMP
&not-hex
.System/rst DEI #e0 GTH ,&too-deep JCN
;asma-trees/macros ;asma-traverse-tree JSR2 ,&not-macro JCN
&macro-loop
@ -869,7 +856,7 @@
&keep-going
DUP2k ;strlen JSR2 INC2 ADD2
SWP2 ;asma-assemble-token JSR2 asma-IF-ERROR ,&macro-error JCN
SWP2 ;asma-assemble-token JSR2 ;asma/error LDA2 ORA ,&macro-error JCN
,&macro-loop JMP
&macro-error
@ -878,15 +865,9 @@
&not-macro
POP2
;asma-msg-token ;asma/error STA2
JMP2r
&too-deep
;asma-msg-too-deep ;asma/error STA2
JMP2r
#60 ;asma-jxi JMP2 ( tail call )
@asma-include
.System/rst DEI #e0 GTH ,asma-normal-body/too-deep JCN
;heap LDA2
;asma/token LDA2 ;append-heap-string JSR2
;asma-assemble-file-pass JSR2
@ -899,10 +880,8 @@
@asma-msg-zero-page "Address 20 "not 20 "in 20 "zero 20 "page 00
@asma-msg-relative "Address 20 "outside 20 "range 00
@asma-msg-label "Label 20 "not 20 "found 00
@asma-msg-token "Unrecognised 20 "token 00
@asma-msg-macro "Macro 20 "already 20 "exists 00
@asma-msg-rewound "Memory 20 "overwrite 00
@asma-msg-too-deep "Recursion 20 "level 20 "too 20 "deep 00
@asma-msg-redefined "Label 20 "redefined 00
( trees )
@ -915,45 +894,47 @@
than than string data )
@asma-first-char-comment
&28 $2 $2 '( 00 :asma-comment-more
&_entry :&28 $2 ') 00 :asma-comment-less
&28 $2 $2 "( 00 :asma-comment-more
&_entry :&28 $2 ") 00 :asma-comment-less
@asma-first-char-macro
&28 $2 $2 '( 00 :asma-comment-start
&29 :&28 $2 ') 00 :asma-comment-end
&_entry :&29 :&7d '{ 00 :asma-ignore
&7d $2 $2 '} 00 :asma-macro-end
&28 $2 $2 "( 00 :asma-comment-start
&29 :&28 $2 ") 00 :asma-comment-end
&_entry :&29 :&7d "{ 00 :asma-ignore
&7d $2 $2 "} 00 :asma-macro-end
@asma-first-char-normal
&22 $2 $2 '" 00 :asma-raw-word
&23 :&22 $2 '# 00 :asma-literal-hex
&24 :&23 :&25 '$ 00 :asma-pad-relative
&25 $2 $2 '% 00 :asma-macro-define
&26 :&24 :&29 26 00 ( & ) :asma-sublabel-define
&27 $2 $2 '' 00 :asma-raw-char
&28 :&27 $2 '( 00 :asma-comment-start
&29 :&28 :&2c ') 00 :asma-comment-end
&2c $2 $2 ', 00 :asma-literal-rel-addr
&_entry :&26 :&5d '. 00 :asma-literal-zero-addr
&3a $2 $2 ': 00 :asma-abs-addr
&3b :&3a $2 '; 00 :asma-literal-abs-addr
&40 :&3b :&5b '@ 00 :asma-label-define
&5b $2 $2 '[ 00 :asma-ignore
&5d :&40 :&7d '] 00 :asma-ignore
&7b $2 $2 '{ 00 :asma-ignore
&7c :&7b $2 '| 00 :asma-pad-absolute
&7d :&7c :&7e '} 00 :asma-ignore
&7e $2 $2 '~ 00 :asma-include
&21 $2 $2 "! 00 :asma-jmi
&22 :&21 $2 "" 00 :asma-raw-word
&23 :&22 :&25 "# 00 :asma-literal-hex
&24 $2 $2 "$ 00 :asma-pad-relative
&25 :&24 $2 "% 00 :asma-macro-define
&26 :&23 :&2c 26 00 ( & ) :asma-sublabel-define
&28 $2 $2 "( 00 :asma-comment-start
&29 :&28 $2 ") 00 :asma-comment-end
&2c :&29 :&2d ", 00 :asma-literal-rel-addr
&2d $2 $2 "- 00 :asma-zero-addr
&_entry :&26 :&5f ". 00 :asma-literal-zero-addr
&3a $2 $2 ": 00 :asma-abs-addr
&3b :&3a $2 "; 00 :asma-literal-abs-addr
&3d :&3b :&40 "= 00 :asma-abs-addr
&3f $2 $2 "? 00 :asma-jci
&40 :&3f $2 "@ 00 :asma-label-define
&5f :&3d :&7d "_ 00 :asma-rel-addr
&7b $2 $2 "{ 00 :asma-ignore
&7c :&7b $2 "| 00 :asma-pad-absolute
&7d :&7c :&7e "} 00 :asma-ignore
&7e $2 $2 "~ 00 :asma-include
@asma-opcodes
&_entry :&GTH :&ROT &_disasm "LIT 00
&INC $2 $2 "INC 00
&POP $2 $2 "POP 00
&DUP $2 $2 "DUP 00
&NIP :&MUL :&OVR "NIP 00
&SWP $2 $2 "SWP 00
&OVR :&ORA :&POP "OVR 00
&ROT :&NIP :&STR "ROT 00
&DUP $2 $2 "DUP 00
&OVR :&ORA :&POP "OVR 00
&EQU $2 $2 "EQU 00
&NEQ $2 $2 "NEQ 00
&GTH :&DIV :&JSR "GTH 00

181
projects/library/debugger.tal
View File

@ -1,181 +0,0 @@
( in-Uxn debugger )
( To use, include this file just before the BRK in the program reset routine, e.g.:
|0100 ( -> )
( theme )
#0fe5 .System/r DEO2
#0fc5 .System/g DEO2
#0f25 .System/b DEO2
~projects/library/debugger.tal
BRK
The debugger will catch stack errors that arise after that point.
)
%BREAKPOINT { LIT2r :debug JSR2r }
@debug-start
;debug-vector .System/vector DEO2
;debug-end JMP2
@debug ( pc* -- )
#0001 SUB2 .System/eaddr DEO2
.System/ecode DEIk #07 EOR SWP DEO
,debug-vector/main JMP
@debug-vector ( -> )
STH STH STH STH ( <- only run in case of working stack overflow )
&main
( flush the working stack )
.System/wst DEI ;debug-wst/ptr STA
&flush-wst
.System/wst DEI #00 EQU ,&end-flush-wst JCN
#00 .System/wst DEI #0002 SUB2 ;debug-wst/dat ADD2 STA
,&flush-wst JMP
&end-flush-wst
( in case of working stack overflow, we need to append the four return stack bytes )
.System/ecode DEI #02 NEQ ,&skip-wst-append JCN
#00 ;debug-wst/ptr LDAk ( 00 ptr-hi ptr-lo ptr / ... z y x w )
DUP #04 ADD OVR2 STA
ROT ROT ADD2 ( start* / ... z y x w )
INC2 DUP2 #0004 ADD2 SWP2 ( end* start* / ... z y x w )
&loop
DUP2 STHr ROT ROT STA
INC2
GTH2k ,&loop JCN
POP2 POP2
&skip-wst-append
( flush the return stack )
.System/rst DEI ;debug-rst/ptr STA
&flush-rst
.System/rst DEI #00 EQU ,&end-flush-rst JCN
STHr #00 .System/rst DEI ;debug-rst/dat ADD2 STA
,&flush-rst JMP
&end-flush-rst
( Version 0.1 functionality: print the error and exit )
;debug-print-error JSR2
#01 .System/halt DEO
BRK
@debug-print-opcode ( instr -- )
DUP ,&not-brk JCN
POP ;&brk-msg ;debug-print JMP2 ( tail call )
&brk-msg "BRK 00
&not-brk
#00 OVR #1f AND #03 MUL ;&opcode-names ADD2 ( instr addr* )
LDAk .Console/write DEO INC2
LDAk .Console/write DEO INC2
LDA .Console/write DEO
DUP #1f AND ,&not-lit JCN
#7f AND
&not-lit
DUP #20 AND #00 EQU ,&not-2 JCN
LIT '2 .Console/write DEO
&not-2
DUP #80 AND #00 EQU ,&not-k JCN
LIT 'k .Console/write DEO
&not-k
#40 AND #00 EQU ,&not-r JCN
LIT 'r .Console/write DEO
&not-r
JMP2r
&opcode-names
"LITINCPOPDUPNIPSWPOVRROT
"EQUNEQGTHLTHJMPJCNJSRSTH
"LDZSTZLDRSTRLDASTADEIDEO
"ADDSUBMULDIVANDORAEORSFT
@debug-print ( addr* -- )
LDAk #00 EQU ,&end JCN
LDAk .Console/write DEO
INC2
,debug-print JMP
&end POP2 JMP2r
@debug-print-error
;&halted-msg ,debug-print JSR
#00 .System/ecode DEI #07 AND #20 SFT2 ;&messages-table ADD2
LDA2k ,debug-print JSR
INC2 INC2 LDA2 ,debug-print JSR
;&executing-msg ,debug-print JSR
.System/eaddr DEI2 LDA ;debug-print-opcode JSR2
;&at-msg ,debug-print JSR
.System/eaddr DEI2 ;debug-print-hex-short JSR2
#0a .Console/write DEO
;&wst-msg ,debug-print JSR
;&contents-msg ,debug-print JSR
;debug-wst ;debug-print-stack JSR2
#0a .Console/write DEO
;&rst-msg ,debug-print JSR
;&contents-msg ,debug-print JSR
;debug-rst ;debug-print-stack JSR2
#0a .Console/write DEO
JMP2r
&messages-table
:&wst-msg :&underflow-msg
:&rst-msg :&underflow-msg
:&wst-msg :&overflow-msg
:&rst-msg :&overflow-msg
:&wst-msg :&divzero-msg
:&rst-msg :&divzero-msg
:&emulator-msg :&interrupt-msg
:&userdef-msg :&breakpoint-msg
&halted-msg "Halted: 2000 ( #0002, at 0x0100 )
&wst-msg "Working-stack 2000
&rst-msg "Return-stack 2000
&emulator-msg "Emulator 2000
&userdef-msg "User-defined 2000
&underflow-msg "underflow 00
&overflow-msg "overflow 00
&divzero-msg "division 20 "by 20 "zero 00
&interrupt-msg "interrupt 00
&breakpoint-msg "breakpoint 00
&executing-msg 20 "executing 2000
&at-msg 20 "at 20 "0x 00
&contents-msg "contents: 00
@debug-print-hex-short ( value* -- )
SWP ,debug-print-hex-byte JSR
( fall through )
@debug-print-hex-byte ( value -- )
DUP #04 SFT ,debug-print-hex-nibble JSR
#0f AND
( fall through )
@debug-print-hex-nibble ( value -- )
#30 ADD DUP #39 GTH #27 MUL ADD
.Console/write DEO
JMP2r
@debug-print-stack ( addr* -- )
LDAk ,&not-empty JCN
POP2 ;&empty-msg ;debug-print JMP2 ( tail call )
&not-empty
LDAk STH INC2 ( dat* / count )
&loop
STHkr #00 EQU ,&end JCN
#20 .Console/write DEO
LDAk ,debug-print-hex-byte JSR
INC2
LITr 01 SUBr
,&loop JMP
&end
POP2 POPr
JMP2r
&empty-msg 20 "(empty) 00
@debug-wst &ptr $1 &dat $ff
@debug-rst &ptr $1 &dat $ff
@debug-end

243
projects/library/helpers.tal Normal file
View File

@ -0,0 +1,243 @@
%BYE { #01 .System/halt DEO BRK }
%DEBUG { #ab .System/debug DEO }
%IN-RANGE { ROT INCk SWP SUB2 GTH }
%MOD { DIVk MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }
%NL { #0a .Console/write DEO }
%SP { #20 .Console/write DEO }
@print-string ( string* -- )
LDAk ,&not-end JCN
POP2 JMP2r
&not-end
LDAk .Console/write DEO
INC2
,print-string JMP
@print-short-decimal ( short* -- )
#03e8 DIV2k
DUP ,print-byte-decimal/second JSR
MUL2 SUB2
#0064 DIV2k
DUP ,print-byte-decimal/third JSR
MUL2 SUB2
NIP ,print-byte-decimal/second JMP
@print-byte-decimal ( byte -- )
#64 DIVk DUP #30 ADD .Console/write DEO MUL SUB
&second
#0a DIVk DUP #30 ADD .Console/write DEO MUL SUB
&third
#30 ADD .Console/write DEO
JMP2r
@print-32z-hex ( 32-zp -- )
#00 SWP
,print-32-hex JMP
@print-64z-hex ( 64-zp -- )
#00 SWP
( fall through )
@print-64-hex ( 64-ptr* -- )
DUP2 #0004 ADD2 SWP2 ( lo32-ptr* hi32-ptr* )
,print-32-hex JSR
( fall through )
@print-32-hex ( 32-ptr* -- )
INC2k INC2 SWP2 ( lo-ptr* hi-ptr* )
LDA2 ,print-short-hex JSR
LDA2 ( fall through )
@print-short-hex ( short* -- )
SWP ,print-byte-hex JSR
( fall through )
@print-byte-hex ( byte -- )
DUP #04 SFT ,print-nibble-hex JSR
#0f AND ( fall through )
@print-nibble-hex ( nibble -- )
#30 ADD DUP #39 GTH #07 MUL ADD .Console/write DEO
JMP2r
@next-input-byte ( -- number 00
OR 01 at end of file )
,next-input-short JSR ,&eof JCN
NIP #00
JMP2r
&eof
#01
JMP2r
@next-input-short ( -- number* 00
OR 01 at end of file )
LIT2 &ptr :heap
LIT2r 0000
&ffwd
LDAk #3039 IN-RANGE ,&number JCN
INC2k SWP2 LDA ,&ffwd JCN
( eof )
POP2 POP2r
;heap ,&ptr STR2
#01 JMP2r
&number
LIT2r 000a MUL2r
LDAk #30 SUB LITr 00 STH ADD2r
INC2
LDAk #3039 IN-RANGE ,&number JCN
,&ptr STR2
STH2r #00
JMP2r
@add64 ( dest-ptr* src-ptr* -- carry )
OVR2 #0004 ADD2 OVR2 #0004 ADD2
,add32 JSR
( fall through )
@adc32 ( dest-ptr* src-ptr* carry -- carry )
STH
OVR2 #0002 ADD2 OVR2 #0002 ADD2
STHr ,adc16 JSR
,adc16 JMP ( tail call )
@add64z ( dest-zp src-zp -- carry )
OVR #04 ADD OVR #04 ADD
,add32z JSR
( fall through )
@adc32z ( dest-zp src-zp carry -- carry )
STH
OVR #02 ADD OVR #02 ADD
STHr ,adc16z JSR
,adc16z JMP ( tail call )
@add32z-short ( dest-zp src* -- carry )
#00 SWP SWP2 ROT
( fall through )
@add32-short ( dest-ptr* src* -- carry )
,&short STR2
;&src ,add32 JMP ( tail call )
&src 0000 &short 0000
@add32 ( dest-ptr* src-ptr* -- carry )
OVR2 #0002 ADD2 OVR2 #0002 ADD2
,add16 JSR
( fall through )
@adc16 ( dest-ptr* src-ptr* carry -- carry )
#00 EQU ,add16 JCN
OVR2 ;&one ,add16 JSR STH
,add16 JSR
STHr ORA
JMP2r
&one 0001
@add16 ( dest-ptr* src-ptr* -- carry )
OVR2 LDA2 DUP2 ROT2 LDA2 ( dest-ptr* dest* dest* src* )
ADD2 GTH2k STH NIP2 ( dest-ptr* sum* / carry )
SWP2 STA2 STHr ( carry )
JMP2r
@add32z ( dest-zp src-zp -- carry )
OVR #02 ADD OVR #02 ADD
,add16z JSR
( fall through )
@adc16z ( dest-zp src-zp carry -- carry )
#00 EQU ,add16z JCN
OVR #00 SWP ;adc16/one ,add16 JSR STH
,add16z JSR
STHr ORA
JMP2r
@add16z ( dest-zp src-zp -- carry )
OVR LDZ2 ROT LDZ2 OVR2 ( dest-zp dest* src* dest* )
ADD2 GTH2k STH NIP2 ( dest-zp sum* / carry )
ROT STZ2 STHr ( carry )
JMP2r
@gth64 ( left-ptr* right-ptr* -- 01 if left > right
OR 00 otherwise )
OVR2 OVR2 ,gth32 JSR ,&greater JCN
OVR2 OVR2 SWP2 ,gth32 JSR ,&less JCN
#0004 ADD2 SWP2 #0004 ADD2 SWP2 ,gth32 JMP ( tail call )
&greater POP2 POP2 #01 JMP2r
&less POP2 POP2 #00 JMP2r
@gth32z ( left-zp* right-zp* -- 01 if left > right
OR 00 otherwise )
#00 ROT ROT #00 SWP
( fall through )
@gth32 ( left-ptr* right-ptr* -- 01 if left > right
OR 00 otherwise )
OVR2 LDA2 OVR2 LDA2 ( left-ptr* right-ptr* left* right* )
EQU2k ,&lo JCN
GTH2 NIP2 NIP NIP
JMP2r
&lo
POP2 POP2
INC2 INC2 LDA2 SWP2 INC2 INC2 LDA2 ( right-lo* left-lo* )
LTH2
JMP2r
@add32z-short-short-mul ( dest-zp a* b* -- carry )
STH2 STH2 #00 SWP STH2r STH2r
( fall through )
@add32-short-short-mul ( dest-ptr* a* b* -- carry )
LITr 00 STH LITr 00 STH ( dest-ptr* a* / blo* bhi* )
#00 ROT ROT #00 SWP ( dest-ptr* ahi* alo* / blo* bhi* )
STH2kr OVR2 MUL2 ,&alo-bhi STR2
OVR2 STH2r MUL2 ,&ahi-bhi STR2 ( dest-ptr ahi* alo* / blo* )
STH2kr MUL2 ,&alo-blo STR2 ( dest-ptr* ahi* / blo* )
STH2r MUL2 ,&ahi-blo STR2 ( dest-ptr* )
DUP2 ;&sum1 ;add32 JSR2 STH
DUP2 ;&sum2 ;add32 JSR2 STH
;&sum3 ;add32 JSR2
STH2r ORA ORA
JMP2r
&sum1 &ahi-bhi 0000 &alo-blo 0000
&sum2 00 &ahi-blo 0000 00
&sum3 00 &alo-bhi 0000 00
@zero64 ( ptr* -- )
#08 ,zero JMP ( tail call )
@zero32z ( zp -- )
#00 SWP
( fall through )
@zero32 ( ptr* -- )
#04
( fall through )
@zero ( ptr* len -- )
#00 SWP ADD2k NIP2 SWP2
&loop
DUP2 #00 ROT ROT STA
INC2
GTH2k ,&loop JCN
POP2 POP2
JMP2r
@is-nonzero64 ( ptr* -- flag )
DUP2 ,is-nonzero32 JSR STH
#0004 ADD2 ,is-nonzero32 JSR STHr ORA
JMP2r
@is-nonzero32 ( ptr* -- flag )
LDA2k ORA STH
INC2 INC2 LDA2 ORA STHr ORA
JMP2r

428
projects/library/math32.tal Normal file
View File

@ -0,0 +1,428 @@
( math32.tal )
( )
( This library supports arithmetic on 32-bit unsigned integers, )
( also known as long values. )
( )
( 32-bit long values are represented by two 16-bit short values: )
( )
( decimal hexadecimal uxn literals )
( 0 0x00000000 #0000 #0000 )
( 1 0x00000001 #0000 #0001 )
( 4660 0x00001234 #0000 #1234 )
( 65535 0x0000ffff #0000 #ffff )
( 65536 0x00010000 #0001 #0000 )
( 16777215 0x00ffffff #00ff #ffff )
( 4294967295 0xffffffff #ffff #ffff )
( )
( The most significant 16-bit, the "high bits", are stored first. )
( We document long values as x** -- equivalent to xhi* xlo*. )
( )
( Operations supported: )
( )
( NAME STACK EFFECT DEFINITION )
( add32 x** y** -> z** x + y )
( sub32 x** y** -> z** x - y )
( mul16 x* y* -> z** x * y )
( mul32 x** y** -> z** x * y )
( div32 x** y** -> q** x / y )
( mod32 x** y** -> r** x % y )
( divmod32 x** y** -> q** r** x / y, x % y )
( gcd32 x** y** -> z** gcd(x, y) )
( negate32 x** -> z** -x )
( lshift32 x** n^ -> z** x<<n )
( rshift32 x** n^ -> z** x>>n )
( and32 x** y** -> z** x & y )
( or32 x** y** -> z** x | y )
( xor32 x** y** -> z** x ^ y )
( complement32 x** -> z** ~x )
( eq32 x** y** -> bool^ x == y )
( ne32 x** y** -> bool^ x != y )
( is-zero32 x** -> bool^ x == 0 )
( non-zero32 x** -> bool^ x != 0 )
( lt32 x** y** -> bool^ x < y )
( gt32 x** y** -> bool^ x > y )
( lteq32 x** y** -> bool^ x <= y )
( gteq32 x** y** -> bool^ x >= y )
( bitcount8 x^ -> bool^ floor(log2(x))+1 )
( bitcount16 x* -> bool^ floor(log2(x))+1 )
( bitcount32 x** -> bool^ floor(log2(x))+1 )
( )
( In addition to the code this file uses 44 bytes of registers )
( to store temporary state: )
( )
( - shared memory, 16 bytes )
( - mul32 memory, 12 bytes )
( - _divmod32 memory, 16 bytes )
( bitcount: number of bits needed to represent number )
( equivalent to floor[log2[x]] + 1 )
@bitcount8 ( x^ -> n^ )
#00 SWP ( n x )
&loop
DUP #00 EQU ( n x x=0 )
,&done JCN ( n x )
#01 SFT ( n x>>1 )
SWP INC SWP ( n+1 x>>1 )
,&loop JMP
&done
POP ( n )
JMP2r
@bitcount16 ( x* -> n^ )
SWP ( xlo xhi )
;bitcount8 JSR2 ( xlo nhi )
DUP #00 NEQ ( xlo nhi nhi!=0 )
,&hi-set JCN ( xlo nhi )
SWP ;bitcount8 JSR2 ADD ( nhi+nlo )
JMP2r
&hi-set
SWP POP #08 ADD ( nhi+8 )
JMP2r
@bitcount32 ( x** -> n^ )
SWP2 ( xlo* xhi* )
;bitcount16 JSR2 ( xlo* nhi )
DUP #00 NEQ ( xlo* nhi nhi!=0 )
,&hi-set JCN ( xlo* nhi )
ROT ROT ;bitcount16 JSR2 ADD JMP2r ( nhi+nlo )
&hi-set
ROT ROT POP2 #10 ADD ( nhi+16 )
JMP2r
( equality )
( x == y )
@eq32 ( xhi* xlo* yhi* ylo* -> bool^ )
ROT2 EQU2 STH
EQU2 STHr AND JMP2r
( x != y )
@ne32 ( xhi* xlo* yhi* ylo* -> bool^ )
ROT2 NEQ2 STH
NEQ2 STHr ORA JMP2r
( x == 0 )
@is-zero32 ( x** -> bool^ )
ORA2 #0000 EQU2 JMP2r
( x != 0 )
@non-zero32 ( x** -> bool^ )
ORA2 #0000 NEQ2 JMP2r
( comparisons )
( x < y )
@lt32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
LTH2 ,&lt-lo JCN ( xhi yhi )
LTH2 JMP2r
&lt-lo
GTH2 #00 EQU JMP2r
( x <= y )
@lteq32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
GTH2 ,&gt-lo JCN ( xhi yhi )
GTH2 #00 EQU JMP2r
&gt-lo
LTH2 JMP2r
( x > y )
@gt32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
GTH2 ,&gt-lo JCN ( xhi yhi )
GTH2 JMP2r
&gt-lo
LTH2 #00 EQU JMP2r
( x > y )
@gteq32 ( x** y** -> bool^ )
ROT2 SWP2 ( xhi yhi xlo ylo )
LTH2 ,&lt-lo JCN ( xhi yhi )
LTH2 #00 EQU JMP2r
&lt-lo
GTH2 JMP2r
( bitwise operations )
( x & y )
@and32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
ROT2 AND2 STH2 AND2 STH2r JMP2r
( x | y )
@or32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
ROT2 ORA2 STH2 ORA2 STH2r JMP2r
( x ^ y )
@xor32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
ROT2 EOR2 STH2 EOR2 STH2r JMP2r
( ~x )
@complement32 ( x** -> ~x** )
SWP2 #ffff EOR2 SWP2 #ffff EOR2 JMP2r
( temporary registers )
( shared by most operations, except mul32 and div32 )
@m32 [ &x0 $1 &x1 $1 &x2 $1 &x3 $1
&y0 $1 &y1 $1 &y2 $1 &y3 $1
&z0 $1 &z1 $1 &z2 $1 &z3 $1
&w0 $1 &w1 $1 &w2 $2 ]
( bit shifting )
( x >> n )
@rshift32 ( x** n^ -> x<<n )
DUP #08 LTH ;rshift32-0 JCN2 ( x n )
DUP #10 LTH ;rshift32-1 JCN2 ( x n )
DUP #18 LTH ;rshift32-2 JCN2 ( x n )
;rshift32-3 JMP2 ( x n )
JMP2r
( shift right by 0-7 bits )
@rshift32-0 ( x** n^ -> x<<n )
STHk SFT ;m32/z3 STA ( write z3 )
#00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 )
#00 STHkr SFT2 #00 ;m32/z2 LDA ORA2 ;m32/z1 STA2 ( write z1,z2 )
#00 STHr SFT2 #00 ;m32/z1 LDA ORA2 ( compute z0,z1 )
;m32/z2 LDA2
JMP2r
( shift right by 8-15 bits )
@rshift32-1 ( x** n^ -> x<<n )
#08 SUB STH POP
STHkr SFT ;m32/z3 STA ( write z3 )
#00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 )
#00 STHr SFT2 #00 ;m32/z2 LDA ORA2 ( compute z1,z2 )
#00 ROT ROT ;m32/z3 LDA
JMP2r
( shift right by 16-23 bits )
@rshift32-2 ( x** n^ -> x<<n )
#10 SUB STH POP2
STHkr SFT ;m32/z3 STA ( write z3 )
#00 STHr SFT2 #00 ;m32/z3 LDA ORA2 ( compute z2,z3 )
#0000 SWP2
JMP2r
( shift right by 16-23 bits )
@rshift32-3 ( x** n^ -> x<<n )
#18 SUB STH POP2 POP ( x0 )
#00 SWP #0000 SWP2 ( 00 00 00 x0 )
STHr SFT
JMP2r
( x << n )
@lshift32 ( x** n^ -> x<<n )
DUP #08 LTH ;lshift32-0 JCN2 ( x n )
DUP #10 LTH ;lshift32-1 JCN2 ( x n )
DUP #18 LTH ;lshift32-2 JCN2 ( x n )
;lshift32-3 JMP2 ( x n )
JMP2r
( shift left by 0-7 bits )
@lshift32-0 ( x** n^ -> x<<n )
#40 SFT STH ( stash n<<4 )
#00 SWP STHkr SFT2 ;m32/z2 STA2 ( store z2,z3 )
#00 SWP STHkr SFT2 #00 ;m32/z2 LDA ORA2 ;m32/z1 STA2 ( store z1,z2 )
#00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 )
STHr SFT ;m32/z0 LDA ORA ( calculate z0 )
;m32/z1 LDA ;m32/z2 LDA2
JMP2r
( shift left by 8-15 bits )
@lshift32-1 ( x** n^ -> x<<n )
#08 SUB #40 SFT STH ( stash [n-8]<<4 )
#00 SWP STHkr SFT2 ;m32/z1 STA2 ( store z1,z2 )
#00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 )
STHr SFT ;m32/z0 LDA ORA ( calculate z0 )
SWP POP ( x0 unused )
;m32/z1 LDA2 #00
JMP2r
( shift left by 16-23 bits )
@lshift32-2 ( x** n^ -> x<<n )
#10 SUB #40 SFT STH ( stash [n-16]<<4 )
#00 SWP STHkr SFT2 ;m32/z0 STA2 ( store z0,z1 )
STHr SFT ;m32/z0 LDA ORA ( calculate z0 )
STH POP2 STHr
;m32/z1 LDA #0000
JMP2r
( shift left by 24-31 bits )
@lshift32-3 ( x** n^ -> x<<n )
#18 SUB #40 SFT ( x0 x1 x2 x3 r=[n-24]<<4 )
SFT ( x0 x1 x2 x3<<r )
SWP2 POP2 SWP POP #0000 #00
JMP2r
( arithmetic )
( x + y )
@add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* )
;m32/y2 STA2 ;m32/y0 STA2 ( save ylo, yhi )
;m32/x2 STA2 ;m32/x0 STA2 ( save xlo, xhi )
#0000 #0000 ;m32/z0 STA2 ;m32/z2 STA2 ( reset zhi, zlo )
( x3 + y3 => z2z3 )
#00 ;m32/x3 LDA #00 ;m32/y3 LDA ADD2 ;m32/z2 STA2
( x2 + y2 + z2 => z1z2 )
#00 ;m32/x2 LDA ;m32/z1 LDA2 ADD2 ;m32/z1 STA2
#00 ;m32/y2 LDA ;m32/z1 LDA2 ADD2 ;m32/z1 STA2
( x1 + y1 + z1 => z0z1 )
#00 ;m32/x1 LDA ;m32/z0 LDA2 ADD2 ;m32/z0 STA2
#00 ;m32/y1 LDA ;m32/z0 LDA2 ADD2 ;m32/z0 STA2
( x0 + y0 + z0 => z0 )
;m32/x0 LDA ;m32/z0 LDA ADD ;m32/z0 STA
;m32/y0 LDA ;m32/z0 LDA ADD ;m32/z0 STA
( load zhi,zlo )
;m32/z0 LDA2 ;m32/z2 LDA2
JMP2r
( -x )
@negate32 ( x** -> -x** )
;complement32 JSR2
INC2 ( ~xhi -xlo )
DUP2 #0000 NEQ2 ( ~xhi -xlo non-zero? )
,&done JCN ( xlo non-zero => don't inc hi )
SWP2 INC2 SWP2 ( -xhi -xlo )
&done
JMP2r
( x - y )
@sub32 ( x** y** -> z** )
;negate32 JSR2 ;add32 JSR2 JMP2r
( 16-bit multiplication )
@mul16 ( x* y* -> z** )
;m32/y1 STA ;m32/y0 STA ( save ylo, yhi )
;m32/x1 STA ;m32/x0 STA ( save xlo, xhi )
#0000 #00 ;m32/z1 STA2 ;m32/z3 STA ( reset z1,z2,z3 )
#0000 #00 ;m32/w0 STA2 ;m32/w2 STA ( reset w0,w1,w2 )
( x1 * y1 => z1z2 )
#00 ;m32/x1 LDA #00 ;m32/y1 LDA MUL2 ;m32/z2 STA2
( x0 * y1 => z0z1 )
#00 ;m32/x0 LDA #00 ;m32/y1 LDA MUL2 ;m32/z1 LDA2 ADD2 ;m32/z1 STA2
( x1 * y0 => w1w2 )
#00 ;m32/x1 LDA #00 ;m32/y0 LDA MUL2 ;m32/w1 STA2
( x0 * y0 => w0w1 )
#00 ;m32/x0 LDA #00 ;m32/y0 LDA MUL2 ;m32/w0 LDA2 ADD2 ;m32/w0 STA2
( add z and a<<8 )
#00 ;m32/z1 LDA2 ;m32/z3 LDA
;m32/w0 LDA2 ;m32/w2 LDA #00
;add32 JSR2
JMP2r
( x * y )
@mul32 ( x** y** -> z** )
,&y1 STR2 ,&y0 STR2 ( save ylo, yhi )
,&x1 STR2 ,&x0 STR2 ( save xlo, xhi )
,&y1 LDR2 ,&x1 LDR2 ;mul16 JSR2 ( [x1*y1] )
,&z1 STR2 ,&z0 STR2 ( sum = x1*y1, save zlo, zhi )
,&y1 LDR2 ,&x0 LDR2 MUL2 ( [x0*y1]<<16 )
,&y0 LDR2 ,&x1 LDR2 MUL2 ( [x1*y0]<<16 )
( [x0*y0]<<32 will completely overflow )
ADD2 ,&z0 LDR2 ADD2 ( sum += x0*y1<<16 + x1*y0<<16 )
,&z1 LDR2
JMP2r
[ &x0 $2 &x1 $2
&y0 $2 &y1 $2
&z0 $2 &z1 $2 ]
@div32 ( x** y** -> q** )
;_divmod32 JSR2
;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2
JMP2r
@mod32 ( x** y** -> r** )
;_divmod32 JSR2
;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2
JMP2r
@divmod32 ( x** y** -> q** r** )
;_divmod32 JSR2
;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2
;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2
JMP2r
( calculate and store x / y and x % y )
@_divmod32 ( x** y** -> )
( store y and x for repeated use )
,&div1 STR2 ,&div0 STR2 ( y -> div )
,&rem1 STR2 ,&rem0 STR2 ( x -> rem )
( if x < y then the answer is 0 )
,&rem0 LDR2 ,&rem1 LDR2
,&div0 LDR2 ,&div1 LDR2
;lt32 JSR2 ,&is-zero JCN ,&not-zero JMP
&is-zero
#0000 ,&quo0 STR2 #0000 ,&quo1 STR2 JMP2r
( x >= y so the answer is >= 1 )
&not-zero
#0000 ,&quo0 STR2 #0000 ,&quo1 STR2 ( 0 -> quo )
( bitcount[x] - bitcount[y] determines the largest multiple of y to try )
,&rem0 LDR2 ,&rem1 LDR2 ;bitcount32 JSR2 ( rbits^ )
,&div0 LDR2 ,&div1 LDR2 ;bitcount32 JSR2 ( rbits^ dbits^ )
SUB ( shift=rbits-dits )
#00 DUP2 ( shift 0 shift 0 )
( 1<<shift -> cur )
#0000 #0001 ROT2 POP
;lshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2
( div<<shift -> div )
,&div0 LDR2 ,&div1 LDR2 ROT2 POP
;lshift32 JSR2 ,&div1 STR2 ,&div0 STR2
,&loop JMP
[ &div0 $2 &div1 $2
&rem0 $2 &rem1 $2
&quo0 $2 &quo1 $2
&cur0 $2 &cur1 $2 ]
&loop
( if rem >= the current divisor, we can subtract it and add to quotient )
,&rem0 LDR2 ,&rem1 LDR2 ,&div0 LDR2 ,&div1 LDR2 ;lt32 JSR2 ( is rem < div? )
,&rem-lt JCN ( if rem < div skip this iteration )
( since rem >= div, we have found a multiple of y that divides x )
,&rem0 LDR2 ,&rem1 LDR2 ,&div0 LDR2 ,&div1 LDR2 ;sub32 JSR2 ,&rem1 STR2 ,&rem0 STR2 ( rem -= div )
,&quo0 LDR2 ,&quo1 LDR2 ,&cur0 LDR2 ,&cur1 LDR2 ;add32 JSR2 ,&quo1 STR2 ,&quo0 STR2 ( quo += cur )
&rem-lt
,&div0 LDR2 ,&div1 LDR2 #01 ;rshift32 JSR2 ,&div1 STR2 ,&div0 STR2 ( div >>= 1 )
,&cur0 LDR2 ,&cur1 LDR2 #01 ;rshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2 ( cur >>= 1 )
,&cur0 LDR2 ,&cur1 LDR2 ;non-zero32 JSR2 ,&loop JCN ( if cur>0, loop. else we're done )
JMP2r
( greatest common divisor - euclidean algorithm )
@gcd32 ( x** y** -> z** )
&loop ( x y )
OVR2 OVR2 ( x y y )
;is-zero32 JSR2 ( x y y=0? )
,&done JCN ( x y )
OVR2 OVR2 ( x y y )
STH2 STH2 ( x y [y] )
;mod32 JSR2 ( r=x%y [y] )
STH2r ( rhi rlo yhi [ylo] )
ROT2 ( rlo yhi rhi [ylo] )
ROT2 ( yhi rhi rlo [ylo] )
STH2r ( yhi rhi rlo ylo )
ROT2 ( yhi rlo ylo rhi )
ROT2 ( yhi ylo rhi rlo )
,&loop JMP
&done
POP2 POP2 ( x )
JMP2r

0
projects/pictures/akane2010.bit → projects/pictures/akane20x10.icn
View File

0
projects/pictures/cibo.bit → projects/pictures/cibo10x10.icn
View File

BIN
projects/pictures/cyr10x8.chr → projects/pictures/cyr0cx08.chr
View File

Binary file not shown.

0
projects/pictures/dafu10x10.bit → projects/pictures/dafu10x10.icn
View File

0
projects/pictures/ergo100x0c0.bit → projects/pictures/ergo20x1a.icn
View File

BIN
projects/pictures/logo02x02.icn Normal file
View File

Binary file not shown.

BIN
projects/pictures/logo04x04.chr Normal file
View File

Binary file not shown.

0
projects/pictures/logo1x1.bit → projects/pictures/logo08x08.icn
View File

0
projects/pictures/pc98.chr → projects/pictures/pc9820x10.chr
View File

BIN
projects/pictures/pjw20x20.icn Normal file
View File

Binary file not shown.

0
projects/pictures/tima2a1a.bit → projects/pictures/tima2ax1a.icn
View File

BIN
projects/pictures/uxn16.chr
View File

Binary file not shown.

BIN
projects/pictures/uxn32.chr
View File

Binary file not shown.

521
projects/software/calc.tal
View File

@ -1,119 +1,59 @@
(
a simple calculator
uxnasm projects/software/calc.tal bin/calc.rom && uxnemu bin/calc.rom )
( simple graphical calculator )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 }
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }
%2MOD { #01 AND } %2MOD2 { #0001 AND2 }
%4MOD { #03 AND } %4MOD2 { #0003 AND2 }
%8MOD { #07 AND } %8MOD2 { #0007 AND2 }
%10MOD { #0f AND } %10MOD2 { #000f AND2 }
%!~ { NEQk NIP }
%DEBUG { ;print-hex/byte JSR2 #0a .Console/write DEO }
%DEBUG2 { ;print-hex/short JSR2 #0a .Console/write DEO }
%AUTO-NONE { #00 .Screen/auto DEO }
%AUTO-X { #01 .Screen/auto DEO }
%AUTO-XADDR { #05 .Screen/auto DEO }
%AUTO-YADDR { #06 .Screen/auto DEO }
%RELEASE-MOUSE { #0096 DEO }
%RTN { JMP2r }
%RTN? { JMP RTN }
%TOS { #00 SWP }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
( variables )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|0000
@input
&value $2
&mode $1
@stack
&length $1
&items $10
@center
&x $2 &y $2
@pointer
&x $2 &y $2 &last $1
@keypad-frame
&x $2 &y $2 &x2 $2 &y2 $2
@modpad-frame
&x $2 &y $2 &x2 $2 &y2 $2
@bitpad-frame
&x $2 &y $2 &x2 $2 &y2 $2
@input-frame
&x $2 &y $2 &x2 $2 &y2 $2
( program )
@input &value $2 &mode $1
@stack &length $1 &items $10
@center &x $2 &y $2
@pointer &x $2 &y $2 &last $1
@keypad-frame &x $2 &y $2 &x2 $2 &y2 $2
@modpad-frame &x $2 &y $2 &x2 $2 &y2 $2
@bitpad-frame &x $2 &y $2 &x2 $2 &y2 $2
@input-frame &x $2 &y $2 &x2 $2 &y2 $2
|0100 ( -> )
( theme )
#0e7d .System/r DEO2
#0ec6 .System/g DEO2
( theme )
#0e7d .System/r DEO2
#0ec6 .System/g DEO2
#0e95 .System/b DEO2
( size )
#0090 .Screen/width DEO2
#0100 .Screen/height DEO2
( vectors )
;on-mouse .Mouse/vector DEO2
;on-button .Controller/vector DEO2
( setup synth )
#0010 .Audio0/adsr DEO2
#0112 .Audio0/adsr DEO2
;sin-pcm .Audio0/addr DEO2
#0100 .Audio0/length DEO2
#dd .Audio0/volume DEO
#88 .Audio0/volume DEO
( center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
.center/x LDZ2 #0020 --
DUP2 .keypad-frame/x STZ2 #0040 ++ .keypad-frame/x2 STZ2
.center/y LDZ2 #0018 --
DUP2 .keypad-frame/y STZ2 #003f ++ .keypad-frame/y2 STZ2
.Screen/width DEI2 #01 SFT2 .center/x STZ2
.Screen/height DEI2 #01 SFT2 .center/y STZ2
.center/x LDZ2 #0020 SUB2
DUP2 .keypad-frame/x STZ2 #003f ADD2 .keypad-frame/x2 STZ2
.center/y LDZ2 #0018 SUB2
DUP2 .keypad-frame/y STZ2 #003f ADD2 .keypad-frame/y2 STZ2
.keypad-frame/x LDZ2
DUP2 .modpad-frame/x STZ2 #0040 ++ .modpad-frame/x2 STZ2
.keypad-frame/y LDZ2 #0040 ++
DUP2 .modpad-frame/y STZ2 #001f ++ .modpad-frame/y2 STZ2
DUP2 .modpad-frame/x STZ2 #003f ADD2 .modpad-frame/x2 STZ2
.keypad-frame/y LDZ2 #0040 ADD2
DUP2 .modpad-frame/y STZ2 #001f ADD2 .modpad-frame/y2 STZ2
.keypad-frame/x LDZ2
DUP2 .bitpad-frame/x STZ2 #0040 ++ .bitpad-frame/x2 STZ2
.modpad-frame/y2 LDZ2 #0008 ++
DUP2 .bitpad-frame/y STZ2 #000f ++ .bitpad-frame/y2 STZ2
.center/x LDZ2 #0020 --
DUP2 .input-frame/x STZ2 #0040 ++ .input-frame/x2 STZ2
.center/y LDZ2 #002a --
DUP2 .input-frame/y STZ2 #0010 ++ .input-frame/y2 STZ2
DUP2 .bitpad-frame/x STZ2 #003f ADD2 .bitpad-frame/x2 STZ2
.modpad-frame/y2 LDZ2 #0008 ADD2
DUP2 .bitpad-frame/y STZ2 #000f ADD2 .bitpad-frame/y2 STZ2
.center/x LDZ2 #0020 SUB2
DUP2 .input-frame/x STZ2 #003f ADD2 .input-frame/x2 STZ2
.center/y LDZ2 #002a SUB2
DUP2 .input-frame/y STZ2 #000f ADD2 .input-frame/y2 STZ2
( theme support )
;load-theme JSR2
@ -121,23 +61,23 @@ BRK
@on-button ( -> )
.Controller/key DEI
.Controller/key DEI
( generics )
#00 !~ ,&no-empty JCN ;redraw JSR2 POP BRK &no-empty
#09 !~ ,&no-tab JCN ;toggle-mode JSR2 POP BRK &no-tab
#0d !~ ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter
#1b !~ ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc
#08 !~ ,&no-backspace JCN ;do-erase JSR2 POP BRK &no-backspace
[ #00 ] NEQk NIP ,&no-empty JCN ;redraw JSR2 POP BRK &no-empty
[ #09 ] NEQk NIP ,&no-tab JCN ;toggle-mode JSR2 POP BRK &no-tab
[ #0d ] NEQk NIP ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter
[ #1b ] NEQk NIP ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc
[ #08 ] NEQk NIP ,&no-backspace JCN ;do-erase JSR2 POP BRK &no-backspace
( arithmetic )
LIT '+ !~ ,&no-add JCN ;do-add JSR2 POP BRK &no-add
LIT '- !~ ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub
LIT '* !~ ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul
LIT '/ !~ ,&no-div JCN ;do-div JSR2 POP BRK &no-div
[ LIT "+ ] NEQk NIP ,&no-add JCN ;do-add JSR2 POP BRK &no-add
[ LIT "- ] NEQk NIP ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub
[ LIT "* ] NEQk NIP ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul
[ LIT "/ ] NEQk NIP ,&no-div JCN ;do-div JSR2 POP BRK &no-div
( bitwise )
LIT '& !~ ,&no-and JCN ;do-and JSR2 POP BRK &no-and
LIT '| !~ ,&no-ora JCN ;do-ora JSR2 POP BRK &no-ora
LIT '^ !~ ,&no-eor JCN ;do-eor JSR2 POP BRK &no-eor
LIT '~ !~ ,&no-not JCN ;do-not JSR2 POP BRK &no-not
[ LIT "& ] NEQk NIP ,&no-and JCN ;do-and JSR2 POP BRK &no-and
[ LIT "| ] NEQk NIP ,&no-ora JCN ;do-ora JSR2 POP BRK &no-ora
[ LIT "^ ] NEQk NIP ,&no-eor JCN ;do-eor JSR2 POP BRK &no-eor
[ LIT "~ ] NEQk NIP ,&no-not JCN ;do-not JSR2 POP BRK &no-not
( value )
;key-value JSR2 ;push-input JSR2
@ -155,20 +95,21 @@ BRK
( draw new cursor )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#41 .Mouse/state DEI #01 = + .Screen/sprite DEO
#41 .Mouse/state DEI #01 EQU ADD .Screen/sprite DEO
.Mouse/state DEI .pointer/last LDZ
( down )
DUP2 #0100 !! ,&no-down JCN
.Mouse/x DEI2 .Mouse/y DEI2
DUP2 #0100 NEQ2 ,&no-down JCN
.Mouse/x DEI2 .Mouse/y DEI2
OVR2 OVR2 .keypad-frame ;within-rect JSR2 ;click-keypad JCN2
OVR2 OVR2 .input-frame ;within-rect JSR2 ;click-input JCN2
OVR2 OVR2 .modpad-frame ;within-rect JSR2 ;click-modpad JCN2
OVR2 OVR2 .bitpad-frame ;within-rect JSR2 ;click-bitpad JCN2
;toggle-mode JSR2
POP2 POP2
&no-down
( up )
DUP2 #0001 !! ,&no-up JCN
DUP2 #0001 NEQ2 ,&no-up JCN
;redraw JSR2
&no-up
POP2
@ -179,108 +120,109 @@ BRK
@click-keypad ( state* x* y* -> )
( y ) .keypad-frame/y LDZ2 -- #24 SFT2
( x ) SWP2 .keypad-frame/x LDZ2 -- 10// 4MOD2
( value ) ++ ;keypad/layout ++ LDA ;push-input JSR2
RELEASE-MOUSE POP2
( y ) .keypad-frame/y LDZ2 SUB2 #24 SFT2
( x ) SWP2 .keypad-frame/x LDZ2 SUB2 #04 SFT2 #0003 AND2
( value ) ADD2 ;keypad/layout ADD2 LDA ;push-input JSR2
#00 .Mouse/state DEO POP2
BRK
@click-modpad ( state* x* y* -> )
( y ) .modpad-frame/y LDZ2 -- #24 SFT2 NIP STH
( x ) .modpad-frame/x LDZ2 -- 10//
( lookup ) STHr + 2** ;keypad/ops ++ LDA2 JSR2
( y ) .modpad-frame/y LDZ2 SUB2 #24 SFT2 NIP STH
( x ) .modpad-frame/x LDZ2 SUB2 #04 SFT2
( lookup ) STHr ADD DUP2 ADD2 ;keypad/ops ADD2 LDA2 JSR2
;draw-bitpad JSR2
RELEASE-MOUSE POP2
#00 .Mouse/state DEO POP2
BRK
@click-input ( state* x* y* -> )
POP2
.input-frame/x LDZ2 -- 8// NIP
DUP #00 ! ,&no-push JCN
.input-frame/x LDZ2 SUB2 #03 SFT2 NIP
DUP ,&no-push JCN
;do-push JSR2 &no-push
DUP #01 ! ,&no-pop JCN
DUP #01 NEQ ,&no-pop JCN
;do-pop JSR2 &no-pop
POP
RELEASE-MOUSE POP2
#00 .Mouse/state DEO POP2
BRK
@click-bitpad ( state* x* y* -> )
( y ) .bitpad-frame/y LDZ2 -- 8// NIP 8* STH
( x ) .bitpad-frame/x LDZ2 -- 8// NIP
( value ) STHr + STHk
( y ) .bitpad-frame/y LDZ2 SUB2 #33 SFT2 NIP STH
( x ) .bitpad-frame/x LDZ2 SUB2 #03 SFT2 NIP
( value ) STHr ADD STHk
#30 + .Audio0/pitch DEO
#30 ADD .Audio0/pitch DEO
( toggle bit )
.input/value LDZ2 #0001
[ STHr #0f SWP - ] #40 SFT SFT2 EOR2
.input/value LDZ2 #0001
[ STHr #0f SWP SUB ] #40 SFT SFT2 EOR2
.input/value STZ2
;draw-bitpad JSR2
#ff ;draw-input JSR2
RELEASE-MOUSE POP2
#00 .Mouse/state DEO POP2
BRK
@push-input ( key -- )
DUP #50 + .Audio0/pitch DEO
DUP TOS ;keypad/series ++ LDA ;draw-keypad JSR2
DUP #50 ADD .Audio0/pitch DEO
#00 OVR ;keypad/series ADD2 LDA ;draw-keypad JSR2
( hex/dec )
TOS .input/value LDZ2 #00 [ #0a #10 .input/mode LDZ JMP SWP POP ] **
++ .input/value STZ2
#00 SWP .input/value LDZ2 #00 [ #0a #10 .input/mode LDZ JMP SWP POP ] MUL2
ADD2 .input/value STZ2
#ff ;draw-input JSR2
;draw-bitpad JSR2
RTN
JMP2r
@push ( value* -- )
( store ) .stack/length LDZ 2* .stack/items + STZ2
( store ) .stack/length LDZ DUP ADD .stack/items ADD STZ2
( INCZ ) .stack/length LDZk INC SWP STZ
( reset ) #0000 .input/value STZ2
#00 ;draw-input JSR2
;draw-stack JSR2
RTN
JMP2r
@pop ( -- value* )
.stack/length LDZ #01 - 2* .stack/items + LDZ2
( clear ) #0000 [ .stack/length LDZ #01 - 2* .stack/items + ] STZ2
( DECZ ) .stack/length LDZk #01 - SWP STZ
.stack/length LDZ #01 SUB DUP ADD .stack/items ADD LDZ2
( clear ) #0000 [ .stack/length LDZ #01 SUB DUP ADD .stack/items ADD ] STZ2
( DECZ ) .stack/length LDZk #01 SUB SWP STZ
#01 ;draw-input JSR2
;draw-stack JSR2
RTN
JMP2r
@toggle-mode ( -- )
.input/mode LDZk #00 = SWP STZ
.input/mode LDZk #00 EQU SWP STZ
#30 .Audio0/pitch DEO
;redraw JSR2
RTN
JMP2r
@do-push ( -- )
.input/value LDZ2 ADD #00 > JMP RTN
.stack/length LDZ #07 < JMP RTN
.input/value LDZ2 #0000 GTH2 JMP JMP2r
.stack/length LDZ #07 LTH JMP JMP2r
#40 .Audio0/pitch DEO
.input/value LDZ2 ;push JSR2
;draw-bitpad JSR2
RTN
JMP2r
@do-pop ( -- )
#0000 .input/value STZ2
.stack/length LDZ #00 = ,&continue JCN
.stack/length LDZ #00 EQU ,&continue JCN
#41 .Audio0/pitch DEO
;pop JSR2 POP2
;draw-stack JSR2
@ -288,119 +230,119 @@ RTN
#01 ;draw-input JSR2
;draw-bitpad JSR2
RTN
JMP2r
@do-add ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#42 .Audio0/pitch DEO
#00 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2
RTN
JMP2r
@do-sub ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#43 .Audio0/pitch DEO
#01 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2
RTN
JMP2r
@do-mul ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#44 .Audio0/pitch DEO
#02 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2
RTN
JMP2r
@do-div ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#45 .Audio0/pitch DEO
#03 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2
RTN
JMP2r
@do-and ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#46 .Audio0/pitch DEO
#04 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 AND2 ;push JSR2
RTN
JMP2r
@do-ora ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#47 .Audio0/pitch DEO
#05 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ORA2 ;push JSR2
RTN
JMP2r
@do-eor ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#48 .Audio0/pitch DEO
#06 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 EOR2 ;push JSR2
RTN
JMP2r
@do-not ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
.input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #00 > RTN?
( stack empty ) .stack/length LDZ #00 GTH JMP JMP2r
#49 .Audio0/pitch DEO
#07 ;draw-modpad JSR2
;pop JSR2 #ffff EOR2 ;push JSR2
;pop JSR2 #ffff EOR2 ;push JSR2
RTN
JMP2r
@do-erase ( -- )
@ -408,19 +350,19 @@ RTN
#ff ;draw-input JSR2
;draw-bitpad JSR2
RTN
JMP2r
@key-value ( key -- value )
DUP #2f > OVR #3a < #0101 !! ,&no-num JCN
#30 - RTN &no-num
DUP #60 > OVR #67 < #0101 !! ,&no-lc JCN
#57 - RTN ( #61 - #0a + ) &no-lc
DUP #40 > OVR #47 < #0101 !! ,&no-uc JCN
#37 - RTN ( #41 - #0a + ) &no-uc
DUP #2f GTH OVR #3a LTH #0101 NEQ2 ,&no-num JCN
#30 SUB JMP2r &no-num
DUP #60 GTH OVR #67 LTH #0101 NEQ2 ,&no-lc JCN
#57 SUB JMP2r ( #61 - #0a ADD ) &no-lc
DUP #40 GTH OVR #47 LTH #0101 NEQ2 ,&no-uc JCN
#37 SUB JMP2r ( #41 - #0a ADD ) &no-uc
POP #00
RTN
JMP2r
@redraw ( -- )
@ -434,188 +376,177 @@ RTN
#0010 .Screen/x DEO2
#0010 .Screen/y DEO2
RTN
JMP2r
@draw-mode ( -- )
AUTO-XADDR
#26 .Screen/auto DEO
.input-frame/x LDZ2 .Screen/x DEO2
.input-frame/y LDZ2 #0014 -- .Screen/y DEO2
;modes #00 .input/mode LDZ #0018 MUL2 ++ .Screen/addr DEO2
#02 .input/mode LDZ + .Screen/sprite DEOk DEOk DEO
AUTO-NONE
.input-frame/y LDZ2 #0014 SUB2 .Screen/y DEO2
;modes #00 .input/mode LDZ #0018 MUL2 ADD2 .Screen/addr DEO2
#02 .input/mode LDZ ADD .Screen/sprite DEO
#00 .Screen/auto DEO
RTN
JMP2r
@draw-stack ( -- )
#08 #00
&loop
.input-frame/x LDZ2 #0018 ++ .Screen/x DEO2
DUP TOS 8** .input-frame/y LDZ2 ++ #004c -- .Screen/y DEO2
( color ) DUP #08 .stack/length LDZ - #01 - > STH
( value ) DUP 2* .stack/items + [ #10 .stack/length LDZ 2* - - ] LDZ2
.input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2
#00 OVR #30 SFT2 .input-frame/y LDZ2 ADD2 #004c SUB2 .Screen/y DEO2
( color ) DUP #08 .stack/length LDZ SUB #01 SUB GTH STH
( value ) DUP DUP ADD .stack/items ADD [ #10 .stack/length LDZ DUP ADD SUB SUB ] LDZ2
STHr ;draw-number JSR2
INC GTHk ,&loop JCN
POP2
RTN
JMP2r
@draw-input ( key -- )
STH
( draw value )
.input-frame/x LDZ2 #0018 ++ .Screen/x DEO2
.input-frame/y LDZ2 #0003 ++ .Screen/y DEO2
.input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2
.input-frame/y LDZ2 #0003 ADD2 .Screen/y DEO2
.input/value LDZ2 #02 ;draw-number JSR2
( controls )
.input-frame/x LDZ2
.input-frame/y LDZ2
;stack-icns/push [ STHkr #00 = ] #02
;stack-icns/push [ STHkr #00 EQU ] #02
;draw-key-thin JSR2
.input-frame/x LDZ2 #0008 ++
.input-frame/x LDZ2 #0008 ADD2
.input-frame/y LDZ2
;stack-icns/pop [ STHkr #01 = ] #03
;stack-icns/pop [ STHkr #01 EQU ] #03
;draw-key-thin JSR2
( line )
.input-frame/x LDZ2
.input-frame/x2 LDZ2
.input-frame/y LDZ2 #0004 -- #02
.input-frame/x LDZ2
.input-frame/x2 LDZ2
.input-frame/y LDZ2 #0004 SUB2 #02
;line-hor-dotted JSR2
POPr
RTN
JMP2r
@draw-keypad ( key -- )
STH
#10 #00
&loop
( color ) DUP TOS ;keypad/color ++ LDA STH
( state ) DUP OVRr STHr = STH
( layout ) DUP TOS ;keypad/layout ++ LDA
( layout addr ) TOS 8** ;font-hex ++ STH2
( x ) DUP 4MOD TOS 10** STH2
( y ) DUP 4/ TOS 10**
( origin-x ) STH2r .keypad-frame/x LDZ2 ++ SWP2
( origin-y ) .keypad-frame/y LDZ2 ++
( color ) #00 OVR ;keypad/color ADD2 LDA STH
( state ) DUP OVRr STHr EQU STH
( layout ) #00 OVR ;keypad/layout ADD2 LDA
( layout addr ) #00 SWP #30 SFT2 ;font-hex ADD2 STH2
( x ) #00 OVR #03 AND #40 SFT2 STH2
( y ) #00 OVR #42 SFT2
( origin-x ) STH2r .keypad-frame/x LDZ2 ADD2 SWP2
( origin-y ) .keypad-frame/y LDZ2 ADD2
STH2r STHr STHr ;draw-key JSR2
INC GTHk ,&loop JCN
POP2
POPr
RTN
JMP2r
@draw-modpad ( key -- )
STH
#08 #00
&loop
( state ) DUP STHkr = STH
( glyph ) DUP TOS 8** ;mod-icns ++ STH2
( y ) DUP 4/ TOS 10** .modpad-frame/y LDZ2 ++ STH2
( x ) DUP 4MOD TOS 10** .modpad-frame/x LDZ2 ++ STH2
STH2r STH2r STH2r STHr #03 ;draw-key JSR2
( state ) DUP STHkr EQU STH
( glyph ) #00 OVR #30 SFT2 ;mod-icns ADD2 STH2
( y ) #00 OVR #42 SFT2 .modpad-frame/y LDZ2 ADD2 STH2
( x ) #00 OVR #03 AND #40 SFT2 .modpad-frame/x LDZ2 ADD2
STH2r STH2r STHr #03 ;draw-key JSR2
INC GTHk ,&loop JCN
POP2
POPr
RTN
JMP2r
@draw-bitpad ( -- )
#1000
&loop
( y ) DUP 8/ TOS 8** .bitpad-frame/y LDZ2 ++ .Screen/y DEO2
( x ) DUP 8MOD TOS 8** .bitpad-frame/x LDZ2 ++ .Screen/x DEO2
( state ) DUP #0f SWP - .input/value LDZ2 ROT SFT2 2MOD2
( addr ) 8** ;bit-icns ++ .Screen/addr DEO2
( y ) #00 OVR #33 SFT2 .bitpad-frame/y LDZ2 ADD2 .Screen/y DEO2
( x ) #00 OVR #07 AND #30 SFT2 .bitpad-frame/x LDZ2 ADD2 .Screen/x DEO2
( state ) DUP #0f SWP SUB .input/value LDZ2 ROT SFT2 #0001 AND2
( addr ) #30 SFT2 ;bit-icns ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
RTN
JMP2r
@draw-key ( x* y* glyph* state color -- )
( auto x addr ) AUTO-XADDR
( color ) ,&color STR
( state ) ,&state STR
( glyph ) ,&glyph STR2
( state ) ;button-icns [ #00 ,&state LDR 20** ++ ] .Screen/addr DEO2
( y ) .Screen/y DEO2
( x ) .Screen/x DEO2
( draw background )
,&color LDR .Screen/sprite DEO
,&color LDR .Screen/sprite DEO
.Screen/x DEI2 #0010 -- .Screen/x DEO2
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
,&color LDR .Screen/sprite DEOk DEO
( glyph )
,&glyph LDR2 .Screen/addr DEO2
.Screen/x DEI2 #000c -- .Screen/x DEO2
.Screen/y DEI2 #0005 -- .Screen/y DEO2
,&color LDR [ ,&state LDR #09 MUL + ] .Screen/sprite DEO
( auto none ) AUTO-NONE
STH2
#16 .Screen/auto DEO
SWP2 .Screen/y DEO2
SWP2 .Screen/x DEO2
( bg )
;button-icns [ #00 OVRr STHr #50 SFT2 ADD2 ] .Screen/addr DEO2
STHkr .Screen/sprite DEOk DEO
( fg )
.Screen/addr DEO2
#00 .Screen/auto DEO
.Screen/y DEI2k #000d SUB2 ROT DEO2
.Screen/x DEI2k #0004 ADD2 ROT DEO2
STHr [ STHr #09 MUL ADD ] .Screen/sprite DEO
RTN
&color $1 &state $1 &glyph $2
JMP2r
@draw-key-thin ( x* y* glyph* state color -- )
AUTO-YADDR
#06 .Screen/auto DEO
,&color STR ,&state STR ,&glyph STR2
( frame )
;button-thin-icns #00 [ LIT &state $1 ] 10** ++ .Screen/addr DEO2
;button-thin-icns #00 [ LIT &state $1 ] #40 SFT2 ADD2 .Screen/addr DEO2
.Screen/y DEO2 .Screen/x DEO2
[ LIT &color $1 ] .Screen/sprite DEOk DEO
( glyph )
[ LIT2 &glyph $2 ] .Screen/addr DEO2
.Screen/y DEI2 #000c -- .Screen/y DEO2
.Screen/y DEI2 #000c SUB2 .Screen/y DEO2
#05 .Screen/sprite DEO
AUTO-NONE
#00 .Screen/auto DEO
RTN
JMP2r
@draw-number ( number* color -- )
,&color STR
( reset zero pad )
( reset zero pad )
#00 ;&zero STA
( hexadecimal )
.input/mode LDZ ,&decimal JCN
AUTO-X
#01 .Screen/auto DEO
#00 ,&digit JSR
SWP
SWP ,&byte JSR
&byte
STHk #04 SFT ,&digit JSR
STHr #0f AND ,&digit JSR
STHk #04 SFT ,&digit JSR
STHr #0f AND ,&digit JSR
AUTO-NONE
RTN
STHr #0f AND
&digit ( num -- )
,&addr JSR .Screen/addr DEO2
LIT &color $1 .Screen/sprite DEO
RTN
,&addr JSR .Screen/addr DEO2
[ LIT &color $1 ] .Screen/sprite DEO
JMP2r
&decimal ( num* -- )
AUTO-X
#01 .Screen/auto DEO
#2710 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
#03e8 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
#0064 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 NIP
#0a DIVk DUP ,&digit JSR MUL SUB
#0a DIVk DUP ,&digit JSR MUL SUB
,&digit JSR
AUTO-NONE
RTN
#00 .Screen/auto DEO
JMP2r
&addr ( num -- addr* )
,&zero LDR ,&padded JCN
DUP ,&no-blank JCN
POP ;blank-icn RTN
DUP ,&no-blank JCN
POP ;blank-icn JMP2r
&no-blank
DUP ,&zero STR
&padded 8* TOS ;font-hex ++
RTN
&padded #30 SFT #00 SWP ;font-hex ADD2
RTN
JMP2r
&zero $1
( theme )
@ -624,31 +555,31 @@ RTN
@load-theme ( -- )
;theme-txt .File/name DEO2
#0006 .File/length DEO2
;theme-txt .File/name DEO2
#0006 .File/length DEO2
#fffa .File/read DEO2
.File/success DEI2 #0006 !! ,&ignore JCN
.File/success DEI2 #0006 NEQ2 ,&ignore JCN
#fffa LDA2 .System/r DEO2
#fffc LDA2 .System/g DEO2
#fffe LDA2 .System/b DEO2
&ignore
;redraw JSR2
RTN
JMP2r
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
RTN
&skip POP2 POP2 POPr #00 RTN
#01
JMP2r
&skip POP2 POP2 POPr #00 JMP2r
@line-hor-dotted ( x0* x1* y* color -- )
@ -660,20 +591,10 @@ RTN
INC2 INC2 GTH2k ,&loop JCN
POP2 POP2 POPr
RTN
@print-hex ( value* -- )
SWP ,&byte JSR
&byte ( byte -- )
STHk #04 SFT ,&parse JSR #18 DEO
STHr #0f AND ,&parse JSR #18 DEO
JMP2r
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r
&above #57 ADD JMP2r
JMP2r
( assets )
@keypad
&layout
0708 090f 0405 060e 0102 030d 000a 0b0c
@ -682,8 +603,8 @@ JMP2r
&color
0101 0102 0101 0102 0101 0102 0102 0202
&ops
:do-add :do-sub :do-mul :do-div
:do-and :do-ora :do-eor :do-not
:do-add :do-sub :do-mul :do-div
:do-and :do-ora :do-eor :do-not
@sin-pcm
8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad
@ -707,28 +628,28 @@ JMP2r
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
007c 8280 fc82 827c 007c 8202 1e02 0202
007c 8280 fc82 827c 00fe 0202 0408 1010
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007e 8080 fe80 807e 007c 8280 f080 8080
00fe 8080 fe80 80fe 00fe 8080 f080 8080
@modes
( hex )
0082 8282 fe82 8282
007e 8080 fe80 807e
00fe 8080 fe80 80fe
0082 4428 1028 4482
( dec )
00fc 8282 8282 82fc
007e 8080 fe80 807e
00fe 8080 fe80 80fe
007c 8280 8080 827c
@mod-icns
0010 1010 fe10 1010
0000 0000 fe00 0000
0082 4428 1028 4482
0010 0000 fe00 0010
0078 8484 4836 8876
0002 0408 1020 4080
0070 8888 728a 847a
0010 1010 1010 1010
0000 1028 4482 0000
0000 0060 920c 0000
@ -768,4 +689,4 @@ JMP2r
@pointer-icn
80c0 e0f0 f8e0 1000
@blank-icn
@blank-icn

245
projects/examples/demos/clock.tal → projects/software/clock.tal
View File

@ -1,45 +1,13 @@
( Dev/Time )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%4* { #20 SFT }
%10* { #40 SFT }
%2** { #10 SFT2 } %2// { #01 SFT2 }
%4// { #02 SFT2 }
%10** { #40 SFT2 }
%20** { #50 SFT2 }
%TOS { #00 SWP }
%RTN { JMP2r }
%MOD { DUP2 DIV MUL SUB }
%ABS2 { DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 -- }
%LTS2 { #8000 ++ SWP2 #8000 ++ GTH2 }
%GTS2 { #8000 ++ SWP2 #8000 ++ LTH2 }
%RADIUS { #0040 }
%SCALEX { 2// .center/x LDZ2 ++ RADIUS -- }
%SCALEY { 2// .center/y LDZ2 ++ RADIUS -- }
%12HOURS { #0c MOD }
%IS-UC { DUP #40 > SWP #5b < AND }
%IS-LC { DUP #60 > SWP #7b < AND }
%IS-NUM { DUP #2f > SWP #3a < AND }
( devices )
( simple graphical clock )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|0000
@last
@last
&day $1 &sec $1
@center
&x $2 &y $2
@ -48,46 +16,38 @@
@time
&x $2 &y $2
@needles
&hx $2 &hy $2
&mx $2 &my $2
&hx $2 &hy $2
&mx $2 &my $2
&sx $2 &sy $2
&zx $2 &zy $2
@buf
&d $3 &h $2 &s1 $1 &m $2 &s2 $1 &s $3
@line
&x0 $2 &y0 $2 &x $2 &y $2 &sx $2 &sy $2
&dx $2 &dy $2 &e1 $2 &e2 $2 &color $1
( program )
&x $2 &y $2 &dx $2 &dy $2 &e1 $2
|0100 ( -> )
( theme )
#0ff8 .System/r DEO2
#0f08 .System/g DEO2
( theme )
#0ff8 .System/r DEO2
#0f08 .System/g DEO2
#0f08 .System/b DEO2
( resize )
#00f0 .Screen/width DEO2
#00d0 .Screen/width DEO2
#0120 .Screen/height DEO2
( vectors )
( vectors )
;on-frame .Screen/vector DEO2
( center )
.Screen/width DEI2 2//
.Screen/width DEI2 #01 SFT2
DUP2 .center/x STZ2
DUP2 #0028 -- .date/x STZ2
#0020 -- .time/x STZ2
.Screen/height DEI2 2//
DUP2 #0028 SUB2 .date/x STZ2
#0020 SUB2 .time/x STZ2
.Screen/height DEI2 #01 SFT2
DUP2 .center/y STZ2
DUP2 #0078 -- .date/y STZ2
#006c ++ .time/y STZ2
DUP2 #0078 SUB2 .date/y STZ2
#006c ADD2 .time/y STZ2
;draw-watchface JSR2
( time buffer )
LIT ':
LIT ":
DUP .buf/s1 STZ
.buf/s2 STZ
@ -96,8 +56,8 @@
@on-frame ( -> )
( once per second )
.DateTime/second DEI
DUP .last/sec LDZ = ,&same-sec JCN
.DateTime/second DEI
DUP .last/sec LDZ EQU ,&same-sec JCN
( make time )
.DateTime/hour DEI .buf/h ;decimal JSR2
.DateTime/minute DEI .buf/m ;decimal JSR2
@ -115,15 +75,15 @@
POP
( once per day )
.DateTime/day DEI
DUP .last/day LDZ = ,&same-day JCN
.DateTime/day DEI
DUP .last/day LDZ EQU ,&same-day JCN
( make date )
DUP .buf/d ;decimal JSR2
( draw label )
.date/x LDZ2 .Screen/x DEO2
.date/y LDZ2 .Screen/y DEO2
.DateTime/dotw DEI 4* TOS ;week-txt ++ ;draw-text JSR2
.DateTime/month DEI 4* TOS ;month-txt ++ ;draw-text JSR2
[ #00 .DateTime/dotw DEI #20 SFT ] ;week-txt ADD2 ;draw-text JSR2
[ #00 .DateTime/month DEI #20 SFT ] ;month-txt ADD2 ;draw-text JSR2
;buf/d ;draw-text JSR2
DUP .last/day STZ
&same-day
@ -134,89 +94,90 @@ BRK
@draw-needles ( draw -- )
STH
.center/x LDZ2 .center/y LDZ2
OVR2 OVR2
.needles/zx LDZ2 .needles/zy LDZ2 #02 STHkr * ;draw-line JSR2
OVR2 OVR2
.needles/sx LDZ2 .needles/sy LDZ2 #02 STHkr * ;draw-line JSR2
OVR2 OVR2
.needles/mx LDZ2 .needles/my LDZ2 #01 STHkr * ;draw-line JSR2
OVR2 OVR2
.needles/hx LDZ2 .needles/hy LDZ2 #01 STHr * ;draw-line JSR2
( middle )
#0001 -- .Screen/y DEO2 #0001 -- .Screen/x DEO2
;middle-icn .Screen/addr DEO2
#0a .Screen/sprite DEO
.center/x LDZ2 .center/y LDZ2
OVR2 OVR2
.needles/mx LDZ2 .needles/my LDZ2 #01 STHkr MUL
;draw-line JSR2
OVR2 OVR2
.needles/hx LDZ2 .needles/hy LDZ2 #01 STHkr MUL
;draw-line JSR2
.needles/sx LDZ2 .needles/sy LDZ2
.needles/zx LDZ2 .needles/zy LDZ2 #02 STHr MUL
;draw-line JSR2
RTN
( middle )
#0001 SUB2 .Screen/y DEO2
#0001 SUB2 .Screen/x DEO2
;middle-icn .Screen/addr DEO2
#0a .Screen/sprite DEO
JMP2r
@draw-text ( addr* -- )
( auto addr ) #06 .Screen/auto DEO
( auto addr ) #15 .Screen/auto DEO
&while
LDAk
DUP IS-LC ,&lc JCN
DUP IS-UC ,&uc JCN
DUP IS-NUM ,&num JCN
DUP LIT '/ = ,&slash JCN
DUP LIT ': = ,&colon JCN
DUP ;is-lc JSR2 ,&lc JCN
DUP ;is-uc JSR2 ,&uc JCN
DUP ;is-num JSR2 ,&num JCN
DUP LIT "/ EQU ,&slash JCN
DUP LIT ": EQU ,&colon JCN
POP ;font/blank
&end
.Screen/addr DEO2
#0303 .Screen/sprite DEO .Screen/sprite DEO
.Screen/y DEI2 #0010 -- .Screen/y DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
#03 .Screen/sprite DEO
INC2 LDAk ,&while JCN
POP2
#00 .Screen/sprite DEO
( auto none ) #00 .Screen/auto DEO
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
RTN
&lc #61 - TOS 10** ;font/lc ++ ,&end JMP
&uc #41 - TOS 10** ;font/uc ++ ,&end JMP
&num #30 - TOS 10** ;font/num ++ ,&end JMP
JMP2r
&lc #61 SUB #00 SWP #40 SFT2 ;font/lc ADD2 ,&end JMP
&uc #41 SUB #00 SWP #40 SFT2 ;font/uc ADD2 ,&end JMP
&num #30 SUB #00 SWP #40 SFT2 ;font/num ADD2 ,&end JMP
&slash POP ;font/slash ,&end JMP
&colon POP ;font/colon ,&end JMP
@draw-line ( x1* y1* x2* y2* color -- )
( load ) .line/color STZ .line/y0 STZ2 .line/x0 STZ2 .line/y STZ2 .line/x STZ2
.line/x0 LDZ2 .line/x LDZ2 -- ABS2 .line/dx STZ2
.line/y0 LDZ2 .line/y LDZ2 -- ABS2 #0000 SWP2 -- .line/dy STZ2
#ffff #00 .line/x LDZ2 .line/x0 LDZ2 LTS2 2** ++ .line/sx STZ2
#ffff #00 .line/y LDZ2 .line/y0 LDZ2 LTS2 2** ++ .line/sy STZ2
.line/dx LDZ2 .line/dy LDZ2 ++ .line/e1 STZ2
&loop
.line/x LDZ2 .Screen/x DEO2
.line/y LDZ2 .Screen/y DEO2
.line/color LDZ .Screen/pixel DEO
[ .line/x LDZ2 .line/x0 LDZ2 == ]
[ .line/y LDZ2 .line/y0 LDZ2 == ] AND ,&end JCN
.line/e1 LDZ2 2** .line/e2 STZ2
.line/e2 LDZ2 .line/dy LDZ2 LTS2 ,&skipy JCN
.line/e1 LDZ2 .line/dy LDZ2 ++ .line/e1 STZ2
.line/x LDZ2 .line/sx LDZ2 ++ .line/x STZ2
&skipy
.line/e2 LDZ2 .line/dx LDZ2 GTS2 ,&skipx JCN
.line/e1 LDZ2 .line/dx LDZ2 ++ .line/e1 STZ2
.line/y LDZ2 .line/sy LDZ2 ++ .line/y STZ2
&skipx
;&loop JMP2
&end
RTN
( load ) STH ,&y STR2 ,&x STR2 .line/y STZ2 .line/x STZ2
,&x LDR2 .line/x LDZ2 SUB2 ;abs2 JSR2 .line/dx STZ2
#0000 ,&y LDR2 .line/y LDZ2 SUB2 ;abs2 JSR2 SUB2 .line/dy STZ2
#ffff #00 .line/x LDZ2 ,&x LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sx STR2
#ffff #00 .line/y LDZ2 ,&y LDR2 ;lts2 JSR2 DUP2 ADD2 ADD2 ,&sy STR2
.line/dx LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
&loop
.line/x LDZ2 DUP2 .Screen/x DEO2 [ LIT2 &x $2 ] EQU2
.line/y LDZ2 DUP2 .Screen/y DEO2 [ LIT2 &y $2 ] EQU2
STHkr .Screen/pixel DEO
AND ,&end JCN
.line/e1 LDZ2 DUP2 ADD2 DUP2
.line/dy LDZ2 ;lts2 JSR2 ,&skipy JCN
.line/e1 LDZ2 .line/dy LDZ2 ADD2 .line/e1 STZ2
.line/x LDZ2 [ LIT2 &sx $2 ] ADD2 .line/x STZ2
&skipy
.line/dx LDZ2 ;gts2 JSR2 ,&skipx JCN
.line/e1 LDZ2 .line/dx LDZ2 ADD2 .line/e1 STZ2
.line/y LDZ2 [ LIT2 &sy $2 ] ADD2 .line/y STZ2
&skipx
,&loop JMP
&end
POPr
JMP2r
@draw-watchface ( -- )
#3c00
#3c00
&loop
( dots )
DUP TOS 2** ;table ++ LDA2
#00 OVRk ADD2 ;table ADD2 LDA2
#0018 ;circle JSR2
.Screen/x DEO2 .Screen/y DEO2 #01 .Screen/pixel DEO
( markers )
DUP #05 MOD ,&no-marker JCN
DUP TOS 2** ;table ++ LDA2
DUP #05 ;mod JSR2 ,&no-marker JCN
#00 OVRk ADD2 ;table ADD2 LDA2
STH2k #0018 ;circle JSR2 SWP2
STH2r #001c ;circle JSR2 SWP2
#01 ;draw-line JSR2
@ -224,42 +185,50 @@ RTN
INC GTHk ;&loop JCN2
POP2
RTN
JMP2r
@make-needles ( -- )
[ #00 .DateTime/second DEI #1e + #3c MOD ] 2** ;table ++ LDA2
[ #00 .DateTime/second DEI #1e ADD #3c ;mod JSR2 ] DUP2 ADD2 ;table ADD2 LDA2
#00a0 ,circle JSR .needles/zx STZ2 .needles/zy STZ2
[ #00 .DateTime/second DEI ] 2** ;table ++ LDA2
#0020 ,circle JSR .needles/sx STZ2 .needles/sy STZ2
[ #00 .DateTime/minute DEI ] 2** ;table ++ LDA2
#0022 ,circle JSR .needles/mx STZ2 .needles/my STZ2
[ #00 .DateTime/hour DEI 12HOURS #20 SFTk NIP ADD ]
( minute offset ) [ #00 .DateTime/minute DEI #0f / ++ ] 2** ;table ++ LDA2
[ #00 .DateTime/second DEI ] DUP2 ADD2 ;table ADD2 LDA2
#0020 ,circle JSR .needles/sx STZ2 .needles/sy STZ2
[ #00 .DateTime/minute DEI ] DUP2 ADD2 ;table ADD2 LDA2
#0022 ,circle JSR .needles/mx STZ2 .needles/my STZ2
[ #00 .DateTime/hour DEI #0c ;mod JSR2 #20 SFTk NIP ADD ]
( minute offset ) [ #00 .DateTime/minute DEI #0f DIV ADD2 ] DUP2 ADD2 ;table ADD2 LDA2
#002a ,circle JSR .needles/hx STZ2 .needles/hy STZ2
RTN
JMP2r
@circle ( cx cy radius* -- y* x* )
STH2 SWP
TOS 10** STH2kr // .center/x LDZ2 ++ #0080 10** STH2kr // --
#00 SWP #40 SFT2 STH2kr DIV2 .center/x LDZ2 ADD2 #0800 STH2kr DIV2 SUB2
STH2 SWP2r
TOS 10** STH2kr // .center/y LDZ2 ++ #0080 10** STH2kr // --
#00 SWP #40 SFT2 STH2kr DIV2 .center/y LDZ2 ADD2 #0800 STH2kr DIV2 SUB2
POP2r STH2r
RTN
JMP2r
@decimal ( value* zp-label -- )
STH
DUP #0a DIV #30 + STHkr STZ
#0a MOD #30 + STHr INC STZ
DUP #0a DIV #30 ADD STHkr STZ
#0a ;mod JSR2 #30 ADD STHr INC STZ
RTN
JMP2r
@mod DIVk MUL SUB JMP2r
@abs2 DUP2 #0f SFT2 EQU #05 JCN #0000 SWP2 SUB2 JMP2r
@lts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r
@gts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r
@is-uc DUP #40 GTH SWP #5b LTH AND JMP2r
@is-lc DUP #60 GTH SWP #7b LTH AND JMP2r
@is-num DUP #2f GTH SWP #3a LTH AND JMP2r
@week-txt
"Sun $1 "Mon $1 "Tue $1 "Wed $1 "Thu $1 "Fri $1
"Sun $1 "Mon $1 "Tue $1 "Wed $1 "Thu $1 "Fri $1
"Sat $1
@month-txt

31
projects/software/hexes.tal
View File

@ -1,31 +0,0 @@
( hexes
A small utility that prints incoming console messages as hex values. )
%RTN { JMP2r }
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 ]
( init )
|0100 ( -> )
;on-message .Console/vector DEO2
BRK
@on-message ( -> )
.Console/read DEI ,print-hex JSR
BRK
@print-hex ( value -- )
STHk #04 SFT ,&parse JSR .Console/write DEO
STHr #0f AND ,&parse JSR .Console/write DEO
RTN
&parse ( value -- char )
DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN
RTN

324
projects/software/launcher.tal
View File

@ -1,35 +1,5 @@
( launcher )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 }
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }
%40** { #60 SFT2 }
%RTN { JMP2r }
%TOS { #00 SWP }
%AUTO-NONE { #00 .Screen/auto DEO }
%AUTO-XADDR { #05 .Screen/auto DEO }
%AUTO-YADDR { #06 .Screen/auto DEO }
%HALT { #010f DEO }
%EMIT { #18 DEO }
%PRINT { ;print-str JSR2 #0a EMIT }
%DEBUG { ;print-hex/byte JSR2 #0a EMIT }
%DEBUG2 { ;print-hex JSR2 #0a EMIT }
%LINES-COUNT { .browser/y2 LDZ2 .browser/y LDZ2 -- 10// NIP }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
@ -37,7 +7,7 @@
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
( variables )
@ -46,7 +16,7 @@
@pointer
&x $2 &y $2
@browser
&x $2 &y $2 &x2 $2 &y2 $2
&x $2 &y $2 &x2 $2 &y2 $2
&sel $1 &last $1 &scroll $1
&lines $1
@ -54,9 +24,9 @@
|0100 ( -> )
( theme )
#f079 .System/r DEO2
#f0c2 .System/g DEO2
( theme )
#f079 .System/r DEO2
#f0c2 .System/g DEO2
#f0a4 .System/b DEO2
( vectors )
@ -64,6 +34,10 @@
;on-button .Controller/vector DEO2
;on-mouse .Mouse/vector DEO2
( resize )
#0200 .Screen/width DEO2
#0140 .Screen/height DEO2
( asma debugger )
#0d ;asma/log-level STA
@ -78,16 +52,16 @@
( place )
#0088 .browser/x STZ2
#0010 .browser/y STZ2
.Screen/height DEI2 #33 SFT2 #0011 -- .browser/y2 STZ2
.Screen/height DEI2 #33 SFT2 #0011 SUB2 .browser/y2 STZ2
( theme support )
;load-theme JSR2
( draw mascot )
#0010 #0010 #0060 #0060 ;mascot-icn #01 ;draw-icn JSR2
;load-dir JSR2
( theme support )
;load-theme JSR2
( force selection )
#ff .browser/last STZ
#00 ;select-file JSR2
@ -111,28 +85,28 @@ BRK
( draw new cursor )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#41 .Mouse/state DEI #01 = + .Screen/sprite DEO
#41 .Mouse/state DEI #01 EQU ADD .Screen/sprite DEO
( wheel )
.Mouse/scrolly INC DEI
DUP #ff ! ,&no-up JCN
.browser/scroll LDZ #00 = ,&no-up JCN
DUP .browser/scroll LDZ + ;scroll-to JSR2
DUP #ff NEQ ,&no-up JCN
.browser/scroll LDZ #00 EQU ,&no-up JCN
DUP .browser/scroll LDZ ADD ;scroll-to JSR2
&no-up
DUP #01 ! ,&no-down JCN
.browser/scroll LDZ .browser/lines LDZ = ,&no-down JCN
DUP .browser/scroll LDZ + ;scroll-to JSR2
DUP #01 NEQ ,&no-down JCN
.browser/scroll LDZ .browser/lines LDZ EQU ,&no-down JCN
DUP .browser/scroll LDZ ADD ;scroll-to JSR2
&no-down
POP
( within browser )
.Mouse/y DEI2 .browser/y LDZ2 << ,&outside JCN
.Mouse/y DEI2 .browser/y2 LDZ2 #0010 -- >> ,&outside JCN
.Mouse/y DEI2 .browser/y LDZ2 LTH2 ,&outside JCN
.Mouse/y DEI2 .browser/y2 LDZ2 #0010 SUB2 GTH2 ,&outside JCN
( select choice )
.Mouse/y DEI2 .browser/y LDZ2 --
10// NIP .browser/scroll LDZ + ;select-file JSR2
.Mouse/y DEI2 .browser/y LDZ2 SUB2
#04 SFT2 NIP .browser/scroll LDZ ADD ;select-file JSR2
( run choice )
.Mouse/state DEI #00 = ,&no-click JCN
.Mouse/state DEI #00 EQU ,&no-click JCN
.browser/sel LDZ ;run-file JSR2
&no-click
&outside
@ -143,26 +117,26 @@ BRK
( controller )
.Controller/button DEI
DUP #10 ! ,&no-up JCN
.browser/sel LDZ #00 = ,&no-up JCN
.browser/sel LDZ #01 - ;select-file JSR2
DUP #10 NEQ ,&no-up JCN
.browser/sel LDZ #00 EQU ,&no-up JCN
.browser/sel LDZ #01 SUB ;select-file JSR2
;follow-selection JSR2
POP BRK
&no-up
DUP #20 ! ,&no-down JCN
.browser/sel LDZ INC .browser/lines LDZ = ,&no-down JCN
.browser/sel LDZ INC ;select-file JSR2
DUP #20 NEQ ,&no-down JCN
.browser/sel LDZ INC .browser/lines LDZ EQU ,&no-down JCN
.browser/sel LDZ INC ;select-file JSR2
;follow-selection JSR2
POP BRK
&no-down
DUP #01 ! ,&no-a JCN
.browser/sel LDZ ;run-file JSR2
DUP #01 NEQ ,&no-a JCN
.browser/sel LDZ ;run-file JSR2
POP BRK
&no-a
POP
( keyboard )
.Controller/key DEI
DUP #0d ! ,&no-enter JCN
DUP #0d NEQ ,&no-enter JCN
.browser/sel LDZ ;run-file JSR2
POP BRK
&no-enter
@ -181,99 +155,103 @@ BRK
( split with null-char )
;dir/data
&while
LDAk #1f > ,&no-lb JCN
LDAk #1f GTH ,&no-lb JCN
( split ) STH2k #00 STH2r STA
( count lines ) .browser/lines LDZk INC SWP STZ
&no-lb
INC2 LDAk ,&while JCN
POP2
RTN
JMP2r
@select-file ( id -- )
( has changed )
DUP .browser/last LDZ ! ,&has-changed JCN
POP RTN
DUP .browser/last LDZ NEQ ,&has-changed JCN
POP JMP2r
&has-changed
( beyond )
DUP .browser/lines LDZ < ,&valid JCN
POP RTN
DUP .browser/lines LDZ LTH ,&valid JCN
POP JMP2r
&valid
#00 ;draw-browser JSR2
DUP .browser/sel STZ
DUP .browser/last STZ
#30 + .Audio0/pitch DEO
#30 ADD .Audio0/pitch DEO
#01 ;draw-browser JSR2
( draw mascot )
#0010 #0010 #0060 #0060
;mascot-icn [ .browser/sel LDZ #03 AND TOS #0480 ** ++ ] #01
#0010 #0010 #0060 #0060
;mascot-icn .browser/sel LDZ #03 AND #00 SWP #0480 MUL2 ADD2 #01
;draw-icn JSR2
( draw position )
AUTO-YADDR
#06 .Screen/auto DEO
#0010 .Screen/x DEO2
#0080 .Screen/y DEO2
.browser/sel LDZ #02 ;draw-byte JSR2
LIT '/ #02 ;draw-char JSR2
.browser/lines LDZ #01 - #02 ;draw-byte JSR2
AUTO-NONE
LIT "/ #02 ;draw-char JSR2
.browser/lines LDZ #01 SUB #02 ;draw-byte JSR2
#00 .Screen/auto DEO
RTN
JMP2r
@follow-selection ( -- )
LINES-COUNT .browser/sel LDZ .browser/scroll LDZ -
DUP2 > ,&no-down JCN
.browser/y2 LDZ2 .browser/y LDZ2 SUB2 #04 SFT2 NIP .browser/sel LDZ .browser/scroll LDZ SUB
GTHk ,&no-down JCN
.browser/scroll LDZ INC ,scroll-to JSR
&no-down
DUP2 SWP < ,&no-up JCN
DUP2 SWP LTH ,&no-up JCN
.browser/sel LDZ ,scroll-to JSR
&no-up
POP2
RTN
JMP2r
@scroll-to ( line -- )
STH
( more lines than visible )
.browser/lines LDZ LINES-COUNT
DUP2 > ,&can-scroll JCN
POPr POP2 RTN
.browser/lines LDZ .browser/y2 LDZ2 .browser/y LDZ2 SUB2 #04 SFT2 NIP
GTHk ,&can-scroll JCN
POPr POP2 JMP2r
&can-scroll
( less than max scroll )
- INC STHkr > ,&valid-scroll JCN
POPr RTN
&valid-scroll
SUB INC STHkr GTH ,&valid-scroll JCN
POPr JMP2r
&valid-scroll
#00 ;draw-browser JSR2
STHr .browser/scroll STZ
#01 ;draw-browser JSR2
RTN
JMP2r
@run-file ( id -- )
;get-entry JSR2 #0005 ++
( release inputs )
#0000 .Controller/button DEO2
#00 .Mouse/state DEO
;get-entry JSR2 #0005 ADD2
DUP2 ;check-rom JSR2 ,&valid JCN
( check if tal file )
DUP2 ;scap JSR2 #0004 -- ;&tal-ext ;scmp JSR2 #01 ! ,&no-tal JCN
DUP2 ;scap JSR2 #0004 SUB2 ;&tal-ext ;scmp JSR2 #01 NEQ ,&no-tal JCN
( assemble tal file )
DUP2 ;&output-path ;scpy JSR2
;&rom-ext ;&output-path ;scat JSR2
;&output-path ;asma-assemble-file JSR2
;&output-path ;asma-assemble-file JSR2
;load-dir JSR2
;redraw JSR2
RTN
JMP2r
&no-tal
POP2 RTN
POP2 JMP2r
&valid
;load-rom JSR2
;load-rom JSR2
RTN
JMP2r
&tal-ext ".tal $1
&rom-ext ".rom $1
&output-path $20
@ -284,38 +262,38 @@ RTN
#ff .browser/last STZ
#00 ;select-file JSR2
RTN
JMP2r
@draw-browser ( mask -- )
( when empty )
.browser/lines LDZ #01 = ;draw-browser-empty JCN2
.browser/lines LDZ #01 EQU ;draw-browser-empty JCN2
STH
( draw hand )
.browser/x LDZ2 #0018 -- .browser/y LDZ2
.browser/sel LDZ .browser/scroll LDZ - TOS 10** ++
#0010 #0010
;hand-icn STHkr #02 * ;draw-icn JSR2
.browser/x LDZ2 #0018 SUB2 .browser/y LDZ2
.browser/sel LDZ .browser/scroll LDZ SUB #00 SWP #40 SFT2 ADD2
#0010 #0010
;hand-icn STHkr #10 SFT ;draw-icn JSR2
( draw files )
LINES-COUNT #00
.browser/y2 LDZ2 .browser/y LDZ2 SUB2 #04 SFT2 NIP #00
&loop
( reached end )
DUP INC .browser/lines LDZ > ,&end JCN
INCk .browser/lines LDZ GTH ,&end JCN
( has file )
.browser/x LDZ2 .Screen/x DEO2
DUP TOS 10** .browser/y LDZ2 ++ .Screen/y DEO2
DUP .browser/scroll LDZ + ;get-entry JSR2
#00 OVR #40 SFT2 .browser/y LDZ2 ADD2 .Screen/y DEO2
DUP .browser/scroll LDZ ADD ;get-entry JSR2
DUP2 ;get-type JSR2 ;draw-type JSR2
#01 STHkr * ;draw-str JSR2
#01 STHkr MUL ;draw-str JSR2
INC GTHk ,&loop JCN
&end
POP2
POPr
RTN
JMP2r
@draw-browser-empty ( mask -- )
@ -324,14 +302,14 @@ RTN
.browser/y LDZ2 .Screen/y DEO2
;&empty-txt #01 ;draw-str JSR2
RTN
JMP2r
&empty-txt "Empty 20 "Folder $1
@get-type ( line* -- type )
;scap JSR2 #0004 -- ;&rom-ext ;scmp JSR2
;scap JSR2 #0004 SUB2 ;&rom-ext ;scmp JSR2
RTN
JMP2r
&rom-ext ".rom $1
@get-entry ( id -- addr* )
@ -340,10 +318,10 @@ RTN
( counter ) LITr 00
;dir/length LDA2 #0000
&loop
EQUkr STHr #00 = ,&no-reached JCN
POP2r NIP2 ;dir/data ++ RTN
EQUkr STHr #00 EQU ,&no-reached JCN
POP2r NIP2 ;dir/data ADD2 JMP2r
&no-reached
DUP2 ;dir/data ++ LDA #00 ! ,&no-lb JCN
DUP2 ;dir/data ADD2 LDA ,&no-lb JCN
INCr
&no-lb
INC2 GTH2k ,&loop JCN
@ -351,30 +329,30 @@ RTN
POP2r
;dir/data
RTN
JMP2r
@draw-type ( type -- )
STHk TOS 20** ;file-icns ++ .Screen/addr DEO2
AUTO-XADDR
#02 STHkr - .Screen/sprite DEOk DEO
STHk #00 SWP #50 SFT2 ;file-icns ADD2 .Screen/addr DEO2
#05 .Screen/auto DEO
#02 STHkr SUB .Screen/sprite DEOk DEO
.Screen/x DEI2k #0010 -- ROT DEO2
.Screen/y DEI2k #0008 ++ ROT DEO2
.Screen/x DEI2k #0010 SUB2 ROT DEO2
.Screen/y DEI2k #0008 ADD2 ROT DEO2
#02 STHr - .Screen/sprite DEOk DEO
#02 STHr SUB .Screen/sprite DEOk DEO
.Screen/x DEI2k #0008 ++ ROT DEO2
.Screen/y DEI2k #0008 -- ROT DEO2
AUTO-NONE
.Screen/x DEI2k #0008 ADD2 ROT DEO2
.Screen/y DEI2k #0008 SUB2 ROT DEO2
#00 .Screen/auto DEO
RTN
JMP2r
@draw-icn ( x* y* width* height* addr* color -- )
AUTO-XADDR
#05 .Screen/auto DEO
( load ) STH .Screen/addr DEO2 ,&height STR2 ,&width STR2 ,&y STR2 ,&x STR2
,&height LDR2 #0000
,&height LDR2 #0000
&ver
( save ) DUP2 ,&y LDR2 ADD2 .Screen/y DEO2
,&x LDR2 .Screen/x DEO2
@ -386,14 +364,14 @@ RTN
#0008 ADD2 GTH2k ,&ver JCN
POP2 POP2
POPr
AUTO-NONE
#00 .Screen/auto DEO
RTN
JMP2r
&x $2 &y $2 &width $2 &height $2
@draw-str ( text* color -- )
AUTO-YADDR
#06 .Screen/auto DEO
STH
&while
LDAk STHkr ,draw-char JSR
@ -401,14 +379,7 @@ RTN
POP2
POPr
RTN
@draw-short ( short* color -- )
STH SWP STHkr ,draw-byte JSR
STHr ,draw-byte JSR
RTN
JMP2r
@draw-byte ( byte color -- )
@ -416,17 +387,16 @@ RTN
DUP #04 SFT ,&parse JSR STHkr ,draw-char JSR
#0f AND ,&parse JSR STHr ,draw-char JSR
RTN
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r
JMP2r
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r
&above #57 ADD JMP2r
@draw-char ( char color -- )
SWP
[ #20 - #00 SWP #40 SFT2 ;font ++ ] .Screen/addr DEO2
.Screen/sprite DEOk DEO
.Screen/x DEI2k #0008 ++ ROT DEO2
.Screen/y DEI2k #0010 -- ROT DEO2
#15 .Screen/auto DEO
#20 SUB #00 SWP #40 SFT2 ;font ADD2 .Screen/addr DEO2
.Screen/sprite DEO
JMP2r
@ -436,66 +406,40 @@ JMP2r
@load-theme ( -- )
;theme-txt .File/name DEO2
#0006 .File/length DEO2
;theme-txt .File/name DEO2
#0006 .File/length DEO2
#fffa .File/read DEO2
.File/success DEI2 #0006 !! ,&ignore JCN
.File/success DEI2 #0006 NEQ2 ,&ignore JCN
#fffa LDA2 .System/r DEO2
#fffc LDA2 .System/g DEO2
#fffe LDA2 .System/b DEO2
&ignore
;redraw JSR2
RTN
JMP2r
( helpers )
@print-str ( string* -- )
#0001 SUB2
&while
INC2 LDAk DUP #18 DEO ,&while JCN
POP2
JMP2r
@print-hex ( value* -- )
SWP ,&byte JSR
&byte ( byte -- )
STHk #04 SFT ,&parse JSR #18 DEO
STHr #0f AND ,&parse JSR #18 DEO
JMP2r
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r
&above #57 ADD JMP2r
JMP2r
@scat ( src* dst* -- )
DUP2 ,slen JSR ++ ,scpy JSR
JMP2r
@scmp ( a* b* -- flag )
STH2
&loop
LDAk LDAkr STHr = ,&not-diff JCN
POP2 POP2r #00 RTN
&not-diff
LDAk LDAkr STHr #0000 !! ,&not-end JCN
POP2 POP2r #01 RTN
LDAk LDAkr STHr NEQ ,&end JCN
LDAk LDAkr STHr ORA ,&not-end JCN
POP2 POP2r #01 JMP2r
&not-end
INC2 INC2r
,&loop JMP
INC2 INC2r ,&loop JMP
&end
POP2 POP2r #00
RTN
JMP2r
@scat ( src* dst* -- )
DUP2 ,slen JSR ADD2
@scpy ( src* dst* -- )
STH2
&while
LDAk STH2kr STA INC2r
@ -505,16 +449,16 @@ RTN
JMP2r
@scap ( str* -- str-end* )
( clamp ) LDAk #00 ! JMP RTN
&while INC2 LDAk ,&while JCN
RTN
@slen ( str* -- len* )
DUP2 ,scap JSR SWP2 --
DUP2 ,scap JSR SWP2 SUB2
JMP2r
@scap ( str* -- str-end* )
( clamp ) LDAk #00 NEQ JMP JMP2r
&while INC2 LDAk ,&while JCN
JMP2r
@ -554,10 +498,10 @@ JMP2r
~projects/library/check-rom.tal
~projects/library/load-rom.tal
~projects/assets/mascot0cx0c.tal
~projects/assets/msx01x02.tal
( directory memory )
@dir
&path ". $1
&length $2

103
projects/software/neralie.tal
View File

@ -1,46 +1,11 @@
(
app/neralie : clock with arvelie date
TODO
- use splash screen when FPS calculation is unstable
)
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT }
%4* { #20 SFT } %4/ { #02 SFT }
%8* { #30 SFT } %8/ { #03 SFT }
%10* { #40 SFT } %10/ { #04 SFT }
%20* { #50 SFT } %20/ { #05 SFT }
%2** { #10 SFT2 } %2// { #01 SFT2 }
%4** { #20 SFT2 } %4// { #02 SFT2 }
%8** { #30 SFT2 } %8// { #03 SFT2 }
%10** { #40 SFT2 } %10// { #04 SFT2 }
%20** { #50 SFT2 } %20// { #05 SFT2 }
%MOD { DUP2 DIV MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }
%TOS { #00 SWP }
%h { .DateTime/hour DEI }
%m { .DateTime/minute DEI }
%s { .DateTime/second DEI }
%1-- { #0001 -- }
%PAD { #0018 }
%RTN { JMP2r }
( app/neralie : clock with arvelie date )
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|c0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
@ -73,18 +38,18 @@
#01 .fps/current STZ
( set size )
PAD
#0018 ( padding )
DUP2 .frame/x1 STZ2
DUP2 .frame/y1 STZ2
DUP2 .Screen/width DEI2 SWP2 -- #0001 -- .frame/x2 STZ2
.Screen/height DEI2 SWP2 -- .frame/y2 STZ2
DUP2 .Screen/width DEI2 SWP2 SUB2 #0001 SUB2 .frame/x2 STZ2
.Screen/height DEI2 SWP2 SUB2 .frame/y2 STZ2
#01 .neralie/color STZ
.frame/x1 LDZ2 .frame/x2 LDZ2
OVR2 OVR2 .frame/y1 LDZ2 ;h JSR2
.frame/y2 LDZ2 ;h JSR2
.frame/y1 LDZ2 #0001 -- .frame/y2 LDZ2 INC2
.frame/y1 LDZ2 #0001 SUB2 .frame/y2 LDZ2 INC2
OVR2 OVR2 .frame/x1 LDZ2 ;v JSR2
.frame/x2 LDZ2 ;v JSR2
@ -105,46 +70,46 @@ BRK
@neralie-calc ( -- )
( add up fractions of a pulse, store tenths in n6 )
#0120 #00 h MUL2
#00c0 #00 m MUL2 ADD2
#00f8 #00 s MUL2 ADD2
#0271 #00 .fps/next LDZ MUL2 #00 .fps/current LDZ DIV2 8** ADD2
#0120 #00 .DateTime/hour DEI MUL2
#00c0 #00 .DateTime/minute DEI MUL2 ADD2
#00f8 #00 .DateTime/second DEI MUL2 ADD2
#0271 #00 .fps/next LDZ MUL2 #00 .fps/current LDZ DIV2 #30 SFT2 ADD2
#01b0 ;modf JSR2 SWP2 #0017 MUL2 #03e8 DIV2 .neralie/n6 STZ POP
( add up units and tens of pulses, store in n5 and n4 )
#0042 #00 h MUL2 ADD2
#005e #00 m MUL2 ADD2
#000b #00 s MUL2 ADD2
#0042 #00 .DateTime/hour DEI MUL2 ADD2
#005e #00 .DateTime/minute DEI MUL2 ADD2
#000b #00 .DateTime/second DEI MUL2 ADD2
#000a ;modf JSR2 SWP2 .neralie/n5 STZ POP
#000a ;modf JSR2 SWP2 .neralie/n4 STZ POP
( add up hundreds of pulses + 10 x beats, store in n0123 )
#01a0 #00 h MUL2 ADD2
#0006 #00 m MUL2 ADD2 .neralie/n0123 STZ2
#01a0 #00 .DateTime/hour DEI MUL2 ADD2
#0006 #00 .DateTime/minute DEI MUL2 ADD2 .neralie/n0123 STZ2
RTN
JMP2r
@draw-date ( -- )
( auto x ) #01 .Screen/auto DEO
.Screen/width DEI2 2// #0034 -- .Screen/x DEO2
.Screen/height DEI2 #0010 -- .Screen/y DEO2
.Screen/width DEI2 #01 SFT2 #0034 SUB2 .Screen/x DEO2
.Screen/height DEI2 #0010 SUB2 .Screen/y DEO2
( arvelie )
.DateTime/year DEI2 #07d6 -- NIP
DUP #0a DIV TOS 8** ;font-numbers ++ .Screen/addr DEO2
.DateTime/year DEI2 #07d6 SUB2 NIP
DUP #0a DIV #00 SWP #30 SFT2 ;font-numbers ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
#0a MOD TOS 8** ;font-numbers ++ .Screen/addr DEO2
#0a DIVk MUL SUB #00 SWP #30 SFT2 ;font-numbers ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
.DateTime/doty DEI2
DUP2 #000e DIV2 8** ;font-letters ++ .Screen/addr DEO2
DUP2 #000e DIV2 #30 SFT2 ;font-letters ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
#000e MOD2
#000e DIV2k MUL2 SUB2
DUP2 #000a DIV2 ,digit JSR
#000a MOD2 ,digit JSR
#000a DIV2k MUL2 SUB2 ,digit JSR
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
( neralie )
.neralie/n0123 LDZ2
@ -158,14 +123,14 @@ RTN
( auto none ) #00 .Screen/auto DEO
RTN
JMP2r
@digit ( index* -- )
8** ;font-numbers ++ .Screen/addr DEO2
#30 SFT2 ;font-numbers ADD2 .Screen/addr DEO2
.neralie/color LDZ .Screen/sprite DEO
RTN
JMP2r
@draw-clock ( -- )
@ -197,7 +162,7 @@ RTN
&next ( digit-addr number* -- next-digit-addr next-number* prev-digit* )
#03e8 ;modf JSR2 STH2 #000a MUL2
ROT DUP STH INC ROT ROT
ROT STHk INC ROT ROT
#00 STHr LDZ ADD2
STH2r
JMP2r
@ -233,7 +198,7 @@ RTN
.Screen/y .lines/addr STZ
&draw-line ( v1* v2* -- )
OVR2 OVR2 LTH2 #01 JCN SWP2
LTH2k #01 JCN SWP2
STH2
&loop
@ -249,15 +214,15 @@ RTN
@update-fps ( -- )
.fps/next LDZ INC .fps/next STZ
s .fps/second LDZ NEQ JMP JMP2r
s .fps/second STZ
.DateTime/second DEI .fps/second LDZ NEQ JMP JMP2r
.DateTime/second DEI .fps/second STZ
.fps/next LDZ .fps/current STZ
#00 .fps/next STZ
JMP2r
@modf ( dividend* divisor* -- remainder* quotient* )
OVR2 OVR2 DIV2 DUP2 STH2 MUL2 SUB2 STH2r JMP2r
@modf ( dividend* divisor* SUB2 remainder* quotient* )
DIV2k STH2k MUL2 SUB2 STH2r JMP2r
@mul2hi ( a* b* -- product-top-16-bits* )
(

477
projects/software/piano.tal Normal file
View File

@ -0,0 +1,477 @@
( Piano:
Play notes with the keyboard or the controller )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2
|0000
@last-note $1
@octave $1
@pointer
&x $2 &y $2
@center
&x $2 &y $2
@adsr-view
&x1 $2 &y1 $2 &x2 $2 &y2 $2
@wave-view
&x1 $2 &y1 $2 &x2 $2 &y2 $2
@octave-view
&x1 $2 &y1 $2 &x2 $2 &y2 $2
|0100 ( -> )
( theme )
#0fe5 .System/r DEO2
#0fc5 .System/g DEO2
#0f25 .System/b DEO2
( vectors )
;on-frame .Screen/vector DEO2
;on-control .Controller/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-message .Console/vector DEO2
( find center )
.Screen/width DEI2 #01 SFT2 .center/x STZ2
.Screen/height DEI2 #01 SFT2 .center/y STZ2
( place octave )
.center/x LDZ2 #0080 SUB2 .octave-view/x1 STZ2
.center/y LDZ2 #0008 ADD2 .octave-view/y1 STZ2
.octave-view/x1 LDZ2 #0050 ADD2 .octave-view/x2 STZ2
.octave-view/y1 LDZ2 #0018 ADD2 .octave-view/y2 STZ2
( place adsr )
.center/x LDZ2 #0020 SUB2 .adsr-view/x1 STZ2
.center/y LDZ2 #0008 ADD2 .adsr-view/y1 STZ2
.adsr-view/x1 LDZ2 #00a0 ADD2 .adsr-view/x2 STZ2
.adsr-view/y1 LDZ2 #0018 ADD2 .adsr-view/y2 STZ2
( place waveform )
.center/x LDZ2 #0080 SUB2 .wave-view/x1 STZ2
.center/y LDZ2 #0020 SUB2 .wave-view/y1 STZ2
.wave-view/x1 LDZ2 #0100 ADD2 .wave-view/x2 STZ2
.wave-view/y1 LDZ2 #0020 ADD2 .wave-view/y2 STZ2
( default settings )
#ff .last-note STZ
#041c .Audio0/adsr DEO2
#dd .Audio0/volume DEO
;sin-pcm .Audio0/addr DEO2
#0100 .Audio0/length DEO2
( inital drawing )
;draw-octave JSR2
;draw-adsr JSR2
;draw-wave JSR2
BRK
@on-frame ( -> )
.adsr-view/y2 LDZ2 #0020 SUB2 .Screen/y DEO2
#10 #00
&loop
.adsr-view/x2 LDZ2 #003a SUB2 .Screen/x DEO2
#10 OVR SUB .Audio0/output DEI #0f AND LTH .Screen/pixel DEO
.adsr-view/x2 LDZ2 #003a SUB2 INC2 INC2 .Screen/x DEO2
#10 OVR SUB .Audio0/output DEI #04 SFT LTH .Screen/pixel DEO
.Screen/y DEI2k INC2 INC2 ROT DEO2
INC GTHk ,&loop JCN
POP2
BRK
@on-control ( -> )
( clear last cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
.Controller/key DEI
[ LIT "a ] NEQk NIP ,&no-c JCN #30 .octave LDZ #0c MUL ADD ;play JSR2 &no-c
[ LIT "s ] NEQk NIP ,&no-d JCN #32 .octave LDZ #0c MUL ADD ;play JSR2 &no-d
[ LIT "d ] NEQk NIP ,&no-e JCN #34 .octave LDZ #0c MUL ADD ;play JSR2 &no-e
[ LIT "f ] NEQk NIP ,&no-f JCN #35 .octave LDZ #0c MUL ADD ;play JSR2 &no-f
[ LIT "g ] NEQk NIP ,&no-g JCN #37 .octave LDZ #0c MUL ADD ;play JSR2 &no-g
[ LIT "h ] NEQk NIP ,&no-a JCN #39 .octave LDZ #0c MUL ADD ;play JSR2 &no-a
[ LIT "j ] NEQk NIP ,&no-b JCN #3b .octave LDZ #0c MUL ADD ;play JSR2 &no-b
[ LIT "k ] NEQk NIP ,&no-c2 JCN #3c .octave LDZ #0c MUL ADD ;play JSR2 &no-c2
[ #1b ] NEQk NIP ,&no-esc JCN #010f DEO &no-esc
POP
( release )
#00 .Controller/key DEO
.Controller/button DEI
[ #11 ] NEQk NIP ,&cu JCN #3c ;play JSR2 &cu
[ #21 ] NEQk NIP ,&cd JCN #3d ;play JSR2 &cd
[ #41 ] NEQk NIP ,&cl JCN #3e ;play JSR2 &cl
[ #81 ] NEQk NIP ,&cr JCN #3f ;play JSR2 &cr
[ #12 ] NEQk NIP ,&au JCN #40 ;play JSR2 &au
[ #22 ] NEQk NIP ,&ad JCN #41 ;play JSR2 &ad
[ #42 ] NEQk NIP ,&al JCN #42 ;play JSR2 &al
[ #82 ] NEQk NIP ,&ar JCN #43 ;play JSR2 &ar
[ #14 ] NEQk NIP ,&su JCN #44 ;play JSR2 &su
[ #24 ] NEQk NIP ,&sd JCN #45 ;play JSR2 &sd
[ #44 ] NEQk NIP ,&sl JCN #46 ;play JSR2 &sl
[ #84 ] NEQk NIP ,&sr JCN #47 ;play JSR2 &sr
[ #40 ] NEQk NIP ,&l JCN .Audio0/addr DEI2 #0010 SUB2 .Audio0/addr DEO2 &l
[ #80 ] NEQk NIP ,&r JCN .Audio0/addr DEI2 #0010 ADD2 .Audio0/addr DEO2 &r
POP
;draw-octave JSR2
;draw-wave JSR2
BRK
@on-message ( -> )
.Console/read DEI ;play JSR2
;draw-octave JSR2
BRK
@on-mouse ( -> )
;draw-cursor JSR2
.Mouse/state DEI #00 NEQ JMP [ BRK ]
.Mouse/x DEI2 .Mouse/y DEI2 .wave-view ;within-rect JSR2
;on-touch-wave-view JCN2
.Mouse/x DEI2 .Mouse/y DEI2 .adsr-view ;within-rect JSR2
;on-touch-adsr-view JCN2
.Mouse/x DEI2 .Mouse/y DEI2 .octave-view ;within-rect JSR2
;on-touch-octave-view JCN2
BRK
@on-touch-wave-view ( -> )
.Mouse/x DEI2 .wave-view/x1 LDZ2 SUB2 .Audio0/length DEO2
;draw-wave JSR2
;draw-cursor JSR2
BRK
@on-touch-octave-view ( -> )
.Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 NIP #09 NEQ ,&no-mod JCN
.Mouse/y DEI2 .octave-view/y1 LDZ2 SUB2 #03 SFT2 NIP
[ #00 ] NEQk NIP ,&no-incr JCN
.octave LDZ #03 EQU ,&no-incr JCN
.octave LDZ INC .octave STZ &no-incr
[ #02 ] NEQk NIP ,&no-decr JCN
.octave LDZ #ff EQU ,&no-decr JCN
.octave LDZ #01 SUB .octave STZ &no-decr
POP
( release ) #00 .Mouse/state DEO
;draw-octave JSR2
BRK
&no-mod
.Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 NIP #06 GTH ,&no-key JCN
.Mouse/x DEI2 .octave-view/x1 LDZ2 SUB2 #03 SFT2 ;notes ADD2 LDA .octave LDZ #0c MUL ADD ;play JSR2
( release ) #00 .Mouse/state DEO
;draw-octave JSR2
&no-key
BRK
@on-touch-adsr-view ( -> )
.Mouse/x DEI2 .adsr-view/x1 LDZ2 SUB2 #03 SFT2 NIP #03 DIV
[ #00 ] NEQk NIP ,&no-a JCN
.Audio0/adsr DEI ,&touch2 JSR .Audio0/adsr DEO &no-a
[ #01 ] NEQk NIP ,&no-d JCN
.Audio0/adsr DEI ,&touch JSR .Audio0/adsr DEO &no-d
[ #02 ] NEQk NIP ,&no-s JCN
.Audio0/adsr INC DEI ,&touch2 JSR .Audio0/adsr INC DEO &no-s
[ #03 ] NEQk NIP ,&no-r JCN
.Audio0/adsr INC DEI ,&touch JSR .Audio0/adsr INC DEO &no-r
[ #05 ] NEQk NIP ,&no-left JCN
.Audio0/volume DEI ,&touch2 JSR .Audio0/volume DEO &no-left
[ #06 ] NEQk NIP ,&no-right JCN
.Audio0/volume DEI ,&touch JSR .Audio0/volume DEO &no-right
POP
( release ) #00 .Mouse/state DEO
;draw-adsr JSR2
;draw-cursor JSR2
BRK
&touch DUP #f0 AND STH #01 .Mouse/state DEI #01 GTH #0e MUL ADD ADD #0f AND STHr ADD JMP2r
&touch2 #10 .Mouse/state DEI #01 GTH #e0 MUL ADD ADD JMP2r
@play ( pitch -- )
DUP #0c ( mod ) [ DIVk MUL SUB ] .last-note STZ
.Audio0/pitch DEO
JMP2r
@draw-cursor ( -- )
( clear last cursor )
;cursor .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( record pointer positions )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
( colorize on state )
#41 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
JMP2r
@draw-octave ( -- )
.octave-view/x1 LDZ2 #0048 ADD2 .Screen/x DEO2
;arrow-icns .Screen/addr DEO2
.octave-view/y1 LDZ2 .Screen/y DEO2
#01 .Screen/sprite DEO
;arrow-icns/down .Screen/addr DEO2
.octave-view/y1 LDZ2 #0010 ADD2 .Screen/y DEO2
#01 .Screen/sprite DEO
;font-hex .octave LDZ #03 ADD #00 SWP #30 SFT2 ADD2 .Screen/addr DEO2
.octave-view/y1 LDZ2 #0008 ADD2 .Screen/y DEO2
#03 .Screen/sprite DEO
.octave-view/x1 LDZ2 .Screen/x DEO2
.octave-view/y1 LDZ2 .Screen/y DEO2
#06 .Screen/auto DEO
.last-note LDZ STH
;keys-left-icns STHkr #00 EQU INC ,draw-key JSR
;keys-middle-icns STHkr #02 EQU INC ,draw-key JSR
;keys-right-icns STHkr #04 EQU INC ,draw-key JSR
;keys-left-icns STHkr #05 EQU INC ,draw-key JSR
;keys-middle-icns STHkr #07 EQU INC ,draw-key JSR
;keys-middle-icns STHkr #09 EQU INC ,draw-key JSR
;keys-right-icns STHr #0b EQU INC ,draw-key JSR
#00 .Screen/auto DEO
JMP2r
@draw-key ( addr* color -- )
STH
.Screen/addr DEO2
.Screen/y DEI2
STHr .Screen/sprite DEOk DEOk DEO
.Screen/x DEI2k #0008 ADD2 ROT DEO2
.Screen/y DEO2
JMP2r
@draw-adsr ( -- )
( adsr )
.adsr-view/x1 LDZ2 .adsr-view/y1 LDZ2
.Audio0/adsr DEI #04 SFT
;draw-knob JSR2
.adsr-view/x1 LDZ2 #0018 ADD2 .adsr-view/y1 LDZ2
.Audio0/adsr DEI #0f AND
;draw-knob JSR2
.adsr-view/x1 LDZ2 #0030 ADD2 .adsr-view/y1 LDZ2
.Audio0/adsr INC DEI #04 SFT
;draw-knob JSR2
.adsr-view/x1 LDZ2 #0048 ADD2 .adsr-view/y1 LDZ2
.Audio0/adsr INC DEI #0f AND
;draw-knob JSR2
( volume )
.adsr-view/x2 LDZ2 #0028 SUB2 .adsr-view/y1 LDZ2
.Audio0/volume DEI #04 SFT
;draw-knob JSR2
.adsr-view/x2 LDZ2 #0010 SUB2 .adsr-view/y1 LDZ2
.Audio0/volume DEI #0f AND
;draw-knob JSR2
JMP2r
@draw-wave ( -- )
#01 ;draw-wave-length JSR2
.wave-view/x1 LDZ2 .Screen/x DEO2
( waveform )
#ff #00
&loop
( dotted line )
DUP #01 AND ,&no-dot JCN
.wave-view/y1 LDZ2 #0010 ADD2 .Screen/y DEO2
#03 .Screen/pixel DEO
&no-dot
#00 OVR .Audio0/addr DEI2 ADD2 LDA
#01 SFT
#00 SWP #02 SFT2 .wave-view/y1 LDZ2 ADD2 .Screen/y DEO2
.Screen/x DEI2 INC2 .Screen/x DEO2
( draw ) DUP
.Audio0/length DEI2 NIP GTH
.Audio0/length DEI2 #0100 NEQ2 AND DUP ADD INC .Screen/pixel DEO
INC GTHk ,&loop JCN
POP2
( range )
#01 .Screen/auto DEO
.wave-view/x1 LDZ2 .Screen/x DEO2
.wave-view/y1 LDZ2 #0010 SUB2 .Screen/y DEO2
.Audio0/addr DEI2 ;draw-short JSR2
.wave-view/x2 LDZ2 #0020 SUB2 .Screen/x DEO2
.Audio0/length DEI2 ;draw-short JSR2
#00 .Screen/auto DEO
JMP2r
@draw-wave-length ( color -- )
( clear background )
#f2 .Screen/auto DEO
.wave-view/x1 LDZ2 DUP2 .Screen/x DEO2
.wave-view/y1 LDZ2 DUP2 .Screen/y DEO2
,&wipe JSR
.Screen/y DEO2
#0080 ADD2 .Screen/x DEO2
,&wipe JSR
#00 .Screen/auto DEO
STH
.wave-view/x1 LDZ2 .Audio0/length DEI2 ADD2 .Screen/x DEO2
.wave-view/y1 LDZ2 DUP2 #0020 ADD2 SWP2
&loop
DUP2 .Screen/y DEO2
( draw ) STHkr .Screen/pixel DEO
INC2 GTH2k ,&loop JCN
POP2 POP2
POPr
JMP2r
&wipe #00 .Screen/sprite DEOk DEOk DEOk DEO JMP2r
@draw-knob ( x* y* value -- )
STH
OVR2 OVR2 .Screen/y DEO2 .Screen/x DEO2
( circle )
;knob-icns .Screen/addr DEO2
#16 .Screen/auto DEO
#01 .Screen/sprite DEOk DEO
#00 .Screen/auto DEO
( value )
#0010 ADD2 .Screen/y DEO2
#0004 ADD2 .Screen/x DEO2
;font-hex #00 STHkr #30 SFT ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO
( marker )
.Screen/x DEI2 #0004 SUB2 #00 #00 STHkr ;knob-offsetx ADD2 LDA ADD2 .Screen/x DEO2
.Screen/y DEI2 #0010 SUB2 #00 #00 STHr ;knob-offsety ADD2 LDA ADD2 .Screen/y DEO2
;knob-icns #0020 ADD2 .Screen/addr DEO2
#05 .Screen/sprite DEO
JMP2r
@draw-short ( short* -- )
SWP ,draw-byte JSR
@draw-byte ( byte -- )
DUP #04 SFT ,draw-hex JSR #0f AND
@draw-hex ( char -- )
#00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
#02 .Screen/sprite DEO
JMP2r
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
JMP2r
&skip
POP2 POP2 POPr
#00
JMP2r
@cursor
80c0 e0f0 f8e0 1000
@arrow-icns
0010 387c fe10 1000
&down
0010 1010 fe7c 3810
@notes
30 32 34 35
37 39 3b 3c
@keys-left-icns
7c7c 7c7c 7c7c 7c7c
7c7c 7c7c 7c7c 7e7f
7f7f 7f7f 7f7f 3e00
@keys-middle-icns
1c1c 1c1c 1c1c 1c1c
1c1c 1c1c 1c1c 3e7f
7f7f 7f7f 7f7f 3e00
@keys-right-icns
1f1f 1f1f 1f1f 1f1f
1f1f 1f1f 1f1f 3f7f
7f7f 7f7f 7f7f 3e00
@knob-icns
0003 0c10 2020 4040
00c0 3008 0404 0202
4040 2020 100c 0300
0202 0404 0830 c000
0000 183c 3c18 0000
@knob-offsetx
01 00 00 00 00 01 02 03
05 06 07 08 08 08 08 07
@knob-offsety
07 06 05 03 02 01 00 00
00 00 01 02 03 05 06 07
@font-hex ( 0-F )
007c 8282 8282 827c 0030 1010 1010 1010
007c 8202 7c80 80fe 007c 8202 1c02 827c
000c 1424 4484 fe04 00fe 8080 7c02 827c
007c 8280 fc82 827c 007c 8202 1e02 0202
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
@sin-pcm
8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad
b0b3 b6b9 bbbe c1c3 c6c9 cbce d0d2 d5d7
d9db dee0 e2e4 e6e7 e9eb ecee f0f1 f2f4
f5f6 f7f8 f9fa fbfb fcfd fdfe fefe fefe
fffe fefe fefe fdfd fcfb fbfa f9f8 f7f6
f5f4 f2f1 f0ee eceb e9e7 e6e4 e2e0 dedb
d9d7 d5d2 d0ce cbc9 c6c3 c1be bbb9 b6b3
b0ad aaa7 a4a1 9e9b 9895 928f 8c89 8683
807d 7a77 7471 6e6b 6865 625f 5c59 5653
504d 4a47 4542 3f3d 3a37 3532 302e 2b29
2725 2220 1e1c 1a19 1715 1412 100f 0e0c
0b0a 0908 0706 0505 0403 0302 0202 0202
0102 0202 0202 0303 0405 0506 0708 090a
0b0c 0e0f 1012 1415 1719 1a1c 1e20 2225
2729 2b2e 3032 3537 3a3d 3f42 4547 4a4d
5053 5659 5c5f 6265 686b 6e71 7477 7a7d

65
projects/utils/hexdump.tal Normal file
View File

@ -0,0 +1,65 @@
( usage: uxncli hexdump.rom file.bin )
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|0000
@src $40
|0100 ( -> )
;on-console .Console/vector DEO2
BRK
@on-console ( -> )
;src STH2
( read input )
.Console/read DEI
DUP #20 LTH OVR #7f GTH ORA ,&end JCN
STH2kr ,slen JSR #003f GTH2 ,&end JCN
STH2kr ,scap JSR STA POP2r BRK
&end
POP
STH2r .File/name DEO2
#0002 .File/length DEO2
LIT2r 0000
&stream
#0000 ,&buf STR2
;&buf .File/read DEO2
.File/success DEI2 #0000 EQU2 ,&eof JCN
;&buf LDA2 ,print JSR #2018 DEO
INC2r
( linebreak )
STH2kr #000f AND2 ORA ,&no-lb JCN
#0a18 DEO &no-lb
,&stream JMP &eof
POP2r
#010f DEO
BRK
&buf $2
@slen ( str* -- len* )
DUP2 ,scap JSR SWP2 SUB2
JMP2r
@scap ( str* -- end* )
LDAk #00 NEQ JMP JMP2r
&while
INC2 LDAk ,&while JCN
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

240
projects/utils/metadata.tal Normal file
View File

@ -0,0 +1,240 @@
( A little program to see a rom's metadata )
|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
|b0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|0000
@src $40
|0100 ( -> )
#630f .System/r DEO2
#840f .System/g DEO2
#c60f .System/b DEO2
#0150 .Screen/width DEO2
#0050 .Screen/height DEO2
;await-src .Console/vector DEO2
;dict/input ;pstr JSR2
BRK
(
@|vectors )
@await-src ( -> )
.Console/read DEI .src ;skey JSR2
,on-ready JCN
BRK
@on-ready ( -> )
;src
DUP2 ;pstr JSR2 #0a18 DEO
;has-metadata JSR2
,&on-metadata JCN
#004c .Screen/x DEO2
#0024 .Screen/y DEO2
;dict/empty ;draw-txt JSR2 POP2
BRK
&on-metadata ( -> )
;load-metadata JSR2
;metadata/body ;pstr JSR2 #0a18 DEO
;draw-metadata JSR2
BRK
(
@|core )
@has-metadata ( src* -- bool )
.File/name DEO2
#0006 .File/length DEO2
;metadata/header .File/read DEO2
;metadata/deo LDA2 #0637 EQU2
JMP2r
@load-metadata ( -- )
;metadata/start LDA2 #0100 SUB2 ;seek JSR2
( version )
#0001 .File/length DEO2
;metadata/version .File/read DEO2
( body )
;metadata/body STH2
&s
STH2kr
DUP2 .File/read DEO2
INC2r LDA ,&s JCN
POP2r
( fields )
;metadata/fields
DUP2 .File/read DEO2
LDAk #03 MUL #00 SWP .File/length DEO2
INC2 .File/read DEO2
JMP2r
(
@|drawing )
@draw-metadata ( -- )
#004c .Screen/x DEO2
#0018 .Screen/y DEO2
;metadata/body ;draw-txt JSR2 POP2
( find picture )
;metadata/fields LDAk LITr 00 STH
INC2 DUP2 STH2r ADD2 SWP2
&l
LDAk #83 NEQ ,&no-pict JCN
INC2k LDA2 #0100 SUB2 ;draw-icon JSR2
&no-pict
INC2 GTH2k ,&l JCN
POP2 POP2
JMP2r
@draw-icon ( location* -- )
;seek JSR2
#0090 .File/length DEO2
;metadata/icon
DUP2 .File/read DEO2
.Screen/addr DEO2
#26 .Screen/auto DEO
#001c
DUP2 .Screen/x DEO2
.Screen/y DEO2
#81 .Screen/sprite DEOk DEOk DEO
JMP2r
@draw-txt ( txt* -- end* )
#01 .Screen/auto DEO
.Screen/x DEI2 ,&anchor STR2
&w
LDAk #20 SUB #00 SWP #30 SFT2 ;font ADD2 .Screen/addr DEO2
#03 .Screen/sprite DEO
LDAk #0a NEQ ,&no-lb JCN
[ LIT2 &anchor $2 ] ,draw-lb JSR
&no-lb
INC2 LDAk ,&w JCN
JMP2r
@draw-lb ( anchor* -- )
.Screen/x DEO2
.Screen/y DEI2k #0008 ADD2 ROT DEO2
JMP2r
(
@|stdlib )
@phex ( 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
@seek ( length* -- )
.File/name DEI2k ROT DEO2
#0000 INC2k .File/length DEO2
&l
;&b .File/read DEO2
INC2 GTH2k ,&l JCN
POP2 POP2
JMP2r
&b $1
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
@sput ( chr str* -- ) ,scap JSR STA JMP2r
@skey ( key buf -- proc ) OVR #21 LTH ,&eval JCN #00 SWP ;sput JSR2 #00 JMP2r &eval POP2 #01 JMP2r
@pstr ( str* -- ) &w LDAk #18 DEO INC2 LDAk ,&w JCN POP2 JMP2r
(
@|assets )
@dict
&input "Input(.tal): 20 $1
&empty "Metadata 20 "Missing $1
@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
1c30 3030 3030 1c00 380c 0c0c 0c0c 3800
0066 3cff 3c66 0000 0018 187e 1818 0000
0000 0000 0030 3060 0000 007e 0000 0000
0000 0000 0018 1800 0306 0c18 3060 c000
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
0018 1800 0018 1800 0018 1800 1818 3000
0c18 3060 3018 0c00 0000 7e00 007e 0000
3018 0c06 0c18 3000 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 3c18 1818 1818 3c00
3e06 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 3c30 3030 3030 3c00
c060 3018 0c06 0300 3c0c 0c0c 0c0c 3c00
1038 6cc6 0000 0000 0000 0000 0000 fe00
0060 3018 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
1818 1818 1818 1818 380c 0c06 0c0c 3800
0000 60f2 9e0c 0000 3c42 9985 8599 423c
@metadata
&header $1 &start $3 &deo $2 &version $1
&body $100
&fields $100
&icon $90

103
projects/utils/proquints.tal Normal file
View File

@ -0,0 +1,103 @@
(
converts a binary file to a proquints, identifiers that are readable, and pronounceable.
usage: uxncli proquints.rom file.bin )
( devices )
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
( variables )
|0000
@length $2
@src $30
|0100 ( -> )
;on-console .Console/vector DEO2
BRK
@on-console ( -> )
( starting )
[ LIT &trap $1 ] ,&started JCN
;src #0020 ;mclr JSR2
#01 ,&trap STR
&started
( append )
.Console/read DEI #20 LTH ,&validate JCN
;src ;slen JSR2 #0030 EQU2 ,&validate JCN
;src .Console/read DEI ;sput JSR2 BRK
&validate
( load )
;src .File/name DEO2
#fff0 ;data SUB2 .File/length DEO2
;data .File/read DEO2
( save length )
.File/success DEI2 .length STZ2
,parse JSR
#00 ,&trap STR
BRK
@parse ( -- )
.length LDZ2 ;data ADD2 ;data
&loop
LDA2k ,proquint JSR
INC2 INC2 GTH2k ,&loop JCN
POP2 POP2
#010f DEO
JMP2r
@proquint ( short* -- )
( c1 ) DUP2 #0c ,&emit-con JSR
( v1 ) DUP2 #0a ,&emit-vow JSR
( c2 ) DUP2 #06 ,&emit-con JSR
( v2 ) DUP2 #03 ,&emit-vow JSR
( c3 ) #00 ,&emit-con JSR
#2018 DEO
JMP2r
&emit-con SFT2 #000f AND2 ;&con ADD2 LDA #18 DEO JMP2r
&con "bdfghjklmnprstvz
&emit-vow SFT2 #0003 AND2 ;&vow ADD2 LDA #18 DEO JMP2r
&vow "aiou
@slen ( str* -- len* )
DUP2 ,scap JSR SWP2 SUB2
JMP2r
@scap ( str* -- end* )
LDAk #00 NEQ JMP JMP2r
&while
INC2 LDAk ,&while JCN
JMP2r
@sput ( str* char -- )
ROT ROT ,scap JSR STA
JMP2r
@mclr ( addr* len* -- )
OVR2 ADD2 SWP2
&loop
STH2k #00 STH2r STA
INC2 GTH2k ,&loop JCN
POP2 POP2
JMP2r
@data

464
projects/utils/tests.tal Normal file
View File

@ -0,0 +1,464 @@
( Opcode Tester )
( Requirements:
EQU/EQU2 should put #00 or #01 on the stack
#18 DEO should output ascii character to console )
%EMIT { #18 DEO }
%TEST-SHORT { EQU2 #30 ADD EMIT }
%TEST-BYTE { EQU #30 ADD EMIT }
%MODE { #20 EMIT }
%OPCODE { #0a EMIT }
%TYPE { OPCODE OPCODE }
|0000
@zeropage
&byte $1 &short $2
|0100
( Logic )
( EQU )
#f8 #f8 EQU [ #01 ] TEST-BYTE
#01 #01 EQU [ #01 ] TEST-BYTE
#f8 #01 EQU [ #00 ] TEST-BYTE
#01 #f8 EQU [ #00 ] TEST-BYTE
MODE
#f801 #f801 EQU2 [ #01 ] TEST-BYTE
#01f8 #01f8 EQU2 [ #01 ] TEST-BYTE
#f801 #01f8 EQU2 [ #00 ] TEST-BYTE
#01f8 #f801 EQU2 [ #00 ] TEST-BYTE
MODE
#f8 #f8 EQUk ADD ADD [ #f1 ] TEST-BYTE
#01 #01 EQUk ADD ADD [ #03 ] TEST-BYTE
#f8 #01 EQUk ADD ADD [ #f9 ] TEST-BYTE
#01 #f8 EQUk ADD ADD [ #f9 ] TEST-BYTE
MODE
#f801 #f801 EQU2k #00 ADD2 ADD2 [ #f102 ] TEST-SHORT
#01f8 #01f8 EQU2k #00 ADD2 ADD2 [ #04f0 ] TEST-SHORT
#f801 #01f8 EQU2k #00 ADD2 ADD2 [ #f9f9 ] TEST-SHORT
#01f8 #f801 EQU2k #00 ADD2 ADD2 [ #f9f9 ] TEST-SHORT
OPCODE
( NEQ )
#f8 #f8 NEQ [ #00 ] TEST-BYTE
#01 #01 NEQ [ #00 ] TEST-BYTE
#f8 #01 NEQ [ #01 ] TEST-BYTE
#01 #f8 NEQ [ #01 ] TEST-BYTE
MODE
#f801 #f801 NEQ2 [ #00 ] TEST-BYTE
#01f8 #01f8 NEQ2 [ #00 ] TEST-BYTE
#f801 #01f8 NEQ2 [ #01 ] TEST-BYTE
#01f8 #f801 NEQ2 [ #01 ] TEST-BYTE
MODE
#f8 #f8 NEQk ADD ADD [ #f0 ] TEST-BYTE
#01 #01 NEQk ADD ADD [ #02 ] TEST-BYTE
#f8 #01 NEQk ADD ADD [ #fa ] TEST-BYTE
#01 #f8 NEQk ADD ADD [ #fa ] TEST-BYTE
MODE
#f801 #f801 NEQ2k #00 ADD2 ADD2 [ #f002 ] TEST-SHORT
#01f8 #01f8 NEQ2k #00 ADD2 ADD2 [ #03f0 ] TEST-SHORT
#f801 #01f8 NEQ2k #00 ADD2 ADD2 [ #faf9 ] TEST-SHORT
#01f8 #f801 NEQ2k #00 ADD2 ADD2 [ #faf9 ] TEST-SHORT
OPCODE
( GTH )
#f8 #f8 GTH [ #00 ] TEST-BYTE
#01 #01 GTH [ #00 ] TEST-BYTE
#f8 #01 GTH [ #01 ] TEST-BYTE
#01 #f8 GTH [ #00 ] TEST-BYTE
MODE
#f801 #f801 GTH2 [ #00 ] TEST-BYTE
#01f8 #01f8 GTH2 [ #00 ] TEST-BYTE
#f801 #01f8 GTH2 [ #01 ] TEST-BYTE
#01f8 #f801 GTH2 [ #00 ] TEST-BYTE
MODE
#f8 #f8 GTHk ADD ADD [ #f0 ] TEST-BYTE
#01 #01 GTHk ADD ADD [ #02 ] TEST-BYTE
#f8 #01 GTHk ADD ADD [ #fa ] TEST-BYTE
#01 #f8 GTHk ADD ADD [ #f9 ] TEST-BYTE
MODE
#f801 #f801 GTH2k #00 ADD2 ADD2 [ #f002 ] TEST-SHORT
#01f8 #01f8 GTH2k #00 ADD2 ADD2 [ #03f0 ] TEST-SHORT
#f801 #01f8 GTH2k #00 ADD2 ADD2 [ #faf9 ] TEST-SHORT
#01f8 #f801 GTH2k #00 ADD2 ADD2 [ #f9f9 ] TEST-SHORT
OPCODE
( LTH )
#f8 #f8 LTH [ #00 ] TEST-BYTE
#01 #01 LTH [ #00 ] TEST-BYTE
#f8 #01 LTH [ #00 ] TEST-BYTE
#01 #f8 LTH [ #01 ] TEST-BYTE
MODE
#f801 #f801 LTH2 [ #00 ] TEST-BYTE
#01f8 #01f8 LTH2 [ #00 ] TEST-BYTE
#f801 #01f8 LTH2 [ #00 ] TEST-BYTE
#01f8 #f801 LTH2 [ #01 ] TEST-BYTE
MODE
#f8 #f8 LTHk ADD ADD [ #f0 ] TEST-BYTE
#01 #01 LTHk ADD ADD [ #02 ] TEST-BYTE
#f8 #01 LTHk ADD ADD [ #f9 ] TEST-BYTE
#01 #f8 LTHk ADD ADD [ #fa ] TEST-BYTE
MODE
#f801 #f801 LTH2k #00 ADD2 ADD2 [ #f002 ] TEST-SHORT
#01f8 #01f8 LTH2k #00 ADD2 ADD2 [ #03f0 ] TEST-SHORT
#f801 #01f8 LTH2k #00 ADD2 ADD2 [ #f9f9 ] TEST-SHORT
#01f8 #f801 LTH2k #00 ADD2 ADD2 [ #faf9 ] TEST-SHORT
TYPE
( Arithmetic )
( ADD )
#ff #00 ADD [ #ff ] TEST-BYTE
#01 #ff ADD [ #00 ] TEST-BYTE
#ff #ff ADD [ #fe ] TEST-BYTE
#fe #ff ADD [ #fd ] TEST-BYTE
MODE
#ffff #0000 ADD2 [ #ffff ] TEST-SHORT
#0001 #ffff ADD2 [ #0000 ] TEST-SHORT
#ffff #ffff ADD2 [ #fffe ] TEST-SHORT
#fffe #ffff ADD2 [ #fffd ] TEST-SHORT
MODE
#ff #00 ADDk ADD ADD [ #fe ] TEST-BYTE
#01 #ff ADDk ADD ADD [ #00 ] TEST-BYTE
#ff #ff ADDk ADD ADD [ #fc ] TEST-BYTE
#fe #ff ADDk ADD ADD [ #fa ] TEST-BYTE
MODE
#ffff #0000 ADD2k ADD2 ADD2 [ #fffe ] TEST-SHORT
#0001 #ffff ADD2k ADD2 ADD2 [ #0000 ] TEST-SHORT
#ffff #ffff ADD2k ADD2 ADD2 [ #fffc ] TEST-SHORT
#fffe #ffff ADD2k ADD2 ADD2 [ #fffa ] TEST-SHORT
OPCODE
( SUB )
#ff #00 SUB [ #ff ] TEST-BYTE
#01 #ff SUB [ #02 ] TEST-BYTE
#ff #ff SUB [ #00 ] TEST-BYTE
#fe #ff SUB [ #ff ] TEST-BYTE
MODE
#ffff #0000 SUB2 [ #ffff ] TEST-SHORT
#0001 #ffff SUB2 [ #0002 ] TEST-SHORT
#ffff #ffff SUB2 [ #0000 ] TEST-SHORT
#fffe #ffff SUB2 [ #ffff ] TEST-SHORT
MODE
#ff #00 SUBk ADD ADD [ #fe ] TEST-BYTE
#01 #ff SUBk ADD ADD [ #02 ] TEST-BYTE
#ff #ff SUBk ADD ADD [ #fe ] TEST-BYTE
#fe #ff SUBk ADD ADD [ #fc ] TEST-BYTE
MODE
#ffff #0000 SUB2k ADD2 ADD2 [ #fffe ] TEST-SHORT
#0001 #ffff SUB2k ADD2 ADD2 [ #0002 ] TEST-SHORT
#ffff #ffff SUB2k ADD2 ADD2 [ #fffe ] TEST-SHORT
#fffe #ffff SUB2k ADD2 ADD2 [ #fffc ] TEST-SHORT
OPCODE
( MUL )
#00 #01 MUL [ #00 ] TEST-BYTE
#3f #e7 MUL [ #d9 ] TEST-BYTE
#37 #3f MUL [ #89 ] TEST-BYTE
#10 #02 MUL [ #20 ] TEST-BYTE
MODE
#1000 #0003 MUL2 [ #3000 ] TEST-SHORT
#abcd #1234 MUL2 [ #4fa4 ] TEST-SHORT
#8000 #0200 MUL2 [ #0000 ] TEST-SHORT
#2222 #0003 MUL2 [ #6666 ] TEST-SHORT
MODE
#00 #01 MULk ADD ADD [ #01 ] TEST-BYTE
#3f #e7 MULk ADD ADD [ #ff ] TEST-BYTE
#37 #3f MULk ADD ADD [ #ff ] TEST-BYTE
#10 #02 MULk ADD ADD [ #32 ] TEST-BYTE
MODE
#1000 #0003 MUL2k ADD2 ADD2 [ #4003 ] TEST-SHORT
#abcd #1234 MUL2k ADD2 ADD2 [ #0da5 ] TEST-SHORT
#8000 #0200 MUL2k ADD2 ADD2 [ #8200 ] TEST-SHORT
#2222 #0003 MUL2k ADD2 ADD2 [ #888b ] TEST-SHORT
OPCODE
( DIV )
#10 #02 DIV [ #08 ] TEST-BYTE
#20 #20 DIV [ #01 ] TEST-BYTE
#34 #01 DIV [ #34 ] TEST-BYTE
#02 #ef DIV [ #00 ] TEST-BYTE
MODE
#1000 #0040 DIV2 [ #0040 ] TEST-SHORT
#abcd #1234 DIV2 [ #0009 ] TEST-SHORT
#8000 #0200 DIV2 [ #0040 ] TEST-SHORT
#2222 #0003 DIV2 [ #0b60 ] TEST-SHORT
MODE
#10 #02 DIVk ADD ADD [ #1a ] TEST-BYTE
#20 #20 DIVk ADD ADD [ #41 ] TEST-BYTE
#34 #01 DIVk ADD ADD [ #69 ] TEST-BYTE
#02 #ef DIVk ADD ADD [ #f1 ] TEST-BYTE
MODE
#1000 #0040 DIV2k ADD2 ADD2 [ #1080 ] TEST-SHORT
#abcd #1234 DIV2k ADD2 ADD2 [ #be0a ] TEST-SHORT
#8000 #0200 DIV2k ADD2 ADD2 [ #8240 ] TEST-SHORT
#2222 #0003 DIV2k ADD2 ADD2 [ #2d85 ] TEST-SHORT
TYPE
( Stack )
( INC )
#01 INC [ #02 ] TEST-BYTE
#ff INC [ #00 ] TEST-BYTE
#fe INC [ #ff ] TEST-BYTE
#00 INC [ #01 ] TEST-BYTE
MODE
#0001 INC2 [ #0002 ] TEST-SHORT
#ffff INC2 [ #0000 ] TEST-SHORT
#fffe INC2 [ #ffff ] TEST-SHORT
#0000 INC2 [ #0001 ] TEST-SHORT
MODE
#01 INCk ADD [ #03 ] TEST-BYTE
#ff INCk ADD [ #ff ] TEST-BYTE
#fe INCk ADD [ #fd ] TEST-BYTE
#00 INCk ADD [ #01 ] TEST-BYTE
MODE
#0001 INC2k ADD2 [ #0003 ] TEST-SHORT
#ffff INC2k ADD2 [ #ffff ] TEST-SHORT
#fffe INC2k ADD2 [ #fffd ] TEST-SHORT
#0000 INC2k ADD2 [ #0001 ] TEST-SHORT
OPCODE
( POP )
#0a #0b POP [ #0a ] TEST-BYTE
#0a #0b #0c POP POP [ #0a ] TEST-BYTE
#0a #0b #0c ADD POP [ #0a ] TEST-BYTE
#0a #0b #0c POP ADD [ #15 ] TEST-BYTE
MODE
#0a0b #0c0d POP2 [ #0a0b ] TEST-SHORT
#0a0b #0c0d #0e0f POP2 POP2 [ #0a0b ] TEST-SHORT
#0a0b #0c0d #0e0f ADD2 POP2 [ #0a0b ] TEST-SHORT
#0a0b #0c0d #0e0f POP2 ADD2 [ #1618 ] TEST-SHORT
MODE
#0a #0b POPk [ #0b ] TEST-BYTE POP
#0a #0b #0c POPk POP [ #0b ] TEST-BYTE POP
#0a #0b #0c ADD POPk [ #17 ] TEST-BYTE POP
#0a #0b #0c POPk ADD [ #17 ] TEST-BYTE POP
MODE
#0a0b #0c0d POP2k [ #0c0d ] TEST-SHORT POP2
#0a0b #0c0d #0e0f POP2k POP2 [ #0c0d ] TEST-SHORT POP2
#0a0b #0c0d #0e0f ADD2 POP2k [ #1a1c ] TEST-SHORT POP2
#0a0b #0c0d #0e0f POP2k ADD2 [ #1a1c ] TEST-SHORT POP2
OPCODE
( DUP )
#0a #0b DUP ADD ADD [ #20 ] TEST-BYTE
MODE
#0a0b DUP2 ADD2 [ #1416 ] TEST-SHORT
MODE
#0a #0b DUPk ADD ADD ADD [ #2b ] TEST-BYTE
MODE
#0a0b DUP2k ADD2 ADD2 [ #1e21 ] TEST-SHORT
OPCODE
( NIP )
#12 #34 #56 NIP ADD [ #68 ] TEST-BYTE
MODE
#1234 #5678 #9abc NIP2 ADD2 [ #acf0 ] TEST-SHORT
MODE
#12 #34 #56 NIPk ADD ADD [ #e0 ] TEST-BYTE POP
MODE
#1234 #5678 #9abc NIP2k ADD2 ADD2 [ #8bf0 ] TEST-SHORT POP2
OPCODE
( SWP )
#02 #10 SWP DIV [ #08 ] TEST-BYTE
MODE
#0a0b #0c0d SWP2 NIP2 [ #0a0b ] TEST-SHORT
MODE
#02 #10 SWPk DIV ADD ADD [ #1a ] TEST-BYTE
MODE
#0a0b #0c0d SWP2k POP2 POP2 POP2 [ #0a0b ] TEST-SHORT
OPCODE
( OVR )
#02 #10 OVR DIV ADD [ #0a ] TEST-BYTE
MODE
#0a0b #0c0d OVR2 NIP2 ADD2 [ #1416 ] TEST-SHORT
MODE
#02 #10 OVRk DIV ADD ADD ADD [ #1c ] TEST-BYTE
MODE
#0a0b #0c0d OVR2k NIP2 ADD2 ADD2 ADD2 [ #2a2e ] TEST-SHORT
OPCODE
( ROT )
#02 #04 #10 ROT DIV ADD [ #0c ] TEST-BYTE
MODE
#0a0b #0c0d #0c0f ROT2 ADD2 NIP2 [ #161a ] TEST-SHORT
MODE
#02 #04 #10 ROTk DIV ADD ADD ADD ADD [ #22 ] TEST-BYTE
MODE
#0a0b #0c0d #0c0f ROT2k ADD2 NIP2 ADD2 ADD2 ADD2 [ #3841 ] TEST-SHORT
TYPE
( Bitwise )
( AND )
#fc #3f AND [ #3c ] TEST-BYTE
#f0 #0f AND [ #00 ] TEST-BYTE
#ff #3c AND [ #3c ] TEST-BYTE
#02 #03 AND [ #02 ] TEST-BYTE
MODE
#f0f0 #00f0 AND2 [ #00f0 ] TEST-SHORT
#aaaa #5555 AND2 [ #0000 ] TEST-SHORT
#ffff #1234 AND2 [ #1234 ] TEST-SHORT
#abcd #0a0c AND2 [ #0a0c ] TEST-SHORT
MODE
#fc #3f ANDk ADD ADD [ #77 ] TEST-BYTE
#f0 #0f ANDk ADD ADD [ #ff ] TEST-BYTE
#ff #3c ANDk ADD ADD [ #77 ] TEST-BYTE
#02 #03 ANDk ADD ADD [ #07 ] TEST-BYTE
MODE
#f0f0 #00f0 AND2k ADD2 ADD2 [ #f2d0 ] TEST-SHORT
#aaaa #5555 AND2k ADD2 ADD2 [ #ffff ] TEST-SHORT
#ffff #1234 AND2k ADD2 ADD2 [ #2467 ] TEST-SHORT
#abcd #0a0c AND2k ADD2 ADD2 [ #bfe5 ] TEST-SHORT
OPCODE
( ORA )
#0f #f0 ORA [ #ff ] TEST-BYTE
#ab #cd ORA [ #ef ] TEST-BYTE
#12 #34 ORA [ #36 ] TEST-BYTE
#88 #10 ORA [ #98 ] TEST-BYTE
MODE
#0f0f #f0f0 ORA2 [ #ffff ] TEST-SHORT
#abab #cdcd ORA2 [ #efef ] TEST-SHORT
#1122 #1234 ORA2 [ #1336 ] TEST-SHORT
#8888 #1000 ORA2 [ #9888 ] TEST-SHORT
MODE
#0f #f0 ORAk ADD ADD [ #fe ] TEST-BYTE
#ab #cd ORAk ADD ADD [ #67 ] TEST-BYTE
#12 #34 ORAk ADD ADD [ #7c ] TEST-BYTE
#88 #10 ORAk ADD ADD [ #30 ] TEST-BYTE
MODE
#0f0f #f0f0 ORA2k ADD2 ADD2 [ #fffe ] TEST-SHORT
#abab #cdcd ORA2k ADD2 ADD2 [ #6967 ] TEST-SHORT
#1122 #1234 ORA2k ADD2 ADD2 [ #368c ] TEST-SHORT
#8888 #1000 ORA2k ADD2 ADD2 [ #3110 ] TEST-SHORT
OPCODE
( EOR )
#00 #00 EOR [ #00 ] TEST-BYTE
#ff #00 EOR [ #ff ] TEST-BYTE
#aa #55 EOR [ #ff ] TEST-BYTE
#ff #ff EOR [ #00 ] TEST-BYTE
MODE
#ffff #ff00 EOR2 [ #00ff ] TEST-SHORT
#aaaa #5555 EOR2 [ #ffff ] TEST-SHORT
#1122 #1234 EOR2 [ #0316 ] TEST-SHORT
#8888 #1000 EOR2 [ #9888 ] TEST-SHORT
MODE
#00 #00 EORk ADD ADD [ #00 ] TEST-BYTE
#ff #00 EORk ADD ADD [ #fe ] TEST-BYTE
#aa #55 EORk ADD ADD [ #fe ] TEST-BYTE
#ff #ff EORk ADD ADD [ #fe ] TEST-BYTE
MODE
#ffff #ff00 EOR2k ADD2 ADD2 [ #fffe ] TEST-SHORT
#aaaa #5555 EOR2k ADD2 ADD2 [ #fffe ] TEST-SHORT
#1122 #1234 EOR2k ADD2 ADD2 [ #266c ] TEST-SHORT
#8888 #1000 EOR2k ADD2 ADD2 [ #3110 ] TEST-SHORT
OPCODE
( SFT )
#ff #08 SFT [ #00 ] TEST-BYTE
#ff #e0 SFT [ #00 ] TEST-BYTE
#ff #11 SFT [ #fe ] TEST-BYTE
#ff #12 SFT [ #7e ] TEST-BYTE
MODE
#ffff #01 SFT2 [ #7fff ] TEST-SHORT
#ffff #70 SFT2 [ #ff80 ] TEST-SHORT
#ffff #7e SFT2 [ #0180 ] TEST-SHORT
#ffff #e3 SFT2 [ #c000 ] TEST-SHORT
MODE
#ff #08 SFTk ADD ADD [ #07 ] TEST-BYTE
#ff #e0 SFTk ADD ADD [ #df ] TEST-BYTE
#ff #11 SFTk ADD ADD [ #0e ] TEST-BYTE
#ff #12 SFTk ADD ADD [ #8f ] TEST-BYTE
MODE
#ffff #01 SFT2k ROT POP ADD2 [ #7ffe ] TEST-SHORT
#ffff #70 SFT2k ROT POP ADD2 [ #ff7f ] TEST-SHORT
#ffff #7e SFT2k ROT POP ADD2 [ #017f ] TEST-SHORT
#ffff #e3 SFT2k ROT POP ADD2 [ #bfff ] TEST-SHORT
TYPE
( Memory )
( STZ/LDZ )
#ab .zeropage/byte STZ .zeropage/byte LDZ [ #ab ] TEST-BYTE
#cd .zeropage/byte STZ .zeropage/byte LDZ [ #cd ] TEST-BYTE
MODE
#1234 .zeropage/short STZ2 .zeropage/short LDZ2 [ #1234 ] TEST-SHORT
#5678 .zeropage/short STZ2 .zeropage/short LDZ2 [ #5678 ] TEST-SHORT
OPCODE
( STR/LDR )
[ LIT &before1 $1 ] POP
[ LIT2 &before2 $2 ] POP2
#22 ,&before1 STR ,&before1 LDR [ #22 ] TEST-BYTE
#ef ,&after1 STR ,&after1 LDR [ #ef ] TEST-BYTE
MODE
#1234 ,&before2 STR2 ,&before2 LDR2 [ #1234 ] TEST-SHORT
#5678 ,&after2 STR2 ,&after2 LDR2 [ #5678 ] TEST-SHORT
[ LIT &after1 $1 ] POP
[ LIT2 &after2 $2 ] POP2
OPCODE
( STA/LDA )
#34 ;absolute/byte STA ;absolute/byte LDA [ #34 ] TEST-BYTE
#56 ;absolute/byte STA ;absolute/byte LDA [ #56 ] TEST-BYTE
MODE
#1234 ;absolute/short STA2 ;absolute/short LDA2 [ #1234 ] TEST-SHORT
#5678 ;absolute/short STA2 ;absolute/short LDA2 [ #5678 ] TEST-SHORT
OPCODE
( DEI/DEO )
LIT "1 EMIT
LIT "1 EMIT
TYPE
( Branching )
( JMP )
#12 #34 ,&reljmp JMP SWP &reljmp POP [ #12 ] TEST-BYTE
MODE
#56 #78 ;&absjmp JMP2 SWP &absjmp POP [ #56 ] TEST-BYTE
OPCODE
( JCN )
#23 #01 ,&reljcn-y JCN INC &reljcn-y [ #23 ] TEST-BYTE
#23 #00 ,&reljcn-n JCN INC &reljcn-n [ #24 ] TEST-BYTE
MODE
#23 #01 ;&absjcn-y JCN2 INC &absjcn-y [ #23 ] TEST-BYTE
#23 #00 ;&absjcn-n JCN2 INC &absjcn-n [ #24 ] TEST-BYTE
OPCODE
( JSR - Requires return mode )
#12 #34 ;routine JSR2 [ #46 ] TEST-BYTE
OPCODE
( STH )
#0a STH #0b STH ADDr STHr [ #15 ] TEST-BYTE
MODE
#000a STH2 #000b STH2 ADD2r STH2r [ #0015 ] TEST-SHORT
TYPE
( Keep )
#12 #34 ADDk ADD ADD [ #8c ] TEST-BYTE
OPCODE
#010e DEO
#010f DEO
BRK
@routine ( a b -- c )
ADD
JMP2r
@absolute
&byte $1 &short $2

43
src/devices/audio.c
View File

@ -2,8 +2,7 @@
#include "audio.h"
/*
Copyright (c) 2021 Devine Lu Linvega
Copyright (c) 2021 Andrew Alderwick
Copyright (c) 2021-2023 Devine Lu Linvega, Andrew Alderwick
Permission to use, copy, modify, and distribute this software for any
purpose with or without fee is hereby granted, provided that the above
@ -16,6 +15,14 @@ WITH REGARD TO THIS SOFTWARE.
#define NOTE_PERIOD (SAMPLE_FREQUENCY * 0x4000 / 11025)
#define ADSR_STEP (SAMPLE_FREQUENCY / 0xf)
typedef struct {
Uint8 *addr;
Uint32 count, advance, period, age, a, d, s, r;
Uint16 i, len;
Sint8 volume[2];
Uint8 pitch, repeat;
} UxnAudio;
/* clang-format off */
static Uint32 advances[12] = {
@ -23,7 +30,7 @@ static Uint32 advances[12] = {
0xb504f, 0xbfc88, 0xcb2ff, 0xd7450, 0xe411f, 0xf1a1c
};
UxnAudio uxn_audio[POLYPHONY];
static UxnAudio uxn_audio[POLYPHONY];
/* clang-format on */
@ -40,8 +47,9 @@ envelope(UxnAudio *c, Uint32 age)
}
int
audio_render(UxnAudio *c, Sint16 *sample, Sint16 *end)
audio_render(int instance, Sint16 *sample, Sint16 *end)
{
UxnAudio *c = &uxn_audio[instance];
Sint32 s;
if(!c->advance || !c->period) return 0;
while(sample < end) {
@ -59,13 +67,26 @@ audio_render(UxnAudio *c, Sint16 *sample, Sint16 *end)
*sample++ += s * c->volume[0] / 0x180;
*sample++ += s * c->volume[1] / 0x180;
}
if(!c->advance) audio_finished_handler(c);
if(!c->advance) audio_finished_handler(instance);
return 1;
}
void
audio_start(UxnAudio *c, Uint16 adsr, Uint8 pitch)
audio_start(int instance, Uint8 *d, Uxn *u)
{
UxnAudio *c = &uxn_audio[instance];
Uint16 addr, adsr;
Uint8 pitch;
PEKDEV(adsr, 0x8);
PEKDEV(c->len, 0xa);
PEKDEV(addr, 0xc);
if(c->len > 0x10000 - addr)
c->len = 0x10000 - addr;
c->addr = &u->ram[addr];
c->volume[0] = d[0xe] >> 4;
c->volume[1] = d[0xe] & 0xf;
c->repeat = !(d[0xf] & 0x80);
pitch = d[0xf] & 0x7f;
if(pitch < 108 && c->len)
c->advance = advances[pitch % 12] >> (8 - pitch / 12);
else {
@ -85,8 +106,9 @@ audio_start(UxnAudio *c, Uint16 adsr, Uint8 pitch)
}
Uint8
audio_get_vu(UxnAudio *c)
audio_get_vu(int instance)
{
UxnAudio *c = &uxn_audio[instance];
int i;
Sint32 sum[2] = {0, 0};
if(!c->advance || !c->period) return 0;
@ -97,3 +119,10 @@ audio_get_vu(UxnAudio *c)
}
return (sum[0] << 4) | sum[1];
}
Uint16
audio_get_position(int instance)
{
UxnAudio *c = &uxn_audio[instance];
return c->i;
}

Some files were not shown because too many files have changed in this diff Show More