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
|
||||
16-bit Lisp based OS
|
||||
# glip
|
||||
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 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)
|
||||
|
|
|
|||
20
startup.lisp
20
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))))
|
||||
|
|
|
|||
28
system.s
28
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:
|
||||
|
|
|
|||
Loading…
Reference in a new issue