├── .hgignore ├── COPYRIGHT ├── Makefile ├── README.html ├── README.pdf ├── README.tex ├── allegro-fixes.cl ├── atdoc.lisp ├── blackthorn-collision-test.asd ├── blackthorn-stress-test.asd ├── blackthorn-test.asd ├── blackthorn.asd ├── bunnyslayer.asd ├── disp ├── collision.config ├── collision.png ├── refmap │ ├── README │ ├── TileA1.config │ ├── TileA2.config │ ├── TileA3.config │ ├── TileA4.config │ ├── TileA5.config │ ├── TileB.config │ ├── TileC.config │ ├── TileD.config │ ├── TileE.config │ ├── gettilesets.sh │ ├── vx_chara01_a.config │ ├── vx_chara01_b.config │ ├── vx_chara02_b.config │ ├── vx_chara02_c.config │ ├── vx_chara04_a.config │ ├── vx_chara04_b.config │ ├── vx_chara06_a.config │ ├── vx_chara07_a.config │ ├── vx_chara07_b.config │ └── vx_chara08_a.config ├── sheet.config ├── sheet.png ├── thopter-item.config ├── thopter-item.png ├── thopter-screen.config ├── thopter-screen.png ├── thopter.config └── thopter.png ├── dist.lisp ├── dmg_utils.make ├── load.lisp ├── macosx ├── Info.plist ├── PkgInfo ├── bt.icns └── thopter.icns ├── profile.lisp ├── property.lisp ├── sound ├── COPYRIGHT ├── README ├── beep.ogg ├── missile.ogg ├── music.mp3 ├── phaser.wav ├── thopterblades.ogg └── thoptergun.ogg ├── src ├── blackthorn │ ├── actor.lisp │ ├── collision.lisp │ ├── component.lisp │ ├── event.lisp │ ├── fonts.lisp │ ├── game.lisp │ ├── graphics.lisp │ ├── input.lisp │ ├── library.lisp │ ├── main.lisp │ ├── music.lisp │ ├── network.lisp │ ├── package.lisp │ ├── public.lisp │ ├── resources.lisp │ └── utils.lisp ├── bunnyslayer │ ├── driver.lisp │ └── package.lisp ├── collision-test │ ├── driver.lisp │ └── package.lisp ├── stress-test │ ├── collidable.lisp │ ├── mobile.lisp │ ├── package.lisp │ └── static.lisp ├── test │ ├── component.lisp │ └── package.lisp └── thopter │ ├── package.lisp │ └── thopter.lisp ├── test.lisp ├── thopter.asd ├── unix └── run.sh └── windows ├── bt.ico ├── chp ├── COPYING.txt ├── Makefile ├── Makefile.win ├── README.txt ├── chp.cbp ├── chp.dev ├── chp.exe ├── chp.layout ├── chp_private.h ├── chp_private.rc ├── chp_private.res └── main.c ├── install.nsi ├── is_user_admin.nsh └── thopter.ico /.hgignore: -------------------------------------------------------------------------------- 1 | syntax: glob 2 | 3 | # hidden, backup, and temporary files 4 | *~ 5 | .\#* 6 | .*.swp 7 | .DS_Store 8 | 9 | # object files 10 | *.o 11 | *.fas 12 | *.lib 13 | *.fasl 14 | *.?x32fsl 15 | *.?x64fsl 16 | 17 | # README output files 18 | README.aux 19 | README.log 20 | README.out 21 | README.toc 22 | 23 | # build files 24 | bin/* 25 | lib/* 26 | doc/* 27 | disp/refmap/*.png 28 | *.app 29 | *.exe 30 | *.dll 31 | *.tar.gz 32 | build.in 33 | build.out 34 | -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | Copyright (c) 2007-2012, Elliott Slaughter 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 14 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 15 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 16 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 17 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 18 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 19 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | #### Blackthorn -- Lisp Game Engine 2 | #### 3 | #### Copyright (c) 2007-2010, Elliott Slaughter 4 | #### 5 | #### Permission is hereby granted, free of charge, to any person 6 | #### obtaining a copy of this software and associated documentation 7 | #### files (the "Software"), to deal in the Software without 8 | #### restriction, including without limitation the rights to use, copy, 9 | #### modify, merge, publish, distribute, sublicense, and/or sell copies 10 | #### of the Software, and to permit persons to whom the Software is 11 | #### furnished to do so, subject to the following conditions: 12 | #### 13 | #### The above copyright notice and this permission notice shall be 14 | #### included in all copies or substantial portions of the Software. 15 | #### 16 | #### THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | #### EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | #### MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | #### NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | #### HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | #### WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | #### OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | #### DEALINGS IN THE SOFTWARE. 24 | #### 25 | 26 | # Search PATH for a Lisp compiler. 27 | ifneq ($(shell which sbcl),) 28 | cl := sbcl 29 | else 30 | ifneq ($(shell which alisp),) 31 | cl := allegro 32 | else 33 | ifneq ($(shell which clisp),) 34 | cl := clisp 35 | else 36 | ifneq ($(shell which ecl),) 37 | cl := ecl 38 | else 39 | ifneq ($(shell which ecl.exe),) 40 | cl := ecl 41 | else 42 | ifneq ($(shell which ccl),) 43 | cl := clozure 44 | else 45 | $(error No Lisp compiler found.) 46 | endif 47 | endif 48 | endif 49 | endif 50 | endif 51 | endif 52 | 53 | # Which ASDF system to load: 54 | system := thopter 55 | 56 | # Stardard drivers: 57 | prop := property.lisp 58 | load := load.lisp 59 | test := test.lisp 60 | dist := dist.lisp 61 | prof := profile.lisp 62 | atdoc := atdoc.lisp 63 | 64 | # Select which driver to run (load by default). 65 | driver := ${load} 66 | 67 | args := 68 | 69 | # Specify the run command for the installer. 70 | ifeq (${cl}, allegro) 71 | command := \\\"\\x24INSTDIR\\\\main.exe\\\" 72 | else 73 | command := \\\"\\x24INSTDIR\\\\chp\\\\chp.exe\\\" \\\"\\x24INSTDIR\\\\main.exe\\\" 74 | endif 75 | 76 | # A temporary file for passing values around. 77 | tempfile := .tmp 78 | 79 | # A command which can be used to get an ASDF system property. 80 | ifeq (${cl}, allegro) 81 | get-property = $(shell alisp +B +s ${prop} -e "(defparameter *driver-system* '|${system}|)" -e "(defparameter *output-file* \"${tempfile}\")" -e "(defparameter *output-expression* '$(1))") 82 | else 83 | ifeq (${cl}, sbcl) 84 | get-property = $(shell sbcl --eval "(defparameter *driver-system* \"${system}\")" --eval "(defparameter *output-file* \"${tempfile}\")" --eval "(defparameter *output-expression* '$(1))" --load ${prop}) 85 | else 86 | ifeq (${cl}, clisp) 87 | get-property = $(shell clisp -x "(defparameter *driver-system* \"${system}\")" -x "(defparameter *output-file* \"${tempfile}\")" -x "(defparameter *output-expression* '$(1))" -x "(load \"${prop}\")") 88 | else 89 | ifeq (${cl}, ecl) 90 | get-property = $(shell ecl -eval "(defparameter *driver-system* \"${system}\")" -eval "(defparameter *output-file* \"${tempfile}\")" -eval "(defparameter *output-expression* '$(1))" -load ${prop}) 91 | else 92 | ifeq (${cl}, clozure) 93 | get-property = $(shell ccl --eval "(defparameter *driver-system* \"${system}\")" --eval "(defparameter *output-file* \"${tempfile}\")" --eval "(defparameter *output-expression* '$(1))" --load ${prop}) 94 | endif 95 | endif 96 | endif 97 | endif 98 | endif 99 | 100 | # Get ASDF system properties for the specified system. 101 | define get-properties 102 | $(eval temp := $$(call get-property,(asdf:component-name *system*))) 103 | $(eval name := $$(shell cat $${tempfile})) 104 | $(eval temp := $$(call get-property,(or (asdf:component-property *system* :long-name) (asdf:component-name *system*)))) 105 | $(eval longname := $$(shell cat $${tempfile})) 106 | $(eval temp := $$(call get-property,(asdf:component-version *system*))) 107 | $(eval version := $$(shell cat $${tempfile})) 108 | $(eval temp := $$(call get-property,(asdf:system-description *system*))) 109 | $(eval description := $$(shell cat $${tempfile})) 110 | $(eval temp := $$(call get-property,(asdf:component-property *system* :url))) 111 | $(eval url := $$(shell cat $${tempfile})) 112 | endef 113 | 114 | export cl, db, system, driver, name, longname, version, description, url, command 115 | 116 | .PHONY: new 117 | new: 118 | $(MAKE) clean 119 | $(MAKE) load 120 | 121 | .PHONY: load 122 | load: 123 | $(MAKE) load-${cl} 124 | 125 | .PHONY: load-allegro 126 | load-allegro: 127 | alisp +B +s ${driver} -e "(defparameter *driver-system* '|${system}|)" -- ${args} 128 | 129 | .PHONY: load-sbcl 130 | load-sbcl: 131 | sbcl --eval "(defparameter *driver-system* \"${system}\")" --load ${driver} -- ${args} 132 | 133 | .PHONY: load-clisp 134 | load-clisp: 135 | clisp -x "(defparameter *driver-system* \"${system}\")" -x "(load \"${driver}\")" -- ${args} 136 | 137 | .PHONY: load-ecl 138 | load-ecl: 139 | ifneq ($(shell which ecl.exe),) 140 | ecl.exe -eval "(defparameter *driver-system* \"${system}\")" -load ${driver} -- ${args} 141 | else 142 | ecl -eval "(defparameter *driver-system* \"${system}\")" -load ${driver} -- ${args} 143 | endif 144 | 145 | .PHONY: load-clozure 146 | load-clozure: 147 | ccl --eval "(defparameter *driver-system* \"${system}\")" --load ${driver} -- ${args} 148 | 149 | .PHONY: server 150 | server: 151 | $(MAKE) args="--server=127.0.0.1 --port=12345" new 152 | 153 | .PHONY: client 154 | client: 155 | $(MAKE) args="--connect=127.0.0.1 --port=12345" new 156 | 157 | .PHONY: server3 158 | server3: 159 | $(MAKE) args="--server --port=12345 --players=3" new 160 | 161 | .PHONY: server4 162 | server4: 163 | $(MAKE) args="--server --port=12345 --players=4" new 164 | 165 | .PHONY: server5 166 | server5: 167 | $(MAKE) args="--server --port=12345 --players=5" new 168 | 169 | .PHONY: slime 170 | slime: 171 | $(MAKE) clean 172 | emacs --eval "(progn (slime '${cl}) (while (not (slime-connected-p)) (sleep-for 0 200)) (slime-interactive-eval \"(defparameter *driver-system* \\\"${system}\\\")\") (slime-load-file \"${driver}\"))" 173 | 174 | .PHONY: thopter 175 | thopter: 176 | $(MAKE) system="thopter" new 177 | 178 | .PHONY: bunny 179 | bunny: 180 | $(MAKE) system="bunnyslayer" new 181 | 182 | .PHONY: stress 183 | stress: 184 | $(MAKE) system="blackthorn-stress-test" new 185 | 186 | .PHONY: collision 187 | collision: 188 | $(MAKE) system="blackthorn-collision-test" new 189 | 190 | .PHONY: test 191 | test: 192 | $(MAKE) driver="${test}" system="blackthorn-test" new 193 | 194 | .PHONY: prof 195 | prof: 196 | $(MAKE) driver="${prof}" new 197 | 198 | .PHONY: distnoclean 199 | distnoclean: 200 | mkdir -p bin 201 | cp -r $(wildcard lib/*) disp sound bin 202 | $(MAKE) driver="${dist}" new 203 | 204 | .PHONY: dist 205 | dist: 206 | $(MAKE) distclean distnoclean 207 | 208 | .PHONY: README 209 | README: 210 | pdflatex README.tex 211 | ifneq ($(shell which hevea.bat),) 212 | hevea.bat -o README.html README.tex 213 | d2u README.html 214 | else 215 | hevea -o README.html README.tex 216 | endif 217 | 218 | .PHONY: doc 219 | doc: 220 | $(MAKE) docclean 221 | $(MAKE) atdoc 222 | 223 | .PHONY: atdoc 224 | atdoc: 225 | $(MAKE) driver="${atdoc}" new 226 | 227 | .PHONY: install-w32 228 | install-w32: 229 | -$(call get-properties) 230 | $(MAKE) distclean 231 | mkdir -p bin 232 | if test -e windows/${name}.ico; then cp windows/${name}.ico bin/app.ico; else cp windows/bt.ico bin/app.ico; fi 233 | $(MAKE) distnoclean postinstall-w32 234 | 235 | .PHONY: postinstall-w32 236 | postinstall-w32: 237 | -$(call get-properties) 238 | cp -r windows/chp windows/is_user_admin.nsh COPYRIGHT bin 239 | awk "{gsub(/@NAME@/, \"${name}\");print}" windows/install.nsi | awk "{gsub(/@LONGNAME@/, \"${longname}\");print}" | awk "{gsub(/@VERSION@/, \"${version}\");print}" | awk "{gsub(/@DESCRIPTION@/, \"${description}\");print}" | awk "{gsub(/@URL@/, \"${url}\");print}" | awk "{gsub(/@COMMAND@/, \"${command}\");print}" > bin/install.nsi 240 | makensis bin/install.nsi 241 | mv bin/*-install.exe . 242 | 243 | .PHONY: install-unix 244 | install-unix: 245 | -$(call get-properties) 246 | $(MAKE) dist 247 | cp unix/run.sh bin 248 | mv bin ${name} 249 | tar cfz ${name}-${version}-linux.tar.gz ${name} 250 | mv ${name} bin 251 | 252 | .PHONY: install-mac 253 | install-mac: 254 | -$(call get-properties) 255 | rm -rf "${longname}.app" 256 | $(MAKE) dist 257 | mkdir "${longname}.app" "${longname}.app/Contents" "${longname}.app/Contents/MacOS" "${longname}.app/Contents/Frameworks" "${longname}.app/Contents/Resources" 258 | awk "{gsub(/@NAME@/, \"${name}\");print}" macosx/Info.plist | awk "{gsub(/@LONGNAME@/, \"${longname}\");print}" | awk "{gsub(/@VERSION@/, \"${version}\");print}" | awk "{gsub(/@DESCRIPTION@/, \"${description}\");print}" | awk "{gsub(/@URL@/, \"${url}\");print}" > "${longname}.app/Contents/Info.plist" 259 | cp -r $(wildcard lib/*.framework) "${longname}.app/Contents/Frameworks" 260 | cp -r disp sound "${longname}.app/Contents/Resources" 261 | cp bin/main "${longname}.app/Contents/MacOS" 262 | cp macosx/PkgInfo COPYRIGHT "${longname}.app/Contents" 263 | if test -e "macosx/${name}.icns"; then cp "macosx/${name}.icns" "${longname}.app/Contents/Resources/app.icns"; else cp macosx/bt.icns "${longname}.app/Contents/Resources/app.icns"; fi 264 | tar cfz "${name}-${version}-macos.tar.gz" "${longname}.app" 265 | $(MAKE) -f dmg_utils.make NAME="${longname}" VERSION="${version}" SOURCE_DIR=. SOURCE_FILES="${longname}.app COPYRIGHT" 266 | 267 | .PHONY: clean 268 | clean: 269 | rm -rf $(wildcard */*/*.o */*/*.fas */*/*.lib */*/*.fasl */*/*.?x32fsl */*/*.?x64fsl *.db ${tempfile}) 270 | 271 | .PHONY: docclean 272 | docclean: 273 | rm -rf doc README.aux README.haux README.htoc README.log README.out README.toc 274 | 275 | .PHONY: distclean 276 | distclean: 277 | $(MAKE) clean docclean 278 | rm -rf $(wildcard build.in build.out bin) 279 | -------------------------------------------------------------------------------- /README.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | Blackthorn: Lisp Game Engine 6 | 7 | 8 | 9 | 10 | 47 | 48 | 49 | 50 | 51 |

Blackthorn: Lisp Game Engine

Elliott Slaughter

52 |

Contents

53 |

1  What is Blackthorn?

Blackthorn is a framework for writing 2D games in Common Lisp. Blackthorn is attempt to write an efficient, dynamic, persistent 2D game engine in an expressive language which makes it easy to write games.

54 |

2  Why another game engine?

Games are hard to write. The effort needed to write a usable game engine from scratch, especially when dealing with the low-level details of languages like C, make the cost of writing games prohibitive. Libraries like SDL get many of the driver-level graphics details out of the way, but still leave the user writing in C. Libraries like PyGame and LISPBUILDER-SDL wrap more of these low-level details, but still don’t provide a full game engine needed for writing substantial games.

There are, of course, game engines which provide this functionality to the user. Game Maker, for example, is an engine which provides everything needed to make a basic game, and an extention language for writing more complex behavior. Using Game Maker, an experienced user can write a basic game in five minutes. However, Game Maker (and similar programs the authors have tried) have some substantial flaws. Problems with Game Maker, specifically, include:

59 |

3  What does Blackthorn provide?

Blackthorn attempts to fix many of the problems above. Blackthorn provides:

70 |

4  Technical details

Blackthorn uses LISPBUILDER-SDL for graphics support (which internally uses SDL and SDL_image), and CL-STORE as an internal database for object persistence.

Blackthorn currently runs on Windows, Linux, and Mac OS X, under Allegro CL, CLISP, Clozure CL, and SBCL. Blackthorn has been tested successfully on the following OS/Lisp combinations:

71 | 72 | 73 | 74 | 75 |
 WindowsLinuxMac OS X
Allegro CLYes????
CLISPYesYesYes
Clozure CLYesYesNo
SBCLYesYesYes

Among the compatible compilers, SBCL is suggested because it is (a) free and open source, (b) compatible with Windows, Linux and Mac, and (c) has the best performance of the compilers listed. Allegro CL is also a good choice, but is commercial software (although a free version is available).

76 |

4.1  Direct dependencies

83 |

4.2  Windows only (optional)

87 |

5  Installation

Download the source using darcs

darcs get http://common-lisp.net/~eslaughter/darcs/blackthorn
 88 |

To start Blackthorn from the shell, merely call make

make
 89 |

Optionally, use parameters to specify the build environment, e.g.

make cl=sbcl db=nodb driver=load.lisp system=bunnyslayer
 90 |

If instead you prefer to start Blackthorn interactively, start your Lisp and

(load "load")
 91 |
92 |

6  Download

Binary distributions are made semi-frequently and are available for download at http://elliottslaughter.net/bunnyslayer/download. 93 | License

Blackthorn is free and open source software, see the COPYRIGHT file for details.

