Define shape datatype

src/Color.hs

@@ -0,0 +1,74 @@
+module Color
+  where
+import Geometry
+
+type RGBA  = Point4
+type Color = Point4
+
+withAlpha :: Float -> RGBA -> RGBA
+{-# INLINE withAlpha #-}
+withAlpha a (V4 x y z a') = V4 x y z (a*a')
+
+red,green,blue,yellow,cyan,magenta,rose
+    ,violet,azure,aquamarine,chartreuse,orange,white,black::Color
+red       = V4   1   0   0 1 
+green     = V4   0   1   0 1 
+blue      = V4   0   0   1 1 
+yellow    = V4   1   1   0 1  
+cyan      = V4   0   1   1 1 
+magenta   = V4   1   0   1 1  
+rose      = V4   1   0 0.5 1 
+violet    = V4 0.5   0   1 1  
+azure     = V4   0 0.5   1 1 
+aquamarine= V4   0   1 0.5 1 
+chartreuse= V4 0.5   1   0 1
+orange    = V4   1 0.5   0 1  
+white     = V4   1   1   1 1 
+black     = V4   0   0   0 1
+{-# INLINE red        #-}
+{-# INLINE green      #-}
+{-# INLINE blue       #-}
+{-# INLINE yellow     #-}
+{-# INLINE cyan       #-}
+{-# INLINE magenta    #-}
+{-# INLINE rose       #-}
+{-# INLINE violet     #-}
+{-# INLINE azure      #-}
+{-# INLINE aquamarine #-}
+{-# INLINE chartreuse #-}
+{-# INLINE orange     #-}
+{-# INLINE white      #-}
+{-# INLINE black      #-}
+
+mixColors :: Float -> Float -> Color -> Color -> Color
+{-# INLINE mixColors #-}
+mixColors rata ratb (V4 r0 g0 b0 a0) (V4 r2 g2 b2 a2) = 
+    let fullrat = rata + ratb
+        normrata = rata / fullrat
+        normratb = ratb / fullrat
+        f x y = sqrt $ normrata * x^(2::Int) + normratb * y^(2::Int)
+    in  V4 (f r0 r2 ) ( f g0 g2 ) ( f b0 b2 ) ( normrata * a0 + normratb * a2)
+
+light :: Color -> Color
+{-# INLINE light #-}
+light (V4 r g b a) = V4 (r+0.2) (g+0.2) (b+0.2) a
+
+dark :: Color -> Color
+{-# INLINE dark #-}
+dark (V4 r g b a) = V4 (r-0.2) (g-0.2) (b-0.2) a
+        
+dim :: Color -> Color
+{-# INLINE dim #-}
+dim (V4 r g b a) = V4 (r/1.2) (g/1.2) (b/1.2) a
+
+brightX :: Float -> Float -> Color -> Color
+{-# INLINE brightX #-}
+brightX cm am (V4 r g b a) = V4 (r*cm) (g*cm) (b*cm) (a*am)
+
+bright :: Color -> Color
+{-# INLINE bright #-}
+bright (V4 r g b a) = V4 (r*1.2) (g*1.2) (b*1.2) a
+
+greyN :: Float -> Color
+{-# INLINE greyN #-}
+greyN x = toV4 (x,x,x,1)