chiark - git - mdw - rocl/blob - elite-pairs

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