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
|
;;
;; like "simple", but using higher-level <gtk-graph-area> widget.
;; $Id: simple2.scm,v 1.2 2007/01/13 01:36:30 maruska Exp $
;;
(use gtk)
(use gtk.gtkgl)
(use gtk.glgd)
(define *attr-geometry* 0)
(define *attr-skeleton* 1)
(define *attr-current* GLGD_ATTR_FORCEVISIBLE)
(define (main args)
(gtk-init args)
(unless (gdk-gl-query-extension)
(error "*** OpenGL is not supported."))
(let1 window (gtk-window-new GTK_WINDOW_TOPLEVEL)
(gtk-window-set-title window "objview")
(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 graph-area (make <gtk-graph-area>)
(gtk-widget-set-size-request graph-area 640 480)
(gtk-box-pack-start vbox graph-area #t #t 0)
(graph-build-simple (ref graph-area 'graph))
(gtk-widget-show graph-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))
)
(gtk-widget-show window)
(gtk-main)
0))
;; create a simple graph
(define (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)
#t)
|
