;;
;; like "simple", but using higher-level <gtk-graph-area> widget.
;;

(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)
