#!/usr/local/tk3.2/bin/wish -f

##################################################################
#
#  bkset  A TCL PRGRAM FOR SETTING UP A BlockComm FORTRAN FILE
#         
#         4/22/1993  Man Kam Kwong, Argonne National Laboratory
#                    kwong@mcs.anl.gov
#
##################################################################

##################################################################
#
#  THIS PREAMBLE DEFINES SOME Tcl PROCS.  SOME OF THEM ARE OF 
#  INTEREST IN THEIR OWN RIGHT.
#
##################################################################

proc : args { m1 $args }
proc do {i s e args} { 
  if {[llength $args]>1} { set in [m1 $args]; set com [m2 $args]
     } else { set in ""; set com $args; }
  eval "uplevel {for {set $i $s} {
        $$i<=$e} {incr $i $in} { eval $com }}"
}
proc EQ {s t} {if [string comp $s $t] {: 0} else {: 1}}
proc lshift list { lrange $list 1 end }
proc m1 list { lindex $list 0 }
proc m2 list { lindex $list 1 }

proc tx {w wd ht args} { if {[llength $w]>1} { set opt "" } else {set opt "-bg azure"}
  set na [eval text $w $opt -relief raised\
  -font 9x15bold -border 2 -width $wd -height $ht -wrap none]
  if {[llength $args]} {eval "uplevel {set [m1 $args] $na}"} else {set na}}
proc dtx args { foreach w $args { $w delete 1.0 end} }
proc ptx {w t} { $w insert 1.0 $t }
proc dptx {w t} { dtx $w; ptx $w $t }
proc ntx args { foreach w $args { $w conf -st disabled } }
proc gtx {w args} { set na "{[$w get 1.0 end]}"
  if {[llength $args]} { eval "uplevel {set [m1 $args] $na}" }
  eval : $na }

proc bn {w t c} {
  button $w -text " $t  " -font 9x15bold -bg pink -com $c}

proc pk {pos w args} { 
  if [ EQ $w . ] {set pw ""} else { set pw $w }
  foreach i $args { set p $pos
    if {[llength $i]==1} {set c $i; } else {
        set c [m1 $i]; append p " [lshift $i]" }
    pack append $w $pw.$c $p } }
proc pcol  args { eval "pk top    $args" }
proc pcolb args { eval "pk bottom $args" }
proc prow  args { eval "pk left   $args" }
proc prowr args { eval "pk right  $args" }

proc xch {args} { if {[llength $args]} {set w [m1 $args]} else {set w .}
  foreach i [winfo child $w] {destroy $i} }

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

if [winfo exists .h] xch  # Used during debugging

proc txp  {w wd t} { tx $w $wd 1; ptx [m1 $w] $t }
proc txpn {w wd t} { txp $w $wd $t; ntx [m1 $w] }

set opt1 {-bg bisque}
set opt2 {-bg blue -fg white}
set opt3 {-bg yellow}
set fo bkcom.f; set fi bkdata
set V0 "  mx";  set V1 "  nx";   set V2 "  nd"
set V3 "  sz";  set V4 " iper";  set V5 " pgm"
set W0 " myid"; set W1 " npr"; set W2 "  st"
set W3 "  en";  set W4 " sgp";   set W5 " egp"

wm title . "BlockComm Setup"
do i 0 8 { frame .t$i }; frame .h 
do i 0 5 { tx .t$i.3 30 1; bind .t$i.3 <Return> ";" }

  tx   ".t0.1 $opt3" 35 1
  txpn ".t0.2 $opt3" 13 "   Example"
  eval .t0.3 conf $opt3
    ptx .t0.3 "     Your Parameters"; ntx .t0.3

  txpn ".t1.1 $opt1" 35 { Sizes of array: mx0 mx1 [mx2 ...]}
  txpn ".t1.2 $opt2" 13 { 12  34  567}

  txpn ".t2.1 $opt1" 35 " # of processors for each dimen"
  txpn ".t2.2 $opt2" 13 "  2   4    0"

  txpn ".t3.1 $opt1" 35 " Periodic?  For each dim enter 0/1"
  txpn ".t3.2 $opt2" 13 "  0   0    1"

  txpn ".t4.1 $opt1" 35 { Stencil type  PLUS p BOX b [width]}
  txpn ".t4.2 $opt2" 13 "  p   2"

  txpn ".t5.1 $opt1" 35 " Enter names of all grid variables"
  txpn ".t5.2 $opt2" 13 " a  b p1  p2"

  txpn ".t6.1 $opt3" 18 "  Variable Names"
  txpn ".t6.2 $opt3" 34 ""
  txpn ".t6.3 $opt3" 10 "  Prepend"
  txp   .t6.4 5 "  "; bind .t6.4 <Return> "Prepend"
  bn .t6.5 Default Def

  do i 7 8 {
  do j 0 5 { tx ".t$i.$j $opt1" 5 1; tx .t$i.v$j 7 1 
     prow .t$i $j v$j; bind .t$i.v$j <Return> ";" } }

  do i 0 5 { eval ptx .t7.$i \$V$i; eval ptx .t8.$i \$W$i 
           do j 7 8 { ntx .t$j.$i} }

