From 0693006606d8e14754effcce75787014433117d6 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Fri, 17 Jan 2014 10:42:14 -0500 Subject: press 'c' to erase all key borders; they come back after notes are played --- axis.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'axis.hs') diff --git a/axis.hs b/axis.hs index 00e6998..a17df54 100644 --- a/axis.hs +++ b/axis.hs @@ -34,7 +34,7 @@ netwireIsCool = smartShowPitch p = showPitch p -- TODO: use flat for Eb, Bb; use unicode flat/sharp chars -_USE_HEXAGONS = True +_USE_HEXAGONS = False _drawHexircle f v x y s c = if _USE_HEXAGONS @@ -65,14 +65,17 @@ drawKeys pitches videoSurface font axis_key_locations axis_key_size = do drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_COLOR_PIXEL centerText videoSurface x y font _KEY_TEXT_COLOR _KEY_COLOR (smartShowPitch pitch) -eraseKeys pitches videoSurface font axis_key_locations axis_key_size = do +reallyEraseKeys = eraseKeys_ True +eraseKeys = eraseKeys_ False + +eraseKeys_ really pitches videoSurface font axis_key_locations axis_key_size = do forM_ pitches $ \pitch -> do forM_ (elemIndices pitch pitchIndex) $ \idx -> do let (x, y) = axis_key_locations !! idx drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_BG_COLOR_PIXEL - drawHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) _KEY_COLOR_PIXEL - centerText videoSurface x y font _KEY_TEXT_COLOR _KEY_BG_COLOR (smartShowPitch pitch) + drawHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) (if really then _KEY_BG_COLOR_PIXEL else _KEY_COLOR_PIXEL) +-- centerText videoSurface x y font _KEY_TEXT_COLOR _KEY_BG_COLOR (smartShowPitch pitch) fi = fromIntegral 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 = let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect let _ALL_PITCHES = [_AXIS_BOTTOM_PITCH .. _AXIS_TOP_PITCH] - let allKeysOFF = eraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size + let allKeysOFF = eraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size + allKeysReallyOFF = reallyEraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size allKeysOFF putStrLn "Initialized." @@ -137,6 +141,7 @@ main = return () Control.Monad.when (keysDown' /= keysDown && keyDown SDL.SDLK_BACKSPACE keysDown') allKeysOFF + Control.Monad.when (keysDown' /= keysDown && keyDown SDL.SDLK_c keysDown') allKeysReallyOFF -- Control.Monad.when (keysDown' /= keysDown) $ do -- let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown' -- cgit v1.2.3