source: trunk/source/examples/opengl-ffi.lisp @ 13474

Last change on this file since 13474 was 13474, checked in by rme, 10 years ago

Make this example work again.

#_IsProcessVisible seems to be returning 1 even if the IDE is not
running (at least on Snow Leopard), so just use a dopey heuristic
test instead.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.0 KB
Line 
1;;; Example openmcl FFI by hamlink
2;;;
3;;; 2d Gasket example taken from
4;;;  "Interactive Computer Graphics:
5;;;   A Top-Down Approach with OpenGL" by Ed Angel
6
7(eval-when (:compile-toplevel :load-toplevel :execute)
8  (ccl:use-interface-dir :GL))
9
10(defpackage "2DGASKET")
11(defpackage "OPENGL"
12    (:nicknames :opengl :gl)
13    (:export "INITIALIZE-GLUT"
14             "WITH-MATRIX-MODE"))
15
16;;; Opening "libglut.so" should also open "libGL.so", "libGLU.so",
17;;; and other libraries that they depend on.
18;;; It seems that it does on some platforms and not on others;
19;;; explicitly open what we require here.
20(eval-when (:compile-toplevel :load-toplevel :execute)
21  #+linux-target
22  (dolist (lib '("libGL.so" "libGLU.so" "libglut.so"))
23    (open-shared-library lib))
24  #+darwin-target
25  (let* ((s (make-semaphore)))
26    (process-interrupt ccl::*initial-process*
27                       (lambda ()
28                         (open-shared-library "GLUT.framework/GLUT")
29                         (signal-semaphore s)))
30    (wait-on-semaphore s))
31  )
32
33(in-package :opengl)
34
35;; glut complains if it's initialized redundantly
36(let ((glut-initialized-p nil))
37  (defun initialize-glut ()
38    (let ((command-line-strings (list "ccl")))
39      (when (not glut-initialized-p)
40        (ccl::with-string-vector (argv command-line-strings)
41          (rlet ((argvp (* t))    ; glutinit takes (* (:signed 32)) and (* (* (:unsigned 8)))
42                 (argcp :signed)) ; so why are these declared as (* t) and :signed?
43            (setf (%get-long argcp) (length command-line-strings)
44                  (%get-ptr argvp) argv)
45            (#_glutInit argcp argvp)))
46        (setf glut-initialized-p t))))
47  ;; When a saved image is restarted, it needs to know that glut
48  ;; hasn't been initialized yet.
49  (defun uninitialize-glut ()
50    (setf glut-initialized-p nil))
51  )
52
53(pushnew #'uninitialize-glut ccl::*save-exit-functions*
54         :key #'ccl::function-name)
55
56(defparameter *matrix-mode* #$GL_MODELVIEW)
57(defmacro with-matrix-mode (mode &body body)
58  `(unwind-protect
59       (let ((*matrix-mode* ,mode))
60         (#_glMatrixMode *matrix-mode*)
61         ,@body)
62     (#_glMatrixMode *matrix-mode*)))
63
64(in-package :2dgasket)
65
66(defun myinit ()
67  (#_glClearColor 1.0 1.0 1.0 0.0) ; white background
68  (#_glColor3f 1.0 0.0 0.0) ; red pen color
69
70  (opengl:with-matrix-mode #$GL_PROJECTION
71    (#_glLoadIdentity)
72    (#_gluOrtho2D 0.0D0 500.0D0 0.0D0 500.0D0))
73
74  ; (#_glEnable #$GL_DEPTH_TEST) ; for 3d only
75
76  (#_srand (#_time (%null-ptr)))
77  )
78
79;; 2d gasket using points
80
81(ccl::defcallback display-cb (:void)
82  (let ((bounds #2a((0.0 0.0) (250.0 500.0) (500.0 0.0)))
83        (point #(75.0 50.0)))
84    (#_glClear #$GL_COLOR_BUFFER_BIT)
85    (#_glBegin #$GL_POINTS)
86    (dotimes (i 5000)
87      (let ((j (random 3)))
88        (setf (aref point 0) (/ (+ (aref point 0) (aref bounds j 0)) 2.0)
89              (aref point 1) (/ (+ (aref point 1) (aref bounds j 1)) 2.0))
90        (#_glVertex2f (aref point 0) (aref point 1))))
91    (#_glEnd)
92    (#_glFlush)))
93
94(defun main () ; no int argc or char **argv
95  (opengl:initialize-glut)
96  (#_glutInitDisplayMode (logior #$GLUT_RGB
97                                 #$GLUT_SINGLE
98                                 #+ignore #$GLUT_DEPTH))
99  (#_glutInitWindowSize 500 500)
100  (#_glutInitWindowPosition 0 0)
101  (ccl::with-cstrs ((title "simple OpenGL example"))
102    (#_glutCreateWindow title))
103  (#_glutDisplayFunc display-cb)
104  (myinit)
105
106  ;; It appears that glut provides no mechanism for doing the event loop
107  ;; yourself -- if you want to do that, you should use some other set of
108  ;; libraries and make your own GUI toolkit.
109 
110  (#_glutMainLoop) ; this never returns
111  )
112
113
114;;; With native threads, #_glutMainLoop doesn't necessarily interfere
115;;; with scheduling: we can just run all of the OpenGL code in a
116;;; separate thread (which'll probably spend most of its time blocked
117;;; in GLUT's event loop.)  On OSX (especially) it may work best to
118;;; force the GLUT event loop to run on the main thread, which
119;;; ordinarily does period "housekeeping" tasks.  Start another thread
120;;; to do those tasks, and force the initial/main thread to run the
121;;; GLUT event loop.
122;;;
123
124;;; Try to detect cases where we're already running some sort of event
125;;; loop on OSX.  There are other ways to lose, of course.
126
127#+darwin-target
128(progn
129  (eval-when (:compile-toplevel :execute)
130    (use-interface-dir :cocoa))
131  ;; If the IDE appears to be running, complain about that.
132  (if (ignore-errors (find-symbol "*NSAPP*" "GUI"))
133    (error "This is a GLUT example; it can't possibly work ~
134                 in a GUI environment.")))
135(progn
136  (ccl:process-run-function
137   "housekeeping"
138   #'ccl::housekeeping-loop)
139  (ccl:process-interrupt
140   ccl::*initial-process*
141   (lambda ()
142     ;; CCL::%SET-TOPLEVEL is sort of like PROCESS-PRESET for the
143     ;; initial process; CCL::TOPLEVEL is sort of like PROCESS-RESET
144     ;; for that process.
145     (ccl::%set-toplevel
146      (lambda ()
147       ;;; Set the OSX Window Server's notion of the name of the
148       ;;; current process.
149       (rlet ((psn #>ProcessSerialNumber))
150         (#_GetCurrentProcess psn)
151         (with-cstrs ((name "simple OpenGL example"))
152           (ccl::external-call "_CPSSetProcessName" :address psn :address name :void)))
153       (ccl::%set-toplevel nil)
154       (main)))
155     (ccl::toplevel))))
156
157
Note: See TracBrowser for help on using the repository browser.