working spaceship

This commit is contained in:
nek0 2016-12-27 23:25:58 +01:00
parent eb1ec187ac
commit 76a1bf69de
2 changed files with 192 additions and 1 deletions

View file

@ -61,6 +61,9 @@ executable haskelloids
build-depends: base >=4.9 && <4.10
, affection
, gegl
, babl
, sdl2
, containers
-- Directories containing source files.
hs-source-dirs: src

View file

@ -1,4 +1,192 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Affection
import qualified SDL
import GEGL
import BABL
import qualified Data.Map as M
import Control.Monad (when)
import Debug.Trace
main :: IO ()
main = putStrLn "Hello, Haskell!"
main = withAffection $ AffectionConfig
{ initComponents = All
, windowTitle = "Haskelloids"
, windowConfig = defaultWindow
, preLoop = return ()
, drawLoop = draw
, updateLoop = update
, loadState = load
, cleanUp = clean
}
load :: SDL.Surface -> IO UserData
load _ = do
traceM "loading"
root <- gegl_node_new
traceM "root node"
ship <- gegl_node_new_child root $ Operation "gegl:svg-load"
[ Property "path" $ PropertyString "assets/ship.svg"
, Property "width" $ PropertyInt 50
, Property "height" $ PropertyInt 50
]
nop <- gegl_node_new_child root $ Operation "gegl:nop" []
over <- gegl_node_new_child root $ defaultOverOperation
translate <- gegl_node_new_child root $ Operation "gegl:translate"
[ Property "origin-x" $ PropertyDouble 25
, Property "origin-y" $ PropertyDouble 25
, Property "x" $ PropertyDouble 400
, Property "y" $ PropertyDouble 300
, Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic
]
rotate <- gegl_node_new_child root $ Operation "gegl:rotate"
[ Property "origin-x" $ PropertyDouble 25
, Property "origin-y" $ PropertyDouble 25
, Property "sampler" $ PropertyInt $ fromEnum GeglSamplerCubic
]
crop <- gegl_node_new_child root $ Operation "gegl:crop"
[ Property "width" $ PropertyDouble 800
, Property "height" $ PropertyDouble 600
]
buffer <- gegl_buffer_new (Just $ GeglRectangle 0 0 800 600) =<<
babl_format (PixelFormat BABL.RGBA CFfloat)
sink <- gegl_node_new_child root $ Operation "gegl:copy-buffer"
[ Property "buffer" $ PropertyBuffer buffer
]
-- gegl_node_link_many [over, crop, sink]
-- gegl_node_link_many [ship, translate, rotate]
gegl_node_link_many [ship, rotate, translate, crop, sink]
gegl_node_connect_to rotate "output" over "aux"
traceM "nodes complete"
myMap <- return $ M.fromList
[ (KeyRoot, root)
, (KeyTranslate, translate)
, (KeyRotate, rotate)
, (KeyShip, ship)
, (KeyNop, nop)
, (KeyCrop, crop)
, (KeyOver, over)
, (KeySink, sink)
]
return $ UserData
{ nodeGraph = myMap
, ship = Ship
{ sPos = (400, 300)
, sVel = (0, 0)
, sRot = 0
, sFlange = rotate
}
, buffer = buffer
}
data UserData = UserData
{ nodeGraph :: M.Map NodeKey GeglNode
, ship :: Ship
, buffer :: GeglBuffer
}
data Ship = Ship
{ sPos :: (Double, Double)
, sVel :: (Double, Double)
, sRot :: Double
, sFlange :: GeglNode
}
data NodeKey
= KeyRoot
| KeyTranslate
| KeyRotate
| KeyShip
| KeyNop
| KeyCrop
| KeyOver
| KeySink
deriving (Ord, Eq)
update :: Double -> Affection UserData ()
update sec = do
-- traceM $ (show $ 1 / sec) ++ " FPS"
ad <- get
evs <- SDL.pollEvents
mapM_ (\e ->
case SDL.eventPayload e of
SDL.KeyboardEvent dat ->
case (SDL.keysymKeycode $ SDL.keyboardEventKeysym dat) of
SDL.KeycodeLeft -> do
ud <- getAffection
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $
putAffection ud
{ ship = (ship ud)
{ sRot = (sRot $ ship ud) + 90 * sec
}
}
SDL.KeycodeRight -> do
ud <- getAffection
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $
putAffection ud
{ ship = (ship ud)
{ sRot = (sRot $ ship ud) - 90 * sec
}
}
SDL.KeycodeUp ->
when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
ud <- getAffection
let vx = -10 * (sin (toR $ 2 * (sRot $ ship ud))) + fst (sVel $ ship ud)
vy = -10 * (cos (toR $ 2 * (sRot $ ship ud))) + snd (sVel $ ship ud)
putAffection ud
{ ship = (ship ud)
{ sVel = (vx, vy)
}
}
traceM $ show (vx, vy) ++ " " ++ show ((*) 2 $ sRot $ ship ud)
_ -> return ()
SDL.WindowClosedEvent _ -> do
traceM "seeya!"
put ad
{ quitEvent = True
}
_ -> return ()
) evs
ud2 <- getAffection
let nx = fst (sPos $ ship ud2) + (fst (sVel $ ship ud2)) * sec
ny = snd (sPos $ ship ud2) + (snd (sVel $ ship ud2)) * sec
nnx =
if nx > 800
then nx - 850
else if nx < -50 then nx + 850 else nx
nny =
if ny > 600
then ny - 650
else if ny < -50 then ny + 650 else ny
liftIO $ gegl_node_set (nodeGraph ud2 M.! KeyTranslate) $ Operation "gegl:translate"
[ Property "x" $ PropertyDouble $ nnx
, Property "y" $ PropertyDouble $ nny
]
liftIO $ gegl_node_set (nodeGraph ud2 M.! KeyRotate) $ Operation "gegl:rotate"
[ Property "degrees" $ PropertyDouble $ sRot $ ship ud2
]
putAffection ud2
{ ship = (ship ud2)
{ sPos = (nnx, nny)
}
}
draw :: Affection UserData ()
draw = do
traceM "drawing"
ud <- getAffection
liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink
present
(GeglRectangle 0 0 800 600)
(buffer ud)
False
clean :: UserData -> IO ()
clean ud = return ()
toR :: Double -> Double
toR deg = deg * pi / 180