nek0/haskelloids
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

pixelize

Browse source
This commit is contained in:
nek0 2016-12-28 21:41:09 +01:00
parent 8257b69c97
commit e0985ffb37
1 changed files with 16 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/Main.hs
View file

@ -72,8 +72,16 @@ load _ = do
, Property "size" $ PropertyDouble 100 , Property "size" $ PropertyDouble 100
, Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1 , Property "color" $ PropertyColor $ GEGL.RGBA 1 1 1 1
] ]
vignette <- gegl_node_new_child root $ Operation "gegl:vignette" []
pixelize <- gegl_node_new_child root $ Operation "gegl:pixelize"
[ Property "size-x" $ PropertyInt 3
, Property "size-y" $ PropertyInt 3
]
-- vdeg <- gegl_node_new_child root $ Operation "gegl:video-degradation"
-- [ Property "pattern" $ PropertyInt 8
-- ]
gegl_node_link_many [ship, rotate, translate] gegl_node_link_many [ship, rotate, translate]
gegl_node_link_many [pover, hover, sover, crop, sink] gegl_node_link_many [pover, hover, sover, crop, pixelize, vignette, sink]
_ <- gegl_node_connect_to translate "output" sover "aux" _ <- gegl_node_connect_to translate "output" sover "aux"
_ <- gegl_node_connect_to pnop "output" pover "aux" _ <- gegl_node_connect_to pnop "output" pover "aux"
_ <- gegl_node_connect_to hnop "output" hover "aux" _ <- gegl_node_connect_to hnop "output" hover "aux"
@ -90,6 +98,7 @@ load _ = do
, (KeySink, sink) , (KeySink, sink)
, (KeyWon, won) , (KeyWon, won)
, (KeyLost, lost) , (KeyLost, lost)
, (KeyPixelize, pixelize)
] ]
hs <- catMaybes <$> foldM (\acc _ -> do hs <- catMaybes <$> foldM (\acc _ -> do
px <- liftIO $ randomRIO (0, 800) px <- liftIO $ randomRIO (0, 800)
@ -151,6 +160,7 @@ data NodeKey
| KeySink | KeySink
| KeyWon | KeyWon
| KeyLost | KeyLost
| KeyPixelize
deriving (Ord, Eq) deriving (Ord, Eq)
update :: Double -> Affection UserData () update :: Double -> Affection UserData ()
@ -301,7 +311,7 @@ draw = do
(not $ wonlost ud) (not $ wonlost ud)
clean :: UserData -> IO () clean :: UserData -> IO ()
clean _ = return () clean ud = gegl_node_drop $ nodeGraph ud M.! KeyRoot
toR :: Double -> Double toR :: Double -> Double
toR deg = deg * pi / 180 toR deg = deg * pi / 180
@ -340,7 +350,7 @@ shotsUpd sec part@Particle{..} = do
) )
maybe (return ()) (\_ -> do maybe (return ()) (\_ -> do
liftIO $ traceIO "YOU LOST!" liftIO $ traceIO "YOU LOST!"
liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeySink) liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeyPixelize)
putAffection ud putAffection ud
{ wonlost = True { wonlost = True
} }
@ -353,6 +363,7 @@ shotsUpd sec part@Particle{..} = do
haskelloidShotDown :: Haskelloid -> Affection UserData () haskelloidShotDown :: Haskelloid -> Affection UserData ()
haskelloidShotDown h = do haskelloidShotDown h = do
-- liftIO $ traceIO "Haskelloid shot down" -- liftIO $ traceIO "Haskelloid shot down"
liftIO $ gegl_node_drop $ hNodeGraph h M.! "root"
ud <- getAffection ud <- getAffection
let redHaskelloids = delete h (haskelloids ud) let redHaskelloids = delete h (haskelloids ud)
newHaskelloids <- catMaybes <$> foldM newHaskelloids <- catMaybes <$> foldM
@ -373,7 +384,7 @@ haskelloidShotDown h = do
(nodeGraph ud M.! KeyHNop) (nodeGraph ud M.! KeyHNop)
else do else do
liftIO $ traceIO "YOU WON!" liftIO $ traceIO "YOU WON!"
liftIO $ gegl_node_link (nodeGraph ud M.! KeyWon) (nodeGraph ud M.! KeySink) liftIO $ gegl_node_link (nodeGraph ud M.! KeyWon) (nodeGraph ud M.! KeyPixelize)
putAffection ud putAffection ud
{ wonlost = True { wonlost = True
} }
@ -408,7 +419,7 @@ updateHaskelloid sec h@Haskelloid{..} = do
) )
maybe (return ()) (\_ -> do maybe (return ()) (\_ -> do
liftIO $ traceIO "YOU LOST!" liftIO $ traceIO "YOU LOST!"
liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeySink) liftIO $ gegl_node_link (nodeGraph ud M.! KeyLost) (nodeGraph ud M.! KeyPixelize)
putAffection ud putAffection ud
{ wonlost = True { wonlost = True
} }