From 481a919763effbc8ba4213581b065484acf3e31d Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 2 Feb 2019 22:45:57 +0100 Subject: [PATCH] meow --- ibis.cabal | 3 ++ shell.nix | 10 +++-- src/.Draw.hs.swp | Bin 0 -> 12288 bytes src/.Main.hs.swp | Bin 0 -> 16384 bytes src/.Types.hs.swp | Bin 0 -> 12288 bytes src/Draw.hs | 102 ++++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 45 +++++++++++++------- src/Types.hs | 14 ++++++- 8 files changed, 154 insertions(+), 20 deletions(-) create mode 100644 src/.Draw.hs.swp create mode 100644 src/.Main.hs.swp create mode 100644 src/.Types.hs.swp diff --git a/ibis.cabal b/ibis.cabal index 9ea0f84..45b3cff 100644 --- a/ibis.cabal +++ b/ibis.cabal @@ -20,6 +20,7 @@ executable ibis other-modules: Events , Util , Types + , Draw -- other-extensions: default-extensions: OverloadedStrings build-depends: base >=4.11 @@ -30,9 +31,11 @@ executable ibis , linear , monad-loops , OpenGL + , GLUtil , text , magic , split , time + , bytestring hs-source-dirs: src default-language: Haskell2010 diff --git a/shell.nix b/shell.nix index 40feffb..07afc4e 100644 --- a/shell.nix +++ b/shell.nix @@ -28,8 +28,8 @@ let inherit (nixpkgs) pkgs; - f = { mkDerivation, base, containers, linear, magic, monad-loops, - optparse-applicative, OpenGL, poppler, split, stdenv, text, time + f = { mkDerivation, base, bytestring, containers, linear, magic, monad-loops, + optparse-applicative, OpenGL, GLUtil, poppler, split, stdenv, text, time }: mkDerivation { pname = "ibis"; @@ -37,8 +37,10 @@ let src = ./.; isLibrary = false; isExecutable = true; - executableHaskellDepends = [ base containers linear sdl2 magic - monad-loops OpenGL optparse-applicative poppler split text time ]; + executableHaskellDepends = [ base bytestring containers linear sdl2 magic + monad-loops OpenGL GLUtil optparse-applicative poppler split text + time + ]; description = "A pdf presenter"; license = stdenv.lib.licenses.gpl3; }; diff --git a/src/.Draw.hs.swp b/src/.Draw.hs.swp new file mode 100644 index 0000000000000000000000000000000000000000..30c95fe221ef8fa9efcd509cf08b4c356d96e811 GIT binary patch literal 12288 zcmeI2U2GIp6vriDO4^D$IupK-MHh>mz^&TOvfXm<#_#Au&-Usi23*asA3OEZwV1r@M4W0m9 zAO#)(E#TixLi`Q>0>6Oo!3W?Xcp3QM0N4lw_;sTYKZBpZMNkJ3I1ILfD|ZX=1Nant z3_b$qz$q{Qo&ryT^`2b+L7i~>f11qJB($5BC)q12gFd}iYtX)1fq4Jf;Y^^Ruk zT21=SG3xEh;&)HeWQCPrmaLKrszZJx%gXl1b)+BB4zfCE_ih^S0y|2l(~G*NGL*|c z%75+5P)9bG-jhT)6SxjlZP&NbbUJC{Q(GI)BdA9@7-|l%(Ur|6DYb1zs?ZI5>g>!> zF;FrkN|;L(F^yJiN2(;gZYl+yIG7mH+5+dkrp=1Hce{Kd1j(*zA^ZpS9{_m#a$z(IR;=5$IN>S>z1DEE7b@sIGjn(hz4bpLOtCxgMqLxsdP1lxzEC zPll9RvanjolYTj>(22V3^aYSRaZqr5XF|_FyBRJVm&J%$yU7cJ>3S{6xD`edJ;Nb| z5qHCi;-fZGMG9&vI8Ix4Y^51j&gzS5;7D)5Ot;7WdZ6?~CxXMD^vahD{j?hlP@NuA zwjY)PRgF_*9je=rR6Z|(jwUb79%DD2jN-CRy3h$Y7!J@@q=oYKhg6F6#xy%i1_{s8E)E zyeyuvt5UeW%WI)I@J3V9M&@Wa@(epzw!ZW{h|XY8F0y5JfA26dEj`J#rng=yNfi&N zEl$H?LR-WkE-^?18O+bfLcj`f<~(VuxCnFB(4ud4>9yB^C4g8L8skEnbmipik0V*K zsUG7l<9_Ited(ZPlVA6|kw|ezBG#Q}1DmD^_sg)T+**XUK_@@bLm`SrSMFo+gRwwA z5<2`O6%p!SVI*+zdQf^2J-Q{|C|1}+t=;kHjq#HRc=@_ly@KS{4^`69hyS6&<|w63^nlbOd;xK)jG{amV0vW8gUWfHBTP3&($nZ{OZ zUgy`E6~=O8EvgLE{UR4AtrZ&cG7R-z9n52Ap}O!U#Wiw?y}7Vg;uma3hVV7f36&-( zhnFW`^P8fPweCfC@G;2?;wa}ZcEE)c{V;ianV>bJOKaorxFvoXTXM@}Vjs8X^boNW z@o@1q52m%nXl}KJI!YONayFM39KYDM)|-2?-=_pb*6OS9RN-eaw;@ zpla!JKdS1lzrO!b)zv;c*RD0_l5^g|@j=V_?Vt9aefr@~SZ5!%tUwOW@#Fg)BQF_> zGz`4%$u*y2fh&_R9ww3K%9SmV45ja{c!yrHlEmGWhVTMsken>Vlo|#M1MirDaoStH z^oVuw!g&?b3xzZE_+$I;Sd3|47%&VN1`Gp+0mFb{z%XDKFbw?fGLS|OSYL$t4`f5& zYd+qkPt)_ev-^j$^U-bP*{wMl1`Gp+0mFb{z%XDKFbo(53GHFz{c(J{}-T=V&|NQ;`caK`uFM-#A?*q>Rp8+lb9|QjQ0n7RW@MGXdz&C&wfm^_rfCvbI zXMm@Hb>KnQL zhk(<-Dd3;)x2(5-zW~1nUIktTnm`S(fk%O#zR$A03bcU|umYR{{(2g^00Gbj3c!QF zFHTw3cY$vLec&nJA>h~86!|uA3n&Atz>~mZz@OiXF#@ju&jS-+1PI^&SOfm?kY#-b zxCLAV9N-Dy_4ioTOTbOQ14_VK4`NKfo4^~uYru=Z3&2ev2HLUf_lkawrMhB2By?v52nA z_>e-=+q>QAXXObj7 z#!IY1Sw`uAJI?M~sSLWFub*7AwDgfsqn6j9{gwz^U&a)VgCec1t`c(*g}z_mQXV`X z{IKsg#88&Taf||HhI#6SK`L)(4l=RN+KQH?tV)rV*U1enqRGJXCDR>C;WpZ!N_A?h zLR`}7G6iy?O7`NhL=#PXlqOWDprhCe`cx0YsDQGpJ60_jgp(5tr`ngjB=W@(OVGO8 zNs-0yQMA+v-5s)`d_-~BkHsh_pzqfLZ%Rk%jaWNAY+ocPEwVP$!xei>F7CX=HCoD5 zaH)M}Zjd$}vM3&SU#1zgds_J1(79_*_})!cUP;l4b6*gV>mSQ>90!!sk6Wz>F1Uy4 zzLR*P$d|2waAmxs2Y98$B*TXKDcQYP^hdC8cCT#7a&kgg6jM+3)X<%ojhR8N;X&nU z9nCW0X05oSz0pL3fv(#kOd0CfXyI$nmB$@!mYW*T2 z+3CgMsP4fM2VArfDCR`6M0}ftLkp2Ul*u(77i4uWvj*GfvR%zx zp7qGQpPQ>3()U$mS<+FFXAye`HhDerWzbIt zN}c+-neiP>OFq><`(*r9>{oU&rC6#>hhH5v{Cg7wigOYC+l;j@JTL z%6BmwK5uzJx~syu#qBa#=m8Pf9mwvGbaVQg?gb@8s~=tGIiZAzZl3NUg9)xZw*z^;vFMK8z>Gz zqz5&p_RPX|VMip1bYYIs2s15l24i1`QIgAW%k(( zZg}aY@O-#T{^*#-@Et)riRgjzE9)U|$nK7a6VzUWpkAn0WbZ*}AT|cl zk7Qi5M)+4TvIUk>>I!M8)+D=#HT5V8%HxlCT6bD(cd|3{&xEP0(en^%syXIM5(%}Y5^gKsL*nBKd(#R$X~&_DwYy5+ zu%W|C(L2f;VIW+GSD{JHXWmp5O&c_Im^&M}PhX#nM`uk-@vJR0(=S_RKshW~rqX8R z)mTIWubVj4IvbKlQN^EJGuz&!o=#A(jgzf2xJ8|8^}e!1J%5}GmZ-#UFZxBnb{xd# zof0`O?23tVMI?wYNWp`9*Qx~L(S0kmvA_(oT4eWq*loJbDc)5!-Yr9Sj3opAlb-Vj za?$6P7pT6mUESZPR_KZd`a1%l7b8j*mcL-}`~TZ`C;vF!>G}O1udM3$8}5Gv{0#UB z@Djj#0G|a^-K?HD83qgkh5^HXVZbn87%&VN1`Gp+0mFb{;QxmK-qyO~nES|f{|}`4 zJDdKF%KKc$cC~r$ppWe>>~2rLk6@EJ`+7LrMJ%W)+&nAQyJLFW4WAX%KD?zB)iPTX S5$WymtjDYrpF`EwhV^gb;s-VW literal 0 HcmV?d00001 diff --git a/src/.Types.hs.swp b/src/.Types.hs.swp new file mode 100644 index 0000000000000000000000000000000000000000..aa830203dee2680e701e3602f6f738333d2b5996 GIT binary patch literal 12288 zcmeI2KW`H;6u?~u#8N;oF=1e7rE=HOrK-fx1bTpiQjtFu|0J9{=g!ULe6^iktEjN? z0boLcoln3}J^_3I76!yhJFqbG>|BGWs-kXGdX|3j#qas~`4?rVdY#$!-TQRGn$uM}Ax)B;&nVyZo=w7rMuc%tUx}=5t%nFQn?}oQ2%K!*q|QsV_Q0`&xy5 zb1UcCOZ3rYFp37yz;O)>O!xZ2B$>Z4=YG@Iu3n)RFSL$Z1@qAW8bAYR01co4G=K)s z02(;K224IdUO@k+$~#;x=ZOPz`4J~HfCkV28bAYR01co4G=K)s02)98Xy61IU=bk` zlZ3nh?EnAw|Nh@QN60Sl5!eA<1FrxDtOJjLhd>3G0w#f9X9@WRd<8xOpMVd*TVM!0 z1LlF#z)v`D57-6106V}t!1nPTcnRP@184vZpaC?12G9T+Km%w14g9wTDBY$JS7JkC zF`a58vY1Yc$@QY|7e(PEqxYRXsbW8oGEO-?YHSlqXJ{;LSL$?ekp?xdGU#@>s(03S zXdpO*VEgc3#0-NS8@waw&GLc3mQhV@+T)@&#T}&0ijuKneQi&BJhduSG(&@y*GL## zstis)EtA_z^}iEqUYje!Hu~*M| X7S!C18X + GL.bufferData GL.ArrayBuffer $= + ( fromIntegral $ length quadCoord * sizeOf (0 :: Float) + , ptr + , GL.StaticDraw + ) + + elementBufferObject <- GL.genObjectName + GL.bindBuffer GL.ElementArrayBuffer $= Just elementBufferObject + + withArray quadIndices $ \ptr -> + GL.bufferData GL.ElementArrayBuffer $= + ( fromIntegral $ length quadIndices * sizeOf (0 :: Word) + , ptr + , GL.StaticDraw + ) + + GL.vertexAttribPointer (GL.AttribLocation 0) $= + ( GL.ToFloat + , GL.VertexArrayDescriptor 3 GL.Float 0 nullPtr + ) + + GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr + + GL.clearColor $= (GL.Color4 0 0 1 1 :: GL.Color4 Float) + + return GLvebo + { giVBO = vertexBufferObject + , giEBO = elementBufferObject + } + +initVAO :: Word -> IO (Word, GL.VertexArrayObject) +initVAO ident = do + vertexArrayObject <- GL.genObjectName + GL.bindVertexArrayObject $= Just vertexArrayObject + return (ident, vertexArrayObject) + draw :: MVar State -> Word -> IO () draw state ident = do + st <- readMVar state + GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $ + stPrograms st) + -- let proj = ortho (-1) 1 (-1) (1) (-1) 1 + -- model = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 0 0 0) + -- view = lookAt (V3 0 0 0) (V3 0 0 0) (V3 0 0 0) + -- pvm = proj !*! view !*! model + GL.bindVertexArrayObject $= lookup ident (stVAOs st) + GL.drawArrays GL.Triangles 0 (fromIntegral $ length quadCoord) return () + +vertexShader :: BS.ByteString +vertexShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty + [ "#version 330 core" + , "" + , "layout (location = 0) in vec3 pos;" + , "" + , "void main() {" + , " gl_Position = vec4(pos.x, pos.y, pos.z, 1.0);" + , "}" + ] + +fragmentShader :: Word -> BS.ByteString +fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty + [ "#version 330 core" + , "" + -- , "out vec4 gl_FragColor;" + , "" + , "void main() {" + , " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);" + , "}" + ] diff --git a/src/Main.hs b/src/Main.hs index a7ec4d7..470771f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -8,6 +8,8 @@ import qualified SDL.Raw.Basic as SDL import qualified Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..)) +import qualified Graphics.GLUtil as GU + -- import qualified NanoVG as NVG import Linear @@ -39,6 +41,8 @@ import Magic import Events +import Draw + import Util import Types @@ -88,33 +92,44 @@ main = do mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . snd) wins void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1 verb opts "Creating OpenGL context(s)" - contexts <- zip (map fst wins) <$> mapM (SDL.glCreateContext . snd) wins + context <- (SDL.glCreateContext . snd) (head wins) -- verb opts "Creating NanoVG context" -- _ <- glewInit -- nano <- NVG.createGL3 (S.fromList [NVG.Antialias, NVG.StencilStrokes]) - verb opts "Initializing state" - state <- newMVar <$> ( - State <$> - pure 1 <*> - pure (last $ map fst wins) <*> - getCurrentTime + verb opts "Initializing rendering pipeline" + glInits <- mapM (initVAO . fst) wins + vebo <- initGL + programs <- mapM (\(ident, _) -> do + ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident) + return (ident, ret) ) + wins + verb opts "Initializing state" + time <- getCurrentTime + state <- newMVar ( + State + 1 + (last $ map fst wins) + time + glInits + programs + vebo + ) verb opts "Displaying window(s)" mapM_ (SDL.showWindow . snd) wins verb opts "Entering Loop" run <- newMVar True whileM_ (readMVar run) (do - mapM_ (\(ident, context) -> do - let win = fromJust (lookup ident wins) - SDL.glMakeCurrent win context + mapM_ (\(ident, window) -> do + SDL.glMakeCurrent window context mapM_ (eventHandler run) =<< SDL.pollEvents GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] - draw state + draw state ident GL.flush - SDL.glSwapWindow win - ) contexts + SDL.glSwapWindow window + ) wins ) - verb opts "Deleting context(s)" - mapM_ (SDL.glDeleteContext . snd) contexts + verb opts "Deleting context" + SDL.glDeleteContext context verb opts "Destroying window(s)" mapM_ (SDL.destroyWindow . snd) wins diff --git a/src/Types.hs b/src/Types.hs index 1c87915..222b7fb 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,5 +1,9 @@ module Types where +import qualified Graphics.Rendering.OpenGL as GL + +import qualified Graphics.GLUtil as GU + import qualified Data.Text as T import Data.Time.Clock @@ -16,4 +20,12 @@ data State = State { stCurrentPage :: Word , stPresentationWindow :: Word , stStartTime :: UTCTime - } deriving (Show) + , stVAOs :: [(Word, GL.VertexArrayObject)] + , stPrograms :: [(Word, GU.ShaderProgram)] + , stVEBO :: GLvebo + } + +data GLvebo = GLvebo + { giVBO :: GL.BufferObject + , giEBO :: GL.BufferObject + }