diff --git a/haskelloids.cabal b/haskelloids.cabal index 9d68a85..bc0b566 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 65ae4a0..825c9a8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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