#!/bin/sh
# Here is tcl/tk script for visually generating
# latex and xypic arrays. 
# - Donu Arapura (dvb@math.purdue.edu)

# the next line restarts using wish \
exec wish "$0"

######################################################
#             History
#
# Preliminary version Nov. 21, 2000
# Version 1 (submitted to Ctan) July 9, 2001
# -DA
#
# Modified by HF Nordhaug (hansfn@mi.uib.no),
# 01.08.2001:
# - Changed menu labels from 'message' to 'label'
#   because 'label' _always_ obey width commands...
# - Added/changed some widths in the size/help menu
# - Added some text to the the help menu 
# - Added title to size menu
#
# Current revision (Aug. 10 2001) contains
# major structural changes; in particular, the xypic stuff 
# has been completely rewritten.
# -DA 
#####################################################
#           Script Organization
#
# 1. Help Window
# 2. Initial Window (size...)
# 3. Main Window
# 4. Layout Window (xypic mode)
# 5. Make TeX
# 6. Miscellaneous
#
####################################################



########################################
# 1. Help Window
########################################
proc help {} {
    if {[winfo exists .help] == 0} then\
    {toplevel .help

set helpmessage \
"                          Summary
 
Arraymaker is a program for visually constructing latex and xypic
arrays. The output can then be pasted into a (la)tex file.

Ref.
 \[1\] L. Lamport, Latex user's guide, 2nd ed.
 \[2\] K. Rose, Xy-pic user's guide, version 3.7

--------------------------------------------------------------
                         Start Up

To begin with, enter the size of the array - upto 9x9 - and the 
mode (latex or xypic) in the initial window and press \"OK\". 
These choices can be changed at any time while the program
is running.
---------------------------------------------------------------
                          Latex Mode

The entry \"type\" which is initially set to array determines 
the structure as in \\begin{type}...

\"Parenth. style\" determines enclosing  parentheses, if any.
By default there are none.
 
Justification in each column can be changed from center (c) to 
left (l) or right (r).

The actual data is entered under \"array entries\"; these should be
valid latex expressions. Use \"clear\" to erase all of them
if necessary.

Use \"make TeX\" to generate the latex code for the array.
-------------------------------------------------------------
                            Xypic Mode

For our purposes a diagram of the kind generated by xypic can
be viewed as a labelled directed graph such that vertices
are points of a rectangular grid, and where the labels are 
valid (la)tex  expressions. Thus for example
              
              f
            A -> B
                 |
                 C

would require a 2x2 (not 3x3) grid.

First  enter the vertex labels  (e.g. A, B, C) under \"vertices\".


Then pressing \"add arrows\" leads to a new window - the layout -  
with vertices in place, like this:

           A   B

               C

To add an arrow, place mouse over the initial vertex (e.g. A) and 
click with the left button. Then place the mouse on the final vertex 
(e.g. B) and click with the right button (or control-click for a 
one button mouse). Then  you're presented with the option to label 
the arrow (e.g. with f) or modify its shape. Press \"add\" in this new
window to add the arrow, or press \"delete\" to remove it.

To erase all of the arrows, use \"close/clear arrows\"; you can
repeat the previous step(s) if needed. To erase everything (vertices 
and arrows), use \"clear all\".

When you're done, type \"make TeX\" to generate the xypic code.
------------------------------------------------------------

Current revision August 10, 2001.
Some code has been contributed by  HF Nordhaug. 

 Donu Arapura dvb@math.purdue.edu "

text .help.text -relief sunken -bd 2 -yscrollcommand ".help.scroll set"\
 -setgrid 1 -height 30
scrollbar .help.scroll -command ".help.text yview"
pack .help.scroll -side right -fill y
pack .help.text -expand yes -fill both
.help.text insert 0.0 $helpmessage
.help.text mark set insert 0.0
button .help.ok -text "ok" -command "destroy .help"
pack  .help.ok

} else \
    {focus .help}
}
####################################
# 2. Initial window (size...)
####################################

toplevel .size 
wm title .size "arraymaker menu"


frame .size.f1 
label .size.f1.label -text "number of cols" -width 15 -anchor w
entry .size.f1.width -textvariable width -width 10
pack .size.f1.label .size.f1.width -side left
pack .size.f1 -anchor w

frame .size.f2
label .size.f2.label -text "number of rows" -width 15 -anchor w
entry .size.f2.height -textvariable height -width 10
pack .size.f2.label .size.f2.height -side left
pack .size.f2 -anchor w

