Option Explicit

' holds puzzle-related information
Type PuzzleInfo
   Title As String
   Height As Integer
   Width As Integer
   SquareSize As Integer
   SquareFillColor As Long
   SquareBorderColor As Long
   ThreeD As Integer
End Type

' holds disk-saved information
Type typeDiskPuzzle
   SolutionInfo As typeSolution
   AcrossWord As String * 24
   DownWord As String * 24
   ClueAcross As String * 80
   ClueDown As String * 80
End Type
                   
Global Args As typeArgs

Global gCancelFlag As Integer
Global gCreatingPuzzle As Integer
Global gCWScale As Single
Global gPuzzleExists As Integer
Global Puzzle As PuzzleInfo
Global PuzzleGrid%()
Global Solution() As typeSolution
Global Words() As String
Global Clues() As String

Sub CenterForm (F As Form)

   F.Left = (Screen.Width - F.Width) \ 2
   F.Top = (Screen.Height - F.Height) \ 2

End Sub

Function CreatePuzzle (TheForm As Form) As Integer
   
   Dim MaxPosn As Integer
   Dim Zero As String * 1
   Dim PlacedCnt As Integer
   Dim Display As Integer
   
   Zero = Chr$(0)
   
   CreatePuzzle = 0
   
   GoSub CreateOnePuzzle
   Args.FirstWord = Int((MaxPosn * Rnd) + 1)
   Args.Recalled = True
   
   TheForm.MousePointer = 0
   
   Exit Function
   
CreateOnePuzzle:
   Args.FirstAcross = True
   
   If Solver(Words(), Solution(), Args) Then
      PlacedCnt = Args.PlacedCnt
      If Display Then
         TheForm!txtSize.Enabled = False
      End If
      CreatePuzzle = PlacedCnt
   End If
   Return

LoadOpenError:
   MsgBox "Open error", MB_ICONEXCLAMATION
   Exit Function

End Function

Function fnLoadPuzzle ()
   
   Dim WordInfoDim  As Integer, i As Integer
   Dim Infile As Integer
   Dim LoadPuzzle As typeDiskPuzzle
   Dim LoadSolution As typeSolution
   
   fnLoadPuzzle = 0
   On Error GoTo LoadPuzzleErr
   
   ' read the Solution array to disk
   Infile = FreeFile
   Open frmMain!dlgCMDialog.Filename For Random As Infile Len = Len(LoadPuzzle)
   
   ' get the size of the puzzle from Solution(0)
   ReDim Solution(1 To 1)
   Get Infile, 1, LoadPuzzle
   LoadSolution = LoadPuzzle.SolutionInfo
   Args.Size = LoadSolution.Row
   
   i = 2
   WordInfoDim = 0
   ReDim Preserve Words(WordInfoDim)
   ReDim Preserve Clues(WordInfoDim)
   Do
      Get Infile, i, LoadPuzzle
      If Not (EOF(Infile)) Then
         ReDim Preserve Solution(1 To i - 1)
         Solution(i - 1) = LoadPuzzle.SolutionInfo
         If Solution(i - 1).AcrossWord > -1 Then
            WordInfoDim = WordInfoDim + 1
            ReDim Preserve Words(WordInfoDim)
            ReDim Preserve Clues(WordInfoDim)
            Words(WordInfoDim) = Trim$(LoadPuzzle.AcrossWord)
            Clues(WordInfoDim) = Trim$(LoadPuzzle.ClueAcross)
         End If
         If Solution(i - 1).DownWord > -1 Then
            If WordInfoDim < Solution(i - 1).DownWord Then
               WordInfoDim = WordInfoDim + 1
               ReDim Preserve Words(WordInfoDim)
               ReDim Preserve Clues(WordInfoDim)
            End If
            Words(WordInfoDim) = Trim$(LoadPuzzle.DownWord)
            Clues(WordInfoDim) = Trim$(LoadPuzzle.ClueDown)
         End If
         i = i + 1
      Else
         Exit Do
      End If
   Loop
   Close Infile
   fnLoadPuzzle = UBound(Words, 1)
   Exit Function

LoadPuzzleErr:
   MsgBox "Unexpected fatal error when attempting to read WRD file: " & Error$
   Exit Function

End Function

Function fnLoadWords (Filename) As Integer

   Dim Infile As Integer, WordsDim As Integer, MaxPosn As Integer
   Dim Word As String, CharPos As Integer
   
   fnLoadWords = 0
   On Error GoTo LoadWordsErr
   
   Infile = FreeFile
   Open Filename For Input Access Read Shared As #Infile
   
   ' Load Words().
   WordsDim = 10
   ReDim Words(0 To WordsDim)
   ReDim Clues(0 To WordsDim)
   MaxPosn = 0
   Do Until EOF(Infile)
100
      ' get the word
      Line Input #Infile, Word
      Word = LTrim$(Word)
      CharPos = InStr(1, LTrim$(Word), " ")
      If CharPos Then
         Word = Left$(Word, CharPos - 1)
      End If
      If Word <> "" Then
         If WordsDim < MaxPosn Then
            WordsDim = MaxPosn + 10
            ReDim Preserve Words(0 To WordsDim)
            ReDim Preserve Clues(0 To WordsDim)
         End If
         ' convert the word to all uppercase characters
         Words(MaxPosn) = UCase$(Word)
200
         ' get the clue
         Line Input #Infile, Word
         Clues(MaxPosn) = Word
         MaxPosn = MaxPosn + 1
      End If
   Loop
