Mad Libs: Difference between revisions

=={{header|Fortran}}==

Early Fortran had no provision for manipulating text, only arrangements to provide fixed headings for tables, etc. Later came the ability to read and write text via the A1 format code into say an array of integers, usually 16-bit. Such arrays could be manipulated and their numerical values were accessible. Curiously, early SNOBOL interpreters were written in Fortran, because of the portability of such arrangements. Next came the ability for READ and WRITE statements to read from or write to such arrays, as well as normal I/O devices. Finally, a declaration such as <code>CHARACTER*6 A(200)</code> meant an array of two hundred elements, each of six characters.

There is no direct equivalent to a string-type variable, one that has a current length as well as text content, however one can proceed with a character variable called say NAME and an associated integer called LNAME, and be diligent. When a character variable is passed to a subprogram, its length is passed as a secret additional parameter, and this can be accessed via a function LEN(param). Later Fortran systems allow the declaration of compound data types, and routines for manipulating them can be "overloaded" onto standard operators so that they may be used in normal-looking expressions, but a great deal of jargon is required for a comprehensive solution. Similarly, character variables can be reallocated storage to fit the size of their current usage, with of course the risk of memory leaks on top of the overhead.

Simple character variables have fixed storage allocation, so one is, as often, confronted with the need to choose sizes that are surely big enough. Thus the story could be stored in an array <code>CHARACTER*100 STORY(200)</code> to allow for up to two hundred lines, each of up to a hundred characters in length, and similarly for the collection of target and replacement texts. Obviously, most lines will be barely filled just to protect against the risk of one longish line, but profligate usage of storage is the modern way.

The plan here is to use a pool of storage, one large character storage area (STASH) along with an array ISTASH giving the positions of the initial character of each stashed text string. Such strings can then be referred to by their index number, a simple integer, which can be stored in other lists as ordinary arrays. The key point is that there is no change to the size of any stashed strings, nor are any deleted. This means no shuffling about with the need to update various arrays. Thus, the i'th stashed string is found in STASH starting at character <code>ISTASH(i)</code> and so by extension, its last character is at <code>ISTASH(i + 1) - 1</code> Thereby the storage of the strings wastes no space, though STASH still has to be "big enough".

Because there is no "length" attribute as a part of a character variable, pieces of a character variable can be passed to subprograms without the need for copies. Specifically, if a string consisted of a one-byte length followed by the storage area for the content (as say in Pascal), passing a substring of characters 7-11 would mean creating a copy in other storage with a length byte having 5 followed by the content. The subprogram could ''not'' receive some sort of pointer to the parent string, because the need to place the length byte for the string type would mean overwriting a character of the parent string. Because Fortran has no such length feature, specifying say <code>STASH(7:11)</code> as a parameter involves ''no'' copying of the content. A subprogram to convert text to uppercase would work on the source data in place rather than copy-in, copy-out. Specifically, comparison of a portion of a character variable to another portion of another character variable is achieved ''without copying text''.

The absence of a "current length" notion also means that when an assignment is made to a character variable, if the source is shorter than the recipient, trailing spaces will be supplied, possibly in very large numbers. A statement <code>STASH = "Short"</code> would copy five characters and then follow with spaces to the end. This can be avoided by specifying <code>STASH(1:5) = "Short"</code> with the usual risk of miscounting in the programming. Character variables typically contain trailing spaces, and the rule for comparison ignores them. Thus "Short" and "Short " are deemed equal. For this reason, the < and > bounding the target texts are included in their string: "<Short>" and "<Short >" are definitely not equal.

Because allowing replacement texts to themselves refer to <...> entries (and add their own) is not called for, the complications are avoided. Similarly, there is only token checking for ill-formed stories. The checking for array overflow and the like is present on principle, but is unlikely to be exercised in simple runs.

<lang Fortran>

MODULE MADLIB !Messing with COMMON is less convenient.

INTEGER MSG,KBD,INF !I/O unit numbers.

DATA MSG,KBD,INF/6,5,10/ !Output, input, some disc file.

INTEGER LSTASH,NSTASH,MSTASH !Prepare a common text stash.

PARAMETER (LSTASH = 246810, MSTASH = 666) !LSTASH characters for MSTASH texts.

CHARACTER*(LSTASH) STASH !The pool.

INTEGER ISTASH(MSTASH + 1) !Fingers start positions, and thus end positions by extension.

DATA NSTASH,ISTASH(1)/0,1/ !Empty pool: no entries, first available character is at 1.

INTEGER MANYLINES,MANYTESTS !I also want some lists of texts.

