File: tk-geo.tcl

package info (click to toggle)
nsf 2.4.0-1
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 13,208 kB
  • sloc: ansic: 32,687; tcl: 10,723; sh: 660; pascal: 176; javascript: 135; lisp: 41; makefile: 24
file content (158 lines) | stat: -rw-r--r-- 4,682 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
# Drawing geometric figures - the result of airplane travel. 
#
# The example script shows the use of canvas and geometric figues
# (regular, convex polygons) with different number of edges based on
# trigonometric functions.
#
# -gustaf neumann    (Aug 2, 2013)
#
# image::tk-geo1.png[width=400]
# image::tk-geo2.png[width=400]
#

package require Tk
package require nx

#
# Class Canvas is a simple convenience wrapper for the tk canvas,
# which packs itself.
#
nx::Class create Canvas {
  :property {canvas .canvas}
  :property {bg beige}
  :property {height 500}
  :property {width 500}

  :method init {} {
    canvas ${:canvas} -bg ${:bg} -height ${:height} -width ${:width}
    pack ${:canvas}
  }
}

#
# Class Area provides a center point (x, y) and a radius
#
nx::Class create Area {
  :property {canvas .canvas}
  :property {x 250}
  :property {y 250}
  :property {radius 200}

  :variable pi [expr {acos(-1)}]

  :method degree {d} {
    #
    # return a coordinate pair on a circle around the center point with
    # :radius at the provided degrees (0..360)
    #
    set x  [expr {$d*${:pi}/180.0 - ${:pi}/2.0}]
    set x0 [expr {cos($x)*${:radius}+${:x}}]
    set y0 [expr {sin($x)*${:radius}+${:y}}]
    list $x0 $y0
  }

  :method n-tangle {n} {
    #
    # Draw a regular n-tangle (e.g. when n==3, a triangle) inscribed to
    # a circle with radius :radius
    #
    for {set i 0} {$i < $n} {incr i} {
      set p($i) [:degree [expr {$i*360/$n}]]
    }
    lassign $p(0) x0 y0
    for {set i 1} {$i < $n} {incr i} {
      lassign $p($i) x1 y1
      ${:canvas} create line $x0 $y0 $x1 $y1
      lassign $p($i) x0 y0
    }
    lassign $p(0) x1 y1
    ${:canvas} create line $x0 $y0 $x1 $y1
  }
}

#
# Class Inscribe draws multiple n-tangles with the came center point.
#
nx::Class create Inscribe -superclass Area {
  :property {count 4}
  :property {edges 3}
  :method init {} {
    for {set i 0} {$i < ${:count}} {incr i} {
      ${:canvas} create oval \
	  [expr {${:x}-${:radius}}] [expr {${:y}-${:radius}}] \
	  [expr {${:x}+${:radius}}] [expr {${:y}+${:radius}}]
      :n-tangle ${:edges}
      set :radius [expr {${:radius}/2.0}]
    }
  }
}

#
# Class Hull creates an n-tangle with :density hull lines between
# neighboring edges
#
nx::Class create Hull -superclass Area {
  :property {edges 3}
  :property {density 10}

  :method n-tangle {n} {
    for {set i 0} {$i < $n} {incr i} {
      set p($i) [:degree [expr {$i*360/$n}]]
    }
    lassign $p(0) x0 y0
    for {set i 1} {$i < $n} {incr i} {
      lassign $p($i) x1 y1
      set line($i) [list $x0 $y0 $x1 $y1]
      ${:canvas} create line $x0 $y0 $x1 $y1
      lassign $p($i) x0 y0
    }
    lassign $p(0) x1 y1
    ${:canvas} create line $x0 $y0 $x1 $y1
    set line(0) [list $x0 $y0 $x1 $y1]
    set line($n) [list $x0 $y0 $x1 $y1]

    for {set i 0} {$i < $n} {incr i} {
      lassign $line($i) x0 y0 x1 y1
      lassign $line([expr {$i+1}]) x2 y2 x3 y3
      set dx1 [expr {($x0 - $x1)*1.0/${:density}}]
      set dy1 [expr {($y0 - $y1)*1.0/${:density}}]
      set dx2 [expr {($x2 - $x3)*1.0/${:density}}]
      set dy2 [expr {($y2 - $y3)*1.0/${:density}}]
      for {set j 1} {$j < ${:density}} {incr j} {
	${:canvas} create line [expr {$x0-$dx1*$j}] [expr {$y0-$dy1*$j}] \
	    [expr {$x2-$dx2*$j}] [expr {$y2-$dy2*$j}]
      }
    }
  }
    
  :method init {} {
    :n-tangle ${:edges}
  }
}


# Draw either one larger figure with inner figures
# or a series of smaller figures next to each other.

set multiple 0

if {$multiple} {
  # Draw a series of figures next to each other
  set c [::Canvas new -width 650 -height 750 -bg white]
  ::Inscribe new -canvas [$c cget -canvas] -x 100 -y 100 -radius 80 -count 7
  ::Inscribe new -canvas [$c cget -canvas] -x 300 -y 100 -radius 80 -count 7 -edges 4
  ::Inscribe new -canvas [$c cget -canvas] -x 500 -y 100 -radius 80 -count 7 -edges 5
  ::Hull new -canvas [$c cget -canvas] -x 100 -y 300 -radius 80 -edges 3 -density 10
  ::Hull new -canvas [$c cget -canvas] -x 300 -y 300 -radius 80 -edges 4 -density 10
  ::Hull new -canvas [$c cget -canvas] -x 500 -y 300 -radius 80 -edges 5 -density 10
  ::Hull new -canvas [$c cget -canvas] -x 300 -y 600 -radius 200 -edges 3 -density 40
} else {
  # Draw a several series of figures with the same center
  set c [::Canvas new -width 650 -height 650 -bg white]
  ::Hull new -canvas [$c cget -canvas] -x 300 -y 320 -radius 300 -edges 5 -density 40
  ::Hull new -canvas [$c cget -canvas] -x 300 -y 320 -radius 150 -edges 4 -density 20
  ::Hull new -canvas [$c cget -canvas] -x 300 -y 320 -radius 75 -edges 3 -density 10
  ::Hull new -canvas [$c cget -canvas] -x 300 -y 320 -radius 30 -edges 5 -density 5
}