package require Metawidget

# name: Document
# args: args: option-value pairs
# defines icons for the window title bar. defines a default menu and creates
# all standard window elements (MS Windows look&feel). declares option values.
metawidget create Document {
  # if first object is being created, define some icons
  if { ! [ourinfo exists lAllDocs] } {
    our lAllDocs {}
    our wFocus {}

    # x/y-offset from top left corner
    our iOffset 0

    our pIconMin [image create bitmap -data {
      #define _width 8
      #define _height 8
      static char _bits[] = { 0x00,0x00,0x00,0x00,0x00,0x3e,0x3e,0x00 };
    }]
    our pIconMax [image create bitmap -data {
      #define _width 8
      #define _height 8
      static char _bits[] = { 0x7f,0x7f,0x41,0x41,0x41,0x41,0x7f,0x00 };
    }]
    our pIconRestore [image create bitmap -data {
      #define _width 8
      #define _height 8
      static char _bits[] = { 0x7c,0x7c,0x44,0x5f,0x5f,0x71,0x11,0x1f };
    }]
    our pIconClose [image create bitmap -data {
      #define _width 8
      #define _height 8
      static char _bits[] = { 0x00,0x63,0x36,0x1c,0x1c,0x36,0x63,0x00 };
    }]
  }

  # define popup menu
  menu $this.menu -tearoff 0
  $this.menu add command -label Restore  -command "$this _restore"
  $this.menu add command -label Minimize -command "$this _minimize"
  $this.menu add command -label Maximize -command "$this _maximize"
  $this.menu add separator
  $this.menu add command -label Close -command "destroy $this"

  # create title bar elements
  pack [frame $this.head -border 2] -padx 2 -pady 2 -fill x
  pack [label $this.head.icon -border 0] -side left -padx 1
  pack [label $this.head.clob -border 2 -relief raised -image [our pIconClose]] -side right -pady 2 -padx 2
  pack [label $this.head.maxb -border 2 -relief raised -image [our pIconMax]] -side right -pady 2
  pack [label $this.head.minb -border 2 -relief raised -image [our pIconMin]] -side right -pady 2
  pack [label $this.head.text -border 0 -anchor w] -side left -fill x -expand 1
  pack [frame $this.work -border 0] -fill both -expand 1 -padx 2 -pady 2

  # option values, self explaining
  my -title $this
  my -foreground white
  my -background darkblue
  my -font [$this.head.text cget -font]
  my -minsize {100 30}
  my -icontext {}
  my -state normal
  my -image {}

  # position and size of the window
  my -x [our iOffset]
  my -y [our iOffset]
  my -width  250
  my -height 150

  # bind menu to icon and close button
  bind $this.head.icon <1>        "$this _showMenu"
  bind $this.head.icon <Double-1> "$this.menu invoke Close"
  bind $this.head.clob <1>        "$this.menu invoke Close"

  # increase offset for next window
  our iOffset [expr [our iOffset]+16]
  if { [expr [our iOffset]+64] > [winfo height [winfo parent $this]] } {
    our iOffset 0
  }

  # show in normal mode and put it on top
  _restore
  raise_

  # add it to the list of all documents
  _register
} {
  if { [our wFocus] == $this } {
    our wFocus {}
  }

  # remove it from all documents
  _unregister
} -border 2 -relief raised

# name: _register
# args: o Document object to register
# adds the current object to a list. required for geometry management.
metawidget proc Document _register {} {
  our lAllDocs [linsert [our lAllDocs] end $this]
}

# name: _unregister
# args: o Document object to unregister
# removes the object from this list.
metawidget proc Document _unregister {} {
  our lAllDocs [mkw.lshrink [our lAllDocs] $this]
}

# name: _showMenu
# args: -
# displays the popup menu right under the document's icon
metawidget proc Document _showMenu {} {
  $this.menu post [winfo rootx $this.head.icon] \
    [expr [winfo height $this.head.icon] + [winfo rooty $this.head.icon]]
}

# name: _move1
# args: -
# called on a <Button-1> event on the title bar. stores the current mouse
# pointer position. raises the document.
metawidget proc Document _move1 {} {
  raise_

  my iXp0 [winfo pointerx $this]
  my iYp0 [winfo pointery $this]
}

# name: _move2
# args: -
# called on a <B1-Motion> event on the title bar. calculates the new
# window position and places it there.
metawidget proc Document _move2 {} {
  set iXp [winfo pointerx $this]
  set iYp [winfo pointery $this]

  place $this -x [expr [my -x]-[my iXp0]+$iXp] -y [expr [my -y]-[my iYp0]+$iYp]
}

# name: _move3
# args: -
# called on a <ButtonRelease-1> event on the title bar. stores the actual
# window position in some private variables.
metawidget proc Document _move3 {} {
  my -x [winfo x $this]
  my -y [winfo y $this]
}

