From 41bc45813196fdef715565b6b27bc899ccb20af1 Mon Sep 17 00:00:00 2001 From: able Date: Mon, 6 May 2024 07:02:04 -0500 Subject: [PATCH] Changes --- .gitignore | 1 + README.md | 6 +- build.sh | 0 shell.nix | 11 ++ snake.lisp | 410 +++++++++++++++++++++++++-------------------------- startup.lisp | 20 +-- system.s | 28 ++-- 7 files changed, 245 insertions(+), 231 deletions(-) create mode 100644 .gitignore mode change 100644 => 100755 build.sh create mode 100644 shell.nix diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..efa6632 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +bin/* \ No newline at end of file diff --git a/README.md b/README.md index e17ffdd..7c34d95 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,4 @@ -# flip -16-bit Lisp based OS +# glip +Glip is a modern variant of [flip](https://github.com/nakst/flip). + +A 16-bit Lisp based OS. diff --git a/build.sh b/build.sh old mode 100644 new mode 100755 diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..2f899bd --- /dev/null +++ b/shell.nix @@ -0,0 +1,11 @@ +{ pkgs ? import { } }: +pkgs.mkShell rec { + buildInputs = with pkgs; [ + gcc9 + nasm + clang + ]; + shellHook = '' + # export CC=clang + ''; +} diff --git a/snake.lisp b/snake.lisp index 72d3b18..699c117 100644 --- a/snake.lisp +++ b/snake.lisp @@ -1,230 +1,230 @@ -[let TILE 16] -[let GRID_X 20] -[let GRID_Y 12] +(let TILE 16) +(let GRID_X 20) +(let GRID_Y 12) -[let snake nil] -[let direction nil] -[let direction-id nil] -[let apple nil] -[let game-running nil] -[let score nil] +(let snake nil) +(let direction nil) +(let direction-id nil) +(let apple nil) +(let game-running nil) +(let score nil) -[let tile-head-left [q [1 1 1 3 3 3 1 1 1 2 3 4 5 4 3 3 1 3 4 6 5 5 5 5 1 3 4 4 5 5 5 5 1 3 4 4 5 5 5 5 1 3 4 6 5 5 5 5 1 2 3 4 5 4 3 3 1 1 1 3 3 3 1 1]]] -[let tile-head-right [q [1 1 3 3 3 1 1 1 3 3 4 5 4 3 2 1 5 5 5 5 6 4 3 1 5 5 5 5 4 4 3 1 5 5 5 5 4 4 3 1 5 5 5 5 6 4 3 1 3 3 4 5 4 3 2 1 1 1 3 3 3 1 1 1]]] -[let tile-head-down [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 3 4 5 5 5 5 4 3 3 5 5 5 5 5 5 3 3 4 6 4 4 6 4 3 1 3 4 4 4 4 3 1 1 2 3 3 3 3 2 1 1 1 1 1 1 1 1 1]]] -[let tile-head-up [q [1 1 1 1 1 1 1 1 1 2 3 3 3 3 2 1 1 3 4 4 4 4 3 1 3 4 6 4 4 6 4 3 3 5 5 5 5 5 5 3 3 4 5 5 5 5 4 3 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]] -[let tile-tail-left [q [1 1 1 1 1 1 1 1 3 3 2 1 1 2 2 1 5 5 4 3 1 1 2 1 5 5 5 5 4 3 1 1 5 5 5 5 4 3 1 1 5 5 4 3 1 1 2 1 3 3 2 1 1 2 2 1 1 1 1 1 1 1 1 1]]] -[let tile-tail-right [q [1 1 1 1 1 1 1 1 1 2 2 1 1 2 3 3 1 2 1 1 3 4 5 5 1 1 3 4 5 5 5 5 1 1 3 4 5 5 5 5 1 2 1 1 3 4 5 5 1 2 2 1 1 2 3 3 1 1 1 1 1 1 1 1]]] -[let tile-tail-down [q [1 1 1 1 1 1 1 1 1 2 2 1 1 2 2 1 1 2 1 3 3 1 2 1 1 1 1 4 4 1 1 1 1 1 3 5 5 3 1 1 1 2 4 5 5 4 2 1 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]] -[let tile-tail-up [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 1 2 4 5 5 4 2 1 1 1 3 5 5 3 1 1 1 1 1 4 4 1 1 1 1 2 1 3 3 1 2 1 1 2 2 1 1 2 2 1 1 1 1 1 1 1 1 1]]] -[let tile-body-h [q [1 1 1 1 1 1 1 1 3 3 3 1 1 3 3 3 5 5 4 3 3 4 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 4 3 3 4 5 5 3 3 3 1 1 3 3 3 1 1 1 1 1 1 1 1]]] -[let tile-body-v [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 1 3 4 5 5 4 3 1 1 1 3 5 5 3 1 1 1 1 3 5 5 3 1 1 1 3 4 5 5 4 3 1 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]] -[let tile-body-nw [q [1 3 5 5 5 5 3 1 3 4 5 5 5 5 3 1 5 5 5 5 5 5 3 1 5 5 5 5 5 4 3 1 5 5 5 5 4 3 1 1 5 5 5 4 3 1 2 1 3 3 3 3 1 2 2 1 1 1 1 1 1 1 1 1]]] -[let tile-body-ne [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 4 3 1 3 5 5 5 5 5 5 1 3 4 5 5 5 5 5 1 1 3 4 5 5 5 5 1 2 1 3 4 5 5 5 1 2 2 1 3 3 3 3 1 1 1 1 1 1 1 1]]] -[let tile-body-sw [q [1 1 1 1 1 1 1 1 3 3 3 3 1 2 2 1 5 5 5 4 3 1 2 1 5 5 5 5 4 3 1 1 5 5 5 5 5 4 3 1 5 5 5 5 5 5 3 1 3 4 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]] -[let tile-body-se [q [1 1 1 1 1 1 1 1 1 2 2 1 3 3 3 3 1 2 1 3 4 5 5 5 1 1 3 4 5 5 5 5 1 3 4 5 5 5 5 5 1 3 5 5 5 5 5 5 1 3 5 5 5 5 4 3 1 3 5 5 5 5 3 1]]] -[let tile-background [q [1 1 1 1 1 1 1 1 1 2 2 1 1 2 2 1 1 2 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 2 1 1 2 2 1 1 2 2 1 1 1 1 1 1 1 1 1]]] -[let tile-apple [q [1 1 1 9 1 1 1 1 1 2 2 1 9 2 2 1 1 7 7 7 9 8 8 1 7 7 9 7 7 8 8 8 7 9 9 7 7 8 8 8 7 7 7 7 7 8 8 8 1 7 7 7 7 8 8 1 1 1 7 7 8 8 1 1]]] -[let tile-digit-0 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 7 7 8 7 7 7 8 2 7 7 7 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2]]] -[let tile-digit-1 [q [2 2 2 7 7 2 2 2 2 2 7 7 7 8 2 2 2 2 7 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2]]] -[let tile-digit-2 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 8 2 7 7 8 2 7 7 8 2 2 8 2 2 7 7 8 2 2 7 7 7 7 8 2 2 7 7 8 8 8 2 2 2 7 7 8 2 7 7 2 2 7 7 7 7 7 7 8]]] -[let tile-digit-3 [q [2 2 7 7 7 7 2 2 2 2 2 8 8 7 7 2 2 2 2 2 2 7 7 8 2 2 2 7 7 7 7 8 2 2 2 2 8 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 7 7 7 7 8 2]]] -[let tile-digit-4 [q [2 2 7 2 2 7 7 2 2 2 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 7 7 7 7 8 2 2 8 8 8 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8]]] -[let tile-digit-5 [q [2 2 7 7 7 7 7 2 2 2 7 7 8 8 8 2 2 2 7 7 2 2 2 2 2 2 7 7 7 7 2 2 2 2 2 8 8 7 7 2 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 7 7 7 7 8 2]]] -[let tile-digit-6 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 2 2 7 7 8 2 7 7 2 2 2 8 8 2 7 7 7 7 7 7 2 2 7 7 8 8 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2]]] -[let tile-digit-7 [q [2 7 7 7 7 7 7 2 2 7 7 8 8 7 7 8 2 2 8 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2]]] -[let tile-digit-8 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2]]] -[let tile-digit-9 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 2 7 7 7 7 7 8 2 2 2 8 8 7 7 8 2 2 2 2 2 7 7 8 2 7 7 2 2 7 7 8 2 2 7 7 7 7 8 2]]] +(let tile-head-left (q (1 1 1 3 3 3 1 1 1 2 3 4 5 4 3 3 1 3 4 6 5 5 5 5 1 3 4 4 5 5 5 5 1 3 4 4 5 5 5 5 1 3 4 6 5 5 5 5 1 2 3 4 5 4 3 3 1 1 1 3 3 3 1 1))) +(let tile-head-right (q (1 1 3 3 3 1 1 1 3 3 4 5 4 3 2 1 5 5 5 5 6 4 3 1 5 5 5 5 4 4 3 1 5 5 5 5 4 4 3 1 5 5 5 5 6 4 3 1 3 3 4 5 4 3 2 1 1 1 3 3 3 1 1 1))) +(let tile-head-down (q (1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 3 4 5 5 5 5 4 3 3 5 5 5 5 5 5 3 3 4 6 4 4 6 4 3 1 3 4 4 4 4 3 1 1 2 3 3 3 3 2 1 1 1 1 1 1 1 1 1))) +(let tile-head-up (q (1 1 1 1 1 1 1 1 1 2 3 3 3 3 2 1 1 3 4 4 4 4 3 1 3 4 6 4 4 6 4 3 3 5 5 5 5 5 5 3 3 4 5 5 5 5 4 3 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1))) +(let tile-tail-left (q (1 1 1 1 1 1 1 1 3 3 2 1 1 2 2 1 5 5 4 3 1 1 2 1 5 5 5 5 4 3 1 1 5 5 5 5 4 3 1 1 5 5 4 3 1 1 2 1 3 3 2 1 1 2 2 1 1 1 1 1 1 1 1 1))) +(let tile-tail-right (q (1 1 1 1 1 1 1 1 1 2 2 1 1 2 3 3 1 2 1 1 3 4 5 5 1 1 3 4 5 5 5 5 1 1 3 4 5 5 5 5 1 2 1 1 3 4 5 5 1 2 2 1 1 2 3 3 1 1 1 1 1 1 1 1))) +(let tile-tail-down (q (1 1 1 1 1 1 1 1 1 2 2 1 1 2 2 1 1 2 1 3 3 1 2 1 1 1 1 4 4 1 1 1 1 1 3 5 5 3 1 1 1 2 4 5 5 4 2 1 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1))) +(let tile-tail-up (q (1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 1 2 4 5 5 4 2 1 1 1 3 5 5 3 1 1 1 1 1 4 4 1 1 1 1 2 1 3 3 1 2 1 1 2 2 1 1 2 2 1 1 1 1 1 1 1 1 1))) +(let tile-body-h (q (1 1 1 1 1 1 1 1 3 3 3 1 1 3 3 3 5 5 4 3 3 4 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 4 3 3 4 5 5 3 3 3 1 1 3 3 3 1 1 1 1 1 1 1 1))) +(let tile-body-v (q (1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 1 3 4 5 5 4 3 1 1 1 3 5 5 3 1 1 1 1 3 5 5 3 1 1 1 3 4 5 5 4 3 1 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1))) +(let tile-body-nw (q (1 3 5 5 5 5 3 1 3 4 5 5 5 5 3 1 5 5 5 5 5 5 3 1 5 5 5 5 5 4 3 1 5 5 5 5 4 3 1 1 5 5 5 4 3 1 2 1 3 3 3 3 1 2 2 1 1 1 1 1 1 1 1 1))) +(let tile-body-ne (q (1 3 5 5 5 5 3 1 1 3 5 5 5 5 4 3 1 3 5 5 5 5 5 5 1 3 4 5 5 5 5 5 1 1 3 4 5 5 5 5 1 2 1 3 4 5 5 5 1 2 2 1 3 3 3 3 1 1 1 1 1 1 1 1))) +(let tile-body-sw (q (1 1 1 1 1 1 1 1 3 3 3 3 1 2 2 1 5 5 5 4 3 1 2 1 5 5 5 5 4 3 1 1 5 5 5 5 5 4 3 1 5 5 5 5 5 5 3 1 3 4 5 5 5 5 3 1 1 3 5 5 5 5 3 1))) +(let tile-body-se (q (1 1 1 1 1 1 1 1 1 2 2 1 3 3 3 3 1 2 1 3 4 5 5 5 1 1 3 4 5 5 5 5 1 3 4 5 5 5 5 5 1 3 5 5 5 5 5 5 1 3 5 5 5 5 4 3 1 3 5 5 5 5 3 1))) +(let tile-background (q (1 1 1 1 1 1 1 1 1 2 2 1 1 2 2 1 1 2 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 2 1 1 2 2 1 1 2 2 1 1 1 1 1 1 1 1 1))) +(let tile-apple (q (1 1 1 9 1 1 1 1 1 2 2 1 9 2 2 1 1 7 7 7 9 8 8 1 7 7 9 7 7 8 8 8 7 9 9 7 7 8 8 8 7 7 7 7 7 8 8 8 1 7 7 7 7 8 8 1 1 1 7 7 8 8 1 1))) +(let tile-digit-0 (q (2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 7 7 8 7 7 7 8 2 7 7 7 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2))) +(let tile-digit-1 (q (2 2 2 7 7 2 2 2 2 2 7 7 7 8 2 2 2 2 7 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2))) +(let tile-digit-2 (q (2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 8 2 7 7 8 2 7 7 8 2 2 8 2 2 7 7 8 2 2 7 7 7 7 8 2 2 7 7 8 8 8 2 2 2 7 7 8 2 7 7 2 2 7 7 7 7 7 7 8))) +(let tile-digit-3 (q (2 2 7 7 7 7 2 2 2 2 2 8 8 7 7 2 2 2 2 2 2 7 7 8 2 2 2 7 7 7 7 8 2 2 2 2 8 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 7 7 7 7 8 2))) +(let tile-digit-4 (q (2 2 7 2 2 7 7 2 2 2 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 7 7 7 7 8 2 2 8 8 8 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8))) +(let tile-digit-5 (q (2 2 7 7 7 7 7 2 2 2 7 7 8 8 8 2 2 2 7 7 2 2 2 2 2 2 7 7 7 7 2 2 2 2 2 8 8 7 7 2 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 7 7 7 7 8 2))) +(let tile-digit-6 (q (2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 2 2 7 7 8 2 7 7 2 2 2 8 8 2 7 7 7 7 7 7 2 2 7 7 8 8 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2))) +(let tile-digit-7 (q (2 7 7 7 7 7 7 2 2 7 7 8 8 7 7 8 2 2 8 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2))) +(let tile-digit-8 (q (2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2))) +(let tile-digit-9 (q (2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 2 7 7 7 7 7 8 2 2 2 8 8 7 7 8 2 2 2 2 2 7 7 8 2 7 7 2 2 7 7 8 2 2 7 7 7 7 8 2))) -[let tile-digits [list tile-digit-0 tile-digit-1 tile-digit-2 tile-digit-3 tile-digit-4 tile-digit-5 tile-digit-6 tile-digit-7 tile-digit-8 tile-digit-9]] +(let tile-digits (list tile-digit-0 tile-digit-1 tile-digit-2 tile-digit-3 tile-digit-4 tile-digit-5 tile-digit-6 tile-digit-7 tile-digit-8 tile-digit-9)) -[defun tile-overlap [x y] [and [is [car x] [car y]] [is [cdr x] [cdr y]]]] +(defun tile-overlap (x y) (and (is (car x) (car y)) (is (cdr x) (cdr y)))) -[defun draw-tile [x y tile] [do - [let i 0] - [while [< i TILE] [do - [let p [+ [* x TILE] [* [+ i [* y TILE]] 320]]] - [let j 0] - [let ts tile] - [while [< j TILE] [do - [let col [car tile]] - [= tile [cdr tile]] - [poke 10 p col] - [inc j] - [inc p] - [poke 10 p col] - [inc j] - [inc p] - ]] - [inc i] - [= p [+ [* x TILE] [* [+ i [* y TILE]] 320]]] - [= j 0] - [= tile ts] - [while [< j TILE] [do - [let col [car tile]] - [= tile [cdr tile]] - [poke 10 p col] - [inc j] - [inc p] - [poke 10 p col] - [inc j] - [inc p] - ]] - [inc i] - ]] -]] +(defun draw-tile (x y tile) (do + (let i 0) + (while (< i TILE) (do + (let p (+ (* x TILE) (* (+ i (* y TILE)) 320))) + (let j 0) + (let ts tile) + (while (< j TILE) (do + (let col (car tile)) + (= tile (cdr tile)) + (poke 10 p col) + (inc j) + (inc p) + (poke 10 p col) + (inc j) + (inc p) + )) + (inc i) + (= p (+ (* x TILE) (* (+ i (* y TILE)) 320))) + (= j 0) + (= tile ts) + (while (< j TILE) (do + (let col (car tile)) + (= tile (cdr tile)) + (poke 10 p col) + (inc j) + (inc p) + (poke 10 p col) + (inc j) + (inc p) + )) + (inc i) + )) +)) -[defun draw-apple [] [do - [draw-tile [car apple] [cdr apple] tile-apple] -]] +(defun draw-apple () (do + (draw-tile (car apple) (cdr apple) tile-apple) +)) -[defun draw-snake-body [before pos after] [do - [draw-tile [car pos] [cdr pos] [if - [is [car before] [car after]] tile-body-v - [is [cdr before] [cdr after]] tile-body-h - [and [is [car before] [- [car pos] 1]] [is [cdr after] [- [cdr pos] 1]]] tile-body-nw - [and [is [car after] [- [car pos] 1]] [is [cdr before] [- [cdr pos] 1]]] tile-body-nw - [and [is [car before] [- [car pos] 1]] [is [cdr after] [+ [cdr pos] 1]]] tile-body-sw - [and [is [car after] [- [car pos] 1]] [is [cdr before] [+ [cdr pos] 1]]] tile-body-sw - [and [is [car before] [+ [car pos] 1]] [is [cdr after] [- [cdr pos] 1]]] tile-body-ne - [and [is [car after] [+ [car pos] 1]] [is [cdr before] [- [cdr pos] 1]]] tile-body-ne +(defun draw-snake-body (before pos after) (do + (draw-tile (car pos) (cdr pos) (if + (is (car before) (car after)) tile-body-v + (is (cdr before) (cdr after)) tile-body-h + (and (is (car before) (- (car pos) 1)) (is (cdr after) (- (cdr pos) 1))) tile-body-nw + (and (is (car after) (- (car pos) 1)) (is (cdr before) (- (cdr pos) 1))) tile-body-nw + (and (is (car before) (- (car pos) 1)) (is (cdr after) (+ (cdr pos) 1))) tile-body-sw + (and (is (car after) (- (car pos) 1)) (is (cdr before) (+ (cdr pos) 1))) tile-body-sw + (and (is (car before) (+ (car pos) 1)) (is (cdr after) (- (cdr pos) 1))) tile-body-ne + (and (is (car after) (+ (car pos) 1)) (is (cdr before) (- (cdr pos) 1))) tile-body-ne tile-body-se - ]] -]] + )) +)) -[defun draw-snake-head [p] [do - [draw-tile [car p] [cdr p] [if - [is direction-id 0] tile-head-left - [is direction-id 1] tile-head-down - [is direction-id 2] tile-head-right - tile-head-up]] -]] +(defun draw-snake-head (p) (do + (draw-tile (car p) (cdr p) (if + (is direction-id 0) tile-head-left + (is direction-id 1) tile-head-down + (is direction-id 2) tile-head-right + tile-head-up)) +)) -[defun draw-snake-tail [before pos] [do - [draw-tile [car pos] [cdr pos] [if - [is [car before] [- [car pos] 1]] tile-tail-left - [is [car before] [+ [car pos] 1]] tile-tail-right - [is [cdr before] [- [cdr pos] 1]] tile-tail-up +(defun draw-snake-tail (before pos) (do + (draw-tile (car pos) (cdr pos) (if + (is (car before) (- (car pos) 1)) tile-tail-left + (is (car before) (+ (car pos) 1)) tile-tail-right + (is (cdr before) (- (cdr pos) 1)) tile-tail-up tile-tail-down - ]] -]] + )) +)) -[defun draw-background-piece [p] [do - [draw-tile [car p] [cdr p] tile-background] -]] +(defun draw-background-piece (p) (do + (draw-tile (car p) (cdr p) tile-background) +)) -[defun draw-background [] [do - [let i 0] - [while [< i GRID_X] [do - [let j 0] - [while [< j GRID_Y] [do - [draw-background-piece [cons i j]] - [inc j] - ]] - [inc i] - ]] -]] +(defun draw-background () (do + (let i 0) + (while (< i GRID_X) (do + (let j 0) + (while (< j GRID_Y) (do + (draw-background-piece (cons i j)) + (inc j) + )) + (inc i) + )) +)) -[defun move-apple [] [do - [= apple [cons [mod [random] GRID_X] [mod [random] GRID_Y]]] - [inc score] -]] +(defun move-apple () (do + (= apple (cons (mod (random) GRID_X) (mod (random) GRID_Y))) + (inc score) +)) -[defun wrap [x y] [if [< x 0] -1 [is x y] -1 x]] +(defun wrap (x y) (if (< x 0) -1 (is x y) -1 x)) -[defun move-snake [] [do - [let head [car snake]] - [let moved-head [cons [wrap [+ [car head] [car direction]] GRID_X] [wrap [+ [cdr head] [cdr direction]] GRID_Y]]] - [= snake [cons moved-head snake]] -]] +(defun move-snake () (do + (let head (car snake)) + (let moved-head (cons (wrap (+ (car head) (car direction)) GRID_X) (wrap (+ (cdr head) (cdr direction)) GRID_Y))) + (= snake (cons moved-head snake)) +)) -[defun process-input [] [do - [let x [last-scancode]] - [if [is x 72] [do [= direction [cons 0 -1]] [= direction-id 3]] 0] - [if [is x 77] [do [= direction [cons 1 0]] [= direction-id 2]] 0] - [if [is x 80] [do [= direction [cons 0 1]] [= direction-id 1]] 0] - [if [is x 75] [do [= direction [cons -1 0]] [= direction-id 0]] 0] -]] +(defun process-input () (do + (let x (last-scancode)) + (if (is x 72) (do (= direction (cons 0 -1)) (= direction-id 3)) 0) + (if (is x 77) (do (= direction (cons 1 0)) (= direction-id 2)) 0) + (if (is x 80) (do (= direction (cons 0 1)) (= direction-id 1)) 0) + (if (is x 75) (do (= direction (cons -1 0)) (= direction-id 0)) 0) +)) -[defun game-over [] [do - [if game-running [= game-running nil] 0] -]] +(defun game-over () (do + (if game-running (= game-running nil) 0) +)) -[defun check-collision [] [do - [let s snake] - [let head [car s]] - [if [or [is [car head] -1] [is [cdr head] -1]] [game-over] 0] - [while s [do - [let t [cdr s]] - [while t [do - [if [tile-overlap [car s] [car t]] - [game-over] 0 - ] - [= t [cdr t]] - ]] - [= s [cdr s]] - ]] -]] +(defun check-collision () (do + (let s snake) + (let head (car s)) + (if (or (is (car head) -1) (is (cdr head) -1)) (game-over) 0) + (while s (do + (let t (cdr s)) + (while t (do + (if (tile-overlap (car s) (car t)) + (game-over) 0 + ) + (= t (cdr t)) + )) + (= s (cdr s)) + )) +)) -[defun show-score [] [do - [draw-tile 9 4 [nth tile-digits [mod [/ score 100] 10]]] - [draw-tile 10 4 [nth tile-digits [mod [/ score 10 ] 10]]] - [draw-tile 11 4 [nth tile-digits [mod [/ score 1 ] 10]]] -]] +(defun show-score () (do + (draw-tile 9 4 (nth tile-digits (mod (/ score 100) 10))) + (draw-tile 10 4 (nth tile-digits (mod (/ score 10 ) 10))) + (draw-tile 11 4 (nth tile-digits (mod (/ score 1 ) 10))) +)) -[defun set-color [i r g b] [do - [outb 968 i] - [outb 969 r] - [outb 969 g] - [outb 969 b] -]] +(defun set-color (i r g b) (do + (outb 968 i) + (outb 969 r) + (outb 969 g) + (outb 969 b) +)) -[defun set-palette [] [do - [set-color 1 24 20 20] - [set-color 2 30 25 26] - [set-color 3 27 44 31] - [set-color 4 32 48 31] - [set-color 5 36 52 31] - [set-color 6 12 7 11] - [set-color 7 57 36 29] - [set-color 8 44 23 20] - [set-color 9 56 48 43] -]] +(defun set-palette () (do + (set-color 1 24 20 20) + (set-color 2 30 25 26) + (set-color 3 27 44 31) + (set-color 4 32 48 31) + (set-color 5 36 52 31) + (set-color 6 12 7 11) + (set-color 7 57 36 29) + (set-color 8 44 23 20) + (set-color 9 56 48 43) +)) -[defun before-last [x] [if [cdr [cdr x]] [before-last [cdr x]] x]] +(defun before-last (x) (if (cdr (cdr x)) (before-last (cdr x)) x)) -[defun start-game [] [do - [set-graphics 1] - [set-palette] - [= game-running 1] - [= score 0] - [= snake [list [q [8 . 5]] [q [7 . 5]] [q [6 . 5]] [q [5. 5]]]] - [= direction [q [1 . 0]]] - [= direction-id 2] - [draw-background] - [move-apple] - [while game-running [do - [let tail [last snake]] - [draw-background-piece tail] - [move-snake] - [let head [car snake]] - [let body [car [cdr snake]]] - [let body-after [car [cdr [cdr snake]]]] - [draw-snake-body head body body-after] - [draw-snake-head head] - [if [tile-overlap head apple] [move-apple] [del-last snake]] - [let tail-before [before-last snake]] - [draw-snake-tail [car tail-before] [car [cdr tail-before]]] - [draw-apple] - [process-input] - [check-collision] - [pause] - [pause] - ]] - [show-score] - [wait-key] - [set-graphics nil] - [print "Type [start-game] to play again!"] -]] +(defun start-game () (do + (set-graphics 1) + (set-palette) + (= game-running 1) + (= score 0) + (= snake (list (q (8 . 5)) (q (7 . 5)) (q (6 . 5)) (q (5. 5)))) + (= direction (q (1 . 0))) + (= direction-id 2) + (draw-background) + (move-apple) + (while game-running (do + (let tail (last snake)) + (draw-background-piece tail) + (move-snake) + (let head (car snake)) + (let body (car (cdr snake))) + (let body-after (car (cdr (cdr snake)))) + (draw-snake-body head body body-after) + (draw-snake-head head) + (if (tile-overlap head apple) (move-apple) (del-last snake)) + (let tail-before (before-last snake)) + (draw-snake-tail (car tail-before) (car (cdr tail-before))) + (draw-apple) + (process-input) + (check-collision) + (pause) + (pause) + )) + (show-score) + (wait-key) + (set-graphics nil) + (print "Type (start-game) to play again!") +)) -[start-game] +(start-game) diff --git a/startup.lisp b/startup.lisp index 5bdac95..6170ce7 100644 --- a/startup.lisp +++ b/startup.lisp @@ -1,15 +1,15 @@ -[let defun [mac [name args body] - [list let name nil] - [list = name [list fun args body]]]] +(let defun (mac (name args body) + (list let name nil) + (list = name (list fun args body)))) -[defun square [x] [* x x]] +(defun square (x) (* x x)) -[let inc [mac [s] [list [q =] s [list [q +] s 1]]]] +(let inc (mac (s) (list (q =) s (list (q +) s 1)))) -[defun to-upper [str] [capture-upper [print str]]] -[defun to-lower [str] [capture-lower [print str]]] +(defun to-upper (str) (capture-upper (print str))) +(defun to-lower (str) (capture-lower (print str))) -[defun last [x] [if [cdr x] [last [cdr x]] [car x]]] -[defun del-last [x] [if [cdr [cdr x]] [del-last [cdr x]] [setcdr x nil]]] +(defun last (x) (if (cdr x) (last (cdr x)) (car x))) +(defun del-last (x) (if (cdr (cdr x)) (del-last (cdr x)) (setcdr x nil))) -[defun nth [a n] [if [is n 0] [car a] [nth [cdr a] [- n 1]]]] +(defun nth (a n) (if (is n 0) (car a) (nth (cdr a) (- n 1)))) diff --git a/system.s b/system.s index dae5ee7..b6ecfd1 100644 --- a/system.s +++ b/system.s @@ -407,9 +407,9 @@ highlight_first_unmatched_brace: cmp bx,[user_input_start] jb .at_start mov al,[es:bx] - cmp al,']' + cmp al,')' je .right_brace - cmp al,'[' + cmp al,'(' je .left_brace jmp .search_loop .right_brace: @@ -440,7 +440,7 @@ highlight_first_unmatched_brace: cmp bx,[user_input_start] jb .done mov al,[es:bx] - cmp al,']' + cmp al,')' jne .search_loop2 inc bx mov [previously_unmatched_brace],bx @@ -585,7 +585,7 @@ read_object: ; Check for single-character tokens, ']' and '.'. mov bx,0xFFFF - cmp al,']' + cmp al,')' je .done cmp al,'.' je .done @@ -595,7 +595,7 @@ read_object: je read_string_object ; Check for list. - cmp al,'[' + cmp al,'(' je read_list_object ; It must be either a symbol or integer. @@ -653,9 +653,9 @@ read_symbol_object: ; Read characters into the buffer. .loop: - cmp al,'[' + cmp al,'(' je .end_symbol - cmp al,']' + cmp al,')' je .end_symbol cmp al,';' je .end_symbol @@ -796,7 +796,7 @@ read_list_object: jne .next_item or al,al jz error_unexpected_eoi - cmp al,']' + cmp al,')' je .done cmp al,'.' je .dotted @@ -855,7 +855,7 @@ read_list_object: call read_object cmp bx,0xFFFF jne error_invalid_dot - cmp al,']' + cmp al,')' jne error_invalid_dot jmp .done @@ -4911,7 +4911,7 @@ loading_message: hex_characters: db '0123456789ABCDEF' prompt_message: - db 10,'flip> ',0 + db 10,'glip> ',0 unknown_type_message: db '',0 nil_message: @@ -4927,11 +4927,11 @@ close_sign_message: string_quote_message: db '"',0 list_start_message: - db '[',0 + db '(',0 depth_limit_reached_message: - db '...]',0 + db '...)',0 list_end_message: - db ']',0 + db ')',0 dot_message: db ' . ',0 space_message: @@ -4948,7 +4948,7 @@ memory_usage_message: db 'Memory usage: ',0 startup_command: - db '[src "startup.lisp"]',0 + db '(src "startup.lisp")',0 startup_command_length: db 21 run_startup_command: