| 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 | } |