# Copyright (c) 2003 University of Joensuu,
#                    Department of Computer Science

#Example Palindrome
proc palindrome { } {
	
    AN_createProgramLine 1 1 "program palindrome (input, output);"
    AN_createProgramLine 2 1 "const MaxLen = 8;"
    AN_createProgramLine 3 1 "var len, i : integer;"
    AN_createProgramLine 4 5 "candidate : array \[1..MaxLen\] of char;"
    AN_createProgramLine 5 5 "pali : Boolean;"
    AN_createProgramLine 6 1 "begin"
    AN_createProgramLine 7 5 "repeat"
    AN_createProgramLine 8 9 "write('Enter the length: ');"
    AN_createProgramLine 9 9 "readln(len);"
    AN_createProgramLine 10 9 "if (len < 1) or (len > MaxLen)"
    AN_createProgramLine 11 13 "then writeln('Must be between 1..', MaxLen)"
    AN_createProgramLine 12 5 "until (len >= 1) and (len <= MaxLen);"
    AN_createProgramLine 13 5 "for i := 1 to len do begin"
    AN_createProgramLine 14 9 "write('Enter the ', i, '. letter: ');"
    AN_createProgramLine 15 9 "readln(candidate\[i\])"
    AN_createProgramLine 16 5 "end;"
    AN_createProgramLine 17 5 "pali := true;"
    AN_createProgramLine 18 5 "for i := 1 to len do"
    AN_createProgramLine 19 9 "pali := pali and (candidate\[i\] = candidate\[len-i+1\]);"
    AN_createProgramLine 20 5 "if pali"
    AN_createProgramLine 21 9 "then write('String is')"
    AN_createProgramLine 22 9 "else write('String is not');"
    AN_createProgramLine 23 5 "writeln(' a palindrome.')"
    AN_createProgramLine 24 1 "end."         
    
	AN_beginAnimation  
   
	set MaxLenId [AN_createVar MaxLen FIXED 8 {2 6 12} NULL CONST]
   	set lenId [AN_createVar len MRH NULL {3 4 7}]
	set iId [AN_createVar i STEP NULL {3 9 11}]
	set candidateId [AN_createVar candidate CONS NULL {4 1 9} NULL CHAR 8]
	set paliId [AN_createVar pali OWF NULL {5 1 4} NULL BOOL]
	
	AN_notice PROGRAM_BEGINS {6 1 5}
   
	AN_notice REPEAT_LOOP_BEGINS {7 1 6}
	set ok 0
	
	while {!$ok} { 
    	AN_writeln  "Enter the length: " {8 start end} null "PRINT_REQUEST"   
	    AN_readData $lenId {9 start end} READ_DATA _null_ {9 8 10}
    	#AN_notice IF_STATEMENT {10 1 2}
    	if { [AN_compare {10 1 2} IF_SKIP_ELSE "$lenId < > 1 8 {10 4 end} OR"] } { 
        	AN_writeln  "Must be between 1..8" {11 5 end} {{MaxLen 20}} "PRINT_RESULT"
    	}
    	set ok [AN_compare {12 1 5} REPEAT "$lenId >= <= 1 8 {12 7 end} AND"]
	}
	AN_notice FOR_LOOP_BEGINS {13 1 3}
	AN_setNewValue $iId 1 {13 5 10}
	AN_setDirection $iId right
	AN_setExpression $iId "@+1"
	AN_setLim $iId "@<=[AN_getAttribute $lenId value]" $lenId 

    while {[AN_compare null FOR "$iId {13 5 20}" ]} {
        AN_writeln  "Enter the [AN_getAttribute $iId value]. letter: " {14 start end} {{i 11}} "PRINT_REQUEST"
        set val [AN_readData $candidateId {15 start end} READ_DATA [AN_getAttribute $iId value] {15 8 19}]
        AN_step $iId {13 11 13}
    }
    #notice LOOP_ENDS {16 start end}

   AN_change $paliId true {17 start end}

   AN_notice FOR_LOOP_BEGINS {18 1 3}
   AN_setNewValue $iId 1 {18 4 10}
   while {[AN_compare null FOR "$iId {18 5 20}" ]} {
		set ex "AN_compareElements $candidateId [AN_getAttribute $iId value] [expr [AN_getAttribute $lenId value] - [AN_getAttribute $iId value] + 1  ] i len-i+1 {19 16 end} =="  
        AN_change $paliId false {19 start 11} $ex    
    	AN_step $iId {18 11 13} 
	}
	
	AN_notice IF_STATEMENT {20 1 2}
	if {[AN_compare {20 1 2} IF "$paliId {20 3 end}"] } {
		AN_writeln  "String is" { 21 6 end } null PRINT_RESULT
	} else {
		AN_writeln  "String is not" { 22 6 end } null PRINT_RESULT
	}
	AN_write " a palindrome." { 23 1 end } PRINT_RESULT
    
	AN_notice PROGRAM_ENDS {24 start end}
    
	AN_endAnimation
    
}



