#!/usr/bin/tclsh
# $Header: /home/setok/proging/demos/ravelinvi/invi3.tcl,v 1.5 2002/12/06 11:02:11 setok Exp setok $
# Original Alternative Party 2003 invitation intro
# by Mikko "Ravel" Tuomela on 18-Nov-2002
# email: mikko@tuomela.net
#
# Conversion by Kristoffer "Setok" Lawson from the original perl code with 
# several optimisations making it noticably faster.
# email: setok@kasvua.org
#
# Tcl isn't quite as natural with maths as some other languages (because
# there is no special syntax: for that the [expr] command is used).
# However what may be interesting is the way we have optimised by separating
# the effect implementation code body from its procedure: that way we can
# easily replace the part of the code that differs in each effect, without
# affecting the rest and then generate the right procedure dynamically. I'm 
# not sure whether this is possible in perl. Naturally we could do it by
# copy-pasting but that's boring.
#
# We have also used lists instead of arrays because in Tcl arrays are
# associative arrays, or hashes, making them slower. The "downside" is
# that, unlike arrays, lists do not use any special syntax but we use 
# commands like [lindex] and [lset].
#
# usage: 
# $ ./invi.tcl
# (normal mode, you may have to export COLUMNS and export LINES)
#
# $ ./invi.tcl x y
# (x and y are the desired geometry, 10 < x,y < 100)

# $ ./invi.tcl x y n
# (x,y = geometry, n = number of objects, default=2)


package require Tcl 8.4

set MaxColumns 100
set MaxRows 100
set ObAmount 2

# Current part of demo. Defined to be a part of the demo with its own
# text.
set Part 0

# Changed Chars and Text from perl code with more info

set Chars {
    "OOOO    "
    "  .,+o$M"
    "@@ == @@"
    "-\"!*.._#"
    "OO  OO  "
    "M¤o+,.  "
    "O O O O "
    "OO      "
    "..  MM  "
}


set Text {
    "   Ravel and Setok present    "
    "   a Sleber Eid production    " 
    "   the first ever Tcl demo!   "
    "   and an invitation to       "
    "   Alternative Party 2003     "
    "   10th-12th January 2003     "
    "   Gloria Helsinki Finland    "
    "   http://www.altparty.org/   "
    "   Press Ctrl-C to stop       "
}


# Contains body of procedure to implement all parts of an effect.
# The text %HEIGHT% from the code should be replaced (f.ex. by using
# [string map]) with the code to set the value for height of that particular 
# character.
# The text %HEIGHTLIMITER% should be replace with the code to convert an
# existing height value (in the 'height' variable) with a value that limits
# it to 0-7.
#
# Variables that can be used at the point of %HEIGHT% execution:
# 'x','y'   X and Y position of character being drawn.
# 'ob   Number of object handled.
# 'obCenterX', 'obCenterY'   X and Y position of object center.
# 'distance'  Two-dimensional distance table.
# 'altDistance'  Alternative to 'distance'.
# 'ObAmount'  Amount of objects.
# 'obNum'  Set to 0, increase in the loop if you need it.
#
# At %HEIGHTLIMITER% the additional 'height' variable can be used.
#
# No, not the most beautiful possible.

set effectCode {
    global Chars Rows ObAmount Columns Text Part

    set textLength [llength $Text]
    set type 0
    set round 0
    set endPart [expr {$textLength}]

    puts -nonewline "\033c" 
    
    for {set part 0} {$part < $endPart} {incr part} {
	set charset [split [lindex $Chars $part] ""]
	set message [lindex $Text $part]
	
	for {set time 0} {$time <= 100} {incr time} {
	    set full ""
	    for {set y 0} {$y <= $Rows} {incr y} {
		for {set x 0} {$x <= $Columns} {incr x} {
		    set height 0		    
		    set flipflop 1  ;# Required by FX 2
		    foreach ob $coords {
			incr height %HEIGHT%
		    } 
		    set height %HEIGHTLIMITER%
		    append full [lindex $charset $height]
		}
		append full "\n"
	    }

	    puts -nonewline "\033\[H${full}\033\[4m${message}\033\[m"

	    # Move circles
	    for {set ob 0} {$ob < $ObAmount} {incr ob} {
		lset coords $ob 0 [expr {[lindex $coords $ob 0] + 
					   [lindex $coords $ob 2]}]
		lset coords $ob 1 [expr {[lindex $coords $ob 1] +
					   [lindex $coords $ob 3]}]
		if {([lindex $coords $ob 0] < 0) ||
		    ([lindex $coords $ob 0] > $Columns)} {
		    lset coords $ob 2 [expr {-[lindex $coords $ob 2]}]
		}
		if {([lindex $coords $ob 1] < 0) ||
		    ([lindex $coords $ob 1] > $Rows)} {
		    lset coords $ob 3 [expr {-[lindex $coords $ob 3]}]
		}
		lset coords $ob 4 [expr {int([lindex $coords $ob 0])}]
		lset coords $ob 5 [expr {int([lindex $coords $ob 1])}]
	    }
	}
    }
}


