#* 
#* ------------------------------------------------------------------
#* Role PlayingDB V2.0 by Deepwoods Software
#* ------------------------------------------------------------------
#* RPGEdDressing.tcl - Dressing Editor
#* Created by Robert Heller on Fri Aug 21 08:41:33 1998
#* ------------------------------------------------------------------
#* Modification History: 
#* $Log: RPGEdDressing.tcl,v $
#* Revision 1.4  2000/02/11 00:30:25  heller
#* Change MacOS type code GIF => GIFf
#*
#* Revision 1.3  1999/07/13 01:29:16  heller
#* Fix documentation: spelling, punctuation, etc.
#*
#* Revision 1.2  1998/12/30 15:10:51  heller
#* Add in comments
#*
#* Revision 1.1  1998/12/28 01:57:59  heller
#* Initial revision
#*
#* ------------------------------------------------------------------
#* Contents:
#* ------------------------------------------------------------------
#*  
#*     Role Playing DB -- A database package that creates and maintains
#* 		       a database of RPG characters, monsters, treasures,
#* 		       spells, and playing environments.
#* 
#*     Copyright (C) 1995,1998  Robert Heller D/B/A Deepwoods Software
#* 			51 Locke Hill Road
#* 			Wendell, MA 01379-9728
#* 
#*     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., 675 Mass Ave, Cambridge, MA 02139, USA.
#* 
#*  
#* 

#@Chapter:RPGEdDressing.tcl -- Various items that might be about
#@Label:RPGEdDressing.tcl
#$Id: RPGEdDressing.tcl,v 1.4 2000/02/11 00:30:25 heller Rel $
# This file deals with various fixed items that might be in a room or other
# place in an adventure: things like furniture and other items that ``dress
# up the place''


