#   Copyright (C) 1987-2005 by Jeffery P. Hansen
#
#   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.
#
# Last edit by hansen on Thu Sep  2 11:07:49 2004
#

set blk_src ""
set blk_dst ""

proc tkg_blockOp {cap sprompt dprompt opr} {
  global blk_src blk_dst tkg_currentBlock

  if { [catch { toplevel .blk } ] } { return }
  wm title .blk $cap
  wm geometry .blk [offsetgeometry . 50 50 ]
  wm transient .blk .

  set blk_src ""
  set blk_dst ""
  set i [.sbar.blklst.f.list curselection]

  if { $i != "" } {
      set blk_src [string trim [.sbar.blklst.f.list get $i] "+()"]
  } else {
      #
      # Get the current block name and remove any junk if necessary.
      #
      set blk_src $tkg_currentBlock
      set i [string last ":" $blk_src]
      if { $i >= 0 } {
	  set blk_src [string range $blk_src [expr $i+1] end]
      }
      set i [string first "(" $blk_src]
      if { $i >= 0 } {
	  set blk_src [string range $blk_src 0 [expr $i - 1]]
      }
  }

  frame .blk.t -relief raised -bd 2

  label .blk.t.tsrc -text $sprompt
  entry .blk.t.esrc -textvariable blk_src
  grid .blk.t.tsrc -row 0 -column 0 -sticky e -padx 3 -pady 3
  grid .blk.t.esrc -row 0 -column 1 -sticky w -padx 3 -pady 3

  set opr "destroy .blk; $opr"

  if { $dprompt != "" } {
    label .blk.t.tdst -text $dprompt
    entry .blk.t.edst -textvariable blk_dst
    grid .blk.t.tdst -row 1 -column 0 -sticky e -padx 3 -pady 3
    grid .blk.t.edst -row 1 -column 1 -sticky w -padx 3 -pady 3

    append opr { $blk_src $blk_dst }
    bind .blk.t.esrc <Return> $opr
    bind .blk.t.edst <Return> $opr
  } else {
    append opr { $blk_src }
    bind .blk.t.esrc <Return> $opr
  }

  okcancel .blk.b $opr { destroy .blk }

  pack .blk.t -ipadx 10 -ipady 10
  pack .blk.b -fill x


  if { $blk_src != "" } { .blk.t.esrc selection range 0 end }

  focus .blk.t.esrc
  grab set .blk
  tkwait window .blk
  grab release .blk

}


proc tkg_blockNew {} {
  tkg_blockOp "TKGate: Module New" "[m blklst.newmod]:" "" gat_newBlock
}

proc tkg_blockDelete {} {
  tkg_blockOp "TKGate: Module Delete" "[m blklst.delmod]:" "" gat_deleteBlock
}

proc tkg_blockCopy {} {
  tkg_blockOp "TKGate: Module Copy" "[m blklst.frommod]:" "[m blklst.tomod]:" gat_copyBlock
}

proc tkg_blockRename {} {
  tkg_blockOp "TKGate: Module Rename" "[m blklst.oldname]:" "[m blklst.newname]:" gat_renameBlock
}

proc tkg_blockClaim {} {
  tkg_blockOp "TKGate: Claim Module" "[m blklst.claim]:" "" gat_claimBlock
}

#
# Compare two block names.
#
proc blklstCompare {A B} {
  set tA  [string trim $A "+()"]
  set tB  [string trim $B "+()"]
  set lcA [string tolower $tA]
  set lcB [string tolower $tB]
  set c [string compare $lcA $lcB]
  if {$c == 0} {
    set c [string compare $tA $tB]
  }
  return $c
}

#
# Add a block to the block list in sorted order
#
proc tkg_blockListAdd {blk} {
  lbSortRInsert .sbar.blklst.f.list $blk blklstCompare
}

proc tkg_blockListClear {} {
  .sbar.blklst.f.list delete 0 end
}

proc tkg_blockListRemove {blk} {
  lbSortDelete .sbar.blklst.f.list $blk blklstCompare
}

