aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Graphics/Glyph/BufferBuilder.hs32
-rw-r--r--Graphics/Glyph/GlyphObject.hs158
-rw-r--r--Graphics/Glyph/Util.hs3
-rw-r--r--Hw8.hs185
-rw-r--r--jora2470_hw8.cabal4
-rw-r--r--shaders/moon.vert8
-rw-r--r--shaders/normal.vert9
-rw-r--r--shaders/satelites.frag23
-rw-r--r--shaders/satelites.geom31
-rw-r--r--shaders/satelites.vert41
-rw-r--r--shaders/space.vert3
11 files changed, 355 insertions, 142 deletions
diff --git a/Graphics/Glyph/BufferBuilder.hs b/Graphics/Glyph/BufferBuilder.hs
index 4c56c6f..e9606de 100644
--- a/Graphics/Glyph/BufferBuilder.hs
+++ b/Graphics/Glyph/BufferBuilder.hs
@@ -88,7 +88,7 @@ compilingBuilder (Builder lst _) = do
tmp _ = 0
{- Simply figure out what types of elementse
- exist in this buffer -}
- let en@(bn,bc,bt) = Fold.foldl (\(bn,bc,bt) ele ->
+ let en@(bn,bc,bt) = Fold.foldl' (\(bn,bc,bt) ele ->
case ele of
NormalLink _ -> (True,bc,bt)
ColorLink _ -> (bn,True,bt)
@@ -100,8 +100,8 @@ compilingBuilder (Builder lst _) = do
(?) False = 0
-- Cur color normal texture buffer
let (nverts,_,_,_,buffer) =
- Fold.foldl (\(num,cn,cc,ct,ll) ele ->
- -- trace ("foldl " ++! ele) $
+ Fold.foldl' (\(num,cn,cc,ct,ll) ele ->
+ -- trace ("foldl " ++! ele) $
case ele of
NormalLink nn -> (num,nn,cc,ct,ll)
ColorLink nc -> (num,cn,nc,ct,ll)
@@ -111,19 +111,19 @@ compilingBuilder (Builder lst _) = do
ll >< (tp3 True vert >< tp3 bn cn >< tp4 bc cc >< tp2 bt ct)
)) ( 0, (0,0,0), (0,0,0,0), (0,0), Seq.empty ) (Seq.reverse lst)
- arr <- newListArray (0,Seq.length buffer) (Fold.toList buffer)
- ((putStrLn.("Compiled: "++!))>&>return) $ CompiledBuild stride en nverts arr
-
-
- where
- tp2 True (a,b) = Seq.fromList [a,b]
- tp2 False _ = empty
-
- tp3 True (a,b,c) = Seq.fromList [a,b,c]
- tp3 False _ = empty
-
- tp4 True (a,b,c,d) = Seq.fromList [a,b,c,d]
- tp4 False _ = empty
+ let blst = (Fold.toList buffer)
+ arr <- blst `seq` newListArray (0,Seq.length buffer) blst
+ let compiledRet = CompiledBuild stride en nverts arr
+ compiledRet `seq` putStrLn ("Compiled: " ++! compiledRet ) `seq` return compiledRet
+ where
+ tp2 True (a,b) = Seq.fromList [a,b]
+ tp2 False _ = empty
+
+ tp3 True (a,b,c) = Seq.fromList [a,b,c]
+ tp3 False _ = empty
+
+ tp4 True (a,b,c,d) = Seq.fromList [a,b,c,d]
+ tp4 False _ = empty
storableArrayToBuffer :: (Storable el) => BufferTarget -> StorableArray Int el -> IO BufferObject
storableArrayToBuffer target arr = do
diff --git a/Graphics/Glyph/GlyphObject.hs b/Graphics/Glyph/GlyphObject.hs
new file mode 100644
index 0000000..8a3fe4a
--- /dev/null
+++ b/Graphics/Glyph/GlyphObject.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Graphics.Glyph.GlyphObject (
+ GlyphObject,
+ getBufferObject,
+ getCompiledData,
+ getVertexAttribute,
+ getNormalAttribute,
+ getColorAttribute ,
+ getTextureAttribute,
+ getResources,
+ getSetupRoutine,
+ getTeardownRoutine,
+ getPrimitiveMode,
+ setBufferObject,
+ setCompiledData,
+ setVertexAttribute,
+ setNormalAttribute,
+ setColorAttribute ,
+ setTextureAttribute,
+ setResources,
+ setSetupRoutine,
+ setTeardownRoutine,
+ setPrimitiveMode,
+ prepare, teardown,
+ Drawable, draw, newGlyphObject,
+ newDefaultGlyphObject
+) where
+
+import Graphics.Glyph.BufferBuilder
+import Graphics.Glyph.Util
+import Graphics.Rendering.OpenGL
+import Data.Setters
+
+import Control.Monad
+import Control.Applicative
+import Data.Maybe
+
+class Drawable a where
+ -- mvMat -> pMat -> obj -> IO ()
+ draw :: a -> IO ()
+
+data GlyphObject a = GlyphObject {
+ bufferObject :: BufferObject, -- buffer
+ compiledData :: (CompiledBuild GLfloat), -- compiled data
+ vertexAttribute :: AttribLocation, -- vertex attribute
+ normalAttribute :: (Maybe AttribLocation), -- normal attrib
+ colorAttribute :: (Maybe AttribLocation), -- color attrib
+ textureAttribute :: (Maybe AttribLocation), -- texture attrib
+ resources :: a, -- Resources
+ setupRoutine :: (Maybe (GlyphObject a -> IO ())), -- Setup
+ teardownRoutine :: (Maybe (GlyphObject a -> IO ())), -- Tear down
+ primitiveMode :: PrimitiveMode
+}
+
+$(declareSetters ''GlyphObject)
+getBufferObject :: GlyphObject a -> BufferObject
+getBufferObject = bufferObject
+
+getCompiledData :: GlyphObject a -> (CompiledBuild GLfloat)
+getCompiledData = compiledData
+
+getVertexAttribute :: GlyphObject a -> AttribLocation
+getVertexAttribute = vertexAttribute
+
+getNormalAttribute :: GlyphObject a -> (Maybe AttribLocation)
+getNormalAttribute = normalAttribute
+
+getColorAttribute :: GlyphObject a -> (Maybe AttribLocation)
+getColorAttribute = colorAttribute
+
+getTextureAttribute :: GlyphObject a -> (Maybe AttribLocation)
+getTextureAttribute = textureAttribute
+
+getResources :: GlyphObject a -> a
+getResources = resources
+
+getSetupRoutine :: GlyphObject a -> (Maybe (GlyphObject a -> IO ()))
+getSetupRoutine = setupRoutine
+
+getTeardownRoutine :: GlyphObject a -> (Maybe (GlyphObject a -> IO ()))
+getTeardownRoutine = teardownRoutine
+
+getPrimitiveMode :: GlyphObject a -> PrimitiveMode
+getPrimitiveMode = primitiveMode
+
+newGlyphObject :: Builder GLfloat x ->
+ AttribLocation ->
+ Maybe AttribLocation ->
+ Maybe AttribLocation ->
+ Maybe AttribLocation ->
+ a ->
+ Maybe (GlyphObject a -> IO ()) ->
+ Maybe (GlyphObject a -> IO ()) ->
+ PrimitiveMode ->
+ IO (GlyphObject a)
+
+newGlyphObject builder vertAttr normAttr colorAttr textureAttr res setup tear mode = do
+ compiled <- compilingBuilder builder
+ buffer <- createBufferObject ArrayBuffer compiled
+ return $ GlyphObject buffer compiled vertAttr normAttr colorAttr textureAttr res setup tear mode
+
+prepare :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
+prepare a b = setSetupRoutine (Just b) a
+
+teardown :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
+teardown a b = setTeardownRoutine (Just b) a
+
+instance Drawable (GlyphObject a) where
+ draw obj@(GlyphObject bo co vAttr nAttr cAttr tAttr _ setup tearDown p) = do
+ {- Setup whatever we need for the object to draw itself -}
+ maybe (return ()) (apply obj) setup
+
+ {- Get the array descriptors for the possible
+ - parts -}
+ let vad = vertexArrayDescriptor co
+ let nad = normalArrayDescriptor co
+ let cad = colorArrayDescriptor co
+ let tad = textureArrayDescriptor co
+
+ bindBuffer ArrayBuffer $= Just bo
+ let enabled = catMaybes $
+ map liftMaybe [(Just vAttr,Just vad), (nAttr, nad), (cAttr,cad), (tAttr,tad)]
+
+ forM_ enabled $ \(attr, ad) -> do
+ vertexAttribPointer attr $= (ToFloat, ad)
+ vertexAttribArray attr $= Enabled
+
+ drawArrays p 0 (bufferLength co)
+
+ forM_ enabled $ \(attr, _) -> do
+ vertexAttribArray attr $= Disabled
+
+ {- Tear down whatever the object needs -}
+ maybe (return ()) (apply obj) tearDown
+ where liftMaybe (Just a, Just b) = Just (a,b)
+ liftMaybe _ = Nothing
+ apply obj' f = f obj'
+
+instance (Show a) => Show (GlyphObject a) where
+ show (GlyphObject _ co vAttr nAttr cAttr tAttr res _ _ p) =
+ "[GlyphObject compiled=" ++! co ++ " vertAttr=" ++! vAttr ++
+ " normalAttr="++!nAttr++" colorAttr="++!cAttr++" textureAttr="++!tAttr++" res="++!res++" PrimitiveMode="++!p++"]"
+
+
+newDefaultGlyphObject :: Builder GLfloat x -> a -> IO (GlyphObject a)
+newDefaultGlyphObject builder resources =
+ newGlyphObject builder
+ (AttribLocation 0) -- vertex
+ (Just $ AttribLocation 1) -- normal
+ (Just $ AttribLocation 2) -- color
+ (Just $ AttribLocation 3) -- texture
+ resources
+ Nothing -- setup
+ Nothing -- teardown
+ Triangles -- primitive
+
+
diff --git a/Graphics/Glyph/Util.hs b/Graphics/Glyph/Util.hs
index 550dd30..d657aa3 100644
--- a/Graphics/Glyph/Util.hs
+++ b/Graphics/Glyph/Util.hs
@@ -3,6 +3,9 @@ module Graphics.Glyph.Util where
import Data.Angle
import Graphics.Rendering.OpenGL
+int :: (Integral a, Num b) => a -> b
+int = fromIntegral
+
uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> (a,b,c,d,e,f,g) -> h
uncurry7 func (a,b,c,d,e,f,g) = func a b c d e f g
diff --git a/Hw8.hs b/Hw8.hs
index b1cfbfa..1d257ae 100644
--- a/Hw8.hs
+++ b/Hw8.hs
@@ -3,6 +3,7 @@ module Main where
import Control.Applicative
import Control.Monad
+import GHC.Exts
import Data.Setters
import Data.Maybe
@@ -10,7 +11,7 @@ import Data.Word
import Debug.Trace
-import Graphics.Rendering.OpenGL
+import Graphics.Rendering.OpenGL as GL
import Graphics.Rendering.OpenGL.Raw.Core31
import Graphics.UI.SDL as SDL
import Graphics.Glyph.GLMath
@@ -21,6 +22,7 @@ import Graphics.Glyph.Textures
import Graphics.Glyph.Shaders
import Graphics.Glyph.Util
import Graphics.Glyph.BufferBuilder
+import Graphics.Glyph.GlyphObject
import Control.DeepSeq
import System.Exit
@@ -30,79 +32,6 @@ import Debug.Trace
import Foreign.Storable
import Foreign.Ptr
-class Drawable a where
- -- mvMat -> pMat -> obj -> IO ()
- draw :: a -> IO ()
-
-data GlyphObject a = GlyphObject {
- bufferObject :: BufferObject, -- buffer
- compiledData :: (CompiledBuild GLfloat), -- compiled data
- vertexAttribute :: AttribLocation, -- vertex attribute
- normalAttribute :: (Maybe AttribLocation), -- normal attrib
- colorAttribute :: (Maybe AttribLocation), -- color attrib
- textureAttribute :: (Maybe AttribLocation), -- texture attrib
- resources :: a, -- Resources
- setupRoutine :: (Maybe (GlyphObject a -> IO ())), -- Setup
- teardownRoutine :: (Maybe (GlyphObject a -> IO ())) -- Tear down
-}
-
-$(declareSetters ''GlyphObject)
-makeGlyphObject :: Builder GLfloat x ->
- AttribLocation ->
- Maybe AttribLocation ->
- Maybe AttribLocation ->
- Maybe AttribLocation ->
- a ->
- Maybe (GlyphObject a -> IO ()) ->
- Maybe (GlyphObject a -> IO ()) ->
- IO (GlyphObject a)
-
-makeGlyphObject builder vertAttr normAttr colorAttr textureAttr res setup tear = do
- compiled <- compilingBuilder builder
- buffer <- createBufferObject ArrayBuffer compiled
- return $ GlyphObject buffer compiled vertAttr normAttr colorAttr textureAttr res setup tear
-
-glyphObjectPrepare :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
-glyphObjectPrepare (GlyphObject a b c d e f g _ i) h = GlyphObject a b c d e f g (Just h) i
-
-glyphObjectTeardown :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
-glyphObjectTeardown (GlyphObject a b c d e f g h _) i = GlyphObject a b c d e f g h (Just i)
-
-instance (Show a) => Show (GlyphObject a) where
- show (GlyphObject _ co vAttr nAttr cAttr tAttr res _ _) =
- "[GlyphObject compiled=" ++! co ++ " vertAttr=" ++! vAttr ++
- " normalAttr="++!nAttr++" colorAttr="++!cAttr++" textureAttr="++!tAttr++" res="++!res++"]"
-
-instance Drawable (GlyphObject a) where
- draw obj@(GlyphObject bo co vAttr nAttr cAttr tAttr _ setup tearDown) = do
- {- Setup whatever we need for the object to draw itself -}
- maybe (return ()) (apply obj) setup
-
- {- Get the array descriptors for the possible
- - parts -}
- let vad = vertexArrayDescriptor co
- let nad = normalArrayDescriptor co
- let cad = colorArrayDescriptor co
- let tad = textureArrayDescriptor co
-
- bindBuffer ArrayBuffer $= Just bo
- let enabled = catMaybes $
- map liftMaybe [(Just vAttr,Just vad), (nAttr, nad), (cAttr,cad), (tAttr,tad)]
-
- forM_ enabled $ \(attr, ad) -> do
- vertexAttribPointer attr $= (ToFloat, ad)
- vertexAttribArray attr $= Enabled
-
- drawArrays Triangles 0 (bufferLength co)
-
- forM_ enabled $ \(attr, _) -> do
- vertexAttribArray attr $= Disabled
-
- {- Tear down whatever the object needs -}
- maybe (return ()) (apply obj) tearDown
- where liftMaybe t@(Just a, Just b) = Just (a,b)
- liftMaybe _ = Nothing
- apply obj f = f obj
data Uniforms = Uniforms {
dxU :: UniformLocation,
@@ -126,6 +55,12 @@ data TextureData = TextureData {
data Resources = Resources {
object :: GlyphObject Uniforms,
backDrop :: GlyphObject (Program,UniformLocation),
+ satelites :: GlyphObject (Program,
+ UniformLocation, -- noise
+ UniformLocation, -- mvMat
+ UniformLocation, -- pMat
+ UniformLocation, -- time
+ UniformLocation), -- light
moon :: GlyphObject (Program,
UniformLocation,
UniformLocation,
@@ -170,12 +105,13 @@ enumEq a = (fromEnum a ==) . fromEnum
enumNeq :: Enum a => a -> a -> Bool
enumNeq a = not . enumEq a
-loadProgram :: String -> String -> IO Program
-loadProgram vert frag = do
- shaders <- loadShaders [
- (VertexShader, vert),
- (FragmentShader, frag) ]
- mapM_ (putStrLn . fst) shaders
+loadProgram :: String -> String -> Maybe String -> IO Program
+loadProgram vert frag geom = do
+ shaders <- loadShaders $ catMaybes [
+ Just (VertexShader, vert),
+ Just (FragmentShader, frag),
+ geom >>= return . (,)GeometryShader]
+ -- mapM_ (putStrLn . fst) shaders
(linklog, maybeProg) <- createShaderProgram (workingShaders shaders)
when (isNothing maybeProg) $ do
@@ -228,14 +164,9 @@ circle r step = do
makeResources :: IO Resources
makeResources =
let pMatrix' = perspectiveMatrix 50 1.8 0.1 100 in
- loadProgram "shaders/normal.vert" "shaders/textured.frag" >>= (\prog -> do
- glo <- makeGlyphObject
- <$> (pure $ circle 1 3)
- <*> get (attribLocation prog "in_position")
- <*> (get (attribLocation prog "in_normal") >>= return . Just)
- <*> pure Nothing
- <*> (get (attribLocation prog "in_texMapping") >>= return . Just)
- <*> do Uniforms
+ loadProgram "shaders/normal.vert" "shaders/textured.frag" Nothing >>= (\prog -> do
+ glo <- newDefaultGlyphObject (circle 1 3)
+ <$> do Uniforms
<$> get (uniformLocation prog "dX")
<*> get (uniformLocation prog "dY")
<*> get (uniformLocation prog "texture")
@@ -245,28 +176,15 @@ makeResources =
<*> get (uniformLocation prog "lights")
<*> get (uniformLocation prog "random")
<*> get (uniformLocation prog "winter")
- <*> pure Nothing
- <*> pure Nothing
prog2 <- loadBackdropProgram
- backDrop <- makeGlyphObject
- <$> pure quad
- <*> get (attribLocation prog "in_position")
- <*> pure Nothing
- <*> pure Nothing
- <*> pure Nothing
- <*> (get (uniformLocation prog2 "texture") >>= \x-> return (prog2,x))
- <*> pure Nothing
- <*> pure Nothing
-
- moonProg <- loadProgram "shaders/moon.vert" "shaders/moon.frag"
- moon <- makeGlyphObject
- <$> pure (circle 0.2 5)
- <*> get (attribLocation moonProg "in_position")
- <*> liftM Just (get (attribLocation moonProg "in_normal"))
- <*> pure Nothing
- <*> liftM Just (get (attribLocation moonProg "in_texMapping"))
- <*> do (,,,,,,,)
+ backDrop <- newDefaultGlyphObject quad
+ <$> (get (uniformLocation prog2 "texture") >>=
+ \x-> return (prog2,x))
+
+ moonProg <- loadProgram "shaders/moon.vert" "shaders/moon.frag" Nothing
+ moon <- newDefaultGlyphObject (circle 0.2 5)
+ <$> do (,,,,,,,)
<$> pure moonProg
<*> get (uniformLocation moonProg "texture")
<*> get (uniformLocation moonProg "lightPos")
@@ -275,12 +193,28 @@ makeResources =
<*> get (uniformLocation moonProg "time")
<*> get (uniformLocation moonProg "dX")
<*> get (uniformLocation moonProg "dY")
- <*> pure Nothing
- <*> pure Nothing
+
+ stgen1 <- newStdGen
+ stgen2 <- newStdGen
+ stgen3 <- newStdGen
+ let run = (\(x,y,_)->bTexture2 (1.0/x,1.0/y)) >&> bVertex3
+ satelitesProg <- loadProgram "shaders/satelites.vert" "shaders/satelites.frag" (Just "shaders/satelites.geom")
+ satelites <- newDefaultGlyphObject (do
+ mapM_ run $
+ sortWith (\(a,_,_)-> -a) $ take 200000 $ zip3 (randoms stgen1) (randoms stgen2) (randoms stgen3)
+ )
+ <$> do (,,,,,)
+ <$> pure satelitesProg
+ <*> get (uniformLocation satelitesProg "noiseTexture")
+ <*> get (uniformLocation satelitesProg "mvMatrix")
+ <*> get (uniformLocation satelitesProg "pMatrix")
+ <*> get (uniformLocation satelitesProg "time")
+ <*> get (uniformLocation satelitesProg "light")
Resources
<$> glo
<*> backDrop
+ <*> liftM (setPrimitiveMode Points) satelites
<*> moon
<*> (makeTexture >>= genRandomTexture)
<*> (load ("textures/earth.png") >>= textureFromSurface)
@@ -300,7 +234,7 @@ makeResources =
<*> pure (0,0,0)
<*> pure (20,0.1,0.1)
<*> pure False
- <*> pure 1.0
+ <*> pure 0.1
)
printErrors :: String -> IO ()
@@ -347,8 +281,8 @@ display surf res = do
SDL.flip surf
depthFunc $= Nothing
- draw $ glyphObjectPrepare (backDrop res) $ \obj -> do
- let (prg,uni) = (resources obj)
+ draw $ prepare (backDrop res) $ \obj -> do
+ let (prg,uni) = (getResources obj)
currentProgram $= Just prg
setupTexturing (spaceTex res) uni 0
@@ -358,11 +292,12 @@ display surf res = do
where ph' = (floor ph::Int) `mod` 360
let mvMatrix = lookAtMatrix (Vec3 . toEuclidian $ eyeLocation res) (Vec3 (0,0,0)) up
+ blend $= Disabled
vertexProgramPointSize $= Enabled
- draw $ glyphObjectPrepare (object res) $ \glo -> do
+ draw $ prepare (object res) $ \glo -> do
depthFunc $= Just Less
let bumpMap = if useNoise res then resTexture else earthTex
- let uniforms = resources glo
+ let uniforms = getResources glo
let (w,h) = mapT2 fromIntegral (textureSize $ bumpMap res)
uniform (dxU uniforms) $= Index1 (1.0/w::GLfloat)
uniform (dyU uniforms) $= Index1 (1.0/h::GLfloat)
@@ -376,8 +311,8 @@ display surf res = do
setupTexturing (resTexture res) (randomU uniforms) 4
setupTexturing (winterTex res) (winterU uniforms) 5
- draw $ glyphObjectPrepare (moon res) $ \glo -> do
- let (prog, texU, lU, mvMatU, pMatU, timeUn,dxUn,dyUn) = resources glo
+ draw $ prepare (moon res) $ \glo -> do
+ let (prog, texU, lU, mvMatU, pMatU, timeUn,dxUn,dyUn) = getResources glo
let (w,h) = mapT2 fromIntegral (textureSize $ moonTex res)
let time = resTime res
currentProgram $= Just prog
@@ -388,6 +323,18 @@ display surf res = do
uniform dyUn $= Index1 (1.0/w::GLfloat)
setupTexturing (moonTex res) texU 0
setupLighting mvMatrix res lU
+
+ blend $= Enabled
+ blendFunc $= (GL.SrcAlpha,OneMinusSrcAlpha)
+ draw $ prepare (satelites res) $ \glo -> do
+ let (prog, texU, mvMatU, pMatU, timeUn, light) = getResources glo
+ let time = resTime res
+ currentProgram $= Just prog
+ uniform mvMatU $= mvMatrix
+ uniform pMatU $= pMatrix res
+ uniform timeUn $= Index1 time
+ setupLighting mvMatrix res light
+ setupTexturing (resTexture res) texU 0
SDL.glSwapBuffers
return res
@@ -430,10 +377,10 @@ digestEvents args = do
digestEvents $ (Prelude.flip setUseNoise args.not.useNoise) args
KeyDown (Keysym SDLK_EQUALS _ _) ->
- digestEvents $ setDTime (dTime args + 1.0) args
+ digestEvents $ setDTime (dTime args + 0.1) args
KeyDown (Keysym SDLK_MINUS _ _) ->
- digestEvents $ setDTime (dTime args - 1.0) args
+ digestEvents $ setDTime (dTime args - 0.1) args
Quit -> exitSuccess
_ -> digestEvents args
diff --git a/jora2470_hw8.cabal b/jora2470_hw8.cabal
index 1fc9ffc..fbc9041 100644
--- a/jora2470_hw8.cabal
+++ b/jora2470_hw8.cabal
@@ -1,6 +1,8 @@
-- Initial jora2470_hw2.cabal generated by cabal init. For further
-- documentation, see http://haskell.org/cabal/users-guide/
+--enable-library-profiling and/or
+--enable-executable-profiling.
name: homework8
version: 0.1.0.0
-- synopsis:
@@ -17,5 +19,7 @@ cabal-version: >=1.8
executable jora2470_hw8
main-is: Hw8.hs
extensions: FlexibleInstances
+ ghc-options: -rtsopts
+ -- ghc-options: -prof -osuf h_o
-- other-modules:
build-depends: setters, base, OpenGL, bytestring, array, SDL, random, OpenGLRaw, AC-Angle, deepseq, containers, SDL-image
diff --git a/shaders/moon.vert b/shaders/moon.vert
index 2e6a928..c8dface 100644
--- a/shaders/moon.vert
+++ b/shaders/moon.vert
@@ -1,7 +1,9 @@
#version 150
-in vec3 in_position ;
-in vec3 in_normal ;
-in vec2 in_texMapping ;
+#extension GL_ARB_explicit_attrib_location : enable
+
+layout(location = 0) in vec3 in_position ;
+layout(location = 1) in vec3 in_normal ;
+layout(location = 3) in vec2 in_texMapping ;
uniform mat4 mvMat ;
uniform mat4 pMat ;
diff --git a/shaders/normal.vert b/shaders/normal.vert
index 34ddce3..bfe9080 100644
--- a/shaders/normal.vert
+++ b/shaders/normal.vert
@@ -1,7 +1,10 @@
#version 150
-in vec3 in_position ;
-in vec3 in_normal ;
-in vec2 in_texMapping ;
+#extension GL_ARB_explicit_attrib_location : enable
+
+layout(location = 0) in vec3 in_position ;
+layout(location = 1) in vec3 in_normal ;
+// # 2 is color
+layout(location = 3) in vec2 in_texMapping ;
uniform mat4 pMat ;
uniform mat4 mvMat ;
diff --git a/shaders/satelites.frag b/shaders/satelites.frag
new file mode 100644
index 0000000..a605025
--- /dev/null
+++ b/shaders/satelites.frag
@@ -0,0 +1,23 @@
+#version 150
+
+out vec4 frag_color ;
+
+uniform vec3 light ;
+uniform sampler2D noiseTexture ;
+
+// normal == position ;
+in vec4 position ;
+in vec3 normal ;
+in vec2 texMapping ;
+
+in float rad ;
+in vec3 mNormal ;
+in vec4 origPos_ ;
+
+void main() {
+ float intensity = dot( normalize(vec3(position) - light), normalize(mNormal) );
+ frag_color = vec4(
+ mix(vec3(texture2D(noiseTexture,origPos_.xy))*intensity,
+ vec3(1.0), 0.90)
+ ,0.1/pow(rad,1.7)) ;
+}
diff --git a/shaders/satelites.geom b/shaders/satelites.geom
new file mode 100644
index 0000000..7e3d747
--- /dev/null
+++ b/shaders/satelites.geom
@@ -0,0 +1,31 @@
+#version 150
+layout(points) in;
+layout(triangle_strip, max_vertices=28) out;
+
+out float rad ;
+out vec3 mNormal ;
+
+uniform mat4 mvMatrix ;
+in vec4 origPos[] ;
+out vec4 origPos_ ;
+
+void vertex( vec3 pos ) {
+ gl_Position = gl_in[0].gl_Position + vec4(pos,0.0) ;
+ origPos_ = origPos[0] ;
+ EmitVertex() ;
+}
+
+void main( ) {
+ mNormal = -inverse(transpose(mat3(mvMatrix))) * vec3(0,0,1.0) ;
+ float r = 0.005 ;
+ float th = 0.00 ;
+ for( ; th < 6.3 ; th += 0.5 ) {
+ rad = 2 ;
+ vertex( vec3(r*sin(th),r*cos(th),0.0) ) ;
+ rad = 0.0 ;
+ vertex( vec3(0.0,0.0,0.0) ) ;
+ }
+ rad = 2 ;
+ vertex( vec3(r*sin(0.0),r*cos(0.0),0.0) ) ;
+ EndPrimitive();
+}
diff --git a/shaders/satelites.vert b/shaders/satelites.vert
new file mode 100644
index 0000000..a95055b
--- /dev/null
+++ b/shaders/satelites.vert
@@ -0,0 +1,41 @@
+#version 150
+#extension GL_ARB_explicit_attrib_location : enable
+
+layout(location = 0) in vec3 in_position ;
+layout(location = 3) in vec2 in_texMapping ;
+
+uniform sampler2D noiseTexture ;
+
+uniform mat4 mvMatrix ;
+uniform mat4 pMatrix ;
+uniform float time ;
+uniform vec3 light ;
+
+out vec4 position ;
+out vec3 normal ;
+out vec2 texMapping ;
+out vec4 origPos ;
+
+void main() {
+ vec4 u = texture2D( noiseTexture, in_texMapping ) ;
+ texMapping = in_texMapping ;
+
+ float r = pow(0.1,in_position.x)+1.2 ;
+ float th = in_position.y - ((u.x+1.0) * time/(sqrt(r) * 50.0)) + u.z * 360;
+ float ph = 2*(in_position.z - 0.5) ;// pow(in_position.z-0.2,0.5) + ;
+ ph *= pow( abs(ph), 2.0 ) * sin( time / (sqrt(r) * 50));
+
+ vec4 real_position = vec4(
+ -r * sin(th) * cos(ph),
+ r * sin(ph),
+ r * cos(th) * cos(ph),
+ 1.0 ) ;
+ origPos = real_position ;
+
+ vec4 tmp = mvMatrix * real_position ;
+ position = tmp ;
+ normal = inverse(transpose(mat3(mvMatrix))) * vec3(tmp) ;
+ tmp = pMatrix * tmp;
+ gl_PointSize = texture2D(noiseTexture,in_texMapping+vec2(.1,.1)).a * 4.0 / length(vec3(tmp)) ;
+ gl_Position = tmp ;
+}
diff --git a/shaders/space.vert b/shaders/space.vert
index fdfec59..579963d 100644
--- a/shaders/space.vert
+++ b/shaders/space.vert
@@ -1,5 +1,6 @@
#version 150
-in vec3 in_position ;
+#extension GL_ARB_explicit_attrib_location : enable
+layout(location = 0) in vec3 in_position ;
out vec2 texMap ;
void main() {
generated by cgit (git 2.34.1) at 2025-04-28 12:18:29 +0000