~octaspire/crates2

0d25bc0235606789a1a0156068d7a8610d3c2788 — octaspire 3 months ago 90d973e + 2a915e3 master
Merge branch 'feature/3D'
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))