# --------------------------------------------------------------------------------
# 
# The following procedures:
# 
# 	AN_change_lan
# 	AN_createVar
# 	AN_readData
# 	var_set_length
# 
# do not work correctly with all examples :-(
# 
# Therefore, they are redefined by some examples. In case such an example
# is loaded before this one, we first redefine these procedures to their original
# form:
# 
# --------------------------------------------------------------------------------

proc AN_change_lan { } {
    global lan typeTable
        if {$lan == 1} {
            set lan 2
            set typeTable(INT)      integer
            set typeTable(CHAR)     char
            set typeTable(BOOL)     boolean
            set typeTable(REAL)     real
            set typeTable(CONST)    constant
            set typeTable(DOUBLE)   doubl
            set typeTable(LONG)     long
            set typeTable(FLOAT)    float
            
                #change_roleTable
        } else {
            set lan 1
            set typeTable(INT)      kokonaisluku
            set typeTable(CHAR)     merkki
            set typeTable(BOOL)     totuusarvo
            set typeTable(REAL)     liukuluku
            set typeTable(CONST)    Vakio
            set typeTable(DOUBLE)   liukuluku
            set typeTable(LONG)     kokonaisluku
            set typeTable(FLOAT)    liukuluku

                #change_roleTable 
        }
    gb_change_language $lan 
}

proc AN_createVar { name role value mark {coords null} {type INT} {length null} } {
    global lanTable lan AN stepState typeTable
   	# parse parameters
	set role [string toupper $role]
	set type [string toupper $type]
	lappend params -name $name
	if { [lsearch -exact [array names typeTable] $type] == -1} {        
        set type "INT"
    }	
    if { ![string equal -nocase $coords "null"] } {
        lappend params -coords "[lindex $coords 0] [lindex $coords 1]"
    }
    if { [string equal -nocase $length "null"] } {
        if { [string equal $type CONST] } { 
			set mess [format $lanTable([format "%s_CREATE_CONST" $lan]) $name]
		} else {
			set mess [format $lanTable([format "%s_CREATE_VAR" $lan]) $typeTable($type) $name $lanTable([format "%s_%s" $lan $role])]
		}
        set length _null_
    } else {
        set mess [format $lanTable([format "%s_CREATE_ARRAY" $lan]) $typeTable($type) $name $lanTable([format "%s_%s" $lan $role])]
        lappend params -array $length
    }
    if { [string equal -nocase $value "null"] } {
        set val _null_
		set roleState "new"
    } else {
        set val $value
		set roleState "started"
    }
    if { ![string equal -nocase $mark "null"] && !$AN(noSrc)} {
        set markId [eval markIt $mark]
        gb_flash [lindex $markId 0] 5
    }
    showMessage $mess
	if {!$AN(noVarPictures) } {
    	set id [eval gb_var_create $role $params]
    	if { ![string equal -nocase $mark "null"] } {   
			if { !$AN(noSrc) } {
				set arrowId [arrow_create_o2o [lindex $markId 0] $id 1]
        		AN_delay
        		gb_destroy $arrowId
			}
		}
	} else {
		set id _null_
	}
	if { !$AN(noSrc)} {
    	gb_text_unmark_all
	}
	# set varables attributes
    set next [getNextId] 
    lappend attributes "name $name" "role $role" "gbId $id" \
					   "value $val" "roleState $roleState"
    switch -- $role {
        CONS {
            lappend attributes "unCorrValue _null_"
        }
        STEP {
            lappend attributes "direction _null_" "expression _null_" \
							   "comparison _null_" "limitValue _null_" \
							   "limitExpression _null_"    
        } 
        FOLL {
            lappend attributes "variable _null_"
        }
        MRH {
            lappend attributes "unCorrValue _null_" "prevValue _null_"
        }
        GATH {
            lappend attributes "prevValue _null_"
        }
        OWF {
            lappend attributes "direction _null_"
        }
        TEMP {
            lappend attributes "variable _null_" "state _null_"
        }
        MWH { 
            lappend attributes "prevValue _null_"
        }
    }
    lappend attributes "length $length"
    if {![string equal $length _null_]} {
        lappend attributes "values _null_"
    }
    set AN($next) $attributes

    if { ![string equal -nocase $value "null"] } {
        if { [string equal $length "_null_"] } {
            AN_setNewValue $next $value
        } else {
            foreach val $value {
                AN_setNewElementValue $next [lindex $val 0] [lindex $val 1]
            }
        }
    }
    set AN($next) $attributes
	# Stop here if stepmode is on.
    stepStop 
    return $next
}