proc RPGEdDressing {{filename {}}} {
# This procedure creates or edits a (dungeon) ``dressing'' -- things like
# furniture and related items.
# <in> filename -- the file to open.
# [index] RPGEdDressing!procedure

  global tk_version
  set toplevel [GenerateToplevelName rpgEdDres]

  RPGToplevel .$toplevel {Role Playing V2 Dressing Editor} Dressing
  wm withdraw .$toplevel
  global .$toplevel
  upvar #0 .$toplevel data
  set data(filename) "$filename"
  set data(filetype) "dressing"
  if {[string length "$filename"] > 0} {
    set data(object) [Dressing]
    set object $data(object)
    if {[file readable "$filename"]} {
    set buffer [Record]
      if {[catch [list $buffer ReadRecord "$filename"] err]} {
        CloseWindow .$toplevel
        tkerror "Could not load $filename: $err"
        return
      }
      if {[string compare {*Dressing} "[lindex [$buffer ReturnRecord] 0]"] != 0} {
	CloseWindow .$toplevel
	tkerror "Not a dressing file: $filename"
	return
      }
      $object UpdateFromRecord $buffer
      rename $buffer {}
    } else {
      CloseWindow .$toplevel
      tkerror "File does not exist or is not readable: $filename"
      return
    }
  } else {
    set data(object) [Dressing]
    set object $data(object)
    set data(dirty) 0
  }

# Construct a toplevel to hold the dressing's picture
  toplevel .$toplevel.picture
  wm transient .$toplevel.picture .$toplevel
  wm title .$toplevel.picture {Picture of Trick or Trap}
  wm protocol .$toplevel.picture WM_DELETE_WINDOW {NoOperation}
  label .$toplevel.picture.imname -text "[$object Image]" -relief sunken -border 2
  image create photo im$toplevel
#  puts stderr "*** \[image names\] = [image names] - 'im$toplevel'"
  label .$toplevel.picture.picture -image im$toplevel -relief ridge -border 2
  bind .$toplevel.picture <Destroy> [list catch "image delete im$toplevel"]
  pack .$toplevel.picture.imname -expand 1 -fill x
  pack .$toplevel.picture.picture -expand 1 -fill both
  set im "[$object Image]"
  if {[string length "$im"] > 0} { 
    if {[catch [list im$toplevel configure -format gif -file "$im"] err]} {
      tkerror "Could not set image file $im for image im$toplevel: $err"
    }
  }
  set data(image) "$im"

  # build widget .$toplevel.nameValue
  frame .$toplevel.nameValue \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.nameValue.name
  frame .$toplevel.nameValue.name

  # build widget .$toplevel.nameValue.name.label57
  label .$toplevel.nameValue.name.label57 \
    -text {Name:}

  # build widget .$toplevel.nameValue.name.value
  entry .$toplevel.nameValue.name.value \
    -width {0} \
    -textvariable ".[set toplevel](name)"
  bind .$toplevel.nameValue.name.value <KeyPress> "SetDirty .$toplevel"

  # build widget .$toplevel.nameValue.value
  frame .$toplevel.nameValue.value

  # build widget .$toplevel.nameValue.value.label59
  label .$toplevel.nameValue.value.label59 \
    -text {Value:}

  # build widget .$toplevel.nameValue.value.value
  entry .$toplevel.nameValue.value.value \
    -width {0} \
    -textvariable ".[set toplevel](value)"
  bind .$toplevel.nameValue.value.value <KeyPress> "SetDirty .$toplevel"
  bindtags .$toplevel.nameValue.value.value \
	[list .$toplevel.nameValue.value.value Entry .$toplevel all IntEntry]

  # build widget .$toplevel.description
  frame .$toplevel.description \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.description.scrollbar1
  scrollbar .$toplevel.description.scrollbar1 \
    -command ".$toplevel.description.value yview" \
    -relief {raised}

  # build widget .$toplevel.description.value
  text .$toplevel.description.value \
    -height {10} \
    -width {60} \
    -wrap {word} \
    -yscrollcommand ".$toplevel.description.scrollbar1 set"
  bindtags .$toplevel.description.value \
	[list .$toplevel.description.value Text .$toplevel all UpdComments]

  # build widget .$toplevel.buttons
  frame .$toplevel.buttons \
    -borderwidth {2}

  # build widget .$toplevel.buttons.button61
  button .$toplevel.buttons.button61 \
    -text {Load} \
    -command "LoadDressing .$toplevel"

  # build widget .$toplevel.buttons.button62
  button .$toplevel.buttons.button62 \
    -text {Save} \
    -command "SaveDressing .$toplevel"

  # build widget .$toplevel.buttons.button63
  button .$toplevel.buttons.button63 \
    -text {Change Picture} \
    -command "ChangeDressingPicture .$toplevel im$toplevel"

  # pack master .$toplevel.nameValue
  pack configure .$toplevel.nameValue.name \
    -expand 1 \
    -fill x \
    -side left
  pack configure .$toplevel.nameValue.value \
    -expand 1 \
    -fill x \
    -side left

  # pack master .$toplevel.nameValue.name
  pack configure .$toplevel.nameValue.name.label57 \
    -side left
  pack configure .$toplevel.nameValue.name.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.nameValue.value
  pack configure .$toplevel.nameValue.value.label59 \
    -side left
  pack configure .$toplevel.nameValue.value.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.description
  pack configure .$toplevel.description.scrollbar1 \
    -fill y \
    -side right
  pack configure .$toplevel.description.value \
    -expand 1 \
    -fill both

  # pack master .$toplevel.buttons
  pack configure .$toplevel.buttons.button61 \
    -expand 1 \
    -side left
  pack configure .$toplevel.buttons.button62 \
    -expand 1 \
    -side left
  pack configure .$toplevel.buttons.button63 \
    -expand 1 \
    -side left

  # pack master .$toplevel
  pack configure .$toplevel.nameValue \
    -fill x
  pack configure .$toplevel.description \
    -fill both
  pack configure .$toplevel.buttons \
    -fill x

  set data(name) "[$object Name]"
  set data(value) [$object Value]
  set data(comments) "[$object Description]"
  .$toplevel.description.value insert end "$data(comments)"
  rename $object {}


# end of widget tree


  wm deiconify .$toplevel
}