set mode "latex"
frame .size.f3
label .size.f3.label -text "mode" -width 10 -anchor w
radiobutton .size.f3.rad1 -text latex -variable mode -value "latex"
radiobutton .size.f3.rad2 -text xypic -variable mode -value "xypic"
pack .size.f3.label .size.f3.rad1 .size.f3.rad2 -side left
pack .size.f3 -anchor w


frame .size.f5
button .size.f5.ok -text "OK" -command setupmain
button .size.f5.help -text "help" -command help
button .size.f5.quit -text "quit" -command {destroy .}
pack .size.f5.help .size.f5.ok .size.f5.quit -side left
pack .size.f5 -pady 5



###############################################
# 3. Main Window
###############################################

proc setupmain {} {
    global width height  a b   mode 
# a and b are the key variables; they are arrays of size height x width.
# a is an array of strings containing "array entries" in latex mode,
# and "vertices" in xypic mode. b is an array of lists of strings
# containing arrow information in xpic mode.

destroy .justf .row1 .row2 .row3 .row4 .row5 .row6 .row7 .row8 .row9
destroy .btn .type .label1 .label2 .paren .label3 .texwindow


frame .btn
button .btn.print -text "make TeX" -command {print} 
button .btn.quit -text "quit" -command {destroy .}

if {$width > 9} then {set width  9}
    
    if {$mode == "latex"} then\
    {setuplatex}\
    else\
    {setupxypic}

text .texwindow 

clearall
  
frame .row1
entry .row1.1 -textvariable a(1,1)
entry .row1.2 -textvariable a(1,2)
entry .row1.3 -textvariable a(1,3)
entry .row1.4 -textvariable a(1,4)
entry .row1.5 -textvariable a(1,5)
entry .row1.6 -textvariable a(1,6)
entry .row1.7 -textvariable a(1,7)
entry .row1.8 -textvariable a(1,8)
entry .row1.9 -textvariable a(1,9)

frame .row2
entry .row2.1 -textvariable a(2,1)
entry .row2.2 -textvariable a(2,2)
entry .row2.3 -textvariable a(2,3)
entry .row2.4 -textvariable a(2,4)
entry .row2.5 -textvariable a(2,5)
entry .row2.6 -textvariable a(2,6)
entry .row2.7 -textvariable a(2,7)
entry .row2.8 -textvariable a(2,8)
entry .row2.9 -textvariable a(2,9)

frame .row3
entry .row3.1 -textvariable a(3,1)
entry .row3.2 -textvariable a(3,2)
entry .row3.3 -textvariable a(3,3)
entry .row3.4 -textvariable a(3,4)
entry .row3.5 -textvariable a(3,5)
entry .row3.6 -textvariable a(3,6)
entry .row3.7 -textvariable a(3,7)
entry .row3.8 -textvariable a(3,8)
entry .row3.9 -textvariable a(3,9)

frame .row4
entry .row4.1 -textvariable a(4,1)
entry .row4.2 -textvariable a(4,2)
entry .row4.3 -textvariable a(4,3)
entry .row4.4 -textvariable a(4,4)
entry .row4.5 -textvariable a(4,5)
entry .row4.6 -textvariable a(4,6)
entry .row4.7 -textvariable a(4,7)
entry .row4.8 -textvariable a(4,8)
entry .row4.9 -textvariable a(4,9)

frame .row5
entry .row5.1 -textvariable a(5,1)
entry .row5.2 -textvariable a(5,2)
entry .row5.3 -textvariable a(5,3)
entry .row5.4 -textvariable a(5,4)
entry .row5.5 -textvariable a(5,5)
entry .row5.6 -textvariable a(5,6)
entry .row5.7 -textvariable a(5,7)
entry .row5.8 -textvariable a(5,8)
entry .row5.9 -textvariable a(5,9)

frame .row6
entry .row6.1 -textvariable a(6,1)
entry .row6.2 -textvariable a(6,2)
entry .row6.3 -textvariable a(6,3)
entry .row6.4 -textvariable a(6,4)
entry .row6.5 -textvariable a(6,5)
entry .row6.6 -textvariable a(6,6)
entry .row6.7 -textvariable a(6,7)
entry .row6.8 -textvariable a(6,8)
entry .row6.9 -textvariable a(6,9)

frame .row7
entry .row7.1 -textvariable a(7,1)
entry .row7.2 -textvariable a(7,2)
entry .row7.3 -textvariable a(7,3)
entry .row7.4 -textvariable a(7,4)
entry .row7.5 -textvariable a(7,5)
entry .row7.6 -textvariable a(7,6)
entry .row7.7 -textvariable a(7,7)
entry .row7.8 -textvariable a(7,8)
entry .row7.9 -textvariable a(7,9)


frame .row8
entry .row8.1 -textvariable a(8,1)
entry .row8.2 -textvariable a(8,2)
entry .row8.3 -textvariable a(8,3)
entry .row8.4 -textvariable a(8,4)
entry .row8.5 -textvariable a(8,5)
entry .row8.6 -textvariable a(8,6)
entry .row8.7 -textvariable a(8,7)
entry .row8.8 -textvariable a(8,8)
entry .row8.9 -textvariable a(8,9)

frame .row9
entry .row9.1 -textvariable a(9,1)
entry .row9.2 -textvariable a(9,2)
entry .row9.3 -textvariable a(9,3)
entry .row9.4 -textvariable a(9,4)
entry .row9.5 -textvariable a(9,5)
entry .row9.6 -textvariable a(9,6)
entry .row9.7 -textvariable a(9,7)
entry .row9.8 -textvariable a(9,8)
entry .row9.9 -textvariable a(9,9)


for {set i 1} {$i <= $width} {incr i 1} {
    pack .row1.$i -side left }
pack .row1 
if {$height > 1} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row2.$i -side left }
    pack .row2}
