~octaspire/crates2

86f20111ee3cafa4e460daec5666bd4968d6f1f5 — octaspire 1 year, 10 months ago 1e530d3
WIP: Continue with 3D representation
3 files changed, 152 insertions(+), 53 deletions(-)

M src/octaspire-cl-sdl2.lisp
M src/pass-counter.lisp
M src/sdl2-3d.lisp
M src/octaspire-cl-sdl2.lisp => src/octaspire-cl-sdl2.lisp +20 -3
@@ 1105,9 1105,6 @@

(defconstant +GL-BLEND+               #x0BE2)

(defconstant +GL-TEXTURE-MIN-FILTER+  #x2801)
(defconstant +GL-LINEAR+              #x2601)

(defcfun "glewInit" :uint)

(defcfun "glGetError" :uint32)           ; GLenum for real


@@ 1260,11 1257,31 @@
(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))





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/sdl2-3d.lisp => src/sdl2-3d.lisp +131 -49
@@ 15,10 15,10 @@
(in-package :crates2-ui)

;; Crate is drawn as CW x CH pixel shape
(defconstant cw 32)
(defconstant ch 32)
(defconstant iw 1024)
(defconstant ih 1024)
(defconstant cw 64)
(defconstant ch 64)
(defconstant iw 2048)
(defconstant ih 2048)
;; Window dimensions
(defconstant screen-width 800)
(defconstant screen-height 600)


@@ 91,7 91,7 @@
      (:east   (make-rect-for-east   tx1 ty1 tx2 ty2))
      (:west   (make-rect-for-west   tx1 ty1 tx2 ty2)))))

(defun make-transparent-top (index)
(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)))


@@ 100,14 100,14 @@
         (tx2 (+ tx1 tw))
         (ty2 (+ ty1 th)))
    (list
     (make-rect-for-top    tx1 ty1 tx2 ty2 0.08)
     (make-rect-for-top    tx1 ty1 tx2 ty2 z)
     nil
     nil
     nil
     nil
     nil)))

(defun make-transparent-bottom (index)
(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)))


@@ 117,7 117,7 @@
         (ty2 (+ ty1 th)))
    (list
     nil
     (make-rect-for-bottom tx1 ty1 tx2 ty2 0.08)
     (make-rect-for-bottom tx1 ty1 tx2 ty2 z)
     nil
     nil
     nil


@@ 353,6 353,107 @@
  (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


@@ 362,24 463,24 @@
  ;; 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-cube 11 nil nil nil nil nil))
  (setf (gethash "pulled-east-handle-idle"   *visual-hash*) (make-cube 7 nil nil nil nil nil))
  (setf (gethash "pulled-east-no-handle"     *visual-hash*) (make-cube 15 nil nil nil nil nil))
  (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-cube 13 nil nil nil nil nil))
  (setf (gethash "pulled-west-handle-idle"   *visual-hash*) (make-cube 9 nil nil nil nil nil))
  (setf (gethash "pulled-west-no-handle"     *visual-hash*) (make-cube 15 nil nil nil nil nil))
  (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-cube 12 nil nil nil nil nil))
  (setf (gethash "pulled-north-handle-idle"   *visual-hash*) (make-cube 8 nil nil nil nil nil))
  (setf (gethash "pulled-north-no-handle"     *visual-hash*) (make-cube 15 nil nil nil nil nil))
  (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-cube 14 nil nil nil nil nil))
  (setf (gethash "pulled-south-handle-idle"   *visual-hash*) (make-cube 10 nil nil nil nil nil))
  (setf (gethash "pulled-south-no-handle"     *visual-hash*) (make-cube 15 nil nil nil nil nil))
  (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-cube nil 74 nil nil nil nil))
  (setf (gethash "stepper-active"             *visual-hash*) (make-cube nil 75 nil nil nil nil))
  (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


@@ 536,24 637,18 @@
    (when bottom
      (ui-render-face bottom))

    (glend)
    (check-error)))
    (glend)))

(defun ui-render (level step)
  (sb-int:with-float-traps-masked (:invalid :inexact :overflow)
    (check-error)
    (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+)
    (check-error "X")
    (glenable  +GL-DEPTH-TEST+)
    (gldisable +GL-CULL-FACE+)
    (gldisable +GL-ALPHA-TEST+)
    ;; (gltranslatef 5.0 5.0 -5.0)
    (check-error)

    (glcolor4f   1.0 1.0 1.0 1.0)
    (cffi:with-foreign-objects ((rect1 '(:struct sdl-rect))
                                (rect2 '(:struct sdl-rect))


@@ 588,48 683,35 @@
    ;; (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-window* (sdl-createwindow "Crates 2" 0 0 screen-width screen-height 2))
    ;; (sdl-gl-setswapinterval 1)
    (setf *crates2-gl-context* (sdl-gl-createcontext *crates2-window*))
    (glewinit)
    (check-error "1")
    (glenable +GL-TEXTURE-2D+)
    (gldisable +GL-LIGHTING+)
    ;; (gldisable +GL-BLEND+)
    (glenable +GL-BLEND+)
    (glblendfunc +GL-SRC-ALPHA+ +GL-ONE-MINUS-SRC-ALPHA+)
    (glmatrixmode +GL-PROJECTION+)
    (check-error "2")
    (glHint +GL-PERSPECTIVE-CORRECTION-HINT+ +GL-NICEST+)
    (glloadidentity)
    (check-error "3")
    (glviewport 0 0 screen-width screen-height)
    (check-error "4")
    ;; (gluortho2d 0.0d0 (coerce screen-width 'double-float) 0.0d0 (coerce screen-height 'double-float))
    (gluperspective 45.0d0 (/ (coerce screen-width 'double-float) screen-height) 0.1d0 100.0d0)
    (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)
    (check-error "5")
    (glmatrixmode +GL-MODELVIEW+)
    (check-error "6")
    (glloadidentity)
    (setf *image* (img-load "etc/assets/texture/texture32.png"))
    (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+ 1024 1024 0 +GL-RGBA+ +GL-UNSIGNED-BYTE+ pixels))
    (gltexparameteri +GL-TEXTURE-2D+ +GL-TEXTURE-MIN-FILTER+ +GL-LINEAR+)
    (check-error "7")
    ;; (setf *texture* (sdl-createtexturefromsurface
    ;;                  *crates2-renderer*
    ;;                  *image*))
    ))
      (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-destroyrenderer *crates2-renderer*)
      (sdl-destroywindow *crates2-window*)
      (sdl-quit)))