#* 
#* ------------------------------------------------------------------
#* Role PlayingDB V2.0 by Deepwoods Software
#* ------------------------------------------------------------------
#* RPGEdCharacter.tcl - Make or Edit a character
#* Created by Robert Heller on Tue Aug 11 14:01:14 1998
#* ------------------------------------------------------------------
#* Modification History: 
#* $Log: RPGEdCharacter.tcl,v $
#* Revision 1.8  2000/02/11 00:30:25  heller
#* Change MacOS type code GIF => GIFf
#*
#* Revision 1.7  1999/07/13 01:29:16  heller
#* Fix documentation: spelling, punctuation, etc.
#*
#* Revision 1.6  1999/04/19 21:36:01  heller
#* Update HelpTopics to match help topic links.
#*
#* Revision 1.5  1999/03/28 06:20:44  heller
#* Update on-line help.
#*
#* Revision 1.4  1998/12/31 02:27:42  heller
#* Fix small problem with new character roll dialog
#*
#* Revision 1.3  1998/12/30 15:05:20  heller
#* Added in documentation
#*
#* Revision 1.2  1998/12/28 01:41:55  heller
#* Add in chapter heading text.
#*
#* Revision 1.1  1998/12/28 01:06:03  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:RPGEdCharacter.tcl -- The characters in the game.
#@Label:RPGEdCharacter.tcl
#$Id: RPGEdCharacter.tcl,v 1.8 2000/02/11 00:30:25 heller Rel $
# This file deals with editing data objects that describe both player and 
# non-player characters -- intelligent persons that are involved in the 
# adventure.

proc RPGEdCharacter {{filename {}}} {
# This procedure creates or edits a character object file. 
# <in> filename -- the file to load a character object from.
# [index] RPGEdCharacter!procedure

  global tk_version

# Generate a unique name for the toplevel
  set toplevel [GenerateToplevelName rpgEdCh]

# Construct a standarized toplevel, complete with standard menubar.
# Also add the toplevel to the list of active toplevels
  RPGToplevel .$toplevel {Role Playing V2 Character Editor} Character
# Withdraw the toplevel while we build it
  wm withdraw .$toplevel
# Make the toplevel a global variable -- all of the status and in memory state
# for this toplevel will be kept in the array
  global .$toplevel
# Bind the toplevel array name to a convient variable handle
  upvar #0 .$toplevel data
# Initialize some basic fields in the toplevel
  set data(filename) "$filename"
  set data(filetype) "character"
# If the filename parameter was non null, open and read in the data file
  if {[string length "$filename"] > 0} {
    set data(object) [Character]
    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 {*Character} "[lindex [$buffer ReturnRecord] 0]"] != 0} {
	CloseWindow .$toplevel
	tkerror "Not a Character file: $filename"
	return
      }
      $object UpdateFromRecord $buffer
      rename $buffer {}
    } else {
      CloseWindow .$toplevel
      tkerror "File does not exist or is not readable: $filename"
      return
    }
# Otherwise create a new character data object, either by rolling stats
# or creating a default character data object.
  } else {
    if {[tk_dialog .askNewRoll "Roll new character?" \
		"Roll attributes for a new character?"  questhead 0 "Yes" "No"] \
		== 0} {
      set data(object) [RollChar .]
      if {[string length "$data(object)"] == 0} {
	set data(object) [Character]
      }
      set data(dirty) 0
      set object $data(object)
    } else {
      set data(object) [Character]
      set object $data(object)
      set data(dirty) 0
    }
  }

# Create a second, transient toplevel as a child of this toplevel to hold the
# character picture.
  toplevel .$toplevel.picture
  wm transient .$toplevel.picture .$toplevel
  wm title .$toplevel.picture {Picture of Character}
  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"
    }
  }

