opengl.scm 7.06 KB
Newer Older
John Croisant's avatar
John Croisant committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14
;; The contents of this demo file are made available under the CC0 1.0
;; Universal Public Domain Dedication. See LICENSE-CC0.txt or visit
;; http://creativecommons.org/publicdomain/zero/1.0/


;;; This is a demo program showing how to integrate with OpenGL to
;;; create 3D graphics, using the opengl-glew, gl-utils, and gl-math
;;; eggs.
;;;
;;; Controls:
;;;
;;; - Click the close button to quit


15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
(cond-expand
  (chicken-4
   (use (prefix sdl2 sdl2:)
        (prefix opengl-glew  gl:)
        (prefix gl-utils     gl-utils:)
        (prefix gl-math      gl-math:)
        miscmacros))
  (chicken-5
   ;; NOTE: This will fail until the OpenGL eggs are ported to CHICKEN 5.
   (import (chicken condition)
           (chicken format)
           (prefix sdl2 sdl2:)
           (prefix opengl-glew  gl:)
           (prefix gl-utils     gl-utils:)
           (prefix gl-math      gl-math:)
           miscmacros)))
John Croisant's avatar
John Croisant committed
31 32 33 34 35


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; INITIALIZE SDL AND OPENGL

36
;; Initialize SDL
John Croisant's avatar
John Croisant committed
37 38
(sdl2:set-main-ready!)
(sdl2:init! '(video timer))
John Croisant's avatar
John Croisant committed
39

40 41 42 43 44 45 46 47 48 49 50 51
;; Automatically call sdl2:quit! when program exits normally.
(on-exit sdl2:quit!)

;; Call sdl2:quit! and then call the original exception handler if an
;; unhandled exception reaches the top level.
(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (sdl2:quit!)
     (original-handler exception))))


