127 lines
4.8 KiB
Common Lisp
127 lines
4.8 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(uiop:define-package :stoe/engine/viewport
|
|
(:use :cl :glop
|
|
:stoe/core/utils
|
|
:stoe/engine/input)
|
|
(:export #:viewport-width #:viewport-height #:need-resize-p
|
|
#:glsl-version
|
|
#:support-gl-version-p
|
|
#:viewport-configure
|
|
#:viewport-initialize
|
|
#:viewport-finalize
|
|
#:during-one-frame))
|
|
(in-package :stoe/engine/viewport)
|
|
|
|
(defstruct gl-config
|
|
major minor glsl)
|
|
|
|
(defstruct viewport-config
|
|
title width height)
|
|
|
|
(defvar *gl-config* nil)
|
|
(defvar *main-conf* nil)
|
|
(defvar *main-window* nil)
|
|
|
|
(defun viewport-width () (window-width *main-window*))
|
|
(defun viewport-height () (window-height *main-window*))
|
|
(defun need-resize-p () (and *main-window*
|
|
(or (/= (window-width *main-window*) (viewport-config-width *main-conf*))
|
|
(/= (window-height *main-window*) (viewport-config-height *main-conf*)))))
|
|
|
|
(defun support-gl-version-p (version)
|
|
(and *gl-config*
|
|
(multiple-value-bind (maj min) (floor version 10)
|
|
(or (< maj (gl-config-major *gl-config*))
|
|
(and (= maj (gl-config-major *gl-config*))
|
|
(<= min (gl-config-minor *gl-config*)))))))
|
|
|
|
(defun glsl-version () (and *gl-config* (gl-config-glsl *gl-config*)))
|
|
|
|
(defun viewport-configure (&optional argv)
|
|
(let ((config (make-viewport-config :title (get-command-line-option argv "--title" "Stoe")
|
|
:width (get-command-line-option-number argv "--width" 800)
|
|
:height (get-command-line-option-number argv "--height" 600)))
|
|
(version (get-command-line-option-number argv "--opengl")))
|
|
(setf *main-conf* config)
|
|
(when version
|
|
(multiple-value-bind (maj min) (floor version 10)
|
|
(setf *gl-config* (make-gl-config :major maj :minor min))))))
|
|
|
|
(defun initialize-context ()
|
|
(gl:enable :cull-face)
|
|
(gl:cull-face :back)
|
|
(gl:front-face :cw)
|
|
(gl:enable :depth-test)
|
|
(gl:depth-mask :true)
|
|
(gl:depth-func :lequal)
|
|
(gl:depth-range 0.0 1.0))
|
|
|
|
(defun viewport-initialize ()
|
|
"Initialize the viewport."
|
|
(if *gl-config*
|
|
(setf *main-window* (create-window (viewport-config-title *main-conf*)
|
|
(viewport-config-width *main-conf*)
|
|
(viewport-config-height *main-conf*)
|
|
:major (gl-config-major *gl-config*)
|
|
:minor (gl-config-minor *gl-config*)))
|
|
(progn
|
|
(setf *main-window* (create-window (viewport-config-title *main-conf*)
|
|
(viewport-config-width *main-conf*)
|
|
(viewport-config-height *main-conf*)))
|
|
(setf *gl-config* (make-gl-config :major (gl:get-integer :major-version)
|
|
:minor (gl:get-integer :minor-version)))))
|
|
(setf (gl-config-glsl *gl-config*)
|
|
(with-input-from-string (in (gl:get-string :shading-language-version))
|
|
(stoe/core/file:safe-read in)))
|
|
(initialize-context))
|
|
|
|
(defun viewport-finalize ()
|
|
"Finalize the viewport."
|
|
(when *main-window*
|
|
(destroy-window *main-window*)
|
|
(setf *main-window* nil)))
|
|
|
|
(defun clear-buffers ()
|
|
(gl:clear-color 0 0 0 0)
|
|
(gl:clear-depth 1.0)
|
|
(gl:clear :color-buffer-bit :depth-buffer-bit))
|
|
|
|
(defun swap-main-buffers ()
|
|
(swap-buffers *main-window*))
|
|
|
|
(defmacro during-one-frame (&body body)
|
|
`(progn
|
|
(clear-buffers)
|
|
,@body
|
|
(swap-main-buffers)
|
|
(poll-events)))
|
|
|
|
(defun poll-events ()
|
|
"Poll events from the window manager.
|
|
This needs to be called once per frame, at the beginning of the loop."
|
|
(when *main-window*
|
|
(setf (viewport-config-width *main-conf*) (window-width *main-window*)
|
|
(viewport-config-height *main-conf*) (window-height *main-window*))
|
|
(dispatch-events *main-window* :blocking nil :on-foo nil)))
|
|
|
|
(defmethod on-event (window event)
|
|
(declare (ignore window))
|
|
(typecase event
|
|
(key-press-event (on-key-event t (keycode event) (keysym event) (text event)))
|
|
(key-release-event (on-key-event nil (keycode event) (keysym event) (text event)))
|
|
(button-press-event (on-button-event t (button event)))
|
|
(button-release-event (on-button-event nil (button event)))
|
|
(mouse-motion-event (on-motion-event (x event) (y event) (dx event) (dy event)))
|
|
(resize-event (on-resize-event (width event) (height event)))
|
|
(expose-event (on-resize-event (width event) (height event)))
|
|
;; (visibility-event)
|
|
;; (focus-event)
|
|
;; (close-event)
|
|
(t (format t "Unhandled event type: ~s~%" (type-of event)))))
|
|
|
|
(defun on-resize-event (width height)
|
|
(gl:viewport 0 0 width height))
|