This commit is contained in:
mtgmonkey
2025-12-02 20:30:03 +01:00
parent d5719e36ba
commit e8b088312c
6 changed files with 38 additions and 5 deletions

BIN
assets/awesomeface.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 43 KiB

BIN
assets/flag.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 62 KiB

BIN
assets/parrots.jpg Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 MiB

View File

@@ -35,8 +35,8 @@
];
ghcPackages = p: [
p.GLFW-b
p.GLUtil
p.linear
p.linear-opengl
p.OpenGL
p.relude
];

View File

@@ -7,6 +7,7 @@ module Haskengl.IO (openWindow, shutdownWindow, view) where
import qualified Graphics.Rendering.OpenGL as GL
import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.GLUtil as GLU (readTexture, texture2DWrap)
import qualified Graphics.UI.GLFW as GLFW
import qualified Language.GLSL as GLSL
import qualified Linear as L
@@ -83,6 +84,14 @@ testArray =
, GL.Vertex3 0.5 0.5 0
]
verticesUVArray :: [GL.Vertex2 GL.GLfloat]
verticesUVArray =
[ GL.Vertex2 0 0
, GL.Vertex2 1 0
, GL.Vertex2 0 1
, GL.Vertex2 1 1
]
generateRGBA :: Int -> [GL.Color4 GL.GLfloat]
generateRGBA i =
take i $ cycle rgba
@@ -123,6 +132,7 @@ createDisplayableObject array numComponents primitiveMode = do
GL.bindVertexArrayObject $= Just vao
vbo_0 <- createVBO array numComponents $ GL.AttribLocation 0
vbo_1 <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1
vbo_2 <- createVBO verticesUVArray 2 $ GL.AttribLocation 2
return
(DisplayableObject
vao
@@ -132,6 +142,13 @@ createDisplayableObject array numComponents primitiveMode = do
primitiveMode
)
loadTexture :: FilePath -> IO GL.TextureObject
loadTexture f = do
Right t <- GLU.readTexture f
GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Nearest)
GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
return t
initResources :: GLFW.Window -> IO DisplayableObjects
initResources window = do
-- init objects
@@ -142,6 +159,12 @@ initResources window = do
putStrLn (unpack $ GLSL.generateGLSL vertShader)
putStrLn (unpack $ GLSL.generateGLSL fragShader)
GL.activeTexture $= GL.TextureUnit 0
let tex = "assets/flag.png"
tx <- loadTexture tex
GL.texture GL.Texture2D $= GL.Enabled
GL.textureBinding GL.Texture2D $= Just tx
-- load shaders
program <- loadShaders
[ ShaderInfo GL.VertexShader (StringSource $ unpack $ GLSL.generateGLSL vertShader)
@@ -156,7 +179,7 @@ initResources window = do
(w, h) <- GLFW.getFramebufferSize window
let
perspectiveMatrix = toGLMatrix $ L.perspective (78 * 3.141592653 / 180) ((fromIntegral w) / (fromIntegral h)) 0.1 100 L.!*! L.lookAt (L.V3 0 0 (-3)) (L.V3 0 0 0) (L.V3 0 1 0)
perspectiveMatrix = toGLMatrix $ L.perspective (78 * 3.141592653 / 180) ((fromIntegral w) / (fromIntegral h)) 0.1 100 L.!*! L.lookAt (L.V3 0 0 (-2)) (L.V3 0 0 0) (L.V3 0 1 0)
putStrLn $ show perspectiveMatrix
let
@@ -170,6 +193,9 @@ initResources window = do
location0 <- GL.get $ GL.uniformLocation program "projection"
GL.uniform location0 $= projection
location1 <- GL.get $ GL.uniformLocation program "tex"
GL.uniform location1 $= (GL.TextureUnit 0)
putStrLn $ show projection
putStrLn $ show location0

View File

@@ -13,9 +13,11 @@ fragShader :: Program
fragShader =
[ VersionDeclaration 450 Core
, VariableDeclaration Nothing In fragColorOut
, VariableDeclaration Nothing In uv
, VariableDeclaration Nothing Out fragColor
, DangerousExpression "uniform sampler2D tex;"
, MainStart
, VariableAssignment fragColor fragColorOut
, DangerousExpression "fragColor = texture(tex, uv);"
]
vertShader :: Program
@@ -23,11 +25,14 @@ vertShader =
[ VersionDeclaration 450 Core
, VariableDeclaration (Just $ Location 0) In vertexPosition
, VariableDeclaration (Just $ Location 1) In vertexColor
, VariableDeclaration (Just $ Location 2) In uvCoords
, VariableDeclaration Nothing Out fragColorOut
, VariableDeclaration Nothing Out uv
, VariableDeclaration Nothing Uniform projection
, MainStart
, DangerousExpression "gl_Position = projection * vec4(vertexPosition, 1.0);"
, VariableAssignment fragColorOut vertexColor
, VariableAssignment uv uvCoords
]
fragColor = Variable "fragColor" $ GLSLVec4 GLSLFloat
@@ -35,3 +40,5 @@ fragColorOut = Variable "fragColorOut" $ GLSLVec4 GLSLFloat
vertexPosition = Variable "vertexPosition" $ GLSLVec3 GLSLFloat
vertexColor = Variable "vertexColor" $ GLSLVec4 GLSLFloat
projection = Variable "projection" $ GLSLMat4 GLSLFloat
uvCoords = Variable "uvCoords" $ GLSLVec2 GLSLFloat
uv = Variable "uv" $ GLSLVec2 GLSLFloat