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