haskelloids/src/Commons.hs
2017-12-20 02:00:28 +01:00

123 lines
3 KiB
Haskell

{-# LANGUAGE RecordWildCards #-}
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)
import NanoVG as N hiding (V2(..))
import Linear as L hiding (rotate)
import Foreign.C.Types (CFloat(..))
import Types
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)
where
nnx
| nx > 800 + half = nx - (800 + width)
| nx < -half = nx + 800 + width
| otherwise = nx
nny
| ny > 600 + half = ny - (600 + width)
| ny < -half = ny + 600 + width
| otherwise = ny
half = width / 2
newHaskelloids :: Affection UserData [Haskelloid]
newHaskelloids = do
img <- haskImage <$> getAffection
liftIO $ mapM (\_ -> do
posx <- randomRIO (0, 800)
posy <- randomRIO (0, 600)
velx <- randomRIO (-10, 10)
vely <- randomRIO (-10, 10)
rot <- randomRIO (-180, 180)
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 dsec has =
has
{ hPos = wrapAround
(hPos has + hVel has * V2 sec sec)
(100 / fromIntegral (hDiv has))
, hRot = hRot has + hPitch has * sec
}
where
sec = realToFrac dsec
clamp :: Ord a => a -> a -> a -> a
clamp a' low up
| a' < low = low
| a' > up = up
| otherwise = a'
drawImage :: Context -> Image -> V2 Float -> V2 Float -> Float -> Float -> IO ()
drawImage ctx img pos dim rot alpha = do
let (V2 x y) = fmap CFloat pos
(V2 w h) = fmap CFloat dim
save ctx
translate ctx (x + (w/2)) (y + (h/2))
rotate ctx (degToRad $ CFloat rot)
translate ctx (-(w/2)) (-(h/2))
sPaint <- imagePattern ctx 0 0 w h 0 img (CFloat alpha)
beginPath ctx
rect ctx 0 0 w h
fillPaint ctx sPaint
fill ctx
resetTransform ctx
restore ctx
drawSpinner :: Context -> Float -> Float -> Float -> Float -> IO ()
drawSpinner ctx x y cr ct = do
let a0 = 0+t*6
a1 = pi + t*6
r0 = r
r1 = r*0.75
(cx, cy) = (CFloat x, CFloat y)
r = CFloat cr
t = CFloat ct
save ctx
beginPath ctx
arc ctx cx cy r0 a0 a1 CW
arc ctx cx cy r1 a1 a0 CCW
closePath ctx
let ax = cx+cos a0 * (r0+r1)*0.5
ay = cy+sin a0 * (r0+r1)*0.5
bx = cx+cos a1 * (r0+r1)*0.5
by = cy+sin a1 * (r0+r1)*0.5
paint <- linearGradient ctx ax ay bx by (rgba 255 255 255 0) (rgba 255 255 255 128)
fillPaint ctx paint
fill ctx
restore ctx
drawHaskelloid :: Haskelloid -> Affection UserData ()
drawHaskelloid (Haskelloid pos _ rot _ div img) = do
ctx <- nano <$> getAffection
liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 255
where
dim = (fmap (/ fromIntegral div) (V2 100 100))