chiark / gitweb /
And then screwed the code over...
[rocl] / elite-pairs
CommitLineData
1304202a 1#! /usr/bin/tclsh
b130b8f5 2#
161e6ada 3# $Id: elite-pairs,v 1.4 2003/03/07 00:41:46 mdw Exp $
1304202a 4
161e6ada 5package require "elite" "1.0.1"
1304202a 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
fef13875 34set v 0
1304202a 35for {set i 0} {$i < [llength $argv]} {incr i} {
36 set a [lindex $argv $i]
37 switch -glob -- $a {
38 "-g" {
39 incr i
40 set a [lindex $argv $i]
41 set g [parse-galaxy-spec $a]
42 if {[string equal $g ""]} {
43 puts stderr "$argv0: bad galaxy string `$a'"
44 exit 1
45 }
46 destructure {. g} $g
47 }
48 "-d" {
49 incr i
161e6ada 50 set d [expr {int([lindex $argv $i] * 10)}]
1304202a 51 }
fef13875 52 "-v" {
53 incr v
54 }
55 "-q" {
56 incr v -1
57 }
1304202a 58 "--" {
59 incr i
60 break
61 }
62 "-*" {
fef13875 63 puts stderr "usage: $argv0 \[-qv\] \[-g GALAXY\] \[-d DIST\] AEXPR BEXPR"
1304202a 64 exit 1
65 }
66 default {
67 break
68 }
69 }
70}
71if {$i != [llength $argv] - 2} {
72 puts stderr "usage: $argv0 \[-g GALAXY\] \[-d DIST\] AEXPR BEXPR"
73 exit 1
74}
75destructure {aexpr bexpr} [lrange $argv $i end]
161e6ada 76set ww [elite-galaxylist $g]
77elite-adjacency adj $ww $d
1304202a 78unset a
79foreach {s x y} $ww {
80 if {![ok $s {} $aexpr]} { continue }
81 elite-worldinfo a $s
82 set l {}
83 foreach {ss xx yy} $adj($s) {
161e6ada 84 set d [elite-distance $x $y $xx $yy]
1304202a 85 if {[ok $ss {a d} $bexpr]} {
161e6ada 86 set d [expr {[elite-distance $x $y $xx $yy]/10.0}]
fef13875 87 if {$v} {
88 puts [format "%s (%.1f LY)" [world-summary $s] $d]
89 puts [world-summary $ss]
90 puts ""
91 } else {
92 puts [format "%-11s %-11s (%.1f LY)" $a(name) [worldname $ss] $d]
93 }
1304202a 94 }
95 }
96}