allow live-toggle of axis display size

press 2 for the mirrored version, 1 for unmirrored

1 files changed, 21 insertions, 18 deletions

diff --git a/axis.hs b/axis.hs
index d9a3860..fe8a2e6 100644
--- a/axis.hs
+++ b/axis.hs
@@ -41,7 +41,7 @@ _LABEL_ALL_KEYS = False
 
 _AXIS_ROWS = 7 + 4
 _AXIS_UNIQUE_COLS = 7
-_AXIS_COLS_REPEAT = 2
+_AXIS_COLS_REPEAT = 1
 _AXIS_TOPLEFT_PITCH = 81 + (7 * (_AXIS_ROWS - 7) `div` 2)
 _AXIS_BOTTOMLEFT_PITCH = _AXIS_TOPLEFT_PITCH - (_AXIS_ROWS * 7)
 _AXIS_TOPRIGHT_PITCH = _AXIS_TOPLEFT_PITCH + _AXIS_UNIQUE_COLS `div` 2
@@ -116,8 +116,8 @@ pitchToColor p =
     x | inMajorC x -> (SDL.Color 0xE0 0xE0 0xE0) -- _CGA !! 7
     _ -> _CGA !! 8
 
-smartDrawKeys :: (Integral a, Integral a2, Integral a1) => Bool -> Set.Set (Event.Channel, Event.Pitch) -> Set.Set (Event.Channel, Event.Pitch) -> SDL.Surface -> SDL.TTF.Font -> [(a1, a2)] -> a -> IO ()
-smartDrawKeys reallyErase beforeKeys_ nowKeys_ videoSurface font axis_key_locations axis_key_size = do
+--smartDrawKeys :: (Integral a, Integral a2, Integral a1) => Bool -> Set.Set (Event.Channel, Event.Pitch) -> Set.Set (Event.Channel, Event.Pitch) -> SDL.Surface -> SDL.TTF.Font -> [(a1, a2)] -> a -> IO ()
+smartDrawKeys colsRepeat reallyErase beforeKeys_ nowKeys_ videoSurface font axis_key_locations axis_key_size = do
   let
       chanfilter = Set.filter (\ (c, _) -> c /= (Event.Channel 9))
       beforeKeys = chanfilter beforeKeys_
@@ -130,7 +130,7 @@ smartDrawKeys reallyErase beforeKeys_ nowKeys_ videoSurface font axis_key_locati
   forM_ actions $ \ (n, chans) -> do
     let text = smartShowPitch (unPitch n)
         pitch = unPitch n
-    forM_ (elemIndices pitch pitchIndex) $ \idx -> do
+    forM_ (elemIndices pitch $ pitchIndex colsRepeat) $ \idx -> do
       let showLabel = (not reallyErase) && (_LABEL_ALL_KEYS || (_LABEL_WHILE_PLAYING && (length chans /= 0)))
       drawKey idx videoSurface font axis_key_locations axis_key_size
         (if reallyErase then _KB_BG_COLOR else pitchToColor pitch)
