#! /usr/bin/expectk -f

# This is UCB Logo front-end. Features command editing (standard Tk entry 
# keys), history (Up/Down keys and double-click on history window), commands 
# completion (space key). Distributed under GNU General Public License, see
# http://www.gnu.org/copyleft/gpl.html.

# Requirements:
#   Mandatory:
#     Tcl/Tk: http://www.scriptics.com. To use Save/Load buttons you'll need
#	Tk 8.0+.
#     expectk: http://expect.nist.gov/
#     UCB Logo: ftp://anarres.cs.berkeley.edu/pub/ucblogo/
#   Optional:
#     tkinfo: http://www.math.ucsb.edu/~boldt/tkinfo/

# Installation: customize things below and run!

# Customize these!

set logoInterpreter "logo"
set logoRcFile "$env(HOME)/.tklogorc"
set logoHelp "tkinfo ucblogo"

# Localization

set buttonHelp "Помощь"
set buttonLoad "Прочитать"
set buttonSave "Сохранить"
set buttonQuit "Выйти"
set font "-*-times-*-r-*-*-24-*-*-*-*-*-koi8-*"
set buttonFont "-*-18-*-koi8-r"

set completions {
    arc back bye for forward left pendown penup repeat right setbackground
    setpencolor setpensize направо вправо налево влево вверх вниз вперед назад
    стереть закрасить дуга цвет рисовать стирать цикл фон место повтор круг
    идти
}

# No user serviceable parts below

proc logoRun { command } {
    if { [catch {
	exp_send -- "${command}\r"
	expect -re "(\\?)|(>)"
    } err] } shutDown
}

proc shutDown {} {
    exit 0
}

proc logoSetup {} {
    global logoRcFile
    if [file readable $logoRcFile] {
	doCommand "load \"$logoRcFile"
    }
}

proc ExecuteCommand {} {
    set cmd [string trim [.lo.e get]]
    .lo.e delete 0 end
    switch "$cmd" {
	"" {
	    return
	}
	"/clear" {
	    .hi.story delete 0.0 end
	    set histIndex 0
	    set currIndex 0
	    return
	}
	default {
	    doCommand $cmd
	}
    }
}

proc doCommand { cmd } {
    .hi.story insert end "${cmd}\n"
    .hi.story see end
    addToHistory $cmd
    logoRun $cmd
    if { "$cmd" == "bye" } { exit 0 }
}

set histIndex 0

proc addToHistory { cmd } {
    global history histIndex currIndex
    if { $histIndex == 0 || "$history([expr $histIndex - 1])" != "$cmd" } {
	set history($histIndex) $cmd
	incr histIndex
    }
    set currIndex $histIndex
}

proc HistoryUp {} {
    global history histIndex currIndex
    if { $currIndex > 0 } {
	incr currIndex -1
	.lo.e delete 0 end
	.lo.e insert end $history($currIndex)
    }
}

proc HistoryDown {} {
    global history histIndex currIndex
    if { $currIndex < [expr $histIndex - 1]} {
	incr currIndex
	.lo.e delete 0 end
	.lo.e insert end $history($currIndex)
    }
}

proc RecallHistoryItem { x y } {
    set line [.hi.story get "@$x,$y linestart" "@$x,$y lineend"]
    doCommand $line
}

proc doLoadFile {} {
    global env
    set file [tk_getOpenFile -initialdir $env(HOME) -filetypes {
	{{Logo files} {.lgo}}
	{{All files}  {*}}
    }]
    if { "$file" != "" } {
	doCommand "load \"$file"
    }
}

proc doSaveFile {} {
    global env
    set file [tk_getSaveFile -initialdir $env(HOME) -filetypes {
	{{Logo files} {.lgo}}
	{{All files}  {*}}
    }]
    if { "$file" != "" } {
	doCommand "save \"$file"
    }
}

proc CompleteWord {} {
    set line [.lo.e get]
    set len [expr [string length $line] - 1]
    if { $len == -1 } return
    for {set i [expr $len - 1]} {$i >= 0} {incr i -1} {
	set l "[string index $line $i]"
	if { "$l" == " " || "$l" == "\[" || "$l" == "\]" \
		 || "$l" == "(" || "$l" == ")" } {
	    incr i
	    break
	}
    }
    set word [Complete [string range $line $i $len]]
    if { "$word" != "" } {
	.lo.e delete $i end
	.lo.e insert end "${word}"
    }
}

proc Complete { word } {
    global completions maxIndex
    set pos 0
    set index 0
    set len [expr [string length $word] - 1]
    while { $pos <= $len } {
	if { "[string index [lindex $completions $index] $pos]" \
		 == "[string index $word $pos]" } {
	    incr pos
	    continue
	}
	incr index
	if { $index == $maxIndex } {
	    return $word
	}
	if { [string compare "[string index [lindex $completions $index] $pos]" \
		  "[string index $word $pos]"] > 0 } {
	    return $word
	}
    }
    return [lindex $completions $index]
}

proc Sort { list } {
    set temp "/tmp/tklogo.[pid]"
    set f [open $temp "w"]
    set len [llength $list]
    for {set i 0} {$i < $len} {incr i} {
	puts $f [lindex $list $i]
    }
    close $f
    set f [open "|sort < $temp" "r"]
    set list {}
    for {set i 0} {$i < $len} {incr i} {
	append list " [gets $f]"
    }
    file delete $temp
    return $list
}

# -------------------------------------------- main

set completions [Sort $completions]
set maxIndex [llength $completions]

wm title . "UCB Logo Tk front-end"

frame .hi
text .hi.story -yscrollcommand ".hi.scroll set" -height 6 -width 40 \
    -font $font
bind .hi.story <Double-Button-1> "RecallHistoryItem %x %y"
scrollbar .hi.scroll -command ".hi.story yview"

pack .hi.story -side left -fill both -expand yes
pack .hi.scroll -side left -fill y -expand no
pack .hi -fill both -expand yes

frame .lo
entry .lo.e -font $font
bind .lo.e <Up>   HistoryUp
bind .lo.e <Down> HistoryDown
bind .lo.e <Return> ExecuteCommand
bind .lo.e <Key-space> CompleteWord

frame .lo.b
button .lo.b.help -text $buttonHelp -font $buttonFont -command "exec $logoHelp &"
button .lo.b.load -text $buttonLoad -font $buttonFont -command doLoadFile
button .lo.b.save -text $buttonSave -font $buttonFont -command doSaveFile
button .lo.b.quit -text $buttonQuit -font $buttonFont -command {doCommand "bye"} \
    -fg red

pack .lo.b.load .lo.b.save .lo.b.help .lo.b.quit -side left
pack .lo.e -fill x -side top
pack .lo.b -side bottom
pack .lo -side bottom -fill x

focus .lo.e

if { [catch {spawn $logoInterpreter} ] } {
    puts stderr "Can't run Logo interpreter. Configure tklogo by editing it."
    exit 1
}

logoSetup

#Local variables:
#mode: tcl
#End: