X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk-glext%2Fdemo.lisp;h=1efbde7ea0e933d910e1bf892eff005c393967d2;hb=eadf2b7a4f39e93b50debf05a0925786615564d7;hp=16fee427075ca12a97bb56dea9669d058b077dc7;hpb=34d0739652d8d0919b99d822796d75ca21208e1c;p=cl-gtk2.git

diff --git a/gtk-glext/demo.lisp b/gtk-glext/demo.lisp
index 16fee42..1efbde7 100644
--- a/gtk-glext/demo.lisp
+++ b/gtk-glext/demo.lisp
@@ -1,33 +1,34 @@
 (defpackage :gtk-glext-demo
-  (:use :cl :gtk :gtkglext :gobject :glib)
-  (:export :run))
+  (:use :cl :gtk :gtkglext :gobject :glib :iter)
+  (:export :run
+           #:planet
+           #:opengl-interactive))
 
 (in-package :gtk-glext-demo)
 
 (defvar *theta* 30)
 
 (defun draw (widget event)
-  (declare (ignore event))
-  (with-gl-context (widget)
-    (gl:clear-color 0 0 0 0)
-    (gl:cull-face :back)
-    (gl:depth-func :less)
-    (gl:disable :dither)
-    (gl:shade-model :smooth)
-    (gl:light-model :light-model-local-viewer 1)
-    (gl:color-material :front :ambient-and-diffuse)
-    (gl:enable :light0 :lighting :cull-face :depth-test)
-    (gl:load-identity)
-    (gl:translate 0 0 -5)
-    (gl:rotate *theta* 1 1 0)
-    (gl:light :light0 :position '(0 1 1 0))
-    (gl:light :light0 :diffuse '(0.2 0.4 0.6 0))
-    (gl:clear :color-buffer-bit :depth-buffer-bit)
-    (gl:color 1 1 1)
-    (gl:front-face :cw)
-    (glut:solid-teapot 1.5)
-    (gl:front-face :ccw)
-    (gl:flush)))
+  (declare (ignore widget event))
+  (gl:clear-color 0 0 0 0)
+  (gl:cull-face :back)
+  (gl:depth-func :less)
+  (gl:disable :dither)
+  (gl:shade-model :smooth)
+  (gl:light-model :light-model-local-viewer 1)
+  (gl:color-material :front :ambient-and-diffuse)
+  (gl:enable :light0 :lighting :cull-face :depth-test)
+  (gl:load-identity)
+  (gl:translate 0 0 -5)
+  (gl:rotate *theta* 1 1 0)
+  (gl:light :light0 :position '(0 1 1 0))
+  (gl:light :light0 :diffuse '(0.2 0.4 0.6 0))
+  (gl:clear :color-buffer-bit :depth-buffer-bit)
+  (gl:color 1 1 1)
+  (gl:front-face :cw)
+  (glut:solid-teapot 1.5)
+  (gl:front-face :ccw)
+  (gl:flush))
 
 (defun run ()
   (with-main-loop
@@ -56,3 +57,233 @@
                                                 (g-source-remove source-id)
                                                 nil)))
       (widget-show window :all t))))
+
+(defvar *d* 0)
+(defvar *y* 0)
+
+(defun planet ()
+  (with-main-loop
+    (setf *d* 0 *y* 0)
+    (let ((window (make-instance 'gtk-window
+                                 :window-position :center
+                                 :title "Planets"
+                                 :default-width 500
+                                 :default-height 500))
+          (area (make-instance 'gl-drawing-area :on-expose #'planet-draw :on-resize #'planet-resize)))
+      (container-add window area)
+      (pushnew :key-press-mask (gdk:gdk-window-events (widget-window window)))
+      (connect-signal window "key-press-event"
+                      (lambda (w e)
+                        (declare (ignore w))
+                        (ignore-errors
+                          (let ((c (aref (gdk:event-key-string e) 0)))
+                            (case c
+                              (#\d (incf *d* 10) (widget-queue-draw area))
+                              (#\D (incf *d* -10) (widget-queue-draw area))
+                              (#\y (incf *y* 5) (widget-queue-draw area))
+                              (#\Y (incf *y* -5) (widget-queue-draw area)))))
+                        nil))
+      (let ((timer-id (gtk-main-add-timeout 10 (lambda ()
+                                                  (incf *d* 1) (incf *y* 0.5)
+                                                  (widget-queue-draw area)
+                                                  t))))
+        (connect-signal window "delete-event" (lambda (w e)
+                                                (declare (ignore w e))
+                                                (g-source-remove timer-id)
+                                                nil)))
+      (widget-show window))))
+
+(defun planet-draw (w e)
+  (declare (ignore w e))
+  (gl:clear-color 0 0 0 0)
+  (gl:shade-model :flat)
+  (gl:clear :color-buffer)
+  (gl:color 1 1 1)
+  (gl:with-pushed-matrix
+    ;; draw sun
+    (gl:translate 0 0 -2)
+    (gl:rotate 30 1 1 0)
+    (glut:wire-sphere 1 20 16)
+    ;; draw smaller planet
+    (gl:rotate *y* 0 1 0)
+    (gl:translate 2 0 0)
+    (gl:rotate *d* 0 1 0)
+    (glut:wire-sphere 0.2 10 8))
+  (gl:flush))
+
+(defun planet-resize (w width height)
+  (declare (ignore w))
+  (gl:viewport 0 0 width height)
+  (gl:matrix-mode :projection)
+  (gl:load-identity)
+  (glu:perspective 60 (/ width height) 1 20)
+  (gl:matrix-mode :modelview)
+  (gl:load-identity)
+  (glu:look-at 0 0 5 0 0 0 0 1 0))
+
+(defclass opengl-window (gtk-window)
+  ((expose-fn-text-view :initform (make-instance 'text-view) :reader opengl-window-expose-fn-text-view)
+   (resize-fn-text-view :initform (make-instance 'text-view) :reader opengl-window-resize-fn-text-view)
+   (expose-fn :initform nil :accessor opengl-window-expose-fn)
+   (resize-fn :initform nil :accessor opengl-window-resize-fn)
+   (drawing-area :initform (make-instance 'gl-drawing-area :height-request 100) :reader opengl-window-drawing-area))
+  (:metaclass gobject-class)
+  (:default-initargs
+      :title "Lisp interactive OpenGL"
+    :default-width 500
+    :default-height 500
+    :window-position :center))
+
+(defmethod initialize-instance :after ((window opengl-window) &key &allow-other-keys)
+  (setf (text-buffer-text (text-view-buffer (opengl-window-expose-fn-text-view window)))
+        ";; Expose-fn
+"
+        (text-buffer-text (text-view-buffer (opengl-window-resize-fn-text-view window)))
+        ";; Resize-fn. Parameters: w h
+")
+  (let-ui (v-paned :var v
+                   (:expr (opengl-window-drawing-area window))
+                   :resize t :shrink nil
+                   (v-box
+                    (h-paned
+                     (scrolled-window
+                      :hscrollbar-policy :automatic
+                      :vscrollbar-policy :automatic
+                      (:expr (opengl-window-expose-fn-text-view window)))
+                     :resize t :shrink nil
+                     (scrolled-window
+                      :hscrollbar-policy :automatic
+                      :vscrollbar-policy :automatic
+                      (:expr (opengl-window-resize-fn-text-view window)))
+                     :resize t :shrink nil)
+                    (h-box
+                     (button :label "Update functions" :var update-fns-button) :expand nil
+                     (button :label "Redraw" :var redraw-button) :expand nil)
+                    :expand nil)
+                   :resize t :shrink nil)
+    (container-add window v)
+    (connect-signal update-fns-button "clicked"
+                    (lambda (b)
+                      (declare (ignore b))
+                      (update-fns window)))
+    (connect-signal redraw-button "clicked"
+                    (lambda (b)
+                      (declare (ignore b))
+                      (widget-queue-draw (opengl-window-drawing-area window))))
+    (let ((area (opengl-window-drawing-area window)))
+      (setf (gl-drawing-area-on-expose area)
+            (lambda (w e)
+              (declare (ignore w e))
+              (opengl-interactive-on-expose window))
+            (gl-drawing-area-on-resize area)
+            (lambda (widget w h)
+              (declare (ignore widget))
+              (opengl-interactive-on-resize window w h))))))
+
+(defun opengl-interactive-on-expose (window)
+  (if (opengl-window-expose-fn window)
+      (handler-case
+          (funcall (opengl-window-expose-fn window))
+        (error (e)
+          (declare (ignore e))
+          (setf (opengl-window-expose-fn window) nil)
+          (progn (gl:clear-color 0 0 0 0)
+             (gl:cull-face :back)
+             (gl:depth-func :less)
+             (gl:disable :dither)
+             (gl:shade-model :smooth)
+             (gl:light-model :light-model-local-viewer 1)
+             (gl:color-material :front :ambient-and-diffuse)
+             (gl:enable :light0 :lighting :cull-face :depth-test)
+             (gl:load-identity)
+             (gl:translate 0 0 -5)
+             (gl:rotate *theta* 1 1 0)
+             (gl:light :light0 :position '(0 1 1 0))
+             (gl:light :light0 :diffuse '(0.2 0.4 0.6 0))
+             (gl:clear :color-buffer-bit :depth-buffer-bit)
+             (gl:color 1 1 1)
+             (gl:front-face :cw)
+             (glut:solid-teapot 1.5)
+             (gl:front-face :ccw)
+             (gl:flush))))
+      (progn (gl:clear-color 0 0 0 0)
+             (gl:cull-face :back)
+             (gl:depth-func :less)
+             (gl:disable :dither)
+             (gl:shade-model :smooth)
+             (gl:light-model :light-model-local-viewer 1)
+             (gl:color-material :front :ambient-and-diffuse)
+             (gl:enable :light0 :lighting :cull-face :depth-test)
+             (gl:load-identity)
+             (gl:translate 0 0 -5)
+             (gl:rotate *theta* 1 1 0)
+             (gl:light :light0 :position '(0 1 1 0))
+             (gl:light :light0 :diffuse '(0.2 0.4 0.6 0))
+             (gl:clear :color-buffer-bit :depth-buffer-bit)
+             (gl:color 1 1 1)
+             (gl:front-face :cw)
+             (glut:solid-teapot 1.5)
+             (gl:front-face :ccw)
+             (gl:flush))))
+
+(defun opengl-interactive-on-resize (window w h)
+  (if (opengl-window-resize-fn window)
+      (handler-case
+          (funcall (opengl-window-resize-fn window) w h)
+        (error (e)
+          (declare (ignore e))
+          (setf (opengl-window-resize-fn window) nil)
+          (gl:viewport 0 0 w h)
+          (gl:matrix-mode :projection)
+          (gl:load-identity)
+          (glu:perspective 60 (/ w h) 1 20)
+          (gl:matrix-mode :modelview)
+          (gl:load-identity)))
+      (progn
+        (gl:viewport 0 0 w h)
+        (gl:matrix-mode :projection)
+        (gl:load-identity)
+        (glu:perspective 60 (/ w h) 1 20)
+        (gl:matrix-mode :modelview)
+        (gl:load-identity)
+        #+nil(glu:look-at 0 0 5 0 0 0 0 1 0)
+        )))
+
+(defpackage :cl-gtk2-gl-demo-read-package
+  (:use :cl :cl-opengl))
+
+(defun read-exprs (string)
+  (with-input-from-string
+      (stream string)
+    (let ((eof (gensym)))
+      (iter (for expr = (read stream nil eof))
+                        (until (eq expr eof))
+                        (collect expr)))))
+
+(defun read-fn (string fn-args)
+  (let ((*package* (find-package :cl-gtk2-gl-demo-read-package)))
+    (let ((exprs (read-exprs string)))
+      (when exprs
+        (eval `(lambda (,@fn-args)
+                 ,@exprs))))))
+
+(defparameter *resize-fn-args* (list (intern "W" :cl-gtk2-gl-demo-read-package)
+                                     (intern "H" :cl-gtk2-gl-demo-read-package)))
+
+(defun update-fns (window)
+  (with-gtk-message-error-handler
+    (let ((expose-fn (read-fn (text-buffer-text (text-view-buffer (opengl-window-expose-fn-text-view window))) nil))
+          (resize-fn (read-fn (text-buffer-text (text-view-buffer (opengl-window-resize-fn-text-view window)))
+                              *resize-fn-args*)))
+      (assert (or (null expose-fn) (functionp expose-fn)))
+      (assert (or (null resize-fn) (functionp resize-fn)))
+      (setf (opengl-window-expose-fn window) expose-fn
+            (opengl-window-resize-fn window) resize-fn)
+      (widget-queue-draw (opengl-window-drawing-area window)))))
+
+(defun opengl-interactive ()
+  (let ((output *standard-output*))
+    (within-main-loop
+      (setf *standard-output* output)
+      (let ((w (make-instance 'opengl-window)))
+        (widget-show w)))))