diff options
-rw-r--r-- | axis.hs | 15 |
1 files changed, 10 insertions, 5 deletions
@@ -34,7 +34,7 @@ netwireIsCool = | |||
34 | 34 | ||
35 | smartShowPitch p = showPitch p -- TODO: use flat for Eb, Bb; use unicode flat/sharp chars | 35 | smartShowPitch p = showPitch p -- TODO: use flat for Eb, Bb; use unicode flat/sharp chars |
36 | 36 | ||
37 | _USE_HEXAGONS = True | 37 | _USE_HEXAGONS = False |
38 | 38 | ||
39 | _drawHexircle f v x y s c = | 39 | _drawHexircle f v x y s c = |
40 | if _USE_HEXAGONS | 40 | if _USE_HEXAGONS |
@@ -65,14 +65,17 @@ drawKeys pitches videoSurface font axis_key_locations axis_key_size = do | |||
65 | drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_COLOR_PIXEL | 65 | drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_COLOR_PIXEL |
66 | centerText videoSurface x y font _KEY_TEXT_COLOR _KEY_COLOR (smartShowPitch pitch) | 66 | centerText videoSurface x y font _KEY_TEXT_COLOR _KEY_COLOR (smartShowPitch pitch) |
67 | 67 | ||
68 | eraseKeys pitches videoSurface font axis_key_locations axis_key_size = do | 68 | reallyEraseKeys = eraseKeys_ True |
69 | eraseKeys = eraseKeys_ False | ||
70 | |||
71 | eraseKeys_ really pitches videoSurface font axis_key_locations axis_key_size = do | ||
69 | 72 | ||
70 | forM_ pitches $ \pitch -> do | 73 | forM_ pitches $ \pitch -> do |
71 | forM_ (elemIndices pitch pitchIndex) $ \idx -> do | 74 | forM_ (elemIndices pitch pitchIndex) $ \idx -> do |
72 | let (x, y) = axis_key_locations !! idx | 75 | let (x, y) = axis_key_locations !! idx |
73 | drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_BG_COLOR_PIXEL | 76 | drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_BG_COLOR_PIXEL |
74 | drawHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_COLOR_PIXEL | 77 | drawHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) (if really then _KEY_BG_COLOR_PIXEL else _KEY_COLOR_PIXEL) |
75 | centerText videoSurface x y font _KEY_TEXT_COLOR _KEY_BG_COLOR (smartShowPitch pitch) | 78 | -- centerText videoSurface x y font _KEY_TEXT_COLOR _KEY_BG_COLOR (smartShowPitch pitch) |
76 | 79 | ||
77 | fi = fromIntegral | 80 | fi = fromIntegral |
78 | rgbColor r g b = SDL.Pixel (shiftL (fi r) 24 .|. shiftL (fi g) 16 .|. shiftL (fi b) 8 .|. (fi 255)) | 81 | rgbColor r g b = SDL.Pixel (shiftL (fi r) 24 .|. shiftL (fi g) 16 .|. shiftL (fi b) 8 .|. (fi 255)) |
@@ -106,7 +109,8 @@ main = | |||
106 | let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect | 109 | let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect |
107 | 110 | ||
108 | let _ALL_PITCHES = [_AXIS_BOTTOM_PITCH .. _AXIS_TOP_PITCH] | 111 | let _ALL_PITCHES = [_AXIS_BOTTOM_PITCH .. _AXIS_TOP_PITCH] |
109 | let allKeysOFF = eraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size | 112 | let allKeysOFF = eraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size |
113 | allKeysReallyOFF = reallyEraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size | ||
110 | allKeysOFF | 114 | allKeysOFF |
111 | 115 | ||
112 | putStrLn "Initialized." | 116 | putStrLn "Initialized." |
@@ -137,6 +141,7 @@ main = | |||
137 | return () | 141 | return () |
138 | 142 | ||
139 | Control.Monad.when (keysDown' /= keysDown && keyDown SDL.SDLK_BACKSPACE keysDown') allKeysOFF | 143 | Control.Monad.when (keysDown' /= keysDown && keyDown SDL.SDLK_BACKSPACE keysDown') allKeysOFF |
144 | Control.Monad.when (keysDown' /= keysDown && keyDown SDL.SDLK_c keysDown') allKeysReallyOFF | ||
140 | 145 | ||
141 | -- Control.Monad.when (keysDown' /= keysDown) $ do | 146 | -- Control.Monad.when (keysDown' /= keysDown) $ do |
142 | -- let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown' | 147 | -- let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown' |