1###########################################################
2# DrawingWand test
3# - The purpose is to test the correctness of TclMagick,
4#   not to produce meaningful output
5#
6###########################################################
7
8
9############################################
10# Load debugging version
11# or require TclMagick package from library
12#
13
14if { $tcl_platform(platform) == "unix" } {
15    set auto_path [linsert $auto_path 0 [file join .. unix]]
16    package require TclMagick
17} else {
18    set dll [file join .. win debug tclMagick.dll]
19    if {[file exists $dll]} {
20	load $dll
21    }
22    package require TclMagick
23}
24puts [info script]
25
26
27##########################################
28# Global options
29#
30set IMG "xc:white"
31set TMP [file join .. tmp]
32set FONT "Ariel"        ;# undefine FONT if none available
33
34##########################################
35# Check which tests should be performed
36#
37set TestFunctions {
38    DrawTest            img     1
39    PathTest            img     1
40}
41
42############################################
43# Command debugging
44#
45catch {
46    wm withdraw .
47    console show
48    console eval {wm protocol . WM_DELETE_WINDOW exit}
49}
50proc debug {args} {
51    foreach cmdMask $args {
52        foreach cmd [info commands $cmdMask] {
53            trace add execution $cmd leave debugLeave
54        }
55    }
56}
57proc debugLeave {cmdstr code result op} {
58    puts [format "    %s ==>{%s}" [string range $cmdstr 0 50] [string range $result 0 50]]
59    update
60}
61
62##########################################
63# Single image tests
64#
65proc DrawTest {img} {
66    set wand [$img clone imgX]
67    set draw [magick create draw draw0]
68    debug $draw $wand
69
70    [magick create pixel pix0] SetColor "lightblue"
71    [magick create pixel pix1] SetColor "blue"
72    [magick create pixel pix2] SetColor "red"
73    [magick create pixel pix3] SetColor "yellow"
74    [magick create pixel pix4] SetColor "brown"
75    [magick create pixel pix5] SetColor "lightgreen"
76    [magick create pixel pix6] SetColor "green"
77    [magick create pixel pix7] SetColor "lightgray"
78    [magick create pixel pix8] SetColor "black"
79
80    $draw PushGraphicContext
81        $draw SetStrokeWidth 1.0
82        $draw SetStrokeColor pix1
83        $draw SetFillColor pix1
84        $draw SetFontSize 24
85        $draw Annotation 5 30 "Created by TclMagick:"
86    $draw PopGraphicContext
87    $draw PushGraphicContext
88        $draw SetStrokeWidth 1.0
89        $draw SetStrokeColor pix8
90        $draw SetFillColor pix2
91        $draw Arc 50 50 100 100 45 -45
92    $draw PopGraphicContext
93    $draw PushGraphicContext
94        $draw SetStrokeWidth 1.0
95        $draw SetStrokeColor pix1
96        $draw SetFillColor pix3
97        $draw Bezier 110 110 140 10 170 120 150 150 110 110
98    $draw PopGraphicContext
99    $draw PushGraphicContext
100        $draw SetStrokeWidth 1.0
101        $draw SetStrokeColor pix4
102        $draw SetFillColor pix7
103        $draw Circle 100 200 50 200
104    $draw PopGraphicContext
105    $draw PushGraphicContext
106        $draw SetStrokeColor pix8
107        $draw SetFillColor pix6
108        $draw SetFillOpacity 0.7
109        $draw Ellipse 250 100 50 25 0 360
110    $draw PopGraphicContext
111    $draw PushGraphicContext
112        $draw SetStrokeWidth 1.0
113        $draw SetStrokeColor pix2
114        $draw SetFillColor pix2
115        $draw Point 200 200
116    $draw PopGraphicContext
117    $draw PushGraphicContext
118        $draw SetFillColor pix0
119        $draw Color 0 0 replace
120    $draw PopGraphicContext
121
122    $wand DrawImage $draw
123    $wand WriteImage "$::TMP/y-Draw-%0d.bmp"
124
125    magick delete pix0 pix1 pix2 pix3 pix4 pix5 pix6 pix7 pix8
126    magick delete $draw $wand
127}
128
129##########################################
130#
131#
132proc DLR_logo {draw color x y scale} {
133
134    $draw PushGraphicContext
135
136    $draw SetStrokeColor $color
137    $draw SetFillColor $color
138    $draw SetStrokeWidth 0.0
139
140    $draw Scale $scale
141    $draw path start move [expr {$x+72.5}] [expr {$y+0.0}]
142    $draw path {
143        # "Diagonal part of the DLR bird"
144        -relative on
145        line -45 +45 vertical +31 line +45 -45 vertical -31
146        line -5 +12
147        line -35 +35 vertical +17 line +35 -35 vertical -17
148        close
149        finish
150    }
151    $draw path start move [expr {$x+1.0}] [expr {$y+49.0}]
152    $draw path {
153        # "Horizontal part of the DLR bird"
154        -relative on
155        horizontal +76 line +22 -22 horizontal -76 line -22 +22
156        line +12 -5
157        horizontal +62 line +12 -12 horizontal -62 line -12 +12
158        close
159        finish
160    }
161    if {[info exists ::FONT]} {
162        # Use specified FONT
163        #
164        $draw SetFontFamily $::FONT
165        $draw SetFontSize 20
166        $draw Annotation [expr {$x+55.0}] [expr {$y+82.0}] "DLR"
167    } else {
168        # Draw the letters manually
169        #
170        $draw path start move [expr {$x+55.0}] [expr {$y+82.0}]
171        $draw path {
172            # "Letter D"
173            -relative on
174            vertical -18 horizontal +6
175            quadratic +7 +0 +7 +9
176            quadratic +0 +9 -7 +9
177            horizontal -6
178            line +2.5 -2.5
179            vertical -13 horizontal +3
180            quadratic +5 +0 +5 +6.5
181            quadratic +0 +6.5 -5 +6.5
182            horizontal -3
183            line -2.5 +2.5
184            close
185
186            # "Letter L"
187            move +17 +0
188            vertical -18 horizontal +2.5
189            vertical +15 horizontal +7
190            vertical +3 horizontal -10
191            close
192
193            # "Letter R"
194            move +12.5 +0
195            vertical -18 horizontal +5
196            quadratic +5 +0 +5 +5
197            quadratic +0 +5 -4 +5
198            line +5 +8 horizontal -2.5 line -5 -8
199            horizontal -1 vertical +8 horizontal -2.5
200            line +2.5 -10.5
201            vertical -5 horizontal +2
202            quadratic +3 +0 +3 +2.5
203            quadratic +0 +2.5 -3 +2.5
204            horizontal -2
205            line -2.5 +10.5
206            close
207	    finish
208        }
209    }
210    $draw PopGraphicContext
211}
212proc PathTest {img} {
213    set wand [$img clone imgX]
214    set draw [magick create draw draw0]
215    debug $draw $wand
216
217    [magick create pixel pix0] SetColor "gray"
218    [magick create pixel pix1] SetColor "black"
219
220    DLR_logo $draw pix0 0 2 4
221    DLR_logo $draw pix1 1 1.5 4
222
223    $wand DrawImage $draw
224    $wand WriteImage "$::TMP/y-Path-%0d.bmp"
225
226    magick delete $draw $wand
227}
228
229##########################################
230# Main test loop
231#
232
233debug magick
234
235if { ! [file isdirectory $TMP]} {
236    file mkdir $TMP
237}
238
239set img [magick create wand img0]
240debug $img
241
242$img ReadImage $IMG
243$img ResizeImage 400 340
244
245magick names
246
247set ERRORS 0
248foreach {func var flag} $TestFunctions {
249    if {$flag} {
250        puts [format "%s:" $func $var]
251        set err [catch {$func [set $var]} result]
252        if {$err} {
253            incr ERRORS
254            puts stderr [format "error: %s" $result]
255        }
256    } else {
257        puts [format "--- skip: %s ---" $func]
258    }
259}
260
261puts "##### DRAW TEST READY #####"
262if {!$ERRORS} {
263    after 3000 exit
264}
265
266