{-# OPTIONS -Wall #-} module Main where import Control.Monad (unless, void, when) import Numeric (showFFloat) import Raylib.Core ( beginDrawing, beginMode3D, changeDirectory, clearBackground, closeWindow, disableCursor, endDrawing, endMode3D, getApplicationDirectory, getFrameTime, initWindow, isKeyDown, loadShader, setShaderValue, setTargetFPS, ) import Raylib.Core.Camera (updateCamera) import Raylib.Core.Models (drawModel, drawSphereWires, genMeshCube, genMeshPlane, genMeshSphere, loadModelFromMesh) import Raylib.Core.Text (drawText) import Raylib.Types ( Camera3D (Camera3D, camera3D'position), CameraMode (CameraModeFirstPerson), CameraProjection (CameraPerspective), KeyboardKey (KeyH, KeyJ, KeyU, KeyY), ShaderUniformData ( ShaderUniformFloat, ShaderUniformVec3, ShaderUniformVec4 ), Vector3 (Vector3), Vector4 (Vector4, vector4'w), vectorToColor, ) import Raylib.Util (inGHCi, setMaterialShader, whileWindowOpen_) import Raylib.Util.Colors (black, blue, lightGray, orange, white) assetsPath :: String assetsPath = (if not inGHCi then "../../../../../../../../../" else "./") ++ "examples/basic-shaders/assets/" main :: IO () main = do window <- initWindow 1300 800 "raylib [shaders] example - basic shaders" setTargetFPS 60 disableCursor unless inGHCi (void $ changeDirectory =<< getApplicationDirectory) let camera = Camera3D (Vector3 1 3 3) (Vector3 1 0 1) (Vector3 0 1 0) 45 CameraPerspective shader <- loadShader (Just $ assetsPath ++ "lighting.vert") (Just $ assetsPath ++ "lighting.frag") window let pointLightPosition = Vector3 0 3 2 let pointLightColor = Vector4 1 1 1 1 let pointLightStrength = 1.0 let specularStrength = 0.5 let ambientLightColor = Vector4 1 1 0 1 let ambientStrength = 0.1 setShaderValue shader "pointLightPosition" (ShaderUniformVec3 pointLightPosition) window setShaderValue shader "pointLightColor" (ShaderUniformVec4 pointLightColor) window setShaderValue shader "pointLightStrength" (ShaderUniformFloat pointLightStrength) window setShaderValue shader "specularStrength" (ShaderUniformFloat specularStrength) window setShaderValue shader "ambientLightColor" (ShaderUniformVec4 ambientLightColor) window setShaderValue shader "ambientStrength" (ShaderUniformFloat ambientStrength) window cubeMesh <- genMeshCube 2 2 2 window cubeModel' <- loadModelFromMesh cubeMesh window let cubeModel = setMaterialShader cubeModel' 0 shader sphereMesh <- genMeshSphere 0.5 32 32 window sphereModel' <- loadModelFromMesh sphereMesh window let sphereModel = setMaterialShader sphereModel' 0 shader planeMesh <- genMeshPlane 100 100 20 20 window planeModel' <- loadModelFromMesh planeMesh window let planeModel = setMaterialShader planeModel' 0 shader whileWindowOpen_ ( \(c, ls, ss) -> do beginDrawing clearBackground black beginMode3D c drawModel cubeModel (Vector3 0 1 0) 1 orange drawModel sphereModel (Vector3 2 0.5 2) 1 blue drawModel planeModel (Vector3 0 0 0) 1 lightGray drawSphereWires pointLightPosition 0.25 12 12 $ vectorToColor (pointLightColor {vector4'w = ls / 3}) endMode3D yDown <- isKeyDown KeyY hDown <- isKeyDown KeyH uDown <- isKeyDown KeyU jDown <- isKeyDown KeyJ frameTime <- getFrameTime let newLightStrength = clamp (ls + change * frameTime) 0 3 where change | yDown = 1 | hDown = -1 | otherwise = 0 let newSpecularStrength = clamp (ss + change * frameTime) 0 2 where change | uDown = 1 | jDown = -1 | otherwise = 0 when (yDown || hDown) $ setShaderValue shader "pointLightStrength" (ShaderUniformFloat newLightStrength) window when (uDown || jDown) $ setShaderValue shader "specularStrength" (ShaderUniformFloat newSpecularStrength) window drawText "Press the Y and H keys to increase and decrease the diffuse strength." 10 10 20 white drawText ("Current diffuse strength: " ++ showFFloat (Just 2) newLightStrength "") 10 40 20 white drawText "Press the U and J keys to increase and decrease the specular strength." 10 80 20 white drawText ("Current specular strength: " ++ showFFloat (Just 2) newSpecularStrength "") 10 110 20 white endDrawing newCam <- updateCamera c CameraModeFirstPerson setShaderValue shader "viewPos" (ShaderUniformVec3 $ camera3D'position newCam) window return (newCam, newLightStrength, newSpecularStrength) ) (camera, pointLightStrength, specularStrength) closeWindow window clamp :: Float -> Float -> Float -> Float clamp x l h = min h (max x l)