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 / verse.icn < prev    next >
Text File  |  2000-07-29  |  14KB  |  446 lines
  1. ############################################################################
  2. #
  3. #    File:     verse.icn
  4. #
  5. #    Subject:  Program to generate bizarre verses
  6. #
  7. #    Author:   Chris Tenaglia
  8. #
  9. #    Date:     May 26, 1992
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This verse maker was initially published in an early 1980s Byte magazine in
  18. #  TRS80 Basic. In 1985 I translated it to BASICA, and in 1987 I translated it
  19. #  to Icon. Recently, I've polished it to fetch the vocabulary all from one
  20. #  file.
  21. #  
  22. #  A vocabulary file can be specified on the command line; otherwise
  23. #  file it looks for verse.dat by default. See that file for examples
  24. #  of form.
  25. #  
  26. ############################################################################
  27. #
  28. #  Links:  random
  29. #
  30. ############################################################################
  31.  
  32. link random
  33.  
  34. global nouns,nounp,adjt,advb,more,most,ivpre,ivpas,tvpre,tvpas,prep
  35. global being,art,ques,cond,nompro,punc,noun1,noun2,tv,iv,adjv,prpo
  36. global be,pun,pron,con,ar,tnnum,tadjno,ttvnum,tprnum,cls,name,watch
  37.  
  38. procedure main(param)
  39.   local in, part, line, tmp, reply, Out, In, t
  40.  
  41.   randomize()
  42.   nouns := []                         #singular nouns
  43.   nounp := []                         #plural nouns
  44.   adjt  := []                         #adjectives
  45.   advb  := []                         #adverbized
  46.   more  := []                         #more adjective
  47.   most  := []                         #most adjective
  48.   tvpas := []                         #transitive verb past
  49.   tvpre := []                         #transitive verb present
  50.   ivpas := []                         #intransitive verb past
  51.   ivpre := []                         #intransitive verb present
  52.   prep  := []                         #prepositions
  53.   punc  := []                         #punctuations
  54.   art   := []                         #articles of speech
  55.   ques  := []                         #question words
  56.   being := []                         #being verbs
  57.   cls   := "\e[H\e[2J"                #clear screen string (or system("clear"))
  58.  
  59. ############################################################################
  60. #                                                            #
  61. #                 load the vocabulary arrays                 #
  62. #                                                            #
  63. ############################################################################
  64.  
  65.   name := param[1]    | "verse.dat"
  66.   (in  := open(name)) | stop("Can't open vocabulary file (",name,")")
  67.   part := "?" ; watch := "?"
  68.   write(cls,"VERSE : AI Mysterious Poetry Generator\n\nInitializing\n\n")
  69.   while line := read(in) do
  70.     {
  71.     if match("%",line) then
  72.       {
  73.       part := map(trim(line[2:0]))
  74.       write("Loading words of type ",part)
  75.       next
  76.       }
  77.     tmp := parse(line,'|@#')
  78.     case part of   
  79.       {
  80.       "noun" : {
  81.                put(nouns,tmp[1])
  82.                put(nounp,tmp[2])
  83.                }
  84.       "adjt" : {
  85.                put(adjt,tmp[1])
  86.                put(advb,tmp[2])
  87.                put(more,tmp[3])
  88.                put(most,tmp[4])
  89.                }
  90.       "ivrb" : {
  91.                put(ivpre,tmp[1])
  92.                put(ivpas,tmp[2])
  93.                }
  94.       "tvrb" : {
  95.                put(tvpre,tmp[1])
  96.                put(tvpas,tmp[2])
  97.                }
  98.       "prep" : put(prep,line)
  99.       "been" : put(being,line)
  100.       default: write("Such Language!")
  101.       }
  102.     loadrest()
  103.     }
  104.   close(in)
  105. reply := ""
  106. while map(reply) ~== "q" do
  107.   {
  108. #
  109. #                         output the title
  110. #
  111.   (Out := open("a.out","w")) | stop ("can't open a.out for some reason!")
  112.  
  113.   t := ?7
  114.   tnnum := ?*(nouns)                   #title noun selector
  115.   tadjno:= ?*(adjt)                    #title adjective selector
  116.   ttvnum:= ?*(tvpre)                   #title transitive verb selector
  117.   tprnum:= ?*(prep)                    #title preposition selector
  118.   
  119.   clrvdu()
  120.   write(title(t))
  121.   write(Out,title(t))
  122.   write()
  123.   write(Out)
  124.  
  125. #
  126. #                        output the lines
  127. #
  128.     every 1 to (12+?6) do
  129.       {
  130.       noun1 := ?*(nouns)
  131.       noun2 := ?*(nouns)
  132.       tv    := ?*(tvpre)
  133.       iv    := ?*(ivpre)
  134.       adjv  := ?*(adjt)
  135.       prpo  := ?*(prep)
  136.       be    := ?*(being)
  137.       pun   := ?*(punc)
  138.       pron  := ?*(nompro)
  139.       con   := ?*(cond)
  140.       ar    := ?*(art)
  141.        
  142.       case ?19 of
  143.         {
  144.         1 : {write(form1()) ; write(Out,form1())}
  145.         2 : {write(form2()) ; write(Out,form2())}
  146.         3 : {write(form3()) ; write(Out,form3())}
  147.         4 : {write(form4()) ; write(Out,form4())}
  148.         5 : {write(form5()) ; write(Out,form5())}
  149.         6 : {write(form6()) ; write(Out,form6())}
  150.         7 : {write(form7()) ; write(Out,form7())}
  151.         8 : {write(form8()) ; write(Out,form8())}
  152.         9 : {write(form9()) ; write(Out,form9())}
  153.        10 : {write(form10()) ; write(Out,form10())}
  154.        11 : {write(form11()) ; write(Out,form11())}
  155.        12 : {write(form12()) ; write(Out,form12())}
  156.        13 : {write(form13()) ; write(Out,form13())}
  157.        14 : {write(form14()) ; write(Out,form14())}
  158.        15 : {write(form15()) ; write(Out,form15())}
  159.        16 : {write(form16()) ; write(Out,form16())}
  160.        17 : {write(form17()) ; write(Out,form17())}
  161.        18 : {write(form18()) ; write(Out,form18())}
  162.        19 : {write(form19()) ; write(Out,form19())}
  163.         }   
  164.     }
  165. # last line
  166.   case ?2 of
  167.     {
  168.     1 : {
  169.         write(nounp[tnnum]," ",prep[prpo]," THE ",nouns[noun1],
  170.         " ",being[be]," ",adjt[tadjno],".")
  171.         write(Out,nounp[tnnum]," ",prep[prpo]," THE ",nouns[noun1],
  172.         " ",being[be]," ",adjt[tadjno],".")
  173.         }
  174.     2 : {
  175.         write("THE ",nounp[tnnum]," OR ",nouns[noun1]," ",
  176.         adjt[adjv]," ",being[be],".")
  177.         write(Out,"THE ",nounp[tnnum]," OR ",nouns[noun1]," ",
  178.         adjt[adjv]," ",being[be],".")
  179.         }
  180.     }      
  181.     close(Out)
  182.  
  183.     write()
  184.     writes("Press <RET> for another, Q to quit, or a name to save it>")
  185.     reply := read()
  186.     if (reply ~== "Q") & (trim(reply) ~== "") then
  187.       {
  188.       (In := open("a.out")) | stop ("can't open a.out for some reason!")
  189.       (Out := open(reply,"w")) | stop ("can't open ",reply)
  190.       while write(Out,read(In))
  191.       close(In) ; close(Out)
  192.       }
  193.   }
  194.   end
  195.  
  196. ############################################################################
  197.  
  198. procedure aoran(word)
  199.   local vowels
  200.  
  201.   vowels := 'AEIOU'
  202.   if any(vowels,word) then return ("AN " || word)
  203.                       else return ("A "  || word)
  204. end
  205.  
  206. ############################################################################
  207.  
  208. procedure clrvdu()
  209.   writes(cls)
  210. end
  211.  
  212. ############################################################################
  213.  
  214. procedure gerund(word)
  215.   static vowel
  216.   initial vowel := 'AEIOU'
  217.   if word[-1] == "E" then word[-1] := ""
  218.   return(word || "ING")
  219. end
  220.  
  221. ############################################################################
  222.  
  223. procedure title(a)
  224.  
  225.     local text
  226.  
  227.     case a of
  228.       {               
  229.       1 : text := aoran(adjt[tadjno]) || " " || nouns[tnnum]
  230.       2 : text := "TO " || tvpre[ttvnum] || " SOME " || nouns[tnnum]
  231.       3 : text := prep[tprnum] || " " || nounp[tnnum]
  232.       4 : text := "THE " || nouns[tnnum]
  233.       5 : text := prep[tprnum] || " " || aoran(nouns[tnnum]) || " " || advb[tadjno]
  234.       6 : text := "THE " || more[tadjno] || " " || nouns[tnnum]
  235.       7 : text := "THE " || most[tadjno] || " " || nouns[tnnum]
  236.       }
  237.     return(text)
  238. end
  239.  
  240. ############################################################################
  241.  
  242. procedure form1()
  243.   local text, n, prefix
  244.   n := 1
  245.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  246.   text := prefix || nounp[noun1] || " " || tvpre[tv] || " THE "
  247.   text ||:= more[adjv] || " " || nouns[noun2] || punc[pun]
  248.   return(text)
  249. end
  250.  
  251. procedure form2()
  252.   local text, n, prefix
  253.   n := 2
  254.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  255.   text := prefix || nounp[noun1] || " " || tvpre[tv] || " THE "
  256.   text ||:= most[adjv] || " " || nouns[noun2] || punc[pun]
  257.   return(text)
  258. end
  259.  
  260. procedure form3()
  261.   local text, n, prefix
  262.   n := 3
  263.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  264.   text := prefix || adjt[adjv] || " " || nounp[noun1] || " " || being[be]
  265.   text ||:= " " || gerund(ivpre[iv]) || " " || punc[pun]
  266.   return(text)
  267. end  
  268.  
  269. procedure form4()
  270.   local text, n, prefix
  271.   n := 4
  272.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  273.   text := prefix || adjt[adjv] || " " || nounp[noun1] || " " || ivpre[iv]
  274.   text ||:= " " || punc[pun]
  275.   return(text)
  276. end
  277.  
  278. procedure form5()
  279.   local text, n, prefix
  280.   n := 5
  281.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  282.   text := prefix || ques[?*ques] || " " || adjt[adjv] || " "
  283.   text ||:= nounp[noun1] || " " || ivpre[iv] || "?"
  284.   return(text)
  285. end
  286.  
  287. procedure form6()
  288.   local text, n, prefix
  289.   n := 6
  290.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  291.   text := prefix || art[ar] || " " || adjt[adjv] || " " || nouns[noun1]
  292.   text ||:= " " || tvpas[tv] || " THE " || nouns[noun2] || punc[pun]
  293.   return(text)
  294. end
  295.  
  296. procedure form7()
  297.   local text, n, prefix
  298.   n := 7
  299.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  300.   text := prefix || "THE " || nounp[tnnum] || " " || ivpas[iv]
  301.   text ||:= " " || prep[prpo] || " THE " || more[tadjno] || " "
  302.   text ||:= nounp[noun1] || " " || punc[pun]
  303.   return(text)
  304. end
  305.  
  306. procedure form8()
  307.   local text, n, prefix
  308.   n := 8
  309.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  310.   text := prefix || "THE " || nounp[tnnum] || " " || ivpas[iv] || " " 
  311.   text ||:= prep[prpo] || " THE " || most[tadjno] || " " || nounp[noun1]
  312.   text ||:= " " || punc[pun]
  313.   return(text)
  314. end
  315.  
  316. procedure form9()
  317.   local text, n, prefix
  318.   n := 9
  319.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  320.   text := prefix || ques[?*ques] || " " || nounp[tnnum] || " " || ivpre[iv]
  321.   text ||:= " " || prep[prpo] || " " || aoran(adjt[adjv]) || " "
  322.   text ||:= nouns[noun2] || "?"
  323.   return(text)
  324. end
  325.  
  326. procedure form10()
  327.   local text, n, prefix
  328.   n := 10
  329.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  330.   text := prefix || nounp[noun1] || " " || ivpre[iv] || " " || advb[adjv]
  331.   text ||:= " " || prep[prpo] || " " || nompro[pron] || punc[pun]
  332.   return(text)
  333. end
  334.  
  335. procedure form11()
  336.   local text, n, prefix
  337.   n := 11
  338.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  339.   text := prefix || adjt[adjv] || " " || nounp[noun1] || " " || being[be]
  340.   text ||:= " " || adjt[tadjno] || " " || cond[con]
  341.   return(text)
  342. end
  343.  
  344. procedure form12()
  345.   local text, n, prefix
  346.   n := 12
  347.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  348.   text := prefix || art[ar] || " " || nouns[noun1] || " " || ivpas[iv]
  349.   text ||:= " " || advb[adjv] || punc[pun]
  350.   return(text)
  351. end
  352.  
  353. procedure form13()
  354.   local text, n, prefix
  355.   n := 13
  356.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  357.   text := prefix || cond[con] || " " || nounp[noun1] || " " || being[be]
  358.   text ||:= " " || gerund(tvpre[ttvnum]) || " " || prep[prpo] || " "
  359.   text ||:= gerund(ivpre[iv]) || " " || nounp[noun2] || punc[pun]
  360.   return(text)
  361. end
  362.  
  363. procedure form14()
  364.   local text, n, prefix
  365.   n := 14
  366.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  367.   text := prefix || art[ar] || " " || adjt[adjv] || " " || gerund(tvpre[tv])
  368.   text ||:= " OF THE " || nouns[tnnum] || " AND " || nouns[noun1] || punc[pun]
  369.   return(text)
  370. end
  371.  
  372. procedure form15()
  373.   local text, n, prefix
  374.   n := 15
  375.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  376.   text := prefix || gerund(tvpre[ttvnum]) || " " || nouns[noun1]
  377.   text ||:= " AND " || nouns[noun2]
  378.   return(text)
  379. end
  380.  
  381. procedure form16()
  382.   local text, n, prefix
  383.   n := 16
  384.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  385.   text := prefix || "THE " || nounp[tnnum] || " " || ivpre[iv] || punc[pun]
  386.   return(text)
  387. end
  388.  
  389. procedure form17()
  390.   local text, n, prefix
  391.   n := 17
  392.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  393.   text := prefix || nompro[pron] || " " || tvpas[ttvnum] || " THE "
  394.   text ||:= adjt[adjv] || " " || nouns[noun1] || punc[pun]
  395.   return(text)
  396. end
  397.  
  398. procedure form18()
  399.   local text, n, prefix
  400.   n := 18
  401.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  402.   text := prefix || adjt[adjv] || " " || nounp[noun2] || " " || being[be]
  403.   text ||:= " " || nounp[noun1] || punc[pun]
  404.   return(text)
  405. end
  406.  
  407. procedure form19()
  408.   local text, n, prefix
  409.   n := 19
  410.   if watch=="true" then prefix := "(" || n || ") " else prefix := ""
  411.   text := prefix || "THE " || nounp[tnnum] || "'S " || nounp[noun1] || " "
  412.   text ||:= adjt[adjv] || " " || being[be] || punc[pun]
  413.   return(text)
  414. end
  415.  
  416. ############################################################################
  417.        
  418. procedure parse(line,delims)  
  419.   static chars
  420.   local tokens
  421.  
  422.   chars  := &cset -- delims
  423.   tokens := []
  424.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  425.   return tokens
  426.   end
  427.  
  428. procedure loadrest()
  429.   art   := ["ITS" , "THIS" , "SOME", "ANY" , "ONE" , "THAT" ,
  430.             "ITS" , "MY" , "YOUR" , "OUR"]
  431.  
  432.   ques  := ["WHY DO" , "WHEN DO" , "WHERE DO" , "HOW DO" , "CANNOT" ,
  433.             "HOW COME" , "WHY DON'T"]
  434.  
  435.   nompro := ["SOMETHING" , "ANYTHING" , "IT" , "THAT" , "ONE" , "YOU" , "THIS"]
  436.           
  437.   cond  := ["SINCE" , "BECAUSE" , "UNTIL" , "IF" , "THEN" , "OR" ,
  438.             "UNLESS" , "THEREFORE" , "AND THEN" , "OR ELSE" , "ELSE IF"]
  439.  
  440.   punc  := ["." , "," , "?" , "!" , "," , "-" , ";"]
  441. end
  442.  
  443.  
  444.  
  445.  
  446.