#  # build widget .$toplevel.label1
#  label .$toplevel.label1 \
#    -font {-Adobe-Helvetica-Bold-R-Normal--*-240-*-*-*-*-*-*} \
#    -text {Character}

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

  # build widget .$toplevel.attributes.left
  frame .$toplevel.attributes.left

  # build widget .$toplevel.attributes.left.strength
  frame .$toplevel.attributes.left.strength \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.attributes.left.strength.label9
  label .$toplevel.attributes.left.strength.label9 \
    -text {Strength:}

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

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

  # build widget .$toplevel.attributes.left.intelligence
  frame .$toplevel.attributes.left.intelligence \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.attributes.left.intelligence.label14
  label .$toplevel.attributes.left.intelligence.label14 \
    -text {Intelligence}

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

  # build widget .$toplevel.attributes.left.wisdom
  frame .$toplevel.attributes.left.wisdom \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.attributes.left.wisdom.label16
  label .$toplevel.attributes.left.wisdom.label16 \
    -text {Wisdom:}

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

  # build widget .$toplevel.attributes.right
  frame .$toplevel.attributes.right

  # build widget .$toplevel.attributes.right.dexterity
  frame .$toplevel.attributes.right.dexterity \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.attributes.right.dexterity.label21
  label .$toplevel.attributes.right.dexterity.label21 \
    -text {Dexterity:}

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

  # build widget .$toplevel.attributes.right.constitution
  frame .$toplevel.attributes.right.constitution \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.attributes.right.constitution.label23
  label .$toplevel.attributes.right.constitution.label23 \
    -text {Constitution:}

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

  # build widget .$toplevel.attributes.right.charisma
  frame .$toplevel.attributes.right.charisma \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .$toplevel.attributes.right.charisma.label24
  label .$toplevel.attributes.right.charisma.label24 \
    -text {Charisma:}

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

  # build widget .$toplevel.label4
  label .$toplevel.label4 \
    -text {Descriptive text:}

  # 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 {sunken}

  # build widget .$toplevel.description.value
  text .$toplevel.description.value \
    -height {2} \
    -width {60} \
    -relief {sunken} \
    -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} \
    -relief {ridge}

  # build widget .$toplevel.buttons.label41
  label .$toplevel.buttons.label41 \
    -text {Current Level:}

  # build widget .$toplevel.buttons.clevel
  label .$toplevel.buttons.clevel \
    -relief {sunken} \
    -textvariable ".[set toplevel](level)"

  # build widget .$toplevel.buttons.button47
  button .$toplevel.buttons.button47 \
    -text {Roll Excecpt. Strength} \
    -command "ChRollExceptionalStrength .$toplevel"

  # build widget .$toplevel.buttons.button48
  button .$toplevel.buttons.button48 \
    -text {+ Level} \
    -command "AdvanceChLevel .$toplevel"

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

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

  # build widget .$toplevel.buttons.button51
  button .$toplevel.buttons.button51 \
    -text {Change Picture} \
    -command "UpdateCharacterPicture .$toplevel $object im$toplevel" 

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

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

  # build widget .$toplevel.demographics.chname.label35
  label .$toplevel.demographics.chname.label35 \
    -text {Character Name:}

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

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

  # build widget .$toplevel.demographics.plname.label35
  label .$toplevel.demographics.plname.label35 \
    -text {Player Name:}

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

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

  # build widget .$toplevel.demographics.race.label35
  label .$toplevel.demographics.race.label35 \
    -text {Character Race:}

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

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

  # build widget .$toplevel.demographics.alignment.label35
  label .$toplevel.demographics.alignment.label35 \
    -text {Character Alignment:}

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

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

  # build widget .$toplevel.demographics.sex.label35
  label .$toplevel.demographics.sex.label35 \
    -text {Character Sex:}

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

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

  # build widget .$toplevel.demographics.age.label35
  label .$toplevel.demographics.age.label35 \
    -text {Character Age:}

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

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

  # build widget .$toplevel.demographics.expAndGold.experiencePoints
  frame .$toplevel.demographics.expAndGold.experiencePoints

  # build widget .$toplevel.demographics.expAndGold.experiencePoints.label35
  label .$toplevel.demographics.expAndGold.experiencePoints.label35 \
    -text {Experience Points:}

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

  # build widget .$toplevel.demographics.expAndGold.gold
  frame .$toplevel.demographics.expAndGold.gold

  # build widget .$toplevel.demographics.expAndGold.gold.label35
  label .$toplevel.demographics.expAndGold.gold.label35 \
    -text {Gold Pieces:}

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

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

  # build widget .$toplevel.demographics.hpAndClass.hitPoints
  frame .$toplevel.demographics.hpAndClass.hitPoints

  # build widget .$toplevel.demographics.hpAndClass.hitPoints.label35
  label .$toplevel.demographics.hpAndClass.hitPoints.label35 \
    -text {Hit Points:}

  # build widget .$toplevel.demographics.hpAndClass.hitPoints.value
  label .$toplevel.demographics.hpAndClass.hitPoints.value \
    -relief {sunken} \
    -textvariable ".[set toplevel](hp)"

  # build widget .$toplevel.demographics.hpAndClass.class
  frame .$toplevel.demographics.hpAndClass.class

  # build widget .$toplevel.demographics.hpAndClass.class.label35
  label .$toplevel.demographics.hpAndClass.class.label35 \
    -text {Character Class:}

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

  # pack master .$toplevel.attributes
  pack configure .$toplevel.attributes.left \
    -expand 1 \
    -fill both \
    -side left
  pack configure .$toplevel.attributes.right \
    -expand 1 \
    -fill both \
    -side right

  # pack master .$toplevel.attributes.left
  pack configure .$toplevel.attributes.left.strength \
    -expand 1 \
    -fill x
  pack configure .$toplevel.attributes.left.intelligence \
    -expand 1 \
    -fill x
  pack configure .$toplevel.attributes.left.wisdom \
    -expand 1 \
    -fill x

  # pack master .$toplevel.attributes.left.strength
  pack configure .$toplevel.attributes.left.strength.label9 \
    -side left
  pack configure .$toplevel.attributes.left.strength.value \
    -expand 1 \
    -fill x \
    -side left
  pack configure .$toplevel.attributes.left.strength.extra \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.attributes.left.intelligence
  pack configure .$toplevel.attributes.left.intelligence.label14 \
    -side left
  pack configure .$toplevel.attributes.left.intelligence.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.attributes.left.wisdom
  pack configure .$toplevel.attributes.left.wisdom.label16 \
    -side left
  pack configure .$toplevel.attributes.left.wisdom.value \
    -expand 1 \
    -fill x \
    -side left

  # pack master .$toplevel.attributes.right
  pack configure .$toplevel.attributes.right.dexterity \
    -expand 1 \
    -fill x
  pack configure .$toplevel.attributes.right.constitution \
    -expand 1 \
    -fill x
  pack configure .$toplevel.attributes.right.charisma \
    -expand 1 \
    -fill x

  # pack master .$toplevel.attributes.right.dexterity
  pack configure .$toplevel.attributes.right.dexterity.label21 \
    -side left
  pack configure .$toplevel.attributes.right.dexterity.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.attributes.right.constitution
  pack configure .$toplevel.attributes.right.constitution.label23 \
    -side left
  pack configure .$toplevel.attributes.right.constitution.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.attributes.right.charisma
  pack configure .$toplevel.attributes.right.charisma.label24 \
    -side left
  pack configure .$toplevel.attributes.right.charisma.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.label41 \
    -side left
  pack configure .$toplevel.buttons.clevel \
    -expand 1 \
    -fill x \
    -side left
  pack configure .$toplevel.buttons.button47 \
    -side left
  pack configure .$toplevel.buttons.button48 \
    -side left
  pack configure .$toplevel.buttons.button49 \
    -side left
  pack configure .$toplevel.buttons.button50 \
    -side left
  pack configure .$toplevel.buttons.button51 \
    -side left

  # pack master .$toplevel.demographics
  pack configure .$toplevel.demographics.chname \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics.plname \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics.race \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics.alignment \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics.sex \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics.age \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics.expAndGold \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics.hpAndClass \
    -expand 1 \
    -fill x

  # pack master .$toplevel.demographics.chname
  pack configure .$toplevel.demographics.chname.label35 \
    -side left
  pack configure .$toplevel.demographics.chname.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.plname
  pack configure .$toplevel.demographics.plname.label35 \
    -side left
  pack configure .$toplevel.demographics.plname.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.race
  pack configure .$toplevel.demographics.race.label35 \
    -side left
  pack configure .$toplevel.demographics.race.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.alignment
  pack configure .$toplevel.demographics.alignment.label35 \
    -side left
  pack configure .$toplevel.demographics.alignment.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.sex
  pack configure .$toplevel.demographics.sex.label35 \
    -side left
  pack configure .$toplevel.demographics.sex.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.age
  pack configure .$toplevel.demographics.age.label35 \
    -side left
  pack configure .$toplevel.demographics.age.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.expAndGold
  pack configure .$toplevel.demographics.expAndGold.experiencePoints \
    -expand 1 \
    -fill x \
    -side left
  pack configure .$toplevel.demographics.expAndGold.gold \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.expAndGold.experiencePoints
  pack configure .$toplevel.demographics.expAndGold.experiencePoints.label35 \
    -side left
  pack configure .$toplevel.demographics.expAndGold.experiencePoints.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.expAndGold.gold
  pack configure .$toplevel.demographics.expAndGold.gold.label35 \
    -side left
  pack configure .$toplevel.demographics.expAndGold.gold.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.hpAndClass
  pack configure .$toplevel.demographics.hpAndClass.hitPoints \
    -expand 1 \
    -fill x \
    -side left
  pack configure .$toplevel.demographics.hpAndClass.class \
    -expand 1 \
    -fill x \
    -side left

  # pack master .$toplevel.demographics.hpAndClass.hitPoints
  pack configure .$toplevel.demographics.hpAndClass.hitPoints.label35 \
    -side left
  pack configure .$toplevel.demographics.hpAndClass.hitPoints.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel.demographics.hpAndClass.class
  pack configure .$toplevel.demographics.hpAndClass.class.label35 \
    -side left
  pack configure .$toplevel.demographics.hpAndClass.class.value \
    -expand 1 \
    -fill x \
    -side right

  # pack master .$toplevel