if {$height > 2} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row3.$i -side left }
    pack .row3}
if {$height > 3} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row4.$i -side left }
    pack .row4}
if {$height > 4} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row5.$i -side left }
    pack .row5}
if {$height > 5} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row6.$i -side left }
    pack .row6}
if {$height > 6} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row7.$i -side left }
    pack .row7}
if {$height > 7} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row8.$i -side left }
    pack .row8}
if {$height > 8} then\
    {for {set i 1} {$i <= $width} {incr i 1} {
	pack .row9.$i -side left }
    pack .row9}

pack   .btn .texwindow

}

# specific to latex mode
proc setuplatex {} {
global width height a b left right  just  mode type

button .btn.clear -text "clear" -command clearall
pack .btn.print  .btn.clear .btn.quit -side left

set type "array"
frame .type
label .type.label -text "type:" 
entry .type.value -textvariable type -width 10
pack .type.label .type.value -side left
pack .type 

frame .label1
message .label1.mess -text "parenth. style:" -width 200
pack .label1.mess -side left

frame .label2
message .label2.mess -text "justification(lcr):" -width 200
pack .label2.mess -side left

set left "."
set right "."
frame .paren
message .paren.mess1 -text "(?"
message .paren.mess2 -text ")?"
entry .paren.left -textvariable left
entry .paren.right -textvariable right
pack .paren.mess1 .paren.left  .paren.right .paren.mess2   -side left

pack .label1 .paren .label2

for {set i 1} {$i <= 9} {incr i 1} {
    set just($i) c}

frame .justf
entry .justf.1 -textvariable just(1)
entry .justf.2 -textvariable just(2)
entry .justf.3 -textvariable just(3)
entry .justf.4 -textvariable just(4)
entry .justf.5 -textvariable just(5)
entry .justf.6 -textvariable just(6)
entry .justf.7 -textvariable just(7)
entry .justf.8 -textvariable just(8)
entry .justf.9 -textvariable just(9)

for {set i 1} {$i <= $width} {incr i 1} {
    pack .justf.$i -side left }
pack .justf

frame .label3
message .label3.mess -text "array entries:" -width 200
pack .label3.mess -side left
pack .label3
}

# specific to xypic mode
proc setupxypic {} {
    global width height  a  b mode 

button .btn.clear -text "clear all" -command clearall 
button .btn.layout -text "add arrows"  -command layout
  pack .btn.print .btn.layout .btn.clear .btn.quit -side left

    frame .label3
message .label3.mess -text "vertices:" -width 200
pack .label3.mess -side left
pack .label3
}    

