-- Cryptogram Solver

without warning

include win32lib.ew
include cryptlib.ew

---------------------------------------------------------
procedure debug(sequence s)    -- for debugging
integer junk

junk = message_box(s,"DEBUG",0)
end procedure

---------------------------------------------------------
constant TRUE = 1, FALSE = 0
integer junk   -- for message box
sequence mess
---------------------------------------------------------
sequence screen_size
atom K
screen_size = getSize(Screen)
K = screen_size[3] / 1024

function mK(integer i)  -- Adjust to screen resolution. My screen is 1024*768.
return(floor(K * i))
end function
---------------------------------------------------------
constant
CryptWin=create(Window,
   "Cryptogram Solver   May 27, 2000   freeware   Jerry Story",
   0,1,1,mK(1000),mK(700),0),

FileMenu = create( Menu, "File", CryptWin, 0, 0, 0, 0, 0 ),
  MenuDict = create(MenuItem,"Dictionary", FileMenu,0,0,0,0,0 ),
  MenuExit = create(MenuItem,"Exit", FileMenu,0,0,0,0,0 ),

ProbMenu = create( Menu, "Make a Cryptogram", CryptWin, 0, 0, 0, 0, 0 ),
  MenuMakeF = create(MenuItem,"Make a Cryptogram from a File",ProbMenu,0,0,0,0,0 ),
  MenuMakeM = create(MenuItem,"Make a Cryptogram from MLE",ProbMenu,0,0,0,0,0 ),

SolveMenu = create( Menu, "Solve a Cryptogram", CryptWin, 0, 0, 0, 0, 0 ),
  MenuHow   = create(MenuItem,"Solving Cryptograms", SolveMenu,0,0,0,0,0 ),
  MenuHowM  = create(MenuItem,"Multiple Solutions", SolveMenu,0,0,0,0,0 ),
  MenuHowN  = create(MenuItem,"No Solution", SolveMenu,0,0,0,0,0 ),

HelpMenu = create( Menu, "Help", CryptWin, 0, 0, 0, 0, 0 ),
  MenuAbout = create(MenuItem,"About", HelpMenu,0,0,0,0,0 ),



status = create( StatusBar, "", CryptWin, 0, 0, 0, 0, 0 ),

lstProblem  = create(List,"",CryptWin,mK( 5),mK( 3),mK(980),mK( 60),0),
lstSolution = create(List,"",CryptWin,mK( 5),mK(550),mK(980),mK( 60),0),

radPr=create(Radio,"Whole Problem",CryptWin,mK(500),mK(70),mK(200),mK(20),0),
radWd=create(Radio,"One List",     CryptWin,mK(750),mK(70),mK(200),mK(20),0),

lblDict=create(LText,"No Dictionary is loaded.",
  CryptWin,mK(10),mK(70),mK(450),mK(36),0),
lblProbPath=create(LText,"No Problem is loaded.",
  CryptWin,mK(10),mK(514),mK(450),mK(36),0),

grpFiles = create(Group,"Files",CryptWin,mK(10),mK(110),mK(100),mK(70),0),
cmdProb=   create(PushButton,"Cryptogram",grpFiles,mK(10),mK( 30),mK(80),mK(30),0),

grpSolve=create(Group,"Reduce Lists",CryptWin,mK(10),mK(205),mK( 100),mK(175),0),
cmdSel =  create(PushButton,"Selected",grpSolve,mK(10),mK( 30),mK( 80),mK( 30),0),
cmdAll=create(PushButton,"All Lists",grpSolve,mK(10),mK( 65),mK( 80),mK( 30),0),
cmdSolve =create(PushButton,"Solve!",grpSolve,mK(10),mK(100),mK( 80),mK( 30),0),
cmdOrig=create(PushButton,"Original",grpSolve,mK(10),mK(135),mK( 80),mK( 30),0),

