beautyful haskelloids
This commit is contained in:
parent
95d761babe
commit
877fec5289
1 changed files with 14 additions and 14 deletions
28
src/Main.hs
28
src/Main.hs
|
@ -87,10 +87,10 @@ load _ = do
|
||||||
pitch <- liftIO $ randomRIO (-2 * pi, 2 * pi)
|
pitch <- liftIO $ randomRIO (-2 * pi, 2 * pi)
|
||||||
tempRoot <- liftIO $ gegl_node_new
|
tempRoot <- liftIO $ gegl_node_new
|
||||||
tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation
|
tempOver <- liftIO $ gegl_node_new_child tempRoot $ defaultOverOperation
|
||||||
tempText <- liftIO $ gegl_node_new_child tempRoot $ textOperation
|
tempSvg <- gegl_node_new_child root $ Operation "gegl:svg-load"
|
||||||
[ Property "string" $ PropertyString "λ"
|
[ Property "path" $ PropertyString "assets/haskelloid.svg"
|
||||||
, Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1
|
, Property "width" $ PropertyInt (100 `div` rdiv)
|
||||||
, Property "size" $ PropertyDouble 100
|
, Property "height" $ PropertyInt (100 `div` rdiv)
|
||||||
]
|
]
|
||||||
tempTrans <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:translate"
|
tempTrans <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:translate"
|
||||||
[ Property "x" $ PropertyDouble px
|
[ Property "x" $ PropertyDouble px
|
||||||
|
@ -98,8 +98,8 @@ load _ = do
|
||||||
, Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic
|
, Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic
|
||||||
]
|
]
|
||||||
tempRot <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:rotate"
|
tempRot <- liftIO $ gegl_node_new_child tempRoot $ Operation "gegl:rotate"
|
||||||
[ Property "origin-x" $ PropertyDouble 50
|
[ Property "origin-x" $ PropertyDouble (100 / 2 / fromIntegral rdiv)
|
||||||
, Property "origin-y" $ PropertyDouble 50
|
, Property "origin-y" $ PropertyDouble (100 / 2 / fromIntegral rdiv)
|
||||||
, Property "degrees" $ PropertyDouble rot
|
, Property "degrees" $ PropertyDouble rot
|
||||||
, Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic
|
, Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic
|
||||||
]
|
]
|
||||||
|
@ -115,18 +115,18 @@ load _ = do
|
||||||
, hNodeGraph = M.fromList
|
, hNodeGraph = M.fromList
|
||||||
[ ("root", tempRoot)
|
[ ("root", tempRoot)
|
||||||
, ("over", tempOver)
|
, ("over", tempOver)
|
||||||
, ("text", tempText)
|
, ("svg", tempSvg)
|
||||||
, ("trans", tempTrans)
|
, ("trans", tempTrans)
|
||||||
, ("rot", tempRot)
|
, ("rot", tempRot)
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
) [1..5]
|
) ([0..9] :: [Int])
|
||||||
liftIO $ gegl_node_link_many $ map hFlange hs
|
liftIO $ gegl_node_link_many $ map hFlange hs
|
||||||
liftIO $ gegl_node_link (last $ map hFlange hs) hnop
|
liftIO $ gegl_node_link (last $ map hFlange hs) hnop
|
||||||
return $ UserData
|
return $ UserData
|
||||||
{ nodeGraph = myMap
|
{ nodeGraph = myMap
|
||||||
, ship = Ship
|
, ship = Ship
|
||||||
{ sPos = (400, 300)
|
{ sPos = (375, 275)
|
||||||
, sVel = (0, 0)
|
, sVel = (0, 0)
|
||||||
, sRot = 0
|
, sRot = 0
|
||||||
, sFlange = rotate
|
, sFlange = rotate
|
||||||
|
@ -176,7 +176,7 @@ data NodeKey
|
||||||
|
|
||||||
update :: Double -> Affection UserData ()
|
update :: Double -> Affection UserData ()
|
||||||
update sec = do
|
update sec = do
|
||||||
-- traceM $ (show $ 1 / sec) ++ " FPS"
|
traceM $ (show $ 1 / sec) ++ " FPS"
|
||||||
ad <- get
|
ad <- get
|
||||||
evs <- SDL.pollEvents
|
evs <- SDL.pollEvents
|
||||||
mapM_ (\e ->
|
mapM_ (\e ->
|
||||||
|
@ -209,7 +209,7 @@ update sec = do
|
||||||
{ sVel = (vx, vy)
|
{ sVel = (vx, vy)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
traceM $ show (vx, vy) ++ " " ++ show (sRot $ ship ud)
|
-- traceM $ show (vx, vy) ++ " " ++ show (sRot $ ship ud)
|
||||||
SDL.KeycodeSpace ->
|
SDL.KeycodeSpace ->
|
||||||
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
|
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
|
||||||
ud <- getAffection
|
ud <- getAffection
|
||||||
|
@ -345,10 +345,10 @@ updateHaskelloid sec h@Haskelloid{..} = do
|
||||||
let newX = (fst $ hPos) + sec * (fst $ hVel)
|
let newX = (fst $ hPos) + sec * (fst $ hVel)
|
||||||
newY = (snd $ hPos) + sec * (snd $ hVel)
|
newY = (snd $ hPos) + sec * (snd $ hVel)
|
||||||
newRot = hRot + hPitch * sec
|
newRot = hRot + hPitch * sec
|
||||||
(nnx, nny) = wrapAround (newX, newY) (50 / fromIntegral hDiv)
|
(nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv)
|
||||||
liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate"
|
liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate"
|
||||||
[ Property "x" $ PropertyDouble $ nnx - (50 / fromIntegral hDiv)
|
[ Property "x" $ PropertyDouble $ nnx
|
||||||
, Property "y" $ PropertyDouble $ nny - (50 / fromIntegral hDiv)
|
, Property "y" $ PropertyDouble $ nny
|
||||||
]
|
]
|
||||||
liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate"
|
liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate"
|
||||||
[ Property "degrees" $ PropertyDouble newRot
|
[ Property "degrees" $ PropertyDouble newRot
|
||||||
|
|
Loading…
Reference in a new issue