hide email
This commit is contained in:
nakst
commit
b3a7acb5f5
21
LICENSE
Normal file
21
LICENSE
Normal file
|
|
@ -0,0 +1,21 @@
|
||||||
|
MIT License
|
||||||
|
|
||||||
|
Copyright (c) 2020 Nakst
|
||||||
|
|
||||||
|
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
of this software and associated documentation files (the "Software"), to deal
|
||||||
|
in the Software without restriction, including without limitation the rights
|
||||||
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||||
|
copies of the Software, and to permit persons to whom the Software is
|
||||||
|
furnished to do so, subject to the following conditions:
|
||||||
|
|
||||||
|
The above copyright notice and this permission notice shall be included in all
|
||||||
|
copies or substantial portions of the Software.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||||
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||||
|
SOFTWARE.
|
||||||
270
boot.s
Normal file
270
boot.s
Normal file
|
|
@ -0,0 +1,270 @@
|
||||||
|
[bits 16]
|
||||||
|
[org 0x7C00]
|
||||||
|
[cpu 386]
|
||||||
|
|
||||||
|
; Memory map:
|
||||||
|
; 0x500-0x700: filesystem header
|
||||||
|
; 0x700-0x900: sector table buffer
|
||||||
|
; 0x900-0xB00: file sector buffer
|
||||||
|
; 0x7000-0x7C00: stack
|
||||||
|
; 0x7C00-0x7E00: this code
|
||||||
|
; 0x10000-0x20000: loaded program
|
||||||
|
|
||||||
|
start:
|
||||||
|
; Setup segment registers and the stack.
|
||||||
|
cli
|
||||||
|
xor ax,ax
|
||||||
|
mov ds,ax
|
||||||
|
mov ss,ax
|
||||||
|
mov sp,0x7C00 ; Put stack below the code.
|
||||||
|
sti
|
||||||
|
cld
|
||||||
|
jmp 0x0000:.set_cs
|
||||||
|
.set_cs:
|
||||||
|
|
||||||
|
; Save the BIOS drive number.
|
||||||
|
mov [drive_number],dl
|
||||||
|
|
||||||
|
; Print a loading message.
|
||||||
|
mov si,loading_message
|
||||||
|
call print_string
|
||||||
|
|
||||||
|
; Get drive parameters.
|
||||||
|
mov ah,0x08
|
||||||
|
mov dl,[drive_number]
|
||||||
|
xor di,di
|
||||||
|
int 0x13
|
||||||
|
mov si,error_read
|
||||||
|
jc error
|
||||||
|
and cx,31
|
||||||
|
mov [max_sectors],cx
|
||||||
|
inc dh
|
||||||
|
shr dx,8
|
||||||
|
mov [max_heads],dx
|
||||||
|
|
||||||
|
; Load the filesystem header.
|
||||||
|
xor ax,ax
|
||||||
|
mov es,ax
|
||||||
|
mov di,1
|
||||||
|
mov bx,0x500
|
||||||
|
call load_sector
|
||||||
|
|
||||||
|
; Check for correct signature and version.
|
||||||
|
mov si,error_disk
|
||||||
|
mov ax,[0x500]
|
||||||
|
cmp ax,0x706C
|
||||||
|
jne error
|
||||||
|
mov ax,[0x502]
|
||||||
|
cmp ax,1
|
||||||
|
jne error
|
||||||
|
|
||||||
|
; Load the root directory.
|
||||||
|
mov ax,[0x51C]
|
||||||
|
mov [file_remaining_size],ax
|
||||||
|
mov ax,[0x520]
|
||||||
|
mov [current_sector],ax
|
||||||
|
mov di,ax
|
||||||
|
xor ax,ax
|
||||||
|
mov es,ax
|
||||||
|
mov bx,0x900
|
||||||
|
call load_sector
|
||||||
|
|
||||||
|
; Scan the root directory.
|
||||||
|
xor bx,bx
|
||||||
|
.scan_root_directory:
|
||||||
|
cmp bx,0x200
|
||||||
|
jne .loaded_sector
|
||||||
|
call next_file_sector
|
||||||
|
xor bx,bx
|
||||||
|
.loaded_sector:
|
||||||
|
|
||||||
|
; Compare file name.
|
||||||
|
xor ax,ax
|
||||||
|
mov es,ax
|
||||||
|
mov cx,7
|
||||||
|
mov si,program_name
|
||||||
|
mov di,0x900
|
||||||
|
add di,bx
|
||||||
|
rep cmpsb
|
||||||
|
jne .next_entry
|
||||||
|
|
||||||
|
; Save the startup program's first sector, size and checksum.
|
||||||
|
mov al,[0x917 + bx]
|
||||||
|
mov [checksum],al
|
||||||
|
mov ax,[0x910 + bx]
|
||||||
|
mov [file_remaining_size],ax
|
||||||
|
mov di,[0x914 + bx]
|
||||||
|
mov [current_sector],di
|
||||||
|
jmp .load_startup_program
|
||||||
|
|
||||||
|
; Go to the next entry.
|
||||||
|
.next_entry:
|
||||||
|
add bx,0x20
|
||||||
|
sub word [file_remaining_size],0x20
|
||||||
|
cmp word [file_remaining_size],0
|
||||||
|
jne .scan_root_directory
|
||||||
|
mov si,error_disk
|
||||||
|
jmp error
|
||||||
|
|
||||||
|
; Load the startup program.
|
||||||
|
.load_startup_program:
|
||||||
|
xor bx,bx
|
||||||
|
mov es,bx
|
||||||
|
mov bx,0x900
|
||||||
|
call load_sector
|
||||||
|
|
||||||
|
; Copy the sector to the destination.
|
||||||
|
.copy_sector:
|
||||||
|
mov bx,0x1000
|
||||||
|
mov es,bx
|
||||||
|
mov di,[file_destination]
|
||||||
|
mov si,0x900
|
||||||
|
mov cx,0x200
|
||||||
|
rep movsb
|
||||||
|
|
||||||
|
; Calculate checksum.
|
||||||
|
mov bl,[checksum]
|
||||||
|
mov si,0x900
|
||||||
|
mov cx,0x200
|
||||||
|
.checksum_loop:
|
||||||
|
lodsb
|
||||||
|
xor bl,al
|
||||||
|
loop .checksum_loop
|
||||||
|
mov [checksum],bl
|
||||||
|
|
||||||
|
; Load the next sector of the startup program.
|
||||||
|
add word [file_destination],0x200
|
||||||
|
mov ax,[file_remaining_size]
|
||||||
|
cmp ax,0x200
|
||||||
|
jbe .launch
|
||||||
|
|
||||||
|
sub word [file_remaining_size],0x200
|
||||||
|
call next_file_sector
|
||||||
|
jmp .copy_sector
|
||||||
|
|
||||||
|
; Launch the startup program.
|
||||||
|
.launch:
|
||||||
|
mov si,error_disk
|
||||||
|
cmp byte [checksum],0
|
||||||
|
jne error
|
||||||
|
mov dl,[drive_number]
|
||||||
|
jmp 0x1000:0x0000
|
||||||
|
|
||||||
|
next_file_sector:
|
||||||
|
; Do we need to switch the sector table buffer?
|
||||||
|
mov ax,[current_sector]
|
||||||
|
shr ax,8 ; 256 sector table entries per sector
|
||||||
|
cmp al,[current_sector_table]
|
||||||
|
je .skip_switch
|
||||||
|
mov [current_sector_table],al
|
||||||
|
|
||||||
|
; Load the new sector table buffer.
|
||||||
|
add ax,2
|
||||||
|
mov di,ax
|
||||||
|
xor bx,bx
|
||||||
|
mov es,bx
|
||||||
|
mov bx,0x700
|
||||||
|
call load_sector
|
||||||
|
.skip_switch:
|
||||||
|
|
||||||
|
; Get the next sector.
|
||||||
|
mov bx,[current_sector]
|
||||||
|
and bx,0xFF
|
||||||
|
shl bx,1
|
||||||
|
mov di,[0x700 + bx]
|
||||||
|
mov [current_sector],di
|
||||||
|
|
||||||
|
; Load the next sector.
|
||||||
|
xor bx,bx
|
||||||
|
mov es,bx
|
||||||
|
mov bx,0x900
|
||||||
|
jmp load_sector
|
||||||
|
|
||||||
|
; di - LBA.
|
||||||
|
; es:bx - buffer
|
||||||
|
load_sector:
|
||||||
|
mov byte [read_attempts],5
|
||||||
|
|
||||||
|
.try_again:
|
||||||
|
|
||||||
|
mov si,error_read
|
||||||
|
mov al,[read_attempts]
|
||||||
|
or al,al
|
||||||
|
jz error
|
||||||
|
dec byte [read_attempts]
|
||||||
|
|
||||||
|
; Calculate cylinder and head.
|
||||||
|
mov ax,di
|
||||||
|
xor dx,dx
|
||||||
|
div word [max_sectors]
|
||||||
|
xor dx,dx
|
||||||
|
div word [max_heads]
|
||||||
|
push dx ; remainder - head
|
||||||
|
mov ch,al ; quotient - cylinder
|
||||||
|
shl ah,6
|
||||||
|
mov cl,ah
|
||||||
|
|
||||||
|
; Calculate sector.
|
||||||
|
mov ax,di
|
||||||
|
xor dx,dx
|
||||||
|
div word [max_sectors]
|
||||||
|
inc dx
|
||||||
|
or cl,dl
|
||||||
|
|
||||||
|
; Load the sector.
|
||||||
|
pop dx
|
||||||
|
mov dh,dl
|
||||||
|
mov dl,[drive_number]
|
||||||
|
mov ax,0x0201
|
||||||
|
int 0x13
|
||||||
|
jc .try_again
|
||||||
|
|
||||||
|
ret
|
||||||
|
|
||||||
|
; ds:si - zero-terminated string.
|
||||||
|
error:
|
||||||
|
call print_string
|
||||||
|
jmp $
|
||||||
|
|
||||||
|
; ds:si - zero-terminated string.
|
||||||
|
print_string:
|
||||||
|
lodsb
|
||||||
|
or al,al
|
||||||
|
jz .done
|
||||||
|
mov ah,0xE
|
||||||
|
int 0x10
|
||||||
|
jmp print_string
|
||||||
|
.done: ret
|
||||||
|
|
||||||
|
file_destination:
|
||||||
|
dw 0
|
||||||
|
current_sector_table:
|
||||||
|
db 0xFF
|
||||||
|
|
||||||
|
error_read:
|
||||||
|
db "Cannot read boot disk.",0
|
||||||
|
error_disk:
|
||||||
|
db "Corrupt boot disk.",0
|
||||||
|
program_name:
|
||||||
|
db "system",0 ; don't forget to change name length in comparison!
|
||||||
|
loading_message:
|
||||||
|
db 'Loading... ',0
|
||||||
|
|
||||||
|
times (0x1FE - $ + $$) nop
|
||||||
|
dw 0xAA55
|
||||||
|
|
||||||
|
; Uninitialised variables outside the boot image.
|
||||||
|
drive_number:
|
||||||
|
db 0
|
||||||
|
read_attempts:
|
||||||
|
db 0
|
||||||
|
max_sectors:
|
||||||
|
dw 0
|
||||||
|
max_heads:
|
||||||
|
dw 0
|
||||||
|
current_sector:
|
||||||
|
dw 0
|
||||||
|
file_remaining_size:
|
||||||
|
dw 0
|
||||||
|
checksum:
|
||||||
|
db 0
|
||||||
29
build.sh
Normal file
29
build.sh
Normal file
|
|
@ -0,0 +1,29 @@
|
||||||
|
mkdir -p bin bin/dest
|
||||||
|
set -e
|
||||||
|
|
||||||
|
# Create a blank floppy image.
|
||||||
|
dd if=/dev/zero of=bin/drive.img bs=512 count=2880 status=none
|
||||||
|
|
||||||
|
# Assemble and copy the bootloader.
|
||||||
|
nasm boot.s -f bin -o bin/boot
|
||||||
|
dd if=bin/boot of=bin/drive.img bs=512 count=1 conv=notrunc status=none
|
||||||
|
|
||||||
|
# Assemble the system.
|
||||||
|
nasm system.s -f bin -o bin/dest/system
|
||||||
|
|
||||||
|
# Check the system fits in 32KB.
|
||||||
|
# The bootloader can't load files greater than a 64KB segment,
|
||||||
|
# and the system uses the upper 32KB of its segment for buffers.
|
||||||
|
if [ $(wc -c <bin/dest/system) -ge 32768 ]; then
|
||||||
|
echo "System too large (more than 32KB)."
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
|
# Copy the system and other files to the floppy.
|
||||||
|
gcc -o bin/mkfs mkfs.c
|
||||||
|
cp *.lisp bin/dest
|
||||||
|
bin/mkfs bin/drive.img 2880 bin/dest
|
||||||
|
|
||||||
|
# Launch the emulator.
|
||||||
|
qemu-system-x86_64 -drive file=bin/drive.img,index=0,if=floppy,format=raw -boot a
|
||||||
|
# bochs -f bochs_config.txt -q
|
||||||
40
mandelbrot.lisp
Normal file
40
mandelbrot.lisp
Normal file
|
|
@ -0,0 +1,40 @@
|
||||||
|
[set-graphics 1]
|
||||||
|
|
||||||
|
; Constants.
|
||||||
|
[let WIDTH 320]
|
||||||
|
[let HEIGHT 200]
|
||||||
|
[let MAXIT 15]
|
||||||
|
[let FIXED 500]
|
||||||
|
|
||||||
|
; Fixed-point arithmetic.
|
||||||
|
[let mf [fun [x] [* x FIXED]]]
|
||||||
|
[let *f [fun [x y] [muldiv x y FIXED]]]
|
||||||
|
|
||||||
|
; Complex numbers.
|
||||||
|
[let re [fun [z] [car z]]]
|
||||||
|
[let im [fun [z] [cdr z]]]
|
||||||
|
[let +c [fun [a b] [cons [+ [re a] [re b]] [+ [im a] [im b]]]]]
|
||||||
|
[let square-c [fun [z] [cons
|
||||||
|
[- [*f [re z] [re z]] [*f [im z] [im z]]]
|
||||||
|
[* 2 [*f [re z] [im z]]]]]]
|
||||||
|
[let length-squared [fun [z] [+ [*f [re z] [re z]] [*f [im z] [im z]]]]]
|
||||||
|
|
||||||
|
; Viewport.
|
||||||
|
[let getx [fun [x] [- [muldiv x [mf 3] WIDTH] [mf 2]]]]
|
||||||
|
[let gety [fun [y] [- [muldiv y [mf 2] HEIGHT] [mf 1]]]]
|
||||||
|
|
||||||
|
; Image generation.
|
||||||
|
[let iterate [fun [z c] [+c c [square-c z]]]]
|
||||||
|
[let do_pixel [fun [X Y c] [let i 0] [let z c]
|
||||||
|
[while [and [< i MAXIT] [<= [length-squared z] [mf 4]]]
|
||||||
|
[do [= z [iterate z c]] [inc i]]]
|
||||||
|
[poke 10 [+ X [* 320 Y]] [+ 64 i]]]]
|
||||||
|
[let do_row [fun [Y y] [let col 0] [while [< col WIDTH]
|
||||||
|
[do [do_pixel col Y [cons [getx col] y]] [inc col]]]]]
|
||||||
|
[let image [fun [] [let row 0] [while [< row HEIGHT]
|
||||||
|
[do [do_row row [gety row]] [inc row]]]]]
|
||||||
|
|
||||||
|
; Show the image and wait for user input.
|
||||||
|
[image]
|
||||||
|
[wait-key]
|
||||||
|
[set-graphics nil]
|
||||||
120
mkfs.c
Normal file
120
mkfs.c
Normal file
|
|
@ -0,0 +1,120 @@
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <stdint.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <dirent.h>
|
||||||
|
#include <assert.h>
|
||||||
|
#include <sys/stat.h>
|
||||||
|
|
||||||
|
#define HEADER_SIGNATURE (0x706C)
|
||||||
|
#define VERSION (1)
|
||||||
|
#define FLAG_DIRECTORY (1 << 0)
|
||||||
|
#define NAME_SIZE (16)
|
||||||
|
#define SECTOR_SIZE (0x200)
|
||||||
|
#define SECTOR_FREE (0)
|
||||||
|
#define SECTOR_EOF (1)
|
||||||
|
|
||||||
|
typedef uint16_t SectorEntry;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
/* 00 */ char name[NAME_SIZE];
|
||||||
|
/* 16 */ uint32_t fileSize;
|
||||||
|
/* 20 */ uint16_t firstSector;
|
||||||
|
/* 22 */ uint8_t flags;
|
||||||
|
/* 23 */ uint8_t checksum;
|
||||||
|
/* 24 */ uint8_t unused1[8];
|
||||||
|
// 32 bytes.
|
||||||
|
} DirectoryEntry;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
// Stored in LBA 1.
|
||||||
|
/* 00 */ uint16_t signature;
|
||||||
|
/* 02 */ uint16_t version;
|
||||||
|
/* 04 */ uint16_t sectorCount;
|
||||||
|
/* 06 */ uint16_t unused0;
|
||||||
|
/* 08 */ uint16_t sectorTableSize; // In sectors, starting at LBA 2.
|
||||||
|
/* 10 */ uint16_t unused1;
|
||||||
|
/* 12 */ DirectoryEntry root;
|
||||||
|
// 44 bytes.
|
||||||
|
uint8_t unused2[512 - 44];
|
||||||
|
} Header;
|
||||||
|
|
||||||
|
int main(int argc, char **argv) {
|
||||||
|
FILE *drive = fopen(argv[1], "r+b");
|
||||||
|
|
||||||
|
Header header = { HEADER_SIGNATURE };
|
||||||
|
header.version = VERSION;
|
||||||
|
header.sectorCount = atoi(argv[2]);
|
||||||
|
header.sectorTableSize = header.sectorCount * sizeof(SectorEntry) / SECTOR_SIZE + 1;
|
||||||
|
|
||||||
|
strcpy(header.root.name, "My Floppy");
|
||||||
|
header.root.firstSector = 2 + header.sectorTableSize;
|
||||||
|
|
||||||
|
SectorEntry *sectorTable = (SectorEntry *) calloc(SECTOR_SIZE, header.sectorTableSize);
|
||||||
|
sectorTable[0] = sectorTable[1] = sectorTable[header.root.firstSector] = SECTOR_EOF;
|
||||||
|
|
||||||
|
for (uintptr_t i = 0; i < header.sectorTableSize; i++) {
|
||||||
|
sectorTable[2 + i] = (i == header.sectorTableSize - 1) ? SECTOR_EOF : (3 + i);
|
||||||
|
}
|
||||||
|
|
||||||
|
DirectoryEntry *rootDirectory = (DirectoryEntry *) calloc(1, SECTOR_SIZE);
|
||||||
|
|
||||||
|
DIR *import = opendir(argv[3]);
|
||||||
|
struct dirent *entry;
|
||||||
|
assert(import);
|
||||||
|
|
||||||
|
int currentSector = header.root.firstSector + 1;
|
||||||
|
int currentFile = 0;
|
||||||
|
|
||||||
|
while ((entry = readdir(import))) {
|
||||||
|
// Load the file.
|
||||||
|
if (entry->d_name[0] == '.') continue;
|
||||||
|
char buffer[256];
|
||||||
|
sprintf(buffer, "%s/%s", argv[3], entry->d_name);
|
||||||
|
struct stat s;
|
||||||
|
lstat(buffer, &s);
|
||||||
|
if (!S_ISREG(s.st_mode)) continue;
|
||||||
|
FILE *input = fopen(buffer, "rb");
|
||||||
|
assert(input);
|
||||||
|
fseek(input, 0, SEEK_END);
|
||||||
|
uint64_t fileSize = ftell(input);
|
||||||
|
fseek(input, 0, SEEK_SET);
|
||||||
|
void *data = malloc(fileSize);
|
||||||
|
fread(data, 1, fileSize, input);
|
||||||
|
fclose(input);
|
||||||
|
|
||||||
|
// Setup the root directory entry.
|
||||||
|
assert(header.root.fileSize != SECTOR_SIZE);
|
||||||
|
header.root.fileSize += sizeof(DirectoryEntry);
|
||||||
|
assert(strlen(entry->d_name) < NAME_SIZE);
|
||||||
|
strncpy(rootDirectory[currentFile].name, entry->d_name, NAME_SIZE);
|
||||||
|
rootDirectory[currentFile].fileSize = fileSize;
|
||||||
|
rootDirectory[currentFile].firstSector = currentSector;
|
||||||
|
|
||||||
|
// Calculate the checksum.
|
||||||
|
rootDirectory[currentFile].checksum = 0;
|
||||||
|
for (uintptr_t i = 0; i < fileSize; i++) rootDirectory[currentFile].checksum ^= ((uint8_t *) data)[i];
|
||||||
|
|
||||||
|
// Write out the file.
|
||||||
|
int sectorCount = (fileSize + SECTOR_SIZE) / SECTOR_SIZE;
|
||||||
|
fseek(drive, SECTOR_SIZE * currentSector, SEEK_SET);
|
||||||
|
fwrite(data, 1, fileSize, drive);
|
||||||
|
|
||||||
|
// Update the sector table.
|
||||||
|
for (uintptr_t i = currentSector; i < currentSector + sectorCount - 1; i++) sectorTable[i] = i + 1;
|
||||||
|
sectorTable[currentSector + sectorCount - 1] = SECTOR_EOF;
|
||||||
|
|
||||||
|
// Go to the next file.
|
||||||
|
// printf("import %d %s of size %d (%d sectors) at sector %d\n", currentFile, buffer, fileSize, sectorCount, currentSector);
|
||||||
|
currentSector += sectorCount;
|
||||||
|
currentFile++;
|
||||||
|
free(data);
|
||||||
|
}
|
||||||
|
|
||||||
|
fseek(drive, SECTOR_SIZE, SEEK_SET);
|
||||||
|
fwrite(&header, 1, SECTOR_SIZE, drive);
|
||||||
|
fwrite(sectorTable, 1, SECTOR_SIZE * header.sectorTableSize, drive);
|
||||||
|
fwrite(rootDirectory, 1, SECTOR_SIZE, drive);
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
230
snake.lisp
Normal file
230
snake.lisp
Normal file
|
|
@ -0,0 +1,230 @@
|
||||||
|
[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 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]]
|
||||||
|
|
||||||
|
[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-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
|
||||||
|
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-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 [] [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 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 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 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 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 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!"]
|
||||||
|
]]
|
||||||
|
|
||||||
|
[start-game]
|
||||||
15
startup.lisp
Normal file
15
startup.lisp
Normal file
|
|
@ -0,0 +1,15 @@
|
||||||
|
[let defun [mac [name args body]
|
||||||
|
[list let name nil]
|
||||||
|
[list = name [list fun args body]]]]
|
||||||
|
|
||||||
|
[defun square [x] [* x x]]
|
||||||
|
|
||||||
|
[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 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]]]]
|
||||||
Loading…
Reference in a new issue