#!/usr/local/bin/wish4.0 -f

# $Header: /home/cia/crosby/proj/advcad/tk/RCS/ifmap,v 2.0 1996/05/26 07:44:29 crosby Rel $

#  IF Map Editor
#
#  A visual tool for Interactive fiction playing
#
#  Copyright 1996 Matthew Crosby, crosby@cs.colorado.edu
#
#  This is free software that may be redistributed and/or modified 
#  under the terms of the GNU General Public License as published by
#  the Free Software Foundation.  You should have recieved a copy of 
#  this license, if not, it may be obtained by ftp from prep.ai.mit.edu
#
#  File box copyright Sven Delmas, garfield@cs.tu-berlin.de
#
#

######################################################################
#
#  Constants
#

set Version "0.1"
set Debug 0

# Size of the room nodes
set Xsize 60  
set Ysize 30
set SQsize 4
set LoopSize 10

set directions {NW N NE W E SW S SE U D}

######################################################################
#
#   Variables
#

# The canvas
canvas .map -scrollregion {0 0 2048 2048}  \
         -xscrollcommand ".horizontal set" -yscrollcommand ".vertical set" \
	 -bd 2 -relief sunken

# The actual height, width of the map

set MapXMax 0
set MapYMax 0
set MapXMin 2048
set MapYMin 2048


#
# The title of the Dungeon
#

set DungeonTitle ""

# Id:  Maps canvas id to room id and or corridoor id
#      Room_id:  In form of Room<nmbr>
#      Edge_id:  In form of Edge<nmbr>

# ReverseId:  Maps room/edge id back to canvas ID

# Nodelist:  List of nodes

# Node:  Node information (pseudo structure)
#      Node(Room_Id.var)   Var can be:
#        X:  X pos
#        Y:  Y pos
#	 joins.{N,S,etc}:  Room ID room joins to
#	 joinsThru.{N,S,etc}:  Edge ID they join through
#	 joinsTo.{N,S,etc}:  Exit in other room it joins
#	 Name: room name
#	 Desc: room desc
#	 textId: ID of text (name)
#	 Type: Room type

# EdgeList: List of edges

# Edge:  Edge information (pseudo structure)
#      Edge(Edge_id.var)   Var can be:
#      Node.1:  Room_id of 1st node
#      Node.2:  Room_id of 2nd node
#      NodePos.1,2  Pos  (N,S, etc)
#      Secret:  Is this a secret passage?
#      Oneway:  Is this a oneway passage?  0-no 12-from 1 to 2, 21-from 2 to 1

# nodecount & edgecount:  These keep a running count of nodes & edges
set Nodecount 	0
set Edgecount	0

# nextnode and next edge.  These two are counters that are never decremented.
# They are used to generate a new unique edge/node id.
set NextNode	0
set NextEdge	0

# CPlist
#    contains the Direction for a particular ID


# Selected
#   The currently selected room

set selected 0

# moveedge
#  The edge being moved

set movededge 0

# Changed
#  Flage to indicate that we changed something

set changed 0


######################################################################
#
#   Room handling procedures
#


#
#  Withcoord--converts coord from screen to canvas
#

proc withcoord {command oldx oldy} {
    set x [.map canvasx $oldx]
    set y [.map canvasy $oldy]
    $command $x $y
}


#
#  mkRoom:  Creates a new room at (x,y)
#
proc mkRoom {x y {node_id ""} {name ""} {desc ""} {type "Normal"} {joins ""} {joinsto ""} {joinsthru ""}} {
    global Id Nodelist Node Nodecount directions ReverseId NextNode changed
    global MapXMax MapYMax MapXMin MapYMin

    # drawRoom:  This procedure draws the room itself

    proc drawroom {x y node} {

	global Id Xsize Ysize Node ReverseId
	set new [.map create rectangle [expr $x-($Xsize/2)] \
	         [expr $y-($Ysize/2)] [expr $x+($Xsize/2)] \
		 [expr $y+($Ysize/2)]  \
	         -outline black -fill white -tags $node ]
	set ReverseId($node) $new
	.map bind $new <Double-Button-1> {withcoord roompopup %x %y}
	.map bind $new <Button-1> {withcoord selectroom %x %y}
	.map bind $new <Button1-Motion> {withcoord moveroom %x %y}
        .map bind $new <KeyPress-Delete> deleteobj
	set Id($new) $node
	# set new [ .map create text $x $y -tags $node -width [expr $Xsize-4] -text $Node($node.Name) -font "-*-helvetica-medium-r-normal--11-*-*-*-*-*-*-*"] 
	set new [ .map create text $x $y -tags $node -width [expr $Xsize-4] -text $Node($node.Name) -justify center ]
	.map bind $new <Double-Button-1> {withcoord roompopup %x %y}
	.map bind $new <Button1-Motion> {withcoord moveroom %x %y}
	.map bind $new <Button-1> {withcoord selectroom %x %y}
	set Id($new) $node
	set Node($node.textId) $new
    }
    
    # drawconpoint:  Draws the buttons for the edges
    proc drawconpoint {node dir} {
	global SQsize CPlist Id Node
	set pos [findConPos $node $dir]
	set x [ lindex $pos 0 ]
	set y [ lindex $pos 1 ]
	set new [.map create rectangle [expr $x-$SQsize/2] [expr $y-$SQsize/2] \
				       [expr $x+$SQsize/2] [expr $y+$SQsize/2] \
				       -outline black -fill black -tags "$node cpoint" ]
  	
	.map bind $new <Double-Button-1> { withcoord loopback %x %y}	 
  	.map bind $new <Button-1> { withcoord drawline %x %y}	 
	.map bind $new <Button1-Motion> {withcoord movedrawline %x %y}
	.map bind $new <ButtonRelease-1> {withcoord finishdrawline %x %y}

	set Id($new) $node
	set CPlist($new) $dir
	.map bind $new
	set Node($node.joins.${dir}) 0
	set Node($node.joinsThru.${dir}) 0
	set Node($node.joinsTo.${dir}) 0
    }

    # create an ID for this room
    if {$node_id==""} { set node_id "Room$NextNode" }
    set Nodelist($node_id) $node_id
    set Node($node_id.Name) $name
    set Node($node_id.Desc) $desc

    # set up the variables
    set Node(${node_id}.X) $x
    set Node(${node_id}.Y) $y
    set Node(${node_id}.Name) $name
    set Node(${node_id}.Type) $type
    
    #foreach i $joins { set $Node(${node_id}.Joins) $i }
    #foreach i $joinsto { set $Node(${node_id}.JoinsTo) $i }
    #foreach i $joinsthru { set $Node(${node_id}.JoinsThru) $i }


    # draw the room itself
    drawroom $x $y $node_id   

    if {$x>$MapXMax} {set MapXMax $x}
    if {$y>$MapYMax} {set MapYMax $y}
    if {$x<$MapXMin} {set MapXMin $x}
    if {$y<$MapYMin} {set MapYMin $y}

    setroomtype $node_id $type

    foreach i $directions  {
	drawconpoint $node_id $i
    }
    
    set Nodecount [ expr $Nodecount+1 ]
    set NextNode [ expr $NextNode+1 ]
    set changed 1

}

#
#  findConPos:  Finds the x,y position of a connection button
#

proc findConPos {node pos} {
    global Node Xsize Ysize SQsize

    set x $Node(${node}.X)
    set y $Node(${node}.Y)
    switch $pos {
	NW {
	    set x [expr $x-($Xsize/2)-$SQsize/2]
	    set y [expr $y-($Ysize/2)-$SQsize/2]
	}
	N {
	    set x [expr $x]
	    set y [expr $y-($Ysize/2)-$SQsize/2]
	}
	NE {
	    set x [expr $x+($Xsize/2)+$SQsize/2]
	    set y [expr $y-($Ysize/2)-$SQsize/2]
	}
	W {
	    set x [expr $x-($Xsize/2)-$SQsize/2]
	    set y [expr $y]
	}
	E {
	    set x [expr $x+($Xsize/2)+$SQsize/2]
	    set y [expr $y]
	}
	SW {
	    set x [expr $x-($Xsize/2)-$SQsize/2]
	    set y [expr $y+($Ysize/2)+$SQsize/2]
	}
	S {
	    set x [expr $x]
	    set y [expr $y+($Ysize/2)+$SQsize/2]
	}
	SE {
	    set x [expr $x+($Xsize/2)+$SQsize/2]
	    set y [expr $y+($Ysize/2)+$SQsize/2]
	}
	U {
	    set x [expr $x-($Xsize/4)-$SQsize/2]
	    set y [expr $y-($Ysize/2)-$SQsize/2]
	}
	D {
	    set x [expr $x+($Xsize/4)+$SQsize/2]
	    set y [expr $y+($Ysize/2)+$SQsize/2]
	}
    }
    return "$x $y"
}


#
#  findConPoint:  Finds the x,y position of a connecting point for a node.
#

proc findConPoint {node pos} {
    global Node Xsize Ysize SQsize

    set x $Node(${node}.X)
    set y $Node(${node}.Y)
    switch $pos {
	NW {
	    set x [expr $x-($Xsize/2)]
	    set y [expr $y-($Ysize/2)]
	}
	N {
	    set x [expr $x]
	    set y [expr $y-($Ysize/2)]
	}
	NE {
	    set x [expr $x+($Xsize/2)]
	    set y [expr $y-($Ysize/2)]
	}
	W {
	    set x [expr $x-($Xsize/2)]
	    set y [expr $y]
	}
	E {
	    set x [expr $x+($Xsize/2)]
	    set y [expr $y]
	}
	SW {
	    set x [expr $x-($Xsize/2)]
	    set y [expr $y+($Ysize/2)]
	}
	S {
	    set x [expr $x]
	    set y [expr $y+($Ysize/2)]
	}
	SE {
	    set x [expr $x+($Xsize/2)]
	    set y [expr $y+($Ysize/2)]
	}
	U {
	    set x [expr $x-($Xsize/4)]
	    set y [expr $y-($Ysize/2)]
	}
	D {
	    set x [expr $x+($Xsize/4)]
	    set y [expr $y+($Ysize/2)]
	}
    }
    return "$x $y"
}


#
#  Moveroom.  Moves rooms
#

