Task: Mad Libs








VB: Function mad_libs(s)
    Do
        If InStr(1,s,"<") <> 0 Then
            start_position = InStr(1,s,"<") + 1
            end_position = InStr(1,s,">")
            parse_string = Mid(s,start_position,end_position-start_position)
            WScript.StdOut.Write parse_string & "? "
            input_string = WScript.StdIn.ReadLine
            s = Replace(s,"<" & parse_string & ">",input_string)
        Else
            Exit Do
        End If
    Loop
    mad_libs = s
End Function

WScript.StdOut.Write mad_libs("<name> went for a walk in the park. <he or she> found a <noun>. <name> decided to take it home.")
WScript.StdOut.WriteLine



Fortran:       MODULE MADLIB	
       INTEGER MSG,KBD,INF		
       DATA MSG,KBD,INF/6,5,10/		
       INTEGER LSTASH,NSTASH,MSTASH	
       PARAMETER (LSTASH = 246810, MSTASH = 6666)	
       CHARACTER*(LSTASH) STASH		
       INTEGER ISTASH(MSTASH + 1)	
       DATA NSTASH,ISTASH(1)/0,1/	
       INTEGER MANYLINES,MANYTESTS	
       PARAMETER (MANYLINES = 1234)	
       INTEGER NSTORY,STORY(MANYLINES)	
       PARAMETER (MANYTESTS = 1234)	
       INTEGER NTESTS,TARGET(MANYTESTS),REPLACEMENT(MANYTESTS)	
       DATA NSTORY,NTESTS/0,0/		
       INTEGER STACKLIMIT		
       PARAMETER (STACKLIMIT = 28)	

       CONTAINS
        SUBROUTINE CROAK(GASP)	
         CHARACTER*(*) GASP	
         WRITE (MSG,*) "Oh dear."	
         WRITE (MSG,*) GASP		
         STOP "How sad."		
        END SUBROUTINE CROAK	

        SUBROUTINE SHOWSTASH(BLAH,I)	
         CHARACTER*(*) BLAH		
         INTEGER I			
          WRITE (MSG,1) BLAH,I,STASH(ISTASH(I):ISTASH(I + 1) - 1)	
    1     FORMAT (A,': Text(',I0,')="',A,'"')	
        END SUBROUTINE SHOWSTASH	

        INTEGER FUNCTION EATTEXT(IN)	
