2017-01-03 16:34:37 +00:00
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
|
2016-12-31 16:01:24 +00:00
|
|
|
module Commons where
|
|
|
|
|
|
|
|
import Affection
|
|
|
|
import qualified SDL
|
|
|
|
|
|
|
|
import qualified Data.Map as M
|
2017-01-03 16:34:37 +00:00
|
|
|
import Data.List (delete)
|
2017-12-16 10:55:30 +00:00
|
|
|
import Data.Maybe (catMaybes, isJust)
|
2016-12-31 16:01:24 +00:00
|
|
|
|
2017-12-16 10:55:30 +00:00
|
|
|
import Control.Monad (foldM, unless, when)
|
2017-12-16 18:06:36 +00:00
|
|
|
import Control.Monad.IO.Class (liftIO)
|
2016-12-31 16:01:24 +00:00
|
|
|
|
|
|
|
import System.Random (randomRIO)
|
|
|
|
|
2017-12-16 18:06:36 +00:00
|
|
|
import NanoVG hiding (V2(..))
|
|
|
|
|
|
|
|
import Linear
|
2016-12-31 16:01:24 +00:00
|
|
|
|
|
|
|
import Types
|
|
|
|
|
|
|
|
toR :: Double -> Double
|
|
|
|
toR deg = deg * pi / 180
|
|
|
|
|
2017-01-03 16:34:37 +00:00
|
|
|
wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t)
|
|
|
|
wrapAround (nx, ny) width = (nnx, nny)
|
|
|
|
where
|
2017-01-03 18:36:01 +00:00
|
|
|
nnx
|
|
|
|
| nx > 800 = nx - (800 + width)
|
|
|
|
| nx < -width = nx + 800 + width
|
|
|
|
| otherwise = nx
|
|
|
|
nny
|
|
|
|
| ny > 600 = ny - (600 + width)
|
|
|
|
| ny < -width = ny + 600 + width
|
|
|
|
| otherwise = ny
|
2017-12-16 18:06:36 +00:00
|
|
|
|
|
|
|
newHaskelloids :: Image -> Affection UserData [Haskelloid]
|
|
|
|
newHaskelloids img = liftIO $ mapM (\_ -> do
|
|
|
|
posx <- randomRIO (0, 800)
|
|
|
|
posy <- randomRIO (0, 600)
|
|
|
|
velx <- randomRIO (-10, 10)
|
|
|
|
vely <- randomRIO (-10, 10)
|
|
|
|
rot <- randomRIO (0, 2*pi)
|
|
|
|
pitch <- randomRIO (-pi, pi)
|
|
|
|
div <- randomRIO (1, 2)
|
|
|
|
return $ Haskelloid
|
|
|
|
(V2 posx posy)
|
|
|
|
(V2 velx vely)
|
|
|
|
rot
|
|
|
|
pitch
|
|
|
|
div
|
|
|
|
img
|
|
|
|
) [1..10]
|
|
|
|
|
|
|
|
updateHaskelloid :: Double -> Haskelloid -> Haskelloid
|
|
|
|
updateHaskelloid sec has =
|
|
|
|
has
|
|
|
|
{ hPos = hPos has + hVel has * V2 sec sec
|
|
|
|
, hRot = hRot has + hPitch has * sec
|
|
|
|
}
|