#!/usr/local/tk-3.3/bin/wish -f
#!/usr/bin/X11/wish -f

# THINGS TO DO
#  complicated squeeze
#  squeeze parentless parents
#  get rid of cursor in text proof window
#  display "extra" history (demod, gL-id, etc.)
#  position display for nonequality, nonunit.

global argc argv

# initial size of displayed part of canvas

set Can_width 925
set Can_height 675

set Can_buffer 10  ;# space at edges of scrollregion

if {1} {
    # Helvetica is variable-width.  This can help, because proofs are WIDE.
    set Large_font -*-helvetica-*-r-*-*-*-240-*-*-*-*-*-*
    set Med_font -*-helvetica-*-r-*-*-*-140-*-*-*-*-*-*
    set Small_font -*-helvetica-medium-r-*-*-*-100-*-*-*-*-*-*
} else {
    # lucidatypewriter is fixed-width.
    set Large_font -*-lucidatypewriter-*-*-*-*-*-240-*-*-*-*-*-*
    set Med_font -*-lucidatypewriter-*-*-*-*-*-140-*-*-*-*-*-*
    set Small_font -*-lucidatypewriter-medium-*-*-*-*-100-*-*-*-*-*-*
}

# space between parents

set Large_h_space 14
set Med_h_space   10
set Small_h_space  6

# space between parents and child

set Large_v_space 70
set Med_v_space   50
set Small_v_space 30

set Font_size small
set Orientation vertical
set Term_shade #dddddd
set Term_bg white
set Term_fg black

proc get_opts {} {
    global argc argv Proof_file

    if {$argc == 1} {
        set Proof_file [lindex $argv 0]
    } else {
        set Proof_file ""
    }
}  ;#  get_opts

proc setup {} {
    global Font_size Large_font Med_font Small_font Orientation
    global Can_width Can_height
    wm minsize . 0 0
    wm title . "Proof Display"
    wm geometry . -0+0

    frame .menu -relief raised -borderwidth 2
    frame .fr -relief raised -bd 2

    pack .menu -side top -fill x
    pack .fr -side bottom -expand yes -fill both

    canvas .fr.can -background white -width $Can_width -height $Can_height \
        -xscroll ".fr.hscroll set" -yscroll ".fr.vscroll set"

    scrollbar .fr.vscroll -relief sunken -command ".fr.can yview"
    scrollbar .fr.hscroll -orient horiz -relief sunken -command ".fr.can xview"

    pack .fr.vscroll -side right -fill y
    pack .fr.hscroll -side bottom -fill x
    pack .fr.can -expand yes -fill both

    menubutton .menu.misc -text Misc -menu .menu.misc.m -relief raised
    menu .menu.misc.m
    .menu.misc.m add command -label "Display proof of last step" -command display
    .menu.misc.m add command -label Clear -command clear
    .menu.misc.m add command -label Postscript -command output_postscript
    .menu.misc.m add command -label Quit -command exit

    menubutton .menu.font -text "Font size" -menu .menu.font.radio -relief raised
    menu .menu.font.radio
    .menu.font.radio add radio -label Small -font $Small_font \
         -variable Font_size -value small -command change_font
    .menu.font.radio add radio -label Medium -font $Med_font \
         -variable Font_size -value medium -command change_font
    .menu.font.radio add radio -label Large -font $Large_font \
         -variable Font_size -value large -command change_font

    menubutton .menu.orient -text Orientation -menu .menu.orient.radio -relief raised
    menu .menu.orient.radio
    .menu.orient.radio add radio -label Vertical \
         -variable Orientation -value vertical -command change_orientation
    .menu.orient.radio add radio -label Horizontal \
         -variable Orientation -value horizontal -command change_orientation

    label .menu.flab -text "Proof file:"
    entry .menu.load -relief sunken -width 20 -textvariable Proof_file
    bind .menu.load <Return> read_proof

    label .menu.levlab -text "Display level:"
    entry .menu.level -relief sunken -width 4 -textvariable Display_level

    pack .menu.misc .menu.font .menu.orient -side left
    pack .menu.load .menu.flab -side right
    pack .menu.level .menu.levlab -side right

#   .fr.can bind all <1> term_button

    bind .fr.can <2> ".fr.can scan mark %x %y"
    bind .fr.can <B2-Motion> ".fr.can scan dragto %x %y"

}  ;# setup

