##+##########################################################################
 #
 # ribbon.tcl -- Draws a line graph with a 3-D ribbon affect
 # by Keith Vetter, Sept 2006
 #
 
 package require Tk
 package require tile
 
 set samples {
    {50 285 74 282 98 313 133 340 145 339 165 308 174 298 191 286 215 273 232 252 244 254 271 211 286 200 297 198 318 220 358 166 429 189 458 169 480 193 491 213 503 231 513 198 531 177 599 114 657 79 687 68 687 350}
    {50 231 63 234 77 248 86 261 117 186 131 217 158 193 173 152 187 146 204 176 217 161 226 185 236 164 245 140 257 130 277 144 291 119 329 47 354 95 385 196 392 205 466 233 478 241 505 242 505 350}
    {50 301 62 304 72 304 80 290 86 287 89 293 106 287 114 284 147 261 158 251 195 220 200 220 215 226 246 170 259 214 265 199 290 241 296 227 300 245 304 228 323 252 328 278 335 274 348 268 371 259 401 228 407 222 433 196 450 198 481 171 517 131 538 98 560 53 587 55 619 115 635 82 635 350}
    {50 350 98 314 115 288 131 304 166 300 194 299 209 281 223 273 248 271 262 275 286 259 323 232 341 216 361 184 379 170 397 133 402 151 409 187 418 240 440 285 468 267 512 247 548 220 563 247 591 301 619 307 657 298 668 296 668 350}
    {50 198 61 189 68 218 91 189 96 206 109 155 138 133 149 123 167 138 180 123 199 154 208 156 245 68 259 79 288 114 323 177 330 198 334 231 340 213 346 193 357 169 371 189 407 166 427 220 440 198 446 200 453 211 467 254 473 252 480 273 493 286 501 298 505 308 516 339 522 340 539 313 551 282 564 285 575 289 586 288 593 270 599 265 603 274 614 297 636 250 648 220 648 350}
    {50 277 53 268 56 278 61 273 70 261 82 243 87 232 89 225 92 224 101 252 107 231 111 195 119 218 123 233 127 233 130 237 152 206 160 203 172 205 176 209 185 182 195 217 205 225 223 218 234 196 245 179 251 143 261 88 263 89 269 121 273 138 281 161 286 186 289 191 304 212 313 237 323 235 326 230 338 203 347 194 355 169 361 156 366 177 377 187 384 167 391 122 396 137 400 153 408 155 415 181 423 195 450 211 452 212 460 192 481 152 486 153 494 162 504 210 520 250 536 282 544 301 571 317 605 335 616 326 628 335 662 317 687 301 687 350}
    {50 285 67 278 80 290 161 339 245 290 257 278 271 285 283 282 295 313 312 340 318 339 329 308 333 298 341 286 354 273 362 252 368 254 382 211 389 200 395 198 405 220 425 166 460 189 475 169 486 193 492 213 497 231 502 198 512 177 546 114 575 79 589 68 628 156 638 154 654 123 654 350}
 }
 
 array set DEMO {dir r idx 0 length 10 length,show 10}
 
 namespace eval ::Ribbon {}
 
 ##+##########################################################################
 # 
 # ::Ribbon::Draw -- Creates 3d affect for a line graph
 #
 # Works in screen coordinates and shifts each point back dx,dy
 #
 # Tough issue:
 #  Bad news when the graph more steeply than our perspective line then
 #  two offset segments will need to get clipped to the graph.
 #  This can happen both to the left and to the right
 #    1. the upward segment shouldn't be drawn (it's "inside")
 #    2. incoming segment will have one corner drawn too far
 #
 # Three pass algorithm:
 #    1. each point w/ 2 sentinels into P; each 3d-offset point into Q
 #    3. detect offset points inside and move them
 #    4. draw all non-inside segments
 #
 proc ::Ribbon::Draw {w pxy dir length} {
    set dx 4
    set dy -10
 
    # Get vector to add to each point for 3d offset
    set dx [expr {$dx * ($dir eq "l" ? -1 : $dir eq "r" ? 1 : 0)}]
    set offsetXY [list $dx $dy]
    set scaler [expr {$length/hypot($dx,$dy)}]
 
    set CNT [expr {[llength $pxy] / 2}]
    unset -nocomplain P
    unset -nocomplain Q
 
    # 1st pass -- each point into P w/ 2 sentinels; each 3d-offset into Q
    for {set i -1} {$i <= $CNT} {incr i} {
        set P($i) [lrange $pxy [expr {2*$i}] [expr {2*$i + 1}]]
        if {$i == -1}   { set P(-1)   [::Ribbon::VAdd [lrange $pxy 0 1] {0 -100}] }
        if {$i == $CNT} { set P($CNT) [::Ribbon::VAdd [lrange $pxy end-1 end] {0 100}] }
        set Q($i) [::Ribbon::VAdd $P($i) $offsetXY $scaler]
    }
 
    # 2nd pass fixes up any offset point which are "inside" 
    for {set i0 -1; set i 0; set i1 1} {$i < $CNT} {incr i0; incr i; incr i1} {
        set alpha [::Ribbon::GetAngle $P($i) $Q($i)]  ;# Perspective line angle
        set beta  [::Ribbon::GetAngle $P($i) $P($i1)] ;# Segment right angle
        set gamma [::Ribbon::GetAngle $P($i) $P($i0)] ;# Segment left angle
        set P($i,beta) $beta                    ;# Keep for color info
 
        set Q($i,badR) [expr {$alpha >= $beta}] ;# Clockwise from beta
        set Q($i,badL) [expr {$alpha <= $gamma}];# Anti-clockwise from gamma
 
        if {$Q($i,badR)} {                      ;# Clip left seg to right line
            catch {set Q($i) [::Ribbon::Intersect $Q($i) $Q($i0) $P($i) $P($i1)]}
        }
        if {$Q($i,badL)} {                      ;# Clip right seg to left line
            catch {set Q($i) [::Ribbon::Intersect $Q($i) $Q($i1) $P($i) $P($i0)]}
        }
    }
 
    # Now draw each segment--unless a corner is bad
    for {set i 0; set i1 1} {$i < $CNT-1} {incr i; incr i1} {
        if {$Q($i,badR) || $Q($i1,badL)} continue
        set xy [concat $P($i) $Q($i) $Q($i1) $P($i1)]
        set clr gray[expr {99-round(abs($P($i,beta) - 360))}]
        
        $w create poly $xy -fill $clr -outline black;#-tag [list r$i ribbon]
    }
 }
 
 ##+##########################################################################
 # 
 # ::Ribbon::GetAngle -- returns clockwise angle a line makes with the x axis
 # BUT in 90-450 range
 # 
 proc ::Ribbon::GetAngle {p0 p1} {
    foreach {x0 y0} $p0 {x1 y1} $p1 break
    set dx [expr {$x1 - $x0}]
    set dy [expr {$y1 - $y0}]
    set a [expr {atan2($dy,$dx)*180/acos(-1)}]
    while {$a <= 90} { set a [expr {$a + 360}] }
    return $a
 }
 
 proc ::Ribbon::VAdd {v1 v2 {scaler 1}} {
    foreach {x1 y1} $v1 {x2 y2} $v2 break
    return [list [expr {$x1 + $scaler*$x2}] [expr {$y1 + $scaler*$y2}]]
 }
 proc ::Ribbon::VSub {v1 v2} { return [::Ribbon::VAdd $v1 $v2 -1] }
 ##+##########################################################################
 #
 # ::Ribbon::Intersect -- find two line intersection given two points on each line
 #
 proc ::Ribbon::Intersect {p1 p2 p3 p4} {
    return [::Ribbon::IntersectV $p1 [VSub $p2 $p1] $p3 [VSub $p4 $p3]]
 }
 ##+##########################################################################
 #
 # ::Ribbon::IntersectV -- find where 2 point/vector intersect
 #
 # p1+K(v1) = p3+J(v3)
 # convert into and solve matrix equation (a b / c d) ( K / J) = ( e / f )
 #
 proc ::Ribbon::IntersectV {p1 v1 p3 v3} {
    foreach {x1 y1} $p1 {vx1 vy1} $v1 {x3 y3} $p3 {vx3 vy3} $v3 break
 
    set a $vx1
    set b [expr {-1 * $vx3}]
    set c $vy1
    set d [expr {-1 * $vy3}]
    set e [expr {$x3 - $x1}]
    set f [expr {$y3 - $y1}]
 
    set det [expr {double($a*$d - $b*$c)}]
    if {$det == 0} {error "Determinant is 0"}
 
    set k [expr {($d*$e - $b*$f) / $det}]
    #set j [expr {($a*$f - $c*$e) / $det}]
    return [::Ribbon::VAdd $p1 $v1 $k]
 }
 
 ################################################################
 #
 # DEMO CODE BELOW
 #
 proc DoDisplay {} {
    wm title . "Ribbon Graph Demo"
    bind all <F2> {console show}
    frame .bottom
    pack .bottom -fill x -side bottom -pady 10
    canvas .c -bd 2 -relief ridge -width 760 -height 380
    pack .c -side top
 
    ::ttk::labelframe  .fdir   -text "3D Direction"
    ::ttk::radiobutton .right  -text Right  -variable  ::DEMO(dir) -value r
    ::ttk::radiobutton .center -text Center -variable  ::DEMO(dir) -value c
    ::ttk::radiobutton .left   -text Left   -variable  ::DEMO(dir) -value l
    pack .right .center .left -in .fdir -side top -anchor w
 
    ::ttk::labelframe .flength -text "3D Length"
    ::ttk::label .llength -textvariable ::DEMO(length,show)
    ::ttk::scale .length  -variable ::DEMO(length) -from 0 -to 50
    pack .length  -in .flength -fill x -side bottom -pady {0 10}
    pack .llength -in .flength -side left
 
    ::ttk::labelframe .findex -text "Which Sample"
    set values {}
    for {set i 0} {$i < [llength $::samples]} {incr i} { lappend values $i}
    ::ttk::combobox .index -textvariable ::DEMO(idx) -state readonly \
        -values $values -width 5 -justify center \
        -exportselection 0 -takefocus 0

        #error?
        #-selectbackground white -selectborderwidth 0

    pack .index -in .findex -expand 1
    grid .fdir .flength .findex -in .bottom -sticky news -padx 20
    grid columnconfigure .bottom {0 1 2} -weight 0 -uniform a
    
    trace variable ::DEMO w Tracer
 }
 proc Tracer {var1 var2 op} {
    set ::DEMO(length,show) [expr {round($::DEMO(length))}]
    DrawGraph
 }
 proc DrawGraph {} {
    global DEMO
    
    set pxy [lindex $::samples $DEMO(idx)]
 
    .c delete all
    .c create line 700 350 50 350 50 25         ;# Axis
    set clr [expr {($DEMO(idx) & 1) ? "darkblue" : "seagreen"}]
    .c create poly [concat $pxy 50 350] -fill $clr -outline black
    ::Ribbon::Draw .c $pxy $DEMO(dir) $DEMO(length)
 }
 
 DoDisplay
 DrawGraph
 return

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References