From: pk6811s@acad.drake.edu
Date: 05 Apr 94 15:06:51

net!demon!uknet!pipex!howland.reston.ans.net!vixen.cso.uiuc.edu!newsrelay.
iastate.edu!dunix.drake.edu!acad.drake.edu!pk6811s
From: pk6811s@acad.drake.edu

'  VTANIMATE.BAS
'  Public Domain Source
'
'  Basic program to take a file of sequential screen images and create
'  a compressed version using cursor positioning and other VTxxx codes
'  to create an animated movie.
'
'  Input file format is an ascii file:
'
'      24 line x 80 column screen image
'      form-feed
'      24 line x 80 column screen image
'      form-feed
'      <lots more screen images separated by form-feeds>
' 
'      *Trailing spaces are optional
'      *Blank lines at bottom are optional
'  
DEFINT A-Z
DIM PrevChar(24,80),CurrChar(24,81),ChangeChar(24,80)
DIM StrStartRow(1500),StrEndRow(1500),StrStartCol(1500),StrEndCol(1500)
DIM Strg$(1500)
RChar$=" "
DIM CurrLine$(24)
DIM Words$(100)
HomeCursor$=CHR$(27)+"[H"
LineFeed$=CHR$(10)
BackSpace$=CHR$(8)
EraseToEol$=CHR$(27)+"[K"
EraseToEos$=CHR$(27)+"[J"
Csi$=CHR$(27)+"["

gosub "ConvertFile"
end

"ConvertFile"

'
'  *** Open file
'
PRINT "Enter name of file to convert:";
LINE INPUT CF$
IF CF$="" THEN GOTO "ConvertFileEx"
OPEN "I",1,CF$
PRINT "Enter name of file to output:";
LINE INPUT CFNew$
OPEN "O",2,CFNew$
PRINT #2,HomeCursor$+EraseToEos$;          '  Home Cursor and Clear Screen
'
'  *** Load CurrChar table with spaces
'
CLS
FOR I=1 TO 24
    FOR J=1 TO 80
        CurrChar(I,J)=32
    NEXT J
NEXT I
LINE INPUT #1,C$
IF LEFT$(C$,3)=HomeCursor$ OR LEFT$(C$,1)=CHR$(12) THEN LINE INPUT #1,C$
IF LEN(C$)>80 THEN C$=LEFT$(C$,80)
IF LEN(C$)<80 THEN C$=C$+SPACE$(80-LEN(C$))
WHILE NOT EOF(1)
'
'  *** Move CurrChar to PrevChar and reset ChangeChar tables
'
    FOR I=1 TO 24
        FOR J=1 TO 80
            PrevChar(I,J)=CurrChar(I,J)
            CurrChar(I,J)=32
            ChangeChar(I,J)=0
        NEXT J
    NEXT I
'
'  *** Read next screen into CurrChar table
'  *** screens are separated by form-feeds (control-L) or HomeCursor sequence
'
    I=0
    WHILE (NOT EOF(1)) AND (LEFT$(C$,3)<>HomeCursor$) AND LEFT$(C$,1)<>CHR$(12)
        IF I<24 THEN I=I+1
        Jend=80
        FOR J=1 TO Jend
            CurrChar(I,J)=ASC(MID$(C$,J,1))
        NEXT J
        LINE INPUT #1,C$
        C$=C$+SPACE$(80-LEN(C$))
    WEND
'
'  *** Find differences between previous screen and current
'
    FOR I=1 TO 24
        FOR J=1 TO 80
            LONG IF CurrChar(I,J)<>PrevChar(I,J)
                ChangeChar(I,J)=CurrChar(I,J)
                LOCATE J,I: PRINT CHR$(CurrChar(I,J));
            END IF
        NEXT J
    NEXT I
'
'  *** Load changed characters into Str tables:
'  ***   StrStartRow, StrStartCol, Strg$
'
    StrCount=0
    FOR I=1 TO 24
        J=1
        WHILE J<=80
            LONG IF ChangeChar(I,J)<>0
                StrCount=StrCount+1
                StrStartRow(StrCount)=I
                StrStartCol(StrCount)=J
                Strg$(StrCount)=CHR$(ChangeChar(I,J))
                J=J+1
                WHILE J<=80 AND ChangeChar(I,J)<>0
                    Strg$(StrCount)=Strg$(StrCount)+CHR$(ChangeChar(I,J))
                    J=J+1
                WEND
                StrEndRow(StrCount)=I
                StrEndCol(StrCount)=J-1
            XELSE
                J=J+1
            END IF
        WEND
    NEXT I