#############################################
# 4. Layout Window (xypic mode)
############################################
proc layout {} {global a b startX startY  scalex scaley  width height
    
    if {[winfo exists .layout] != 0} then \
    {return}

clearb    
toplevel .layout

set startX 0
set startY 0

frame .layout.frame
pack .layout.frame -side top -fill both -expand yes
canvas .layout.frame.c  -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \
    -relief sunken -borderwidth 2 \
    -xscrollcommand ".layout.frame.hscroll set" \
    -yscrollcommand ".layout.frame.vscroll set"
scrollbar .layout.frame.vscroll -command ".layout.frame.c yview"
scrollbar .layout.frame.hscroll -orient horiz -command ".layout.frame.c xview"

grid .layout.frame.c -in .layout.frame \
    -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid .layout.frame.vscroll \
    -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
grid .layout.frame.hscroll \
    -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid rowconfig    .layout.frame 0 -weight 1 -minsize 0
grid columnconfig .layout.frame 0 -weight 1 -minsize 0

frame .layout.btn
button .layout.btn.close -text "close/clear arrows" \
    -command { clearb
    destroy .layout}

pack .layout.btn.close -side left
pack .layout.btn

set scalex [.layout.frame.c canvasx 1c]
set scaley [.layout.frame.c canvasy 1c]


for {set i 1} {$i <= $width} {incr i 1} {
    for {set j 1} {$j <= $height} {incr j 1} {
	.layout.frame.c create text [expr 3*$i]c [expr 3*$j]c \
	    -text [clip $a($j,$i)]}}


bind .layout.frame.c <Button-1> "beginarrow .layout.frame.c %x %y"
bind .layout.frame.c <Control-Button-1> "createarrow .layout.frame.c %x %y"
bind .layout.frame.c <Button-2> "createarrow .layout.frame.c %x %y"
bind .layout.frame.c <Button-3> "createarrow .layout.frame.c %x %y"
}


proc beginarrow {c x y} {
    global startX startY 

set startX [$c canvasx $x 3c]
set startY [$c canvasy $y 3c]}


proc createarrow {c x y} { 
    global startX startY arrowlab  arrowstyle b labelposition \
oldarrowid

if {[winfo exists .configarrow] != 0} then \
    {destroy .configarrow
    $c delete $oldarrowid}

set endX [$c canvasx $x 3c]
set endY [$c canvasy $y 3c]
set arrowid [$c create line $startX $startY $endX $endY  \
    -arrow last -fill blue]
set oldarrowid $arrowid

set arrowlab ""
set arrowstyle ""
set labelposition "^"


toplevel .configarrow
message .configarrow.mess -text "Configure Arrow\n" -width 100
frame  .configarrow.f1
label .configarrow.f1.mess -text Label
entry .configarrow.f1.lab -textvariable arrowlab
radiobutton .configarrow.f1.b1 -text over -variable labelposition -value "^"
radiobutton .configarrow.f1.b2 -text under -variable labelposition -value "_"
radiobutton .configarrow.f1.b3 -text through -variable labelposition -value "|"
pack .configarrow.f1.mess .configarrow.f1.lab .configarrow.f1.b1\
    .configarrow.f1.b2 .configarrow.f1.b3 -side left

message .configarrow.mess2 -text "\nArrow Styles:" -width 100


frame .configarrow.f2
radiobutton .configarrow.f2.b1 -text plain -variable arrowstyle -value ""
radiobutton .configarrow.f2.b2 -text dash -variable arrowstyle -value "\@{-->}"
radiobutton .configarrow.f2.b3 -text squiggly -variable arrowstyle -value "\@{~>}"
radiobutton .configarrow.f2.b4 -text double -variable arrowstyle -value "\@{=>}"
radiobutton .configarrow.f2.b5 -text invisible -variable arrowstyle -value "\@{}"
pack .configarrow.f2.b1 .configarrow.f2.b2 .configarrow.f2.b3\
    .configarrow.f2.b4 .configarrow.f2.b5 -side left

frame .configarrow.f3
radiobutton .configarrow.f3.b0 -text "headless" -variable arrowstyle \
    -value "\@{-}"
radiobutton .configarrow.f3.b1 -text "curve up" -variable arrowstyle \
    -value "\@/^/"
radiobutton .configarrow.f3.b2 -text "curve down" -variable arrowstyle \
    -value "\@/_/"
radiobutton .configarrow.f3.b3 -text "shift up" -variable arrowstyle \
    -value "\@<1ex>"
pack .configarrow.f3.b0 .configarrow.f3.b1 .configarrow.f3.b2 \
    .configarrow.f3.b3  -side left

frame .configarrow.btn
button .configarrow.btn.delete -text delete -command \
"deletearrow $c .configarrow $arrowid"
button .configarrow.btn.ok -text add -command "labelarrow $c $endX $endY "
pack .configarrow.btn.delete .configarrow.btn.ok -side left
pack  .configarrow.mess .configarrow.f1 .configarrow.mess2 .configarrow.f2 \
    .configarrow.f3 .configarrow.btn


}

