DIM A$, L$, dest$, buf$
DIM bit, bytes, stat, numb, hi, lo, left, top, iheight, iwidth, size, depth AS INTEGER
DIM filename$

stat = 0

CLS
PRINT "Netscape Looping Extension"
PRINT "================================================================="
PRINT "This program will insert a GIF89a Application Extension Block to "
PRINT "instruct Netscape Navigator 2.0 to loop a GIF89a graphic. If the "
PRINT "source file already contain this extension block, another will be"
PRINT "inserted before it."
PRINT "================================================================="
INPUT "Name of source GIF (include .EXTension): "; filename$
INPUT "Name of destination GIF (include .EXTension): "; dest$
PRINT "================================================================="
PRINT " The specified destination file will be -**!! OVERWRITTEN !!**-"
dest$ = UCASE$(dest$)
filename$ = UCASE$(filename$)
PRINT "================================================================="
INPUT "How many iterations should it loop through (0-65535; 0=infinite)"; L$
lo = VAL(L$)
IF lo < 0 OR lo > 65535 THEN
   PRINT "Invalid value "; L$; " entered. Will use zero."
   L$ = "0"
END IF
PRINT
OPEN filename$ FOR BINARY ACCESS READ AS 1
OPEN "NETGIF$$.TMP" FOR OUTPUT ACCESS WRITE AS 2
bytes = 6
GOSUB indata

IF buf$ <> "GIF89a" THEN GOTO errorhand
stat = 2
GOSUB outdata

bytes = 4
GOSUB indata
GOSUB outdata

bytes = 1
GOSUB indata

bit = INT(numb / 128)
IF bit THEN
        size = 2 ^ (numb - (INT(numb / 8) * 8) + 1)
        PRINT "color table has "; size; "colors"
ELSE
        GOTO errorhand
END IF
GOSUB outdata

REM finish screen descriptor
bytes = 2
GOSUB indata
GOSUB outdata
PRINT "LOGICAL SCREEN DESCRIPTOR DONE."
stat = 3
REM color table
bytes = size * 3
GOSUB indata
GOSUB outdata
PRINT "GLOBAL COLOR TABLE DONE."


stat = 4
numb = VAL(L$)
hi = INT(numb / 256)
lo = numb - hi * 256
PRINT "Inserting Netscape 2.0 Application Extension for looping."
buf$ = CHR$(33) + CHR$(255) + CHR$(11) + "NETSCAPE2.0" + CHR$(3) + CHR$(1) + CHR$(lo) + CHR$(hi) + CHR$(0)
GOSUB outdata
stat = 5
PRINT "Decoding GIF...";

REM begin block decodes
bytes = 256
WHILE NOT EOF(1)
GOSUB indata
PRINT ".";
GOSUB outdata
WEND
GOTO FINI


FINI:
CLOSE #1
CLOSE #2
PRINT "================================================================="

stat = 6
OPEN dest$ FOR OUTPUT ACCESS WRITE AS #3
WRITE #3, "***"
CLOSE #3
KILL dest$
stat = 7
NAME "NETGIF$$.TMP" AS dest$
PRINT "Finished inserting application extension block."
PRINT "================================================================="

END

indata:
  IF (EOF(1)) THEN GOTO FINI
  buf$ = INPUT$(bytes, #1)
 
  IF LEN(buf$) = 1 THEN numb = ASC(buf$)
RETURN

outdata:
  PRINT #2, buf$;
RETURN

errorhand:
BEEP
PRINT
PRINT "*********************ERROR HANDLER**********************"
SELECT CASE stat
CASE 0
        PRINT "ERROR:No GIF89A header found. File Not Found or not a GIF89A. Did you not include the .GIF extension in the name?"
CASE 1
        PRINT "ERROR:No Logical Screen Descriptor."
CASE 2
        PRINT "ERROR:No Global Color Table."
CASE 3
        PRINT "ERROR:Unable to transfer Global Color Table. Either the file ended prematurely, or there may be insufficent space to write the temp file."
CASE 4
        PRINT "ERROR:Unable to write Netscape Extension to temporary disk file. Either the file ended prematurely, or there may be insufficent space to write the temp file."
CASE 5
        PRINT "ERROR:Unable to write remaining image data to temporary disk file. Either the file ended prematurely, or there may be insufficent space to write the temp file."
CASE 6
        PRINT "ERROR:Unable to delete existing destination file. In use by another program, read-only access?"
CASE 7
        PRINT "ERROR:Unable to rename NETGIF$$.TMP to destination filename.  Illegal filename? Destination file is open and being used by another program."
CASE ELSE
        PRINT "Unknown Error. Check access to disk, free space. Are the filenames correct?"
END SELECT
PRINT
PRINT "Press any key to return to QBASIC editor."
SLEEP
STOP
END