# For testing purposes. We want the output to be exactly the same every time.
# (Tcl's default seed comes from the internal clock)
#expr {srand(5)}


proc precalc {} {
    global Distance AltDistance Coords ObAmount Columns Rows

    for {set x 0} {$x <= 200} {incr x} {
	set innerDistance [list]
	set innerAltDistance [list]
	for {set y 0} {$y <= 200} {incr y} {
	    lappend innerDistance [expr { int(sqrt(pow($x, 2) + pow($y, 2)))}]
	    lappend innerAltDistance \
		[expr { int(sqrt(abs(pow($x, 2) - pow($y, 2))))}]
	}
	lappend Distance $innerDistance
	lappend AltDistance $innerAltDistance
    }

    for {set ob 0} {$ob < $ObAmount} {incr ob} {
	set inner [list [expr { rand() * $Columns}] \
		       [expr { rand() * $Rows}] \
		       [expr { rand() * 2}] \
		       [expr { rand() * 2}]]
	lappend inner [expr { int([lindex $inner 0])}]
	lappend inner [expr { int([lindex $inner 1])}]
	if {rand()*10 < 5} {
	    lset inner 2 "-[lindex $inner 2]"
	} 
	if {rand()*10 < 5} {
	    lset inner 3 "-[lindex $inner 3]"
	}
	lappend Coords $inner
    }
}


proc effect1 {distance coords} \
    [string map {
	%HEIGHT% {[expr {
			 [lindex $distance \
			      [expr {abs($x - [lindex $ob 4])}] \
			      [expr {abs($y - [lindex $ob 5])}]]
			 & 0x7}]}
	%HEIGHTLIMITER% {[expr {$height / $ObAmount}]}
    } $effectCode]


proc effect2 {distance coords} \
    [string map {
	%HEIGHT% {[expr {
			 [lindex $altDistance \
			      [expr {abs($x - [lindex $ob 4])}] \
			      [expr {abs($y - [lindex $ob 5])}]]
			 & 0x7}]}
	%HEIGHTLIMITER% {[expr {$height / $ObAmount}]}
    } $effectCode]


proc effect2 {distance coords} \
    [string map {
	%HEIGHT% {[expr {$flipflop * \
			     [lindex $distance \
				  [expr {abs($x - [lindex $ob 4])}] \
				  [expr {abs($y - [lindex $ob 5])}]]
		     }]
	    #	    incr obNum
	    set flipflop [expr {-$flipflop}]
	}
	%HEIGHTLIMITER% {[expr {$height % 8}]}
    } $effectCode]


if {[llength $argv] == 0} {
    set Columns [expr {$env(COLUMNS) - 1}]
    set Rows [expr {$env(LINES) - 1}]
} else {
    set Columns [expr {[lindex $argv 0] - 1}]
    set Rows [expr {[lindex $argv 1] - 1}]
}
if {$Columns > $MaxColumns || $Rows > $MaxRows} {
    puts stderr "Your terminal is too big!"
    exit -1
}
if {$Columns < 10 || $Rows < 10} {
    puts stderr "Env variables COLUMNS and LINES must be at least 10!"
    exit -1
}
if {[llength $argv] == 3} {
    set Amount [lindex $argv 2]
}
incr Rows -1  ;# Sorry, just taken straight from the perl code.. :-)

precalc
while {1} {
    effect1 $Distance $Coords
    effect1 $AltDistance $Coords
    effect2 $Distance $Coords
    effect2 $AltDistance $Coords
}