Fix nonexistent planet error. Make staying put cost nothing.

[rocl] / elite-map

#! /usr/bin/tclsh
#
# $Id: elite-map,v 1.4 2003/03/07 00:41:46 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 {}} {p {}}} {
  set minx 10000
  set miny 10000
  set maxx 0
  set maxy 0

  set lmain {}
  set lmagic {}
  set lpath {}
  if {[llength $n] == 1} {
    set w [lindex $n 0]
    set fancy($w) "*"
    lappend lmagic $fancy($w) $w
  } else {
    set i 0
    foreach w $n {
      if {![info exists fancy($w)]} {
	set fancy($w) "*[symbol $i]"
	lappend lmagic $fancy($w) $w
	incr i
      }
    }
  }
  set i 0
  foreach w $p {
    if {![info exists fancy($w)]} {
      set fancy($w) "+[symbol $i]"
      lappend lpath $fancy($w) $w
      incr i
    }
  }
  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
  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
    }
    set l lmain
    if {[info exists fancy($s)]} {
      set sy $fancy($s)
    } else {
      set sy [symbol $i]
      lappend $l $sy $s
      incr i
    }
    puts -nonewline $sy
    incr x [string length $sy]
  }
  puts -nonewline "\n"
  return [list $lmagic $lpath $lmain]
}

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

set g $galaxy1
set wx 72
set wy 10
set asp 2.17
set d 70
set v 2
set weight {}
set usage "usage: $argv0 \[-qv\] \[-g GAL\] \[-d DIST\] \[-w WEIGHT\]\n\t\[-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 {int([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
      }
    }
    "-w" {
      incr i
      set a [lindex $argv $i]
      set weight "weight-$a"
      if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
	puts stderr "$argv0: unknown weight function `$a'"
	puts stderr "$argv0: I know [info commands weight-*]"
	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]
set ww [elite-galaxylist $g]
if {![llength $p]} {
  set n {}
  set rt {}
  set w $ww
  incr v -1
} else {
  if {![string equal $weight ""]} { elite-adjacency adj $ww $d }
  set n {}
  foreach a $p {
    set s [parse-planet-spec $g $a]
    if {[string equal $s ""]} {
      puts stderr "$argv0: unknown planet `$a'"
      exit 1
    }
    lappend n $s
  }
  set rt {}
  if {![string equal $weight ""]} {
    set home [lindex $n 0]
    foreach w [lrange $n 1 end] {
      destructure {p .} [shortest-path adj $home $w $weight]
      if {![llength $p]} {
	puts stderr \
	    "$argv0: no route from [worldname $home] to [worldname $w]"
	exit 1
      }
      eval lappend rt $p
      set home $w
    }
  }
  set x0 1024
  set y0 1024
  set x1 0
  set y1 0
  set w {}
  foreach p [concat $n $rt] {
    elite-worldinfo ii $p
    if {$ii(x) < $x0} { set x0 $ii(x) }
    if {$ii(y) < $y0} { set y0 $ii(y) }
    if {$ii(x) > $x1} { set x1 $ii(x) }
    if {$ii(y) > $y1} { set y1 $ii(y) }
  }
  set x0 [expr {$x0 - $d - 5}]
  set y0 [expr {$y0 - $d - 5}]
  set x1 [expr {$x1 + $d + 5}]
  set y1 [expr {$y1 + $d + 5}]
  set w {}
  foreach {p x y} $ww {
    if {$x >= $x0 && $y >= $y0 && $x <= $x1 && $y <= $y1} {
      lappend w $p $x $y
    }
  }
}
destructure {lmagic lpath lmain} [show-map $asp $wx $wy $w $n $rt]
if {$v > 0} {
  puts ""
  show-key $lmagic $n
}
if {$v > 1} {
  if {[string equal $weight ""]} {
    show-key $lmain $n
  } else {
    show-key $lpath $n
    if {$v > 2} {
      show-key $lmain $n
    }
  }
}