h-raylib-4.5.3.1: examples/basic-shaders/src/Main.hs

{-# OPTIONS -Wall #-}

module Main where

import Control.Monad (when)
import Raylib.Core
  ( beginDrawing,
    beginMode3D,
    changeDirectory,
    clearBackground,
    closeWindow,
    disableCursor,
    endDrawing,
    endMode3D,
    getApplicationDirectory,
    getFrameTime,
    initWindow,
    isKeyDown,
    loadShader,
    setShaderValue,
    setTargetFPS,
    updateCamera
  )
import Raylib.Core.Models (drawModel, genMeshCube, loadModelFromMesh, genMeshSphere, genMeshPlane, drawSphereWires)
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 (whileWindowOpen_, setMaterialShader)
import Raylib.Util.Colors (black, orange, white, blue, lightGray)
import Numeric (showFFloat)

assetsPath :: String
assetsPath = "../../../../../../../../../examples/basic-shaders/assets/"

main :: IO ()
main = do
  initWindow 1300 800 "raylib [shaders] example - basic shaders"
  setTargetFPS 60
  disableCursor
  _ <- 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")

  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)
  setShaderValue shader "pointLightColor" (ShaderUniformVec4 pointLightColor)
  setShaderValue shader "pointLightStrength" (ShaderUniformFloat pointLightStrength)
  setShaderValue shader "specularStrength" (ShaderUniformFloat specularStrength)
  setShaderValue shader "ambientLightColor" (ShaderUniformVec4 ambientLightColor)
  setShaderValue shader "ambientStrength" (ShaderUniformFloat ambientStrength)

  cubeMesh <- genMeshCube 2 2 2
  cubeModel' <- loadModelFromMesh cubeMesh
  let cubeModel = setMaterialShader cubeModel' 0 shader

  sphereMesh <- genMeshSphere 0.5 32 32
  sphereModel' <- loadModelFromMesh sphereMesh
  let sphereModel = setMaterialShader sphereModel' 0 shader

  planeMesh <- genMeshPlane 100 100 20 20
  planeModel' <- loadModelFromMesh planeMesh
  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)
        when (uDown || jDown) $ setShaderValue shader "specularStrength" (ShaderUniformFloat newSpecularStrength)

        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)

        return (newCam, newLightStrength, newSpecularStrength)
    )
    (camera, pointLightStrength, specularStrength)

  closeWindow

clamp :: Float -> Float -> Float -> Float
clamp x l h = min h (max x l)