#!/usr/bin/wish8.3
# menu.tcl --
#
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubars.
#
# RCS: @(#) $Id: menu.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
#
#  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.
#
# Ingo Blechschmidt
# Arberstrae 5
# 86179 Augsburg
# E-Mail: iblech@web.de, http://www.way.to/uselinux/
# Tel.: +49 / 821 882955
#
# 

# eigentlich am Ende, aber was solls...
proc balloon_help {w msg} {
    bind $w <Enter> "after 1000 \"balloon_aux %W [list $msg]\""
    bind $w <Leave> "after cancel \"balloon_aux %W [list $msg]\"
                     after 100 {catch {destroy .balloon_help}}"
}

proc balloon_aux {w msg} {
    set t .balloon_help
    catch {destroy $t}
    toplevel $t
    wm overrideredirect $t 1
    if {$::tcl_platform(platform) == "macintosh"} {
     unsupported1 style $t floating sideTitlebar
    }
    pack [label $t.l -text $msg -relief groove -bd 1 -bg gold] -fill both
    set x [expr [winfo rootx $w]+6+[winfo width $w]/2]
    set y [expr [winfo rooty $w]+6+[winfo height $w]/2]
    wm geometry $t +$x\+$y
    bind $t <Enter> {after cancel {catch {destroy .balloon_help}}}
    bind $t <Leave> "catch {destroy .balloon_help}"
}

# demo
# pack [button .b -text tryme -command {puts "you did it!"}]
# balloon_help .b "Text that describes\nwhat the button does"

set font "Arial"

global .w

array set daten { }

set w .menu
catch {destroy $w}
toplevel $w
wm title $w "Latein lernen"
wm iconname $w "menu"
# positionWindow $w

label $w.question -font $font -wraplength 4i -justify center -width 50 -height 10
$w.question configure -text "Frage" -background "yellow" -foreground "red"
label $w.answer -font $font -wraplength 4i -justify center  -width 50 -height 10
$w.answer configure -text "Antwort" -foreground "yellow" -background "orange"

pack $w.question -side top
pack $w.answer -side bottom

set menustatus "    "
global counter
frame $w.statusBar
label $w.statusBar.label -background "green" -foreground "orangered" -textvariable menustatus -relief sunken -bd 1 -font "Helvetica 10" -anchor w
label $w.statusBar.counter -foreground "blue" -background "orange" -textvariable counter -relief raised -bd 1 -font "Helvetica 10" -anchor e
pack $w.statusBar.label -side left -padx 2 -expand yes -fill both
pack $w.statusBar.counter -side right -padx 2 -expand no -fill both
pack $w.statusBar -side bottom -fill x -pady 2

frame $w.buttons -background "ghostwhite"
pack $w.buttons -side bottom -fill x -pady 2m
button $w.buttons.gewusst -text "Gewusst!" -command "gewusst" -background "orangered" -bitmap "info" -padx .3c -pady .3c
button $w.buttons.nachgedacht -text "Nachgedacht!" -command "nachgedacht" -background "ghostwhite" -bitmap "questhead" -padx .3c -pady .3c
button $w.buttons.verloren -text "Verloren!" -command "verloren" -background "#FF6733" -bitmap "error" -padx .3c -pady .3c
pack $w.buttons.gewusst $w.buttons.nachgedacht $w.buttons.verloren -side right -expand 1
balloon_help $w.buttons.gewusst "Hier klicken, wenn du die Antwort gewusst hast!  (Sei ehrlich)"
balloon_help $w.buttons.verloren "Hier klicken, wenn du die Antwort (vorlufig?) vergessen hast!  (Sei ehrlich)"
balloon_help $w.buttons.nachgedacht "Hier klicken, wenn du berlegt hast!"

menu $w.menu -tearoff 0 -background "#FF8800" -foreground "orangered"

set m $w.menu.file
menu $m -tearoff 1
$w.menu add cascade -label "Latein" -menu $m -underline 0
$m add command -label "ffnen ..." -command datei_oeffnen -underline 0
$m add separator
$m add command -label "beenden ..." -command exit -underline 0
balloon_help $m "Das ist das Hauptmen"

