Commit 286801fd authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'rtoy-update-clx' into rtoy-update-clx-with-cmucl-fixes

parents c802a375 e6f4c980
Loading
Loading
Loading
Loading
+0 −3
Original line number Diff line number Diff line
@@ -12,9 +12,6 @@
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

#+cmu
(ext:file-comment "$Id: big-requests.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")

(in-package "XLIB")

;;; No new events or errors are defined by this extension.  (Big
+2 −5
Original line number Diff line number Diff line
@@ -13,10 +13,7 @@
;;;;  any purpose of the information in this document.  This documentation is
;;;;  provided ``as is'' without express or implied warranty.

#+cmu
(ext:file-comment "$Id: dpms.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")

(defpackage :dpms
(defpackage #:xlib/dpms
  (:use :common-lisp)
  (:import-from :xlib
                "DEFINE-EXTENSION"
@@ -39,7 +36,7 @@
           "DPMS-FORCE-LEVEL"
           "DPMS-INFO"))

(in-package :dpms)
(in-package #:xlib/dpms)

(define-extension "DPMS")

+56 −8
Original line number Diff line number Diff line
#+cmu
(ext:file-comment "$Id: gl.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")

(defpackage :gl
(defpackage #:xlib/gl
  (:use :common-lisp :xlib)
  (:import-from :glx
  (:import-from :xlib/glx
                "*CURRENT-CONTEXT*"
                "CONTEXT"
                "CONTEXT-P"
@@ -1156,7 +1153,7 @@
           ))


(in-package :gl)
(in-package #:xlib/gl)



@@ -2138,6 +2135,27 @@
  value)


#+lispworks
(progn
  (defun %single-float-bits (x)
    (declare (type single-float x))
    (fli:with-dynamic-foreign-objects ((bits :int32))
      (fli:with-coerced-pointer (pointer :type :lisp-single-float) bits
        (setf (fli:dereference pointer) x))
      (fli:dereference bits)))

  (declaim (notinline aset-float32))
  (defun aset-float32 (value array index)
    (declare (type (or short-float single-float) value)
             (type buffer-bytes array)
             (type array-index index))
    #.(declare-buffun)
    (let ((bits (%single-float-bits (coerce value 'single-float))))
      (declare (type (unsigned-byte 32) bits))
      (aset-card32 bits array index))
    value))


#+sbcl
(defun aset-float64 (value array index)
  (declare (type double-float value)
@@ -2180,6 +2198,36 @@
  value)


#+lispworks
(progn
  (fli:define-c-struct %uint64
    (high :uint32)
    (low :uint32))

  (defun %double-float-bits (x)
    (declare (type double-float x))
    (fli:with-dynamic-foreign-objects ((bits %uint64))
      (fli:with-coerced-pointer (pointer :type :lisp-double-float) bits
        (setf (fli:dereference pointer) x))

      (values (fli:foreign-slot-value bits 'low :type :uint32 :object-type '%uint64)
              (fli:foreign-slot-value bits 'high :type :uint32 :object-type '%uint64))))

  (declaim (notinline aset-float64))
  (defun aset-float64 (value array index)
    (declare (type double-float value)
             (type buffer-bytes array)
             (type array-index index))
    #.(declare-buffun)
    (multiple-value-bind (low high)
        (%double-float-bits value)
      (declare (type (unsigned-byte 32) low high))

      (aset-card32 low array index)
      (aset-card32 high array (the array-index (+ index 4))))
    value))


(eval-when (:compile-toplevel :load-toplevel :execute)
(defun byte-width (type)
  (ecase type
@@ -2593,7 +2641,7 @@
                                  #.+convolution-width+
                                  #.+convolution-height+
                                  #.+max-convolution-width+
                                  #.+max-convolution-width+)
                                  #.+max-convolution-height+)
                                 1)
                                ((#.+convolution-filter-scale+
                                  #.+convolution-filter-bias+)
@@ -2619,7 +2667,7 @@
                                #.+convolution-width+
                                #.+convolution-height+
                                #.+max-convolution-width+
                                #.+max-convolution-width+)
                                #.+max-convolution-height+)
                               1)
                              ((#.+convolution-filter-scale+
                                #.+convolution-filter-bias+)
+6 −9
Original line number Diff line number Diff line
#+cmu
(ext:file-comment "$Id: glx.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")

(defpackage :glx
(defpackage #:xlib/glx
  (:use :common-lisp :xlib)
  (:import-from :xlib
                "DEFINE-ACCESSOR"
@@ -72,11 +69,11 @@
           ))


(in-package :glx)


(declaim (optimize (debug 3) (safety 3)))
(in-package #:xlib/glx)

;;; Generally don't want this declamation to have load-time effects
(eval-when (:compile-toplevel)
  (declaim (optimize (debug 3) (safety 3))))

(define-extension "GLX"
    :events (:glx-pbuffer-clobber)
@@ -599,7 +596,7 @@ Example: '(:glx-rgba (:glx-alpha-size 4) :glx-double-buffer (:glx-class 4 =)."
  (let* ((ctx *current-context*)
         (display (context-display ctx)))
    ;; Make sure all rendering commands are sent away.
    (glx:render)
    (render)
    (with-buffer-request (display (extension-opcode display "GLX"))
      (data +swap-buffers+)
      ;; *** GLX_CONTEXT_TAG
Loading