proc output_postscript {} {
    global X_tree_size Y_tree_size Orientation

    if {$Orientation == "vertical"} {
	set width $X_tree_size; set height $Y_tree_size
    } else {
	set width $Y_tree_size; set height $X_tree_size
    }

# 775 x 600 seems to fit on US paper.

    set max [max $width $height]
    set min [min $width $height]

    if {$max > 775 || $min > 600} {
	puts "\nMaximum size is 600x775 or 775x600 (rotated)."
        puts "Your tree is $width x $height."
        puts "Postscript generated anyway."
    }
       
    if {$width > 600} {
	set rotate 1
    } else {
        set rotate 0
    }

    puts "$width x $height rotate=$rotate"

    .fr.can postscript -colormode gray -file temp.ps -rotate $rotate -width $width -height $height
}  ;# output_postscript

proc read_proof {} {
    global Proof_file Have_proof S Proof

    if {$Have_proof} {unset S; unset Proof; set Have_proof 0; destroy .proof}

    set f [open $Proof_file r]
    set Proof {}
    for {set i 0} {[gets $f line] >= 0} {incr i} {
        set Proof [linsert $Proof $i $line]
        parse_step $line
    }
    close $f

    if {$i > 0} {
        set Have_proof 1
        text_proof
    }
}  ;# read_proof

proc max {a b} {
    if {$a > $b} {
        return $a
    } else {
        return $b
    }
}  ;# max

proc min {a b} {
    if {$a < $b} {
        return $a
    } else {
        return $b
    }
}  ;# min

proc exactly_one_zero {a b} {
    if {$a == 0 && $b != 0} {
        return 1
    } elseif {$a != 0 && $b == 0} {
        return 1
    } else {
        return 0
    }
}  ;# exactly_one_zero

proc error_message {message} {
    global Med_font
    set id [.fr.can create text 5 5 -text $message -font $Med_font \
                 -anchor nw -fill red]
    after 2000 ".fr.can delete $id"  ;# after 2 seconds
}  ;# error_message

proc clear_drawn_flag {d} {
    global D S
    set S($D($d,id),drawn) 0
    if {$D($d,list_of_parents)} {
	foreach p $D($d,parents) {
            clear_drawn_flag $p
	}
    } elseif {$D($d,num_parents) == 1} {
        clear_drawn_flag $D($d,p1)
    } elseif {$D($d,num_parents) == 2} {
        clear_drawn_flag $D($d,p1)
        clear_drawn_flag $D($d,p2)
    }
}  ;# clear_drawn_flag

proc clear {} {
    global Displayed_proof D
    if {$Displayed_proof} {
        clear_drawn_flag $Displayed_proof
        # tag "all" is implicitly associated with every item on canvas
        .fr.can delete all
        unset D
        set Displayed_proof 0
    }
    .fr.can xview 0
    .fr.can yview 0
}  ;# clear

proc change_font {} {
    global Font_size Term_font Term_h_space Term_v_space
    global Small_font Med_font Large_font
    global Small_h_space Med_h_space Large_h_space
    global Small_v_space Med_v_space Large_v_space
    global Displayed_proof Term_fg D

    switch $Font_size {
        small {set Term_font $Small_font; set Term_h_space $Small_h_space; set Term_v_space $Small_v_space}
        medium {set Term_font $Med_font; set Term_h_space $Med_h_space; set Term_v_space $Med_v_space}
        large {set Term_font $Large_font; set Term_h_space $Large_h_space; set Term_v_space $Large_v_space}
    }

    set d $Displayed_proof
    if {$Displayed_proof} {
        set id $D($d,id)
        clear
        display_proof $id $Term_fg $Term_font
    }
}  ;# change_font

proc change_orientation {} {
    global Orientation
    global Displayed_proof D Term_fg Term_font

    set d $Displayed_proof
    if {$Displayed_proof} {
        set id $D($d,id)
        clear
        display_proof $id $Term_fg $Term_font
    }
}  ;# change_orientation