set m $w.menu.help
menu $m -tearoff 1
$w.menu add cascade -label "Hilfe" -menu $m -underline 0
$m add command -label "ber ..." -command hilfe -underline 0 -bitmap info
# $m add separator
# $m add command -label "beenden ..." -command exit -underline 0
balloon_help $m "Und das ist das Hilfemen"

set m $w.menu.edit
menu $m -tearoff 1
$w.menu add cascade -label "Selbst erstellen" -menu $m -underline 0
$m add command -label "neu ..." -command "neue_datei 0" -underline 0
$m add command -label "ndern ..." -command "neue_datei 1" -underline 0
# $m add separator
# $m add command -label "beenden ..." -command exit -underline 0
balloon_help $m "Hinweis: Dies ist noch nicht fertig programmiert."

global protokoljanein
set protokoljanein 0
set protname "Protokoll-1.html"
set m $w.menu.options
$w.menu add cascade -label "Optionen" -menu $m -underline 0
menu $m -tearoff 1 -postcommand {
  global protokoljanein
  $m delete 0 end
  $m add check -label "Protokoll aufzeichnen" -variable protokoljanein -underline 0
  if { $protokoljanein == 0 } { 
    $m add command -label "Protokolldatei whlen ..." -state disabled -command "protname" -underline 15
  } else {
    $m add command -label "Protokolldatei whlen ..." -state active -command {
      global protname
      set protname [ fileDialog $w name protsave ]
    } -underline 15
  }
  balloon_help $m "Willst du eine Protokolldatei? Kein Problem..."
}

$w configure -menu $w.menu -background "orangered"

bind Menu <<MenuSelect>> {
    global $menustatus
    if {[catch {%W entrycget active -label} label]} {
	set label "    "
    }
    set menustatus $label
    # set counter "Hallo"
    # pack $w.statusBar.counter
    update idletasks
}

bind $w <<Enter>> gewusst
bind $w <<Space>> verloren

# Sam Mr  2 20:18:27 MET 2002: alles heute, jetzt von GM wieder da:

global ins
proc datei_oeffnen { } {
  global w
  global daten
  set name [ fileDialog $w name open ]
  #exec "/bin/cp" $name "/tmp/latein-lernen.txt"
  # fileDialog $w name open
  global counter
  set fId [ open $name r ]
  set aa [ read $fId ]
  set ab [ split $aa "\n" ]
  set nul [ expr [ llength $ab ] - 1 ]
  close $fId
  set fId [ open $name r ]
  set c ""
  set n "0"
  # set nul [ exec "/bin/bash" "-c" "cat $name | wc -l" ]
  while { $n < $nul } {
    set c ""
    # puts "aaa"
    while { $c != "\n" } {
      set c [ read $fId 1 ]
      append daten($n) $c
      # puts $c
      #tk_messageBox -icon info -message "Congratulations!" -type ok -parent $w
    }
    set n [ expr $n + 1 ]
  }
  set counter [ expr [ array size daten ] - 1 ]
  global ins
  set ins [ array size daten ]
  close $fId
  #Die Mr  5 14:22:38 MET 2002: ^^
  # $n
  global protokoljanein
  global protname
  if { $protokoljanein == 1 } {
    set myCid3 [ open $protname a ]
    puts $myCid3 "<html><head><title>Nicht gewusste Vokabeln</title></head><body><table border='1'>"
    close $myCid3
  }
  displayer_voc
}

proc displayer_voc { } {
  global w
  global counter
  global daten
  global menustatus
  global fehler
  if { $counter == -1 } {
    global ins
    set menustatus "Fehler: [ expr $fehler - 1 ] von $ins, also [ expr 100 * ($fehler - 1) / $ins ] %"
    tk_messageBox -icon info -message "Congratulations!" -type ok -parent $w
  } else {
#    set c ""
#    set cc 0
    global q
    set q ""
    global a
    set a ""
#    while {$cc != 2} {
#      set c [ read $fId 1 ]
#      if {$c != "-"} { append q $c }
#      if {$c == "-"} { set cc [ expr $cc + 1 ] }
#    }
#    set c [ read $fId 1 ]
#    set c [ read $fId 1 ]
#    while {$c != "-" && $c != "\n" } {
#      set c [ read $fId 1 ]
#      append a $c
#    }
    set q [ string range $daten([ expr [ array size daten ] - 1]) 0 [ expr [ string first "--" $daten([ expr [ array size daten ] - 1])] - 1 ] ]
    set a [ string range $daten([ expr [ array size daten ] - 1]) [ expr [ string first "--" $daten([ expr [ array size daten ] - 1])] - 1 + 3 ] end ]
    $w.question configure -text $q
    $w.answer configure -text ""
    puts -nonewline $q
    puts -nonewline ": "
  }
}

