(in-package :qt.tests)

(5am:in-suite :qt.suite)

(5am:test simple-signal-slot
  "Test custom signal to custom slot connection."
  (let ((counter 0))
    (let ((my-signal (qt:make-signal))
          (my-slot (qt::make-slot #'(lambda () (incf counter))
                                  nil)))
      
      (qt:connect my-signal my-slot)
      (funcall my-signal)
      (5am:is (= 1 counter)))))

(5am:test (emit-int-signal :depends-on with-app)
  "Emits a signal with a C++ integer argument to a C++ slot."
  (qt:with-app ()
    (let ((my-signal (qt:make-signal))
          (label (make-instance 'qt:label)))
      (qt:connect my-signal (qt:get-slot label "setNum(int)"))
      (5am:for-all ((number (5am:gen-integer)))
        (funcall my-signal number)
        (5am:is (eql number (read-from-string (cxx:text label))))))))

(5am:test (emit-float-signal :depends-on with-app)
  "Emits a signal with a C++ integer argument to a C++ slot."
  (qt:with-app ()
    (let ((my-signal (qt:make-signal))
          (label (make-instance 'qt:label)))
      (qt:connect my-signal (qt:get-slot label "setNum(double)"))
      (5am:for-all ((number (5am:gen-float :bound 100 
                                           :type 'double-float)))
        (funcall my-signal number)
        (5am:is (< (abs (- number (read-from-string (cxx:text label))))
                   0.001))))))

(5am:test emit-bool-signal
  "Emits a signal with an boolean C++ argument to a C++ slot."
  (qt:with-app ()
    (let ((my-signal (qt:make-signal))
          (widget (make-instance 'qt:check-box)))
      (qt:connect my-signal (qt:get-slot widget "setChecked(bool)"))
      (5am:for-all ((enable (5am:gen-one-element t nil)))
        (funcall my-signal enable)
        (5am:is (eql enable (cxx:is-checked widget)))))))


(5am:test (emit-qstring-signal :depends-on (and qstring with-app))
  "Emits a signal with a C++ QString argument to a C++ slot."
  (qt:with-app ()
    (let ((my-signal (qt:make-signal))
          (widget (make-instance 'qt:widget)))
      (qt:connect my-signal (qt:get-slot widget "setWindowTitle(QString)"))

      ;;    (5am:for-all ((title (5am:gen-string)))
      ;; FIXME fails for gen-string (some UTF-8 problem?)
      (5am:for-all ((title (5am:gen-one-element "foo" "FooBar" "öäü")))
        (funcall my-signal title)
        (5am:is (string= title (cxx:window-title widget)))))))

;; FIXME in reality the lisp wrapper object get passed.
(5am:test (arg-signal-slot :depends-on simple-signal-slot)
  "Passing an C++ class as argument to an slot."
  (let ((size nil))
    (let ((my-signal (qt:make-signal))
          (my-slot (qt:make-slot #'(lambda (s)
                                     (5am:is (typep s (find-class 'qt:size)))
                                     (setf size (cons (cxx:width s)
                                                      (cxx:height s))))
                                 (list (find-class 'qt:size)))))
      (qt:connect my-signal my-slot)
      (funcall my-signal (make-instance 'qt:size :args '(3 7)))
      (5am:is (= 3 (first size)))
      (5am:is (= 7 (rest size))))))


(5am:test (lisp-arg-signal-slot :depends-on simple-signal-slot)
  "Pass a lisp object over a signal-slot connection."
  (let ((num 1d0)
        (ret nil))
    (let ((my-signal (qt:make-signal (find-class 'double-float)))
          (my-slot (qt:make-slot #'(lambda (d)
                                     (5am:is (eq d num))
                                     (setf ret d))
                                 (list (find-class 'double-float)))))
      (qt:connect my-signal my-slot)
      (funcall my-signal num))
    (5am:is (eq ret num))))

(5am:test (lisp-two-arg-signal-slot :depends-on lisp-arg-signal-slot)
  "Pass a lisp object over a signal-slot connection."
  (let ((num 1d0)
        (count 0))
    (let ((my-signal (qt:make-signal))
          (my-slot (qt::make-slot #'(lambda (a b)
                                      (5am:is (eq a num))
                                      (5am:is (eql t b))
                                      (incf count))
                                  (mapcar #'find-class '(double-float t)))))
      (qt:connect my-signal my-slot)
      (funcall my-signal num t))
    (5am:is (= 1 count))))

(defparameter *destroyed* nil)

(defun test-destroyed-signal ()
  (let ((object (make-instance 'qt:object)))
    (qt:connect (qt:get-signal object "destroyed()")
                #'(lambda () (setf *destroyed* t)))
    (tg:gc :full t)
    (5am:is (eq nil *destroyed*)))
  (tg:gc :full t))

;; SBCL runs the finalizer when the object has been garbage collected,
;; thus its children could be to and thus the destroyed() signal is not
;; received
#-(or sbcl cmucl ccl)
(5am:test (destroyed-signal :depends-on gc-qobject)
  "Receive a destroy signal for a QObject."
  (setf *destroyed* nil)
  (eval '(test-destroyed-signal)) ;; FIXME eval somehow makes gc in 5am work!?
  (eval '(tg:gc :full t))
  (tg:gc :full t)
  (5am:is (eq t *destroyed*)))

(5am:test int-signal
  "Receive a int signal."
  (qt:with-app ()
    (let ((spin-box (make-instance 'qt:spin-box))
          (current-value)
          (current-string-value))
      (qt:connect (qt:get-signal spin-box "valueChanged(int)")
                  #'(lambda (value)
                      (setf current-value value)))
      (qt:connect (qt:get-signal spin-box "valueChanged(const QString&)")
                  #'(lambda (value)
                      (setf current-string-value value)))
      (5am:for-all ((value (5am:gen-integer
                            :min (cxx:minimum spin-box)
                            :max (cxx:maximum spin-box))))
        (cxx:set-value spin-box value)
        (5am:is (= value current-value))
        (5am:is (= value (read-from-string current-string-value)))))))

(5am:test object-signal
  "Receive a qt:object pointer signal."
  (qt:with-app ()
    (let ((button (make-instance 'qt:push-button))
          (click-count 0)
          (signal-mapper (make-instance 'qt:signal-mapper)))
      (qt:connect (qt:get-signal button "clicked()")
                  (qt:get-slot signal-mapper "map()"))
      (cxx:set-mapping signal-mapper button button)
      ;; button is a QWidget thus it's mapped(QWidget*) and not
      ;; mapped(QObject*)
      (qt:connect (qt:get-signal signal-mapper "mapped(QWidget*)")
                  #'(lambda (object)
                      (5am:is (eq button object))
                      (incf click-count)))
      (5am:is (= 0 click-count))
      (qt:test.mouse-click button qt:+left-button+
                           0 (make-instance 'qt:point) -1)
      (5am:is (= 1 click-count)))))

(5am:test receive-by-value
  "Receive a C++ class by value signal."
  (qt:with-app ()
    (let ((model (make-instance 'qt:string-list-model))
          (count 0))
      (qt:connect (qt:get-signal model
                                 "rowsInserted(QModelIndex, int, int)")
                  #'(lambda (parent start end)
                      (declare (ignore end))
                      (5am:is (cxx:= (cxx:parent (cxx:index model start)))
                              parent)
                      (incf count)))
      (5am:is (= 0 count))
      (cxx:insert-rows model 0 1)
      (5am:is (= 1 count))
      (cxx:insert-rows model 0 3)
      (5am:is (= 2 count)))))

(5am:test (emit-user-conversion :depends-on emit-qstring-signal)
  "Emit a signal with a user conversion of the argument."
  (qt:with-app ()
    (let ((combobox (make-instance 'qt:text-edit))
          (set-font (qt:make-signal)))
      (qt:connect set-font
                  (qt:get-slot combobox "setCurrentFont(QFont)"))
      (5am:is (cxx:operator== (cxx:current-font combobox)
                              (make-instance 'qt:font)))
      (funcall set-font "Times")
      (5am:is (cxx:operator== (cxx:current-font combobox)
                              "Times")))))