proc erase_proof {d} {
    global D
    .fr.can delete term$d
    erase_proof $D($d,p1)
    erase_proof $D($d,p2)
}  ;# erase_proof

proc string_size {string font} {
    # draw it, measure it, erase it (there must be a better way)
    .fr.can create text -100 -100 -anchor e -text $string -font $font \
         -tag temptag
    set box [.fr.can bbox temptag]
    .fr.can delete temptag
    set width [expr [lindex $box 2] - [lindex $box 0]]
    set height [expr [lindex $box 3] - [lindex $box 1]]
    set size "$width $height"
    return $size
}  ;# string size

proc parse_step {step} {
    global S

    set id [lindex $step 0]
    set hist [lindex $step 1]
    set S($id,clause) [lindex $step 2]
    set S($id,list_of_parents) 0
    if {[llength $hist] == 0} {
        set S($id,rule) "input"
    } else {
        set S($id,rule) [lindex $hist 0]
    }
    switch $S($id,rule) {
        input {
            set S($id,num_parents) 0
            set S($id,other) ""
        }
        binary -
        para_from -
        para_into {
            set S($id,num_parents) 2
            set S($id,par1) [lindex $hist 1]
            set S($id,pos1) [lindex $hist 2]
            set S($id,par2) [lindex $hist 3]
            set S($id,pos2) [lindex $hist 4]
            set S($id,other) [lindex $hist 5] ; # ok if not there
        }
	hyper -
        ur {
	    # "132 {hyper {1,5,6}} p"
            set S($id,list_of_parents) 1
	    set parents [lindex $hist 1]
	    regsub -all , $parents " " S($id,parents)
            set S($id,num_parents) [llength $S($id,parents)]
            set S($id,other) [lindex $hist 2] ; # ok if not there
	}
        back_demod -
        factor -
        gL {
            set S($id,num_parents) 1
            set S($id,par1) [lindex $hist 1]
            set S($id,pos1) ""
            set S($id,other) [lindex $hist 2] ; # ok if not there
        }
        demod -
	factor_simp {
            set S($id,rule) ""
            set S($id,num_parents) 0
            set S($id,other) [lindex $hist 1] ; # ok if not there
        }
    }

    set S($id,drawn) 0

}  ;# parse_step