#
# Make item at position i the root module
#
proc tkg_blockListIdxSetRoot {j} {
  set n [.sbar.blklst.f.list size]
  for { set i 0 } { $i < $n } { incr i } {
    set s [.sbar.blklst.f.list get $i]
    if { [string match "*+" $s] } {
      set s [string trim $s "+()"]
      .sbar.blklst.f.list delete $i 
      .sbar.blklst.f.list insert $i $s
      .sbar.blklst.f.list selection set $i
      break
    }
  }
  set s [.sbar.blklst.f.list get $j]
  .sbar.blklst.f.list delete $j 
  .sbar.blklst.f.list insert $j "$s+"
  .sbar.blklst.f.list selection clear 0 end
  .sbar.blklst.f.list selection set $j
}

#
# Make the named module a library if islib is set, or not a libary if it is not set. 
#
proc tkg_blockListSetLibFlag {name islib} {
  set n [.sbar.blklst.f.list size]
  for { set i 0 } { $i < $n } { incr i } {
    set q [.sbar.blklst.f.list get $i]
    set s [string trim $q "()+"]
    if { $s == $name } {
      if { $islib != 0 } { set s "($s)" }
      if { [string first "+" $q] >= 0 } { set s "$s+" }
      .sbar.blklst.f.list delete $i 
      .sbar.blklst.f.list insert $i $s
      break
    }
  }
}

namespace eval BlockListDrag {
  variable drag_obj ""
  variable mouseset_x 0
  variable mouseset_y 0

  proc seeB1 {w x y} {
    variable mouseset_x
    variable mouseset_y
    variable drag_obj

    set mouseset_x ""
    set mouseset_y ""
    set drag_obj ""
  }

  proc seeModuleDrop {m w x y} {
    variable mouseset_x
    variable mouseset_y

    set mouseset_x ""
    set mouseset_y ""

    if { $w == ".frame.cf.canvas"} {
      action Make "gat_make block -func $m -x $x -y $y -interface 1"
    }
  }

  #
  # Respond to motion of the mouse with button 1 depressed
  #
  proc seeMotion {w x y} {
    variable drag_obj
    variable mouseset_x
    variable mouseset_y
    global bd

    if { $mouseset_x == "" } {
      set mouseset_x $x
      set mouseset_y $y
      set i [$w curselection]
      if { $i != "" } {
	set drag_obj [$w get $i]
      } else {
	set drag_obj ""
      }
      return
    }


    if { $drag_obj != "" } {
      set dx [expr $mouseset_x - $x]
      set dy [expr $mouseset_y - $y]
      if { [expr $dx*$dx + $dy*$dy] > 25 } {
	set lbl [string trim $drag_obj "+@()"]

	set dw [Dragger::make -command "BlockListDrag::seeModuleDrop $lbl"]
	if {$dw != "" } {
	  label $dw.icon -image [gifI "$bd/module.gif"]
	  label $dw.label -text $lbl
	  pack $dw.icon $dw.label -padx 2 -pady 2 -side left
	}
      }
    }
  }
}


proc tkg_makeBlockList {w} {
  labelframe $w [m iblmodule]
  frame $w.pad
  pack $w.pad -pady 3

  frame $w.f
  listbox $w.f.list -width 15 -height 1 -yscrollcommand "$w.f.sb set" -takefocus 0
  scrollbar $w.f.sb -command "$w.f.list yview" -takefocus 0
  
#  pack $w.f.lab -anchor w
  pack $w.f.list $w.f.sb -side left -padx 1 -pady 1 -fill y
  pack $w.f -padx 2 -pady 4 -fill y -expand 1

  set cmd { continueAction GotoBlock { gat_openBox [string trim [.sbar.blklst.f.list get [.sbar.blklst.f.list curselection]] "+()"]} }
  bind $w.f.list <Double-ButtonRelease-1> $cmd
  bind $w.f.list <ButtonPress> { action -Unselect { tkg_undoSelections blocks };  BlockListDrag::seeB1 %W %X %Y }
  bind $w.f.list <B1-Motion> { BlockListDrag::seeMotion %W %X %Y }

#    helpon $w.f.lab [m ho.f.modlist]
  helpon ${w}_label [m ho.f.modlist]
}

proc tkg_blockListTest {} {
  button .open -text Open -command tkg_blockListTestSetup
  pack .open
}

tkg_makeBlockList .sbar.blklst
pack .sbar.blklst -fill both -expand 1 -padx 3 -pady 5


#tkg_blockListTest