mapc I V
foreach {v} [map2 I V] {
- foreach {m} [map21r I V $v] {
+ foreach {m} [map2m I V $v] {
foreach {index scheme_subscheme_range} $m {
foreach {scheme subscheme range} $scheme_subscheme_range {break}
map RI V [list $range $index] $v [list $scheme $subscheme]
mapc RI V
foreach {v} [map2 RI V] {
- foreach {m} [map21r RI V $v] {
+ foreach {m} [map2m RI V $v] {
foreach {index scheme_subscheme} $m {
foreach {scheme subscheme} $scheme_subscheme {break}
map SRI V [list $subscheme $range $index] $v $scheme
# generate TAB_VALUES_24
set SZT_VALUES 0
tab_begin $f "unsigned char TAB_VALUES_24\[SZT_VALUES_24\] = {"
-foreach {value} [lsort -dictionary [map2 C V]] {
+foreach {value} [map2 C V] {
tab_begin_block $f $SZT_VALUES
foreach {r g b} $value {break}
set ALL_VALUES_coded($value) $SZT_VALUES
incr SZT_VALUES
- tab_end_block $f [map21r C V $value]
+ tab_end_block $f [map2m C V $value]
}
tab_end $f "};\n"
# generate NONAME_VALUES_24
set SZT_NONAME_VALUES 0
tab_begin $f "unsigned char TAB_NONAME_VALUES_24\[SZT_NONAME_VALUES_24\] = {"
-foreach {value} [lsort -dictionary [map2 I V]] {
+foreach {value} [map2 I V] {
if {! [info exists ALL_VALUES($value)]} {
tab_begin_block $f $SZT_NONAME_VALUES
}
-# tab_end_block $f [map21r RI V $value]
+# tab_end_block $f [map2m RI V $value]
}
}
tab_end $f "};\n"
tab_end $f "};\n"
-# collect common altsets
-foreach {color} [lsort -ascii [map1 C V]] {
- lappend ALL_ALTSETS([map1r C V $color]) $color
-}
-
# generate TAB_ALTS
set SZT_ALTS 0
tab_begin $f "inkpot_name_t TAB_ALTS\[SZT_ALTS\] = {"
-foreach {m} [lsort -ascii [array names ALL_ALTSETS]] {
+foreach {ms} [map1mas C V] {
set isneeded 0
- set aliases [lsort -ascii $ALL_ALTSETS($m)]
- set cnt [llength $m]
+ set cnt [llength $ms]
switch $cnt {
0 {
puts stderr "shouldn't happen - zero alts: $color"
}
1 {
- foreach {alt} $m {break}
- foreach {value schemeset} $alt {break}
+ foreach {m} $ms {break}
+ foreach {value schemeset} $m {break}
set scheme_bits 0
foreach {scheme} $schemeset {
foreach {scheme_idx scheme_bit} $ALL_SCHEMES($scheme) {break}
}
default {
set first_idx $SZT_ALTS
- foreach {alt} $m {
- foreach {value schemeset} $alt {break}
+ foreach {m} $ms {
+ foreach {value schemeset} $m {break}
set scheme_bits 0
foreach {scheme} $schemeset {
foreach {scheme_idx scheme_bit} $ALL_SCHEMES($scheme) {break}
tab_end $f "};\n"
-# collect common mapsets
-foreach {value} [lsort -ascii [map2 C V]] {
- lappend ALL_MAPSETS([map2r C V $value]) $value
-}
-
# generate TAB_TO_NAMES
set SZT_TO_NAMES 0
tab_begin $f "IDX_NAMES TAB_TO_NAMES\[SZT_TO_NAMES\] = {"
-foreach {m} [lsort -dictionary [array names ALL_MAPSETS]] {
+foreach {value} [map2 C V] {
tab_begin_block $f $SZT_TO_NAMES
+ set m [map2ma C V $value]
switch [llength $m] {
0 {
puts stderr "shouldn't happen - zero maps: $value"
}
}
}
- if {$isneeded} {tab_end_block $f $aliases}
+ if {$isneeded} {tab_end_block $f \$aliases}
}
tab_end $f "};\n"
}
####################################################################
-# MAP --mapping m:n relationships between elemenets of 2 sets
+# MAP --mapping m:n relationships between elements of 2 sets
-#populate the map
+#populate the map X<=>Y with a single x-y pairing labeled r
proc map {X Y x y r} {
upvar MAP_[set X][set Y] MAP_XY
lappend MAP_XY([list $x $y]) $r
upvar [set M]_2[set Y] MAP_2Y
upvar [set M]_[set X]2 MAP_X2
upvar [set M]_[set Y]2 MAP_Y2
- #obtain sorted r_sets and use them as keys to the map
+ upvar [set M]_[set X]a MAP_Xa
+ upvar [set M]_[set Y]a MAP_Ya
+
+ array unset MAP_2X
+ array unset MAP_2Y
+ array unset MAP_X2
+ array unset MAP_Y2
+ array unset MAP_Xa
+ array unset MAP_Ya
+
+ #obtain sorted r_set's and use them as keys to the map
foreach {xy} [array names MAP_XY] {
foreach {x y} $xy {break}
set r_set [lsort -ascii $MAP_XY($xy)]
lappend MAP_Y2($y) $m
}
}
+ #set up for finding aliases - all x that share the same map to the same set of y's
+ foreach {y} [lsort -ascii [array names MAP_Y2]] {
+ lappend MAP_Xa($MAP_Y2($y)) $y
+ }
+ #set up for finding aliases - all y that share the same map to the same set of x's
+ foreach {x} [lsort -ascii [array names MAP_X2]] {
+ lappend MAP_Ya($MAP_X2($x)) $x
+ }
+
if {0} {
foreach {up map} [list [set M] MAP_XY \
[set M]_2[set X] MAP_2X \
[set M]_2[set Y] MAP_2Y \
[set M]_[set X]2 MAP_X2 \
- [set M]_[set Y]2 MAP_Y2 ] {
-
- puts "size $up = [llength [array names $map]]"
+ [set M]_[set Y]2 MAP_Y2 \
+ [set M]_[set X]a MAP_Xa \
+ [set M]_[set Y]a MAP_Ya ] {
+ print_first $map
}
}
}
#list all x
proc map1 {X Y} {
upvar MAP_[set X][set Y]_[set X]2 MAP_X2
- array names MAP_X2
+ lsort [array names MAP_X2]
}
#list all y
proc map2 {X Y} {
upvar MAP_[set X][set Y]_[set Y]2 MAP_Y2
- array names MAP_Y2
-}
-#list all maps from x to y
-proc map1m {X Y} {
- upvar MAP_[set X][set Y]_2[set Y] MAP_2Y
- array names MAP_2Y
-}
-#list all maps from y to x
-proc map2m {X Y} {
- upvar MAP_[set X][set Y]_2[set X] MAP_2X
- array names MAP_2X
+ lsort [array names MAP_Y2]
}
-#list the r_sets for X
-proc map1r {X Y x} {
+#list the map for x, result of the form: {y {r...}}
+proc map1m {X Y x} {
upvar MAP_[set X][set Y]_[set X]2 MAP_X2
set MAP_X2($x)
}
-#list the r_sets for Y
-proc map2r {X Y y} {
+#list the map for y, result of the form: {x {r...}}
+proc map2m {X Y y} {
upvar MAP_[set X][set Y]_[set Y]2 MAP_Y2
set MAP_Y2($y)
}
+#list all x->y maps, result of the form: {{y {r...}}...}
+proc map1ms {X Y} {
+ upvar MAP_[set X][set Y]_2[set Y] MAP_2Y
+ lsort [array names MAP_2Y]
+}
+#list all y->x maps, result of the form: {{x {r...}}...}
+proc map2ms {X Y} {
+ upvar MAP_[set X][set Y]_2[set X] MAP_2X
+ lsort [array names MAP_2X]
+}
#use the map to go from x to {y}'s
proc map12 {X Y x} {
upvar MAP_[set X][set Y]_[set X]2 MAP_X2
foreach {y r_set} $m {break}
lappend res $y
}
- set res
+ lsort $res
}
#use the map to go from y to {x}'s
proc map21 {X Y y} {
foreach {x r_set} $m {break}
lappend res $x
}
- set res
+ lsort $res
}
-#use the map to go from x to {y{r_set}}'s
-proc map12r {X Y x} {
- upvar MAP_[set X][set Y]_[set X]2 MAP_X2
- set MAP_X2($x)
+# find aliases - go from map: {x {r...}, to the list of x that share the same mapping
+proc map1ma {X Y m} {
+ upvar MAP_[set X][set Y]_[set Y]a MAP_Ya
+ lsort $MAP_Ya($m)
}
-#use the map to go from y to {x{r_set}}'s
-proc map21r {X Y y} {
- upvar MAP_[set X][set Y]_[set Y]2 MAP_Y2
- set MAP_Y2($y)
+# find aliases - go from map: {y {r...}, to the list of y that share the same mapping
+proc map2ma {X Y m} {
+ upvar MAP_[set X][set Y]_[set X]a MAP_Xa
+ lsort $MAP_Xa($m)
+}
+# find aliases sets for x
+proc map1mas {X Y} {
+ upvar MAP_[set X][set Y]_[set Y]a MAP_Ya
+ lsort [array names MAP_Ya]
+}
+# find aliases sets for y
+proc map2mas {X Y} {
+ upvar MAP_[set X][set Y]_[set X]a MAP_Xa
+ lsort [array names MAP_Xa]
+}
+
+
+if {0} { ;# for debug
+ map C V black 0 svg
+ map C V black 0 x11
+ map C V black 0 tk
+ map C V grey0 0 svg
+ map C V grey0 0 x11
+ map C V grey0 0 tk
+ map C V noir 0 french
+ map C V green 2 svg
+ map C V lime 1 svg
+ map C V green 1 x11
+ map C V green 1 tk
+ map C V lime 1 tk
+ map C V lime 1 x11
+ map C V vert 1 french
+
+ mapc C V
+
+ puts "map1 C V : [map1 C V]"
+ puts " expected : black green grey0 lime noir vert"
+ puts "map2 C V : [map2 C V]"
+ puts " expected : 0 1 2"
+ puts "map1m C V green : [map1m C V green]"
+ puts " expected : {1 {tk x11}} {2 svg}"
+ puts "map2m C V 2 : [map2m C V 2]"
+ puts " expected : {green svg}"
+ puts "map1ms C V : [map1ms C V]"
+ puts " expected : {black {svg tk x11}} {green svg} {green {tk x11}} {grey0 {svg tk x11}} {lime {svg tk x11}} {noir french} {vert french}"
+ puts "map2ms C V : [map2ms C V]"
+ puts " expected : {0 french} {0 {svg tk x11}} {1 french} {1 {svg tk x11}} {1 {tk x11}} {2 svg}"
+ puts "map12 C V green : [map12 C V green]"
+ puts " expected : 1 2"
+ puts "map21 C V 1 : [map21 C V 1]"
+ puts " expected : green lime vert"
+ puts "map1ma C V [map1m C V black] : [map1ma C V [map1m C V black]]"
+ puts " expected : black grey0"
+ puts "map2ma C V [map2m C V 1] : [map2ma C V [map2m C V 1]]"
+ puts " expected : 1"
}
projects / graphviz / commitdiff