#!/bin/sh
# 
#  show disk usage as 2D tree
#  show ps-tree (memory usage) as 2D tree
# Bugs:
#  - nonaccessable files does not work
# ToDo:
#  - history for back-button default={ / /home /home/user ... }
#
# tcl ignores the next line, but sh not \
/usr/X11R6/bin/wish $0 $@; exit

# old for every object asyncron bounce (error to large!)
# better one bounce-routine for all objects (syncron)

set depth 1
set rpath .
set lx 640
set ly 480
set showing $rpath
set debug 0
set mode 0
set count 0

label .info -text $showing
canvas .c -height $ly -width $lx
pack .info .c 



# call this recursiv
proc addArray { w path depth x0 y0 x1 y1 } {
 global debug count rpath mode
 if { $depth == 0 } {
  if { $debug > 0 } { puts "$path $depth $x0 $y0 $x1 $y1" }
  set type [scan [exec ls -dl $path] "%c"]
  incr count
  # beautiful images instead of boxes?
  set nr [.c create line $x0 $y0 $x0 $y1 $x1 $y1]
  .c itemconfigure $nr -fill black
  if { ([expr $x0+$y0] & 1) == 1 } { .c itemconfigure $nr -fill brown }

  incr x0;  incr y0;  incr x1 -1;  incr y1 -1
  if { ($x0<$x1) && ($y0<$y1) } {
    set nr [.c create rectangle $x0 $y0 $x1 $y1 -tag o$path]
    .c itemconfigure $nr -fill red
    if { $type == 45 } { .c itemconfigure $nr -fill green }
    .c bind $nr <Enter> [list .info configure -text "$nr: $path"]
    .c bind $nr <Button> [list set rpath "$path"]
    .c bind $nr <Shift-Button> {set rpath "."; pRefresh}
    .c bind $nr <Control-Button> {set rpath "/"; pRefresh}
 }
 } else {
  # show action
  .info configure -text "please wait, examine $path"
  update idletask
  set nobj 0
  set ssum 0
  set f1 [open "|ls -1 $path" "r"]
  while { [expr ! [eof $f1]] } {
   gets $f1 name
   #  drwxr-xr-x   25 jschulen users        3072 Jul 12 03:15 tmp 
   set type [scan [exec ls -dl $path/$name] "%c"]
   catch [set size [scan [exec du -s  $path/$name] "%s"]] err
   if { $debug > 0 } { puts "file $type $size $name" }
   if { $size <= 0 } { set size 1 }
   if { [string length $name] > 0 } { 
     # object and its size
     array set object [list o$nobj "$path/$name" s$nobj $size t$nobj $type]
     incr nobj
     set ssum [expr $ssum + $size]
   }
  }
  close $f1
  # puts " nobj=$nobj"
  # parray object

  if { $ssum>0 } {
    set ii 0
    set psum 0
    while { $ii < $nobj } {
      set size $object(s$ii)
      set name $object(o$ii)
      set ndepth [expr $depth-1]
      # d=100 -=45 l=...
      if { $object(t$ii) == 100 } {
        set ndepth [expr $depth-1]
      } else {
        set ndepth 0
      }
      if { ($depth & 1) == 1 } {
        set lsum [expr $x1-$x0+1]
        set xn0 [expr $x0+$psum*$lsum/$ssum]
        set xn1 [expr $x0+($psum+$size)*$lsum/$ssum-1]
        addArray $w $name $ndepth $xn0 [expr $y0] $xn1 [expr $y1-1]
      } else {
        set lsum [expr $y1-$y0+1]
        set yn0 [expr $y0+$psum*$lsum/$ssum+1]
        set yn1 [expr $y0+($psum+$size)*$lsum/$ssum-1]
        addArray $w $name $ndepth [expr $x0] $yn0 [expr $x1-1] $yn1
      }
      incr ii
      set psum [expr $psum + $size]
    }
  }
 }
}

array set colors { 0 black 1 red 2 green 3 yellow 4 blue 5 cyan 6 brown 7 white }

menu .menu -tearoff 0
menu .menu.m1 -tearoff 0
menu .menu.opt -tearoff 0
menu .menu.help -tearoff 0

.menu add cascade -label "Menu" -menu .menu.m1 -underline 0

 .menu.m1 add command -label "refresh" -command {pRefresh}
 .menu.m1 add command -label "inc depth" -command {incr depth;pRefresh}
 .menu.m1 add command -label "dec depth" -command {incr depth -1;pRefresh}
 .menu.m1 add separator
 .menu.m1 add command -label "Lock" -command {exec xlock -mode blank}
 .menu.m1 add command -label "Exit" -command exit
 
.menu add cascade -label "Options" -menu .menu.opt -underline 0

 .menu.opt add command -label "change Options" -command {puts "still not available"}
 .menu.opt add radiobutton -label "show oldFiles" -variable mode -value 1
 .menu.opt add radiobutton -label "show mpgFiles" -variable mode -value 2
 .menu.opt add checkbutton -label "Debug" -variable debug -onvalue 1 -offvalue 0

.menu add cascade -label "Help" -menu .menu.help -underline 0

 .menu.help add command -label "Version" -command { procVersion .menu.help }
 .menu.help add command -label "Help" -command { procVars .menu.help }

. configure -menu .menu

#bind Menu <<MenuSelect>> {}

proc procVersion { w } {
  tk_messageBox -icon info -message\
 "tk_disk_usage version 0.1\n by jschulen/at/gmx/dot/de" -type ok -parent $w
}

proc procVars { w } {
  global tcl_version tcl_platform
  tk_messageBox -icon info -message "\
  Press Left-Button - dive into current path\n\
  Press Shift+Button - go to current path\n\
  Press Control+Button - go to root\n\
  tcl_version: $tcl_version\n\
  tcl_platform:\n [array get tcl_platform]\n"\
  -type ok -parent $w
}

#bind .c <ButtonPress-1> { puts "click1 %W %x %y" }
#bind .c <B1-Motion> { puts "drag %W %x %y" }
#bind .c <ButtonRelease-1> { puts "drop1 %W %x %y" }
#bind . <Key-y> { puts "%K pressed" }
# bind .c <Key> { puts "%K pressed in %W " }
#focus .c

#bind .c <ButtonPress-1> {
# puts "click1 %W %x %y"
# set text "%W %x %y"
# .info configure -text "$text"
#}

proc pRefresh { } {
  global rpath depth lx ly
  .info configure -text "please wait"
  update idletask
  .c delete all
  addArray . $rpath $depth 1  1 [expr $lx-1] [expr $ly-1]
  .info configure -text "ready"
}

#set depth 2
pRefresh