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

Last change on this file since 11990 was 11990, checked in by gb, 11 years ago

Try to run the GLUT event loop on the main thread, just in case some
future OSX release insists on that.

Don't try to start the GLUT event loop at all if on OSX and we're already
a GUI application; error in that case.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.2 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 current (window system) process is visible (has a UI),
132  ;; we can't possibly win.
133  (rlet ((psn #>ProcessSerialNumber))
134    (and (eql 0 (#_GetCurrentProcess psn))
135         (not (eql #$false (#_IsProcessVisible psn)))
136         (error "This is a GLUT example; it can't possibly work ~
137                 in a GUI environment."))))
138(progn
139  (ccl:process-run-function
140   "housekeeping"
141   #'ccl::housekeeping-loop)
142  (ccl:process-interrupt
143   ccl::*initial-process*
144   (lambda ()
145     ;; CCL::%SET-TOPLEVEL is sort of like PROCESS-PRESET for the
146     ;; initial process; CCL::TOPLEVEL is sort of like PROCESS-RESET
147     ;; for that process.
148     (ccl::%set-toplevel
149      (lambda ()
150       ;;; Set the OSX Window Server's notion of the name of the
151       ;;; current process.
152       (rlet ((psn #>ProcessSerialNumber))
153         (#_GetCurrentProcess psn)
154         (with-cstrs ((name "simple OpenGL example"))
155           (ccl::external-call "_CPSSetProcessName" :address psn :address name :void)))
156       (ccl::%set-toplevel nil)
157       (main)))
158     (ccl::toplevel))))
159
160
Note: See TracBrowser for help on using the repository browser.