Compare commits

...

3 Commits

Author SHA1 Message Date
nek0 1acf7f2a0f throw out more of GLUtil 2020-05-13 05:42:32 +02:00
nek0 4b37d5f51c start getting rid of GLUtil 2020-05-13 04:21:49 +02:00
nek0 d73c854999 black screen? 2020-02-10 00:35:28 +01:00
10 changed files with 194 additions and 214 deletions

View File

@ -8,7 +8,6 @@ import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GL as GLRaw
import qualified Graphics.GLUtil as GLU
import Codec.Picture
@ -58,12 +57,15 @@ main =
preLoopImpl :: Affection UserData ()
preLoopImpl = liftIO $ do
void $ SDL.setMouseLocationMode SDL.RelativeLocation
-- GL.depthFunc $= Just GL.Less
GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Nearest)
GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
GL.texture GL.Texture2D $= GL.Enabled
-- GL.frontFace $= GL.CW
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
GL.frontFace $= GL.CCW
GL.blend $= GL.Enabled
GL.depthFunc $= Nothing
GL.scissor $= Nothing
GL.viewport $= (GL.Position 0 0, GL.Size 1920 1080)
GL.clearColor $= GL.Color4 1 1 1 1
loadStateImpl :: IO UserData
loadStateImpl = do

View File

@ -6,7 +6,7 @@ import SDL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GL.Functions as GLRaw (glVertexAttribDivisor)
import qualified Graphics.GLUtil as GLU
-- import qualified Graphics.GLUtil as GLU
import qualified Data.Map.Strict as M
@ -101,10 +101,50 @@ rawVertices =
]
initSpriteShaderObjects = do
-- vertexShaderSrc <- BS.readFile "shader/vertex.sl"
-- fragmentShaderSrc <- BS.readFile "shader/fragment.sl"
vertexShader <- createShader VertexShader
fragmentShader <- createShader FragmentShader
vertexShaderSrc <- BS.readFile "shader/vertex.sl"
fragmentShaderSrc <- BS.readFile "shader/fragment.sl"
shaderProgram <- GLU.simpleShaderProgramBS vertexShaderSrc fragmentShaderSrc
shaderSourceBS vertexShader $= vertexShaderSrc
shaderSourceBS fragmentShader $= fragmentShaderSrc
compileShader vertexShader
get errors >>= mapM_ (hPutStrLn stderr . ("GL: "++) . show)
vOK <- get (compileStatus vertexShader)
infoLog <- get (shaderInfoLog vertexShader)
unless (null infoLog || infoLog == "\NUL")
(mapM_
putStrLn
["Shader info log for '" ++ filePath ++ "':", infoLog, ""]
)
unless vOK $ do
deleteObjectName vertexShader
ioError (userError "vertexShader compilation failed")
compileShader fragmentShader
get errors >>= mapM_ (hPutStrLn stderr . ("GL: "++) . show)
fOK <- get (compileStatus fragmentShader)
infoLog <- get (shaderInfoLog fragmentShader)
unless (null infoLog || infoLog == "\NUL")
(mapM_
putStrLn
["Shader info log for '" ++ filePath ++ "':", infoLog, ""]
)
unless fOK $ do
deleteObjectName fragmentShader
ioError (userError "fragmentShader compilation failed")
-- shaderProgram <- GLU.simpleShaderProgramBS vertexShaderSrc fragmentShaderSrc
shaderProgram <- createProgram
attachShaders shaderProgram $= [vertexShader, fragmentShader]
linkProgram shaderProgram
get errors >>= mapM_ (hPutStrLn stderr . ("GL: "++) . show)
return (SpriteShaderObjects shaderProgram)
@ -149,6 +189,12 @@ loadSprites amount = do
-- [ (V2 0 0)
-- ]
GL.texture GL.Texture2D $= GL.Enabled
GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
GL.textureFilter GL.Texture2D $= ((GL.Nearest, Just GL.Nearest), GL.Nearest)
GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat)
GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat)
textObj <- initSpriteTextureObjects lookups
positions <- replicateM amount $ do

View File

@ -4,3 +4,4 @@ module Types
import Types.UserData as T
import Types.Sprite as T
import Types.CanvasShader as T

26
app/Types/CanvasShader.hs Normal file
View File

