summaryrefslogtreecommitdiffstats
path: root/ext/rtree/util/randomshape.tcl
blob: 98725bc9dc270a41d0ef36f2cc0500c1d1adbe35 (plain)
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
#!/usr/bin/tclsh
#
# This script generates a cluster of random polygons that are useful
# for testing the geopoly extension.
#
# Usage:
#
#    tclsh randomshape.tcl | tee x.sql | sqlite3 >x.html
#
# The output files are x.sql and x.html.  Run the above multiple times
# until an interesting "x.html" file is found, then use the "x.sql" inputs
# to construct test cases.
#
proc randomenclosure {cx cy p1 p2 p3 p4} {
  set r 0
  set pi 3.145926
  set pi2 [expr {$pi*2}]
  set x0 [expr {$cx + rand()*$p3 + $p4}]
  set ans "\[\[$x0,$cy\]"
  while {1} {
    set r [expr {$r+$p1+$p2*rand()}]
    if {$r>=$pi2} break
    set m [expr {rand()*$p3 + $p4}]
    set x [expr {$cx+$m*cos($r)}]
    set y [expr {$cy+$m*sin($r)}]
    append ans ",\[$x,$y\]"
  }
  append ans ",\[$x0,$cy\]\]"
  return $ans
}
proc randomshape1 {} {
  set cx [expr {100+int(rand()*800)}]
  set cy [expr {100+int(rand()*600)}]
  set p1 [expr {rand()*0.1}]
  set p2 [expr {rand()*0.5+0.5}]
  set p3 [expr {rand()*100+25}]
  set p4 [expr {rand()*25}]
  return [randomenclosure $cx $cy $p1 $p2 $p3 $p4]
}
proc randomshape1_sm {} {
  set cx [expr {100+int(rand()*800)}]
  set cy [expr {100+int(rand()*600)}]
  set p1 [expr {rand()*0.1}]
  set p2 [expr {rand()*0.5+0.5}]
  set p3 [expr {rand()*10+25}]
  set p4 [expr {rand()*5}]
  return [randomenclosure $cx $cy $p1 $p2 $p3 $p4]
}
proc randomshape2 {} {
  set cx [expr {400+int(rand()*200)}]
  set cy [expr {300+int(rand()*200)}]
  set p1 [expr {rand()*0.05}]
  set p2 [expr {rand()*0.5+0.5}]
  set p3 [expr {rand()*50+200}]
  set p4 [expr {rand()*50+100}]
  return [randomenclosure $cx $cy $p1 $p2 $p3 $p4]
}
proc randomcolor {} {
  set n [expr {int(rand()*5)}]
  return [lindex {red orange green blue purple} $n]
}

puts {.print '<html>'}
puts {.print '<svg width="1000" height="800" style="border:1px solid black">'}
puts {CREATE TABLE t1(poly,clr);}
puts {CREATE TABLE t2(poly,clr);}
for {set i 0} {$i<30} {incr i} {
  puts "INSERT INTO t1(rowid,poly,clr)"
  puts " VALUES($i,'[randomshape1]','[randomcolor]');"
}
for {set i 30} {$i<80} {incr i} {
  puts "INSERT INTO t1(rowid,poly,clr)"
  puts " VALUES($i,'[randomshape1_sm]','[randomcolor]');"
}
for {set i 100} {$i<105} {incr i} {
  puts "INSERT INTO t2(rowid,poly,clr)"
  puts " VALUES($i,'[randomshape2]','[randomcolor]');"
}

puts {DELETE FROM t1 WHERE geopoly_json(poly) IS NULL;}
puts {SELECT geopoly_svg(poly,
   printf('style="fill:none;stroke:%s;stroke-width:1;"',clr))
  FROM t1;}
puts {SELECT geopoly_svg(poly,
   printf('style="fill:none;stroke:%s;stroke-width:2;"',clr))
  FROM t2;}
puts {.print '<svg>'}