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

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