/usr/share/gauche-0.9/site/lib/gtk/glgd.scm is in gauche-gtk 0.6~pre1+git20121223-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ;;;
;;; gtk/glgd.scm - openGL Graph Display binding
;;;
;;; Copyright(C) 2004 by Shawn Taras (shawn_t@cementedminds.com)
;;; Copyright(C) 2004 by Shiro Kawai (shiro@acm.org)
;;;
;;; Permission to use, copy, modify, distribute this software and
;;; accompanying documentation for any purpose is hereby granted,
;;; provided that existing copyright notices are retained in all
;;; copies and that this notice is included verbatim in all
;;; distributions.
;;; This software is provided as is, without express or implied
;;; warranty. In no circumstances the author(s) shall be liable
;;; for any damages arising out of the use of this software.
;;;
;;; $Id: glgd.scm,v 1.5 2007/01/13 01:36:31 maruska Exp $
;;;
(define-module gtk.glgd
(use gl)
(use gtk)
(use gtk.gtkgl)
(export-all))
(select-module gtk.glgd)
(dynamic-load "gauche-glgd" :export-symbols #t)
;; Higher-level utilities
;; Class <gtk-graph-area>
;; Binds glgd-graph and gtk-drawing-area conveniently.
(define-class <gtk-graph-area> (<gtk-drawing-area>)
((glconfig :init-keyword :glconfig
:init-form (or (gdk-gl-config-new-by-mode
(logior GDK_GL_MODE_RGB GDK_GL_MODE_DEPTH
GDK_GL_MODE_DOUBLE))
(gdk-gl-config-new-by-mode
(logior GDK_GL_MODE_RGB GDK_GL_MODE_DEPTH))
(error "Required visual not supported")))
(graph :init-keyword :graph
:init-form (glgd-graph-create))
;; temporary
(connected :init-value #f)
))
(define-method initialize ((self <gtk-graph-area>) initargs)
(next-method)
;; Set OpenGL-capability to the widget.
(gtk-widget-set-gl-capability self (ref self 'glconfig) #f #t
GDK_GL_RGBA_TYPE)
;; Initial event mask.
(gtk-widget-set-events self (logior GDK_EXPOSURE_MASK
GDK_VISIBILITY_NOTIFY_MASK))
;; Default event handlings
(g-signal-connect self "destroy"
(lambda (w . _)
(glgd-graph-fini (ref self 'graph))))
(g-signal-connect self "realize"
(lambda (w . _)
(with-gtkgl-context self gtk-graph-area-initialize)))
(g-signal-connect self "configure_event"
(lambda (w . _)
(with-gtkgl-context self gtk-graph-area-configure)))
(g-signal-connect self "expose_event"
(lambda (w . _)
(with-gtkgl-context self gtk-graph-area-draw)))
(g-signal-connect self "map_event"
(lambda (w . _)
(with-gtkgl-context self gtk-graph-area-mapped)))
)
(define-method gtk-graph-area-initialize ((self <gtk-graph-area>)
gldrawable glcontext)
(gl-enable GL_DEPTH_TEST))
(define-method gtk-graph-area-configure ((self <gtk-graph-area>)
gldrawable glcontext)
(let ((wsize (ref self 'allocation)))
(gl-viewport 0 0 (ref wsize 'width) (ref wsize 'height))
#t))
(define-method gtk-graph-area-draw ((self <gtk-graph-area>)
gldrawable glcontext)
(gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
(glgd-graph-draw (ref self 'graph))
(if (gdk-gl-drawable-is-double-buffered gldrawable)
(gdk-gl-drawable-swap-buffers gldrawable)
(gl-flush)))
(define-method gtk-graph-area-mapped ((self <gtk-graph-area>)
gldrawable glcontext)
(unless (and (ref self 'graph) (ref self 'connected))
(glgd-graph-connect (ref self 'graph) self)
(set! (ref self 'connected) #t))
(gtk-widget-queue-draw self)
#t)
(provide "gtk/glgd")
|