From 6a106ad0a407241e8782f5e0e3849153b162f346 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Sat, 30 Dec 2023 20:08:54 +0000 Subject: [PATCH] Re-start ocean waves demo --- README.md | 8 +++ examples/common/Common.hs | 4 +- examples/ghengin-games.cabal | 17 +++++ examples/ocean-waves/Main.hs | 84 +++++++++++++++++++++++++ examples/ocean-waves/Shaders.hs | 106 ++++++++++++++++++++++++++++++++ 5 files changed, 217 insertions(+), 2 deletions(-) create mode 100644 examples/ocean-waves/Main.hs create mode 100644 examples/ocean-waves/Shaders.hs diff --git a/README.md b/README.md index 67f58c3..6fea08a 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,14 @@ A work in progress game engine. ## Demos +See the executables from `ghegin-games.cabal` in the `examples/` directory. +The few work in progress/unpolished executables are: +* `ocean-waves` +* `planets-core` +* `domain-warping` +* `fir-juliaset`, a port of FIR's juliaset to `ghengin`. +* `mandlebrot-set` + ### Ocean waves Based on https://dl.acm.org/doi/abs/10.1145/15922.15894 diff --git a/examples/common/Common.hs b/examples/common/Common.hs index d4c549d..09e2a62 100644 --- a/examples/common/Common.hs +++ b/examples/common/Common.hs @@ -71,10 +71,10 @@ makeMainPipeline shaderPipeline = makeRenderPipeline (shaderPipeline WINDOW_SIZE ) -- | we should be getting the window size dynamically (in ghengin utils we can even pass it automatically) -pattern WINDOW_SIZE = (3840, 2160) +-- pattern WINDOW_SIZE = (3840, 2160) -- pattern WINDOW_SIZE = (2560, 1600) -- pattern WINDOW_SIZE = (1920, 1200) --- pattern WINDOW_SIZE = (640, 480) +pattern WINDOW_SIZE = (640, 480) renderQueueWithViewport :: (Typeable w, Compatible '[Vec3] '[] '[] PipelineProps w, _) => ((Word32, Word32) -> G.ShaderPipeline w) -> Renderer (RenderQueue (), Ur (PipelineKey w PipelineProps)) renderQueueWithViewport sp = Linear.do diff --git a/examples/ghengin-games.cabal b/examples/ghengin-games.cabal index 746b208..3863eab 100644 --- a/examples/ghengin-games.cabal +++ b/examples/ghengin-games.cabal @@ -185,3 +185,20 @@ executable domain-warping fir, filepath, text-short, vector-sized hs-source-dirs: domain-warping + +executable ocean-waves + import: common-flags + main-is: Main.hs + other-modules: Shaders + build-depends: + base >=4.19.0.0, + ghengin-games, + -- Can't depend on this without instancing it because of backpack + ghengin-core, + ghengin-vulkan, + ghengin-core-indep, + mtl, vector, hsnoise, containers, random, linear-base, + derive-storable, geomancy, vulkan, time, ghengin-geometry, + fir, filepath, text-short, vector-sized + + hs-source-dirs: ocean-waves/ diff --git a/examples/ocean-waves/Main.hs b/examples/ocean-waves/Main.hs new file mode 100644 index 0000000..bd38ef9 --- /dev/null +++ b/examples/ocean-waves/Main.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE PostfixOperators #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} +module Main where + +import GHC.Float +import Data.Coerce +import Data.Time +import Data.Time.Clock.POSIX +import Foreign.Storable +import Geomancy.Mat4 +import Geomancy.Transform +import Geomancy.Vec2 +import Geomancy.Vec3 +import Geomancy.Vec4 +import Geomancy.Vulkan.Projection (perspective) +import Ghengin.Core +import Ghengin.Core.Log +import Ghengin.Core.Mesh +import Ghengin.Core.Mesh.Vertex +import Ghengin.Core.Material +import Ghengin.Core.Prelude as Linear +import Ghengin.Core.Render +import Ghengin.Core.Render.Packet +import Ghengin.Core.Render.Pipeline +import Ghengin.Core.Render.Property +import Ghengin.Core.Render.Queue +import Ghengin.Vulkan.Renderer.Sampler +import Ghengin.Core.Shader (StructVec2(..), StructVec3(..), StructMat4(..), StructFloat(..)) +import Vulkan.Core10.FundamentalTypes (Extent2D(..)) +import qualified Data.Monoid.Linear as LMon +import qualified FIR +import FIR.Generics +import qualified Math.Linear as FIR +import qualified Prelude +import qualified Generics.SOP as SOP +import qualified GHC.Generics as GHC +import Data.Time.Clock.POSIX + +import Shaders +import Common + +gameLoop :: forall (_s :: FIR.PipelineInfo). PipelineKey _s PipelineProps -> UTCTime -> RenderQueue () ⊸ Core (RenderQueue ()) +gameLoop pkey lastTime rq = Linear.do + should_close <- (shouldCloseWindow ↑) + if should_close then return rq else Linear.do + (pollWindowEvents ↑) + + Ur ( double2Float -> newPosX + , double2Float -> newPosY + ) <- (getMousePos ↑) + Ur nowTime <- liftSystemIOU getCurrentTime + let diffTime = diffUTCTime nowTime lastTime + liftSystemIO $ do + print ("Frame time " ++ show diffTime) + + rq' <- Core $ lift $ + editPipeline pkey rq $ + propertyAt @1 (\(Ur (Time time)) -> pure $ Ur $ Time $ time + (realToFrac diffTime / 2)) + <=< propertyAt @0 (\(Ur _) -> pure $ Ur $ MousePos $ vec2 newPosX newPosY) + + rq'' <- render rq' + + gameLoop pkey nowTime rq'' + +main :: Prelude.IO () +main = do + withLinearIO $ + runCore WINDOW_SIZE Linear.do + (rq, Ur pkey) <- (renderQueueWithViewport shaderPipeline ↑) + Ur now <- liftSystemIOU getCurrentTime + + rq <- gameLoop pkey now rq + + (freeRenderQueue rq ↑) + + -- In fact, freeing these again is a type error. Woho! + -- (destroyRenderPipeline pipeline ↑) + + return (Ur ()) + diff --git a/examples/ocean-waves/Shaders.hs b/examples/ocean-waves/Shaders.hs new file mode 100644 index 0000000..9650fae --- /dev/null +++ b/examples/ocean-waves/Shaders.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_GHC -Wno-missing-local-signatures #-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NamedWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} + +module Shaders where + +-- base +import Data.Foldable + ( sequence_ ) +import Data.Maybe + ( fromJust ) +import GHC.TypeNats + ( KnownNat ) + +-- filepath +import System.FilePath + ( () ) + +-- text-short +import Data.Text.Short + ( ShortText ) + +-- vector-sized +import qualified Data.Vector.Sized as Vector + ( fromList ) + +-- fir +import FIR +import FIR.Syntax.Labels +import Math.Linear + +-- ghengin +import qualified Ghengin.Core.Shader as G + +-- ghengin-games +import Common.Shader + +-------------------------------------------------------------------------------- +-- * Vertex Shader +-------------------------------------------------------------------------------- +-- The input to our vertex shader are vertices along the XY plane, which we will +-- displace according to the ocean model. We receive the vertices in `Location 0` +-- and they are `V 2 Float`s (points in the XY plane). + +type VertexDefs = + '[ "in_position" ':-> Input '[ Location 0 ] (V 3 Float) + ] + +type VertexInput + = '[ Slot 0 0 ':-> V 3 Float ] + +vertex :: G.VertexShaderModule VertexDefs _ +vertex = shader do + ~(Vec3 x y z) <- get @"in_position" + put @"gl_Position" (Vec4 x y z 1) + +-------------------------------------------------------------------------------- +-- * Fragment Shader +-------------------------------------------------------------------------------- + +type FragmentDefs = + '[ "ubo" ':-> Uniform '[ DescriptorSet 0, Binding 0 ] + ( Struct '[ "mousePos" ':-> V 2 Float ] ) + , "time" ':-> Uniform '[ DescriptorSet 0, Binding 1 ] (Struct '[ "val" ':-> Float ]) + ] + +fragment :: (Float, Float) -> G.FragmentShaderModule FragmentDefs _ +fragment (width,height) = shader do + + ~(Vec4 ix iy _ _) <- #gl_FragCoord + ~(Vec2 mx my) <- use @(Name "ubo" :.: Name "mousePos") + t <- use @(Name "time" :.: Name "val") + + let uv@(Vec2 x y) = Vec2 (ix-Lit width) (iy-Lit height) ^/ Lit height + + let + omega = pi + k = 1 + r = 1 + alpha = -k*x-omega*t + x' = (-alpha/k) - r*sin(alpha) + z = -r*cos(alpha) + + #out_colour .= Vec4 x' y z 1 + +-------------------------------------------------------------------------------- +-- * Pipeline +-------------------------------------------------------------------------------- + +shaderPipeline :: (Word32, Word32) -> G.ShaderPipeline _ +shaderPipeline (fromIntegral -> x, fromIntegral -> y) + = G.ShaderPipeline (StructInput @VertexInput @(Triangle List)) + G.:>-> vertex + G.:>-> fragment (x,y)