@ -0,0 +1,26 @@
module Types.CanvasShader where
import Data.List as L
import Data.Map.Strict
import Graphics.Rendering.OpenGL (get)
import qualified Graphics.Rendering.OpenGL as GL
data CanvasShader = CanvasShader
{ shaderAttribs :: Map String (GL.AttribLocation, GL.VariableType)
, shaderUniforms :: Map String (GL.UniformLocation, GL.VariableType)
, shaderProgram :: GL.Program
}
makeCanvasShader :: GL.Program -> IO CanvasShader
makeCanvasShader p = CanvasShader
<$> (fromList <$> ((get (GL.activeAttribs p) >>= mapM (aux (GL.attribLocation p)))))
<*> (fromList <$> ((get (GL.activeUniforms p)
>>= mapM (aux (GL.uniformLocation p) . on3 trimArray))))
<*> (pure p)
where aux f (_,t,name) = get (f name) >>= \l -> return (name, (l, t))
on3 f (a,b,c) = (a, b, f c)
-- An array uniform, foo, is sometimes given the name "foo" and
-- sometimes the name "foo[0]". We strip off the "[0]" if present.
trimArray n = if "[0]" `isSuffixOf` n then L.take (length n - 3) n else n

View File

@ -1,18 +1,29 @@
{-# LANGUAGE TypeFamilies #-}
module Types.Sprite where
import Data.Maybe (maybe)
import qualified Data.Map.Strict as M
import SDL (get, ($=))
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLU
import qualified Graphics.GL.Core33 as GLRaw
-- import qualified Graphics.GLUtil as GLU
import Codec.Picture
import Linear
import Foreign.Ptr
import Foreign.Marshal.Utils (with)
import Unsafe.Coerce (unsafeCoerce)
-- internal imports
import Classes.Renderable
import Types.CanvasShader
data SpriteRenderObjects = SpriteRenderObjects
{ roVAO :: GL.VertexArrayObject
@ -20,7 +31,7 @@ data SpriteRenderObjects = SpriteRenderObjects
}
data SpriteShaderObjects = SpriteShaderObjects
{ soProgram :: GLU.ShaderProgram
{ soProgram :: CanvasShader
}
data Sprite = Sprite
@ -35,20 +46,19 @@ instance Renderable Sprite where
init
(SpriteRenderObjects vao vbo)
(SpriteShaderObjects prog)
(SpriteShaderObjects (CanvasShader att uni prog))
texture
_ = do
GL.currentProgram $= Just (GLU.program prog)
GL.currentProgram $= Just prog
GL.bindVertexArrayObject $= Just vao
GL.activeTexture $= GL.TextureUnit 0
GL.textureBinding GL.Texture2D $= Just texture
GL.clearColor $= GL.Color4 1 1 1 1
-- let projection = ortho (-960) 960 (-540) 540 (-1) 1 :: M44 Float
-- GLU.setUniform prog "projection" (projection)
draw
(SpriteRenderObjects vao vbo)
(SpriteShaderObjects prog)
(SpriteShaderObjects (CanvasShader att uni prog))
(Sprite pos@(V2 px py) size) = do
let (V2 sx sy) = fmap fromIntegral size
model = fmap (fmap fromIntegral) $ V4
@ -59,8 +69,15 @@ instance Renderable Sprite where
:: M44 Float
projection = ortho (-960) 960 (-540) 540 (-1) 1
-- putStrLn $ show model
GLU.setUniform prog "pm" (projection !*! model)
maybe
(const (putStrLn warn >> return ()))
(flip asUniform . fst)
(M.lookup "pm" uni)
(projection !*! model)
GL.drawArrays GL.Triangles 0 6
where
warn = "WARNING: uniform pm is not active"
v `asUniform` loc = with v $ GLRaw.glUniformMatrix4fv (unsafeCoerce loc) 1 1 . castPtr
clean _ = do
GL.currentProgram $= (Nothing :: Maybe GL.Program)

View File

@ -45,11 +45,11 @@ data Subsystems = Subsystems
, subMouse :: SubMouse
}
newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData ())])
newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection UserData ())])
newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection ())])
newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection ())])
instance Participant SubWindow UserData where
type Mesg SubWindow UserData = WindowMessage
instance Participant SubWindow where
type Mesg SubWindow = WindowMessage
partSubscribers (SubWindow t) = genericSubscribers t
@ -57,11 +57,11 @@ instance Participant SubWindow UserData where
partUnSubscribe (SubWindow t) = genericUnSubscribe t
instance SDLSubsystem SubWindow UserData where
instance SDLSubsystem SubWindow where
consumeSDLEvents = consumeSDLWindowEvents
instance Participant SubMouse UserData where
type Mesg SubMouse UserData = MouseMessage
instance Participant SubMouse where
type Mesg SubMouse = MouseMessage
partSubscribers (SubMouse t) = genericSubscribers t
@ -69,29 +69,29 @@ instance Participant SubMouse UserData where
partUnSubscribe (SubMouse t) = genericUnSubscribe t
instance SDLSubsystem SubMouse UserData where
instance SDLSubsystem SubMouse where
consumeSDLEvents = consumeSDLMouseEvents
genericSubscribers
:: TVar [(UUID, msg -> Affection UserData ())]
-> Affection UserData [(msg -> Affection UserData ())]
:: TVar [(UUID, msg -> Affection ())]
-> Affection [(msg -> Affection ())]
genericSubscribers t = do
subTups <- liftIO $ readTVarIO t
return $ map snd subTups
genericSubscribe
:: TVar [(UUID, msg -> Affection UserData ())]
-> (msg -> Affection UserData ())
-> Affection UserData UUID
:: TVar [(UUID, msg -> Affection ())]
-> (msg -> Affection ())
-> Affection UUID
genericSubscribe t funct = do
uu <- genUUID
liftIO $ atomically $ modifyTVar' t ((uu, funct) :)
return uu
genericUnSubscribe
:: TVar [(UUID, msg -> Affection UserData ())]
:: TVar [(UUID, msg -> Affection ())]
-> UUID
-> Affection UserData ()
-> Affection ()
genericUnSubscribe t uu =
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
where

