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