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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
|
;;
;; Simple OpenGL Graph Display. This program is in the public domain.
;;
;; Shawn Taras
;; $Id: simple.scm,v 1.21 2007/01/13 01:36:30 maruska Exp $
(use math.const)
(use math.mt-random)
(use gtk)
(use gtk.gtkgl)
(use gtk.glgd)
(use gl)
(define *attr-geometry* 0)
(define *attr-skeleton* 1)
(define *attr-current* GLGD_ATTR_FORCEVISIBLE)
(define *graph* (glgd-graph-create))
(define *mt* (make <mersenne-twister>))
;; GLGDGRAPH_FN_MOUSE_LEFT callback
;; --------------------------------
(define (mouse-left-callback graph node link event)
(when (= (ref event 'type) GDK_BUTTON_PRESS)
(if (= *attr-current* GLGD_ATTR_FORCEVISIBLE)
(set! *attr-current* *attr-geometry*)
(set! *attr-current* (+ *attr-current* 1)))
(if (> *attr-current* *attr-skeleton*)
(set! *attr-current* GLGD_ATTR_FORCEVISIBLE))
(glgd-graph-attribute-clear graph)
(glgd-graph-attribute-set graph *attr-current*)
(glgd-graph-auto-organize graph 0.0 0.0)
(print #`"*attr-current* now ,*attr-current*")
(print #`"left mouse click on node ,(glgd-node-id-get node)")
(print #`"left mouse click on link ,(glgd-graph-link-index graph link)"))
#t)
;; GLGDGRAPH_FN_KEY callback
;; -------------------------
(define (key-callback graph node link event)
(let1 kv (ref event 'keyval)
(cond
((= kv GDK_KEY_Escape) (gtk-main-quit))))
#t)
;; GLGDGRAPH_FN_PRERENDER callback
;; -------------------------------
(define (pre-draw-callback node)
(glgd-node-color-set node
(mt-random-real *mt*)
(mt-random-real *mt*)
(mt-random-real *mt*) 1.0)
#t)
(define (draw widget . _)
(let ((glcontext (gtk-widget-get-gl-context widget))
(gldrawable (gtk-widget-get-gl-drawable widget)))
;;*** OpenGL BEGIN ***
(when (gdk-gl-drawable-gl-begin gldrawable glcontext)
(gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
(glgd-graph-draw *graph*)
(if (gdk-gl-drawable-is-double-buffered gldrawable)
(gdk-gl-drawable-swap-buffers gldrawable)
(gl-flush))
(gdk-gl-drawable-gl-end gldrawable))
#t))
;; new window size or exposure
(define (reshape widget . _)
(let* ((glcontext (gtk-widget-get-gl-context widget))
(gldrawable (gtk-widget-get-gl-drawable widget))
(wsize (ref widget 'allocation))
(h (/ (ref wsize 'height) (ref wsize 'width))))
;;*** OpenGL BEGIN ***
(when (gdk-gl-drawable-gl-begin gldrawable glcontext)
(gl-viewport 0 0 (ref wsize 'width) (ref wsize 'height))
(gdk-gl-drawable-gl-end gldrawable))
;;*** OpenGL END ***
#t)
(glgd-graph-reshape *graph*))
(define (init widget)
(let ((glcontext (gtk-widget-get-gl-context widget))
(gldrawable (gtk-widget-get-gl-drawable widget)))
;;*** OpenGL BEGIN ***
(when (gdk-gl-drawable-gl-begin gldrawable glcontext)
(gl-light GL_LIGHT0 GL_POSITION '#f32(5.0 5.0 10.0 0.0))
(gl-enable GL_CULL_FACE)
(gl-enable GL_LIGHTING)
(gl-enable GL_LIGHT0)
(gl-enable GL_DEPTH_TEST)
(gl-enable GL_NORMALIZE)
(print)
(print #`"GL_RENDERER = ,(gl-get-string GL_RENDERER)")
(print #`"GL_VERSION = ,(gl-get-string GL_VERSION)")
(print #`"GL_VENDOR = ,(gl-get-string GL_VENDOR)")
(print #`"GL_EXTENSIONS = ,(gl-get-string GL_EXTENSIONS)")
(print)
(gdk-gl-drawable-gl-end gldrawable))
;;*** OpenGL END ***
))
;; exit upon ESC
(define (key widget event)
(let ((kv (ref event 'keyval))
(q (lambda () (gtk-widget-queue-draw widget))))
(cond
((= kv GDK_KEY_Escape) (gtk-main-quit))))
#t)
;; create a simple graph
(define (glgd-graph-build-simple graph)
(glgd-graph-init graph)
(let* ((model (glgd-node-create))
(geometry (glgd-node-create))
(torso (glgd-node-create))
(arms (glgd-node-create))
(legs (glgd-node-create))
(skeleton (glgd-node-create))
(hip (glgd-node-create))
(thighLeft (glgd-node-create))
(thighRight (glgd-node-create)))
(glgd-node-info-set model "model" 0)
(glgd-node-attribute-set model *attr-geometry*)
(glgd-node-info-set geometry "geometry" 1)
(glgd-node-attribute-set geometry *attr-geometry*)
(glgd-node-info-set skeleton "skeleton" 2)
(glgd-node-attribute-set skeleton *attr-skeleton*)
(glgd-node-info-set torso "torso" 3)
(glgd-node-attribute-set torso *attr-geometry*)
(glgd-node-info-set arms "arms" 4)
(glgd-node-attribute-set arms *attr-geometry*)
(glgd-node-info-set legs "legs" 5)
(glgd-node-attribute-set legs *attr-geometry*)
(glgd-node-info-set hip "hip" 6)
(glgd-node-attribute-set hip *attr-skeleton*)
(glgd-node-info-set thighLeft "thighLeft" 7)
(glgd-node-attribute-set thighLeft *attr-skeleton*)
(glgd-node-info-set thighRight "thighRight" 8)
(glgd-node-attribute-set thighRight *attr-skeleton*)
(glgd-graph-node-add graph model)
(glgd-graph-node-add graph geometry)
(glgd-graph-node-add graph skeleton)
(glgd-graph-node-add graph torso)
(glgd-graph-node-add graph arms)
(glgd-graph-node-add graph legs)
(glgd-graph-node-add graph hip)
(glgd-graph-node-add graph thighLeft)
(glgd-graph-node-add graph thighRight)
(let* ((list (glgd-link-list-create))
(m2g (glgd-link-create))
(g2t (glgd-link-create))
(g2a (glgd-link-create))
(g2l (glgd-link-create))
(m2s (glgd-link-create))
(s2h (glgd-link-create))
(h2tl (glgd-link-create))
(h2tr (glgd-link-create))
(tr2h (glgd-link-create))
(tr2s (glgd-link-create)))
(glgd-link-set m2g model geometry)
(glgd-link-set g2t geometry torso)
(glgd-link-set g2a geometry arms)
(glgd-link-set g2l geometry legs)
(glgd-link-set m2s model skeleton)
(glgd-link-set s2h skeleton hip)
(glgd-link-set h2tl hip thighLeft)
(glgd-link-set h2tr hip thighRight)
(glgd-link-set tr2h thighRight hip)
(glgd-link-set tr2s thighRight skeleton)
(glgd-graph-link-add graph list m2g)
(glgd-graph-link-add graph list m2s)
(glgd-graph-link-add graph list g2t)
(glgd-graph-link-add graph list g2a)
(glgd-graph-link-add graph list g2l)
(glgd-graph-link-add graph list s2h)
(glgd-graph-link-add graph list h2tl)
(glgd-graph-link-add graph list h2tr)
(glgd-graph-link-add graph list tr2h)
(glgd-graph-link-add graph list tr2s)
(glgd-graph-link-list-add graph list)))
(glgd-graph-attribute-set graph *attr-current*)
(glgd-graph-auto-organize graph 0.0 0.0)
(glgd-graph-link-list-dump graph)
(glgd-graph-callback-set graph GLGDGRAPH_FN_PRERENDER pre-draw-callback)
(glgd-graph-callback-set graph GLGDGRAPH_FN_KEY key-callback)
(glgd-graph-callback-set graph GLGDGRAPH_FN_MOUSE_LEFT mouse-left-callback)
#t)
(define (main args)
(gtk-init args)
(glgd-verbosity 1)
(unless (gdk-gl-query-extension)
(error "*** OpenGL is not supported."))
;;
;; Configure OpenGL-capable visual.
;;
(let1 glconfig (or (gdk-gl-config-new-by-mode (logior GDK_GL_MODE_RGB
GDK_GL_MODE_DEPTH
GDK_GL_MODE_DOUBLE))
(begin
(warn "*** Cannot find the double-buffered visual.\n*** Trying single-buffered visual.\n")
(gdk-gl-config-new-by-mode (logior GDK_GL_MODE_RGB
GDK_GL_MODE_DEPTH)))
(error "*** No appropriate OpenGL-capable visual found.")
)
;;
;; Top-level window.
;;
(let1 window (gtk-window-new GTK_WINDOW_TOPLEVEL)
(gtk-window-set-title window "Simple Graph Demo")
(g-signal-connect window "delete_event" (lambda _ (gtk-main-quit)))
(let1 vbox (gtk-vbox-new #f 0)
(gtk-container-add window vbox)
(gtk-widget-show vbox)
;;
;; Drawing area for drawing OpenGL scene.
;;
(let1 drawing-area (gtk-drawing-area-new)
(gtk-widget-set-size-request drawing-area 640 480)
;; Set OpenGL-capability to the widget.
(gtk-widget-set-gl-capability drawing-area glconfig #f #t
GDK_GL_RGBA_TYPE)
(gtk-box-pack-start vbox drawing-area #t #t 0)
(gtk-widget-set-events drawing-area
(logior GDK_EXPOSURE_MASK
GDK_VISIBILITY_NOTIFY_MASK))
(g-signal-connect drawing-area "realize" init)
(g-signal-connect drawing-area "configure_event" reshape)
(g-signal-connect drawing-area "expose_event" draw)
(glgd-graph-build-simple *graph*)
(glgd-graph-connect *graph* drawing-area)
(gtk-widget-show drawing-area))
;;
;; Simple quit button.
;;
(let1 button (gtk-button-new-with-label "Quit")
(gtk-box-pack-start vbox button #f #f 0)
(g-signal-connect button "clicked" (lambda _ (gtk-main-quit)))
(gtk-widget-show button))
);vbox
(gtk-widget-show window)
)
(gtk-main)
(glgd-graph-fini *graph*)
0))
|
