source: tags/pre_1_0_pre_hash_modifications/ccl/examples/opengl-ffi.lisp @ 2475

Last change on this file since 2475 was 2475, checked in by anonymous, 14 years ago

This commit was manufactured by cvs2svn to create tag
'pre_1_0_pre_hash_modifications'.

  • 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  #+linuxppc-target
22  (dolist (lib '("libGL.so" "libGLU.so" "libglut.so"))
23    (open-shared-library lib))
24  #+darwinppc-target
25  (open-shared-library "GLUT.framework/GLUT")
26  )
27
28(in-package :opengl)
29
30;; glut complains if it's initialized redundantly
31(let ((glut-initialized-p nil))
32  (defun initialize-glut ()
33    (let ((command-line-strings (list "openmcl")))
34      (when (not glut-initialized-p)
35        (ccl::with-string-vector (argv command-line-strings)
36          (rlet ((argvp (* t))    ; glutinit takes (* (:signed 32)) and (* (* (:unsigned 8)))
37                 (argcp :signed)) ; so why are these declared as (* t) and :signed?
38            (setf (%get-long argcp) (length command-line-strings)
39                  (%get-ptr argvp) argv)
40            (#_glutInit argcp argvp)))
41        (setf glut-initialized-p t))))
42  ;; When a saved image is restarted, it needs to know that glut
43  ;; hasn't been initialized yet.
44  (defun uninitialize-glut ()
45    (setf glut-initialized-p nil))
46  )
47
48(pushnew #'uninitialize-glut ccl::*save-exit-functions*
49         :key #'ccl::function-name)
50
51(defparameter *matrix-mode* #$GL_MODELVIEW)
52(defmacro with-matrix-mode (mode &body body)
53  `(unwind-protect
54       (let ((*matrix-mode* ,mode))
55         (#_glMatrixMode *matrix-mode*)
56         ,@body)
57     (#_glMatrixMode *matrix-mode*)))
58
59(in-package :2dgasket)
60
61(defun myinit ()
62  (#_glClearColor 1.0 1.0 1.0 0.0) ; white background
63  (#_glColor3f 1.0 0.0 0.0) ; red pen color
64
65  (opengl:with-matrix-mode #$GL_PROJECTION
66    (#_glLoadIdentity)
67    (#_gluOrtho2D 0.0D0 500.0D0 0.0D0 500.0D0))
68
69  ; (#_glEnable #$GL_DEPTH_TEST) ; for 3d only
70
71  (#_srand (#_time (%null-ptr)))
72  )
73
74;; 2d gasket using points
75
76(ccl::defcallback display-cb (:void)
77  (let ((bounds #2a((0.0 0.0) (250.0 500.0) (500.0 0.0)))
78        (point #(75.0 50.0)))
79    (#_glClear #$GL_COLOR_BUFFER_BIT)
80    (#_glBegin #$GL_POINTS)
81    (dotimes (i 5000)
82      (let ((j (random 3)))
83        (setf (aref point 0) (/ (+ (aref point 0) (aref bounds j 0)) 2.0)
84              (aref point 1) (/ (+ (aref point 1) (aref bounds j 1)) 2.0))
85        (#_glVertex2f (aref point 0) (aref point 1))))
86    (#_glEnd)
87    (#_glFlush)))
88
89(defun main () ; no int argc or char **argv
90  (opengl:initialize-glut)
91  (#_glutInitDisplayMode (logior #$GLUT_RGB
92                                 #$GLUT_SINGLE
93                                 #+ignore #$GLUT_DEPTH))
94  (#_glutInitWindowSize 500 500)
95  (#_glutInitWindowPosition 0 0)
96  (ccl::with-cstrs ((title "simple OpenGL example"))
97    (#_glutCreateWindow title))
98  (#_glutDisplayFunc display-cb)
99  (myinit)
100; It appears that glut provides no mechanism for doing the event loop
101; yourself -- if you want to do that, you should use some other set of
102; libraries and make your own GUI toolkit.
103 
104  (#_glutMainLoop) ; this never returns and interferes w/scheduling
105  )
106
107
108;;; With native threads, #_glutMainLoop doesn't necessarily interfere
109;;; with scheduling: we can just run all of the OpenGL code in a separate
110;;; thread (which'll probably spend most of its time blocked in GLUT's
111;;; event loop.)  On OSX, we need to use an undocumented API or two
112;;; to ensure that the thread we're creating is seen as the "main"
113;;; event handling thread (that's what the code that sets the current
114;;; thread's CFRunLoop to the main CFRunLoop does.)
115#+OpenMCL-native-threads
116(ccl:process-run-function
117 "OpenGL main thread"
118 #'(lambda ()
119     #+darwinppc-target
120     (progn
121       ;;; In OSX, a "run loop" is a data structure that
122       ;;; describes how event-handling code should block
123       ;;; for events, timers, and other event sources.
124       ;;; Ensure that this thread has a "current run loop".
125       ;;; (Under some circumstances, there may not yet be
126       ;;; a "main" run loop; setting the "current" run loop
127       ;;; ensures that a main run loop exists.)
128       (ccl::external-call "_CFRunLoopGetCurrent" :address)
129       ;;; Make the current thread's run loop be the "main" one;
130       ;;; only the main run loop can interact with the window
131       ;;; server.
132       (ccl::external-call
133        "__CFRunLoopSetCurrent"
134        :address (ccl::external-call "_CFRunLoopGetMain" :address))
135       ;;; Set the OSX Window Server's notion of the name of the
136       ;;; current process.
137       (%stack-block ((psn 8))
138         (ccl::external-call "_GetCurrentProcess" :address psn)
139         (with-cstrs ((name "simple OpenGL example"))
140           (ccl::external-call "_CPSSetProcessName" :address psn :address name))))
141     (main)))
142
143; (main)
144
Note: See TracBrowser for help on using the repository browser.