Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | improving svgml. Cubes work ok |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
9915177ff8c7ea29b18e9aab10cb3d4d |
| User & Date: | ramsan 2019-10-14 16:17:45 |
Context
|
2019-10-15
| ||
| 00:05 | some drawings in strenths_in_shells.md are svgml check-in: 64ecc93b1c user: ramsan tags: trunk | |
|
2019-10-14
| ||
| 16:17 | improving svgml. Cubes work ok check-in: 9915177ff8 user: ramsan tags: trunk | |
|
2019-10-11
| ||
| 23:15 | fixed some details in svgml. Working well check-in: 20ae191551 user: ramsan tags: trunk | |
Changes
Changes to scripts/svgml.tcl.
1 1 2 +package require compass_utils::math 2 3 package require math::linearalgebra 3 4 package require compass_utils 4 5 5 6 namespace eval m { 6 7 namespace import -force ::math::linearalgebra::* 7 8 } 8 9 ................................................................................ 73 74 proc svgml::give_propD { d id name default } { 74 75 75 76 if { ![dict exists $d ids $id props $name] } { 76 77 return $default 77 78 } 78 79 return [dict get $d ids $id props $name] 79 80 } 81 + 82 +proc svgml::bbox_to_points { bbox } { 83 + lassign $bbox x y w h 84 + return [list "$x $y" [list [expr {$x+$w}] [expr {$y+$h}]]] 85 +} 86 + 87 +proc svgml::add_to_bbox { id bbox } { 88 + variable d 89 + 90 + if { [dict exists d ids $id bbox] } { 91 + set pnts "" 92 + lappend pnts {*}[bbox_to_points [dict get d ids $id bbox]] 93 + lappend pnts {*}[bbox_to_points $bbox] 94 + foreach pnt $pnts { 95 + if { ![info exists x0] || [lindex $pnt 0]<$x0 } { set x0 [lindex $pnt 0] } 96 + if { ![info exists y0] || [lindex $pnt 1]<$y0 } { set y0 [lindex $pnt 1] } 97 + } 98 + foreach pnt $pnts { 99 + if { ![info exists w] || [lindex $pnt 0]-$x0 > $w } { 100 + set w [expr {[lindex $pnt 0]-$x0}] 101 + } 102 + if { ![info exists h] || [lindex $pnt 1]-$y0 > $h } { 103 + set h [expr {[lindex $pnt 1]-$y0}] 104 + } 105 + } 106 + set bbox [list $x0 $y0 $w $h] 107 + } 108 + dict set d ids $id bbox $bbox 109 +} 110 + 111 +proc svgml::rotate_angles { anglexy anglez } { 112 + 113 + set anglexy_R [expr {$m::degtorad*($anglexy+90.0)}] 114 + set anglez_R [expr {-1.0*$m::degtorad*($anglez-90.0)}] 115 + set a [m::quaternion::rotation [list 0.0 0.0 1.0] $anglexy_R] 116 + set newaxis [m::quaternion::rotation [list 1.0 0.0 0.0] $anglez_R] 117 + set rotation_vector [m::quaternion::multiply $a $newaxis] 118 + return [m::quaternion::normalizeP $rotation_vector 6] 119 +} 120 + 121 +proc svgml::is_number { text } { 122 + 123 + if { [scan $text "%f %n" number len] == 0 } { return 0 } 124 + if { $len != [string length $text] } { return 0 } 125 + return 1 126 +} 80 127 81 128 # x,y where values are: -1,0,1 82 129 proc svgml::give_anchor_axes { d id } { 83 130 84 - set anchor [split [give_propD $d $id anchor "nw"] ""] 131 + set anchor [split [give_propD $d $id anchor ""] ""] 85 132 86 133 lassign "0 0" x y 87 134 88 135 if { "w" in $anchor && "e" in $anchor } { 89 136 set x 0 90 137 } elseif { "w" in $anchor } { 91 138 set x 1 ................................................................................ 150 197 variable d 151 198 variable xml 152 199 153 200 ################################################################################# 154 201 # initial parsing by lines 155 202 ################################################################################# 156 203 157 - set d "" 158 - foreach line [split $txt \n] { 204 + lassign "" d line 205 + foreach ln [split $txt \n] { 206 + if { [regexp {(.*[^\\])\\\s*$} $ln {} prefix] } { 207 + append line $prefix 208 + continue 209 + } else { 210 + append line $ln 211 + } 159 212 if { [regexp {^\s*\+svgml(\S+)\s+(.*)} $line {} version content] } { 160 213 append_line d 0 $line $content 161 214 dict set d version $version 162 215 163 216 set width [give_prop $d 0 width] 164 217 set height [give_prop $d 0 height] 165 218 166 219 if { [regexp {(\d+)%} $height {} p] } { 167 220 set height [expr {int($p/100.0*$width)}] 168 221 } 222 + dict set d ids __ROOT bbox [list 0 0 100 100] 223 + dict set d ids __ROOT props "" 169 224 dict set d ids 0 bbox [list 0 0 $width $height] 170 225 dict set d ids 0 bboxL [dict get $d ids 0 bbox] 171 226 dict set d ids 0 angle 0 172 227 } elseif { [regexp {^\s*\+alias\s+(\S.*)} $line {} content] } { 173 228 foreach "long short" [parse_props $content 0 $line] { 174 229 dict set d alias $short $long 175 230 } ................................................................................ 187 242 } 188 243 } elseif { [regexp {^\s*(\w\S+)\s+(\w+)\s+(\S.*)} $line {} id cmd content] } { 189 244 if { [dict exists $d ids $id] } { 190 245 set_error $d $id "repeated id in line" 191 246 } 192 247 append_line d $id $line $content 193 248 dict set d ids $id cmd $cmd 249 + dict set d ids_short [lindex [split $id .] end] $id 194 250 } elseif { [regexp {^\s*\.(\S+)\s+(\S.*)} $line {} class content] } { 195 251 dict set d classes $class $content 196 252 } elseif { ![regexp {^\s*$|^\s*#} $line] } { 197 253 error "unknown line '$line'" 198 254 } 255 + set line "" 199 256 } 200 257 201 258 ################################################################################# 202 259 # substitute alias and variables 203 260 ################################################################################# 204 261 205 262 foreach id [dict keys [dict get $d ids]] { ................................................................................ 223 280 ################################################################################# 224 281 225 282 if { ![dict exists $d ids 0] } { 226 283 error "there is no header" 227 284 } 228 285 lassign [dict get $d ids 0 bbox] - - width height 229 286 230 - set xml "<?xml version='1.0' encoding='UTF-8' standalone='no'?>\n" 231 - append xml "<svg xmlns='http://www.w3.org/2000/svg' " 232 - append xml "xmlns:xlink='http://www.w3.org/1999/xlink' version='1.1' " 233 - append xml "width='$width' height='$height'>\n" 234 - append xml "<!--created with svgml-RamDebugger <http://www.compassis.com/ramdebugger>-->" 235 - append xml "<defs>\n" 287 + set xmlH "<?xml version='1.0' encoding='UTF-8' standalone='no'?>\n" 288 + append xmlH "<svg xmlns='http://www.w3.org/2000/svg' " 289 + append xmlH "xmlns:xlink='http://www.w3.org/1999/xlink' version='1.1' " 290 + append xmlH "width='$width' height='$height'>\n" 291 + append xmlH "<!--created with svgml-RamDebugger <http://www.compassis.com/ramdebugger>-->" 292 + append xmlH "<defs>\n" 236 293 237 294 set stP "stroke:#000000;stroke-width:1pt;fill:#000000;" 238 - append xml "<marker orient='auto' refY='0.0' refX='-4.5' id='TriangleInL' style='overflow:visible'>\n" 239 - append xml "<path d='M 4.5,0.0 L -2.3,4.0 L -2.3,-4.0 L 4.5,0.0 z' style='$stP' transform='scale(-1.0)'/>\n" 240 - append xml "</marker>\n" 295 + append xmlH "<marker orient='auto' refY='0.0' refX='-4.5' id='TriangleInL' style='overflow:visible'>\n" 296 + append xmlH "<path d='M 4.5,0.0 L -2.3,4.0 L -2.3,-4.0 L 4.5,0.0 z' " 297 + append xmlH "fill='context-stroke' stroke='context-stroke' style='$stP' transform='scale(-1.0)'/>\n" 298 + append xmlH "</marker>\n" 241 299 242 - append xml "<marker orient='auto' refY='0.0' refX='4.5' id='TriangleOutL' style='overflow:visible'>\n" 243 - append xml "<path d='M 4.5,0.0 L -2.3,4.0 L -2.3,-4.0 L 4.5,0.0 z' style='$stP'/>\n" 244 - append xml "</marker>\n" 300 + append xmlH "<marker orient='auto' refY='0.0' refX='4.5' id='TriangleOutL' style='overflow:visible'>\n" 301 + append xmlH "<path d='M 4.5,0.0 L -2.3,4.0 L -2.3,-4.0 L 4.5,0.0 z' " 302 + append xmlH "fill='context-stroke' stroke='context-stroke' style='$stP'/>\n" 303 + append xmlH "</marker>\n" 245 304 246 - append xml "</defs>\n" 305 + append xmlH "</defs>\n" 247 306 248 307 ################################################################################# 249 308 # loop on entities. The tries are here to solve dependencies of dependencies 250 309 ################################################################################# 251 310 252 311 for { set i_try 0 } { $i_try < 10 } { incr i_try } { 253 - set needs_recalculate 0 312 + set xml $xmlH 313 + dict set d needs_recalculate 0 254 314 dict for "id ent" [dict get $d ids] { 255 - if { [dict exist $ent bbox] } { continue } 256 - #puts "$i_try [dict get $ent line]" 315 + if { $id in "0 __ROOT" } { continue } 316 + #if { [dict exist $ent bbox] } { continue } 317 + puts "$i_try [dict get $ent line]" 257 318 258 319 set ret [catch { create_entity $id "" } str opts] 259 320 if { $ret != 0 && $ret != 4 } { 260 321 error $str [dict get $opts -errorinfo] 322 + } elseif { $ret == 4 } { 323 + dict set d needs_recalculate 1 261 324 } 325 + } 326 + if { ![dict get $d needs_recalculate] } { 327 + break 262 328 } 263 329 } 264 330 append xml "</svg>\n" 265 331 return $xml 266 332 } 333 + 334 +proc svgml::resolve_id { id id_from } { 335 + variable d 336 + 337 + if { $id eq "" } { return 0 } 338 + 339 + if { ![dict exists $d ids $id] && [dict exists $d ids_short $id] } { 340 + set id [dict get $d ids_short $id] 341 + } 342 + if { ![dict exists $d ids $id] } { 343 + set_error $d $id_from "unknown id #$id" 344 + } 345 + return $id 346 +} 267 347 268 348 proc svgml::calculate_parent { id } { 269 349 variable d 270 350 271 - set parent [lrange [split $id .] 0 end-1] 272 - if { $parent eq "" } { 273 - set parent 0 351 + set parent [join [lrange [split $id .] 0 end-1] "."] 352 + return [resolve_id $parent $id] 353 +} 354 +proc svgml::copy_operation { id n x y npoint copy_info } { 355 + variable d 356 + 357 + if { [dict exists $copy_info delta_points] } { 358 + set dist_max 0.0 359 + set deltas "" 360 + dict for "p v" [dict get $copy_info delta_points] { 361 + set dist [m::norm_two [m::sub $p "$x $y"]] 362 + lappend deltas $dist $v 363 + if { $dist > $dist_max } { 364 + set dist_max $dist 365 + } 366 + } 367 + set delta "0 0" 368 + set fac_tot 0.0 369 + foreach "dist v" $deltas { 370 + set fac [expr {($dist_max-$dist)**3}] 371 + set delta [m::axpy $fac $v $delta] 372 + set fac_tot [expr {$fac_tot+$fac}] 373 + } 374 + set delta [m::scale [expr {1.0/$fac_tot}] $delta] 375 + } else { 376 + set delta [dict get $copy_info delta] 377 + } 378 + set factor [dict get $copy_info factor] 379 + set delta [m::scale $factor $delta] 380 + lassign "$x $y" x0 y0 381 + lassign [m::add "$x $y" $delta] x y 382 + 383 + if { [dict get $copy_info connect_points] && $n eq "point" } { 384 + if { $factor > 1 } { 385 + set delta_prev [m::scale [expr {$factor-1}] $delta] 386 + } else { 387 + set delta_prev "0 0" 388 + } 389 + set p_prev [m::add "$x0 $y0" $delta_prev] 390 + set content "point:#__ROOT,[join $p_prev ,]; point:#__ROOT,$x,$y;" 391 + if { [dict get $copy_info style_name] ne "" } { 392 + append content " class:[dict get $copy_info style_name];" 393 + } 394 + regsub -all {\.} [dict get $copy_info id] _ idF 395 + set idC __copy_${idF}_${npoint}_$factor 396 + set line "$idC line $content" 397 + append_line d $idC $line $content 398 + dict set d ids $idC cmd line 399 + dict set d needs_recalculate 1 400 + } 401 + return [list $x $y] 402 +} 403 + 404 +proc svgml::process_cube { id what args } { 405 + variable d 406 + 407 + lassign [dict get $d ids $id bbox] x0 y0 w h 408 + set pnts [dict get $d ids $id pnts] 409 + 410 + set angles [give_propD $d $id angles "45deg,45deg"] 411 + set anglesList [split $angles ","] 412 + if { [llength $anglesList] != 2 } { 413 + set_error $d $id "properties angles must be: angles:45deg,45deg;" 414 + } 415 + set anglesN "" 416 + foreach a $anglesList { 417 + if { [regexp {^\s*([-+\d.e]+)\s*deg\s*$} $a {} value] } { 418 + lappend anglesN $value 419 + } elseif { [regexp {^\s*([-+\d.e]+)\s*rad\s*$} $a {} value] } { 420 + lappend anglesN [expr {$m::radtodeg*$value}] 421 + } else { 422 + set_error $d $id "properties angles must be: angles:45deg,45deg;" 423 + } 424 + } 425 + set q [svgml::rotate_angles {*}$anglesN] 426 + 427 + set ipos [lsearch -index 0 $pnts "width-height"] 428 + set height "" 429 + if { $ipos != -1 } { 430 + set height [lindex $pnts $ipos 3] 431 + } 432 + if { $height eq "" } { 433 + set height $w 434 + } 435 + 436 + set point_to_axes {{0 0 0} {1 0 0} {1 1 0} {0 1 0} {0 0 1} {1 0 1} {1 1 1} {0 1 1}} 437 + set face_to_points {{0 1 2 3} {0 4 5 1} {1 2 6 5} {3 7 6 2} {0 3 7 4} {4 5 6 7}} 438 + set ariste_to_points {{0 1} {1 2} {3 2} {0 3} {0 4} {1 5} {2 6} {3 7} {4 5} {5 6} {7 6} {4 7}} 439 + set face_to_normal {2 1 0 1 0 2} 440 + set face_to_normal_prev_next {0 0 1 1 0 1} 441 + 442 + set p0 [list [expr {$x0+0.5*$w}] [expr {$y0+0.5*$h}]] 443 + 444 + if { $what eq "faces" } { 445 + set idx_faces [list 0 1 4 2 3 5] 446 + set faces "" 447 + foreach idx_face $idx_faces { 448 + set face "$idx_face" 449 + set center_face "0 0" 450 + for { set i 0 } { $i < 4 } { incr i } { 451 + set idx_point [lindex $face_to_points $idx_face $i] 452 + set vL [lindex $point_to_axes $idx_point] 453 + set xL [expr {(-1+2*[lindex $vL 0])*0.5*$w}] 454 + set yL [expr {(-1+2*[lindex $vL 1])*0.5*$h}] 455 + set zL [expr {[lindex $vL 2]*$height}] 456 + set v [m::matmul [m::transpose [m::quaternion::matrix $q]] [list $xL $yL $zL]] 457 + set v [list [lindex $v 0] [expr {-1*[lindex $v 1]}]] 458 + set pnt [m::add $p0 $v] 459 + lappend face $pnt 460 + set center_face [m::axpy 0.25 $pnt $center_face] 461 + } 462 + lappend faces $face 463 + } 464 + return $faces 465 + } elseif { $what eq "draw_labels" } { 466 + set xml "" 467 + 468 + if { [lindex $args 0] in "faces all" } { 469 + for { set idx_face 0 } { $idx_face < 6 } { incr idx_face } { 470 + set center_face "0 0" 471 + for { set i 0 } { $i < 4 } { incr i } { 472 + set idx_point [lindex $face_to_points $idx_face $i] 473 + set vL [lindex $point_to_axes $idx_point] 474 + set xL [expr {(-1+2*[lindex $vL 0])*0.5*$w}] 475 + set yL [expr {(-1+2*[lindex $vL 1])*0.5*$h}] 476 + set zL [expr {[lindex $vL 2]*$height}] 477 + set v [m::matmul [m::transpose [m::quaternion::matrix $q]] [list $xL $yL $zL]] 478 + set v [list [lindex $v 0] [expr {-1*[lindex $v 1]}]] 479 + set pnt [m::add $p0 $v] 480 + set center_face [m::axpy 0.25 $pnt $center_face] 481 + } 482 + lassign $center_face x y 483 + append xml "<text x='$x' y='$y' style='fill: red;'>" 484 + append xml "[expr {$idx_face+1}]</text>" 485 + 486 + set style "stroke-width: 1.0px; stroke: black;fill:none;marker-end:url(#TriangleOutL);" 487 + set styleT "font-size: 18px; fill: black; font-family: sans-serif;" 488 + set pnt [process_cube $id face [expr {$idx_face+1}] 70 50] 489 + set pnt [m::add $center_face [m::scale 50 [m::unitLengthVector [m::sub $pnt $center_face]]]] 490 + append xml "<path d='M$center_face L$pnt' style='$style'/>" 491 + append xml "<text x='[lindex $pnt 0]' y='[lindex $pnt 1]' style='$styleT'>x'</text>" 492 + set pnt [process_cube $id face [expr {$idx_face+1}] 50 70] 493 + set pnt [m::add $center_face [m::scale 50 [m::unitLengthVector [m::sub $pnt $center_face]]]] 494 + append xml "<path d='M$center_face L$pnt' style='$style'/>" 495 + append xml "<text x='[lindex $pnt 0]' y='[lindex $pnt 1]' style='$styleT'>y'</text>" 496 + } 497 + } 498 + if { [lindex $args 0] in "aristes all" } { 499 + for { set idx_ariste 0 } { $idx_ariste < 12 } { incr idx_ariste } { 500 + set center_ariste "0 0" 501 + for { set i 0 } { $i < 2 } { incr i } { 502 + set idx_point [lindex $ariste_to_points $idx_ariste $i] 503 + set vL [lindex $point_to_axes $idx_point] 504 + set xL [expr {(-1+2*[lindex $vL 0])*0.5*$w}] 505 + set yL [expr {(-1+2*[lindex $vL 1])*0.5*$h}] 506 + set zL [expr {[lindex $vL 2]*$height}] 507 + set v [m::matmul [m::transpose [m::quaternion::matrix $q]] [list $xL $yL $zL]] 508 + set v [list [lindex $v 0] [expr {-1*[lindex $v 1]}]] 509 + set pnt [m::add $p0 $v] 510 + set center_ariste [m::axpy 0.5 $pnt $center_ariste] 511 + } 512 + lassign $center_ariste x y 513 + append xml "<text x='$x' y='$y' style='fill: blue;'>" 514 + append xml "[expr {$idx_ariste+1}]</text>" 515 + } 516 + } 517 + if { [lindex $args 0] in "vertexs all" } { 518 + for { set idx_point 0 } { $idx_point < 8 } { incr idx_point } { 519 + set vL [lindex $point_to_axes $idx_point] 520 + set xL [expr {(-1+2*[lindex $vL 0])*0.5*$w}] 521 + set yL [expr {(-1+2*[lindex $vL 1])*0.5*$h}] 522 + set zL [expr {[lindex $vL 2]*$height}] 523 + set v [m::matmul [m::transpose [m::quaternion::matrix $q]] [list $xL $yL $zL]] 524 + set v [list [lindex $v 0] [expr {-1*[lindex $v 1]}]] 525 + set pnt [m::add $p0 $v] 526 + lassign $pnt x y 527 + append xml "<text x='$x' y='$y' style='fill: green;'>" 528 + append xml "[expr {$idx_point+1}]</text>" 529 + } 530 + } 531 + return $xml 532 + } elseif { $what eq "face" } { 533 + lassign $args idx_face x y z 534 + incr idx_face -1 535 + set x [expr {$x/100.0}] 536 + set y [expr {$y/100.0}] 537 + set z [expr {($z eq "")?0:$z/100.0}] 538 + lappend p0 0.0 539 + 540 + set face "" 541 + for { set i 0 } { $i < 4 } { incr i } { 542 + set idx_point [lindex $face_to_points $idx_face $i] 543 + set vL [lindex $point_to_axes $idx_point] 544 + set xL [expr {(-1+2*[lindex $vL 0])*0.5*$w}] 545 + set yL [expr {(-1+2*[lindex $vL 1])*0.5*$h}] 546 + set zL [expr {[lindex $vL 2]*$height}] 547 + set v [m::matmul [m::transpose [m::quaternion::matrix $q]] [list $xL $yL $zL]] 548 + set v [list [lindex $v 0] [expr {-1*[lindex $v 1]}] [lindex $v 2]] 549 + set pnt [m::add $p0 $v] 550 + lappend face $pnt 551 + } 552 + set normal [m::vector_normal_triangle {*}[lrange $face 0 2]] 553 + set sign [expr {([lindex $face_to_normal_prev_next $idx_face]==1)?-1:1}] 554 + set normal [m::scale [expr {$sign*$w}] [m::unitLengthVector $normal]] 555 + 556 + set dx [m::scale $x [m::sub [lindex $face 1] [lindex $face 0]]] 557 + set dy [m::scale $y [m::sub [lindex $face 3] [lindex $face 0]]] 558 + set dz [m::scale $z $normal] 559 + 560 + set p [m::add [lindex $face 0] [m::add $dx [m::add $dy $dz]]] 561 + return [lrange $p 0 1] 562 + } 563 +} 564 + 565 +proc svgml::get_geometry_point { id vertex_ariste_face num args } { 566 + variable d 567 + 568 + 569 + if { [dict get $d ids $id cmd] eq "cube" } { 570 + return [process_cube $id $vertex_ariste_face $num {*}$args] 274 571 } else { 275 - set parent [join $parent "."] 572 + if { $vertex_ariste_face eq "face" } { 573 + set_error $d $id "face only allowed for 'cube'" 574 + } 575 + set coord [lindex $args 0] 576 + set idx 1 577 + set pnts [dict_getd $d ids $id pnts ""] 578 + for { set i 0 } { $i < [llength $pnts] } { incr i } { 579 + lassign [lindex $pnts $i] type x y 580 + if { $type ne "point" } { continue } 581 + if { $num == $idx } { 582 + if { $vertex_ariste_face eq "vertex" } { 583 + return [list $x $y] 584 + } else { 585 + if { $i < [llength $pnts]-1 } { 586 + set i_next [expr {$i+1}] 587 + } else { 588 + set i_next 0 589 + } 590 + lassign [lindex $pnts $i_next] type_n x_n y_n 591 + if { $type_n eq "Q" } { 592 + lassign [lindex $pnts $i_next+1] type_n2 x_n2 y_n2 593 + if { $type_n2 ne "point" } { error "aa" } 594 + return [m::eval_quadratic_bezier $x $y $x_n $y_n \ 595 + $x_n2 $y_n2 $coord] 596 + } else { 597 + return [m::eval_linear $x $y $x_n $y_n $coord] 598 + } 599 + } 600 + } 601 + incr idx 602 + } 276 603 } 277 - if { ![dict exists $d ids $parent] } { 278 - set_error $d $id "unknow parent id #$parent" 279 - } 280 - return $parent 281 604 } 282 605 283 -proc svgml::calculate_points { id deltaVec } { 606 +proc svgml::calculate_points { id copy_info } { 284 607 variable d 285 608 286 609 set parent [calculate_parent $id] 287 610 288 611 set pnts "" 289 612 foreach "n v" [dict get $d ids $id props] { 290 613 if { $n ni "point delta-point width-height" } { continue } 614 + #puts "---calculate_points $n --- $v" 291 615 292 616 set parentL $parent 293 617 set pnt "" 294 618 set parents "" 295 - foreach c [split $v ,] { 296 - if { [regexp {^\s*#(\S+)\s*$} $c {} idP] } { 297 - set parentL $idP 298 - } elseif { [regexp {^\s*([-+\d.]+)\s*$} $c {} value] } { 619 + set calculate_type "" 620 + set vList [split $v ,] 621 + for { set i 0 } { $i < [llength $vList] } { incr i } { 622 + set c [string trim [lindex $vList $i]] 623 + if { [regexp {^#(\S+)$} $c {} idP] } { 624 + set parentL [resolve_id $idP $id] 625 + } elseif { [regexp {^([-+\d.]+)$} $c {} value] } { 299 626 lappend pnt $value 300 627 lappend parents $parentL 628 + } elseif { [regexp {[qQzZ]} $c] } { 629 + set n $c 630 + } elseif { [regexp {vertex|ariste|face} $c] } { 631 + set calculate_type $c 301 632 } else { 302 633 set_error $d $id "incorrect format '$n:$v'" 303 634 } 635 + if { $n in "z Z" } { 636 + lappend pnts [list z] 637 + continue 638 + } 639 + if { $calculate_type eq "vertex" } { 640 + if { [llength $pnt] < 1 } { 641 + continue 642 + } 643 + } elseif { $calculate_type eq "ariste" } { 644 + if { [llength $pnt] < 2 } { 645 + continue 646 + } 647 + } elseif { $calculate_type eq "face" } { 648 + if { [llength $pnt] < 3 } { 649 + continue 650 + } 651 + if { [llength $pnt] == 3 && $i < [llength $vList]-1 && 652 + [is_number [lindex $vList $i+1]] } { 653 + continue 654 + } 655 + } elseif { $n eq "width-height" && [llength $vList] == 3 && [llength $pnt] < 3 } { 656 + continue 657 + } elseif { [llength $pnt] < 2 } { 658 + continue 659 + } 660 + lassign $pnt x y z 661 + 662 + if { $calculate_type in "vertex ariste face" } { 663 + if { ![dict exists $d ids [lindex $parents 0] bbox] } { 664 + if { ![dict exists $d ids $parentL] } { 665 + error "error: unknown parent id #$parentL for id #$id" 666 + } 667 + return -code continue 668 + } 669 + lassign [get_geometry_point [lindex $parents 0] $calculate_type {*}$pnt] x y 670 + set calculate_type "" 671 + } else { 672 + foreach parentL $parents { 673 + if { ![dict exists $d ids $parentL bbox] } { 674 + if { ![dict exists $d ids $parentL] } { 675 + error "error: unknown parent id #$parentL for id #$id" 676 + } 677 + return -code continue 678 + } 679 + } 680 + set bboxPx [dict get $d ids [lindex $parents 0] bbox] 681 + set bboxPy [dict get $d ids [lindex $parents 1] bbox] 682 + if { $z ne "" } { 683 + set bboxPz [dict get $d ids [lindex $parents 2] bbox] 684 + } 685 + if { $n in "point Q" } { 686 + set x [expr {[lindex $bboxPx 0]+$x/100.0*[lindex $bboxPx 2]}] 687 + set y [expr {[lindex $bboxPy 1]+$y/100.0*[lindex $bboxPy 3]}] 688 + } else { 689 + set x [expr {$x/100.0*[lindex $bboxPx 2]}] 690 + set y [expr {$y/100.0*[lindex $bboxPy 3]}] 691 + if { $z ne "" } { 692 + set z [expr {$z/100.0*[lindex $bboxPz 2]}] 693 + } 694 + } 695 + } 696 + if { $n in "point Q" && [dict size $copy_info] } { 697 + lassign [copy_operation $id $n $x $y [llength $pnts] $copy_info] x y 698 + } 699 + if { $z eq "" } { 700 + lappend pnts [list $n $x $y] 701 + } else { 702 + lappend pnts [list $n $x $y $z] 703 + } 704 + set pnt "" 304 705 } 305 - if { [llength $pnt] != 2} { 706 + if { [llength $pnt] == 1} { 306 707 set_error $d $id "bad number of components '$n:$v'" 307 708 } 308 - lassign $pnt x y 309 - 310 - if { ![dict exists $d ids $parentL bbox] } { 311 - if { ![dict exists $d ids $parentL] } { 312 - error "error: unknow parent id #$parentL for id #$id" 313 - } 314 - return -code continue 315 - } 316 - set bboxPx [dict get $d ids [lindex $parents 0] bbox] 317 - set bboxPy [dict get $d ids [lindex $parents 1] bbox] 318 - if { $n eq "point" } { 319 - set x [expr {[lindex $bboxPx 0]+$x/100.0*[lindex $bboxPx 2]}] 320 - set y [expr {[lindex $bboxPy 1]+$y/100.0*[lindex $bboxPy 3]}] 321 - } else { 322 - set x [expr {$x/100.0*[lindex $bboxPx 2]}] 323 - set y [expr {$y/100.0*[lindex $bboxPy 3]}] 324 - } 325 - if { $n eq "point" && $deltaVec ne "" } { 326 - lassign [m::add "$x $y" $deltaVec] x y 327 - } 328 - lappend pnts [list $n $x $y] 709 + } 710 + if { [dict size $copy_info] == 0 } { 711 + dict set d ids $id pnts $pnts 712 + } else { 713 + set idC [dict get $copy_info id] 714 + set pntsO [dict_getd $idC pnts ""] 715 + lappend pntsO {*}$pnts 716 + dict set d ids $idC pnts $pnts 329 717 } 330 718 return $pnts 331 719 } 332 720 333 721 proc svgml::give_descendants { id id_avoid } { 334 722 variable d 335 723 ................................................................................ 343 731 if { [lrange [split $idC "."] 0 $n] eq $idL } { 344 732 lappend idsList $idC 345 733 } 346 734 } 347 735 return $idsList 348 736 } 349 737 350 -proc svgml::create_entity { id deltaVec } { 738 +proc svgml::create_entity { id copy_info } { 351 739 variable d 352 740 variable xml 353 741 354 - set pnts [calculate_points $id $deltaVec] 742 + set ret [catch { calculate_points $id $copy_info } pnts opts] 743 + if { $ret != 0 } { 744 + return -code $ret -errorinfo \ 745 + [dict_getd $opts -errorinfo ""] $pnts 746 + } 355 747 356 748 lassign [give_anchor_axes $d $id] anchorX anchorY 357 749 358 750 set pntsBBOX "" 359 751 foreach p $pnts { 360 752 lassign $p type x y 361 753 if { $type eq "width-height" } { 362 754 lassign $p - b h 363 755 if { [llength $pntsBBOX] } { 364 756 lassign [lindex $pntsBBOX end] x y 365 757 } else { 366 758 set ipos [lsearch -index 0 $pnts point] 367 759 if { $ipos == -1 } { 368 - set_error $d $id "a property of type 'pntsBBOX' needs a 'point'" 760 + set_error $d $id "property 'width-height' needs a 'point'" 369 761 } 370 762 lassign [lindex $pnts $ipos] - x y 371 763 } 372 764 set a1x [expr {-0.5*(1.0-$anchorX)}] 373 765 set a2x [expr {0.5*(1.0+$anchorX)}] 374 766 set a1y [expr {-0.5*(1.0-$anchorY)}] 375 767 set a2y [expr {0.5*(1.0+$anchorY)}] 376 768 377 769 lappend pntsBBOX [list [expr {$x+$a1x*$b}] [expr {$y+$a1y*$h}]] 378 770 lappend pntsBBOX [list [expr {$x+$a2x*$b}] [expr {$y+$a2y*$h}]] 379 - } elseif { $type eq "point" } { 771 + } elseif { $type in "point Q" } { 380 772 lappend pntsBBOX [list $x $y] 381 - } elseif { $type eq "delta-point" && [llength $pntsBBOX] } { 773 + } elseif { $type in "delta-point q" && [llength $pntsBBOX] } { 382 774 lassign [lindex $pntsBBOX end] xp yp 383 775 set x [expr {$x+$xp}] 384 776 set y [expr {$y+$yp}] 385 777 lappend pntsBBOX [list $x $y] 386 778 } 387 779 } 388 780 ................................................................................ 397 789 } 398 790 set w [expr {$x1-$x0}] 399 791 set h [expr {$y1-$y0}] 400 792 set bbox [list $x0 $y0 $w $h] 401 793 } else { 402 794 set bbox "" 403 795 } 404 - if { $deltaVec eq "" } { 796 + if { [dict size $copy_info] == 0 } { 405 797 dict set d ids $id bbox $bbox 798 + } else { 799 + add_to_bbox [dict get $copy_info id] $bbox 406 800 } 407 801 408 - set style "" 802 + lassign "" style style_name 409 803 foreach "n v" [dict get $d ids $id props] { 410 804 if { $n ne "class" } { continue } 411 805 append style "[dict get $d classes $v]" 806 + set style_name $v 412 807 } 808 + append style [dict_getd $copy_info style ""] 809 + 413 810 set cmd [dict get $d ids $id cmd] 414 811 415 812 switch $cmd { 416 813 region { 417 814 if { $bbox eq "" } { 418 815 set_error $d $id "region needs a box definition" 419 816 } ................................................................................ 421 818 rect { 422 819 lassign $bbox x0 y0 w h 423 820 append xml "<rect x='$x0' y='$y0' width='$w' height='$h' id='$id' style='$style'" 424 821 if { [regexp {border-radius\s*:\s*(\d+)} $style {} r] } { 425 822 append xml " rx='$r' ry='$r'" 426 823 } 427 824 append xml "/>\n" 428 - if { $deltaVec eq "" } { 825 + if { [dict size $copy_info] == 0 } { 826 + dict set d ids $id bboxL $bbox 827 + dict set d ids $id angle 0 828 + } 829 + } 830 + cube { 831 + set labels [give_propD $d $id labels ""] 832 + if { $labels ne "" && $labels ne "0" } { 833 + if { $labels ni "vertexs aristes faces" } { 834 + set labels all 835 + } 836 + append xml [process_cube $id draw_labels $labels] 837 + append style "fill:none;" 838 + } 839 + set faces [process_cube $id faces] 840 + foreach face $faces { 841 + set ds "" 842 + for { set i 0 } { $i < [llength $face] } { incr i } { 843 + if { $i == 0 } { 844 + set idx_face [lindex $face $i] 845 + continue 846 + } 847 + set pnt [lindex $face $i] 848 + if { $ds eq "" } { 849 + append ds "M$pnt" 850 + } else { 851 + append ds " L$pnt" 852 + } 853 + } 854 + append ds "z" 855 + append xml "<path d='$ds' id='$id-$idx_face' style='$style'/>\n" 856 + } 857 + 858 + if { [dict size $copy_info] == 0 } { 429 859 dict set d ids $id bboxL $bbox 430 860 dict set d ids $id angle 0 431 861 } 432 862 } 433 863 line { 434 - set ds "" 435 - foreach p $pntsBBOX { 864 + lassign "" ds type_prev 865 + foreach p $pnts { 866 + lassign $p type x y 436 867 if { $ds eq "" } { 437 - append ds "M$p" 438 - } else { 439 - append ds " L$p" 868 + append ds "M$x,$y" 869 + } elseif { $type eq "point" && $type_prev in "q Q" } { 870 + append ds " $x,$y" 871 + } elseif { $type eq "point" } { 872 + append ds " L$x,$y" 873 + } elseif { $type eq "delta-point" && $type_prev in "q Q" } { 874 + append ds " $x,$y" 875 + } elseif { $type eq "delta-point" } { 876 + append ds " l$x,$y" 877 + } elseif { $type in "q Q" } { 878 + append ds " $type$x,$y" 879 + } elseif { $type in "z Z" } { 880 + append ds " $type" 440 881 } 882 + set type_prev $type 441 883 } 442 884 append xml "<path d='$ds' id='$id' style='$style'/>\n" 443 885 444 886 set pnt1 [lindex $pntsBBOX 1] 445 887 set pnt0 [lindex $pntsBBOX 0] 446 888 set L [m::norm [m::sub $pnt1 $pnt0]] 447 889 set angle [expr {atan2([lindex $pnt1 1]-[lindex $pnt0 1], 448 890 [lindex $pnt1 0]-[lindex $pnt0 0])}] 449 - if { $deltaVec eq "" } { 891 + if { [dict size $copy_info] == 0 } { 450 892 dict set d ids $id bboxL [list $x0 $y0 $L $L] 451 893 dict set d ids $id angle $angle 452 894 } 453 895 } 454 896 label - dimension - text { 455 897 set text [give_propD $d $id text ""] 456 898 set ariste [give_propD $d $id ariste "s"] ................................................................................ 541 983 set st "stroke:black;stroke-width=1px;$style" 542 984 append xml "<path d='M$p0 L$p0D2' id='$id-DL1' style='$st'/>\n" 543 985 append xml "<path d='M$p1 L$p1D2' id='$id-DL2' style='$st'/>\n" 544 986 545 987 append st "marker-end:url(#TriangleOutL);" \ 546 988 "marker-start:url(#TriangleInL);" 547 989 append xml "<path d='M$p0D1 L$p1D1' id='$id-DL' style='$st'/>\n" 548 - } elseif { $delta ne "" } { 990 + } elseif { $delta ne "" && [m::norm_two $delta] > 20 } { 549 991 set p0D [m::add $pLabel $delta] 550 992 set p1D [m::axpy 0.1 $delta $pLabel] 993 + set delta "" 551 994 552 995 set st "stroke:black;stroke-width=1px;$style" 553 996 append st "marker-end:url(#TriangleOutL);" 554 997 append xml "<path d='M$p0D L$p1D' id='$id-DL' style='$st'/>\n" 555 998 set pLabel $p0D 556 999 set cmd labelarrow 557 1000 } ................................................................................ 574 1017 set fac1 [expr {abs([lindex $fsX $anchorX+1]*$font_size)}] 575 1018 } 576 1019 if { abs([lindex $vN 1])>0.2 } { 577 1020 set fac2 [expr {abs([lindex $fsY $anchorY+1]*$font_size)}] 578 1021 } 579 1022 set fac [expr {($fac1>$fac2)?$fac1:$fac2}] 580 1023 set pLabel [m::axpy $fac $vN $pLabel] 1024 + 1025 + if { $delta ne "" } { 1026 + set pLabel [m::add $pLabel $delta] 1027 + } 581 1028 582 1029 if { $anchorX == -1 } { 583 1030 set ta "end" 584 1031 } elseif { $anchorX == 1 } { 585 1032 set ta "start" 586 1033 } else { 587 1034 set ta "middle" ................................................................................ 609 1056 if { $st ne "" } { 610 1057 append xml " style='$st'" 611 1058 } 612 1059 set map [list "<" "<" ">" ">" "&" "&"] 613 1060 append xml ">[string map $map $txt]</tspan>\n" 614 1061 } 615 1062 append xml "</text>\n" 616 - if { $deltaVec eq "" } { 1063 + if { [dict size $copy_info] == 0 } { 617 1064 dict set d ids $id bboxL [dict_getd $d ids $id bbox ""] 618 1065 dict set d ids $id angle 0 619 1066 } 620 1067 } 621 1068 copy { 622 1069 set idC [join [lrange [split $id .] 0 end-1] .] 623 1070 set idsList [list $idC] 624 1071 set ic [give_propD $d $id include_children 0] 625 1072 if { $ic } { 626 1073 lappend idsList {*}[give_descendants $idC $id] 627 1074 } 628 1075 629 - set ipos [lsearch -index 0 $pnts "delta-point"] 630 - if { $ipos == -1 } { 631 - set_error $d $id "command 'copy' must have a delta-point property" 632 - } 633 - lassign [lindex $pnts $ipos] - x y 634 1076 set n [give_propD $d $id number 1] 1077 + 1078 + dict set copy_info style $style 1079 + dict set copy_info style_name $style_name 1080 + dict set copy_info id $id 1081 + dict set copy_info connect_points [give_propD $d $id connect_points 0] 1082 + 1083 + for { set i 0 } { $i < [llength $pnts] } { incr i } { 1084 + lassign [lindex $pnts $i] type x y 1085 + if { $type ne "delta-point" } { continue } 1086 + if { $i == 0 || [lindex $pnts $i-1 0] ne "point" } { 1087 + dict set copy_info delta "$x $y" 1088 + } else { 1089 + lassign [lindex $pnts $i-1] - xP yP 1090 + dict set copy_info delta_points "$xP $yP" "$x $y" 1091 + } 1092 + } 1093 + if { ![dict exists $copy_info delta] } { 1094 + if { ![dict exists $copy_info delta_points] } { 1095 + set_error $d $id "'copy' must have a delta-point property" 1096 + } 1097 + } 635 1098 636 1099 for { set i 1 } { $i <= $n } { incr i } { 1100 + dict set copy_info factor $i 637 1101 foreach idC $idsList { 638 - create_entity $idC [m::scale $i "$x $y"] 1102 + create_entity $idC $copy_info 639 1103 } 640 1104 } 641 1105 } 642 1106 default { 643 1107 set_error $d $id "unknown command '$cmd'" 644 1108 } 645 1109 }