repos
/
qt.tests
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Test to QVector<QPoint> translation.
Annotate for file /src/qvector.lisp
2010-01-23 tobias
1
(in-package :qt.tests)
22:18:13 '
2
'
3
(5am:in-suite :qt.suite)
'
4
'
5
(5am:test qvector-qpoint
'
6
"Tests to QVector<QPoint> translation."
'
7
(let* ((points
'
8
(map 'vector #'(lambda (coords)
'
9
(make-instance 'qt:point :arg0 (first coords)
'
10
:arg1 (rest coords)))
'
11
'((9 . 8) (7 . 6) (5 . 4))))
'
12
(polygon (make-instance 'qt:polygon :arg0 points)))
'
13
(dotimes (i (length points))
'
14
(5am:is (= (cxx:x (aref points i))
'
15
(cxx:x (cxx:point polygon i))))
'
16
(5am:is (= (cxx:y (aref points i))
'
17
(cxx:y (cxx:point polygon i))))))
'
18
;; Free the allocated QVector<QPoint>
'
19
(tg:gc :full t))
'
20
(5am:test qvector-double
'
21
"Test QVector<double> <-> Lisp translation."
'
22
(5am:for-all ((pattern (5am:gen-one-element #()
'
23
#(1d0 2d0)
'
24
#(3.1415926d0 -10d0 1d10 0d0))))
'
25
(let ((pen (make-instance 'qt:pen))) ;; set-dash-pattern only works once!?
'
26
(cxx:set-dash-pattern pen pattern)
'
27
(5am:is (equalp pattern (cxx:dash-pattern pen))))))
'
28
'
29
(5am:test qvector-uint
'
30
"Test QVector<unsigned int> <-> Lisp translation."
'
31
(let ((image (make-instance 'qt:image
'
32
:args (list 10 10 qt:image.+format-indexed8+)))
'
33
(colors (map 'vector
'
34
#'qt:q-rgb
'
35
'(1 2 44 55 255)
'
36
'(4 6 23 43 12)
'
37
'(5 0 23 12 123))))
'
38
(5am:is (equalp #() (cxx:color-table image)))
'
39
(cxx:set-color-table image colors)
'
40
(5am:is (equalp colors (cxx:color-table image)))))
'
41