'
'  *** Replace trailing spaces with EraseToEol$
'
    FOR I=1 TO StrCount 
        LONG IF RIGHT$(Strg$(I),3)="   "
            TestSpace=1
            TestRow=StrStartRow(I)
            J=StrEndCol(I)+1
            WHILE J<=80
                IF CurrChar(TestRow,J)<>32 THEN TestSpace=0
                J=J+1
            WEND
            LONG IF TestSpace=1
                WorkLine$=Strg$(I)
                WHILE RIGHT$(WorkLine$,1)=" " AND LEN(WorkLine$)>1
                    WorkLine$=LEFT$(WorkLine$,LEN(WorkLine$)-1)
                    StrEndCol(I)=StrEndCol(I)-1
                WEND
                Strg$(I)=WorkLine$+EraseToEol$
            END IF
        END IF
    NEXT I
'
'  *** Do the conversion using vtxxx controls
'
    GOSUB "CompressStrings"
'
'  *** Write every remaining string with it's correct cursor-positioning
'
    CatenateCt=0
    FOR I=1 TO StrCount
        IF LEN(Strg$(I))=0 THEN CatenateCt=CatenateCt+1
        LONG IF LEN(Strg$(I))>0
            PRINT #2,Csi$;
            IF StrStartRow(I)<10 THEN PRINT #2,USING "#";StrStartRow(I);
            IF StrStartRow(I)>=10 THEN PRINT #2,USING "##";StrStartRow(I);
            PRINT #2,";";
            IF StrStartCol(I)<10 THEN PRINT #2,USING "#";StrStartCol(I);
            IF StrStartCol(I)>=10 THEN PRINT #2,USING "##";StrStartCol(I);
            PRINT #2,"H";
            PRINT #2,Strg$(I);
        END IF
    NEXT I
  '  PRINT "/" CatenateCt
    PRINT #2,HomeCursor$
    IF NOT EOF(1) AND LEFT$(C$,3)=HomeCursor$ THEN LINE INPUT #1,C$
WEND
PRINT #2,Csi$+"23;1H";                  '  Put Cursor at bottom of screen
CLOSE
CLS

"ConvertFileEx"
RETURN

"CompressStrings"
'
'  *** Compress by concatenating string pairs with shorter links than e[r;cH
'
FOR I=1 TO StrCount-1
    LONG IF LEN(Strg$(I))>0
        FOR J=I+1 TO StrCount
            LONG IF LEN(Strg$(J))>0 AND LEN(Strg$(I))+LEN(Strg$(J))<250
                IStartRow=StrStartRow(I):  IStartCol=StrStartCol(I)
                IEndRow=StrEndRow(I):  IEndCol=StrEndCol(I)
                JStartRow=StrStartRow(J):  JStartCol=StrStartCol(J)
                JEndRow=StrEndRow(J):  JEndCol=StrEndCol(J)
'
'  *** 2nd string starts 2 columns after 1st ends
'
                LONG IF IEndRow=JStartRow AND JStartCol-IEndCol=2
                    Strg$(I)=Strg$(I)+CHR$(CurrChar(IEndRow,IEndCol+1))+Strg$(J)

                    Strg$(J)=""
                    StrEndRow(I)=JEndRow:  StrEndCol(I)=JEndCol
                XELSE
'
'  *** 1st string starts 2 columns after 2nd ends
'
                LONG IF JEndRow=IStartRow AND IStartCol-JEndCol=2
                    Strg$(I)=Strg$(J)+CHR$(CurrChar(JEndRow,JEndCol+1))+Strg$(I)

                    Strg$(J)=""
                    StrStartRow(I)=JStartRow:  StrStartCol(I)=JStartCol
                XELSE
'
'  *** 2nd string starts 1 line down from where 1st ends
'
                LONG IF IEndCol+1=JStartCol AND IEndRow+1=JStartRow
                    Strg$(I)=Strg$(I)+LineFeed$+Strg$(J)
                    Strg$(J)=""
                    StrEndRow(I)=JEndRow:  StrEndCol(I)=JEndCol
                XELSE
'
'  *** 1st string starts 1 line down from where 2nd ends
'
                LONG IF JEndCol+1=IStartCol AND JEndRow+1=IStartRow
                    Strg$(I)=Strg$(J)+LineFeed$+Strg$(I)
                    Strg$(J)=""
                    StrStartRow(I)=JStartRow:  StrStartCol(I)=JStartCol
                END IF
                END IF
                END IF
                END IF
            END IF
        NEXT J
    END IF
NEXT I

FOR I=1 TO StrCount-1
    LONG IF LEN(Strg$(I))>0
        FOR J=I+1 TO StrCount
            LONG IF LEN(Strg$(J))>0 AND LEN(Strg$(I))+LEN(Strg$(J))<250
                IStartRow=StrStartRow(I):  IStartCol=StrStartCol(I)
                IEndRow=StrEndRow(I):  IEndCol=StrEndCol(I)
                JStartRow=StrStartRow(J):  JStartCol=StrStartCol(J)
                JEndRow=StrEndRow(J):  JEndCol=StrEndCol(J)
'
'  *** 1st string starts 3 columns after 2nd ends
'
                LONG IF IEndRow=JStartRow AND JStartCol=IEndCol+3

(Continued in the next message...)
---
 * Origin: Drake University, Des Moines,  (1:104/332.20000@nyx.cs.du.edu)