proc SaveAsDressing {tl} {
# This procedure saves the current object in a prompted for file.  Bound to
# the ``SaveAs...'' menu item on the ``File'' menu.
# <in> tl -- the toplevel to save.
# [index] SaveAsDressing!procedure

  SaveDressing $tl 1
}

proc SaveDressing {tl {forceNew 0}} {
# This procedure saves the current object in the file named in the structure.
# Bound to the ``Save'' menu item on the ``File'' menu.
# <in> tl -- the toplevel to save.
# <in> forceNew -- force a new filename flag.
# [index] SaveDressing!procedure

  upvar #0 $tl data
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  set object [Dressing -this [NewDressing \
			-name  "$data(name)" \
			-description "$data(comments)" \
			-image "$data(image)" \
			-value  $data(value)]]
  set buffer [Record -this [$object RawData]]
  set initdir "[file dirname $filename]"
  if {[string compare "$initdir" {.}] == 0} {set initdir "[pwd]"}
  if {[string compare "[string index "$initdir" 0]" {/}] != 0} {
    set initdir [file join "[pwd]" "$initdir"]
  }
  if {[string length "$filename"] == 0} {
    set initfile "new.$filetype"
  } else {
    set initfile "$filename"
  }
  if {$forceNew || [string length "$filename"] == 0} {
    set filename [tk_getSaveFile -defaultextension ".$filetype" \
      				   -initialfile "$initfile" \
				   -initialdir "$initdir" \
				   -filetypes [list [list "Dressing files" \
							  "*.$filetype"]]\
				   -parent . \
				   -title {File to save dressing data in}]
    if {[string length "$filename"] == 0} {return}
    if {[string length "[file extension $filename]"] == 0} {
	set filename "$filename.$filetype"
    }
  }
  $buffer WriteRecord "$filename"
  rename $buffer {}
  rename $object {}
  set data(dirty) 0
}

proc LoadDressing {tl} {
# This procedure loads a dressing object file into the current GUI toplevel.
# <in> tl -- the toplevel to load into.
# [index] LoadDressing!procedure

  upvar #0 $tl data
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  if {$data(dirty)} {
    set saveP [tk_dialog .askDirty "Save dressing?" \
		"Save modified Dressing data?" \
		questhead 0 "Yes" "No"]
    if {$saveP == 0} {SaveDressing $tl}
  }
  set initdir "[file dirname $filename]"
  if {[string compare "$initdir" {.}] == 0} {set initdir "[pwd]"}
  if {[string compare "[string index "$initdir" 0]" {/}] != 0} {
    set initdir [file join "[pwd]" "$initdir"]
  }
  set filename [tk_getOpenFile -defaultextension ".$filetype" \
				   -initialfile "$filename" \
                                   -initialdir "$initdir" \
                                   -filetypes [list [list "Dressing files" \
							  "*.$filetype"]]\
                                   -parent $tl \
                                   -title {File to load dressing data from}]
  if {[string length "$filename"] == 0} {return}
  set buffer [Record]
  if {[catch [list $buffer ReadRecord "$filename"] err]} {
    tkerror "Could not load file $filename: $err"
    rename $buffer {}
    return
  }
  set key [lindex [$buffer ReturnRecord] 0]
  if {[string compare "$key" {*Dressing}] != 0} {
    rename $buffer {}
    tkerror "Not a trick / trap file: $filename"
    return
  }
  set object [Dressing]
  $object UpdateFromRecord $buffer
  rename $buffer {}
  set data(name) "[$object Name]"
  set data(value) [$object Value]
  set data(image) "[$object Image]"
  set data(comments) "[$object Description]"
  $tl.description.value insert end "$data(comments)"
  set data(dirty) 0
  rename $object {}
  set img [$tl.picture.picture cget -image]
  if {[catch [list $img configure -format gif -file "$data(image)"] err]} {
    tkerror "Could not set image file $data(image) for image $img: $err"
  }
  $tl.picture.imname configure -text "$data(image)"
}

