crosswords game

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

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" (or double click with the mouse) 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-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 ...


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 <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