From 25750da6c02aa71909b6908abf17296d4bd2a73f Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 4 Jan 2025 18:04:39 +0100 Subject: [PATCH 01/22] Split tag search in one proc per tag --- tcl/htext.tcl | 292 +++++++++++++++++++++++++------------------------- 1 file changed, 148 insertions(+), 144 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 102b2cc0..2172727e 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -254,6 +254,134 @@ proc ::htext::extractSectionName {tagName} { set ::htext::interrupt 0 +proc ::htext::a_tag {w tagName} { + set linkName [::htext::extractLinkName $tagName] + set sectionName [::htext::extractSectionName $tagName] + set linkTag "link ${linkName} ${sectionName}" + $w tag configure "$linkTag" -foreground blue -underline 1 + $w tag bind "$linkTag" \ + "helpWindow $linkName $sectionName" + $w tag bind $linkTag \ + "$w tag configure \"$linkTag\" -background yellow + $w configure -cursor hand2" + $w tag bind $linkTag \ + "$w tag configure \"$linkTag\" -background {} + $w configure -cursor {}" + return [list a $linkTag ] +} +proc ::htext::url_tag {w tagName} { + set urlName [string range $tagName 4 end] + set urlTag "url $urlName" + $w tag configure "$urlTag" -foreground red -underline 1 + $w tag bind "$urlTag" "openURL {$urlName}" + $w tag bind $urlTag \ + "$w tag configure \"$urlTag\" -background yellow + $w configure -cursor hand2" + $w tag bind $urlTag \ + "$w tag configure \"$urlTag\" -background {} + $w configure -cursor {}" + return [list url $urlTag ] +} +proc ::htext::run_tag {w tagName} { + # Check if it is a Tcl command tag: + set runName [string range $tagName 4 end] + set runTag "run $runName" + $w tag bind "$runTag" "catch {$runName}" + $w tag bind $runTag \ + "$w tag configure \"$runTag\" -foreground white + $w tag configure \"$runTag\" -background DodgerBlue4 + $w configure -cursor hand2" + $w tag bind $runTag \ + "$w tag configure \"$runTag\" -foreground {} + $w tag configure \"$runTag\" -background {} + $w configure -cursor {}" + return [list run $runTag ] +} +proc ::htext::go_tag {w tagName} { + # Check if it is a goto tag: + set goName [string range $tagName 3 end] + set goTag "go $goName" + $w tag bind "$goTag" \ + "catch {$w see \[lindex \[$w tag nextrange $goName 1.0\] 0\]}" + $w tag bind $goTag \ + "$w tag configure \"$goTag\" -foreground yellow + $w tag configure \"$goTag\" -background maroon + $w configure -cursor hand2" + $w tag bind $goTag \ + "$w tag configure \"$goTag\" -foreground {} + $w tag configure \"$goTag\" -background {} + $w configure -cursor {}" + return [list go $goTag ] +} +proc ::htext::pi_tag {w tagName} { + # Check if it is a player info tag: + set playerTag $tagName + set playerName [string range $playerTag 3 end] + $w tag configure "$playerTag" -foreground DodgerBlue3 + $w tag bind "$playerTag" "::pinfo::playerInfo \"$playerName\"" + $w tag bind $playerTag \ + "$w tag configure \"$playerTag\" -foreground white + $w tag configure \"$playerTag\" -background DodgerBlue4 + $w configure -cursor hand2" + $w tag bind $playerTag \ + "$w tag configure \"$playerTag\" -foreground DodgerBlue3 + $w tag configure \"$playerTag\" -background {} + $w configure -cursor {}" +return [list pi $playerTag ] +} +proc ::htext::g_tag {w tagName} { + # Check if it is a game-load tag: + set gameTag $tagName + set gnum [string range $gameTag 2 end] + set glCommand "::game::LoadMenu $w [sc_base current] $gnum %X %Y" + $w tag bind $gameTag $glCommand + $w tag bind $gameTag \ + "::gbrowser::new [sc_base current] $gnum" + $w tag bind $gameTag \ + "$w tag configure $gameTag -foreground white + $w tag configure $gameTag -background DodgerBlue4 + $w configure -cursor hand2" + $w tag bind $gameTag \ + "$w tag configure $gameTag -foreground {} + $w tag configure $gameTag -background {} + $w configure -cursor {}" + return [list g $gameTag ] +} +proc ::htext::m_tag {w tagName} { + # Check if it is a move tag: + set moveTag $tagName + ### TODO + ### Does not work for variations as the var-Tag appears before + ### the "sc_move pgn [string range $moveTag 2 end]; updateBoard" + # Bind middle button to popup a PGN board: + $w tag bind $moveTag "::pgn::ShowBoard .pgnWin.text $moveTag %X %Y" + $w tag bind $moveTag "::pgn::HideBoard" + # invoking contextual menu in PGN window + $w tag bind $moveTag "sc_move pgn [string range $moveTag 2 end]; updateBoard" + $w tag bind $moveTag "$w tag configure $moveTag -underline 1 + $w configure -cursor hand2" + $w tag bind $moveTag "$w tag configure $moveTag -underline 0 + $w configure -cursor {}" + return [list m $moveTag ] +} +proc ::htext::c_tag {w tagName} { + # Check if it is a comment tag: + set commentTag $tagName + $w tag configure $commentTag -foreground $::pgnColor(Comment) -font font_Regular + $w tag bind $commentTag "sc_move pgn [string range $commentTag 2 end]; updateBoard; ::makeCommentWin" + $w tag bind $commentTag "$w tag configure $commentTag -underline 1 + $w configure -cursor hand2" + $w tag bind $commentTag "$w tag configure $commentTag -underline 0 + $w configure -cursor {}" + return [list c $commentTag ] +} +proc ::htext::h1_tag {w tagName} { + $w insert end "\n" + return { "h1" "h1" } +} + proc ::htext::display {w helptext {section ""} {fixed 1}} { global helpWin # set start [clock clicks -milli] @@ -262,7 +390,6 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { $w mark set insert 0.0 $w configure -state normal set linkName "" - set count 0 set str $helptext if {$fixed} { @@ -275,157 +402,45 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { } set tagType "" set seePoint "" - + if {! [info exists ::htext::updates($w)]} { set ::htext::updates($w) 100 } - + # Loop through the text finding the next formatting tag: - while {1} { set startPos [string first "<" $str] if {$startPos < 0} { break } set endPos [string first ">" $str] if {$endPos < 1} { break } - + set tagName [string range $str [expr {$startPos + 1}] [expr {$endPos - 1}]] - + # Check if it is a starting tag (no "/" at the start): - + set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag "h1" h1_tag } + if {![strIsPrefix "/" $tagName]} { - - # Check if it is a link tag: - if {[strIsPrefix "a " $tagName]} { - set linkName [::htext::extractLinkName $tagName] - set sectionName [::htext::extractSectionName $tagName] - set linkTag "link ${linkName} ${sectionName}" - set tagName "a" - $w tag configure "$linkTag" -foreground blue -underline 1 - $w tag bind "$linkTag" \ - "helpWindow $linkName $sectionName" - $w tag bind $linkTag \ - "$w tag configure \"$linkTag\" -background yellow - $w configure -cursor hand2" - $w tag bind $linkTag \ - "$w tag configure \"$linkTag\" -background {} - $w configure -cursor {}" - } elseif {[strIsPrefix "url " $tagName]} { - # Check if it is a URL tag: - set urlName [string range $tagName 4 end] - set urlTag "url $urlName" - set tagName "url" - $w tag configure "$urlTag" -foreground red -underline 1 - $w tag bind "$urlTag" "openURL {$urlName}" - $w tag bind $urlTag \ - "$w tag configure \"$urlTag\" -background yellow - $w configure -cursor hand2" - $w tag bind $urlTag \ - "$w tag configure \"$urlTag\" -background {} - $w configure -cursor {}" - } elseif {[strIsPrefix "run " $tagName]} { - # Check if it is a Tcl command tag: - set runName [string range $tagName 4 end] - set runTag "run $runName" - set tagName "run" - $w tag bind "$runTag" "catch {$runName}" - $w tag bind $runTag \ - "$w tag configure \"$runTag\" -foreground white - $w tag configure \"$runTag\" -background DodgerBlue4 - $w configure -cursor hand2" - $w tag bind $runTag \ - "$w tag configure \"$runTag\" -foreground {} - $w tag configure \"$runTag\" -background {} - $w configure -cursor {}" - } elseif {[strIsPrefix "go " $tagName]} { - # Check if it is a goto tag: - set goName [string range $tagName 3 end] - set goTag "go $goName" - set tagName "go" - $w tag bind "$goTag" \ - "catch {$w see \[lindex \[$w tag nextrange $goName 1.0\] 0\]}" - $w tag bind $goTag \ - "$w tag configure \"$goTag\" -foreground yellow - $w tag configure \"$goTag\" -background maroon - $w configure -cursor hand2" - $w tag bind $goTag \ - "$w tag configure \"$goTag\" -foreground {} - $w tag configure \"$goTag\" -background {} - $w configure -cursor {}" - } elseif {[strIsPrefix "pi " $tagName]} { - # Check if it is a player info tag: - set playerTag $tagName - set playerName [string range $playerTag 3 end] - set tagName "pi" - $w tag configure "$playerTag" -foreground DodgerBlue3 - $w tag bind "$playerTag" "::pinfo::playerInfo \"$playerName\"" - $w tag bind $playerTag \ - "$w tag configure \"$playerTag\" -foreground white - $w tag configure \"$playerTag\" -background DodgerBlue4 - $w configure -cursor hand2" - $w tag bind $playerTag \ - "$w tag configure \"$playerTag\" -foreground DodgerBlue3 - $w tag configure \"$playerTag\" -background {} - $w configure -cursor {}" - } elseif {[strIsPrefix "g_" $tagName]} { - # Check if it is a game-load tag: - set gameTag $tagName - set tagName "g" - set gnum [string range $gameTag 2 end] - set glCommand "::game::LoadMenu $w [sc_base current] $gnum %X %Y" - $w tag bind $gameTag $glCommand - $w tag bind $gameTag \ - "::gbrowser::new [sc_base current] $gnum" - $w tag bind $gameTag \ - "$w tag configure $gameTag -foreground white - $w tag configure $gameTag -background DodgerBlue4 - $w configure -cursor hand2" - $w tag bind $gameTag \ - "$w tag configure $gameTag -foreground {} - $w tag configure $gameTag -background {} - $w configure -cursor {}" - } elseif {[strIsPrefix "m_" $tagName]} { - # Check if it is a move tag: - set moveTag $tagName - set tagName "m" - ### TODO - ### Does not work for variations as the var-Tag appears before - ### the "sc_move pgn [string range $moveTag 2 end]; updateBoard" - # Bind middle button to popup a PGN board: - $w tag bind $moveTag "::pgn::ShowBoard .pgnWin.text $moveTag %X %Y" - $w tag bind $moveTag "::pgn::HideBoard" - # invoking contextual menu in PGN window - $w tag bind $moveTag "sc_move pgn [string range $moveTag 2 end]; updateBoard" - $w tag bind $moveTag "$w tag configure $moveTag -underline 1 - $w configure -cursor hand2" - $w tag bind $moveTag "$w tag configure $moveTag -underline 0 - $w configure -cursor {}" - } elseif {[strIsPrefix "c_" $tagName]} { - # Check if it is a comment tag: - set commentTag $tagName - set tagName "c" - $w tag configure $commentTag -foreground $::pgnColor(Comment) -font font_Regular - $w tag bind $commentTag "sc_move pgn [string range $commentTag 2 end]; updateBoard; ::makeCommentWin" - $w tag bind $commentTag "$w tag configure $commentTag -underline 1 - $w configure -cursor hand2" - $w tag bind $commentTag "$w tag configure $commentTag -underline 0 - $w configure -cursor {}" - } - - if {$tagName == "h1"} {$w insert end "\n"} - + set found 0 + foreach {tag proc} $tagList { + if {[strIsPrefix $tag $tagName]} { + lassign [$proc $w $tagName] tagName help + set fullTag($tagName) $help + set found 1 + break + } + } + if { ! $found } { set fullTag($tagName) $tagName } } - + # Now insert the text up to the formatting tag: $w insert end [string range $str 0 [expr {$startPos - 1}]] - + # Check if it is a name tag matching the section we want: if {$section != "" && [strIsPrefix "name " $tagName]} { set sect [string range $tagName 5 end] if {$section == $sect} { set seePoint [$w index insert] } } - + if {[string index $tagName 0] == "/"} { # Get rid of initial "/" character: set tagName [string range $tagName 1 end] @@ -433,24 +448,13 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { h1 - h2 - h3 - h4 - h5 {$w insert end "\n"} } if {$tagName == "p"} {$w insert end "\n"} - #if {$tagName == "h1"} {$w insert end "\n"} if {$tagName == "menu"} {$w insert end "\]"} if {$tagName == "ul"} { incr helpWin(Indent) -4 $w insert end "\n" } if {[info exists startIndex($tagName)]} { - switch -- $tagName { - a {$w tag add $linkTag $startIndex($tagName) [$w index insert]} - g {$w tag add $gameTag $startIndex($tagName) [$w index insert]} - c {$w tag add $commentTag $startIndex($tagName) [$w index insert]} - m {$w tag add $moveTag $startIndex($tagName) [$w index insert]} - pi {$w tag add $playerTag $startIndex($tagName) [$w index insert]} - url {$w tag add $urlTag $startIndex($tagName) [$w index insert]} - run {$w tag add $runTag $startIndex($tagName) [$w index insert]} - go {$w tag add $goTag $startIndex($tagName) [$w index insert]} - default {$w tag add $tagName $startIndex($tagName) [$w index insert]} - } + $w tag add $fullTag($tagName) $startIndex($tagName) [$w index insert] unset startIndex($tagName) } } else { From b513630a86ff6fd776fcca1b095a8b8223ff4277 Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 4 Jan 2025 18:39:21 +0100 Subject: [PATCH 02/22] Use procs for tag button, img and window --- tcl/htext.tcl | 63 ++++++++++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 28 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 2172727e..e98355d1 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -377,6 +377,35 @@ proc ::htext::c_tag {w tagName} { $w configure -cursor {}" return [list c $commentTag ] } +proc ::htext::img_tag {w tagName} { + set imgName [string range $tagName 4 end] + #flags are not loaded on start, so check if a flag needs to load + if { $imgName ne [info commands $imgName] && [string range $imgName 0 3] eq "flag" } { + set imgName [getFlagImage [string range $imgName [expr [string length $imgName] - 3] end] yes] + } + set winName $w.$imgName + while {[winfo exists $winName]} { append winName a } + ttk::label $winName -image $imgName -relief flat -borderwidth 0 -background white + $w window create end -window $winName +} +proc ::htext::button_tag {w tagName} { + set idx [ string first "-command" $tagName] + set cmd "" + if {$idx == -1} { + set imgName [string range $tagName 7 end] + } else { + set imgName [string trim [string range $tagName 7 [expr $idx -1]]] + set cmd [ string range $tagName [expr $idx +9] end ] + } + set winName $w.$imgName + while {[winfo exists $winName]} { append winName a } + ttk::button $winName -image $imgName -command $cmd + $w window create end -window $winName +} +proc ::htext::window_tag {w tagName} { + set winName [string range $tagName 7 end] + $w window create end -window $winName +} proc ::htext::h1_tag {w tagName} { $w insert end "\n" return { "h1" "h1" } @@ -479,34 +508,12 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { } # Check if it is an image or button tag: - if {[strIsPrefix "img " $tagName]} { - set imgName [string range $tagName 4 end] - #flags are not loaded on start, so check if a flag needs to load - if { $imgName ne [info commands $imgName] && [string range $imgName 0 3] eq "flag" } { - set imgName [getFlagImage [string range $imgName [expr [string length $imgName] - 3] end] yes] - } - set winName $w.$imgName - while {[winfo exists $winName]} { append winName a } - ttk::label $winName -image $imgName -relief flat -borderwidth 0 -background white - $w window create end -window $winName - } - if {[strIsPrefix "button " $tagName]} { - set idx [ string first "-command" $tagName] - set cmd "" - if {$idx == -1} { - set imgName [string range $tagName 7 end] - } else { - set imgName [string trim [string range $tagName 7 [expr $idx -1]]] - set cmd [ string range $tagName [expr $idx +9] end ] - } - set winName $w.$imgName - while {[winfo exists $winName]} { append winName a } - ttk::button $winName -image $imgName -command $cmd - $w window create end -window $winName - } - if {[strIsPrefix "window " $tagName]} { - set winName [string range $tagName 7 end] - $w window create end -window $winName + set tagList { "img " img_tag "button " button_tag "window " window_tag } + foreach {tag proc} $tagList { + if {[strIsPrefix $tag $tagName]} { + $proc $w $tagName + break + } } # Now eliminate the processed text from the string: From 51dee00ce3c3026a5b8cf36466c3e25355ccd050 Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 4 Jan 2025 22:28:03 +0100 Subject: [PATCH 03/22] Code reduced --- tcl/htext.tcl | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index e98355d1..11fc1802 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -447,7 +447,6 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { # Check if it is a starting tag (no "/" at the start): set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag "h1" h1_tag } - if {![strIsPrefix "/" $tagName]} { set found 0 foreach {tag proc} $tagList { @@ -474,9 +473,8 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { # Get rid of initial "/" character: set tagName [string range $tagName 1 end] switch -- $tagName { - h1 - h2 - h3 - h4 - h5 {$w insert end "\n"} + h1 - h2 - h3 - h4 - h5 - p {$w insert end "\n"} } - if {$tagName == "p"} {$w insert end "\n"} if {$tagName == "menu"} {$w insert end "\]"} if {$tagName == "ul"} { incr helpWin(Indent) -4 @@ -495,12 +493,10 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { $w insert end " " } } - p {$w insert end "\n"} - br {$w insert end "\n"} q {$w insert end "\""} lt {$w insert end "<"} gt {$w insert end ">"} - h2 - h3 - h4 - h5 {$w insert end "\n"} + h2 - h3 - h4 - h5 - p - br {$w insert end "\n"} } #Set the start index for this type of tag: set startIndex($tagName) [$w index insert] From d4363e08fbfe42c8ed61678ef91e746b1dec399d Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 4 Jan 2025 23:10:22 +0100 Subject: [PATCH 04/22] code optimized --- tcl/htext.tcl | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 11fc1802..4738371a 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -418,7 +418,6 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { set ::htext::interrupt 0 $w mark set insert 0.0 $w configure -state normal - set linkName "" set count 0 set str $helptext if {$fixed} { @@ -448,16 +447,13 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { # Check if it is a starting tag (no "/" at the start): set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag "h1" h1_tag } if {![strIsPrefix "/" $tagName]} { - set found 0 + set fullTag($tagName) $tagName foreach {tag proc} $tagList { if {[strIsPrefix $tag $tagName]} { - lassign [$proc $w $tagName] tagName help - set fullTag($tagName) $help - set found 1 + lassign [$proc $w $tagName] tagName fullTag($tagName) break } } - if { ! $found } { set fullTag($tagName) $tagName } } # Now insert the text up to the formatting tag: @@ -503,7 +499,7 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { if {$tagName == "menu"} {$w insert end "\["} } - # Check if it is an image or button tag: + # Check if it is an image, window or button tag: set tagList { "img " img_tag "button " button_tag "window " window_tag } foreach {tag proc} $tagList { if {[strIsPrefix $tag $tagName]} { From d0f3ea0d7cd2030fd2044f2c154bc8516bc1dd3c Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 4 Jan 2025 23:13:37 +0100 Subject: [PATCH 05/22] Show a board in pgn window at the position where NAG "D" or in comment "[#]" is used --- tcl/htext.tcl | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 4738371a..64db1969 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -406,6 +406,18 @@ proc ::htext::window_tag {w tagName} { set winName [string range $tagName 7 end] $w window create end -window $winName } +proc ::htext::insertBoard {w move} { + ::board::new $w.bd$move 25 + set offSet [sc_pos pgnOffset] + sc_move pgn [string range $move 2 end] + set bd [sc_pos board] + sc_move pgn $offSet + if {[::board::isFlipped .main.board]} {set bd [string reverse [lindex $bd 0]]} + ::board::update $w.bd$move $bd + $w insert end "\n\n\t\t" + $w window create end -window $w.bd$move + $w insert end "\n\n" +} proc ::htext::h1_tag {w tagName} { $w insert end "\n" return { "h1" "h1" } @@ -457,8 +469,14 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { } # Now insert the text up to the formatting tag: - $w insert end [string range $str 0 [expr {$startPos - 1}]] + set text [string range $str 0 [expr {$startPos - 1}]] + $w insert end $text + #check for Diagramm in NAG D or in comment [#] + if { [info exists fullTag(m)] && ([strIsPrefix "/nag" $tagName] && [string first " D" $text] >= 0) || + ([strIsPrefix "/c" $tagName] && [string first "\[#\]" $text] >= 0 )} { + insertBoard $w $fullTag(m) + } # Check if it is a name tag matching the section we want: if {$section != "" && [strIsPrefix "name " $tagName]} { set sect [string range $tagName 5 end] From 8f85cab15d1a03882cf0bd0eee43eab10af6d91f Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 4 Jan 2025 23:21:38 +0100 Subject: [PATCH 06/22] h1 Tag optimized --- tcl/htext.tcl | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 64db1969..91bfeec6 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -418,10 +418,6 @@ proc ::htext::insertBoard {w move} { $w window create end -window $w.bd$move $w insert end "\n\n" } -proc ::htext::h1_tag {w tagName} { - $w insert end "\n" - return { "h1" "h1" } -} proc ::htext::display {w helptext {section ""} {fixed 1}} { global helpWin @@ -457,7 +453,7 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { set tagName [string range $str [expr {$startPos + 1}] [expr {$endPos - 1}]] # Check if it is a starting tag (no "/" at the start): - set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag "h1" h1_tag } + set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag } if {![strIsPrefix "/" $tagName]} { set fullTag($tagName) $tagName foreach {tag proc} $tagList { @@ -510,7 +506,7 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { q {$w insert end "\""} lt {$w insert end "<"} gt {$w insert end ">"} - h2 - h3 - h4 - h5 - p - br {$w insert end "\n"} + h1 - h2 - h3 - h4 - h5 - p - br {$w insert end "\n"} } #Set the start index for this type of tag: set startIndex($tagName) [$w index insert] From 384004e32ae7b7ced5691e2fd437f36d428edeaa Mon Sep 17 00:00:00 2001 From: Uwe Date: Sun, 5 Jan 2025 09:55:08 +0100 Subject: [PATCH 07/22] hide/show variations with [-] / [+] --- tcl/game.tcl | 2 +- tcl/htext.tcl | 73 ++++++++++++++++++++++++++++++++++++++++----- tcl/windows/pgn.tcl | 2 ++ 3 files changed, 68 insertions(+), 9 deletions(-) diff --git a/tcl/game.tcl b/tcl/game.tcl index b1d07322..d499bc54 100644 --- a/tcl/game.tcl +++ b/tcl/game.tcl @@ -353,7 +353,7 @@ namespace eval ::notify { # Invoke all the function that don't care about the current position but want # to be notified when the game text (tags, comments, notation) has changed. proc privGameTextChanged {} { - ::pgn::Refresh 1 + ::pgn::Refresh 2 ::tools::graphs::score::Refresh 0 } diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 91bfeec6..b8167b78 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -212,12 +212,7 @@ proc ::htext::init {w} { $w tag configure menu -font font_Bold -foreground $cyan # PGN-window-specific tags: - $w tag configure var -font font_Regular - $w tag configure nag -font font_Regular - if { $::pgnColor(Var) ne "" } { - $w tag configure var -foreground $::pgnColor(Var) - } - $w tag configure nag -foreground $::pgnColor(Nag) + $w tag configure nag -font font_Regular -foreground $::pgnColor(Nag) set lmargin 0 for {set i 1} {$i <= 19} {incr i} { @@ -418,6 +413,63 @@ proc ::htext::insertBoard {w move} { $w window create end -window $w.bd$move $w insert end "\n\n" } +proc ::htext::var_tag {w tagName varIndex hideVar} { + #insert toggle token [+] or [-] for show/hide the variation + if { [ lsearch [$w tag names] hvar$varIndex] != -1 } { + set hideVar [$w tag cget hvar$varIndex -elide] + } + set start [$w index insert] + if { $hideVar } { + $w insert end " \[+\] " + } else { + $w insert end " \[-\] " + } + set end [$w index insert] + $w tag configure hvar$varIndex -elide $hideVar -font font_Regular -foreground $::pgnColor(Var) + $w tag configure toggle$varIndex -font font_Regular -foreground $::pgnColor(Var) + $w tag bind toggle$varIndex "::htext::toggleHideVar $w $varIndex" + $w tag add toggle$varIndex $start $end + return [list var hvar$varIndex [expr {$varIndex+1}]] +} +#when new game is loaded delete all tags with hvarN +proc ::htext::deleteToggleVar { w } { + foreach i [ lsearch -all -inline [$w tag names] hvar* ] { + $w tag delete $i + } +} + +#make sure a variation is shown when a move from variation is on the board +proc ::htext::showVar { w pos } { + set tag [lsearch -inline [$w tag names $pos] hvar*] + if { $tag ne "" } { + ::htext::toggleHideVar $w [string range $tag 4 end] 0 + } +} + +#reset status for hide/show on all variations according hideVar +proc ::htext::resetToggleVar { w hideVar} { + foreach i [ lsearch -all -inline [$w tag names] hvar* ] { + toggleHideVar $w [string range $i 4 end] $hideVar + } +} + +#toggle status of hide/show of a variation or set it to hv +proc ::htext::toggleHideVar { w n {hv ""}} { + lassign [$w tag nextrange toggle$n 1.0] start end + if { $hv eq "" } { + set hv [expr - [$w tag cget hvar$n -elide] + 1 ]; + } + $w tag configure hvar$n -elide $hv + $w configure -state normal + if { $hv } { + $w replace $start $end " \[+\] " + } else { + $w replace $start $end " \[-\] " + } + $w tag configure hvar$n -elide $hv + $w tag add toggle$n $start $end + $w configure -state disabled +} proc ::htext::display {w helptext {section ""} {fixed 1}} { global helpWin @@ -427,6 +479,8 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { $w mark set insert 0.0 $w configure -state normal set count 0 + set hideVar 0 ;#$::pgn::hideVar + set varIndex 0 set str $helptext if {$fixed} { regsub -all "\n\n" $str "

" str @@ -453,12 +507,15 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { set tagName [string range $str [expr {$startPos + 1}] [expr {$endPos - 1}]] # Check if it is a starting tag (no "/" at the start): - set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag } + set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag "var" var_tag } if {![strIsPrefix "/" $tagName]} { set fullTag($tagName) $tagName foreach {tag proc} $tagList { if {[strIsPrefix $tag $tagName]} { - lassign [$proc $w $tagName] tagName fullTag($tagName) + switch $tag { + var { lassign [$proc $w $tagName $varIndex $hideVar] tagName fullTag($tagName) varIndex } + default { lassign [$proc $w $tagName] tagName fullTag($tagName) } + } break } } diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl index f345681b..91a0c827 100644 --- a/tcl/windows/pgn.tcl +++ b/tcl/windows/pgn.tcl @@ -289,6 +289,7 @@ namespace eval pgn { proc Refresh { {pgnNeedsUpdate 0} } { if {![winfo exists .pgnWin]} { return } + if {$pgnNeedsUpdate == 2 } { ::htext::deleteToggleVar .pgnWin.text } if {$pgnNeedsUpdate} { busyCursor . set format plain @@ -331,6 +332,7 @@ namespace eval pgn { .pgnWin.text tag remove Current 1.0 end set moveRange [.pgnWin.text tag nextrange "m_$offset" 1.0] if {[llength $moveRange] == 2} { + ::htext::showVar .pgnWin.text [lindex $moveRange 0] .pgnWin.text tag add Current [lindex $moveRange 0] [lindex $moveRange 1] .pgnWin.text see [lindex $moveRange 1] } else { From 0ef7ab6166d3afcc86047c42e6b0a8286b41bc8f Mon Sep 17 00:00:00 2001 From: Uwe Date: Sun, 5 Jan 2025 12:54:47 +0100 Subject: [PATCH 08/22] Add save options for hideVar and showDiagramm --- tcl/htext.tcl | 17 ++++++++++------- tcl/options.tcl | 4 +++- tcl/windows/pgn.tcl | 7 +++++++ 3 files changed, 20 insertions(+), 8 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index b8167b78..2766cb73 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -212,6 +212,7 @@ proc ::htext::init {w} { $w tag configure menu -font font_Bold -foreground $cyan # PGN-window-specific tags: + $w tag configure var -font font_Regular -foreground $::pgnColor(Var) $w tag configure nag -font font_Regular -foreground $::pgnColor(Nag) set lmargin 0 @@ -413,9 +414,11 @@ proc ::htext::insertBoard {w move} { $w window create end -window $w.bd$move $w insert end "\n\n" } -proc ::htext::var_tag {w tagName varIndex hideVar} { - #insert toggle token [+] or [-] for show/hide the variation +#insert toggle token [+] or [-] for show/hide the variation +proc ::htext::var_tag {w tagName varIndex} { + set hideVar $::pgn::hideVar if { [ lsearch [$w tag names] hvar$varIndex] != -1 } { + #if tag exists then use it set hideVar [$w tag cget hvar$varIndex -elide] } set start [$w index insert] @@ -425,7 +428,7 @@ proc ::htext::var_tag {w tagName varIndex hideVar} { $w insert end " \[-\] " } set end [$w index insert] - $w tag configure hvar$varIndex -elide $hideVar -font font_Regular -foreground $::pgnColor(Var) + $w tag configure hvar$varIndex -elide $hideVar $w tag configure toggle$varIndex -font font_Regular -foreground $::pgnColor(Var) $w tag bind toggle$varIndex "::htext::toggleHideVar $w $varIndex" $w tag add toggle$varIndex $start $end @@ -479,7 +482,6 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { $w mark set insert 0.0 $w configure -state normal set count 0 - set hideVar 0 ;#$::pgn::hideVar set varIndex 0 set str $helptext if {$fixed} { @@ -513,7 +515,7 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { foreach {tag proc} $tagList { if {[strIsPrefix $tag $tagName]} { switch $tag { - var { lassign [$proc $w $tagName $varIndex $hideVar] tagName fullTag($tagName) varIndex } + var { lassign [$proc $w $tagName $varIndex] tagName fullTag($tagName) varIndex } default { lassign [$proc $w $tagName] tagName fullTag($tagName) } } break @@ -526,8 +528,8 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { $w insert end $text #check for Diagramm in NAG D or in comment [#] - if { [info exists fullTag(m)] && ([strIsPrefix "/nag" $tagName] && [string first " D" $text] >= 0) || - ([strIsPrefix "/c" $tagName] && [string first "\[#\]" $text] >= 0 )} { + if { $::pgn::showDiagramm && [info exists fullTag(m)] && (([strIsPrefix "/nag" $tagName] && [string first " D" $text] >= 0) || + ([strIsPrefix "/c" $tagName] && [string first "\[#\]" $text] >= 0 ))} { insertBoard $w $fullTag(m) } # Check if it is a name tag matching the section we want: @@ -549,6 +551,7 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { } if {[info exists startIndex($tagName)]} { $w tag add $fullTag($tagName) $startIndex($tagName) [$w index insert] + if { $tagName == "var" } {$w tag add var $startIndex($tagName) [$w index insert] } unset startIndex($tagName) } } else { diff --git a/tcl/options.tcl b/tcl/options.tcl index 10256342..af8ee264 100644 --- a/tcl/options.tcl +++ b/tcl/options.tcl @@ -279,6 +279,8 @@ set ::pgn::columnFormat 0 set ::pgn::stripMarks 0 set ::pgn::showPhoto 1 set ::pgn::figurine 0 +set ::pgn::hideVar 0 +set ::pgn::showDiagramm 0 set pgnColor(Var) "" set pgnColor(Nag) {#cf6403} set pgnColor(Comment) {#008b00} @@ -630,7 +632,7 @@ proc options.write {} { puts $optionF "" foreach i {boardSize boardStyle language ::pgn::showColor \ ::pgn::indentVars ::pgn::indentComments ::pgn::showPhoto \ - ::pgn::shortHeader ::pgn::boldMainLine ::pgn::stripMarks ::pgn::figurine \ + ::pgn::shortHeader ::pgn::boldMainLine ::pgn::stripMarks ::pgn::figurine ::pgn::hideVar ::pgn::showDiagramm \ ::pgn::symbolicNags ::pgn::moveNumberSpaces ::pgn::columnFormat \ tree(order) optionsAutoSave ::tree::mask::recentMask \ ecoFile suggestMoves showVarPopup showVarArrows \ diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl index 91a0c827..df1b61b5 100644 --- a/tcl/windows/pgn.tcl +++ b/tcl/windows/pgn.tcl @@ -111,6 +111,9 @@ namespace eval pgn { -variable ::pgn::showPhoto -command {::pgn::Refresh 1} #ToDo: translate label + $w.menu.opt add checkbutton -label "Hide variations" \ + -variable ::pgn::hideVar -command {::htext::resetToggleVar .pgnWin.text $::pgn::hideVar} + $w.menu.opt add checkbutton -label "Show Diagramm" -variable ::pgn::showDiagramm -command {::pgn::Refresh 1} $w.menu.opt add checkbutton -label "Notation Figurine" \ -variable ::pgn::figurine -command {::pgn::Refresh 1} $w.menu.color add command -label PgnColorAnno \ @@ -205,6 +208,10 @@ namespace eval pgn { $mctxt.evals2 add command -label "N" -command {::addNag N} $mctxt.evals2 add command -label "D" -command {::addNag D} + #TODO: translate + $mctxt add command -label "Hide all Variations" -command {::htext::resetToggleVar .pgnWin.text 1} + $mctxt add command -label "Show all Variations" -command {::htext::resetToggleVar .pgnWin.text 0} + $mctxt add separator $mctxt add command -label [tr EditDelete] -state $state -command "::pgn::deleteVar" $mctxt add command -label [tr EditFirst] -state $state -command "::pgn::firstVar" $mctxt add command -label [tr EditMain] -state $state -command "::pgn::mainVar" From 0646bf49fa695518fe3a7ceddf9d4168f31820a5 Mon Sep 17 00:00:00 2001 From: Uwe Date: Sun, 5 Jan 2025 14:11:19 +0100 Subject: [PATCH 09/22] code cleanup --- tcl/htext.tcl | 29 ++++++++--------------------- 1 file changed, 8 insertions(+), 21 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 2766cb73..d75c8138 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -309,9 +309,8 @@ proc ::htext::go_tag {w tagName} { $w configure -cursor {}" return [list go $goTag ] } -proc ::htext::pi_tag {w tagName} { +proc ::htext::pi_tag {w playerTag} { # Check if it is a player info tag: - set playerTag $tagName set playerName [string range $playerTag 3 end] $w tag configure "$playerTag" -foreground DodgerBlue3 $w tag bind "$playerTag" "::pinfo::playerInfo \"$playerName\"" @@ -325,9 +324,8 @@ proc ::htext::pi_tag {w tagName} { $w configure -cursor {}" return [list pi $playerTag ] } -proc ::htext::g_tag {w tagName} { +proc ::htext::g_tag {w gameTag} { # Check if it is a game-load tag: - set gameTag $tagName set gnum [string range $gameTag 2 end] set glCommand "::game::LoadMenu $w [sc_base current] $gnum %X %Y" $w tag bind $gameTag $glCommand @@ -343,13 +341,8 @@ proc ::htext::g_tag {w tagName} { $w configure -cursor {}" return [list g $gameTag ] } -proc ::htext::m_tag {w tagName} { +proc ::htext::m_tag {w moveTag} { # Check if it is a move tag: - set moveTag $tagName - ### TODO - ### Does not work for variations as the var-Tag appears before - ### the "sc_move pgn [string range $moveTag 2 end]; updateBoard" # Bind middle button to popup a PGN board: $w tag bind $moveTag "::pgn::ShowBoard .pgnWin.text $moveTag %X %Y" @@ -362,9 +355,8 @@ proc ::htext::m_tag {w tagName} { $w configure -cursor {}" return [list m $moveTag ] } -proc ::htext::c_tag {w tagName} { +proc ::htext::c_tag {w commentTag} { # Check if it is a comment tag: - set commentTag $tagName $w tag configure $commentTag -foreground $::pgnColor(Comment) -font font_Regular $w tag bind $commentTag "sc_move pgn [string range $commentTag 2 end]; updateBoard; ::makeCommentWin" $w tag bind $commentTag "$w tag configure $commentTag -underline 1 @@ -474,7 +466,7 @@ proc ::htext::toggleHideVar { w n {hv ""}} { $w configure -state disabled } -proc ::htext::display {w helptext {section ""} {fixed 1}} { +proc ::htext::display {w str {section ""} {fixed 1}} { global helpWin # set start [clock clicks -milli] set helpWin(Indent) 0 @@ -483,7 +475,6 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { $w configure -state normal set count 0 set varIndex 0 - set str $helptext if {$fixed} { regsub -all "\n\n" $str "

" str regsub -all "\n" $str " " str @@ -492,7 +483,6 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { regsub -all ">\[ \n\]+" $str "> " str regsub -all "\[ \n\]+<" $str " <" str } - set tagType "" set seePoint "" if {! [info exists ::htext::updates($w)]} { @@ -542,13 +532,10 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { # Get rid of initial "/" character: set tagName [string range $tagName 1 end] switch -- $tagName { + menu {$w insert end "\]"} + ul {incr helpWin(Indent) -4; $w insert end "\n"} h1 - h2 - h3 - h4 - h5 - p {$w insert end "\n"} } - if {$tagName == "menu"} {$w insert end "\]"} - if {$tagName == "ul"} { - incr helpWin(Indent) -4 - $w insert end "\n" - } if {[info exists startIndex($tagName)]} { $w tag add $fullTag($tagName) $startIndex($tagName) [$w index insert] if { $tagName == "var" } {$w tag add var $startIndex($tagName) [$w index insert] } @@ -566,11 +553,11 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} { q {$w insert end "\""} lt {$w insert end "<"} gt {$w insert end ">"} + menu {$w insert end "\["} h1 - h2 - h3 - h4 - h5 - p - br {$w insert end "\n"} } #Set the start index for this type of tag: set startIndex($tagName) [$w index insert] - if {$tagName == "menu"} {$w insert end "\["} } # Check if it is an image, window or button tag: From ce58894d74c58b9b6992548e948a9b839fcdfa01 Mon Sep 17 00:00:00 2001 From: Uwe Date: Sun, 5 Jan 2025 15:47:19 +0100 Subject: [PATCH 10/22] add comments and rename some variables and procs --- tcl/htext.tcl | 79 ++++++++++++++++++++++++++++----------------------- 1 file changed, 44 insertions(+), 35 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index d75c8138..1abe718a 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -250,7 +250,8 @@ proc ::htext::extractSectionName {tagName} { set ::htext::interrupt 0 -proc ::htext::a_tag {w tagName} { +# Process a link tag +proc ::htext::aTagProcess {w tagName} { set linkName [::htext::extractLinkName $tagName] set sectionName [::htext::extractSectionName $tagName] set linkTag "link ${linkName} ${sectionName}" @@ -265,7 +266,8 @@ proc ::htext::a_tag {w tagName} { $w configure -cursor {}" return [list a $linkTag ] } -proc ::htext::url_tag {w tagName} { +# Process a url tag +proc ::htext::urlTagProcess {w tagName} { set urlName [string range $tagName 4 end] set urlTag "url $urlName" $w tag configure "$urlTag" -foreground red -underline 1 @@ -278,8 +280,8 @@ proc ::htext::url_tag {w tagName} { $w configure -cursor {}" return [list url $urlTag ] } -proc ::htext::run_tag {w tagName} { - # Check if it is a Tcl command tag: +# Process a Tcl command tag: +proc ::htext::runTagProcess {w tagName} { set runName [string range $tagName 4 end] set runTag "run $runName" $w tag bind "$runTag" "catch {$runName}" @@ -293,7 +295,8 @@ proc ::htext::run_tag {w tagName} { $w configure -cursor {}" return [list run $runTag ] } -proc ::htext::go_tag {w tagName} { +# Process a goto tag +proc ::htext::goTagProcess {w tagName} { # Check if it is a goto tag: set goName [string range $tagName 3 end] set goTag "go $goName" @@ -309,8 +312,8 @@ proc ::htext::go_tag {w tagName} { $w configure -cursor {}" return [list go $goTag ] } -proc ::htext::pi_tag {w playerTag} { - # Check if it is a player info tag: +# Process a player info tag +proc ::htext::piTagProcess {w playerTag} { set playerName [string range $playerTag 3 end] $w tag configure "$playerTag" -foreground DodgerBlue3 $w tag bind "$playerTag" "::pinfo::playerInfo \"$playerName\"" @@ -324,8 +327,8 @@ proc ::htext::pi_tag {w playerTag} { $w configure -cursor {}" return [list pi $playerTag ] } -proc ::htext::g_tag {w gameTag} { - # Check if it is a game-load tag: +# Process a game-load tag +proc ::htext::gTagProcess {w gameTag} { set gnum [string range $gameTag 2 end] set glCommand "::game::LoadMenu $w [sc_base current] $gnum %X %Y" $w tag bind $gameTag $glCommand @@ -341,8 +344,8 @@ proc ::htext::g_tag {w gameTag} { $w configure -cursor {}" return [list g $gameTag ] } -proc ::htext::m_tag {w moveTag} { - # Check if it is a move tag: +# Process a move tag +proc ::htext::mTagProcess {w moveTag} { $w tag bind $moveTag "sc_move pgn [string range $moveTag 2 end]; updateBoard" # Bind middle button to popup a PGN board: $w tag bind $moveTag "::pgn::ShowBoard .pgnWin.text $moveTag %X %Y" @@ -355,8 +358,8 @@ proc ::htext::m_tag {w moveTag} { $w configure -cursor {}" return [list m $moveTag ] } -proc ::htext::c_tag {w commentTag} { - # Check if it is a comment tag: +# Process a comment tag +proc ::htext::cTagProcess {w commentTag} { $w tag configure $commentTag -foreground $::pgnColor(Comment) -font font_Regular $w tag bind $commentTag "sc_move pgn [string range $commentTag 2 end]; updateBoard; ::makeCommentWin" $w tag bind $commentTag "$w tag configure $commentTag -underline 1 @@ -365,7 +368,7 @@ proc ::htext::c_tag {w commentTag} { $w configure -cursor {}" return [list c $commentTag ] } -proc ::htext::img_tag {w tagName} { +proc ::htext::imgTagProcess {w tagName} { set imgName [string range $tagName 4 end] #flags are not loaded on start, so check if a flag needs to load if { $imgName ne [info commands $imgName] && [string range $imgName 0 3] eq "flag" } { @@ -376,7 +379,7 @@ proc ::htext::img_tag {w tagName} { ttk::label $winName -image $imgName -relief flat -borderwidth 0 -background white $w window create end -window $winName } -proc ::htext::button_tag {w tagName} { +proc ::htext::buttonTagProcess {w tagName} { set idx [ string first "-command" $tagName] set cmd "" if {$idx == -1} { @@ -390,24 +393,25 @@ proc ::htext::button_tag {w tagName} { ttk::button $winName -image $imgName -command $cmd $w window create end -window $winName } -proc ::htext::window_tag {w tagName} { +proc ::htext::windowTagProcess {w tagName} { set winName [string range $tagName 7 end] $w window create end -window $winName } -proc ::htext::insertBoard {w move} { - ::board::new $w.bd$move 25 +#insert a board diagramm after movenr +proc ::htext::insertBoard {w movenr} { + ::board::new $w.bd$movenr 25 set offSet [sc_pos pgnOffset] - sc_move pgn [string range $move 2 end] + sc_move pgn $movenr set bd [sc_pos board] sc_move pgn $offSet if {[::board::isFlipped .main.board]} {set bd [string reverse [lindex $bd 0]]} - ::board::update $w.bd$move $bd + ::board::update $w.bd$movenr $bd $w insert end "\n\n\t\t" - $w window create end -window $w.bd$move + $w window create end -window $w.bd$movenr $w insert end "\n\n" } #insert toggle token [+] or [-] for show/hide the variation -proc ::htext::var_tag {w tagName varIndex} { +proc ::htext::varTagProcess {w tagName varIndex} { set hideVar $::pgn::hideVar if { [ lsearch [$w tag names] hvar$varIndex] != -1 } { #if tag exists then use it @@ -426,6 +430,8 @@ proc ::htext::var_tag {w tagName varIndex} { $w tag add toggle$varIndex $start $end return [list var hvar$varIndex [expr {$varIndex+1}]] } + +#Helper procs for show/hide variation #when new game is loaded delete all tags with hvarN proc ::htext::deleteToggleVar { w } { foreach i [ lsearch -all -inline [$w tag names] hvar* ] { @@ -498,19 +504,20 @@ proc ::htext::display {w str {section ""} {fixed 1}} { set tagName [string range $str [expr {$startPos + 1}] [expr {$endPos - 1}]] - # Check if it is a starting tag (no "/" at the start): - set tagList { "a " a_tag "url " url_tag "run " run_tag "go " go_tag "pi " pi_tag "g_" g_tag "m_" m_tag "c_" c_tag "var" var_tag } + # Check if it is a starting tag (no "/" at the start) and process the tag: + set tagList { "a" aTagProcess "url" urlTagProcess "run" runTagProcess "go" goTagProcess "pi" piTagProcess "g_" gTagProcess + "m_" mTagProcess "c_" cTagProcess "var" varTagProcess } if {![strIsPrefix "/" $tagName]} { - set fullTag($tagName) $tagName - foreach {tag proc} $tagList { - if {[strIsPrefix $tag $tagName]} { - switch $tag { - var { lassign [$proc $w $tagName $varIndex] tagName fullTag($tagName) varIndex } - default { lassign [$proc $w $tagName] tagName fullTag($tagName) } - } - break - } + set fullTag($tagName) $tagName + foreach {tag proc} $tagList { + if {[strIsPrefix $tag $tagName]} { + switch $tag { + var { lassign [$proc $w $tagName $varIndex] tagName fullTag($tagName) varIndex } + default { lassign [$proc $w $tagName] tagName fullTag($tagName) } + } + break } + } } # Now insert the text up to the formatting tag: @@ -520,7 +527,8 @@ proc ::htext::display {w str {section ""} {fixed 1}} { #check for Diagramm in NAG D or in comment [#] if { $::pgn::showDiagramm && [info exists fullTag(m)] && (([strIsPrefix "/nag" $tagName] && [string first " D" $text] >= 0) || ([strIsPrefix "/c" $tagName] && [string first "\[#\]" $text] >= 0 ))} { - insertBoard $w $fullTag(m) + # fullTag(m) has the movenumber of the last processed move + insertBoard $w [string range $fullTag(m) 2 end] } # Check if it is a name tag matching the section we want: if {$section != "" && [strIsPrefix "name " $tagName]} { @@ -538,6 +546,7 @@ proc ::htext::display {w str {section ""} {fixed 1}} { } if {[info exists startIndex($tagName)]} { $w tag add $fullTag($tagName) $startIndex($tagName) [$w index insert] + # var tag needs two tags one (hvarN) for hiding (line above) and one (var) for coloring (line below) if { $tagName == "var" } {$w tag add var $startIndex($tagName) [$w index insert] } unset startIndex($tagName) } @@ -561,7 +570,7 @@ proc ::htext::display {w str {section ""} {fixed 1}} { } # Check if it is an image, window or button tag: - set tagList { "img " img_tag "button " button_tag "window " window_tag } + set tagList { "img " imgTagProcess "button " buttonTagProcess "window " windowTagProcess } foreach {tag proc} $tagList { if {[strIsPrefix $tag $tagName]} { $proc $w $tagName From 329583a6a24dc022a6ab87ea6142c89ba568f5d3 Mon Sep 17 00:00:00 2001 From: Uwe Date: Tue, 7 Jan 2025 21:28:11 +0100 Subject: [PATCH 11/22] Handle insert and delete of variations --- tcl/game.tcl | 2 +- tcl/htext.tcl | 32 +++++++++++++++++++++++++++++--- tcl/windows/pgn.tcl | 3 ++- 3 files changed, 32 insertions(+), 5 deletions(-) diff --git a/tcl/game.tcl b/tcl/game.tcl index d499bc54..b1d07322 100644 --- a/tcl/game.tcl +++ b/tcl/game.tcl @@ -353,7 +353,7 @@ namespace eval ::notify { # Invoke all the function that don't care about the current position but want # to be notified when the game text (tags, comments, notation) has changed. proc privGameTextChanged {} { - ::pgn::Refresh 2 + ::pgn::Refresh 1 ::tools::graphs::score::Refresh 0 } diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 1abe718a..30f4f42f 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -30,6 +30,8 @@ proc help_PushStack {name {heading ""}} { } set ::htext::headingColor "\#990000" +set ::htext::amountVar 0 +set ::htext::hideVarValue {} array set ::htext:updates {} proc help_PopStack {} { @@ -410,14 +412,33 @@ proc ::htext::insertBoard {w movenr} { $w window create end -window $w.bd$movenr $w insert end "\n\n" } +#calc number of variations in pgn string to check if number has changed +proc ::htext::countVar {str} { + set count [regsub -all "" $str {} stripped] + set ::htext::varChanged [expr $count - $::htext::amountVar] + set ::htext::amountVar $count +} #insert toggle token [+] or [-] for show/hide the variation proc ::htext::varTagProcess {w tagName varIndex} { set hideVar $::pgn::hideVar - if { [ lsearch [$w tag names] hvar$varIndex] != -1 } { + set start [$w index insert] + set pos [$w count -chars 0.0 $start] + if {[llength $::htext::hideVarValue] > $varIndex } { #if tag exists then use it - set hideVar [$w tag cget hvar$varIndex -elide] + if { $::htext::varChanged != 0 } { + # number of variations has changed, ajust the values + if { $::htext::varChanged > 0 && $pos ne $::htext::pos($varIndex)} { + # a variation was inserted + set ::htext::hideVarValue [linsert $::htext::hideVarValue $varIndex $::pgn::hideVar] + set ::htext::varChanged 0 + } elseif { $::htext::varChanged < 0 && $pos ne $::htext::pos($varIndex)} { + # a variation was deleted + set ::htext::hideVarValue [lreplace $::htext::hideVarValue $varIndex $varIndex] + set ::htext::varChanged 0 + } + } + set hideVar [lindex $::htext::hideVarValue $varIndex] } - set start [$w index insert] if { $hideVar } { $w insert end " \[+\] " } else { @@ -428,6 +449,8 @@ proc ::htext::varTagProcess {w tagName varIndex} { $w tag configure toggle$varIndex -font font_Regular -foreground $::pgnColor(Var) $w tag bind toggle$varIndex "::htext::toggleHideVar $w $varIndex" $w tag add toggle$varIndex $start $end + set ::htext::pos($varIndex) $pos + set ::htext::hideVarValue [lreplace $::htext::hideVarValue $varIndex $varIndex $hideVar] return [list var hvar$varIndex [expr {$varIndex+1}]] } @@ -437,6 +460,8 @@ proc ::htext::deleteToggleVar { w } { foreach i [ lsearch -all -inline [$w tag names] hvar* ] { $w tag delete $i } + set ::htext::amountVar 0 + set ::htext::hideVarValue { } } #make sure a variation is shown when a move from variation is on the board @@ -470,6 +495,7 @@ proc ::htext::toggleHideVar { w n {hv ""}} { $w tag configure hvar$n -elide $hv $w tag add toggle$n $start $end $w configure -state disabled + set ::htext::hideVarValue [lreplace $::htext::hideVarValue $n $n $hv] } proc ::htext::display {w str {section ""} {fixed 1}} { diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl index df1b61b5..6cddd37f 100644 --- a/tcl/windows/pgn.tcl +++ b/tcl/windows/pgn.tcl @@ -141,6 +141,7 @@ namespace eval pgn { grid columnconfigure $w 0 -weight 1 set pgnWin 1 + bind $w <> "::htext::deleteToggleVar .pgnWin.text" bind $w { set pgnWin 0 } # Take input focus even if -state is disabled @@ -296,7 +297,6 @@ namespace eval pgn { proc Refresh { {pgnNeedsUpdate 0} } { if {![winfo exists .pgnWin]} { return } - if {$pgnNeedsUpdate == 2 } { ::htext::deleteToggleVar .pgnWin.text } if {$pgnNeedsUpdate} { busyCursor . set format plain @@ -312,6 +312,7 @@ namespace eval pgn { .pgnWin.text delete 1.0 end if {$::pgn::showColor} { + ::htext::countVar $pgnStr ::htext::display .pgnWin.text $pgnStr } else { .pgnWin.text insert 1.0 $pgnStr From 25af09f1c282c011356e640a268c24ca42887cb3 Mon Sep 17 00:00:00 2001 From: Uwe Date: Wed, 8 Jan 2025 17:41:02 +0100 Subject: [PATCH 12/22] old tag var not needed. rename hvar to var --- tcl/htext.tcl | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 30f4f42f..a5d038bc 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -214,7 +214,6 @@ proc ::htext::init {w} { $w tag configure menu -font font_Bold -foreground $cyan # PGN-window-specific tags: - $w tag configure var -font font_Regular -foreground $::pgnColor(Var) $w tag configure nag -font font_Regular -foreground $::pgnColor(Nag) set lmargin 0 @@ -445,19 +444,20 @@ proc ::htext::varTagProcess {w tagName varIndex} { $w insert end " \[-\] " } set end [$w index insert] - $w tag configure hvar$varIndex -elide $hideVar + $w tag configure var$varIndex -elide $hideVar -font font_Regular -foreground $::pgnColor(Var) + $w tag lower var$varIndex $w tag configure toggle$varIndex -font font_Regular -foreground $::pgnColor(Var) $w tag bind toggle$varIndex "::htext::toggleHideVar $w $varIndex" $w tag add toggle$varIndex $start $end set ::htext::pos($varIndex) $pos set ::htext::hideVarValue [lreplace $::htext::hideVarValue $varIndex $varIndex $hideVar] - return [list var hvar$varIndex [expr {$varIndex+1}]] + return [list var var$varIndex [expr {$varIndex+1}]] } #Helper procs for show/hide variation -#when new game is loaded delete all tags with hvarN +#when new game is loaded delete all tags with varN proc ::htext::deleteToggleVar { w } { - foreach i [ lsearch -all -inline [$w tag names] hvar* ] { + foreach i [ lsearch -all -inline [$w tag names] var* ] { $w tag delete $i } set ::htext::amountVar 0 @@ -466,16 +466,16 @@ proc ::htext::deleteToggleVar { w } { #make sure a variation is shown when a move from variation is on the board proc ::htext::showVar { w pos } { - set tag [lsearch -inline [$w tag names $pos] hvar*] + set tag [lsearch -inline [$w tag names $pos] var*] if { $tag ne "" } { - ::htext::toggleHideVar $w [string range $tag 4 end] 0 + ::htext::toggleHideVar $w [string range $tag 3 end] 0 } } #reset status for hide/show on all variations according hideVar proc ::htext::resetToggleVar { w hideVar} { - foreach i [ lsearch -all -inline [$w tag names] hvar* ] { - toggleHideVar $w [string range $i 4 end] $hideVar + foreach i [ lsearch -all -inline [$w tag names] var* ] { + toggleHideVar $w [string range $i 3 end] $hideVar } } @@ -483,16 +483,16 @@ proc ::htext::resetToggleVar { w hideVar} { proc ::htext::toggleHideVar { w n {hv ""}} { lassign [$w tag nextrange toggle$n 1.0] start end if { $hv eq "" } { - set hv [expr - [$w tag cget hvar$n -elide] + 1 ]; + set hv [expr - [$w tag cget var$n -elide] + 1 ]; } - $w tag configure hvar$n -elide $hv + $w tag configure var$n -elide $hv $w configure -state normal if { $hv } { $w replace $start $end " \[+\] " } else { $w replace $start $end " \[-\] " } - $w tag configure hvar$n -elide $hv + $w tag configure var$n -elide $hv $w tag add toggle$n $start $end $w configure -state disabled set ::htext::hideVarValue [lreplace $::htext::hideVarValue $n $n $hv] @@ -572,8 +572,6 @@ proc ::htext::display {w str {section ""} {fixed 1}} { } if {[info exists startIndex($tagName)]} { $w tag add $fullTag($tagName) $startIndex($tagName) [$w index insert] - # var tag needs two tags one (hvarN) for hiding (line above) and one (var) for coloring (line below) - if { $tagName == "var" } {$w tag add var $startIndex($tagName) [$w index insert] } unset startIndex($tagName) } } else { From c9b56f4834a8948326fbaabe7dba8b4f9e51d6f0 Mon Sep 17 00:00:00 2001 From: Uwe Date: Wed, 8 Jan 2025 18:44:05 +0100 Subject: [PATCH 13/22] The variables amountVar and hideVarValue were assigned to the calling window. --- tcl/htext.tcl | 38 +++++++++++++++++++++----------------- tcl/windows/pgn.tcl | 2 +- 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index a5d038bc..0dbe1e94 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -30,8 +30,8 @@ proc help_PushStack {name {heading ""}} { } set ::htext::headingColor "\#990000" -set ::htext::amountVar 0 -set ::htext::hideVarValue {} +array set ::htext::amountVar {} +array set ::htext::hideVarValue {} array set ::htext:updates {} proc help_PopStack {} { @@ -168,6 +168,8 @@ proc ::htext::init {w} { set green "green" set ::htext::updates($w) 100 + set ::htext::amountVar($w) 0 + set ::htext::hideVarValue($w) {} $w tag configure black -foreground black $w tag configure white -foreground white $w tag configure red -foreground red @@ -412,31 +414,31 @@ proc ::htext::insertBoard {w movenr} { $w insert end "\n\n" } #calc number of variations in pgn string to check if number has changed -proc ::htext::countVar {str} { +proc ::htext::countVar {w str} { set count [regsub -all "" $str {} stripped] - set ::htext::varChanged [expr $count - $::htext::amountVar] - set ::htext::amountVar $count + set ::htext::varChanged [expr $count - $::htext::amountVar($w)] + set ::htext::amountVar($w) $count } #insert toggle token [+] or [-] for show/hide the variation proc ::htext::varTagProcess {w tagName varIndex} { set hideVar $::pgn::hideVar set start [$w index insert] set pos [$w count -chars 0.0 $start] - if {[llength $::htext::hideVarValue] > $varIndex } { + if {[llength $::htext::hideVarValue($w)] > $varIndex } { #if tag exists then use it if { $::htext::varChanged != 0 } { # number of variations has changed, ajust the values if { $::htext::varChanged > 0 && $pos ne $::htext::pos($varIndex)} { # a variation was inserted - set ::htext::hideVarValue [linsert $::htext::hideVarValue $varIndex $::pgn::hideVar] + set ::htext::hideVarValue($w) [linsert $::htext::hideVarValue($w) $varIndex $::pgn::hideVar] set ::htext::varChanged 0 } elseif { $::htext::varChanged < 0 && $pos ne $::htext::pos($varIndex)} { # a variation was deleted - set ::htext::hideVarValue [lreplace $::htext::hideVarValue $varIndex $varIndex] + set ::htext::hideVarValue($w) [lreplace $::htext::hideVarValue($w) $varIndex $varIndex] set ::htext::varChanged 0 } } - set hideVar [lindex $::htext::hideVarValue $varIndex] + set hideVar [lindex $::htext::hideVarValue($w) $varIndex] } if { $hideVar } { $w insert end " \[+\] " @@ -450,7 +452,7 @@ proc ::htext::varTagProcess {w tagName varIndex} { $w tag bind toggle$varIndex "::htext::toggleHideVar $w $varIndex" $w tag add toggle$varIndex $start $end set ::htext::pos($varIndex) $pos - set ::htext::hideVarValue [lreplace $::htext::hideVarValue $varIndex $varIndex $hideVar] + set ::htext::hideVarValue($w) [lreplace $::htext::hideVarValue($w) $varIndex $varIndex $hideVar] return [list var var$varIndex [expr {$varIndex+1}]] } @@ -460,22 +462,24 @@ proc ::htext::deleteToggleVar { w } { foreach i [ lsearch -all -inline [$w tag names] var* ] { $w tag delete $i } - set ::htext::amountVar 0 - set ::htext::hideVarValue { } + set ::htext::amountVar($w) 0 + set ::htext::hideVarValue($w) { } } #make sure a variation is shown when a move from variation is on the board proc ::htext::showVar { w pos } { set tag [lsearch -inline [$w tag names $pos] var*] - if { $tag ne "" } { - ::htext::toggleHideVar $w [string range $tag 3 end] 0 + if { $tag ne "" && [$w tag cget $tag -elide]} { + ::htext::toggleHideVar $w [string range $tag 3 end] } } #reset status for hide/show on all variations according hideVar proc ::htext::resetToggleVar { w hideVar} { - foreach i [ lsearch -all -inline [$w tag names] var* ] { - toggleHideVar $w [string range $i 3 end] $hideVar + set i [llength $::htext::hideVarValue($w)] + while { $i > 0 } { + incr i -1 + toggleHideVar $w $i $hideVar } } @@ -495,7 +499,7 @@ proc ::htext::toggleHideVar { w n {hv ""}} { $w tag configure var$n -elide $hv $w tag add toggle$n $start $end $w configure -state disabled - set ::htext::hideVarValue [lreplace $::htext::hideVarValue $n $n $hv] + set ::htext::hideVarValue($w) [lreplace $::htext::hideVarValue($w) $n $n $hv] } proc ::htext::display {w str {section ""} {fixed 1}} { diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl index 6cddd37f..86a366e7 100644 --- a/tcl/windows/pgn.tcl +++ b/tcl/windows/pgn.tcl @@ -312,7 +312,7 @@ namespace eval pgn { .pgnWin.text delete 1.0 end if {$::pgn::showColor} { - ::htext::countVar $pgnStr + ::htext::countVar .pgnWin.text $pgnStr ::htext::display .pgnWin.text $pgnStr } else { .pgnWin.text insert 1.0 $pgnStr From 84322d0adb85dc024ad37a8ca857e32661c906ef Mon Sep 17 00:00:00 2001 From: Uwe Date: Thu, 9 Jan 2025 18:07:07 +0100 Subject: [PATCH 14/22] Text changed "hide" to "fold" --- tcl/windows/pgn.tcl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl index 86a366e7..755e367d 100644 --- a/tcl/windows/pgn.tcl +++ b/tcl/windows/pgn.tcl @@ -111,9 +111,9 @@ namespace eval pgn { -variable ::pgn::showPhoto -command {::pgn::Refresh 1} #ToDo: translate label - $w.menu.opt add checkbutton -label "Hide variations" \ + $w.menu.opt add checkbutton -label "Fold Variations" \ -variable ::pgn::hideVar -command {::htext::resetToggleVar .pgnWin.text $::pgn::hideVar} - $w.menu.opt add checkbutton -label "Show Diagramm" -variable ::pgn::showDiagramm -command {::pgn::Refresh 1} + $w.menu.opt add checkbutton -label "Show Diagramms" -variable ::pgn::showDiagramm -command {::pgn::Refresh 1} $w.menu.opt add checkbutton -label "Notation Figurine" \ -variable ::pgn::figurine -command {::pgn::Refresh 1} $w.menu.color add command -label PgnColorAnno \ @@ -210,8 +210,8 @@ namespace eval pgn { $mctxt.evals2 add command -label "D" -command {::addNag D} #TODO: translate - $mctxt add command -label "Hide all Variations" -command {::htext::resetToggleVar .pgnWin.text 1} - $mctxt add command -label "Show all Variations" -command {::htext::resetToggleVar .pgnWin.text 0} + $mctxt add command -label "Fold all Variations" -command {::htext::resetToggleVar .pgnWin.text 1} + $mctxt add command -label "Unfold all Variations" -command {::htext::resetToggleVar .pgnWin.text 0} $mctxt add separator $mctxt add command -label [tr EditDelete] -state $state -command "::pgn::deleteVar" $mctxt add command -label [tr EditFirst] -state $state -command "::pgn::firstVar" From b3264db2631e1a4af4ed0953d6e1d50d492d1749 Mon Sep 17 00:00:00 2001 From: Uwe Date: Thu, 9 Jan 2025 18:41:06 +0100 Subject: [PATCH 15/22] adjust indentation --- tcl/htext.tcl | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 0dbe1e94..53628b2b 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -372,29 +372,29 @@ proc ::htext::cTagProcess {w commentTag} { return [list c $commentTag ] } proc ::htext::imgTagProcess {w tagName} { - set imgName [string range $tagName 4 end] - #flags are not loaded on start, so check if a flag needs to load - if { $imgName ne [info commands $imgName] && [string range $imgName 0 3] eq "flag" } { - set imgName [getFlagImage [string range $imgName [expr [string length $imgName] - 3] end] yes] - } - set winName $w.$imgName - while {[winfo exists $winName]} { append winName a } - ttk::label $winName -image $imgName -relief flat -borderwidth 0 -background white - $w window create end -window $winName + set imgName [string range $tagName 4 end] + #flags are not loaded on start, so check if a flag needs to load + if { $imgName ne [info commands $imgName] && [string range $imgName 0 3] eq "flag" } { + set imgName [getFlagImage [string range $imgName [expr [string length $imgName] - 3] end] yes] + } + set winName $w.$imgName + while {[winfo exists $winName]} { append winName a } + ttk::label $winName -image $imgName -relief flat -borderwidth 0 -background white + $w window create end -window $winName } proc ::htext::buttonTagProcess {w tagName} { set idx [ string first "-command" $tagName] - set cmd "" - if {$idx == -1} { - set imgName [string range $tagName 7 end] - } else { - set imgName [string trim [string range $tagName 7 [expr $idx -1]]] - set cmd [ string range $tagName [expr $idx +9] end ] - } - set winName $w.$imgName - while {[winfo exists $winName]} { append winName a } - ttk::button $winName -image $imgName -command $cmd - $w window create end -window $winName + set cmd "" + if {$idx == -1} { + set imgName [string range $tagName 7 end] + } else { + set imgName [string trim [string range $tagName 7 [expr $idx -1]]] + set cmd [ string range $tagName [expr $idx +9] end ] + } + set winName $w.$imgName + while {[winfo exists $winName]} { append winName a } + ttk::button $winName -image $imgName -command $cmd + $w window create end -window $winName } proc ::htext::windowTagProcess {w tagName} { set winName [string range $tagName 7 end] From b863f5c035eec2f05f6fdb341346d84e6d419eb1 Mon Sep 17 00:00:00 2001 From: Uwe Date: Fri, 10 Jan 2025 08:47:13 +0100 Subject: [PATCH 16/22] Process img, button and window tag same way as the other tags --- tcl/htext.tcl | 23 +++++++---------------- 1 file changed, 7 insertions(+), 16 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 53628b2b..f420ed19 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -534,14 +534,19 @@ proc ::htext::display {w str {section ""} {fixed 1}} { set tagName [string range $str [expr {$startPos + 1}] [expr {$endPos - 1}]] + # Now insert the text up to the formatting tag: + set text [string range $str 0 [expr {$startPos - 1}]] + $w insert end $text + # Check if it is a starting tag (no "/" at the start) and process the tag: set tagList { "a" aTagProcess "url" urlTagProcess "run" runTagProcess "go" goTagProcess "pi" piTagProcess "g_" gTagProcess - "m_" mTagProcess "c_" cTagProcess "var" varTagProcess } + "m_" mTagProcess "c_" cTagProcess "var" varTagProcess "img" imgTagProcess "button" buttonTagProcess "window" windowTagProcess } if {![strIsPrefix "/" $tagName]} { set fullTag($tagName) $tagName foreach {tag proc} $tagList { if {[strIsPrefix $tag $tagName]} { switch $tag { + img - button - window { $proc $w $tagName } var { lassign [$proc $w $tagName $varIndex] tagName fullTag($tagName) varIndex } default { lassign [$proc $w $tagName] tagName fullTag($tagName) } } @@ -550,10 +555,6 @@ proc ::htext::display {w str {section ""} {fixed 1}} { } } - # Now insert the text up to the formatting tag: - set text [string range $str 0 [expr {$startPos - 1}]] - $w insert end $text - #check for Diagramm in NAG D or in comment [#] if { $::pgn::showDiagramm && [info exists fullTag(m)] && (([strIsPrefix "/nag" $tagName] && [string first " D" $text] >= 0) || ([strIsPrefix "/c" $tagName] && [string first "\[#\]" $text] >= 0 ))} { @@ -596,16 +597,6 @@ proc ::htext::display {w str {section ""} {fixed 1}} { #Set the start index for this type of tag: set startIndex($tagName) [$w index insert] } - - # Check if it is an image, window or button tag: - set tagList { "img " imgTagProcess "button " buttonTagProcess "window " windowTagProcess } - foreach {tag proc} $tagList { - if {[strIsPrefix $tag $tagName]} { - $proc $w $tagName - break - } - } - # Now eliminate the processed text from the string: set str [string range $str [expr {$endPos + 1}] end] incr count @@ -615,7 +606,7 @@ proc ::htext::display {w str {section ""} {fixed 1}} { return } } - + # Now add any remaining text: if {! $::htext::interrupt} { $w insert end $str } From 54cd45bf0eca3f0d2c14aeaf768a1e1cb8a7c94b Mon Sep 17 00:00:00 2001 From: Uwe Date: Fri, 10 Jan 2025 16:29:57 +0100 Subject: [PATCH 17/22] remove varIndex from htext::display --- tcl/htext.tcl | 16 ++++++++-------- tcl/windows/pgn.tcl | 1 - 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index f420ed19..4be529ec 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -31,6 +31,7 @@ proc help_PushStack {name {heading ""}} { set ::htext::headingColor "\#990000" array set ::htext::amountVar {} +array set ::htext::varIndex {} array set ::htext::hideVarValue {} array set ::htext:updates {} @@ -415,12 +416,14 @@ proc ::htext::insertBoard {w movenr} { } #calc number of variations in pgn string to check if number has changed proc ::htext::countVar {w str} { + set ::htext::varIndex($w) 0 set count [regsub -all "" $str {} stripped] set ::htext::varChanged [expr $count - $::htext::amountVar($w)] set ::htext::amountVar($w) $count } #insert toggle token [+] or [-] for show/hide the variation -proc ::htext::varTagProcess {w tagName varIndex} { +proc ::htext::varTagProcess {w tagName} { + set varIndex $::htext::varIndex($w) set hideVar $::pgn::hideVar set start [$w index insert] set pos [$w count -chars 0.0 $start] @@ -453,7 +456,8 @@ proc ::htext::varTagProcess {w tagName varIndex} { $w tag add toggle$varIndex $start $end set ::htext::pos($varIndex) $pos set ::htext::hideVarValue($w) [lreplace $::htext::hideVarValue($w) $varIndex $varIndex $hideVar] - return [list var var$varIndex [expr {$varIndex+1}]] + incr ::htext::varIndex($w) + return [list var var$varIndex] } #Helper procs for show/hide variation @@ -510,7 +514,7 @@ proc ::htext::display {w str {section ""} {fixed 1}} { $w mark set insert 0.0 $w configure -state normal set count 0 - set varIndex 0 + ::htext::countVar $w $str if {$fixed} { regsub -all "\n\n" $str "