proc CheckWriteDirtyRecordDressing {tl} {
# This procedure is called when the toplevel is being closed and the data
# structure is ``dirty'' (modified).  The user is asked if the data should
# be saved.
# <in> tl -- the toplevel.
# [index] CheckWriteDirtyRecordDressing!procedure

  upvar #0 $tl data
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  set saveP [tk_dialog .askDirty "Save dressing?" "Save modified Dressing data?" \
	questhead 0 "Yes" "No"]
  if {$saveP == 0} {
    set object [Dressing -this [NewDressing \
			-name  "$data(name)" \
			-description "$data(comments)" \
			-image "$data(image)" \
			-value  $data(value)]]
    set buffer [Record -this [$object RawData]]
    set initdir "[file dirname $filename]"
    if {[string compare "$initdir" {.}] == 0} {set initdir "[pwd]"}
    if {[string compare "[string index "$initdir" 0]" {/}] != 0} {
      set initdir [file join "[pwd]" "$initdir"]
    }
    if {[string length "$filename"] == 0} {
      set initfile "new.$filetype"
    } else {
      set initfile "$filename"
    }
    if {[string length "$filename"] == 0} {
      set filename [tk_getSaveFile -defaultextension ".$filetype" \
      				   -initialfile "$initfile" \
				   -initialdir "$initdir" \
				   -filetypes [list [list "Dressing files" \
							  "*.$filetype"]]\
				   -parent . \
				   -title {File to save dressing data in}]
      if {[string length "$filename"] == 0} {return}
      if {[string length "[file extension $filename]"] == 0} {
	set filename "$filename.$filetype"
      }
    }
    $buffer WriteRecord "$filename"
    rename $buffer {}
    rename $object {}
  }
}



proc OpenDressing {tl} {
# This procedure loads a dressing data object file into a new toplevel GUI
# window.
# <in> tl -- the current toplevel.
# [index] OpenDressing!procedure

  if {"$tl" == {.}} {
    set data(filename) {}
    set data(filetype) dressing
    set data(class) Dressing
  } else {
    upvar #0 $tl data
  }
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  set initdir "[file dirname $filename]"
  if {[string compare "$initdir" {.}] == 0} {set initdir "[pwd]"}
  if {[string compare "[string index "$initdir" 0]" {/}] != 0} {
    set initdir [file join "[pwd]" "$initdir"]
  }
  set filename [tk_getOpenFile -defaultextension ".$data(filetype)" \
			   -filetypes [list [list "$data(class) files" \
					"*.$filetype"]]\
			   -parent $tl \
			   -initialfile "$filename" \
			   -initialdir "$initdir" \
			   -title "File to load $data(class) data from"]
  if {[string length "$filename"] == 0} {return}
  RPGEd$data(class) "$filename"
}

proc ChangeDressingPicture {tl img} {
# This procedure is used to update the dressing's picture (GIF file).
# <in> tl -- the current toplevel.
# <in> img -- the image to update.
# [index] ChangeDressingPicture!procedure

  upvar #0 $tl data
  set initdir "[file dirname $data(image)]"
  if {[string compare "$initdir" {.}] == 0} {set initdir "[pwd]"}
  if {[string compare "[string index "$initdir" 0]" {/}] != 0} {
    set initdir [file join "[pwd]" "$initdir"]
  }
  set newIm [tk_getOpenFile -defaultextension {.gif} \
			    -filetypes { { {GIF Files} {*.gif *.GIF} GIFf } }  \
			    -initialfile "$data(image)" \
			    -initialdir "$initdir" \
			    -parent "$tl" \
			    -title {Select a new imgage file}]
  if {[string length "$newIm"] == 0} {return}
  if {[catch [list $img configure -format gif -file "$newIm"] err]} {
    tkerror "Could not set image file $newIm for image $img: $err"
  }
  $tl.picture.imname configure -text "$newIm"
  set data(image) "$newIm"
  set data(dirty) 1
}


package provide RPGEdDressing 1.0