From f619a4c584fe6c21c234b05487e9f2259e12d4a0 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 17 Jan 2014 03:13:01 -0500
Subject: moving toward hilighting axis keys

---
 axis.hs | 39 +++++++++++++++++++++------------------
 1 file changed, 21 insertions(+), 18 deletions(-)

(limited to 'axis.hs')

diff --git a/axis.hs b/axis.hs
index d6a76a6..a31199e 100644
--- a/axis.hs
+++ b/axis.hs
@@ -48,11 +48,20 @@ main =
   _ <- SDL.showCursor False
   _ <- SDL.grabInput True
   warpMouse
+
+  let pixelFormat = SDL.surfaceGetPixelFormat videoSurface
+  blue <- SDL.mapRGB pixelFormat 0 255 255 -- why is it blue???
   -- _ <- SDL.setRelativeMouseMode True -- SDL2.  Should I use it?
 
   let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect
-  print getKeyLocationsAbs
-  print axis_key_locations
+
+  forM_ axis_key_locations $ \(x, y) -> do
+    --SDL.Primitive.filledCircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return
+    drawHexagonSDL videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return
+
+  forM_ [0 .. length axis_key_locations - 1] $ \i -> do
+    let (centerx, centery) = axis_key_locations !! i
+    centerText videoSurface centerx centery font (show i)
 
   putStrLn "Initialized."
 
@@ -81,22 +90,15 @@ main =
         textBand videoSurface videoClipRect (SDL.Rect 0 280 0 70) font $
           if keyDown SDL.SDLK_a keysDown' then "arpeggiate" else ""
 
-        mouse <- SDL.getRelativeMouseState
-        let (x, y, button) = mouse
-        textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font ((show x) ++ " " ++ (show y) ++ " " ++ (show button))
-        Control.Monad.when (x /= 0 || y /= 0) warpMouse
+        Control.Monad.when(False) $ do
 
-        let pixelFormat = SDL.surfaceGetPixelFormat videoSurface
-        blue <- SDL.mapRGB pixelFormat 0 255 255 -- why is it blue???
-        forM_ axis_key_locations $ \(x, y) -> do
-          --SDL.Primitive.filledCircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return
-          drawHexagonSDL videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return
+          mouse <- SDL.getRelativeMouseState
+          let (x, y, button) = mouse
+          let text = ((show x) ++ " " ++ (show y) ++ " " ++ (show button))
+          textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font text
+          Control.Monad.when (x /= 0 || y /= 0) warpMouse
 
-        forM_ [0 .. length axis_key_locations - 1] $ \i -> do
-          let (centerx, centery) = axis_key_locations !! i
-          centerText videoSurface centerx centery font (show i)
-
-        _ <- SDL.updateRect videoSurface videoClipRect -- draw it all!
+        _ <- SDL.updateRect videoSurface videoClipRect -- draw it all!  probably a bad idea
 
         let framerate = 30
         let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds)
@@ -106,6 +108,8 @@ main =
 
   loop Set.empty Set.empty clockSession_ netwireIsCool ""
 
+zipzip ls = if (head ls) == [] then [] else (map head ls) : (zipzip $ map tail ls)
+
 drawHexagonSDL videoSurface centerx centery radius pixel = do
   let r = fromIntegral radius
 --let points = map (\(x, y) -> (centerx + x + radius `div` 2, centery + y + radius `div` 2)) $
@@ -124,7 +128,6 @@ centerText videoSurface x y font text = do
 --_ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) + w) (fromIntegral(y) + h `div` 2) w h))
   return ()
 
-
 getKeyLocations (SDL.Rect offx offy totalw totalh) =
   let (key_height, key_width, xys) = getKeyLocationsAbs
 
@@ -150,7 +153,7 @@ getKeyLocations (SDL.Rect offx offy totalw totalh) =
       centerx = (screenw - keyboard_width * scale) / 2
       centery = (screenh - keyboard_height * scale) / 2
     in
-      (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat xys)
+      (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat $ zipzip xys)
 
 getKeyLocationsAbs =
   let kb_rows = 7 :: Double
-- 
cgit v1.2.3