" str regsub -all "\n" $str " " str @@ -545,11 +549,7 @@ proc ::htext::display {w str {section ""} {fixed 1}} { set fullTag($tagName) $tagName foreach {tag proc} $tagList { if {[strIsPrefix $tag $tagName]} { - switch $tag { - img - button - window { $proc $w $tagName } - var { lassign [$proc $w $tagName $varIndex] tagName fullTag($tagName) varIndex } - default { lassign [$proc $w $tagName] tagName fullTag($tagName) } - } + lassign [$proc $w $tagName] tagName fullTag($tagName) break } } diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl index 755e367d..98ba76d7 100644 --- a/tcl/windows/pgn.tcl +++ b/tcl/windows/pgn.tcl @@ -312,7 +312,6 @@ namespace eval pgn { .pgnWin.text delete 1.0 end if {$::pgn::showColor} { - ::htext::countVar .pgnWin.text $pgnStr ::htext::display .pgnWin.text $pgnStr } else { .pgnWin.text insert 1.0 $pgnStr From 5cda9451958a87d3e08ba53cfa0c6f1842e1c274 Mon Sep 17 00:00:00 2001 From: Uwe Date: Fri, 10 Jan 2025 23:17:50 +0100 Subject: [PATCH 18/22] optimize tag evaluation with a single switch statement --- tcl/htext.tcl | 52 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 32 insertions(+), 20 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 4be529ec..5180d62e 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -34,6 +34,21 @@ array set ::htext::amountVar {} array set ::htext::varIndex {} array set ::htext::hideVarValue {} array set ::htext:updates {} +#assign processing proc to tags +array set ::htext::proc { + a aTagProcess + url urlTagProcess + run runTagProcess + go goTagProcess + pi piTagProcess + g gTagProcess + m mTagProcess + c cTagProcess + var varTagProcess + img imgTagProcess + button buttonTagProcess + window windowTagProcess +} proc help_PopStack {} { global helpWin helpText @@ -543,15 +558,26 @@ proc ::htext::display {w str {section ""} {fixed 1}} { $w insert end $text # Check if it is a starting tag (no "/" at the start) and process the tag: - set tagList { "a" aTagProcess "url" urlTagProcess "run" runTagProcess "go" goTagProcess "pi" piTagProcess "g_" gTagProcess - "m_" mTagProcess "c_" cTagProcess "var" varTagProcess "img" imgTagProcess "button" buttonTagProcess "window" windowTagProcess } if {![strIsPrefix "/" $tagName]} { set fullTag($tagName) $tagName - foreach {tag proc} $tagList { - if {[strIsPrefix $tag $tagName]} { - lassign [$proc $w $tagName] tagName fullTag($tagName) - break + set tag $tagName + #create basename of tag: m_12 -> m or "pi name" -> pi + if { [regexp ".*?\[_ \]" $tagName tag] } { set tag [string range $tag 0 end-1]} + switch -- $tag { + a - url - run - go - pi - g - m - c - var - img - button - window { + lassign [$::htext::proc($tag) $w $tagName] tagName fullTag($tagName) } + ul {incr helpWin(Indent) 4} + li { + $w insert end "\n" + for {set space 0} {$space < $helpWin(Indent)} {incr space} { + $w insert end " " + } } + q {$w insert end "\""} + lt {$w insert end "<"} + gt {$w insert end ">"} + menu {$w insert end "\["} + h1 - h2 - h3 - h4 - h5 - p - br {$w insert end "\n"} } } @@ -580,20 +606,6 @@ proc ::htext::display {w str {section ""} {fixed 1}} { unset startIndex($tagName) } } else { - switch -- $tagName { - ul {incr helpWin(Indent) 4} - li { - $w insert end "\n" - for {set space 0} {$space < $helpWin(Indent)} {incr space} { - $w insert end " " - } - } - q {$w insert end "\""} - lt {$w insert end "<"} - gt {$w insert end ">"} - menu {$w insert end "\["} - h1 - h2 - h3 - h4 - h5 - p - br {$w insert end "\n"} - } #Set the start index for this type of tag: set startIndex($tagName) [$w index insert] } From 242a1d1d55135e3f6599a9cd3b6e8c4749f41fc1 Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 11 Jan 2025 12:52:49 +0100 Subject: [PATCH 19/22] implement "showboard" as tag in htext::display option is handled in pgn --- src/game.cpp | 3 +++ src/game.h | 1 + src/tkscid.cpp | 6 ++++-- tcl/htext.tcl | 12 +++++------- tcl/windows/pgn.tcl | 6 +++++- 5 files changed, 18 insertions(+), 10 deletions(-) diff --git a/src/game.cpp b/src/game.cpp index 6a45bcca..dcf3b51f 100644 --- a/src/game.cpp +++ b/src/game.cpp @@ -1844,6 +1844,9 @@ errorT Game::WriteMoveList(TextBuffer* tb, moveT* oldCurrentMove, tb->PrintWord (temp); colWidth -= (int) std::strlen(temp); + if (IsColorFormat() && (m->nags[i] == NAG_Diagram) && (PgnStyle & PGN_STYLE_DIAGRAM)) { + tb->PrintString (""); + } } if (IsColorFormat() && m->nagCount > 0) { tb->PrintString (""); diff --git a/src/game.h b/src/game.h index 6736e5e3..22a2f58f 100644 --- a/src/game.h +++ b/src/game.h @@ -149,6 +149,7 @@ enum gameFormatT { #define PGN_STYLE_STRIP_MARKS 1024 // Strip [%mark] and [%arrow] codes. #define PGN_STYLE_NO_NULL_MOVES 2048 // Convert null moves to comments. #define PGN_STYLE_UNICODE 4096 // Use U+2654..U+2659 for figurine +#define PGN_STYLE_DIAGRAM 8192 // Show board diagram void game_printNag (byte nag, char * str, bool asSymbol, gameFormatT format); diff --git a/src/tkscid.cpp b/src/tkscid.cpp index b025ac8b..7bc28345 100644 --- a/src/tkscid.cpp +++ b/src/tkscid.cpp @@ -3294,14 +3294,14 @@ sc_game_pgn (ClientData, Tcl_Interp * ti, int argc, const char ** argv) "-column", "-comments", "-base", "-gameNumber", "-format", "-shortHeader", "-indentComments", "-indentVariations", "-symbols", "-tags", "-variations", "-width", "-space", - "-markCodes", "-unicode", + "-markCodes", "-unicode", "-showDiagram", NULL }; enum { OPT_COLUMN, OPT_COMMENTS, OPT_BASE, OPT_GAME_NUMBER, OPT_FORMAT, OPT_SHORT_HDR, OPT_INDENT_COMMENTS, OPT_INDENT_VARS, OPT_SYMBOLS, OPT_TAGS, OPT_VARS, OPT_WIDTH, OPT_SPACE, - OPT_NOMARKS, OPT_UNICODE, + OPT_NOMARKS, OPT_UNICODE, OPT_SHOWDIAGRAM, }; const scidBaseT* base = db; @@ -3392,6 +3392,8 @@ sc_game_pgn (ClientData, Tcl_Interp * ti, int argc, const char ** argv) bitmask = PGN_STYLE_STRIP_MARKS; break; case OPT_UNICODE: bitmask = PGN_STYLE_UNICODE; break; + case OPT_SHOWDIAGRAM: + bitmask = PGN_STYLE_DIAGRAM; break; default: // unreachable! return errorResult (ti, "Invalid option."); }; diff --git a/tcl/htext.tcl b/tcl/htext.tcl index 5180d62e..f911458a 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -48,6 +48,7 @@ array set ::htext::proc { img imgTagProcess button buttonTagProcess window windowTagProcess + board insertBoard } proc help_PopStack {} { @@ -566,6 +567,9 @@ proc ::htext::display {w str {section ""} {fixed 1}} { switch -- $tag { a - url - run - go - pi - g - m - c - var - img - button - window { lassign [$::htext::proc($tag) $w $tagName] tagName fullTag($tagName) } + board { if { [info exists fullTag(m)] } { + # fullTag(m) has the movenumber of the last processed move + $::htext::proc($tag) $w [string range $fullTag(m) 2 end]} } ul {incr helpWin(Indent) 4} li { $w insert end "\n" @@ -581,19 +585,13 @@ proc ::htext::display {w str {section ""} {fixed 1}} { } } - #check for Diagramm in NAG D or in comment [#] - if { $::pgn::showDiagramm && [info exists fullTag(m)] && (([strIsPrefix "/nag" $tagName] && [string first " D" $text] >= 0) || - ([strIsPrefix "/c" $tagName] && [string first "\[#\]" $text] >= 0 ))} { - # fullTag(m) has the movenumber of the last processed move - insertBoard $w [string range $fullTag(m) 2 end] - } # Check if it is a name tag matching the section we want: if {$section != "" && [strIsPrefix "name " $tagName]} { set sect [string range $tagName 5 end] if {$section == $sect} { set seePoint [$w index insert] } } - if {[string index $tagName 0] == "/"} { + if {[strIsPrefix "/" $tagName]} { # Get rid of initial "/" character: set tagName [string range $tagName 1 end] switch -- $tagName { diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl index 98ba76d7..358103fa 100644 --- a/tcl/windows/pgn.tcl +++ b/tcl/windows/pgn.tcl @@ -302,9 +302,13 @@ namespace eval pgn { set format plain if {$::pgn::showColor} {set format color} set pgnStr [sc_game pgn -symbols $::pgn::symbolicNags \ - -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments \ + -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments -showDiagram $::pgn::showDiagramm \ -space $::pgn::moveNumberSpaces -format $format -column $::pgn::columnFormat \ -short $::pgn::shortHeader -markCodes $::pgn::stripMarks -unicode $::pgn::figurine] + if { $::pgn::showDiagramm } { + #Add Diagramm for Chessbase Notation [#] in comment + set pgnStr [string map {"\[#\]" "" } $pgnStr] + } set windowTitle [format $::tr(PgnWindowTitle) [sc_game number]] ::setTitle .pgnWin "$windowTitle" From 6047a78b150c4b4fe9d6f768184e6277a0d850ff Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 11 Jan 2025 16:55:49 +0100 Subject: [PATCH 20/22] tag name moved in switch section and create process proc --- tcl/htext.tcl | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index f911458a..b9590ad7 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -49,6 +49,7 @@ array set ::htext::proc { button buttonTagProcess window windowTagProcess board insertBoard + name nameTagProcess } proc help_PopStack {} { @@ -417,6 +418,12 @@ proc ::htext::windowTagProcess {w tagName} { set winName [string range $tagName 7 end] $w window create end -window $winName } +#Process a name tag +proc ::htext::nameTagProcess {w tagName section} { + if {$section == [string range $tagName 5 end] } { + $w yview [$w index insert] + } +} #insert a board diagramm after movenr proc ::htext::insertBoard {w movenr} { ::board::new $w.bd$movenr 25 @@ -539,7 +546,6 @@ proc ::htext::display {w str {section ""} {fixed 1}} { regsub -all ">\[ \n\]+" $str "> " str regsub -all "\[ \n\]+<" $str " <" str } - set seePoint "" if {! [info exists ::htext::updates($w)]} { set ::htext::updates($w) 100 @@ -570,6 +576,7 @@ proc ::htext::display {w str {section ""} {fixed 1}} { board { if { [info exists fullTag(m)] } { # fullTag(m) has the movenumber of the last processed move $::htext::proc($tag) $w [string range $fullTag(m) 2 end]} } + name { $::htext::proc($tag) $w $tagName $section } ul {incr helpWin(Indent) 4} li { $w insert end "\n" @@ -585,12 +592,6 @@ proc ::htext::display {w str {section ""} {fixed 1}} { } } - # Check if it is a name tag matching the section we want: - if {$section != "" && [strIsPrefix "name " $tagName]} { - set sect [string range $tagName 5 end] - if {$section == $sect} { set seePoint [$w index insert] } - } - if {[strIsPrefix "/" $tagName]} { # Get rid of initial "/" character: set tagName [string range $tagName 1 end] @@ -619,8 +620,6 @@ proc ::htext::display {w str {section ""} {fixed 1}} { # Now add any remaining text: if {! $::htext::interrupt} { $w insert end $str } - - if {$seePoint != ""} { $w yview $seePoint } $w configure -state disabled # set elapsed [expr {[clock clicks -milli] - $start}] } From 12e209bc4aa2096418fcb97d5808b59c4ec7b835 Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 11 Jan 2025 17:18:36 +0100 Subject: [PATCH 21/22] unused procs removed --- tcl/htext.tcl | 8 -------- 1 file changed, 8 deletions(-) diff --git a/tcl/htext.tcl b/tcl/htext.tcl index b9590ad7..03402daf 100644 --- a/tcl/htext.tcl +++ b/tcl/htext.tcl @@ -243,14 +243,6 @@ proc ::htext::init {w} { } } -proc ::htext::isStartTag {tagName} { - return [expr {![strIsPrefix "/" $tagName]} ] -} - -proc ::htext::isEndTag {tagName} { - return [strIsPrefix "/" $tagName] -} - proc ::htext::isLinkTag {tagName} { return [strIsPrefix "a " $tagName] } From 56e2d0059e63d6b11a716c8962f8e3fe21b87343 Mon Sep 17 00:00:00 2001 From: Uwe Date: Sat, 11 Jan 2025 17:33:15 +0100 Subject: [PATCH 22/22] use printDiagramHere for ColorFormat to print diagram --- src/game.cpp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/game.cpp b/src/game.cpp index dcf3b51f..a051d522 100644 --- a/src/game.cpp +++ b/src/game.cpp @@ -1656,6 +1656,7 @@ errorT Game::WriteMoveList(TextBuffer* tb, moveT* oldCurrentMove, if (IsColorFormat()) { startTable = "
"; endColumn = "
"; + printDiagrams = PgnStyle & PGN_STYLE_DIAGRAM; } if (IsHtmlFormat() && VarDepth == 0) { tb->PrintString (""); } @@ -1843,10 +1844,6 @@ errorT Game::WriteMoveList(TextBuffer* tb, moveT* oldCurrentMove, } tb->PrintWord (temp); colWidth -= (int) std::strlen(temp); - - if (IsColorFormat() && (m->nags[i] == NAG_Diagram) && (PgnStyle & PGN_STYLE_DIAGRAM)) { - tb->PrintString (""); - } } if (IsColorFormat() && m->nagCount > 0) { tb->PrintString (""); @@ -1859,7 +1856,10 @@ errorT Game::WriteMoveList(TextBuffer* tb, moveT* oldCurrentMove, } } - if (printDiagramHere) { + if (printDiagramHere && IsColorFormat()) { + // print tag here to avoid dumping board in next if-statement + tb->PrintString (""); + } else if (printDiagramHere) { if ((PgnStyle & PGN_STYLE_COLUMN) && VarDepth == 0) { if (! endedColumn) { if (CurrentPos->GetToMove() == WHITE) {