Move adjacency map stuff to C for performance reasons. Allow `PLANET/N'

[rocl] / elite-prices

#! /usr/bin/tclsh
#
# $Id: elite-prices,v 1.4 2003/03/07 00:41:46 mdw Exp $

package require "elite" "1.0.1"

foreach-world $galaxy1 p {
  set econame $eco($p(economy))
  if {[info exists rep($econame)]} { continue }
  set rep($econame) $p(seed)
}
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 check-profits {from to} {
  global products
  set np [expr {[llength $products]/2}]
  puts -nonewline stderr "Thinking: \[[string repeat { } 32]\] "
  puts -nonewline stderr "\[[string repeat { } $np]\] "
  puts -nonewline stderr "\rThinking: \["
  flush stderr
  foreach {a s} [list l $from e $to] {
    for {set f 0} {$f < 256} {incr f} {
      elite-market m $s $f
      foreach {t p} $products { destructure [list ${a}($f:$t) .] $m($t) }
      if {($f & 15) == 15} { puts -nonewline stderr "."; flush stderr }
    }
  }
  puts -nonewline stderr "\] \["
  flush stderr
  set r {}
  foreach {t p} $products {
    set ll {}
    set ee {}
    for {set f 0} {$f < 256} {incr f} {
      lappend ll $l($f:$t)
      lappend ee $e($f:$t)
    }
    destructure {llo lavg lhi} [loavghi $ll]
    destructure {elo eavg ehi} [loavghi $ee]
    lappend r [list $t \
	[expr {$elo - $lhi}] \
	[expr {int($eavg - $lavg)}] \
	[expr {$ehi - $llo}]]
    puts -nonewline stderr "."; flush stderr
  }
  puts stderr "\] done"
  return $r
}

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 { }
  2 {
    destructure {fp tp} $argv
    set from [get-world $fp]
    set to [get-world $tp]
    foreach {p s} [list $fp $from $tp $to] {
      if {[string equal $s ""]} {
	puts stderr "$argv0: bad planet spec `$p'"
	exit 1
      }
    }
  }
  default {
    puts stderr $usage
    exit 1
  }
}

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