chiark / gitweb /
Print seed -- it's useful.
[rocl] / elite-prices
CommitLineData
1304202a 1#! /usr/bin/tclsh
b130b8f5 2#
43c77c8f 3# $Id: elite-prices,v 1.5 2003/03/09 23:45:02 mdw Exp $
1304202a 4
161e6ada 5package require "elite" "1.0.1"
1304202a 6
43c77c8f 7set i 0
8set allreps {}
5f2423a4 9foreach-world $galaxy1 p {
43c77c8f 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 }
5f2423a4 17}
43c77c8f 18set rep(avg) ""
5f2423a4 19unset p
20
21set from $rep(poor-agri)
22set to $rep(rich-ind)
23
24proc 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
38proc 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
1304202a 45 }
5f2423a4 46 return $s
1304202a 47}
5f2423a4 48
43c77c8f 49proc 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 }
5f2423a4 59 }
1304202a 60 }
5f2423a4 61 foreach {t p} $products {
43c77c8f 62 set a($t) [loavghi $l($t)]
1304202a 63 }
43c77c8f 64}
1304202a 65
5f2423a4 66set g $galaxy1
67set sortcol 0
68set usage "usage: $argv0 \[-g GALAXY\] \[-s SORT\] \[FROM TO\]"
69for {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
108set argv [lrange $argv $i end]
109switch -exact -- [llength $argv] {
110 0 { }
43c77c8f 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 }
5f2423a4 121 2 {
43c77c8f 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] {
5f2423a4 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
43c77c8f 138get-prices $from fp
139get-prices $to tp
140set pp {}
141foreach {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
5f2423a4 150if {$sortcol} {
151 set pp [lsort -index $sortcol -real -decreasing $pp]
152}
153foreach i $pp {
154 destructure {t min avg max} $i
43c77c8f 155 puts [format "%-12s %6.1f %5.1f %5.1f" $t \
5f2423a4 156 [expr {$min/10.0}] [expr {$avg/10.0}] [expr {$max/10.0}]]
1304202a 157}