#  pack configure .$toplevel.label1 \
#    -fill x
  pack configure .$toplevel.attributes \
    -expand 1 \
    -fill x
  pack configure .$toplevel.demographics \
    -expand 1 \
    -fill x
  pack configure .$toplevel.label4 \
    -fill x
  pack configure .$toplevel.description \
    -fill both
  pack configure .$toplevel.buttons \
    -expand 1 \
    -fill x

#
# Initialize the GUI from the data object.
#
  set data(hp) [$object HitPoints]
  set data(strength) [$object Strength]
  set data(intelligence) [$object Intelligence]
  set data(wisdom) [$object Wisdom]
  set data(dexterity) [$object Dexterity]
  set data(constitution) [$object Constitution]
  set data(charisma) [$object Charisma]
  set data(estrength) [$object ExceptionalStrength]
  set data(name) "[$object Name]"
  set data(playername) "[$object Player]"
  set data(race) "[$object Race]"
  set data(chclass) "[$object CharacterClass]"
  set data(alignment) "[$object Alignment]"
  set data(set) "[$object Sex]"
  set data(age) [$object Age]
  set data(ep) [$object ExperiencePoints]
  set data(gold) [$object Gold]
  set data(comments) "[$object Comments]"
  .$toplevel.description.value insert end "$data(comments)"
  set data(level) [$object Level]

