Models.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

module Models where

import Graphics.Glyph.GeometryBuilder 
import Graphics.Glyph.BufferBuilder

import Control.Monad
import Data.ByteString.Lazy

import Graphics.Glyph.GLMath
import Graphics.Glyph.ObjLoader

square :: (Num b,IsModelBuilder b a) => b -> a ()
square dist = do
    plotVertex3   dist    dist  0
    plotVertex3 (-dist)   dist  0
    plotVertex3 (-dist) (-dist)  0
    plotVertex3   dist  (-dist)  0

getBS :: GeometryBuilder () -> ByteString
getBS = buildSource

getAsStr :: GeometryBuilder () -> String
getAsStr = buildSourceAsString

treeShader :: ByteString
treeShader = buildSource tree

triangle :: GeometryBuilder ()
triangle =
    generating Triangles $ do
        projectionMatrixUniform "pjMatrix"
        modelViewMatrixUniform "mvMatrix"
        textureOutput "texposition"
        normalOutput "normal"
        positionOutput "frag_position"
    
        gVertex4E 1 0 0 0
        gVertex4E 0 1 0 0
        gVertex4E 0 0 1 0

tree :: GeometryBuilder ()
tree =
    generating TriangleStrip $ do
        projectionMatrixUniform "pjMatrix"
        modelViewMatrixUniform "mvMatrix"
        textureOutput "texposition"
        normalOutput "normal"
        positionOutput "frag_position"
    
        let r = 0.045
        let h = 0.4
    
    
        forM_ [0..6.4] $ \th -> do
            let vertex x y z = do
                gNormal3 x 0 z
                gVertex4E x y z 0
    
            let c = r * cos th
            let s = r * sin th
    
            let c2 = r * (cos $ th + 1.0)
            let s2 = r * (sin $ th + 1.0)
    
            let texX = th / 6.4 / 2.0
            let texX2 = (th+1.0) / 6.4 / 2.0
    
            let quads = trianglesFromQuads
                    [(gTexture2 texX  0 >> vertex c 0 s),
                    (gTexture2 texX  1 >> vertex c  h s),
                    (gTexture2 texX2 1 >> vertex c2 h s2),
                    (gTexture2 texX2 0 >> vertex c2 0 s2)]
    
            sequence_ quads
    
        forM_ [0..6.4] $ \th -> do
            let vertex x y z = do
                gNormal3 x 0 z
                gVertex4E x y z 0
    
            let c = r * 4 * cos th
            let s = r * 4 * sin th
            let texX = th / 6.4 / 2.0 + 0.5
    
            gTexture2 texX 1
            vertex 0 (h*2) 0
            gTexture2 texX 0
            vertex s (h/4) c