#!/usr/local/bin/wish -f


set w .f
frame $w
pack $w

set canvwidget ""

proc mkcan {w x y s r} {
    global ypagesize canvwidget
    catch {destroy $w.c}
    set xx [expr "$x * $s"]c
    set yy [expr "$y * $s"]c
    if {$r} {
	canvas $w.c -background white -width $yy -height $xx
    } else {
	canvas $w.c -background white -width $xx -height $yy
    }
    pack $w.c -side left
    set canvwidget $w.c
    # figure out how big the page is in points (XXX- assumes cm)
}

proc conf_can {w x y s r} {
    global ypagesize
    set xx [expr "$x * $s"]c
    set yy [expr "$y * $s"]c
    if {$r} {
	$w config -background white -width $yy -height $xx
    } else {
	$w config -background white -width $xx -height $yy
    }
}

proc mktri {w sx sy br er rs cs s u} {
    catch {$w delete triangle}
    # beginning row size, end row size/2
    set brs [expr "$br * $cs * .5"]
    set ers [expr "$er * $cs * .5"]
    set rd [expr "$er - $br"]
    # begin, end row y coords
    # this works, but is too obscure.
    set sys [expr "$sy * $s"]
    set eys [expr "(($rd * $rs) + $sy) * $s"]
    $w create polygon [expr "($sx + $brs)*$s"]$u $sys$u \
                      [expr "($sx - $brs)*$s"]$u $sys$u \
                      [expr "($sx - $ers)*$s"]$u $eys$u \
                      [expr "($sx + $ers)*$s"]$u $eys$u \
		       -outline black -fill blue -tags triangle
}

proc dotri {val} {
    global start_x start_y font_size linespacing max_width space \
	   b_row e_row units def_scale t_scale
    mktri .f.ft.c $start_x $start_y $b_row $e_row \
	  [expr "$linespacing * $t_scale"] \
	  [expr "$space * $t_scale"] \
	  $def_scale $units
}

set def_scale .25
set t_scale 1
set start_x 421
set start_y 15
# meaning, the distance from the first pixels to the top of the page
set font_size 5
set linespacing 7
set max_width 6
set space 8
set b_row 1
set e_row 80
set units p
set rot_90 1
set page_x 21
set page_y 29.7


proc cm2pt {foo} {
    return [expr "($foo / 2.54) * 72"]
}

proc scalecm {foo} {
    global def_scale
    return [expr "$foo * $def_scale"]c
}

frame $w.ft
frame $w.fb
pack $w.ft -side top -anchor w
pack $w.fb -side bottom -anchor w

scale $w.ft.yoff -label "y-offset" -orient vertical -variable start_y \
	-showvalue false -from -400 -to 400 -command dotri

scale $w.fb.xpos -label "x position" -orient horizontal -variable start_x \
	-from 0 -to 1000 -command dotri

button $w.fb.xcent -text Center -command {
    set start_x [expr [cm2pt [expr $rot_90 ? $page_y : $page_x]] * .5]
    set s_y [expr [cm2pt [expr $rot_90 ? $page_x : $page_y]]]
    set t_s [expr "$t_scale * ($e_row - $b_row) * $linespacing"]
    set start_y [expr ".5 * ($s_y - $t_s)"]
    dotri foo
}

mkcan $w.ft $page_x $page_y $def_scale $rot_90
pack $w.ft.yoff -side right -anchor n
pack $w.fb.xpos -side left -anchor w
pack $w.fb.xcent -side right -anchor s

proc config_all {w} {
    global page_x page_y rot_90 font_size linespacing max_width space \
	   b_row e_row t_scale

    set xx [expr "$rot_90 ? $page_y : $page_x"]
    set yy [expr "$rot_90 ? $page_x : $page_y"]

    set oy [expr "($e_row - $b_row + 1) * $linespacing * $t_scale"]
    set fy [expr "0 - $oy"]
    set ty [cm2pt $yy]

    set ox [expr ".5 * $e_row * $space * $t_scale"]
    set fx [expr "0 - $ox"]
    set tx [expr "[cm2pt $xx] + $ox"]
    $w.f.ft.yoff config -length [scalecm $yy] -from $fy -to $ty
    $w.f.fb.xpos config -length [scalecm $xx] -from $fx -to $tx
}

config_all ""

dotri foo

set c .control1
frame $c
pack $c -side bottom -anchor w -fill x

proc refig {foo} {
    global b_row e_row
    if {$b_row > $e_row} { set b_row $e_row }
    config_all ""
    dotri foo
}

proc scaleit {n} {
    global space linespacing bscale
    if {$n == 0} {return}
    set space [expr "$space + $n"]
    set linespacing [expr "$linespacing + $n"]
    set bscale 0
    dotri foo
}

set c .control1.l

frame $c
pack $c -side left -anchor w -fill x

menubutton $c.numtype -menu $c.numtype.m -relief raised -text xxx
menu $c.numtype.m
set numtype_menu $c.numtype
proc add_radiobutton {w t v var} {
    $w.m add radiobutton -label $t -variable $var -value "$v" \
	-command "$w config -text \"$t\""
}