# end of widget tree

  wm deiconify .$toplevel
}

proc UpdateCharacterPicture {tl obj img} {
# This procedure re-draws the character's picture, which is a GIF file.
# <in> tl -- the toplevel.
# <in> obj -- the data object.
# <in> img -- the new image file name.
# [index] UpdateCharacterPicture!procedure

  upvar #0 $tl data
  set initialfile "[$obj Image]"
  set initdir "[file dirname $initialfile]"
  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 "$initialfile" \
			    -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"
  $obj SetImage "$newIm"
  set data(dirty) 1
}

proc CheckWriteDirtyRecordCharacter {tl} {
# This procedure is called when the toplevel is closed and the toplevel's dirty
# flag is set.  The user is asked if the data should be saved or not.
# <in> tl - the toplevel.
# [index] CheckWriteDirtyRecordCharacter!procedure

  upvar #0 $tl data
  set object $data(object)
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  set saveP [tk_dialog .askDirty "Save character?" "Save modified Character data?" \
	questhead 0 "Yes" "No"]
  if {$saveP == 0} {
    $object SetStrength $data(strength)
    $object SetExceptionalStrength $data(estrength)
    $object SetIntelligence $data(intelligence)
    $object SetWisdom $data(wisdom)
    $object SetDexterity $data(dexterity)
    $object SetConstitution $data(constitution)
    $object SetCharisma $data(charisma)
    $object SetName "$data(name)"
    $object SetPlayer "$data(playername)"
    $object SetRace "$data(race)"
    $object SetCharacterClass "$data(chclass)"
    $object SetAlignment "$data(alignment)"
    $object SetSex "$data(sex)"
    $object SetAge $data(age)
    $object SetExperiencePoints $data(ep)
    $object SetGold $data(gold)
    $object SetComments "$data(comments)"
    set buffer [Record -this [$object RawData]]
    if {[string length "$filename"] == 0} {
      set filename [tk_getSaveFile -defaultextension ".$filetype" \
      				   -initialfile "new.$filetype" \
				   -initialdir "[pwd]" \
				   -filetypes [list [list "Character files" \
							  "*.$filetype"]]\
				   -parent . \
				   -title {File to save character 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 RollChar {tl} {
# This procedure ``rolls'' a new character.  This procedure uses pseudo dice
# rolls to generate new character attribute statistics and the initial hit 
# points.
# <in> tl -- the toplevel.
# [index] RollChar!procedure

  # build widget .rollChar
  if {"[info procs XFEdit]" != ""} {
    catch "XFDestroy .rollChar"
  } {
    catch "destroy .rollChar"
  }
  toplevel .rollChar 

  # Window manager configurations
  wm positionfrom .rollChar ""
  wm sizefrom .rollChar ""
  wm maxsize .rollChar 625 450
  wm minsize .rollChar 1 1
  wm title .rollChar {Roll Character}
  wm transient .rollChar $tl


  # build widget .rollChar.parameters
  frame .rollChar.parameters \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .rollChar.parameters.label4
  label .rollChar.parameters.label4 \
    -text {Attr. Dice:}

  # build widget .rollChar.parameters.nattdie
  entry .rollChar.parameters.nattdie \
    -width {1} -textvariable nattdie

  # build widget .rollChar.parameters.label6
  label .rollChar.parameters.label6 \
    -text {d}

  # build widget .rollChar.parameters.attrnsides
  entry .rollChar.parameters.attrnsides \
    -width {1} -textvariable attrnsides

  # build widget .rollChar.parameters.label8
  label .rollChar.parameters.label8 \
    -text {, Hit Dice:}

  # build widget .rollChar.parameters.hdNum
  entry .rollChar.parameters.hdNum \
    -width {1} -textvariable hdNum

  # build widget .rollChar.parameters.label10
  label .rollChar.parameters.label10 \
    -text {d}

  # build widget .rollChar.parameters.hdNsides
  entry .rollChar.parameters.hdNsides \
    -width {1} -textvariable hdNsides

  # build widget .rollChar.parameters.label12
  label .rollChar.parameters.label12 \
    -text {, Max hit dice:}

  # build widget .rollChar.parameters.maxHd
  entry .rollChar.parameters.maxHd \
    -width {2} -textvariable maxHd

  # build widget .rollChar.values
  frame .rollChar.values \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .rollChar.values.label14
  label .rollChar.values.label14 \
    -text {S:}

  # build widget .rollChar.values.sval
  label .rollChar.values.sval \
    -relief {sunken}

  # build widget .rollChar.values.label16
  label .rollChar.values.label16 \
    -text {I:}

  # build widget .rollChar.values.ival
  label .rollChar.values.ival \
    -relief {sunken}

  # build widget .rollChar.values.label18
  label .rollChar.values.label18 \
    -text {W:}

  # build widget .rollChar.values.wval
  label .rollChar.values.wval \
    -relief {sunken}

  # build widget .rollChar.values.label20
  label .rollChar.values.label20 \
    -text {D:}

  # build widget .rollChar.values.dval
  label .rollChar.values.dval \
    -relief {sunken}

  # build widget .rollChar.values.label22
  label .rollChar.values.label22 \
    -text {C:}

  # build widget .rollChar.values.cval
  label .rollChar.values.cval \
    -relief {sunken}

  # build widget .rollChar.values.label24
  label .rollChar.values.label24 \
    -text {Ch:}

  # build widget .rollChar.values.chval
  label .rollChar.values.chval \
    -relief {sunken}

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

  # build widget .rollChar.buttons.button26
  button .rollChar.buttons.button26 \
    -padx {9} \
    -pady {3} \
    -text {Re-Roll} \
    -command {
  set rollCharDice [Dice -args [.rollChar.parameters.attrnsides get] \
			       [.rollChar.parameters.nattdie get]]
#  puts stderr "*** (re-roll) rollCharDice = $rollCharDice, TypeOfDice : [$rollCharDice TypeOfDice]"
  .rollChar.values.sval configure -text [$rollCharDice Roll]
  .rollChar.values.ival configure -text [$rollCharDice Roll]
  .rollChar.values.wval configure -text [$rollCharDice Roll]
  .rollChar.values.dval configure -text [$rollCharDice Roll]
  .rollChar.values.cval configure -text [$rollCharDice Roll]
  .rollChar.values.chval configure -text [$rollCharDice Roll]
  rename $rollCharDice {}
  }	

  # build widget .rollChar.buttons.button27
  button .rollChar.buttons.button27 \
    -padx {9} \
    -pady {3} \
    -text {Accept Roll} \
    -command {global rollChar;set rollChar 1}

  # build widget .rollChar.buttons.button28
  button .rollChar.buttons.button28 \
    -padx {9} \
    -pady {3} \
    -text {Dismiss} \
    -command {global rollChar;set rollChar 0}

  # build widget .rollChar.buttons.button29
  button .rollChar.buttons.button29 \
    -padx {9} \
    -pady {3} \
    -text {Help} \
    -command {HelpTopic {New Character Roll Dialog}}

  # pack master .rollChar.parameters
  pack configure .rollChar.parameters.label4 \
    -side left
  pack configure .rollChar.parameters.nattdie \
    -side left
  pack configure .rollChar.parameters.label6 \
    -side left
  pack configure .rollChar.parameters.attrnsides \
    -side left
  pack configure .rollChar.parameters.label8 \
    -side left
  pack configure .rollChar.parameters.hdNum \
    -side left
  pack configure .rollChar.parameters.label10 \
    -side left
  pack configure .rollChar.parameters.hdNsides \
    -side left
  pack configure .rollChar.parameters.label12 \
    -side left
  pack configure .rollChar.parameters.maxHd \
    -side left

  # pack master .rollChar.values
  pack configure .rollChar.values.label14 \
    -side left
  pack configure .rollChar.values.sval \
    -expand 1 \
    -fill x \
    -side left
  pack configure .rollChar.values.label16 \
    -side left
  pack configure .rollChar.values.ival \
    -expand 1 \
    -fill x \
    -side left
  pack configure .rollChar.values.label18 \
    -side left
  pack configure .rollChar.values.wval \
    -expand 1 \
    -fill x \
    -side left
  pack configure .rollChar.values.label20 \
    -side left
  pack configure .rollChar.values.dval \
    -expand 1 \
    -fill x \
    -side left
  pack configure .rollChar.values.label22 \
    -side left
  pack configure .rollChar.values.cval \
    -expand 1 \
    -fill x \
    -side left
  pack configure .rollChar.values.label24 \
    -side left
  pack configure .rollChar.values.chval \
    -expand 1 \
    -fill x \
    -side left

  # pack master .rollChar.buttons
  pack configure .rollChar.buttons.button26 \
    -expand 1 \
    -side left
  pack configure .rollChar.buttons.button27 \
    -expand 1 \
    -side left
  pack configure .rollChar.buttons.button28 \
    -expand 1 \
    -side left
  pack configure .rollChar.buttons.button29 \
    -expand 1 \
    -side right

  # pack master .rollChar
  pack configure .rollChar.parameters \
    -expand 1 \
    -fill x
  pack configure .rollChar.values \
    -expand 1 \
    -fill x
  pack configure .rollChar.buttons \
    -fill x

  .rollChar.parameters.nattdie delete 0 end
  .rollChar.parameters.nattdie insert end {3}
  bindtags .rollChar.parameters.nattdie \
    {.rollChar.parameters.nattdie Entry .rollChar all IntEntry}
  .rollChar.parameters.attrnsides delete 0 end
  .rollChar.parameters.attrnsides insert end {6}
  bindtags .rollChar.parameters.attrnsides \
    {.rollChar.parameters.attrnsides Entry .rollChar all IntEntry}
  .rollChar.parameters.hdNum delete 0 end
  .rollChar.parameters.hdNum insert end {1}
  bindtags .rollChar.parameters.hdNum \
    {.rollChar.parameters.hdNum Entry .rollChar all IntEntry}
  .rollChar.parameters.hdNsides delete 0 end
  .rollChar.parameters.hdNsides insert end {6}
  bindtags .rollChar.parameters.hdNsides \
    {.rollChar.parameters.hdNsides Entry .rollChar all IntEntry}
  .rollChar.parameters.maxHd delete 0 end
  .rollChar.parameters.maxHd insert end {10}
  bindtags .rollChar.parameters.maxHd \
    {.rollChar.parameters.maxHd Entry .rollChar all IntEntry}

# end of widget tree

  set rollCharDice [Dice -args [.rollChar.parameters.attrnsides get] \
			       [.rollChar.parameters.nattdie get]]
#  puts stderr "*** (init) rollCharDice = $rollCharDice, TypeOfDice : [$rollCharDice TypeOfDice]"
  .rollChar.values.sval configure -text [$rollCharDice Roll]
  .rollChar.values.ival configure -text [$rollCharDice Roll]
  .rollChar.values.wval configure -text [$rollCharDice Roll]
  .rollChar.values.dval configure -text [$rollCharDice Roll]
  .rollChar.values.cval configure -text [$rollCharDice Roll]
  .rollChar.values.chval configure -text [$rollCharDice Roll]
  rename $rollCharDice {}

  set oldFocus [focus]
  set oldGrab [grab current .rollChar]
  if {$oldGrab != ""} {
    set grabStatus [grab status $oldGrab]
  }

  focus .rollChar.parameters.nattdie
  grab .rollChar
  global rollChar
  set rollChar -1
  tkwait variable rollChar 

  catch {focus $oldFocus}
  catch {
        # It's possible that the window has already been destroyed,
        # hence this "catch".  Delete the Destroy handler so that
        # tkPriv(button) doesn't get reset by it.

        bind $w <Destroy> {}
        destroy $w
  }
  if {$oldGrab != ""} {
        if {$grabStatus == "global"} {
            grab -global $oldGrab
        } else {
            grab $oldGrab
        }
  }


  if {$rollChar == 0} {
    set result {}
  } else {
    set result [Character -this [NewCharacter \
		-strength [.rollChar.values.sval cget -text] \
		-intelligence [.rollChar.values.ival cget -text] \
		-wisdom [.rollChar.values.wval cget -text] \
		-dexterity [.rollChar.values.dval cget -text] \
		-constitution [.rollChar.values.cval cget -text] \
		-charisma [.rollChar.values.chval cget -text] \
		-hitdice [.rollChar.parameters.hdNsides get] \
		-numhitdice [.rollChar.parameters.hdNum get] \
		-maxhitdice [.rollChar.parameters.maxHd get]]]
  }
  destroy .rollChar
  return $result
}

proc ChRollExceptionalStrength {tl} {
# This procedure is for rolling the exceptional strength (fighters only)
# character attribute.
# <in> tl -- the toplevel.
# [index] ChRollExceptionalStrength!procedure

  upvar #0 $tl data
  set PercentDie [Dice]
  set data(estrength) [$PercentDie Roll]
  rename $PercentDie {}
}

proc AdvanceChLevel {tl} {
# This procedure advances a character level.  It is just a hook to the data
# object's AdvanceLevel method.  The character's level is advanced and the
# character gains another die's worth of hit points.
# <in> tl -- the toplevel.
# [index] AdvanceChLevel!procedure

  upvar #0 $tl data
  $data(object) AdvanceLevel
  set data(hp) [$data(object) HitPoints]
  set data(level) [$data(object) Level]
}

proc SaveAsCharacter {tl} {
# Procedure hooked to character ``SaveAs...'' menu item.
# <in> tl -- the toplevel.
# [index] SaveAsCharacter!procedure

  SaveCharacter $tl 1
}


proc SaveCharacter {tl {forceNew 0}} {
# Procedure hooked to character ``Save'' menu item.
# <in> tl -- the toplevel.
# <in> forceNew -- flag that indicates if we should force a new filename or 
# not.
# [index] SaveCharacter!procedure

  upvar #0 $tl data
  set object $data(object)
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  $object SetStrength $data(strength)
  $object SetExceptionalStrength $data(estrength)
  $object SetIntelligence $data(intelligence)
  $object SetWisdom $data(wisdom)
  $object SetDexterity $data(dexterity)
  $object SetConstitution $data(constitution)
  $object SetCharisma $data(charisma)
  $object SetName "$data(name)"
  $object SetPlayer "$data(playername)"
  $object SetRace "$data(race)"
  $object SetCharacterClass "$data(chclass)"
  $object SetAlignment "$data(alignment)"
  $object SetSex "$data(sex)"
  $object SetAge $data(age)
  $object SetExperiencePoints $data(ep)
  $object SetGold $data(gold)
  $object SetComments "$data(comments)"
  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 "Character files" \
							  "*.$filetype"]]\
				 -parent $tl \
				 -title {File to save character data in}]
    if {[string length "$filename"] == 0} {return}
    if {[string length "[file extension $filename]"] == 0} {
      set filename "$filename.$filetype"
    }
  }
  $buffer WriteRecord "$filename"
  rename $buffer {}
  set data(filename) "$filename"
  set data(dirty) 0
}

proc LoadCharacter {tl} {
# Procedure to load a character into the GUI from a disk file.
# Bound to the ``Load'' button.
# <in> tl -- the toplevel.
# [index] LoadCharacter!procedure

  upvar #0 $tl data
  set object $data(object)
  set filename "$data(filename)"
  set filetype "$data(filetype)"
  if {$data(dirty)} {
    set saveP [tk_dialog .askDirty "Save character?" "Save modified Character data?" \
	questhead 0 "Yes" "No"]
    if {$saveP == 0} {SaveCharacter $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 "Character files" \
							  "*.$filetype"]]\
				   -parent $tl \
				   -title {File to load character 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" {*Character}] != 0} {
    rename $buffer {}
    tkerror "Not a character file: $filename"
    return
  }
  $object UpdateFromRecord $buffer
  rename $buffer {}
  set data(hp) [$object HitPoints]
  set data(strength) [$object Strength]
  set data(intelligence) [$object Intelligence]
  set data(wisdom) [$object Wisdom]
  set data(dexterity) [$object Dexterity]
  set data(constitution) [$object Constitution]
  set data(charisma) [$object Charisma]
  set data(estrength) [$object ExceptionalStrength]
  set data(name) "[$object Name]"
  set data(playername) "[$object Player]"
  set data(race) "[$object Race]"
  set data(chclass) "[$object CharacterClass]"
  set data(alignment) "[$object Alignment]"
  set data(set) "[$object Sex]"
  set data(age) [$object Age]
  set data(ep) [$object ExperiencePoints]
  set data(gold) [$object Gold]
  set data(comments) "[$object Comments]"
  $tl.description.value delete 1.0 end
  $tl.description.value insert end "$data(comments)"
  set data(level) [$object Level]
  set data(dirty) 0
  set img [$tl.picture.picture cget -image]
  if {[catch [list $img configure -format gif -file "[$object Image]"] err]} {
    tkerror "Could not set image file [$object Image] for image $img: $err"
  }
  $tl.picture.imname configure -text "[$object Image]"
}

proc OpenCharacter {tl} {
# This procedure opens a character object file in a new GUI toplevel.
# Bound to the ``Open...'' menu item.
# <in> tl -- the toplevel.
# [index] OpenCharacter!procedure

  if {"$tl" == {.}} {
    set data(filename) {}
    set data(filetype) character
    set data(class) Character
  } 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"
}



package provide RPGEdCharacter 1.0