proc moveroom {x y} {
    global Id Xsize Ysize Node directions ReverseId changed Edge
    global MapXMax MapYMax MapXMin MapYMin
    
    set tag $Id([.map find withtag current])
  
    .map move $tag [expr $x-$Node($tag.X)] [expr $y-$Node(${tag}.Y)]
    if {$x>$MapXMax} {set MapXMax $x}
    if {$y>$MapYMax} {set MapYMax $y}
    if {$x<$MapXMin} {set MapXMin $x}
    if {$y<$MapYMin} {set MapYMin $y}
    set Node(${tag}.X) $x
    set Node(${tag}.Y) $y

    foreach i $directions {
	if { ($Node(${tag}.joins.${i}) != 0)  && \
	     ($Node(${tag}.joins.${i}) != $tag) } {
	    set edge $Node(${tag}.joinsThru.${i})
	    set tag1 $Edge($edge.Node.1)
	    set tag2 $Edge($edge.Node.2)

	    set pos [ findConPoint $tag1 $Edge($edge.NodePos.1) ]
	    set pos2 [ findConPoint $tag2 $Edge($edge.NodePos.2) ]
	    
	    .map coords $ReverseId($edge) \
		[ lindex $pos 0 ] [ lindex $pos 1] \
		[ lindex $pos2 0 ] [ lindex $pos2 1]
	    
	}
    }
    set changed 1
}

#
#  Selectroom.  Selects a room
#

proc selectroom  {x y} {
    global selected Id ReverseId 
    unselect
    set room $Id([.map find withtag current])
    set id $ReverseId($room)
    set selected $room

    .map itemconfigure $id -outline red -width 2
}

#
#  Selectedge.  Selects an edge
#

proc selectedge  {x y} {
    global selected Id ReverseId Node Edge
    unselect
    set selected $Id([.map find withtag current])
    set id $ReverseId($selected)

    if { $Edge($selected.Node.1)==$Edge($selected.Node.2) } {
	.map itemconfigure $id -outline red -width 2
    } else {
	.map itemconfigure $id -fill red -width 2

    }
}

#
# Unselect.  Selects whatever is selected
#

proc unselect { } {
    global selected ReverseId Edge
    if [string match Edge*  $selected] {
	if { $Edge($selected.Node.1)==$Edge($selected.Node.2) } {
	    .map itemconfigure $ReverseId($selected) -outline black -width 1 
	} elseif {$Edge($selected.Secret) } {
	    .map itemconfigure $ReverseId($selected) -fill grey -width 1 
	} else {
	    .map itemconfigure $ReverseId($selected) -fill black -width 1
	}
    } 
    if [string match Room* $selected] {
	.map itemconfigure $ReverseId($selected) -outline black -width 1
    }
    set selected 0
}


#
#  drawline.  Begins drawing an edge
#
proc drawline {x y} {
    global CPlist Node Id currentline cstartroom cstart changed xorig yorig
    unselect
    set idval [.map find withtag current]
    set node $Id($idval)
    if { $Node($node.joins.$CPlist($idval))==0 } {
	set pos [ findConPoint $node $CPlist($idval) ]
	set x [ lindex $pos 0 ]
	set y [ lindex $pos 1 ]
	set new [.map create line $x $y [expr $x+1] [expr $y+1 ]]
	set currentline $new
	set cstartroom $node
	set cstart $idval
	set changed 1
    } else {
	set currentline 0
    }
    set xorig x
    set yorig y
}

#
#  movedrawline.  Continues drawing an edge
#
proc movedrawline {x2 y2} {
    global Id currentline CPlist cstartroom cstart
    if {$currentline!=0} {
	set pos [findConPoint $cstartroom $CPlist($cstart)]
	set x1 [ lindex $pos 0 ]
	set y1 [ lindex $pos 1 ]
	.map coords $currentline $x1 $y1 $x2 $y2
    }
}

#
# finishdrawline.  Finishes off an edge.
#
proc finishdrawline {x y} {
    global Id currentline CPlist cstartroom cstart Edgecount Node ReverseId \
	   Edge EdgeList NextEdge xorig yorig

    set cend [ findbutton $x $y ]

    if {$cend != 0} {
	set cendroom [lindex $cend 0]
	set cendir [lindex $cend 1]
	set cstartdir $CPlist($cstart)

	if { ($Node($cendroom.joins.$cendir)==0) && (($cendroom!=$cstartroom) \
	     || ($cendir != $cstartdir)) } {
	    set pos [findConPoint $cstartroom $cstartdir ]
	    set x1 [ lindex $pos 0 ]
	    set y1 [ lindex $pos 1 ]
	    set pos [findConPoint $cendroom $cendir ]
	    set x2 [ lindex $pos 0 ]
	    set y2 [ lindex $pos 1 ]
	    .map coords $currentline $x1 $y1 $x2 $y2

	    .map bind $currentline <Button-1> { withcoord selectedge %x %y }
	    .map bind $currentline <Double-Button-1> { withcoord edgepopup %x %y }
	    .map bind $currentline <Button1-Motion> { withcoord moveedge %x %y }
	    .map bind $currentline <ButtonRelease-1> {withcoord finishmoveedge %x %y}
	    set edge_id "Edge$NextEdge"
	    set EdgeList($edge_id) $edge_id
	    set Id($currentline) $edge_id
	    set ReverseId($edge_id) $currentline

	    set Edge(${edge_id}.Node.1) $cstartroom
	    set Edge(${edge_id}.NodePos.1) $cstartdir
	    set Edge(${edge_id}.Node.2) $cendroom
	    set Edge(${edge_id}.NodePos.2) $cendir

	    set Edge(${edge_id}.Secret) 0
	    set Edge(${edge_id}.Oneway) 0

	    set Edgecount [expr $Edgecount+1]
	    set NextEdge [expr $NextEdge+1]
	    
	    set Node(${cstartroom}.joins.${cstartdir}) $cendroom
	    set Node(${cendroom}.joins.${cendir}) $cstartroom
	    set Node(${cstartroom}.joinsThru.${cstartdir}) $edge_id
	    set Node(${cendroom}.joinsThru.${cendir}) $edge_id
	    set Node(${cstartroom}.joinsTo.${cstartdir}) $cendir
	    set Node(${cendroom}.joinsTo.${cendir}) $cstartdir
	 } else { .map delete $currentline } 
    } else { .map delete $currentline } 
    set currentline 0
}

#
# mkedge.  Makes an edge between two different objects.
#

proc mkEdge {node1 pos1 node2 pos2 {edge_id ""} {secret 0} {oneway 0}} {
    global EdgeList Id ReverseId Edge Edgecount Node NextEdge changed

    set pos [findConPoint $node1 $pos1]
    set x1 [lindex $pos 0]
    set y1 [lindex $pos 1]
    if {$node1==$node2} {
	loopback $x1 $y1 $edge_id
    } else {
    	set pos [findConPoint $node2 $pos2]
	set x2 [lindex $pos 0]
	set y2 [lindex $pos 1]
	
	set currentline [.map create line $x1 $y1 $x2 $y2]
	.map bind $currentline <Button-1> { withcoord selectedge %x %y }
	.map bind $currentline <Double-Button-1> { withcoord edgepopup %x %y }
	.map bind $currentline <Button1-Motion> { withcoord moveedge %x %y }
	.map bind $currentline <ButtonRelease-1> {withcoord finishmoveedge %x %y}

	if {$edge_id==""} {
	    set edge_id "Edge$NextEdge"
	}
	set EdgeList($edge_id) $edge_id
	set Id($currentline) $edge_id
	set ReverseId($edge_id) $currentline

	set Edge(${edge_id}.Node.1) $node1
	set Edge(${edge_id}.NodePos.1) $pos1
	set Edge(${edge_id}.Node.2) $node2
	set Edge(${edge_id}.NodePos.2) $pos2

	set Edge(${edge_id}.Secret) $secret
	set Edge(${edge_id}.Oneway) $oneway
	setedgetype $edge_id $secret $oneway

	set Edgecount [expr $Edgecount+1]
	set NextEdge  [expr $NextEdge+1]
	
	set Node(${node1}.joins.${pos1}) $node2
	set Node(${node2}.joins.${pos2}) $node1
	set Node(${node1}.joinsThru.${pos1}) $edge_id
	set Node(${node2}.joinsThru.${pos2}) $edge_id
	set Node(${node1}.joinsTo.${pos1}) $pos2
	set Node(${node2}.joinsTo.${pos2}) $pos1
    }
    set changed 1
}


#
# moveedge   Moves an edge
#

proc moveedge {x y} {
    global Edge Id selected movededge ReverseId notmoved changed

    if { $movededge==0 } {


	set pos [findConPoint $Edge($selected.Node.1) \
		  $Edge($selected.NodePos.1) ]
	set x1 [ lindex $pos 0 ]
 	set y1 [ lindex $pos 1 ]
	set pos [findConPoint $Edge($selected.Node.2) \
		  $Edge($selected.NodePos.2) ]
	set x2 [ lindex $pos 0 ]
 	set y2 [ lindex $pos 1 ]

	if { [ expr sqrt(($x-$x1)*($x-$x1)+($y-$y1)*($y-$y1))< \
	            sqrt(($x-$x2)*($x-$x2)+($y-$y2)*($y-$y2))] } {
	    set x1 $x2
	    set y1 $y2
	    set notmoved 2
	    set movededge 1
	} else {
	    set movededge 2
	    set notmoved 1
	}
    
    } else {
	set pos [findConPoint $Edge($selected.Node.$notmoved) \
		  $Edge($selected.NodePos.$notmoved) ]

	set x1 [ lindex $pos 0 ]
 	set y1 [ lindex $pos 1 ]
    }
   
    
    if { $movededge==1 } { .map coords $ReverseId($selected) $x $y $x1 $y1 
    } else { .map coords $ReverseId($selected) $x1 $y1 $x $y }
    

    set changed 1
}

#
# finishmoveedge.  Finished moving an edge.
#

proc finishmoveedge {x y} {
    global Edge ReverseId selected movededge Node  notmoved
    set nogo 1

    set cend [ findbutton $x $y ]
   
    if { $cend != 0 } { 
	set room [lindex $cend 0]
	set dir [lindex $cend 1]

	if { $Node($room.joins.$dir) == 0 } {
	    set nogo 0

	set Node($Edge($selected.Node.$notmoved).joins.$Edge($selected.NodePos.$notmoved)) $room
	set Node($Edge($selected.Node.$notmoved).joinsTo.$Edge($selected.NodePos.$notmoved)) $dir

	set Node(${room}.joins.$dir) $Edge($selected.Node.$notmoved)
	set Node(${room}.joinsThru.$dir) $selected
	set Node(${room}.joinsTo.$dir) $Edge($selected.NodePos.$notmoved)

	set Node($Edge($selected.Node.$movededge).joins.$Edge($selected.NodePos.$movededge)) 0
	set Node($Edge($selected.Node.$notmoved).joinsTo.$Edge($selected.NodePos.$movededge)) 0
	set Node($Edge($selected.Node.$notmoved).joinsThru.$Edge($selected.NodePos.$movededge)) 0

	set Edge(${selected}.Node.$movededge) $room
	set Edge(${selected}.NodePos.$movededge) $dir
	}
    } 
    if { $nogo == 1 } {
	set pos [findConPoint $Edge($selected.Node.1) \
		  $Edge($selected.NodePos.1) ]
	set x1 [ lindex $pos 0 ]
 	set y1 [ lindex $pos 1 ]
	set pos [findConPoint $Edge($selected.Node.2) \
		  $Edge($selected.NodePos.2) ]
	set x2 [ lindex $pos 0 ]
 	set y2 [ lindex $pos 1 ]
    }
    set pos [findConPoint $Edge($selected.Node.1) \
	      $Edge($selected.NodePos.1) ]
    set x1 [ lindex $pos 0 ]
    set y1 [ lindex $pos 1 ]
    set pos [findConPoint $Edge($selected.Node.2) \
	      $Edge($selected.NodePos.2) ]
    set x2 [ lindex $pos 0 ]
    set y2 [ lindex $pos 1 ]
    .map coords $ReverseId($selected) $x1 $y1 $x2 $y2
    set movededge 0
}