grpHelp = create(Group,"Help",CryptWin,mK(10),mK(405),mK( 110),mK( 85),0),
chkHints=create(CheckBox,"Hints",grpHelp,mK(10),mK( 30),mK( 80),mK( 30),0),

lstWords =    create(List,"",CryptWin,mK(125),mK(110),mK(160),mK(400),0),
lstCand  =    create(List,"",CryptWin,mK(300),mK(110),mK(160),mK(400),0),

lblWords =   create(CText,"",CryptWin,mK(125),mK( 90),mK(160),mK( 20),0),
lblCand  =   create(CText,"",CryptWin,mK(300),mK( 90),mK(160),mK( 20),0)



---------------------------------------------------------
constant  CHAR = {"A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P",
"Q","R","S","T","U","V","W","X","Y","Z","'","-"}

constant fNAME = "New Courier", gSIZE = 16, fSIZE = 12
sequence lblGrid,lblRow,lblCol
lblGrid = {}    lblRow = {}    lblCol = {}
for i = 1 to 26 do
  for j = 1 to 26 do
    lblGrid  =  append(lblGrid, create(LText,"X",CryptWin,
       mK(495) + mK(j*gSIZE),mK(105) + mK(i*gSIZE),mK(gSIZE),mK(gSIZE),0))
    setFont(lblGrid[((i-1)*26) + j],fNAME,mK(fSIZE),Normal)
  end for
end for
for i = 1 to 26 do
  lblRow = append(lblRow,create(LText,CHAR[i],CryptWin,
       mK(485),  mK(105) + mK(i*gSIZE),mK(gSIZE),mK(gSIZE),0))
    setFont(lblRow[i],fNAME,mK(fSIZE),Bold)
  lblCol = append(lblCol,create(LText,CHAR[i],CryptWin,
       mK(495) + mK(i*gSIZE),  mK(95),mK(gSIZE),mK(gSIZE),0))
    setFont(lblCol[i],fNAME,mK(fSIZE),Bold)
end for
---------------------------------------------------------
setCheck(radPr,1)
setFont(lblDict,"Courier",mK(12),Bold)
setFont(lblProbPath,"Courier",mK(12),Bold)
setFont(lblWords,"Fixedsys",mK(16),Normal)
setFont(lblCand,"Fixedsys",mK(12),Normal)
setFont(lstProblem,"Fixedsys",mK(16),Normal)
setFont(lstSolution,"Fixedsys",mK(16),Normal)
setFont(lstWords,"Fixedsys",mK(16),Normal)
setFont(lstCand,"Fixedsys",mK(16),Normal)
setFont(radPr,"Courier",mK(16),Normal)
setFont(radWd,"Courier",mK(16),Normal)

setFont(status,"Courier",mK(20),Italic + Bold)


setWindowBackColor(CryptWin,Yellow)
---------------------------------------------------------
-- data
---------------------------------------------------------
sequence dictionary_filename,dictionary              -- dictionary stuff
sequence problem_filename,problem,words_in_problem   -- cryptogram to solve
sequence original_lists,reduced_lists                -- lists of candidate words
sequence grid_pr,grid_pr_test,grid_wd                -- logic
sequence abc
sequence solution

dictionary_filename = "words.txt"
dictionary = {}
problem_filename = {}    problem = {}          words_in_problem = {}
solution = {}

procedure initStuff()
original_lists = {}      reduced_lists = {}
grid_pr = {}             grid_pr_test = {}     grid_wd = {}
abc = repeat('?',26)
solution = {}
end procedure
initStuff()
---------------------------------------------------------
-- support routines
---------------------------------------------------------
procedure ShuffleAbc()
integer r,hold

abc = repeat('?',26)
for i = 1 to 26 do
  abc[i] = 'A' + (i-1)
end for
for i =1 to 26 do
  r = rand(26)
  hold = abc[r]
  abc[r] = abc[i]
  abc[i] = hold
end for
end procedure  -- ShuffleAbc
---------------------------------------------------------
procedure GettaDictionary()
integer junk
sequence mess