proc Input {} { uplevel { set fid [eval open $fi]
  do i 1 5 { dptx .t$i.3 " [read $fid 40]"; gets $fid; }
  gets $fid; gets $fid txt7; gets $fid txt8
  do i 0 5 { dptx .t7.v$i " [m2 [split [lindex $txt7 $i] =]]"
           dptx .t8.v$i " [m2 [split [lindex $txt8 $i] =]]" }
  close $fid } }

Input

  txpn ".h.fo $opt1" 15 "  Output File"
  txp .h.fo2 11 " bkcom.f"
     bind .h.fo2 <Return> ";"
  txpn ".h.fi $opt1" 14 "  Input File"
  txp .h.fi2 11 " bkdata"
    .h.fo conf -border 1
    .h.fi conf -border 1
     bind .h.fi2 <Return> "gtx .h.fi2 fi; Input"
  bn .h.q Quit         "destroy ."
  bn .h.h Help         Help
  bn .h.w "Write File" Write

prow .h fo fo2 fi fi2 q h w 
do i 0 5 { prow .t$i 1 2 3}
do i 1 5 { prow .t6 $i }
pack append . .h fill; do i 0 8 { pcol . t$i }
wm geometry . +10+60

foreach w {.t1.3 .t2.3 .t3.3 .t4.3 .t5.3 .h.fo2 .h.fi2 } { 
  bind $w <Delete> "dtx $w" }
do i 7 8 { do j 0 5 {bind .t$i.v$j <Delete> "dtx .t$i.v$j"} }

proc Write {} { uplevel { set fid [open tmp w] 
  do i 1 5 { puts $fid [gtx .t$i.3] }
  do i 0 5 {scan [gtx .t7.v$i] %s v$i;scan [gtx .t8.v$i] %s w$i}
  puts $fid "\n=$v0 =$v1 =$v2 =$v3 =$v4 =$v5"
  puts $fid "=$w0 =$w1 =$w2 =$w3 =$w4 =$w5"
  close $fid
  gtx .h.fo2 fo; scan "$fo" %s fo
  set fd "[m1 [split $fo .]].data"
  puts stdout "\n*****  Output has been written in $fo"
  puts stdout "*****  Parameters are recorded in $fd\n"
# Need to give bk a complete path.
  exec bk $fo tmp
} }

proc Def "" { uplevel { dptx .t6.4 "  "
  do i 0 5 { dptx .t7.v$i [set V$i]
             dptx .t8.v$i [set W$i] } } }

proc Prepend "" { scan [gtx .t6.4] %s p
  do i 0 5 { scan [gtx .t7.v$i] %s v; dptx .t7.v$i " $p$v"
     scan [gtx .t8.v$i] %s w; dptx .t8.v$i " $p$w" } }

proc Help "" { if ![winfo exists .help] { toplevel .help
  bn .help.q Quit "destroy .help"
  message .help.1 -font 9x15bold -text "This Tcl program helps you to setup the basic Fortran code for using BlockComm, to parallelize a numerical code.  Your entries are:

  \"Output File\"     holds the Fortran program generated
  \"Input File\"      file containing the parameters to be modified

  \"Sizes ... \"      # of node points in each dimension (up to 5 dim)
                    enter only 2 # for 2-D array, etc.
  \"# of ... \"       # of processors assigned to each dimension
                    enter 0 if you want BlockComm to decide it for you
  \"Periodic ... \"   0 means not; 1 means yes
  \"Stencial ... \"   the width is optional
  \"Grid variables\"  all the variables defined on the grid points: if you forget 
                    some or there is not enough space for all of them, you can 
                    edit the output file to make changes

\"Variable names\" These variables have been given default names that can be changed by clicking in the entry box and enter as usual.  The \"Prepend\" entry is used to add a 1- or 2- character prefix to all names.  Use the \"Default\" button to revert all changes back to the default.

   \"mx\"     mx0, mx1, ... are the sizes of the dimensions of the grid array
   \"nx\"     nx0, nx1, ... hold the # of processors in each dimension
   \"nd\"     # of dimensions
   \"sz\"     array used by BlockComm to hold info on sizes of the local block
   \"iper\"   holds the periodicity of the boundary conditions
   \"pgm\"    used by BlockComm, as in \"call Bkexec(pgm,a,a)\"
   \"myid\"   holds the id of the local processor
   \"npr\"    holds the # of processors
   \"st\"     st0, st1, ... are indices of the starting grid point
   \"en\"     en0, en1, ... are indices of the ending grid point
   \"sgp\"    sgp0, sgp1, ... are the # of ghostpoints at the starting end
   \"egp\"    egp0, egp1, ... are the # of ghostpoints at the ending end"
  pcol .help q 1; wm geometry .help +100+302
} }
