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

   1 #! /usr/bin/tclsh
   2 #
   3 # $Id: elite-find,v 1.2 2003/02/25 00:25:38 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 for {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     "--" {
  48       incr i
  49       break
  50     }
  51     "-*" {
  52       puts stderr "usage: $argv0 \[-g GALAXY\] \[EXPR\]"
  53       exit 1
  54     }
  55     default {
  56       break
  57     }
  58   }
  59 }
  60
  61 set expr {}
  62 if {$i == [llength $argv] - 1} {
  63   set expr [lindex $argv $i]
  64 } elseif {$i != [llength $argv]} {
  65   puts stderr "usage: $argv0 \[-g GALAXY\] \[EXPR\]"
  66   exit 1
  67 }
  68 set ww [worldinfo $g]
  69 foreach {s x y} $ww {
  70   if {[string equal $expr ""] || [ok $s {} $expr]} {
  71     puts [world-summary $s]
  72   }
  73 }