From 4a95b04896f297019f6d62b6c46c67c9f31076c9 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Fri, 17 Jan 2014 16:43:40 -0500 Subject: keys have different colors depending on channel this is disabled by a constant, but it does work --- axis.hs | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 51 insertions(+), 14 deletions(-) (limited to 'axis.hs') 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 -- cgit v1.2.3