1## -*- tcl -*- 2## (C) 2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> 3## BSD Licensed 4# # ## ### ##### ######## ############# ###################### 5 6# 7# diagram points. 8# 9# Type validation and implementation of the various operations on 10# points and lines. The low-level commands for this come from 11# math::geometry. The operations here additionally (un)box from/to 12# tagged values. They also handle operations mixing polar and 13# cartesian specifications. 14# 15 16## 17# # ## ### ##### ######## ############# ###################### 18## Requisites 19 20package require Tcl 8.5 ; # Want the nice things it 21 # brings (dicts, {*}, etc.) 22package require math::geometry 1.1.2 ; # Vector math (points, line 23 # (segments), poly-lines). 24 25namespace eval ::diagram::point { 26 namespace export is isa validate absolute at delta by unbox + - | resolve 27 namespace ensemble create 28} 29 30# # ## ### ##### ######## ############# ###################### 31## Implementation 32# # ## ### ##### ######## ############# ###################### 33## Public API :: validation 34 35proc ::diagram::point::validate {value} { 36 if {[is $value]} {return $value} 37 return -code error "Expected diagram::point, got \"$value\"" 38} 39 40proc ::diagram::point::absolute {value} { 41 if {[isa $value]} {return $value} 42 return -code error "Expected absolute diagram::point, got \"$value\"" 43} 44 45proc ::diagram::point::is {value} { 46 return [expr {([llength $value] == 2) && 47 ([lindex $value 0] in {point + by})}] 48} 49 50proc ::diagram::point::isa {value} { 51 # note overlap with constructor 'at'. 52 return [expr {([llength $value] == 2) || 53 ([lindex $value 0] eq "point")}] 54} 55 56# # ## ### ##### ######## ############# ###################### 57## Public API :: Constructors 58 59# Absolute location 60proc ::diagram::point::at {x y} { 61 return [list point [list $x $y]] 62} 63 64# Relative location, cartesian 65proc ::diagram::point::delta {dx dy} { 66 return [list + [list $dx $dy]] 67} 68 69# Relative location, polar 70proc ::diagram::point::by {distance angle} { 71 return [list by [list $distance $angle]] 72} 73 74# # ## ### ##### ######## ############# ###################### 75 76proc ::diagram::point::unbox {p} { 77 return [lindex $p 1] 78} 79 80# # ## ### ##### ######## ############# ###################### 81## Public API :: Point arithmetic 82 83proc ::diagram::point::+ {a b} { 84 set a [2cartesian [validate $a]] 85 set b [2cartesian [validate $b]] 86 87 # Unboxing 88 89 lassign $a atag adetail 90 lassign $b btag bdetail 91 92 # Calculation and result type determination 93 94 set result [geo::+ $adetail $bdetail] 95 set rtype [expr {(($atag eq "point") || ($btag eq "point")) 96 ? "at" 97 : "delta"}] 98 99 return [$rtype {*}$result] 100} 101 102proc ::diagram::point::- {a b} { 103 set a [2cartesian [validate $a]] 104 set b [2cartesian [validate $b]] 105 106 # Unboxing 107 108 lassign $a atag adetail 109 lassign $b btag bdetail 110 111 # Calculation and result type determination 112 113 set result [geo::- $adetail $bdetail] 114 set rtype [expr {(($atag eq "point") || ($btag eq "point")) 115 ? "at" 116 : "delta"}] 117 118 return [$rtype {*}$result] 119} 120 121proc ::diagram::point::| {a b} { 122 set a [2cartesian [absolute $a]] 123 set b [2cartesian [absolute $b]] 124 125 # Unboxing 126 127 lassign $a atag adetail ; lassign $adetail ax ay 128 lassign $b btag bdetail ; lassign $bdetail bx by 129 130 # Calculation of the projection. 131 return [at $ax $by] 132} 133 134# # ## ### ##### ######## ############# ###################### 135 136proc ::diagram::point::resolve {base p} { 137 #puts P|resolve|$base|$p| 138 139 # The base is an untagged point, p is a tagged point or delta. 140 lassign $p tag detail 141 142 # A point is returned unchanged. 143 if {$tag eq "point"} { return [unbox $p] } 144 145 # A delta is normalized, then added to the base. 146 147 #puts R|$base|$p| 148 #puts R|[2cartesian $p]| 149 #puts R|[unbox [2cartesian $p]]| 150 151 return [geo::+ $base [unbox [2cartesian $p]]] 152} 153 154# # ## ### ##### ######## ############# ###################### 155 156# Normalize point/delta information to cartesian 157# coordinates. Input and output are both tagged, and points not 158# using a polar representation are not modified. 159 160proc ::diagram::point::2cartesian {p} { 161 lassign $p tag details 162 if {$tag ne "by"} { return $p } 163 return [delta {*}[polar2cartesian $details]] 164} 165 166# Conversion of a delta from polar to cartesian coordinates, 167# operating on untagged data. 168 169proc ::diagram::point::polar2cartesian {polar} { 170 lassign $polar distance angle 171 return [geo::s* $distance [geo::direction $angle]] 172} 173 174## 175# # ## ### ##### ######## ############# ###################### 176 177# # ## ### ##### ######## ############# ###################### 178## Ready 179 180namespace eval ::diagram::point::geo { 181 namespace import ::math::geometry::* 182} 183 184package provide diagram::point 1 185