hunting warnings

This commit is contained in:
nek0 2017-12-22 09:01:07 +01:00
parent 248043ba24
commit 8104c636cd
7 changed files with 22 additions and 42 deletions

View file

@ -1,13 +1,7 @@
module Commons where module Commons where
import Affection 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 Control.Monad.IO.Class (liftIO)
import System.Random (randomRIO) import System.Random (randomRIO)
@ -24,25 +18,25 @@ toR :: Double -> Double
toR deg = deg * pi / 180 toR deg = deg * pi / 180
wrapAround :: (Fractional t, Ord t, Num t) => V2 t -> t -> V2 t 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 where
nnx nnx
| nx > 800 + half = nx - (800 + width) | nx > 800 + half = nx - (800 + w)
| nx < -half = nx + 800 + width | nx < -half = nx + 800 + w
| otherwise = nx | otherwise = nx
nny nny
| ny > 600 + half = ny - (600 + width) | ny > 600 + half = ny - (600 + w)
| ny < -half = ny + 600 + width | ny < -half = ny + 600 + w
| otherwise = ny | otherwise = ny
half = width / 2 half = w / 2
newHaskelloids :: Affection UserData [Haskelloid] newHaskelloids :: Affection UserData [Haskelloid]
newHaskelloids = newHaskelloids =
do do
img <- haskImage <$> getAffection img <- haskImage <$> getAffection
liftIO $ mapM (\_ -> do liftIO $ mapM (\_ -> do
div <- randomRIO (1, 2) d <- randomRIO (1, 2)
(posx, posy) <- getCoordinates div (posx, posy) <- getCoordinates d
velx <- randomRIO (-10, 10) velx <- randomRIO (-10, 10)
vely <- randomRIO (-10, 10) vely <- randomRIO (-10, 10)
rot <- randomRIO (-180, 180) rot <- randomRIO (-180, 180)
@ -52,15 +46,15 @@ newHaskelloids =
(V2 velx vely) (V2 velx vely)
rot rot
pitch pitch
div d
img img
) [1..10] ) ([1..10] :: [Int])
where where
getCoordinates div = do getCoordinates d = do
posx <- randomRIO (0, 800) posx <- randomRIO (0, 800)
posy <- randomRIO (0, 600) posy <- randomRIO (0, 600)
if distance (V2 posx posy) (V2 400 300) < 20 + (50 / fromIntegral div) if distance (V2 posx posy) (V2 400 300) < 20 + (50 / fromIntegral d)
then getCoordinates div then getCoordinates d
else return (posx, posy) else return (posx, posy)
updateHaskelloid :: Double -> Haskelloid -> Haskelloid updateHaskelloid :: Double -> Haskelloid -> Haskelloid
@ -120,8 +114,8 @@ drawSpinner ctx x y cr ct = do
restore ctx restore ctx
drawHaskelloid :: Haskelloid -> Affection UserData () drawHaskelloid :: Haskelloid -> Affection UserData ()
drawHaskelloid (Haskelloid pos _ rot _ div img) = do drawHaskelloid (Haskelloid pos _ rot _ d img) = do
ctx <- nano <$> getAffection ctx <- nano <$> getAffection
liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 255 liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 255
where where
dim = fmap (/ fromIntegral div) (V2 100 100) dim = fmap (/ fromIntegral d) (V2 100 100)

View file

@ -221,7 +221,7 @@ drawWonLost wl = do
let color = case wl of let color = case wl of
Won -> rgba 128 255 0 255 Won -> rgba 128 255 0 255
Lost -> rgba 255 128 0 255 Lost -> rgba 255 128 0 255
text = case wl of textStr = case wl of
Won -> "YOU WON!" Won -> "YOU WON!"
Lost -> "YOU LOsT!" Lost -> "YOU LOsT!"
save ctx save ctx
@ -229,7 +229,7 @@ drawWonLost wl = do
fontFace ctx "modulo" fontFace ctx "modulo"
textAlign ctx (S.fromList [AlignCenter,AlignTop]) textAlign ctx (S.fromList [AlignCenter,AlignTop])
fillColor ctx (rgba 255 255 255 255) fillColor ctx (rgba 255 255 255 255)
textBox ctx 0 200 800 text textBox ctx 0 200 800 textStr
fillColor ctx color fillColor ctx color
fontSize ctx 40 fontSize ctx 40
textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again"

View file

@ -4,7 +4,6 @@ module Init where
import Affection as A import Affection as A
import SDL (($=)) import SDL (($=))
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -15,7 +14,6 @@ import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM import Control.Concurrent.STM
import System.Random
import System.Exit (exitFailure) import System.Exit (exitFailure)
import Linear import Linear
@ -77,4 +75,5 @@ load = do
, font = fromJust mfont , font = fromJust mfont
, subsystems = subs , subsystems = subs
, haskImage = fromJust mhaskImage , haskImage = fromJust mhaskImage
, stateUUIDs = UUIDClean [] []
} }

View file

@ -6,8 +6,6 @@ import SDL (($=))
import qualified SDL import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import qualified Data.Map as M
import Linear as L import Linear as L
import NanoVG hiding (V2(..), V4(..)) import NanoVG hiding (V2(..), V4(..))
@ -18,7 +16,6 @@ import Control.Monad.IO.Class (liftIO)
-- internal imports -- internal imports
import Types import Types
import Commons
import StateMachine () import StateMachine ()
import Init import Init
@ -51,8 +48,8 @@ pre = do
_ <- partSubscribe (subWindow subs) $ \msg -> case msg of _ <- partSubscribe (subWindow subs) $ \msg -> case msg of
MsgWindowResize _ _ (V2 w h) -> do MsgWindowResize _ _ (V2 w h) -> do
liftIO $ logIO A.Debug "Window has been resized" liftIO $ logIO A.Debug "Window has been resized"
let nw = floor $ fromIntegral h * (800/600) let nw = floor $ (fromIntegral h * (800/600) :: Double)
dw = floor $ (fromIntegral w - fromIntegral nw) / 2 dw = floor $ ((fromIntegral w - fromIntegral nw) / 2 :: Double)
GL.viewport $= (GL.Position dw 0, GL.Size nw h) GL.viewport $= (GL.Position dw 0, GL.Size nw h)
_ -> return () _ -> return ()
_ <- partSubscribe (subKeyboard subs) $ \kbdev -> _ <- partSubscribe (subKeyboard subs) $ \kbdev ->

View file

@ -3,21 +3,12 @@ module Menu where
import Affection as A import Affection as A
import qualified SDL import qualified SDL
import Debug.Trace
import Data.Maybe
import qualified Data.Set as S import qualified Data.Set as S
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M import NanoVG
import NanoVG hiding (V2(..), V4(..))
import Linear
import Foreign.C.Types
-- internal imports -- internal imports

View file

@ -1,3 +1,4 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
module StateMachine where module StateMachine where

View file

@ -3,7 +3,6 @@
module Types where module Types where
import Affection import Affection
import qualified SDL
import NanoVG hiding (V2(..)) import NanoVG hiding (V2(..))
import Linear import Linear
@ -16,7 +15,6 @@ data UserData = UserData
, shots :: [Pew] , shots :: [Pew]
-- , debris :: ParticleSystem -- , debris :: ParticleSystem
, wonlost :: Maybe WonLost , wonlost :: Maybe WonLost
, pixelSize :: Int
, state :: State , state :: State
, fade :: MenuFade , fade :: MenuFade
, nano :: Context , nano :: Context