#
# search.test --
#
#     This file contains some automated tests to ensure that searching for
#     items in a canvas3d widget works. Specifically tested are searching
#     for items by ID, TAG or logical combinations thereof. Not tested is
#     searching for items based on projected viewport coordinates (because
#     this is difficult to automate).
#

package require tcltest 2.2
namespace import -force ::tcltest::*

package require Tk
package require Canvas3d

canvas3d .win

set ::COORDS {0.0 0.0 0.0 1.0 1.0 1.0 2.0 2.0 2.0}

#---------------------------------------------------------------------------
# A couple of straightforward tests to get started:
#
#     search.1.1 - Create an item, check that [find all] returns it.
#     search.1.2 - Create another item, check that [find all] still works.
#     search.1.3 - Search for first item by ID.
#     search.1.4 - Search for second item by ID.
#     search.1.5 - Search for an ID that doesn't exist.
#     search.1.6 - Add a tag to the first item, check that query by tag works.
#     search.1.7 - Add the tag to the second item, check query by tag.
#     search.1.8 - Remove the tag from the first item, check query by tag.
#     search.1.9 - Remove the tag from the second item, check query by tag.
#     search.1.10 - Delete all items, check [find all] returns an empty list.
#
lappend ::idlist [.win create polygon $::COORDS]
test canvas3d-search.1.1 {find all} -body {
  lsort [.win find all]
} -result $::idlist
lappend ::idlist [.win create polygon $::COORDS]
test canvas3d-search.1.2 {find all} -body {
  lsort [.win find all]
} -result [lsort $::idlist]
set ::id [lindex $idlist 0]
test canvas3d-search.1.3 {find ID} -body {
  .win find $::id
} -result [list $::id]
set ::id [lindex $idlist 1]
test canvas3d-search.1.4 {find ID} -body {
  .win find $::id
} -result [list $::id]
set ::id 2531
test canvas3d-search.1.5 {find ID} -body {
  .win find $::id
} -result [list]
set ::id [lindex $idlist 0]
test canvas3d-search.1.6 {find ID} -body {
  .win addtag $::id tag1
  .win find tag1
} -result [list $::id]
set ::id [lindex $idlist 1]
test canvas3d-search.1.7 {find ID} -body {
  .win addtag $::id tag1
  lsort [.win find tag1]
} -result [lsort $::idlist]
set ::id [lindex $idlist 0]
test canvas3d-search.1.8 {find ID} -body {
  .win dtag $::id tag1
  .win find tag1
} -result [lrange $::idlist 1 1]
set ::id [lindex $idlist 1]
test canvas3d-search.1.9 {find ID} -body {
  .win dtag $::id tag1
  .win find tag1
} -result [list]
.win delete all
test canvas3d-search.1.10 {find all} -body {
  .win find all
} -result [list]

#---------------------------------------------------------------------------
# The following test invokes [$win create] [$win addtag] [$win delete] and
# [$win dtag] in a pseudo-random pattern. At the same time Tcl variables
# are manipulated to keep a record of the associations between tags and
# items. After each step, the Tcl variables are compared to the results of
# [$win find] commands to ensure that the internal mapping from items to
# tags is being correctly updated.
#
set all  [list]
set tag1 [list]
set tag2 [list]
set tag3 [list]
set tag4 [list]
set tag5 [list]

for {set i 0} {$i < 100} {incr i} {
  set id [.win create polygon $::COORDS]

  lappend ::all $id
  for {set j 0} {$j < 3} {incr j} {
    set tagname "tag[expr int(rand()*5.0) + 1]"
    if {[lsearch [set ::$tagname] $id]==-1} {
      lappend ::$tagname $id
    }
    .win addtag $id $tagname
  }

  if {($i % 2) == 0} {
    set idx [expr int(rand()*[llength $::all])]
    set id [lindex $::all $idx]
    set ::all [lreplace $::all $idx $idx]

    foreach l [list tag1 tag2 tag3 tag4 tag5] {
      set idx [lsearch -exact [set $l] $id]
      if {$idx>=0} {
        set $l [lreplace [set $l] $idx $idx]
      }
    }

    .win delete $id
  } else {
    set tagname "tag[expr int(rand()*5.0) + 1]"
    set len [llength [set ::$tagname]]
    if {$len > 0} {
      set idx [expr int(rand()*$len)]
      set id [lindex [set ::$tagname] $idx]
      set ::$tagname [lreplace [set ::$tagname] $idx $idx]
      .win dtag $id $tagname
    }
  }

  set testno 0
  foreach l [list all tag1 tag2 tag3 tag4 tag5] {
    test canvas3d-search.2.$i.[incr testno] "find $l" -body [subst -nocommands {
      lsort [.win find $l]
    }] -result [lsort [set ::$l]]
  }
}