proc arrange_proof {id font level} {

    # First, have parents arrange themselves individually, then
    # arrange them with respect to each other (i.e., set their offsets)
    # and calculate the size of $t.
    #
    # Proof tree is normally displayed vertically, with the root at
    # the bottom.  If {$Orientation == "horizontal"}, the root is at
    # the right.  In both cases, coordinates are calculated as if for
    # vertical display; then when things are actually drawn on the
    # canvas, if {$Orientation == "horizontal"}, x and y are switched.
    #
    # In addition, when ARRANGING the proof, if "horizontal",
    # (1) text string containing clause is treated as if it
    # will be displayed vertically, so that when transposed, geometry
    # is correct, and (2) staggering and squeezing are not done.

    global D D_count Term_h_space Term_v_space S Orientation
    set max_width 0; set max_height 0

    incr D_count
    set d $D_count
    set rule $S($id,rule)

    set D($d,id) $id

    if {($rule == "input") || $S($id,drawn) || ($level == 0)} {
        set D($d,num_parents) 0
	set D($d,list_of_parents) 0
    } else {
        set D($d,num_parents) $S($id,num_parents)
	set D($d,list_of_parents) $S($id,list_of_parents)
    }

    set S($id,drawn) 1

    set size [string_size "$id.$S($id,clause)" $font]

    if {$Orientation == "vertical"} {
        set wc [expr [lindex $size 0] + 4] ;# add a few for position
        set hc [lindex $size 1]
    } else {
        set hc [expr [lindex $size 0] + 4] ;# add a few for position
        set wc [lindex $size 1]
    }

    set D($d,cwidth) $wc
    set D($d,cheight) $hc

    if {$D($d,num_parents) == 0} {
        set D($d,width) $wc
        set D($d,height) $hc
        # clause anchor will be s (south).
        set D($d,cx) [expr $wc / 2]
        set D($d,cy) $hc

    } elseif {$D($d,list_of_parents)} {

        # Arrange parent proofs, set horizontal offsets, find max height.
	# Assume child is not wider than sum of parents.

	set vmax 0; set width 0
	foreach e $S($id,parents) {
	    set de [arrange_proof $e $font [expr $level-1]]
	    lappend parents $de
	    set D($de,x) $width
            set D($de,unify_pos) {}
	    set width [expr $width + $D($de,width) + $Term_h_space]
	    set vmax [max $vmax $D($de,height)]
	}
	set D($d,parents) $parents

	set width [expr $width - $Term_h_space]
	set D($d,width) $width
        set height [expr $vmax + $Term_v_space + $hc]
	set D($d,height) $height
	
        # Set vertical offsets of parents
        foreach de $parents {
	    set D($de,y) [expr $vmax - $D($de,height)]
        }

        # Calculate center of clause; try to put it midway between parents.

        set p1 [lindex $D($d,parents) 0]
        set pn [lindex $D($d,parents) [expr $D($d,num_parents)-1]]

        set c1 [expr $D($p1,x) + $D($p1,cx)]
        set cn [expr $D($pn,x) + $D($pn,cx)]
        set center [expr ($c1 + $cn) / 2]

        # Place child at bottom center.
        set D($d,cx) $center
        set D($d,cy) $height

    } elseif {$D($d,num_parents) == 2} {

        # Arrange parent proofs.

        set d1 [arrange_proof $S($id,par1) $font [expr $level-1]]
        set d2 [arrange_proof $S($id,par2) $font [expr $level-1]]

        set D($d,p1) $d1
        set D($d,p2) $d2

        set D($d1,unify_pos) $S($id,pos1)
        set D($d2,unify_pos) $S($id,pos2)

        # Arrange this step of the proof.

        set w1 $D($d1,width)
        set h1 $D($d1,height)
        set w2 $D($d2,width)
        set h2 $D($d2,height)

        # Calculate height for this box and vertical offsets of parents.

	if {$Orientation == "vertical"} {
        # Stagger bottoms of parent proofs for readability.
            if {$h1 == $h2} {
                set D($d1,y) $hc
                set D($d2,y) 0
                set D($d,height) [expr $h1 + $Term_v_space + $hc + $hc]
            } else {
                set hmax [max $h1 $h2]
                set D($d,height) [expr $hmax + $Term_v_space + $hc]
                if {$hmax == $h1} {
                    set D($d1,y) 0
                    set D($d2,y) [expr ($h1 - $h2)-$hc]
                } else {
                    set D($d2,y) 0
                    set D($d1,y) [expr ($h2 - $h1)-$hc]
                }
            }
            set D($d,cy) $D($d,height)

        } else {
            set hmax [max $h1 $h2]
            set D($d,height) [expr $hmax + $Term_v_space + $hc]
            if {$hmax == $h1} {
                set D($d1,y) 0
                set D($d2,y) [expr $h1 - $h2]
            } else {
                set D($d2,y) 0
                set D($d1,y) [expr $h2 - $h1]
            }
            set D($d,cy) $D($d,height)
        }

        # Set width of box and horizontal offsets of parents.

        if {[exactly_one_zero $D($d1,num_parents) $D($d2,num_parents)] && \
            $Orientation == "vertical"} {

            # Try to squeeze parents together. 
            set wmax [max $w1 $w2]
            set width [expr ($D($d1,cwidth)/2) + ($D($d2,cwidth)/2) + \
                     $Term_h_space + $D($d1,cx) + ($w2-$D($d2,cx))]
            # Make sure child is not smaller than wider parent.
            if {$width < $wmax} {set width $wmax}

            # Following should be fixed to move lone parent closer

            set D($d,width) $width
            set D($d1,x) 0
            set D($d2,x) [expr $width - $w2]

        } else {
            set width [expr $w1 + $Term_h_space + $w2]
            # If child is bigger than sum of parents, spread parents.
            if {$wc > $width} {set width $wc}

            set D($d,width) $width
            set D($d1,x) 0
            set D($d2,x) [expr $width - $w2]
        }

        # Calculate center of clause; try to put it midway between parents.

        set c1 [expr $D($d1,x) + $D($d1,cx)]
        set c2 [expr $D($d2,x) + $D($d2,cx)]
        set center [expr ($c1 + $c2) / 2]

        # Adjust center if clause is out of bounds.

        set half [expr $wc/2]
        if {$center-$half < 0} {
            set center $half
        } elseif {$center+$half > $width} {
            set center [expr $width - $half]
        }
        set D($d,cx) $center

    } else {

        # Assume there is exactly one parent

        set d1 [arrange_proof $S($id,par1) $font [expr $level-1]]
        set D($d,p1) $d1
        set D($d1,unify_pos) $S($id,pos1)

        # Arrange this step of the proof.

        set w1 $D($d1,width)
        set h1 $D($d1,height)

        # Height and Vertical offset.

        set D($d,height) [expr $h1 + $Term_v_space + $hc]
        set D($d,cy) $D($d,height)
        set D($d1,y) 0

        # Horizontal offset and width.

        if {$wc > $w1} {
            set D($d,width) $wc
            set D($d1,x) [expr ($wc-$w1)/2]
            set D($d,cx) [expr $wc/2]
        } else {
            set D($d,width) $w1
            set D($d1,x) 0
            set D($d,cx) $D($d1,cx)
        }
    }

    return $d

}  ;# arrange proof

