Image Map Image Map
Page 1 of 2 12 LastLast
Results 1 to 10 of 11

Thread: Looking for 'Travesty' program

  1. #1

    Default Looking for 'Travesty' program

    Hello,

    I found interesting program A Travesty Generator for Micros

    I typed sourve code, but after compilation on TurboPascal program doesn't work.

    Code:
    PROGRAM travesty (input, output); {Kenner / O'Rourke, 5/9/84} 
    
    {(*This is based on Brian Hayes's article in Scientific *)
    (*American, November 1983. It scans a text and generates *)
    (*an n-order simulation of its letter combinations. For *)
    (*order n, the relation of output to input is exactly: *)
    
    (*"Any pattern n characters long in the output *)
    (*has occurred somewhere in the input, *)
    (*and at about the same frequency." *)
    (*Input should be ready on disk. Program asks how many *)
    (*characters of output you want. It next asks for the *)
    (*"Order" i.e. how long a string of characters will be *)
    (*cloned to output when found. You are asked for the *)
    (*name of the input file, and offered a "Verse" option.*)
    (*If you select this, and if the input has a " ! " char- *)
    (*acter at the end of each line, words that end lines in *)
    (*the original will terminate output lines. Otherwise, *)
    (*output lines will average 50 characters in length. *)}
    
    
    
    CONST 
    ArraySize= 3000; {maximum number of text chars} 
    MaxPat=9; {maximum Pattern length} 
    
    VAR
    
    BigArray : PACKED ARRAY [1 ..ArraySize] of CHAR; 
    
    FreqArray, StartSkip : ARRAY[' '..'|'] of INTEGER;
    
    Pattern : PACKED ARRAY [1 ..MaxPat] of CHAR; 
    
    SkipArray : ARRAY [1 ..ArraySize] of INTEGER; 
    
    OutChars : INTEGER; {number of characters to be output} 
    PatLength : INTEGER; 
    f : TEXT; 
     CharCount : INTEGER; {characters so far output} 
     Verse, NearEnd : BOOLEAN; 
    NewChar : CHAR; 
    TotalChars : INTEGER; {total chars input, + wraparound} 
    Seed : INTEGER; 
    
    FUNCTION Random (VAR Randlnt : INTEGER) : REAL; 
    {41}
    BEGIN 
    
    Random:= Randlnt/ 1009; 
    Randlnt:= (31 * Randlnt + 11) MOD 1009;
    END; 
    
    PROCEDURE InParams; 
    {* Obtains user's instructions *)}
    VAR
    
    InFile : STRING [12]; 
    Response : CHAR; 
    
    BEGIN
    
    WRITELN ('Enter a Seed (1 .. 1 000) for the randomizer'); 
    READLN (Seed); 
    WRITELN ('Number of characters to be output?'); 
    READLN (OutChars); 
    REPEAT
    WRITELN ('What order? <2 - ', MaxPat,'>'); 
    READLN (PatLength) 
    UNTIL (PatLength IN [2 ..MaxPat]); 
    PatLength:= PatLength - 1 ; 
    WRITELN ('Name of input file?'); 
    
    READLN (InFile); 
    ASSIGN (f, InFile); 
    RESET (f); 
    
    WRITELN ('Prose or Verse? <p/v>'); 
    READLN (Response); 
    IF (Response='V') OR (Response='v') THEN
    Verse:= true 
    ELSE Verse:= false 
    END; {Procedure InParams} 
    
    PROCEDURE ClearFreq; 
    {* FreqArray is indexed by 93 probable ASCII characters, }
    {* from " " to "! ". Its elements are all set to zero. }
    
    VAR 
    ch : CHAR;
    
    BEGIN 
    FOR ch:= ' ' TO '|' DO 
    FreqArray[ch]:= 0
    END; {Procedure ClearFreq} 
    
    
    PROCEDURE NullArrays; 
    {* Fill BigArray and Pattern with nulls *}
    
    VAR 
    j : INTEGER; 
    BEGIN 
    FOR j:=1 TO ArraySize DO 
    BigArray[j]:= CHR(0); 
    
    FOR j:=1 TO MaxPat DO 
    Pattern[j]:=CHR(0)
    END; {Procedure NullArrays} 
    
    PROCEDURE FillArray; 
    {* Moves textfile from disk into BigArray, cleaning it 
    (* up and reducing any run of blanks to one blank. 
    (* Then copies to end of array a string of its opening 
    (* characters as long as the Pattern, in effect wrapping 
    (* the end to the beginning. }
    
    VAR 
    Blank : BOOLEAN; 
    ch: CHAR; 
    j : INTEGER; 
    
    PROCEDURE Cleanup; 
    
    {(* Clears Carriage Returns, Linefeeds, and Tabs out of 
    (* input stream. All are changed to blanks. }
    BEGIN 
    IF ((ch = CHR(13)) {CR} 
    OR (ch = CHR(10)) {LF} 
    OR (ch = CHR(9))) {TAB} 
    THEN ch:= ' ' {!!!}
    END; 
    
    BEGIN {Procedure FillArray} 
    
    j:= 1; 
    Blank:=false; 
    WHILE (NOT EOF(f)) AND (j<=(ArraySize-MaxPat)) DO
    BEGIN {While Not EOF} 
    
    READ (f, ch); 
    Cleanup; 
    BigArray[j]:=ch; {Place character in BigArray} 
    IF ch=' ' THEN Blank:= true; {!!!}
    
    j:= j + 1; 
    
    WHILE (Blank AND (NOT EOF(f)) AND (j <= (ArraySize - MaxPat))) DO 
    {125}
    BEGIN {While Blank} 
    READ (f, ch); 
    Cleanup; 
    
    IF ch<>' ' THEN {!!!}
    BEGIN {If} 
    Blank:=false; 
    BigArray[j]:=ch; {To BigArray if not a Blank} 
    j:=j + 1
    END {If} 
    END {While Blank} 
    END; {While Not EOF} 
    
    TotalChars:= j - 1; 
    IF BigArray[TotalChars] <>'' THEN 
    BEGIN {If no Blank at end of text, append one} 
    
    TotalChars:= TotalChars + 1; 
    
    BigArray[TotalChars]:=' '
    END;
    
    {Copy front of array to back to simulate wraparound.} 
    FOR j:=1 TO PatLength DO 
    
    BigArray[TotalChars + j]:= BigArray[j]; 
    TotalChars:= TotalChars + PatLength; 
    WRITELN('Characters read, plus wraparound = ',TotalChars:4) 
    END; {Procedure FillArray} 
    
    PROCEDURE FirstPattern; 
    {(* User selects "order" of operation, an integer, n, in the 
    (* range 1 .. 9. The input text will henceforth be scanned 
    (* in n-sized chunks. The first n-1 characters of the input 
    
    (* file are placed in the "Pattern" Array. The Pattern is 
    
    (* written at the head of output. }
    
    VAR 
    j : INTEGER; 
    BEGIN 
    
    FOR j:= 1 TO PatLength DO {Put opening chars into Pattern}
    Pattern[j]:=BigArray[j]; 
    CharCount:= PatLength; 
    NearEnd:= false; 
    
    IF Verse THEN write(' '); {Align first line} {not sure if write}
    
    FOR j:=1 TO PatLength DO 
    WRITE (Pattern[j]) 
    END; {Procedure FirstPattern} 
    
    PROCEDURE InitSkip; 
    {The i-th entry of SkipArray contains the smallest index 
    j < i such that BigArrayO] = BigArray[i]. Thus SkipArray 
    links together all identical characters in BigArray. 
    Starts kip contains the index of the first occurrence of 
    each character, These two arrays are used to skip the 
    matching routine through the text, stopping only at 
    locations whose character matches the first character 
    in Pattern. }
    VAR 
    ch : CHAR; 
    j : INTEGER; 
    BEGIN 
    FOR ch:=' ' TO '|' DO 
    StartSkip[ch]:=TotalChars + 1 ; 
    
    FOR j:=TotalChars DOWNTO 1 DO 
    BEGIN 
    ch:=BigArray[j]; 
    SkipArray[j]:=StartSkip[ch]; 
    StartSkip[ch]:= j 
    
    {188}
    END 
    END; {Procedure InitSkip} 
    
    PROCEDURE Match; 
    {(* Checks BigArray for strings that match Pattern; for each *) 
    (* match found, notes following character and increments its *) 
    (* count in FreqArray. Position for first trial comes from *) 
    (* StartSkip; thereafter positions are taken from SkipArray. *) 
    (* Thus no sequence is checked unless its first character is *) 
    (* already known to match first character of Pattern. *)}
    
    
    {198}
    VAR
    i : INTEGER; {one location before start of the match in BigArray} 
    j : INTEGER; {index into Pattern} 
    Found : BOOLEAN; {true if there is a match from i + 1 to i + j - 1 } 
    ch1 : CHAR; {the first character in Pattern; used for skipping} 
    NxtCh : CHAR; 
    
    BEGIN {Procedure Match} 
    
    ch1:= Pattern[1]; 
    i:= StartSkip[ch1] - 1; {i is 1 to left of the Match start} 
    
    WHILE (i <=TotalChars-PatLength-1) DO 
    
    BEGIN {While} 
    j:= 1;
    Found:= true; 
    WHILE (Found AND (j <= PatLength)) DO 
    IF BigArray[i + j] <> Pattern[j] 
    THEN Found:=false {Go thru Pattern till Match fails} 
    ELSE j:=j + 1 ; 
    
    IF Found THEN 
    BEGIN {Note next char and increment FreqArray} 
    NxtCh:= BigArray[i + PatLength + 1]; 
    FreqArray[NxtCh]:=FreqArray[NxtCh] + 1 
    END; 
    
    i:= SkipArray[i+ 1] - 1 {Skip to next matching position} 
    END {While} 
    END; {Procedure Match} 
    
    
    PROCEDURE WriteCharacter; 
    {(* The next character is written. It is chosen at Random *) 
    (* from characters accumulated in FreqArray during last *) 
    (* scan of input. Output lines will average 50 characters *) 
    (* in length. If "Verse" option has been selected, a new *) 
    (* line will commence after any word that ends with "'"in *) 
    (* input file. Thereafter lines will be indented until *) 
    (* the 50-character average has been made up. *) }
    
    VAR 
    Counter, Total, Toss : INTEGER; 
    ch : CHAR; 
    
    BEGIN 
    Total:=0; 
    FOR ch:=' ' TO '|' DO 
    Total:= Total + FreqArray[ch]; {Sum counts in FreqArray} 
    Toss:= TRUNC (Total * Random(Seed)) +1; 
    Counter:= 31; 
    REPEAT 
    Counter:=Counter + 1 ; {We begin with ' ' } 
    Toss:= Toss-FreqArray[CHR(Counter)] 
    until Toss <= 0; {Char chosen by} 
    
    NewChar:= CHR(Counter); {successive subtractions} 
    
    IF NewChar <>'|'THEN 
    WRITE (NewChar); 
    
    CharCount:= CharCount + 1; 
    IF CharCount MOD 50 = 0 THEN NearEnd:= true; 
    IF ((Verse) AND (NewChar = '|')) THEN WRITELN; 
    
    {251} IF ((NearEnd) AND (NewChar = ' ')) THEN 
    BEGIN {If NearEnd} 
    WRITELN; 
     IF Verse THEN WRITE (' '); 
     NearEnd:= false 
     END {If NearEnd} 
    END; {Procedure WriteCharacter} 
    
    PROCEDURE NewPattern; 
    {(* This removes the first character of the Pattern and 
    (* appends the character just printed. FreqArray is 
    (* zeroed in preparation for a new scan. }
    
    VAR 
    j : INTEGER; 
    BEGIN 
    FOR j:=1 to PatLength - 1 DO 
    
    Pattern[j]:= Pattern[j+ 1]; {Move all chars leftward }
    Pattern[Patlength]:=NewChar; {Append NewChar} 
    ClearFreq 
    END; {Procedure NewPattern} 
    
    {272}
    BEGIN {Main Program} 
    
    ClearFreq; 
    NullArrays; 
    InParams; 
    FillArray; 
    FirstPattern; 
    InitSkip; 
    REPEAT 
    Match; 
    WriteCharacter; 
    NewPattern 
    UNTIL CharCount <= OutChars; 
    END. {Main Program}
    I found link in teh internets to travesty.lbr, but file unavailable. Does anyone has listing?

    thank you.

  2. #2

    Default

    Cursorily, however, this source code looks rather complete. I don't think a missing library is your problem. What error do you actually get?
    I use my C128 because I am an ornery, stubborn, retro grouch. -- Bob Masse
    Machine room: http://www.floodgap.com/etc/machines.html

  3. #3

    Default

    Quote Originally Posted by ClassicHasClass View Post
    Cursorily, however, this source code looks rather complete. I don't think a missing library is your problem. What error do you actually get?
    *.LBR isn't a linker library, it's an old archive format; presumably the file might've contained a binary built from the source. I couldn't find the file either; the one (relevant) result for it that shows up on Google indicates that "GEnie library 24" would've had it, but none of the CP/M archive sites I know of have that set.
    Computers: Amiga 1200, DEC VAXStation 4000/60, DEC MicroPDP-11/73
    Synthesizers: Roland JX-10/SH-09/MT-32/D-50, Yamaha DX7-II/V50/TX7/TG33/FB-01, Korg MS-20 Mini/ARP Odyssey/DW-8000/X5DR, Ensoniq SQ-80, E-mu Proteus/2, Moog Satellite, Oberheim SEM
    "'Legacy code' often differs from its suggested alternative by actually working and scaling." - Bjarne Stroustrup

  4. #4
    Join Date
    Aug 2006
    Location
    Chicagoland, Illinois, USA
    Posts
    5,556
    Blog Entries
    1

    Default

    I typed sourve code
    You probably mis-typed the "sourve" code. It compiles and runs, but produces 2 or 3 characters of output. Double-check what you typed with the listing in Byte magazine.
    Offering a bounty for:
    - The software "Overhead Express" (doesn't have to be original, can be a copy)
    - A working Sanyo MBC-775, Olivetti M24, or Logabax 1600
    - Documentation and original disks for: Panasonic Sr. Partner, Zenith Z-160 series
    - Music Construction Set, IBM Music Feature edition (has red sticker on front stating IBM Music Feature)

  5. #5
    Join Date
    Aug 2006
    Location
    Chicagoland, Illinois, USA
    Posts
    5,556
    Blog Entries
    1

    Default

    At the very end of the program, you have a reversed comparison. You have <= when it should be >= . Then the program works.

    Also, the output doesn't start to get readable until order 4.
    Offering a bounty for:
    - The software "Overhead Express" (doesn't have to be original, can be a copy)
    - A working Sanyo MBC-775, Olivetti M24, or Logabax 1600
    - Documentation and original disks for: Panasonic Sr. Partner, Zenith Z-160 series
    - Music Construction Set, IBM Music Feature edition (has red sticker on front stating IBM Music Feature)

  6. #6

    Default

    Double check these changes. Search for first and change to second.

    Code:
    BigArray : PACKED ARRAY [1 ..ArraySize] of CHAR;
    BigArray : PACKED ARRAY[1..ArraySize] of CHAR;
    
    Pattern : PACKED ARRAY [1 ..MaxPat] of CHAR;
    Pattern : PACKED ARRAY[1..MaxPat] of CHAR;
    
    SkipArray : ARRAY [1 ..ArraySize] of INTEGER;
    SkipArray : ARRAY[1..ArraySize] of INTEGER;
    
    FUNCTION Random (VAR Randlnt : INTEGER) : REAL;
    FUNCTION Random (VAR Randint : INTEGER) : REAL;
    
    Random:= Randlnt/ 1009;
    Random:= Randint/ 1009;
    
    Randlnt:= (31 * Randlnt + 11) MOD 1009;
    Randint:= (31 * Randint + 11) MOD 1009;
    
    InFile : STRING [12];
    InFile : STRING[12];
    
    WRITELN ('Enter a Seed (1 .. 1000) for the randomizer');
    WRITELN ('Enter a Seed (1..1000) for the randomizer');
    
    UNTIL (PatLength IN [2 ..MaxPat]);
    UNTIL (PatLength IN [2..MaxPat]);
    
    PatLength:= PatLength - 1 ;
    PatLength:= PatLength - 1;
    
    BEGIN {Procedure FillArray}
    BEGIN {Procedure FillArray};
    
    StartSkip[ch]:= j ;
    StartSkip[ch]:= j
    
    Toss:= Toss-FreqArray[CHR(Counter)];
    Toss:= Toss-FreqArray[CHR(Counter)]
    
    IF Verse THEN WRITE (' ');
    IF Verse THEN WRITE ('   ');
    
    UNTIL CharCount <= OutChars;
    UNTIL CharCount >= OutChars;
    That should help.

    Larry

  7. #7

    Default

    There are no error,but seems program works wrong:
    2018-12-07_172912.jpg

  8. #8

    Default

    omg, it works!
    Code:
    UNTIL CharCount >= OutChars;
    thank you very much!

  9. #9
    Join Date
    Mar 2017
    Location
    New Jersey, USA
    Posts
    315

    Default

    In case anyone is interested, a C implementation of this was posted to comp.sources.games on Usenet in December 1989:

    v08i075: travesty - make a travesty of the input, Part01/01
    v08i079: travesty - make a travesty of the input, Patch1

  10. #10
    Join Date
    Jul 2005
    Location
    State College, PA
    Posts
    142

    Default

    Neil Rubenking wrote a program called BREKDOWN (Break Down), based on the Travesty program article. It's written for Turbo Pascal and Turbo Database Toolbox:

    http://cd.textfiles.com/bthevhell/300/245/

    I have a version split up into INC files for CP/M 2.2.

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •