(in-package #:ocl)

(defun create-buffer (context flags size &optional (host-ptr (cffi:null-pointer)))
  (check-error-arg (%create-buffer context flags size host-ptr)))

;; TODO: Support multi-dimensional arrays? row-major?
(defun create-buffer-from-array (context flags array)
  (let* ((length (length array))
         (c-type (array-foreign-type array))
         (size (* length (cffi:foreign-type-size c-type))))
    (cffi:with-foreign-array (c-array array (list :array c-type length))
      (check-error-arg (%create-buffer context flags size c-array)))))

(defun create-pipe (context flags packet-size max-packets &key properties)
  (declare (ignorable properties))
  (check-error-arg
   (%create-pipe context flags packet-size max-packets (cffi:null-pointer))))

(defun retain-mem-object (memobj)
  (check-error (%retain-mem-object memobj)))

(defun release-mem-object (memobj)
  (check-error (%release-mem-object memobj)))

(get-cl-objects get-supported-image-formats (context flags image-type)
                %get-supported-image-formats 'cl-image-format)

(defparameter +mem-object-info-type-alist+
  '((:mem-type                 . cl-mem-object-type)
    (:mem-flags                . cl-mem-flags)
    (:mem-size                 . :size)
    (:mem-host-ptr             . (:pointer :void))
    (:mem-map-count            . cl-uint)
    (:mem-reference-count      . cl-uint)
    (:mem-context              . cl-context)
    (:mem-associated-memobject . cl-mem)
    (:mem-offset               . :size)
    (:mem-uses-svm-pointer     . cl-bool)
    (:mem-properties           . (:pointer cl-mem-properties))))

(wrap-get-info-function get-mem-object-info %get-mem-object-info
                        +mem-object-info-type-alist+)

(defparameter +image-info-type-alist+
  '((:image-format         . cl-image-format)
    (:image-element-size   . :size)
    (:image-row-pitch      . :size)
    (:image-slice-pitch    . :size)
    (:image-width          . :size)
    (:image-height         . :size)
    (:image-depth          . :size)
    (:image-array-size     . :size)
    (:image-buffer         . cl-mem)
    (:image-num-mip-levels . cl-uint)
    (:image-num-samples    . cl-uint)))

(wrap-get-info-function get-image-info %get-image-info +image-info-type-alist+)

(defparameter +pipe-info-type-alist+
  '((:pipe-packet-size . cl-uint)
    (:pipe-max-packets . cl-uint)
    (:pipe-properties  . (:pointer cl-pipe-properties))))

(wrap-get-info-function get-pipe-info %get-pipe-info +pipe-info-type-alist+)

(defmacro with-mem-object ())

(defmacro with-buffer ((buffer context flags size &optional host-ptr) &body body)
  `(let ((,buffer (create-buffer ,context ,flags ,size ,(if host-ptr host-ptr '(cffi:null-pointer)))))
     (unwind-protect
          (progn ,@body)
       (release-mem-object ,buffer))))

(defmacro with-buffer-from-array ((buffer context flags array) &body body)
  `(let ((,buffer (create-buffer-from-array ,context ,flags ,array)))
     (unwind-protect
          (progn ,@body)
       (release-mem-object ,buffer))))

(defmacro with-buffers-from-arrays ())

(defun copy-buffer-to-array (queue buffer array)
  (let* ((length (length array))
         (c-type (array-foreign-type array))
         (size (* length (cffi:foreign-type-size c-type))))
    (cffi:with-foreign-object (c-array c-type length)
      (enqueue-read-buffer queue buffer t 0 size c-array)
      (dotimes (i length)
        (setf (aref array i) (cffi:mem-aref c-array c-type i))))))