Various minor fixes.

[rocl] / elite-prices

#! /usr/bin/tclsh
#
# $Id: elite-prices,v 1.5 2003/03/09 23:45:02 mdw Exp $

package require "elite" "1.0.1"

set i 0
set allreps {}
foreach-world $galaxy1 p {
  set e $eco($p(economy))
  set s $p(seed)
  if {[info exists rep($e)]} { continue }
  set rep($e) $s
  lappend allreps $s
  incr i
  if {$i == 8} { break }
}
set rep(avg) ""
unset p

set from $rep(poor-agri)
set to   $rep(rich-ind)

proc loavghi {l} {
  set lo 10000
  set hi -10000
  set tot 0
  set n 0
  foreach x $l {
    incr tot $x
    incr n
    if {$x < $lo} { set lo $x }
    if {$x > $hi} { set hi $x }
  }
  return [list $lo [expr {$tot/double($n)}] $hi]
}

proc get-world {p} {
  global rep g argv0
  if {[info exists rep($p)]} { return $rep($p) }
  set s [parse-planet-spec $g $p]
  if {[string equal $s ""]} {
    puts stderr "$argv0: bad planet spec `$p'"
    exit 1
  }
  return $s
}

proc get-prices {ss arr} {
  global products allreps
  upvar \#0 $arr a
  foreach {t p} $products { set l($t) {} }
  foreach s [if {[string equal $ss ""]} { set allreps } { set ss }] {
    if {![string equal $s ""]} {
      for {set i 0} {$i < 256} {incr i} {
	elite-market m $s $i
	foreach {t p} $products { lappend l($t) [lindex $m($t) 0] }
      }
    }
  }
  foreach {t p} $products {
    set a($t) [loavghi $l($t)]
  }
}  

set g $galaxy1
set sortcol 0
set usage "usage: $argv0 \[-g GALAXY\] \[-s SORT\] \[FROM TO\]"
for {set i 0} {$i < [llength $argv]} {incr i} {
  switch -glob -- [lindex $argv $i] {
    "-g" {
      incr i
      set a [lindex $argv $i]
      set g [parse-galaxy-spec $a]
      if {[string equal $g ""]} {
	puts stderr "$argv0: bad galaxy string `$a'"
	exit 1
      }
      destructure {. g} $g
    }
    "-s" {
      incr i
      set a [lindex $argv $i]
      switch -- $a {
	"min" - "minimum" { set sortcol 1 }
	"avg" - "average" { set sortcol 2 }
	"max" - "maximum" { set sortcol 3 }
	default {
	  puts stderr "$argv0: unknown sort type: `$a' (must be `min', `max' or `avg'"
	  exit 1
	}
      }
    }
    "--" {
      incr i
      break
    }
    "-*" {
      puts stderr $usage
      exit 1
    }
    default {
      break
    }
  }
}

set argv [lrange $argv $i end]
switch -exact -- [llength $argv] {
  0 { }
  1 {
    set w [get-world [lindex $argv 0]]
    get-prices $w pp
    foreach {t p} $products {
      destructure {min avg max} $pp($t)
      puts [format "%-12s %5.1f %5.1f %5.1f" $t \
	  [expr {$min/10.0}] [expr {$avg/10.0}] [expr {$max/10.0}]]
    }
    exit
  }
  2 {
    destructure {f t} $argv
    set from [get-world $f]
    set to [get-world $t]
    foreach {p s} [list $f $from $t $to] {
      if {[string equal $s ""]} {
	puts stderr "$argv0: bad planet spec `$p'"
	exit 1
      }
    }
  }
  default {
    puts stderr $usage
    exit 1
  }
}

get-prices $from fp
get-prices $to tp
set pp {}
foreach {t p} $products {
  destructure {flo favg fhi} $fp($t)
  destructure {tlo tavg thi} $tp($t)
  lappend pp [list $t \
      [expr {$tlo - $fhi}] \
      [expr {int($tavg - $favg)}] \
      [expr {$thi - $flo}]]
}

if {$sortcol} {
  set pp [lsort -index $sortcol -real -decreasing $pp]
}
foreach i $pp {
  destructure {t min avg max} $i
  puts [format "%-12s %6.1f %5.1f %5.1f" $t \
      [expr {$min/10.0}] [expr {$avg/10.0}] [expr {$max/10.0}]]
}