Variable fuel range for connectivity map and pathfinder.

[rocl] / elite-map

#! /usr/bin/tclsh
#
# $Id: elite-map,v 1.2 2003/02/25 00:25:38 mdw Exp $

package require "elite" "1.0.0"

set syms "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
proc symbol {i} {
  global syms
  if {$i < [string length $syms]} {
    return [string index $syms $i]
  }
  set hi [expr {$i / [string length $syms]}]
  set lo [expr {$i % [string length $syms]}]
  return [string index $syms $hi][string index $syms $lo]
}

proc show-map {asp wx wy ww {n ""}} {
  set minx 10000
  set miny 10000
  set maxx 0
  set maxy 0

  foreach {s x y} $ww {
    if {$x < $minx} { set minx $x}
    if {$y < $miny} { set miny $y}
    if {$x > $maxx} { set maxx $x}
    if {$y > $maxy} { set maxy $y}
  }
  set dx [expr {$maxx - $minx}]
  set dy [expr {$maxy - $miny}]
  if {$dx == 0} { set dx 1 }
  if {$dy == 0} { set dy 1 }

  set sc [expr {$wx/double($dx)}]
  if {$dy * $sc/$asp > $wy} {
    set sc [expr {$wy * $asp/double($dy)}]
  }
  set gw {}
  foreach {s x y} $ww {
    set gx [expr {int(($x - $minx) * $sc + 0.5)}]
    set gy [expr {int(($y - $miny) * $sc/$asp + 0.5)}]
    lappend gw [list $s $gx $gy]
  }

  set pw [lsort -index 1 -integer -increasing $gw]
  set pw [lsort -index 2 -integer -increasing $pw]
  set x 0
  set y 0
  set i 0
  set l {}
  foreach w $pw {
    destructure {s px py} $w
    if {$y < $py} {
      puts -nonewline [string repeat "\n" [expr {$py - $y}]]
      set x 0
      set y $py
    }
    if {$x < $px} {
      puts -nonewline [string repeat " " [expr {$px - $x}]]
      set x $px
    }
    if {[string equal $s $n]} {
      set sy "*"
    } else {
      set sy [symbol $i]
      incr i
    }
    puts -nonewline $sy
    incr x [string length $sy]
    lappend l $sy $s
  }
  puts -nonewline "\n"
  return $l
}

proc show-key {l n} {
  global gov eco
  if {![string equal $n ""]} {
    elite-worldinfo p $n
  }
  foreach {sy s} $l {
    elite-worldinfo pp $s
    set out [format "%2s %s" $sy [world-summary $s]]
    if {![string equal $n ""]} {
      append out [format " (%.1f LY)" \
	[expr {[world-distance $p(x) $p(y) $pp(x) $pp(y)]/10.0}]]
    }
    puts $out
  }
}

proc local-area {g d n} {
  set ww [worldinfo $g]
  elite-worldinfo p $n

  set w {}
  foreach {s x y} $ww {
    if {abs($p(x) - $x) > $d + 10 || abs($p(y) - $y) > $d + 10 ||
        [world-distance $p(x) $p(y) $x $y] > $d} { continue }
    lappend w $s $x $y
  }
  return $w
}

set g $galaxy1
set wx 72
set wy 10
set asp 2.17
set d 70
set v 1
set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WD,HT\] \[-a ASP\] \[PLANET\]"
for {set i 0} {$i < [llength $argv]} {incr i} {
  set a [lindex $argv $i]
  switch -glob -- $a {
    "-g" {
      incr i
      set a [lindex $argv $i]
      set g [parse-galaxy-spec $a]
      if {[string equal $g ""]} {
	puts stderr "$argv0: bad galaxy string `$a'"
	exit 1
      }
      destructure {. g} $g
    }
    "-d" {
      incr i
      set d [expr {[lindex $argv $i] * 10}]
    }
    "-w" {
      incr i
      if {![regexp {^(\d+),(\d+)$} [lindex $argv $i] . wx wy]} {
	puts stderr "$argv0: bad window size string"
	exit 1
      }
    }
    "-a" {
      incr i
      set asp [lindex $argv $i]
    }
    "-v" {
      incr v
    }
    "-q" {
      incr v -1
    }
    "--" {
      incr i
      break
    }
    "-*" {
      puts stderr $usage
      exit 1
    }
    default {
      break
    }
  }
}

set p [lrange $argv $i end]
switch -exact [llength $p] {
  0 {
    set n ""
    set w [worldinfo $g]
    incr v -1
  }
  1 {
    set n [parse-planet-spec $g $a]
    if {[string equal $n ""]} {
      puts stderr "$argv0: unknown planet `$a'"
      exit 1
    }
    set w [local-area $g $d $n]
  }
  default {
    puts stderr $usage
    exit 1
  }
}    
set l [show-map $asp $wx $wy $w $n]
if {$v > 0} {
  puts ""
  show-key $l $n
}