glrepl-tests.lisp

   1
   2 (defpackage :glrepl-tests
   3     (:use :cl :iterate :glrepl :alexandria))
   4
   5 (in-package :glrepl-tests)
   6
   7 (defparameter *win-height* 768)
   8 (defparameter *win-width* 1024)
   9
  10 ;;   80 x 25 display
  11 (defparameter *texture-width* (/ 2.0 80.0))
  12 (defparameter *texture-height* (/ 2.0 25.0))
  13
  14 (defvar *esc-pressed* nil)
  15
  16 (cffi:defcallback key-callback :void ((key :int) (action :int))
  17   (when (= action glfw:+press+)
  18     (format t "Keypress ~A " key)
  19     (cond
  20       ((= key glfw:+key-esc+)  (setf *esc-pressed* t)))))
  21
  22 (cffi:defcallback window-size-callback :void ((width :int) (height :int))
  23   (setf *win-width* width)
  24   (setf *win-height* height)
  25   (gl:viewport 0 0 *win-width* *win-height*))
  26
  27
  28 (defun init-gl ()
  29   ;;  Disable stuff that's likely to slow down glRenderPixels.
  30   ;;  (Omit as much of this as possible, when you know in advance
  31   ;;   that the OpenGL state will already be set correctly.)
  32   (gl:enable gl:+texture-2d+)
  33   (gl:matrix-mode gl:+projection+)
  34   (gl:load-identity)
  35   (gl:push-matrix)
  36   (gl:matrix-mode gl:+modelview+)
  37   (gl:load-identity)
  38   (gl:push-matrix)
  39   (gl:viewport 0 0 *win-width* *win-height*))
  40
  41 (defun end-gl ()
  42   ())
  43
  44 (defun callback-set ()
  45   (setf *esc-pressed* nil)
  46   (glfw:set-key-callback (cffi:callback key-callback)))
  47
  48 (defun callback-clear ()
  49   (glfw:set-key-callback (cffi:null-pointer)))
  50
  51 (defun render-char (c x y)
  52  (when (graphic-char-p c)
  53    (let ((image (aref *font-images* (char-code c))))
  54      (when (typep  image 'rgba-image)
  55        (with-opengl
  56          (gl:bind-texture gl:+texture-2d+
  57                           (cffi::mem-ref (name-of image) :uint32))
  58          (gl:tex-env-f gl:+texture-env+ gl:+texture-env-mode+ gl:+decal+)
  59          (gl:color-4f 0.0 0.0 0.0 1.0)
  60          (gl:enable gl:+texture-2d+)
  61          (gl:enable gl:+blend+)
  62          (gl:blend-func  gl:+src-alpha+ gl:+one-minus-src-alpha+)
  63          (gl:with-begin gl:+quads+
  64            (gl:tex-coord-2i 0 1)
  65            (gl:vertex-2f x y) ;; top lhs
  66            (gl:tex-coord-2i 1 1)
  67            (gl:vertex-2f  (+ x *texture-width*) y  ) ;; top rhs
  68            (gl:tex-coord-2f 1 0)
  69            (gl:vertex-2f  (+ x *texture-width*) (+ y *texture-height*)) ;; bot rhs
  70            (gl:tex-coord-2i 0 0)
  71            (gl:vertex-2f x (+ y *texture-height*)))))))) ;; bot lhs
  72
  73
  74 (defun render-world ()
  75 ;;  (glrepl::render (aref *font-images* 65)))
  76   (render-char #\A 0.5 0.5))
  77
  78 (defun update-world (dt))
  79
  80 (defun main-loop ()
  81     (let ((t0 (glfw:get-time))
  82           (dt 0.0)
  83           (test-image (make-instance 'glrepl::rgba-image :width 64 :height 64)))
  84       (iterate
  85         (for i from 0 below (* 64 64))
  86         (setf (glrepl::pixel test-image i) #X000000FF))
  87       (glrepl::update-image test-image)
  88       (glfw:sleep 0.05d0)
  89       (gl:clear-color 0.0 0.0 0.0 1.0)
  90       (iterate
  91         (while (= (glfw::get-window-param glfw:+opened+) glfw:+true+))
  92         (gl:clear gl:+color-buffer-bit+)
  93         (setf dt (- (glfw:get-time) t0))
  94         (setf t0 (glfw:get-time))
  95         (update-world dt)
  96         (render-world)
  97         ;;(glrepl::render  test-image)
  98         ;; update
  99         ;; check for time available if time is avaliable render
 100         ;; surrender any cpu time..
 101         (glfw:swap-buffers)
 102         (if *esc-pressed*
 103             (glfw:close-window)))))
 104
 105 (defun test-glrepl ()
 106   (if (glfw::init)
 107     (progn
 108       (handler-case
 109           (if (glfw:open-window *win-width* *win-height* 16 16 16 16 16)
 110               (progn
 111                 (init-gl)
 112                 (format t "Making font..")
 113                 (make-font)
 114                 (format t "Done..")
 115                 (glfw:swap-interval 1)
 116                 (glfw:enable glfw:+key-repeat+)
 117                 (callback-set)
 118 ;;                (glrepl::dump (aref *font-images* 65))
 119                 (main-loop)
 120                 (callback-clear)
 121                 (end-gl)
 122                 (glfw:terminate))
 123               (error "Failed to open window"))
 124         (error (ohbum)
 125           (progn
 126             (format T "Boom ~A " ohbum)
 127             (destroy-font)
 128             (end-gl)
 129             (glfw:terminate)))))
 130     (error "Failed to init glfw")))
 131
 132 ;; (defun test-glrepl ()
 133 ;;   (glfw:with-init-window ("Glrepl" *win-width* *win-height*)
 134 ;;     (glfw:set-window-size-callback (cffi:callback window-size-callback))
 135 ;;     (glfw:set-key-callback (cffi:callback key-callback))
 136 ;;     (glfw:swap-interval 1)
 137 ;;     (let* ((frame 0))
 138 ;;       (iterate
 139 ;;         (while (and (not *esc-pressed*)
 140 ;;                     (eql (glfw:get-window-param glfw:+opened+) gl:+true+)))
 141 ;;         (gl:clear gl:+color-buffer-bit+)
 142 ;;         (incf frame)
 143 ;;         (glfw:swap-buffers)
 144 ;;           (cl:sleep 0.1))
 145 ;;       (if (eql (glfw:get-window-param glfw:+opened+) gl:+true+)
 146 ;;         (glfw:close-window))
 147 ;;       (glfw:terminate))))