#
#  loopback:  Implements a loop corridoor
#

proc loopback {x y {edge_id ""}} {
    global Id Edgecount Node ReverseId LoopSize Edge EdgeList NextEdge changed

    unselect
    set button [ findbutton $x $y ]
     
    if {$button != 0} {

	set buttonroom [lindex $button 0]
	set buttondir [lindex $button 1]

	if { $Node($buttonroom.joins.$buttondir)==0 } {

	set pos [findConPoint $buttonroom $buttondir ]

	set x [ lindex $pos 0 ]
 	set y [ lindex $pos 1 ]

	switch $buttondir {
	    NW { 
		set x1 [expr $x-$LoopSize ]
		set x2 $x 
		set y1 [expr $y-$LoopSize ]
		set y2 $y 
	    } N { 
		set x1 [expr $x-$LoopSize/2 ]
	        set x2 [expr $x+$LoopSize/2 ]
		set y1 [expr $y-$LoopSize ]
		set y2 $y 
	    } NE {  
		set x1 $x
		set x2 [expr $x+$LoopSize ]
		set y1 [expr $y-$LoopSize ]
		set y2 $y
	    } W {
		set x1 [expr $x-$LoopSize ]
		set x2 $x
		set y1 [expr $y-$LoopSize/2 ]    
		set y2 [expr $y+$LoopSize/2 ]
	    } E {
		set x1 $x
		set x2 [expr $x+$LoopSize ]
		set y1 [expr $y-$LoopSize/2 ]
		set y2 [expr $y+$LoopSize/2 ]
	    } SW {
		set x1 [expr $x-$LoopSize ]
		set x2 $x         
		set y1 $y
		set y2 [expr $y+$LoopSize ]
	    } S {
		set x1 [expr $x-$LoopSize/2 ]  
		set x2 [expr $x+$LoopSize/2 ]   
		set y1 $y      
		set y2 [expr $y+$LoopSize ]
	    } SE {
		set x1 $x
		set x2 [expr $x+$LoopSize ]     
		set y1 $y
		set y2 [expr $y+$LoopSize ]
	    } U {
		set x1 [expr $x-$LoopSize/2 ]
		set x2 [expr $x+$LoopSize/2 ]
		set y1 [expr $y-$LoopSize ]
		set y2 $y
	    } D {
		set x1 [expr $x-$LoopSize/2 ]
		set x2 [expr $x+$LoopSize/2 ]
		set y1 $y
		set y2 [expr $y+$LoopSize ]
	    }
	}

	debug $buttonroom
	set currentline [ .map create oval $x1 $y1 $x2 $y2 -tags $buttonroom ]
	.map bind $currentline <Button-1> { withcoord selectedge %x %y }

	if {$edge_id==""} { set edge_id "Edge$NextEdge" }
	set EdgeList($edge_id) $edge_id
	set Id($currentline) $edge_id
	set ReverseId($edge_id) $currentline

	set Edge(${edge_id}.Node.1) $buttonroom
	set Edge(${edge_id}.NodePos.1) $buttondir
	set Edge(${edge_id}.Node.2) $buttonroom
	set Edge(${edge_id}.NodePos.2) $buttondir
	set Edge(${edge_id}.Secret) 0
	set Edge(${edge_id}.Oneway) 0
	
	set Node(${buttonroom}.joins.${buttondir}) $buttonroom
	set Node(${buttonroom}.joinsThru.${buttondir}) $edge_id
	set Node(${buttonroom}.joinsTo.${buttondir}) $buttondir

	set Edgecount [expr $Edgecount+1]
	set NextEdge [expr $NextEdge+1]
     } 
     set changed 1
     }
}


#
# findbutton.  Finds the button associated with an X,Y pair
#
proc findbutton {x y} {
    global Node Xsize Ysize Nodelist SQsize directions
    foreach i [array names Nodelist] {
	foreach j $directions {
	    if { [expr $x>[expr $Node(${i}.X)-($Xsize)] && \
		$x<[expr $Node(${i}.X)+($Xsize)] && \
		$y>[expr $Node(${i}.Y)-($Ysize)] && \
		$y<[expr $Node(${i}.Y)+($Ysize)]] } { 
		    set pos [ findConPoint $i $j ]
		    set x1 [ lindex $pos 0 ]
		    set y1 [ lindex $pos 1 ]
		    if { [expr $x>$x1-$SQsize] && [expr $x<$x1+$SQsize] && 
			 [expr $y>$y1-$SQsize] && [expr $y<$y1+$SQsize]} {
			return "$i $j"
		}
	    }
	}
    }  
    return 0
}


#
# inroom.  Determines what room an x,y pair is in.
#
proc inroom {x y} {
    global Node Xsize Ysize Nodelist
    foreach i [array names Nodelist] {
	if { [expr $x>[expr $Node(${i}.X)-($Xsize)] && \
	    $x<[expr $Node(${i}.X)+($Xsize)] && \
	    $y>[expr $Node(${i}.Y)-($Ysize)] && \
	    $y<[expr $Node(${i}.Y)+($Ysize)]] } { return $i }
    }  
    return 0
}

#
#  InObject  Boolean, determines whether or not this is in an object
#
proc inobject {x y} {
    global Node Xsize Ysize Nodelist
    if { [ .map find overlapping [expr $x-2] [expr $y-2] [expr $x+2] \
    [expr $y+2] ] != "" } {
	return 1
    }  
    return 0
}



proc setroomtype {room type} {
    global ReverseId
    switch $type {
	Normal {
	    .map itemconfigure $ReverseId($room) -fill "white" -outline "black"
	    .map dtag $ReverseId($room) conn
	}
	Maze {
	    .map itemconfigure $ReverseId($room) -fill "wheat" -outline "black"
	    .map dtag $ReverseId($room) conn
	 }
	Joins {
	    .map itemconfigure $ReverseId($room) -fill "light grey" -outline ""
	    .map addtag conn withtag $ReverseId($room)
	}
    }
}


proc setedgetype {edge secret oneway} {
    global ReverseId
	
    if { $secret } {
	.map itemconfigure $ReverseId($edge) -fill lightgrey
    } else {
	.map itemconfigure $ReverseId($edge) -fill black
    }
    if { $oneway=="12"} {
	.map itemconfigure $ReverseId($edge) -arrow first
    } elseif { $oneway=="21"} {
	.map itemconfigure $ReverseId($edge) -arrow last
    } else {
	.map itemconfigure $ReverseId($edge) -arrow none
    }
}



#
# roompoput.  Pops up the room dialog box
#
proc roompopup {x y {room ""}} {
    global Node roomname type

    proc okbtn {room} {
	global .roomdialog Node roomname changed type
    	set Node($room.Name) $roomname
	set Node($room.Type) $type
	set Node($room.Desc) [ .roomdialog.t.b.descript get 0.0 end ]
	setroomtype $room $type
	destroy .roomdialog
	.map itemconfigure $Node($room.textId) -text $roomname
	set changed 1
    }
    proc cancelbtn {} {
	global .roomdialog 
	destroy .roomdialog
    }
  
    if { [winfo exists .roomdialog]} {
   	destroy .roomdialog 
    }

    if {$room==""} {
	set room [inroom $x $y ]   
	if { $room==0 } {
	    return
	}
    }
    set roomname $Node($room.Name)
    set type $Node($room.Type)

    toplevel .roomdialog -class Dialog
    wm title .roomdialog "Room Information"
    frame .roomdialog.t -relief raised
    frame .roomdialog.t.t
    #frame .roomdialog.t.v
    frame .roomdialog.t.b
    frame .roomdialog.b -relief raised
    label .roomdialog.t.t.namelabel -text "Name: "
    entry .roomdialog.t.t.nameentry -width 20 -relief sunken \
	   -textvariable roomname
    label .roomdialog.t.t.typelabel -text "Type: "

    radiobutton .roomdialog.t.t.norm  -text "Normal" -variable type -value "Normal" 
    radiobutton .roomdialog.t.t.maze  -text "Maze" -variable type -value "Maze" 
    radiobutton .roomdialog.t.t.joins  -text "Joins" -variable type -value "Joins" 

    label .roomdialog.t.b.desclabel -text "Description: "
    text .roomdialog.t.b.descript  -width 60 -height 15
    button .roomdialog.b.ok -text "OK"  -command "okbtn $room"
    button .roomdialog.b.cancel -text "Cancel" -command "cancelbtn"
    
    bind .roomdialog.t.t.nameentry <Return> ".roomdialog.b.ok flash;okbtn $room"	
    bind .roomdialog <Escape> ".roomdialog.b.cancel flash;cancelbtn"	
    
    pack .roomdialog.t.t.namelabel .roomdialog.t.t.nameentry -anchor n
    pack .roomdialog.t.t.typelabel .roomdialog.t.t.norm .roomdialog.t.t.maze \
         .roomdialog.t.t.joins  
    pack .roomdialog.t.b.desclabel .roomdialog.t.b.descript 

    pack .roomdialog.t.t .roomdialog.t.b -side left
    pack .roomdialog.b.ok .roomdialog.b.cancel -side left -padx 3m -pady 3m 
    pack .roomdialog.t .roomdialog.b

    .roomdialog.t.b.descript insert 1.0 $Node($room.Desc)

}