PARAMETER (MANYLINES = 1234) !This is to hold the story.

INTEGER NSTORY,STORY(MANYLINES) !Fingering texts in the stash.

PARAMETER (MANYTESTS = 1234) !Likewise, some target/replacement texts.

INTEGER NTESTS,TARGET(MANYTESTS),REPLACEMENT(MANYTESTS) !Thus.

DATA NSTORY,NTESTS/0,0/ !No story lines, and no tests.

CONTAINS

SUBROUTINE CROAK(GASP) !A dying remark.

CHARACTER*(*) GASP !The last words.

WRITE (MSG,*) "Oh dear." !Shock.

WRITE (MSG,*) GASP !Aargh!

STOP "How sad." !Farewell, cruel world.

END SUBROUTINE CROAK !Farewell...

SUBROUTINE SHOWSTASH(BLAH,I) !One might be wondering.

CHARACTER*(*) BLAH !An annotation.

INTEGER I !The desired stashed text.

WRITE (MSG,1) BLAH,I,STASH(ISTASH(I):ISTASH(I + 1) - 1) !Whee!

1 FORMAT (A,': Text(',I0,')="',A,'"') !Hopefully, helpful.

END SUBROUTINE SHOWSTASH !Ah, debugging.

INTEGER FUNCTION EATTEXT(IN) !Add a text to STASH and finger it.

Co-opts the as-yet unused space in STASH as its scratchpad.

INTEGER IN !Input from this I/O unit number.

INTEGER I,N,L !Fingers.

I = ISTASH(NSTASH + 1)!First available position in STASH.

N = LSTASH - I + 1 !Number of characters yet unused.

IF (N.LT.666) CALL CROAK("Insufficient STASH space remains!")

READ (IN,1,END = 66) L,STASH(I:I + MIN(L,N) - 1) !Calculated during the read.

1 FORMAT (Q,A) !Obviously, Q = character count incoming, A = accept all of them.

L = I + MIN(L,N) - 1 !The last character read.

10 IF (L.LT.I) GO TO 66 !A blank line! Deemed end-of-file.

IF (ICHAR(STASH(L:L)).LE.ICHAR(" ")) THEN !A trailing space?

L = L - 1 !Yes. Pull back.

GO TO 10 !And try again.

END IF !So much for trailing spaces.

IF (NSTASH.GE.MSTASH) CALL CROAK("Too many texts!")

NSTASH = NSTASH + 1 !Admit another text.

ISTASH(NSTASH + 1) = L + 1 !The start point of the following text.

EATTEXT = NSTASH !STASH(ISTASH(n):ISTASH(n + 1) - 1) has text n.

RETURN

66 EATTEXT = 0 !Sez: "No text".

END FUNCTION EATTEXT

INTEGER FUNCTION ADDPOOL(TEXT) !Appends an arbitrary text to the pool.

CHARACTER*(*) TEXT !The stuff.

IF (NSTASH.GE.MSTASH) CALL CROAK("The text pool is crowded!") !Alas.

I = ISTASH(NSTASH + 1) !First unused character.

IF (I + LEN(TEXT).GT.LSTASH) CALL CROAK("Overtexted!") !Alack.

STASH(I:I + LEN(TEXT) - 1) = TEXT !Place.

NSTASH = NSTASH + 1 !Count in another entry.

ISTASH(NSTASH + 1) = I + LEN(TEXT) !The new "first available" position.

ADDPOOL = NSTASH !Pass a finger back to the caller.

END FUNCTION ADDPOOL !Just an integer.

SUBROUTINE TABLE(TEXT) !Possibly add TEXT to the table of target texts.

CHARACTER*(*) TEXT !The text of the target.

INTEGER I,IT !Steppers.

DO I = 1,NTESTS !Step through the known target texts.

IT = TARGET(I) !Finger a target text.

IF (TEXT.EQ.STASH(ISTASH(IT):ISTASH(IT + 1) - 1)) RETURN !Already have this one.

END DO !Otherwise, try the next.

IF (NTESTS.GE.MANYTESTS) CALL CROAK("Too many tests!") !Oh dear.

NTESTS = NTESTS + 1 !Count in another.

TARGET(NTESTS) = ADDPOOL(TEXT)!Stash its text and get a finger to it.

WRITE (MSG,1) TEXT !Now request the replacement text.

1 FORMAT ("Enter your text for ",A,": ",$) !Obviously, the $ indicates "no new line".

REPLACEMENT(NTESTS) = EATTEXT(KBD) !Zero for "no text".