proc absolute_proof {d x_par y_par} {
    # replace the offsets with absolute coordinates
    global D X_tree_size Y_tree_size

    set x [expr $x_par + $D($d,x)]
    set y [expr $y_par + $D($d,y)]

    set D($d,x) $x
    set D($d,y) $y
    set D($d,cx) [expr $x + $D($d,cx)]
    set D($d,cy) [expr $y + $D($d,cy)]

    set X_tree_size [max $X_tree_size [expr $x + $D($d,width)]]
    set Y_tree_size [max $Y_tree_size [expr $y + $D($d,height)]]

    if {$D($d,list_of_parents)} {
	foreach p $D($d,parents) {
            absolute_proof $p $x $y
        }
    } elseif {$D($d,num_parents) == 1} {
        absolute_proof $D($d,p1) $x $y
    } elseif {$D($d,num_parents) == 2} {
        absolute_proof $D($d,p1) $x $y
        absolute_proof $D($d,p2) $x $y
    }
}  ;# absolute_proof

proc draw_clause {x y id clause pos font} {
    global Term_shade

    if {$pos == ""} {
        set txt "$id.$clause"        
        .fr.can create text $x $y -font $font -anchor nw -text $txt -fill black
    } else {
        set part [partition_position $clause $pos]

        set s0 [lindex $part 0]
        set s1 [lindex $part 1]
        set s2 [lindex $part 2]

        set x1 $x
        set i [.fr.can create text $x1 $y -font $font -anchor nw -text "$id."]
        set box [.fr.can bbox $i]
        set x1 [lindex $box 2]
        if {$s0 != ""} {
            set i [.fr.can create text $x1 $y -font $font -anchor nw -text $s0]
            set box [.fr.can bbox $i]
            set x1 [lindex $box 2]
        }
        if {$s1 != ""} {
            set i [.fr.can create text $x1 $y -font $font -anchor nw -text $s1]
            set box [.fr.can bbox $i]
            .fr.can delete $i

            set x2 [lindex $box 2]
            set y2 [lindex $box 3]

            .fr.can create rectangle $x1 $y $x2 $y2 -fill $Term_shade -outline ""
            .fr.can create text $x1 $y -font $font -anchor nw -text $s1

            set x1 [lindex $box 2]
        }
        if {$s2 != ""} {
            set i [.fr.can create text $x1 $y -font $font -anchor nw -text $s2]
        }
    }
}  ;# draw_clause

