1304202a |
1 | #! /usr/bin/tclsh |
b130b8f5 |
2 | # |
5f2423a4 |
3 | # $Id: elite-prices,v 1.3 2003/02/26 00:03:08 mdw Exp $ |
1304202a |
4 | |
5 | package require "elite" "1.0.0" |
6 | |
5f2423a4 |
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 |
1304202a |
38 | } |
5f2423a4 |
39 | return $s |
1304202a |
40 | } |
5f2423a4 |
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 | } |
1304202a |
55 | } |
5f2423a4 |
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 |
1304202a |
73 | } |
5f2423a4 |
74 | puts stderr "\] done" |
75 | return $r |
1304202a |
76 | } |
1304202a |
77 | |
5f2423a4 |
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}]] |
1304202a |
148 | } |