summaryrefslogtreecommitdiff
path: root/examples/triangle.scm
blob: 92496776e359231ab5a1a8226fbcd746ec5a6af6 (plain)
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
(use-modules (chickadee)
             (chickadee data bytestruct)
             (chickadee math vector)
             (chickadee graphics)
             (chickadee graphics buffer)
             (chickadee graphics color)
             (chickadee graphics pipeline)
             (chickadee graphics shader)
             (chickadee graphics texture)
             (chickadee graphics viewport)
             (rnrs base))

(define window-width 800)
(define window-height 600)
(define index-buffer #f)
(define vertex-buffers #f)
(define uniforms #f)
(define texture #f)
(define view #f)
(define sampler #f)
(define shader #f)
(define pipeline #f)
(define pass #f)
(define bindings #f)

(define-bytestruct <uniforms>
  (struct (time f32)))

(define (load)
  (set! index-buffer
        (bytevector->buffer (u32vector 0 1 2)
                            #:name "Triangle indices"))
  (set! vertex-buffers
        (vector
         (bytevector->buffer (f32vector -1.0 -1.0   0.0 0.0   1.0 0.0 0.0 1.0
                                        +1.0 -1.0   1.0 0.0   0.0 1.0 0.0 1.0
                                        +0.0 +1.0   0.5 1.0   0.0 0.0 1.0 1.0)
                             #:name "Triangle position, texture, color")))
  (set! uniforms (make-buffer 4 #:name "Uniform buffer" #:usage '(uniform)))
  (set! texture (load-image "images/wall.png" #:name "Wall texture"))
  (set! view (make-texture-view texture #:name "Wall texture view"))
  (set! sampler (make-sampler #:name "Nearest neighbor sampler"
                              #:address-mode-u 'repeat
                              #:address-mode-v 'repeat))
  (set! shader (make-shader
                (lambda (lang)
                  (if (eq? lang 'glsl)
                      (values "
#ifdef GLSL330
layout (location = 0) in vec2 position;
layout (location = 1) in vec2 tex;
layout (location = 2) in vec4 color;
#elif defined(GLSL130)
in vec2 position;
in vec2 tex;
in vec4 color;
#elif defined(GLSL120)
attribute vec2 position;
attribute vec2 tex;
attribute vec4 color;
#endif
#ifdef GLSL120
varying vec2 fragTex;
varying vec4 fragColor;
#else
out vec2 fragTex;
out vec4 fragColor;
#endif

layout (std140) uniform Time
{
    float time;
};

void main(void) {
    fragTex = vec2(tex.x, tex.y) + mod(time / 3.0, 1.0);
    fragColor = color;
    gl_Position = vec4(position, 0.0, 1.0);
}
"
                              "
#ifdef GLSL120
varying vec2 fragTex;
varying vec4 fragColor;
#else
in vec2 fragTex;
in vec4 fragColor;
#endif
#ifdef GLSL330
out vec4 outFragColor;
#else
#define outFragColor gl_FragColor
#define texture texture2D
#endif

uniform sampler2D sampler;

void main (void) {
    outFragColor = texture(sampler, fragTex) + fragColor;
}
")
                      (error "unsupported shader language" lang)))
                #:name "Triangle shader"))
  (set! pipeline
        (make-render-pipeline
         #:name "Triangle"
         #:shader shader
         #:vertex-layout
         (vector (make-vertex-buffer-layout
                  #:stride (* 4 8)
                  #:attributes (vector
                                (make-vertex-attribute
                                 #:format 'float32x2)
                                (make-vertex-attribute
                                 #:format 'float32x2
                                 #:offset (* 2 4))
                                (make-vertex-attribute
                                 #:format 'float32x4
                                 #:offset (* 4 4)))))
         #:binding-layout (vector (make-texture-layout)
                                  (make-sampler-layout)
                                  (make-buffer-layout))))
  (set! bindings (vector view sampler uniforms)))

(define (draw* alpha)
  (let ((bv (map-buffer uniforms 'write 0 4)))
    (bytestruct-pack! <uniforms> (((time) (mod (elapsed-time) 1000.0))) bv 0)
    (unmap-buffer uniforms))
  (draw 3
        #:pipeline pipeline
        #:index-buffer index-buffer
        #:vertex-buffers vertex-buffers
        #:bindings bindings))

(define (key-press key modifiers repeat)
  (when (eq? key 'q) (abort-game)))

;; (add-hook! after-gc-hook (lambda () (pk (gc-stats))))

(run-game #:load load
          #:draw draw*
          #:key-press key-press
          #:window-width window-width
          #:window-height window-height
          #:window-fullscreen? #f
          #:window-resizable? #t)