proc gewusst { } {
  global counter
  global daten
  global w
  puts "Gewusst!"
  array unset daten [ expr [ array size daten ] - 1 ]
  set counter [ expr [ array size daten ] - 1 ]
  displayer_voc
}

global v
global fehler
set fehler 1
set v 1

proc verloren { } {
#  global a
#  global q
#  set i ""
#  append i $q "--" $a
#  global fId
#  puts $fId $i
  # Die Mr  5 14:36:53 MET 2002:
  global protokoljanein
  global protname
  if { $protokoljanein == 1 } {
    set myCid2 [ open $protname a ]
    global q
    global a
    puts $myCid2 "<tr><td>$q</td><td align='right'>$a</td></tr>"
    close $myCid2
  }
  puts "Verloren!"
  global daten
  global counter
  set counter [ expr [ array size daten ] - 1 ]
  global v
  set v [ expr $v + 1 ]
  global fehler
  set fehler [ expr $fehler + 1 ]
  if { $v >= $counter } { set v 1 }
  set l $daten($v)
  set daten($v) $daten($counter)
  set daten($counter) $l
  displayer_voc
}

proc nachgedacht { } {
  global a
  global w
  $w.answer configure -text $a
}

proc fileDialog {w ent operation} {
    #   Type names		Extension(s)	Mac File Type(s)
    #
    #---------------------------------------------------------
#	{"Text files"		{.txt .doc}	}
#	{"Text files"		{}		TEXT}
#	{"Tcl Scripts"		{.tcl}		TEXT}
#	{"C Source Files"	{.c .h}		}
#	{"All Source Files"	{.tcl .c .h}	}
#	{"Image Files"		{.gif}		}
#	{"Image Files"		{.jpeg .jpg}	}
#	{"Image Files"		""		{GIFF JPEG}}
#	{"All files"		*}
    set types {
        {"Latein-Dateien"       {.txt .lat}     TEXT}
        {"HTML-Dateien"         {.htm .html}    }
    }
    if {$operation == "open"} {
	set file [tk_getOpenFile -filetypes $types -parent $w]
    } elseif {$operation == "save"} {
	set file [tk_getSaveFile -filetypes $types -parent $w \
	    -initialfile Unbennant -defaultextension .txt]
    } else {
	set file [tk_getSaveFile -filetypes $types -parent $w \
	    -initialfile Unbennant -defaultextension .html]
    }
    if [string compare $file ""] {
        return $file
#	$ent delete 0 end
#	$ent insert 0 $file
#	$ent xview end
    }
}

