DECLARE SUB SaveWordFile () DECLARE SUB IngestFile (f$) DECLARE SUB Ingest (p$) DECLARE FUNCTION FindWord! (w$) DECLARE FUNCTION MakePhrase$ (l!) DECLARE SUB LoadWordFile () DECLARE SUB LoadLineFile () DECLARE SUB DisplayVerse (struct!) DECLARE SUB op (a$) CONST WORDSIZE = 500 CONST LINESIZE = 50 DIM SHARED Word$(WORDSIZE), Link$(WORDSIZE), NumSyl(WORDSIZE) DIM SHARED Line$(LINESIZE), Descript$(LINESIZE) COMMON SHARED WordCount, LineCount, LogFile, IngestMode Word$(1) = "XXXX": NumSyl(1) = 0: Link$(1) = "" Word$(2) = "ZZZZ": NumSyl(1) = 0: Link$(1) = "" WordCount = 2: LineCount = 0: IngestMode = 1 RANDOMIZE TIMER LogFile = FREEFILE OPEN "c:\dos\basic\dieter.log" FOR APPEND AS LogFile COLOR 15, 1: CLS op "Dieter v0.2, GPL 1998 Adam Sampson, Chris Verlage" op "" LoadWordFile LoadLineFile op "" op "[W]rite a new song, [L]earn from an old one, or [T]alk to me?" DO DO: LOOP UNTIL INKEY$ = "" DO: i$ = LCASE$(INKEY$): LOOP UNTIL i$ <> "" LOOP UNTIL i$ = "w" OR i$ = "l" OR i$ = "t" op i$ SELECT CASE i$ CASE "w" Seed% = INT(RND(1) * 32768) op "This song's number:" + STR$(Seed%) RANDOMIZE Seed% op "" VerseStruct = INT(RND(1) * LineCount) + 1 DO ChorusStruct = INT(RND(1) * LineCount) + 1 LOOP UNTIL ChorusStruct <> VerseStruct IF LEN(Line$(ChorusStruct)) > LEN(Line$(VerseStruct)) THEN SWAP VerseStruct, ChorusStruct VersesPerChorus = INT(RND(1) * 2) + 1 NumberChoruses = INT(RND(1) * 3) + 2 TrailingChoruses = INT(RND(1) * 2) FOR j = 1 TO VersesPerChorus * NumberChoruses op "Verse " + STR$(j) + ":" DisplayVerse VerseStruct NEXT op "Chorus:" DisplayVerse ChorusStruct op "Order:" r$ = "": x = 0 FOR k = 1 TO NumberChoruses FOR j = 1 TO VersesPerChorus x = x + 1 r$ = r$ + STR$(x) NEXT j r$ = r$ + " C" NEXT k FOR k = 1 TO TrailingChoruses r$ = r$ + " C" NEXT k op r$ CASE "l" LINE INPUT "Filename? ", f$ IngestFile f$ SaveWordFile CASE "t" IngestMode = 0 DO PRINT "Dieter: ", MakePhrase$(0) LINE INPUT "You (bye to exit): ", y$ Ingest y$ LOOP UNTIL y$ = "bye" END SELECT op "" op "---" op "" CLOSE LogFile CLOSE SYSTEM SUB DisplayVerse (struct) op "(" + Descript$(struct) + ")" struct$ = Line$(struct) FOR k = 1 TO LEN(struct$) / 5 op MakePhrase$(VAL(MID$(struct$, ((k - 1) * 5) + 1, 5))) NEXT k op "" END SUB FUNCTION FindWord (w$) w = 0 FOR k = 1 TO WordCount IF w$ = Word$(k) THEN w = k NEXT k FindWord = w END FUNCTION SUB Ingest (p$) Phrase$ = "XXXX " + p$ + " ZZZZ " DIM w$(50) a = 1: words = 0: start = 1 DO a = a + 1 SELECT CASE MID$(Phrase$, a, 1) CASE " " words = words + 1 w$(words) = MID$(Phrase$, start, a - start) start = a + 1 END SELECT LOOP UNTIL a = LEN(Phrase$) FOR k = 2 TO words IF FindWord(w$(k)) = 0 THEN WordCount = WordCount + 1 Word$(WordCount) = w$(k) Link$(WordCount) = "" NumSyl(WordCount) = 0 IF IngestMode = 1 THEN PRINT "New word: "; WordCount; Word$(WordCount) INPUT "How many syllables? ", NumSyl(WordCount) op "Word added: " + Word$(WordCount) + " syl:" + STR$(NumSyl(WordCount)) END IF END IF f = FindWord(w$(k - 1)): t = FindWord(w$(k)) Link$(f) = Link$(f) + RIGHT$("00000" + RIGHT$(STR$(t), LEN(STR$(t)) - 1), 5) NEXT k END SUB SUB IngestFile (f$) op "Ingesting file " + f$ + " after pos" + STR$(WordCount) f = FREEFILE OPEN f$ FOR INPUT AS f DO LINE INPUT #f, Line$ IF Line$ <> "" THEN Ingest Line$ LOOP UNTIL EOF(f) CLOSE f END SUB SUB LoadLineFile f = FREEFILE OPEN "c:\dos\basic\dieter.lin" FOR INPUT AS f DO LineCount = LineCount + 1 LINE INPUT #f, Line$(LineCount) LINE INPUT #f, Descript$(LineCount) LOOP UNTIL EOF(f) CLOSE f op STR$(LineCount) + " line structures loaded." END SUB SUB LoadWordFile WordCount = 0 f = FREEFILE OPEN "c:\dos\basic\dieter.wrd" FOR INPUT AS f DO WordCount = WordCount + 1 INPUT #f, dum, Word$(WordCount), NumSyl(WordCount) IF NumSyl(WordCount) = 0 AND Word$(WordCount) <> "," THEN NumSyl(WordCount) = 1 INPUT #f, Link$(WordCount) LOOP UNTIL EOF(f) OR TryFlag = 1 CLOSE f NumSyl(1) = 0: NumSyl(2) = 0 op STR$(WordCount) + " words loaded." END SUB FUNCTION MakePhrase$ (l) DO syl = 0 e = 1 p$ = "" DO e = VAL(MID$(Link$(e), (((INT(RND(1) * LEN(Link$(e)) / 5) + 1) - 1) * 5 + 1), 5)) IF e <> 2 THEN p$ = p$ + Word$(e) + " " syl = syl + NumSyl(e) END IF LOOP UNTIL e = 2 LOOP UNTIL l = syl OR l = 0 MakePhrase$ = p$ END FUNCTION SUB Old Ingest "deep in my heart there's a fire , a burning heart" Ingest "deep in my heart there's desire for a start" Ingest "i'm dying in emotion" Ingest "it's my world in fantasy" Ingest "i'm living in my , living in my dreams" Ingest "you're my heart , you're my soul" Ingest "i'll keep it shining everywhere i go" Ingest "i'll be holding you forever" Ingest "stay with you forever" Ingest "oh i can not explain" Ingest "every time it's the same" END SUB SUB op (a$) PRINT a$ PRINT #LogFile, a$ END SUB SUB SaveWordFile f = FREEFILE OPEN "c:\dos\basic\dieter.wrd" FOR OUTPUT AS f FOR k = 1 TO WordCount WRITE #f, k, Word$(k), NumSyl(k) WRITE #f, Link$(k) NEXT k CLOSE f END SUB SUB ShowWords FOR k = 1 TO WordCount PRINT k, Word$(k), NumSyl(k), LEN(Link$(k)) NEXT k END SUB