From decwrl!decvax!tektronix!tekgen!tekred!games Wed Feb 15 19:55:57 PST 1989 Article 470 of comp.sources.games: Path: granite!decwrl!decvax!tektronix!tekgen!tekred!games From: games@tekred.CNA.TEK.COM Newsgroups: comp.sources.games Subject: v06i004: sonnet - a program to compose poetry, Part01/02 Message-ID: <3608@tekred.CNA.TEK.COM> Date: 13 Feb 89 20:25:41 GMT Sender: billr@tekred.CNA.TEK.COM Lines: 1385 Approved: billr@saab.CNA.TEK.COM Submitted by: Rich Salz Comp.sources.games: Volume 6, Issue 4 Archive-name: sonnet/Part01 [From the author... -br] [[Chris Wilbur wrote this a few years ago. I recently resurrected the code and completely overhauled it with Chris's input. If you understand the algorithm, you can change it to write your favorite form of poetry with a bit of work. I generalized much of the code, but anything other than iambic pentameter sonnets will still take a bit of doing. By default, the Makefile is set up to compile on a fairly modern Unix system. It uses getopt and strchr/strrchr. If you need getopt, or use index/rindex, you'll have to edit the Makefile. It also uses curses, which is found in the "terminfo" library on some systems. The program doesn't use any fancy curses functions, so at most you should just need to edit the Makefile. If you find any bugs, send them to us. If you add more than, say, 50 words to the database, send them to us, too. No funk effete plebian France of stun Obscure avoirdupois no Job petite Hysterical success impromptu sun Recessive friends the stun environ heat Pronto the pile without beplastered food Mouthpiece ambitious midrange kernel sponge Computer jaundiced brushoff fire collude Machismo epitaph excessive plunge Romance robotic twilight zone and chirp Appeal with huge reversion memo fruit Abhorred cantata foreign frowzy twerp Intrinsic brilliance jimson footwork cute Incestuous exemplify of dull Immense ambitious products hideous null /rich $alz Chris Wilbur ]] #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh 'MANIFEST' <<'END_OF_FILE' X File Name Archive # Description X----------------------------------------------------------- X MANIFEST 1 This shipping list X Makefile 1 Compilation instructions for make(1) X README 1 Introduction X compose.c 1 The main poetry-writing routines X getopt.c 1 Getopt routine, if you need it X lex.data 2 Dictionary X makelex.c 1 Convert the dictionary to C code X patchlog.h 1 Mistake recorder X sonnet.6 1 Manual page X sonnet.c 1 Curses-based driver for compose X sonnet.h 1 Constants used by this package END_OF_FILE if test 695 -ne `wc -c <'MANIFEST'`; then echo shar: \"'MANIFEST'\" unpacked with wrong size! fi # end of 'MANIFEST' fi if test -f 'Makefile' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Makefile'\" else echo shar: Extracting \"'Makefile'\" \(1456 characters\) sed "s/^X//" >'Makefile' <<'END_OF_FILE' X## X## Makefile for sonnet. X## $Header: Makefile,v 2.0 89/02/08 16:29:38 rsalz Release1 $ X## X X## Some systems have strchr/strrchr, some have index/rindex. X## If you're the latter, then uncomment the next line. X#DEFS = -DUSE_INDEX X X## If getopt isn't in your C library, and you can't add it, uncomment X## these two lines. X#GET_c = getopt.c X#GET_o = getopt.o X X## On some systems, curses is just part of terminfo or termlib. X#LIBS = -lterminfo XLIBS = -lcurses -ltermcap X X## If you don't want to check the code against the library use for lint, X## edit this line XLLIBS = $(LIBS) X X## If you add to the database, put the words here. X#LEXERS = lex.data lex.bbn XLEXERS = lex.data X X## X## END OF CONFIG SECTION X## X XCFLAGS = -g $(DEFS) X XSOURCES = sonnet.c compose.c $(GET_c) XOBJECTS = sonnet.o compose.o $(GET_o) X Xall: sonnet sonnet.6 X Xinstall: all X @echo Install according to local convention X Xclean: X rm -f foo core tags a.out lint lints lintm X rm -f sonnet lex.c makelex $(OBJECTS) X Xshar: X makekit -m -nSHAR X @rm -f MANIFEST.BAK X## Xlint: lints lintm Xlints: sonnet X lint -a -b -h $(DEFS) $(SOURCES) $(LLIBS) >lints Xlintm: makelex X lint -a -b -h $(DEFS) makelex.c >lintm X X## Xsonnet: $(OBJECTS) X @rm -f sonnet X $(CC) $(CFLAGS) -o sonnet $(OBJECTS) $(LIBS) X Xmakelex: makelex.c sonnet.h X @rm -f makelex X $(CC) $(CFLAGS) -o makelex makelex.c X X## X$(OBJECTS): sonnet.h Xcompose.o: lex.c Xlex.c: lex.data makelex X @rm -f lex.c X ./makelex $(LEXERS) >lex.c END_OF_FILE if test 1456 -ne `wc -c <'Makefile'`; then echo shar: \"'Makefile'\" unpacked with wrong size! fi # end of 'Makefile' fi if test -f 'README' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'README'\" else echo shar: Extracting \"'README'\" \(2770 characters\) sed "s/^X//" >'README' <<'END_OF_FILE' X XSONNET INTRODUCTION X------------------- X XChris Wilbur wrote this a few years ago. I recently resurrected the code Xand completely overhauled it with Chris's input. If you understand the Xalgorithm, you can change it to write your favorite form of poetry with a Xbit of work. I generalized much of the code, but anything other than Xiambic pentameter sonnets will still take a bit of doing. X XBy default, the Makefile is set up to compile on a fairly modern Unix Xsystem. It uses getopt and strchr/strrchr. If you need getopt, or use Xindex/rindex, you'll have to edit the Makefile. It also uses curses, Xwhich is found in the "terminfo" library on some systems. The program Xdoesn't use any fancy curses functions, so at most you should just need Xto edit the Makefile. X XThe database used by the program is in the lex.data file, which is then Xconverted into a C array by the utility program makelex. "It's easy and Xfun to add new words to the vocabulary." (Those are Chris's words; I Xdon't think it's very easy, and it's certainly not fun.) X XThe lex.data file consist of four colon-separated fields: X word : foot_type : vowel_sound : consonant_type X XThe word is (obviously) the word itself. X XThe foot_type is the metrical pattern of the word; it represents the Xword's rhythm. The legal values are the #define's in "sonnet.h" that Xstart with FT_. You learn the meanings of the values quickly as you add Xwords; until you do, it's easiest to find a word with the same rhythm as Xthe one you're adding. For example, if you add "inflammatory" you would Xscan the list and see that "administration" has the pattern, so you'd use XIIFF. If you use the wrong pattern you'll end up with lines that don't Xscan, so be careful. X XThe vowel_sound and the consonant_type fields determine the actual Xrhymes. The vowel sound is always a constant and are the #define's that Xbegin with VS_. For example VS_LI is a long "i" as in "mice" while VS_SI Xis a short "i" as in "fish." For more information, see the header file. X XThe consonant_type field is either a single lower-case letter ("t" for Xwords like "cat" "bat" and "rat") or a #define'd constant for a compound Xconsonant (ST for words like "best" "pest" and "undressed"). You can add Xyour own values to the consonant_type field, but make sure you don't use Xany of the lower-case letters or you'll get bogus rhymes. X XWhen adding a word, check to make sure that there a couple of words with Xsimilar rhymes, and and other entries if there don't seem to be many. X XIf you find any bugs, send them to us. If you add more than, say, 50 Xwords to the database, send them to us, too. X /rich $alz Chris Wilbur X X X X$Header: README,v 2.0 89/02/08 16:29:45 rsalz Release1 $ END_OF_FILE if test 2770 -ne `wc -c <'README'`; then echo shar: \"'README'\" unpacked with wrong size! fi # end of 'README' fi if test -f 'compose.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'compose.c'\" else echo shar: Extracting \"'compose.c'\" \(8502 characters\) sed "s/^X//" >'compose.c' <<'END_OF_FILE' X/* X** COMPOSE X** A routine to write some poetry. X*/ X#include "sonnet.h" X#include X#ifndef lint Xstatic char RCS[] = X "$Header: compose.c,v 2.0 89/02/08 16:29:51 rsalz Release1 $"; X#endif /* lint */ X X/* X** Load the database. The list has a dummy entry at the end, hence X** the non-standard "-1" in NWORDS. X*/ X#include "lex.c" X#define NWORDS (sizeof Words / sizeof Words[0] - 1) X X X/* X** A couple of magic percentages. Feel free to tweak them. X*/ X#define PAD_FACTOR 32 /* For adding a pad word */ X#define REV_FACTOR 3 /* For reversing first foot */ X X X/* X** Generate a random number between 0 and n-1. This is stolen from X** hack, markov3, etc., etc., and should be portable. If you change it, X** make sure to read your manual pages carefully, and note that the bottom X** bits are usually not very random. X*/ X#define ROLL(n) ((rand() >> 3) % (n)) X X X/* X** Externally-available variables. X*/ XLINETYPE *Lines; /* The poem */ Xint Lcount; /* Number of lines/poem */ Xint NumBeats; /* Number of beats/line */ X X X/* X** Magic data structures. X*/ Xstatic char hendec[] = "01010101010"; Xstatic char revdec[] = "10010101010"; X Xstatic char *OddRhythm[] = { X "0", "1", "01", "10", "11", "10", "01", X "010", "0101", "1010", "01010","1010", "101", "10101" X}; X Xstatic char *EvenRhythm[] = { X "0", "01", "01", "10", "11", "10", "01", X "010", "0101", "1010", "01010","1010", "101", "10101" X}; X X X X/* X** Return TRUE if the letter is a vowel. X*/ Xstatic int XIsVowel(c) X char c; X{ X switch (c) { X case 'a': case 'e': case 'i': case 'o': case 'u': X case 'A': case 'E': case 'I': case 'O': case 'U': X return TRUE; X } X return FALSE; X} X X X/* X** Return a small "pad" word. X*/ Xstatic char * XGetPad(word) X char *word; X{ X register int f; X X f = ROLL(100); X X if (f > 94) X return "of"; X if (f > 83) X return "and"; X if (f > 75) X return IsVowel(*word) ? "an" : "a"; X if (f > 54) X return "no"; X if (f > 53) X return "to"; X if (f > 50) X return "with"; X if (f > 45) X return IsVowel(*word) ? "in an" : "in a"; X if (f > 44) X return IsVowel(*word) ? "for an" : "for a"; X if (f > 43) X return IsVowel(*word) ? "by an" : "by a"; X if (f > 42) X return IsVowel(*word) ? "to an" : "to a"; X if (f > 41) X return IsVowel(*word) ? "with an" : "with a"; X if (f > 40) X return "they"; X if (f > 38) X return "for"; X if (f > 37) X return "we"; X if (f > 36) X return "O"; X if (f > 35) X return "but"; X if (f > 34) X return "thou"; X return "the"; X} X X X/* X** Return TRUE if string s ends with substring t. Not robuts, but X** that's okay. X*/ Xstatic int XEndsWith(s, t) X char *s; X char *t; X{ X return EQ(&s[strlen(s)] - strlen(t), t); X} X X X/* X** Returns TRUE if ending with word would produce a perfect rhyme. X*/ Xstatic int XIsPerfectRhyme(L, word) X LINETYPE *L; X char *word; X{ X return L->Line != L->Rhyme && EndsWith(Lines[L->Rhyme].Text, word); X} X X X/* X** Apend a word to the end of a line. X*/ Xstatic void XAppend(L, word) X LINETYPE *L; X char *word; X{ X if (L->Text[0]) X (void)strcat(L->Text, " "); X (void)strcat(L->Text, word); X} X X X/* X** Get a word that meets our criteria. X*/ Xstatic WORDTYPE * XGetWord(L, i, RevOK, exact, syllables, pad) X register LINETYPE *L; X register int i; X int RevOK; X int exact; X int *syllables; X int *pad; X{ X register WORDTYPE *W; X register int timeleft; X register int n; X char **RTable; X char *Template; X char *Rhythm; X int len; X int PadOK; X X /* Clear the used bit, do some other setup. */ X for (W = Words; W < &Words[NWORDS]; W++) X W->Used = FALSE; X PadOK = ROLL(100) < PAD_FACTOR; X RTable = i & 1 ? OddRhythm : EvenRhythm; X X /* Search through all the words if we need to. */ X for (timeleft = NWORDS; --timeleft >= 0; ) { X /* Find a word we haven't used. */ X while (Words[n = ROLL(NWORDS)].Used) X ; X W = &Words[n]; X W->Used = TRUE; X X /* Allow reversed foot if it is not a dactyl. */ X Template = RevOK && W->Foot != FT_DF ? revdec : hendec; X len = strlen(RTable[W->Foot]); X X if (EQn(&Template[i], RTable[W->Foot], len)) { X *pad = RTable == EvenRhythm && W->Foot == FT_HF; X *syllables = len; X if (*pad == FALSE || PadOK) { X if (i + len < NumBeats) X /* This isn't the last word, so don't check the rhyme. */ X return W; X X /* Filter out feminine rhymes if at end of stanza. */ X Rhythm = RTable[W->Foot]; X if (((L->Active % 2) == 0 || L->Active == 13) X && Rhythm[strlen(Rhythm) - 1] == '0') X continue; X X if (L->vowel == '\0' || L->cons == '\0') { X L->vowel = W->vowel; X L->cons = W->cons; X } X if (L->vowel == W->vowel X && (!exact || L->cons == W->cons) X && !IsPerfectRhyme(L, W->Text)) X return W; X } X } X } X return NULL; X} X X X X/* X** Compose a line of poetry. X*/ XComposeLine(L) X register LINETYPE *L; X{ X register WORDTYPE *W; X register LINETYPE *Rhymer; X int RevOK; X int exact; X int i; X int pad; X int syllables; X X if (L->Marked) X /* User doesn't want this line touched. */ X return; X if (L->Rhyme < 0) { X /* A blank filler line. */ X L->Text[0] = '\0'; X return; X } X X /* Zap the text. */ X L->Text[0] = '\0'; X X /* Coordinate rhymes. */ X if (L->Rhyme == L->Line) { X /* If the second line with this rhyme has been saved, make the first X * one agree with it. */ X for (Rhymer = L + 1; Rhymer < &Lines[Lcount]; Rhymer++) X if (Rhymer->Rhyme == L->Rhyme) X break; X if (Rhymer < &Lines[Lcount] && Rhymer->Marked) { X L->vowel = Rhymer->vowel; X L->cons = Rhymer->cons; X } X else { X L->vowel = 0; X L->cons = 0; X } X } X else { X L->vowel = Lines[L->Rhyme].vowel; X L->cons = Lines[L->Rhyme].cons; X } X X /* Get enough syllables, try for exact match for time through. */ X for (exact = TRUE, i = 0; i < NumBeats; ) { X pad = 0; X RevOK = i == 0 X && ROLL(100) < REV_FACTOR * ((L->Active - 1) % 4 == 0 ? 3 : 1); X if (W = GetWord(L, i, RevOK, exact, &syllables, &pad)) { X if (pad) X Append(L, GetPad(W->Text)); X Append(L, W->Text); X i += syllables; X } X else { X /* Couldn't find anything, try again. */ X i = 0; X exact = FALSE; X L->Text[0] = '\0'; X } X } X X /* Make line start with a capital letter. */ X if (islower(L->Text[0])) X L->Text[0] = toupper(L->Text[0]); X} X X X/* X** Set the desired rhyme scheme of a line. These is the only time we X** loop through the whole word list, and this routine is only called at X** start-up, so it just doesn't seem worth keeping the list sorted and X** using a binary search. X*/ XSetRhyme(L) X register LINETYPE *L; X{ X register WORDTYPE *W; X register char *p; X register char *q; X register int i; X X if (L->Text[0] == '\0') X return; X X /* Find last word, see if it's in our list. */ X p = RDX(L->Text, ' ') + 1; X for (W = Words, i = NWORDS; --i >= 0; W++) X if (EQ(W->Text, p)) { X L->vowel = W->vowel; X L->cons = W->cons; X return; X } X X /* Could be a two-word word, add in second-to-last word and search. */ X q = --p; X *p = '\0'; X p = RDX(L->Text, ' ') + 1; X *q = ' '; X for (W = Words, i = NWORDS; --i >= 0; W++) X if (EQ(W->Text, p)) { X L->vowel = W->vowel; X L->cons = W->cons; X return; X } X X /* Can't happen, unless fed a poem that we didn't write. */ X Printf("WORD %s NOT FOUND", p); X abort(); X} X X X/* X** Set up the rhyme pattern, seed the generator, etc. X*/ XComposeInit(pattern, beats) X register char *pattern; X int beats; X{ X register LINETYPE *L; X register int i; X register int j; X register int Active; X X /* NOSTRICT "warning: long assignment may lose accuracy" */ X (void)srand((int)time((time_t *)NULL)); X if (pattern == NULL) X pattern = "ABAB CDCD EFEF GG"; X NumBeats = beats ? beats : 10; X X Lcount = strlen(pattern); X /* NOSTRICT "warning: possible pointer alignment problem" */ X Lines = (LINETYPE *)malloc((unsigned int)Lcount * sizeof Lines[0]); X X for (Active = 0, L = Lines, i = 0; i < Lcount; i++, L++) { X L->Text[0] = '\0'; X L->Line = i; X if (pattern[i] == ' ') X L->Rhyme = -1; X else X for (L->Active = ++Active, j = 0; j < Lcount; j++) X if (pattern[i] == pattern[j]) { X L->Rhyme = j; X break; X } X } X} X X X#ifdef STANDALONE Xmain() X{ X register LINETYPE *L; X register int i; X X ComposeInit((char *)NULL, 0); X X for (L = Lines, i = Lcount; --i >= 0; L++) { X ComposeLine(L); X Printf("%s\n", L->Text); X } X X exit(0); X} X#endif /* STANDALONE */ END_OF_FILE if test 8502 -ne `wc -c <'compose.c'`; then echo shar: \"'compose.c'\" unpacked with wrong size! fi # end of 'compose.c' fi if test -f 'getopt.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'getopt.c'\" else echo shar: Extracting \"'getopt.c'\" \(1521 characters\) sed "s/^X//" >'getopt.c' <<'END_OF_FILE' X/* X** Return options and their values from the command line. X** This comes from the AT&T public-domain getopt published in mod.sources. X*/ X#include X X/* Pick one */ X#define IDX index /* .. */ X/*#define IDX strchr /* .. */ X X#define TYPE int X X#define ERR(s, c) \ X if (opterr) { \ X char buff[2]; \ X buff[0] = c; buff[1] = '\n'; \ X (void)write(2, av[0], (TYPE)strlen(av[0])); \ X (void)write(2, s, (TYPE)strlen(s)); \ X (void)write(2, buff, 2); \ X } X Xint opterr = 1; Xint optind = 1; Xint optopt; Xchar *optarg; X Xint Xgetopt(ac, av, opts) X int ac; X char *av[]; X char *opts; X{ X static int i = 1; X register char *p; X X /* Move to next value from argv? */ X if (i == 1) { X if (optind >= ac || av[optind][0] != '-' || av[optind][1] == '\0') X return EOF; X if (strcmp(av[optind], "--") == 0) { X optind++; X return EOF; X } X } X X /* Get next option character. */ X if ((optopt = av[optind][i]) == ':' || (p = IDX(opts, optopt)) == NULL) { X ERR(": illegal option -- ", optopt); X if (av[optind][++i] == '\0') { X optind++; X i = 1; X } X return '?'; X } X X /* Snarf argument? */ X if (*++p == ':') { X if (av[optind][i + 1] != '\0') X optarg = &av[optind++][i + 1]; X else { X if (++optind >= ac) { X ERR(": option requires an argument -- ", optopt); X i = 1; X return '?'; X } X optarg = av[optind++]; X } X i = 1; X } X else { X if (av[optind][++i] == '\0') { X i = 1; X optind++; X } X optarg = NULL; X } X X return optopt; X} END_OF_FILE if test 1521 -ne `wc -c <'getopt.c'`; then echo shar: \"'getopt.c'\" unpacked with wrong size! fi # end of 'getopt.c' fi if test -f 'makelex.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'makelex.c'\" else echo shar: Extracting \"'makelex.c'\" \(2315 characters\) sed "s/^X//" >'makelex.c' <<'END_OF_FILE' X/* X** MAKELEX X** Build lexical dictionary from the input file. X*/ X#include "sonnet.h" X#ifndef lint Xstatic char RCS[] = X "$Header: makelex.c,v 2.0 89/02/08 16:30:16 rsalz Release1 $"; X#endif /* lint */ X X X/* X** Process one file. X*/ Xstatic void XProcess(name, F) X char *name; X register FILE *F; X{ X register char *p; X register int i; X char buff[128]; X X Printf("\t/* Input: %s */\n", name); X X while (fgets(buff, sizeof buff, F)) { X /* Blank lines and line beginning with a pound sign are comments. */ X if (buff[0] == '\n' || buff[0] == '#') X continue; X X /* Make isn't truncated. */ X if ((p = IDX(buff, '\n')) == NULL) { X Fprintf(stderr, "Line too long, skipped:\n\t%s\n", buff); X continue; X } X *p = '\0'; X X /* Make sure it's well-formed. */ X for (i = 0, p = buff; *p; p++) X if (*p == ':') X i++; X if (i != 3) { X Fprintf(stderr, "Badly-formed line, skipped:\n\t%s\n", buff); X continue; X } X X /* First field is the actual word. */ X Printf(" {\t\""); X for (i = 3, p = buff; *p != ':'; p++, i++) X (void)putchar(*p); X X /* Second field is the foot type. */ X Printf("\",\t%s 0, FT_", i < 8 ? "\t" : ""); X while (*++p != ':') X (void)putchar(*p); X X /* Third word is the vowel sound. */ X Printf(", VS_"); X while (*++p != ':') X (void)putchar(*p); X X /* Fourth field is the consonant sound. */ X Printf(", "); X if (*++p == '\0') X (void)putchar('0'); X else if (isdigit(*p)) X (void)putchar(*p); X else if (islower(*p)) X Printf("'%c'", *p); X else X Printf("CS_%s", p); X Printf("\t},\n"); X } X} X Xmain(ac, av) X int ac; X char *av[]; X{ X register FILE *F; X X /* Print prolog. */ X Printf("/*\n"); X Printf("** DICTIONARY -- DO NOT EDIT THIS FILE!\n"); X Printf("** This file is generated by a program. To edit the word\n"); X Printf("** list, edit the data files then run make.\n"); X Printf("*/\n"); X Printf("\n"); X Printf("WORDTYPE Words[] = {\n"); X X /* Munch munch. */ X if (ac == 1) X Process("standard input", stdin); X else X while (*++av) X if ((F = fopen(*av, "r")) == NULL) X Fprintf(stderr, "Can't open \"%s\" for input.\n", *av); X else{ X Process(*av, F); X (void)fclose(F); X } X X X /* Epilog. */ X Printf(" { NULL }\n"); X Printf("};\n"); X X /* That's all she wrote. */ X exit(0); X} END_OF_FILE if test 2315 -ne `wc -c <'makelex.c'`; then echo shar: \"'makelex.c'\" unpacked with wrong size! fi # end of 'makelex.c' fi if test -f 'patchlog.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'patchlog.h'\" else echo shar: Extracting \"'patchlog.h'\" \(253 characters\) sed "s/^X//" >'patchlog.h' <<'END_OF_FILE' X/* X** This file records official patches. X** X** $Header: patchlog.h,v 2.0 89/02/08 16:30:24 rsalz Release1 $ X** X** $Log: patchlog.h,v $ X** Revision 2.0 89/02/08 16:30:24 rsalz X** First net release. X** X*/ X#define VERSION 2 X#define PATCHLEVEL 0 END_OF_FILE if test 253 -ne `wc -c <'patchlog.h'`; then echo shar: \"'patchlog.h'\" unpacked with wrong size! fi # end of 'patchlog.h' fi if test -f 'sonnet.6' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'sonnet.6'\" else echo shar: Extracting \"'sonnet.6'\" \(1963 characters\) sed "s/^X//" >'sonnet.6' <<'END_OF_FILE' X.\" $Header: sonnet.6,v 2.0 89/02/08 16:30:30 rsalz Release1 $" X.TH SONNET 6 X.SH NAME Xsonnet \- write (bad) poetry X.SH SYNOPSIS X.B sonnet X[ X.BI \-l file X] [ X.BI \-f file X] [ X.B \-s X] [ X.B \-v X] X.SH DESCRIPTION X.I Sonnet Xis a screen-oriented program that writes sonnets. XIt as an interactive X.IR curses (3)-based Xprogram. X.PP XThe ``\-v'' flag, if specified, prints the current version and patchlevel Xand exits. X.PP XTo start working on a pre-existing sonnet, use the ``\-l'' flag to Xload a sonnet, otherwise the program will write one from scratch. XIf you load in a file that has a poem not composed by this program Xit will abort. XOnce the sonnet has been composed, the program will display it Xand enter the main command loop. XIn this main loop, you can mark lines that you like, and try to Xwrite the rest of the poem around those lines. X.PP XCommands while in the main loop (either case, but end with a return): X.TP 10 X.B "?, H" XDisplay help. X.TP 10 X.B R XRecompose. XAll un-marked lines are recomposed. X.TP 10 X.B [RETURN] XRecompose or Refresh. XNormally, the [RETURN] key will also compose a new sonnet. XIf the ``\-s'' flag is used, however, the program acts more ``safely'' Xand [RETURN] will just redraw the screen. X.TP 10 X.BI M # XMark a line. XThe line with the indicated number is marked so that it will not Xbe replaced with new text after the next restart. X.TP 10 X.BI U # XUn-mark. XThe line is no longer protected. X.TP 10 X.BI W [file] XWrite. XThe current poem is written to the named file. XIf no filename is given, the name specified with the ``\-f'' flag is used. XIf the file exists, the poem is appended to the existing contents. X.TP 10 X.B Q XQuit. XThe program exits. XNote that the poem is not saved. X.PP XAny other key redraws the screen. X.SH BUGS XThe database is compiled into the program and must be generated using the Xundocumented X.IR makelex (8L) Xprogram distributed with the source. X.SH AUTHORS XChris Wilbur X.br XRich $alz END_OF_FILE if test 1963 -ne `wc -c <'sonnet.6'`; then echo shar: \"'sonnet.6'\" unpacked with wrong size! fi # end of 'sonnet.6' fi if test -f 'sonnet.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'sonnet.c'\" else echo shar: Extracting \"'sonnet.c'\" \(5065 characters\) sed "s/^X//" >'sonnet.c' <<'END_OF_FILE' X/* X** SONNET X** Curses-based driver for the poetry composer. X*/ X#include X#include "sonnet.h" Xstatic char RCS[] = X "$Header: sonnet.c,v 2.0 89/02/08 16:30:38 rsalz Release1 $"; X Xstatic int safe = FALSE; X Xextern LINETYPE *Lines; Xextern int Lcount; X X X/* X** Display the current sonnet X*/ Xstatic void XShowIt() X{ X register LINETYPE *L; X register int i; X X for (L = Lines, i = Lcount; --i >= 0; L++) { X (void)move(L->Line + 2, 0); X (void)clrtoeol(); X if (L->Active) X Printw("%2d%c\t%s", L->Active, L->Marked ? '*' : ' ', L->Text); X } X Printw("\n"); X (void)refresh(); X} X X X/* X** Mark or un-mark a line. X*/ Xstatic void XMarkLine(p, on) X register char *p; X register int on; X{ X register LINETYPE *L; X register int i; X register int offset; X X while (*p && isspace(*p)) X p++; X if (*p) X for (offset = atoi(p), L = Lines, i = Lcount; --i >= 0; L++) X if (L->Active == offset) { X L->Marked = on; X break; X } X} X X X/* X** Help the user out by listing the legal commands. X*/ Xstatic void XDoHelp() X{ X (void)move(0, 0); X (void)clrtobot(); X Printw("\nSonnet commands:\n"); X Printw("\tM #\t\tMark the indicated line\n"); X Printw("\tU #\t\tUnmark the indicated line\n"); X Printw("\tR\t\tRecompose all unmarked lines\n"); X if (!safe) X Printw("\t[RETURN]\talso means recompose\n"); X Printw("\tQ\t\tQuit\n"); X Printw("\tW name\t\tAppend poem to indicated file\n"); X Printw("\t?\t\tShow this help text\n"); X Printw("\tH\t\tShow this help text\n"); X Printw("\n"); X Printw(" Any other key redraws the screen\n"); X Printw( X " Commands may be given in either case and must be ended with a RETURN.\n" X ); X Printw("\n\n[Press return to continue]"); X (void)refresh(); X while ((getchar()) != '\n') X ; X (void)move(0, 0); X (void)clrtobot(); X (void)refresh(); X} X X X X/* X** Main program. X*/ Xmain(ac, av) X int ac; X char *av[]; X{ X register FILE *F; X register LINETYPE *L; X register char *p; X register int i; X char *outfile; X char *infile; X char buff[MAXLEN]; X X outfile = DEFAULT_OUT_FILE; X infile = NULL; X while ((i = getopt(ac, av, "f:l:sv")) != EOF) X switch (i) { X default: X Fprintf(stderr, "Usage: %s [-l input] [-f outfilename]\n", av[0]); X exit(1); X /* NOTREACHED */ X case 'f': X outfile = optarg; X break; X case 'l': X infile = optarg; X break; X case 's': X safe = TRUE; X break; X case 'v': X printf("Sonnet program Version %d, Patchlevel %d:\n\t%s\n", X VERSION, PATCHLEVEL, RCS); X exit(0); X /* NOTREACHED */ X } X X /* Set up curses. */ X (void)initscr(); X (void)move(0, 0); X (void)clrtobot(); X (void)refresh(); X X /* Wake up, Mr. Shakespeare! */ X ComposeInit((char *)NULL, 0); X X /* Start with nothing, or from an existing poem. */ X if (infile == NULL) X for (L = Lines, i = Lcount; --i >= 0; L++) X ComposeLine(L); X else { X if ((F = fopen(optarg, "r")) == NULL) { X Fprintf(stderr, "Can't open %s for input.\n", optarg); X exit(1); X /* NOTREACHED */ X } X for (L = Lines, i = Lcount; --i >= 0; L++) { X /* Get a good line or give up. */ X if (fgets(L->Text, sizeof L->Text, F) == NULL) { X Fprintf(stderr, "Too little data in file.\n"); X (void)fclose(F); X exit(1); X /* NOTREACHED */ X } X if ((p = IDX(L->Text, '\n')) == NULL) { X Fprintf(stderr, "Bad data in file.\n"); X (void)fclose(F); X exit(1); X /* NOTREACHED */ X } X *p = '\0'; X X L->Marked = TRUE; X SetRhyme(L); X } X (void)fclose(F); X } X X /* Show what we're starting off with. */ X ShowIt(); X X /* Main processing loop. */ X for ( ; ; ) { X /* Show old poem and prompt. Cautious curses calls. */ X ShowIt(); X (void)move(20, 0); X (void)clrtobot(); X (void)move(20, 0); X Printw("[m# u# r w[file] q; ? for help]: "); X (void)clrtoeol(); X (void)refresh(); X X /* Get input. */ X if (fgets(buff, sizeof buff, stdin) == NULL) X buff[0] = 'q'; X else if (p = IDX(buff, '\n')) X *p = '\0'; X X /* Blank line in unsafe mode means rewrite. */ X if (buff[0] == '\0' && !safe) X buff[0] = 'r'; X X /* Dispatch. */ X switch (buff[0]) { X default: X clearok(curscr, TRUE); X touchwin(curscr); X (void)refresh(); X break; X case '?': X case 'H': case 'h': X DoHelp(); X break; X case 'M': case 'm': X MarkLine(&buff[1], TRUE); X break; X case 'Q': case 'q': X (void)move(LINES - 1, 0); X (void)refresh(); X Printf("\n\n"); X (void)endwin(); X exit(0); X /* NOTREACHED */ X case 'R': case 'r': X for (L = Lines, i = Lcount; --i >= 0; L++) X ComposeLine(L); X break; X case 'W': case 'w': X if (buff[1]) X for (p = &buff[1]; *p && isspace(*p); p++) X ; X else X p = outfile; X if ((F = fopen(p, "a")) == NULL) { X Printf("Cannot open %s for output.\n", p); X exit(1); X /* NOTREACHED */ X } X for (L = Lines, i = Lcount; --i >= 0; L++) X Fprintf(F, "%s\n", L->Text); X (void)fclose(F); X break; X case 'U': case 'u': X MarkLine(&buff[1], FALSE); X break; X } X } X X /* NOTREACHED */ X} END_OF_FILE if test 5065 -ne `wc -c <'sonnet.c'`; then echo shar: \"'sonnet.c'\" unpacked with wrong size! fi # end of 'sonnet.c' fi if test -f 'sonnet.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'sonnet.h'\" else echo shar: Extracting \"'sonnet.h'\" \(4349 characters\) sed "s/^X//" >'sonnet.h' <<'END_OF_FILE' X/* X** X** $Header: sonnet.h,v 2.0 89/02/08 16:30:49 rsalz Release1 $ X*/ X#include X#include X#include "patchlog.h" X X/* Manifest constants, syntactic sugar. */ X#define NLINES 17 X#define MAXLEN 80 X#define EQ(a, b) (strcmp((a), (b)) == 0) X#define EQn(a, b, n) (strncmp((a), (b), (n)) == 0) X#define DEFAULT_OUT_FILE "sonnet.out" X X/* Some fundamental constants of the universe. */ X#ifndef TRUE X#define TRUE 1 X#endif /* TRUE */ X#ifndef FALSE X#define FALSE 0 X#endif /* FALSE */ X X/* Dialectical differences. */ X#ifdef USE_INDEX X#define IDX strchr X#define RDX strrchr X#else X#define IDX index X#define RDX rindex X#endif /* USE_INDEX */ X X X/* FOOT TYPES -- index into the Rhythm tables */ X#define FT__fill1 0 /* Not used */ X#define FT_HF 1 /* ace (Single syllable) */ X#define FT_IF 2 /* hurrah (Iambic) */ X#define FT_TF 3 /* hollow (Trochaic) */ X#define FT__fill2 4 /* Not used */ X#define FT_DF 5 /* happily (Dactylic) */ X#define FT_AF 6 /* ala mode (Anapestic) */ X#define FT_IFF 7 /* resemble */ X#define FT_IIF 8 /* establishing */ X#define FT_TTF 9 /* education */ X#define FT_IIFF 10 /* administration */ X#define FT_TDF 11 /* BMW */ X#define FT_HIF 12 /* document */ X#define FT_TDIF 13 /* opportunity */ X X/* VOWEL SOUNDS */ X#define VS_LA 'A' /* Cambridge (long A) */ X#define VS_SA 'a' /* mad (short A) */ X#define VS_LE 'E' /* MIT (long E) */ X#define VS_SE 'e' /* deaf (short E) */ X#define VS_LI 'I' /* bicep (long I) */ X#define VS_SI 'i' /* big (short I) */ X#define VS_LO 'O' /* bold (long O) */ X#define VS_SO 'o' /* bomb (short O) */ X#define VS_LU 'U' /* zoo (long U) */ X#define VS_SU 'u' /* lunch (short U) */ X#define VS_OI 'y' /* oil */ X#define VS_OU 'w' /* ouch */ X#define VS_ER 'r' /* purgative */ X /* You can add your own sounds if you need to. */ X X/* CONSONANT SOUNDS */ X#define CS_SH 'A' /* awash, dish, flesh */ X#define CS_ST 'B' /* feast, burst, juiced */ X#define CS_CH 'C' /* ouch, slouch, grouch */ X#define CS_LD 'D' /* soiled, boiled behold */ X#define CS_RD 'E' /* chord, hoard, buzzword */ X#define CS_NK 'F' /* junk, pink, crank */ X#define CS_NT 'G' /* grunt, insolent, paramount */ X#define CS_ND 'H' /* refined, stained, sustained */ X#define CS_NG 'I' /* wrong, long, song */ X#define CS_NS 'J' /* dense, tense, bounce */ X#define CS_MP 'K' /* champ, clamp, clomp */ X#define CS_TH 'L' /* south, mouth, rebirth */ X#define CS_TS 'M' /* guts, nuts, reports */ X#define CS_RT 'N' /* snort, sport, apart */ X#define CS_RK 'O' /* work, beserk, arc */ X#define CS_CT 'P' /* defunct, cataract, deject */ X#define CS_RM 'Q' /* harm, alarm, chloroform */ X#define CS_PS 'R' /* corpse, warps, elapse */ X#define CS_PT 'S' /* flipped, equipped, flapped */ X#define CS_LT 'T' /* insult, occult, salt */ X#define CS_SP 'U' /* grasp, rasp, lisp */ X#define CS_NZ 'V' /* wrench, stench, brunch */ X#define CS_SK 'W' /* risk, tasks, brusque */ X#define CS_RS 'X' /* worse, hearse, coarse */ X#define CS_NJ 'Y' /* hinge, cringe, munge */ X#define CS_FT 'Z' /* cleft, left, thrift */ X#define CS_RN '$' /* born, worn, porn */ X /* If you add your own consonant sounds, make sure not to use X * the lowercase letters! */ X X Xtypedef struct _WORDTYPE { X char *Text; /* Text of the word */ X short Used; /* Used this word in the search? */ X short Foot; /* Foot type (for scanning) */ X short vowel; /* Vowel sound (for rhyming) */ X short cons; /* Consonant sound (for rhyming) */ X} WORDTYPE; X X Xtypedef struct _LINETYPE { X short Line; /* Absolute line number */ X short Active; /* Text line number */ X short Rhyme; /* Rhyme pattern location */ X short Marked; /* Save current contents? */ X short vowel; /* Vowel rhyme */ X short cons; /* Consonant rhyme */ X char Text[MAXLEN + 1]; /* Output text */ X} LINETYPE; X X X/* Lint placation */ X#define Printf (void)printf X#define Printw (void)printw X#define Fprintf (void)fprintf X#define Sprintf (void)sprintf X#ifdef lint X#undef putchar X#endif /* lint */ X X X/* Linked in later */ Xextern int optind; Xextern char *optarg; X Xextern char *malloc(); Xextern char *sprintf(); Xextern char *strcat(); Xextern char *IDX(); Xextern char *RDX(); Xextern int rand(); Xextern long time(); END_OF_FILE if test 4349 -ne `wc -c <'sonnet.h'`; then echo shar: \"'sonnet.h'\" unpacked with wrong size! fi # end of 'sonnet.h' fi echo shar: End of archive 1 \(of 2\). cp /dev/null ark1isdone MISSING="" for I in 1 2 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked both archives. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0