mess = "You need a dictionary to solve cryptograms with this program. \n"
 & "If you don't have one you gotta git one. \n"
 & "The default name is WORDS.TXT. \n"
 & "It must be in simple text form and not compressed. \n"
 & "Click on <File> --> <Dictionary> and load a dictionary. \n"
 & "\n"
 & "\n"
junk = message_box(mess,"Dictionary Not Found",0)
setText(status,"Click <File> --> <Dictionary>   Need one to solve cryptograms.")
end procedure
---------------------------------------------------------
procedure ShowGrid()
integer wd

if isChecked(radPr) then
  for i = 1 to 26 do
    for j = 1 to 26 do
      if grid_pr[i][j] = 'F' then
        setText(lblGrid[((i-1) * 26) + j]," ")
      else
        setText(lblGrid[((i-1) * 26) + j],sprintf("%s",{grid_pr[i][j]}))
      end if
    end for
  end for
elsif isChecked(radWd) then
  if getCount(lstWords) > 0 then
    wd = getIndex(lstWords)
    if wd > 0 then
      for i = 1 to 26 do
        for j = 1 to 26 do
    if grid_wd[wd][i][j] = 'F' then
    setText(lblGrid[((i-1) * 26) + j]," ")
    else
    setText(lblGrid[((i-1) * 26) + j],sprintf("%s",{grid_wd[wd][i][j]}))
    end if
        end for
      end for
    end if
  end if
end if
end procedure  -- ShowGrid
---------------------------------------------------------
procedure PrepareAbc()
integer countF

for i = 1 to 26 do
  for j = 1 to 26 do
    if grid_pr[j][i] = 'T' then
      abc[j] = i + ('A'-1)
    end if
  end for
end for
for i = 1 to 26 do
  countF = 0
  for j = 1 to 26 do
    if grid_pr[i][j] = 'F' then
      countF += 1
    end if
  end for
  if countF = 26 then
    abc[i] = '#'
  end if
end for
end procedure  --PrepareAbc
---------------------------------------------------------
procedure Translate()  -- Use abc to convert to solution.
integer a

solution = problem
for i = 1 to length(problem) do
  for j = 1 to length(problem[i]) do
    if isLetter(problem[i][j]) then
      a = problem[i][j] - ('A'-1)
      solution[i][j] = abc[a]
    else  -- ignore
    end if
  end for
end for
eraseItems(lstSolution)
for i = 1 to length(solution) do
  addItem(lstSolution,solution[i])
end for
end procedure    -- Translate
---------------------------------------------------------
procedure ShowCandidateWords()
integer index

index = getIndex(lstWords)
if index > 0 then
  eraseItems(lstCand)
  for i = 1 to length(reduced_lists[index]) do
    addItem(lstCand,reduced_lists[index][i])
  end for
  setText(lblCand,sprintf("%d words",{length(reduced_lists[index])}))
end if
end procedure  -- ShowCandidateWords
---------------------------------------------------------
procedure InitGrid_pr()
grid_pr = repeat(repeat('U',26),26)
end procedure  -- initGrid_pr
---------------------------------------------------------
procedure InitGrid_pr_test()
grid_pr_test = repeat(repeat('U',26),26)
end procedure  -- initGrid_pr_test
---------------------------------------------------------
procedure InitGrid_wd(integer L)
integer a,b
sequence word_pr,word_li

