M .gitignore => .gitignore +1 -0
@@ 1,6 1,7 @@
crates2-text
crates2-charms
crates2-sdl2
+crates2-sdl2-opengl
.#*
expected.txt.bz2
expected.txt
M Makefile => Makefile +20 -13
@@ 16,7 16,7 @@ LISP ?= sbcl
EVAL ?= "--eval"
level ?= 0
-all: crates2-text crates2-charms crates2-sdl2
+all: crates2-text crates2-charms crates2-sdl2 crates2-sdl2-opengl
.PHONY: slime clean help test
@@ 38,6 38,12 @@ crates2-sdl2: Makefile crates2-sdl2.asd src/*.lisp etc/assets/font/IBM/Plex/IBMP
(asdf:make :crates2-sdl2) \
(quit))"
+crates2-sdl2-opengl: Makefile crates2-sdl2-opengl.asd src/*.lisp etc/assets/font/IBM/Plex/IBMPlexMono-Bold.ttf etc/assets/texture/texture32.png
+ @$(LISP) $(EVAL) "(progn (declaim (optimize (speed 0) (space 0) (safety 3) (debug 3))) \
+ (ql:quickload :crates2-sdl2-opengl) \
+ (asdf:make :crates2-sdl2-opengl) \
+ (quit))"
+
slime:
@etc/slime.sh &
@@ 51,7 57,7 @@ install: crates2-text crates2-charms
@etc/install.sh
clean:
- @rm -f crates2-text crates2-charms crates2-sdl2 expected.txt.bz2 expected.txt got.txt
+ @rm -f crates2-text crates2-charms crates2-sdl2 crates2-sdl2-opengl expected.txt.bz2 expected.txt got.txt
test: crates2-text
@etc/test.sh
@@ 61,14 67,15 @@ help:
@echo ' make <target>'
@echo ''
@echo 'Targets:'
- @echo ' all build standalone binaries crates2 text, charms, SDL and OpenGL (default target)'
- @echo ' crates2-text build standalone binary executable for crates2 text mode'
- @echo ' crates2-charms build standalone binary executable for crates2 charms (ncurses) mode'
- @echo ' crates2-sdl2 build standalone binary executable for crates2 SDL2 (2D) mode'
- @echo ' run build standalone binary and run it'
- @echo ' play build standalone binary and autoplay it from given level'
- @echo ' install build standalone binary and install it'
- @echo ' slime start Emacs/slime (if needed) with crates2 loaded'
- @echo ' clean remove build artifacts'
- @echo ' test build and do a play test'
- @echo ' help show this help'
+ @echo ' all build standalone binaries crates2 text, charms, SDL and OpenGL (default target)'
+ @echo ' crates2-text build standalone binary executable for crates2 text mode'
+ @echo ' crates2-charms build standalone binary executable for crates2 charms (ncurses) mode'
+ @echo ' crates2-sdl2 build standalone binary executable for crates2 SDL2 (2D) mode'
+ @echo ' crates2-sdl2-opengl build standalone binary executable for crates2 SDL2 (3D) mode'
+ @echo ' run build standalone binary and run it'
+ @echo ' play build standalone binary and autoplay it from given level'
+ @echo ' install build standalone binary and install it'
+ @echo ' slime start Emacs/slime (if needed) with crates2 loaded'
+ @echo ' clean remove build artifacts'
+ @echo ' test build and do a play test'
+ @echo ' help show this help'
M README.org => README.org +38 -4
@@ 8,11 8,12 @@ is to be added.
*Please note that this is still Work In Progress.*
* Getting Started
+** Prerequisites
-Prerequisites:
+At this stage: =Common Lisp= implementation (tested with SBCL), =Quicklisp=, =make=,
+=libffi=, =SDL2=, =SDL2-image=, =SDL2-mixer=, =GL= and =GLU= libraries.
-At this stage: =Common Lisp= implementation (tested with SBCL), =Quicklisp=, =make=
-and =SDL2= library.
+*** Cloning and Building
Get sources and build by issuing commands:
@@ 30,6 31,16 @@ But please note, that the path given in that file probably
has to be changed to match the location of the cloned directory
on your machine.
+If =libffi= is not found on a UNIX like system, the
+following change to file
+=$HOME/quicklisp/dists/quicklisp/software/cffi_0.23.0/libffi/libffi.lisp=
+might help:
+
+#+begin_src diff
+- (:unix (:or "libffi.so.7" "libffi32.so.7" "libffi.so.6" "libffi32.so.6" "libffi.so.5" "libffi32.so.5"))
++ (:unix (:or "libffi.so.7" "libffi32.so.7" "libffi.so.6" "libffi32.so.6" "libffi.so.5" "libffi32.so.5" "libffi.so"))
+#+end_src
+
You can also build and run by issuing command:
#+begin_src shell
@@ 42,8 53,31 @@ To install and start playing from level 20:
make install && make play level=20
#+end_src
-** Platform Specific Notes
+*** Controls
+**** In 3D Mode
+
+| Key | Action |
+|-------------+-------------------------------|
+| LEFT | Move west |
+|-------------+-------------------------------|
+| RIGHT | Move east |
+|-------------+-------------------------------|
+| UP | Move north |
+|-------------+-------------------------------|
+| DOWN | Move south |
+|-------------+-------------------------------|
+| SHIFT+LEFT | Previous level |
+|-------------+-------------------------------|
+| SHIFT+RIGHT | Next level |
+|-------------+-------------------------------|
+| SPACE | Action 1 |
+|-------------+-------------------------------|
+| R | Restart current level |
+|-------------+-------------------------------|
+| B or ESC | Go back or exit current state |
+|-------------+-------------------------------|
+** Platform Specific Notes
*** OpenBSD
To use crates2 in OpenBSD without Common Lisp REPL - i.e. by running the generated
M crates2-charms.asd => crates2-charms.asd +1 -0
@@ 25,6 25,7 @@
(:file "simple-crates")
(:file "exit")
(:file "key")
+ (:file "special")
(:file "pulled")
(:file "toggle")
(:file "player")
A crates2-sdl2-opengl.asd => crates2-sdl2-opengl.asd +56 -0
@@ 0,0 1,56 @@
+;; Octaspire Crates 2 - Puzzle Game
+;; Copyright 2020, 2021 octaspire.com
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+(asdf:defsystem "crates2-sdl2-opengl"
+ :depends-on (:alexandria
+ :unix-opts
+ :parse-float
+ :trivial-garbage
+ :cffi
+ :cffi-libffi
+ :trivial-features
+ :log4cl)
+ :serial t
+ :components ((:module src
+ :components
+ ((:file "package")
+ (:file "classes")
+ (:file "utils")
+ (:file "crate")
+ (:file "moving")
+ (:file "simple-crates")
+ (:file "exit")
+ (:file "key")
+ (:file "special")
+ (:file "pulled")
+ (:file "toggle")
+ (:file "player")
+ (:file "slopes")
+ (:file "turnstiles")
+ (:file "bomb")
+ (:file "block-timer")
+ (:file "block-counter")
+ (:file "pass-counter")
+ (:file "pass-timer")
+ (:file "vacuum")
+ (:file "stepper")
+ (:file "level")
+ (:file "octaspire-cl-sdl2")
+ (:file "sdl2-3d")
+ (:file "sdl2-common")
+ (:file "levels")
+ (:file "main"))))
+ :build-operation program-op
+ :build-pathname "crates2-sdl2-opengl"
+ :entry-point "crates2:main")
M crates2-sdl2.asd => crates2-sdl2.asd +2 -0
@@ 32,6 32,7 @@
(:file "simple-crates")
(:file "exit")
(:file "key")
+ (:file "special")
(:file "pulled")
(:file "toggle")
(:file "player")
@@ 47,6 48,7 @@
(:file "level")
(:file "octaspire-cl-sdl2")
(:file "sdl2-2d")
+ (:file "sdl2-common")
(:file "levels")
(:file "main"))))
:build-operation program-op
M crates2-text.asd => crates2-text.asd +1 -0
@@ 25,6 25,7 @@
(:file "simple-crates")
(:file "exit")
(:file "key")
+ (:file "special")
(:file "pulled")
(:file "toggle")
(:file "player")
M etc/assets/texture/texture32.png => etc/assets/texture/texture32.png +0 -0
M etc/assets/texture/texture64.png => etc/assets/texture/texture64.png +0 -0
M src/classes.lisp => src/classes.lisp +17 -3
@@ 43,8 43,12 @@
:initform t
:accessor active)
(tail :initarg :tail
- :initform nil
- :accessor moving-tail)))
+ :initform nil
+ :accessor moving-tail)
+ (specials :initform nil
+ :accessor moving-specials)
+ (airborne :initform nil
+ :accessor moving-airborne)))
(defclass wall (crate)
())
@@ 160,6 164,14 @@
:initform 0
:accessor key-active-step)))
+(defclass special-jump (crate)
+ ((active-step :initarg :active-step
+ :initform 0
+ :accessor special-jump-active-step)
+ (target :initarg :target
+ :initform nil
+ :accessor special-jump-target)))
+
(defclass pulled (moving)
((puller :initarg :puller
:accessor pulled-puller
@@ 193,7 205,9 @@
(defclass player (moving)
((delay :initform 0
- :accessor player-delay)))
+ :accessor player-delay)
+ (pending-input :initform nil
+ :accessor player-pending-input)))
(defclass vacuum (crate)
((full :initarg :full
M src/levels.lisp => src/levels.lisp +3 -2
@@ 28,10 28,11 @@
:south nil nil nil nil
:north)
(list (make-instance 'pulled :x 4 :y 3 :z 0 :east t)
- (make-instance 'pulled :x 5 :y 9 :z 0 :north t)
- (make-instance 'pushed :x 5 :y 5 :z 0)
+ (make-instance 'pulled :x 5 :y 14 :z 0 :north t)
+ ;; (make-instance 'pushed :x 5 :y 5 :z 0)
(make-instance 'vacuum :x 5 :y 7 :z -1)
(make-instance 'player :x 6 :y 3 :z 0)
+ (make-instance 'special-jump :x 7 :y 3 :z 0)
(make-instance 'pulled :x 8 :y 3 :z 0 :west t)
(make-instance 'pulled :x 5 :y 2 :z 0 :south t)
(make-instance 'pulled :x 2 :y 8 :z 0 :east t)
M src/main.lisp => src/main.lisp +18 -21
@@ 26,11 26,11 @@
(defparameter *errors* nil)
(defparameter *update-counter* 0)
(defparameter *input* nil)
-(defparameter *level-number* -1)
+(defparameter *level-number* 7)
(defparameter *running* t)
(defparameter *level* nil)
(defparameter *created* nil)
-(defparameter *next-level* nil)
+(defparameter *next-level* 8)
(defparameter *level-width* 20)
(defparameter *level-height* 20)
(defparameter *frame-duration-default* 0.125) ; Not zeroed in test mode.
@@ 110,23 110,6 @@ This is similar to 'test' but runs much slower."
(when (> *verbose* 0)
(format t fmt args)))
-(defun ui-maybe-read-input ()
- (let ((player (find-first-crate-of-type 'player)))
- (if (null player)
- (crates2-ui:ui-read-input) ; clean the event queue
- (progn
- (if (movingp player)
- (let ((pending (crates2-ui:ui-read-input)))
- (when pending
- (setf *pending-input* pending))
- nil) ; No input while player moves, in textual mode.
- (progn (setf *last-input*
- (if *pending-input*
- *pending-input*
- (crates2-ui:ui-read-input)))
- (setf *pending-input* nil)
- *last-input*))))))
-
(defun ui-input ()
(if *level*
(if *test-run*
@@ 134,9 117,21 @@ This is similar to 'test' but runs much slower."
(setf *fake-input* (cdr *fake-input*))
(setf *last-input* input)
input)
- (ui-maybe-read-input))
+ (let ((pending (crates2-ui:ui-read-input)))
+ (when pending
+ (setf *last-input* pending))
+ pending))
nil))
+(defun reset-to-level (num)
+ (let ((valid num)
+ (largest (- *num-levels* 1)))
+ (when (< valid 0)
+ (setf valid largest))
+ (when (> valid largest)
+ (setf valid 0))
+ (setf *next-level* valid)))
+
(defun run (options)
(unless *errors*
(crates2-ui:ui-init)
@@ 160,7 155,9 @@ This is similar to 'test' but runs much slower."
(setf *input* (cons input *input*))
(case input
(:back (running nil))
- (:restart (setf *next-level* *level-number*)))))
+ (:restart (reset-to-level *level-number*))
+ (:prev (reset-to-level (1- *level-number*)))
+ (:next (reset-to-level (1+ *level-number*))))))
(unless *next-level*
(update *level*))
(when *next-level*
M src/moving.lisp => src/moving.lisp +23 -2
@@ 36,13 36,16 @@
(defmethod update ((self moving))
(setf (moving-tail self) nil)
(when (active self)
- (let ((v (velocity self)))
+ (let ((v (velocity self))
+ (airborne (moving-airborne self)))
(ecase v
(:east (east self))
(:west (west self))
(:north (north self))
(:south (south self))
- (:zero))))
+ (:zero))
+ (when airborne
+ (fall self))))
(call-next-method))
(defmethod tail-x ((self moving))
@@ 82,6 85,24 @@
(defmethod set-tail ((self moving) x y z)
(setf (moving-tail self) (list x y z)))
+(defmethod jump ((self moving))
+ (let* ((z (+ (crate-z self) 1))
+ (specials (moving-specials self))
+ (airborne (moving-airborne self))
+ (crate (find-at (crate-x self) (crate-y self) z)))
+ (unless airborne
+ (when specials
+ (setf (moving-specials self) (cdr (moving-specials self)))
+ (if crate
+ (handle-collision self crate)
+ (setf (moving-airborne self) 1))))))
+
+(defmethod fall ((self moving))
+ (when (moving-airborne self)
+ (setf (moving-airborne self) (1- (moving-airborne self)))
+ (when (< (moving-airborne self) 0)
+ (setf (moving-airborne self) nil))))
+
(defmethod west ((self moving))
(let* ((x (- (crate-x self) 1))
(crate (find-at x (crate-y self) (crate-z self))))
M src/octaspire-cl-sdl2.lisp => src/octaspire-cl-sdl2.lisp +362 -3
@@ 39,10 39,25 @@
(:darwin (:or (:framework "SDL2_mixer") (:default "libSDL2_mixer")))
(:unix (:or "libSDL2_mixer-2.0.so")))
+(define-foreign-library libgl
+ (:darwin (:or (:framework "GL") (:default "libGL")))
+ (:unix (:or "libGL.so")))
+
+(define-foreign-library libglu
+ (:darwin (:or (:framework "GLU") (:default "libGLU")))
+ (:unix (:or "libGLU.so")))
+
+(define-foreign-library libglew
+ (:darwin (:or (:framework "GLEW") (:default "libGLEW")))
+ (:unix (:or "libGLEW.so")))
+
(use-foreign-library libsdl2)
(use-foreign-library libsdl2-image)
(use-foreign-library libsdl2-ttf)
(use-foreign-library libsdl2-mixer)
+(use-foreign-library libgl)
+(use-foreign-library libglu)
+(use-foreign-library libglew)
(defcfun "SDL_Init" :int
(flags :long))
@@ 771,6 786,22 @@
(file :pointer) ; char*
(windowID :uint32))
+;; Declared in SDL_surface.h
+(defcstruct sdl-surface
+ "Collection of pixels."
+ (flags :uint32)
+ (format :pointer)
+ (w :int)
+ (h :int)
+ (pitch :int)
+ (pixels :pointer)
+ (userdata :pointer)
+ (locked :int)
+ (list-blitmap :pointer)
+ (clip-rect (:struct sdl-rect))
+ (map :pointer)
+ (refcount :int))
+
(defcunion sdl-event
"General event structure (union)."
(type sdl-eventtype)
@@ 965,6 996,38 @@
(:SDL-LASTEVENT (format nil "TYPE: LastEvent")))))
;; Declared in include/SDL_video.h
+(eval (let ((sdl-win-fullscr #x01))
+ `(defcenum sdl-windowflags
+ "Flags for a window"
+ (:SDL-WINDOW-FULLSCREEN ,sdl-win-fullscr)
+ (:SDL-WINDOW-OPENGL #x02)
+ (:SDL-WINDOW-SHOWN #x04)
+ (:SDL-WINDOW-HIDDEN #x08)
+ (:SDL-WINDOW-BORDERLESS #x10)
+ (:SDL-WINDOW-RESIZABLE #x20)
+ (:SDL-WINDOW-MINIMIZED #x40)
+ (:SDL-WINDOW-MAXIMIZED #x80)
+ (:SDL-WINDOW-INPUT-GRABBED #x100)
+ (:SDL-WINDOW-INPUT-FOCUS #x200)
+ (:SDL-WINDOW-MOUSE-FOCUS #x400)
+ (:SDL-WINDOW-FULLSCREEN-DESKTOP ,(logior sdl-win-fullscr #x1000))
+ (:SDL-WINDOW-FOREIGN #x800)
+ (:SDL-WINDOW-ALLOW-HIGHDPI #x2000)
+ (:SDL-WINDOW-MOUSE-CAPTURE #x4000)
+ (:SDL-WINDOW-ALWAYS-ON-TOP #x8000)
+ (:SDL-WINDOW-SKIP-TASKBAR #x10000)
+ (:SDL-WINDOW-UTILITY #x20000)
+ (:SDL-WINDOW-TOOLTIP #x40000)
+ (:SDL-WINDOW-POPUP-MENU #x80000)
+ (:SDL-WINDOW-VULKAN #x10000000)
+ (:SDL-WINDOW-METAL #x20000000))))
+
+(defcfun "SDL_GL_CreateContext" :pointer
+ (window :pointer))
+
+(defcfun "SDL_GL_SetSwapInterval" :int
+ (interval :int))
+
(defcfun "SDL_CreateWindow" :pointer
(title (:string :encoding :utf-8))
(x :int)
@@ 973,7 1036,261 @@
(flags :uint32)
(h :int))
-
+;; Defined in SDL_keycode.h
+(defconstant +KMOD-NONE+ #x0)
+(defconstant +KMOD-LSHIFT+ #x1)
+(defconstant +KMOD-RSHIFT+ #x2)
+(defconstant +KMOD-LCTRL+ #x40)
+(defconstant +KMOD-RCTRL+ #x80)
+(defconstant +KMOD-LALT+ #x100)
+(defconstant +KMOD-RALT+ #x200)
+(defconstant +KMOD-LGUI+ #x400)
+(defconstant +KMOD-RGUI+ #x800)
+(defconstant +KMOD-NUM+ #x1000)
+(defconstant +KMOD-CAPS+ #x2000)
+(defconstant +KMOD-MODE+ #x4000)
+(defconstant +KMOD-RESERVED+ #x8000)
+(defconstant +KMOD-CTRL+ (logior +KMOD-LCTRL+ +KMOD-RCTRL+))
+(defconstant +KMOD-SHIFT+ (logior +KMOD-LSHIFT+ +KMOD-RSHIFT+))
+(defconstant +KMOD-ALT+ (logior +KMOD-LALT+ +KMOD-RALT+))
+(defconstant +KMOD-GUI+ (logior +KMOD-LGUI+ +KMOD-RGUI+))
+
+(defcfun "SDL_GetModState" :uint32) ; SDL_Keymod in C
+
+;; OpenGL
+
+;; declared in GL/gl.h
+(defconstant +GL-CURRENT-BIT+ #x1)
+(defconstant +GL-POINT-BIT+ #x2)
+(defconstant +GL-LINE-BIT+ #x4)
+(defconstant +GL-POLYGON-BIT+ #x8)
+(defconstant +GL-POLYGON-STIPPLE-BIT+ #x10)
+(defconstant +GL-PIXEL-MODE-BIT+ #x20)
+(defconstant +GL-LIGHTING-BIT+ #x40)
+(defconstant +GL-FOG-BIT+ #x80)
+(defconstant +GL-DEPTH-BUFFER-BIT+ #x100)
+(defconstant +GL-ACCUM-BUFFER-BIT+ #x200)
+(defconstant +GL-STENCIL-BUFFER-BIT+ #x400)
+(defconstant +GL-VIEWPORT-BIT+ #x800)
+(defconstant +GL-TRANSFORM-BIT+ #x1000)
+(defconstant +GL-ENABLE-BIT+ #x2000)
+(defconstant +GL-COLOR-BUFFER-BIT+ #x4000)
+(defconstant +GL-EVAL-BIT+ #x10000)
+(defconstant +GL-LIST-BIT+ #x20000)
+(defconstant +GL-TEXTURE-BIT+ #x40000)
+(defconstant +GL-SCISSOR-BIT+ #x80000)
+(defconstant +GL-ALL-ATTRIB-BITS+ #xFFFFFFFF)
+
+(defconstant +GL-TEXTURE-2D+ #x0DE1)
+(defconstant +GL-DEPTH-TEST+ #x0B71)
+(defconstant +GL-DEPTH-TEST+ #x0B71)
+(defconstant +GL-CULL-FACE+ #x0B44)
+(defconstant +GL-ALPHA-TEST+ #x0BC0)
+
+(defconstant +GL-NO-ERROR+ #x0)
+(defconstant +GL-INVALID-ENUM+ #x500)
+(defconstant +GL-INVALID-VALUE+ #x501)
+(defconstant +GL-INVALID-OPERATION+ #x502)
+(defconstant +GL-STACK-OVERFLOW+ #x503)
+(defconstant +GL-STACK-UNDERFLOW+ #x504)
+(defconstant +GL-OUT-OF-MEMORY+ #x505)
+
+(defconstant +GL-BYTE+ #x1400)
+(defconstant +GL-UNSIGNED-BYTE+ #x1401)
+
+(defconstant +GL-RGB+ #x1907)
+(defconstant +GL-RGBA+ #x1908)
+
+(defconstant +GL-LIGHTING+ #x0B50)
+
+(defconstant +GL-BLEND+ #x0BE2)
+
+(defcfun "glewInit" :uint)
+
+(defcfun "glGetError" :uint32) ; GLenum for real
+(defcfun "gluErrorString" (:string :encoding :utf-8)
+ (error :uint32)) ;; GLenum for real
+
+(defcfun "glClear" :void
+ (mask :uint32))
+
+(defcfun "glClearColor" :void
+ (red :float)
+ (green :float)
+ (blue :float)
+ (alpha :float))
+
+(defcfun "glDisable" :void
+ (cap :uint32))
+
+(defcfun "glEnable" :void
+ (cap :uint32))
+
+(defcfun "glBlendFunc" :void
+ (sfactor :uint32)
+ (dfactor :uint32))
+
+(defcfun "glGenTextures" :void
+ (n :uint32)
+ (textures :pointer))
+
+(defcfun "glBindTexture" :void
+ (target :uint32)
+ (texture :uint32))
+
+(defcfun "glTranslatef" :void
+ (x :float)
+ (y :float)
+ (z :float))
+
+(defcfun "glViewport" :void
+ (x :int32)
+ (y :int32)
+ (w :uint32)
+ (h :uint32))
+
+(defcfun "glFlush" :void)
+
+;; GLenum for real. Defined in include/GL/gl.h
+(defconstant +GL-MODELVIEW+ #x1700)
+(defconstant +GL-PROJECTION+ #x1701)
+(defconstant +GL-TEXTURE+ #x1702)
+(defconstant +GL-COLOR+ #x1800)
+
+(defcfun "glMatrixMode" :void
+ (mode :uint))
+
+(defcfun "glLoadIdentity" :void)
+
+(defcfun "gluPerspective" :void
+ (fovy :double)
+ (aspect :double)
+ (znear :double)
+ (zfar :double))
+
+(defcfun "gluOrtho2D" :void
+ (left :double)
+ (rightt :double)
+ (bottom :double)
+ (top :double))
+
+(defcfun "glColor3f" :void
+ (red :float)
+ (green :float)
+ (blue :float))
+
+(defcfun "glColor4f" :void
+ (red :float)
+ (green :float)
+ (blue :float)
+ (alpha :float))
+
+(defcfun "glVertex3f" :void
+ (x :float)
+ (y :float)
+ (z :float))
+
+(defcfun "glNormal3f" :void
+ (nx :float)
+ (ny :float)
+ (nz :float))
+
+(defcfun "glTexCoord2f" :void
+ (cs :float)
+ (ct :float))
+
+(defcfun "gluLookAt" :void
+ (eyeX :double)
+ (eyeY :double)
+ (eyeZ :double)
+ (centerX :double)
+ (centerY :double)
+ (centerZ :double)
+ (upX :double)
+ (upY :double)
+ (upZ :double))
+
+(defcfun "glTexImage2D" :void
+ (target :uint32)
+ (level :int32)
+ (internalformat :int32)
+ (width :uint32)
+ (height :uint32)
+ (border :int32)
+ (format :uint32)
+ (type :uint32)
+ (pixels :pointer))
+
+(defcfun "glTexParameteri" :void
+ (texture :uint32)
+ (pname :uint32)
+ (param :int32))
+
+(defcfun "glPushMatrix" :void)
+(defcfun "glPopMatrix" :void)
+
+;; GLenum for real. Defined in include/GL/gl.h
+(defconstant +GL-POINTS+ #x0)
+(defconstant +GL-LINES+ #x1)
+(defconstant +GL-LINE-LOOP+ #x2)
+(defconstant +GL-LINE-STRIP+ #x3)
+(defconstant +GL-TRIANGLES+ #x4)
+(defconstant +GL-TRIANGLE-STRIP+ #x5)
+(defconstant +GL-TRIANGLE-FAN+ #x6)
+(defconstant +GL-QUADS+ #x7)
+(defconstant +GL-QUAD-STRIP+ #x8)
+(defconstant +GL-POLYGON+ #x9)
+
+;; Blending.
+(defconstant +GL-BLEND+ #x0BE2)
+(defconstant +GL-BLEND-SRC+ #x0BE1)
+(defconstant +GL-BLEND-DST+ #x0BE0)
+(defconstant +GL-ZERO+ #x0)
+(defconstant +GL-ONE+ #x1)
+(defconstant +GL-SRC-COLOR+ #x0300)
+(defconstant +GL-ONE-MINUS-SRC-COLOR+ #x0301)
+(defconstant +GL-SRC-ALPHA+ #x0302)
+(defconstant +GL-ONE-MINUS-SRC-ALPHA+ #x0303)
+(defconstant +GL-DST-ALPHA+ #x0304)
+(defconstant +GL-ONE-MINUS-DST-ALPHA+ #x0305)
+(defconstant +GL-DST-COLOR+ #x0306)
+(defconstant +GL-ONE-MINUS-DST-COLOR+ #x0307)
+(defconstant +GL-SRC-ALPHA-SATURATE+ #x0308)
+
+;; Hints
+(defconstant +GL-PERSPECTIVE-CORRECTION-HINT+ #x0C50)
+(defconstant +GL-POINT-SMOOTH-HINT+ #x0C51)
+(defconstant +GL-LINE-SMOOTH-HINT+ #x0C52)
+(defconstant +GL-POLYGON-SMOOTH-HINT+ #x0C53)
+(defconstant +GL-FOG-HINT+ #x0C54)
+(defconstant +GL-DONT-CARE+ #x1100)
+(defconstant +GL-FASTEST+ #x1101)
+(defconstant +GL-NICEST+ #x1102)
+
+;; Texture mapping
+(defconstant +GL-TEXTURE-MAG-FILTER+ #x2800)
+(defconstant +GL-TEXTURE-MIN-FILTER+ #x2801)
+(defconstant +GL-LINEAR+ #x2601)
+(defconstant +GL-NEAREST+ #x2600)
+
+(defcfun "glBegin" :void
+ (mode :uint))
+
+(defcfun "glEnd" :void)
+
+(defcfun "glHint" :void
+ (target :uint32)
+ (mode :uint32))
+
+
+
+
+
+(defcfun "SDL_LockSurface" :int
+ (surface :pointer))
+
+(defcfun "SDL_UnlockSurface" :void
+ (surface :pointer))
@@ 1181,8 1498,50 @@
(mix-closeaudio))))
-
-
+;;; OpenGL
+
+(defcenum sdl-glattr
+ "OpenGL configuration attributes"
+ (:SDL-GL-RED-SIZE 0)
+ (:SDL-GL-GREEN-SIZE)
+ (:SDL-GL-BLUE-SIZE)
+ (:SDL-GL-ALPHA-SIZE)
+ (:SDL-GL-BUFFER-SIZE)
+ (:SDL-GL-DOUBLEBUFFER)
+ (:SDL-GL-DEPTH-SIZE)
+ (:SDL-GL-STENCIL-SIZE)
+ (:SDL-GL-ACCUM-RED-SIZE)
+ (:SDL-GL-ACCUM-GREEN-SIZE)
+ (:SDL-GL-ACCUM-BLUE-SIZE)
+ (:SDL-GL-ACCUM-ALPHA-SIZE)
+ (:SDL-GL-STEREO)
+ (:SDL-GL-MULTISAMPLEBUFFERS)
+ (:SDL-GL-MULTISAMPLESAMPLES)
+ (:SDL-GL-ACCELERATED-VISUAL)
+ (:SDL-GL-RETAINED-BACKING)
+ (:SDL-GL-CONTEXT-MAJOR-VERSION)
+ (:SDL-GL-CONTEXT-MINOR-VERSION)
+ (:SDL-GL-CONTEXT-EGL)
+ (:SDL-GL-CONTEXT-FLAGS)
+ (:SDL-GL-CONTEXT-PROFILE-MASK)
+ (:SDL-GL-SHARE-WITH-CURRENT-CONTEXT)
+ (:SDL-GL-FRAMEBUFFER_SRGB_CAPABLE)
+ (:SDL-GL-CONTEXT-RELEASE-BEHAVIOR)
+ (:SDL-GL-CONTEXT-RESET-NOTIFICATION)
+ (:SDL-GL-CONTEXT-NO-ERROR))
+
+(defcenum sdl-glprofile
+ "Profile mask"
+ (:SDL-GL-CONTEXT-PROFILE-CORE #x01)
+ (:SDL-GL-CONTEXT-PROFILE-COMPATIBILITY #x02)
+ (:SDL-GL-CONTEXT-PROFILE-ES #x04))
+
+(defcfun "SDL_GL_SetAttribute" :int
+ (attr sdl-glattr)
+ (value :int))
+
+(defcfun "SDL_GL_SwapWindow" :void
+ (window :pointer))
;; Helpers
M src/pass-counter.lisp => src/pass-counter.lisp +1 -1
@@ 21,7 21,7 @@
(pass-counter-passes self)))
(defmethod visual ((self pass-counter))
- (let ((result "number-")
+ (let ((result "number-bottom-")
(passstr (format nil "~2,'0d" (passes-left self))))
(setf result (concatenate 'string result passstr))
(list "pass-counter" result)))
M src/player.lisp => src/player.lisp +22 -9
@@ 18,7 18,9 @@
(defmethod visual ((self player))
(if (active self)
- (list (format nil "player-active-~2,'0d" (crate-frame self)))
+ (if (moving-airborne self)
+ (list "player-airborne")
+ (list (format nil "player-active-~2,'0d" (crate-frame self))))
(list "player-hidden")))
(defmethod update ((self player))
@@ 38,12 40,14 @@
(call-next-method))
(defmethod handle-input ((self player) input)
- (when (active self)
+ (when (and input (active self))
(ecase input
- (:east (setf (velocity self) input))
- (:west (setf (velocity self) input))
- (:north (setf (velocity self) input))
- (:south (setf (velocity self) input)))))
+ (:east (setf (velocity self) input))
+ (:west (setf (velocity self) input))
+ (:north (setf (velocity self) input))
+ (:south (setf (velocity self) input))
+ (:action1 (jump self)))
+ (setf (player-pending-input self) nil)))
(defmethod collide ((self player) (target pushed))
(let ((vplayer (velocity self))
@@ 55,12 59,21 @@
;; Functions
+(defmethod get-input ((self player))
+ (let ((input (car *input*)))
+ (unless input
+ (setf input (player-pending-input self)))
+ input))
+
(defun player-update-idle (self)
- (let ((input (car *input*))
+ (let ((input (get-input self))
(frame (1+ (crate-frame self))))
(setf (crate-frame self) (mod frame 7))
- (when (and input (stationaryp self))
- (handle-input self input))))
+ (if (stationaryp self)
+ (handle-input self input)
+ (if (eq input :action1)
+ (handle-input self input)
+ (setf (player-pending-input self) input)))))
(defun player-update-lamented (self)
(incf (player-delay self))
M src/sdl2-2d.lisp => src/sdl2-2d.lisp +17 -19
@@ 70,6 70,22 @@
(setf (gethash "key-idle-07" *visual-hash*) (make-rect 71))
(setf (gethash "key-idle-08" *visual-hash*) (make-rect 72))
(setf (gethash "key-active" *visual-hash*) (make-rect 73))
+ ;; SPECIAL
+ (setf (gethash "special-jump-idle-00" *visual-hash*) (make-rect 960))
+ (setf (gethash "special-jump-idle-01" *visual-hash*) (make-rect 961))
+ (setf (gethash "special-jump-idle-02" *visual-hash*) (make-rect 962))
+ (setf (gethash "special-jump-idle-03" *visual-hash*) (make-rect 963))
+ (setf (gethash "special-jump-idle-04" *visual-hash*) (make-rect 964))
+ (setf (gethash "special-jump-idle-05" *visual-hash*) (make-rect 965))
+ (setf (gethash "special-jump-idle-06" *visual-hash*) (make-rect 966))
+ (setf (gethash "special-jump-idle-07" *visual-hash*) (make-rect 967))
+ (setf (gethash "special-jump-idle-08" *visual-hash*) (make-rect 968))
+ (setf (gethash "special-jump-idle-09" *visual-hash*) (make-rect 969))
+ (setf (gethash "special-jump-idle-10" *visual-hash*) (make-rect 970))
+ (setf (gethash "special-jump-idle-11" *visual-hash*) (make-rect 971))
+ (setf (gethash "special-jump-idle-12" *visual-hash*) (make-rect 972))
+ (setf (gethash "special-jump-idle-13" *visual-hash*) (make-rect 972))
+ (setf (gethash "special-jump-active" *visual-hash*) (make-rect 973))
;; PLAYER
(setf (gethash "player-active-00" *visual-hash*) (make-rect 32))
(setf (gethash "player-active-01" *visual-hash*) (make-rect 33))
@@ 78,6 94,7 @@
(setf (gethash "player-active-04" *visual-hash*) (make-rect 36))
(setf (gethash "player-active-05" *visual-hash*) (make-rect 37))
(setf (gethash "player-active-06" *visual-hash*) (make-rect 38))
+ (setf (gethash "player-airborne" *visual-hash*) (list (floor (* 0.9619140625 iw)) 0 (floor (* 1.2 cw)) (floor (* 1.2 ch))))
(setf (gethash "player-hidden" *visual-hash*) (make-rect 15))
;; SLOPES
(setf (gethash "slope-en" *visual-hash*) (make-rect 384))
@@ 314,22 331,3 @@
(sdl-destroyrenderer *crates2-renderer*)
(sdl-destroywindow *crates2-window*)
(sdl-quit)))
-
-(defun ui-read-input ()
- (sb-int:with-float-traps-masked (:invalid :inexact :overflow)
- (let ((result nil))
- (with-foreign-objects ((event '(:union sdl-event)))
- (loop while (/= (sdl-pollevent event) 0)
- do
- (cffi:with-foreign-slots ((type) event (:union sdl-event))
- (cond ((eq type :SDL-KEYDOWN) (cffi:with-foreign-slots ((keysym) event sdl-keyboardevent)
- (let ((scancode (getf keysym 'scancode)))
- (cond ((eq scancode :SDL-SCANCODE-LEFT) (setf result :west))
- ((eq scancode :SDL-SCANCODE-RIGHT) (setf result :east))
- ((eq scancode :SDL-SCANCODE-UP) (setf result :north))
- ((eq scancode :SDL-SCANCODE-DOWN) (setf result :south))
- ((eq scancode :SDL-SCANCODE-R) (setf result :restart))
- ((eq scancode :SDL-SCANCODE-B) (setf result :back))
- ((eq scancode :SDL-SCANCODE-ESCAPE) (setf result :back))))))
- ((eq type :SDL-QUIT) (setf result :back))))))
- result)))>
\ No newline at end of file
A src/sdl2-3d.lisp => src/sdl2-3d.lisp +738 -0
@@ 0,0 1,738 @@
+;; Octaspire Crates 2 - Puzzle Game
+;; Copyright 2020, 2021 octaspire.com
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+(in-package :crates2-ui)
+
+;; Crate is drawn as CW x CH pixel shape
+(defconstant cw 64)
+(defconstant ch 64)
+(defconstant iw 2048)
+(defconstant ih 2048)
+;; Window dimensions
+(defconstant screen-width 800)
+(defconstant screen-height 600)
+
+(defparameter *crates2-window* :pointer)
+(defparameter *crates2-gl-context* :pointer)
+;; (defparameter *crates2-renderer* :pointer)
+(defparameter *image* :pointer)
+(defparameter *txids* :pointer)
+;; (defparameter *texture* :pointer)
+(defparameter *visual-hash* (make-hash-table :test 'equal))
+
+(defun make-rect-for-top (tx1 ty1 tx2 ty2 &optional (delta 0.0))
+ (let* ((hw 0.5)
+ (-hw (- hw))
+ (z (+ hw delta)))
+ (list 0.0 0.0 1.0 ; normal
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1 ; texture coordinates
+ -hw -hw z hw -hw z hw hw z -hw hw z)))
+
+(defun make-rect-for-north (tx1 ty1 tx2 ty2)
+ (let* ((hw 0.5)
+ (-hw (- hw)))
+ (list 0.0 1.0 0.0
+ tx1 ty2 tx1 ty1 tx2 ty1 tx2 ty2
+ -hw hw -hw -hw hw hw hw hw hw hw hw -hw)))
+
+(defun make-rect-for-south (tx1 ty1 tx2 ty2)
+ (let* ((hw 0.5)
+ (-hw (- hw)))
+ (list 0.0 -1.0 0.0
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1
+ -hw -hw -hw hw -hw -hw hw -hw hw -hw -hw hw)))
+
+(defun make-rect-for-west (tx1 ty1 tx2 ty2)
+ (let* ((hw 0.5)
+ (-hw (- hw)))
+ (list -1.0 0.0 0.0
+ tx1 ty2 tx1 ty1 tx2 ty1 tx2 ty2
+ -hw -hw -hw -hw -hw hw -hw hw hw -hw hw -hw)))
+
+(defun make-rect-for-bottom (tx1 ty1 tx2 ty2 &optional (delta 0.0))
+ (let* ((hw 0.5)
+ (-hw (- hw))
+ (z (+ -hw delta)))
+ (list 0.0 0.0 1.0
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1
+ -hw -hw z hw -hw z hw hw z -hw hw z)))
+
+(defun make-rect-for-east (tx1 ty1 tx2 ty2)
+ (let* ((hw 0.5)
+ (-hw (- hw)))
+ (list 1.0 0.0 0.0
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1
+ hw -hw -hw hw hw -hw hw hw hw hw -hw hw)))
+
+(defun make-rect (index face)
+ (let* ((sprites-per-row (floor iw cw))
+ (tx1 (float (/ (* cw (mod index sprites-per-row)) iw)))
+ (ty1 (float (/ (* ch (floor index sprites-per-row)) iw)))
+ (tw (float (/ cw iw)))
+ (th (float (/ ch ih)))
+ (tx2 (+ tx1 tw))
+ (ty2 (+ ty1 th)))
+ (ecase face
+ (:top (make-rect-for-top tx1 ty1 tx2 ty2))
+ (:bottom (make-rect-for-bottom tx1 ty1 tx2 ty2))
+ (:front (make-rect-for-south tx1 ty1 tx2 ty2))
+ (:back (make-rect-for-north tx1 ty1 tx2 ty2))
+ (:east (make-rect-for-east tx1 ty1 tx2 ty2))
+ (:west (make-rect-for-west tx1 ty1 tx2 ty2)))))
+
+(defun make-transparent-top (index &optional (z 0.08))
+ (let* ((sprites-per-row (floor iw cw))
+ (tx1 (float (/ (* cw (mod index sprites-per-row)) iw)))
+ (ty1 (float (/ (* ch (floor index sprites-per-row)) iw)))
+ (tw (float (/ cw iw)))
+ (th (float (/ ch ih)))
+ (tx2 (+ tx1 tw))
+ (ty2 (+ ty1 th)))
+ (list
+ (make-rect-for-top tx1 ty1 tx2 ty2 z)
+ nil
+ nil
+ nil
+ nil
+ nil)))
+
+(defun make-transparent-bottom (index &optional (z 0.08))
+ (let* ((sprites-per-row (floor iw cw))
+ (tx1 (float (/ (* cw (mod index sprites-per-row)) iw)))
+ (ty1 (float (/ (* ch (floor index sprites-per-row)) iw)))
+ (tw (float (/ cw iw)))
+ (th (float (/ ch ih)))
+ (tx2 (+ tx1 tw))
+ (ty2 (+ ty1 th)))
+ (list
+ nil
+ (make-rect-for-bottom tx1 ty1 tx2 ty2 z)
+ nil
+ nil
+ nil
+ nil)))
+
+(defun make-cube (top bottom front back east west)
+ (list
+ (if top (make-rect top :top) nil)
+ (if bottom (make-rect bottom :bottom) nil)
+ (if front (make-rect front :front) nil)
+ (if back (make-rect back :back) nil)
+ (if east (make-rect east :east) nil)
+ (if west (make-rect west :west) nil)))
+
+(defun init-visual-hash ()
+ ;; VACUUM
+ (setf (gethash "vacuum-body" *visual-hash*) (make-cube nil 482 nil nil nil nil))
+ (setf (gethash "gear-00" *visual-hash*) (make-transparent-bottom 483))
+ (setf (gethash "gear-01" *visual-hash*) (make-transparent-bottom 484))
+ (setf (gethash "gear-02" *visual-hash*) (make-transparent-bottom 485))
+ (setf (gethash "gear-03" *visual-hash*) (make-transparent-bottom 486))
+ (setf (gethash "gear-04" *visual-hash*) (make-transparent-bottom 487))
+ (setf (gethash "gear-05" *visual-hash*) (make-transparent-bottom 488))
+ (setf (gethash "gear-06" *visual-hash*) (make-transparent-bottom 489))
+ (setf (gethash "gear-07" *visual-hash*) (make-transparent-bottom 490))
+ ;; WALL
+ (setf (gethash "wall-idle-00" *visual-hash*) (make-cube 0 0 0 0 0 0))
+ (setf (gethash "wall-idle-01" *visual-hash*) (make-cube 1 1 1 1 1 1))
+ (setf (gethash "wall-idle-02" *visual-hash*) (make-cube 2 2 2 2 2 2))
+ (setf (gethash "wall-idle-03" *visual-hash*) (make-cube 3 3 3 3 3 3))
+ ;; PUSHED
+ (setf (gethash "pushed-idle" *visual-hash*) (make-cube 0 0 0 0 0 0))
+ ;; BLOCK-TIMER
+ (setf (gethash "block-timer-durable" *visual-hash*) (make-cube 0 0 0 0 0 0))
+ (setf (gethash "block-timer" *visual-hash*) (make-cube 5 5 5 5 5 5))
+ ;; EXIT
+ (setf (gethash "exit-idle" *visual-hash*) (make-cube 96 96 96 96 96 96)) ; 48 + 48 to old
+ (setf (gethash "exit-active-pass" *visual-hash*) (make-cube 97 97 97 97 97 97))
+ (setf (gethash "exit-active-fail" *visual-hash*) (make-cube 98 98 98 98 98 98))
+ ;; KEY
+ (setf (gethash "key-idle-00" *visual-hash*) (make-cube 64 64 64 64 64 64))
+ (setf (gethash "key-idle-01" *visual-hash*) (make-cube 65 65 65 65 65 65))
+ (setf (gethash "key-idle-02" *visual-hash*) (make-cube 66 66 66 66 66 66))
+ (setf (gethash "key-idle-03" *visual-hash*) (make-cube 67 67 67 67 67 67))
+ (setf (gethash "key-idle-04" *visual-hash*) (make-cube 68 68 68 68 68 68))
+ (setf (gethash "key-idle-05" *visual-hash*) (make-cube 69 69 69 69 69 69))
+ (setf (gethash "key-idle-06" *visual-hash*) (make-cube 70 70 70 70 70 70))
+ (setf (gethash "key-idle-07" *visual-hash*) (make-cube 71 71 71 71 71 71))
+ (setf (gethash "key-idle-08" *visual-hash*) (make-cube 72 72 72 72 72 72))
+ (setf (gethash "key-active" *visual-hash*) (make-cube 73 73 73 73 73 73))
+ ;; SPECIAL
+ (setf (gethash "special-jump-idle-00" *visual-hash*) (make-cube nil 960 nil nil nil nil))
+ (setf (gethash "special-jump-idle-01" *visual-hash*) (make-cube nil 961 nil nil nil nil))
+ (setf (gethash "special-jump-idle-02" *visual-hash*) (make-cube nil 962 nil nil nil nil))
+ (setf (gethash "special-jump-idle-03" *visual-hash*) (make-cube nil 963 nil nil nil nil))
+ (setf (gethash "special-jump-idle-04" *visual-hash*) (make-cube nil 964 nil nil nil nil))
+ (setf (gethash "special-jump-idle-05" *visual-hash*) (make-cube nil 965 nil nil nil nil))
+ (setf (gethash "special-jump-idle-06" *visual-hash*) (make-cube nil 966 nil nil nil nil))
+ (setf (gethash "special-jump-idle-07" *visual-hash*) (make-cube nil 967 nil nil nil nil))
+ (setf (gethash "special-jump-idle-08" *visual-hash*) (make-cube nil 968 nil nil nil nil))
+ (setf (gethash "special-jump-idle-09" *visual-hash*) (make-cube nil 969 nil nil nil nil))
+ (setf (gethash "special-jump-idle-10" *visual-hash*) (make-cube nil 970 nil nil nil nil))
+ (setf (gethash "special-jump-idle-11" *visual-hash*) (make-cube nil 971 nil nil nil nil))
+ (setf (gethash "special-jump-idle-12" *visual-hash*) (make-cube nil 972 nil nil nil nil))
+ (setf (gethash "special-jump-idle-13" *visual-hash*) (make-cube nil 972 nil nil nil nil))
+ (setf (gethash "special-jump-active" *visual-hash*) (make-cube nil 973 nil nil nil nil))
+ ;; PLAYER
+ (setf (gethash "player-active-00" *visual-hash*) (make-cube 32 32 32 32 32 32))
+ (setf (gethash "player-active-01" *visual-hash*) (make-cube 33 33 33 33 33 33))
+ (setf (gethash "player-active-02" *visual-hash*) (make-cube 34 34 34 34 34 34))
+ (setf (gethash "player-active-03" *visual-hash*) (make-cube 35 35 35 35 35 35))
+ (setf (gethash "player-active-04" *visual-hash*) (make-cube 36 36 36 36 36 36))
+ (setf (gethash "player-active-05" *visual-hash*) (make-cube 37 37 37 37 37 37))
+ (setf (gethash "player-active-06" *visual-hash*) (make-cube 38 38 38 38 38 38))
+
+ (setf (gethash "player-airborne" *visual-hash*) (let* ((w 1.0)
+ (hw (/ 1.0 2))
+ (-hw (- hw))
+ (tx1 0.0)
+ (tx2 (+ tx1 (/ cw iw)))
+ (ty1 (/ (* 1.0 ch) ih))
+ (ty2 (+ ty1 (/ ch ih))))
+ (list
+
+ ;; top
+ (list 0.0 0.0 1.0 ; normal
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1 ; texture coordinates
+ -hw -hw (+ hw 1.0) hw -hw (+ hw 1.0) hw hw (+ hw 1.0) -hw hw (+ hw 1.0))
+ ;; north
+ (list 0.0 1.0 0.0
+ tx1 ty2 tx1 ty1 tx2 ty1 tx2 ty2
+ -hw hw (+ -hw 1.0) -hw hw (+ hw 1.0) hw hw (+ hw 1.0) hw hw (+ -hw 1.0))
+ ;; south
+ (list 0.0 -1.0 0.0
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1
+ -hw -hw (+ -hw 1.0) hw -hw (+ -hw 1.0) hw -hw (+ hw 1.0) -hw -hw (+ hw 1.0))
+ ;; west
+ (list -1.0 0.0 0.0
+ tx1 ty2 tx1 ty1 tx2 ty1 tx2 ty2
+ -hw -hw (+ -hw 1.0) -hw -hw (+ hw 1.0) -hw hw (+ hw 1.0) -hw hw (+ -hw 1.0))
+ ;; bottom
+ nil
+ ;; east
+ (list 1.0 0.0 0.0
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1
+ hw -hw (+ -hw 1.0) hw hw (+ -hw 1.0) hw hw (+ hw 1.0) hw -hw (+ hw 1.0)))))
+
+ (setf (gethash "player-hidden" *visual-hash*) (make-cube 15 15 15 15 15 15))
+ ;; SLOPES
+ (setf (gethash "slope-en" *visual-hash*) (make-cube 384 nil 0 nil nil 0))
+ (setf (gethash "slope-en-active" *visual-hash*) (make-cube 385 nil 0 nil nil 0))
+ (setf (gethash "slope-es" *visual-hash*) (make-cube 416 nil nil 0 nil 0)) ; + 32 to EN
+ (setf (gethash "slope-es-active" *visual-hash*) (make-cube 417 nil nil 0 nil 0))
+ (setf (gethash "slope-wn" *visual-hash*) (make-cube 448 nil 0 nil 0 nil)) ; + 32 to ES
+ (setf (gethash "slope-wn-active" *visual-hash*) (make-cube 449 nil 0 nil 0 nil))
+ (setf (gethash "slope-ws" *visual-hash*) (make-cube 480 nil nil 0 0 nil)) ; + 32 to WN
+ (setf (gethash "slope-ws-active" *visual-hash*) (make-cube 481 nil nil 0 0 nil))
+ ;; TURNSTILE
+ (setf (gethash "turnstile-e" *visual-hash*) (make-cube 128 0 0 0 0 0))
+ (setf (gethash "turnstile-e-active" *visual-hash*) (make-cube 129 0 0 0 0 0))
+ (setf (gethash "turnstile-e1" *visual-hash*) (make-cube 160 0 0 0 0 0)) ; + 32 to E
+ (setf (gethash "turnstile-e1-active" *visual-hash*) (make-cube 161 0 0 0 0 0))
+ (setf (gethash "turnstile-n" *visual-hash*) (make-cube 192 0 0 0 0 0)) ; + 32 to E1
+ (setf (gethash "turnstile-n-active" *visual-hash*) (make-cube 193 0 0 0 0 0))
+ (setf (gethash "turnstile-n1" *visual-hash*) (make-cube 224 0 0 0 0 0)) ; + 32 to W1
+ (setf (gethash "turnstile-n1-active" *visual-hash*) (make-cube 225 0 0 0 0 0))
+ (setf (gethash "turnstile-s" *visual-hash*) (make-cube 256 0 0 0 0 0)) ; + 32 to N
+ (setf (gethash "turnstile-s-active" *visual-hash*) (make-cube 257 0 0 0 0 0))
+ (setf (gethash "turnstile-s1" *visual-hash*) (make-cube 288 0 0 0 0 0)) ; + 32 to N1
+ (setf (gethash "turnstile-s1-active" *visual-hash*) (make-cube 289 0 0 0 0 0))
+ (setf (gethash "turnstile-w" *visual-hash*) (make-cube 320 0 0 0 0 0)) ; + 32 to S1
+ (setf (gethash "turnstile-w-active" *visual-hash*) (make-cube 321 0 0 0 0 0))
+ (setf (gethash "turnstile-w1" *visual-hash*) (make-cube 352 0 0 0 0 0)) ; + 32 to W
+ (setf (gethash "turnstile-w1-active" *visual-hash*) (make-cube 353 0 0 0 0 0))
+ ;; NUMBERS
+ (setf (gethash "number-01" *visual-hash*) (make-transparent-top 99))
+ (setf (gethash "number-02" *visual-hash*) (make-transparent-top 100))
+ (setf (gethash "number-03" *visual-hash*) (make-transparent-top 101))
+ (setf (gethash "number-04" *visual-hash*) (make-transparent-top 102))
+ (setf (gethash "number-05" *visual-hash*) (make-transparent-top 103))
+ (setf (gethash "number-06" *visual-hash*) (make-transparent-top 104))
+ (setf (gethash "number-07" *visual-hash*) (make-transparent-top 105))
+ (setf (gethash "number-08" *visual-hash*) (make-transparent-top 106))
+ (setf (gethash "number-09" *visual-hash*) (make-transparent-top 107))
+ (setf (gethash "number-10" *visual-hash*) (make-transparent-top 108))
+ (setf (gethash "number-11" *visual-hash*) (make-transparent-top 131)) ; Add 32 to start of previous line.
+ (setf (gethash "number-12" *visual-hash*) (make-transparent-top 132))
+ (setf (gethash "number-13" *visual-hash*) (make-transparent-top 133))
+ (setf (gethash "number-14" *visual-hash*) (make-transparent-top 134))
+ (setf (gethash "number-15" *visual-hash*) (make-transparent-top 135))
+ (setf (gethash "number-16" *visual-hash*) (make-transparent-top 136))
+ (setf (gethash "number-17" *visual-hash*) (make-transparent-top 137))
+ (setf (gethash "number-18" *visual-hash*) (make-transparent-top 138))
+ (setf (gethash "number-19" *visual-hash*) (make-transparent-top 139))
+ (setf (gethash "number-20" *visual-hash*) (make-transparent-top 140))
+ (setf (gethash "number-21" *visual-hash*) (make-transparent-top 163)) ; Add 32 to start of previous line.
+ (setf (gethash "number-22" *visual-hash*) (make-transparent-top 164))
+ (setf (gethash "number-23" *visual-hash*) (make-transparent-top 165))
+ (setf (gethash "number-24" *visual-hash*) (make-transparent-top 166))
+ (setf (gethash "number-25" *visual-hash*) (make-transparent-top 167))
+ (setf (gethash "number-26" *visual-hash*) (make-transparent-top 168))
+ (setf (gethash "number-27" *visual-hash*) (make-transparent-top 169))
+ (setf (gethash "number-28" *visual-hash*) (make-transparent-top 170))
+ (setf (gethash "number-29" *visual-hash*) (make-transparent-top 171))
+ (setf (gethash "number-30" *visual-hash*) (make-transparent-top 172))
+ (setf (gethash "number-31" *visual-hash*) (make-transparent-top 195)) ; Add 32 to start of previous line.
+ (setf (gethash "number-32" *visual-hash*) (make-transparent-top 196))
+ (setf (gethash "number-33" *visual-hash*) (make-transparent-top 197))
+ (setf (gethash "number-34" *visual-hash*) (make-transparent-top 198))
+ (setf (gethash "number-35" *visual-hash*) (make-transparent-top 199))
+ (setf (gethash "number-36" *visual-hash*) (make-transparent-top 200))
+ (setf (gethash "number-37" *visual-hash*) (make-transparent-top 201))
+ (setf (gethash "number-38" *visual-hash*) (make-transparent-top 202))
+ (setf (gethash "number-39" *visual-hash*) (make-transparent-top 203))
+ (setf (gethash "number-40" *visual-hash*) (make-transparent-top 204))
+ (setf (gethash "number-41" *visual-hash*) (make-transparent-top 227)) ; Add 32 to start of previous line.
+ (setf (gethash "number-42" *visual-hash*) (make-transparent-top 228))
+ (setf (gethash "number-43" *visual-hash*) (make-transparent-top 229))
+ (setf (gethash "number-44" *visual-hash*) (make-transparent-top 230))
+ (setf (gethash "number-45" *visual-hash*) (make-transparent-top 231))
+ (setf (gethash "number-46" *visual-hash*) (make-transparent-top 232))
+ (setf (gethash "number-47" *visual-hash*) (make-transparent-top 233))
+ (setf (gethash "number-48" *visual-hash*) (make-transparent-top 234))
+ (setf (gethash "number-49" *visual-hash*) (make-transparent-top 235))
+ (setf (gethash "number-50" *visual-hash*) (make-transparent-top 236))
+ (setf (gethash "number-51" *visual-hash*) (make-transparent-top 259)) ; Add 32 to start of previous line.
+ (setf (gethash "number-52" *visual-hash*) (make-transparent-top 260))
+ (setf (gethash "number-53" *visual-hash*) (make-transparent-top 261))
+ (setf (gethash "number-54" *visual-hash*) (make-transparent-top 262))
+ (setf (gethash "number-55" *visual-hash*) (make-transparent-top 263))
+ (setf (gethash "number-56" *visual-hash*) (make-transparent-top 264))
+ (setf (gethash "number-57" *visual-hash*) (make-transparent-top 265))
+ (setf (gethash "number-58" *visual-hash*) (make-transparent-top 266))
+ (setf (gethash "number-59" *visual-hash*) (make-transparent-top 267))
+ (setf (gethash "number-60" *visual-hash*) (make-transparent-top 268))
+ (setf (gethash "number-61" *visual-hash*) (make-transparent-top 291)) ; Add 32 to start of previous line.
+ (setf (gethash "number-62" *visual-hash*) (make-transparent-top 292))
+ (setf (gethash "number-63" *visual-hash*) (make-transparent-top 293))
+ (setf (gethash "number-64" *visual-hash*) (make-transparent-top 294))
+ (setf (gethash "number-65" *visual-hash*) (make-transparent-top 295))
+ (setf (gethash "number-66" *visual-hash*) (make-transparent-top 296))
+ (setf (gethash "number-67" *visual-hash*) (make-transparent-top 297))
+ (setf (gethash "number-68" *visual-hash*) (make-transparent-top 298))
+ (setf (gethash "number-69" *visual-hash*) (make-transparent-top 299))
+ (setf (gethash "number-70" *visual-hash*) (make-transparent-top 300))
+ (setf (gethash "number-71" *visual-hash*) (make-transparent-top 323)) ; Add 32 to start of previous line.
+ (setf (gethash "number-72" *visual-hash*) (make-transparent-top 324))
+ (setf (gethash "number-73" *visual-hash*) (make-transparent-top 325))
+ (setf (gethash "number-74" *visual-hash*) (make-transparent-top 326))
+ (setf (gethash "number-75" *visual-hash*) (make-transparent-top 327))
+ (setf (gethash "number-76" *visual-hash*) (make-transparent-top 328))
+ (setf (gethash "number-77" *visual-hash*) (make-transparent-top 329))
+ (setf (gethash "number-78" *visual-hash*) (make-transparent-top 330))
+ (setf (gethash "number-79" *visual-hash*) (make-transparent-top 331))
+ (setf (gethash "number-80" *visual-hash*) (make-transparent-top 332))
+ (setf (gethash "number-81" *visual-hash*) (make-transparent-top 355)) ; Add 32 to start of previous line.
+ (setf (gethash "number-82" *visual-hash*) (make-transparent-top 356))
+ (setf (gethash "number-83" *visual-hash*) (make-transparent-top 357))
+ (setf (gethash "number-84" *visual-hash*) (make-transparent-top 358))
+ (setf (gethash "number-85" *visual-hash*) (make-transparent-top 359))
+ (setf (gethash "number-86" *visual-hash*) (make-transparent-top 360))
+ (setf (gethash "number-87" *visual-hash*) (make-transparent-top 361))
+ (setf (gethash "number-88" *visual-hash*) (make-transparent-top 362))
+ (setf (gethash "number-89" *visual-hash*) (make-transparent-top 363))
+ (setf (gethash "number-90" *visual-hash*) (make-transparent-top 364))
+ (setf (gethash "number-91" *visual-hash*) (make-transparent-top 387)) ; Add 32 to start of previous line.
+ (setf (gethash "number-92" *visual-hash*) (make-transparent-top 388))
+ (setf (gethash "number-93" *visual-hash*) (make-transparent-top 389))
+ (setf (gethash "number-94" *visual-hash*) (make-transparent-top 390))
+ (setf (gethash "number-95" *visual-hash*) (make-transparent-top 391))
+ (setf (gethash "number-96" *visual-hash*) (make-transparent-top 392))
+ (setf (gethash "number-97" *visual-hash*) (make-transparent-top 393))
+ (setf (gethash "number-98" *visual-hash*) (make-transparent-top 394))
+ (setf (gethash "number-99" *visual-hash*) (make-transparent-top 395))
+ (setf (gethash "number-100" *visual-hash*) (make-transparent-top 396))
+ ;; BOTTOM NUMBERS
+ (setf (gethash "number-bottom-01" *visual-hash*) (make-transparent-bottom 99))
+ (setf (gethash "number-bottom-02" *visual-hash*) (make-transparent-bottom 100))
+ (setf (gethash "number-bottom-03" *visual-hash*) (make-transparent-bottom 101))
+ (setf (gethash "number-bottom-04" *visual-hash*) (make-transparent-bottom 102))
+ (setf (gethash "number-bottom-05" *visual-hash*) (make-transparent-bottom 103))
+ (setf (gethash "number-bottom-06" *visual-hash*) (make-transparent-bottom 104))
+ (setf (gethash "number-bottom-07" *visual-hash*) (make-transparent-bottom 105))
+ (setf (gethash "number-bottom-08" *visual-hash*) (make-transparent-bottom 106))
+ (setf (gethash "number-bottom-09" *visual-hash*) (make-transparent-bottom 107))
+ (setf (gethash "number-bottom-10" *visual-hash*) (make-transparent-bottom 108))
+ (setf (gethash "number-bottom-11" *visual-hash*) (make-transparent-bottom 131)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-12" *visual-hash*) (make-transparent-bottom 132))
+ (setf (gethash "number-bottom-13" *visual-hash*) (make-transparent-bottom 133))
+ (setf (gethash "number-bottom-14" *visual-hash*) (make-transparent-bottom 134))
+ (setf (gethash "number-bottom-15" *visual-hash*) (make-transparent-bottom 135))
+ (setf (gethash "number-bottom-16" *visual-hash*) (make-transparent-bottom 136))
+ (setf (gethash "number-bottom-17" *visual-hash*) (make-transparent-bottom 137))
+ (setf (gethash "number-bottom-18" *visual-hash*) (make-transparent-bottom 138))
+ (setf (gethash "number-bottom-19" *visual-hash*) (make-transparent-bottom 139))
+ (setf (gethash "number-bottom-20" *visual-hash*) (make-transparent-bottom 140))
+ (setf (gethash "number-bottom-21" *visual-hash*) (make-transparent-bottom 163)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-22" *visual-hash*) (make-transparent-bottom 164))
+ (setf (gethash "number-bottom-23" *visual-hash*) (make-transparent-bottom 165))
+ (setf (gethash "number-bottom-24" *visual-hash*) (make-transparent-bottom 166))
+ (setf (gethash "number-bottom-25" *visual-hash*) (make-transparent-bottom 167))
+ (setf (gethash "number-bottom-26" *visual-hash*) (make-transparent-bottom 168))
+ (setf (gethash "number-bottom-27" *visual-hash*) (make-transparent-bottom 169))
+ (setf (gethash "number-bottom-28" *visual-hash*) (make-transparent-bottom 170))
+ (setf (gethash "number-bottom-29" *visual-hash*) (make-transparent-bottom 171))
+ (setf (gethash "number-bottom-30" *visual-hash*) (make-transparent-bottom 172))
+ (setf (gethash "number-bottom-31" *visual-hash*) (make-transparent-bottom 195)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-32" *visual-hash*) (make-transparent-bottom 196))
+ (setf (gethash "number-bottom-33" *visual-hash*) (make-transparent-bottom 197))
+ (setf (gethash "number-bottom-34" *visual-hash*) (make-transparent-bottom 198))
+ (setf (gethash "number-bottom-35" *visual-hash*) (make-transparent-bottom 199))
+ (setf (gethash "number-bottom-36" *visual-hash*) (make-transparent-bottom 200))
+ (setf (gethash "number-bottom-37" *visual-hash*) (make-transparent-bottom 201))
+ (setf (gethash "number-bottom-38" *visual-hash*) (make-transparent-bottom 202))
+ (setf (gethash "number-bottom-39" *visual-hash*) (make-transparent-bottom 203))
+ (setf (gethash "number-bottom-40" *visual-hash*) (make-transparent-bottom 204))
+ (setf (gethash "number-bottom-41" *visual-hash*) (make-transparent-bottom 227)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-42" *visual-hash*) (make-transparent-bottom 228))
+ (setf (gethash "number-bottom-43" *visual-hash*) (make-transparent-bottom 229))
+ (setf (gethash "number-bottom-44" *visual-hash*) (make-transparent-bottom 230))
+ (setf (gethash "number-bottom-45" *visual-hash*) (make-transparent-bottom 231))
+ (setf (gethash "number-bottom-46" *visual-hash*) (make-transparent-bottom 232))
+ (setf (gethash "number-bottom-47" *visual-hash*) (make-transparent-bottom 233))
+ (setf (gethash "number-bottom-48" *visual-hash*) (make-transparent-bottom 234))
+ (setf (gethash "number-bottom-49" *visual-hash*) (make-transparent-bottom 235))
+ (setf (gethash "number-bottom-50" *visual-hash*) (make-transparent-bottom 236))
+ (setf (gethash "number-bottom-51" *visual-hash*) (make-transparent-bottom 259)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-52" *visual-hash*) (make-transparent-bottom 260))
+ (setf (gethash "number-bottom-53" *visual-hash*) (make-transparent-bottom 261))
+ (setf (gethash "number-bottom-54" *visual-hash*) (make-transparent-bottom 262))
+ (setf (gethash "number-bottom-55" *visual-hash*) (make-transparent-bottom 263))
+ (setf (gethash "number-bottom-56" *visual-hash*) (make-transparent-bottom 264))
+ (setf (gethash "number-bottom-57" *visual-hash*) (make-transparent-bottom 265))
+ (setf (gethash "number-bottom-58" *visual-hash*) (make-transparent-bottom 266))
+ (setf (gethash "number-bottom-59" *visual-hash*) (make-transparent-bottom 267))
+ (setf (gethash "number-bottom-60" *visual-hash*) (make-transparent-bottom 268))
+ (setf (gethash "number-bottom-61" *visual-hash*) (make-transparent-bottom 291)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-62" *visual-hash*) (make-transparent-bottom 292))
+ (setf (gethash "number-bottom-63" *visual-hash*) (make-transparent-bottom 293))
+ (setf (gethash "number-bottom-64" *visual-hash*) (make-transparent-bottom 294))
+ (setf (gethash "number-bottom-65" *visual-hash*) (make-transparent-bottom 295))
+ (setf (gethash "number-bottom-66" *visual-hash*) (make-transparent-bottom 296))
+ (setf (gethash "number-bottom-67" *visual-hash*) (make-transparent-bottom 297))
+ (setf (gethash "number-bottom-68" *visual-hash*) (make-transparent-bottom 298))
+ (setf (gethash "number-bottom-69" *visual-hash*) (make-transparent-bottom 299))
+ (setf (gethash "number-bottom-70" *visual-hash*) (make-transparent-bottom 300))
+ (setf (gethash "number-bottom-71" *visual-hash*) (make-transparent-bottom 323)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-72" *visual-hash*) (make-transparent-bottom 324))
+ (setf (gethash "number-bottom-73" *visual-hash*) (make-transparent-bottom 325))
+ (setf (gethash "number-bottom-74" *visual-hash*) (make-transparent-bottom 326))
+ (setf (gethash "number-bottom-75" *visual-hash*) (make-transparent-bottom 327))
+ (setf (gethash "number-bottom-76" *visual-hash*) (make-transparent-bottom 328))
+ (setf (gethash "number-bottom-77" *visual-hash*) (make-transparent-bottom 329))
+ (setf (gethash "number-bottom-78" *visual-hash*) (make-transparent-bottom 330))
+ (setf (gethash "number-bottom-79" *visual-hash*) (make-transparent-bottom 331))
+ (setf (gethash "number-bottom-80" *visual-hash*) (make-transparent-bottom 332))
+ (setf (gethash "number-bottom-81" *visual-hash*) (make-transparent-bottom 355)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-82" *visual-hash*) (make-transparent-bottom 356))
+ (setf (gethash "number-bottom-83" *visual-hash*) (make-transparent-bottom 357))
+ (setf (gethash "number-bottom-84" *visual-hash*) (make-transparent-bottom 358))
+ (setf (gethash "number-bottom-85" *visual-hash*) (make-transparent-bottom 359))
+ (setf (gethash "number-bottom-86" *visual-hash*) (make-transparent-bottom 360))
+ (setf (gethash "number-bottom-87" *visual-hash*) (make-transparent-bottom 361))
+ (setf (gethash "number-bottom-88" *visual-hash*) (make-transparent-bottom 362))
+ (setf (gethash "number-bottom-89" *visual-hash*) (make-transparent-bottom 363))
+ (setf (gethash "number-bottom-90" *visual-hash*) (make-transparent-bottom 364))
+ (setf (gethash "number-bottom-91" *visual-hash*) (make-transparent-bottom 387)) ; Add 32 to start of previous line.
+ (setf (gethash "number-bottom-92" *visual-hash*) (make-transparent-bottom 388))
+ (setf (gethash "number-bottom-93" *visual-hash*) (make-transparent-bottom 389))
+ (setf (gethash "number-bottom-94" *visual-hash*) (make-transparent-bottom 390))
+ (setf (gethash "number-bottom-95" *visual-hash*) (make-transparent-bottom 391))
+ (setf (gethash "number-bottom-96" *visual-hash*) (make-transparent-bottom 392))
+ (setf (gethash "number-bottom-97" *visual-hash*) (make-transparent-bottom 393))
+ (setf (gethash "number-bottom-98" *visual-hash*) (make-transparent-bottom 394))
+ (setf (gethash "number-bottom-99" *visual-hash*) (make-transparent-bottom 395))
+ (setf (gethash "number-bottom-100" *visual-hash*) (make-transparent-bottom 396))
+ ;; BLOCK-COUNTER
+ (setf (gethash "block-counter" *visual-hash*) (make-cube 0 nil 0 0 0 0))
+ ;; PASS-COUNTER
+ (setf (gethash "pass-counter" *visual-hash*) (make-cube nil 4 nil nil nil nil))
+ ;; PASS-TIMER
+ (setf (gethash "pass-timer" *visual-hash*) (make-cube nil 4 nil nil nil nil))
+ ;; PULLED
+ (setf (gethash "pulled-idle" *visual-hash*) (make-cube 6 6 6 6 6 6))
+ ;; east
+ (setf (gethash "pulled-east-handle-active" *visual-hash*) (make-transparent-top 11))
+ (setf (gethash "pulled-east-handle-idle" *visual-hash*) (make-transparent-top 7))
+ (setf (gethash "pulled-east-no-handle" *visual-hash*) (make-cube nil nil nil nil nil nil))
+ ;; west
+ (setf (gethash "pulled-west-handle-active" *visual-hash*) (make-transparent-top 13 0.16))
+ (setf (gethash "pulled-west-handle-idle" *visual-hash*) (make-transparent-top 9 0.16))
+ (setf (gethash "pulled-west-no-handle" *visual-hash*) (make-cube nil nil nil nil nil nil))
+ ;; north
+ (setf (gethash "pulled-north-handle-active" *visual-hash*) (make-transparent-top 12 0.22))
+ (setf (gethash "pulled-north-handle-idle" *visual-hash*) (make-transparent-top 8 0.22))
+ (setf (gethash "pulled-north-no-handle" *visual-hash*) (make-cube nil nil nil nil nil nil))
+ ;; south
+ (setf (gethash "pulled-south-handle-active" *visual-hash*) (make-transparent-top 14 0.28))
+ (setf (gethash "pulled-south-handle-idle" *visual-hash*) (make-transparent-top 10 0.28))
+ (setf (gethash "pulled-south-no-handle" *visual-hash*) (make-cube nil nil nil nil nil nil))
+ ;; STEPPER
+ (setf (gethash "stepper-idle" *visual-hash*) (make-transparent-top 74))
+ (setf (gethash "stepper-active" *visual-hash*) (make-transparent-top 75))
+ ;; TOGGLE
+ (setf (gethash "toggle-idle" *visual-hash*) (make-cube 39 39 39 39 39 39))
+ ;; east
+ (setf (gethash "toggle-east-on" *visual-hash*) (make-transparent-top 40))
+ (setf (gethash "toggle-east-off" *visual-hash*) (make-transparent-top 50))
+ ;; west
+ (setf (gethash "toggle-west-on" *visual-hash*) (make-transparent-top 42 0.16))
+ (setf (gethash "toggle-west-off" *visual-hash*) (make-transparent-top 50 0.16))
+ ;; north
+ (setf (gethash "toggle-north-on" *visual-hash*) (make-transparent-top 41 0.22))
+ (setf (gethash "toggle-north-off" *visual-hash*) (make-transparent-top 50 0.22))
+ ;; south
+ (setf (gethash "toggle-south-on" *visual-hash*) (make-transparent-top 43 0.28))
+ (setf (gethash "toggle-south-off" *visual-hash*) (make-transparent-top 50 0.28))
+ ;; BOMB
+ (setf (gethash "bomb-durable" *visual-hash*) (make-cube 76 76 76 76 76 76))
+ (setf (gethash "bomb" *visual-hash*) (make-cube 77 77 77 77 77 77))
+ ;; ring 1
+ (setf (gethash "bomb-ring-1" *visual-hash*) (list
+ (let* ((hw 0.5)
+ (-hw (- hw))
+ (tx1 0.0)
+ (tx2 (+ tx1 (/ cw iw)))
+ (ty1 (/ (* 16.0 ch) ih))
+ (ty2 (+ ty1 (/ ch ih))))
+ (list 0.0 0.0 1.0 ; normal
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1 ; texture coordinates
+ -hw -hw 0.0 hw -hw 0.0 hw hw 0.0 -hw hw 0.0))
+ nil
+ nil
+ nil
+ nil
+ nil)) ; start at index 256 (y slot 16); size 1 slot
+ ;; ring 2
+ (setf (gethash "bomb-ring-2" *visual-hash*) (list
+ (let* ((hw 1.5)
+ (-hw (- hw))
+ (tx1 0.0)
+ (tx2 (+ tx1 (/ (* 3 cw) iw)))
+ (ty1 (/ (* 17.0 ch) ih))
+ (ty2 (+ ty1 (/ (* 3 ch) ih))))
+ (list 0.0 0.0 1.0 ; normal
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1 ; texture coordinates
+ -hw -hw 0.0 hw -hw 0.0 hw hw 0.0 -hw hw 0.0))
+ nil
+ nil
+ nil
+ nil
+ nil)) ; start at y slot 17; size 3x3 slots
+ ;; ring 3
+ (setf (gethash "bomb-ring-3" *visual-hash*) (list
+ (let* ((hw 2.5)
+ (-hw (- hw))
+ (tx1 0.0)
+ (tx2 (+ tx1 (/ (* 5 cw) iw)))
+ (ty1 (/ (* 20.0 ch) ih))
+ (ty2 (+ ty1 (/ (* 5 ch) ih))))
+ (list 0.0 0.0 1.0 ; normal
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1 ; texture coordinates
+ -hw -hw 0.0 hw -hw 0.0 hw hw 0.0 -hw hw 0.0))
+ nil
+ nil
+ nil
+ nil
+ nil)) ; size 5x5 slots
+ ;; ring 4
+ (setf (gethash "bomb-ring-4" *visual-hash*) (list
+ (let* ((hw 2.5)
+ (-hw (- hw))
+ (tx1 0.0)
+ (tx2 (+ tx1 (/ (* 5 cw) iw)))
+ (ty1 (/ (* 25.0 ch) ih))
+ (ty2 (+ ty1 (/ (* 5 ch) ih))))
+ (list 0.0 0.0 1.0 ; normal
+ tx1 ty2 tx2 ty2 tx2 ty1 tx1 ty1 ; texture coordinates
+ -hw -hw 0.0 hw -hw 0.0 hw hw 0.0 -hw hw 0.0))
+ nil
+ nil
+ nil
+ nil
+ nil))) ; size 5x5 slots
+
+(defparameter *fake-input* nil)
+
+(defun check-error (&optional msg)
+ (let ((err (glgeterror)))
+ (unless (= err +GL-NO-ERROR+)
+ (error "GL ERROR: ~A (~A)~%" (gluErrorString err) msg))))
+
+(defun ui-render-face (face)
+ ;; TODO this could be made more efficient by using foreign
+ ;; arrays and function(s) operating on them.
+ (let* ((nx (nth 0 face))
+ (ny (nth 1 face))
+ (nz (nth 2 face))
+
+ (t1 (nth 3 face))
+ (t2 (nth 4 face))
+ (t3 (nth 5 face))
+ (t4 (nth 6 face))
+ (t5 (nth 7 face))
+ (t6 (nth 8 face))
+ (t7 (nth 9 face))
+ (t8 (nth 10 face))
+
+ (v1 (nth 11 face))
+ (v2 (nth 12 face))
+ (v3 (nth 13 face))
+ (v4 (nth 14 face))
+ (v5 (nth 15 face))
+ (v6 (nth 16 face))
+ (v7 (nth 17 face))
+ (v8 (nth 18 face))
+ (v9 (nth 19 face))
+ (v10 (nth 20 face))
+ (v11 (nth 21 face))
+ (v12 (nth 22 face)))
+ (glnormal3f nx ny nz)
+ (gltexcoord2f t1 t2) (glvertex3f v1 v2 v3)
+ (gltexcoord2f t3 t4) (glvertex3f v4 v5 v6)
+ (gltexcoord2f t5 t6) (glvertex3f v7 v8 v9)
+ (gltexcoord2f t7 t8) (glvertex3f v10 v11 v12)))
+
+(defun ui-render-cube (faces)
+ ;; top bottom front back east west
+ (let ((top (first faces))
+ (bottom (second faces))
+ (south (third faces))
+ (north (fourth faces))
+ (east (fifth faces))
+ (west (sixth faces)))
+ (glbegin +GL-QUADS+)
+ ;; Top north south west east bottom
+ (when top
+ (ui-render-face top))
+
+ ;; North face
+ (when north
+ (ui-render-face north))
+
+ ;; South face
+ (when south
+ (ui-render-face south))
+
+ ;; West face
+ (when west
+ (ui-render-face west))
+
+ ;; East face
+ (when east
+ (ui-render-face east))
+
+ ;; Bottom face (inverted)
+ (when bottom
+ (ui-render-face bottom))
+
+ (glend)))
+
+(defun ui-render (level step)
+ (sb-int:with-float-traps-masked (:invalid :inexact :overflow)
+ (glclearcolor 0.0 0.0 0.0 1.0)
+ (glclear (logior +GL-COLOR-BUFFER-BIT+ +GL-DEPTH-BUFFER-BIT+))
+ (glenable +GL-TEXTURE-2D+)
+ (glbindtexture +GL-TEXTURE-2D+ (mem-aref *txids* :uint32 0))
+ (glenable +GL-TEXTURE-2D+)
+ (glenable +GL-DEPTH-TEST+)
+ (gldisable +GL-CULL-FACE+)
+ (gldisable +GL-ALPHA-TEST+)
+ (glcolor4f 1.0 1.0 1.0 1.0)
+ (cffi:with-foreign-objects ((rect1 '(:struct sdl-rect))
+ (rect2 '(:struct sdl-rect))
+ (rect1pointer :pointer)
+ (rect2pointer :pointer)
+ (nullpointer :pointer))
+ (setf nullpointer (null-pointer))
+ (setf rect1pointer (mem-aptr rect1 '(:struct sdl-rect) 0))
+ (setf rect2pointer (mem-aptr rect2 '(:struct sdl-rect) 0))
+ (loop for crate in level
+ do (progn
+ (let* ((x (if (and (= step 0) (typep crate 'crates2:moving)) (tail-x crate) (crate-x crate)))
+ (y (if (and (= step 0) (typep crate 'crates2:moving)) (tail-y crate) (crate-y crate)))
+ (z (if (and (= step 0) (typep crate 'crates2:moving)) (tail-z crate) (crate-z crate)))
+ (vids (visual crate)))
+ (loop for vid in vids
+ do
+ (let ((viv (gethash vid *visual-hash*)))
+ (when viv
+ (glpushmatrix)
+ (gltranslatef (float x) (- (float y)) (float z))
+ (ui-render-cube viv)
+ (glpopmatrix)))))))
+ (sdl-gl-swapwindow *crates2-window*)
+ (check-error))))
+
+(defun ui-init ()
+ (sb-int:with-float-traps-masked (:invalid :inexact :overflow)
+ (sdl-init +SDL-INIT-VIDEO+)
+ ;; (sdl-gl-setattribute :SDL-GL-CONTEXT-MAJOR-VERSION 2)
+ ;; (sdl-gl-setattribute :SDL-GL-CONTEXT-MINOR-VERSION 0)
+ ;; (sdl-gl-setattribute :SDL-GL-CONTEXT-PROFILE-MASK (foreign-enum-value 'sdl-glprofile :SDL-GL-CONTEXT-PROFILE-CORE))
+ ;; (sdl-gl-setattribute :SDL-GL-DOUBLEBUFFER 1)
+ (setf *crates2-window* (sdl-createwindow "Crates 2" 0 0 screen-width screen-height (logior (foreign-enum-value 'sdl-windowflags :SDL-WINDOW-OPENGL) (foreign-enum-value 'sdl-windowflags :SDL-WINDOW-SHOWN))))
+ (setf *crates2-gl-context* (sdl-gl-createcontext *crates2-window*))
+ (glewinit)
+ (glenable +GL-TEXTURE-2D+)
+ (gldisable +GL-LIGHTING+)
+ (glenable +GL-BLEND+)
+ (glblendfunc +GL-SRC-ALPHA+ +GL-ONE-MINUS-SRC-ALPHA+)
+ (glmatrixmode +GL-PROJECTION+)
+ (glHint +GL-PERSPECTIVE-CORRECTION-HINT+ +GL-NICEST+)
+ (glloadidentity)
+ (glviewport 0 0 screen-width screen-height)
+ (gluperspective 45.0d0 (/ (coerce screen-width 'double-float) screen-height) 0.1d0 50.0d0)
+ (glulookat 11.0d0 -26.0d0 20.0d0 10.0d0 -10.0d0 0.0d0 0.0d0 0.0d0 1.0d0)
+ (glmatrixmode +GL-MODELVIEW+)
+ (glloadidentity)
+ (setf *image* (img-load "etc/assets/texture/texture64.png"))
+ (setf *txids* (foreign-alloc :uint32 :count 1))
+ (glgentextures 1 *txids*)
+ (glbindtexture +GL-TEXTURE-2D+ (mem-aref *txids* :uint32 0))
+ (glenable +GL-TEXTURE-2D+)
+ (with-foreign-slots ((pixels) *image* (:struct sdl-surface))
+ (glteximage2d +GL-TEXTURE-2D+ 0 +GL-RGBA+ iw ih 0 +GL-RGBA+ +GL-UNSIGNED-BYTE+ pixels))
+ (gltexparameteri +GL-TEXTURE-2D+ +GL-TEXTURE-MAG-FILTER+ +GL-NEAREST+)
+ (gltexparameteri +GL-TEXTURE-2D+ +GL-TEXTURE-MIN-FILTER+ +GL-NEAREST+)
+ (check-error)))
+
+(defun ui-delete ()
+ (sb-int:with-float-traps-masked (:invalid :inexact :overflow)
+ ;; (sdl-destroytexture *texture*)
+ (sdl-freesurface *image*)
+ (sdl-destroywindow *crates2-window*)
+ (sdl-quit)))
+
+(defun ui-read-input ()
+ (sb-int:with-float-traps-masked (:invalid :inexact :overflow)
+ (let ((result nil))
+ (with-foreign-objects ((event '(:union sdl-event)))
+ (loop while (/= (sdl-pollevent event) 0)
+ do
+ (cffi:with-foreign-slots ((type) event (:union sdl-event))
+ (cond ((eq type :SDL-KEYDOWN) (cffi:with-foreign-slots ((keysym) event sdl-keyboardevent)
+ (let* ((scancode (getf keysym 'scancode))
+ (modstate (sdl-getmodstate))
+ (shift (/= (logand modstate +KMOD-SHIFT+) 0)))
+ (cond ((eq scancode :SDL-SCANCODE-LEFT) (setf result (if shift :prev :west)))
+ ((eq scancode :SDL-SCANCODE-RIGHT) (setf result (if shift :next :east)))
+ ((eq scancode :SDL-SCANCODE-UP) (setf result :north))
+ ((eq scancode :SDL-SCANCODE-DOWN) (setf result :south))
+ ((eq scancode :SDL-SCANCODE-R) (setf result :restart))
+ ((eq scancode :SDL-SCANCODE-SPACE) (setf result :action1))
+ ((eq scancode :SDL-SCANCODE-B) (setf result :back))
+ ((eq scancode :SDL-SCANCODE-ESCAPE) (setf result :back))))))
+ ((eq type :SDL-QUIT) (setf result :back))))))
+ result)))<
\ No newline at end of file
A src/sdl2-common.lisp => src/sdl2-common.lisp +37 -0
@@ 0,0 1,37 @@
+;; Octaspire Crates 2 - Puzzle Game
+;; Copyright 2020, 2021 octaspire.com
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+(in-package :crates2-ui)
+
+(defun ui-read-input ()
+ (sb-int:with-float-traps-masked (:invalid :inexact :overflow)
+ (let ((result nil))
+ (with-foreign-objects ((event '(:union sdl-event)))
+ (loop while (/= (sdl-pollevent event) 0)
+ do
+ (cffi:with-foreign-slots ((type) event (:union sdl-event))
+ (cond ((eq type :SDL-KEYDOWN) (cffi:with-foreign-slots ((keysym) event sdl-keyboardevent)
+ (let* ((scancode (getf keysym 'scancode))
+ (modstate (sdl-getmodstate))
+ (shift (/= (logand modstate +KMOD-SHIFT+) 0)))
+ (cond ((eq scancode :SDL-SCANCODE-LEFT) (setf result (if shift :prev :west)))
+ ((eq scancode :SDL-SCANCODE-RIGHT) (setf result (if shift :next :east)))
+ ((eq scancode :SDL-SCANCODE-UP) (setf result :north))
+ ((eq scancode :SDL-SCANCODE-DOWN) (setf result :south))
+ ((eq scancode :SDL-SCANCODE-R) (setf result :restart))
+ ((eq scancode :SDL-SCANCODE-SPACE) (setf result :action1))
+ ((eq scancode :SDL-SCANCODE-B) (setf result :back))
+ ((eq scancode :SDL-SCANCODE-ESCAPE) (setf result :back))))))
+ ((eq type :SDL-QUIT) (setf result :back))))))
+ result)))<
\ No newline at end of file
A src/special.lisp => src/special.lisp +52 -0
@@ 0,0 1,52 @@
+;; Octaspire Crates 2 - Puzzle Game
+;; Copyright 2020 octaspire.com
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+(in-package :crates2)
+
+;; Methods
+
+(defmethod visual ((self special-jump))
+ (ecase (crate-state self)
+ (:idle
+ (list (format nil "special-jump-idle-~2,'0d" (crate-frame self))))
+ (:active (list "special-jump-active"))
+ (:lamented (list "special-jump-active"))))
+
+(defmethod update ((self special-jump))
+ (ecase (crate-state self)
+ (:idle
+ (let ((frame (1+ (crate-frame self))))
+ (setf (crate-frame self) (mod frame 14))))
+ (:active
+ (let ((step (special-jump-active-step self)))
+ (if (> step 0)
+ (setf (special-jump-active-step self) (1- step))
+ (progn
+ (attach-to self (special-jump-target self))
+ (lament self))))))
+ (call-next-method))
+
+(defmethod collide ((self special-jump) (target player))
+ (ecase (crate-state self)
+ (:idle
+ (setf (velocity target) (on-which-side-i-am self target))
+ (setf (crate-state self) :active)
+ (setf (special-jump-active-step self) 1)
+ (setf (special-jump-target self) target))
+ (:active
+ (setf (velocity target) (on-which-side-i-am self target)))
+ (:lamented nil)))
+
+(defmethod attach-to ((self special-jump) (target moving))
+ (setf (moving-specials target) (cons self (moving-specials target))))
M src/textual-charms.lisp => src/textual-charms.lisp +3 -0
@@ 34,6 34,9 @@
(let ((c (cl-charms/low-level:wgetch *crates2-window*)))
(log:debug "Input is ~A" c)
(cond
+ ((= c cl-charms/low-level:KEY_SLEFT) :prev)
+ ((= c cl-charms/low-level:KEY_SRIGHT) :next)
+ ((= c (char-code #\Space)) :action1)
((or (= c (char-code #\w))
(= c cl-charms/low-level:KEY_UP)) :north)
((or (= c (char-code #\s))
M src/textual-common.lisp => src/textual-common.lisp +17 -0
@@ 80,6 80,22 @@
(setf (gethash "key-idle-07" *visual-hash*) #("+----+" " KEY " "+----+"))
(setf (gethash "key-idle-08" *visual-hash*) #("+----+" " KEY " "+----+"))
(setf (gethash "key-active" *visual-hash*) #("+----+" " !!! " "+----+"))
+ ;; SPECIAL
+ (setf (gethash "special-jump-idle-00" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-01" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-02" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-03" *visual-hash*) #(" " " :: " " "))
+ (setf (gethash "special-jump-idle-04" *visual-hash*) #(" " " :: " " "))
+ (setf (gethash "special-jump-idle-05" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-06" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-07" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-08" *visual-hash*) #(" " " :: " " "))
+ (setf (gethash "special-jump-idle-09" *visual-hash*) #(" " " :: " " "))
+ (setf (gethash "special-jump-idle-10" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-11" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-12" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-idle-13" *visual-hash*) #(" " " ** " " "))
+ (setf (gethash "special-jump-active" *visual-hash*) #(" " " OO " " "))
;; PLAYER
(setf (gethash "player-active-00" *visual-hash*) #(" .--. " " |XX| " " `--' "))
(setf (gethash "player-active-01" *visual-hash*) #(" .--. " " |xx| " " `--' "))
@@ 88,6 104,7 @@
(setf (gethash "player-active-04" *visual-hash*) #(" .--. " " |..| " " `--' "))
(setf (gethash "player-active-05" *visual-hash*) #(" .--. " " |**| " " `--' "))
(setf (gethash "player-active-06" *visual-hash*) #(" .--. " " |xx| " " `--' "))
+ (setf (gethash "player-airborne" *visual-hash*) #(".----." "|xxxx|" "`----'"))
(setf (gethash "player-hidden" *visual-hash*) #(" " " " " "))
;; SLOPES
(setf (gethash "slope-en" *visual-hash*) #("+--+ " "| \\ " "+----+"))
M src/utils.lisp => src/utils.lisp +17 -13
@@ 67,21 67,25 @@ directions."
(if other
(let ((ix (crate-x i))
(iy (crate-y i))
+ (iz (crate-z i))
(ox (crate-x other))
- (oy (crate-y other)))
- (if (= iy oy)
- (if (between-inclusive-p ix (- ox 1) (- ox 1 slack))
- :west
- (if (between-inclusive-p ix (+ ox 1) (+ ox 1 slack))
- :east
- :zero))
- (if (= ix ox)
- (if (between-inclusive-p iy (- oy 1) (- oy 1 slack))
- :north
- (if (between-inclusive-p iy (+ oy 1) (+ oy 1 slack))
- :south
+ (oy (crate-y other))
+ (oz (crate-z other)))
+ (if (= iz oz)
+ (if (= iy oy)
+ (if (between-inclusive-p ix (- ox 1) (- ox 1 slack))
+ :west
+ (if (between-inclusive-p ix (+ ox 1) (+ ox 1 slack))
+ :east
:zero))
- :zero)))
+ (if (= ix ox)
+ (if (between-inclusive-p iy (- oy 1) (- oy 1 slack))
+ :north
+ (if (between-inclusive-p iy (+ oy 1) (+ oy 1 slack))
+ :south
+ :zero))
+ :zero))
+ :zero))
:zero))
(defun on-which-side-is-other (i other &optional (slack 0))
M src/vacuum.lisp => src/vacuum.lisp +1 -1
@@ 22,7 22,7 @@
(let ((frame (1+ (crate-frame self)))
(crate (find-at-of-type (crate-x self) (crate-y self) 0 'moving)))
(setf (crate-frame self) (mod frame 8))
- (when crate
+ (when (and crate (not (moving-airborne crate)))
(setf (crate-state self) :broken)
(lament crate))))
(:broken nil))