CloseFile:
   Close #Infile
   ReDim Preserve Words(0 To MaxPosn - 1)
   On Error GoTo 0
   fnLoadWords = UBound(Words, 1) + 1
   Exit Function

LoadWordsErr:
   Select Case Err
      Case Is = 62
         If Erl = 200 Then
            MsgBox "It appears that the last word in the selected Word-Clue file lacks a clue. Therefore, the last word, '" & Words(MaxPosn) & "', will be discarded."
            Resume CloseFile
         Else
            MsgBox "It appears that the last word in the selected Word-Clue file lacks a clue. Therefore, the last word, '" & Words(MaxPosn) & "', will be discarded."
            MaxPosn = MaxPosn - 1
            Resume CloseFile
         End If
      Case Else
         MsgBox "Unexpected fatal error when attempting to read WRD file: " & Error$
   End Select
   Resume

End Function

Function fnSavePuzzle () As Integer

   On Error GoTo fnSavePuzzleErr
   Dim i As Integer
   Dim outFile As Integer
   Dim SavePuzzle As typeDiskPuzzle
   Dim SaveSolution As typeSolution
   Dim WordIndexChange As Integer
   
   frmMain!dlgCMDialog.DialogTitle = "Crossword Save As..."
   frmMain!dlgCMDialog.DefaultExt = "CW"
   frmMain!dlgCMDialog.Filter = "Saved Puzzles|*.CW"
   frmMain!dlgCMDialog.FilterIndex = 0
   frmMain!dlgCMDialog.Flags = OFN_CREATEPROMPT Or OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST Or OFN_SHOWHELP
   frmMain!dlgCMDialog.Filename = "*.CW"
   frmMain!dlgCMDialog.Action = DLG_FILE_SAVE
   
   If frmMain!dlgCMDialog.Filename <> "" Then
      ' write the Solution array to disk
      outFile = FreeFile
      
      On Error Resume Next
      Kill frmMain!dlgCMDialog.Filename
      On Error GoTo 0
      Open frmMain!dlgCMDialog.Filename For Random As outFile Len = Len(SavePuzzle)
                  
      SaveSolution.Col = Args.Size
      SaveSolution.Row = Args.Size
      SavePuzzle.SolutionInfo = SaveSolution
      SavePuzzle.AcrossWord = ""
      SavePuzzle.ClueAcross = ""
      SavePuzzle.DownWord = ""
      SavePuzzle.ClueDown = ""
      Put outFile, 1, SavePuzzle
      
      WordIndexChange = -1
      For i = 1 To UBound(Solution, 1)
         SavePuzzle.SolutionInfo = Solution(i)
         SavePuzzle.AcrossWord = ""
         SavePuzzle.ClueAcross = ""
         SavePuzzle.DownWord = ""
         SavePuzzle.ClueDown = ""
         If Solution(i).AcrossWord > -1 Then
            WordIndexChange = WordIndexChange + 1
            SavePuzzle.AcrossWord = Words(Solution(i).AcrossWord)
            SavePuzzle.ClueAcross = Clues(Solution(i).AcrossWord)
            SavePuzzle.SolutionInfo.AcrossWord = WordIndexChange
         End If
         If Solution(i).DownWord > -1 Then
            WordIndexChange = WordIndexChange + 1
            SavePuzzle.DownWord = Words(Solution(i).DownWord)
            SavePuzzle.ClueDown = Clues(Solution(i).DownWord)
            SavePuzzle.SolutionInfo.DownWord = WordIndexChange
         End If
         If Solution(i).AcrossWord Or Solution(i).DownWord Then
            Put outFile, i + 1, SavePuzzle
         End If
      Next i
      Close outFile
   End If
   Exit Function

fnSavePuzzleErr:
   If Err = 32755 Then Exit Function
   MsgBox "WordJunction could not save the puzzle (" & Trim$(Str$(Err)) & ").", MB_ICONEXCLAMATION
   Exit Function


End Function

Sub Initialize ()

   ' set default arguments
   Args.FirstWord = 0
   Args.RandomWord = True
   Args.RandomMatch = True
   Args.MaxSize = 10

End Sub

Sub InitPuzzleGrid ()

   On Error GoTo InitPuzzleGridErr
   Dim i As Integer, j As Integer
   ' initializes array with 0's
   ReDim PuzzleGrid%(1 To Args.Size, 1 To Args.Size)
   
   For i = 1 To UBound(Solution, 1)
      ' across word
      If Solution(i).AcrossWord > -1 Then
         For j = 0 To Len(Words(Solution(i).AcrossWord)) - 1
            PuzzleGrid%(Solution(i).Row, Solution(i).Col + j) = -1
         Next j
      End If
      If Solution(i).DownWord > -1 Then
         For j = 0 To Len(Words(Solution(i).DownWord)) - 1
            PuzzleGrid%(Solution(i).Row + j, Solution(i).Col) = -1
         Next j
      End If
   Next i
   Exit Sub

InitPuzzleGridErr:
   MsgBox "WordJunction could not initialize the puzzle (" & Trim$(Str$(Err)) & ").", MB_ICONEXCLAMATION
   Screen.MousePointer = DEFAULT
   Exit Sub

End Sub

Sub Main ()

   Dim X!
   App.Title = "WordJunction 1.00"
   App.HelpFile = "WJ.HLP"
   gPuzzleExists = False

   ' show splash screen
   frmSplash.Show MODELESS
   DoEvents
   X! = Timer
   Load frmMain
   Do
   Loop Until Timer - X! > 5

   ' unload splash screen
   Unload frmSplash
   DoEvents
   Initialize
   frmMain.Show MODAL

End Sub