If the canvas does not exist, it will be created in the specified or default size (default size 39*26 pixels is to make the US flag look reasonable; for Greece, a height of 27 would look nicer).The description language is implemented directly as Tcl procs, which retrieve their upvar context from the caller, but this fact is nicely hidden in a namespace. The central command is flag::show canvas args ;# for example
flag::show .gb -flag {hori blue; x white red; cross white red}where args is a -switch value pairlist. The most important switch is -flag that gives the description string.The description language, which will have to grow, contains so far the following "words":- circle: a centered circle filled in the specified color
- cross: a centered cross extending to the edges in the specified color; if >1 colors are specified, they are superimposed with decreasing widths(e.g. Union Jack)
- hori: horizontal stripes in the specified colors; a suffix "+" indicates when a stripe is to appear double as wide as the others.
- ncross: "Nordic cross", like cross, but shifted so it cuts out squares at left
- scross: "Swiss cross", like cross but not extending to edges
- stripes: like hori, but characterized by the number of stripes and two colors that are regularly repeated
- tlq: "top left quadrant"
- tlsq: "top left square", half as high as the flag, and of same width
- triangle: equilateral triangle from left edge
- vert: vertical stripes in the specified colors
- x: "St. Andrews cross", like cross but made of diagonals
package require Tk
namespace eval flag {
proc show {c args} {
array set opt [concat {-x 0 -y 0 -w 0 -h 0 -flag {}} $args]
foreach i {w h x y} {set $i [set opt(-$i)]}
if {$w && !$h} {
set h [expr $w/1.5]
} elseif {$h && !$w} {
set w [expr $h*1.5]
} elseif {!$w && !$h} {
set w 39; set h 26
}
foreach i [split $opt(-flag) ";"] {
if [regexp " *set " $i] {eval $i}
} ;# do changes in geometry before creation
if ![winfo exists $c] {
canvas $c -width $w -height $h -bg white -relief raised\
-borderwidth 1
}
set b [$c cget -borderwidth]
eval $opt(-flag)
set c
}
proc circle color {
upvar c c x x y y w w h h
set r [expr $h*0.3]
set xm [expr ($x+$w)/2]
set ym [expr ($y+$h)/2+2]
$c create oval [expr $xm-$r] [expr $ym-$r]\
[expr $xm+$r] [expr $ym+$r] -fill $color -outline $color
}
proc hori args {
upvar b b c c x x y y w w h h
regsub -all {([A-Za-z0-9]+)[+]} $args {\1 \1} args
set n [llength $args]
set dy [expr $h/$n.]
set y0 [expr $y+2+$b]
foreach i $args {
$c create rect $x $y0 [expr $x+$w+2*$b]\
[expr round($y0+$dy)] -fill $i -outline $i
set y0 [expr $y0+$dy]
}
}
proc vert args {
upvar c c x x y y w w h h
regsub -all {([A-Za-z0-9]+)[+]} $args {\1 \1} args
set n [llength $args]
set dx [expr $w/$n.]
set x0 [expr $x+2]
foreach i $args {
$c create rect $x0 $y [expr round($x0+$dx)] [expr $y+$w]\
-fill $i -outline $i
set x0 [expr $x0+$dx]
}
}
proc cross args {
upvar b b c c x x y y w w h h
set x1 [expr $x+$b+$w*0.4]
set x2 [expr $x+$b+$w*0.6]
set y1 [expr $y+$h*0.4+2]
set y2 [expr $h*0.6+1]
foreach i $args {
$c create rect $x $y1 [expr $x+$w+2*$b] $y2\
-fill $i -outline $i
$c create rect $x1 $y $x2 [expr $y+$h+2]\
-fill $i -outline $i
set x1 [expr $x1*1.1]
set x2 [expr $x2/1.1]
set y1 [expr $y1*1.1]
set y2 [expr $y2/1.1]
}
}
proc ncross args {
upvar b b c c x x y y w w h h
set y1 [expr $h*0.4+2]
set y2 [expr $h*0.6]
foreach i $args {
$c create rect $x $y1 [expr $x+$w+2*$b] $y2\
-fill $i -outline $i
$c create rect $y1 $y $y2 [expr $y+$h+1]\
-fill $i -outline $i
set y1 [expr $y1*1.1]
set y2 [expr $y2/1.1]
}
}
proc scross color {
upvar b b c c x x y y w w h h
set x0 [expr $x+$h*0.2+2+$b]
set x1 [expr $x+$h*0.4+2+$b]
set x2 [expr $x+$h*0.6]
set x3 [expr $x+$h*0.8]
set y0 [expr $y+$h*0.2+2+$b]
set y1 [expr $y+$h*0.4+2+$b]
set y2 [expr $y+$h*0.6]
set y3 [expr $y+$h*0.8]
$c create rect $x0 $y1 $x3 $y2\
-fill $color -outline $color
$c create rect $x1 $y0 $x2 $y3\
-fill $color -outline $color
}
proc x args {
upvar c c x x y y w w h h
set width [expr round($w/10.)]
foreach i $args {
$c create line $x [expr $y+2] [expr $x+$w] [expr $y+$h]\
-fill $i -width $width
$c create line $x [expr $y+$h] [expr $x+$w] [expr $y+2] \
-fill $i -width $width
set width [expr int($width/2.)]
}
}
proc stars {n color} {#to be implemented}
proc stripes {n c0 c1} {
upvar b b c c x x y y w w h h
set dy [expr $h/$n.]
set y0 [expr $y+2+$b]
for {set i 0} {$i<$n} {incr i} {
set color [set c[expr $i%2]]
$c create rect $x $y0 [expr $x+$w+2*$b] \
[expr round($y0+$dy)]\
-fill $color -outline $color
set y0 [expr $y0+$dy]
}
}
proc sun color {
upvar b b c c x x y y w w h h
set x0 [expr $x+$w/2.+2]
set y0 [expr $y+$h/2.+2]
set r [expr round($h/2.25)]
$c create oval [expr $x0-$r/2.] [expr $y0-$r/2.]\
[expr $x0+$r/2.] [expr $y0+$r/2.]\
-fill $color
foreach i [geom::sunrays $x0 $y0 $r] {
eval $c create poly $i -fill $color
}
}
proc tlq color {
upvar b b c c x x y y w w h h
set x1 [expr $x+$w/2]
set y1 [expr $y+$b+$h/2]
$c create rect $x $y $x1 $y1 -fill $color -outline $color
set h [expr $y1-$y]
set w [expr $x1-$x]
}
proc tlsq color {
upvar b b c c x x y y w w h h
set x1 [expr $x+$h/2]
set y1 [expr $y+$b+$h/2]
$c create rect $x $y $x1 $y1 -fill $color -outline $color
set h [expr $y1-$y]
set w [expr $x1-$x]
}
proc triangle color {
upvar c c x x y y w w h h
set x1 [expr sqrt(3*($h/2.)*($h/2.))]
$c create poly $x $y $x1 [expr ($y+$h)/2.+2] $x [expr $y+$h+2]\
-fill $color
}
proc left amount {upvar w w; set w [expr $w*$amount]}
proc moon color {
upvar b b c c x x y y w w h h
set x0 [expr $x+$w/2.+2]
set y0 [expr $y+$h/2.+2]
set item [$c find closest $x0 $y0]
set bg [$c itemcget $item -fill]
set r [expr round($h/4.)]
$c create oval [expr $x0-$r] [expr $y0-$r] \
[expr $x0+$r] [expr $y0+$r] -fill $color -outline $color
set x1 [expr $x0+$w/12.+1]
set r [expr $r/1.25]
$c create oval [expr $x1-$r] [expr $y0-$r] \
[expr $x1+$r] [expr $y0+$r] -fill $bg -outline $bg
}
}# Test and usage examples: foreach {country1 flag1 country2 flag2} {
bh {hori blue yellow blue; triangle black}
ch {set w $h; hori red; scross white}
cl {hori white red; tlsq blue;star white}
co {hori yellow+ blue red}
cr {hori blue white red+ white blue}
cu {stripes 5 blue white;triangle red;star white}
cz {hori white red; triangle blue}
de {hori black red yellow}
es {hori red yellow+ red}
gb {hori blue; x white red; cross white red}
gr {stripes 9 blue white; tlsq blue; cross white}
it {vert green3 white red}
jp {hori white; circle red}
no {hori red; ncross white blue}
ru {hori white blue red}
se {hori DodgerBlue; ncross yellow}
so {hori DodgerBlue; star white}
tr {hori red;left 0.6; moon white; left 1.8; star white 15 0.5}
tw {hori red; tlq blue; sun white}
us {stripes 13 red white; tlq blue; stars 50 white}
} {
flag::show .$country1 -flag $flag1
label .l$country1 -text "$country1: $flag1"
if {$flag2!=""} {
flag::show .$country2 -flag $flag2
label .l$country2 -text "$country2: $flag2"
grid .$country1 .l$country1 .$country2 .l$country2 -sticky w
} else {
grid .$country1 .l$country1 -sticky w
}
}Kevin Kenny adds:In the English speaking countries, there is actually fairly standard terminology (a strange hybrid of English and Norman) for describing banners. A rough correspondence of your terms:
circle - "roundel"
cross - "Cross", believe it or not!
hori - Party per fesse
ncross - Latin cross
scross - Greek cross
stripes - Barry of <n>
tlq - Canton
tlsq - (Special case of 'party per fesse')
triangle - (Gotta look this one up...)
vert - Party per pale, or paly of <n> for the case of <n>
stripes in alternating colours.
x - Saltire
star - Molet (a type of spur). An 'estoile' (Norman for 'star'
has six wavy points; the 'stars' on the US flag are
molets.
moon - Lune
sun - Sun, sun in splendour, sun in glory, etc., depending
on how rendered.
diamond - Lozenge or fusil (the fusil is taller and narrower)By the way, there's a formal grammar for describing these things. Two well-trained heralds, observing the same banner, will produce descriptions ("blazons") that are word-for-word identical!Example: the US flag is "barry of thirteen, gules and argent, in canton azure, fifty molets argent, by six and five in fesse". The Bundesflagge is "tierce per fesse, sable, gules, or;" the French tricolour is "tierce per pale, azure, argent, gules".See also: tricolore shows how to create simple flags in a photo image.
EKB A "star" is used in the examples, but there is no matching proc, so the examples don't run. I could implement my own star (well, a "molet", really :-), but, RS, if you already have an implementation, would you mind posting it? Thanks...It might sound strange, but I've actually been wanting something just like this - scalable flags that can be defined compactly. - RS: As hinted above, stars are on Sun, moon, and stars :) EKB Great, thanks!
KPV See also Maritime Signal Flags which draws over forty different flags used as international signals by ships at sea.
gold We can hack the stripes routine to develop an alternate broken line procedure for flags of iching trigram symbols.
proc brokenline {n c0 c1 cc2} {
# example ic {brokenline 6 black white white}
# c0 mainline color, c1 outline color
# cc2 middle space color or broken area
# works on windows xp with etcl, 7May2007
upvar b b c c x x y y w w h h
set dy [expr $h/$n.]
set y0 [expr $y+2+$b]
for {set i 0} {$i<$n} {incr i} {
set color [set c[expr $i%2]]
$c create rect $x $y0 [expr $x+$w+2*$b] \
[expr round($y0+$dy)]\
-fill $color -outline $color
$c create rect [expr $x +.4*$w] $y0 [expr $x+$w+2*$b] \
[expr round($y0+$dy)]\
-fill $c1 -outline $cc2
$c create rect [expr $x +.7*$w] $y0 [expr $x+$w+2*$b] \
[expr round($y0+$dy)]\
-fill $color -outline $color
set y0 [expr $y0+$dy]
}
}
#usage, entry ic {brokenline 6 black white white} for
# mother earth trigram, 3 broken lines.