chiark / gitweb /
Prevent unneceessary recomputation of adjacency maps.
[rocl] / elite-pairs
CommitLineData
1304202a 1#! /usr/bin/tclsh
b130b8f5 2#
3# $Id: elite-pairs,v 1.2 2003/02/25 00:25:38 mdw Exp $
1304202a 4
5package require "elite" "1.0.0"
6
7proc ok {s vv expr} {
8 global argv0
9 set ip [interp create]
10 foreach v $vv {
11 upvar 1 $v var
12 if {[array exists var]} {
13 foreach {k d} [array get var] {
14 $ip eval [list set ${v}($k) $d]
15 }
16 } else {
17 $ip eval [list set $v $var]
18 }
19 }
20 elite-worldinfo p $s
21 foreach {k v} [array get p] {
22 $ip eval [list set $k $v]
23 }
24 if {[catch { $ip eval [list expr $expr] } rc]} {
25 puts stderr "$argv0: error in expression: $rc"
26 exit 1
27 }
28 interp delete $ip
29 return $rc
30}
31
32set g $galaxy1
33set d 70
34for {set i 0} {$i < [llength $argv]} {incr i} {
35 set a [lindex $argv $i]
36 switch -glob -- $a {
37 "-g" {
38 incr i
39 set a [lindex $argv $i]
40 set g [parse-galaxy-spec $a]
41 if {[string equal $g ""]} {
42 puts stderr "$argv0: bad galaxy string `$a'"
43 exit 1
44 }
45 destructure {. g} $g
46 }
47 "-d" {
48 incr i
49 set d [expr {[lindex $argv $i] * 10}]
50 }
51 "--" {
52 incr i
53 break
54 }
55 "-*" {
56 puts stderr "usage: $argv0 \[-g GALAXY\] \[-d DIST\] AEXPR BEXPR"
57 exit 1
58 }
59 default {
60 break
61 }
62 }
63}
64if {$i != [llength $argv] - 2} {
65 puts stderr "usage: $argv0 \[-g GALAXY\] \[-d DIST\] AEXPR BEXPR"
66 exit 1
67}
68destructure {aexpr bexpr} [lrange $argv $i end]
69puts -nonewline stderr "\[computing adjacency table..."
70flush stderr
71set ww [worldinfo $g]
72adjacency $ww adj $d
73puts stderr " done\]"
74unset a
75foreach {s x y} $ww {
76 if {![ok $s {} $aexpr]} { continue }
77 elite-worldinfo a $s
78 set l {}
79 foreach {ss xx yy} $adj($s) {
80 set d [world-distance $x $y $xx $yy]
81 if {[ok $ss {a d} $bexpr]} {
82 puts [format "%-11s %-11s (%.1f LY)" $a(name) [worldname $ss] \
83 [expr {[world-distance $x $y $xx $yy]/10.0}]]
84 }
85 }
86}