#   gui-2.tcl - Tcl code for communicating with CLISP, NanoCAD GUI
#   Copyright (C) 1996,1997 Will Ware
#   
#   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.
#
#   I can be reached via email at .

toplevel .w
wm title . "NanoCAD Structure Viewer"
wm title .w "NanoCAD Control Panel"

frame .w.f1
frame .w.f2
frame .w.f3

frame .w.f3.sf1 -relief groove -borderwidth 4
frame .w.f3.sf2 -relief groove -borderwidth 4
frame .w.f3.sf3 -relief groove -borderwidth 4
frame .w.f3.sf4 -relief groove -borderwidth 4
frame .w.f3.sf5 -relief groove -borderwidth 4

############################

button .w.f1.b1 -text Load -command {talk_to_lisp "(load)"}
button .w.f1.b2 -text Save -command {talk_to_lisp "(save)"}
button .w.f1.b3 -text SaveXYZ -command {talk_to_lisp "(savexyz)"}
button .w.f1.b4 -text SavePS -command {canvas_ps cl-gui.ps}
button .w.f1.b5 -text Clear -command {talk_to_lisp "(clear)"}
button .w.f1.b6 -text Emin -command {talk_to_lisp "(emin)"}
button .w.f1.b7 -text HideGUI -command \
	{puts stdout "exit"; flush stdout; after 5 destroy .}

############################

set show_force 0
set use_torsion 0
set use_vdw 0

checkbutton .w.f2.cb1 -text "Show Force Vectors" -variable show_force \
	-command update_options
checkbutton .w.f2.cb2 -text "Use Torsion Forces" -variable use_torsion \
	-command update_options
checkbutton .w.f2.cb3 -text "Use VDW Forces" -variable use_vdw \
	-command update_options

############################

set action rotate

radiobutton .w.f3.sf1.rb1 -text Rotate \
	-variable action -value rotate -anchor w -command update_controls
radiobutton .w.f3.sf1.rb2 -text MoveAtom \
	-variable action -value moveatom -anchor w -command update_controls
radiobutton .w.f3.sf1.rb3 -text AddAtom \
	-variable action -value addatom -anchor w -command update_controls
radiobutton .w.f3.sf1.rb4 -text DeleteAtom \
	-variable action -value deleteatom -anchor w -command update_controls
radiobutton .w.f3.sf1.rb5 -text AddBond \
	-variable action -value addbond -anchor w -command update_controls
radiobutton .w.f3.sf1.rb6 -text DeleteBond \
	-variable action -value deletebond -anchor w -command update_controls

pack .w.f3.sf1.rb1 .w.f3.sf1.rb2 .w.f3.sf1.rb3 \
	.w.f3.sf1.rb4 .w.f3.sf1.rb5 .w.f3.sf1.rb6 -side top

############################

set bondorder single

label .w.f3.sf2.lbl -text Bond
radiobutton .w.f3.sf2.rb1 -text Single \
	-variable bondorder -value single -anchor w -command update_controls
radiobutton .w.f3.sf2.rb2 -text Double \
	-variable bondorder -value double -anchor w -command update_controls
radiobutton .w.f3.sf2.rb3 -text Triple \
	-variable bondorder -value triple -anchor w -command update_controls

pack .w.f3.sf2.lbl \
	.w.f3.sf2.rb1 .w.f3.sf2.rb2 .w.f3.sf2.rb3 -side top

############################

set element C

radiobutton .w.f3.sf3.rb1 -text Carbon \
	-variable element -value C -anchor w -command update_controls
radiobutton .w.f3.sf3.rb2 -text Hydrogen \
	-variable element -value H -anchor w -command update_controls
radiobutton .w.f3.sf3.rb3 -text Oxygen \
	-variable element -value O -anchor w -command update_controls
radiobutton .w.f3.sf3.rb4 -text Nitrogen \
	-variable element -value N -anchor w -command update_controls

pack .w.f3.sf3.rb1 .w.f3.sf3.rb2 .w.f3.sf3.rb3 .w.f3.sf3.rb4 -side top

############################

set zoomfactor 25

label .w.f3.sf4.lbl -text Zoom
radiobutton .w.f3.sf4.rb1 -text 10 \
	-variable zoomfactor -value 10 -anchor w -command update_controls
radiobutton .w.f3.sf4.rb2 -text 25 \
	-variable zoomfactor -value 25 -anchor w -command update_controls
radiobutton .w.f3.sf4.rb3 -text 50 \
	-variable zoomfactor -value 50 -anchor w -command update_controls
radiobutton .w.f3.sf4.rb4 -text 100 \
	-variable zoomfactor -value 100 -anchor w -command update_controls

pack .w.f3.sf4.lbl \
	.w.f3.sf4.rb1 .w.f3.sf4.rb2 .w.f3.sf4.rb3 .w.f3.sf4.rb4 -side top

############################

set eminspeed fine

label .w.f3.sf5.lbl -text Emin
radiobutton .w.f3.sf5.rb1 -text Coarse \
	-variable eminspeed -value coarse -anchor w -command update_controls
radiobutton .w.f3.sf5.rb2 -text Fine \
	-variable eminspeed -value fine -anchor w -command update_controls

pack .w.f3.sf5.lbl .w.f3.sf5.rb1 .w.f3.sf5.rb2 -side top

############################

pack .w.f1.b1 .w.f1.b2 .w.f1.b3 .w.f1.b4 .w.f1.b5 .w.f1.b6 .w.f1.b7 -side left
pack .w.f2.cb1 .w.f2.cb2 .w.f2.cb3 -side left
pack .w.f3.sf1 .w.f3.sf2 .w.f3.sf3 .w.f3.sf4 .w.f3.sf5 -side left

pack .w.f1 .w.f2 .w.f3

############################

set cansize 400
canvas .can -width $cansize -height $cansize

bind .can  {
    talk_to_lisp "(press-1 %x %y)"
}

bind .can  {
    talk_to_lisp "(move-1 %x %y)"
}

bind .can  {
    talk_to_lisp "(release-1 %x %y)"
}

pack .can -side left -expand yes -fill both

proc update_options { } {
    global show_force
    global use_torsion
    global use_vdw
    talk_to_lisp "(options $show_force $use_torsion $use_vdw)"
}

proc update_controls { } {
    global action
    global bondorder
    global element
    global zoomfactor
    global eminspeed
    talk_to_lisp "(controls $action $bondorder $element \
	    $zoomfactor $eminspeed)"
}

set pen_color black
set pen_width 1

proc set_color { c } {
    global pen_color
    set pen_color $c
}

proc set_pen { c w } {
    global pen_color
    global pen_width
    set pen_color $c
    set pen_width $w
}

proc delete_erasable { } {
    .can delete erasable
}

proc create_line { x1 y1 x2 y2 } {
    global pen_color
    global pen_width
    .can create line $x1 $y1 $x2 $y2 -width $pen_width \
	    -fill $pen_color -tags erasable
}

proc create_ellipse { x1 y1 x2 y2 } {
    global pen_color
    .can create oval $x1 $y1 $x2 $y2 -fill $pen_color -tags erasable
}

proc canvas_ps { fname } {
    .can postscript -file $fname
}

proc talk_to_lisp { cmd } {
    puts stdout $cmd
    flush stdout
    # accept one or more commands from Lisp, and execute them
    set ex ""
    for { gets stdin i } { [string compare @ $i] != 0 } \
	    { gets stdin i } { set ex "$ex\n$i" }
    foreach b $ex { eval $b }
}

talk_to_lisp "(startup)"
update_controls
update_options