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 (https://www.dropbox.com/s/f4a8dryefg79puf/publico-1.cross?dl=0%|%example%|%) It can also be used to create other crosswords. The format is self explanatory ***How to use:*** - 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" to swap between vertical and horizontal crosswords. Happy gaming ;) ***Features*** - 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. ***DrawBacks*** - 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). *** Images *** I was not able to put an image.... ---- [Jeff Smith] 2021-01- : Below is an online demo using [CloudTk]. This demo runs "crosswords game" in an Alpine Linux Docker Container. It is a 27.5MB 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. <> <> ---- ***The code*** ====== ## ## 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 {wm title . [int [%W canvasx %x]],[int [%W canvasy %y]]} #binding Identigy letter bind .canvas { identifyItem %x %y } bind .canvas { if {$direction=="row"} {set direction "column"} else {set direction "row"}; identifyItem %x %y} bind . {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 ======