Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 105 lines (79 sloc) 3.056 kb
05be929 @dharmatech Add 'checker'
authored
1
2 (import (rnrs)
3 (gl)
4 (glut)
5 (agave glu compat)
6 (agave glamour window)
7 (agave glamour misc))
8
9 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10
11 (define check-image-width 64)
12 (define check-image-height 64)
13 (define check-image-depth 4)
14
15 (define check-image
16 (make-bytevector
17 (* check-image-width
18 check-image-height
19 check-image-depth)))
20
21 (define (check-image-set! i j k val)
22 (bytevector-u8-set! check-image
23 (+ (* i check-image-width check-image-depth)
24 (* j check-image-depth)
25 k)
26 val))
27
28 (define (make-check-image)
29 (do ((i 0 (+ i 1))) ((>= i check-image-height))
30 (do ((j 0 (+ j 1))) ((>= j check-image-width))
31 (let ((c (* (bitwise-xor (if (= (bitwise-and i #x8) 0) 1 0)
32 (if (= (bitwise-and j #x8) 0) 1 0))
33 255)))
34 (check-image-set! i j 0 c)
35 (check-image-set! i j 1 c)
36 (check-image-set! i j 2 c)
37 (check-image-set! i j 3 255)))))
38
39 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40
41 (initialize-glut)
42
43 (window (size 250 250)
44 (title "image.sps")
45 (reshape (width height)
46 (lambda (w h)
47 (glLoadIdentity)
48 (gluPerspective 60.0 (inexact (/ w h)) 1.0 30.0))))
49
50 (glShadeModel GL_FLAT)
51 (glEnable GL_DEPTH_TEST)
52
53 (make-check-image)
54
55 (glPixelStorei GL_UNPACK_ALIGNMENT 1)
56
57 (define tex-name (make-bytevector 4))
58
59 (glGenTextures 1 tex-name)
60
61 (glBindTexture GL_TEXTURE_2D (bytevector-u32-native-ref tex-name 0))
62
63 (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT)
64 (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT)
65 (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST)
66 (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST)
67 (glTexImage2D GL_TEXTURE_2D
68 0
69 GL_RGBA
70 check-image-width
71 check-image-height
72 0
73 GL_RGBA
74 GL_UNSIGNED_BYTE
75 check-image)
76
77 (buffered-display-procedure
78 (lambda ()
79 (glTranslatef 0.0 0.0 -3.6)
80 (background 0.0)
81 (glClear GL_DEPTH_BUFFER_BIT)
82
83 (glEnable GL_TEXTURE_2D)
84 ;; (glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_DECAL)
85 (glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_DECAL)
86
87 (glBindTexture GL_TEXTURE_2D (bytevector-u32-native-ref tex-name 0))
88
89 (gl-begin GL_QUADS
90
91 (glTexCoord2f 0.0 0.0) (glVertex3f -2.0 -1.0 0.0)
92 (glTexCoord2f 0.0 1.0) (glVertex3f -2.0 1.0 0.0)
93 (glTexCoord2f 1.0 1.0) (glVertex3f 0.0 1.0 0.0)
94 (glTexCoord2f 1.0 0.0) (glVertex3f 0.0 -1.0 0.0)
95
96 (glTexCoord2f 0.0 0.0) (glVertex3f 1.0 -1.0 0.0)
97 (glTexCoord2f 0.0 1.0) (glVertex3f 1.0 1.0 0.0)
98 (glTexCoord2f 1.0 1.0) (glVertex3f 2.41421 1.0 -1.41421)
99 (glTexCoord2f 1.0 0.0) (glVertex3f 2.41421 -1.0 -1.41421))))
100
101 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
102
103 (glutMainLoop)
104
Something went wrong with that request. Please try again.