module Commons where import Affection 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) w = V2 nnx nny where nnx | nx > 800 + half = nx - (800 + w) | nx < -half = nx + 800 + w | otherwise = nx nny | ny > 600 + half = ny - (600 + w) | ny < -half = ny + 600 + w | otherwise = ny half = w / 2 newHaskelloids :: Image -> Affection [Haskelloid] newHaskelloids img = do liftIO $ mapM (\_ -> do d <- randomRIO (1, 2) (posx, posy) <- getCoordinates d velx <- randomRIO (-10, 10) vely <- randomRIO (-10, 10) rot <- randomRIO (-180, 180) pitch <- randomRIO (-pi, pi) return $ Haskelloid (V2 posx posy) (V2 velx vely) rot pitch d img ) ([1..10] :: [Int]) where getCoordinates d = do posx <- randomRIO (0, 800) posy <- randomRIO (0, 600) if distance (V2 posx posy) (V2 400 300) < 20 + (50 / fromIntegral d) then getCoordinates d else return (posx, posy) 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 :: Context -> Haskelloid -> Affection () drawHaskelloid ctx (Haskelloid pos _ rot _ d img) = do liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 1 where dim = fmap (/ fromIntegral d) (V2 100 100)