Co-opts the as-yet unused space in STASH as its scratchpad.
         INTEGER IN	
         INTEGER I,N,L	
          I = ISTASH(NSTASH + 1)
          N = LSTASH - I + 1	
          IF (N.LT.666) CALL CROAK("Insufficient STASH space remains
          READ (IN,1,END = 66) L,STASH(I:I + MIN(L,N) - 1)	
    1     FORMAT (Q,A)		
          L = I + MIN(L,N) - 1	
   10     IF (L.LT.I) GO TO 66	
          IF (ICHAR(STASH(L:L)).LE.ICHAR(" ")) THEN	
            L = L - 1		
            GO TO 10		
          END IF		
          IF (NSTASH.GE.MSTASH) CALL CROAK("Too many texts
          NSTASH = NSTASH + 1	
          ISTASH(NSTASH + 1) = L + 1	
          EATTEXT = NSTASH	
         RETURN			
   66     EATTEXT = 0		
        END FUNCTION EATTEXT	

        INTEGER FUNCTION ADDSTASH(TEXT)	
         CHARACTER*(*) TEXT	
         INTEGER I		
          IF (NSTASH.GE.MSTASH) CALL CROAK("The text pool is crowded
          I = ISTASH(NSTASH + 1)	
          IF (I + LEN(TEXT).GT.LSTASH) CALL CROAK("Overtexted
          STASH(I:I + LEN(TEXT) - 1) = TEXT	
          NSTASH = NSTASH + 1			
          ISTASH(NSTASH + 1) = I + LEN(TEXT)	
          ADDSTASH = NSTASH	
        END FUNCTION ADDSTASH	

        INTEGER FUNCTION ANOTHER(TEXT)	
Collects TARGET REPLACEMENT pairs (increasing NTESTS) as directed by INSPECT.
         CHARACTER*(*) TEXT	
         INTEGER I,IT		
          ANOTHER = 0		
          DO I = 1,NTESTS	
            IT = TARGET(I)		
            IF (TEXT.EQ.STASH(ISTASH(IT):ISTASH(IT + 1) - 1)) RETURN	
          END DO		
          IF (NTESTS.GE.MANYTESTS) CALL CROAK("Too many tests
          NTESTS = NTESTS + 1		
          TARGET(NTESTS) = ADDSTASH(TEXT)
          ANOTHER = NTESTS		
          WRITE (MSG,1) TEXT		
    1     FORMAT ("Enter your text for ",A,": ",$)	
          REPLACEMENT(NTESTS) = EATTEXT(KBD)	
        END FUNCTION ANOTHER	

        SUBROUTINE INSPECT(X)	
Calls for inspection of REPLACEMENT texts as well, should ANOTHER report a new entry.
         INTEGER X	
         INTEGER MARK	
         INTEGER IT,NEW	
         INTEGER I	
         INTEGER SP,STACK(STACKLIMIT)	
          SP = 1		
          STACK(1) = X		
          DO WHILE(SP.GT.0)	
            IT = STACK(SP)		
            SP = SP - 1			
            MARK = 0			
            DO I = ISTASH(IT),ISTASH(IT + 1) - 1
              IF (STASH(I:I).EQ."<") THEN	
                MARK = I			
              ELSE IF (STASH(I:I).EQ.">") THEN	
                IF (MARK.LE.0) CALL CROAK("A > with no preceeding <
                NEW = ANOTHER(STASH(MARK:I))	
                IF (NEW.GT.0) THEN		
                  IF (SP.GE.STACKLIMIT) CALL CROAK("Stack overflow
                  SP = SP + 1			
                  STACK(SP) = REPLACEMENT(NEW)	
                END IF			
                MARK = 0		
              END IF		
            END DO		
          END DO	
        END SUBROUTINE INSPECT	

        SUBROUTINE READSTORY(IN)
         INTEGER IN		
         INTEGER LINE		
   10    LINE = EATTEXT(IN)	
         IF (LINE.GT.0) THEN	
           NSTORY = NSTORY + 1	
           STORY(NSTORY) = LINE	
           CALL INSPECT(LINE)	
           GO TO 10		
         END IF			
        END SUBROUTINE READSTORY

        SUBROUTINE WRITESTORY(WIDTH)	
Co-opts the as-yet unused space in STASH as its output scratchpad.
Can't rely on changing the index and bounds of a DO-loop on the fly.
         INTEGER WIDTH
         INTEGER LINE,IT,I,J	
         INTEGER L,L0,N		
         INTEGER TAIL,MARK,LAST	
         INTEGER SP,STACKI(STACKLIMIT),STACKL(STACKLIMIT)	
          L0 = ISTASH(NSTASH + 1)	
          L = L0 - 1			
       LL:DO LINE = 1,NSTORY		
            SP = 0			
            IT = STORY(LINE)		
            LAST = ISTASH(IT + 1) - 1	
            I = ISTASH(IT)		
            TAIL = I - 1		
            IF (STASH(I:I).LE." ") THEN	
              CALL BURP			
            ELSE IF (LINE.GT.1) THEN	
              L = L + 1			
              STASH(L:L) = " "		
            END IF			
  666    II:DO WHILE(I.LE.LAST)		
              IF (STASH(I:I).EQ."<") THEN	
                MARK = I			
              ELSE IF (STASH(I:I).EQ.">") THEN	
                CALL APPEND(TAIL + 1,MARK - 1)	
             JJ:DO J = 1,NTESTS		
                  IT = TARGET(J)		
                  IF (STASH(ISTASH(IT):ISTASH(IT + 1) - 1)	
     1            .EQ.STASH(MARK:I)) THEN		
                    IT = REPLACEMENT(J)		
                    IF (IT.GT.0) THEN	
                      IF (SP.GE.STACKLIMIT) CALL CROAK("StackOverflow
                      SP = SP + 1		
                      STACKI(SP) = I		
                      STACKL(SP) = LAST		
                      I = ISTASH(IT) - 1	
                      LAST = ISTASH(IT + 1) - 1	
                    END IF			
                    EXIT JJ		
                  END IF		
                END DO JJ		
                TAIL = I		
              END IF			
              I = I + 1			
            END DO II		
            IF (SP.GT.0) THEN	
              CALL APPEND(TAIL + 1,LAST)
              TAIL = STACKI(SP)		
              LAST = STACKL(SP)		
              SP = SP - 1		
              I = TAIL + 1		
              GO TO 666			
            END IF		
            CALL APPEND(TAIL + 1,LAST)	
          END DO LL			
          CALL BURP		
         CONTAINS		
          SUBROUTINE APPEND(IST,LST)	
           INTEGER IST,LST		
           INTEGER N			
            N = LST - IST + 1		
            IF (N.LE.0) RETURN		
            IF (L + N.GT.LSTASH) CALL CROAK("Out of stash
            STASH(L + 1:L + N) = STASH(IST:LST)	
            L = L + N			
            IF (L - L0 + 1.GE.WIDTH) CALL BURP	
          END SUBROUTINE APPEND		
          SUBROUTINE BURP		
           INTEGER N,W,L1		
            N = L - L0 + 1		
            IF (N.LE.WIDTH) THEN	
              L1 = L			
             ELSE			
              W = L0 + WIDTH - 1	
              DO L1 = W,L0,-1		
                IF (STASH(L1:L1).LE." ") EXIT	
              END DO			
              IF (L1.LE.L0) L1 = W	
            END IF			
            WRITE (MSG,"(A)") STASH(L0:L1)	
            IF (N.LE.WIDTH) THEN	
              L = L0 - 1		
             ELSE			
              W = L0 + L - L1 - 1	
              STASH(L0:W) = STASH(L1 + 1:L)	
              L = W			
            END IF			
          END SUBROUTINE BURP		
        END SUBROUTINE WRITESTORY	
      END MODULE MADLIB		

      PROGRAM MADLIBBER	
      USE MADLIB
      WRITE (MSG,1)	
    10FORMAT ("Reads a story in template form, containing special ",
     1 "entries such as <dog's name> amongst the text.",/,
     2 "You will be invited to supply a replacement text for each "
     3 "such entry, as encountered,",/,
     4 "after which the story will be presented with your ",
     5 "substitutions made.",//,
     6 "Here goes... Reading file Madlib.txt",/)
      OPEN(INF,STATUS="OLD",ACTION="READ",FORM="FORMATTED",
     1 FILE = "Madlib.txt")
      CALL READSTORY(INF)
      CLOSE(INF)
      WRITE (MSG,*)
      WRITE (MSG,*) "  Righto
      WRITE (MSG,*)
      CALL WRITESTORY(66)
      END