Scid  4.6.5
browser.tcl
Go to the documentation of this file.
1 
2 ####################
3 # Game Browser window
4 
5 namespace eval ::gbrowser {}
6 
7 proc ::gbrowser::new {base gnum {ply -1}} {
8  if {! [info exists ::gbrowser::size] } { set ::gbrowser::size 65}
9  options.save ::gbrowser::size
10 
11  set n 0
12  while {[winfo exists .gb$n]} { incr n}
13  set w .gb$n
14  toplevel $w
15  if {$base < 1} { set base [sc_base current]}
16  if {$gnum < 1} { set game [sc_game number]}
17  set filename [file tail [sc_base filename $base]]
18  wm title $w "Scid: $::tr(BrowseGame) ($filename: $gnum)"
19  set header [sc_game summary -base $base -game $gnum header]
20  set ::gbrowser::boards($n) [sc_game summary -base $base -game $gnum boards]
21  set moves [sc_game summary -base $base -game $gnum moves]
22 
23  pack [frame $w.b] -side bottom -fill x
24  ::board::new $w.bd $::gbrowser::size
25  pack $w.bd -side left -padx 4 -pady 4
26 
27  #pack [frame $w.t] -side right -fill both -expand yes
28  #text $w.t.text -foreground black -background white -wrap word \
29  # -width 45 -height 12 -font font_Small -yscrollcommand "$w.t.ybar set" \
30  # -setgrid 1
31  #scrollbar $w.t.ybar -command "$w.t.text yview" -takefocus 0
32  #pack $w.t.ybar -side right -fill y
33  #pack $w.t.text -side left -fill both -expand yes
34  autoscrollframe $w.t text $w.t.text \
35  -foreground black -background white -wrap word \
36  -width 45 -height 12 -font font_Small -setgrid 1
37  pack $w.t -side right -fill both -expand yes
38 
39  set t $w.t.text
40  event generate $t <ButtonRelease-1>
41  $t tag configure header -foreground darkBlue
42  $t tag configure next -foreground yellow -background darkBlue
43  $t insert end "$header" header
44  $t insert end "\n\n"
45  set m 0
46 
47  foreach i $moves {
48  set moveTag m$m
49  $t insert end [::trans $i] $moveTag
50  $t insert end " "
51  $t tag bind $moveTag <ButtonRelease-1> "::gbrowser::update $n $m"
52  $t tag bind $moveTag <Any-Enter> \
53  "$t tag configure $moveTag -foreground red
54  $t configure -cursor hand2"
55  $t tag bind $moveTag <Any-Leave> \
56  "$t tag configure $moveTag -foreground {}
57  $t configure -cursor {}"
58  incr m
59  }
60  bind $w <F1> {helpWindow GameList Browsing}
61  bind $w <Escape> "destroy $w"
62  bind $w <Home> "::gbrowser::update $n start"
63  bind $w <End> "::gbrowser::update $n end"
64  bind $w <Left> "::gbrowser::update $n -1"
65  bind $w <Right> "::gbrowser::update $n +1"
66  bind $w <Up> "::gbrowser::update $n -10"
67  bind $w <Down> "::gbrowser::update $n +10"
68  bind $w <minus> {set ::gbrowser::size [::board::resize %W.bd -1]}
69  bind $w <Control-Shift-Left> {set ::gbrowser::size [::board::resize %W.bd -1]}
70  bind $w <plus> {set ::gbrowser::size [::board::resize %W.bd +1]}
71  bind $w <Control-Shift-Right> {set ::gbrowser::size [::board::resize %W.bd +1]}
72  bindMouseWheel $w "::gbrowser::mousewheelHandler $n"
73 
74  button $w.b.start -image tb_start -command "::gbrowser::update $n start"
75  button $w.b.back -image tb_prev -command "::gbrowser::update $n -1"
76  button $w.b.forward -image tb_next -command "::gbrowser::update $n +1"
77  button $w.b.end -image tb_end -command "::gbrowser::update $n end"
78  frame $w.b.gap -width 3
79  button $w.b.autoplay -image tb_play -command "::gbrowser::autoplay $n"
80  frame $w.b.gap2 -width 3
81  button $w.b.flip -image tb_flip -command "::gbrowser::flip $n"
82 
83  pack $w.b.start $w.b.back $w.b.forward $w.b.end $w.b.gap \
84  $w.b.autoplay $w.b.gap2 $w.b.flip -side left -padx 3 -pady 1
85 
86  set ::gbrowser::autoplay($n) 0
87 
88  if {$gnum > 0} {
89  button $w.b.load -textvar ::tr(LoadGame) -command "sc_base switch $base; ::game::Load $gnum"
90  button $w.b.merge -textvar ::tr(MergeGame) -command "mergeGame $base $gnum"
91  }
92  button $w.b.close -textvar ::tr(Close) -command "destroy $w"
93  pack $w.b.close -side right -padx 1 -pady 1
94  if {$gnum > 0} {
95  pack $w.b.merge $w.b.load -side right -padx 1 -pady 1
96  }
97 
98  wm resizable $w 1 0
99  if {$ply < 0} {
100  set ply 0
101  #TODO: search if game gnum match the current board pos
102  }
103  ::gbrowser::update $n $ply
104 
105  if { [::board::isFlipped .main.board] } {
107  }
108 }
109 
110 proc gbrowser::mousewheelHandler {n direction} {
111  if {$direction < 0} {
112  ::gbrowser::update $n -1
113  } else {
114  ::gbrowser::update $n +1
115  }
116 }
117 
118 proc ::gbrowser::flip {n} {
119  ::board::flip .gb$n.bd
120 }
121 
122 proc ::gbrowser::update {n ply} {
123  set w .gb$n
124  if {! [winfo exists $w]} { return}
125  set oldply 0
126  if {[info exists ::gbrowser::ply($n)]} { set oldply $::gbrowser::ply($n)}
127  if {$ply == "forward"} { set ply [expr {$oldply + 1}]}
128  if {$ply == "back"} { set ply [expr {$oldply - 1}]}
129  if {$ply == "start"} { set ply 0}
130  if {$ply == "end"} { set ply 9999}
131  if {[string index $ply 0] == "-" || [string index $ply 0] == "+"} {
132  set ply [expr {$oldply + $ply}]
133  }
134  if {$ply < 0} { set ply 0}
135  set max [expr {[llength $::gbrowser::boards($n)] - 1}]
136  if {$ply > $max} { set ply $max}
137  set ::gbrowser::ply($n) $ply
138  ::board::update $w.bd [lindex $::gbrowser::boards($n) $ply] 1
139 
140  set t $w.t.text
141  $t configure -state normal
142  set moveRange [$t tag nextrange m$ply 1.0]
143  $t tag remove next 1.0 end
144  set moveRange [$t tag nextrange m$ply 1.0]
145  if {[llength $moveRange] == 2} {
146  $t tag add next [lindex $moveRange 0] [lindex $moveRange 1]
147  $t see [lindex $moveRange 0]
148  }
149  $t configure -state disabled
150 
151  if {$::gbrowser::autoplay($n)} {
152  if {$ply >= $max} {
154  } else {
155  after cancel "::gbrowser::update $n +1"
156  after $::autoplayDelay "::gbrowser::update $n +1"
157  }
158  }
159 }
160 
161 proc ::gbrowser::autoplay {n} {
162  if {$::gbrowser::autoplay($n)} {
163  set ::gbrowser::autoplay($n) 0
164  .gb$n.b.autoplay configure -image tb_play
165  return
166  } else {
167  set ::gbrowser::autoplay($n) 1
168  .gb$n.b.autoplay configure -image tb_stop
169  ::gbrowser::update $n +1
170  }
171 }