View File

@ -26,12 +26,11 @@ executable canvas
Renderer
-- other-extensions:
ghc-options: -Wall
build-depends: base ^>=4.12.0.0
build-depends: base >= 4.12.0.0 && < 5
, affection
, sdl2 ^>=2.5.0.0
, OpenGL
, OpenGLRaw
, GLUtil
, JuicyPixels
, JuicyPixels-extra
, stm

View File

@ -1,45 +0,0 @@
{
"affection": {
"branch": "master",
"description": "A simple Game Engine in Haskell using SDL",
"homepage": "",
"owner": "nek0",
"repo": "affection",
"rev": "18775515d8d569c36148c02a134e1f538981b1ff",
"sha256": "09bxf917mj1lanc0d5f7xj3n22dk8drzgqivqpnvskdx88pmrv4k",
"type": "tarball",
"url": "https://github.com/nek0/affection/archive/18775515d8d569c36148c02a134e1f538981b1ff.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"ghc": {
"sha256": "1pqlx6rdjs2110g0y1i9f8x18lmdizibjqd15f5xahcz39hgaxdw",
"type": "file",
"url": "https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-deb9-linux.tar.xz",
"url_template": "https://downloads.haskell.org/~ghc/<version>/ghc-<version>-x86_64-deb9-linux.tar.xz",
"version": "8.6.5"
},
"niv": {
"branch": "master",
"description": "Easy dependency management for Nix projects",
"homepage": "https://github.com/nmattia/niv",
"owner": "nmattia",
"repo": "niv",
"rev": "7a21f49027c0901456acd6e61d91bd9e3b15b1f6",
"sha256": "1hrcjgz4ib5n6wm96gcjk2qjl03pvspksk48b2lkn29vpdry98jm",
"type": "tarball",
"url": "https://github.com/nmattia/niv/archive/7a21f49027c0901456acd6e61d91bd9e3b15b1f6.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"nixpkgs": {
"branch": "nixos-19.09",
"description": "A read-only mirror of NixOS/nixpkgs tracking the released channels. Send issues and PRs to",
"homepage": "https://github.com/NixOS/nixpkgs",
"owner": "NixOS",
"repo": "nixpkgs-channels",
"rev": "d3d2de8b99be56c5a6ed18f46e280f8103124dd7",
"sha256": "1chzbajrspw24csnv2c0h1h59pbp1k6939cllmd61382p9iw7rg8",
"type": "tarball",
"url": "https://github.com/NixOS/nixpkgs-channels/archive/d3d2de8b99be56c5a6ed18f46e280f8103124dd7.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}
}

View File

@ -1,134 +0,0 @@
# This file has been generated by Niv.
let
#
# The fetchers. fetch_<type> fetches specs of type <type>.
#
fetch_file = pkgs: spec:
if spec.builtin or true then
builtins_fetchurl { inherit (spec) url sha256; }
else
pkgs.fetchurl { inherit (spec) url sha256; };
fetch_tarball = pkgs: spec:
if spec.builtin or true then
builtins_fetchTarball { inherit (spec) url sha256; }
else
pkgs.fetchzip { inherit (spec) url sha256; };
fetch_git = spec:
builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
fetch_builtin-tarball = spec:
builtins.trace
''
WARNING:
The niv type "builtin-tarball" will soon be deprecated. You should
instead use `builtin = true`.
$ niv modify <package> -a type=tarball -a builtin=true
''
builtins_fetchTarball { inherit (spec) url sha256; };
fetch_builtin-url = spec:
builtins.trace
''
WARNING:
The niv type "builtin-url" will soon be deprecated. You should
instead use `builtin = true`.
$ niv modify <package> -a type=file -a builtin=true
''
(builtins_fetchurl { inherit (spec) url sha256; });
#
# Various helpers
#
# The set of packages used when specs are fetched using non-builtins.
mkPkgs = sources:
let
sourcesNixpkgs =
import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) {};
hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;
hasThisAsNixpkgsPath = <nixpkgs> == ./.;
in
if builtins.hasAttr "nixpkgs" sources
then sourcesNixpkgs
else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then
import <nixpkgs> {}
else
abort
''
Please specify either <nixpkgs> (through -I or NIX_PATH=nixpkgs=...) or
add a package called "nixpkgs" to your sources.json.
'';
# The actual fetching function.
fetch = pkgs: name: spec:
if ! builtins.hasAttr "type" spec then
abort "ERROR: niv spec ${name} does not have a 'type' attribute"
else if spec.type == "file" then fetch_file pkgs spec
else if spec.type == "tarball" then fetch_tarball pkgs spec
else if spec.type == "git" then fetch_git spec
else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec
else if spec.type == "builtin-url" then fetch_builtin-url spec
else
abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";
# Ports of functions for older nix versions
# a Nix version of mapAttrs if the built-in doesn't exist
mapAttrs = builtins.mapAttrs or (
f: set: with builtins;
listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))
);
# fetchTarball version that is compatible between all the versions of Nix
builtins_fetchTarball = { url, sha256 }@attrs:
let
inherit (builtins) lessThan nixVersion fetchTarball;
in
if lessThan nixVersion "1.12" then
fetchTarball { inherit url; }
else
fetchTarball attrs;
# fetchurl version that is compatible between all the versions of Nix
builtins_fetchurl = { url, sha256 }@attrs:
let
inherit (builtins) lessThan nixVersion fetchurl;
in
if lessThan nixVersion "1.12" then
fetchurl { inherit url; }
else
fetchurl attrs;
# Create the final "sources" from the config
mkSources = config:
mapAttrs (
name: spec:
if builtins.hasAttr "outPath" spec
then abort
"The values in sources.json should not have an 'outPath' attribute"
else
spec // { outPath = fetch config.pkgs name spec; }
) config.sources;
# The "config" used by the fetchers
mkConfig =
{ sourcesFile ? ./sources.json
, sources ? builtins.fromJSON (builtins.readFile sourcesFile)
, pkgs ? mkPkgs sources
}: rec {
# The sources, i.e. the attribute set of spec name to spec
inherit sources;
# The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
inherit pkgs;
};
in
mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }

