chiark / gitweb /
Print seed -- it's useful.
[rocl] / elite-pairs
1 #! /usr/bin/tclsh
2 #
3 # $Id: elite-pairs,v 1.4 2003/03/07 00:41:46 mdw Exp $
4
5 package require "elite" "1.0.1"
6
7 proc 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
32 set g $galaxy1
33 set d 70
34 set v 0
35 for {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
50       set d [expr {int([lindex $argv $i] * 10)}]
51     }
52     "-v" {
53       incr v
54     }
55     "-q" {
56       incr v -1
57     }
58     "--" {
59       incr i
60       break
61     }
62     "-*" {
63       puts stderr "usage: $argv0 \[-qv\] \[-g GALAXY\] \[-d DIST\] AEXPR BEXPR"
64       exit 1
65     }
66     default {
67       break
68     }    
69   }
70 }
71 if {$i != [llength $argv] - 2} {
72   puts stderr "usage: $argv0 \[-g GALAXY\] \[-d DIST\] AEXPR BEXPR"
73   exit 1
74 }
75 destructure {aexpr bexpr} [lrange $argv $i end]
76 set ww [elite-galaxylist $g]
77 elite-adjacency adj $ww $d
78 unset a
79 foreach {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) {
84     set d [elite-distance $x $y $xx $yy]
85     if {[ok $ss {a d} $bexpr]} {
86       set d [expr {[elite-distance $x $y $xx $yy]/10.0}]
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       }
94     }
95   }
96 }