Factor out context gl-specific code

context.lisp

@@ -46,15 +46,11 @@
    (wait-lock :initform (bt:make-lock "Context wait lock") :reader context-wait-lock)
    (handler :initarg :handler :accessor handler)
    (shared-with :initarg :share-with :reader shared-with)
-   (glsl-target-version :initarg :glsl-version :initform NIL :accessor glsl-target-version)
    (binding-point-allocator :initform (make-array 256 :element-type 'bit) :accessor binding-point-allocator))
   (:default-initargs
    :title "Trial"
    :width 1280
    :height 720
-   :glsl-version NIL
-   :version '(3 3)
-   :profile :core
    :double-buffering T
    :stereo-buffer NIL
    :vsync :off
@@ -134,8 +130,7 @@
     (call-next-method)
     (v:info :trial.context "Recreated context successfully.")
     (make-current context)
-    (context-note-debug-info context)
-    (cache-gl-extensions)))
+    (context-note-debug-info context)))
 
 (defmethod current-p ((context context) &optional (thread (bt:current-thread)))
   (eql thread (current-thread context)))
@@ -214,20 +209,6 @@
              (with-output-to-string (out)
                (context-info context :stream out)))))
 
-(defmethod glsl-target-version ((context context))
-  (let ((slot (slot-value context 'glsl-target-version)))
-    (or slot (format NIL "~{~d~d~}0" (version context)))))
-
-(defmethod glsl-version-header ((context context))
-  (format NIL "#version ~a~@[ ~a~]"
-          (glsl-target-version context)
-          (case (profile context)
-            (:core "core")
-            (:es "es"))))
-
-(defmethod glsl-target-version ((default (eql T)))
-  (if *context* (glsl-target-version *context*) "330"))
-
 (defmethod (setf icon) ((path pathname) (context context))
   (multiple-value-bind (bits width height pixel-type pixel-format swizzle)
       (load-image path T)

gl-features.lisp

@@ -129,6 +129,29 @@
                (progn ,@body)
             (pop-features))))
 
+(defclass gl-context (context)
+  ((glsl-target-version :initarg :glsl-version :initform NIL :accessor glsl-target-version))
+  (:default-initargs
+   :version '(3 3)
+   :profile :core))
+
+(defmethod create-context :after ((context glcontext))
+  (cache-gl-extensions))
+
+(defmethod glsl-target-version ((context gl-context))
+  (let ((slot (slot-value context 'glsl-target-version)))
+    (or slot (format NIL "~{~d~d~}0" (version context)))))
+
+(defmethod glsl-version-header ((context gl-context))
+  (format NIL "#version ~a~@[ ~a~]"
+          (glsl-target-version context)
+          (case (profile context)
+            (:core "core")
+            (:es "es"))))
+
+(defmethod glsl-target-version ((default (eql T)))
+  (if *context* (glsl-target-version *context*) "330"))
+
 (defmacro with-render-settings (settings &body body)
   (let ((thunk (gensym "THUNK"))
         (settings (loop for setting in settings
@@ -153,10 +176,10 @@
          ,@(loop for (func on off) in settings
                  unless (eql off '_) collect `(setf (,func *context*) ,off))))))
 
-(defmethod (setf write-to-depth) (mask (context context))
+(defmethod (setf write-to-depth) (mask (context gl-context))
   (gl:depth-mask mask))
 
-(defmethod (setf depth-mode) (mode (context context))
+(defmethod (setf depth-mode) (mode (context gl-context))
   (ecase mode
     ((NIL) (gl:depth-func :never))
     ((T) (gl:depth-func :always))
@@ -167,21 +190,21 @@
     (< (gl:depth-func :less))
     (> (gl:depth-func :greater))))
 
-(defmethod (setf blend-mode) (mode (context context))
+(defmethod (setf blend-mode) (mode (context gl-context))
   (ecase mode
     (:additive
      (gl:blend-func :src-alpha :one))
     ((NIL :default :source-over)
      (gl:blend-func-separate :src-alpha :one-minus-src-alpha :one :one-minus-src-alpha))))
 
-(defmethod (setf culling-mode) (mode (context context))
+(defmethod (setf culling-mode) (mode (context gl-context))
   (ecase mode
     ((NIL) (disable-feature :cull-face))
     ((T) (enable-feature :cull-face))
     ((:default :back-faces) (gl:cull-face :back))
     (:front-faces (gl:cull-face :front))))
 
-(defmethod (setf stencil-mode) (mode (context context))
+(defmethod (setf stencil-mode) (mode (context gl-context))
   (ecase mode
     ((NIL)
      (gl:stencil-func :never 127 #xFFFFFF)
@@ -220,13 +243,13 @@
      (gl:stencil-func :always mode #xFFFFFF)
      (gl:stencil-op :keep :keep :replace))))
 
-(defmethod (setf clear-color) ((vec vec3) (context context))
+(defmethod (setf clear-color) ((vec vec3) (context gl-context))
   (gl:clear-color (vx3 vec) (vy3 vec) (vz3 vec) 1.0))
 
-(defmethod (setf clear-color) ((vec vec4) (context context))
+(defmethod (setf clear-color) ((vec vec4) (context gl-context))
   (gl:clear-color (vx4 vec) (vy4 vec) (vz4 vec) (vw4 vec)))
 
-(defmethod (setf clear-color) ((int integer) (context context))
+(defmethod (setf clear-color) ((int integer) (context gl-context))
   (let ((r (ldb (byte 8 0) int))
         (g (ldb (byte 8 8) int))
         (b (ldb (byte 8 16) int))
@@ -250,7 +273,7 @@
     (values vidmem-free
             vidmem-total)))
 
-(defmethod gpu-room ((context context))
+(defmethod gpu-room ((context gl-context))
   (macrolet ((jit (thing)
                `(ignore-errors
                  (return-from gpu-room
@@ -261,7 +284,7 @@
     (jit (%gl-gpu-room-nvidia))
     (jit (values 1 1))))
 
-(defmethod max-texture-id ((context context))
+(defmethod max-texture-id ((context gl-context))
   (gl:get-integer :max-texture-image-units))
 
 (define-global +gl-extensions+ ())
@@ -311,7 +334,7 @@
           ((search "AMD" vendor) :amd)
           (T :unknown))))
 
-(defmethod context-info ((context context) &key (stream *standard-output*) (show-extensions T))
+(defmethod context-info ((context gl-context) &key (stream *standard-output*) (show-extensions T))
   (format stream "~&~%Running GL~a.~a ~a~%~
                     Sample buffers:     ~a (~a sample~:p)~%~
                     Max texture size:   ~a~%~
@@ -325,7 +348,7 @@
                     ~@[GL Extensions:      ~{~a~^ ~}~%~]"
           (gl-property :major-version)
           (gl-property :minor-version)
-          (profile context)
+          (profile gl-context)
           (gl-property :sample-buffers)
           (gl-property :samples)
           (gl-property :max-texture-size)