#---------------------------------------------------------------------------
# The following tests ensure that illegal tag names are rejected. An
# illegal tag name is any that starts with a digit or contains one of the
# characters '(', ')', '^', '&', '|' or '!'.
#
set badtags [list 1tag 0tag tag)yes )adf fsa( adsf| da|asdf |adsf dfs& ^ !abc]
set testnum 0
foreach bad $badtags {
  test canvas3d-search.3.[incr testnum] {Bad tagname} -body {
    set rc [catch {
      .win addtag all $bad
    } msg]
    list $rc $msg
  } -result "1 {Illegal tag name: $bad}"
}

#---------------------------------------------------------------------------
# The next block of tests test some more complicated search expressions
# involving the logical operators !, ^, && and ||.
#
# search.4.1 - 4.2:  NOT operator
# search.4.3 - 4.5:  OR  operator
# search.4.6 - 4.8:  AND operator
# search.4.9 - 4.11: XOR operator
#
.win delete all
set ::idlist [list]
lappend ::idlist [.win create polygon $::COORDS]
lappend ::idlist [.win create polygon $::COORDS]
foreach {item1 item2} $::idlist {}

test canvas3d-search.4.1 {NOT operator} -body {
  .win find "!$::item1"
} -result [list $::item2]
test canvas3d-search.4.2 {NOT operator} -body {
  .win find "!RandomTag"
} -result $::idlist

test canvas3d-search.4.3 {OR operator} -body {
  .win find "$::item1 || $::item2"
} -result $::idlist
test canvas3d-search.4.4 {OR operator} -body {
  .win find "$::item1 || !RandomTag"
} -result $::idlist
test canvas3d-search.4.5 {OR operator} -body {
  .win find "$::item1||RandomTag"
} -result [list $::item1]

test canvas3d-search.4.6 {AND operator} -body {
  .win find "$::item1 && $::item2"
} -result [list]
test canvas3d-search.4.7 {AND operator} -body {
  .win find "$::item1 && !RandomTag"
} -result [list $::item1]
test canvas3d-search.4.8 {AND operator} -body {
  .win find "$::item1 && RandomTag"
} -result [list]

test canvas3d-search.4.9 {XOR operator} -body {
  .win find "$::item1 ^ $::item2"
} -result $::idlist
test canvas3d-search.4.10 {XOR operator} -body {
  .win find "$::item1 ^ !RandomTag"
} -result [list $::item2]
test canvas3d-search.4.11 {XOR operator} -body {
  .win find "$::item1 ^ RandomTag"
} -result [list $::item1]

#---------------------------------------------------------------------------
# Test cases search.5.* test the precedence of the logical operators and
# the use of parenthesis in search expressions.
#
.win delete all
set ::idlist [list]
for {set i 0} {$i < 12} {incr i} {
  set id [.win create polygon $::COORDS]
  lappend ::idlist $id
  for {set j 1} {$j < 5} {incr j} {
    if {($i % $j) == 0} {
      .win addtag $id tag$j
    }
  }
}

proc items {args} {
  set ret [list]
  foreach a $args {
    lappend ret [lindex $::idlist $a]
  }
  return [lsort $ret]
}

set expressions [list \
[list      tag3                    [items 0 3 6 9]                   ] \
[list      !tag2&&tag3             [items 3 9]                       ] \
[list      !(tag2&&tag3)           [items 1 2 3 4 5 7 8 9 10 11]     ] \
[list      tag1||tag2&&tag3        [items 0 1 2 3 4 5 6 7 8 9 10 11] ] \
[list      (tag1||tag2)&&tag3      [items 0 3 6 9 ]                  ] \
[list      tag1||(tag2&&tag3)      [items 0 1 2 3 4 5 6 7 8 9 10 11] ] \
]

set testnum 0
foreach e $expressions {
  test canvas-search.5.[incr testnum] {} -body {
    lsort [.win find [lindex $e 0]]
  } -result [lindex $e 1]
}

#---------------------------------------------------------------------------
# Test cases search.6.* test the precedence of the logical operators and
# the use of parenthesis in search expressions.
#
# These tests use the command [$win gettags all], the result of which are
# ambiguously defined if there is more than one item in the canvas. The
# manpage says the result list is the list of tags attached to the first
# "item found", but does not define which item is likely to be "found
# first". In practice items this search encounters items in the order that
# they were added, but this might change if the implementation changes. If
# this happens, these tests will fail.
#
test canvas-search.6.1 {} -body {
  .win delete all
  set ::item1 [.win create polygon $::COORDS]
  set ::item2 [.win create polygon $::COORDS]
  .win gettags all
} -result {}

test canvas-search.6.2 {} -body {
  .win addtag $::item1 tag1
  .win gettags all
} -result {tag1}

test canvas-search.6.3 {} -body {
  .win addtag $::item1 tag2
  lsort [.win gettags all]
} -result {tag1 tag2}

test canvas-search.6.4 {} -body {
  .win addtag $::item2 tag3
  lsort [.win gettags all]
} -result {tag1 tag2}

test canvas-search.6.5 {} -body {
  .win addtag $::item1 tag2
  lsort [.win gettags all]
} -result {tag1 tag2}