add_radiobutton $numtype_menu "Binomial" "(bin-init)" gen_cmd
add_radiobutton $numtype_menu "Stirling 1" "(s1-init)" gen_cmd
add_radiobutton $numtype_menu "Stirling 2" "(s2-init)" gen_cmd
add_radiobutton $numtype_menu "Eulerian" "(ean-init)" gen_cmd

pack $c.numtype -anchor nw -fill x

set gen_cmd "(bin-init)"
$c.numtype config -text "Binomial"

scale $c.space -label "Number spacing" -orient horizontal -variable space \
	-from 0 -to 20 -digits 4 -resolution .25 -command refig
scale $c.lspace -label "Line spacing" -orient horizontal -variable linespacing \
	-from 0 -to 20 -digits 4 -resolution .25 -command refig
scale $c.bscale -label "Scaling" -orient horizontal -variable t_scale \
	-from 0 -to 1 -digits 3 -resolution .01 -command refig

set port_button $c.port
checkbutton $c.port -text Landscape -relief raised \
  -variable rot_90 -offvalue 1 -onvalue 0 -command {
    if {$rot_90} { set lbel Landscape } { set lbel Portrait }
    $port_button config -text $lbel
    config_all ""
    conf_can $canvwidget $page_x $page_y $def_scale $rot_90
}

pack $c.space \
     $c.lspace \
     $c.bscale \
     $c.port \
	-anchor w -side top -fill x

set c .control1.r
frame $c
pack $c -side left -anchor nw -fill x -expand 1

scale $c.brow -label "Begin Row" -orient horizontal -variable b_row \
	-from 1 -to 500 -resolution 1 -command refig
scale $c.erow -label "End Row" -orient horizontal -variable e_row \
	-from 1 -to 500 -resolution 1 -command refig

pack \
     $c.brow \
     $c.erow \
	-side top -anchor ne -fill x

frame $c.stuff
pack $c.stuff -anchor nw

button $c.stuff.do -text "Calc" -command {
    printcmd $filename
}
button $c.stuff.prev -text "Preview" -command {
    exec ghostview $filename &
}
button $c.stuff.pcmd -text "Print" -command {
    exec lpr $filename
}
pack $c.stuff.do $c.stuff.prev $c.stuff.pcmd \
    -anchor nw -side left

entry $c.fname -textvariable filename
set filename foo

pack $c.fname -anchor nw

menubutton $c.print_type -menu $c.print_type.m -text Circles -relief raised
menu $c.print_type.m
pack $c.print_type -anchor nw -fill x -expand 1
set print_type -d

add_radiobutton $c.print_type "Circles" "-d" print_type
add_radiobutton $c.print_type "Concentric Circles" "-cc" print_type
add_radiobutton $c.print_type "Numbers" "-n" print_type
add_radiobutton $c.print_type "Squares" "-s" print_type
add_radiobutton $c.print_type "Triangles" "-t" print_type

add_radiobutton $c.print_type "Do not fill" "100" fill_opt
add_radiobutton $c.print_type "Fill" ".5" fill_opt

set fill_opt "100"

set cc .control1.r.mod
frame $cc
pack $cc -anchor nw -fill x -expand 1

menubutton $cc.type -menu $cc.type.m -text pmod -relief raised
menu $cc.type.m
set modulo_menu $cc.type
set mod_type pmod

add_radiobutton $modulo_menu "pmod" "pmod" mod_type
add_radiobutton $modulo_menu "mod" "mod" mod_type
add_radiobutton $modulo_menu "none" "none" mod_type

scale $cc.mod -orient horizontal -variable divide \
	-from 1 -to 99 -resolution 1
set divide 3

pack $cc.type $cc.mod -side left -fill x -expand 1

proc printcmd {fn} {
    global def_scale t_scale start_x start_y font_size linespacing \
	   max_width space b_row e_row units rot_90 page_x page_y \
	   gen_cmd mod_type divide fill_opt print_type
    if {[string compare $mod_type mod] == 0} {
	set mod_cmd "(rep-mlist $e_row $divide)"
    } elseif {[string compare $mod_type pmod] == 0} {
	set mod_cmd "(rep-plist $e_row $divide)"
    } elseif {[string compare $mod_type none] == 0} {
	set mod_cmd "(rep-list $e_row)"
    }
    if {$rot_90} { set land_opt "-landscape" } { set land_opt "-portrait" }
    set xx [expr "$rot_90 ? $start_y : $start_x"]
    set yy [expr "$rot_90 ? $start_x : [expr [cm2pt $page_y]-$start_y]"]
    exec -- scm -f cell.scm -e$gen_cmd$mod_cmd | tail "+$b_row" | \
      ./npscvt -scale $t_scale $land_opt -sx $xx -oy $yy \
      -linespace $linespacing -numspace $space \
      $print_type -f $fill_opt > $fn
}
