chiark - git - mdw - rocl/blob - elite-map

   1 #! /usr/bin/tclsh
   2
   3 package require "elite" "1.0.0"
   4
   5 set syms "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
   6 proc symbol {i} {
   7   global syms
   8   if {$i < [string length $syms]} {
   9     return [string index $syms $i]
  10   }
  11   set hi [expr {$i / [string length $syms]}]
  12   set lo [expr {$i % [string length $syms]}]
  13   return [string index $syms $hi][string index $syms $lo]
  14 }
  15
  16 proc show-map {asp wx wy ww {n ""}} {
  17   set minx 10000
  18   set miny 10000
  19   set maxx 0
  20   set maxy 0
  21
  22   foreach {s x y} $ww {
  23     if {$x < $minx} { set minx $x}
  24     if {$y < $miny} { set miny $y}
  25     if {$x > $maxx} { set maxx $x}
  26     if {$y > $maxy} { set maxy $y}
  27   }
  28   set dx [expr {$maxx - $minx}]
  29   set dy [expr {$maxy - $miny}]
  30   if {$dx == 0} { set dx 1 }
  31   if {$dy == 0} { set dy 1 }
  32
  33   set sc [expr {$wx/double($dx)}]
  34   if {$dy * $sc/$asp > $wy} {
  35     set sc [expr {$wy * $asp/double($dy)}]
  36   }
  37   set gw {}
  38   foreach {s x y} $ww {
  39     set gx [expr {int(($x - $minx) * $sc + 0.5)}]
  40     set gy [expr {int(($y - $miny) * $sc/$asp + 0.5)}]
  41     lappend gw [list $s $gx $gy]
  42   }
  43
  44   set pw [lsort -index 1 -integer -increasing $gw]
  45   set pw [lsort -index 2 -integer -increasing $pw]
  46   set x 0
  47   set y 0
  48   set i 0
  49   set l {}
  50   foreach w $pw {
  51     destructure {s px py} $w
  52     if {$y < $py} {
  53       puts -nonewline [string repeat "\n" [expr {$py - $y}]]
  54       set x 0
  55       set y $py
  56     }
  57     if {$x < $px} {
  58       puts -nonewline [string repeat " " [expr {$px - $x}]]
  59       set x $px
  60     }
  61     if {[string equal $s $n]} {
  62       set sy "*"
  63     } else {
  64       set sy [symbol $i]
  65       incr i
  66     }
  67     puts -nonewline $sy
  68     incr x [string length $sy]
  69     lappend l $sy $s
  70   }
  71   puts -nonewline "\n"
  72   return $l
  73 }
  74
  75 proc show-key {l n} {
  76   global gov eco
  77   if {![string equal $n ""]} {
  78     elite-worldinfo p $n
  79   }
  80   foreach {sy s} $l {
  81     elite-worldinfo pp $s
  82     set out [format "%2s %s" $sy [world-summary $s]]
  83     if {![string equal $n ""]} {
  84       append out [format " (%.1f LY)" \
  85         [expr {[world-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]]
  86     }
  87     puts $out
  88   }
  89 }
  90
  91 proc local-area {g d n} {
  92   set ww [worldinfo $g]
  93   elite-worldinfo p $n
  94
  95   set w {}
  96   foreach {s x y} $ww {
  97     if {abs($p(x) - $x) > $d + 10 || abs($p(y) - $y) > $d + 10 ||
  98         [world-distance $p(x) $p(y) $x $y] > $d} { continue }
  99     lappend w $s $x $y
 100   }
 101   return $w
 102 }
 103
 104 set g $galaxy1
 105 set wx 72
 106 set wy 10
 107 set asp 2.17
 108 set d 70
 109 set v 1
 110 set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WD,HT\] \[-a ASP\] \[PLANET\]"
 111 for {set i 0} {$i < [llength $argv]} {incr i} {
 112   set a [lindex $argv $i]
 113   switch -glob -- $a {
 114     "-g" {
 115       incr i
 116       set a [lindex $argv $i]
 117       set g [parse-galaxy-spec $a]
 118       if {[string equal $g ""]} {
 119         puts stderr "$argv0: bad galaxy string `$a'"
 120         exit 1
 121       }
 122       destructure {. g} $g
 123     }
 124     "-d" {
 125       incr i
 126       set d [expr {[lindex $argv $i] * 10}]
 127     }
 128     "-w" {
 129       incr i
 130       if {![regexp {^(\d+),(\d+)$} [lindex $argv $i] . wx wy]} {
 131         puts stderr "$argv0: bad window size string"
 132         exit 1
 133       }
 134     }
 135     "-a" {
 136       incr i
 137       set asp [lindex $argv $i]
 138     }
 139     "-v" {
 140       incr v
 141     }
 142     "-q" {
 143       incr v -1
 144     }
 145     "--" {
 146       incr i
 147       break
 148     }
 149     "-*" {
 150       puts stderr $usage
 151       exit 1
 152     }
 153     default {
 154       break
 155     }
 156   }
 157 }
 158
 159 set p [lrange $argv $i end]
 160 switch -exact [llength $p] {
 161   0 {
 162     set n ""
 163     set w [worldinfo $g]
 164     incr v -1
 165   }
 166   1 {
 167     set n [parse-planet-spec $g $a]
 168     if {[string equal $n ""]} {
 169       puts stderr "$argv0: unknown planet `$a'"
 170       exit 1
 171     }
 172     set w [local-area $g $d $n]
 173   }
 174   default {
 175     puts stderr $usage
 176     exit 1
 177   }
 178 }
 179 set l [show-map $asp $wx $wy $w $n]
 180 if {$v > 0} {
 181   puts ""
 182   show-key $l $n
 183 }