#---------------------------------------------------------------------------
# The following test cases test the parsing of the 'viewport' keyword. Also
# test that "viewport" works as a tag name if used in that context.
#
test canvas-search.7.1 {} -body {
  .win delete all
  set ::item1 [.win create polygon $::COORDS]
  set ::item2 [.win create polygon $::COORDS]
  .win addtag $::item1 viewport
} -result {}
test canvas-search.7.2 {} -body {
  .win find viewport(10,10)
} -result {}
test canvas-search.7.3 {} -body {
  set rc [catch {
    .win find viewport(10
  } msg]
  list $rc $msg
} -result {1 {Syntax error in expression near "viewport"}}
test canvas-search.7.4 {} -body {
  set rc [catch {
    .win find viewport(hello
  } msg]
  list $rc $msg
} -result {1 {Syntax error in expression near "viewport"}}
test canvas-search.7.5 {} -body {
  set rc [catch {
    .win find {  viewport  (  10  , 10 )  }
  } msg]
  list $rc $msg
} -result {0 {}}
test canvas-search.7.6 {} -body {
  .win find viewport
} -result $::item1
test canvas-search.7.7 {} -body {
  .win find {all && viewport}
} -result $::item1
test canvas-search.7.8 {} -body {
  .win find {viewport && all}
} -result $::item1
test canvas-search.7.9 {} -body {
  .win find viewport(1,2,3,4)
  .win find {viewport( 1 , 2 , 3 , 4 )}
  .win find {viewport(-1.2, 2 , 3 , 4 )}
} -result {}

#---------------------------------------------------------------------------
# The following test cases test the 'type()' search syntax.
#
test canvas-search.7.1 {} -body {
  .win delete all
  set ::item1 [.win create polygon $::COORDS]
  set ::item2 [.win create polygon $::COORDS]
  set ::item3 [.win create line $::COORDS]
  set ::item4 [.win create light {0.0 0.0 0.0}]
  llength [.win find all]
} -result {4}
test canvas-search.7.2 {} -body {
  lsort [.win find type(polygon)]
} -result [lsort [list $::item1 $::item2]]
test canvas-search.7.3 {} -body {
  .win find type(line)
} -result $::item3
test canvas-search.7.4 {} -body {
  .win find type(light)
} -result $::item4
test canvas-search.7.5 {} -body {
  .win find { type ( light ) }
} -result $::item4
test canvas-search.7.6 {} -body {
  .win find {  type  (  light  )  }
} -result $::item4
test canvas-search.7.7 {} -body {
  .win find {	type	(	light	)	}
} -result $::item4

#---------------------------------------------------------------------------
# Test a few syntax errors in search expressions.
#
test canvas-search.8.1 {} -body {
  set rc [catch {
    .win find {tag &&}
  } msg]
  list $rc $msg
} -result {1 {Syntax error in expression near "&&"}}
test canvas-search.8.2 {} -body {
  set rc [catch {
    .win find {tag1 tag2}
  } msg]
  list $rc $msg
} -result {1 {Syntax error in expression near "tag2"}}
test canvas-search.8.3 {} -body {
  set rc [catch {
    .win find { }
  } msg]
  list $rc $msg
} -result {0 {}}
test canvas-search.8.4 {} -body {
  set rc [catch {
    .win find {	}
  } msg]
  list $rc $msg
} -result {0 {}}
test canvas-search.8.5 {} -body {
  set rc [catch {
    llength [.win find all]
  } msg]
  list $rc $msg
} -result {0 4}

#---------------------------------------------------------------------------
# Test the hidden() search syntax a bit.
#
test canvas-search.9.1 {} -body {
  .win delete all
  set ::item1 [.win create polygon $::COORDS]
  set ::item2 [.win create polygon $::COORDS]
  set ::item3 [.win create line $::COORDS]
  set ::item4 [.win create light {0.0 0.0 0.0}]
  llength [.win find all]
} -result {4}
test canvas-search.9.2 {} -body {
  lsort [.win find hidden()]
} -result {}
test canvas-search.9.3 {} -body {
  .win itemconf $::item1 -hidden 1
  .win find hidden()
} -result $::item1
test canvas-search.9.4 {} -body {
  .win itemconf $::item1 -hidden 0
  .win find hidden()
} -result {}
test canvas-search.9.5 {} -body {
  .win itemconf type(polygon) -hidden 1
  lsort [.win find { hidden ( ) }]
} -result "$::item1 $::item2"
test canvas-search.9.6 {} -body {
  .win find {  hidden  ()  }
} -result "$::item1 $::item2"
test canvas-search.9.7 {} -body {
  lsort [.win find {!hidden() }]
} -result "$::item3 $::item4"
test canvas-search.9.8 {} -body {
  .win find hidden
} -result {}
test canvas-search.9.9 {} -body {
  .win addtag type(line) hidden
  .win find hidden
} -result $::item3

destroy .win

# cleanup
cleanupTests
return
