#!../wish
# $Id: etext.tcl,v 1.3 1996/01/14 23:13:34 ilya Exp $

set prefix "Control-Meta-"
if [info exists env(kprefix)] {set prefix $env(kprefix)}

proc putss args {
  puts $args
}
proc stdLayout args {
  puts $args
  set y 0
  set w 0
  set ww 0
  set h 0
  set b 0
  foreach row [lrange $args 2 end] {
    if {$w < [lindex $row 2]} {set w [lindex $row 2]}
    if {$ww < [lindex $row 3]} {set ww [lindex $row 3]}
    set h [expr $h+[lindex $row 4]]
    set b [expr $b+[lindex $row 5]]
  }
  set b [expr ($h + $b/([llength $args] - 2))/2 ]
  set out [list [list -1 0 $y $w $ww $h $b]]
  foreach row [lrange $args 2 end] {
    set row [lrange $row 0 5]
    lappend out [linsert [lreplace $row 3 3 $ww] 1 0]
  }
  puts $out
  puts -nonewline X
  return $out
}

# We put super- and sub-scripts satisfying following relations:
#    The bottom of super is not lower that half of the standard ascent;
#    The top of sub is not higher than half of the standard ascent;
#    The baseline of sub is not higher than the standard descent.
#
# In fact we need to take baseline of topmost line in the above
# description. This is not available with the standard...

set stdAscent 15
set stdAscentHalf [expr int($stdAscent/2)]
set stdDescent 5

proc layoutSubSuper {block x super sub} {
  #puts [list $block $x $super $sub]
  global stdAscentHalf stdDescent
  set super [lrange $super 0 5]
  set sub [lrange $sub 0 5]
  set w [lindex $super 2]
  if {$w < [lindex $sub 2]} {set w [lindex $sub 2]}
  set ww [lindex $super 3]
  if {$ww < [lindex $sub 3]} {set ww [lindex $sub 3]}
  set b [expr $stdAscentHalf + [lindex $super 4]]
  set d 0
  set y1 0
  if [lindex $sub 4] {
    # There is a subscript
    set d [expr $stdDescent + [lindex $sub 4] - [lindex $sub 5]]
    if {$d < [expr [lindex $sub 4] - $stdAscentHalf ]} {
      set d [expr [lindex $sub 4] - $stdAscentHalf ]
      set y1 [lindex $super 4]
    } else {
      set y1 [expr $b + $stdAscentHalf - [lindex $sub 5]]
    }
  }
  set h [expr $b + $d]
  set out [list \
	   [list -1 0 0 $w $ww $h $b] \
	   [linsert [lreplace $super 3 3 $ww] 1 0] \
	   [linsert [lreplace [lreplace $sub 3 3 $ww] 1 1 $y1] 1 0] \
	  ]
  #puts $out
  #puts -nonewline X
  return $out
}

set fractionWidth 2
set fractionWidthHalf [expr ($fractionWidth+1)/2]

proc layoutFraction {block x super sub} {
  #puts [list $block $x $super $sub]
  global stdAscentHalf fractionWidth fractionWidthHalf blackLine
  set super [lrange $super 0 5]
  set sub [lrange $sub 0 5]
  set w [lindex $super 2]
  if {$w < [lindex $sub 2]} {set w [lindex $sub 2]}
  set w [expr $w + 2]
  #set ww [lindex $super 3]
  #if {$ww < [lindex $sub 3]} {set ww [lindex $sub 3]}
  set x0 [expr ($w - [lindex $super 2])/2]
  set x1 [expr ($w - [lindex $sub 2])/2]
  set b [expr $stdAscentHalf + [lindex $super 4] + $fractionWidthHalf]
  set y0 [lindex $super 4]
  set y1 [expr [lindex $super 4] + $fractionWidth]
  set h [expr [lindex $super 4] + $fractionWidth + [lindex $sub 4]]
  if {$h < $b} {set h $b}
  set out [list \
	   [list -1 0 0 $w $w $h $b] \
	   [linsert [lreplace $super 3 3 [lindex $super 2]] 1 $x0] \
	   [linsert \
		[lreplace [lreplace $sub 3 3 [lindex $sub 2]] 1 1 $y1] 1 $x1] \
	   [list $blackLine 0 $y0 $w $w 2 1] \
	  ]
  #puts $out
  #puts -nonewline X
  return $out
}

#set eqWidth 300
set eqGap 15

