Use the GLUT Framework on Darwin
Sat Jul 25 15:55:54 PDT 2009 Luis Oliveira <loliveira@common-lisp.net>
* Use the GLUT Framework on Darwin
Patch courtesy of Xristos <xristos@suspicious.org> and others.
{
hunk ./glut/callbacks.lisp 140
+#-darwin
hunk ./glut/callbacks.lisp 145
-;; freeglut ext
-(defcfun ("glutCloseFunc" close-func) :void
+;; freeglut/GLUT.framework ext
+(defcfun (#-darwin "glutCloseFunc"
+ #+darwin "glutWMCloseFunc" close-func) :void
hunk ./glut/callbacks.lisp 157
+#-darwin
hunk ./glut/fonts.lisp 110
+#-darwin
hunk ./glut/fonts.lisp 115
+#-darwin
hunk ./glut/fonts.lisp 120
+#-darwin
hunk ./glut/fonts.lisp 126
+#-darwin
hunk ./glut/geometry.lisp 95
+#-darwin
hunk ./glut/geometry.lisp 97
+
+#-darwin
hunk ./glut/geometry.lisp 101
+#-darwin
hunk ./glut/geometry.lisp 107
+#-darwin
hunk ./glut/geometry.lisp 112
+#-darwin
hunk ./glut/geometry.lisp 118
+#-darwin
hunk ./glut/geometry.lisp 123
+#-darwin
hunk ./glut/geometry.lisp 130
+#-darwin
hunk ./glut/init.lisp 46
+(defparameter *glut-initialized-p* nil)
+
+#+(and darwin (or openmcl-native-threads sb-thread))
+(defparameter *glut-thread* nil)
+
+(defun make-thread (name function)
+ #+openmcl-native-threads (ccl:process-run-function name function)
+ #+sb-thread (sb-thread:make-thread function :name name)
+ #-(or openmcl-native-threads sb-thread)
+ (error "CL-GLUT::MAKE-THREAD not implemented for this Lisp."))
+
+(defun %init (program-name)
+ (with-foreign-objects ((argcp :int) (argv :pointer))
+ (setf (mem-ref argcp :int) 1)
+ (with-foreign-string (str program-name)
+ (setf (mem-ref argv :pointer) str)
+ (%glutInit argcp argv)
+ (setf *glut-initialized-p* t)))
+ ;; By default, we choose the saner option to return from the event
+ ;; loop on window close instead of exit()ing.
+ (set-action-on-window-close :action-continue-execution)
+ ;; this probably doesn't play well with other toolkits
+ (setq %gl:*gl-get-proc-address* 'get-proc-address)
+ (values))
+
+;;; From CCL's opengl-ffi:
+;;;
+;;; "On OSX, we need to use an undocumented API or two to ensure that
+;;; the thread we're creating is seen as the 'main' event handling
+;;; thread (that's what the code that sets the current thread's
+;;; CFRunLoop to the main CFRunLoop does.)"
+
+#+(and darwin (or sb-thread openmcl-native-threads))
+(progn
+ (defcfun ("CFRunLoopGetCurrent" cf-run-loop-get-current) :pointer)
+ (defcfun ("_CFRunLoopSetCurrent" cf-run-loop-set-current)
+ :pointer (arg :pointer))
+ (defcfun ("CFRunLoopGetMain" cf-run-loop-get-main) :pointer))
+
hunk ./glut/init.lisp 87
- ;; freeglut will exit() if we try to call initGlut() when
- ;; things are already initialized.
- (unless (getp :init-state)
- (with-foreign-objects ((argcp :int) (argv :pointer))
- (setf (mem-ref argcp :int) 1)
- (with-foreign-string (str program-name)
- (setf (mem-ref argv :pointer) str)
- (%glutInit argcp argv)))
- ;; By default, we choose the saner option to return from the event
- ;; loop on window close instead of exit()ing.
- (set-action-on-window-close :action-continue-execution)
- ;; this probably doesn't play well with other toolkits
- (setq %gl:*gl-get-proc-address* 'get-proc-address)))
+ ;; freeglut will exit() if we try to call initGlut() when
+ ;; things are already initialized.
+ (unless *glut-initialized-p*
+ #+(and darwin (or sb-thread openmcl-native-threads))
+ (setf *glut-thread*
+ (make-thread
+ "CL-GLUT thread"
+ (lambda ()
+ ;; In OSX, a "run loop" is a data structure that
+ ;; describes how event-handling code should block for
+ ;; events, timers, and other event sources. Ensure that
+ ;; this thread has a "current run loop". (Under some
+ ;; circumstances, there may not yet be a "main" run
+ ;; loop; setting the "current" ensures that a main loop
+ ;; exists.)
+ (cf-run-loop-get-current)
+ ;; Make the current thread's run loop be the "main" one;
+ ;; only the main run loop can interact with the window
+ ;; server.
+ (cf-run-loop-set-current (cf-run-loop-get-main))
+ (%init program-name)
+ (loop (sleep 1)))))
+ #-(and darwin (or sb-thread openmcl-native-threads))
+ (%init program-name)))
hunk ./glut/interface.lisp 192
- ;; (wm-close (window)) ; synonym for CLOSE
hunk ./glut/interface.lisp 222
+ (destroyed :accessor destroyed :initform nil)
hunk ./glut/interface.lisp 308
- (with-window window
- (register-callback event))
- (pushnew event (events window))
- (when (eq event-name :idle)
- (push window *windows-with-idle-event*))))
+ (when (not (find event (events window)))
+ (with-window window
+ (register-callback event))
+ (push event (events window))
+ (when (eq event-name :idle)
+ (push window *windows-with-idle-event*)))))
+
hunk ./glut/interface.lisp 321
- ;; We don't actually disable the CLOSE event since we need it
- ;; for bookkeeping. See the CLOSE methods below.
- (unless (or (eq event-name :idle) (eq event-name :close))
- (with-window window
- (unregister-callback event)))
- (setf (events window) (delete event (events window)))
- (when (eq event-name :idle)
- (setq *windows-with-idle-event*
- (delete window *windows-with-idle-event*))))))
+ (when (find event (events window))
+ ;; We don't actually disable the CLOSE event since we need it
+ ;; for bookkeeping. See the CLOSE methods below.
+ (unless (or (eq event-name :idle)
+ (eq event-name :close))
+ (with-window window
+ (unregister-callback event)))
+ (setf (events window) (delete event (events window)))
+ (when (eq event-name :idle)
+ (setq *windows-with-idle-event*
+ (delete window *windows-with-idle-event*))
+ ;; We need to disable the idle callback here too in
+ ;; addition to close.
+ (when (null *windows-with-idle-event*)
+ (unregister-callback event)))))))
hunk ./glut/interface.lisp 339
- (if (game-mode current-window)
- (leave-game-mode)
- (destroy-window (id current-window)))))
+ (cond
+ ((game-mode current-window)
+ (leave-game-mode))
+ (t
+ (destroy-window (id current-window))
+ #+darwin
+ (progn
+ (setf (destroyed current-window) t)
+ (close current-window))))))
hunk ./glut/interface.lisp 354
+ #+darwin
+ (when (not (destroyed w))
+ (setf (destroyed w) t)
+ (destroy-window (id w)))
hunk ./glut/interface.lisp 359
- (unregister-callback (find-event-or-lose :idle))))
+ (unregister-callback (find-event-or-lose :idle)))
+ #+darwin
+ (progn
+ (when (= 0 (length (remove-if #'null *id->window*)))
+ ;; We want to leave the glut event loop if all glut windows are
+ ;; closed, even when :action-continue-execution is set.
+ (leave-main-loop))
+ (ecase *window-close-action*
+ ;; :action-exit is probably unnecessary, as it should never be used.
+ (:action-exit
+ #+sbcl (sb-ext:quit)
+ #+ccl (ccl:quit)
+ #-(or sbcl ccl) (warn "Don't know how to quit."))
+ (:action-glutmainloop-returns
+ (leave-main-loop))
+ (:action-continue-execution
+ nil))))
hunk ./glut/interface.lisp 446
-
-;;;; For posterity
-
-;;; "This is quite ugly: OS X is very picky about which thread gets to handle
-;;; events and only allows the main thread to do so. We need to run any event
-;;; loops in the initial thread on multithreaded Lisps, or in this case,
-;;; OpenMCL."
-
-;; #-openmcl
-;; (defun run-event-loop ()
-;; (glut:main-loop))
-
-;; #+openmcl
-;; (defun run-event-loop ()
-;; (flet ((start ()
-;; (ccl:%set-toplevel nil)
-;; (glut:main-loop)))
-;; (ccl:process-interrupt ccl::*initial-process*
-;; (lambda ()
-;; (ccl:%set-toplevel #'start)
-;; (ccl:toplevel)))))
hunk ./glut/library.lisp 35
+;;; TODO: check what other (threaded) Lisps might need to load this
+;;; framework which is necessary to setup the necessary magic for
+;;; GLUT's main loop. CCL already loads this framework by default.
+(define-foreign-library core-foundation
+ ((:and :darwin :sb-thread) (:framework "CoreFoundation")))
+
hunk ./glut/library.lisp 42
- (:darwin (:or "libglut.dylib" "libglut.3.dylib"))
+ (:darwin (:framework "GLUT"))
hunk ./glut/library.lisp 47
+(use-foreign-library core-foundation)
hunk ./glut/main.lisp 37
+#+darwin
+(defcfun ("glutCheckLoop" check-loop) :void)
+
+#-darwin
hunk ./glut/main.lisp 46
-(defcfun ("glutMainLoopEvent" main-loop-event) :void)
+#+(and darwin (or openmcl-native-threads sb-thread))
+(defun interrupt-thread (thread function)
+ #+ccl (ccl:process-interrupt thread function)
+ #+sbcl (sb-thread:interrupt-thread thread function))
+
+#+darwin
+(let ((darwin-run-main-loop-p t))
+ (defun main-loop ()
+ (flet ((%loop ()
+ (without-fp-traps
+ (loop while darwin-run-main-loop-p do (check-loop)))
+ (init)
+ (setf darwin-run-main-loop-p t)))
+ #+(or openmcl-native-threads sb-thread)
+ (interrupt-thread *glut-thread* #'%loop)
+ #-(or openmcl-native-threads sb-thread)
+ (%loop)))
+ (defun leave-main-loop ()
+ (setf darwin-run-main-loop-p nil)))
+
+#-darwin (defcfun ("glutMainLoopEvent" main-loop-event) :void)
+#-darwin (defcfun ("glutLeaveMainLoop" leave-main-loop) :void)
hunk ./glut/main.lisp 69
-(defcfun ("glutLeaveMainLoop" leave-main-loop) :void)
hunk ./glut/misc.lisp 76
-(defcfun ("glutEnterGameMode" enter-game-mode) :int)
+(defcfun ("glutEnterGameMode" enter-game-mode) #-darwin :int #+darwin :void)
hunk ./glut/state.lisp 44
+(defparameter *window-close-action* nil)
+
hunk ./glut/state.lisp 59
+#-darwin
hunk ./glut/state.lisp 64
+#+darwin
+(defun set-option (val1 val2)
+ (declare (ignore val1 val2))
+ (warn "GLUT:SET-OPTION not supported in GLUT.framework"))
+
hunk ./glut/state.lisp 112
+ #-darwin
hunk ./glut/state.lisp 114
- (foreign-enum-value 'window-close-behaviour action)))
+ (foreign-enum-value 'window-close-behaviour action))
+ (setf *window-close-action* action))
hunk ./glut/state.lisp 169
- :rendering-context ; freeglut ext
+
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
The following corrupt files were found:
/tiger/project/cl-opengl/public_html/darcs/cl-opengl/_darcs/patches/20090725225554-28748-44af07993c30ff5a08f63ce8c379c1d392041eda.gz
#-darwin :rendering-context ; freeglut ext
}