src/cowl-viewport.lisp

   1
   2 (in-package #:cowl)
   3
   4 (defclass viewport (widget)
   5   ((render :type function :initarg :render :accessor render-of
   6            :documentation "Callback for this class for drawing the scene inside the viewport."))
   7   (:documentation "Widget that contains a miniature viewport,
   8 use the render attribute, or draw-viewport-scene method for derived classes."))
   9
  10 (defgeneric draw-viewport-scene (viewport)
  11   (:documentation "Override this method in sub-classes of viewport to
  12 define the render function of the viewport."))
  13
  14 (defmethod draw ((viewport viewport))
  15   (destructuring-bind (display-width display-height)
  16       (let ((viewport (list 0 0 0 0)))
  17         (gl:get-integerv gl:+viewport+ viewport)
  18         (cddr viewport))
  19     (gl:with-push-attrib (gl:+depth-buffer-bit+)
  20       (gl:enable gl:+depth-test+)
  21       (gl:depth-func gl:+always+)
  22       (gl:color-4f 0.5 0.5 0.5 0)
  23       (gl:translate-f 0 0 -1)
  24       (gl:rect-f 0 (current-size-of (y viewport))
  25                  (current-size-of (x viewport)) 0))
  26     (destructuring-bind (x y) (cumulative-offset-of viewport)
  27       (gl:with-push-attrib (gl:+viewport-bit+)
  28         (let ((height (round (current-size-of (y viewport)))))
  29           (gl:viewport (round x)
  30                        (- display-height (round y) height)
  31                        (round (current-size-of (x viewport)))
  32                        height))
  33         (draw-viewport-scene viewport)))))
  34
  35 (defmethod draw-viewport-scene ((viewport viewport))
  36   (funcall (render-of viewport)))
  37
  38 (defmacro make-viewport ((&rest make-instance-keyargs) &body render-forms)
  39   "Convenience macro that takes the keywords and a render function body."
  40   `(make-instance 'viewport ,@make-instance-keyargs
  41                   :render #'(lambda () ,@render-forms)))
  42
  43 ;; cityscape specific
  44 ;; (defclass model-viewer (viewport)
  45 ;;   ((model-uri :type model-uri :initarg :model-uri :initform nil :accessor model-uri-of
  46 ;;               :documentation "Unique identifier of the model to be drawn.")
  47 ;;    (x-rotation :type single-float :initform -45.0 :initarg :x-rotation :accessor x-rotation-of
  48 ;;                :documentation "Angle from straight-down this model is rotated by.")
  49 ;;    (z-rotation :type single-float :initform 0.0 :initarg :z-rotation :accessor z-rotation-of
  50 ;;                :documentation "Current state of the z-rotation."))
  51 ;;   (:documentation "Viewport widget that renders a centred, rotating model."))
  52
  53 ;; (defmethod draw-viewport-scene ((model-viewer model-viewer))
  54 ;;   (with-slots (model-uri distance x-rotation z-rotation) model-viewer
  55 ;;     (when model-uri
  56 ;;       (let* ((width (current-size-of (x model-viewer)))
  57 ;;              (height (current-size-of (y model-viewer)))
  58 ;;              (model (get-model model-uri))
  59 ;;              (distance (/ (maths:modulus (mapcar #'-
  60 ;;                                                  (first (extents-of model))
  61 ;;                                                  (second (extents-of model))))
  62 ;;                           (tan (/ *fov* 2)))))
  63 ;;         (setf z-rotation (* (glfw:get-time) 10.0))
  64 ;;         (gl:with-projection-matrix
  65 ;;             ((glu:perspective *fov*
  66 ;;                               (coerce (/ width height) 'single-float)
  67 ;;                               (coerce (/ distance 16) 'single-float)
  68 ;;                               (coerce (* distance 2) 'single-float)))
  69 ;;           (gl:load-identity)
  70 ;;           (gl:with-push-attrib (gl:+texture-bit+)
  71 ;;             (gl:disable gl:+texture-2d+)
  72 ;;             (gl:translate-f 0 0 (- distance))
  73 ;;             (gl:rotate-f x-rotation 1 0 0)
  74 ;;             (gl:rotate-f z-rotation 0 0 1)
  75 ;;             ;; translate down by half of the model's z extents
  76 ;;             (gl:translate-f 0 0 (/ (apply #'+ (mapcar #'third (extents-of model)))
  77 ;;                                    -2))
  78 ;;             (gl:color-4f 1 1 1 1)
  79 ;;             (draw model)))))))
  80