(defpackage :cffi-test-case
  (:use :cl :cffi)
  (:export :test))

(in-package :cffi-test-case)

(defcstruct gdk-rectangle-cstruct
  (x :int)
  (y :int)
  (width :int)
  (height :int))

(defstruct gdk-rectangle
  (x 0)
  (y 0)
  (width 0)
  (height 0))

(define-foreign-type gdk-rectangle-type ()
  ()
  (:actual-type :pointer)
  (:simple-parser gdk-rectangle))

(defmethod translate-to-foreign (rectangle (type gdk-rectangle-type))
  (let ((native-structure (foreign-alloc 'gdk-rectangle-cstruct)))
    (loop
       for slot in '(x y width height)
       do (setf (foreign-slot-value native-structure 'gdk-rectangle-cstruct slot)
                (slot-value rectangle slot)))
    (values native-structure rectangle)))

(defmethod free-translated-object (native-structure (type gdk-rectangle-type) rectangle)
  (loop
     for slot in '(x y width height)
     do (setf (slot-value rectangle slot)
              (foreign-slot-value native-structure 'gdk-rectangle-cstruct slot)))
  (foreign-free native-structure))

(defmethod has-callback-cleanup ((type gdk-rectangle-type))
  t)

(defmethod translate-from-foreign (native-structure (type gdk-rectangle-type))
  (let ((rectangle (make-gdk-rectangle)))
    (loop
       for slot in '(x y width height)
       do (setf (slot-value rectangle slot)
                (foreign-slot-value native-structure 'gdk-rectangle-cstruct slot)))
    rectangle))

(defmethod cleanup-translated-object-for-callback ((type gdk-rectangle-type) rectangle native-structure)
  (loop
     for slot in '(x y width height)
     do (setf (foreign-slot-value native-structure 'gdk-rectangle-cstruct slot)
              (slot-value rectangle slot))))

(defcallback incf-rectangle-callback :void
    ((rectangle gdk-rectangle) (delta :int))
  (loop
     for slot in '(x y width height)
     do (incf (slot-value rectangle slot) delta)))

(defun incf-rectangle (r &optional (delta 1))
  (foreign-funcall-pointer (callback incf-rectangle-callback) ()
                           gdk-rectangle r
                           :int delta
                           :void))

(defun test ()
  (let ((r (make-gdk-rectangle :x 1 :y 2 :width 3 :height 4)))
    (print r)
    (incf-rectangle r 3)
    (print r)
    (and (= 4 (gdk-rectangle-x r))
         (= 5 (gdk-rectangle-y r))
         (= 6 (gdk-rectangle-width r))
         (= 7 (gdk-rectangle-height r)))))