diff --git a/src/Commons.hs b/src/Commons.hs index 8544682..5bb86aa 100644 --- a/src/Commons.hs +++ b/src/Commons.hs @@ -14,17 +14,19 @@ import Control.Monad.IO.Class (liftIO) import System.Random (randomRIO) -import NanoVG hiding (V2(..)) +import NanoVG as N hiding (V2(..)) -import Linear +import Linear as L hiding (rotate) + +import Foreign.C.Types (CFloat(..)) import Types toR :: Double -> Double toR deg = deg * pi / 180 -wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) -wrapAround (nx, ny) width = (nnx, nny) +wrapAround :: (Ord t, Num t) => V2 t -> t -> V2 t +wrapAround (V2 nx ny) width = (V2 nnx nny) where nnx | nx > 800 = nx - (800 + width) @@ -41,7 +43,7 @@ newHaskelloids img = liftIO $ mapM (\_ -> do posy <- randomRIO (0, 600) velx <- randomRIO (-10, 10) vely <- randomRIO (-10, 10) - rot <- randomRIO (0, 2*pi) + rot <- randomRIO (-180, 180) pitch <- randomRIO (-pi, pi) div <- randomRIO (1, 2) return $ Haskelloid @@ -54,14 +56,59 @@ newHaskelloids img = liftIO $ mapM (\_ -> do ) [1..10] updateHaskelloid :: Double -> Haskelloid -> Haskelloid -updateHaskelloid sec has = +updateHaskelloid dsec has = has - { hPos = hPos has + hVel has * V2 sec sec + { 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 y + rotate ctx (degToRad $ CFloat rot) + 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 (/ fromIntegral div) (V2 100 100)) rot 255 diff --git a/src/Menu.hs b/src/Menu.hs index 1976332..3fe5be2 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -34,7 +34,7 @@ loadMenu = do liftIO $ logIO A.Debug "Loading Menu" ud <- getAffection mhaskImage <- liftIO $ - createImage (nano ud) (FileName "assets/haskelloid.svg") 0 + createImage (nano ud) (FileName "assets/haskelloid.png") 0 when (isNothing mhaskImage) $ liftIO $ logIO Error "Failed to load asset haskelloid" hs <- newHaskelloids (fromJust mhaskImage) @@ -76,37 +76,6 @@ updateMenu sec = do drawMenu :: Affection UserData () drawMenu = do ud <- getAffection - let V2 sx sy = fmap (CFloat . realToFrac) (sPos $ ship ud) - liftIO $ do - save (nano ud) - sPaint <- imagePattern (nano ud) 400 300 20 20 0 (sImg $ ship ud) 255 - beginPath (nano ud) - rect (nano ud) 400 300 20 20 - fillPaint (nano ud) sPaint - fill (nano ud) - restore (nano ud) - dt <- getElapsedTime - liftIO $ - drawSpinner (nano ud) 100 100 100 (CFloat $ realToFrac dt) - -drawSpinner :: Context -> CFloat -> CFloat -> CFloat -> CFloat -> IO () -drawSpinner vg cx cy r t = do - let a0 = 0+t*6 - a1 = pi + t*6 - r0 = r - r1 = r*0.75 - save vg - - beginPath vg - arc vg cx cy r0 a0 a1 CW - arc vg cx cy r1 a1 a0 CCW - closePath vg - 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 vg ax ay bx by (rgba 255 255 255 0) (rgba 255 255 255 128) - fillPaint vg paint - fill vg - - restore vg + mapM_ drawHaskelloid (haskelloids ud) + -- t <- getElapsedTime + -- liftIO $ drawSpinner (nano ud) 100 100 100 t diff --git a/src/Types.hs b/src/Types.hs index 11ba3ae..584c1da 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -24,17 +24,17 @@ data UserData = UserData } data Ship = Ship - { sPos :: V2 Double - , sVel :: V2 Double - , sRot :: Double + { sPos :: V2 Float + , sVel :: V2 Float + , sRot :: Float , sImg :: Image } data Haskelloid = Haskelloid - { hPos :: V2 Double - , hVel :: V2 Double - , hRot :: Double - , hPitch :: Double + { hPos :: V2 Float + , hVel :: V2 Float + , hRot :: Float + , hPitch :: Float , hDiv :: Int , hImg :: Image } deriving (Eq)