#
#  Edgepopup.  Pops up an edge roomdialog box
#
proc edgepopup {{x -1} {y -1}} {
    global Node Id Edge selected secret oneway

    proc okbtn {edge} {
	global Edge ReverseId secret changed oneway
	set Edge($edge.Secret) $secret
	set Edge($edge.Oneway) $oneway
	setedgetype $edge $secret $oneway
	set changed 1	
	destroy .edgedialog
    }
    proc cancelbtn {} {
	destroy .edgedialog
    }

    set edge $selected
    set secret $Edge($edge.Secret)
    set oneway $Edge($edge.Oneway)

    if { [winfo exists .edgedialog]} {
	destroy .edgedialog
    }

    toplevel .edgedialog -class Dialog
    wm title .edgedialog "Coridoor Information"
    frame .edgedialog.t -relief raised
    frame .edgedialog.b -relief raised
    pack .edgedialog.t .edgedialog.b 

    checkbutton .edgedialog.t.secret -variable secret -text "Secret"

    radiobutton .edgedialog.t.twoway -text "Two Way" -variable oneway -value 0 
    radiobutton .edgedialog.t.oneway12 -text "One Way $Edge(${edge}.NodePos.1)-$Edge(${edge}.NodePos.2)" -variable oneway -value "12"
    radiobutton .edgedialog.t.oneway21 -text "One Way $Edge(${edge}.NodePos.2)-$Edge(${edge}.NodePos.1)" -variable oneway -value "21"
    
    pack .edgedialog.t.secret .edgedialog.t.twoway .edgedialog.t.oneway12 .edgedialog.t.oneway21 -anchor w
    button .edgedialog.b.ok -text "OK"  -command "okbtn $edge"
    button .edgedialog.b.cancel -text "Cancel" -command "cancelbtn"
    pack .edgedialog.b.ok .edgedialog.b.cancel -side left -padx 3m -pady 3m 
    bind .edgedialog <Return> ".edgedialog.b.ok flash;okbtn $edge"	
    bind .edgedialog <Escape> ".edgedialog.b.cancel flash;cancelbtn"	
}


proc doedit {} {
    global selected
    if {[string first "Room" $selected]!=-1} {
	roompopup -1 -1 $selected
    } elseif {[string first "Edge" $selected]!=-1} {
	edgepopup
    }
}



#
#  deleteobj.  Deletes an object  (room or edge)
#
proc deleteobj { {object ""} } {

    #
    #  deleteedge.  deletes an edge.
    #
    proc deleteedge { selected } {
	global Node ReverseId Edge EdgeList Edgecount
	       
	if { $selected !=0 } {
	.map delete $ReverseId($selected)

	set Node($Edge($selected.Node.1).joins.$Edge($selected.NodePos.1)) 0
	set Node($Edge($selected.Node.1).joinsThru.$Edge($selected.NodePos.1)) 0
	set Node($Edge($selected.Node.1).joinsTo.$Edge($selected.NodePos.1)) 0
	set Node($Edge($selected.Node.2).joins.$Edge($selected.NodePos.2)) 0
	set Node($Edge($selected.Node.2).joinsThru.$Edge($selected.NodePos.2)) 0
	set Node($Edge($selected.Node.2).joinsTo.$Edge($selected.NodePos.2)) 0

	unset Edge($selected.Node.1)
	unset Edge($selected.Node.2)
	unset Edge($selected.NodePos.1)
	unset Edge($selected.NodePos.2)
	unset EdgeList($selected)
	set Edgecount [expr $Edgecount-1]
	}
    }

    #
    #  deleteroom.  Deletes a room
    #
    proc deleteroom {selected} {
	global Node ReverseId directions Edge EdgeList Id Nodelist Nodecount

	if { $selected != 0 } {
	    .map delete $selected
	    foreach i $directions {
		if {$Node($selected.joinsThru.$i) != 0} {
		    .map delete $ReverseId($Node($selected.joinsThru.$i))
		    set Node($Node($selected.joins.$i).joins.$Node($selected.joinsTo.$i)) 0
		    set Node($Node($selected.joins.$i).joinsThru.$Node($selected.joinsTo.$i)) 0
		    set Node($Node($selected.joins.$i).joinsTo.$Node($selected.joinsTo.$i)) 0
		    unset Edge($Node($selected.joinsThru.$i).Node.1)
		    unset Edge($Node($selected.joinsThru.$i).Node.2)
		    unset Edge($Node($selected.joinsThru.$i).NodePos.1)
		    unset Edge($Node($selected.joinsThru.$i).NodePos.2)
		    unset EdgeList($Node($selected.joinsThru.$i))
		    unset Id($ReverseId($Node($selected.joinsThru.$i)))
		    unset ReverseId($Node($selected.joinsThru.$i))
		}
		unset Node($selected.joins.$i)
		unset Node($selected.joinsThru.$i)
		unset Node($selected.joinsTo.$i)
	    }
	    unset Node($selected.Type)
	    unset Node($selected.X)
	    unset Node($selected.Y)
	    unset Node($selected.Name)
	    unset Node($selected.textId)
	    unset Nodelist($selected)	
	    set Nodecount [expr $Nodecount-1]
	}
    }


    global selected changed

    if {$object==""} { set object $selected}
    if [string match Edge*  $object] {
	deleteedge $object
    } 
    if [string match Room* $object] {
	deleteroom $object
    }

    set selected 0
    set changed 1
}


##############################################################
#
#  Quit, save, etc commands
#

proc load {fn} {
    global Nodelist Edgelist Version Node Edge directions DungeonTitle 
    global NextNode NextEdge changed Version
 
    if {[yousure]=="cancel"} {
       return
    }

    clear

    set node ""
    set nodedesc ""
    set edge ""
    set fd [open $fn "r"]
    while {![eof $fd]} {
	gets $fd line
	set i 0
	foreach var [split $line " "] {
	    set vars($i) $var
	    set i [expr $i+1]
	}
	
	switch $vars(0) {
	    "Version" { if { $vars(1) != $Version } { return } }
	    "Dungeon" { set DungeonTitle [lindex [ split $line "\"" ] 1] }
	    "\}" {
		if {$node!=""} {
		    mkRoom $nodeX $nodeY $node $nodename $nodedesc $nodetype
		    # $nodeJoins $nodeJoinsTo $nodeJoinsThru
		    set node ""
		    set nodedesc ""
		}
		if {$edge!=""} {
		    mkEdge $edgeTo(1) $edgeExit(1) $edgeTo(2) $edgeExit(2) $edge $edgeSecret $edgeOneway
		    set edge ""
		}
	    }
	    "NextNode" {set lnextnode $vars(1)}
	    "NextEdge" {set lnextedge $vars(1)}
	    "Name" { 
		set nodename [lindex [ split $line "\"" ] 1]
	    }
	    "Desc" { 
		set input [lindex [ split $line "\"" ] 1]
		if {$nodedesc!=""} {	
		    set nodedesc "$nodedesc\n$input"
		} else {
		    set nodedesc $input
		}
	    }
	    "Oneway" {set edgeOneway $vars(1)}
	    "Type" {set nodetype $vars(1)}
	    "X" {set nodeX $vars(1)}
	    "Y" {set nodeY $vars(1)}
	    "joinsTo" {set nodeJoinsTo($vars(1)) $vars(2)}
	    "joinsThru" {set nodeJoinsThru($vars(1)) $vars(2)}
	    "joins" {set nodeJoins($vars(1)) $vars(2)}
	    "ToNode" {set edgeTo($vars(1)) $vars(2)}
	    "Exit" {set edgeExit($vars(1)) $vars(2)}
	    "Secret" {set edgeSecret $vars(1)}
	    "Edge" { set edge $vars(1) }
	    "Node" { set node $vars(1) }
	}
    }
    # We put these at the end to ensure they are correct
    set NextNode $lnextnode
    set NextEdge $lnextedge
    set changed 0
}


proc save {fn} {
global Nodelist EdgeList Version Node Edge directions DungeonTitle Nodecount 
global Edgecount NextNode NextEdge

    set fd [open $fn "w"]
    puts $fd "IFMapper"
    puts $fd "Version $Version"
    puts $fd "Dungeon \"$DungeonTitle\""
    puts $fd "Nodes\n\{"
    puts $fd "NumNodes $Nodecount"
    foreach i [array names Nodelist] {
	puts $fd "Node $i\n\{"
	puts $fd "Name \"$Node($i.Name)\""
	set desc $Node($i.Desc)
	regsub -all "\n" $desc "\"\nDesc \"" desc
	puts $fd "Desc \"$desc\""
	puts $fd "Type $Node($i.Type)"
	puts $fd "X $Node($i.X)"
	puts $fd "Y $Node($i.Y)"
	foreach j $directions {
	    if {$Node($i.joins.$j) != 0 } {
		puts $fd "joins $j $Node($i.joins.$j)"
		puts $fd "joinsTo $j $Node($i.joinsTo.$j)"
		puts $fd "joinsThru $j $Node($i.joinsThru.$j)"
	    }
	}
	puts $fd "\}"
    }
    puts $fd "NextNode $NextNode"
    puts $fd "\}\nEdges\n\{"
    puts $fd "NumEdges $Edgecount"
    foreach i [array names EdgeList] {
	puts $fd "Edge $i\n\{"
	foreach k {1 2} {
	    puts $fd "ToNode $k $Edge($i.Node.$k)"
	    puts $fd "Exit $k $Edge($i.NodePos.$k)"
	}
	puts $fd "Secret $Edge($i.Secret)"
	puts $fd "Oneway $Edge($i.Oneway)\n\}"
    }
    puts $fd "NextEdge $NextEdge"
    puts $fd "\}"
    close $fd
}



#
#
#
#

proc print {} {
    global printto printname filename


    proc okbtn {} {
	global printto printname filename printto printname
        global MapXMax MapYMax MapXMin MapYMin DungeonTitle filename
	destroy .printdialog
	
	if {$printto=="p"} {set filename "/tmp/map.ps"}
	.map itemconfigure cpoint -outline "" -fill ""
	.map itemconfigure conn -outline "" -fill ""
        .map create text [expr $MapXMin+($MapXMax-$MapXMin)/2] \
			 [expr $MapYMin-60] -tag title -text $DungeonTitle \
			 -font "-*-times-medium-r-normal-*-*-240-*-*-*-*-*-*" 
	.map postscript -x [expr $MapXMin-60] -y [expr $MapYMin-120] \
			-width [expr $MapXMax-$MapXMin+120] \
			-height [expr $MapYMax-$MapYMin+180] \
			-pagewidth  "7.5i" -file $filename
	if {$printto=="p"} {
	    exec lpr -P$printname  $filename
	    set filename ""
	}
	.map itemconfigure conn -outline "" -fill "lightgrey"
	.map itemconfigure cpoint -outline "black" -fill "black"
	.map delete title
    }
    proc cancelbtn {} {
	destroy .printdialog
    }

    set printto p

    toplevel .printdialog -class Dialog
    wm title .printdialog "Print"
    frame .printdialog.t -relief raised
    frame .printdialog.b -relief raised
    pack .printdialog.t .printdialog.b 

    label .printdialog.t.title -text "Print To:"
    radiobutton .printdialog.t.prn -text "Printer: " -variable printto -value p
    entry .printdialog.t.printname  -textvariable printname
    radiobutton .printdialog.t.fle -text "File: " -variable printto -value f
    entry .printdialog.t.filename  -textvariable filename

    pack .printdialog.t.title .printdialog.t.prn .printdialog.t.printname .printdialog.t.fle .printdialog.t.filename

    button .printdialog.b.ok -text "OK"  -command "okbtn"
    button .printdialog.b.cancel -text "Cancel" -command "cancelbtn"
    bind .printdialog <Return> ".printdialog.b.ok flash;okbtn"	
    bind .printdialog <Escape> ".printdialog.b.cancel flash;cancelbtn"	

    pack .printdialog.b.ok .printdialog.b.cancel -side left -padx 3m


}


