From 8f283b90e4882fe3fb3e2031a17629b2914fc3b0 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 26 Oct 2014 13:38:42 -0400
Subject: render: Add blending data type.

* sly/render/utils.scm (<blend-mode>): New record type.
  (make-blend-mode, blend-mode?, blend-mode-source,
  blend-mode-destination): New syntax.
  (default-blend-mode): New variable.
  (source-blend-function, destination-blend-function, apply-blend-mode):
  New procedures.
---
 sly/render/utils.scm | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 58 insertions(+), 1 deletion(-)

diff --git a/sly/render/utils.scm b/sly/render/utils.scm
index a0748b2..24d1180 100644
--- a/sly/render/utils.scm
+++ b/sly/render/utils.scm
@@ -23,7 +23,64 @@
 
 (define-module (sly render utils)
   #:use-module (oop goops)
-  #:export (draw))
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (gl low-level)
+  #:use-module (gl enums)
+  #:export (draw
+            make-blend-mode blend-mode?
+            blend-mode-source blend-mode-destination
+            default-blend-mode
+            apply-blend-mode))
 
 ;; Generic method for rendering objects.
 (define-generic draw)
+
+;;;
+;;; Blending
+;;;
+
+(define-record-type <blend-mode>
+  (make-blend-mode source destination)
+  blend-mode?
+  (source blend-mode-source)
+  (destination blend-mode-destination))
+
+(define default-blend-mode
+  (make-blend-mode 'src-alpha 'one-minus-src-alpha))
+
+;; Translate symbols to OpenGL constants.
+(define source-blend-function
+  (match-lambda
+   ('zero 0)
+   ('one 1)
+   ('dst-color 774)
+   ('one-minus-dst-color 775)
+   ('src-alpha-saturate 776)
+   ('src-alpha 770)
+   ('one-minus-src-alpha 771)
+   ('dst-alpha 772)
+   ('one-minus-dst-alpha 773)
+   ('constant-color 32769)
+   ('one-minus-constant-color 32770)
+   ('constant-alpha 32771)
+   ('one-minus-constant-alpha 32772)))
+
+(define destination-blend-function
+  (match-lambda
+   ('zero 0)
+   ('one 1)
+   ('src-color 768)
+   ('one-minus-src-color 769)
+   ('src-alpha 770)
+   ('one-minus-src-alpha 771)
+   ('dst-alpha 772)
+   ('one-minus-dst-alpha 773)
+   ('constant-color 32769)
+   ('one-minus-constant-color 32770)
+   ('constant-alpha 32771)
+   ('one-minus-constant-alpha 32772)))
+
+(define (apply-blend-mode blend-mode)
+  (glBlendFunc (source-blend-function (blend-mode-source blend-mode))
+               (destination-blend-function (blend-mode-destination blend-mode))))
-- 
cgit v1.2.3