| 1 | #! /usr/bin/tclsh |
| 2 | # |
| 3 | # $Id$ |
| 4 | |
| 5 | package require "elite" "1.0.1" |
| 6 | package require "vector" "1.0.0" |
| 7 | package require "graph" "1.0.0" |
| 8 | |
| 9 | set gg {1 2 3 4 5 6 7 8} |
| 10 | set maxdist 100 |
| 11 | set minratio 10 |
| 12 | |
| 13 | for {set i 0} {$i < [llength $argv]} {incr i} { |
| 14 | set a [lindex $argv $i] |
| 15 | switch -glob -- $a { |
| 16 | "-maxdist" { |
| 17 | incr i |
| 18 | set maxdist [expr {int([lindex $argv $i] * 10)}] |
| 19 | } |
| 20 | "-minratio" { |
| 21 | incr i |
| 22 | set minratio [lindex $argv $i] |
| 23 | } |
| 24 | "--" { |
| 25 | incr i |
| 26 | break |
| 27 | } |
| 28 | "-*" { |
| 29 | puts stderr "usage: $argv0 \[-maxdist DIST\] \[-minratio RATIO\] \[GALAXY\] ..." |
| 30 | exit 1 |
| 31 | } |
| 32 | default { |
| 33 | break |
| 34 | } |
| 35 | } |
| 36 | } |
| 37 | |
| 38 | if {[llength $argv] > $i} { |
| 39 | set gg [lrange $argv $i end] |
| 40 | } |
| 41 | |
| 42 | foreach g $gg { |
| 43 | destructure {. gs} [parse-galaxy-spec $g] |
| 44 | set l [elite-galaxylist $gs] |
| 45 | set i 0 |
| 46 | foreach {w x y} $l { |
| 47 | set index($w) $i |
| 48 | incr i |
| 49 | } |
| 50 | elite-adjacency a $l |
| 51 | set v [vector {256 256} -1] |
| 52 | foreach {w x y} $l { |
| 53 | set i $index($w) |
| 54 | foreach {ww xx yy} $a($w) { |
| 55 | set j $index($ww) |
| 56 | $v set $i $j [elite-distance $x $y $xx $yy] |
| 57 | } |
| 58 | $v set $i $i 0 |
| 59 | } |
| 60 | destructure {lv pv} [graph-shortest-path $v] |
| 61 | |
| 62 | elite-adjacency b $l $maxdist |
| 63 | foreach {w x y} $l { |
| 64 | set i $index($w) |
| 65 | foreach {ww xx yy} $b($w) { |
| 66 | set d [elite-distance $x $y $xx $yy] |
| 67 | if {$d <= 70 || [string compare $w $ww] > 0} { continue } |
| 68 | set j $index($ww) |
| 69 | set dd [$lv get $i $j] |
| 70 | set r [expr {$dd/"$d.0"}] |
| 71 | if {$r >= $minratio} { |
| 72 | puts [format "%14s %s -> %s %4.1f %5.1f (%4.1f)" \ |
| 73 | $g [world-brief $w] [world-brief $ww] \ |
| 74 | [expr {$d/10.0}] [expr {$dd/10.0}] $r] |
| 75 | } |
| 76 | } |
| 77 | } |
| 78 | $v destroy |
| 79 | $lv destroy |
| 80 | $pv destroy |
| 81 | } |