#* 
#* ------------------------------------------------------------------
#* Role PlayingDB V2.0 by Deepwoods Software
#* ------------------------------------------------------------------
#* RPGEdTrickTrap.tcl - Trick / Trap Editor
#* Created by Robert Heller on Wed Aug 19 19:24:44 1998
#* ------------------------------------------------------------------
#* Modification History: 
#* $Log: RPGEdTrickTrap.tcl,v $
#* Revision 1.5  2000/02/11 00:30:25  heller
#* Change MacOS type code GIF => GIFf
#*
#* Revision 1.4  1999/07/13 20:30:42  heller
#* Minor doc fixes.
#*
#* 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 02:53:00  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:RPGEdTrickTrap.tcl -- Tricks and traps, things to avoid
#@Label:RPGEdTrickTrap.tcl
#$Id: RPGEdTrickTrap.tcl,v 1.5 2000/02/11 00:30:25 heller Rel $
# This file handles the creation and editing of tricks and traps, which are
# things the game master places in the game area to cause trouble for the
# player characters.  Generally these tricks and traps are used to protect
# treasures as an alternative to placing a guardian monster to guard the
# treasure.

proc RPGEdTrickTrap {{filename {}}} {
# This procedure creates and edits trick/trap objects.
# <in> filename -- the file to edit.
# [index] RPGEdTrickTrap!procedure

  global tk_version
  set toplevel [GenerateToplevelName rpgEdTri]

  RPGToplevel .$toplevel {Role Playing V2 Trick Trap Editor} TrickTrap
  wm withdraw .$toplevel
  global .$toplevel
  upvar #0 .$toplevel data
  set data(filename) "$filename"
  set data(filetype) "tricktrap"
  if {[string length "$filename"] > 0} {
    set data(object) [TrickTrap]
    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 {*TrickTrap} "[lindex [$buffer ReturnRecord] 0]"] != 0} {
	CloseWindow .$toplevel
	tkerror "Not a TrickTrap 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) [TrickTrap]
    set object $data(object)
    set data(dirty) 0
  }

# Construct a toplevel to hold the Trick / Trap'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.nameType
  frame .$toplevel.nameType \
    -borderwidth {2} \
    -relief {ridge}

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

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

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

  # build widget .$toplevel.nameType.type
  frame .$toplevel.nameType.type

  # build widget .$toplevel.nameType.type.label59
  label .$toplevel.nameType.type.label59 \
    -text {Type:}

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

  # 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 "LoadTrickTrap .$toplevel"

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

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

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

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

  # pack master .$toplevel.nameType.type
  pack configure .$toplevel.nameType.type.label59 \
    -side left
  pack configure .$toplevel.nameType.type.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.nameType \
    -fill x
  pack configure .$toplevel.description \
    -fill both
  pack configure .$toplevel.buttons \
    -fill x

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


# end of widget tree


  wm deiconify .$toplevel
}

proc SaveAsTrickTrap {tl} {
# This procedure saves the currently open trick/trap object in a disk file.
# <in> tl -- the toplevel.
# [index] SaveAsTrickTrap!procedure

  SaveTrickTrap $tl 1
}

proc SaveTrickTrap {tl {forceNew 0}} {
# This procedure saves the currently open trick/trap object in a disk file.
# <in> tl -- the toplevel.
# <in> forceNew -- flag to force a new file name.
# [index] SaveTrickTrap!procedure

  upvar #0 $tl data
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  set object [TrickTrap -this [NewTrickTrap \
			-name  "$data(name)" \
			-description "$data(comments)" \
			-image "$data(image)" \
			-type  "$data(type)"]]
  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 "Trick / Trap files" \
							  "*.$filetype"]]\
				   -parent . \
				   -title {File to save trick / trap 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
  set data(filename) "$filename"
}

proc LoadTrickTrap {tl} {
# This procedure loads a trick/trap data file into the current toplevel GUI.
# <in> tl -- the toplevel to load.
# [index] LoadTrickTrap!procedure

  upvar #0 $tl data
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  if {$data(dirty)} {
    set saveP [tk_dialog .askDirty "Save trick / trap?" \
		"Save modified Trick or Trap data?" \
		questhead 0 "Yes" "No"]
    if {$saveP == 0} {SaveTrickTrap $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 "Trick/Trap files" \
							  "*.$filetype"]]\
                                   -parent $tl \
                                   -title {File to load trick or trap 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" {*TrickTrap}] != 0} {
    rename $buffer {}
    tkerror "Not a trick / trap file: $filename"
    return
  }
  set object [TrickTrap]
  $object UpdateFromRecord $buffer
  rename $buffer {}
  set data(name) "[$object Name]"
  set data(type) "[$object Type]"
  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 CheckWriteDirtyRecordTrickTrap {tl} {
# This procedure handles toplevel rundown when the data object is ``dirty''
# (modified).  The data is saved out to a file if the user wants.
# <in> tl -- the toplevel.
# [index] CheckWriteDirtyRecordTrickTrap!procedure

  upvar #0 $tl data
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  set saveP [tk_dialog .askDirty "Save trick / trap?" "Save modified Trick or Trap data?" \
	questhead 0 "Yes" "No"]
  if {$saveP == 0} {
    set object [TrickTrap -this [NewTrickTrap \
			-name  "$data(name)" \
			-description "$data(comments)" \
			-image "$data(image)" \
			-type  "$data(type)"]]
    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 "Trick / Trap files" \
							  "*.$filetype"]]\
				   -parent . \
				   -title {File to save trick or trap 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 OpenTrickTrap {tl} {
# This procedure loads a trick/trap object file into a new GUI toplevel window.
# <in> tl -- the current toplevel window.
# [index] OpenTrickTrap!procedure

  if {"$tl" == {.}} {
    set data(filename) {}
    set data(filetype) tricktrap
    set data(class) TrickTrap
  } 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 ChangeTrickTrapPicture {tl img} {
# This procedure changes the image (picture, GIF file) associated with the
# trick/trap object.
# <in> tl -- the toplevel GUI window.
# <in> img -- the image object.
# [index] ChangeTrickTrapPicture!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 image 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 RPGEdTrickTrap 1.0