a little cleaning

haskelloids.cabal

@@ -67,7 +67,7 @@ executable haskelloids
   
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.9 && <4.11
-                     , affection <= 0.0.0.8
+                     , affection <= 0.0.0.9
                      , sdl2 >= 2.1.3.1
                      , OpenGL
                      , containers

src/InGame.hs

@@ -33,12 +33,17 @@ pewTTL = 10
 dRot :: Float
 dRot = 150
 
-loadGame :: Affection UserData () -> Affection UserData () -> Affection UserData ()
+loadGame
+  :: Affection UserData ()
+  -> Affection UserData ()
+  -> Affection UserData ()
 loadGame stateChange clean = do
   liftIO $ logIO A.Debug "loading game"
   ud <- getAffection
   nhs <- newHaskelloids
-  kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange clean)
+  kid <- partSubscribe
+    (subKeyboard $ subsystems ud)
+    (handleGameKeys stateChange clean)
   putAffection ud
     { stateUUIDs = UUIDClean [] [kid]
     , haskelloids = nhs
@@ -53,11 +58,15 @@ loadGame stateChange clean = do
     , wonlost = Nothing
     }
 
-handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData ()
+handleGameKeys
-handleGameKeys stateChange clean kbdev = if (msgKbdKeyMotion kbdev == SDL.Pressed)
+  :: Affection UserData ()
+  -> Affection UserData ()
+  -> KeyboardMessage
+  -> Affection UserData ()
+handleGameKeys stateChange clean kbdev =
+  if (msgKbdKeyMotion kbdev == SDL.Pressed)
   then case SDL.keysymKeycode (msgKbdKeysym kbdev) of
     SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do
-      liftIO $ logIO A.Debug "PEW!"
       shoot
     SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do
       ud <- getAffection
@@ -68,13 +77,11 @@ handleGameKeys stateChange clean kbdev = if (msgKbdKeyMotion kbdev == SDL.Presse
       liftIO $ logIO A.Debug "Leave to Menu"
       stateChange
     SDL.KeycodeW -> accelShip dVel
-    -- SDL.KeycodeS -> accelShip (-dVel)
     SDL.KeycodeA -> rotateShip dRot
     SDL.KeycodeD -> rotateShip (-dRot)
     _ -> return ()
   else case SDL.keysymKeycode (msgKbdKeysym kbdev) of
     SDL.KeycodeW -> deThrust
-    -- SDL.KeycodeS -> deThrust
     SDL.KeycodeA -> deThrust
     SDL.KeycodeD -> deThrust
     _ -> return ()
@@ -161,12 +168,18 @@ checkShotDown :: Affection UserData ()
 checkShotDown =
   do
     ud <- getAffection
-    let shoots = shots ud
+    let pews = shots ud
         hasks = haskelloids ud
-        pairs = catMaybes $ concatMap (crossOut hasks) shoots
+        pairs = catMaybes $ concatMap (crossOut hasks) pews
         deadHasks = map fst pairs
-        nhask = foldl (\acc a -> filter (\x -> a /= x) acc) hasks deadHasks
+        nhask = foldl
-        npews = foldl (\acc a -> filter (\x -> a /= x) acc) shoots (map snd pairs)
+          (\acc a -> filter (\x -> a /= x) acc)
+          hasks
+          deadHasks
+        npews = foldl
+          (\acc a -> filter (\x -> a /= x) acc)
+          pews
+          (map snd pairs)
     children <- liftIO $ concat <$> mapM (\Haskelloid{..} -> do
       n1velx <- randomRIO (-10, 10)
       n1vely <- randomRIO (-10, 10)
@@ -257,10 +270,11 @@ drawShip Ship{..} = do
   ctx <- nano <$> getAffection
   liftIO $ do
     when (sThrust) $ do
-      let pos@(V2 px py) = fmap CFloat sPos - V2 0 10 `rotVec` CFloat sRot
+      let pos@(V2 px py) = fmap CFloat sPos - V2 0 10 `rotVec` cRot
-          V2 x1 y1 = pos - (V2 10 0 `rotVec` CFloat sRot)
+          V2 x1 y1 = pos - (V2 10 0 `rotVec` cRot)
-          V2 x2 y2 = pos + (V2 10 0 `rotVec` CFloat sRot)
+          V2 x2 y2 = pos + (V2 10 0 `rotVec` cRot)
-          V2 x3 y3 = pos - (V2 0 25 `rotVec` CFloat sRot)
+          V2 x3 y3 = pos - (V2 0 25 `rotVec` cRot)
+          cRot = CFloat sRot
       save ctx
       grad <- linearGradient ctx px py x3 y3 (rgba 255 128 0 255) (rgba 0 0 0 0)
       fillPaint ctx grad

src/Init.hs

@@ -67,6 +67,7 @@ load = do
       , sVel = V2 0 0
       , sRot = 0
       , sImg = fromJust mshipImage
+      , sThrust = False
       }
     , haskelloids = []
     , shots = []

src/Main.hs

@@ -2,9 +2,7 @@
 module Main where
 
 import Affection as A
-import SDL (($=))
 import qualified SDL
-import qualified Graphics.Rendering.OpenGL as GL
 
 import Linear as L
 
@@ -46,19 +44,7 @@ pre :: Affection UserData ()
 pre = do
   subs <- subsystems <$> getAffection
   liftIO $ logIO A.Debug "Setting global resize event listener"
-  _ <- partSubscribe (subWindow subs) $ \msg -> case msg of
+  _ <- partSubscribe (subWindow subs) (fitViewport (800/600))
-    MsgWindowResize _ _ (V2 w h) -> do
-      liftIO $ logIO A.Debug "Window has been resized"
-      if (fromIntegral w / fromIntegral h) > (800/600)
-      then do
-        let nw = floor (fromIntegral h * (800/600) :: Double)
-            dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double)
-        GL.viewport $= (GL.Position dw 0, GL.Size nw h)
-      else do
-        let nh = floor (fromIntegral w / (800/600) :: Double)
-            dh = floor ((fromIntegral h - fromIntegral nh) / 2 :: Double)
-        GL.viewport $= (GL.Position 0 dh, GL.Size w nh)
-    _ -> return ()
   _ <- partSubscribe (subKeyboard subs) $ \kbdev ->
     when (msgKbdKeyMotion kbdev == SDL.Pressed) $
       case SDL.keysymKeycode (msgKbdKeysym kbdev) of