proc draw_proof {d fg font} {
    global D S Orientation Term_font Large_font Term_h_space

    set cx $D($d,cx)
    set cy $D($d,cy)

    set x $D($d,x)
    set y $D($d,y)
    set width $D($d,width)
    set height $D($d,height)

    # Draw a rectangle if the clause has parents that will not be shown.

    if {$D($d,num_parents) == 0 && $S($D($d,id),rule) != "input"} {

        if {$Orientation == "vertical"} {
            .fr.can create rectangle $x [expr $y-1] [expr $x+$width+1] \
                  [expr $y+$height+1] -outline $fg -tag term$d
	} else {
            .fr.can create rectangle $y [expr $x-1] [expr $y+$height+1] \
                  [expr $x+$width+1] -outline $fg -tag term$d
        }
    }

    set x4 [expr $cx - ($D($d,cwidth)/2)]
    set y4 [expr $cy - $D($d,cheight)]

    set pos $D($d,unify_pos)

    if {$Orientation == "vertical"} {
        draw_clause $x4 $y4 $D($d,id) $S($D($d,id),clause) $pos $font
    } else {
        draw_clause $y4 $x4 $D($d,id) $S($D($d,id),clause) $pos $font
    }

    if {$D($d,list_of_parents)} {
        set x0 $cx; set y0 [expr $cy - $D($d,cheight)]
	foreach p $D($d,parents) {
            draw_proof $p $fg $font
            set x1 $D($p,cx); set y1 $D($p,cy)
            if {$Orientation == "vertical"} {
                .fr.can create line $x0 $y0 $x1 $y1 -fill $fg -width 2
            } else {
                .fr.can create line $y0 $x0 $y1 $x1 -fill $fg -width 2
	    }
        }

    } elseif {$D($d,num_parents) == 2} {

        draw_proof $D($d,p1) $fg $font
        draw_proof $D($d,p2) $fg $font

        # draw connecting lines

        set x1 $D($D($d,p1),cx); set y1 $D($D($d,p1),cy)
        set x2 $D($D($d,p2),cx); set y2 $D($D($d,p2),cy)
        set x0 $cx; set y0 [expr $cy - $D($d,cheight)]

        if {$Orientation == "vertical"} {
            .fr.can create line $x0 $y0 $x1 $y1 -fill $fg -width 2
            .fr.can create line $x0 $y0 $x2 $y2 -fill $fg -width 2
        } else {
            .fr.can create line $y0 $x0 $y1 $x1 -fill $fg -width 2
            .fr.can create line $y0 $x0 $y2 $x2 -fill $fg -width 2
        }

        # draw curved arrow for paramoudlation

        set rule $S($D($d,id),rule)

        if {$rule == "para_from"} {
            set direction "last"
        } elseif {$rule == "para_into"} {
            set direction "first"
        } else {
            set direction "none"
        }

        if {$direction != "none"} {
            set e1 [expr ($x1-$x0)/4+$x0]; set f1 [expr ($y1-$y0)/4+$y0]
            set e2 [expr ($x2-$x0)/4+$x0]; set f2 [expr ($y2-$y0)/4+$y0]
            set e0 $x0; set f0 $y1

            if {$Orientation == "vertical"} {
                .fr.can create line $e1 $f1 $e0 $f0 $e2 $f2 -smooth on \
                    -arrow $direction -width 1
            } else {
                .fr.can create line $f1 $e1 $f0 $e0 $f2 $e2 -smooth on \
                    -arrow $direction -width 1
            }
        }
    } elseif {$D($d,num_parents) == 1} {
        draw_proof $D($d,p1) $fg $font
        set x0 $cx; set y0 [expr $cy - $D($d,cheight)]
        set x1 $D($D($d,p1),cx); set y1 $D($D($d,p1),cy)
        if {$Orientation == "vertical"} {
            .fr.can create line $x0 $y0 $x1 $y1 -fill $fg -width 2
            set rule $S($D($d,id),rule)
	    .fr.can create text [expr ($x0+$x1)/2+$Term_h_space] \
		 [expr ($y0+$y1)/2] -text $rule -anchor w -font $Term_font
        } else {
            .fr.can create line $y0 $x0 $y1 $x1 -fill $fg -width 2
        }
    }

    # Draw red dots on inferences with "other" history (which is not shown).

    if {$S($D($d,id),other) != "" && $D($d,num_parents) != 0} {
        if {$Orientation == "vertical"} {
            set x0 [expr $cx - $Term_h_space/2]
	    if {$D($d,num_parents) == 1} {
                set x0 [expr $x0 - $Term_h_space]
            }
            set y0 [expr $cy - 2*$D($d,cheight)]
	    .fr.can create oval $x0 $y0 [expr $x0+$Term_h_space] [expr $y0+$Term_h_space] -fill red -outline ""
	} else {
            set x0 [expr $cx - ($D($d,cwidth)/2 + $Term_h_space)]
            set y0 [expr $cy - $D($d,cheight)]
	    .fr.can create oval $y0 $x0 [expr $y0+$Term_h_space] [expr $x0+$Term_h_space] -fill red -outline ""

	}
    }

    update

}  ;# draw_proof

