Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

reset glut font pointers in GLUT:INIT to try to handle saving cores b…

…etter
  • Loading branch information...
commit 2c25e1995544c94734acdb9ed64bffbb737d5807 1 parent c211764
@3b authored
Showing with 51 additions and 35 deletions.
  1. +50 −35 glut/fonts.lisp
  2. +1 −0  glut/init.lisp
View
85 glut/fonts.lisp
@@ -40,41 +40,56 @@
;;; Unless it's windows, in which case it's a sort of enum-as-pointer
;;; thing. "So here it goes:"
-(defparameter +stroke-roman+
- #+windows (make-pointer 0)
- #-windows (foreign-symbol-pointer "glutStrokeRoman"))
-
-(defparameter +stroke-mono-roman+
- #+windows (make-pointer 1)
- #-windows (foreign-symbol-pointer "glutStrokeMonoRoman"))
-
-(defparameter +bitmap-9-by-15+
- #+windows (make-pointer 2)
- #-windows (foreign-symbol-pointer "glutBitmap9By15"))
-
-(defparameter +bitmap-8-by-13+
- #+windows (make-pointer 3)
- #-windows (foreign-symbol-pointer "glutBitmap8By13"))
-
-(defparameter +bitmap-times-roman-10+
- #+windows (make-pointer 4)
- #-windows (foreign-symbol-pointer "glutBitmapTimesRoman10"))
-
-(defparameter +bitmap-times-roman-24+
- #+windows (make-pointer 5)
- #-windows (foreign-symbol-pointer "glutBitmapTimesRoman24"))
-
-(defparameter +bitmap-helvetica-10+
- #+windows (make-pointer 6)
- #-windows (foreign-symbol-pointer "glutBitmapHelvetica10"))
-
-(defparameter +bitmap-helvetica-12+
- #+windows (make-pointer 7)
- #-windows (foreign-symbol-pointer "glutBitmapHelvetica12"))
-
-(defparameter +bitmap-helvetica-18+
- #+windows (make-pointer 8)
- #-windows (foreign-symbol-pointer "glutBitmapHelvetica18"))
+(defvar +stroke-roman+)
+(defvar +stroke-mono-roman+)
+(defvar +bitmap-9-by-15+)
+(defvar +bitmap-8-by-13+)
+(defvar +bitmap-times-roman-10+)
+(defvar +bitmap-times-roman-24+)
+(defvar +bitmap-helvetica-10+)
+(defvar +bitmap-helvetica-12+)
+(defvar +bitmap-helvetica-18+)
+
+;; we need to be able to reinitialize the pointers after loading a
+;; saved core, so move it to a separate function...
+(defun init-font-pointers ()
+ (setf +stroke-roman+
+ #+windows (make-pointer 0)
+ #-windows (foreign-symbol-pointer "glutStrokeRoman"))
+
+ (setf +stroke-mono-roman+
+ #+windows (make-pointer 1)
+ #-windows (foreign-symbol-pointer "glutStrokeMonoRoman"))
+
+ (setf +bitmap-9-by-15+
+ #+windows (make-pointer 2)
+ #-windows (foreign-symbol-pointer "glutBitmap9By15"))
+
+ (setf +bitmap-8-by-13+
+ #+windows (make-pointer 3)
+ #-windows (foreign-symbol-pointer "glutBitmap8By13"))
+
+ (setf +bitmap-times-roman-10+
+ #+windows (make-pointer 4)
+ #-windows (foreign-symbol-pointer "glutBitmapTimesRoman10"))
+
+ (setf +bitmap-times-roman-24+
+ #+windows (make-pointer 5)
+ #-windows (foreign-symbol-pointer "glutBitmapTimesRoman24"))
+
+ (setf +bitmap-helvetica-10+
+ #+windows (make-pointer 6)
+ #-windows (foreign-symbol-pointer "glutBitmapHelvetica10"))
+
+ (setf +bitmap-helvetica-12+
+ #+windows (make-pointer 7)
+ #-windows (foreign-symbol-pointer "glutBitmapHelvetica12"))
+
+ (setf +bitmap-helvetica-18+
+ #+windows (make-pointer 8)
+ #-windows (foreign-symbol-pointer "glutBitmapHelvetica18")))
+
+(init-font-pointers)
;;; Functions
View
1  glut/init.lisp
@@ -51,6 +51,7 @@
(with-foreign-string (str program-name)
(setf (mem-ref argv :pointer) str)
(%glutInit argcp argv)
+ (init-font-pointers)
(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.
Please sign in to comment.
Something went wrong with that request. Please try again.