proc Help {} {
}

#
#  io:  Handles io (The file box)
#

proc io {command} {
    if { $command == "load" } {
	set mesg "Select file to load"
    } else { set mesg "Select file to save" }
    FSBox "mesg" "" "$command \$fsBox(name)"
}


#
#  doquit:  This handles quitting the program
#

proc doquit {} {
   if {[yousure]=="ok"} {
      exit
    }

}


proc doclear {} {
   if {[yousure]=="ok"} {
       clear
    }
}

proc clear {} {
    global Node Nodelist Edgelist Edge CPlist Room_id Edge_id Id ReverseId
    global Edgecount Nodecount selected movededge NextNode NextEdge .map changed

    .map delete all 

    catch {unset Node
    unset Nodelist
    unset Edgelist
    unset Edge
    unset CPlist
    unset Room_id
    unset Edge_id
    unset Id
    unset ReverseId}

    set Edgecount 0
    set Nodecount 0
    set selected 0
    set movededge 0
    set NextNode 0
    set NextEdge 0

    set changed 0
}


proc yousure {} {
    global retval changed

    if { [winfo exists .sure]} {
   	return cancel
    }
    if {$changed!=0} {
	toplevel .sure -class Dialog
	wm iconname .sure Dialog
	wm title .sure "Are you sure?"
	frame .sure.t -relief raised -bd 1
	label .sure.t.bitmap -bitmap questhead
	label .sure.t.text -text "Are you sure?"
    
	frame .sure.b -relief raised -bd 1
	button .sure.b.ok -text "OK"  -command "set retval ok"
	button .sure.b.cancel -text "Cancel" -command "set retval cancel"

	pack .sure.t.bitmap .sure.t.text -side left -padx 3m -expand 1 
	pack .sure.b.ok .sure.b.cancel -side left -padx 2m -expand 1
	pack .sure.t .sure.b -expand 1 

	bind .sure <Return> ".sure.b.ok flash;set retval ok"
	bind .sure <Escape> ".sure.b.cancel flash;set retval cancel"
	tkwait variable retval
	destroy .sure
	return $retval
    } else {
	return "ok"
    }
}

proc ShowHelp {text} {
    if { [winfo exists .help]} {
   	return cancel
    }
    toplevel .help
    wm title .help "Help"
    frame .help.t
    text .help.t.text -wrap word -yscrollcommand ".help.t.scroll set" \
	 -font "-*-times-medium-r-normal-*-14-*-*-*-*-*-*-*" 
    .help.t.text insert end $text
    scrollbar .help.t.scroll -command ".help.t.text yview" 
    button .help.ok -text "OK" -command "destroy .help"
    pack .help.t.text .help.t.scroll -side left -fill y
    pack .help.t .help.ok 
}



##############################################################3

#
#  Misc Procedures
#

proc debug {outmsg} {
    global Debug
    if { $Debug==1} {
	puts $outmsg } 
}

proc dump {} {
    global Version Xsize Ysize SQsize LoopSize DungeonTitle Nodecount Edgecount Selected Movededge
    debug "Version: $Version"
    debug "Xsize: $Xsize"
    debug "Ysize: $Ysize"
    debug "SQsize: $SQsize"
    debug "LoopSize: $LoopSize"
    debug "DungeonTitle: $DungeonTitle"
    debug "Nodecount: $Nodecount"
    debug "Edgecount: $Edgecount"
    debug "Selected: $selected"
    debug "Movededge: $movededge"
}


##############################################################3


#
#  Bind the room creation
#

bind .map <Button-1> {
    set x [.map canvasx %x ]
    set y [.map canvasy %y ]
    if { [inobject $x $y]==0 } { 
	mkRoom $x $y 
    }

}


#
#  The Menu Bar
#

frame .mbar -relief raised -bd 2
menubutton .mbar.file -text File -underline 0 -menu .mbar.file.menu
menubutton .mbar.edit -text Edit -underline 0 -menu .mbar.edit.menu
menubutton .mbar.help -text Help -underline 0 -menu .mbar.help.menu
pack .mbar.file .mbar.edit -side left
pack .mbar.help -side right
menu .mbar.file.menu
.mbar.file.menu add command -label Load -command "io load"
.mbar.file.menu add command -label Save -command "io save"
.mbar.file.menu add command -label Print -command "print"
.mbar.file.menu add separator 
.mbar.file.menu add command -label Clear -command doclear
.mbar.file.menu add command -label Quit -command doquit
menu .mbar.edit.menu
.mbar.edit.menu add command -label Edit  -command doedit
.mbar.edit.menu add command -label Delete -command deleteobj
menu .mbar.help.menu
.mbar.help.menu add command -label Help -command "ShowHelp \$helptext"
.mbar.help.menu add command -label "Release Notes" -command "ShowHelp \$releasenotes"
tk_menuBar .mbar .mbar.file .mbar.edit .mbar.help 

#
#
#

bind .map <KeyPress-Delete> deleteobj
bind .map <KeyPress-Clear> deleteobj
bind .map <KeyPress-BackSpace> deleteobj
bind .map <Control-D> deleteobj
bind .map <KeyPress-Insert> doedit
bind .map <Control-E> doedit
bind .map <KeyPress-Help> ShowHelp
bind .map <KeyPress-F1> ShowHelp
bind .map <Control-H> ShowHelp
bind .map <Control-L> "io load"
bind .map <Control-S> "io save"
bind .map <Control-C> doquit


# 
# The Scroll Bars
#

scrollbar .vertical -command ".map yview"
scrollbar .horizontal -command ".map xview " -orient horizontal

#
# The Title
#

entry .title -textvariable DungeonTitle 

# Pack the widget
pack .mbar -fill x
pack .title -fill x
pack .map -fill both -expand 1
pack .vertical -fill y -after .mbar -side right
pack .horizontal -fill x -after .mbar -side bottom
wm title . "Map editor version $Version"



#---END---
##############################################################3
##############################################################3
### Below isn't my code, its the file box
###  The one I'm using was written by garfield@cs.tu-berlin.de,
###  Availible from the tcl ftp sites.


# XFNoParsing
# Program: template
# Description: file selector box
#

global fsBox
set fsBox(activeBackground) ""
set fsBox(activeForeground) ""
set fsBox(background) ""
set fsBox(font) ""
set fsBox(foreground) ""
set fsBox(scrollActiveForeground) ""
set fsBox(scrollBackground) ""
set fsBox(scrollForeground) ""
set fsBox(scrollSide) left
set fsBox(showPixmap) 0
set fsBox(name) ""
set fsBox(path) [pwd]
set fsBox(pattern) *
set fsBox(all) 0
set fsBox(button) 0
set fsBox(extensions) 0
set fsBox(internalPath) [pwd]