John Croisant's avatar
John Croisant committed
52
;;; Create an SDL window with the opengl flag.
John Croisant's avatar
John Croisant committed
53
(define window (sdl2:create-window!
John Croisant's avatar
John Croisant committed
54 55 56 57 58
                "SDL2 + OpenGL Example"
                'undefined 'undefined 640 480
                '(opengl)))

;;; Use OpenGL 3.3
59 60 61
(sdl2:gl-attribute-set! 'context-profile-mask 'core)
(sdl2:gl-attribute-set! 'context-major-version 3)
(sdl2:gl-attribute-set! 'context-minor-version 3)
John Croisant's avatar
John Croisant committed
62 63

;;; Configure basic OpenGL attributes
64 65 66 67 68
(sdl2:gl-attribute-set! 'red-size     5)
(sdl2:gl-attribute-set! 'green-size   5)
(sdl2:gl-attribute-set! 'blue-size    5)
(sdl2:gl-attribute-set! 'depth-size   16)
(sdl2:gl-attribute-set! 'doublebuffer 1)
John Croisant's avatar
John Croisant committed
69 70

;;; Configure multisampling (anti-aliasing)
71 72
(sdl2:gl-attribute-set! 'multisamplebuffers 1)
(sdl2:gl-attribute-set! 'multisamplesamples 4)
John Croisant's avatar
John Croisant committed
73 74

;;; Create the OpenGL context
John Croisant's avatar
John Croisant committed
75
(define gl-context (sdl2:gl-create-context! window))
John Croisant's avatar
John Croisant committed
76

John Croisant's avatar
John Croisant committed
77 78
(assert (equal? window (sdl2:gl-get-current-window)))
(assert (equal? gl-context (sdl2:gl-get-current-context)))
John Croisant's avatar
John Croisant committed
79 80 81 82 83 84


;;; Initialize OpenGL
(gl:init)
(gl-utils:check-error)

85 86 87 88 89 90 91 92 93 94 95

;;; For some reason, getting certain attributes causes an OpenGL
;;; error, at least on Mac OS X. This procedure attempts to get the
;;; value of the given attribute, but handles exceptions so that the
;;; program can continue.
(define (gl-attribute-safe attr)
  (condition-case
   (sdl2:gl-attribute attr)
   (e (exn sdl2)
      ((condition-property-accessor 'sdl2 'sdl-error) e))))

John Croisant's avatar
John Croisant committed
96 97 98 99 100 101 102 103 104 105
;;; The actual OpenGL settings may differ from the requested settings.
(printf
 "Actual OpenGL settings:
  red-size            ~A
  green-size          ~A
  blue-size           ~A
  depth-size          ~A
  doublebuffer        ~A
  multisamplebuffers  ~A
  multisamplesamples  ~A~%"
106 107 108 109 110 111 112 113
 (gl-attribute-safe 'red-size)
 (gl-attribute-safe 'green-size)
 (gl-attribute-safe 'blue-size)
 (gl-attribute-safe 'depth-size)
 (gl-attribute-safe 'doublebuffer)
 (gl-attribute-safe 'multisamplebuffers)
 (gl-attribute-safe 'multisamplesamples))

John Croisant's avatar
John Croisant committed
114 115

(printf "Drawable size: ~A~%"
John Croisant's avatar
John Croisant committed
116
        (receive (sdl2:gl-get-drawable-size window)))
John Croisant's avatar
John Croisant committed
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SHADERS / PROGRAM

(define vertex-shader-source "
#version 330
in vec2 position;
in vec3 color;
out vec3 c;
uniform mat4 MVP;

void main(){
   gl_Position = MVP * vec4(position, 0.0, 1.0);
   c = color;
}")

(define fragment-shader-source "
#version 330
in vec3 c;
out vec4 fragColor;
void main(){
  fragColor = vec4(c, 1.0);
}")

(define program
  (gl-utils:make-program
   (list (gl-utils:make-shader gl:+vertex-shader+
                               vertex-shader-source)
         (gl-utils:make-shader gl:+fragment-shader+
                               fragment-shader-source))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MESH

(define square
  (gl-utils:make-mesh
   vertices: '(attributes:
               ((position #:float 2)
                (color #:unsigned-byte 3 normalized: #t))
               initial-elements:
               ((position . (-1 -1
                              1 -1
                              1  1
                             -1  1))
                (color . (255 0   0
                          0   255 0
                          0   0   255
                          255 0   255))))
   indices: '(type: #:ushort
              initial-elements: (0 1 2
                                 0 2 3))))

(gl-utils:mesh-make-vao!
 square `((position . ,(gl:get-attrib-location program "position"))
          (color    . ,(gl:get-attrib-location program "color"))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MATRICES

;;; A matrix representing the screen projection.
(define projection-matrix
  (gl-math:perspective 640 480 0.1 100 70))

;;; A matrix representing the camera position and orientation.
(define view-matrix
  (gl-math:look-at (gl-math:make-point 1 0 3)
                   (gl-math:make-point 0 0 0)
                   (gl-math:make-point 0 1 0)))

;;; The model's current rotation around the Z axis.
(define *model-z-angle* 0.0)

;;; Calculate a matrix representing the model's transformation.
(define (calc-model-matrix)
  (gl-math:z-rotation *model-z-angle*))

;;; Calculate a matrix combining the model, view, and projection
;;; matrices.
(define (calc-mvp-matrix)
  (gl-math:m* projection-matrix
              (gl-math:m* view-matrix
                          (calc-model-matrix))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; RENDER

(define (render)
  (gl:use-program program)

  (gl:uniform-matrix4fv (gl:get-uniform-location program "MVP")
                        1 #f
                        (calc-mvp-matrix))

  (gl:bind-vertex-array (gl-utils:mesh-vao square))
  (gl:draw-elements-base-vertex
   (gl-utils:mode->gl (gl-utils:mesh-mode square))
   (gl-utils:mesh-n-indices square)
   (gl-utils:type->gl (gl-utils:mesh-index-type square))
   #f 0)

  (gl-utils:check-error)
  (gl:bind-vertex-array 0))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MAIN LOOP

(define (main-loop)
  ;; Loop until the user clicks the close button.
John Croisant's avatar
John Croisant committed
231
  (while (not (sdl2:quit-requested?))
John Croisant's avatar
John Croisant committed
232 233 234 235 236
    (gl:clear (bitwise-ior gl:+color-buffer-bit+
                           gl:+depth-buffer-bit+))

    ;; Update the model's rotation based on how long the program has
    ;; been running.
John Croisant's avatar
John Croisant committed
237
    (set! *model-z-angle* (* (sdl2:get-ticks) 0.001))
John Croisant's avatar
John Croisant committed
238 239 240

    ;; Render the scene and update the window.
    (render)
John Croisant's avatar
John Croisant committed
241
    (sdl2:gl-swap-window! window)
John Croisant's avatar
John Croisant committed
242 243

    ;; Pause briefly to let the CPU rest.
John Croisant's avatar
John Croisant committed
244
    (sdl2:delay! 10)
John Croisant's avatar
John Croisant committed
245 246

    ;; Flush (clear) all old events so that they don't pile up.
John Croisant's avatar
John Croisant committed
247
    (sdl2:flush-events! 'first 'last)
John Croisant's avatar
John Croisant committed
248 249 250

    ;; Pump events so that we can detect whether the user has clicked
    ;; the close button.
John Croisant's avatar
John Croisant committed
251
    (sdl2:pump-events!)))
John Croisant's avatar
John Croisant committed
252 253

(main-loop)