@@ -167,7 +167,8 @@ rgbColor r g b = SDL.Pixel (shiftL (fi r) 24 .|. shiftL (fi g) 16 .|. shiftL (fi
 chooseFontSize h w = 30 * d `div` 1024 where d = min h w
 
 data LoopState = LoopState {
-  firstLoop :: Bool
+  firstLoop :: Bool,
+  repeatCols :: Integer
 } deriving (Show)
 
 main =
@@ -200,14 +201,16 @@ main =
 
   let parseAlsa keysDown = parseAlsaEvents h keysDown (forwardNoteEvent h q publicAddr)
   let loop state midiKeysDown keysDown resolution font s w x = do
-        let (LoopState firstLoop) = state
+        let (LoopState firstLoop colsRepeat) = state
 
         (keysDown', resolution') <- parseSDLEvents keysDown resolution
         midiKeysDown' <- parseAlsa midiKeysDown
         (ds, s') <- stepSession s
         (ex, w') <- stepWire w ds (Right x)
         let x' = either (const "") id ex
-        let restartVideo = resolution' /= resolution
+        let colsRepeat' = if (keyDown SDL.SDLK_1 keysDown') then 1 else if (keyDown SDL.SDLK_2 keysDown') then 2 else colsRepeat
+
+        let restartVideo = resolution' /= resolution || colsRepeat' /= colsRepeat
 
         Control.Monad.when restartVideo $ do
           let (w, h) = resolution'
@@ -220,10 +223,10 @@ main =
 
         videoSurface <- SDL.getVideoSurface
         videoClipRect <- SDL.getClipRect videoSurface
-        let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect
+        let (axis_key_size, axis_key_locations) = getKeyLocations colsRepeat' videoClipRect
 
         let _ALL_PITCHES = Set.fromList $ map (\p -> (Event.Channel 1, Event.Pitch p)) [_AXIS_BOTTOMLEFT_PITCH .. _AXIS_TOPRIGHT_PITCH]
-            keysOFF really = smartDrawKeys really _ALL_PITCHES Set.empty videoSurface font' axis_key_locations axis_key_size
+            keysOFF really = smartDrawKeys colsRepeat' really _ALL_PITCHES Set.empty videoSurface font' axis_key_locations axis_key_size
             allKeysOFF =  keysOFF False
             allKeysReallyOFF = keysOFF True
 
@@ -239,12 +242,12 @@ main =
 --        let chord = show $ map (\i->elemIndices i pitchIndex) $ pitchList midiKeysDown'
 --        textBand videoSurface videoClipRect (SDL.Rect 0 70 0 70) font chord
 
-          smartDrawKeys False midiKeysDown midiKeysDown' videoSurface font' axis_key_locations axis_key_size
+          smartDrawKeys colsRepeat' False midiKeysDown midiKeysDown' videoSurface font' axis_key_locations axis_key_size
           return ()
 
         Control.Monad.when (restartVideo) $ do
           allKeysOFF
-          smartDrawKeys False Set.empty midiKeysDown' videoSurface font' axis_key_locations axis_key_size
+          smartDrawKeys colsRepeat' False Set.empty midiKeysDown' videoSurface font' axis_key_locations axis_key_size
           return ()
 
         Control.Monad.when (keysDown' /= keysDown) $ do
@@ -272,9 +275,9 @@ main =
         let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds)
         SDL.delay (delay)
         Control.Monad.when (not $ keyDown SDL.SDLK_ESCAPE keysDown) $
-          loop (LoopState False) midiKeysDown' keysDown' resolution' font' s' w' x'
+          loop (LoopState False colsRepeat') midiKeysDown' keysDown' resolution' font' s' w' x'
 
-  loop (LoopState True) Set.empty Set.empty (sWidth, sHeight) font clockSession_ netwireIsCool ""
+  loop (LoopState True _AXIS_COLS_REPEAT) Set.empty Set.empty (sWidth, sHeight) font clockSession_ netwireIsCool ""
 
 zipzip ls = if (head ls) == [] then [] else (map head ls) : (zipzip $ map tail ls)
 
@@ -297,14 +300,14 @@ centerText videoSurface x y font fgColor bgColor text = do
   _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) - w `div` 2) (fromIntegral(y) - h `div` 2) w h))
   return ()
 
-pitchIndex = concat $ map (\x -> unique) [0 .. _AXIS_COLS_REPEAT - 1]
+pitchIndex colsRepeat = concat $ map (\x -> unique) [0 .. colsRepeat - 1]
   where
     toprow = map (\i -> if (i `mod` 2) == 0 then (_AXIS_TOPLEFT_PITCH + i `div` 2) else (_AXIS_TOPLEFT_PITCH - 3 + i `div` 2)) [0 .. _AXIS_UNIQUE_COLS - 1]
     colfrom top = map (+ top) $ map (* (-7)) [0 .. _AXIS_ROWS - 1]
     unique = concat $ map colfrom toprow
 
-getKeyLocations (SDL.Rect offx offy totalw totalh) =
-  let (key_height, key_width, xys) = getKeyLocationsAbs
+getKeyLocations colsRepeat (SDL.Rect offx offy totalw totalh) =
+  let (key_height, key_width, xys) = getKeyLocationsAbs colsRepeat
 
       screenw = fromIntegral(totalw)
       screenh = fromIntegral(totalh)
@@ -330,9 +333,9 @@ getKeyLocations (SDL.Rect offx offy totalw totalh) =
     in
       (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat $ zipzip xys)
 
-getKeyLocationsAbs =
+getKeyLocationsAbs colsRepeat =
   let kb_rows = (fromIntegral _AXIS_ROWS) :: Double
-      kb_cols = _AXIS_COLS_REPEAT * (fromIntegral _AXIS_UNIQUE_COLS) :: Double
+      kb_cols = (fromIntegral colsRepeat) * (fromIntegral _AXIS_UNIQUE_COLS) :: Double
       -- the edges of the hexagon are equal in length to its "radius"
       -- if the radius is 1, then horizontal movement is 1.5 and vertical movement is sqrt(3) from one center to the next
       -- or else it is 2*sqrt(3) to move down