proc FSBox {{fsBoxMessage "Select file:"} {fsBoxFileName ""} {fsBoxActionOk ""} {fsBoxActionCancel ""}} {# xf ignore me 5
##########
# Procedure: FSBox
# Description: show file selector box
# Arguments: fsBoxMessage - the text to display
#            fsBoxFileName - a file name that should be selected
#            fsBoxActionOk - the action that should be performed on ok
#            fsBoxActionCancel - the action that should be performed on cancel
# Returns: the filename that was selected, or nothing
# Sideeffects: none
##########
# 
# global fsBox(activeBackground) - active background color
# global fsBox(activeForeground) - active foreground color
# global fsBox(background) - background color
# global fsBox(font) - text font
# global fsBox(foreground) - foreground color
# global fsBox(extensions) - scan directory for extensions
# global fsBox(scrollActiveForeground) - scrollbar active background color
# global fsBox(scrollBackground) - scrollbar background color
# global fsBox(scrollForeground) - scrollbar foreground color
# global fsBox(scrollSide) - side where scrollbar is located

  global fsBox

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  set tmpScaleOpt ""
  set tmpScrollOpt ""
  if {"$fsBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
  }
  if {"$fsBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
  }
  if {"$fsBox(background)" != ""} {
    append tmpButtonOpt "-background \"$fsBox(background)\" "
    append tmpFrameOpt "-background \"$fsBox(background)\" "
    append tmpMessageOpt "-background \"$fsBox(background)\" "
  }
  if {"$fsBox(font)" != ""} {
    append tmpButtonOpt "-font \"$fsBox(font)\" "
    append tmpMessageOpt "-font \"$fsBox(font)\" "
  }
  if {"$fsBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$fsBox(foreground)\" "
  }
  if {"$fsBox(scrollActiveForeground)" != ""} {
    append tmpScrollOpt "-activeforeground \"$fsBox(scrollActiveForeground)\" "
  }
  if {"$fsBox(scrollBackground)" != ""} {
    append tmpScrollOpt "-background \"$fsBox(scrollBackground)\" "
  }
  if {"$fsBox(scrollForeground)" != ""} {
    append tmpScrollOpt "-foreground \"$fsBox(scrollForeground)\" "
  }

  if {[file exists [file tail $fsBoxFileName]] &&
      [IsAFile [file tail $fsBoxFileName]]} {
    set fsBox(name) [file tail $fsBoxFileName]
  } {
    set fsBox(name) ""
  }
  if {[file exists $fsBoxFileName] && [IsADir $fsBoxFileName]} {
    set fsBox(path) $fsBoxFileName
  } {
    if {"[file rootname $fsBoxFileName]" != "."} {
      set fsBox(path) [file rootname $fsBoxFileName]
    }
  }
  if {$fsBox(showPixmap)} {
    set fsBox(path) [string trimleft $fsBox(path) @]
  }
  if {"$fsBox(path)" != "" && [file exists $fsBox(path)] &&
      [IsADir $fsBox(path)]} {
    set fsBox(internalPath) $fsBox(path)
  } {
    if {"$fsBox(internalPath)" == "" ||
        ![file exists $fsBox(internalPath)]} {
      set fsBox(internalPath) [pwd]
    }
  }
  # build widget structure

  # start build of toplevel
  if {"[info commands XFDestroy]" != ""} {
    catch {XFDestroy .fsBox}
  } {
    catch {destroy .fsBox}
  }
  toplevel .fsBox \
    -borderwidth 0
  catch ".fsBox config $tmpFrameOpt"
  wm geometry .fsBox 350x300 
  wm title .fsBox {File select box}
  wm maxsize .fsBox 1000 1000
  wm minsize .fsBox 100 100
  # end build of toplevel

  label .fsBox.message1 \
    -anchor c \
    -relief raised \
    -text "$fsBoxMessage"
  catch ".fsBox.message1 config $tmpMessageOpt"

  frame .fsBox.frame1 \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.frame1 config $tmpFrameOpt"

  button .fsBox.frame1.ok \
    -text "OK" \
    -command "
      global fsBox
      set fsBox(name) \[.fsBox.file.file get\]
      if {$fsBox(showPixmap)} {
        set fsBox(path) @\[.fsBox.path.path get\]
      } {
        set fsBox(path) \[.fsBox.path.path get\]
      }
      set fsBox(internalPath) \[.fsBox.path.path get\]
      $fsBoxActionOk
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .fsBox}
      } {
        catch {destroy .fsBox}
      }"
  catch ".fsBox.frame1.ok config $tmpButtonOpt"

  button .fsBox.frame1.rescan \
    -text "Rescan" \
    -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get] \
        [.fsBox.pattern.pattern get] $fsBox(all)}
  catch ".fsBox.frame1.rescan config $tmpButtonOpt"

  button .fsBox.frame1.cancel \
    -text "Cancel" \
    -command "
      global fsBox
      set fsBox(name) {}
      set fsBox(path) {}
      $fsBoxActionCancel
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .fsBox}
      } {
        catch {destroy .fsBox}
      }"
  catch ".fsBox.frame1.cancel config $tmpButtonOpt"

  if {$fsBox(showPixmap)} {
    frame .fsBox.frame2 \
      -borderwidth 0 \
      -relief raised
    catch ".fsBox.frame2 config $tmpFrameOpt"

    scrollbar .fsBox.frame2.scrollbar3 \
      -command {.fsBox.frame2.canvas2 xview} \
      -orient {horizontal} \
      -relief {raised}
    catch ".fsBox.frame2.scrollbar3 config $tmpScrollOpt"

    scrollbar .fsBox.frame2.scrollbar1 \
      -command {.fsBox.frame2.canvas2 yview} \
      -relief {raised}
    catch ".fsBox.frame2.scrollbar1 config $tmpScrollOpt"

    canvas .fsBox.frame2.canvas2 \
      -confine {true} \
      -relief {raised} \
      -scrollregion {0c 0c 20c 20c} \
      -width {100} \
      -xscrollcommand {.fsBox.frame2.scrollbar3 set} \
      -yscrollcommand {.fsBox.frame2.scrollbar1 set}
    catch ".fsBox.frame2.canvas2 config $tmpFrameOpt"

    .fsBox.frame2.canvas2 addtag currentBitmap withtag [.fsBox.frame2.canvas2 create bitmap 5 5 -anchor nw]
  }

  frame .fsBox.path \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.path config $tmpFrameOpt"

  frame .fsBox.path.paths \
    -borderwidth 2 \
    -relief raised
  catch ".fsBox.path.paths config $tmpFrameOpt"

  menubutton .fsBox.path.paths.paths \
    -borderwidth 0 \
    -menu ".fsBox.path.paths.paths.menu" \
    -relief flat \
    -text "Pathname:"
  catch ".fsBox.path.paths.paths config $tmpButtonOpt"

  menu .fsBox.path.paths.paths.menu
  catch ".fsBox.path.paths.paths.menu config $tmpButtonOpt"

  .fsBox.path.paths.paths.menu add command \
     -label "[string trimright $fsBox(internalPath) {/@}]" \
     -command "
       global fsBox
       FSBoxFSShow \[.fsBox.path.path get\] \
         \[.fsBox.pattern.pattern get\] \$fsBox(all)
       .fsBox.path.path delete 0 end
       .fsBox.path.path insert 0 [string trimright $fsBox(internalPath) {/@}]"

  entry .fsBox.path.path \
    -relief raised
  catch ".fsBox.path.path config $tmpMessageOpt"

  if {![IsADir $fsBox(internalPath)]} {
    set $fsBox(internalPath) [pwd]
  }
  .fsBox.path.path insert 0 $fsBox(internalPath)

  frame .fsBox.pattern \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.pattern config $tmpFrameOpt"

  frame .fsBox.pattern.patterns \
    -borderwidth 2 \
    -relief raised
  catch ".fsBox.pattern.patterns config $tmpFrameOpt"

  menubutton .fsBox.pattern.patterns.patterns \
    -borderwidth 0 \
    -menu ".fsBox.pattern.patterns.patterns.menu" \
    -relief flat \
    -text "Selection pattern:"
  catch ".fsBox.pattern.patterns.patterns config $tmpButtonOpt"

  menu .fsBox.pattern.patterns.patterns.menu
  catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"

  .fsBox.pattern.patterns.patterns.menu add checkbutton \
    -label "Scan extensions" \
    -variable fsBoxExtensions \
    -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get] \
        [.fsBox.pattern.pattern get] $fsBox(all)}

  entry .fsBox.pattern.pattern \
    -relief raised
  catch ".fsBox.pattern.pattern config $tmpMessageOpt"

  .fsBox.pattern.pattern insert 0 $fsBox(pattern)
  
  frame .fsBox.files \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.files config $tmpFrameOpt"

  scrollbar .fsBox.files.vscroll \
    -relief raised \
    -command ".fsBox.files.files yview"
  catch ".fsBox.files.vscroll config $tmpScrollOpt"

  scrollbar .fsBox.files.hscroll \
    -orient horiz \
    -relief raised \
    -command ".fsBox.files.files xview"
  catch ".fsBox.files.hscroll config $tmpScrollOpt"

  listbox .fsBox.files.files \
    -exportselection false \
    -relief raised \
    -xscrollcommand ".fsBox.files.hscroll set" \
    -yscrollcommand ".fsBox.files.vscroll set"
  catch ".fsBox.files.files config $tmpMessageOpt"

  frame .fsBox.file \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.file config $tmpFrameOpt"

  label .fsBox.file.labelfile \
    -relief raised \
    -text "Filename:"
  catch ".fsBox.file.labelfile config $tmpMessageOpt"

  entry .fsBox.file.file \
    -relief raised
  catch ".fsBox.file.file config $tmpMessageOpt"

  .fsBox.file.file delete 0 end
  .fsBox.file.file insert 0 $fsBox(name)
  
  checkbutton .fsBox.pattern.all \
    -offvalue 0 \
    -onvalue 1 \
    -text "Show all files" \
    -variable fsBox(all) \
    -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get] \
        [.fsBox.pattern.pattern get] $fsBox(all)}
  catch ".fsBox.pattern.all config $tmpButtonOpt"

  FSBoxFSShow $fsBox(internalPath) $fsBox(pattern) $fsBox(all)

  # bindings
  bind .fsBox.files.files <Double-Button-1> "
    FSBoxFSFileSelectDouble %W $fsBox(showPixmap) \{$fsBoxActionOk\} %y"
  bind .fsBox.files.files <ButtonPress-1> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Button1-Motion> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Shift-Button1-Motion> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Shift-ButtonPress-1> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"

  bind .fsBox.path.path <Tab> {
    FSBoxFSNameComplete path}
  bind .fsBox.path.path <Return> {
    global tkVersion
    global fsBox
    FSBoxFSShow [.fsBox.path.path get] \
      [.fsBox.pattern.pattern get] $fsBox(all)
    FSBoxFSInsertPath
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}
  catch "bind .fsBox.path.path <Up> {}"
  bind .fsBox.path.path <Down> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}

  bind .fsBox.file.file <Tab> {
    FSBoxFSNameComplete file}
  bind .fsBox.file.file <Return> "
    global fsBox
    set fsBox(name) \[.fsBox.file.file get\]
    if {$fsBox(showPixmap)} {
      set fsBox(path) @\[.fsBox.path.path get\]
    } {
      set fsBox(path) \[.fsBox.path.path get\]
    }
    set fsBox(internalPath) \[.fsBox.path.path get\]
    $fsBoxActionOk
    if {\"\[info commands XFDestroy\]\" != \"\"} {
      catch {XFDestroy .fsBox}
    } {
      catch {destroy .fsBox}
    }"
  bind .fsBox.file.file <Up> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.path.path icursor end
    } {
      .fsBox.path.path cursor end
    }
    focus .fsBox.path.path}
  bind .fsBox.file.file <Down> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.pattern.pattern icursor end
    } {
      .fsBox.pattern.pattern cursor end
    }
    focus .fsBox.pattern.pattern}

  bind .fsBox.pattern.pattern <Return> {
    global fsBox
    FSBoxFSShow [.fsBox.path.path get] \
      [.fsBox.pattern.pattern get] $fsBox(all)}
  bind .fsBox.pattern.pattern <Up> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}
  catch "bind .fsBox.pattern.pattern <Down> {}"

  # packing
  pack append .fsBox.files \
              .fsBox.files.vscroll "$fsBox(scrollSide) filly" \
              .fsBox.files.hscroll {bottom fillx} \
              .fsBox.files.files {left fill expand}
  pack append .fsBox.file \
              .fsBox.file.labelfile {left} \
              .fsBox.file.file {left fill expand}
  pack append .fsBox.frame1 \
              .fsBox.frame1.ok {left fill expand} \
              .fsBox.frame1.rescan {left fill expand} \
              .fsBox.frame1.cancel {left fill expand}
  pack append .fsBox.path.paths \
              .fsBox.path.paths.paths {left}
  pack append .fsBox.pattern.patterns \
              .fsBox.pattern.patterns.patterns {left}
  pack append .fsBox.path \
              .fsBox.path.paths {left} \
              .fsBox.path.path {left fill expand}
  pack append .fsBox.pattern \
              .fsBox.pattern.patterns {left} \
              .fsBox.pattern.all {right fill} \
              .fsBox.pattern.pattern {left fill expand}
  if {$fsBox(showPixmap)} {
    pack append .fsBox.frame2 \
                .fsBox.frame2.scrollbar1 {left filly} \
                .fsBox.frame2.canvas2 {top expand fill} \
                .fsBox.frame2.scrollbar3 {top fillx} 

    pack append .fsBox \
                .fsBox.message1 {top fill} \
                .fsBox.frame1 {bottom fill} \
                .fsBox.pattern {bottom fill} \
                .fsBox.file {bottom fill} \
                .fsBox.path {bottom fill} \
                .fsBox.frame2 {right fill} \
                .fsBox.files {left fill expand}
  } {
    pack append .fsBox \
                .fsBox.message1 {top fill} \
                .fsBox.frame1 {bottom fill} \
                .fsBox.pattern {bottom fill} \
                .fsBox.file {bottom fill} \
                .fsBox.path {bottom fill} \
                .fsBox.files {left fill expand}
  }

  if {"$fsBoxActionOk" == "" && "$fsBoxActionCancel" == ""} {
    # wait for the box to be destroyed
    update idletask
    grab .fsBox
    tkwait window .fsBox

    if {"[string trim $fsBox(path)]" != "" ||
        "[string trim $fsBox(name)]" != ""} {
      if {"[string trimleft [string trim $fsBox(name)] /]" == ""} {
        return [string trimright [string trim $fsBox(path)] /]
      } {
        return [string trimright [string trim $fsBox(path)] /]/[string trimleft [string trim $fsBox(name)] /]
      }
    }
  }
}