# name: _resize1
# args: -
# called on a <1> event on one of the borders. stores the current mouse
# position. depending on the mouse position (at an edge or not), the
# resize mode is determined.
metawidget proc Document _resize1 {} {
  raise_

  my iWMin [lindex [my -minsize] 0]
  my iHMin [lindex [my -minsize] 1]

  my iXMax [expr [my -x]+[my -width] -[my iWMin]]
  my iYMax [expr [my -y]+[my -height]-[my iHMin]]

  my iXp0 [winfo pointerx $this]
  my iYp0 [winfo pointery $this]

  # allow max. 16 pixel for edge detection
  set iXEdge [expr [my -width] >>1]
  set iYEdge [expr [my -height]>>1]
  if { $iXEdge > 16 } { set iXEdge 16 }
  if { $iYEdge > 16 } { set iYEdge 16 }

  set iXd [winfo rootx $this]
  set iYd [winfo rooty $this]

  # detect if mouse is on one of the edges (x coordinate)
  if { [my iXp0] < [expr $iXd+$iXEdge] } {
    my iXMove -1           ;# left edge
  } elseif { [my iXp0] > [expr $iXd+[my -width]-$iXEdge] } {
    my iXMove 1            ;# right edge
  } else {
    my iXMove 0            ;# between edge
  }

  # detect if mouse is on one of the edges (y coordinate)
  if { [my iYp0] < [expr $iYd+$iYEdge] } {
    my iYMove -1           ;# upper edge
  } elseif { [my iYp0] > [expr $iYd+[my -height]-$iYEdge] } {
    my iYMove 1            ;# lower edge
  } else {
    my iYMove 0            ;# between edge
  }
}

# name: _resize2
# args: -
# called on a <B1-Motion> event on the borders. calculates the new
# Document sizes and position and places it depending on the resize mode.
metawidget proc Document _resize2 {} {
  set iXp [winfo pointerx $this]
  set iYp [winfo pointery $this]

  if { [my iXMove] == -1 } {
    set iX [expr [my -x]-[my iXp0]+$iXp]
    if { $iX > [my iXMax] } { set iX [my iXMax] }

    set iW [expr [my -width]+[my iXp0]-$iXp]
    if { $iW < [my iWMin] } { set iW [my iWMin] }

    place $this -x $iX -width $iW
  } elseif { [my iXMove] == 1 } {
    set iW [expr [my -width]-[my iXp0]+$iXp]
    if { $iW < [my iWMin] } { set iW [my iWMin] }

    place $this -width $iW
  }

  if { [my iYMove] == -1 } {
    set iY [expr [my -y]-[my iYp0]+$iYp]
    if { $iY > [my iYMax] } { set iY [my iYMax] }

    set iH [expr [my -height]+[my iYp0]-$iYp]
    if { $iH < [my iHMin] } { set iH [my iHMin] }

    place $this -y $iY -height $iH
  } elseif { [my iYMove] == 1 } {
    set iH [expr [my -height]-[my iYp0]+$iYp]
    if { $iH < [my iHMin] } { set iH [my iHMin] }

    place $this -height $iH
  }
}

# name: _resize3
# args: -
# called on a <ButtonRelease-1> event on the borders. stores the actual
# window size and position in some private variables.
metawidget proc Document _resize3 {} {
  my -x      [winfo x      $this]
  my -y      [winfo y      $this]
  my -width  [winfo width  $this]
  my -height [winfo height $this]
}

# name: _withdraw
# args: -
# simply lets the Document disappear.
metawidget proc Document _withdraw {} {
  place forget $this
  my -state withdrawn
}

# name: _maximize
# args: -
# maximizes the document. exchanges the icon for the maximize button.
# deletes bindings for resize and move.
metawidget proc Document _maximize {} {
  # if it was minimized or withdrawn: set to default
  if { [my -state] != "normal" } {
    _restore
  }

  pack $this -fill both -expand 1
  $this.head.maxb configure -image [our pIconRestore]
  $this.menu entryconf Maximize -state disabled
  ::${this}::$this config -border 0

  # delete bindings for resizing
  bind $this <1> {}
  bind $this <B1-Motion> {}
  bind $this <ButtonRelease-1> {}

  # delete bindings for moving
  bind $this.head.text <1> {}
  bind $this.head.text <B1-Motion> {}
  bind $this.head.text <ButtonRelease-1> {}

  # change bindings for maximize button and title bar
  bind $this.head.text <Double-1> "$this _restore"
  bind $this.head.maxb <1> "$this _restore"

  my -state maximized
}

