{-# LANGUAGE DataKinds, FlexibleContexts, TypeOperators #-}
module CursorProgram where
import Data.Vinyl
import Graphics.GLUtil
import Graphics.Rendering.OpenGL hiding (normal, normalize, light, Normal, Color)
import Linear (V2(..), V3(..))
import Graphics.VinylGL
import Foreign.Ptr (nullPtr)
import System.FilePath ((</>))
import Data.Word (Word16)
-----
-- Shader params
-----
type Pos = '("position", V2 GLfloat)
pos :: SField Pos
pos = SField
-----
-- Parameter data
-----
cursorNumSlices :: Num a => a
cursorNumSlices = 50
cursorNumIdxs :: GLsizei -- = NumArrayIndices
cursorNumIdxs = toEnum $ cursorNumSlices + 2
cursorpts :: [V2 GLfloat]
cursorpts = take (cursorNumSlices+2) $ (V2 0 0) : (zipWith V2 (map cos winding) (map sin winding))
where
winding :: [Float]
winding = [0,(2*pi/(fromIntegral cursorNumSlices))..]
{-
Changing this from Word16 implies drawElements called w/ UnsignedInt instead of UnsignedShort and removing the import of (Word.Word16).
-}
cursorinds :: [Word16]
cursorinds = take (cursorNumSlices+2) [0,1..]
-----
-- Shader program
-----
type CursorCircleStyle = '[ '("offset", V2 GLfloat), '("color", V3 GLfloat) ]
cursorCircle :: (CursorCircleStyle <: i) => IO (FieldRec i -> IO ())
cursorCircle = do
sprog <- simpleShaderProgram ("etc"</>"cursor.vert") ("etc"</>"cursor.frag")
vb <- bufferVertices . map (pos =:) $ cursorpts
eb <- makeBuffer ElementArrayBuffer cursorinds
vao <- makeVAO $ do
currentProgram $= Just (program sprog)
enableVertices' sprog vb
bindVertices vb
bindBuffer ElementArrayBuffer $= Just eb
let ss = setUniforms sprog
return $ \appInfo -> withVAO vao $ do
currentProgram $= Just (program sprog)
ss (rcast appInfo :: FieldRec CursorCircleStyle)
-- triangle fan drawing
drawElements TriangleFan cursorNumIdxs UnsignedShort nullPtr