##########
# Procedure: FSBoxFSFileSelect
# Description: select file name
# Arguments: fsBoxW - the widget
#            fsBoxShowPixmap - show pixmaps
#            fsBoxY - the y position in the listbox
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSFileSelect {fsBoxW fsBoxShowPixmap fsBoxY} {# xf ignore me 6
  global fsBox

  FSBoxBindSelectOne $fsBoxW $fsBoxY
  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
    if {"[string index $fsBoxTmpEntry \
          [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
        "[string index $fsBoxTmpEntry \
          [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
      set fsBoxFileName [string range $fsBoxTmpEntry 0 \
            [expr [string length $fsBoxTmpEntry]-2]]
      if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
          ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
        set fsBoxFileName $fsBoxTmpEntry
      }
    } {
      if {"[string index $fsBoxTmpEntry \
            [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
        set fsBoxFileName [string range $fsBoxTmpEntry 0 \
          [expr [string length $fsBoxTmpEntry]-2]]
        if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
          set fsBoxFileName $fsBoxTmpEntry
        }
      } {
        set fsBoxFileName $fsBoxTmpEntry
      }
    }
    if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
      set fsBox(name) $fsBoxFileName
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 $fsBox(name)
      if {$fsBoxShowPixmap} {
        catch ".fsBox.frame2.canvas2 itemconfigure currentBitmap -bitmap \"@$fsBox(internalPath)/$fsBox(name)\""
      }
    }
  }
}

##########
# Procedure: FSBoxFSFileSelectDouble
# Description: select file when double clicked
# Arguments: fsBoxW - the widget
#            fsBoxShowPixmap - show pixmaps
#            fsBoxAction - the action bound to the ok button
#            fsBoxY - the y position in the listbox
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSFileSelectDouble {fsBoxW fsBoxShowPixmap fsBoxAction fsBoxY} {# xf ignore me 6
  global fsBox

  FSBoxBindSelectOne $fsBoxW $fsBoxY
  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
    if {"$fsBoxTmpEntry" == "../"} {
      set fsBoxTmpEntry [string trimright [string trim $fsBox(internalPath)] "@/"]
      if {"$fsBoxTmpEntry" == ""} {
        return
      }
      FSBoxFSShow [file dirname $fsBoxTmpEntry] \
        [.fsBox.pattern.pattern get] $fsBox(all)
      .fsBox.path.path delete 0 end
      .fsBox.path.path insert 0 $fsBox(internalPath)
    } {
      if {"[string index $fsBoxTmpEntry \
            [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
          "[string index $fsBoxTmpEntry \
            [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
        set fsBoxFileName [string range $fsBoxTmpEntry 0 \
              [expr [string length $fsBoxTmpEntry]-2]]
        if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
            ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
          set fsBoxFileName $fsBoxTmpEntry
        }
      } {
        if {"[string index $fsBoxTmpEntry \
              [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
          set fsBoxFileName [string range $fsBoxTmpEntry 0 \
                [expr [string length $fsBoxTmpEntry]-2]]
          if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
            set fsBoxFileName $fsBoxTmpEntry
          }
        } {
          set fsBoxFileName $fsBoxTmpEntry
        }
      }
      if {[IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
        set fsBox(internalPath) "[string trimright $fsBox(internalPath) {/@}]/$fsBoxFileName"
        FSBoxFSShow $fsBox(internalPath) \
          [.fsBox.pattern.pattern get] $fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBox(internalPath)
      } {
        set fsBox(name) $fsBoxFileName
        if {$fsBoxShowPixmap} {
          set fsBox(path) @$fsBox(internalPath)
        } {
          set fsBox(path) $fsBox(internalPath)
        }
        if {"$fsBoxAction" != ""} {
          eval "global fsBox; $fsBoxAction"
        }
        if {"[info commands XFDestroy]" != ""} {
          catch {XFDestroy .fsBox}
        } {
          catch {destroy .fsBox}
        }
      }
    }
  }
}

##########
# Procedure: FSBoxFSInsertPath
# Description: insert current pathname into menu
# Arguments: none
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSInsertPath {} {# xf ignore me 6
  global fsBox

  set fsBoxLast [.fsBox.path.paths.paths.menu index last]
  set fsBoxNewEntry [string trimright [.fsBox.path.path get] "/@"]
  for {set fsBoxCounter 0} {$fsBoxCounter <= $fsBoxLast} {incr fsBoxCounter 1} {
    if {"$fsBoxNewEntry" == \
          "[lindex [.fsBox.path.paths.paths.menu entryconfigure \
                    $fsBoxCounter -label] 4]"} {
      return
    }
  }
  if {$fsBoxLast < 9} {
    .fsBox.path.paths.paths.menu add command \
      -label "$fsBoxNewEntry" \
      -command "
        global fsBox
        FSBoxFSShow $fsBoxNewEntry \
          \[.fsBox.pattern.pattern get\] \$fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBoxNewEntry"
  } {
    for {set fsBoxCounter 0} {$fsBoxCounter < $fsBoxLast} {incr fsBoxCounter 1} {
      .fsBox.path.paths.paths.menu entryconfigure \
        $fsBoxCounter -label \
          [lindex [.fsBox.path.paths.paths.menu entryconfigure \
            [expr $fsBoxCounter+1] -label] 4]
      .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter \
        -command "
          global fsBox
          FSBoxFSShow [lindex [.fsBox.path.paths.paths.menu entryconfigure \
            [expr $fsBoxCounter+1] -label] 4] \
            \[.fsBox.pattern.pattern get\] \$fsBox(all)
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 [lindex \
            [.fsBox.path.paths.paths.menu entryconfigure \
              [expr $fsBoxCounter+1] -label] 4]"
    }
    .fsBox.path.paths.paths.menu entryconfigure $fsBoxLast \
      -label "$fsBoxNewEntry"
    .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter \
      -command "
        global fsBox
        FSBoxFSShow \[.fsBox.path.path get\] \
          \[.fsBox.pattern.pattern get\] \$fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBoxNewEntry"
  }
}

##########
# Procedure: FSBoxFSNameComplete
# Description: perform name completion for fs box
# Arguments: fsBoxType - the type we want to complete (path or file)
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSNameComplete {fsBoxType} {# xf ignore me 6
  global tkVersion
  global fsBox

  set fsBoxNewFile ""
  if {"$fsBoxType" == "path"} {
    set fsBoxDirName [file dirname [.fsBox.path.path get]]
    set fsBoxFileName [file tail [.fsBox.path.path get]]
  } {
    set fsBoxDirName [file dirname [.fsBox.path.path get]/]
    set fsBoxFileName [file tail [.fsBox.file.file get]]
  }

  set fsBoxNewFile ""
  if {[IsADir [string trimright $fsBoxDirName @]]} {
    catch "glob -nocomplain $fsBoxDirName/${fsBoxFileName}*" fsBoxResult
    foreach fsBoxCounter $fsBoxResult {
      if {"$fsBoxNewFile" == ""} {
        set fsBoxNewFile [file tail $fsBoxCounter]
      } {
        if {"[string index [file tail $fsBoxCounter] 0]" !=
            "[string index $fsBoxNewFile 0]"} {
          set fsBoxNewFile ""
          break
        }
        set fsBoxCounter1 0
        set fsBoxTmpFile1 $fsBoxNewFile
        set fsBoxTmpFile2 [file tail $fsBoxCounter]
        set fsBoxLength1 [string length $fsBoxTmpFile1]
        set fsBoxLength2 [string length $fsBoxTmpFile2]
        set fsBoxNewFile ""
        if {$fsBoxLength1 > $fsBoxLength2} {
          set fsBoxLength1 $fsBoxLength2
        }
        while {$fsBoxCounter1 < $fsBoxLength1} {
          if {"[string index $fsBoxTmpFile1 $fsBoxCounter1]" == \
                "[string index $fsBoxTmpFile2 $fsBoxCounter1]"} {
            append fsBoxNewFile [string index $fsBoxTmpFile1 $fsBoxCounter1]
          } {
            break
          }
          incr fsBoxCounter1 1
        }
      }
    }
  }
  if {"$fsBoxNewFile" != ""} {
    if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]] ||
        ![IsAFile [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
      if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
        if {"$fsBoxDirName" == "/"} {
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 "/[string trimright [string trim $fsBoxNewFile /] @]/"
        } {
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]/"
        }
        FSBoxFSShow [.fsBox.path.path get] \
          [.fsBox.pattern.pattern get] $fsBox(all)
        FSBoxFSInsertPath
      } {
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]"
      }
    } {
      .fsBox.path.path delete 0 end
      .fsBox.path.path insert 0 "[string trimright $fsBoxDirName {@/}]/"
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 $fsBoxNewFile
      if {$tkVersion >= 3.0} {
        .fsBox.file.file icursor end
      } {
        .fsBox.file.file cursor end
      }
      focus .fsBox.file.file
    }
  }
}