proc AN_readData {varId coords {notice "null"} {index _null_} } {
    
    global AN lan lanTable stepState
    set name [AN_getAttribute $varId name]
    set role [AN_getAttribute $varId role]
	if {!$AN(noSrc)} {
    	set mark [eval markIt $coords]
    	gb_flash [lindex $mark 0] 5
	}
    if {$notice != "null"} {
	    AN_notice $notice
    }

    set val [gb_text_read]

    AN_write "$val" no
        
    if { [string equal $index _null_] } {
		set state [AN_getAttribute $varId roleState]
		if {[string equal $state new]} {
			set mess [format $lanTable([format "%s_VAR_SET_VALUE" $lan]) $name $lanTable([format "%s_%s" $lan $role])]	
			AN_setAttribute $varId roleState "started"
		} else {
			set mess [format $lanTable([format "%s_VAR_UPDATE_VALUE" $lan]) $name $lanTable([format "%s_%s" $lan $role])]
		}

        showMessage $mess
		#Move previuos value away from new value if it's nessery. Depends on role
		if { [string equal $role "MRH"] || [string equal $role "MWH"] || [string equal $role "GATH"] } { 
        	AN_setAttribute $varId prevValue  [AN_getAttribute $varId value]
        	if { ![string equal [AN_getAttribute $varId prevValue] "_null_"] } {
				if {!$AN(noVarPictures)} {
            		gb_var_set_value [AN_getAttribute $varId gbId] [AN_getAttribute $varId prevValue]  1 2
            		gb_var_set_value [AN_getAttribute $varId gbId] " " 
				}
        	}
    	} 
		if { !$AN(noVarPictures) } {
			if {!$AN(noSrc)} {
        		set ID [gb_animate_entry $val [AN_getAttribute $varId gbId] 1 [lindex $mark 0]]		
			} else {
				set ID [gb_animate_entry $val [AN_getAttribute $varId gbId] 1 ]
			}
    		gb_var_set_value [AN_getAttribute $varId gbId] $val
		}
    	AN_setAttribute $varId value $val 
		if {!$AN(noSrc)} {
			gb_text_unmark_all
		}
    } else {
		#TODOO muista järjestys kuten tavan muuttujassa. Katso IF osa
        set mess [format $lanTable([format "%s_ARRAY_SET_VALUE" $lan]) '[AN_getAttribute $varId name]' $index]
        showMessage $mess
		if { !$AN(noVarPictures) } {
			if {!$AN(noSrc)} {
				gb_animate_entry $val [AN_getAttribute $varId gbId] 1 [lindex $mark 0] $index
			} else {
				gb_animate_entry $val [AN_getAttribute $varId gbId] 1 NULL  $index
			}
		}
        AN_setNewElementValue $varId $val $index
		if {!$AN(noSrc)} {
        	gb_text_unmark_all
		}
    }
    stepStop
    return $val
}

proc var_set_length { varId length role pic} {
	global gb
    set id [gb_var_get_picture $varId]
	for {set i 1} {$i < $length } { incr i} {
	    set xxx [expr [lindex [$gb(var) bbox "$id"] 2] -2]
		set yyy [lindex  [$gb(var) bbox "$id"] 1]
		set id [gb_pic_create "var" $xxx $yyy $pic]
        set id $id
		addtag "position [expr $i+1] $varId" $id
		#addtag $varId $id
        
		set co [$gb(var) bbox $id]
		set x [expr [lindex $co 0]+(([lindex $co 2] - [lindex $co 0]) / 2)]
		set y [expr [lindex $co 1] -5]
		
		$gb(var) create text  $x $y \
			-text [expr $i+1] -anchor c -fill $gb(help_color) -tags "index_$id"
        addtag "PIC_[expr $i+1] $id" $varId
    }
    
	set co [$gb(var) bbox [gb_var_get_picture $varId]]	
	set x [expr [lindex $co 0]+(([lindex $co 2] - [lindex $co 0]) / 2)]
	set y [expr [lindex $co 1] -5]
	$gb(var) create text  $x $y \
			-text 1 -anchor c -fill $gb(help_color) -tags "index_[gb_var_get_picture $varId]"	
}

# --------------------------------------------------------------------------------
# 
# And then we redefine procedures that must be redefined for this example to work:
# 
# --------------------------------------------------------------------------------

