home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / puzz.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  148 lines
  1. ############################################################################
  2. #
  3. #    File:     puzz.icn
  4. #
  5. #    Subject:  Program to create word search puzzle
  6. #
  7. #    Author:   Chris Tenaglia
  8. #
  9. #    Date:     February 18, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program creates word search puzzles.
  18. #
  19. ############################################################################
  20.  
  21. global matrix,      # the actual puzzle board
  22.        width,       # width of the puzzle
  23.        height,      # height of the puzzle
  24.        completed    # number of completed word placements
  25.  
  26. procedure main(param)
  27.   local i, j, line, pass, tokens, word, words
  28.  
  29. #
  30. # initial set up : x=20, y=20 by default
  31. #
  32.   width  := param[1] | 20
  33.   height := param[2] | 20
  34.   words  := []
  35. #
  36. # load words to place in a space delimited
  37. # file. more than one word per line is ok.
  38. #
  39.   while line := map(read()) do
  40.     {
  41.     tokens := parse(line,' \t')
  42.     while put(words,pop(tokens))
  43.     }
  44. #
  45. # get ready for main processing
  46. #
  47.   matrix    := table(" ")
  48.   pass      := 0
  49.   completed := 0
  50.   &random:= map(&clock,":","0")
  51. #
  52. # here's the actual word placement rouinte
  53. #
  54.   every word := !words do place(word)
  55. #
  56. # fill in the unchosen areas with random alphas
  57. #
  58.   every i := 1 to height do
  59.     every j := 1 to width do
  60.       if matrix[i||","||j] == " " then
  61.          matrix[i||","||j] := ?(&ucase)
  62. #
  63. # output results (for the test giver, words are lcase, noise is ucase)
  64. #
  65.   write(completed," words inserted out of ",*words," words.\n")
  66.   write("\nNow for the puzzle you've been waiting for! (ANSWER)\n")
  67.   every i := 1 to height do
  68.     {
  69.     every j := 1 to width do writes(matrix[i||","||j]," ")
  70.     write()
  71.     }
  72. #
  73. # output results (for the test taker, everything is upper case
  74. #
  75.   write("\fNow for the puzzle you've been waiting for! (PUZZLE)\n")
  76.   every i := 1 to height do
  77.     {
  78.     every j := 1 to width do writes(map(matrix[i||","||j],&lcase,&ucase)," ")
  79.     write()
  80.     }
  81.   end
  82.  
  83. #
  84. # this procedure tries to place the word in a copy of the matrix
  85. # if successful the updated copy is moved into the original
  86. # if not, the problem word is skipped after 20 tries
  87. #
  88. procedure place(str)
  89.   local byte, construct, direction, item, pass, x, xinc, y, yinc
  90.   static xstep,ystep
  91.  
  92.   initial {
  93.           xstep := [0,1,1,1,0,-1,-1,-1]
  94.           ystep := [-1,-1,0,1,1,1,0,-1]
  95.           }
  96.   pass := 0
  97.  
  98.   repeat  {
  99.   if (pass +:= 1) > 20 then
  100.     { 
  101.     write("skipping ",str)
  102.     fail
  103.     }
  104.   direction := ?8
  105.   xinc      := integer(xstep[direction])
  106.   yinc      := integer(ystep[direction])
  107.  
  108.   if xinc < 0 then x := *str + ?(width - *str)
  109.   if xinc = 0 then x := ?height
  110.   if xinc > 0 then x := ?(width - *str)
  111.  
  112.   if yinc < 0 then y := *str + ?(height - *str)
  113.   if yinc = 0 then y := ?width
  114.   if yinc > 0 then y := ?(height - *str)
  115.  
  116.   if (x < 1) | (y < 1) then stop(str," too long.")
  117.  
  118.   construct := copy(matrix)
  119.   item      := str
  120.   write("placing ",item)
  121.   every byte := !item do
  122.     {
  123.     if (construct[x||","||y] ~== " ")  &
  124.        (construct[x||","||y] ~== byte) then break next
  125.     construct[x||","||y] := byte
  126.     x +:= xinc
  127.     y +:= yinc
  128.     }
  129.   matrix     := copy(construct)
  130.   completed +:= 1
  131.   return "ok"
  132.   } # end repeat
  133.   return "ok"
  134.   end
  135.  
  136. #
  137. # parse a string into a list with respect to a delimiter (cset)
  138. #
  139. procedure parse(line,delims)  
  140.   local tokens
  141.   static chars
  142.  
  143.   chars  := &cset -- delims
  144.   tokens := []
  145.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  146.   return tokens
  147.   end
  148.