##########
# Procedure: FSBoxFSShow
# Description: show the file list
# Arguments: fsBoxPath - the path to show
#            fsBoxPattern - selection pattern
#            fsBoxAll - show all files
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSShow {fsBoxPath fsBoxPattern fsBoxAll} {# xf ignore me 6
  global fsBox

  set tmpButtonOpt ""
  if {"$fsBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
  }
  if {"$fsBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
  }
  if {"$fsBox(background)" != ""} {
    append tmpButtonOpt "-background \"$fsBox(background)\" "
  }
  if {"$fsBox(font)" != ""} {
    append tmpButtonOpt "-font \"$fsBox(font)\" "
  }
  if {"$fsBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
  }

  set fsBox(pattern) $fsBoxPattern
  if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
      [IsADir $fsBoxPath]} {
    set fsBox(internalPath) $fsBoxPath
  } {
    if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
        [IsAFile $fsBoxPath]} {
      set fsBox(internalPath) [file dirname $fsBoxPath]
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 [file tail $fsBoxPath]
      set fsBoxPath $fsBox(internalPath)
    } {
      while {"$fsBoxPath" != "" && "$fsBoxPath" != "/" &&
             ![file isdirectory $fsBoxPath]} {
        set fsBox(internalPath) [file dirname $fsBoxPath]
         set fsBoxPath $fsBox(internalPath)
      }
    }
  }
  if {"$fsBoxPath" == ""} {
    set fsBoxPath "/"
    set fsBox(internalPath) "/"
  }
  .fsBox.path.path delete 0 end
  .fsBox.path.path insert 0 $fsBox(internalPath)

  if {[.fsBox.files.files size] > 0} {
    .fsBox.files.files delete 0 end
  }
  if {$fsBoxAll} {
    if {[catch "exec ls -F -a $fsBoxPath" fsBoxResult]} {
      puts stderr "$fsBoxResult"
    }
  } {
    if {[catch "exec ls -F $fsBoxPath" fsBoxResult]} {
      puts stderr "$fsBoxResult"
    }
  }
  set fsBoxElementList [lsort $fsBoxResult]

  foreach fsBoxCounter [winfo children .fsBox.pattern.patterns.patterns] {
    if {[string length [info commands XFDestroy]] > 0} {
      catch {XFDestroy $fsBoxCounter}
    } {
      catch {destroy $fsBoxCounter}
    }
  }
  menu .fsBox.pattern.patterns.patterns.menu
  catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"

  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add command \
      -label "*" \
      -command {
        global fsBox
        set fsBox(pattern) "*"
        .fsBox.pattern.pattern delete 0 end
        .fsBox.pattern.pattern insert 0 $fsBox(pattern)
        FSBoxFSShow [.fsBox.path.path get] $fsBox(pattern) \
          $fsBox(all)}
  }

  if {"$fsBoxPath" != "/"} {
    .fsBox.files.files insert end "../"
  }
  foreach fsBoxCounter $fsBoxElementList {
    if {[string match $fsBoxPattern $fsBoxCounter] ||
        [IsADir [string trimright $fsBoxPath/$fsBoxCounter "/@"]]} {
      if {"$fsBoxCounter" != "../" &&
          "$fsBoxCounter" != "./"} {
        .fsBox.files.files insert end $fsBoxCounter
      }
    }

    if {$fsBox(extensions)} {
      catch "file rootname $fsBoxCounter" fsBoxRootName
      catch "file extension $fsBoxCounter" fsBoxExtension
      set fsBoxExtension [string trimright $fsBoxExtension "/*@"]
      if {"$fsBoxExtension" != "" && "$fsBoxRootName" != ""} {
        set fsBoxInsert 1
        set fsBoxLast [.fsBox.pattern.patterns.patterns.menu index last]
        for {set fsBoxCounter1 0} {$fsBoxCounter1 <= $fsBoxLast} {incr fsBoxCounter1 1} {
          if {"*$fsBoxExtension" == \
                "[lindex [.fsBox.pattern.patterns.patterns.menu entryconfigure \
                        $fsBoxCounter1 -label] 4]"} {
            set fsBoxInsert 0
          }
        }
	if {$fsBoxInsert} {
          .fsBox.pattern.patterns.patterns.menu add command \
            -label "*$fsBoxExtension" \
            -command "
              global fsBox
              set fsBox(pattern) \"*$fsBoxExtension\"
              .fsBox.pattern.pattern delete 0 end
              .fsBox.pattern.pattern insert 0 \$fsBox(pattern)
              FSBoxFSShow \[.fsBox.path.path get\] \$fsBox(pattern) \
                \$fsBox(all)"
        }
      }
    }
  }
  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add separator
  }
  if {$fsBox(extensions) || 
      "[.fsBox.pattern.patterns.patterns.menu index last]" == "none"} {
    .fsBox.pattern.patterns.patterns.menu add checkbutton \
      -label "Scan extensions" \
      -variable "fsBox(extensions)" \
      -command {
        global fsBox
        FSBoxFSShow [.fsBox.path.path get] \
          [.fsBox.pattern.pattern get] $fsBox(all)}
  }
}

##########
# Procedure: FSBoxBindSelectOne
# Description: action to select the current list item
# Arguments: fsBoxW - the widget
#            fsBoxY - the y position in the listbox
# Returns: none
# Sideeffects: none
##########
proc FSBoxBindSelectOne {fsBoxW fsBoxY} {# xf ignore me 6

  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    $fsBoxW select set $fsBoxNearest 
    $fsBoxW select set $fsBoxNearest
  }
}

proc IsADir {pathName} {# xf ignore me 5
##########
# Procedure: IsADir
# Description: check if name is a directory (including symbolic links)
# Arguments: pathName - the path to check
# Returns: 1 if its a directory, otherwise 0
# Sideeffects: none
##########

  if {[file isdirectory $pathName]} {
    return 1
  } {
    catch "file type $pathName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $pathName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isdirectory $linkName]
    }
  }
  return 0
}

proc IsAFile {fileName} {# xf ignore me 5
##########
# Procedure: IsAFile
# Description: check if filename is a file (including symbolic links)
# Arguments: fileName - the filename to check
# Returns: 1 if its a file, otherwise 0
# Sideeffects: none
##########

  if {[file isfile $fileName]} {
    return 1
  } {
    catch "file type $fileName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $fileName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isfile $linkName]
    }
  }
  return 0
}

proc IsASymlink {fileName} {# xf ignore me 5
##########
# Procedure: IsASymlink
# Description: check if filename is a symbolic link
# Arguments: fileName - the path/filename to check
# Returns: none
# Sideeffects: none
##########

  catch "file type $fileName" fileType
  if {"$fileType" == "link"} {
    return 1
  }
  return 0
}

# eof

#------

# Help Text

set helptext \
"Welcome to the IF Map Editor.  This space under construction.  

The IF Map Editor is a tool to allow you to easily draw nice looking maps for IF games (text adventures).  It creates maps conforming more or less to the
standard used by Infocom in their maps.

NOTE:  This is Alpha software.  It is still under development.  There are certainly bugs.   Please read the release notes.  Also please send any feedback, bugreports or whatever to 
crosby@cs.colorado.edu

For better help, please go to 
http://ugrad-www.cs.colorado.edu/~crosby/ifmap/Help.html

How to use the map editor:
- To create a room, click the mouse button in the location you desire it

A room will be created with a box in the location of each of the compass 
points, plus one between NW and N for up and one between S and SE for down.

- To move a room, select it with the mouse button and drag it to the new location

- To create a passage between two rooms, select the location on the first room you desire, drag to the location on the second room and release the button.

- To move a passage, select the end you wish to move and drag it to its new location

- To create a passage looping back upon itself, double click upon the location you desire it. 

- To edit the parameters of a room or passage, double click on the room or passage.

Parameters For Rooms:

Name-The name of the room

Description-Any notes on the room you wish to make, for instance objects found there

Type-The type of room.  May be normal (a normal room), joins (creates an annotation without a box) or maze (a greyed out box, indicating several rooms).

Parameters For Passages:

Secret-Indicates a secret passage.  Greys out the passage.

One way-A one way passage.  Puts an arrow indicating the direction of the passag

- To delete an item, select the item and select 'delete' from the edit menu.

- To change the title of your map, select the box underneath the menu bar and type in the title.

- To save your map, select 'Save' from the File menu, type in the name and select OK.

- To load a map, select 'Load' from the File menu, type in the name and select ok.  (Note that loading may take some time if the map is big).

- To print, select 'Print' from the File menu.  A dialog box will appear allowing you to print to a file or printer.  You may choose between printing to a file or directly to a printer.  In either case, you should select the destination
in the appropriate box below each button:  The printer name, or the file name.

This option outputs Encapsulated postscript scaled to fit onto one page.  This means that if you have a very large map, you may find it hard to read.  There exist, however, various programs that will blow it up and print it over multiple pages.  Also, it may be imported into other programs.

The printed output is slightly different to the screen display, eliminating the direction buttons." 

 
set releasenotes \
"

IF Map Editor v0.1 

Copyright 1996 Matthew Crosby (crosby@cs.colorado.edu)

This is free software that may be redistributed and/or modified under the terms of the GNU General Public License as published by the Free Software Foundation.  You should have recieved a copy of this license, if not, it may be obtained by ftp from prep.ai.mit.edu.   (see license.txt)

This program is a beta.  Please send bug reports, ideas for the future or any feedback whatsoever to crosby@cs.colorado.edu.  More information about this program may be found on 
http://ugrad-www.cs.colorado.edu/~crosby/ifmap/IFMap.html

This program is a map editor for IF games.  I have tried to stick fairly close to Infocoms format.  Some sample maps and postscript output may be found in the maps directory in the release package.

This program is written in Tk/Tcl using Tk 4.0, however it _should_ be compatible with 3.6.  Specifically, it requires wish.  If you don't have wish, Tc/Tcl may be obtained from 
ftp://ftp.smli.com/pub/tcl

To install this program, simply edit the line at the top, changing the location of wish to reflect its location on your system.  You can then put the script wherever you desire--everything is self contained within the 'ifedit' script.  You may also want to install the man page somewhere.

This should be very portable, i'd be very interested in any problems anyone has running it.  It was developed on an HP 735 running HP-UX, but I've tested it on a couple of other Unix platforms.  It should run just fine on non Unix platforms, with the exception of printing (printing to a file should still work).

Ideas for the future:
Eventually, I want to expand this to create a graphical IF creation tool.  A sort of 'Visual inform and tads'.  As it stands, it is actually pretty far along; it should be relatively trivial to write a converter from the save format for this program to any language.  (The format is pretty self explanatory if anyone wants to go for it).  

I also want to ditch Tcl.  It was never designed for this level of project, and it shows.  This started out as a prototype, however I ended up putting most of the functionality I wanted into it.  But it does really need to be rewritten.  I also need to clean the code up a _lot_.  

Some of the shorter term ideas for 0.2 include:
-More entries for room info
  (so you can annotate things more)
-Less sensativity
  (right now, it requires a lot of agility of the mouse)
-optional grid
  (to make it easier to line things up)
-selecting multiple objects 
  (so you can move whole things)
-Multiple maps 
 (so you can, eg, have the zork1 forest, maze and dungeon maps all in one file)
-Undo. obvious.
-A nicer file box.  I'm not all that thrilled with the one I have.
-HTML help.  I've actually done this, just didn't get around to interfacing it in.

I'd definately be interested in any requests that anyone has. 

Finally, i'd be interested in recieving maps anyone creates for adventures.  I'd like to build a large library of maps up.  I envision a maps secition of ftp.gmd.de in the future, to go with the walkthroughs.  This program really does make things a lot easier, I was able to create the map of Zork 1 in about 15 minutes, for instance, from my hand drawn maps.

Enjoy.
"