proc layoutEquation {block x super sub} {
  #puts [list $block $x $super $sub]
  global eqGap
  set eqw [winfo width [lindex $block 1]]
  set super [lrange $super 0 5]
  set sub [lrange $sub 0 5]
  set w [lindex $super 2]
  if {$w < [lindex $sub 2]} {set w [lindex $sub 2]}
  set tw [expr [lindex $super 2] + [lindex $sub 2] + $eqGap]
  if {$eqw < $tw} {set eqw $tw}
  set gap [expr [lindex $super 2] + $eqGap + int(($eqw-$tw)/2)]
  set h [lindex $super 4]
  if {$h < [lindex $sub 4]} {set h [lindex $sub 4]}
  set y0 0
  if {$h > [lindex $super 4]} {set y0 [expr int(($h - [lindex $super 4])/2)]}
  set y1 0
  set b [expr [lindex $sub 5] + $y1]
  return [list \
	      [list -1 0 0 $eqw $eqw $h $b] \
	      [lreplace $super 1 1 0 $y0] \
	      [lreplace $sub   1 1 $gap $y1] \
	     ]
}

proc layoutRadical {block x row} {
  #puts [list $block $x $super $sub]
  global stdAscentHalf blackLine radicalCheck
  set row [lrange $row 0 5]
  set h [lindex $row 4]
  set vlx 9
  set hlw 2
  set vlw 1
  set addxoff 1
  set rcYoff 1
  set xoff [expr $vlx + $hlw + $addxoff]
  set checkH 20
  set checkB 15
  set addHeight 3
  if {$h < $checkB} {set addHeight [expr $checkB - $h + $addHeight - 1]}
  set vlH 0
  set vrow ""
  if {$h > $checkB} {
    set vlH [expr $h - $checkB]
    set vrow [list $blackLine $vlx 0 $vlw $vlw $vlH 0]
  }
  set b [expr [lindex $row 5] + $addHeight]
  set h [expr $h + $addHeight]
  set wtot [expr [lindex $row 2] + $xoff]
  set hll [expr [lindex $row 2] + $vlw + $addxoff]
  set row [lreplace $row 1 1 $xoff $addHeight]
  set hrow [list $blackLine $vlx 0 $hll $hll $hlw $hlw]
  set totblock [list -1 0 0 $wtot $wtot $h $b]
  set check [list $radicalCheck 0 [expr $vlH + $rcYoff] 0 0 $checkH $checkB]
  #puts [list $totblock $row $hrow $vrow $check]
  if {$vrow==""} {
    return [list $totblock $row $hrow $check]
  } {
    return [list $totblock $row $hrow $vrow $check]
  }
}

proc layoutTab {min mult block x} {
  global backgrId1 backgrId2
  #puts [list $block $x $super $sub]
  set w [expr $min + $mult - ($x + $min - 1) % $mult - 1]
  set totblock [list $backgrId2 0 0 $w $w 5 3]
  #puts $w
  return [list $totblock $totblock]
}

proc insBlock {txt {block std} {string ""}} {
  set sel [$txt tag nextrange sel 0.0]
  if {$sel == ""} {
    $txt block insert $block insert
    $txt mark set insert insert-1c
    if {$string != ""} {$txt insert insert $string}
  } else {
    $txt block insert $block [lindex $sel 0] [lindex $sel 1]
  }
}

proc insTag {txt tag {on 1}} {
  set sel [$txt tag nextrange sel 0.0]
  if {$sel == ""} {return} {
    if $on {
      $txt tag add $tag [lindex $sel 0] [lindex $sel 1]
    } else {
      $txt tag delete $tag [lindex $sel 0] [lindex $sel 1]
    }
  }
}

proc sample1 {txt {str aaaaa\nbbbbb\nccccc\nddddd\neeeee}} {
  set s [string length $str]
  $txt insert insert $str
  $txt block insert std "insert -$s  c" insert
  # Block of size 31 by default
}
proc sample2 txt {
  sample1 $txt iiiii\njjjjj\nkkkkk\nlllll\nmmmmm
  # After second "k"
  $txt mark set insert "insert - 22c"
  sample1 $txt
  # Size 38 by default
}
proc sample3 txt {
  set i [$txt index insert]
  $txt insert insert sssttt
  $txt mark set insert $i+3c
  sample1 $txt uuuuu\nvvvvv\nwwwww\nxxxxx\nyyyyy\nzzzzz
  # After second "v"
  $txt mark set insert $i+12c
  # After second "x"
  $txt mark set another $i+30c
  sample2 $txt
  $txt mark set insert another
  sample2 $txt
}

proc sample4 txt {
  set i [$txt index insert]
  $txt insert insert aabbb\ncc\ndeee
  $txt block insert superSub $i+2c $i+10c
  $txt block split $i+5c 1
}

proc sample5 {{txt .t}} {
  set i [$txt index insert]
  $txt insert insert aabb\nbcceee
  $txt block insert superSub $i+2c $i+8c
  $txt block split $i+7c 1
  $txt tag add small $i+8c $i+11c
}

proc bbox {text start end} {
  set start [$text index $start]
  while {[$text compare $start < $end]} {
    puts "$start [$text bbox $start]"
    set start [$text index $start+1c]
  }
}