View File

@ -1,6 +1,74 @@
{ pkgs ? import <nixpkgs> {} }:
{ nixpkgs ? import <nixpkgs> {}, compiler ? "default", doBenchmark ? false }:
let
hsPkgs = import ./default.nix;
inherit (nixpkgs) pkgs;
affection = with haskellPackages; callPackage(
{ mkDerivation, base, bytestring, clock, containers, glib, linear
, monad-loops, monad-parallel, mtl, OpenGL, sdl2, stdenv, stm, text
, uuid, vector
}:
mkDerivation {
pname = "affection";
version = "0.0.0.10";
src = ../affection;
isLibrary = true;
isExecutable = true;
libraryHaskellDepends = [
base bytestring clock containers glib linear monad-loops
monad-parallel mtl OpenGL sdl2 stm text uuid vector
];
homepage = "https://github.com/nek0/affection#readme";
description = "A simple Game Engine using SDL";
license = stdenv.lib.licenses.lgpl3;
doHaddock = false;
}) {};
#GLUtil = with haskellPackages; callPackage(
# { mkDerivation, array, base, bytestring, containers, directory
# , filepath, hpp, JuicyPixels, linear, OpenGL, OpenGLRaw, stdenv
# , transformers, vector
# }:
# mkDerivation {
# pname = "GLUtil";
# version = "0.10.3";
# sha256 = "1933540d309209fb90f0632336ee6c54e160a12da8508dadaf16882a2358ec27";
# libraryHaskellDepends = [
# array base bytestring containers directory filepath hpp JuicyPixels
# linear OpenGL OpenGLRaw transformers vector
# ];
# libraryToolDepends = [ hpp ];
# description = "Miscellaneous OpenGL utilities";
# license = stdenv.lib.licenses.bsd3;
# }) {};
f = { mkDerivation, base, bytestring, containers
, JuicyPixels, JuicyPixels-extra, linear, OpenGL, OpenGLRaw
, random, sdl2, stdenv, stm
}:
mkDerivation {
pname = "canvas";
version = "0.0.0.0";
src = ./.;
isLibrary = false;
isExecutable = true;
executableHaskellDepends = [
affection base bytestring containers JuicyPixels
JuicyPixels-extra linear OpenGL OpenGLRaw random sdl2 stm
];
description = "A test implementation for drawing images with SDL2 and OpenGL";
license = stdenv.lib.licenses.bsd3;
};
haskellPackages = if compiler == "default"
then pkgs.haskellPackages
else pkgs.haskell.packages.${compiler};
variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
drv = variant (haskellPackages.callPackage f {});
in
hsPkgs.canvas.components.all
if pkgs.lib.inNixShell then drv.env else drv