Changes
This commit is contained in:
parent
b3a7acb5f5
commit
41bc458131
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
bin/*
|
||||||
|
|
@ -1,2 +1,4 @@
|
||||||
# flip
|
# glip
|
||||||
16-bit Lisp based OS
|
Glip is a modern variant of [flip](https://github.com/nakst/flip).
|
||||||
|
|
||||||
|
A 16-bit Lisp based OS.
|
||||||
|
|
|
||||||
11
shell.nix
Normal file
11
shell.nix
Normal file
|
|
@ -0,0 +1,11 @@
|
||||||
|
{ pkgs ? import <nixpkgs> { } }:
|
||||||
|
pkgs.mkShell rec {
|
||||||
|
buildInputs = with pkgs; [
|
||||||
|
gcc9
|
||||||
|
nasm
|
||||||
|
clang
|
||||||
|
];
|
||||||
|
shellHook = ''
|
||||||
|
# export CC=clang
|
||||||
|
'';
|
||||||
|
}
|
||||||
410
snake.lisp
410
snake.lisp
|
|
@ -1,230 +1,230 @@
|
||||||
[let TILE 16]
|
(let TILE 16)
|
||||||
[let GRID_X 20]
|
(let GRID_X 20)
|
||||||
[let GRID_Y 12]
|
(let GRID_Y 12)
|
||||||
|
|
||||||
[let snake nil]
|
(let snake nil)
|
||||||
[let direction nil]
|
(let direction nil)
|
||||||
[let direction-id nil]
|
(let direction-id nil)
|
||||||
[let apple nil]
|
(let apple nil)
|
||||||
[let game-running nil]
|
(let game-running nil)
|
||||||
[let score 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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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
|
(defun draw-tile (x y tile) (do
|
||||||
[let i 0]
|
(let i 0)
|
||||||
[while [< i TILE] [do
|
(while (< i TILE) (do
|
||||||
[let p [+ [* x TILE] [* [+ i [* y TILE]] 320]]]
|
(let p (+ (* x TILE) (* (+ i (* y TILE)) 320)))
|
||||||
[let j 0]
|
(let j 0)
|
||||||
[let ts tile]
|
(let ts tile)
|
||||||
[while [< j TILE] [do
|
(while (< j TILE) (do
|
||||||
[let col [car tile]]
|
(let col (car tile))
|
||||||
[= tile [cdr tile]]
|
(= tile (cdr tile))
|
||||||
[poke 10 p col]
|
(poke 10 p col)
|
||||||
[inc j]
|
(inc j)
|
||||||
[inc p]
|
(inc p)
|
||||||
[poke 10 p col]
|
(poke 10 p col)
|
||||||
[inc j]
|
(inc j)
|
||||||
[inc p]
|
(inc p)
|
||||||
]]
|
))
|
||||||
[inc i]
|
(inc i)
|
||||||
[= p [+ [* x TILE] [* [+ i [* y TILE]] 320]]]
|
(= p (+ (* x TILE) (* (+ i (* y TILE)) 320)))
|
||||||
[= j 0]
|
(= j 0)
|
||||||
[= tile ts]
|
(= tile ts)
|
||||||
[while [< j TILE] [do
|
(while (< j TILE) (do
|
||||||
[let col [car tile]]
|
(let col (car tile))
|
||||||
[= tile [cdr tile]]
|
(= tile (cdr tile))
|
||||||
[poke 10 p col]
|
(poke 10 p col)
|
||||||
[inc j]
|
(inc j)
|
||||||
[inc p]
|
(inc p)
|
||||||
[poke 10 p col]
|
(poke 10 p col)
|
||||||
[inc j]
|
(inc j)
|
||||||
[inc p]
|
(inc p)
|
||||||
]]
|
))
|
||||||
[inc i]
|
(inc i)
|
||||||
]]
|
))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun draw-apple [] [do
|
(defun draw-apple () (do
|
||||||
[draw-tile [car apple] [cdr apple] tile-apple]
|
(draw-tile (car apple) (cdr apple) tile-apple)
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun draw-snake-body [before pos after] [do
|
(defun draw-snake-body (before pos after) (do
|
||||||
[draw-tile [car pos] [cdr pos] [if
|
(draw-tile (car pos) (cdr pos) (if
|
||||||
[is [car before] [car after]] tile-body-v
|
(is (car before) (car after)) tile-body-v
|
||||||
[is [cdr before] [cdr after]] tile-body-h
|
(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 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 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 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 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 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
|
(and (is (car after) (+ (car pos) 1)) (is (cdr before) (- (cdr pos) 1))) tile-body-ne
|
||||||
tile-body-se
|
tile-body-se
|
||||||
]]
|
))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun draw-snake-head [p] [do
|
(defun draw-snake-head (p) (do
|
||||||
[draw-tile [car p] [cdr p] [if
|
(draw-tile (car p) (cdr p) (if
|
||||||
[is direction-id 0] tile-head-left
|
(is direction-id 0) tile-head-left
|
||||||
[is direction-id 1] tile-head-down
|
(is direction-id 1) tile-head-down
|
||||||
[is direction-id 2] tile-head-right
|
(is direction-id 2) tile-head-right
|
||||||
tile-head-up]]
|
tile-head-up))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun draw-snake-tail [before pos] [do
|
(defun draw-snake-tail (before pos) (do
|
||||||
[draw-tile [car pos] [cdr pos] [if
|
(draw-tile (car pos) (cdr pos) (if
|
||||||
[is [car before] [- [car pos] 1]] tile-tail-left
|
(is (car before) (- (car pos) 1)) tile-tail-left
|
||||||
[is [car before] [+ [car pos] 1]] tile-tail-right
|
(is (car before) (+ (car pos) 1)) tile-tail-right
|
||||||
[is [cdr before] [- [cdr pos] 1]] tile-tail-up
|
(is (cdr before) (- (cdr pos) 1)) tile-tail-up
|
||||||
tile-tail-down
|
tile-tail-down
|
||||||
]]
|
))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun draw-background-piece [p] [do
|
(defun draw-background-piece (p) (do
|
||||||
[draw-tile [car p] [cdr p] tile-background]
|
(draw-tile (car p) (cdr p) tile-background)
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun draw-background [] [do
|
(defun draw-background () (do
|
||||||
[let i 0]
|
(let i 0)
|
||||||
[while [< i GRID_X] [do
|
(while (< i GRID_X) (do
|
||||||
[let j 0]
|
(let j 0)
|
||||||
[while [< j GRID_Y] [do
|
(while (< j GRID_Y) (do
|
||||||
[draw-background-piece [cons i j]]
|
(draw-background-piece (cons i j))
|
||||||
[inc j]
|
(inc j)
|
||||||
]]
|
))
|
||||||
[inc i]
|
(inc i)
|
||||||
]]
|
))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun move-apple [] [do
|
(defun move-apple () (do
|
||||||
[= apple [cons [mod [random] GRID_X] [mod [random] GRID_Y]]]
|
(= apple (cons (mod (random) GRID_X) (mod (random) GRID_Y)))
|
||||||
[inc score]
|
(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
|
(defun move-snake () (do
|
||||||
[let head [car snake]]
|
(let head (car snake))
|
||||||
[let moved-head [cons [wrap [+ [car head] [car direction]] GRID_X] [wrap [+ [cdr head] [cdr direction]] GRID_Y]]]
|
(let moved-head (cons (wrap (+ (car head) (car direction)) GRID_X) (wrap (+ (cdr head) (cdr direction)) GRID_Y)))
|
||||||
[= snake [cons moved-head snake]]
|
(= snake (cons moved-head snake))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun process-input [] [do
|
(defun process-input () (do
|
||||||
[let x [last-scancode]]
|
(let x (last-scancode))
|
||||||
[if [is x 72] [do [= direction [cons 0 -1]] [= direction-id 3]] 0]
|
(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 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 80) (do (= direction (cons 0 1)) (= direction-id 1)) 0)
|
||||||
[if [is x 75] [do [= direction [cons -1 0]] [= direction-id 0]] 0]
|
(if (is x 75) (do (= direction (cons -1 0)) (= direction-id 0)) 0)
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun game-over [] [do
|
(defun game-over () (do
|
||||||
[if game-running [= game-running nil] 0]
|
(if game-running (= game-running nil) 0)
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun check-collision [] [do
|
(defun check-collision () (do
|
||||||
[let s snake]
|
(let s snake)
|
||||||
[let head [car s]]
|
(let head (car s))
|
||||||
[if [or [is [car head] -1] [is [cdr head] -1]] [game-over] 0]
|
(if (or (is (car head) -1) (is (cdr head) -1)) (game-over) 0)
|
||||||
[while s [do
|
(while s (do
|
||||||
[let t [cdr s]]
|
(let t (cdr s))
|
||||||
[while t [do
|
(while t (do
|
||||||
[if [tile-overlap [car s] [car t]]
|
(if (tile-overlap (car s) (car t))
|
||||||
[game-over] 0
|
(game-over) 0
|
||||||
]
|
)
|
||||||
[= t [cdr t]]
|
(= t (cdr t))
|
||||||
]]
|
))
|
||||||
[= s [cdr s]]
|
(= s (cdr s))
|
||||||
]]
|
))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun show-score [] [do
|
(defun show-score () (do
|
||||||
[draw-tile 9 4 [nth tile-digits [mod [/ score 100] 10]]]
|
(draw-tile 9 4 (nth tile-digits (mod (/ score 100) 10)))
|
||||||
[draw-tile 10 4 [nth tile-digits [mod [/ score 10 ] 10]]]
|
(draw-tile 10 4 (nth tile-digits (mod (/ score 10 ) 10)))
|
||||||
[draw-tile 11 4 [nth tile-digits [mod [/ score 1 ] 10]]]
|
(draw-tile 11 4 (nth tile-digits (mod (/ score 1 ) 10)))
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun set-color [i r g b] [do
|
(defun set-color (i r g b) (do
|
||||||
[outb 968 i]
|
(outb 968 i)
|
||||||
[outb 969 r]
|
(outb 969 r)
|
||||||
[outb 969 g]
|
(outb 969 g)
|
||||||
[outb 969 b]
|
(outb 969 b)
|
||||||
]]
|
))
|
||||||
|
|
||||||
[defun set-palette [] [do
|
(defun set-palette () (do
|
||||||
[set-color 1 24 20 20]
|
(set-color 1 24 20 20)
|
||||||
[set-color 2 30 25 26]
|
(set-color 2 30 25 26)
|
||||||
[set-color 3 27 44 31]
|
(set-color 3 27 44 31)
|
||||||
[set-color 4 32 48 31]
|
(set-color 4 32 48 31)
|
||||||
[set-color 5 36 52 31]
|
(set-color 5 36 52 31)
|
||||||
[set-color 6 12 7 11]
|
(set-color 6 12 7 11)
|
||||||
[set-color 7 57 36 29]
|
(set-color 7 57 36 29)
|
||||||
[set-color 8 44 23 20]
|
(set-color 8 44 23 20)
|
||||||
[set-color 9 56 48 43]
|
(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
|
(defun start-game () (do
|
||||||
[set-graphics 1]
|
(set-graphics 1)
|
||||||
[set-palette]
|
(set-palette)
|
||||||
[= game-running 1]
|
(= game-running 1)
|
||||||
[= score 0]
|
(= score 0)
|
||||||
[= snake [list [q [8 . 5]] [q [7 . 5]] [q [6 . 5]] [q [5. 5]]]]
|
(= snake (list (q (8 . 5)) (q (7 . 5)) (q (6 . 5)) (q (5. 5))))
|
||||||
[= direction [q [1 . 0]]]
|
(= direction (q (1 . 0)))
|
||||||
[= direction-id 2]
|
(= direction-id 2)
|
||||||
[draw-background]
|
(draw-background)
|
||||||
[move-apple]
|
(move-apple)
|
||||||
[while game-running [do
|
(while game-running (do
|
||||||
[let tail [last snake]]
|
(let tail (last snake))
|
||||||
[draw-background-piece tail]
|
(draw-background-piece tail)
|
||||||
[move-snake]
|
(move-snake)
|
||||||
[let head [car snake]]
|
(let head (car snake))
|
||||||
[let body [car [cdr snake]]]
|
(let body (car (cdr snake)))
|
||||||
[let body-after [car [cdr [cdr snake]]]]
|
(let body-after (car (cdr (cdr snake))))
|
||||||
[draw-snake-body head body body-after]
|
(draw-snake-body head body body-after)
|
||||||
[draw-snake-head head]
|
(draw-snake-head head)
|
||||||
[if [tile-overlap head apple] [move-apple] [del-last snake]]
|
(if (tile-overlap head apple) (move-apple) (del-last snake))
|
||||||
[let tail-before [before-last snake]]
|
(let tail-before (before-last snake))
|
||||||
[draw-snake-tail [car tail-before] [car [cdr tail-before]]]
|
(draw-snake-tail (car tail-before) (car (cdr tail-before)))
|
||||||
[draw-apple]
|
(draw-apple)
|
||||||
[process-input]
|
(process-input)
|
||||||
[check-collision]
|
(check-collision)
|
||||||
[pause]
|
(pause)
|
||||||
[pause]
|
(pause)
|
||||||
]]
|
))
|
||||||
[show-score]
|
(show-score)
|
||||||
[wait-key]
|
(wait-key)
|
||||||
[set-graphics nil]
|
(set-graphics nil)
|
||||||
[print "Type [start-game] to play again!"]
|
(print "Type (start-game) to play again!")
|
||||||
]]
|
))
|
||||||
|
|
||||||
[start-game]
|
(start-game)
|
||||||
|
|
|
||||||
20
startup.lisp
20
startup.lisp
|
|
@ -1,15 +1,15 @@
|
||||||
[let defun [mac [name args body]
|
(let defun (mac (name args body)
|
||||||
[list let name nil]
|
(list let name nil)
|
||||||
[list = name [list fun args body]]]]
|
(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-upper (str) (capture-upper (print str)))
|
||||||
[defun to-lower [str] [capture-lower [print str]]]
|
(defun to-lower (str) (capture-lower (print str)))
|
||||||
|
|
||||||
[defun last [x] [if [cdr x] [last [cdr x]] [car x]]]
|
(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 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))))
|
||||||
|
|
|
||||||
28
system.s
28
system.s
|
|
@ -407,9 +407,9 @@ highlight_first_unmatched_brace:
|
||||||
cmp bx,[user_input_start]
|
cmp bx,[user_input_start]
|
||||||
jb .at_start
|
jb .at_start
|
||||||
mov al,[es:bx]
|
mov al,[es:bx]
|
||||||
cmp al,']'
|
cmp al,')'
|
||||||
je .right_brace
|
je .right_brace
|
||||||
cmp al,'['
|
cmp al,'('
|
||||||
je .left_brace
|
je .left_brace
|
||||||
jmp .search_loop
|
jmp .search_loop
|
||||||
.right_brace:
|
.right_brace:
|
||||||
|
|
@ -440,7 +440,7 @@ highlight_first_unmatched_brace:
|
||||||
cmp bx,[user_input_start]
|
cmp bx,[user_input_start]
|
||||||
jb .done
|
jb .done
|
||||||
mov al,[es:bx]
|
mov al,[es:bx]
|
||||||
cmp al,']'
|
cmp al,')'
|
||||||
jne .search_loop2
|
jne .search_loop2
|
||||||
inc bx
|
inc bx
|
||||||
mov [previously_unmatched_brace],bx
|
mov [previously_unmatched_brace],bx
|
||||||
|
|
@ -585,7 +585,7 @@ read_object:
|
||||||
|
|
||||||
; Check for single-character tokens, ']' and '.'.
|
; Check for single-character tokens, ']' and '.'.
|
||||||
mov bx,0xFFFF
|
mov bx,0xFFFF
|
||||||
cmp al,']'
|
cmp al,')'
|
||||||
je .done
|
je .done
|
||||||
cmp al,'.'
|
cmp al,'.'
|
||||||
je .done
|
je .done
|
||||||
|
|
@ -595,7 +595,7 @@ read_object:
|
||||||
je read_string_object
|
je read_string_object
|
||||||
|
|
||||||
; Check for list.
|
; Check for list.
|
||||||
cmp al,'['
|
cmp al,'('
|
||||||
je read_list_object
|
je read_list_object
|
||||||
|
|
||||||
; It must be either a symbol or integer.
|
; It must be either a symbol or integer.
|
||||||
|
|
@ -653,9 +653,9 @@ read_symbol_object:
|
||||||
|
|
||||||
; Read characters into the buffer.
|
; Read characters into the buffer.
|
||||||
.loop:
|
.loop:
|
||||||
cmp al,'['
|
cmp al,'('
|
||||||
je .end_symbol
|
je .end_symbol
|
||||||
cmp al,']'
|
cmp al,')'
|
||||||
je .end_symbol
|
je .end_symbol
|
||||||
cmp al,';'
|
cmp al,';'
|
||||||
je .end_symbol
|
je .end_symbol
|
||||||
|
|
@ -796,7 +796,7 @@ read_list_object:
|
||||||
jne .next_item
|
jne .next_item
|
||||||
or al,al
|
or al,al
|
||||||
jz error_unexpected_eoi
|
jz error_unexpected_eoi
|
||||||
cmp al,']'
|
cmp al,')'
|
||||||
je .done
|
je .done
|
||||||
cmp al,'.'
|
cmp al,'.'
|
||||||
je .dotted
|
je .dotted
|
||||||
|
|
@ -855,7 +855,7 @@ read_list_object:
|
||||||
call read_object
|
call read_object
|
||||||
cmp bx,0xFFFF
|
cmp bx,0xFFFF
|
||||||
jne error_invalid_dot
|
jne error_invalid_dot
|
||||||
cmp al,']'
|
cmp al,')'
|
||||||
jne error_invalid_dot
|
jne error_invalid_dot
|
||||||
jmp .done
|
jmp .done
|
||||||
|
|
||||||
|
|
@ -4911,7 +4911,7 @@ loading_message:
|
||||||
hex_characters:
|
hex_characters:
|
||||||
db '0123456789ABCDEF'
|
db '0123456789ABCDEF'
|
||||||
prompt_message:
|
prompt_message:
|
||||||
db 10,'flip> ',0
|
db 10,'glip> ',0
|
||||||
unknown_type_message:
|
unknown_type_message:
|
||||||
db '<??>',0
|
db '<??>',0
|
||||||
nil_message:
|
nil_message:
|
||||||
|
|
@ -4927,11 +4927,11 @@ close_sign_message:
|
||||||
string_quote_message:
|
string_quote_message:
|
||||||
db '"',0
|
db '"',0
|
||||||
list_start_message:
|
list_start_message:
|
||||||
db '[',0
|
db '(',0
|
||||||
depth_limit_reached_message:
|
depth_limit_reached_message:
|
||||||
db '...]',0
|
db '...)',0
|
||||||
list_end_message:
|
list_end_message:
|
||||||
db ']',0
|
db ')',0
|
||||||
dot_message:
|
dot_message:
|
||||||
db ' . ',0
|
db ' . ',0
|
||||||
space_message:
|
space_message:
|
||||||
|
|
@ -4948,7 +4948,7 @@ memory_usage_message:
|
||||||
db 'Memory usage: ',0
|
db 'Memory usage: ',0
|
||||||
|
|
||||||
startup_command:
|
startup_command:
|
||||||
db '[src "startup.lisp"]',0
|
db '(src "startup.lisp")',0
|
||||||
startup_command_length:
|
startup_command_length:
|
||||||
db 21
|
db 21
|
||||||
run_startup_command:
|
run_startup_command:
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue