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