{-# LANGUAGE UnicodeSyntax #-}
module GraphRewriting.GL.Render where

import Data.Vector.V2
import Graphics.Rendering.OpenGL (GLdouble)
import qualified Graphics.Rendering.OpenGL as GL
import Unsafe.Coerce
import Graphics.Rendering.FTGL
import Paths_graph_rewriting_gl
import System.IO.Unsafe (unsafePerformIO)


-- | Here the OpenGL code for rendering a node can be given. The node-size is expected to be roughly 2 (radius 1) but this is not a requirement.
class Render a where render  a  IO ()

convertDouble  Double  GLdouble
convertDouble = unsafeCoerce

convertGLdouble  GLdouble  Double
convertGLdouble = unsafeCoerce

vector  Vector2  GL.Vector3 GLdouble
vector v = GL.Vector3 (convertDouble $ v2x v) (convertDouble $ v2y v) 0

vertex  Vector2  IO ()
vertex v = GL.vertex $ GL.Vertex2 (convertDouble $ v2x v) (convertDouble $ v2y v)

vector2  (Double,Double)  GL.Vector3 GLdouble
vector2 (x,y) = GL.Vector3 (convertDouble x) (convertDouble y) 0

vertex2  (Double,Double)  IO ()
vertex2 (x,y) = GL.vertex $ GL.Vertex2 (convertDouble x) (convertDouble y)

font  Font
{-# NOINLINE font #-}
font = unsafePerformIO $ do
	font <- createTextureFont =<< getDataFileName "font/DejaVuSansMono.ttf"
	setFontFaceSize font 24 72
	return font

renderString  String  IO ()
renderString str = GL.preservingMatrix $ do
	GL.translate $ vector2 (-0.36,-0.37)
	GL.scale 0.05 0.05 (0  GLdouble)
	renderFont font str Front