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

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