1 files changed, 51 insertions, 14 deletions

diff --git a/axis.hs b/axis.hs
index c14c0a7..a51b846 100644
--- a/axis.hs
+++ b/axis.hs
@@ -15,7 +15,7 @@ import Graphics.UI.SDL.Keysym as SDL.Keysym
 import Graphics.UI.SDL.Primitives as SDL.Primitive
 import Data.Int (Int16)
 import qualified System.Exit as Exit
-import Data.List (elemIndex, elemIndices)
+import Data.List (elemIndex, elemIndices, filter)
 import GHC.Word
 import Data.Bits
 
@@ -35,18 +35,11 @@ netwireIsCool =
 smartShowPitch p = showPitch p -- TODO: use flat for Eb, Bb; use unicode flat/sharp chars
 
 _USE_HEXAGONS = False
-
-_drawHexircle f v x y s c =
-  if _USE_HEXAGONS
-  then _drawHexagonSDL f v x y s c
-  else (if f then SDL.Primitive.filledCircle else SDL.Primitive.circle) v x y (s * 7 `div` 9) c
-
-drawHexircle  = _drawHexircle False
-drawFilledHexircle = _drawHexircle True
+_COLORIZE_BY_CHANNEL = False
 
 _AXIS_ROWS = 7 + 4
 _AXIS_UNIQUE_COLS = 7
-_AXIS_COLS_REPEAT = 1
+_AXIS_COLS_REPEAT = 2
 _AXIS_TOP_PITCH = 81 + (7 * (_AXIS_ROWS - 7) `div` 2)
 _AXIS_BOTTOM_PITCH = 81 - (7 * _AXIS_ROWS) - 3
 
@@ -54,8 +47,39 @@ _KEY_COLOR = (SDL.Color 0 0 255)
 _KEY_BG_COLOR = (SDL.Color 0 0 0)
 _KEY_TEXT_COLOR = (SDL.Color 128 128 0)
 
-_KEY_COLOR_PIXEL = let (SDL.Color r g b) = _KEY_COLOR in (rgbColor r g b)
-_KEY_BG_COLOR_PIXEL = let (SDL.Color r g b) = _KEY_BG_COLOR in (rgbColor r g b)
+_KEY_COLOR_PIXEL = colorToPixel _KEY_COLOR
+_KEY_BG_COLOR_PIXEL = colorToPixel _KEY_BG_COLOR
+
+{-
+http://en.wikipedia.org/wiki/Enhanced_Graphics_Adapter
+ 0 – black                      (#000000) 000000  0
+ 1 – blue                       (#0000AA) 000001  1
+ 2 – green                      (#00AA00) 000010  2
+ 3 – cyan                       (#00AAAA) 000011  3
+ 4 – red                        (#AA0000) 000100  4
+ 5 – magenta                    (#AA00AA) 000101  5
+ 6 – brown                      (#AA5500) 010100  20
+ 7 – white / light gray         (#AAAAAA) 000111  7
+ 8 – dark gray / bright black   (#555555) 111000  56
+ 9 – bright blue                (#5555FF) 111001  57
+10 – bright green               (#55FF55) 111010  58
+11 – bright cyan                (#55FFFF) 111011  59
+12 – bright red                 (#FF5555) 111100  60
+13 – bright magenta             (#FF55FF) 111101  61
+14 – bright yellow              (#FFFF55) 111110  62
+15 – bright white               (#FFFFFF) 111111  63
+-}
+
+_CGA = [(SDL.Color 0x00 0x00 0x00), (SDL.Color 0x00 0x00 0xAA), (SDL.Color 0x00 0xAA 0x00), (SDL.Color 0x00 0xAA 0xAA), (SDL.Color 0xAA 0x00 0x00), (SDL.Color 0xAA 0x00 0xAA), (SDL.Color 0xAA 0x55 0x00), (SDL.Color 0xAA 0xAA 0xAA), (SDL.Color 0x55 0x55 0x55), (SDL.Color 0x55 0x55 0xFF), (SDL.Color 0x55 0xFF 0x55), (SDL.Color 0x55 0xFF 0xFF), (SDL.Color 0xFF 0x55 0x55), (SDL.Color 0xFF 0x55 0xFF), (SDL.Color 0xFF 0xFF 0x55), (SDL.Color 0xFF 0xFF 0xFF)]
+
+_drawHexircle f v x y s c =
+  if _USE_HEXAGONS
+  then _drawHexagonSDL f v x y s c
+  else (if f then SDL.Primitive.filledCircle else SDL.Primitive.circle) v x y (s * 7 `div` 9) c
+
+drawHexircle  = _drawHexircle False
+drawFilledHexircle = _drawHexircle True
+colorToPixel x = let (SDL.Color r g b) = x in rgbColor r g b
 
 drawKeys pitches videoSurface font axis_key_locations axis_key_size = do
 
@@ -68,14 +92,27 @@ drawKeys pitches videoSurface font axis_key_locations axis_key_size = do
 reallyEraseKeys = eraseKeys_ True
 eraseKeys = eraseKeys_ False
 
+
 smartDrawKeys really drawSet eraseSet videoSurface font axis_key_locations axis_key_size = do
 
   let drawList  = map (\ (_, n) -> unPitch n) $ Set.toList drawSet
-  let eraseList = map (\ (_, n) -> unPitch n) $ Set.toList eraseSet
+  let eraseList = map (\ (_, n) -> unPitch n) $ filter (\ (c, _) -> unChannel c /= 9) $ Set.toList eraseSet
 
-  drawKeys           drawList videoSurface font axis_key_locations axis_key_size
   eraseKeys_ really eraseList videoSurface font axis_key_locations axis_key_size
 
+  forM_ (Set.toList drawSet) $ \ (c, n) -> do
+    let pitch = unPitch n
+    let chann = unChannel c
+    let color = if _COLORIZE_BY_CHANNEL
+                then _CGA !! (((fromIntegral chann) + 2) `mod` 16)
+                else _KEY_COLOR
+    Control.Monad.when(chann /= 9) $ -- TODO: do this elsewhere
+      forM_ (elemIndices pitch pitchIndex) $ \idx -> do
+        let (x, y) = axis_key_locations !! idx
+        drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) (colorToPixel color)
+        drawHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_COLOR_PIXEL
+        centerText videoSurface x y font _KEY_TEXT_COLOR color (smartShowPitch pitch)
+
 eraseKeys_ really pitches videoSurface font axis_key_locations axis_key_size = do
 
   forM_ pitches $ \pitch -> do