# name: _minimize
# args: -
# minimizes the document. exchanges the icon for the minimize button.
# deletes bindings for resize.
metawidget proc Document _minimize {} {
  # if it was maximized or withdrawn: set to default
  if { [my -state] != "normal" } {
    _restore
  }

  # withdraw the document's working area
  pack forget $this.work
  $this.head.minb configure -image [our pIconRestore]
  $this.menu entryconf Minimize -state disabled

  # eventually change title text
  if { [my -icontext] != {} } {
    $this.head.text configure -text [my -icontext]
  }

  place $this -width 128 -height [expr [winfo reqheight $this.head] + 8]

  # delete bindings for resizing
  bind $this <1> {}
  bind $this <B1-Motion> {}
  bind $this <ButtonRelease-1> {}

  # change bindings for minimize button and title bar
  bind $this.head.text <Double-1> "$this _restore"
  bind $this.head.minb <1> "$this _restore"

  my -state minimized
}

# name: _restore
# args: -
# restores a Document from any of the other states. assigns the regular
# bindings to all widgets.
metawidget proc Document _restore {} {
  # show the working area and place Document on last known position
  pack  $this.work -fill both -expand 1 -padx 2 -pady 2
  place $this -x [my -x] -y [my -y] -width [my -width] -height [my -height]

  # restore icons and menu entries for all title bar elements
  $this.head.minb configure -image [our pIconMin]
  $this.head.maxb configure -image [our pIconMax]
  $this.head.text configure -text [my -title]
  $this.menu entryconf Minimize -state normal
  $this.menu entryconf Maximize -state normal
  ::${this}::$this config -border 2

  # restore resize bindings
  bind $this <1>               "$this _resize1"
  bind $this <B1-Motion>       "$this _resize2"
  bind $this <ButtonRelease-1> "$this _resize3"

  bind $this <2> "$this _move1"
  bind $this <B2-Motion> "$this _move2"
  bind $this <ButtonRelease-2> "$this _move3"
  
  # restore move bindings
  bind $this.head.text <1>               "$this _move1"
  bind $this.head.text <B1-Motion>       "$this _move2"
  bind $this.head.text <ButtonRelease-1> "$this _move3"

  # restore maximize and minimize bindings
  bind $this.head.maxb <1>        "$this _maximize"
  bind $this.head.minb <1>        "$this _minimize"
  bind $this.head.text <Double-1> "$this _maximize"

  my -state normal
}

# name: -x et al.
# args: iX, iY, iWidth iHeight: geometry values
# sets a new size or position of the Document window.
metawidget proc Document -x { iX } {
  my -x $iX
  _restore
}
metawidget proc Document -y { iY } {
  my -y $iY
  _restore
}
metawidget proc Document -width { iWidth } {
  my -width $iWidth
  _restore
}
metawidget proc Document -height { iHeight } {
  my -height $iHeight
  _restore
}

# name: -font
# args: sFont: font to set
# option handler. sets the title font.
metawidget proc Document -font { sFont } {
  my -font $sFont
  $this.head.text configure -font $sFont
}

# name: -image
# args: sImage: image to set
# option handler. sets the image in the title bar.
metawidget proc Document -image { sImage } {
  my -image $sImage
  $this.head.icon configure -image $sImage
}

# name: -title
# args: sTitle: title to set
# option handler. sets title text.
metawidget proc Document -title { sTitle } {
  my -title $sTitle
  $this.head.text configure -text $sTitle
}

# name: -state
# args: sState: new Document state
# option handler. sets the state for the document. the variable -state
# is set in the respective (private) member functions.
metawidget proc Document -state { sState } {
  switch -- [mkw.complete $sState {normal minimized maximized withdrawn}] {
    normal    { _restore  }
    minimized { _minimize }
    maximized { _maximize }
    withdrawn { _withdraw }
  }
}

# name: menu
# args: args: arguments for the regular menu command.
# simply passes all arguments to the popup menu.
metawidget proc Document menu_ { args } {
  eval $this.menu $args
}

# name: lower
# args: -
# draws the title bar in grey.
metawidget proc Document lower_ {} {
  $this.head configure -bg gray50
  $this.head.icon configure -bg gray50
  $this.head.text configure -bg gray50 -fg gray
}

# name: raise
# args: -
# puts the Document on top and draws the title bar in different colors.
metawidget proc Document raise_ {} {
  catch { [our wFocus] lower }
  our wFocus $this

  $this.head configure -bg [my -background]
  $this.head.icon configure -bg [my -background]
  $this.head.text configure -bg [my -background] -fg [my -foreground]

  raise $this
}

# name: pack
# args: sWindow: widget to be packed
#       args: option-value pairs
# redirects packing to the work area widget.
metawidget proc Document pack_ { sWindow args } {
  eval pack $sWindow -in $this.work $args
}

# name: grid
# args: sWindow: widget to be gridded
#       args: option-value pairs
# redirects gridding to the work area widget.
metawidget proc Document grid_ { sWindow args } {
  eval grid $sWindow -in $this.work $args
}

