diff options
Diffstat (limited to 'chickadee/graphics/viewport.scm')
| -rw-r--r-- | chickadee/graphics/viewport.scm | 206 |
1 files changed, 112 insertions, 94 deletions
diff --git a/chickadee/graphics/viewport.scm b/chickadee/graphics/viewport.scm index e305c19..998e23a 100644 --- a/chickadee/graphics/viewport.scm +++ b/chickadee/graphics/viewport.scm @@ -20,110 +20,128 @@ ;;; Code: (define-module (chickadee graphics viewport) - #:use-module (ice-9 match) #:use-module (srfi srfi-9) - #:use-module (gl) - #:use-module (chickadee utils) - #:use-module (chickadee graphics color) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics gl) - #:export (make-viewport + #:export (<viewport> + make-viewport viewport? viewport-x viewport-y viewport-width viewport-height - viewport-clear-color - viewport-clear-flags - null-viewport - clear-viewport - g:viewport - current-viewport - %default-clear-flags - %default-clear-color)) + viewport-min-depth + viewport-max-depth + + <scissor-rect> + make-scissor-rect + scissor-rect? + scissor-rect-x + scissor-rect-y + scissor-rect-width + scissor-rect-height)) (define-record-type <viewport> - (%make-viewport x y width height clear-color clear-flags) + (%make-viewport x y width height min-depth max-depth) viewport? (x viewport-x) (y viewport-y) (width viewport-width) (height viewport-height) - (clear-color viewport-clear-color) - (clear-flags viewport-clear-flags)) - -(define %default-clear-flags '(color-buffer depth-buffer stencil-buffer)) -;; Just a fun color from the Dawnbringer 32-color palette instead of -;; boring old black. -(define %default-clear-color tango-light-sky-blue) - -(define (assert-non-negative-integer n) - (if (and (integer? n) (>= n 0)) - n - (error "expecting non-negative integer:" n))) - -(define* (make-viewport x y width height #:key - (clear-color %default-clear-color) - (clear-flags %default-clear-flags)) - "Create a viewport that covers an area of the window starting from -coordinates (X, Y) and spanning WIDTH x HEIGHT pixels. Fill the -viewport with CLEAR-COLOR when clearing the screen. Clear the buffers -denoted by the list of symbols in CLEAR-FLAGS. Possible values for -CLEAR-FLAGS are 'color-buffer', 'depth-buffer', 'accum-buffer', and -'stencil-buffer'." - (%make-viewport (assert-non-negative-integer x) - (assert-non-negative-integer y) - (assert-non-negative-integer width) - (assert-non-negative-integer height) - clear-color - clear-flags)) - -(define null-viewport (make-viewport 0 0 0 0)) - -(define clear-buffer-mask - (memoize - (lambda (flags) - (apply logior - ;; Map symbols to OpenGL constants. - (map (match-lambda - ('depth-buffer 256) - ('accum-buffer 512) - ('stencil-buffer 1024) - ('color-buffer 16384)) - flags))))) - -(define (clear-viewport) - (gl-clear (clear-buffer-mask (viewport-clear-flags (current-viewport))))) - -(define (apply-viewport viewport) - "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport -area, set the clear color, and clear necessary buffers." - (unless (eq? viewport null-viewport) - (let ((x (viewport-x viewport)) - (y (viewport-y viewport)) - (w (viewport-width viewport)) - (h (viewport-height viewport)) - (c (viewport-clear-color viewport))) - (gl-enable (enable-cap scissor-test)) - (gl-viewport x y w h) - (gl-scissor x y w h) - (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c))))) - -(define (bind-viewport viewport) - "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport -area, and set the clear color.." - (unless (eq? viewport null-viewport) - (let ((x (viewport-x viewport)) - (y (viewport-y viewport)) - (w (viewport-width viewport)) - (h (viewport-height viewport)) - (c (viewport-clear-color viewport))) - (gl-enable (enable-cap scissor-test)) - (gl-viewport x y w h) - (gl-scissor x y w h) - (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c))))) - -(define-graphics-state g:viewport - current-viewport - #:default null-viewport - #:bind bind-viewport) + (min-depth viewport-min-depth) + (max-depth viewport-max-depth)) + +(define* (make-viewport x y width height #:key (min-depth 0.0) (max-depth 1.0)) + (%make-viewport x y width height min-depth max-depth)) + +(define-record-type <scissor-rect> + (make-scissor-rect x y width height) + scissor-rect? + (x scissor-rect-x) + (y scissor-rect-y) + (width scissor-rect-width) + (height scissor-rect-height)) + +;; (define-record-type <viewport> +;; (%make-viewport x y width height clear-color clear-flags) +;; viewport? +;; (x viewport-x) +;; (y viewport-y) +;; (width viewport-width) +;; (height viewport-height) +;; (clear-color viewport-clear-color) +;; (clear-flags viewport-clear-flags)) + +;; (define %default-clear-flags '(color-buffer depth-buffer stencil-buffer)) +;; ;; Just a fun color from the Dawnbringer 32-color palette instead of +;; ;; boring old black. +;; (define %default-clear-color tango-light-sky-blue) + +;; (define (assert-non-negative-integer n) +;; (if (and (integer? n) (>= n 0)) +;; n +;; (error "expecting non-negative integer:" n))) + +;; (define* (make-viewport x y width height #:key +;; (clear-color %default-clear-color) +;; (clear-flags %default-clear-flags)) +;; "Create a viewport that covers an area of the window starting from +;; coordinates (X, Y) and spanning WIDTH x HEIGHT pixels. Fill the +;; viewport with CLEAR-COLOR when clearing the screen. Clear the buffers +;; denoted by the list of symbols in CLEAR-FLAGS. Possible values for +;; CLEAR-FLAGS are 'color-buffer', 'depth-buffer', 'accum-buffer', and +;; 'stencil-buffer'." +;; (%make-viewport (assert-non-negative-integer x) +;; (assert-non-negative-integer y) +;; (assert-non-negative-integer width) +;; (assert-non-negative-integer height) +;; clear-color +;; clear-flags)) + +;; (define null-viewport (make-viewport 0 0 0 0)) + +;; (define clear-buffer-mask +;; (memoize +;; (lambda (flags) +;; (apply logior +;; ;; Map symbols to OpenGL constants. +;; (map (match-lambda +;; ('depth-buffer 256) +;; ('accum-buffer 512) +;; ('stencil-buffer 1024) +;; ('color-buffer 16384)) +;; flags))))) + +;; (define (clear-viewport) +;; (gl-clear (clear-buffer-mask (viewport-clear-flags (current-viewport))))) + +;; (define (apply-viewport viewport) +;; "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport +;; area, set the clear color, and clear necessary buffers." +;; (unless (eq? viewport null-viewport) +;; (let ((x (viewport-x viewport)) +;; (y (viewport-y viewport)) +;; (w (viewport-width viewport)) +;; (h (viewport-height viewport)) +;; (c (viewport-clear-color viewport))) +;; (gl-enable (enable-cap scissor-test)) +;; (gl-viewport x y w h) +;; (gl-scissor x y w h) +;; (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c))))) + +;; (define (bind-viewport viewport) +;; "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport +;; area, and set the clear color.." +;; (unless (eq? viewport null-viewport) +;; (let ((x (viewport-x viewport)) +;; (y (viewport-y viewport)) +;; (w (viewport-width viewport)) +;; (h (viewport-height viewport)) +;; (c (viewport-clear-color viewport))) +;; (gl-enable (enable-cap scissor-test)) +;; (gl-viewport x y w h) +;; (gl-scissor x y w h) +;; (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c))))) + +;; (define-graphics-state g:viewport +;; current-viewport +;; #:default null-viewport +;; #:bind bind-viewport) |