proc deletearrow {c configarrow arrowid} {
$c delete $arrowid
destroy $configarrow
}

proc labelarrow {c endX endY } { 
global startX startY  arrowlab scalex scaley  arrowstyle \
b labelposition

switch $labelposition {
    "_" {set sign -1}
    "|" {set sign 0}
    default {set sign 1}
}
 

destroy .configarrow
if {$startX > $endX} then \
    {set x [expr ($endX+$startX)/2]
	set y [expr ($endY+$startY)/2+$sign*10]
	}\
	    else \
	    {if {$startX < $endX} then \
	    {set x [expr ($endX+$startX)/2]
	    set y [expr ($endY+$startY)/2-$sign*10]
	    }\
		else \
		{if {$startY < $endY} then \
		{set x [expr ($endX+$startX)/2+$sign*10]
		set y [expr ($endY+$startY)/2]}\
		    else \
		    {set x [expr ($endX+$startX)/2-$sign*10]
		set y [expr ($endY+$startY)/2]}
	    }}
    $c create text $x $y  -text [clip $arrowlab]

    savearrow [expr int($startX/(3*$scalex) + 0.5)]\
	[expr int($startY/(3*$scaley) + 0.5)]\
	[expr floor(($endX-$startX)/ (3*$scalex) + 0.5)] \
	[expr floor(($endY-$startY)/(3*$scaley) + 0.5)] $arrowlab 
    
}


proc savearrow {s t x y label } {
    global arrowstyle  b labelposition

    if {$x >= 0 } then\
	{set h "r" 
	    set X $x}\
		else\
		{set h "l"
	    set X [expr -$x] }
	set horizlist [list ]
	for {set i 1} {$i <= $X} {incr i 1} {
	    set horizlist [concat $horizlist [list $h]]
	}
	set horiz [join $horizlist ""]

	if {$y >= 0 } then\
	    {set v "d" 
		set Y $y}\
		    else\
		    {set v "u"
		set Y [expr -$y] }
	    set vertlist [list ]
	    for {set i 1} {$i <= $Y} {incr i 1} {
		set vertlist [concat $vertlist [list $v]]
	    }
	    set vert [join $vertlist ""]
	    
	    if {$label == ""} then \
		{set lis [list  "\\ar" $arrowstyle "\[" $horiz $vert "\]" ]}\
		else \
		{set lis [list  "\\ar" $arrowstyle "\[" $horiz $vert "\]" \
		$labelposition "{" $label "}"]}
		
		set out [join $lis ""] 
		set b($t,$s) [concat $b($t,$s) [list $out]]
}


################################################
# 5. Make TeX
###############################################
proc print {} { 
    global a b  width height just left right type mode
    
    if {$mode == "latex"} then \
	{set clis [list ]
	    for {set i 1} {$i <= $width} {incr i 1} {
		set clis [concat $clis [list $just($i)]]}
	    set cc [join $clis ""]
	    set lis [list "\n\n\\left" $left "\n\\begin{" $type "}{" $cc "}\n "]
	    set ending [list  "\\end{" $type "}\n\\right" $right "\n"]
	    }\
		else \
		{set lis [list "\n\n\\xymatrix{\n "]
	    set ending [list "}" ]
	}
	for {set j 1} {$j <= $height} {incr j 1} {
	    for {set i 1} {$i < $width} {incr i 1} {
		set lis [concat $lis [list $a($j,$i)] $b($j,$i) [list " " & " "]]}
	    if {$j < $height} then\
		{set lis [concat $lis [list $a($j,$width)] $b($j,$i) [list " \\\\\n "]]}\
		else \
		{set lis [concat $lis [list $a($j,$width)] $b($j,$i) [list "\n"]]}
	}
	set lis [concat $lis  $ending]
	set texcode [join $lis ""]
	.texwindow  insert 0.0 $texcode
}

################################
# 6. Miscellaneous
#################################
proc clearall {} {global a .layout
    for {set i 1} {$i <= 9} {incr i 1} {
	for {set j 1} {$j <= 9} {incr j 1} {
	    set a($i,$j) ""}}
    clearb
    destroy .layout
    destroy .configarrow
}

proc clearb {} {global b
    for {set i 1} {$i <= 9} {incr i 1} {
	for {set j 1} {$j <= 9} {incr j 1} {
	    set b($i,$j) [list ]}}
}

proc clip {str} {
    if {[string length $str] > 5} then\
	{join [concat [list [string range $str 0 5]] "..."] ""}\
	else\
	{return $str}
}