proc display_proof {id fg font} {
    global D Displayed_proof Display_level Orientation
    global X_tree_size Y_tree_size Can_width Can_height Can_buffer

    set d [arrange_proof $id $font $Display_level]
    set D($d,x) 0
    set D($d,y) 0
    set D($d,unify_pos) {}

    set X_tree_size 0
    set Y_tree_size 0
    absolute_proof $d $Can_buffer $Can_buffer
    set X_tree_size [expr $X_tree_size + $Can_buffer]
    set Y_tree_size [expr $Y_tree_size + $Can_buffer]

    if {$Orientation == "vertical"} {
        set x_region [max $X_tree_size $Can_width]
        set y_region [max $Y_tree_size $Can_height]
        .fr.can configure -scrollregion "0 0 $x_region $y_region"
    } else {
        set y_region [max $Y_tree_size $Can_width]
        set x_region [max $X_tree_size $Can_height]
        .fr.can configure -scrollregion "0 0 $y_region $x_region"
    }

    draw_proof $d $fg $font
    set Displayed_proof $d
}  ;# display_proof

proc display {} {
    global Term_fg Term_font Proof
    clear
    set last_id [lindex [lindex $Proof [expr [llength $Proof]-1]] 0]
    display_proof $last_id $Term_fg $Term_font
}  ;# display

# From tk demo directory:
#
# The procedure below inserts text into a given text widget and
# applies one or more tags to that text.  The arguments are:
#
# w             Window in which to insert
# text          Text to insert (it's inserted at the "insert" mark)
# args          One or more tags to apply to text.  If this is empty
#               then all tags are removed from the text.

proc insertWithTags {w text args} {
    set start [$w index insert]
    $w insert insert $text
    foreach tag [$w tag names $start] {
        $w tag remove $tag $start insert
    }
    foreach i $args {
        $w tag add $i $start insert
    }
}  ;# insertWithTags

proc text_proof {} {
    global Proof Small_font
    catch {destroy $w}
    toplevel .proof
    wm title .proof "Proof Text"
    wm geometry .proof +0+0

    text .proof.t -relief raised -bd 2 -yscrollcommand ".proof.s set" \
            -setgrid true -font $Small_font

    scrollbar .proof.s -relief flat -command ".proof.t yview"
    pack .proof.s -side right -fill y
    pack .proof.t -expand yes -fill both

    set bold "-foreground white -background black"
    set normal "-foreground {} -background {}"

    .proof.t insert 0.0 {To display the proof of a particular step,
click on the step with button 1.

}
    set max_length 44  ;# so above message will always fit

    set n [llength $Proof]
    for {set i 0} {$i < $n} {incr i} {
        set step [lindex $Proof $i]
        insertWithTags .proof.t $step d$i
        insertWithTags .proof.t \n
        .proof.t tag bind d$i <Any-Enter> ".proof.t tag configure d$i $bold"
        .proof.t tag bind d$i <Any-Leave> ".proof.t tag configure d$i $normal"
        .proof.t tag bind d$i <1> "process_step [lindex [lindex $Proof $i] 0]"
        set max_length [max [string length $step] $max_length]
    }

    set w [min 130 $max_length]
    set h [min 67 [expr $n+4]]
        
    .proof.t configure -width $w -height $h
}  ;# text_proof

proc process_step {id} {
    global Term_shade Term_fg Term_font Proof
    clear
    display_proof $id $Term_fg $Term_font
}  ;# process_step

