Hello to you all.
As I use a lot this wiki, I think it was also time to add some content to it.
During COVID I created a small code to resemble a crosswords game like we find in journal and magazines.
I tried to make it simple and nice. My idea was to port it, later on, to androwish and have it available in smartphones. It would be a small but nice game.
It still needs adjustments but I am sharing it so if anyone would like to improve it, be free of doing it and share the results ;)
Currently I only have crosswords in portuguese.
Here it is an example that can be read by the application (example )
It can also be used to create other crosswords. The format is self explanatory
- use the arrows of the keyboard to move the position of cursor along the crossword board
- use space to clean the letters/words .
- use "ENTER" (or double click with the mouse) to swap between vertical and horizontal crosswords.
Happy gaming ;)
- allows to read different crossword file (*.cross).
- Provides the functions:see correct letter, see word, solve the crossword.
- Provides a very rusty score when the solve button is clicked.
- It is slow if the crossword is big.
- it cannot be maximized to fullfill the screen (there are problems with the font that is used).
I was not able to put an image....
Jeff Smith 2021-01-10 : Below is an online demo using CloudTk. This demo runs "crosswords game" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + crosswords-game.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
To used it properly, just click on File> Open, and open the cross file that is available. Thanks Jeff for adding ...
##
## Nuno M. F. Sousa A. Cerqueira
##
## December 2020
##
proc buildGui {} {
global direction helpCount
#menu
menu .mbar
. configure -menu .mbar
menu .mbar.fl -tearoff 0
.mbar add cascade -menu .mbar.fl -label File -underline 0
.mbar.fl add command -label Open -command { openFile }
.mbar.fl add command -label Exit -command { exit }
menu .mbar.f2 -tearoff 0
.mbar add cascade -menu .mbar.f2 -label Edit -underline 0
.mbar.f2 add command -label "Undo" -command {Edit undo}
.mbar.f2 add command -label "Redo" -command {Edit redo}
menu .mbar.f3 -tearoff 0
.mbar add cascade -menu .mbar.f3 -label Options -underline 0
.mbar.f3 add command -label "Show Letter" -command {showLetter}
.mbar.f3 add command -label "Show Word" -command {showWord}
.mbar.f3 add command -label "Check Correct/Wrong" -command {incr helpCount; solution check}
.mbar.f3 add command -label "Solve" -command {solution all}
menu .mbar.f4 -tearoff 0
.mbar add cascade -menu .mbar.f4 -label Help -underline 0
.mbar.f4 add command -label About -command {About }
#canvas 1 - board
grid [tk::canvas .canvas -yscrollcommand ".v set" -xscrollcommand ".h set"] -sticky nwes -column 0 -row 0
#canvas 2 - Message
grid [tk::canvas .canvasMessage -bg #E3E3E3] -sticky nwes -column 0 -row 2 -padx 5 -pady 5
#scroolbars
grid [tk::scrollbar .h -orient horizontal -command ".canvas xview"] -column 0 -row 3 -sticky we
grid [tk::scrollbar .v -orient vertical -command ".canvas yview"] -column 1 -row 0 -sticky ns
grid [ttk::sizegrip .sz] -column 1 -row 3 -sticky se
#weights
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
grid columnconfigure .v {0 1} -weight 1
#bindings show coordinates of the mouse
# bind .canvas <Motion> {wm title . [int [%W canvasx %x]],[int [%W canvasy %y]]}
#binding Identigy letter
bind .canvas <Button-1> { identifyItem %x %y }
bind .canvas <Double-1> { if {$direction=="row"} {set direction "column"} else {set direction "row"}; identifyItem %x %y}
bind . <Key> {changeItem %K}
}
proc changeItem {key} {
global Matrix column totalColumns row totalRows direction
#clear matrix
clearCrossWord
# check allowed keys
set moveKeys "Up Down Left Right"
set otherKeys "Return space Delete BackSpace"
set allowedKeys "q w e r t y u i o p a s d f g h j k l z x c v b n m Q W E R T Y U I O P A S D F G H J K L Ç Z X C V B N M 1 2 3 4 5 6 7 8 9 0 ."
if {[lsearch "$allowedKeys $moveKeys $otherKeys" $key ]==-1} {return}
# See if Space was clicked and change orientation
if {$key=="Return"} {
if {$direction=="row"} {set direction "column"} else {set direction "row"}
highlightItems
return
}
#Check if delete was clicked
set keyPressed "none"
if {$key=="Delete" || $key=="space" || $key=="BackSpace"} {
set keyPressed $key
set key "."
}
#Movement or change item
if {$key=="Up"} {incr row -1
} elseif {$key=="Down"} {incr row +1
} elseif {$key=="Left"} {incr column -1
} elseif {$key=="Right"} {incr column +1
} else {}
# Check Limits
limitReached
#Change Letter if a key was pressed
if {$Matrix($row,$column)!="#" && [lsearch $allowedKeys $key]!=-1} {
#convert letter to upperCase
set key [string toupper $key 0 end]
set Matrix($row,$column) $key
#change text on item
if {$key=="."} {set key " "}
.canvas itemconfigure "Item,$row,$column" -text $key
#Advance highlight item by one
if {$direction=="column" && $keyPressed!="BackSpace"} {
incr row +1
# Check if limits of the board are reached
limitReached
if {$Matrix($row,$column)=="#"} {changeItem "Down"}
}
if {$direction=="row" && $keyPressed!="BackSpace"} {
incr column +1
# Check if limits of the board are reached
limitReached
if {$Matrix($row,$column)=="#"} {changeItem "Right"}
}
if {$keyPressed=="BackSpace"} {
puts "okoko"
if {$direction=="column"} {
incr row -1
limitReached
if {$Matrix($row,$column)=="#"} {changeItem "Up"}
}
if {$direction=="row"} {
incr column -1
limitReached
if {$Matrix($row,$column)=="#"} {changeItem "Left"}
}
}
# Check if the pressed key is not # or next item is #
} elseif {$Matrix($row,$column)=="#" && [lsearch $moveKeys $key]!=-1} {
changeItem $key
return
}
#highlight next item
highlightItems
}
proc limitReached {} {
global Matrix column totalColumns row totalRows direction
if {$row==$totalRows} {set row 0}
if {$row==-1} {set row [expr $totalRows-1]}
if {$column==$totalColumns} {set column 0}
if {$column==-1} {set column [expr $totalColumns -1]}
}
proc clearCrossWord {} {
#change all the boxes to white
set i [.canvas find withtag white]
foreach a $i {
if {[string range [.canvas gettags $a] 0 2]=="Box"} {
# remove background from cox
.canvas itemconfigure $a -fill white
puts "### [.canvas gettags $a]"
#remove color tag
#set tags [.c gettags [lindex $litem end]]
}
}
}
proc clearCrossWordOld {} {
#change all the boxes to white
set i [.canvas find withtag white]
foreach a $i {
if {[string range [.canvas gettags $a] 0 2]=="Box"} {
.canvas itemconfigure $a -fill white
}
}
}
proc identifyItem {x y} {
global Matrix column totalColumns row totalRows direction
clearCrossWord
set x [.canvas canvasx $x]
set y [.canvas canvasy $y]
set i [.canvas find closest $x $y]
#give the items that overlap : box and letter
set i [.canvas find overlapping $x $y [expr $x+1] [expr $y+1]]
set tagBox [.canvas gettags [lindex $i 0]] ; #box
set tagItem [.canvas gettags [lindex $i 1]] ; #row
# highlight column or row
set tagBox [string map {, " "} $tagBox]
set row [lindex $tagBox 1]
set column [lindex $tagBox 2]
if {$row=="" || $column==""} {return}
if {$Matrix($row,$column)=="#"} {return}
#Highlight items
highlightItems
}
proc highlightItems {} {
global Matrix column totalColumns row totalRows direction
#edit item
set item $Matrix($row\,$column)
if {$item!="#"} {
.canvas itemconfigure "Box,$row,$column" -fill yellow
#new
set tags [.canvas gettags "Box,$row,$column"]
puts "#1## tags: $tags"
set tags "$tags changed"
.canvas itemconfigure "Box,$row,$column" -tag $tags
set tags [.canvas gettags "Box,$row,$column"]
puts "#2## tags : $tags"
} else {changeItem ""; # moves next item}
if {$direction=="row"} {
# column right
for {set columnS [expr $column+1]} {$columnS < $totalColumns} {incr columnS} {
set item $Matrix($row\,$columnS)
if {$item!="#"} {.canvas itemconfigure "Box,$row,$columnS" -fill #FFFFCA} else {break}
}
# column left
for {set columnSb [expr $column-1]} {$columnSb >= 0} {set columnSb [expr $columnSb-1]} {
set item $Matrix($row\,$columnSb)
if {$item!="#"} {.canvas itemconfigure "Box,$row,$columnSb" -fill #FFFFCA} else {break}
}
}
if {$direction=="column"} {
# row up
for {set rowS [expr $row+1]} {$rowS < $totalRows} {incr rowS} {
set item $Matrix($rowS\,$column)
if {$item!="#"} {.canvas itemconfigure "Box,$rowS,$column" -fill #FFFFCA} else {break}
}
# row down
for {set rowSb [expr $row-1]} {$rowSb >= 0} {set rowSb [expr $rowSb-1]} {
set item $Matrix($rowSb\,$column)
if {$item!="#"} {.canvas itemconfigure "Box,$rowSb,$column" -fill #FFFFCA} else {break}
}
}
#Show message of rows and columns
showMessage
}
proc int x { expr int($x) }
proc drawBoard {} {
global Matrix MatrixSolution totalColumns totalRows maxWidth
#variables
set colorBox white
set boxWidth 50
set boxHeight $boxWidth
set font1 {Helvetica -10 }
set font2 {Helvetica -35 }
set font3 {Helvetica -20 }
# Print Boxes
set x1 10
set y1 10
set numberSpace 40
set number 0; # count the numbers
set maxX 0
set maxY 0
#Read each row from th Matrix
for {set row 0} {$row < $totalRows} {incr row} {
#Add a number in the box
set newNumber "yes"
#Draw number @ row
.canvas create text [expr ($boxWidth/2)] [expr $y1+($boxWidth/2)+ $numberSpace] -font $font3 -text "[expr $row+1]" -tag "rowNumber"
# create boxes with text and numbers
for {set column 0} {$column < $totalColumns} {incr column} {
#Draw number @ column
if {$row==0} {
.canvas create text [expr $x1+($boxWidth/2) + $numberSpace] [expr ($boxWidth/2)] -font $font3 -text "[expr $column+1]" -tag "columnNumber"
}
#Row Text
set rowItem $Matrix($row,$column)
#Type of row item
if {$rowItem=="#"} {
set colorBox "#1E1E1E"
} else {set colorBox white}
#Draw Box
.canvas create rect [expr $x1+ $numberSpace] [expr $y1+ $numberSpace] [expr $x1 +$numberSpace + $boxWidth] [expr $y1 +$numberSpace + $boxHeight] \
-outline black -fill $colorBox -tag "Box,$row,$column $colorBox"
# Draw Number
if {$newNumber=="yes"} {
incr number
#.canvas create text [expr $x1+ $numberSpace +10] [expr $y1+10 +$numberSpace] -font $font1 -text "$number" -tag "$number"
set newNumber "no"
}
# Draw Letter
if {$rowItem=="#"} {set color "#1E1E1E"} else {set color black}
.canvas create text [expr $x1+ $numberSpace +($boxWidth/2)] [expr $y1+ $numberSpace + ($boxWidth/2)] -fill $color -text $rowItem -font $font2 -tag "Item,$row,$column $rowItem"
#Change column
set x1 [expr $x1 + $boxWidth]
#Type of row item
if {$rowItem=="#" || $row==0} {set newNumber "yes"}
}
#Change row
set maxWidth $x1
set x1 10
set maxHeight $y1
set y1 [expr $y1 + $boxHeight]
}
#based on the board that was draw modify scroolbars
.canvas config -width [expr $maxWidth+70] -height [expr $maxHeight +100] -scrollregion "0 0 [expr $maxWidth+70] [expr $maxHeight +100]"
.canvasMessage config -width [expr $maxWidth+70] -height 150
}
### Justify text
proc mjtext {c x0 y0 x1 y1 args} {
array set opt {-bg white -font {Times 11}}
array set opt $args
set _self mj[$c create rect $x0 $y0 $x1 $y1 \
-fill $opt(-bg) -outline $opt(-bg)]
upvar #0 $_self self
array set self [list x $x0 x0 $x0 y $y0 x1 $x1 y1 $y1 c $c]
set self(-font) $opt(-font)
set self(dy) [font metrics $opt(-font) -linespace]
interp alias {} $_self {} mjtext'do $_self
}
proc mjtext'do {_self cmd cmd2 args} {
upvar #0 $_self self
if {$cmd=="insert" && $cmd2=="end"} {
foreach {text tag} $args {
foreach line [split $text \n] {
set ids {}
foreach word [split $line] {
if {$word==""} continue
set id [$self(c) create text $self(x) $self(y) \
-anchor nw -text $word -font $self(-font)]
foreach {x0 y0 x1 y1} [$self(c) bbox $id] break
if {$x1 > $self(x1)} {
set dx [expr {$self(x0) - $x0}]
$self(c) move $id $dx $self(dy)
foreach {x0 y0 x1 y1} [$self(c) bbox $id] break
mjtext'justify $self(c) $ids $self(x1)
set ids {}
} else {lappend ids $id}
set self(x) [expr {$x1 + 1}]
set self(y) $y0
}
set self(x) $self(x0)
set self(y) [expr {$self(y) + 2 * $self(dy)}]
}
}
} else {error "usage: $self insert end text"}
}
proc mjtext'justify {c ids x1} {
set last [lindex $ids end]
set diff [expr {$x1 - [lindex [$c bbox $last] 2]}]
set step [expr {double($diff)/([llength $ids]-1)}]
for {set i [llength $ids]} {$i>1} {} {
$c move [lindex $ids [incr i -1]] $diff 0
set diff [expr {$diff-$step}]
}
}
proc nl2flowtext s {
# turn multiline text into flowtext, \n only on empty lines
regsub -all {\n *\n} $s \x81 s ;# dummy char
string map {\n " " \x81 \n} $s
}
proc showMessage {} {
global Matrix column totalColumns row totalRows direction rowMessage columnMessage maxWidth
# Inlcude text in canvas2
.canvasMessage delete message
if {$direction=="row"} {set text "Horizontal [expr $row+1]: \n\n $rowMessage($row)"
} else {set text "Vertical [expr $column+1]: \n\n $columnMessage($column)"}
# Print text in canvas2
set mj [mjtext .canvasMessage 15 15 $maxWidth 500 -anchor w -bg #E3E3E3 -justify left -font {Helvetical 15}]
$mj insert end [nl2flowtext $text]
}
proc loadFile {file} {
global Matrix MatrixSolution totalRows totalColumns columnMessage rowMessage
array unset Matrix
array unset MatrixSolution
set loadFile [open $file r]
while {![eof $loadFile]} {
#read data
set data [gets $loadFile]
#Read board
if {$data=="== Board"} {
set row 0
#set column 0
set letter " "
while {![eof $loadFile] && $data!=""} {
set maxColumn [string length $data]
#read data
set data [gets $loadFile]
update
for {set column 0} {$column <[string length $data]} {incr column} {
set letter [string range $data $column $column]
#solution matrix
set MatrixSolution($row,$column) $letter
# game matrix
if {$letter!="#"} {set letter ""}
set Matrix($row,$column) $letter
}
incr row
}
set maxRow $row
}
if {$data=="== Horizontals"} {
set memPos 0
while {![eof $loadFile] && $data!=""} {
#read data
set data [gets $loadFile]
set rowMessage($memPos) [lindex $data 1]
incr memPos
}
}
if {$data=="== Verticals"} {
set memPos 0
while {![eof $loadFile] && $data!=""} {
#read data
set data [gets $loadFile]
set columnMessage($memPos) [lindex $data 1]
incr memPos
}
}
}
close $loadFile
set totalRows [expr $maxRow -1]
set totalColumns [expr $maxColumn -0]
}
proc openFile {} {
set types {
{{CrossWord Files} {.cross} }
{{All Files} * }
}
set fileName [tk_getOpenFile -filetypes $types]
if {$fileName !=""} {
loadFile $fileName
#clear canvas
.canvas delete all
#draw boards
drawBoard
}
}
proc solution {option} {
global Matrix MatrixSolution totalRows totalColumns columnMessage rowMessage maxWidth helpCount
set countLetter 0
set countLetterYES 0
set countLetterNO 0
set countBlank 0
# All solution
#If equal to solution green box. Otherwise red box
for {set row 0} {$row <$totalRows} {incr row} {
for {set column 0} {$column <$totalColumns} {incr column} {
set solution $MatrixSolution($row,$column)
set actual $Matrix($row,$column)
#ccount sspaces withou tletters
if {$solution!="#"} {
if {$actual==""} {incr countBlank}
incr countLetter
#change color of the box
if {$solution==$actual} {
.canvas itemconfigure "Box,$row,$column" -fill #C5D86D
incr countLetterYES
} else {
if {$option=="check"} {
.canvas itemconfigure "Box,$row,$column" -fill #FF8A8A
}
if {$option=="all"} {
.canvas itemconfigure "Box,$row,$column" -fill #FF8A8A
set Matrix($row,$column) $MatrixSolution($row,$column)
.canvas itemconfigure "Item,$row,$column" -text $MatrixSolution($row,$column)
}
if {$option=="example" } {
set Matrix($row,$column) $MatrixSolution($row,$column)
.canvas itemconfigure "Item,$row,$column" -text $MatrixSolution($row,$column)
}
incr countLetterNO
}
}
}
}
# Print some stats
if {$option=="all"} {
.canvasMessage delete message
set text "Estatistica \n \n Performance : [expr $countLetterYES*100 /$countLetter] %"
# Print text in canvas2
set mj [mjtext .canvasMessage 15 15 $maxWidth 500 -anchor w -bg #E3E3E3 -justify left -font {Helvetical 14}]
$mj insert end [nl2flowtext "Performance : [expr $countLetterYES*100 /$countLetter] %"]
$mj insert end [nl2flowtext "Letras em Branco : $countBlank"]
$mj insert end [nl2flowtext "Ajudas : $helpCount"]
}
if {$option=="example"} {
.canvasMessage delete message
set text "Estatistica \n \n Performance : [expr $countLetterYES*100 /$countLetter] %"
# Print text in canvas2
set mj [mjtext .canvasMessage 15 15 $maxWidth 500 -anchor w -bg #E3E3E3 -justify left -font {Helvetical 12}]
$mj insert end [nl2flowtext "Como usar:"]
$mj insert end [nl2flowtext " - Usar as setas do teclado ou o rato para seleccionar as caixas."]
$mj insert end [nl2flowtext " - Duplo Clique ou Enter para mudar entre Horizontais ou verticais."]
$mj insert end [nl2flowtext " - Delete ou BackSpace para eliminar letra das caixas."]
}
}
proc showLetter {} {
global Matrix MatrixSolution totalRows totalColumns columnMessage rowMessage maxWidth row column helpCount
set solution $MatrixSolution($row,$column)
set actual $Matrix($row,$column)
if {$solution==$actual} {
set Matrix($row,$column) $solution
.canvas itemconfigure "Item,$row,$column" -text $solution -fill red
} else {
.canvas itemconfigure "Item,$row,$column" -text $solution -fill red
}
incr helpCount
}
proc showWord {} {
global Matrix MatrixSolution totalRows totalColumns columnMessage rowMessage maxWidth row column helpCount direction
if {$direction=="row"} {
# column right
for {set columnS [expr $column]} {$columnS < $totalColumns} {incr columnS} {
set item $Matrix($row\,$columnS)
if {$item!="#"} {
.canvas itemconfigure "Box,$row,$columnS" -fill #FFFFCA
set Matrix($row,$columnS) $MatrixSolution($row,$columnS)
.canvas itemconfigure "Item,$row,$columnS" -text $Matrix($row,$columnS) -fill red
incr helpCount
} else {break}
}
# column left
for {set columnSb [expr $column]} {$columnSb >= 0} {set columnSb [expr $columnSb-1]} {
set item $Matrix($row\,$columnSb)
if {$item!="#"} {
.canvas itemconfigure "Box,$row,$columnSb" -fill #FFFFCA
set Matrix($row,$columnSb) $MatrixSolution($row,$columnSb)
.canvas itemconfigure "Item,$row,$columnSb" -text $Matrix($row,$columnSb) -fill red
incr helpCount
} else {break}
}
}
if {$direction=="column"} {
# row up
for {set rowS [expr $row]} {$rowS < $totalRows} {incr rowS} {
set item $Matrix($rowS\,$column)
if {$item!="#"} {
.canvas itemconfigure "Box,$rowS,$column" -fill #FFFFCA
set Matrix($rowS,$column) $MatrixSolution($rowS,$column)
.canvas itemconfigure "Item,$rowS,$column" -text $Matrix($rowS,$column) -fill red
incr helpCount
} else {break}
}
# row down
for {set rowSb [expr $row]} {$rowSb >= 0} {set rowSb [expr $rowSb-1]} {
set item $Matrix($rowSb\,$column)
if {$item!="#"} {
.canvas itemconfigure "Box,$rowSb,$column" -fill #FFFFCA
set Matrix($rowSb,$column) $MatrixSolution($rowSb,$column)
.canvas itemconfigure "Item,$rowSb,$column" -text $Matrix($rowSb,$column) -fill red
incr helpCount
} else {break}
}
}
#Show message of rows and columns
showMessage
incr helpCount -1
}
proc About {} {
set answer [tk_messageBox \
-message "Jogo Palavras Cruzadas \n\n Developed by Nuno Sousa Cerqueira in December 2020" \
-type ok \
-title "About"]
}
proc Edit {undo} {
# turn array into a dictionary
#can provide statistics about the steps that were done.
# Todo
}
##### START
encoding system utf-8
set helpCount 0
wm title . "Jogo das Palavras Cruzadas"
#wm geometry . 700x500+300+300
console show
#Build gui
buildGui
set direction "column"
#Load File
loadFile "example.cross"
drawBoard
solution example