diff --git a/src/Commons.hs b/src/Commons.hs index dc50c21..937b051 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -1,13 +1,7 @@ module Commons where import Affection -import qualified SDL -import qualified Data.Map as M -import Data.List (delete) -import Data.Maybe (catMaybes, isJust) - -import Control.Monad (foldM, unless, when) import Control.Monad.IO.Class (liftIO) import System.Random (randomRIO) @@ -24,25 +18,25 @@ toR :: Double -> Double toR deg = deg * pi / 180 wrapAround :: (Fractional t, Ord t, Num t) => V2 t -> t -> V2 t -wrapAround (V2 nx ny) width = V2 nnx nny +wrapAround (V2 nx ny) w = V2 nnx nny where nnx - | nx > 800 + half = nx - (800 + width) - | nx < -half = nx + 800 + width + | nx > 800 + half = nx - (800 + w) + | nx < -half = nx + 800 + w | otherwise = nx nny - | ny > 600 + half = ny - (600 + width) - | ny < -half = ny + 600 + width + | ny > 600 + half = ny - (600 + w) + | ny < -half = ny + 600 + w | otherwise = ny - half = width / 2 + half = w / 2 newHaskelloids :: Affection UserData [Haskelloid] newHaskelloids = do img <- haskImage <$> getAffection liftIO $ mapM (\_ -> do - div <- randomRIO (1, 2) - (posx, posy) <- getCoordinates div + d <- randomRIO (1, 2) + (posx, posy) <- getCoordinates d velx <- randomRIO (-10, 10) vely <- randomRIO (-10, 10) rot <- randomRIO (-180, 180) @@ -52,15 +46,15 @@ newHaskelloids = (V2 velx vely) rot pitch - div + d img - ) [1..10] + ) ([1..10] :: [Int]) where - getCoordinates div = do + getCoordinates d = do posx <- randomRIO (0, 800) posy <- randomRIO (0, 600) - if distance (V2 posx posy) (V2 400 300) < 20 + (50 / fromIntegral div) - then getCoordinates div + if distance (V2 posx posy) (V2 400 300) < 20 + (50 / fromIntegral d) + then getCoordinates d else return (posx, posy) updateHaskelloid :: Double -> Haskelloid -> Haskelloid @@ -120,8 +114,8 @@ drawSpinner ctx x y cr ct = do restore ctx drawHaskelloid :: Haskelloid -> Affection UserData () -drawHaskelloid (Haskelloid pos _ rot _ div img) = do +drawHaskelloid (Haskelloid pos _ rot _ d img) = do ctx <- nano <$> getAffection liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 255 where - dim = fmap (/ fromIntegral div) (V2 100 100) + dim = fmap (/ fromIntegral d) (V2 100 100) diff --git a/src/InGame.hs b/src/InGame.hs index c7e14cc..d51d961 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -221,7 +221,7 @@ drawWonLost wl = do let color = case wl of Won -> rgba 128 255 0 255 Lost -> rgba 255 128 0 255 - text = case wl of + textStr = case wl of Won -> "YOU WON!" Lost -> "YOU LOsT!" save ctx @@ -229,7 +229,7 @@ drawWonLost wl = do fontFace ctx "modulo" textAlign ctx (S.fromList [AlignCenter,AlignTop]) fillColor ctx (rgba 255 255 255 255) - textBox ctx 0 200 800 text + textBox ctx 0 200 800 textStr fillColor ctx color fontSize ctx 40 textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" diff --git a/src/Init.hs b/src/Init.hs index 74b2cdf..83a3ea1 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -4,7 +4,6 @@ module Init where import Affection as A import SDL (($=)) -import qualified SDL import qualified Graphics.Rendering.OpenGL as GL @@ -15,7 +14,6 @@ import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Concurrent.STM -import System.Random import System.Exit (exitFailure) import Linear @@ -77,4 +75,5 @@ load = do , font = fromJust mfont , subsystems = subs , haskImage = fromJust mhaskImage + , stateUUIDs = UUIDClean [] [] } diff --git a/src/Main.hs b/src/Main.hs index 1107b74..6f8939f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,8 +6,6 @@ import SDL (($=)) import qualified SDL import qualified Graphics.Rendering.OpenGL as GL -import qualified Data.Map as M - import Linear as L import NanoVG hiding (V2(..), V4(..)) @@ -18,7 +16,6 @@ import Control.Monad.IO.Class (liftIO) -- internal imports import Types -import Commons import StateMachine () import Init @@ -51,8 +48,8 @@ pre = do _ <- partSubscribe (subWindow subs) $ \msg -> case msg of MsgWindowResize _ _ (V2 w h) -> do liftIO $ logIO A.Debug "Window has been resized" - let nw = floor $ fromIntegral h * (800/600) - dw = floor $ (fromIntegral w - fromIntegral nw) / 2 + 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) _ -> return () _ <- partSubscribe (subKeyboard subs) $ \kbdev -> diff --git a/src/Menu.hs b/src/Menu.hs index 201dbbe..4a3a127 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -3,21 +3,12 @@ module Menu where import Affection as A import qualified SDL -import Debug.Trace - -import Data.Maybe import qualified Data.Set as S import Control.Monad (when) import Control.Monad.IO.Class (liftIO) -import qualified Data.Map as M - -import NanoVG hiding (V2(..), V4(..)) - -import Linear - -import Foreign.C.Types +import NanoVG -- internal imports diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 946da7b..aa8618c 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE MultiParamTypeClasses #-} module StateMachine where diff --git a/src/Types.hs b/src/Types.hs index 36dd3c4..89aa877 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -3,7 +3,6 @@ module Types where import Affection -import qualified SDL import NanoVG hiding (V2(..)) import Linear @@ -16,7 +15,6 @@ data UserData = UserData , shots :: [Pew] -- , debris :: ParticleSystem , wonlost :: Maybe WonLost - , pixelSize :: Int , state :: State , fade :: MenuFade , nano :: Context