END SUBROUTINE TABLE !Produces entries for TARGET and REPLACEMENT.

SUBROUTINE INSPECT(IT) !Examine the text for the special <...> sequence.

INTEGER IT !Fingers the text in STASH via ISTASH.

INTEGER MARK !Recalls where the < was found.

CHARACTER*1 C !A scratchpad.

MARK = 0 !Uninitialised variables are bad.

DO I = ISTASH(IT),ISTASH(IT + 1) - 1 !Step through the stashed text.

C = STASH(I:I) !Grab a character.

IF (C.EQ."<") THEN !Is it the starter?

MARK = I !Yes. Remember where it is.

ELSE IF (C.EQ.">") THEN !The ender?

IF (MARK.LE.0) CALL CROAK("A > with no preceeding <!") !Bah.

CALL TABLE(STASH(MARK:I)) !Yes. Consider the spanned text.

MARK = 0 !And be ready to check afresh.

END IF !So much for that character.

END DO !On to the next.

END SUBROUTINE INSPECT !WRITESTORY will rescan the story lines.

SUBROUTINE READSTORY(IN)!Read and stash the lines.

INTEGER IN !Input from here.

INTEGER LINE !A finger to the story line.

10 LINE = EATTEXT(IN) !So, grab a line.

IF (LINE.GT.0) THEN !A live line?

NSTORY = NSTORY + 1 !Yes.Count it in.

STORY(NSTORY) = LINE !Save it in the story list.

CALL INSPECT(LINE) !Look for trouble as well.

GO TO 10 !And go for the next line.

END IF !Oh for while (Line:=EatText(in)) > 0 do SaveAndInspect(Line);

END SUBROUTINE READSTORY!Simple enough, anyway.

SUBROUTINE WRITESTORY !Applying the replacements.

INTEGER LINE,IT,I,J !Steppers.

INTEGER L,L0,N,HIT !Fingers.

INTEGER LAST,MARK !Scan choppers.

L0 = ISTASH(NSTASH + 1) !The first available place in the stash.

LL:DO LINE = 1,NSTORY !Step through the lines of the story.

L = L0 - 1 !Syncopation for my output finger.

IT = STORY(LINE) !Finger the stashed line.

LAST = ISTASH(IT) - 1 !No text from this line yet.

II:DO I = ISTASH(IT),ISTASH(IT + 1) - 1 !Step along its text.

IF (STASH(I:I).EQ."<") THEN !Trouble starter?

MARK = I !Yes. Remember where.

ELSE IF (STASH(I:I).EQ.">") THEN !The corresponding ender.

N = MARK - LAST - 1 !Waiting text up to the mark.

IF (L + N.GT.LSTASH) CALL CROAK("Out of stash!") !Paranoia.

STASH(L + 1:L + N) = STASH(LAST + 1:MARK - 1) !Place in the output line.

L = L + N !Advance the output finger.

JJ:DO J = 1,NTESTS !Step through the target texts.

HIT = TARGET(J) !Finger one.

IF (STASH(ISTASH(HIT):ISTASH(HIT + 1) - 1) !Its stashed text.

1 .EQ.STASH(MARK:I)) THEN !Matches the suspect text?

HIT = REPLACEMENT(J) !Yes! Finger the replacement text.

IF (HIT.GT.0) THEN !Presumably, not a null text.

N = ISTASH(HIT + 1) - ISTASH(HIT) !Character count thereof.

IF (L + N.GT.LSTASH) CALL CROAK("Over replaced!") !Always distinct messages.

STASH(L + 1:L + N) = STASH !Place for output.

1 (ISTASH(HIT):ISTASH(HIT + 1) - 1)!From wherever it is.

L = L + N !Advance the output finger.

END IF !So much for the replacement.

EXIT JJ !Found the target, so the search is finished.

END IF !Otherwise,

END DO JJ !Try the next target text.

LAST = I !Remember the location of the >.

END IF !Enough analysis of that character from the story line.

END DO II !On to the next.

WRITE (MSG,*) STASH(L0:L)//STASH(LAST+1:ISTASH(IT+1)-1) !With the tail end.

END DO LL !On to the next story line.

END SUBROUTINE WRITESTORY !Just a sequence of lines.

END MODULE MADLIB !Enough of that.

PROGRAM MADLIBBER

USE MADLIB

OPEN(INF,STATUS="OLD",ACTION="READ",FORM="FORMATTED",

1 FILE = "Madlib.txt")

CALL READSTORY(INF)

CLOSE(INF)

CALL WRITESTORY

END

</lang>