proc hilfe { } {
  set z .label
  catch {destroy $z}
  toplevel $z
  wm title $z "Hilfe ber ..."
  wm iconname $z "help"
  wm geometry $z +300+300
  # positionWindow $z
  
  label $z.msg -font "Helvetica" -wraplength 4i -justify left -text "Mit diesem noch namenlosen Programm ist es mglich, Vokabeln (nicht nur Latein) zu lernen.
Die Bedienung ist simpel: Zuerst muss via Datei->ffnen eine Vokabeldatei geladen werden. Dann wird in der oberen Hlfte des Fensters die Frage angezeigt (zum Beispiel 'salve'). Dann musst du berlegen, was die Antwort (zum Beispiel 'Hallo') ist. Sobald du auf 'Nachgedacht!' klickst, siehst du unten die Lsung. Dann musst du nur noch auf 'Gewonnen!' oder 'Verloren!' klicken.
Es ist auch mglich, neue Vokabeldateien zur erstellen: Einfach auf 'Selbst erstellen->Neu' klicken, und dann die Vokabeln eintippen (Format: 'latein -- deutsch') und abspeichern.
Viel Spa beim Pauken!"
  
  pack $z.msg -side top
  
  frame $z.left
  frame $z.right
  pack $z.left $z.right -side left -expand yes -padx 10 -pady 10 -fill both
  
  label $z.left.l1 -text "Versuch, hier zu klicken!"
  label $z.left.l2 -text "Geht's hier?" -relief raised
  label $z.left.l3 -text "Und hier?" -relief sunken
  label $z.left.o1 -text "" -foreground "red"
  button $z.left.b1 -text "Press me!" -bitmap hourglass -command osteregg
  pack $z.left.l1 $z.left.l2 $z.left.l3 $z.left.o1 $z.left.b1 -side top -expand yes -pady 2 -anchor w
  
  label $z.right.bitmap -borderwidth 2 -relief sunken \
	-bitmap @/tmp/ingo.xbm
  label $z.right.caption -text "Ingo Blechschmidt"
  pack $z.right.bitmap $z.right.caption -side top

}

proc osteregg { } {
  set y .label
  catch {destroy $y}
  toplevel $y
  wm title $y "Hinweis"
  wm iconname $y "label"
  wm geometry $y +257+317
  # positionWindow $y
  
  label $y.ouch -text "Ouch!!" -foreground "red"
  pack $y.ouch -side top -expand yes -pady 20 -anchor w
  
  after 100 "grab -global $y"
  after 500 "destroy $y"
  after 700 "easterei 317 293 1"
}

proc easterei { mx my mc } {
  set x .label
  catch {destroy $x}
  toplevel $x
  wm title $x ""
  wm iconname $x "haha"
  wm geometry $x +$mx+$my
  set nx [ expr $mx + 5 ]
  set ny [ expr $my + 5 ]
  set nc [ expr $mc + 1 ]
  # positionWindow $x
  
  label $x.hihi -text "Hihihi!!" -foreground "red" -bitmap questhead -borderwidth [ expr $mc / 2 ] -relief sunken
  pack $x.hihi -side top -expand yes -pady 1 -padx 1 -anchor w
  
  after 100 "grab -global $x"
  if { $mc == 1 } {
    after 7000 "easterei $nx $ny $nc"
  } elseif { $nc < 50 } {
    after 342 "easterei $nx $ny $nc"
  } else {
    after 7000 "hilfe"
  }
}

proc neue_datei { state } {
  global ww
  set ww .text
  catch {destroy $ww}
  toplevel $ww
  wm title $ww "Neue Vokabeldatei erstellen"
  wm iconname $ww "neue_datei"
  # positionWindow $ww

  frame $ww.buttons
  pack $ww.buttons -side bottom -fill x -pady 2m
  button $ww.buttons.dismiss -text "Ende" -command "destroy $ww"
  button $ww.buttons.help -text "Hilfe" -command "hilfe"
  button $ww.buttons.code -text "Speichern" -command {
    global $ww
    set name [ fileDialog $ww name save ]
    set myCid [ open $name a ]
    puts $myCid [ string range [ $ww.text get 0.0 end ] 0 [ expr [ string length [ $ww.text get 0.0 end ] ] - 2 ] ]
    close $myCid
    tk_messageBox -icon info -message "Die Datei $name wurde erfolgreich gesichert!" -type ok -parent $ww
  }
  pack $ww.buttons.dismiss $ww.buttons.code -side left -expand 1

  text $ww.text -relief sunken -bd 2 -yscrollcommand "$ww.scroll set" -setgrid 1 -height 30
  scrollbar $ww.scroll -command "$ww.text yview"
  pack $ww.scroll -side right -fill y
  pack $ww.text -expand yes -fill both
  if { $state == 0 } {
     $ww.text insert 0.0 {Deutsch -- Latein}
  } else {
    set name [ fileDialog $ww name open ]
    set myCid [ open $name r ]
    $ww.text insert 0.0 [ read $myCid ]
    close $myCid
  }
  $ww.text mark set insert 0.0
	
} 


