From e13fd4b0f6a3ada466585c7865ba7479c9e54ed3 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 17 Jul 2013 21:41:38 -0400
Subject: Add rgba->gl-color procedure.

rgba->gl-color converts an RGBA color code in integer form into a list of color values for use with OpenGL calls.
For example, passing #xffffffff returns '(1.0 1.0 1.0 1.0).
---
 2d/helpers.scm | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

(limited to '2d/helpers.scm')

diff --git a/2d/helpers.scm b/2d/helpers.scm
index 153b4b5..c919006 100644
--- a/2d/helpers.scm
+++ b/2d/helpers.scm
@@ -23,8 +23,10 @@
 
 (define-module (2d helpers)
   #:use-module (srfi srfi-1)
+  #:use-module (rnrs arithmetic bitwise)
   #:export (any-equal?
-            logand?))
+            logand?
+            rgba->gl-color))
 
 (define (any-equal? elem . args)
   "Returns true if elem equals any of the arguments and returns false
@@ -35,3 +37,15 @@ otherwise."
   "Returns true if the result of a bitwise AND of the integer
 arguments is non-zero and returns false otherwise."
   (not (zero? (apply logand args))))
+
+(define (rgba->gl-color color)
+  "Converts an integer color code into OpenGL compatible color
+values. Returns a list of four floating point numbers in range [0,1]."
+  (define (component offset)
+    (let ((mask (bitwise-arithmetic-shift-left #xff offset)))
+      (/ (bitwise-arithmetic-shift-right (logand mask color) offset) 255.0)))
+
+  (list (component 24)
+        (component 16)
+        (component 8)
+        (component 0)))
-- 
cgit v1.2.3