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

   1 #! /usr/bin/tclsh
   2 #
   3 # $Id: elite-pairs,v 1.3 2003/02/26 00:02:51 mdw Exp $
   4
   5 package require "elite" "1.0.0"
   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 {[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 puts -nonewline stderr "\[computing adjacency table..."
  77 flush stderr
  78 set ww [worldinfo $g]
  79 adjacency $ww adj $d
  80 puts stderr " done\]"
  81 unset a
  82 foreach {s x y} $ww {
  83   if {![ok $s {} $aexpr]} { continue }
  84   elite-worldinfo a $s
  85   set l {}
  86   foreach {ss xx yy} $adj($s) {
  87     set d [world-distance $x $y $xx $yy]
  88     if {[ok $ss {a d} $bexpr]} {
  89       set d [expr {[world-distance $x $y $xx $yy]/10.0}]
  90       if {$v} {
  91         puts [format "%s (%.1f LY)" [world-summary $s] $d]
  92         puts [world-summary $ss]
  93         puts ""
  94       } else {
  95         puts [format "%-11s %-11s (%.1f LY)" $a(name) [worldname $ss] $d]
  96       }
  97     }
  98   }
  99 }