source: release/1.9/source/examples/opengl-ffi.lisp @ 15774

Last change on this file since 15774 was 15450, checked in by gb, 7 years ago

Unscramble #_glutInit arguments. Fixes ticket:1009 in the trunk.
Conditionalize startup code for Darwin/Linux?.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.9 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 ((argcp :int (length command-line-strings)))
42            (#_glutInit argcp argv)))
43        (setf glut-initialized-p t))))
44  ;; When a saved image is restarted, it needs to know that glut
45  ;; hasn't been initialized yet.
46  (defun uninitialize-glut ()
47    (setf glut-initialized-p nil))
48  )
49
50(pushnew #'uninitialize-glut ccl::*save-exit-functions*
51         :key #'ccl::function-name)
52
53(defparameter *matrix-mode* #$GL_MODELVIEW)
54(defmacro with-matrix-mode (mode &body body)
55  `(unwind-protect
56       (let ((*matrix-mode* ,mode))
57         (#_glMatrixMode *matrix-mode*)
58         ,@body)
59     (#_glMatrixMode *matrix-mode*)))
60
61(in-package :2dgasket)
62
63(defun myinit ()
64  (#_glClearColor 1.0 1.0 1.0 0.0) ; white background
65  (#_glColor3f 1.0 0.0 0.0) ; red pen color
66
67  (opengl:with-matrix-mode #$GL_PROJECTION
68    (#_glLoadIdentity)
69    (#_gluOrtho2D 0.0D0 500.0D0 0.0D0 500.0D0))
70
71  ; (#_glEnable #$GL_DEPTH_TEST) ; for 3d only
72
73  (#_srand (#_time (%null-ptr)))
74  )
75
76;; 2d gasket using points
77
78(ccl::defcallback display-cb (:void)
79  (let ((bounds #2a((0.0 0.0) (250.0 500.0) (500.0 0.0)))
80        (point #(75.0 50.0)))
81    (#_glClear #$GL_COLOR_BUFFER_BIT)
82    (#_glBegin #$GL_POINTS)
83    (dotimes (i 5000)
84      (let ((j (random 3)))
85        (setf (aref point 0) (/ (+ (aref point 0) (aref bounds j 0)) 2.0)
86              (aref point 1) (/ (+ (aref point 1) (aref bounds j 1)) 2.0))
87        (#_glVertex2f (aref point 0) (aref point 1))))
88    (#_glEnd)
89    (#_glFlush)))
90
91(defun main () ; no int argc or char **argv
92  (opengl:initialize-glut)
93  (#_glutInitDisplayMode (logior #$GLUT_RGB
94                                 #$GLUT_SINGLE
95                                 #+ignore #$GLUT_DEPTH))
96  (#_glutInitWindowSize 500 500)
97  (#_glutInitWindowPosition 0 0)
98  (ccl::with-cstrs ((title "simple OpenGL example"))
99    (#_glutCreateWindow title))
100  (#_glutDisplayFunc display-cb)
101  (myinit)
102
103  ;; It appears that glut provides no mechanism for doing the event loop
104  ;; yourself -- if you want to do that, you should use some other set of
105  ;; libraries and make your own GUI toolkit.
106 
107  (#_glutMainLoop) ; this never returns
108  )
109
110
111;;; With native threads, #_glutMainLoop doesn't necessarily interfere
112;;; with scheduling: we can just run all of the OpenGL code in a
113;;; separate thread (which'll probably spend most of its time blocked
114;;; in GLUT's event loop.)  On OSX (especially) it may work best to
115;;; force the GLUT event loop to run on the main thread, which
116;;; ordinarily does period "housekeeping" tasks.  Start another thread
117;;; to do those tasks, and force the initial/main thread to run the
118;;; GLUT event loop.
119;;;
120
121;;; Try to detect cases where we're already running some sort of event
122;;; loop on OSX.  There are other ways to lose, of course.
123
124#+darwin-target
125(progn
126  (eval-when (:compile-toplevel :execute)
127    (use-interface-dir :cocoa))
128  ;; If the IDE appears to be running, complain about that.
129  (if (ignore-errors (find-symbol "*NSAPP*" "GUI"))
130    (error "This is a GLUT example; it can't possibly work ~
131                 in a GUI environment.")))
132
133#+darwin-target
134(progn
135  (ccl:process-run-function
136   "housekeeping"
137   #'ccl::housekeeping-loop)
138  (ccl:process-interrupt
139   ccl::*initial-process*
140   (lambda ()
141     ;; CCL::%SET-TOPLEVEL is sort of like PROCESS-PRESET for the
142     ;; initial process; CCL::TOPLEVEL is sort of like PROCESS-RESET
143     ;; for that process.
144     (ccl::%set-toplevel
145      (lambda ()
146       ;;; Set the OSX Window Server's notion of the name of the
147       ;;; current process.
148       (rlet ((psn #>ProcessSerialNumber))
149         (#_GetCurrentProcess psn)
150         (with-cstrs ((name "simple OpenGL example"))
151           (ccl::external-call "_CPSSetProcessName" :address psn :address name :void)))
152       (ccl::%set-toplevel nil)
153       (main)))
154     (ccl::toplevel))))
155
156#-darwin-target
157(process-run-function "GLUT Main" #'2dgasket::main)
158
159
160
Note: See TracBrowser for help on using the repository browser.