#! /usr/bin/tclsh
###
### Determine the connected components of the various galaxies
###
### (c) 2003 Mark Wooding
###

###----- Licensing notice ---------------------------------------------------
###
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software Foundation,
### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

package require "elite" "1.0.1"

###--------------------------------------------------------------------------
### Support functions.

proc reach {dist seed} {
  ## Given a hyperspace range DIST and a galaxy SEED, determine and print the
  ## connected components of the reachability graph.

  ## Determine the graph.  Throughout, we use world seeds as indices: a(W)
  ## maintains a list of worlds adjacent to W.  p(W) is set (to an
  ## uninteresting value) if it's awaiting tracing.  The algorithm is simple:
  ## repeatedly pick a world awaiting tracing, do a depth-first search of
  ## graph starting from the chosen world adding each one encountered to the
  ## current component and removing it from the waiting list.
  set ww [elite-galaxylist $seed]
  elite-adjacency a $ww $dist
  foreach {s x w} $ww { set p($s) 1 }

  ## Initially there are no components.
  set pp {}

  ## Iterate over the untraced worlds.
  while 1 {

    ## Find an untraced world.  If there are none left then we're done.
    set ps [array startsearch p]
    if {![array anymore p $ps]} { array donesearch p $ps; break }
    set cc [array nextelement p $ps]
    array donesearch p $ps

    ## Now we do the depth-first search.  For each world in $trace,
    ## accumulate the untraced worlds reachable from it, and add them to the
    ## component.  Do this until we stop tracing new worlds.
    set trace $cc
    unset p($cc)
    while {[llength $trace]} {
      set tt $trace; set trace {}
      foreach c $tt {
	foreach w $a($c) {
	  if {[info exists p($w)]} {
	    unset p($w)
	    lappend trace $w
	  }
	}
      }
      set cc [concat $cc $trace]
    }

    ## We've finished the component.  Add it to the list.
    lappend pp $cc
  }

  ## Output the components.
  foreach cc $pp {

    ## Firstly, accumulate the summary data for all the worlds in the
    ## component.  Also, do dead-end analysis: if there's no world in the
    ## component with tech level 10 or higher then the component as a whole
    ## is a `dead end', and can't be escaped by buying a galactic hyperdrive
    ## (and you can't have one of those already, because you must have used
    ## it to reach the component in the first pace).
    set de 1
    set l {}
    foreach c $cc {
      elite-worldinfo i $c
      if {$i(techlevel) >= 10} { set de 0 }
      lappend l [world-summary $i(seed)]
    }

    ## Secondly, output the component information.  Separate components using
    ## blank lines.
    foreach n $l {
      if {$de} { append n " *" }
      puts $n
    }
    puts ""
  }
}

###--------------------------------------------------------------------------
### Main program.

## Parse the command line.  The default will be to scan all of the standard
## galaxies.
if {[llength $argv] == 0} {
  set argv {1 2 3 4 5 6 7 8}
}
set gg {}
set d 70
for {set i 0} {$i < [llength $argv]} {incr i} {
  set a [lindex $argv $i]
  switch -glob -- $a {
    "-d" {
      incr i
      set d [expr {int([lindex $argv $i] * 10)}]
    }
    "-*" {
      puts stderr "usage: $argv0 \[-d DIST\] \[GALAXY ...\]"
      exit 1
    }
    default {
      set g [parse-galaxy-spec $a]
      if {[string equal $g ""]} {
	puts stderr "$argv0: bad galaxy spec `$a'"
	exit 1
      }
      destructure {ng g} $g
      lappend gg $d $ng $g
    }
  }
}

## Analyse the requested galaxies.
foreach {d ng g} $gg {
  puts "*** GALAXY $ng ***"
  reach $d $g
}

###----- That's all, folks --------------------------------------------------