# Tetrios is a very simple text mode tetris for Cisco IOS (R)
# version 1.0
# (c) 2011 Petr Ankudinov
# mail: netl0g.blog@gmail.com
# http://netl0g.blogspot.com/
#
# Tetrios provided "as is" without any warranty.
# Tetrios code is free for personal use and learning.
# Please, contact Alexey Pajitnov for any other purposes.
# Code, name and logo have nothing in common with any Tetris Company, Cisco, etc. brands.

# Display welcome message
# ===========================================================================================================
proc WELCOME {channel} {
	# Clear screen and move cursor to upper-left corner
	puts $channel "\033\[2J"
	puts $channel "\033\[H"
	# Draw welcome screen
	puts $channel {===============================================}
	puts $channel {           ||          _0_/       ||           }
	puts $channel {         ||||||       / |       ||||||         }
	puts $channel {       ||||||||||       |\_/0 ||||||||||       }
	puts $channel {     ||||||||||||||      \/0||||||||||||||     }
	puts $channel {   ||||||||||||||||||     ||||||||||||||||||   }
	puts $channel {.||||||||||||||||||||||.||||||||||||||||||||||.}
	puts $channel {=========== Welcome to Tetrios! ===============}
	puts $channel {============== version 1.0 ====================}
	puts $channel {===       (c) 2011 Petr Ankudinov           ===}
	puts $channel {===    mail: netl0g.blog@blogspot.com       ===}
	puts $channel {===      http://netl0g.blogspot.com/        ===}
	puts $channel {===============================================}
	puts $channel {=== Stop CCIE madness! Gain maximum Score!  ===}
	puts $channel {===============================================}
	puts $channel {====== Tetrios is a very useful tool for ======}
	puts $channel {======= a lonely engineer with a router =======}
	puts $channel {============ on a desert island. ==============}
	puts $channel {===============================================}
	puts $channel {======== Please, do not play too much =========}
	puts $channel {=========== on production routers. ============}
	puts $channel {===============================================}
	puts $channel {========== Press "Enter" to continue ==========}
	puts $channel {========== Ctrl+C to exit at any time =========}
	puts $channel {===============================================}
}

# Initialize battlefield 16x16 and borders
# ===========================================================================================================
set field ""
append field "O================O\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "|                |\n"
append field "O================O"

# Define shape list
# ===========================================================================================================
set shapes ""
# Shape 0: O-tetromino
set shape ""
set shapeString ""
append shapeString "        ##        \n"
append shapeString "        ##        \n"
lappend shape $shapeString ;#angle 0
lappend shape $shapeString ;#angle 90
lappend shape $shapeString ;#angle 180
lappend shape $shapeString ;#angle 270
lappend shapes $shape ;#add shape 0 to shape list
# Shape 1: I-tetromino
set shape ""
set shapeString ""
append shapeString "       ####       \n"
lappend shape $shapeString ;#angle 0
set shapeString ""
append shapeString "       #          \n"
append shapeString "       #          \n"
append shapeString "       #          \n"
append shapeString "       #          \n"
lappend shape $shapeString ;#angle 90
set shapeString ""
append shapeString "       ####       \n"
lappend shape $shapeString ;#angle 180
set shapeString ""
append shapeString "       #          \n"
append shapeString "       #          \n"
append shapeString "       #          \n"
append shapeString "       #          \n"
lappend shape $shapeString ;#angle 270
lappend shapes $shape ;#add shape 1 to shape list
# Shape 2: Z-tetromino
set shape ""
set shapeString ""
append shapeString "        ##        \n"
append shapeString "         ##       \n"
lappend shape $shapeString ;#angle 0
set shapeString ""
append shapeString "         #        \n"
append shapeString "        ##        \n"
append shapeString "        #         \n"
lappend shape $shapeString ;#angle 90
set shapeString ""
append shapeString "        ##        \n"
append shapeString "         ##       \n"
lappend shape $shapeString ;#angle 180
set shapeString ""
append shapeString "         #        \n"
append shapeString "        ##        \n"
append shapeString "        #         \n"
lappend shape $shapeString ;#angle 270
lappend shapes $shape ;#add shape 2 to shape list
# Shape 3: S-tetromino
set shape ""
set shapeString ""
append shapeString "         ##       \n"
append shapeString "        ##        \n"
lappend shape $shapeString ;#angle 0
set shapeString ""
append shapeString "        #         \n"
append shapeString "        ##        \n"
append shapeString "         #        \n"
lappend shape $shapeString ;#angle 90
set shapeString ""
append shapeString "         ##       \n"
append shapeString "        ##        \n"
lappend shape $shapeString ;#angle 180
set shapeString ""
append shapeString "        #         \n"
append shapeString "        ##        \n"
append shapeString "         #        \n"
lappend shape $shapeString ;#angle 270
lappend shapes $shape ;#add shape 3 to shape list
# Shape 4: T-tetromino
set shape ""
set shapeString ""
append shapeString "        ###       \n"
append shapeString "         #        \n"
lappend shape $shapeString ;#angle 0
set shapeString ""
append shapeString "         #        \n"
append shapeString "         ##       \n"
append shapeString "         #        \n"
lappend shape $shapeString ;#angle 90
set shapeString ""
append shapeString "         #        \n"
append shapeString "        ###       \n"
lappend shape $shapeString ;#angle 180
set shapeString ""
append shapeString "         #        \n"
append shapeString "        ##        \n"
append shapeString "         #        \n"
lappend shape $shapeString ;#angle 270
lappend shapes $shape ;#add shape 4 to shape list
# Shape 5: J-tetromino
set shape ""
set shapeString ""
append shapeString "        ###       \n"
append shapeString "          #       \n"
lappend shape $shapeString ;#angle 0
set shapeString ""
append shapeString "         #        \n"
append shapeString "         #        \n"
append shapeString "        ##        \n"
lappend shape $shapeString ;#angle 90
set shapeString ""
append shapeString "        #         \n"
append shapeString "        ###       \n"
lappend shape $shapeString ;#angle 180
set shapeString ""
append shapeString "         ##       \n"
append shapeString "         #        \n"
append shapeString "         #        \n"
lappend shape $shapeString ;#angle 270
lappend shapes $shape ;#add shape 5 to shape list
# Shape 6: L-tetromino
set shape ""
set shapeString ""
append shapeString "        ###       \n"
append shapeString "        #         \n"
lappend shape $shapeString ;#angle 0
set shapeString ""
append shapeString "        ##        \n"
append shapeString "         #        \n"
append shapeString "         #        \n"
lappend shape $shapeString ;#angle 90
set shapeString ""
append shapeString "          #       \n"
append shapeString "        ###       \n"
lappend shape $shapeString ;#angle 180
set shapeString ""
append shapeString "         #        \n"
append shapeString "         #        \n"
append shapeString "         ##       \n"
lappend shape $shapeString ;#angle 270
lappend shapes $shape ;#add shape 6 to shape list
# Remove extra variables
unset shapeString
unset shape

# SHAPEGENERATOR: generate random shape
# ===========================================================================================================
proc SHAPEGENERATOR {} {
	global shapes
	set randNum [expr { int(100 * rand()) }]
	if {$randNum < 14 } {set shapeType 0} \
		elseif {$randNum < 28} {set shapeType 1} \
			elseif {$randNum < 42} {set shapeType 2} \
				elseif {$randNum < 56} {set shapeType 3} \
					elseif {$randNum < 70} {set shapeType 4} \
						elseif {$randNum < 84} {set shapeType 5} \
							else {set shapeType 6}
	set shape [lindex $shapes $shapeType]
	return $shape; #shape list contains 4 strings (different angles) for generated tetromino 
}

# CHARCOUNT: counts defined characters in a string
# ===========================================================================================================
proc CHARCOUNT {someString chars} {
	set splitStrings [split $someString "\n"]
	set stringsTotal [llength $splitStrings]
	set charsTotal 0
	for {set stringNumber 0} {$stringNumber < $stringsTotal} {incr stringNumber} {
		set splitChars [split [lindex $splitStrings $stringNumber] ""]
		set charsInString [llength $splitChars]
		for {set charNumber 0} {$charNumber < $charsInString} {incr charNumber} {
			if {[string match -nocase "\[$chars\]" [lindex $splitChars $charNumber]]} {incr charsTotal}
		}
	}
	return $charsTotal
}

# COLLISIONCHECK: returns 'true' if shape redraw doesn't cross boundaries or old shapes
# ===========================================================================================================
proc COLLISIONCHECK {fieldCurrent fieldNew someShape mode} {
	set noCollisions 0
	switch $mode {
		new {if {[expr {[CHARCOUNT $fieldCurrent "#O|="]+[CHARCOUNT $someShape "#"]}] == [CHARCOUNT $fieldNew "#O|="]} {set noCollisions 1}}
		old {if {[CHARCOUNT $fieldCurrent "#O|="] == [CHARCOUNT $fieldNew "#O|="]} {set noCollisions 1}}
	}
	return $noCollisions
}

# DRAWFIELD: draw battlefield, prompt and score
# ===========================================================================================================
proc DRAWFIELD {channel field} {
	global score
	# Clear screen and move cursor to upper-left corner
	puts $channel "\033\[2J"
	puts $channel "\033\[H"
	# Draw battlefield
	puts $channel $field
	# Current score string
	puts -nonewline $channel "\033\[1;31mCurrent score: $score\033\[m"
	puts $channel "\n"
	# Prompt string
	puts $channel "w or space - rotate"
	puts $channel "s          - drop"
	puts $channel "a          - move right"
	puts $channel "d          - move left"
	puts $channel "enter      - pause"
}

# SHIFT: shifts shape to the right or to the left
# ===========================================================================================================
proc SHIFT {direction currentShape} {
	upvar $currentShape shapeList
	set maxIndex [llength $shapeList]
	set shapeListTemp ""
	switch $direction {
		left {
			for {set index 0} {$index < $maxIndex} {incr index} {
				set splitStrings [split [lindex $shapeList $index] "\n"]
				set stringsTotal [expr {[llength $splitStrings]-1}]
				set shiftedShape ""
				for {set raw 0} {$raw < $stringsTotal} {incr raw} {
					set tempString [lindex $splitStrings $raw]
					set charToMove [string index $tempString 0]
					set tempString [string replace $tempString 0 0 ""] ;# trim char
					append tempString $charToMove; append tempString "\n"
					append shiftedShape $tempString 
				}
				lappend shapeListTemp $shiftedShape
			}
		}
		right {
			for {set index 0} {$index < $maxIndex} {incr index} {
				set splitStrings [split [lindex $shapeList $index] "\n"]
				set stringsTotal [expr {[llength $splitStrings]-1}]
				set shiftedShape ""
				for {set raw 0} {$raw < $stringsTotal} {incr raw} {
					set tempString [lindex $splitStrings $raw]
					set charToMove [string index $tempString end]
					set tempString [string replace $tempString end end ""] ;# trim char
					set exchange $tempString;
					set tempString $charToMove; append tempString $exchange; append tempString "\n"
					append shiftedShape $tempString 
				}
				lappend shapeListTemp $shiftedShape
			}
		}
	}
	set shapeList $shapeListTemp
}

# MOVESHAPE: shape redraw
# ===========================================================================================================
proc MOVESHAPE {fieldCurrent shape position gravity eraseOldShape} {
	upvar $fieldCurrent fieldInternal
	upvar $eraseOldShape eraseString
	upvar $position raw
	set charIndex [expr {$raw*19}]
	set fieldInternal [string replace $fieldInternal $charIndex [expr {$charIndex + [string length $eraseString] - 1}] $eraseString]
	incr raw $gravity
	set charIndex [expr {$raw*19}]
	set shapeLength [string length $shape]
	set eraseString [string range $fieldInternal $charIndex [expr {$charIndex + $shapeLength - 1}]]
	for {set charIndex 0} {$charIndex < $shapeLength} {incr charIndex} {
		if {[string index $shape $charIndex] != " "} {
			set charIndexAbs [expr {$raw*19 + $charIndex}]
			set fieldInternal [string replace $fieldInternal $charIndexAbs $charIndexAbs [string index $shape $charIndex]]
		}
	}
}

# SCORECOUNT: removes all full lines and calculates new score
# ===========================================================================================================
proc SCORECOUNT {fieldCurrent scoreCurrent} {
	upvar $fieldCurrent fieldInternal
	upvar $scoreCurrent scoreInternal
	set splitStrings [split $fieldInternal "\n"]
	set stringsTotal [llength $splitStrings]
	set fieldInternal ""
	for {set stringNumber 0} {$stringNumber < $stringsTotal} {incr stringNumber} {
		if {[string compare [lindex $splitStrings $stringNumber] "|################|"] == 0} {
			incr scoreInternal [CHARCOUNT [lindex $splitStrings $stringNumber] "#"]
			for {set index $stringNumber} {$index > 0} {incr index -1} {
				if {$index != 1} {set splitStrings [lreplace $splitStrings $index $index [lindex $splitStrings [expr {$index - 1}]]]} else {set splitStrings [lreplace $splitStrings $index $index "|                |"]}
			}
		}
	}
	for {set stringNumber 0} {$stringNumber < $stringsTotal} {incr stringNumber} {append fieldInternal [lindex $splitStrings $stringNumber]; append fieldInternal "\n"}
	set fieldInternal [string trimright $fieldInternal]
}


# TCORE: Tetrios core
# ===========================================================================================================
proc TCORE {channel} {
	# access parameters
	global score
	global fieldCurrent
	global nextShape
	global shapes
	global position
	global gravity
	global eraseOldShape
	global needNewShape
	global gameFlag
	global angle
	global antigravity
	global delay
	global fieldTemp
	global currentShape
	global forever
	
	while {$gameFlag} {
		set char [read $channel 1]
		if {($needNewShape) && ($antigravity == 0)} {
			set position 1
			set gravity 0
			set eraseOldShape ""
			set needNewShape 0
			set currentShape $nextShape
			set nextShape [SHAPEGENERATOR]
			set fieldTemp $fieldCurrent
			MOVESHAPE fieldTemp [lindex $currentShape $angle] position $gravity eraseOldShape
			if {[COLLISIONCHECK $fieldCurrent $fieldTemp [lindex $currentShape $angle] "new"]} {set fieldCurrent $fieldTemp} else {set fieldCurrent $fieldTemp; set needNewShape 0; set gameFlag 0}
		} elseif {($gameFlag) && ($antigravity == 0)} {
				incr gravity
				set fieldTemp $fieldCurrent
				MOVESHAPE fieldTemp [lindex $currentShape $angle] position $gravity eraseOldShape
				if {[COLLISIONCHECK $fieldCurrent $fieldTemp [lindex $currentShape $angle] "old"]} {set fieldCurrent $fieldTemp} else {set needNewShape 1; set angle 0}
				set gravity 0
		}
		if {$char == "\3"} {set forever "terminate"; set gameFlag 0} ;# {close $channel; exit} doesn't work correctly in IOS
		if {($char == "a") && ($antigravity != 0)} {
			set tempShape $currentShape
			set fieldTemp $fieldCurrent
			set eraseTempShape $eraseOldShape
			set gravity 0
			SHIFT "left" tempShape
			MOVESHAPE fieldTemp [lindex $tempShape $angle] position $gravity eraseTempShape
			if {[COLLISIONCHECK $fieldCurrent $fieldTemp [lindex $tempShape $angle] "old"]} {set currentShape $tempShape; MOVESHAPE fieldCurrent [lindex $currentShape $angle] position $gravity eraseOldShape}
		}
		if {($char == "d") && ($antigravity != 0)} {
			set tempShape $currentShape
			set fieldTemp $fieldCurrent
			set eraseTempShape $eraseOldShape
			set gravity 0
			SHIFT "right" tempShape
			MOVESHAPE fieldTemp [lindex $tempShape $angle] position $gravity eraseTempShape
			if {[COLLISIONCHECK $fieldCurrent $fieldTemp [lindex $tempShape $angle] "old"]} {set currentShape $tempShape; MOVESHAPE fieldCurrent [lindex $currentShape $angle] position $gravity eraseOldShape}
		}
		if {$char == "s"} {set antigravity 21}
		if {(($char == "w") || ($char == " ")) && ($antigravity != 0)} {if {$angle == 3} {set angle 0} else {incr angle} }
		if {$char == "\n"} {if {$antigravity != -1} {set antigravity -1} else {set antigravity 15}}; #pause
		#
		if {[COLLISIONCHECK $fieldCurrent $fieldTemp [lindex $currentShape $angle] "old"]} {set fieldCurrent $fieldTemp}
		if {$needNewShape} {SCORECOUNT fieldCurrent score}
		if {$antigravity != -1} {DRAWFIELD $channel $fieldCurrent}
		if {$antigravity > 15} {set antigravity 0} elseif {$antigravity == -1} {
			# just do nothing; game pause
		} else {incr antigravity}
		after $delay; update idletasks
		#flush $channel ;# don't work correctly in IOS
	}
	if {!$gameFlag} {set forever "terminate"} ;# {close $channel; exit} doesn't work correctly in IOS
}

# TSERV: Tetrios server procedure to serve incoming TCP connection
# ===========================================================================================================
proc TSERV {channel clientaddr clientport} {
	fconfigure $channel -blocking 0 -buffering none
	puts $channel "\033\[2J"
	puts $channel "\033\[H"
	puts $channel "TCP connection from $clientaddr:$clientport to TSERV $channel socket was registered"
	puts $channel "Loading Tetrios. Please wait. =)"
	after 2000; update idletasks
	WELCOME $channel ;# Draw welcome screen
	fileevent $channel readable [list TCORE $channel]
}

# initial parameters
set nextShape [SHAPEGENERATOR]
set position 1; #initial position for the first figure
set gravity 0; #initial gravity
set eraseOldShape "|                |\n"
set fieldCurrent $field
set needNewShape 1
set gameFlag 1; # if 0 then "game over"
set angle 0
set antigravity -1
set currentShape $nextShape
set fieldTemp $fieldCurrent
set score 0
set delay 50 ;# greater delay reduce tetraminoes falling speed
socket -server TSERV 1111
vwait forever