# name: place
# args: sWindow: widget to be placed
#       args: option-value pairs
# redirects placing to the work area widget.
metawidget proc Document place_ { sWindow args } {
  eval place $sWindow -in $this.work $args
}

# name: Arrange
# args: sHow: arrange mode
# static member function. resizes and repositions all Document objects and all
# descendants from it in one of several ways.
metawidget proc Document Arrange { sHow } {
  variable lAllDocs

  set lDocs {}                                ;# verify list contents
  foreach lDoc $lAllDocs {
    if { ! [winfo exists $lDoc] } continue
    lappend lDocs $lDoc
  }

  set iDocs [llength $lDocs]
  if { $iDocs == 0 } return                   ;# leave if there is nothing

  set iW [winfo width  [winfo parent [lindex $lDocs 0]]]
  set iH [winfo height [winfo parent [lindex $lDocs 0]]]

  set sHow [mkw.complete $sHow {horizontally vertically cascade tile icons maximize minimize}]
  switch $sHow {
    horizontally {
      set iStep [expr $iH/$iDocs]
      for { set i 0 } { $i < $iDocs } { incr i } {
        set sDoc [lindex $lDocs $i]
        place $sDoc -x 0 -y [expr $i*$iStep] -width $iW -height $iStep
      }
    }

    vertically {
      set iStep [expr $iW/$iDocs]
      for { set i 0 } { $i < $iDocs } { incr i } {
        set sDoc [lindex $lDocs $i]
        place $sDoc -x [expr $i*$iStep] -y 0 -width $iStep -height $iH
      }
    }

    cascade {
      set iStep 24
      for { set i 0 } { $i < $iDocs } { incr i } {
        set sDoc [lindex $lDocs $i]
        place $sDoc -x [expr $i*$iStep] -y [expr $i*$iStep] -width [expr $iW*2/3] -height [expr $iH*2/3]
        $sDoc raise
      }
    }

    tile {
      for { set i 0 } { $i <= 100 } { incr i } {
        set iHor [expr ($i+3)/2]
        set iVer [expr ($i+2)/2]
        if { [expr $iHor*$iVer] >= $iDocs } break
      }

      set iXStep [expr $iW/$iHor]
      set iYStep [expr $iH/$iVer]
      for { set i 0 } { $i < $iDocs } { incr i } {
        set sDoc [lindex $lDocs $i]
        place $sDoc -x [expr ($i%$iHor)*$iXStep] -y [expr ($i/$iHor)*$iYStep] -width $iXStep -height $iYStep
      }
    }

    icons {
      set iXd 0
      set iYd 0
      foreach sDoc $lDocs {
        if { [$sDoc cget -state] != "minimized" } continue

        set iWd [winfo width $sDoc]
        if { [expr $iXd+$iWd] > $iW } {
          set iXd 0
          incr iYd [winfo height $sDoc]
        }
        place $sDoc -x $iXd -y $iYd
        after idle "$sDoc _move3"
        incr iXd $iWd
      }
    }

    maximize {
      foreach sDoc $lDocs {
        place $sDoc -x 0 -y 0 -width $iW -height $iH
      }
    }

    minimize {
      foreach sDoc $lDocs {
        $sDoc _minimize
      }
    }
  }

  # get new window geometry and restore default behaviour
  if { $sHow != "minimize" && $sHow != "icons" } {
    foreach sDoc $lDocs {
      after idle "$sDoc _resize3; $sDoc _restore"
    }
  }
}

metawidget command Document _showMenu _showMenu
metawidget command Document _move1    _move1
metawidget command Document _move2    _move2
metawidget command Document _move3    _move3
metawidget command Document _resize1  _resize1
metawidget command Document _resize2  _resize2
metawidget command Document _resize3  _resize3
metawidget command Document _withdraw _withdraw
metawidget command Document _maximize _maximize
metawidget command Document _minimize _minimize
metawidget command Document _restore  _restore

metawidget command Document menu      menu_
metawidget command Document lower     lower_
metawidget command Document raise     raise_
metawidget command Document pack      pack_
metawidget command Document grid      grid_
metawidget command Document place     place_
metawidget command Document Arrange   Arrange

metawidget option  Document -x          -x
metawidget option  Document -y          -y
metawidget option  Document -width      -width
metawidget option  Document -height     -height
metawidget option  Document -font       -font
metawidget option  Document -image      -image
metawidget option  Document -title      -title
metawidget option  Document -state      -state
metawidget option  Document -foreground
metawidget option  Document -background
metawidget option  Document -minsize
metawidget option  Document -icontext

proc test {} {
  pack [frame .w -back darkgray] -fill both -expand 1
  document .w.d1
  document .w.d2
  document .w.d3
}

#test