grid_wd[L] = repeat(repeat('F',26),26)
word_pr = words_in_problem[L]
for i =1 to length(reduced_lists[L]) do
  word_li = reduced_lists[L][i]
  -- compare them, add to grid_wd[L]
  for j = 1 to length(word_pr) do
    a = word_pr[j] - ('A' - 1)    -- 1..26  - '
    b = word_li[j] - ('A' - 1)
    if (a < 1) or (a > 26) then  -- (' -) do nothing
    elsif (b < 1) or (b > 26) then -- do nothing
    else
      grid_wd[L][a][b] = 'U'
    end if
  end for
end for
end procedure  -- initGrid_wd
---------------------------------------------------------
procedure InitGrids()
InitGrid_pr()
InitGrid_pr_test()
grid_wd = repeat({},length(words_in_problem))
for i = 1 to length(grid_wd) do
  InitGrid_wd(i)
end for
end procedure    -- InitGrids
---------------------------------------------------------
procedure CopyFalses(integer L)
for i = 1 to 26 do
  if find(i+('A'-1),words_in_problem[L]) then
    for j = 1 to 26 do
      if grid_wd[L][i][j] = 'F' then
        grid_pr[i][j] = 'F'
      end if
    end for
  end if
end for
end procedure    -- CopyFalses
---------------------------------------------------------
procedure ChangeSUtoTrue()
integer F,sU,changes

while 1 do
  changes = 0
  for i = 1 to 26 do
    sU = 0  F = 0
    for j = 1 to 26 do
      if grid_pr[i][j] = 'F' then  F += 1 end if
      if grid_pr[i][j] = 'U' then  sU = j end if
    end for
    if (F = 25) and (sU > 0) then
      changes += 1
      for i1 = 1 to 26 do
        grid_pr[i1][sU] = 'F'
      end for
      grid_pr[i][sU] = 'T'
    end if
  end for

  for i = 1 to 26 do
    sU = 0  F = 0
    for j = 1 to 26 do
      if grid_pr[j][i] = 'F' then  F += 1 end if
      if grid_pr[j][i] = 'U' then  sU = j end if
    end for
    if (F = 25) and (sU > 0) then
      changes += 1
      for i1 = 1 to 26 do
        grid_pr[sU][i1] = 'F'
      end for
      grid_pr[sU][i] = 'T'
    end if
  end for
  if changes = 0 then exit end if
end while
ShowGrid()
end procedure    -- ChangeSUtoTrue
---------------------------------------------------------
function ReduceLists(integer L)
integer a,b,false_word,reduced
sequence word,s

reduced = FALSE
s = reduced_lists
s[L] = {}
  for j = 1 to length(reduced_lists[L]) do  -- thru list of words
    word = reduced_lists[L][j]
    false_word = FALSE
    for k = 1 to length(word) do  -- thru word
      a = words_in_problem[L][k]
      b = word[k]
      if isLetter(a) and isLetter(b) then
        a -= ('A'-1)
        b -= ('A'-1)
        if grid_pr[a][b] = 'F' then
          false_word = TRUE
          reduced = TRUE
          exit
        end if
      end if
    end for
    if false_word = FALSE then
      s[L] = append(s[L],word)  -- ???
    end if
  end for
reduced_lists = s
ShowGrid()
ShowCandidateWords()
return(reduced)
end function    -- ReduceLists
---------------------------------------------------------
procedure ShowWordsInProblem()
eraseItems(lstWords)
for i = 1 to length(words_in_problem) do
  addItem(lstWords,words_in_problem[i])
end for
setText(lblWords,sprintf("%d words",{length(words_in_problem)}))
end procedure  -- ShowCodeWords
---------------------------------------------------------
function SamePattern(sequence w1,sequence w2)  -- Return TRUE or FALSE.
if length(w1) != length(w2) then return(FALSE) end if
for i = 1 to length(w1)-1 do
  if (w1[i] = '\'') or (w1[i] = '-') then
    if w1[i] != w2[i] then return(FALSE) end if
  elsif (w2[i] = '\'') or (w2[i] = '-') then
    if w1[i] != w2[i] then return(FALSE) end if
  else
    for j = i+1 to length(w1) do
      if w1[i] = w1[j] then
        if w2[i] != w2[j] then
          return(FALSE)
        end if
      else  -- !=
        if w2[i] = w2[j] then
          return(FALSE)
        end if
      end if
    end for
  end if
end for
return(TRUE)
end function  -- SamePattern
---------------------------------------------------------
procedure MakeLists()
integer len
sequence wprob,wdict

original_lists = repeat({},length(words_in_problem))
setText(lblCand,"Making lists.....")
for i = 1 to length(words_in_problem) do
  wprob = words_in_problem[i]
  len = length(wprob)
  for j = 1 to length(dictionary) do
    wdict = dictionary[j]
    if length(wdict) = len then
      if SamePattern(wprob,wdict) then
        original_lists[i] = append(original_lists[i],wdict)
      end if
    end if
  end for
end for
reduced_lists = original_lists
setText(lblCand,"Finished lists.")
end procedure  -- MakeLists
---------------------------------------------------------
function cleanup(sequence s)   -- remove spaces,\n,make upper case
sequence s1,s2
s1 = upper(s)
s2 = ""

for i = 1 to length(s) do
  if find(s1[i],"ABCDEFGHIJKLMNOPQRSTUVWXYZ-'" ) then
    s2 = append(s2,s1[i])
  end if
end for
return(s2)
end function  -- cleanup

---------------------------------------------------------
procedure GetDictionaryFilename()
integer fn,fn1
object x

fn = open("dictionary.ini","r")
if fn != -1 then
  x = gets(fn)
  if sequence(x) then
    fn1 = open(x,"r")
    if fn1 != -1 then
      dictionary_filename = x
    end if
  end if
  close(fn)
end if
end procedure    -- GetDictionaryFilename
---------------------------------------------------------
procedure LoadDictionary()
integer fn
object x

if compare(dictionary_filename,"") != 0 then
  fn = open(dictionary_filename,"r")
  if fn != -1 then
    dictionary = {}
    setText(lblDict,"loading the dictionary...")
    setText(status,"Loading the dictionary .....")
    while 1 do
      x = gets(fn)
      if atom(x) then exit
      else
        x = cleanup(x)    -- remove spaces,\n,make upper case
        dictionary = append(dictionary,x)
      end if
    end while
    close(fn)
    setText(lblDict,dictionary_filename)
    if length(problem) > 0 then

      setText(status,"Making lists of candidate words. .....")
      ShowWordsInProblem()
      MakeLists()
      ShowCandidateWords()
      InitGrids()
      ShowGrid()
      setText(status,"Lists are done!")
    end if
  else  -- no dictionary
    GettaDictionary()
  end if
end if
end procedure  -- LoadDictionary
---------------------------------------------------------
procedure OneCycle(integer L)
integer r

r = TRUE
while r = TRUE do
  CopyFalses(L)
  ChangeSUtoTrue()
  r = ReduceLists(L)
  ShowCandidateWords()
  InitGrid_wd(L)
  ShowGrid()
  PrepareAbc()
  Translate()
end while
end procedure  -- OneCycle
---------------------------------------------------------
procedure Solve()
integer len,r

r = TRUE
len = length(words_in_problem)
while r != FALSE do
  r = FALSE
  for L = 1 to len do  CopyFalses(L)  end for
  ChangeSUtoTrue()
  for L = 1 to len do  r += ReduceLists(L) end for
  ShowCandidateWords()
  for L = 1 to len do  InitGrid_wd(L) end for
  ShowGrid()
  PrepareAbc()
  Translate()
end while
end procedure  -- Solve
---------------------------------------------------------
---------------------------------------------------------
-- events
---------------------------------------------------------
---------------------------------------------------------
procedure onClick_cmdProb()  -- Load a cryptogram.
integer fn
object x

if length(dictionary) > 0 then
  problem_filename = getOpenFileName(CryptWin,"cryptogram.txt",
              {".txt Files","*.txt","all files","*.*"})
  if compare(problem_filename,"") != 0 then
    fn = open(problem_filename,"r")
    if fn != -1 then
      setText(lblProbPath,problem_filename)
      setText(status,"Getting the problem, extracting words from the problem. ..")
      eraseItems(lstProblem)
      eraseItems(lstSolution)
      initStuff()
      InitGrid_pr()
      InitGrid_pr_test()
      problem = {}
      while 1 do
        x = gets(fn)
        if atom(x) then exit
        else
          x = x[1..length(x)-1]
          problem = append(problem,x)
          addItem(lstProblem,x)
        end if
      end while
      close(fn)
      problem = upper(problem)
      words_in_problem = ExtractedWords(problem)
      if length(dictionary) > 0 then
        setText(status,"Making lists of candidate words. .....")
        ShowWordsInProblem()
        MakeLists()
        original_lists = reduced_lists  -- in case of failure to solve
        ShowCandidateWords()
        InitGrids()
        ShowGrid()
      end if
    end if
  end if
  setText(status,"")
else
  GettaDictionary()
end if
end procedure
onClick[ cmdProb ] = routine_id("onClick_cmdProb")
---------------------------------------------------------
procedure onClick_cmdAll()  -- Reduce lists using all lists.
setText(status,"Reducing all lists, one cycle....")
for L = 1 to length(words_in_problem) do
  OneCycle(L)
end for
setText(status,"Finished reducing all lists.  Click on All again if necessary.")
end procedure
onClick[ cmdAll ] = routine_id("onClick_cmdAll")
---------------------------------------------------------
procedure onClick_cmdSolve()  -- Solve!
setText(status,"Solving!  Reducing all lists until no more words are deleted.")
Solve()
setText(status,"Finished solving! If multiple words remain, R-click on some.")
end procedure
onClick[ cmdSolve ] = routine_id("onClick_cmdSolve")
---------------------------------------------------------
procedure onClick_cmdSel()  -- Reduce lists using the selected list.
integer L

setText(status,"Reducing the selected list.")
L = getIndex(lstWords)
OneCycle(L)
setText(status,"Finished reducing the selected list.")
end procedure
onClick[ cmdSel ] = routine_id("onClick_cmdSel")
---------------------------------------------------------
procedure onClick_radPr()  --  Show grid for the whole problem.
ShowGrid()
end procedure
onClick[ radPr ] = routine_id("onClick_radPr")
---------------------------------------------------------
procedure onClick_radWd()  --  Show grid for one word in the problem.
ShowGrid()
end procedure
onClick[ radWd ] = routine_id("onClick_radWd")
---------------------------------------------------------
procedure onClick_About()  -- Information about this program.
mess = "This program solves and/or helps you solve cryptograms. \n"
 & "The default dictionary name is WORDS.TXT. \n"
 & "\n"
 & "This program was made using the Euphoria programming language \n"
 & "and David Cuny's win32lib.ew.  These and many more things can be \n"
 & "downloaded from:     http://www.RapidEuphoria.com  \n \n"
 & "To solve a cryptogram, first click on <cryptogram> to load one. \n"
 & "Then you can mess with 4 buttons and 2 lists and 2 grids. \n"
 & "<Solve!>  This will simply solve the cryptogram. \n"
 & "However, sometimes it works better if you guide the process. \n"
 & "Therefore you might sometimes prefer to use: \n"
 & "<Selected> or <All lists> \n"
 & "\n"
 & "If this program does not perform in a satisfactory manner, \n"
 & "first check for an update on:   http://www.edmc.net/~jstory  \n"
 & "If that's not good enough, gimme a holler. \n"
junk = message_box(mess,"About Cryptogram Solver",0)
end procedure
onClick[ MenuAbout ] = routine_id("onClick_About")
---------------------------------------------------------
procedure onClick_How()
mess ="The process of cryptogram solving is: \n\n"
 & "1. Make lists of candidate words. \n"
 & "2. Find letter associations for each list. \n"
 & "3. Find letter associations for the whole problem. \n"
 & "4. A single Unknown among 25 Falses (V. or H.) is a True. \n"
 & "5. A True implies 25 Falses both V. and H. \n"
 & "6. Remove words that have a False letter association. \n"
 & "7. On removal of words, go back to step 2 and repeat. \n"
 & "\n"
 & "By and large, with a good dictionary, this process works. \n"
 & "But there are two cases where the process does not work: \n"
 & "multiple solutions and no solution. \n"
 & "\n"
 &"\n"
junk = message_box(mess,"Solving Cryptograms",0)
end procedure
onClick[ MenuHow ] = routine_id("onClick_How")
---------------------------------------------------------
procedure onClick_HowM()
mess = "If reduction cannot go furthur and each list has at least one word, \n"
 & "and at least one list has more than one word, \n"
 & "then you have multiple solutions."
 & "This is easy to solve, by human intervention. \n"
 & "You can click on a word in the list of candidates and RightClick.\n"
 & "This will delete the word, thereby reducing the number of solutions.\n"
 & "Then you can resume reducing the lists. \n"
 & "\n"
 & "Sometimes you can know what words to reject because of context. \n"
 & "This is where the human mind has a great advantage over computer \n"
 & "algorithms (at least in 2000). \n"
 & "\n"
junk = message_box(mess,"Multiple Solutions",0)
end procedure
onClick[ MenuHowM ] = routine_id("onClick_HowM")
---------------------------------------------------------
procedure onClick_HowN()
mess =
   "If you see #'s, that means at least one necessary word is missing from \n"
 & "at least one list. This is the problem of incomplete data. \n"
 & "The ideal solution is to have a dictionary that has all the needed words.\n"
 & "If that is not possible, then this is a difficult problem to solve. \n"
 & "\n"
 & "Incomplete data can cause furthur errors, which can lead to furthur errors,\n"
 & "until possibly a wipeout.  Therefore you might want to walk thru slowly \n"
 & "to get the 'maximum' solution. \n"
 & "\n"
 & "You might still be able to solve the cryptogram if you can identity or \n"
 & "guess which list(s) are missing the necessary word(s).\n"
 & "Reduce only the good lists. Don't use All or Solve. \n"
 & "You might get the letters of the word(s) it doesn't have.\n"
 & "\n"
 & "Click <Original> to try the problem again."
 & "\n"
junk = message_box(mess,"No Solution",0)
end procedure
onClick[ MenuHowN ] = routine_id("onClick_HowN")
---------------------------------------------------------
procedure onClick_chkHints()  -- Hints.
if isChecked(chkHints) then
  setHint(lstWords,"View the candidate words for the selected cryptogram word.")
  setHint(lstCand,"Right-click deletes an item.")
  setHint(lstProblem,"This program solves cryptograms.")
  setHint(lstSolution,"Unknown or non-existent solution = ? ")
  setHint(cmdSel,"Reduce selected list.")
  setHint(cmdAll,"Reduce all lists.")
  setHint(cmdSolve,"Simply solve the cryptogram.")
  setHint(cmdOrig,"Try again.")
  setHint(cmdProb,"Load a cryptogram.")
  setHint(radPr,"Show letter associations for the whole problem")
  setHint(radWd,"Show letter associations for selected list.")
else
  setHint(lstWords,"")
  setHint(lstCand,"")
  setHint(lstProblem,"")
  setHint(lstSolution,"")
  setHint(cmdSel,"")
  setHint(cmdAll,"")
  setHint(cmdSolve,"")
  setHint(cmdOrig,"")
  setHint(cmdProb,"")
  setHint(radPr,"")
  setHint(radWd,"")
end if
end procedure
onClick[ chkHints ] = routine_id("onClick_chkHints")
---------------------------------------------------------
procedure onChange_lstWords()  --
ShowCandidateWords()
if isChecked(radWd) then
  ShowGrid()
end if
end procedure
onChange[ lstWords ] = routine_id("onChange_lstWords")
---------------------------------------------------------
procedure onMouse_lstCand(integer event,integer x,integer y,integer shift)
integer index,L,len,junk
sequence s

if event =  RightDown then
  index = getIndex(lstCand)
  if index > 0 then
    L = getIndex(lstWords)
    if L > 0 then
      len = length(reduced_lists[L])

      if index = 1 then
        reduced_lists[L] = reduced_lists[L][2..len]
      elsif index = len then
        reduced_lists[L] = reduced_lists[L][1..(len-1)]
      else
        reduced_lists[L] = reduced_lists[L][1..index-1]
                         & reduced_lists[L][(index+1)..len]
      end if
     junk = deleteItem(lstCand,index)
    end if
  end if
end if
end procedure
onMouse[ lstCand ] = routine_id("onMouse_lstCand")
---------------------------------------------------------
procedure onClick_cmdOrig()    -- In the case of failure to solve.
reduced_lists = original_lists
eraseItems(lstCand)
eraseItems(lstSolution)
abc = repeat('?',26)
solution = {}
InitGrids()
setText(status,"We are back to the original lists. Try again.")
end procedure
onClick[cmdOrig] = routine_id("onClick_cmdOrig")
---------------------------------------------------------
procedure onClick_MenuExit()

closeWindow(CryptWin)
end procedure
onClick[MenuExit] = routine_id("onClick_MenuExit")
---------------------------------------------------------
procedure onClick_MenuDict()  -- Change default dictionary_name.
integer fn,fn1
sequence d_filename

setText(status,"Gimme a dictionary!")
d_filename = getOpenFileName(CryptWin,"dictionary.txt",
       {".txt Files","*.txt","all files","*.*"})

if compare(d_filename,"") != 0 then
  fn = open(d_filename,"r")
  if fn != -1 then
    dictionary_filename = d_filename
    fn1 = open("dictionary.ini","w")
    if fn1 != -1 then
      puts(fn1,dictionary_filename)
      close(fn1)
    end if
    LoadDictionary()
    setText(status,"Dictionary is loaded.  Now gitta problem to solve!")
  else
  end if
  close(fn)
end if
end procedure
onClick[MenuDict] = routine_id("onClick_MenuDict")
---------------------------------------------------------
procedure onClick_MenuMakeF()  -- Make a cryptogram from file.
sequence crypto_filename,c_filename
integer fn,fn1
object x

crypto_filename = getOpenFileName(CryptWin,"solution.txt",
              {".txt Files","*.txt","all files","*.*"})
if compare(crypto_filename,"") != 0 then
  fn = open(crypto_filename,"r")
  if fn != -1 then
    setText(status,"Making a cryptogram.")
    eraseItems(lstProblem)
    eraseItems(lstSolution)
    initStuff()
    InitGrid_pr()
    InitGrid_pr_test()
    problem = {}
    while 1 do
      x = gets(fn)
      if atom(x) then exit
      else
        x = x[1..length(x)-1]
        problem = append(problem,x)
        addItem(lstProblem,x)
      end if
    end while
    close(fn)
    problem = upper(problem)
    words_in_problem = ExtractedWords(problem)
    ShuffleAbc()
    Translate()
    setText(status,"Gimme a file name to save the cryptogram to.")

    c_filename = getSaveFileName(CryptWin,"cryptogram.txt",
              {".txt Files","*.txt","all files","*.*"})
    if compare(c_filename,"") = 0 then
      c_filename = "cryptogram.txt"
    end if
    fn1 = open(c_filename,"w")
    if fn1 != -1 then
      for i = 1 to length(solution) do
        puts(fn1,solution[i])
        puts(fn1,"  \n")
      end for
      close(fn1)
    end if
    setText(status,"Cryptogram saved....")
  end if
end if
end procedure
onClick[MenuMakeF] = routine_id("onClick_MenuMakeF")
---------------------------------------------------------
procedure onClick_MenuMakeM()  -- Make a cryptogram from prompt_string  -- MLE.
integer junk

junk = message_box("This part is not yet done. Make a file.","NOT YET DONE",0)
end procedure
onClick[MenuMakeM] = routine_id("onClick_MenuMakeM")
---------------------------------------------------------
GetDictionaryFilename()
LoadDictionary()
---------------------------------------------------------
WinMain(CryptWin,Normal)