proc AN_readData {varId coords {notice "null"} {index _null_} {coords2 "null"}} {
    
    global AN lan lanTable stepState
    set name [AN_getAttribute $varId name]
    set role [AN_getAttribute $varId role]
        if {!$AN(noSrc)} {
        set mark [eval markIt $coords]
        gb_flash [lindex $mark 0] 5
        }
    if {$notice != "null"} {
            AN_notice $notice
    }

    set val [gb_text_read]

    AN_write "$val" no
        
    if { [string equal $index _null_] } {
                set state [AN_getAttribute $varId roleState]
                if {[string equal $state new]} {
                        set mess [format $lanTable([format "%s_VAR_SET_VALUE" $lan]) $name $lanTable([format "%s_%s" $lan $role])]      
                        AN_setAttribute $varId roleState "started"
                } else {
                        set mess [format $lanTable([format "%s_VAR_UPDATE_VALUE" $lan]) $name $lanTable([format "%s_%s" $lan $role])]
                }

        if {!$AN(noSrc)} {
	if { ![string equal $coords2 "null"] } {
        set mark [eval markIt $coords2]
        gb_flash [lindex $mark 0] 5
        }
        }
        showMessage $mess
                #Move previuos value away from new value if it's nessery. Depends on role
                if { [string equal $role "MRH"] || [string equal $role "MWH"] || [string equal $role "GATH"] } { 
                AN_setAttribute $varId prevValue  [AN_getAttribute $varId value]
                if { ![string equal [AN_getAttribute $varId prevValue] "_null_"] } {
                                if {!$AN(noVarPictures)} {
                        gb_var_set_value [AN_getAttribute $varId gbId] [AN_getAttribute $varId prevValue]  1 2
                        gb_var_set_value [AN_getAttribute $varId gbId] " " 
                                }
                }
        } 
                if { !$AN(noVarPictures) } {
                        if {!$AN(noSrc)} {
                        set ID [gb_animate_entry $val [AN_getAttribute $varId gbId] 1 [lindex $mark 0]]         
                        } else {
                                set ID [gb_animate_entry $val [AN_getAttribute $varId gbId] 1 ]
                        }
                gb_var_set_value [AN_getAttribute $varId gbId] $val
                }
        AN_setAttribute $varId value $val 
                if {!$AN(noSrc)} {
                        gb_text_unmark_all
                }
    } else {
                #TODOO muista järjestys kuten tavan muuttujassa. Katso IF osa
        set mess [format $lanTable([format "%s_ARRAY_SET_VALUE" $lan]) '[AN_getAttribute $varId name]' $index]
		if {!$AN(noSrc)} {
	if { ![string equal $coords2 "null"] } {
        set mark [eval markIt $coords2]
        gb_flash [lindex $mark 0] 5
        }
        }
        showMessage $mess
                if { !$AN(noVarPictures) } {
                        if {!$AN(noSrc)} {
                                gb_animate_entry $val [AN_getAttribute $varId gbId] 1 [lindex $mark 0] $index
                        } else {
                                gb_animate_entry $val [AN_getAttribute $varId gbId] 1 NULL  $index
                        }
                }
        AN_setNewElementValue $varId $val $index
                if {!$AN(noSrc)} {
                gb_text_unmark_all
                }
    }
    stepStop
    return $val
}

proc var_set_length { varId length role pic} {
        global gb
    set id [gb_var_get_picture $varId]
        for {set i 1} {$i < $length } { incr i} {
            set xxx [expr [lindex [$gb(var) bbox "$id"] 2] -2]
                set yyy [lindex  [$gb(var) bbox "$id"] 1]
                set id [gb_pic_create "var" $xxx $yyy $pic]
        set id $id
                addtag "position [expr $i+1] $varId" $id
                #addtag $varId $id

                set co [$gb(var) bbox $id]
                set x [expr [lindex $co 0]+(([lindex $co 2] - [lindex $co 0]) / 2)]
                set y [expr [lindex $co 1] -5]

                $gb(var) create text  $x $y \
                        -text [expr $i+1] -anchor c -fill $gb(help_color) -tags "index_$id"
        addtag "PIC_[expr $i+1] $id" $varId
    }

        set co [$gb(var) bbox [gb_var_get_picture $varId]]
        set x [expr [lindex $co 0]+(([lindex $co 2] - [lindex $co 0]) / 2)]
        set y [expr [lindex $co 1] -5]
        $gb(var) create text  $x $y \
                        -text 1 -anchor c -fill $gb(help_color) -tags "index_[gb_var_get_picture $varId]"
}