proc advance_one_term {s i} {
    set j $i
    set p 0
    set stop 0
    while { ! $stop } {
        incr j
        set c [string index $s $j]
        if {$p == 0 && ($c == "," || $c == ")" || $c == "=" || $c == "")} {
            set stop 1
        } elseif {$c == "("} {
            incr p
        } elseif {$c == ")"} {
            set p [expr $p-1]
        }
    }
    return $j
}  ;# advance_one_term

proc nth_subterm {s i n} {
    set j $i
    while {[string index $s $j] != "("} {incr j}
    incr j
    for {set k 1} {$k < $n} {incr k} {
        set j [advance_one_term $s $j]
        incr j
    }
    return $j
}  ;# nth_subterm

proc partition_position {clause pos} {

    # Split $clause into 3 strings and return a list of the 3 strings.
    # The second string corresponds to the position given by $pos.
    # If $pos is empty, the second and third strings will be empty;
    # otherwise, either or both of the first and third strings can be empty.

    # First, set j to point at the beginning of the correct literal.

# puts "partition clause $clause $pos"  

    set n [lindex $pos 0]
    for {set i 1; set j 0} {$i < $n} {incr i} {
        for {} {[string index $clause $j] != "|"} {incr j} {}
        incr j
        }

# puts "ok, have literal, j=$j"  

    if {[string index $clause $j] == " "} {incr j}

    set len [llength $pos]

    if {$len == 1} {
        # The position indicates an entire literal.
	set k $j
        for {} {[string index $clause $k] != "|" && [string index $clause $k] != ""} {incr k} {}
	
        # j is start of s1, k is one past end of s1

        set s0 [string range $clause 0 [expr $j-1]]
        set s1 [string range $clause $j [expr $k-1]]
        set s2 [string range $clause $k end]
       
    } elseif {$len >= 2} {

        set eq 0; set l [string length $clause]; set k $j

        while {!$eq && $k < $l } {
	    set c [string index $clause $k]
	    if {$c == "="} {
# puts "equality literal"  
		set eq 1
	    } elseif {$c == "|"} {
		set k $l
	    }
	    incr k
	}

        if {$eq && [lindex $pos 1] == 2} {
            set j $k
        } 

	if {$eq} {
	    set k 2
	} else {
	    set k 1
        }

# puts "len=$len, j=$j, k=$k"

        for {} {$k < $len} {incr k} {
            set n [lindex $pos $k]
            set j [nth_subterm $clause $j $n]
        }

        set k [advance_one_term $clause $j]

# puts "len=$len, j=$j, k=$k"

        # j is start of s1, k is one past end of s1

        set s0 [string range $clause 0 [expr $j-1]]
        set s1 [string range $clause $j [expr $k-1]]
        set s2 [string range $clause $k end]
       
    } else {
        set s0 $clause; set s1 ""; set s2 ""
    }

    # Use braces in case a string is empty or contains spaces.

    return "{$s0} {$s1} {$s2}"

}  ;# partition_position

# OK, here is the "main program"

get_opts
set D_count 0
set Have_proof 0
set Displayed_proof 0
set Display_level 999
change_font
setup
if {$Proof_file != ""} read_proof

################################################################################
#
# The S array contains the clauses of the proof.  It is indexed by clause ID.
# 
#  rule
#  num_parents
#  par1
#  pos1
#  par2
#  pos2
#  list_of_parents
#  parents         list of parents for hyper, ur
#  clause
#  other           other data from history list
#  drawn           already been drawn (managed by the arrange_proof)
# 
# The D array contains nodes of the display tree.  Each represents an
# *occurrence* of a clause in the proof.
# 
#  id              clause ID
#  x y             nw coords, first relative to parent, then absolute
#  num_parents     number of DISPLAYED parents,
#  p1 p2           parent nodes
#  list_of_parents
#  parents         parent nodes for hyper, ur
#  cwidth cheight  of clause
#  cx              center of clause (relative, then absolute)
#  cy              bottom of clause (relative, then absolute)
#  width height    of rectangle containing proof tree
#  unify_pos       position of unified term
#  
