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

   1 #! /usr/bin/tclsh
   2 #
   3 # $Id: elite-prices,v 1.3 2003/02/26 00:03:08 mdw Exp $
   4
   5 package require "elite" "1.0.0"
   6
   7 foreach-world $galaxy1 p {
   8   set econame $eco($p(economy))
   9   if {[info exists rep($econame)]} { continue }
  10   set rep($econame) $p(seed)
  11 }
  12 unset p
  13
  14 set from $rep(poor-agri)
  15 set to   $rep(rich-ind)
  16
  17 proc loavghi {l} {
  18   set lo 10000
  19   set hi -10000
  20   set tot 0
  21   set n 0
  22   foreach x $l {
  23     incr tot $x
  24     incr n
  25     if {$x < $lo} { set lo $x }
  26     if {$x > $hi} { set hi $x }
  27   }
  28   return [list $lo [expr {$tot/double($n)}] $hi]
  29 }
  30
  31 proc get-world {p} {
  32   global rep g argv0
  33   if {[info exists rep($p)]} { return $rep($p) }
  34   set s [parse-planet-spec $g $p]
  35   if {[string equal $s ""]} {
  36     puts stderr "$argv0: bad planet spec `$p'"
  37     exit 1
  38   }
  39   return $s
  40 }
  41
  42 proc check-profits {from to} {
  43   global products
  44   set np [expr {[llength $products]/2}]
  45   puts -nonewline stderr "Thinking: \[[string repeat { } 32]\] "
  46   puts -nonewline stderr "\[[string repeat { } $np]\] "
  47   puts -nonewline stderr "\rThinking: \["
  48   flush stderr
  49   foreach {a s} [list l $from e $to] {
  50     for {set f 0} {$f < 256} {incr f} {
  51       elite-market m $s $f
  52       foreach {t p} $products { destructure [list ${a}($f:$t) .] $m($t) }
  53       if {($f & 15) == 15} { puts -nonewline stderr "."; flush stderr }
  54     }
  55   }
  56   puts -nonewline stderr "\] \["
  57   flush stderr
  58   set r {}
  59   foreach {t p} $products {
  60     set ll {}
  61     set ee {}
  62     for {set f 0} {$f < 256} {incr f} {
  63       lappend ll $l($f:$t)
  64       lappend ee $e($f:$t)
  65     }
  66     destructure {llo lavg lhi} [loavghi $ll]
  67     destructure {elo eavg ehi} [loavghi $ee]
  68     lappend r [list $t \
  69         [expr {$elo - $lhi}] \
  70         [expr {int($eavg - $lavg)}] \
  71         [expr {$ehi - $llo}]]
  72     puts -nonewline stderr "."; flush stderr
  73   }
  74   puts stderr "\] done"
  75   return $r
  76 }
  77
  78 set g $galaxy1
  79 set sortcol 0
  80 set usage "usage: $argv0 \[-g GALAXY\] \[-s SORT\] \[FROM TO\]"
  81 for {set i 0} {$i < [llength $argv]} {incr i} {
  82   switch -glob -- [lindex $argv $i] {
  83     "-g" {
  84       incr i
  85       set a [lindex $argv $i]
  86       set g [parse-galaxy-spec $a]
  87       if {[string equal $g ""]} {
  88         puts stderr "$argv0: bad galaxy string `$a'"
  89         exit 1
  90       }
  91       destructure {. g} $g
  92     }
  93     "-s" {
  94       incr i
  95       set a [lindex $argv $i]
  96       switch -- $a {
  97         "min" - "minimum" { set sortcol 1 }
  98         "avg" - "average" { set sortcol 2 }
  99         "max" - "maximum" { set sortcol 3 }
 100         default {
 101           puts stderr "$argv0: unknown sort type: `$a' (must be `min', `max' or `avg'"
 102           exit 1
 103         }
 104       }
 105     }
 106     "--" {
 107       incr i
 108       break
 109     }
 110     "-*" {
 111       puts stderr $usage
 112       exit 1
 113     }
 114     default {
 115       break
 116     }
 117   }
 118 }
 119
 120 set argv [lrange $argv $i end]
 121 switch -exact -- [llength $argv] {
 122   0 { }
 123   2 {
 124     destructure {fp tp} $argv
 125     set from [get-world $fp]
 126     set to [get-world $tp]
 127     foreach {p s} [list $fp $from $tp $to] {
 128       if {[string equal $s ""]} {
 129         puts stderr "$argv0: bad planet spec `$p'"
 130         exit 1
 131       }
 132     }
 133   }
 134   default {
 135     puts stderr $usage
 136     exit 1
 137   }
 138 }
 139
 140 set pp [check-profits $from $to]
 141 if {$sortcol} {
 142   set pp [lsort -index $sortcol -real -decreasing $pp]
 143 }
 144 foreach i $pp {
 145   destructure {t min avg max} $i
 146   puts [format "%-15s %6.1f %5.1f %5.1f" $t \
 147       [expr {$min/10.0}] [expr {$avg/10.0}] [expr {$max/10.0}]]
 148 }