{-# OPTIONS -Wall #-} module Main where import Raylib.Core (beginDrawing, beginMode3D, changeDirectory, clearBackground, closeWindow, endDrawing, endMode3D, getApplicationDirectory, initWindow, setTargetFPS) import Raylib.Core.Models (drawGrid) import Raylib.Core.Textures (loadTexture) import Raylib.Types (Camera3D (Camera3D), CameraProjection (CameraPerspective), Color (Color), RLDrawMode (RLQuads), Rectangle (Rectangle), Texture (texture'height, texture'id, texture'width), Vector3 (Vector3)) import Raylib.Util (whileWindowOpen0) import Raylib.Util.Colors (rayWhite, white) import Raylib.Util.RLGL (rlBegin, rlColor4ub, rlEnd, rlNormal3f, rlPopMatrix, rlSetTexture, rlTexCoord2f, rlVertex3f, rlPushMatrix, rlTranslatef, rlRotatef, rlScalef) import Prelude hiding (length) texturePath :: String texturePath = "../../../../../../../../../examples/basic-rlgl/assets/cubicmap_atlas.png" main :: IO () main = do initWindow 650 400 "raylib [rlgl] example - basic rlgl" setTargetFPS 60 _ <- getApplicationDirectory >>= changeDirectory let camera = Camera3D (Vector3 0 10 10) (Vector3 0 0 0) (Vector3 0 1 0) 45 CameraPerspective texture <- loadTexture texturePath whileWindowOpen0 (do beginDrawing clearBackground rayWhite beginMode3D camera drawCubeTexture texture (Vector3 (-2) 2 0) 2 4 2 white drawCubeTextureRec texture (Rectangle 0 (fromIntegral (texture'height texture) / 2.0) (fromIntegral (texture'width texture) / 2.0) (fromIntegral (texture'height texture) / 2.0)) (Vector3 2 1 0) 2 2 2 white drawGrid 10 1 endMode3D endDrawing ) closeWindow drawCubeTexture :: Texture -> Vector3 -> Float -> Float -> Float -> Color -> IO () drawCubeTexture texture (Vector3 x y z) width height length (Color r g b a) = do rlSetTexture $ texture'id texture rlPushMatrix -- NOTE: Transformation is applied in inverse order (scale -> rotate -> translate) rlTranslatef (-1) 0 0 rlRotatef 45 0 1 0 rlScalef 1.5 1.5 1.5 rlBegin RLQuads rlColor4ub r g b a -- Front Face rlNormal3f 0 0 1 -- Normal Pointing Towards Viewer rlTexCoord2f 0 0 >> rlVertex3f (x - width / 2) (y - height / 2) (z + length / 2) -- Bottom Left Of The Texture and Quad rlTexCoord2f 1 0 >> rlVertex3f (x + width / 2) (y - height / 2) (z + length / 2) -- Bottom Right Of The Texture and Quad rlTexCoord2f 1 1 >> rlVertex3f (x + width / 2) (y + height / 2) (z + length / 2) -- Top Right Of The Texture and Quad rlTexCoord2f 0 1 >> rlVertex3f (x - width / 2) (y + height / 2) (z + length / 2) -- Top Left Of The Texture and Quad -- Back Face rlNormal3f 0 0 (-1) -- Normal Pointing Away From Viewer rlTexCoord2f 1 0 >> rlVertex3f (x - width / 2) (y - height / 2) (z - length / 2) -- Bottom Right Of The Texture and Quad rlTexCoord2f 1 1 >> rlVertex3f (x - width / 2) (y + height / 2) (z - length / 2) -- Top Right Of The Texture and Quad rlTexCoord2f 0 1 >> rlVertex3f (x + width / 2) (y + height / 2) (z - length / 2) -- Top Left Of The Texture and Quad rlTexCoord2f 0 0 >> rlVertex3f (x + width / 2) (y - height / 2) (z - length / 2) -- Bottom Left Of The Texture and Quad -- Top Face rlNormal3f 0 1 0 -- Normal Pointing Up rlTexCoord2f 0 1 >> rlVertex3f (x - width / 2) (y + height / 2) (z - length / 2) -- Top Left Of The Texture and Quad rlTexCoord2f 0 0 >> rlVertex3f (x - width / 2) (y + height / 2) (z + length / 2) -- Bottom Left Of The Texture and Quad rlTexCoord2f 1 0 >> rlVertex3f (x + width / 2) (y + height / 2) (z + length / 2) -- Bottom Right Of The Texture and Quad rlTexCoord2f 1 1 >> rlVertex3f (x + width / 2) (y + height / 2) (z - length / 2) -- Top Right Of The Texture and Quad -- Bottom Face rlNormal3f 0 (-1) 0 -- Normal Pointing Down rlTexCoord2f 1 1 >> rlVertex3f (x - width / 2) (y - height / 2) (z - length / 2) -- Top Right Of The Texture and Quad rlTexCoord2f 0 1 >> rlVertex3f (x + width / 2) (y - height / 2) (z - length / 2) -- Top Left Of The Texture and Quad rlTexCoord2f 0 0 >> rlVertex3f (x + width / 2) (y - height / 2) (z + length / 2) -- Bottom Left Of The Texture and Quad rlTexCoord2f 1 0 >> rlVertex3f (x - width / 2) (y - height / 2) (z + length / 2) -- Bottom Right Of The Texture and Quad -- Right face rlNormal3f 1 0 0 -- Normal Pointing Right rlTexCoord2f 1 0 >> rlVertex3f (x + width / 2) (y - height / 2) (z - length / 2) -- Bottom Right Of The Texture and Quad rlTexCoord2f 1 1 >> rlVertex3f (x + width / 2) (y + height / 2) (z - length / 2) -- Top Right Of The Texture and Quad rlTexCoord2f 0 1 >> rlVertex3f (x + width / 2) (y + height / 2) (z + length / 2) -- Top Left Of The Texture and Quad rlTexCoord2f 0 0 >> rlVertex3f (x + width / 2) (y - height / 2) (z + length / 2) -- Bottom Left Of The Texture and Quad -- Left Face rlNormal3f (-1) 0 0 -- Normal Pointing Left rlTexCoord2f 0 0 >> rlVertex3f (x - width / 2) (y - height / 2) (z - length / 2) -- Bottom Left Of The Texture and Quad rlTexCoord2f 1 0 >> rlVertex3f (x - width / 2) (y - height / 2) (z + length / 2) -- Bottom Right Of The Texture and Quad rlTexCoord2f 1 1 >> rlVertex3f (x - width / 2) (y + height / 2) (z + length / 2) -- Top Right Of The Texture and Quad rlTexCoord2f 0 1 >> rlVertex3f (x - width / 2) (y + height / 2) (z - length / 2) -- Top Left Of The Texture and Quad rlEnd rlPopMatrix rlSetTexture 0 drawCubeTextureRec :: Texture -> Rectangle -> Vector3 -> Float -> Float -> Float -> Color -> IO () drawCubeTextureRec texture (Rectangle sX sY sW sH) (Vector3 x y z) width height length (Color r g b a) = do let texWidth = realToFrac $ texture'width texture :: Float texHeight = realToFrac $ texture'height texture :: Float rlSetTexture $ texture'id texture -- We calculate the normalized texture coordinates for the desired texture-source-rectangle -- It means converting from (tex.width, tex.height) coordinates to [0.0f, 1.0f] equivalent rlBegin RLQuads rlColor4ub r g b a -- Front face rlNormal3f 0 0 1 rlTexCoord2f (sX / texWidth) ((sY + sH) / texHeight) rlVertex3f (x - width / 2) (y - height / 2) (z + length / 2) rlTexCoord2f ((sX + sW) / texWidth) ((sY + sH) / texHeight) rlVertex3f (x + width / 2) (y - height / 2) (z + length / 2) rlTexCoord2f ((sX + sW) / texWidth) (sY / texHeight) rlVertex3f (x + width / 2) (y + height / 2) (z + length / 2) rlTexCoord2f (sX / texWidth) (sY / texHeight) rlVertex3f (x - width / 2) (y + height / 2) (z + length / 2) -- Back face rlNormal3f 0 0 (-1) rlTexCoord2f ((sX + sW) / texWidth) ((sY + sH) / texHeight) rlVertex3f (x - width / 2) (y - height / 2) (z - length / 2) rlTexCoord2f ((sX + sW) / texWidth) (sY / texHeight) rlVertex3f (x - width / 2) (y + height / 2) (z - length / 2) rlTexCoord2f (sX / texWidth) (sY / texHeight) rlVertex3f (x + width / 2) (y + height / 2) (z - length / 2) rlTexCoord2f (sX / texWidth) ((sY + sH) / texHeight) rlVertex3f (x + width / 2) (y - height / 2) (z - length / 2) -- Top face rlNormal3f 0 1 0 rlTexCoord2f (sX / texWidth) (sY / texHeight) rlVertex3f (x - width / 2) (y + height / 2) (z - length / 2) rlTexCoord2f (sX / texWidth) ((sY + sH) / texHeight) rlVertex3f (x - width / 2) (y + height / 2) (z + length / 2) rlTexCoord2f ((sX + sW) / texWidth) ((sY + sH) / texHeight) rlVertex3f (x + width / 2) (y + height / 2) (z + length / 2) rlTexCoord2f ((sX + sW) / texWidth) (sY / texHeight) rlVertex3f (x + width / 2) (y + height / 2) (z - length / 2) -- Bottom face rlNormal3f 0 (-1) 0 rlTexCoord2f ((sX + sW) / texWidth) (sY / texHeight) rlVertex3f (x - width / 2) (y - height / 2) (z - length / 2) rlTexCoord2f (sX / texWidth) (sY / texHeight) rlVertex3f (x + width / 2) (y - height / 2) (z - length / 2) rlTexCoord2f (sX / texWidth) ((sY + sH) / texHeight) rlVertex3f (x + width / 2) (y - height / 2) (z + length / 2) rlTexCoord2f ((sX + sW) / texWidth) ((sY + sH) / texHeight) rlVertex3f (x - width / 2) (y - height / 2) (z + length / 2) -- Right face rlNormal3f 1 0 0 rlTexCoord2f ((sX + sW) / texWidth) ((sY + sH) / texHeight) rlVertex3f (x + width / 2) (y - height / 2) (z - length / 2) rlTexCoord2f ((sX + sW) / texWidth) (sY / texHeight) rlVertex3f (x + width / 2) (y + height / 2) (z - length / 2) rlTexCoord2f (sX / texWidth) (sY / texHeight) rlVertex3f (x + width / 2) (y + height / 2) (z + length / 2) rlTexCoord2f (sX / texWidth) ((sY + sH) / texHeight) rlVertex3f (x + width / 2) (y - height / 2) (z + length / 2) -- Left face rlNormal3f (-1) 0 0 rlTexCoord2f (sX / texWidth) ((sY + sH) / texHeight) rlVertex3f (x - width / 2) (y - height / 2) (z - length / 2) rlTexCoord2f ((sX + sW) / texWidth) ((sY + sH) / texHeight) rlVertex3f (x - width / 2) (y - height / 2) (z + length / 2) rlTexCoord2f ((sX + sW) / texWidth) (sY / texHeight) rlVertex3f (x - width / 2) (y + height / 2) (z + length / 2) rlTexCoord2f (sX / texWidth) (sY / texHeight) rlVertex3f (x - width / 2) (y + height / 2) (z - length / 2) rlEnd rlSetTexture 0