94 | 95 | 96 | 97 |
This document was translated from LATEX by 98 | HEVEA.
99 | 100 | -------------------------------------------------------------------------------- /README.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/README.pdf -------------------------------------------------------------------------------- /README.tex: -------------------------------------------------------------------------------- 1 | %%%% Blackthorn -- Lisp Game Engine 2 | %%%% 3 | %%%% Copyright (c) 2007-2010, Elliott Slaughter 4 | %%%% 5 | %%%% Permission is hereby granted, free of charge, to any person 6 | %%%% obtaining a copy of this software and associated documentation 7 | %%%% files (the "Software"), to deal in the Software without 8 | %%%% restriction, including without limitation the rights to use, copy, 9 | %%%% modify, merge, publish, distribute, sublicense, and/or sell copies 10 | %%%% of the Software, and to permit persons to whom the Software is 11 | %%%% furnished to do so, subject to the following conditions: 12 | %%%% 13 | %%%% The above copyright notice and this permission notice shall be 14 | %%%% included in all copies or substantial portions of the Software. 15 | %%%% 16 | %%%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | %%%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | %%%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | %%%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | %%%% HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | %%%% WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | %%%% OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | %%%% DEALINGS IN THE SOFTWARE. 24 | %%%% 25 | 26 | % Usage: 27 | % This document can generate PDF (with pdflatex) or HTML (with hevea) output. 28 | % $ pdflatex README.latex 29 | % or 30 | % $ hevea -o README.html README.latex 31 | 32 | \documentclass[letterpaper]{article} 33 | 34 | \usepackage{hevea} 35 | \usepackage{hyperref} 36 | 37 | \title{Blackthorn: Lisp Game Engine} 38 | \author{Elliott Slaughter} 39 | 40 | \begin{document} 41 | \maketitle 42 | 43 | \tableofcontents 44 | 45 | \section{What is Blackthorn?} 46 | 47 | Blackthorn is a framework for writing 2D games in Common Lisp. Blackthorn is attempt to write an efficient, dynamic, persistent 2D game engine in an expressive language which makes it easy to write games. 48 | 49 | \section{Why another game engine?} 50 | 51 | Games are hard to write. The effort needed to write a usable game engine from scratch, especially when dealing with the low-level details of languages like C, make the cost of writing games prohibitive. Libraries like \href{http://www.libsdl.org/}{SDL} get many of the driver-level graphics details out of the way, but still leave the user writing in C. Libraries like \href{http://www.pygame.org/news.html}{PyGame} and \href{http://code.google.com/p/lispbuilder/wiki/LispbuilderSDL}{LISPBUILDER-SDL} wrap more of these low-level details, but still don't provide a full game engine needed for writing substantial games. 52 | 53 | There are, of course, game engines which provide this functionality to the user. \href{http://www.yoyogames.com/gamemaker/}{Game Maker}, for example, is an engine which provides everything needed to make a basic game, and an extention language for writing more complex behavior. Using Game Maker, an experienced user can write a basic game in five minutes. However, Game Maker (and similar programs the authors have tried) have some substantial flaws. Problems with Game Maker, specifically, include: 54 | 55 | \begin{itemize} 56 | \item Game Maker only runs on Windows. A Linux port is still a dream, and porting to any sort of mobile device is completely unimaginable. 57 | \item Game Maker's extension language, GML, is a kludge, and inefficient. (The lack of a rich set of built-in datastructures is something I hear GML users complaining about frequently.) 58 | \item Game Maker is closed source, so it would be impossible for anyone other than the authors to fix any of the above problems with Game Maker. 59 | \end{itemize} 60 | 61 | \section{What does Blackthorn provide?} 62 | 63 | Blackthorn attempts to fix many of the problems above. Blackthorn provides: 64 | 65 | \begin{itemize} 66 | \item A not-yet-complete subset of the functionality provided by Game Maker. Despite being incomplete, Blackthorn is already capable of supporting simple games. 67 | \item Blackthorn is written in Common Lisp, providing: 68 | \begin{itemize} 69 | \item Efficiency which is (depending on the implementation, and the benchmark) capable of competing with C. 70 | \item Portable to any platform supported by a compliant ANSI Common Lisp compiler. Blackthorn currently runs on Windows, Linux, and Mac OSX. Porting Blackthorn to a new compiler takes a couple of hours. 71 | \item Dynamic behavior, because the entire compiler is available at runtime. An on-screen development REPL (read-eval-print loop, i.e. a development console) with an on-screen debugger is provided, giving the user the ability to rewrite arbitrary pieces of code on the fly. 72 | \item Extensibility, because the game engine itself is an open platform, and because user code operates at the same level as the game engine. 73 | \item And finally, because Blackthorn is open source, it is open to improvements from the community. 74 | \end{itemize} 75 | \end{itemize} 76 | 77 | \section{Technical details} 78 | 79 | Blackthorn uses \href{http://code.google.com/p/lispbuilder/}{LISPBUILDER-SDL} for graphics support (which internally uses \href{http://www.libsdl.org/}{SDL} and \href{http://www.libsdl.org/projects/SDL_image/}{SDL\_image}), and \href{http://common-lisp.net/project/cl-store/}{CL-STORE} as an internal database for object persistence. 80 | 81 | Blackthorn currently runs on Windows, Linux, and Mac OS X, under \href{http://franz.com/products/allegrocl/}{Allegro CL}, \href{http://clisp.cons.org/}{CLISP}, \href{http://trac.clozure.com/openmcl}{Clozure CL}, and \href{http://www.sbcl.org/}{SBCL}. Blackthorn has been tested successfully on the following OS/Lisp combinations: 82 | 83 | \begin{tabular}{c c c c} 84 | & Windows & Linux & Mac OS X \\ 85 | Allegro CL & Yes & ?? & ?? \\ 86 | CLISP & Yes & Yes & Yes \\ 87 | Clozure CL & Yes & Yes & No \\ 88 | SBCL & Yes & Yes & Yes \\ 89 | \end{tabular} 90 | 91 | Among the compatible compilers, SBCL is suggested because it is (a) free and open source, (b) compatible with Windows, Linux and Mac, and (c) has the best performance of the compilers listed. Allegro CL is also a good choice, but is commercial software (although a free version is available). 92 | 93 | \subsection{Direct dependencies} 94 | 95 | \begin{itemize} 96 | \item \href{http://code.google.com/p/lispbuilder/}{LISPBUILDER-SDL and -SDL-IMAGE} 97 | \item \href{http://common-lisp.net/project/cl-store/}{CL-STORE} 98 | \item \href{http://www.common-lisp.org/project/cl-containers/}{CL-Containers} 99 | \item \href{http://www.cliki.net/trivial-garbage}{Trivial Garbage} 100 | \item \href{http://www.weitz.de/cl-fad/}{CL-FAD} 101 | \end{itemize} 102 | 103 | \subsection{Windows only (optional)} 104 | 105 | \begin{itemize} 106 | \item \href{http://www.cygwin.com/}{Cygwin} or \href{http://gnuwin32.sourceforge.net/}{GnuWin32} to use the Makefile 107 | \item \href{http://nsis.sourceforge.net/}{NSIS} for building installers 108 | \end{itemize} 109 | 110 | \section{Installation} 111 | 112 | Download the source using darcs 113 | 114 | \begin{verbatim} 115 | darcs get http://common-lisp.net/~eslaughter/darcs/blackthorn 116 | \end{verbatim} 117 | 118 | To start Blackthorn from the shell, merely call make 119 | 120 | \begin{verbatim} 121 | make 122 | \end{verbatim} 123 | 124 | Optionally, use parameters to specify the build environment, e.g. 125 | 126 | \begin{verbatim} 127 | make cl=sbcl db=nodb driver=load.lisp system=bunnyslayer 128 | \end{verbatim} 129 | 130 | If instead you prefer to start Blackthorn interactively, start your Lisp and 131 | 132 | \begin{verbatim} 133 | (load "load") 134 | \end{verbatim} 135 | 136 | \section{Download} 137 | 138 | Binary distributions are made semi-frequently and are available for download at \url{http://elliottslaughter.net/bunnyslayer/download}. 139 | License 140 | 141 | Blackthorn is free and open source software, see the \href{http://common-lisp.net/~eslaughter/darcs/blackthorn/COPYRIGHT}{COPYRIGHT} file for details. 142 | 143 | \end{document} 144 | -------------------------------------------------------------------------------- /allegro-fixes.cl: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2010, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage #:usocket-system) -------------------------------------------------------------------------------- /atdoc.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (eval-when (:compile-toplevel :load-toplevel :execute) 27 | #+quicklisp 28 | (ql:quickload :trivial-features) 29 | #-quicklisp 30 | (asdf:oos 'asdf:load-op :trivial-features)) 31 | 32 | #+(and sbcl windows) (load-shared-object "msvcr71.dll") 33 | 34 | #+quicklisp 35 | (ql:quickload :atdoc) 36 | #+quicklisp 37 | (ql:quickload :cl-fad) 38 | #+quicklisp 39 | (ql:quickload :blackthorn) 40 | 41 | #-quicklisp 42 | (require :asdf) 43 | #-quicklisp 44 | (asdf:oos 'asdf:load-op :atdoc) 45 | #-quicklisp 46 | (asdf:oos 'asdf:load-op :cl-fad) 47 | #-quicklisp 48 | (asdf:oos 'asdf:load-op :blackthorn) 49 | 50 | ;;; 51 | ;;; Setup directories for build. 52 | ;;; 53 | 54 | (defun cwd () 55 | (truename (make-pathname))) 56 | 57 | (defun append-directory (default-pathname &rest directories) 58 | (merge-pathnames 59 | (make-pathname :directory (cons :relative directories)) 60 | default-pathname)) 61 | 62 | (defconstant +working-dir+ (cwd)) 63 | 64 | (defconstant +doc-dir+ (append-directory +working-dir+ "doc")) 65 | 66 | (if (fad:file-exists-p +doc-dir+) 67 | (fad:delete-directory-and-files +doc-dir+)) 68 | (ensure-directories-exist +doc-dir+) 69 | 70 | ;;; 71 | ;;; Build documentation. 72 | ;;; 73 | 74 | (atdoc:generate-html-documentation 75 | '(:blt :blt-user) 76 | +doc-dir+ 77 | :index-title "Blackthorn API Reference" 78 | :heading "Blackthorn -- Lisp Game Engine") 79 | 80 | (atdoc:generate-latex-documentation 81 | '(:blt :blt-user) 82 | +doc-dir+ 83 | :title "Blackthorn API Reference") 84 | 85 | 86 | (#-allegro quit #+allegro exit) 87 | -------------------------------------------------------------------------------- /blackthorn-collision-test.asd: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2012, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage :blackthorn-collision-test-asd 27 | (:use :cl :asdf)) 28 | 29 | (in-package :blackthorn-collision-test-asd) 30 | 31 | (defsystem blackthorn-collision-test 32 | :name "Bunny Slayer" 33 | :author "Elliott Slaughter " 34 | :version "0.2" 35 | :license "MIT" 36 | :description "Collision test for Blackthorn 2D engine" 37 | :components ((:module src 38 | :components 39 | ((:module collision-test 40 | :components 41 | ((:file "package") 42 | (:file "driver")) 43 | :serial t)))) 44 | :depends-on (:blackthorn)) 45 | -------------------------------------------------------------------------------- /blackthorn-stress-test.asd: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2012, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage :blackthorn-stress-test-asd 27 | (:use :cl :asdf)) 28 | 29 | (in-package :blackthorn-stress-test-asd) 30 | 31 | (defsystem blackthorn-stress-test 32 | :name "blackthorn-stress-test" 33 | :author "Elliott Slaughter " 34 | :version "0.2" 35 | :license "MIT" 36 | :description "Stress test for Blackthorn 2D engine" 37 | :components ((:module src 38 | :components 39 | ((:module stress-test 40 | :components 41 | ((:file "package") 42 | (:file "static") 43 | (:file "mobile") 44 | (:file "collidable")) 45 | :serial t)))) 46 | :depends-on (:blackthorn)) 47 | -------------------------------------------------------------------------------- /blackthorn-test.asd: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2012, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage :blackthorn-test-asd 27 | (:use :cl :asdf)) 28 | 29 | (in-package :blackthorn-test-asd) 30 | 31 | (defsystem blackthorn-test 32 | :name "blackthorn-test" 33 | :author "Elliott Slaughter " 34 | :version "0.2" 35 | :license "MIT" 36 | :description "Test suite for Blackthorn 2D engine" 37 | :components ((:module src 38 | :components 39 | ((:module test 40 | :components 41 | ((:file "package") 42 | (:file "component")) 43 | :serial t)))) 44 | :depends-on (:blackthorn :fiveam)) 45 | -------------------------------------------------------------------------------- /blackthorn.asd: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2012, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage :blackthorn-asd 27 | (:use :cl :asdf)) 28 | 29 | (in-package :blackthorn-asd) 30 | 31 | (defsystem blackthorn 32 | :name "blackthorn" 33 | :author "Elliott Slaughter " 34 | :version "0.2" 35 | :license "MIT" 36 | :description "2D game engine for Common Lisp" 37 | :components ((:module src 38 | :components 39 | ((:module blackthorn 40 | :components 41 | ((:file "package") 42 | (:file "public") 43 | (:file "utils") 44 | (:file "resources") 45 | (:file "graphics") 46 | (:file "fonts") 47 | (:file "music") 48 | (:file "component") 49 | (:file "event") 50 | (:file "input") 51 | (:file "actor") 52 | (:file "collision") 53 | (:file "game") 54 | (:file "network") 55 | (:file "library") 56 | (:file "main")) 57 | :serial t)))) 58 | :depends-on (;; Utilities 59 | :alexandria 60 | :trivial-features 61 | :command-line-arguments 62 | :cl-fad 63 | :iterate 64 | :cl-containers 65 | :mt19937 66 | 67 | ;; Networking and Serialization 68 | :usocket 69 | :cl-store 70 | 71 | ;; Graphics and Sound: 72 | :lispbuilder-sdl 73 | :lispbuilder-sdl-image 74 | :lispbuilder-sdl-mixer 75 | :cl-opengl)) 76 | -------------------------------------------------------------------------------- /bunnyslayer.asd: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2012, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage :bunnyslayer-asd 27 | (:use :cl :asdf)) 28 | 29 | (in-package :bunnyslayer-asd) 30 | 31 | (defsystem bunnyslayer 32 | :name "Bunny Slayer" 33 | :author "Elliott Slaughter " 34 | :version "0.2" 35 | :license "MIT" 36 | :description "Bunny Slayer, an adventure game" 37 | :components ((:module src 38 | :components 39 | ((:module bunnyslayer 40 | :components 41 | ((:file "package") 42 | (:file "driver")) 43 | :serial t)))) 44 | :depends-on (:blackthorn)) 45 | -------------------------------------------------------------------------------- /disp/collision.config: -------------------------------------------------------------------------------- 1 | ((:name :collision) 2 | (:size 32 32) 3 | (:images 4 | ((:name :orange) (:offset 0 0) (:size 16 16) 5 | (:bbox-offset 0 0) (:bbox-size 0 0)) 6 | ((:name :blue) (:offset 16 0) (:size 16 16)) 7 | ((:name :green) (:offset 0 16) (:size 16 16)) 8 | ((:name :purple) (:offset 16 16) (:size 16 16)))) 9 | -------------------------------------------------------------------------------- /disp/collision.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/disp/collision.png -------------------------------------------------------------------------------- /disp/refmap/README: -------------------------------------------------------------------------------- 1 | Some games included in Blackthorn (for now, just Bunny Slayer) depend on the 2 | REFMAP graphics set. Because of the licensing terms provided by REFMAP, the 3 | graphics must be downloaded separately. A bash script has provided to automate 4 | this process. 5 | 6 | The REFMAP license is available at: 7 | http://www.tekepon.net/fsm/modules/refmap/ 8 | 9 | The download script can be invoked with: 10 | $ ./gettileset.sh 11 | -------------------------------------------------------------------------------- /disp/refmap/TileA1.config: -------------------------------------------------------------------------------- 1 | ((:name :TileA1) 2 | (:size 512 384) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileA2.config: -------------------------------------------------------------------------------- 1 | ((:name :TileA2) 2 | (:size 512 384) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileA3.config: -------------------------------------------------------------------------------- 1 | ((:name :TileA3) 2 | (:size 512 256) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileA4.config: -------------------------------------------------------------------------------- 1 | ((:name :TileA4) 2 | (:size 512 480) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileA5.config: -------------------------------------------------------------------------------- 1 | ((:name :TileA5) 2 | (:size 256 512) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileB.config: -------------------------------------------------------------------------------- 1 | ((:name :TileB) 2 | (:size 512 512) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileC.config: -------------------------------------------------------------------------------- 1 | ((:name :TileC) 2 | (:size 512 512) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileD.config: -------------------------------------------------------------------------------- 1 | ((:name :TileD) 2 | (:size 512 512) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/TileE.config: -------------------------------------------------------------------------------- 1 | ((:name :TileE) 2 | (:size 512 512) 3 | (:images)) 4 | -------------------------------------------------------------------------------- /disp/refmap/gettilesets.sh: -------------------------------------------------------------------------------- 1 | function download () { 2 | which wget 3 | if [ $? == 0 ] 4 | then 5 | wget $1 6 | else 7 | which curl 8 | if [ $? == 0 ] 9 | then 10 | curl $1 -o `basename $1` 11 | else 12 | echo "Can't find wget or curl. Don't know how to download files." 13 | fi 14 | fi 15 | } 16 | 17 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileA1.png' 18 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileA2.png' 19 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileA3.png' 20 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileA4.png' 21 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileA5.png' 22 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileB.png' 23 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileC.png' 24 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileD.png' 25 | download 'http://www.tekepon.net/fsm/modules/refmap/images/map/TileE.png' 26 | 27 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara01_a.png' 28 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara01_b.png' 29 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara02_b.png' 30 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara02_c.png' 31 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara04_a.png' 32 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara04_b.png' 33 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara06_a.png' 34 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara07_a.png' 35 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara07_b.png' 36 | download 'http://www.tekepon.net/fsm/modules/refmap/images/chara/vx_chara08_a.png' 37 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara01_a.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara01_a) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:timescale 4) 5 | (:images 6 | ((:name :hero-north-stand) (:offset 32 144) (:size 32 48)) 7 | ((:name :hero-north-walk-0) (:offset 0 144) (:size 32 48)) 8 | ((:name :hero-north-walk-1) (:offset 32 144) (:size 32 48)) 9 | ((:name :hero-north-walk-2) (:offset 64 144) (:size 32 48)) 10 | ((:name :hero-south-stand) (:offset 32 0) (:size 32 48)) 11 | ((:name :hero-south-walk-0) (:offset 0 0) (:size 32 48)) 12 | ((:name :hero-south-walk-1) (:offset 32 0) (:size 32 48)) 13 | ((:name :hero-south-walk-2) (:offset 64 0) (:size 32 48)) 14 | ((:name :hero-west-stand) (:offset 32 48) (:size 32 48)) 15 | ((:name :hero-west-walk-0) (:offset 0 48) (:size 32 48)) 16 | ((:name :hero-west-walk-1) (:offset 32 48) (:size 32 48)) 17 | ((:name :hero-west-walk-2) (:offset 64 48) (:size 32 48)) 18 | ((:name :hero-east-stand) (:offset 32 96) (:size 32 48)) 19 | ((:name :hero-east-walk-0) (:offset 0 96) (:size 32 48)) 20 | ((:name :hero-east-walk-1) (:offset 32 96) (:size 32 48)) 21 | ((:name :hero-east-walk-2) (:offset 64 96) (:size 32 48))) 22 | (:anims 23 | ((:name :hero-north-walk) (:images :hero-north-walk-0 :hero-north-walk-1 24 | :hero-north-walk-2 :hero-north-walk-1)) 25 | ((:name :hero-south-walk) (:images :hero-south-walk-0 :hero-south-walk-1 26 | :hero-south-walk-2 :hero-south-walk-1)) 27 | ((:name :hero-west-walk) (:images :hero-west-walk-0 :hero-west-walk-1 28 | :hero-west-walk-2 :hero-west-walk-1)) 29 | ((:name :hero-east-walk) (:images :hero-east-walk-0 :hero-east-walk-1 30 | :hero-east-walk-2 :hero-east-walk-1)))) 31 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara01_b.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara01_b) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara02_b.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara02_b) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara02_c.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara02_c) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara04_a.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara04_a) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara04_b.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara04_b) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara06_a.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara06_a) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara07_a.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara07_a) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara07_b.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara07_b) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/refmap/vx_chara08_a.config: -------------------------------------------------------------------------------- 1 | ((:name :vx_chara08_a) 2 | (:size 384 384) 3 | (:color-key-at 0 0) 4 | (:images)) 5 | -------------------------------------------------------------------------------- /disp/sheet.config: -------------------------------------------------------------------------------- 1 | ((:name :sheet) 2 | (:size 32 16) 3 | (:images 4 | ((:name :explosion) (:offset 0 0) (:size 16 16)) 5 | ((:name :hero) (:offset 16 0) (:size 16 16)))) 6 | -------------------------------------------------------------------------------- /disp/sheet.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/disp/sheet.png -------------------------------------------------------------------------------- /disp/thopter-item.config: -------------------------------------------------------------------------------- 1 | ((:name :thopter-item) 2 | (:size 1024 1024) 3 | (:images 4 | ((:name :spread-weapon) (:offset 0 0) (:size 128 128)) 5 | ((:name :chaingun-weapon) (:offset 128 0) (:size 128 128)) 6 | ((:name :missile-weapon) (:offset 256 0) (:size 128 128)) 7 | ((:name :laser-weapon) (:offset 384 0) (:size 128 128)) 8 | ((:name :selection0-primary) (:offset 0 128) (:size 16 16)) 9 | ((:name :selection0-secondary) (:offset 16 128) (:size 16 16)) 10 | ((:name :selection1-primary) (:offset 32 128) (:size 16 16)) 11 | ((:name :selection1-secondary) (:offset 48 128) (:size 16 16)) 12 | ((:name :selection2-primary) (:offset 0 144) (:size 16 16)) 13 | ((:name :selection2-secondary) (:offset 16 144) (:size 16 16)) 14 | ((:name :selection3-primary) (:offset 32 144) (:size 16 16)) 15 | ((:name :selection3-secondary) (:offset 48 144) (:size 16 16)) 16 | ((:name :cursor0) (:offset 0 160) (:size 32 16)) 17 | ((:name :cursor1) (:offset 32 160) (:size 32 16)) 18 | ((:name :cursor2) (:offset 0 176) (:size 32 16)) 19 | ((:name :cursor3) (:offset 32 176) (:size 32 16)))) 20 | -------------------------------------------------------------------------------- /disp/thopter-item.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/disp/thopter-item.png -------------------------------------------------------------------------------- /disp/thopter-screen.config: -------------------------------------------------------------------------------- 1 | ((:name :thopter-screen) 2 | (:size 1024 1024) 3 | (:images 4 | ((:name :title) (:offset 0 0) (:size 960 720)))) 5 | -------------------------------------------------------------------------------- /disp/thopter-screen.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/disp/thopter-screen.png -------------------------------------------------------------------------------- /disp/thopter.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/disp/thopter.png -------------------------------------------------------------------------------- /dist.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage :blackthorn-build 27 | (:nicknames :blt-build) 28 | (:use :cl) 29 | (:import-from :cl-user :*driver-system*) 30 | #+allegro (:import-from :excl :exit :generate-application :run-shell-command) 31 | #+sbcl (:import-from :sb-ext :save-lisp-and-die) 32 | #+clisp (:import-from :ext :quit :saveinitmem) 33 | #+clozure (:import-from :ccl :quit :save-application)) 34 | 35 | (in-package :blt-build) 36 | 37 | (defvar *driver-system* :blackthorn) 38 | 39 | ;;; 40 | ;;; Compile the system and associated driver. 41 | ;;; 42 | 43 | #+quicklisp 44 | (ql:quickload *driver-system*) 45 | 46 | #-quicklisp 47 | (require :asdf) 48 | #-quicklisp 49 | (asdf:oos 'asdf:load-op *driver-system*) 50 | 51 | #+allegro (asdf:oos 'asdf:load-op :com.gigamonkeys.asdf-extensions) 52 | #+allegro (com.gigamonkeys.asdf-extensions:build-one-fasl *driver-system*) 53 | 54 | #+allegro (defvar *driver-fasl* 55 | (make-pathname :name (symbol-name *driver-system*) :type "fasl")) 56 | 57 | ;;; 58 | ;;; Get trivial-features for convienience. 59 | ;;; 60 | 61 | (eval-when (:compile-toplevel :load-toplevel :execute) 62 | (asdf:oos 'asdf:load-op :trivial-features)) 63 | 64 | ;;; 65 | ;;; Some utilities. 66 | ;;; 67 | 68 | (defun cwd () 69 | (truename (make-pathname))) 70 | 71 | (defun append-directory (default-pathname &rest directories) 72 | (merge-pathnames 73 | (make-pathname :directory (cons :relative directories)) 74 | default-pathname)) 75 | 76 | ;;; 77 | ;;; Setup directories for build. 78 | ;;; 79 | 80 | (defconstant +working-dir+ (cwd)) 81 | 82 | (defconstant +build-dir+ (append-directory +working-dir+ "bin")) 83 | 84 | ;;; 85 | ;;; Ensure the build directory is empty. 86 | ;;; 87 | 88 | (ensure-directories-exist +build-dir+) 89 | 90 | ;;; 91 | ;;; Specify executable location. 92 | ;;; 93 | 94 | (defconstant +build-name+ "main") 95 | 96 | (defconstant +build-exe+ 97 | (make-pathname :directory (pathname-directory +build-dir+) 98 | :name +build-name+ 99 | #+windows :type #+windows "exe")) 100 | 101 | ;;; 102 | ;;; Make main executable, Allegro. 103 | ;;; 104 | 105 | #+allegro (defvar *debug* nil) 106 | #+allegro (defvar *console-app* nil) 107 | 108 | #+allegro 109 | (generate-application 110 | +build-name+ 111 | +build-dir+ 112 | (apply #'list :foreign :osi :sock "allegro-fixes.cl" *driver-fasl* 113 | (when *debug* '(:inspect :trace))) 114 | :allow-existing-directory t 115 | #+windows :icon-file 116 | #+windows 117 | (make-pathname :directory '(:relative "windows") :name "thopter" :type "ico") 118 | :restart-init-function 'blt-user:main 119 | #-windows 120 | :application-administration 121 | #-windows ;; Quiet startup (See below for Windows version of this.) 122 | '(:resource-command-line "-Q") 123 | :read-init-files nil ; don't read ACL init files 124 | :print-startup-message nil ; don't print ACL startup messages 125 | :ignore-command-line-arguments t ; ignore ACL (not app) cmd line options 126 | :suppress-allegro-cl-banner t 127 | 128 | ;; Change the following to `t', if: 129 | ;; - the program (vs. data) is large 130 | ;; - you'll have lots of users of the app (so sharing the code is important) 131 | :purify nil 132 | 133 | ;; don't give autoload warning, but you should still be aware that 134 | ;; autoloads.out will contain a list of autoloadable names. 135 | :autoload-warning nil 136 | 137 | :include-debugger *debug* 138 | :include-tpl *debug* 139 | :include-ide nil 140 | :include-devel-env nil 141 | :include-compiler nil 142 | :discard-arglists (not *debug*) 143 | :discard-local-name-info (not *debug*) 144 | :discard-source-file-info (not *debug*) 145 | :discard-xref-info (not *debug*) 146 | 147 | ;; for debugging: 148 | :verbose nil 149 | :build-input "build.in" 150 | :build-output "build.out" 151 | 152 | :runtime :standard 153 | ) 154 | 155 | #+(and allegro mswindows) ;; Quiet startup: 156 | (when (not *console-app*) 157 | (run-shell-command 158 | ;; Replace +cm with +cn to see the window, but have it not be in the 159 | ;; foreground. 160 | (format nil "\"~a\" -o \"~a\" +B +M +cm -Q" 161 | (translate-logical-pathname "sys:bin;setcmd.exe") 162 | +build-exe+) 163 | :show-window :hide)) 164 | 165 | #+(and allegro mswindows) 166 | (when *console-app* 167 | (delete-file +build-exe+) 168 | (sys:copy-file "sys:buildi.exe" +build-exe+)) 169 | 170 | #+allegro (exit) 171 | 172 | ;;; 173 | ;;; Make main executable, SBCL. 174 | ;;; 175 | 176 | #+sbcl (save-lisp-and-die +build-exe+ :toplevel #'blt-user:main :executable t) 177 | 178 | ;;; 179 | ;;; Make main executable, CLISP. 180 | ;;; 181 | 182 | #+clisp 183 | (saveinitmem +build-exe+ :init-function #'blt-user:main :executable t :norc t) 184 | #+clisp (quit) 185 | 186 | ;;; 187 | ;;; Make main executable, CCL. 188 | ;;; 189 | 190 | #+clozure 191 | (save-application +build-exe+ :toplevel-function #'blt-user:main 192 | :prepend-kernel t) 193 | #+clozure (quit) 194 | -------------------------------------------------------------------------------- /dmg_utils.make: -------------------------------------------------------------------------------- 1 | # 2 | # Build file for creating DMG files. 3 | # 4 | # The DMG packager looks for a template.dmg.bz2 for using as its 5 | # DMG template. If it doesn't find one, it generates a clean one. 6 | # 7 | # If you create a DMG template, you should make one containing all 8 | # the files listed in $(SOURCE_FILES) below, and arrange everything to suit 9 | # your style. The contents of the files themselves does not matter, so 10 | # they can be empty (they will be overwritten later). 11 | # 12 | # Remko Tronçon 13 | # http://el-tramo.be/about 14 | # Licensed under the MIT License. See COPYING for details. 15 | 16 | 17 | ################################################################################ 18 | # Customizable variables 19 | ################################################################################ 20 | 21 | NAME ?= MyApp 22 | VERSION ?= 0.1 23 | 24 | SOURCE_DIR ?= src 25 | SOURCE_FILES ?= MyApp.app README COPYING 26 | 27 | TEMPLATE_DMG ?= template.dmg 28 | 29 | 30 | ################################################################################ 31 | # DMG building. No editing should be needed beyond this point. 32 | ################################################################################ 33 | 34 | MASTER_DMG=$(NAME)-$(VERSION).dmg 35 | WC_DMG=wc.dmg 36 | WC_DIR=wc 37 | 38 | .PHONY: all 39 | all: $(MASTER_DMG) 40 | 41 | $(TEMPLATE_DMG): $(TEMPLATE_DMG).bz2 42 | bunzip2 -k $< 43 | 44 | $(TEMPLATE_DMG).bz2: 45 | @echo 46 | @echo --------------------- Generating empty template -------------------- 47 | mkdir template 48 | hdiutil create -fs HFSX -layout SPUD -size 100m "$(TEMPLATE_DMG)" -srcfolder template -format UDRW -volname "$(NAME)" -quiet 49 | rmdir template 50 | bzip2 "$(TEMPLATE_DMG)" 51 | @echo 52 | 53 | $(WC_DMG): $(TEMPLATE_DMG) 54 | cp $< $@ 55 | 56 | $(MASTER_DMG): $(WC_DMG) $(addprefix $(SOURCE_DIR)/,$(SOURCE_FILES)) 57 | @echo 58 | @echo --------------------- Creating Disk Image -------------------- 59 | mkdir -p $(WC_DIR) 60 | hdiutil attach "$(WC_DMG)" -noautoopen -quiet -mountpoint "$(WC_DIR)" 61 | for i in $(SOURCE_FILES); do \ 62 | rm -rf "$(WC_DIR)/$$i"; \ 63 | ditto -rsrc "$(SOURCE_DIR)/$$i" "$(WC_DIR)/$$i"; \ 64 | done 65 | #rm -f "$@" 66 | #hdiutil create -srcfolder "$(WC_DIR)" -format UDZO -imagekey zlib-level=9 "$@" -volname "$(NAME) $(VERSION)" -scrub -quiet 67 | WC_DEV=`hdiutil info | grep "$(WC_DIR)" | grep "Apple_HFS" | awk '{print $$1}'` && \ 68 | hdiutil detach $$WC_DEV -quiet -force 69 | rm -f "$(MASTER_DMG)" 70 | hdiutil convert "$(WC_DMG)" -quiet -format UDZO -imagekey zlib-level=9 -o "$@" 71 | rm -rf $(WC_DIR) 72 | @echo 73 | 74 | .PHONY: clean 75 | clean: 76 | -rm -rf $(TEMPLATE_DMG) $(MASTER_DMG) $(WC_DMG) 77 | -------------------------------------------------------------------------------- /load.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defvar *driver-system* :thopter) 27 | 28 | (eval-when (:compile-toplevel :load-toplevel :execute) 29 | (when (find-package :swank) 30 | (pushnew :blt-debug *features*))) 31 | 32 | ;; Load and run main: 33 | #+quicklisp 34 | (ql:quickload *driver-system*) 35 | 36 | #-quicklisp 37 | (require :asdf) 38 | #-quicklisp 39 | (asdf:operate 'asdf:load-op *driver-system*) 40 | 41 | (blt-user::main) 42 | -------------------------------------------------------------------------------- /macosx/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | CFBundleDevelopmentRegion 6 | English 7 | CFBundleExecutable 8 | main 9 | CFBundleIconFile 10 | app.icns 11 | CFBundleIdentifier 12 | com.sbcl.@NAME@ 13 | CFBundleInfoDictionaryVersion 14 | 6.0 15 | CFBundleName 16 | @LONGNAME@ 17 | CFBundlePackageType 18 | APPL 19 | CFBundleSignature 20 | ???? 21 | CFBundleVersion 22 | @VERSION@ 23 | NSPrincipalClass 24 | NSApplication 25 | CFBundleShortVersionString 26 | @VERSION@ 27 | 28 | 29 | -------------------------------------------------------------------------------- /macosx/PkgInfo: -------------------------------------------------------------------------------- 1 | APPL???? -------------------------------------------------------------------------------- /macosx/bt.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/macosx/bt.icns -------------------------------------------------------------------------------- /macosx/thopter.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/macosx/thopter.icns -------------------------------------------------------------------------------- /profile.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defvar *driver-system* :blackthorn) 27 | 28 | #+quicklisp 29 | (ql:quickload *driver-system*) 30 | 31 | #-quicklisp 32 | (require :asdf) 33 | #-quicklisp 34 | (asdf:operate 'asdf:load-op *driver-system*) 35 | 36 | ;;; -------------------------------------------------------------------------- 37 | ;;; Setup profiler and run main. 38 | ;;; -------------------------------------------------------------------------- 39 | 40 | (in-package :blt-user) 41 | 42 | (defun exit ()) 43 | 44 | (defmacro profile-packages (&rest packages) 45 | `(progn 46 | ,@(loop for package in packages collect 47 | `(progn 48 | ,@(loop for symbol being the external-symbols in package 49 | when (fboundp symbol) 50 | collect 51 | #+sbcl `(sb-profile:profile ,symbol)))))) 52 | 53 | (profile-packages blt blt-user) 54 | 55 | (main) 56 | 57 | #+sbcl (sb-profile:report) 58 | 59 | #+sbcl (sb-ext:quit) 60 | -------------------------------------------------------------------------------- /property.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defvar *system*) 27 | 28 | (defvar *driver-system* :blackthorn) 29 | (defvar *output-file* ".tmp") 30 | (defvar *output-expression* '(asdf:component-name *system*)) 31 | 32 | (require :asdf) 33 | 34 | (let ((*system* (asdf:find-system *driver-system*))) 35 | (with-open-file (f *output-file* :direction :output :if-exists :supersede) 36 | (princ (eval *output-expression*) f))) 37 | 38 | #+allegro (exit) #-allegro (quit) -------------------------------------------------------------------------------- /sound/COPYRIGHT: -------------------------------------------------------------------------------- 1 | The file music.mp3 is Oslodum 2004 by DJ Dolores, and is provided 2 | under the Creative Commons license. It can be obtained from the 3 | following url: 4 | 5 | http://creativecommons.org/wired 6 | 7 | All the other files in this directory are under the same license as 8 | the rest of the project. See the COPYRIGHT file in the root directory. 9 | -------------------------------------------------------------------------------- /sound/README: -------------------------------------------------------------------------------- 1 | These files came from the lispbuilder-sdl-mixer examples directory: 2 | 3 | http://lispbuilder.googlecode.com/svn/trunk/lispbuilder-sdl-mixer/examples/ 4 | 5 | These files are available under the lispbuilder license, which is an MIT-style 6 | license. 7 | -------------------------------------------------------------------------------- /sound/beep.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/sound/beep.ogg -------------------------------------------------------------------------------- /sound/missile.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/sound/missile.ogg -------------------------------------------------------------------------------- /sound/music.mp3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/sound/music.mp3 -------------------------------------------------------------------------------- /sound/phaser.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/sound/phaser.wav -------------------------------------------------------------------------------- /sound/thopterblades.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/sound/thopterblades.ogg -------------------------------------------------------------------------------- /sound/thoptergun.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/sound/thoptergun.ogg -------------------------------------------------------------------------------- /src/blackthorn/actor.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-physics) 27 | 28 | ;;; 29 | ;;; Actors 30 | ;;; 31 | 32 | (defclass actor (component key-mixin) 33 | ()) 34 | 35 | (defmethod initialize-instance :after ((actor actor) &key) 36 | (bind actor :update #'update)) 37 | 38 | ;;; 39 | ;;; Sprites 40 | ;;; 41 | 42 | (defclass sprite (actor) 43 | ((image 44 | :accessor image 45 | :initarg :image 46 | :initform nil))) 47 | 48 | (defmethod initialize-instance :after ((sprite sprite) &key) 49 | (with-slots (image) sprite 50 | (when image 51 | (setf (size sprite) (size image) 52 | (bbox-offset sprite) (bbox-offset image) 53 | (bbox-size sprite) (bbox-size image))))) 54 | 55 | (defmethod (setf image) :after (image (sprite sprite)) 56 | (when image 57 | (setf (size sprite) (size image) 58 | (bbox-offset sprite) (bbox-offset image) 59 | (bbox-size sprite) (bbox-size image)))) 60 | 61 | (defmethod draw ((sprite sprite) xy z) 62 | (with-slots (image) sprite 63 | (draw image xy z))) 64 | 65 | (defmethod update :before ((sprite sprite) event) 66 | (next-image (image sprite))) 67 | 68 | ;;; 69 | ;;; Mobiles 70 | ;;; 71 | 72 | (defclass mobile (actor) 73 | ((veloc 74 | :accessor veloc 75 | :initarg :veloc 76 | :initform #c(0 0)) 77 | (accel 78 | :accessor accel 79 | :initarg :accel 80 | :initform #c(0 0)))) 81 | 82 | (defmethod update :before ((mobile mobile) event) 83 | (with-slots (offset veloc accel) mobile 84 | (incf offset veloc) 85 | (incf veloc accel))) 86 | -------------------------------------------------------------------------------- /src/blackthorn/collision.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-physics) 27 | 28 | ;;; 29 | ;;; Collidables 30 | ;;; 31 | 32 | (defgeneric collision-rect (object)) 33 | (defgeneric reactive-collisions-only-p (object)) 34 | 35 | (defclass collidable (actor) 36 | ((collision-offset 37 | :initform #c(0 0)) 38 | (reactive-collisions-only-p 39 | :accessor reactive-collisions-only-p 40 | :initarg :reactive-collisions-only-p 41 | :initform nil))) 42 | 43 | (defgeneric collide (object event)) 44 | (defmethod collide (object event) 45 | (declare (ignore object event))) 46 | 47 | (defmethod initialize-instance :after ((collidable collidable) &key) 48 | (bind collidable :collide #'collide)) 49 | 50 | (defclass collision-grid () 51 | ((collision-grid 52 | :initform (make-hash-table)) 53 | (collision-square-size 54 | :initform 32))) 55 | 56 | (defmacro with-collision-grid-iterate ((var (grid xy1 xy2) &key outer-label) 57 | &body body) 58 | (with-gensyms (g sq i1 j1 i2 j2 i j) 59 | (once-only (grid xy1 xy2) 60 | `(with-slots ((,g collision-grid) (,sq collision-square-size)) ,grid 61 | (let ((,i1 (truncate (x ,xy1) ,sq)) 62 | (,j1 (truncate (y ,xy1) ,sq)) 63 | (,i2 (truncate (x ,xy2) ,sq)) 64 | (,j2 (truncate (y ,xy2) ,sq))) 65 | (iter ,@(when outer-label (list outer-label)) 66 | (for ,i from ,i1 to ,i2) 67 | (iter (for ,j from ,j1 to ,j2) 68 | (symbol-macrolet 69 | (,(when var `(,var (gethash (complex ,i ,j) ,g)))) 70 | ,@body)))))))) 71 | 72 | (defgeneric collision-grid-insert-node (grid node xy)) 73 | (defmethod collision-grid-insert-node (grid node xy) 74 | (declare (ignore grid node))) 75 | (defmethod collision-grid-insert-node (grid (node collidable) xy) 76 | (with-slots (size (offset collision-offset) bbox-size bbox-offset) node 77 | (when (not (zerop bbox-size)) 78 | (setf offset (+ xy bbox-offset)) 79 | (with-collision-grid-iterate (nodes (grid xy (+ xy bbox-size))) 80 | (push node nodes))))) 81 | 82 | (defgeneric collision-grid-search-node (grid node thunk)) 83 | (defmethod collision-grid-search-node (grid node thunk) 84 | (declare (ignore grid node thunk))) 85 | (let ((collisions (make-hash-table))) 86 | (defmethod collision-grid-search-node (grid (node collidable) thunk) 87 | (with-slots ((s1 bbox-size) (xy1 collision-offset) 88 | (r1-p reactive-collisions-only-p)) node 89 | (unless r1-p 90 | (let ((x1 (x xy1)) (y1 (y xy1)) (w1 (x s1)) (h1 (y s1))) 91 | (with-collision-grid-iterate (nodes (grid xy1 (+ xy1 s1))) 92 | (iter (for other in nodes) 93 | (when (not (eql node other)) 94 | (with-slots ((xy2 collision-offset) (s2 bbox-size)) other 95 | (let ((x2 (x xy2)) (y2 (y xy2)) 96 | (w2 (x s2)) (h2 (y s2))) 97 | (unless (or (<= (+ x1 w1) x2) 98 | (<= (+ x2 w2) x1) 99 | (<= (+ y1 h1) y2) 100 | (<= (+ y2 h2) y1)) 101 | (setf (gethash other collisions) t)))))))) 102 | (iter (for (other nil) in-hashtable collisions) 103 | (with-slots ((r2-p reactive-collisions-only-p)) other 104 | (funcall thunk node other) 105 | (when r2-p (funcall thunk other node)))) 106 | (clrhash collisions) 107 | nil)))) 108 | 109 | (defun collision-grid-search-nearest (grid node radius 110 | &key (test (constantly t))) 111 | (with-slots ((offset collision-offset) size) node 112 | (let ((circle (complex radius radius))) 113 | (with-collision-grid-iterate (nodes (grid (- offset circle) 114 | (+ offset circle size)) 115 | :outer-label outer) 116 | (iter (for other in nodes) 117 | (when (and (not (eql node other)) (funcall test other)) 118 | (with-slots ((other-offset collision-offset) 119 | (other-size size)) other 120 | (in outer (finding other minimizing 121 | (dist (+ offset (/ size 2)) 122 | (+ other-offset (/ other-size 2))) 123 | into min)))) 124 | (in outer 125 | (finally 126 | (when min 127 | (with-slots ((other-offset collision-offset) 128 | (other-size size)) min 129 | (when (< (dist (+ offset (/ size 2)) 130 | (+ other-offset (/ other-size 2))) 131 | (+ radius (/ (+ (x size) (y size)) 2d0))) 132 | (return-from outer min))))))))))) 133 | 134 | (defvar *collision-grid*) 135 | 136 | (defun collision-grid-update (root) 137 | (unless (boundp '*collision-grid*) 138 | (setf *collision-grid* (make-instance 'collision-grid))) 139 | (labels ((insert-helper (node xy) 140 | (collision-grid-insert-node *collision-grid* node xy))) 141 | (with-slots (collision-grid) *collision-grid* 142 | (clrhash collision-grid)) 143 | (walk-tree root #'insert-helper))) 144 | 145 | (defun collision-grid-search (root thunk) 146 | (labels ((search-helper (node xy) 147 | (declare (ignore xy)) 148 | (collision-grid-search-node *collision-grid* node thunk))) 149 | (walk-tree root #'search-helper))) 150 | 151 | (defun collision-update (root) 152 | (collision-grid-update root)) 153 | 154 | (defun collision-search (root thunk) 155 | (collision-grid-search root thunk)) 156 | 157 | (defun find-nearest-object (node radius &key (test (constantly t))) 158 | (collision-grid-search-nearest *collision-grid* node radius :test test)) 159 | 160 | ;;; 161 | ;;; Collision Events 162 | ;;; 163 | 164 | (defclass collision-event (event) 165 | ((type :initform :collide) 166 | (hit 167 | :reader event-hit 168 | :initarg :hit))) 169 | -------------------------------------------------------------------------------- /src/blackthorn/component.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-physics) 27 | 28 | ;;; 29 | ;;; Components 30 | ;;; 31 | 32 | (defclass component () 33 | ((offset 34 | :accessor offset 35 | :initarg :offset 36 | :initform #c(0 0)) 37 | (depth 38 | :accessor depth 39 | :initarg :depth 40 | :initform 0) 41 | (size 42 | :accessor size 43 | :initarg :size 44 | :initform #c(0 0)) 45 | (parent 46 | :reader parent 47 | :initform nil) 48 | (children 49 | :reader children 50 | :initform (vector)) 51 | (bbox-offset 52 | :accessor bbox-offset 53 | :initform #c(0 0)) 54 | (bbox-size 55 | :accessor bbox-size 56 | :initform #c(0 0)))) 57 | 58 | (defmethod initialize-instance :after ((component component) &key parent) 59 | (when parent 60 | (attach parent component))) 61 | 62 | (defmethod attach ((parent component) (child component)) 63 | (with-slots (children) parent 64 | (with-slots ((childs-parent parent)) child 65 | (when childs-parent 66 | (detach childs-parent child)) 67 | (setf children (merge 'vector children (vector child) #'> :key #'depth)) 68 | (setf childs-parent parent)))) 69 | 70 | (defmethod detach ((parent component) (child component)) 71 | (with-slots (children) parent 72 | (with-slots ((childs-parent parent)) child 73 | (setf children (delete child children)) 74 | (setf childs-parent nil)))) 75 | 76 | (defmacro do-children ((var component) &body body) 77 | `(loop for ,var across (slot-value ,component 'children) 78 | do (progn ,@body))) 79 | 80 | (defun walk-tree (component func &optional test (xy #c(0 0))) 81 | (when (or (not test) (funcall test component)) 82 | (with-slots (offset) component 83 | (let ((xy (when xy (+ xy offset)))) 84 | (funcall func component xy) 85 | (do-children (child component) 86 | (walk-tree child func test xy)))))) 87 | 88 | (defun first-neg-depth (children) 89 | (position-if #'(lambda (x) (< (slot-value x 'depth) 0)) children)) 90 | 91 | (defmethod render ((component component) xy zmin zmax) 92 | (with-slots (children offset) component 93 | (let ((xy (+ xy offset)) 94 | (n (array-dimension children 0))) 95 | (if (not (zerop n)) 96 | (let ((median (or (first-neg-depth children) n)) 97 | (dz (/ (- zmax zmin) 2.0d0 n))) 98 | (iter (for child in-vector children below median) 99 | (for z initially zmax then (- z dz)) 100 | (render child xy (- z dz) z)) 101 | (draw component xy (/ (+ zmax zmin) 2d0)) 102 | (iter (for child in-vector children from median) 103 | (for z initially (/ (+ zmax zmin) 2d0) then (- z dz)) 104 | (render child xy (- z dz) z))) 105 | (draw component xy (/ (+ zmax zmin) 2d0)))))) 106 | 107 | (defmethod draw ((component component) xy z) 108 | (declare (ignore component xy z))) 109 | 110 | (defmethod update ((component component) event) 111 | (declare (ignore component event))) 112 | -------------------------------------------------------------------------------- /src/blackthorn/event.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-physics) 27 | 28 | ;;; 29 | ;;; Events 30 | ;;; 31 | 32 | (defclass event () 33 | ((type 34 | :reader event-type 35 | :initarg :type))) 36 | 37 | ;;; 38 | ;;; Event Mixin 39 | ;;; 40 | 41 | (defclass event-mixin () 42 | ((handlers 43 | :accessor event-handlers 44 | :initform (make-hash-table)))) 45 | 46 | (defmethod bound-p ((object event-mixin) event) 47 | (multiple-value-bind (value exists) (gethash event (event-handlers object)) 48 | (declare (ignore value)) 49 | exists)) 50 | 51 | (defmethod bind ((object event-mixin) event thunk) 52 | (with-slots (handlers) object 53 | (setf (gethash event handlers) thunk))) 54 | 55 | (defmethod unbind ((object event-mixin) event) 56 | (with-slots (handlers) object 57 | (remhash event handlers))) 58 | 59 | (defgeneric dispatch-event (object event)) 60 | (defmethod dispatch-event ((object event-mixin) (event event)) 61 | (with-slots (handlers) object 62 | (let ((handler (gethash (event-type event) handlers))) 63 | (when handler 64 | (funcall handler object event))))) 65 | 66 | ;;; 67 | ;;; Event Subscriptions 68 | ;;; 69 | 70 | (defclass event-subscription (event-mixin) 71 | ((subscribers 72 | :accessor event-subscribers 73 | :initform nil))) 74 | 75 | (defmethod initialize-instance :after 76 | ((subscription event-subscription) &key types) 77 | (iter (for type in types) 78 | (unless (bound-p subscription type) 79 | (bind subscription type #'dispatch-event)))) 80 | 81 | (defmethod subscribe 82 | ((subscription event-subscription) (subscriber event-mixin)) 83 | (pushnew subscriber (event-subscribers subscription))) 84 | 85 | (defmethod unsubscribe 86 | ((subscription event-subscription) (subscriber event-mixin)) 87 | (setf (event-subscribers subscription) 88 | (delete subscriber (event-subscribers subscription)))) 89 | 90 | (defmethod dispatch-event ((subscription event-subscription) (event event)) 91 | (iter (for subscriber in (event-subscribers subscription)) 92 | (dispatch-event subscriber event))) 93 | -------------------------------------------------------------------------------- /src/blackthorn/fonts.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-graphics) 27 | 28 | ;;; 29 | ;;; Graphics Utilities 30 | ;;; 31 | 32 | (defvar *font-width* 256) 33 | (defvar *font-height* 256) 34 | (defvar *font-char-code-min* 0) 35 | (defvar *font-char-code-max* 255) 36 | 37 | (defun font-to-surface (font) 38 | (let* ((char-width (sdl:char-width font)) 39 | (char-height (sdl:char-height font)) 40 | (row-length (floor *font-width* char-width)) 41 | (row-count (ceiling (- *font-char-code-max* *font-char-code-min*) 42 | row-length)) 43 | (surface (sdl:create-surface 44 | *font-width* *font-height* :bpp 32 :pixel-alpha t))) 45 | (assert (< (* row-count char-height) *font-height*)) 46 | (sdl:fill-surface sdl:*black* :surface surface) 47 | (iter (for r from 0 below row-count) 48 | (for c0 from *font-char-code-min* 49 | below *font-char-code-max* by row-length) 50 | (let ((string 51 | (iter (for c from c0 52 | below (min (+ c0 row-length) *font-char-code-max*)) 53 | (collect (code-char c) result-type string)))) 54 | (sdl:draw-string-solid-* 55 | string 0 (* r char-height) 56 | :font font :color sdl:*white* :surface surface))) 57 | surface)) 58 | 59 | (defun font-to-texture (font) 60 | (surface-to-texture (font-to-surface font))) 61 | 62 | ;;; 63 | ;;; Fonts 64 | ;;; 65 | 66 | (defclass font () 67 | ((name 68 | :reader name 69 | :initarg :name) 70 | (source 71 | :initarg :source) 72 | sdl-font 73 | char-size 74 | texture)) 75 | 76 | (defvar *fonts* 77 | (let ((table (make-hash-table))) 78 | (setf (gethash :font-10x20 table) 79 | (make-instance 'font :name :font-10x20 :source sdl:*font-10x20*) 80 | (gethash :font-5x7 table) 81 | (make-instance 'font :name :font-5x7 :source sdl:*font-5x7*) 82 | (gethash :font-5x8 table) 83 | (make-instance 'font :name :font-5x8 :source sdl:*font-5x8*) 84 | (gethash :font-6x10 table) 85 | (make-instance 'font :name :font-6x10 :source sdl:*font-6x10*) 86 | (gethash :font-6x12 table) 87 | (make-instance 'font :name :font-6x12 :source sdl:*font-6x12*) 88 | (gethash :font-6x13 table) 89 | (make-instance 'font :name :font-6x13 :source sdl:*font-6x13*) 90 | (gethash :font-6x13b table) 91 | (make-instance 'font :name :font-6x13b :source sdl:*font-6x13b*) 92 | (gethash :font-6x13o table) 93 | (make-instance 'font :name :font-6x13o :source sdl:*font-6x13o*) 94 | (gethash :font-6x9 table) 95 | (make-instance 'font :name :font-6x9 :source sdl:*font-6x9*) 96 | (gethash :font-7x13 table) 97 | (make-instance 'font :name :font-7x13 :source sdl:*font-7x13*) 98 | (gethash :font-7x13b table) 99 | (make-instance 'font :name :font-7x13b :source sdl:*font-7x13b*) 100 | (gethash :font-7x13o table) 101 | (make-instance 'font :name :font-7x13o :source sdl:*font-7x13o*) 102 | (gethash :font-7x14 table) 103 | (make-instance 'font :name :font-7x14 :source sdl:*font-7x14*) 104 | (gethash :font-7x14b table) 105 | (make-instance 'font :name :font-7x14b :source sdl:*font-7x14b*) 106 | (gethash :font-8x13 table) 107 | (make-instance 'font :name :font-8x13 :source sdl:*font-8x13*) 108 | (gethash :font-8x13b table) 109 | (make-instance 'font :name :font-8x13b :source sdl:*font-8x13b*) 110 | (gethash :font-8x13o table) 111 | (make-instance 'font :name :font-8x13o :source sdl:*font-8x13o*) 112 | (gethash :font-8x8 table) 113 | (make-instance 'font :name :font-8x8 :source sdl:*font-8x8*) 114 | (gethash :font-9x15 table) 115 | (make-instance 'font :name :font-9x15 :source sdl:*font-9x15*) 116 | (gethash :font-9x15b table) 117 | (make-instance 'font :name :font-9x15b :source sdl:*font-9x15b*) 118 | (gethash :font-9x18 table) 119 | (make-instance 'font :name :font-9x18 :source sdl:*font-9x18*) 120 | (gethash :font-9x18b table) 121 | (make-instance 'font :name :font-9x18b :source sdl:*font-9x18b*)) 122 | table)) 123 | 124 | (defun load-font (name) 125 | (let ((font (gethash name *fonts*))) 126 | (unless (slot-boundp font 'texture) 127 | (with-slots (source sdl-font char-size texture) font 128 | (setf sdl-font (sdl:initialise-font source) 129 | char-size (complex (sdl:char-width sdl-font) 130 | (sdl:char-height sdl-font)) 131 | texture (font-to-texture sdl-font)))) 132 | font)) 133 | 134 | ;;; 135 | ;;; Text 136 | ;;; 137 | 138 | (defclass text () 139 | ((source 140 | :initarg :source) 141 | (font 142 | :initarg :font) 143 | (color 144 | :initarg :color) 145 | (size 146 | :reader size) 147 | (bbox-offset 148 | :reader bbox-offset 149 | :initform #c(0 0)) 150 | (bbox-size 151 | :reader bbox-size 152 | :initform #c (0 0)) 153 | )) 154 | 155 | (defmethod initialize-instance :after ((text text) &key) 156 | (with-slots (source font size) text 157 | (with-slots (char-size) font 158 | (setf size (complex (* (length source) (x char-size)) (y char-size)))))) 159 | 160 | (defmethod draw ((text text) xy z) 161 | (with-slots (source font color size) text 162 | (with-slots (texture char-size) font 163 | (gl:end) 164 | (gl:bind-texture :texture-2d texture) 165 | (gl:with-primitive :quads 166 | (let* ((width-f (* *font-width* 1d0)) (height-f (* *font-height* 1d0)) 167 | (row-length (floor *font-width* (x char-size)))) 168 | (iter (for c in-string source) (for i from 0 by (x char-size)) 169 | (assert 170 | (<= *font-char-code-min* (char-code c) *font-char-code-max*)) 171 | (let* ((x1 (+ (truncate (x xy)) i)) 172 | (x2 (+ x1 (x char-size))) 173 | (y1 (truncate (y xy))) 174 | (y2 (+ y1 (y char-size))) 175 | (tx1 (* (mod (- (char-code c) *font-char-code-min*) 176 | row-length) 177 | (/ (x char-size) width-f))) 178 | (tx2 (+ tx1 (/ (x char-size) width-f))) 179 | (ty1 (* (floor (- (char-code c) *font-char-code-min*) 180 | row-length) 181 | (/ (y char-size) height-f))) 182 | (ty2 (+ ty1 (/ (y char-size) height-f)))) 183 | (gl:tex-coord tx1 ty1) (gl:vertex x1 y1 z) 184 | (gl:tex-coord tx2 ty1) (gl:vertex x2 y1 z) 185 | (gl:tex-coord tx2 ty2) (gl:vertex x2 y2 z) 186 | (gl:tex-coord tx1 ty2) (gl:vertex x1 y2 z))))) 187 | (gl:bind-texture :texture-2d *active-texture*) 188 | (gl:begin :quads)))) 189 | 190 | (defmethod next-image ((text text)) 191 | (declare (ignore text))) 192 | 193 | ;;; 194 | ;;; Creation Utilities 195 | ;;; 196 | 197 | (defun make-font (name) 198 | (load-font name)) 199 | 200 | (defun make-text (string font) 201 | (make-instance 'text :source string :font font :color sdl:*white*)) 202 | -------------------------------------------------------------------------------- /src/blackthorn/game.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-physics) 27 | 28 | (defclass game (event-subscription) 29 | ((game-screen 30 | :reader game-screen 31 | :initform nil) 32 | (game-screen-next 33 | :accessor game-screen-next 34 | :initform nil) 35 | (game-root 36 | :accessor game-root 37 | :initform nil) 38 | (game-view 39 | :accessor game-view 40 | :initform nil) 41 | (game-sheet 42 | :accessor game-sheet 43 | :initform nil) 44 | (game-keys 45 | :accessor game-keys 46 | :initform (make-instance 'event-subscription :types '(:key-down :key-up))) 47 | (event-queue 48 | :reader event-queue 49 | :initform (make-instance 'containers:basic-queue)))) 50 | 51 | (defmacro delegate (class &rest accessors) 52 | (with-gensyms (game screen value) 53 | `(progn 54 | ,@(iter (for accessor in accessors) 55 | (collect 56 | `(defmethod ,accessor ((,game ,class)) 57 | (let ((,screen (game-screen ,game))) 58 | (if ,screen 59 | (,accessor ,screen) 60 | (slot-value ,game ',accessor))))) 61 | (collect 62 | `(defmethod (setf ,accessor) (,value (,game ,class)) 63 | (let ((,screen (game-screen ,game))) 64 | (if ,screen 65 | (setf (,accessor ,screen) ,value) 66 | (setf (slot-value ,game ',accessor) ,value))))))))) 67 | 68 | (delegate game game-root game-view game-sheet) 69 | 70 | (defun apply-screen-next (game) 71 | (with-slots (game-screen game-screen-next) game 72 | (when game-screen (unsubscribe game game-screen)) 73 | (setf game-screen game-screen-next) 74 | (when game-screen (subscribe game game-screen)))) 75 | 76 | (defmethod initialize-instance :after ((game game) &key) 77 | (subscribe game (game-keys game))) 78 | 79 | (defvar *game*) 80 | 81 | (defmethod game-init :before ((game game) &key &allow-other-keys) 82 | (apply-screen-next game) 83 | (if (game-view game) 84 | (window (size (game-view game))) 85 | (warn "No view for game ~a: Unable to initialize window.~%" game))) 86 | 87 | (defmethod render ((game game) xy zmin zmax) 88 | (apply-screen-next game) 89 | (activate (game-sheet game)) 90 | (with-slots (offset size) (game-view game) 91 | (gl:with-pushed-matrix 92 | (gl:ortho 0 (x size) (y size) 0 -1 1) 93 | (gl:with-primitive :quads 94 | (render (game-root game) (+ xy offset) zmin zmax))))) 95 | 96 | ;;; 97 | ;;; Screens 98 | ;;; 99 | 100 | (defclass screen (event-subscription) 101 | ((game 102 | :reader game 103 | :initarg :game) 104 | (game-root 105 | :accessor game-root 106 | :initform nil) 107 | (game-view 108 | :accessor game-view 109 | :initform nil) 110 | (game-sheet 111 | :accessor game-sheet 112 | :initform nil) 113 | (game-keys 114 | :accessor game-keys 115 | :initform (make-instance 'event-subscription :types '(:key-down :key-up))))) 116 | 117 | (defmethod initialize-instance :after ((screen screen) &key) 118 | (subscribe screen (game-keys screen))) 119 | 120 | (defmethod activate ((screen screen)) 121 | (setf (game-screen-next (game screen)) screen)) 122 | 123 | ;;; 124 | ;;; Game Event Queue 125 | ;;; 126 | 127 | (defgeneric send-event (game target event)) 128 | 129 | (defmethod send-event ((game game) target (event event)) 130 | (declare (ignore game target event))) 131 | 132 | (defmethod send-event ((game game) (target event-mixin) (event event)) 133 | (containers:enqueue (event-queue game) (list target event))) 134 | 135 | (defun send (target event) 136 | "@arg[target]{An @class{event-mixin}.} 137 | @arg[event]{An @class{event}.} 138 | @short{Schedules an event for dispatch at a future time.} The event will be 139 | delivered to the target object during the update portion of the game loop." 140 | (send-event *game* target event)) 141 | 142 | (defun game-update-events (game-root event-queue) 143 | (labels ((event-update (actor xy) 144 | (declare (ignore xy)) 145 | (send actor (make-instance 'event :type :update))) 146 | (event-collide (node other) 147 | (send node (make-instance 'collision-event :hit other))) 148 | (apply-dispatch-event (args) (apply #'dispatch-event args))) 149 | (collision-update game-root) 150 | (walk-tree game-root #'event-update) 151 | (containers:iterate-elements event-queue #'apply-dispatch-event) 152 | (containers:empty! event-queue) 153 | (collision-update game-root) 154 | (collision-search game-root #'event-collide) 155 | (containers:iterate-elements event-queue #'apply-dispatch-event) 156 | (containers:empty! event-queue))) 157 | 158 | (defmethod game-update ((game game)) 159 | (apply-screen-next game) 160 | (let ((screen (game-screen game))) 161 | (if screen 162 | (game-update screen) 163 | (game-update-events (game-root game) (event-queue game))))) 164 | 165 | (defmethod game-update ((screen screen)) 166 | (game-update-events (game-root screen) (event-queue (game screen)))) 167 | 168 | ;;; 169 | ;;; Game Quit Event 170 | ;;; 171 | 172 | (defclass quit-event (event) 173 | ((type :initform :quit) 174 | (quit 175 | :accessor event-quit 176 | :initform t))) 177 | 178 | (defmethod dispatch-event :after ((game game) (event quit-event)) 179 | (when (event-quit event) 180 | (sdl:push-quit-event))) 181 | 182 | (defun quit () 183 | (send *game* (make-instance 'quit-event))) 184 | -------------------------------------------------------------------------------- /src/blackthorn/input.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-physics) 27 | 28 | ;;; 29 | ;;; Key Events 30 | ;;; 31 | 32 | (defclass key-event (event) 33 | ((host 34 | :reader event-host 35 | :initarg :host 36 | :initform nil) 37 | (key 38 | :reader event-key 39 | :initarg :key) 40 | (mod 41 | :reader event-mod 42 | :initarg :mod) 43 | (mod-key 44 | :reader event-mod-key 45 | :initarg :mod-key) 46 | (unicode 47 | :reader event-unicode 48 | :initarg :unicode))) 49 | 50 | ;;; 51 | ;;; Key Mixin 52 | ;;; 53 | 54 | (defclass key-mixin (event-mixin) 55 | ((host 56 | :reader event-host 57 | :initarg :host 58 | :initform nil) 59 | (key-down-handlers 60 | :reader key-down-handlers 61 | :initform (make-hash-table)) 62 | (key-up-handlers 63 | :reader key-up-handlers 64 | :initform (make-hash-table)))) 65 | 66 | (defmethod initialize-instance :after ((object key-mixin) &key) 67 | (unless (bound-p object :key-down) 68 | (bind object :key-down #'dispatch-key-down)) 69 | (unless (bound-p object :key-up) 70 | (bind object :key-up #'dispatch-key-up))) 71 | 72 | (defmethod bound-key-down-p ((object event-mixin) key) 73 | (multiple-value-bind (value exists) (gethash key (key-down-handlers object)) 74 | (declare (ignore value)) 75 | exists)) 76 | 77 | (defmethod bind-key-down ((object key-mixin) key thunk) 78 | (with-slots (key-down-handlers) object 79 | (setf (gethash key key-down-handlers) thunk))) 80 | 81 | (defmethod unbind-key-down ((object event-mixin) key) 82 | (with-slots (key-down-handlers) object 83 | (remhash key key-down-handlers))) 84 | 85 | (defmethod bound-key-up-p ((object event-mixin) key) 86 | (multiple-value-bind (value exists) (gethash key (key-up-handlers object)) 87 | (declare (ignore value)) 88 | exists)) 89 | 90 | (defmethod bind-key-up ((object key-mixin) key thunk) 91 | (with-slots (key-up-handlers) object 92 | (setf (gethash key key-up-handlers) thunk))) 93 | 94 | (defmethod unbind-key-up ((object event-mixin) key) 95 | (with-slots (key-up-handlers) object 96 | (remhash key key-up-handlers))) 97 | 98 | (defgeneric dispatch-key-down (object event)) 99 | (defmethod dispatch-key-down ((object key-mixin) (event key-event)) 100 | (with-slots (host key-down-handlers) object 101 | (with-slots ((event-host host) (event-key key)) event 102 | (let ((handler (gethash event-key key-down-handlers))) 103 | (when (and (or (not host) (not event-host) (eql host event-host)) 104 | handler) 105 | (funcall handler object event)))))) 106 | 107 | (defgeneric dispatch-key-up (object event)) 108 | (defmethod dispatch-key-up ((object key-mixin) (event key-event)) 109 | (with-slots (host key-up-handlers) object 110 | (with-slots ((event-host host) (event-key key)) event 111 | (let ((handler (gethash event-key key-up-handlers))) 112 | (when (and (or (not host) (not event-host) (eql host event-host)) 113 | handler) 114 | (funcall handler object event)))))) 115 | -------------------------------------------------------------------------------- /src/blackthorn/library.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-user) 27 | 28 | ;;; 29 | ;;; Runtime dependencies which must be loaded into the lisp executable prior 30 | ;;; to calling any SDL functionality. Normally this is done when loading the 31 | ;;; system definiton, but must be done manually for distributed executables. 32 | ;;; 33 | 34 | ; from http://lispbuilder.svn.sourceforge.net/viewvc/lispbuilder/trunk/lispbuilder-sdl/cffi/library.lisp 35 | (defun load-sdl-dlls () 36 | #+darwin 37 | (let ((frameworks 38 | (merge-pathnames 39 | (make-pathname :directory '(:relative :up "Frameworks"))))) 40 | (if (fad:directory-exists-p frameworks) 41 | (pushnew frameworks cffi:*darwin-framework-directories*))) 42 | #+darwin 43 | (cffi:define-foreign-library cocoahelper 44 | (:darwin (:framework "cocoahelper"))) 45 | #+darwin 46 | (cffi:use-foreign-library cocoahelper) 47 | (cffi:define-foreign-library sdl 48 | (:darwin (:framework "SDL")) 49 | (:windows "SDL.dll") 50 | (:unix (:or "libSDL-1.2.so.0.7.2" 51 | "libSDL-1.2.so.0" 52 | "libSDL-1.2.so" 53 | "libSDL.so" 54 | "libSDL"))) 55 | (cffi:use-foreign-library sdl) 56 | #+darwin (lispbuilder-sdl-cocoahelper::cocoahelper-init)) 57 | 58 | ; from http://lispbuilder.svn.sourceforge.net/viewvc/lispbuilder/trunk/lispbuilder-sdl-image/cffi/library.lisp 59 | (defun load-sdl-image-dlls () 60 | (cffi:define-foreign-library sdl-image 61 | (:darwin (:framework "SDL_image")) 62 | (:windows (:or "SDL_image.dll" "SDL_image1.2.dll")) 63 | (:unix (:or "libSDL_image-1.2.so.0" 64 | "libSDL_image1.2" 65 | "libSDL_image.so"))) 66 | (cffi:use-foreign-library sdl-image)) 67 | 68 | ; from lispbuilder-sdl-mixer/cffi/library.lisp 69 | (defun load-sdl-mixer-dlls () 70 | (cffi:define-foreign-library sdl-mixer 71 | (:darwin (:framework "SDL_mixer")) 72 | (:windows "SDL_mixer.dll") 73 | (:unix (:or "libSDL_mixer" 74 | "libSDL_mixer.so" 75 | "libSDL_mixer-1.2.so" 76 | "libSDL_mixer-1.2.so.0"))) 77 | (cffi:use-foreign-library sdl-mixer)) 78 | 79 | (defun load-dlls () 80 | "Loads dlls needed to run SDL, SDL_image, and SDL_gfx." 81 | (load-sdl-dlls) 82 | (load-sdl-image-dlls) 83 | (load-sdl-mixer-dlls)) 84 | -------------------------------------------------------------------------------- /src/blackthorn/main.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-user) 27 | 28 | ;;; 29 | ;;; System paths 30 | ;;; 31 | 32 | (defun setup-paths () 33 | (add-resource-path *default-pathname-defaults*) 34 | (add-resource-path 35 | (merge-pathnames #p"../../" #.(or *compile-file-truename* *load-truename*))) 36 | #+darwin 37 | (add-resource-path 38 | (merge-pathnames #p"../Resources/" (command-line-executable)))) 39 | 40 | ;;; 41 | ;;; Command-line option parsing 42 | ;;; 43 | 44 | (defun command-line-executable () 45 | "Returns the path to the executable being run." 46 | #+allegro (car (sys:command-line-arguments)) 47 | #+clisp (aref (ext:argv) 0) 48 | #+clozure (car ccl:*command-line-argument-list*) 49 | #+ecl (car (ext:command-args)) 50 | #+lispworks (car system:*line-arguments-list*) 51 | #+sbcl (car sb-ext:*posix-argv*) 52 | #-(or allegro clisp clozure ecl lispworks sbcl) 53 | (error "Don't know how to get command line args.")) 54 | 55 | (defparameter *cli-options* 56 | '((("server" #\s) :type string :optional t) 57 | (("connect" #\c) :type string :optional t) 58 | (("port" #\P) :type integer :initial-value 12345) 59 | (("players") :type integer :initial-value 2))) 60 | 61 | (defun cli-get-mode () 62 | (let* ((args (command-line-arguments:get-command-line-arguments)) 63 | (opts (command-line-arguments:process-command-line-options 64 | *cli-options* 65 | (aif (position "--" args :test #'equal) 66 | (nthcdr (1+ it) args))))) 67 | (append (or (aif (getf opts :server) (list :server it)) 68 | (aif (getf opts :connect) (list :client it)) 69 | (list :normal nil)) 70 | (list (getf opts :port) 71 | (getf opts :players))))) 72 | 73 | ;;; 74 | ;;; Video modes 75 | ;;; 76 | 77 | (defun vector->complex (v) 78 | (complex (x v) (y v))) 79 | 80 | (defun video-dimensions () 81 | "Converts SDL:VIDEO-DIMENSIONS to a canonical (i.e. complex) form." 82 | (vector->complex (sdl:video-dimensions))) 83 | 84 | (defun list-modes (flags) 85 | (let ((modes (sdl:list-modes flags))) 86 | (or (eql modes t) 87 | (mapcar #'vector->complex modes)))) 88 | 89 | (defun largest-video-dimensions (flags) 90 | (let ((modes (sdl:list-modes flags))) 91 | (if (eql modes t) 92 | (video-dimensions) 93 | (vector->complex 94 | (find (apply #'max (mapcar #'x modes)) modes :key #'x))))) 95 | 96 | (defun smallest-video-dimensions (flags) 97 | (let ((modes (sdl:list-modes flags))) 98 | (if (eql modes t) 99 | (video-dimensions) 100 | (vector->complex 101 | (find (apply #'min (mapcar #'x modes)) modes :key #'x))))) 102 | 103 | ;;; 104 | ;;; Main Game Driver 105 | ;;; 106 | 107 | (defun main-init-abort-handler () 108 | (throw 'main-init nil)) 109 | 110 | (defun main-loop-abort-handler () 111 | (throw 'main-loop nil)) 112 | 113 | (defun main-process-event (event) 114 | (send *game* event)) 115 | 116 | (defun main (&key (exit-when-done t)) 117 | "Main entry point for the game. Deals with initialization, finalization, and the main game loop." 118 | ;; Initialization: 119 | (setup-paths) 120 | (load-dlls) 121 | 122 | (unless *game* (error "No game specified.~%")) 123 | 124 | (apply #'net-init (cli-get-mode)) 125 | 126 | (setf mt19937:*random-state* (mt19937:make-random-state t)) 127 | 128 | (catch 'main-init 129 | (net-game-connect #'main-init-abort-handler) 130 | 131 | (sdl:with-init () 132 | (init-mixer) 133 | (game-init *game* :player (hostname) :players (hostnames)) 134 | 135 | (gl:enable :texture-2d) 136 | (gl:enable :blend) 137 | (gl:blend-func :src-alpha :one-minus-src-alpha) 138 | (gl:clear-color 0 0 0 0) 139 | (gl:enable :depth-test) 140 | (gl:depth-func :lequal) 141 | (gl:matrix-mode :modelview) 142 | (gl:load-identity) 143 | 144 | ;; Main loop: 145 | (let ((input-queue (make-instance 'containers:basic-queue))) 146 | (catch 'main-loop 147 | (net-game-start #'main-loop-abort-handler) 148 | 149 | (sdl:with-events () 150 | (:quit-event () (net-game-quit) t) 151 | (:key-down-event (:key k :mod m :mod-key m-k :unicode u) 152 | (containers:enqueue 153 | input-queue 154 | (make-instance 'key-event :host (hostname) :type :key-down :key k 155 | :mod m :mod-key m-k :unicode u))) 156 | (:key-up-event (:key k :mod m :mod-key m-k :unicode u) 157 | (containers:enqueue 158 | input-queue 159 | (make-instance 'key-event :host (hostname) :type :key-up :key k 160 | :mod m :mod-key m-k :unicode u))) 161 | (:idle () 162 | (gl:clear :color-buffer-bit :depth-buffer-bit) 163 | (render *game* #c(0 0) 1d0 -1d0) 164 | (gl:flush) 165 | (sdl:update-display) 166 | 167 | #+blt-debug 168 | (let ((connection (or swank::*emacs-connection* 169 | (swank::default-connection)))) 170 | (when (and connection 171 | (not (eql swank:*communication-style* :spawn))) 172 | (swank::handle-requests connection t))) 173 | 174 | (net-game-update input-queue #'main-process-event 175 | #'main-loop-abort-handler) 176 | (game-update *game*)))))) 177 | #-clozure ;; FIXME: This causes a crash on Clozure builds on Windows. 178 | (unload-graphics) 179 | (unload-mixer)) 180 | 181 | ;; Finalization: 182 | (net-exit) 183 | (when exit-when-done 184 | (exit))) 185 | -------------------------------------------------------------------------------- /src/blackthorn/music.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-mixer) 27 | 28 | ;;; 29 | ;;; Sprite Sheets 30 | ;;; 31 | 32 | (defvar *samples* (make-hash-table)) 33 | 34 | (defclass sample () 35 | ((name 36 | :reader name 37 | :initarg :name) 38 | (source 39 | :initarg :source) 40 | (type 41 | :initarg :type 42 | :initform :sample) 43 | raw-sample)) 44 | 45 | (defun init-mixer () 46 | (sdl-mixer:open-audio)) 47 | 48 | (defun unload-mixer () 49 | (sdl-mixer:close-audio) 50 | (clrhash *samples*)) 51 | 52 | (defun make-sample (&rest initargs &key name source &allow-other-keys) 53 | (or (when name (gethash name *samples*)) 54 | (when (not source) (error "No such sample named ~a." name)) 55 | (let ((sample (apply #'make-instance 'sample initargs))) 56 | (setf (gethash (name sample) *samples*) sample)))) 57 | 58 | (defun load-sample (sample) 59 | (with-slots (source type) sample 60 | (let ((actual-source (resolve-resource source))) 61 | (assert (probe-file actual-source) (actual-source) 62 | "Source file \"~a\" not found." actual-source) 63 | (ecase type 64 | ((:music) 65 | (sdl-mixer:load-music actual-source)) 66 | ((:sample) 67 | (sdl-mixer:load-sample actual-source)))))) 68 | 69 | (defmethod play ((sample sample) &key loop fade volume) 70 | (with-slots (type raw-sample) sample 71 | (unless (slot-boundp sample 'raw-sample) 72 | (setf raw-sample (load-sample sample))) 73 | (ecase type 74 | ((:music) 75 | (sdl-mixer:play-music raw-sample :loop loop :fade fade) 76 | (if volume (setf (sdl-mixer:music-volume) volume))) 77 | ((:sample) 78 | (let ((channel (sdl-mixer:play-sample raw-sample :loop loop :fade fade))) 79 | (if volume (setf (sdl-mixer:channel-volume channel) volume)) 80 | channel))))) 81 | 82 | (defmethod stop (&key channel) 83 | (if channel 84 | (sdl-mixer:halt-sample :channel channel) 85 | (sdl-mixer:halt-music))) 86 | -------------------------------------------------------------------------------- /src/blackthorn/network.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-net) 27 | 28 | ;;; 29 | ;;; Network - Sockets and Serialization 30 | ;;; 31 | 32 | (defconstant +max-buffer-size+ 65536) 33 | 34 | (defvar *mode*) 35 | (defvar *host*) 36 | (defvar *hosts*) 37 | (defvar *local-port*) 38 | (defvar *remote-host*) 39 | (defvar *remote-port*) 40 | (defvar *server-socket*) 41 | (defvar *socket*) 42 | (defvar *sockets*) 43 | (defvar *players*) 44 | 45 | (defun hostname () 46 | *host*) 47 | 48 | (defun hostnames () 49 | *hosts*) 50 | 51 | (defun default-abort-handler () 52 | (error "Failed to connect.~%")) 53 | 54 | (defun net-init (mode host port players) 55 | (assert (not (boundp '*mode*))) 56 | (ecase mode 57 | ((:server) 58 | (let ((socket (usocket:socket-listen usocket:*wildcard-host* port 59 | :element-type '(unsigned-byte 8)))) 60 | (setf *server-socket* socket 61 | *local-port* 62 | ;; FIXME: This seems to blow up in CLISP. 63 | #-clisp (usocket:get-local-port socket) 64 | #+clisp port))) 65 | ((:client) 66 | (when (eql mode :client) 67 | (setf *remote-host* host *remote-port* port))) 68 | ((:normal))) 69 | (setf *mode* mode *players* (if players (max players 2) 2))) 70 | 71 | (defun net-connect (&optional (abort-handler #'default-abort-handler)) 72 | (ecase *mode* 73 | ((:server) 74 | (setf *sockets* (iter (repeat (1- *players*)) 75 | (collect (usocket:socket-accept *server-socket*)))) 76 | (iter (for socket in *sockets*) 77 | (let ((request (net-receive socket))) 78 | (unless (equal (assoc :request request) '(:request :init)) 79 | (funcall abort-handler)) 80 | (net-send '((:response :init)) socket)))) 81 | ((:client) 82 | (setf *socket* (usocket:socket-connect *remote-host* *remote-port* 83 | :element-type '(unsigned-byte 8))) 84 | (net-send `((:request :init)) *socket*) 85 | (unless (equal (net-receive *socket* :timeout 10) '((:response :init))) 86 | (funcall abort-handler))) 87 | ((:normal)))) 88 | 89 | (defun net-exit () 90 | (assert (boundp '*mode*)) 91 | (ecase *mode* 92 | ((:client) 93 | (usocket:socket-close *socket*)) 94 | ((:server) 95 | (iter (for socket in *sockets*) (usocket:socket-close socket)) 96 | (usocket:socket-close *server-socket*)) 97 | ((:normal))) 98 | (makunbound '*socket*) 99 | (makunbound '*mode*)) 100 | 101 | (defun net-receive (socket &key timeout) 102 | (assert (or (eql *mode* :server) (eql *mode* :client))) 103 | (cl-store:restore (usocket:socket-stream socket))) 104 | 105 | (defun net-send (message socket) 106 | (assert (or (eql *mode* :server) (eql *mode* :client))) 107 | (cl-store:store message (usocket:socket-stream socket)) 108 | (force-output (usocket:socket-stream socket))) 109 | 110 | (defmacro with-serve-request ((request socket &key timeout) &body body) 111 | (let ((s (gensym))) 112 | `(let* ((,s ,socket) 113 | (,request (net-receive ,s :timeout ,timeout))) 114 | (net-send (progn ,@body) ,s)))) 115 | 116 | (defmacro with-serve-requests ((requests sockets &key timeout) &body body) 117 | (let ((ss (gensym)) (s (gensym)) (reply (gensym))) 118 | `(let* ((,ss ,sockets) 119 | (,requests (iter (for ,s in ,ss) 120 | (collect (net-receive ,s :timeout ,timeout)))) 121 | (,reply (progn ,@body))) 122 | (iter (for ,s in ,ss) 123 | (net-send ,reply ,s))))) 124 | 125 | (defun net-send-request (request socket &key timeout) 126 | (net-send request socket) 127 | (net-receive socket :timeout timeout)) 128 | 129 | ;;; 130 | ;;; Network - Game Protocol 131 | ;;; 132 | 133 | (defun net-game-connect (&optional (abort-handler #'default-abort-handler)) 134 | (when (eql *mode* :server) 135 | (format t "Waiting for a connection on port ~a. Please start client.~%" 136 | *local-port*)) 137 | (net-connect abort-handler) 138 | (ecase *mode* 139 | ((:server) 140 | (let ((hosts (iter (for i from 0 below *players*) (collect i)))) 141 | (setf *host* 0 *hosts* hosts) 142 | (iter (for socket in *sockets*) (for i from 1) 143 | (with-serve-request (request socket :timeout nil) 144 | (if (equal (assoc :request request) '(:request :connect)) 145 | `((:response :connect) 146 | (:host ,i) (:hosts ,hosts) 147 | (:random-state 148 | ,(mt19937::random-state-state mt19937:*random-state*))) 149 | (funcall abort-handler))))) 150 | (format t "Connected.~%")) 151 | ((:client) 152 | (handler-case 153 | (let ((response (net-send-request '((:request :connect)) *socket*))) 154 | (unless (equal (assoc :response response) '(:response :connect)) 155 | (error "Client didn't understand response.~%")) 156 | (setf *host* (cadr (assoc :host response)) 157 | *hosts* (cadr (assoc :hosts response)) 158 | mt19937:*random-state* 159 | (mt19937::make-random-object 160 | :state (cadr (assoc :random-state response))))) 161 | (usocket:connection-refused-error () 162 | (funcall abort-handler))) 163 | (format t "Connected.~%")) 164 | ((:normal) (setf *host* 0 *hosts* '(0))))) 165 | 166 | (defun net-game-start (&optional (abort-handler #'default-abort-handler)) 167 | (ecase *mode* 168 | ((:server) 169 | (format t "Server waiting for client to start.~%") 170 | (iter (for socket in *sockets*) 171 | (with-serve-request (request socket :timeout nil) 172 | (if (equal (assoc :request request) '(:request :start)) 173 | `((:response :start)) 174 | (error "Server didn't understand request.~%")))) 175 | (format t "Starting.~%")) 176 | ((:client) 177 | (format t "Attempting to start...~%") 178 | (handler-case 179 | (let ((response (net-send-request '((:request :start)) *socket*))) 180 | (unless (equal (assoc :response response) '(:response :start)) 181 | (error "Client didn't understand response.~%"))) 182 | (usocket:connection-refused-error () 183 | (funcall abort-handler))) 184 | (format t "Starting.~%")) 185 | ((:normal)))) 186 | 187 | (defun net-game-update (input-queue process-event 188 | &optional (abort-handler #'default-abort-handler)) 189 | (ecase *mode* 190 | ((:server) 191 | (with-serve-requests (requests *sockets* :timeout nil) 192 | (let ((events 193 | (nconc 194 | (containers:collect-elements input-queue) 195 | (iter (for request in requests) 196 | (cond ((equal (assoc :request request) '(:request :update)) 197 | (nconcing (cadr (assoc :events request)))) 198 | ((equal (assoc :request request) '(:request :quit)) 199 | (funcall abort-handler)) 200 | (t 201 | (error "Server didn't understand request.~%"))))))) 202 | (iter (for e in events) (funcall process-event e)) 203 | (containers:empty! input-queue) 204 | `((:response :update) (:events ,events))))) 205 | ((:client) 206 | (let ((response 207 | (net-send-request 208 | `((:request :update) 209 | (:events ,(containers:collect-elements input-queue))) 210 | *socket*))) 211 | (cond ((equal (assoc :response response) '(:response :update)) 212 | (let ((events (cadr (assoc :events response)))) 213 | (iter (for e in events) (funcall process-event e)) 214 | (containers:empty! input-queue))) 215 | ((equal (assoc :response response) '(:response :quit)) 216 | (funcall abort-handler)) 217 | (t 218 | (error "Client didn't understand response.~%"))))) 219 | ((:normal) 220 | (let ((events (containers:collect-elements input-queue))) 221 | (iter (for e in events) (funcall process-event e)) 222 | (containers:empty! input-queue))))) 223 | 224 | (defun net-game-quit (&optional (abort-handler #'default-abort-handler)) 225 | (ecase *mode* 226 | ((:server) 227 | (format t "Server disconnecting from client.~%") 228 | (iter (for socket in *sockets*) 229 | (net-send `((:response :quit)) socket)) 230 | (format t "Disconnected.~%")) 231 | ((:client) 232 | (format t "Attempting to disconnect...~%") 233 | (net-send `((:request :quit)) *socket*) 234 | (format t "Disconnected.~%")) 235 | ((:normal)))) 236 | -------------------------------------------------------------------------------- /src/blackthorn/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :cl-user) 27 | 28 | ;;; 29 | ;;; Internal Packages: 30 | ;;; Anything exported here but not exported in the public interface is 31 | ;;; intended for internal use. 32 | ;;; 33 | 34 | (defpackage :blackthorn-utils 35 | (:nicknames :blt-utils) 36 | (:use :cl :alexandria :iter) 37 | (:export 38 | 39 | ;; utils.lisp 40 | :unit 41 | :dot 42 | :proj 43 | :norm 44 | :dist 45 | :theta 46 | :polar 47 | :rot 48 | :cross 49 | :aif 50 | :acond 51 | :it 52 | :once-only 53 | :with-gensyms 54 | :gc 55 | 56 | ;; resources.lisp 57 | :add-resource-path 58 | :resolve-resource 59 | 60 | )) 61 | 62 | (defpackage :blackthorn-net 63 | (:nicknames :blt-net) 64 | (:use :cl :iter :blt-utils) 65 | (:export 66 | 67 | ;; network.lisp 68 | :hostname 69 | :hostnames 70 | :net-init 71 | :net-exit 72 | :net-game-connect 73 | :net-game-start 74 | :net-game-update 75 | :net-game-quit 76 | 77 | )) 78 | 79 | (defpackage :blackthorn-graphics 80 | (:nicknames :blt-gfx) 81 | (:use :cl :alexandria :iter :blt-utils) 82 | (:import-from :sdl :set-caption) 83 | (:export 84 | 85 | :set-caption 86 | 87 | ;; graphics.lisp 88 | :window 89 | :sheet 90 | :activate 91 | :image 92 | :unload-graphics 93 | :size 94 | :x 95 | :y 96 | :draw 97 | :anim 98 | :next-image 99 | :load-sheet 100 | :make-image 101 | :make-anim 102 | :make-anim-or-image 103 | :bbox-offset 104 | :bbox-size 105 | 106 | ;; fonts.lisp 107 | :font 108 | :make-font 109 | :text 110 | :make-text 111 | :bbox-offset 112 | :bbox-size 113 | 114 | )) 115 | 116 | (defpackage :blackthorn-mixer 117 | (:nicknames :blt-mixer) 118 | (:use :cl :blt-utils) 119 | (:export 120 | 121 | ;; music.lisp 122 | :init-mixer 123 | :unload-mixer 124 | :make-sample 125 | :play 126 | :stop 127 | 128 | )) 129 | 130 | (defpackage :blackthorn-physics 131 | (:nicknames :blt-phys) 132 | (:use :cl :alexandria :iter :blt-utils :blt-gfx) 133 | (:export 134 | 135 | ;; component.lisp 136 | :component 137 | :offset 138 | :depth 139 | :size 140 | :parent 141 | :children 142 | :attach 143 | :detach 144 | :render 145 | :draw 146 | :update 147 | :sprite 148 | :image 149 | :bbox-size 150 | :bbox-image 151 | 152 | ;; event.lisp 153 | :event 154 | :event-type 155 | :event-mixin 156 | :bound-p 157 | :bind 158 | :unbind 159 | :event-subscription 160 | :subscribe 161 | :unsubscribe 162 | 163 | ;; input.lisp 164 | :key-event 165 | :key-mixin 166 | :event-host 167 | :event-key 168 | :event-mod 169 | :event-mod-key 170 | :event-unicode 171 | :bound-key-down-p 172 | :bind-key-down 173 | :unbind-key-down 174 | :bound-key-up-p 175 | :bind-key-up 176 | :unbind-key-up 177 | 178 | ;; actor.lisp 179 | :actor 180 | :mobile 181 | :veloc 182 | :accel 183 | 184 | ;; collision.lisp 185 | :collidable 186 | :reactive-collisions-only-p 187 | :collide 188 | :find-nearest-object 189 | :collision-event 190 | :event-hit 191 | 192 | ;; game.lisp 193 | :game 194 | :*game* 195 | :screen 196 | :game-screen 197 | :game-root 198 | :game-view 199 | :game-sheet 200 | :game-keys 201 | :game-init 202 | :game-load 203 | :game-save 204 | :game-update 205 | :send 206 | :quit-event 207 | :event-quit 208 | :quit 209 | 210 | )) 211 | 212 | ;;; 213 | ;;; Public Interface: 214 | ;;; The generic functions and classes listed form the interface to Blackthorn. 215 | ;;; 216 | 217 | (defpackage :blackthorn 218 | (:nicknames :blt) 219 | (:use :cl :blt-utils :blt-gfx :blt-mixer :blt-phys) 220 | (:export 221 | 222 | ;; utils.lisp 223 | :unit 224 | :dot 225 | :proj 226 | :norm 227 | :dist 228 | :theta 229 | :polar 230 | :rot 231 | :cross 232 | :aif 233 | :acond 234 | :it 235 | :once-only 236 | :with-gensyms 237 | :gc 238 | 239 | ;; resources.lisp 240 | :add-resource-path 241 | :resolve-resource 242 | 243 | ;; graphics.lisp 244 | :set-caption 245 | :window 246 | :sheet 247 | :activate 248 | :image 249 | :size 250 | :x 251 | :y 252 | :draw 253 | :anim 254 | :next-image 255 | :load-sheet 256 | :make-image 257 | :make-anim 258 | :make-anim-or-image 259 | :bbox-offset 260 | :bbox-size 261 | 262 | ;; fonts.lisp 263 | :font 264 | :make-font 265 | :text 266 | :make-text 267 | :bbox-offset 268 | :bbox-size 269 | 270 | ;; music.lisp 271 | :init-mixer 272 | :unload-mixer 273 | :make-sample 274 | :play 275 | :stop 276 | 277 | ;; component.lisp 278 | :component 279 | :offset 280 | :depth 281 | :size 282 | :parent 283 | :children 284 | :attach 285 | :detach 286 | :render 287 | :draw 288 | :update 289 | :sprite 290 | :image 291 | :bbox-offset 292 | :bbox-size 293 | 294 | ;; event.lisp 295 | :event 296 | :event-type 297 | :event-mixin 298 | :bound-p 299 | :bind 300 | :unbind 301 | :event-subscription 302 | :subscribe 303 | :unsubscribe 304 | 305 | ;; input.lisp 306 | :key-event 307 | :key-mixin 308 | :event-host 309 | :event-key 310 | :event-mod 311 | :event-mod-key 312 | :event-unicode 313 | :bound-key-down-p 314 | :bind-key-down 315 | :unbind-key-down 316 | :bound-key-up-p 317 | :bind-key-up 318 | :unbind-key-up 319 | 320 | ;; actor.lisp 321 | :actor 322 | :mobile 323 | :veloc 324 | :accel 325 | 326 | ;; collision.lisp 327 | :collidable 328 | :reactive-collisions-only-p 329 | :collide 330 | :find-nearest-object 331 | :collision-event 332 | :event-hit 333 | 334 | ;; game.lisp 335 | :game 336 | :*game* 337 | :screen 338 | :game-screen 339 | :game-root 340 | :game-view 341 | :game-sheet 342 | :game-keys 343 | :game-init 344 | :game-load 345 | :game-save 346 | :game-update 347 | :send 348 | :quit-event 349 | :event-quit 350 | :quit 351 | 352 | )) 353 | 354 | ;;; 355 | ;;; User Package: 356 | ;;; 357 | 358 | (defpackage :blackthorn-user 359 | (:nicknames :blt-user) 360 | (:use :cl :blt :blt-net :iter) 361 | (:shadow :room) 362 | #+allegro (:import-from :cl-user :exit) 363 | (:import-from :blt-gfx :unload-graphics) 364 | (:export 365 | 366 | ;; main.lisp 367 | :main 368 | 369 | )) 370 | 371 | #-allegro 372 | (eval-when (:compile-toplevel :load-toplevel) 373 | (setf (symbol-function 'blt-user::exit) #'quit)) 374 | -------------------------------------------------------------------------------- /src/blackthorn/resources.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-utils) 27 | 28 | ;;; 29 | ;;; Resource search paths 30 | ;;; 31 | 32 | (defvar *resource-search-paths* nil 33 | "List of paths to be searched for resources like image and sound files.") 34 | 35 | (defun directory-of (pathname) 36 | (make-pathname 37 | :host (pathname-host pathname) 38 | :directory (pathname-directory pathname))) 39 | 40 | (defun add-resource-path (pathname) 41 | (aif (and pathname (fad:file-exists-p (directory-of pathname))) 42 | (pushnew it *resource-search-paths* :test #'equal))) 43 | 44 | (defun resource (pathname) 45 | (aif (iter (for dir in *resource-search-paths*) 46 | (thereis (fad:file-exists-p (merge-pathnames pathname dir)))) 47 | it 48 | (error "Unable to find resource ~s in search path ~s." 49 | pathname 50 | *resource-search-paths*))) 51 | 52 | (defun resource-wild (pathname) 53 | (iter (for dir in *resource-search-paths*) 54 | (appending (directory (merge-pathnames pathname dir))))) 55 | 56 | (defun resolve-resource (pathname &key (allow-wild nil)) 57 | (if (and allow-wild (wild-pathname-p pathname)) 58 | (resource-wild pathname) 59 | (resource pathname))) 60 | -------------------------------------------------------------------------------- /src/blackthorn/utils.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-utils) 27 | 28 | ;;; 29 | ;;; Complex numbers 30 | ;;; 31 | 32 | (defun unit (x) 33 | (if (zerop x) x (/ x (abs x)))) 34 | 35 | (defun dot (x y) 36 | (+ (* (realpart x) (realpart y)) (* (imagpart x) (imagpart y)))) 37 | 38 | (defun proj (x y) 39 | (* (unit y) (/ (dot x y) (abs y)))) 40 | 41 | (defun norm (x y) 42 | (- x (proj x y))) 43 | 44 | (defun dist (x y) 45 | (abs (- x y))) 46 | 47 | (defun theta (x) 48 | (atan (imagpart x) (realpart x))) 49 | 50 | (defun polar (a) 51 | (complex (cos a) (sin a))) 52 | 53 | (defun rot (x a) 54 | (* (polar (+ (theta x) a)) (abs x))) 55 | 56 | (defun cross (x y) 57 | (- (* (realpart x) (imagpart y)) (* (imagpart x) (realpart y)))) 58 | 59 | ;;; 60 | ;;; Lists 61 | ;;; 62 | 63 | (defun intersperse (x ys) 64 | (cons (car ys) 65 | (mapcan #'(lambda (y) (list x y)) (cdr ys)))) 66 | 67 | (defun ordered-subset-p (list1 list2 &key (key #'identity) (test #'eql)) 68 | (if list2 69 | (if (funcall test (funcall key (car list1)) (funcall key (car list2))) 70 | (ordered-subset-p (cdr list1) (cdr list2) :key key :test test) 71 | (ordered-subset-p list1 (cdr list2) :key key :test test)) 72 | (not list1))) 73 | 74 | (defun alref (item alist &key key (test nil test-p)) 75 | (cadr (apply #'assoc item alist 76 | (append (list :key key) (if test-p (list :test test)))))) 77 | 78 | (defun alrest (item alist &key key (test nil test-p)) 79 | (cdr (apply #'assoc item alist 80 | (append (list :key key) (if test-p (list :test test)))))) 81 | 82 | (defun select (table) 83 | (when table 84 | (let ((n (random (reduce #'+ (mapcar #'car table))))) 85 | (reduce #'(lambda (n entry) 86 | (if (>= (- n (car entry)) 0) 87 | (- n (car entry)) 88 | (return-from select (cdr entry)))) 89 | (cons n table))))) 90 | 91 | (defun all-pairs (list) 92 | (when list 93 | (nconc (loop for elt in (cdr list) collect (list (car list) elt)) 94 | (all-pairs (cdr list))))) 95 | 96 | (defun list->table (alist) 97 | (let ((table (make-hash-table))) 98 | (loop for (k v) in alist 99 | do (setf (gethash k table) v)) 100 | table)) 101 | 102 | ;;; 103 | ;;; Anaphora 104 | ;;; 105 | 106 | (defmacro aif (test-form then-form &optional else-form) 107 | `(let ((it ,test-form)) 108 | (if it ,then-form ,else-form))) 109 | 110 | (defmacro acond (&rest clauses) 111 | (if (null clauses) 112 | nil 113 | (let ((cl1 (car clauses)) 114 | (sym (gensym))) 115 | `(let ((,sym ,(car cl1))) 116 | (if ,sym 117 | (let ((it ,sym)) ,@(cdr cl1)) 118 | (acond ,@(cdr clauses))))))) 119 | 120 | ;;; 121 | ;;; Macros 122 | ;;; 123 | 124 | (defmacro defmemo (name params &body body) 125 | (with-gensyms (cache args value exists) 126 | `(let ((,cache (make-hash-table :test #'equal))) 127 | (defun ,name (&rest ,args) 128 | (multiple-value-bind (,value ,exists) (gethash ,args ,cache) 129 | (if ,exists 130 | ,value 131 | (setf (gethash ,args ,cache) 132 | (apply #'(lambda ,params ,@body) ,args)))))))) 133 | 134 | (defmacro defweakmemo (name params &body body) 135 | (with-gensyms (cache args value exists) 136 | `(let ((,cache 137 | (tg:make-weak-hash-table :test #'equal #-(or clozure ecl) :weakness #-(or clozure ecl) :key))) 138 | (defun ,name (&rest ,args) 139 | (multiple-value-bind (,value ,exists) (gethash ,args ,cache) 140 | (if ,exists 141 | ,value 142 | (setf (gethash ,args ,cache) 143 | (apply #'(lambda ,params ,@body) ,args)))))))) 144 | 145 | ;;; 146 | ;;; Garbage Collection 147 | ;;; 148 | 149 | (defun gc (&key full verbose) 150 | (trivial-garbage:gc :full full :verbose verbose)) 151 | -------------------------------------------------------------------------------- /src/bunnyslayer/driver.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :bunnyslayer) 27 | 28 | (defclass bunnyslayer-game (game) ()) 29 | 30 | (defclass flag-mixin (actor) 31 | ((flags 32 | :reader flags 33 | :initform (make-hash-table)))) 34 | 35 | (defmethod get-flag ((object flag-mixin) flag) 36 | (with-slots (flags) object 37 | (gethash flag flags))) 38 | 39 | (defun set-flag (flag value) 40 | #'(lambda (object event) 41 | (with-slots (flags) object (setf (gethash flag flags) value)))) 42 | 43 | (defclass direction-mixin (flag-mixin) 44 | ((speed 45 | :accessor speed 46 | :initarg :speed))) 47 | 48 | (defvar *dir-names* '(:north :south :west :east)) 49 | (defvar *dir-vectors* '(#c(0 -1) #c(0 1) #c(-1 0) #c(1 0))) 50 | 51 | (defmethod change-veloc ((object direction-mixin) event) 52 | (with-slots (veloc speed) object 53 | (setf veloc 54 | (* speed 55 | (unit (iter (for d in *dir-names*) (for v in *dir-vectors*) 56 | (when (get-flag object d) (sum v)))))))) 57 | 58 | (defclass facing-mixin (direction-mixin) 59 | ((facing 60 | :reader facing 61 | :initarg :facing))) 62 | 63 | (defmethod change-facing ((object facing-mixin) event) 64 | (with-slots (facing) object 65 | (setf facing 66 | (if (get-flag object facing) 67 | facing 68 | (or (iter (for d in *dir-names*) 69 | (when (get-flag object d) (return d))) 70 | facing))))) 71 | 72 | (defclass action-mixin (actor) 73 | ((action-state 74 | :reader action 75 | :initarg :action) 76 | action-inputs 77 | action-states 78 | action-state-table)) 79 | 80 | (defclass action-event (event) 81 | ((old-action 82 | :reader old-action 83 | :initarg :old-action) 84 | (new-action 85 | :reader new-action 86 | :initarg :new-action) 87 | (input 88 | :reader input 89 | :initarg :input))) 90 | 91 | (defmacro with-action-state-table ((object) inputs &body table) 92 | (assert (listp inputs)) 93 | (assert (iter (for row in table) (always (listp row)))) 94 | (let ((states 95 | (iter (for row in table) (collect (car row)))) 96 | (transitions 97 | (iter (with state-set = (make-hash-table)) 98 | (for (state . result-states) in table) 99 | (setf (gethash state state-set) 100 | (iter (with result-set = (make-hash-table)) 101 | (for input in inputs) 102 | (for result in result-states) 103 | (setf (gethash input result-set) result) 104 | (finally (return result-set)))) 105 | (finally (return state-set))))) 106 | (with-gensyms (a-i a-s a-s-t) 107 | `(with-slots ((,a-i action-inputs) 108 | (,a-s action-states) 109 | (,a-s-t action-state-table)) ,object 110 | (setf ,a-i ',inputs 111 | ,a-s ',states 112 | ,a-s-t ',transitions))))) 113 | 114 | (defmethod dispatch-action-input ((object action-mixin) input) 115 | (with-slots (action action-inputs action-states action-state-table) object 116 | (assert (member action action-states)) 117 | (assert (member input action-inputs)) 118 | (let* ((old-action action) 119 | (new-action (gethash input (gethash action action-state-table))) 120 | (action-event (make-instance 'action-event 121 | :old-action old-action 122 | :new-action new-action 123 | :input input))) 124 | (assert (member new-action action-states)) 125 | (setf action new-action) 126 | (action-transition object action-event)))) 127 | 128 | (defmethod action-transition ((object action-mixin) event) 129 | (declare (ignore object event))) 130 | 131 | (defun action-input (input) 132 | #'(lambda (object event) (dispatch-action-input object input))) 133 | 134 | (defclass hero (sprite mobile facing-mixin action-mixin) 135 | ((facing 136 | :initform :south) 137 | (action 138 | :initform :none) 139 | (speed 140 | :initform 3))) 141 | 142 | (defun doall (&rest handlers) 143 | #'(lambda (object event) 144 | (iter (for handler in handlers) (funcall handler object event)))) 145 | 146 | ;; TODO: generalize this to apply to any class with facings and/or actions 147 | (defmethod change-image ((hero hero) event) 148 | (with-slots (image facing action) hero 149 | (let ((action-name (if (eql action :none) 150 | (if (zerop (iter (for d in *dir-names*) 151 | (for v in *dir-vectors*) 152 | (when (get-flag hero d) (sum v)))) 153 | :stand 154 | :walk) 155 | action))) 156 | (setf image (make-anim-or-image "HERO-~a-~a" facing action-name))))) 157 | 158 | (defmethod initialize-instance :after ((hero hero) &key) 159 | (iter (for (d k) in '((:north :sdl-key-up) (:south :sdl-key-down) 160 | (:west :sdl-key-left) (:east :sdl-key-right))) 161 | (bind-key-down hero k (doall (set-flag d t) #'change-veloc 162 | #'change-facing #'change-image)) 163 | (bind-key-up hero k (doall (set-flag d nil) #'change-veloc 164 | #'change-facing #'change-image))) 165 | (with-action-state-table (hero) 166 | (:attack :finish) 167 | (:none :attack :none) 168 | (:attack :attack :none)) 169 | (change-image hero nil)) 170 | 171 | (defmethod initialize-instance :after ((game bunnyslayer-game) &key) 172 | (setf (game-root game) (make-instance 'component :size #c(800 600)) 173 | (game-view game) (make-instance 'component :size #c(800 600)))) 174 | 175 | (defmethod game-init ((game bunnyslayer-game) &key &allow-other-keys) 176 | (let* ((root (game-root game)) 177 | (size (size (game-root game)))) 178 | (setf (game-sheet game) 179 | (load-sheet "disp/refmap/*.png" :name :sheet)) 180 | (let ((hero (make-instance 'hero :parent root :offset (/ size 2)))) 181 | (subscribe (game-keys game) hero)))) 182 | 183 | (defmethod game-update :after ((game bunnyslayer-game)) 184 | ;; report the frame reate 185 | (let ((s (format nil "fps: ~,2f" (sdl:average-fps)))) 186 | (set-caption s s))) 187 | 188 | ;; For interactive use: 189 | (defun bunnyslayer () 190 | (let ((*game* (make-instance 'bunnyslayer-game))) 191 | (main :exit-when-done nil))) 192 | 193 | ;; For non-interactive use: 194 | (defvar *game* (make-instance 'bunnyslayer-game)) -------------------------------------------------------------------------------- /src/bunnyslayer/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :cl-user) 27 | 28 | (defpackage :bunnyslayer 29 | (:use :cl :iter :blt :blt-user) 30 | (:shadow :speed) 31 | (:export 32 | 33 | ;; driver.lisp 34 | :bunnyslayer 35 | 36 | )) 37 | -------------------------------------------------------------------------------- /src/collision-test/driver.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-collision-test) 27 | 28 | (defclass blackthorn-collision-test-game (game) ()) 29 | 30 | (defclass player (sprite mobile collidable) 31 | ((image :initform (make-image :orange)))) 32 | 33 | (defmethod initialize-instance :after ((player player) &key) 34 | (bind-key-down player :sdl-key-up #'move-north) 35 | (bind-key-up player :sdl-key-up #'stop-north) 36 | (bind-key-down player :sdl-key-down #'move-south) 37 | (bind-key-up player :sdl-key-down #'stop-south) 38 | (bind-key-down player :sdl-key-left #'move-west) 39 | (bind-key-up player :sdl-key-left #'stop-west) 40 | (bind-key-down player :sdl-key-right #'move-east) 41 | (bind-key-up player :sdl-key-right #'stop-east)) 42 | 43 | (defmethod move-north ((player player) event) 44 | (incf (veloc player) #c(0 -1))) 45 | 46 | (defmethod stop-north ((player player) event) 47 | (decf (veloc player) #c(0 -1))) 48 | 49 | (defmethod move-south ((player player) event) 50 | (incf (veloc player) #c(0 1))) 51 | 52 | (defmethod stop-south ((player player) event) 53 | (decf (veloc player) #c(0 1))) 54 | 55 | (defmethod move-west ((player player) event) 56 | (incf (veloc player) #c(-1 0))) 57 | 58 | (defmethod stop-west ((player player) event) 59 | (decf (veloc player) #c(-1 0))) 60 | 61 | (defmethod move-east ((player player) event) 62 | (incf (veloc player) #c(1 0))) 63 | 64 | (defmethod stop-east ((player player) event) 65 | (decf (veloc player) #c(1 0))) 66 | 67 | (defclass toggle (sprite mobile collidable) 68 | ((image :initform (make-image :green)))) 69 | 70 | (defmethod collide ((toggle toggle) event) 71 | (setf (image toggle) (make-image :blue))) 72 | 73 | (defmethod initialize-instance :after ((game blackthorn-collision-test-game) 74 | &key) 75 | (setf (game-root game) (make-instance 'component :size #c(800 600)) 76 | (game-view game) (make-instance 'component :size #c(800 600)))) 77 | 78 | (defmethod game-init ((game blackthorn-collision-test-game) 79 | &key &allow-other-keys) 80 | (let* ((root (game-root game)) 81 | (size (size (game-root game)))) 82 | (setf (game-sheet game) (load-sheet "disp/collision.png")) 83 | (let ((player (make-instance 'player :parent root :offset (/ size 2) 84 | :image (make-image :orange)))) 85 | (subscribe (game-keys game) player)) 86 | (let ((image-size (size (make-image :orange)))) 87 | (iter (for x from 0 below (x size) by (* 2 (x image-size))) 88 | (iter (for y from 0 below (y size) by (* 2 (y image-size))) 89 | (make-instance 90 | 'toggle :parent root :offset (complex x y) :depth 1)))))) 91 | 92 | (defmethod game-update :after ((game blackthorn-collision-test-game)) 93 | ;; report the frame reate 94 | (let ((s (format nil "fps: ~,2f" (sdl:average-fps)))) 95 | (set-caption s s))) 96 | 97 | ;; For interactive use: 98 | (defun blackthorn-collision-test () 99 | (let ((*game* (make-instance 'blackthorn-collision-test-game))) 100 | (main :exit-when-done nil))) 101 | 102 | ;; For non-interactive use: 103 | (defvar *game* (make-instance 'blackthorn-collision-test-game)) 104 | -------------------------------------------------------------------------------- /src/collision-test/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :cl-user) 27 | 28 | (defpackage :blackthorn-collision-test 29 | (:use :cl :iter :blt-gfx :blt-phys :blt-user) 30 | (:export 31 | 32 | ;; driver.lisp 33 | :blackthorn-collision-test 34 | 35 | )) 36 | -------------------------------------------------------------------------------- /src/stress-test/collidable.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-stress-test) 27 | 28 | (defclass collidable-game (game) 29 | ((test-size 30 | :reader test-size 31 | :initarg :test-size 32 | :initform 2000))) 33 | 34 | (defclass collidable-object (sprite mobile collidable) ()) 35 | 36 | (defmethod report-event ((object actor) (event key-event)) 37 | (declare (ignore object)) 38 | (format t "~a: ~a ~a ~a~%" (event-type event) (event-key event) 39 | (event-mod event) (event-mod-key event))) 40 | 41 | (defmethod initialize-instance :after ((game collidable-game) &key) 42 | (setf (game-root game) (make-instance 'component :size #c(800 600)) 43 | (game-view game) (make-instance 'component :size #c(800 600)))) 44 | 45 | (defmethod game-init ((game collidable-game) &key &allow-other-keys) 46 | (let* ((root (game-root game)) 47 | (size (size (game-root game)))) 48 | (setf (game-sheet game) (load-sheet "disp/sheet.png")) 49 | (loop for i from 0 to (test-size game) 50 | do (make-instance 51 | 'collidable-object :parent root 52 | :offset (complex (random (x size)) (random (y size))) 53 | :veloc (complex (- (random 1.0) 0.5) (- (random 1.0) 0.5)) 54 | :image (make-image :explosion))) 55 | (let ((keys (make-instance 'actor))) 56 | (bind keys :key-down #'report-event) 57 | (bind keys :key-up #'report-event) 58 | (subscribe (game-keys game) keys)))) 59 | 60 | (defmethod game-init :after ((game collidable-game) &key &allow-other-keys) 61 | ;; uncork the frame rate and see how fast we go 62 | (setf (sdl:frame-rate) 100)) 63 | 64 | (defmethod game-update :after ((game collidable-game)) 65 | ;; report the frame rate 66 | (let ((s (format nil "fps: ~,2f" (sdl:average-fps)))) 67 | (set-caption s s))) 68 | 69 | (defmethod update :after ((object collidable-object) event) 70 | (declare (ignore event)) 71 | (with-slots (offset veloc) object 72 | (cond ((< (x offset) 0) 73 | (setf veloc (complex (abs (x veloc)) (y veloc)))) 74 | ((>= (x offset) (x (size (game-view *game*)))) 75 | (setf veloc (complex (- (abs (x veloc))) (y veloc))))) 76 | (cond ((< (y offset) 0) 77 | (setf veloc (complex (x veloc) (abs (y veloc))))) 78 | ((>= (y offset) (y (size (game-view *game*)))) 79 | (setf veloc (complex (x veloc) (- (abs (y veloc))))))))) 80 | 81 | ;; For interactive use: 82 | (defun collidable-test (&optional (n 2000)) 83 | (let ((*game* (make-instance 'collidable-game :test-size n))) 84 | (main :exit-when-done nil))) 85 | 86 | ;; For non-interactive use: 87 | ;(defparameter *game* (make-instance 'collidable-game :test-size 2000)) 88 | -------------------------------------------------------------------------------- /src/stress-test/mobile.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-stress-test) 27 | 28 | (defclass mobile-game (game) 29 | ((test-size 30 | :reader test-size 31 | :initarg :test-size 32 | :initform 5000))) 33 | 34 | (defclass mobile-object (sprite mobile) ()) 35 | 36 | (defmethod report-event ((object actor) (event key-event)) 37 | (declare (ignore object)) 38 | (format t "~a: ~a ~a ~a~%" (event-type event) (event-key event) 39 | (event-mod event) (event-mod-key event))) 40 | 41 | (defmethod initialize-instance :after ((game mobile-game) &key) 42 | (setf (game-root game) (make-instance 'component :size #c(800 600)) 43 | (game-view game) (make-instance 'component :size #c(800 600)))) 44 | 45 | (defmethod game-init ((game mobile-game) &key &allow-other-keys) 46 | (let* ((root (game-root game)) 47 | (size (size (game-root game)))) 48 | (setf (game-sheet game) (load-sheet "disp/sheet.png")) 49 | (let ((image (make-image :explosion))) 50 | (loop for i from 0 to (test-size game) 51 | do (make-instance 52 | 'mobile-object :parent root 53 | :offset (complex (random (- (x size) (x (size image)))) 54 | (random (- (y size) (y (size image))))) 55 | :veloc (complex (- (random 1.0) 0.5) (- (random 1.0) 0.5)) 56 | :image image))) 57 | (let ((keys (make-instance 'actor))) 58 | (bind keys :key-down #'report-event) 59 | (bind keys :key-up #'report-event) 60 | (subscribe (game-keys game) keys)))) 61 | 62 | (defmethod game-init :after ((game mobile-game) &key &allow-other-keys) 63 | ;; uncork the frame rate and see how fast we go 64 | (setf (sdl:frame-rate) 100)) 65 | 66 | (defmethod game-update :after ((game mobile-game)) 67 | ;; report the frame rate 68 | (let ((s (format nil "fps: ~,2f" (sdl:average-fps)))) 69 | (set-caption s s))) 70 | 71 | (defmethod update :after ((object mobile-object) event) 72 | (declare (ignore event)) 73 | (with-slots (offset size veloc) object 74 | (cond ((< (x offset) 0) 75 | (setf veloc (complex (abs (x veloc)) (y veloc)))) 76 | ((>= (+ (x offset) (x size)) (x (size (game-view *game*)))) 77 | (setf veloc (complex (- (abs (x veloc))) (y veloc))))) 78 | (cond ((< (y offset) 0) 79 | (setf veloc (complex (x veloc) (abs (y veloc))))) 80 | ((>= (+ (y offset) (y size)) (y (size (game-view *game*)))) 81 | (setf veloc (complex (x veloc) (- (abs (y veloc))))))))) 82 | 83 | ;; For interactive use: 84 | (defun mobile-test (&optional (n 5000)) 85 | (let ((*game* (make-instance 'mobile-game :test-size n))) 86 | (main :exit-when-done nil))) 87 | 88 | ;; For non-interactive use: 89 | (defparameter *game* (make-instance 'mobile-game :test-size 100)) 90 | -------------------------------------------------------------------------------- /src/stress-test/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :cl-user) 27 | 28 | (defpackage :blackthorn-stress-test 29 | (:nicknames :blt-stress-test) 30 | (:use :cl :blt-gfx :blt-phys :blt-user) 31 | (:export 32 | 33 | ;; static.lisp 34 | :static-test 35 | 36 | ;;mobile.lisp 37 | :mobile-test 38 | 39 | ;;collidable.lisp 40 | :collidable-test 41 | 42 | )) 43 | -------------------------------------------------------------------------------- /src/stress-test/static.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-stress-test) 27 | 28 | (defclass static-game (game) 29 | ((test-size 30 | :reader test-size 31 | :initarg :test-size 32 | :initform 5000))) 33 | 34 | (defclass static-object (sprite) ()) 35 | 36 | (defmethod report-event ((object actor) (event key-event)) 37 | (declare (ignore object)) 38 | (format t "~a: ~a ~a ~a~%" (event-type event) (event-key event) 39 | (event-mod event) (event-mod-key event))) 40 | 41 | (defmethod initialize-instance :after ((game static-game) &key) 42 | (setf (game-root game) (make-instance 'component :size #c(800 600)) 43 | (game-view game) (make-instance 'component :size #c(800 600)))) 44 | 45 | (defmethod game-init ((game static-game) &key &allow-other-keys) 46 | (let* ((root (game-root game)) 47 | (size (size (game-root game)))) 48 | (setf (game-sheet game) (load-sheet "disp/sheet.png")) 49 | (loop for i from 0 to (test-size game) 50 | do (make-instance 51 | 'static-object :parent root 52 | :offset (complex (random (x size)) (random (y size))) 53 | :image (make-image :explosion))) 54 | (let ((keys (make-instance 'actor))) 55 | (bind keys :key-down #'report-event) 56 | (bind keys :key-up #'report-event) 57 | (subscribe (game-keys game) keys)))) 58 | 59 | (defmethod game-init :after ((game static-game) &key &allow-other-keys) 60 | ;; uncork the frame rate and see how fast we go 61 | (setf (sdl:frame-rate) 100)) 62 | 63 | (defmethod game-update :after ((game static-game)) 64 | ;; report the frame rate 65 | (let ((s (format nil "fps: ~,2f" (sdl:average-fps)))) 66 | (set-caption s s))) 67 | 68 | ;; For interactive use: 69 | (defun static-test (&optional (n 5000)) 70 | (let ((*game* (make-instance 'static-game :test-size n))) 71 | (main :exit-when-done nil))) 72 | 73 | ;; For non-interactive use: 74 | ;(defparameter *game* (make-instance 'static-game :test-size 5000)) 75 | -------------------------------------------------------------------------------- /src/test/component.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :blackthorn-test) 27 | 28 | (def-suite blackthorn-physics :in blackthorn) 29 | 30 | (in-suite blackthorn-physics) 31 | 32 | ;;; 33 | ;;; Check the structural properties of component trees 34 | ;;; 35 | 36 | (test component-with-no-children 37 | (let ((root (make-instance 'component))) 38 | (is (zerop (offset root))) 39 | (is (zerop (depth root))) 40 | (is (zerop (size root))) 41 | (is (not (parent root))) 42 | (is (arrayp (children root))) 43 | (is (zerop (array-dimension (children root) 0))))) 44 | 45 | (test (component-with-one-child :depends-on component-with-no-children) 46 | (let* ((root (make-instance 'component)) 47 | (child (make-instance 'component :parent root))) 48 | (is (eql root (parent child))) 49 | (is (= 1 (array-dimension (children root) 0))) 50 | (is (eql child (aref (children root) 0))) 51 | (let (seen) 52 | (blt-phys::do-children (c root) 53 | (push child seen)) 54 | (is (equal (list child) seen))))) 55 | 56 | (test (component-attach-detach-child :depends-on component-with-no-children) 57 | (let ((root (make-instance 'component)) 58 | (child (make-instance 'component))) 59 | (is (not (parent child))) 60 | (is (zerop (array-dimension (children root) 0))) 61 | 62 | (attach root child) 63 | (is (eql root (parent child))) 64 | (is (= 1 (array-dimension (children root) 0))) 65 | (is (eql child (aref (children root) 0))) 66 | 67 | (detach root child) 68 | (is (not (parent child))) 69 | (is (zerop (array-dimension (children root) 0))))) 70 | 71 | (test (component-with-two-children :depends-on component-with-one-child) 72 | (let* ((root (make-instance 'component)) 73 | (child1 (make-instance 'component :parent root :depth 1)) 74 | (child2 (make-instance 'component :parent root :depth -1))) 75 | (is (eql root (parent child1))) 76 | (is (eql root (parent child2))) 77 | (is (= 2 (array-dimension (children root) 0))) 78 | ;; since children are sorted by depth, we know the order of the children 79 | (is (eql child1 (aref (children root) 0))) 80 | (is (eql child2 (aref (children root) 1))) 81 | 82 | (let (seen) 83 | (blt-phys::do-children (c root) 84 | (push c seen)) 85 | (setf seen (nreverse seen)) 86 | (is (equal seen (list child1 child2))))) 87 | 88 | ;; everything should be independent of the order of object creation 89 | (let* ((root (make-instance 'component)) 90 | (child2 (make-instance 'component :parent root :depth -1)) 91 | (child1 (make-instance 'component :parent root :depth 1))) 92 | (is (eql root (parent child1))) 93 | (is (eql root (parent child2))) 94 | (is (= 2 (array-dimension (children root) 0))) 95 | (is (eql child1 (aref (children root) 0))) 96 | (is (eql child2 (aref (children root) 1))))) 97 | 98 | (test (component-with-nested-children :depends-on component-with-one-child) 99 | (let* ((root (make-instance 'component)) 100 | (child (make-instance 'component :parent root)) 101 | (grandchild (make-instance 'component :parent child))) 102 | (is (eql root (parent child))) 103 | (is (= 1 (array-dimension (children root) 0))) 104 | (is (eql child (aref (children root) 0))) 105 | 106 | (is (eql child (parent grandchild))) 107 | (is (= 1 (array-dimension (children child) 0))) 108 | (is (eql grandchild (aref (children child) 0))))) 109 | 110 | (test (component-with-many-children :depends-on component-with-two-children) 111 | (let* ((n 100) 112 | (root (make-instance 'component)) 113 | (children 114 | (sort (loop repeat n 115 | collect (make-instance 'component :parent root 116 | :depth (random 1.0))) 117 | #'> :key #'depth))) 118 | (is (= n (array-dimension (children root) 0))) 119 | (loop for i from 0 below n 120 | do (is (eql (nth i children) (aref (children root) i))) 121 | do (is (eql root (parent (aref (children root) i))))))) 122 | 123 | (test (component-attach-detach-many-children 124 | :depends-on component-attach-detach-child) 125 | (let* ((n 20) 126 | (root (make-instance 'component)) 127 | (children 128 | (loop repeat n 129 | collect (make-instance 'component :depth (random 1.0)))) 130 | current) 131 | (is (= 0 (array-dimension (children root) 0))) 132 | (loop for i from 0 below n 133 | for child in children 134 | do (attach root child) 135 | do (is (eql root (parent child))) 136 | do (push child current) 137 | do (setf current (sort current #'> :key #'depth)) 138 | do (loop for j from 0 below i 139 | for c in current 140 | do (is (eql c (aref (children root) j))))) 141 | (loop for i from 0 below n 142 | for child in children 143 | do (detach root child) 144 | do (is (eql nil (parent child))) 145 | do (setf current (delete child current)) 146 | do (loop for j from 0 below (- n i) 147 | for c in current 148 | do (is (eql c (aref (children root) j))))))) 149 | 150 | ;;; 151 | ;;; Ensure that update gets called on every node in the entire subtree 152 | ;;; 153 | 154 | (defclass update-test (component) ()) 155 | 156 | (defvar *methods-called*) 157 | 158 | (defmethod update :before ((object update-test)) 159 | (push (list :before object) *methods-called*)) 160 | 161 | (defmethod update ((object update-test)) 162 | (push (list :primary object) *methods-called*) 163 | (call-next-method)) 164 | 165 | (defmethod update :after ((object update-test)) 166 | (push (list :after object) *methods-called*)) 167 | 168 | (test (component-update-no-children :depends-on component-with-no-children) 169 | (let ((root (make-instance 'update-test)) 170 | *methods-called*) 171 | (update root) 172 | (is (equal `((:before ,root) 173 | (:primary ,root) 174 | (:after ,root)) 175 | (reverse *methods-called*))))) 176 | 177 | (test (component-update-two-children 178 | :depends-on (and component-with-two-children 179 | component-update-no-children)) 180 | (let* ((root (make-instance 'update-test)) 181 | (child1 (make-instance 'update-test :parent root :depth 1)) 182 | (child2 (make-instance 'update-test :parent root :depth -1)) 183 | *methods-called*) 184 | (update root) 185 | (is (equal `((:before ,root) 186 | (:primary ,root) 187 | (:before ,child1) 188 | (:primary ,child1) 189 | (:after ,child1) 190 | (:before ,child2) 191 | (:primary ,child2) 192 | (:after ,child2) 193 | (:after ,root)) 194 | (reverse *methods-called*)))) 195 | 196 | ;; changing child depth should change iteration order 197 | (let* ((root (make-instance 'update-test)) 198 | (child1 (make-instance 'update-test :parent root :depth -1)) 199 | (child2 (make-instance 'update-test :parent root :depth 1)) 200 | *methods-called*) 201 | (update root) 202 | (is (equal `((:before ,root) 203 | (:primary ,root) 204 | (:before ,child2) 205 | (:primary ,child2) 206 | (:after ,child2) 207 | (:before ,child1) 208 | (:primary ,child1) 209 | (:after ,child1) 210 | (:after ,root)) 211 | (reverse *methods-called*))))) 212 | 213 | (test (component-update-children 214 | :depends-on (and component-with-nested-children 215 | component-update-no-children)) 216 | (let* ((root (make-instance 'update-test)) 217 | (child (make-instance 'update-test :parent root)) 218 | (grandchild (make-instance 'update-test :parent child)) 219 | *methods-called*) 220 | (update root) 221 | (is (equal `((:before ,root) 222 | (:primary ,root) 223 | (:before ,child) 224 | (:primary ,child) 225 | (:before ,grandchild) 226 | (:primary ,grandchild) 227 | (:after ,grandchild) 228 | (:after ,child) 229 | (:after ,root)) 230 | (reverse *methods-called*))))) 231 | 232 | -------------------------------------------------------------------------------- /src/test/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :cl-user) 27 | 28 | (defpackage :blackthorn-test 29 | (:nicknames :blt-test) 30 | (:use :cl :fiveam :blt-gfx :blt-phys :blt-user) 31 | (:export 32 | 33 | ;; test.lisp 34 | :run-tests 35 | 36 | )) 37 | 38 | (in-package :blackthorn-test) 39 | 40 | (def-suite blackthorn) 41 | 42 | (defun run-tests () 43 | (run! 'blackthorn)) 44 | -------------------------------------------------------------------------------- /src/thopter/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (in-package :cl-user) 27 | 28 | (defpackage :thopter 29 | (:use :cl :iter :blt :blt-user) 30 | (:shadow :speed) 31 | (:export 32 | 33 | ;; driver.lisp 34 | :thopter 35 | 36 | )) 37 | -------------------------------------------------------------------------------- /test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2011, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defvar *driver-system* :blackthorn-test) 27 | 28 | #+quicklisp 29 | (ql:quickload *driver-system*) 30 | 31 | #-quicklisp 32 | (require :asdf) 33 | #-quicklisp 34 | (asdf:operate 'asdf:load-op *driver-system*) 35 | 36 | ;;; -------------------------------------------------------------------------- 37 | ;;; Run main. 38 | ;;; -------------------------------------------------------------------------- 39 | 40 | (in-package :blt-test) 41 | 42 | (run-tests) 43 | 44 | (blt-user::exit) -------------------------------------------------------------------------------- /thopter.asd: -------------------------------------------------------------------------------- 1 | ;;;; Blackthorn -- Lisp Game Engine 2 | ;;;; 3 | ;;;; Copyright (c) 2007-2012, Elliott Slaughter 4 | ;;;; 5 | ;;;; Permission is hereby granted, free of charge, to any person 6 | ;;;; obtaining a copy of this software and associated documentation 7 | ;;;; files (the "Software"), to deal in the Software without 8 | ;;;; restriction, including without limitation the rights to use, copy, 9 | ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;;; of the Software, and to permit persons to whom the Software is 11 | ;;;; furnished to do so, subject to the following conditions: 12 | ;;;; 13 | ;;;; The above copyright notice and this permission notice shall be 14 | ;;;; included in all copies or substantial portions of the Software. 15 | ;;;; 16 | ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;;; DEALINGS IN THE SOFTWARE. 24 | ;;;; 25 | 26 | (defpackage :thopter-asd 27 | (:use :cl :asdf)) 28 | 29 | (in-package :thopter-asd) 30 | 31 | (defsystem thopter 32 | :name "Thopter" 33 | :author "Elliott Slaughter " 34 | :version "0.4.5" 35 | :license "MIT" 36 | :description "Thopter, a shooter game" 37 | :properties ((:long-name . "Thopter")) 38 | :components ((:module src 39 | :components 40 | ((:module thopter 41 | :components 42 | ((:file "package") 43 | (:file "thopter")) 44 | :serial t)))) 45 | :depends-on (:blackthorn)) 46 | -------------------------------------------------------------------------------- /unix/run.sh: -------------------------------------------------------------------------------- 1 | dir="${BASH_SOURCE[0]}"; 2 | if([ -h "${dir}" ]) then 3 | while([ -h "${dir}" ]) do dir=`readlink "${dir}"`; done 4 | fi 5 | pushd . > /dev/null 6 | cd `dirname ${dir}` > /dev/null 7 | dir=`pwd`; 8 | 9 | LD_LIBRARY_PATH=$dir $dir/main 10 | popd > /dev/null 11 | -------------------------------------------------------------------------------- /windows/bt.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/windows/bt.ico -------------------------------------------------------------------------------- /windows/chp/Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # Makefile automatically generated by Code::Blocks IDE # 3 | ############################################################################### 4 | 5 | # Project: GUI application 6 | # Project filename: D:\dev\chp\chp.cbp 7 | # Compiler used: GNU GCC Compiler 8 | 9 | ### Variables used in this Makefile 10 | default_CC=mingw32-gcc.exe 11 | default_CPP=mingw32-g++.exe 12 | default_LD=mingw32-g++.exe 13 | default_LIB=ar.exe 14 | default_RESCOMP=windres.exe 15 | 16 | ### Compiler/linker options 17 | default_GLOBAL_CFLAGS= 18 | default_PROJECT_CFLAGS= -Os 19 | default_GLOBAL_LDFLAGS= 20 | default_PROJECT_LDFLAGS= -s 21 | default_GLOBAL_INCS= -IC:/Program\ Files/CodeBlocks/include 22 | default_PROJECT_INCS= 23 | default_GLOBAL_LIBDIRS= -LC:/Program\ Files/CodeBlocks/lib 24 | default_PROJECT_LIBDIRS= 25 | default_GLOBAL_LIBS= 26 | default_PROJECT_LIBS= 27 | 28 | ### Targets compiler flags 29 | default_CFLAGS= $(default_PROJECT_CFLAGS) $(default_GLOBAL_CFLAGS) 30 | 31 | ### Targets linker flags 32 | default_LDFLAGS= $(default_PROJECT_LDFLAGS) $(default_GLOBAL_LDFLAGS) 33 | 34 | ### Targets include directories 35 | default_INCS= $(default_PROJECT_INCS) $(default_GLOBAL_INCS) 36 | 37 | ### Targets library directories 38 | default_LIBDIRS= $(default_PROJECT_LIBDIRS) $(default_GLOBAL_LIBDIRS) 39 | 40 | ### Targets libraries 41 | default_LIBS= $(default_PROJECT_LIBS) $(default_GLOBAL_LIBS) 42 | 43 | ############################################################################### 44 | # You shouldn't need to modify anything beyond this point # 45 | ############################################################################### 46 | 47 | ### Resources used in this Makefile 48 | default_RESOURCE= 49 | 50 | ### Objects used in this Makefile 51 | default_OBJS=.objs/main.o 52 | default_LINKOBJS=$(default_OBJS) 53 | default_DEPS=.deps/main.d 54 | 55 | ### The targets of this project 56 | default_BIN=chp.exe 57 | 58 | .PHONY: all all-before all-custom all-after clean clean-custom distclean distclean-custom depend_default default-before default-after 59 | 60 | all: all-before default all-after 61 | 62 | 63 | dist: 64 | @zip chp.cbp.zip chp.cbp Makefile main.c 65 | 66 | clean_default: 67 | @echo Cleaning target "default"... 68 | @$(RM) $(default_BIN) $(default_OBJS) $(default_RESOURCE) 69 | 70 | distclean_default: 71 | @echo Dist-cleaning target "default"... 72 | @$(RM) $(default_BIN) $(default_OBJS) $(default_DEPS) $(default_RESOURCE) 73 | 74 | clean: clean_default 75 | 76 | distclean: distclean_default 77 | 78 | depend_default_DIRS: 79 | -@if not exist ".deps\." mkdir ".deps" 80 | 81 | depend_default: depend_default_DIRS $(default_DEPS) 82 | 83 | depend: depend_default 84 | 85 | default_DIRS: 86 | -@if not exist ".objs\." mkdir ".objs" 87 | 88 | default: depend_default default_DIRS default-before $(default_BIN) default-after 89 | 90 | $(default_BIN): $(default_LINKOBJS) $(default_RESOURCE) 91 | @echo Linking executable "chp.exe"... 92 | @$(default_LD) $(default_LIBDIRS) -o $(default_BIN) $(default_LINKOBJS) $(default_RESOURCE) $(default_LDFLAGS) $(default_LIBS) -mwindows 93 | 94 | 95 | .deps/main.d: main.c 96 | @echo Calculating dependencies for "main.c"... 97 | @$(default_CC) -MM $(default_CFLAGS) -MF .deps/main.d -MT .objs/main.o $(default_INCS) main.c 98 | 99 | .objs/main.o: .deps/main.d 100 | @echo Compiling "main.c"... 101 | @$(default_CC) $(default_CFLAGS) $(default_INCS) -c main.c -o .objs/main.o 102 | 103 | 104 | 105 | -------------------------------------------------------------------------------- /windows/chp/Makefile.win: -------------------------------------------------------------------------------- 1 | # Project: GUI Application 2 | # Makefile created by Dev-C++ 4.9.9.2 3 | 4 | CPP = g++.exe 5 | CC = gcc.exe 6 | WINDRES = windres.exe 7 | RES = chp_private.res 8 | OBJ = main.o $(RES) 9 | LINKOBJ = main.o $(RES) 10 | LIBS = -L"C:/Dev-Cpp/lib" -mwindows -s 11 | INCS = -I"C:/Dev-Cpp/include" 12 | CXXINCS = -I"C:/Dev-Cpp/lib/gcc/mingw32/3.4.2/include" -I"C:/Dev-Cpp/include/c++/3.4.2/backward" -I"C:/Dev-Cpp/include/c++/3.4.2/mingw32" -I"C:/Dev-Cpp/include/c++/3.4.2" -I"C:/Dev-Cpp/include" 13 | BIN = chp.exe 14 | CXXFLAGS = $(CXXINCS) 15 | CFLAGS = $(INCS) 16 | RM = rm -f 17 | 18 | .PHONY: all all-before all-after clean clean-custom 19 | 20 | all: all-before chp.exe all-after 21 | 22 | 23 | clean: clean-custom 24 | ${RM} $(OBJ) $(BIN) 25 | 26 | $(BIN): $(OBJ) 27 | $(CC) $(LINKOBJ) -o "chp.exe" $(LIBS) 28 | 29 | main.o: main.c 30 | $(CC) -c main.c -o main.o $(CFLAGS) 31 | 32 | chp_private.res: chp_private.rc 33 | $(WINDRES) -i chp_private.rc --input-format=rc -o chp_private.res -O coff 34 | -------------------------------------------------------------------------------- /windows/chp/README.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | CHP.EXE (Create Hidden Process) 4 | 5 | 6 | Synopsis 7 | 8 | CHP.EXE is a very simple program utilising the Win32 CreateProcess API to 9 | silently launch GUI and console apps in a hidden window. 10 | 11 | Usage 12 | 13 | CHP yourapp arg1 arg2 arg3 ... 14 | For example:- 15 | CHP notepad <-- runs notepad.exe in a hidden window 16 | 17 | Exit Status 18 | 19 | If CHP succeeds, its exit_status is the process ID (PID) of the newly created 20 | process. 21 | If CHP fails to create the specified process, its exit status is the Win32 22 | error_code that caused the failure, multiplied by -1. Use the "NET_HELPMSG" 23 | command to obtain the meaning of the error code. 24 | Although CHP is a windowless GUI application, it writes its exit status to 25 | stdout. In order to see the output, it must be piped into a program that writes 26 | own stdin to stdout (i.e. MORE). For example, in a cmd.exe shell:- 27 | CHP notepad | more 28 | 29 | Compiling 30 | 31 | This package includes a pre-compiled binary, but if you want to compile 32 | CHP yourself, I recommend either of the following free IDE's:- 33 | 34 | * Dev C++, http://www.bloodshed.net/ 35 | * Code::Blocks, http://www.codeblocks.org/ 36 | 37 | Note: The source should be compiled as a GUI (not a console) application. 38 | 39 | -- Ritchie 40 | -------------------------------------------------------------------------------- /windows/chp/chp.cbp: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 32 | 33 | -------------------------------------------------------------------------------- /windows/chp/chp.dev: -------------------------------------------------------------------------------- 1 | [Project] 2 | FileName=chp.dev 3 | Name=GUI Application 4 | UnitCount=1 5 | Type=0 6 | Ver=1 7 | ObjFiles= 8 | Includes= 9 | Libs= 10 | PrivateResource=chp_private.rc 11 | ResourceIncludes= 12 | MakeIncludes= 13 | Compiler= 14 | CppCompiler= 15 | Linker= 16 | IsCpp=0 17 | Icon= 18 | ExeOutput= 19 | ObjectOutput= 20 | OverrideOutput=1 21 | OverrideOutputName=chp.exe 22 | HostApplication= 23 | Folders= 24 | CommandLine= 25 | UseCustomMakefile=0 26 | CustomMakefile= 27 | IncludeVersionInfo=1 28 | SupportXPThemes=0 29 | CompilerSet=0 30 | CompilerSettings=0000000000000000000100 31 | 32 | [Unit1] 33 | FileName=main.c 34 | CompileCpp=0 35 | Folder= 36 | Compile=1 37 | Link=1 38 | Priority=1000 39 | OverrideBuildCmd=0 40 | BuildCmd= 41 | 42 | [VersionInfo] 43 | Major=0 44 | Minor=1 45 | Release=1 46 | Build=13 47 | LanguageID=2057 48 | CharsetID=1252 49 | CompanyName=www.commandline.co.uk 50 | FileVersion= 51 | FileDescription=CHP (Create Hidden Process) 52 | InternalName= 53 | LegalCopyright=2007 Ritchie Lawrence 54 | LegalTrademarks= 55 | OriginalFilename= 56 | ProductName= 57 | ProductVersion= 58 | AutoIncBuildNr=0 59 | 60 | -------------------------------------------------------------------------------- /windows/chp/chp.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/windows/chp/chp.exe -------------------------------------------------------------------------------- /windows/chp/chp.layout: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | [Editors] 9 | Focused=0 10 | Order=0 11 | [Editor_0] 12 | Open=1 13 | Top=1 14 | CursorCol=1 15 | CursorRow=1 16 | TopLine=36 17 | LeftChar=1 18 | -------------------------------------------------------------------------------- /windows/chp/chp_private.h: -------------------------------------------------------------------------------- 1 | /* THIS FILE WILL BE OVERWRITTEN BY DEV-C++ */ 2 | /* DO NOT EDIT ! */ 3 | 4 | #ifndef CHP_PRIVATE_H 5 | #define CHP_PRIVATE_H 6 | 7 | /* VERSION DEFINITIONS */ 8 | #define VER_STRING "0.1.1.13" 9 | #define VER_MAJOR 0 10 | #define VER_MINOR 1 11 | #define VER_RELEASE 1 12 | #define VER_BUILD 13 13 | #define COMPANY_NAME "www.commandline.co.uk" 14 | #define FILE_VERSION "" 15 | #define FILE_DESCRIPTION "CHP (Create Hidden Process)" 16 | #define INTERNAL_NAME "" 17 | #define LEGAL_COPYRIGHT "2007 Ritchie Lawrence" 18 | #define LEGAL_TRADEMARKS "" 19 | #define ORIGINAL_FILENAME "" 20 | #define PRODUCT_NAME "" 21 | #define PRODUCT_VERSION "" 22 | 23 | #endif /*CHP_PRIVATE_H*/ 24 | -------------------------------------------------------------------------------- /windows/chp/chp_private.rc: -------------------------------------------------------------------------------- 1 | /* THIS FILE WILL BE OVERWRITTEN BY DEV-C++ */ 2 | /* DO NOT EDIT! */ 3 | 4 | #include // include for version info constants 5 | 6 | 7 | // 8 | // TO CHANGE VERSION INFORMATION, EDIT PROJECT OPTIONS... 9 | // 10 | 1 VERSIONINFO 11 | FILEVERSION 0,1,1,13 12 | PRODUCTVERSION 0,1,1,13 13 | FILETYPE VFT_APP 14 | { 15 | BLOCK "StringFileInfo" 16 | { 17 | BLOCK "080904E4" 18 | { 19 | VALUE "CompanyName", "www.commandline.co.uk" 20 | VALUE "FileVersion", "" 21 | VALUE "FileDescription", "CHP (Create Hidden Process)" 22 | VALUE "InternalName", "" 23 | VALUE "LegalCopyright", "2007 Ritchie Lawrence" 24 | VALUE "LegalTrademarks", "" 25 | VALUE "OriginalFilename", "" 26 | VALUE "ProductName", "" 27 | VALUE "ProductVersion", "" 28 | } 29 | } 30 | BLOCK "VarFileInfo" 31 | { 32 | VALUE "Translation", 0x0809, 1252 33 | } 34 | } 35 | 36 | -------------------------------------------------------------------------------- /windows/chp/chp_private.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/windows/chp/chp_private.res -------------------------------------------------------------------------------- /windows/chp/main.c: -------------------------------------------------------------------------------- 1 | /* 2 | * CHP (Create Hidden Process) - 3 | * Silently creates a GUI or console process in a hidden window 4 | * 5 | * Copyright (C) 2007 Ritchie Lawrence 6 | * http://www.commandline.co.uk 7 | * 8 | * This program is free software: you can redistribute it and/or modify 9 | * it under the terms of the GNU General Public License as published by 10 | * the Free Software Foundation, either version 3 of the License, or 11 | * (at your option) any later version. 12 | * 13 | * This program is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | * GNU General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU General Public License 19 | * along with this program. If not, see . 20 | */ 21 | 22 | #define UNICODE 23 | #include 24 | 25 | PTCHAR GetArgs(VOID) 26 | { 27 | PTCHAR p = GetCommandLine(); 28 | 29 | if(*p == TEXT('"')) 30 | { 31 | while(*p == TEXT('"')) p++; // skip any leading quotes 32 | while(*p != TEXT('"')) p++; // skip over exe name 33 | while(*p == TEXT('"')) p++; // skip any trailing quotes 34 | } 35 | else // didn't start with a quote, so skip non-whitespace 36 | { 37 | while((*p) && (*p != TEXT(' ')) && (*p != TEXT('\t'))) p++; 38 | } 39 | // skip whitespace 40 | while((*p) && ((*p == TEXT(' ')) || (*p == TEXT('\t')))) p++; 41 | return p; 42 | } 43 | 44 | INT main(VOID) 45 | { 46 | PTCHAR Args; 47 | Args = GetArgs(); 48 | INT ExitCode; 49 | 50 | STARTUPINFO si; 51 | ZeroMemory(&si, sizeof(si)); 52 | si.cb = sizeof(si); 53 | si.dwFlags = STARTF_USESHOWWINDOW; 54 | si.wShowWindow = SW_HIDE; 55 | 56 | PROCESS_INFORMATION pi; 57 | ZeroMemory(&pi, sizeof(pi)); 58 | 59 | // if CreateProcess fails, exit with GetLastError, otherwise exit with (process ID * -1) 60 | ExitCode = CreateProcess(NULL, Args, NULL, NULL, FALSE, CREATE_NEW_CONSOLE, NULL, NULL, &si, &pi) \ 61 | ? pi.dwProcessId : GetLastError() * -1; 62 | 63 | printf("%d\n", ExitCode); 64 | exit(ExitCode); 65 | } 66 | -------------------------------------------------------------------------------- /windows/is_user_admin.nsh: -------------------------------------------------------------------------------- 1 | ; from http://nsis.sourceforge.net/IsUserAdmin 2 | ; 3 | ; Author: Lilla (lilla@earthlink.net) 2003-06-13 4 | ; function IsUserAdmin uses plugin \NSIS\PlusgIns\UserInfo.dll 5 | ; This function is based upon code in \NSIS\Contrib\UserInfo\UserInfo.nsi 6 | ; This function was tested under NSIS 2 beta 4 (latest CVS as of this writing). 7 | ; 8 | ; Usage: 9 | ; Call IsUserAdmin 10 | ; Pop $R0 ; at this point $R0 is "true" or "false" 11 | ; 12 | Function IsUserAdmin 13 | Push $R0 14 | Push $R1 15 | Push $R2 16 | 17 | ClearErrors 18 | UserInfo::GetName 19 | IfErrors Win9x 20 | Pop $R1 21 | UserInfo::GetAccountType 22 | Pop $R2 23 | 24 | StrCmp $R2 "Admin" 0 Continue 25 | ; Observation: I get here when running Win98SE. (Lilla) 26 | ; The functions UserInfo.dll looks for are there on Win98 too, 27 | ; but just don't work. So UserInfo.dll, knowing that admin isn't required 28 | ; on Win98, returns admin anyway. (per kichik) 29 | ; MessageBox MB_OK 'User "$R1" is in the Administrators group' 30 | StrCpy $R0 "true" 31 | Goto Done 32 | 33 | Continue: 34 | ; You should still check for an empty string because the functions 35 | ; UserInfo.dll looks for may not be present on Windows 95. (per kichik) 36 | StrCmp $R2 "" Win9x 37 | StrCpy $R0 "false" 38 | ;MessageBox MB_OK 'User "$R1" is in the "$R2" group' 39 | Goto Done 40 | 41 | Win9x: 42 | ; comment/message below is by UserInfo.nsi author: 43 | ; This one means you don't need to care about admin or 44 | ; not admin because Windows 9x doesn't either 45 | ;MessageBox MB_OK "Error! This DLL can't run under Windows 9x!" 46 | StrCpy $R0 "true" 47 | 48 | Done: 49 | ;MessageBox MB_OK 'User= "$R1" AccountType= "$R2" IsUserAdmin= "$R0"' 50 | 51 | Pop $R2 52 | Pop $R1 53 | Exch $R0 54 | FunctionEnd 55 | -------------------------------------------------------------------------------- /windows/thopter.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skypher/blackthorn/914b38a95f1d192219f197e4b4a77b1632daa94b/windows/thopter.ico --------------------------------------------------------------------------------