catch {text .t}
catch {pack .t -fill both -expand yes}
.t debug on
.t config -insertbac Gray -insertbo 2 -insertw 6 -hei 25 -wid 35
catch {.t config -font 10x20}
.t tag config red -foreground red
# blue since green is urgly ;-)
.t tag config blue -background lightblue -bord 2 -reli raised
catch {.t tag config small -font 6x10}
.t tag config black -background black
catch {.t tag config symbol -font -*-symbol-*-*-*-*-20-*-*-*-*-*-*-*}
#.t insert insert as\nbs\nkdjfdfaasdfja\nkj
.t block configure std
.t block configure superSub -layoutcmd layoutSubSuper -layoutdepth 1 \
    -layoutwidths 2
.t block configure Fraction -layoutcmd layoutFraction -layoutdepth 1 \
    -layoutwidths 2
.t block configure Equation -layoutcmd layoutEquation -layoutdepth 1 \
    -layoutwidths 2
.t block configure Radical -layoutcmd layoutRadical -layoutdepth 1 \
    -layoutwidths 1
.t block configure Tab -empty on -layoutcmd {layoutTab 5 35}
bind .t <F1>  {sample1  %W}
bind .t <F2>  {sample2  %W}
bind .t <F3>  {sample3  %W}
bind .t <F4>  {sample4  %W}
bind .t <F5>  {sample5  %W}
bind .t <F10> {insBlock %W}
bind .t <${prefix}r> {insTag %W red; break}
bind .t <${prefix}b> {insTag %W blue; break}
bind .t <${prefix}s> {insTag %W small; break}
bind .t <${prefix}Shift-r> {insTag %W red 0; break}
bind .t <${prefix}Shift-b> {insTag %W blue 0; break}
bind .t <${prefix}Shift-s> {insTag %W small 0; break}
bind .t <${prefix}Return> {%W block split insert 1; break}
bind .t <${prefix}Return> {%W block split insert 2; break}
bind .t <${prefix}BackSpace> {%W block trim insert; break}
bind .t <${prefix}t> {%W block insert Tab insert; break}
bind .t <${prefix}l> {puts [%W block list 0.0 end]; break}
bind .t <${prefix}f> {
  insBlock %W Fraction
  break
}
bind .t <${prefix}c> {
  insBlock %W superSub
  break
}
bind .t <${prefix}d> {
  insBlock %W Radical
  break
}
bind .t <${prefix}e> {
  insBlock %W Equation ()\n
  break
}
set script [info script]

bind .t <${prefix}n> {source $script; break}
bind .t <${prefix}q> {exit}
bindtags .t {.t Text . all}

set script [info script]

.t block deletelines
.t insert 1.0 v\n {blue red}
set fractionLine [.t block addline 1.0]
.t delete 1.0 1.0+2c
.t insert 1.0 \326\n {symbol}
set radicalCheck [.t block addline 1.0]
.t delete 1.0 1.0+2c
.t insert 1.0 \n {black}
set blackLine [.t block addline 1.0]
.t delete 1.0 1.0+1c
  .t tag configure backgr1 -background blue -border 2 -relief raised
  .t tag configure backgr2 -background gray90 -border 2 -relief raised
  .t insert 1.0 \n backgr1
  set backgrId1 [.t block addline 1.0]
  .t delete 1.0 1.0+1c
  .t insert 1.0 \n backgr2
  set backgrId2 [.t block addline 1.0]
  .t delete 1.0 1.0+1c
  .t block config myBlock -layoutdepth 1 \
	-layoutwidths 1 -layoutcmd myLayoutCmd
  proc myLayoutCmd {block x row} {
    global backgrId1 backgrId2
    set c [lindex $row 0]
    set w [lindex $row 3]
    set h [lindex $row 4]
    set b [lindex $row 5]
    set tw [expr $w+10]
    set tw2 [expr $w+14]
    set tw1 [expr $w+20]
    set row [list $c 5 5 $w $tw $h $b]
    set addrow1 [list $backgrId1 0 0 $tw1 $tw1 [expr $h+10] [expr $b+5]]
    set addrow2 [list $backgrId2 3 3 $tw2 $tw2 [expr $h+4] [expr $b+2]]
    return [list $addrow1 $row $addrow1 $addrow2]
  }
  proc myLayoutCmd {block x row} {
    global backgrId1 backgrId2
    set c [lindex $row 0]
    set w [lindex $row 2]
    set tw [lindex $row 3]
    set h [lindex $row 4]
    set b [lindex $row 5]
    set tw [expr $tw+10]
    set tw2 [expr $tw+4]
    set tw1 [expr $tw+10]
    set h2 [expr $h+4]
    set h1 [expr $h+10]
    set b2 [expr $b+2]
    set b1 [expr $b+5]
    set addrow1 [list $backgrId1 0 0 $tw1 $tw1 $h1 $b1]
    set addrow2 [list $backgrId2 3 3 $tw2 $tw2 $h2 $b2]
    set row [list $c 5 5 $w $tw $h $b]
    return [list $addrow1 $row $addrow1 $addrow2]
  }
  bind .t <${prefix}m> {
    %W block insert myBlock insert
    %W mark set index insert-1c
    break
  }