(ql:quickload "cl-nextstep")

(eval-when (:compile-toplevel :load-toplevel :execute)
  
  (defun cgify-name (symbol)
    "Convert 'lisp-name into \"CGContextLispName\"."
    (let* ((segs (uiop:split-string (string symbol) :separator '(#\-)))
           (title (loop for seg in segs
                        collect (cond ((string= seg "CTM") "CTM")
                                      ((string= seg "EO") "EO")
                                      (t (string-capitalize seg))))))
      (format nil "CGContext~{~a~}" title)))
  
  (defun interpret-args (args)
    "Convert list of args, with optional interleaved type keywords
(default :double), into defun-args (and cffi-args)."
  (let ((next-type :double)
        (defun-args (list))
        (cffi-args (list)))
    (dolist (arg args)
      (if (keywordp arg)
          (setf next-type arg)
          (progn
            (setf defun-args (nconc defun-args `(,arg)))
            (setf cffi-args
                  (nconc cffi-args
                         (case next-type
                           (:double `(:double (cgfloat ,arg)))
                           (:rect `((:struct ns:rect) ,arg))
                           (otherwise `(,next-type ,arg)))))
            (setf next-type :double))))
    (values defun-args cffi-args))))

;; (cgify-name 'scale-ctm)
;; => "CGContextScaleCTM"

(defmacro defcall (symbol &optional args)
  "Simplify cffi Core Graphics defuns."
  (multiple-value-bind (defun-args cffi-args) (interpret-args args)
    `(defun ,symbol (context ,@defun-args)
       (cffi:foreign-funcall ,(cgify-name symbol)
                             :pointer context
                             ,@cffi-args))))

;; (macroexpand-1 '(defcall stroke-rect-with-width (:rect rect width)))
;;  => (DEFUN STROKE-RECT-WITH-WIDTH (CONTEXT RECT WIDTH)
;;   (CFFI:FOREIGN-FUNCALL "CGContextStrokeRectWithWidth" :POINTER CONTEXT
;;                         (:STRUCT CL-NEXTSTEP:RECT) RECT :DOUBLE
;;                         (CGFLOAT WIDTH)))
;; T