Difference between revisions of "GIF Creation"

From QB64 Wiki
Jump to navigation Jump to search
imported>Clippy
m
m (Text replacement - "Qbasic" to "QBasic")
 
(17 intermediate revisions by one other user not shown)
Line 1: Line 1:
<center>'''GIF File Creator'''</center>
<center>'''GIF File Creator'''</center>
The following routine can be used with QBasic or QB64 to create a Graphic Information File image of a program screen. 


{{CodeStart}} '*********************************** DEMO CODE **********************************
* Accommodates [[_NEWIMAGE]] screen pages with up to 256 colors and image files loaded with [[_LOADIMAGE]].
'Save as a BAS file! Includes the MakeGIF.BI and BM files. Demo by CodeGuy
* The maximum screen coordinates are always one pixel LESS than the screen mode's resolution! (SCREEN 13's are 319 and 199)
* The [[$INCLUDE]] text file can be created using Notepad and is REQUIRED when the program is compiled with QB64 ONLY!


'{{Cl|$INCLUDE}}: 'GIFcreate.BI'


{{CodeStart}} '*********************************** DEMO CODE **********************************
'Save code as a BAS file! Includes the GIFcreate.BI and BM text files. Demo by CodeGuy
{{Cl|DEFINT}} A-Z
{{Cl|SCREEN (statement)|SCREEN}} 13
{{Cl|SCREEN (statement)|SCREEN}} 13
{{Cl|RANDOMIZE}} {{Cl|TIMER}}
{{Cl|RANDOMIZE}} {{Cl|TIMER}}
Line 17: Line 21:
{{Cl|NEXT}}
{{Cl|NEXT}}


MakeGIF "GIFtemp.gif", 0, 0, 319, 199, 256
MakeGIF "GIFtemp.gif", 0, 0, {{Cl|_WIDTH (function)|_WIDTH}} - 1, {{Cl|_HEIGHT}} - 1, 256 'use 319 and 199 in QBasic
 
'Use the include file in QB64 only! Hard code the SUB in QBasic.
'{{Cl|$INCLUDE}}: 'GIFcreate.BM'
'{{Cl|$INCLUDE}}: 'GIFcreate.BM'  


'************************************ END DEMO *********************************
'************************************ END DEMO *********************************
{{CodeEnd}}
{{CodeEnd}}
<center>''GIFcreate.BI text [[$INCLUDE]] file:''</center>
{{TextStart}}
' *************************** GIFcreate.bi ********************
'* original code by Rich Geldreich creates a GIF87a-compliant GIF from a screen image
'* will create GIF only for up to 256 color (8-bit) graphics
{{Cb|DEFINT}} A-Z
{{Cb|CONST}} True = -1, False = 0
{{Cb|DIM}} {{Cb|SHARED}} OutBuffer$, OStartAddress, OAddress, OEndAddress, Oseg
{{Cb|DIM}} {{Cb|SHARED}} CodeSize, CurrentBit, Char&, BlockLength
{{Cb|DIM}} {{Cb|SHARED}} Shift(7) {{Cb|AS}} {{Cb|LONG}}
{{Cb|DIM}} {{Cb|SHARED}} x, y, Minx, MinY, MaxX, MaxY, Done, GIF, LastLoc& '' ''
{{TextEnd}}


<center>''GIFcreate.BM text [[$INCLUDE]] file:''</center>
<center>''GIFcreate.BM text [[$INCLUDE]] file:''</center>
{{TextStart}} '-----------------------------------------------------------------------------
{{TextStart}} '-----------------------------------------------------------------------------
'       GIFcreate.BM Compression Routine v1.00 By Rich Geldreich 1992
'             GIFcreate.BM Compression Routine v1.00 By Rich Geldreich 1992
'            Converted into one SUB Library routine by Ted Weissgerber 2011 
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
'             for 1 BPP, 4 BPP or 8 BPP images only
'                   For 1 BPP, 4 BPP or 8 BPP images only!
'file$      = save image output filename
'file$      = save image output filename
'XStart      = <-upper left hand corner area to encode
'XStart      = <-left hand column of area to encode
'YStart      = <-"
'YStart      = <-upper row of area to encode
'Xend        = <-lower right hand corner of area to encode
'Xend        = <-right hand column of area to encode
'Yend        = <-"                                       "
'Yend        = <-lowest row of area to encode                                       "
'NumColors  = # of colors on screen(2(B&W), 16({{Cb|SCREEN (statement)|SCREEN}} 12), 256({{Cb|SCREEN (statement)|SCREEN}}13)
'NumColors  = # of colors on screen: 2(Black & White), 16(SCREEN 12), 256(SCREEN13)
'
'


{{Cb|SUB}} MakeGIF (file$, Xstart, YStart, Xend, Yend, NumColors)
{{Cb|SUB}} MakeGIF (file$, Xstart, YStart, Xend, Yend, NumColors)
{{Cb|CONST}} True = -1, False = 0
{{Cb|CONST}} Table.size = 7177  'hash table's size - must be a prime number!


{{Cb|CONST}} Table.Size = 7177  'hash table's size - must be a prime number!
{{Cb|DIM}} Prefix(Table.size - 1), Suffix(Table.size - 1), Code(Table.size - 1)
 
{{Cb|DIM}} Shift(7) {{Cb|AS}} {{Cb|LONG}}
{{Cb|DIM}} Prefix(Table__ascii_chr_046__size - 1), Suffix(Table__ascii_chr_046__size - 1), Code(Table__ascii_chr_046__size - 1)
 
{{Cb|FOR...NEXT|FOR}} i = 0 {{Cb|TO}} 7: Shift(i) = 2 ^ i: {{Cb|NEXT}} 'create exponent array for speed.
{{Cb|FOR...NEXT|FOR}} i = 0 {{Cb|TO}} 7: Shift(i) = 2 ^ i: {{Cb|NEXT}} 'create exponent array for speed.


Line 81: Line 73:
     StartCode = 16  'first free code
     StartCode = 16  'first free code
     StartMax = 32  'maximum code in 5 bits
     StartMax = 32  'maximum code in 5 bits
   {{Cb|CASE}} 256         '256 color images {{Cb|SCREEN (statement)|SCREEN}} 13 or {{Cb|_NEWIMAGE}} 256  
   {{Cb|CASE}} 256   '256 color images {{Cb|SCREEN (statement)|SCREEN}} 13 or {{Cb|_NEWIMAGE}} 256  
     BitsPixel = 8  '8 bits per pixel
     BitsPixel = 8  '8 bits per pixel
     StartSize = 9  'first LZW code is 9 bits
     StartSize = 9  'first LZW code is 9 bits
Line 88: Line 80:
{{Cb|END SELECT}}
{{Cb|END SELECT}}


ColorBits = 6      'VGA monitors ONLY
'ColorBits = 2      'for EGA
ColorBits = 6      'VGA monitors ONLY  


{{Cb|PUT}} #GIF, , PWidth% 'put screen's dimensions
{{Cb|PUT}} #GIF, , PWidth% 'put screen's dimensions
Line 139: Line 132:


{{Cb|GOSUB}} ClearTree            'clear the tree & output a
{{Cb|GOSUB}} ClearTree            'clear the tree & output a
PutCode ClearCode         'clear code
PC = ClearCode: {{Cb|GOSUB}} PutCode          'clear code


x = Xstart: y = YStart    'X & Y have the current pixel
x = Xstart: y = YStart    'X & Y have the current pixel
Prefix = GetByte           'the first pixel is a special case
{{Cb|GOSUB}} GetByte: Prefix = GB           'the first pixel is a special case
Done = False              'True when image is complete
Done = False              'True when image is complete


Line 150: Line 143:
'          'and fix up the last block so its count is correct
'          'and fix up the last block so its count is correct


       PutCode Prefix     'write last pixel
       PC = Prefix: {{Cb|GOSUB}} PutCode      'write last pixel
       PutCode {{Cb|EOF}}Code    'send {{Cb|EOF}} code
       PC = {{Cb|EOF}}Code: {{Cb|GOSUB}} PutCode     'send {{Cb|EOF}} code


       {{Cb|IF...THEN|IF}} CurrentBit <> 0 {{Cb|THEN}} PutCode 0   'flush out the last code...
       {{Cb|IF...THEN|IF}} CurrentBit <> 0 {{Cb|THEN}} PC = 0: {{Cb|GOSUB}} PutCode    'flush out the last code...
       PutByte 0
       PB = 0: {{Cb|GOSUB}} PutByte
       OutBuffer$ = {{Cb|LEFT$}}(OutBuffer$, OAddress - OStartAddress)
       OutBuffer$ = {{Cb|LEFT$}}(OutBuffer$, OAddress - OStartAddress)
       {{Cb|PUT}} #GIF, , OutBuffer$
       {{Cb|PUT}} #GIF, , OutBuffer$
Line 161: Line 154:
       A$ = {{Cb|CHR$}}(255 - BlockLength)        'correct the last block's count
       A$ = {{Cb|CHR$}}(255 - BlockLength)        'correct the last block's count
       {{Cb|PUT}} #GIF, LastLoc&, A$
       {{Cb|PUT}} #GIF, LastLoc&, A$
       {{Cb|CLOSE}} #GIF: {{Cb|EXIT SUB}}
       {{Cb|CLOSE}} #GIF: {{Cb|EXIT SUB}}         '<<<<<<<<<<< End of procedure   
     {{Cb|ELSE}}    'get a pixel from the screen and find the new string in table
     {{Cb|ELSE}}    'get a pixel from the screen and find the new string in table
       Suffix = GetByte
       {{Cb|GOSUB}} GetByte: Suffix = GB
       {{Cb|GOSUB}} Hash                                'is it in hash table?
       {{Cb|GOSUB}} Hash                                'is it in hash table?
       {{Cb|IF...THEN|IF}} Found = True {{Cb|THEN}} Prefix = Code(Index) 'replace prefix:suffix string with code in table
       {{Cb|IF...THEN|IF}} Found = True {{Cb|THEN}} Prefix = Code(Index) 'replace prefix:suffix string with code in table
Line 169: Line 162:
   {{Cb|LOOP}} {{Cb|WHILE}} Found            'don't stop unless we find a new string
   {{Cb|LOOP}} {{Cb|WHILE}} Found            'don't stop unless we find a new string


   PutCode Prefix               'output the prefix to the file
   PC = Prefix: {{Cb|GOSUB}} PutCode              'output the prefix to the file
   Prefix(Index) = Prefix      'put the new string in the table
   Prefix(Index) = Prefix      'put the new string in the table
   Suffix(Index) = Suffix
   Suffix(Index) = Suffix
Line 181: Line 174:
     'Note: The GIF89a spec mentions something about a deferred clear code
     'Note: The GIF89a spec mentions something about a deferred clear code
     {{Cb|IF...THEN|IF}} CodeSize = 12 {{Cb|THEN}}    'is the code size too big?
     {{Cb|IF...THEN|IF}} CodeSize = 12 {{Cb|THEN}}    'is the code size too big?
       PutCode ClearCode      'yup; clear the table and
       PC = ClearCode: {{Cb|GOSUB}} PutCode     'yup; clear the table and
       {{Cb|GOSUB}} ClearTree        'start over
       {{Cb|GOSUB}} ClearTree        'start over
       NextCode = StartCode
       NextCode = StartCode
Line 190: Line 183:
   {{Cb|END IF}}
   {{Cb|END IF}}
{{Cb|LOOP}}        'while we have more pixels
{{Cb|LOOP}}        'while we have more pixels
'                                   '{{Cb|GOSUB}} ROUTINES
 
'                             '{{Cb|GOSUB}} ROUTINES
ClearTree:
ClearTree:
{{Cb|FOR...NEXT|FOR}} A = 0 {{Cb|TO}} Table__ascii_chr_046__size - 1 'clears the hashing table
{{Cb|FOR...NEXT|FOR}} A = 0 {{Cb|TO}} Table.size - 1 'clears the hashing table
     Prefix(A) = -1 '-1 = invalid entry
     Prefix(A) = -1 '-1 = invalid entry
     Suffix(A) = -1
     Suffix(A) = -1
Line 200: Line 194:


Hash:  'hash the prefix & suffix(there are also many ways to do this...)
Hash:  'hash the prefix & suffix(there are also many ways to do this...)
Index = ((Prefix * 256&) {{Cb|XOR (boolean)|XOR}} Suffix) {{Cb|MOD}} Table__ascii_chr_046__size
Index = ((Prefix * 256&) {{Cb|XOR (boolean)|XOR}} Suffix) {{Cb|MOD}} Table.size
'
 
'(Note: the table size(7177 in this case) must be a prime number
'       Note: the table size(7177 in this case) must be a prime number
'
'   Calculate an offset just in case we don't find what we want first try...
'Calculate an offset just in case we don't find what we want first try...
{{Cb|IF...THEN|IF}} Index = 0 {{Cb|THEN}}          'cannot have Table.Size 0!
{{Cb|IF...THEN|IF}} Index = 0 {{Cb|THEN}}          'cannot have Table.Size 0!
   Offset = 1
   Offset = 1
{{Cb|ELSE}}
{{Cb|ELSE}}
   Offset = Table__ascii_chr_046__size - Index
   Offset = Table.size - Index
{{Cb|END IF}}
{{Cb|END IF}}


Line 221: Line 214:
     Index = Index - Offset
     Index = Index - Offset
     {{Cb|IF...THEN|IF}} Index < 0 {{Cb|THEN}} 'too far down the table? wrap back the index to end of table
     {{Cb|IF...THEN|IF}} Index < 0 {{Cb|THEN}} 'too far down the table? wrap back the index to end of table
       Index = Index + Table__ascii_chr_046__size
       Index = Index + Table.size
     {{Cb|END IF}}
     {{Cb|END IF}}
   {{Cb|END IF}}
   {{Cb|END IF}}
{{Cb|LOOP}}
{{Cb|LOOP}}
{{Cb|END SUB}}


{{Cb|SUB}} PutByte (A) {{Cb|STATIC}}  'Puts a byte into the GIF file & also takes care of each block.
PutByte:          'Puts a byte into the GIF file & also takes care of each block.
BlockLength = BlockLength - 1 'are we at the end of a block?
BlockLength = BlockLength - 1             'are we at the end of a block?
{{Cb|IF...THEN|IF}} BlockLength <= 0 {{Cb|THEN}}     'end of block
{{Cb|IF...THEN|IF}} BlockLength <= 0 {{Cb|THEN}}                 'end of block
   BlockLength = 255         'block length is now 255
   BlockLength = 255                       'block length is now 255
   LastLoc& = {{Cb|LOC}}(1) + 1 + (OAddress - OStartAddress) 'remember the position
   LastLoc& = {{Cb|LOC}}(GIF) + 1 + (OAddress - OStartAddress) 'remember the position
   BufferWrite 255            'for later fixing
   BW = 255: {{Cb|GOSUB}} BufferWrite             'for later fixing
{{Cb|END IF}}
{{Cb|END IF}}
BufferWrite A                'put a byte into the buffer
BW = PB: {{Cb|GOSUB}} BufferWrite
{{Cb|END SUB}}
{{Cb|RETURN}}
 
{{Cb|SUB}} PutCode (A) {{Cb|STATIC}}  'Puts an LZW variable-bit code into the output file...
Char& = Char& + A * Shift(CurrentBit) 'put the char were it belongs;
CurrentBit = CurrentBit + CodeSize ' shifting it to its proper place
{{Cb|DO...LOOP|DO}} {{Cb|WHILE}} CurrentBit > 7      'do we have a least one full byte?
  PutByte Char& {{Cb|AND (boolean)|AND}} 255      ' yup! mask it off and write it out
  Char& = Char& \ 256        'shift the bit buffer right 8 bits
  CurrentBit = CurrentBit - 8 'now we have 8 less bits
{{Cb|LOOP}}                          'loop until we don't have a full byte
{{Cb|END SUB}}


'Puts a byte into the disk buffer... when the disk buffer is full it is dumped to disk.
BufferWrite:                            'Puts a byte into the buffer
{{Cb|SUB}} BufferWrite (A) {{Cb|STATIC}}
{{Cb|IF...THEN|IF}} OAddress = OEndAddress {{Cb|THEN}}           'are we at the end of the buffer?
{{Cb|IF...THEN|IF}} OAddress = OEndAddress {{Cb|THEN}} 'are we at the end of the buffer?
     {{Cb|PUT}} #GIF, , OutBuffer$               'write it out and
     {{Cb|PUT}} #GIF, , OutBuffer$ ' yup, write it out and
     OAddress = OStartAddress             'start all over
     OAddress = OStartAddress ' start all over
{{Cb|END IF}}
{{Cb|END IF}}
{{Cb|POKE}} OAddress, A 'put byte in buffer
{{Cb|POKE}} OAddress, BW                        'put byte in buffer
OAddress = OAddress + 1 'increment position
OAddress = OAddress + 1                 'increment position
{{Cb|END SUB}}
{{Cb|RETURN}}  
 


{{Cb|FUNCTION}} GetByte {{Cb|STATIC}}      'This routine gets one pixel from the display
GetByte:                'This routine gets one pixel from the display
GetByte = {{Cb|POINT}}(x, y) 'get the "byte"
GB = {{Cb|POINT}}(x, y)                         'get the "byte"
x = x + 1 'increment X coordinate
x = x + 1 'increment X coordinate
{{Cb|IF...THEN|IF}} x > MaxX {{Cb|THEN}} 'are we too far?
{{Cb|IF...THEN|IF}} x > MaxX {{Cb|THEN}}                         'are we too far?
     x = Minx 'go back to start
     x = Minx                             'go back to start
     y = y + 1 'increment Y coordinate
     y = y + 1                           'increment Y coordinate
     {{Cb|IF...THEN|IF}} y > MaxY {{Cb|THEN}} Done = True       ' flag if too far down
     {{Cb|IF...THEN|IF}} y > MaxY {{Cb|THEN}} Done = True         'flag if too far down
{{Cb|END IF}}
{{Cb|END IF}}
{{Cb|END FUNCTION}}'' ''
{{Cb|RETURN}}
 
PutCode:                'Puts an LZW variable-bit code into the output file...
Char& = Char& + PC * Shift(CurrentBit)  'put the char were it belongs;
CurrentBit = CurrentBit + CodeSize      'shifting it to its proper place
{{Cb|DO...LOOP|DO}} {{Cb|WHILE}} CurrentBit > 7                  'do we have a least one full byte?
  PB = Char& {{Cb|AND}} 255: {{Cb|GOSUB}} PutByte      'mask it off and write it out
  Char& = Char& \ 256                    'shift the bit buffer right 8 bits
  CurrentBit = CurrentBit - 8            'now we have 8 less bits
{{Cb|LOOP}}                                    'loop until we don't have a full byte
{{Cb|RETURN}}
{{Cb|END SUB}}'' ''
{{TextEnd}}
{{TextEnd}}
''See also:''
* [[_LOADIMAGE]]
* [[Bitmaps]], [[Icons and Cursors]]
{{PageNavigation}}

Latest revision as of 13:10, 10 February 2021

GIF File Creator

The following routine can be used with QBasic or QB64 to create a Graphic Information File image of a program screen.

  • Accommodates _NEWIMAGE screen pages with up to 256 colors and image files loaded with _LOADIMAGE.
  • The maximum screen coordinates are always one pixel LESS than the screen mode's resolution! (SCREEN 13's are 319 and 199)
  • The $INCLUDE text file can be created using Notepad and is REQUIRED when the program is compiled with QB64 ONLY!


'*********************************** DEMO CODE ********************************** 'Save code as a BAS file! Includes the GIFcreate.BI and BM text files. Demo by CodeGuy DEFINT A-Z SCREEN 13 RANDOMIZE TIMER FOR A = 1 TO 40 x = RND * 320 y = RND * 200 c = RND * 256 CIRCLE (x, y), RND * 80, c PAINT (x, y), RND * 256, c NEXT MakeGIF "GIFtemp.gif", 0, 0, _WIDTH - 1, _HEIGHT - 1, 256 'use 319 and 199 in QBasic 'Use the include file in QB64 only! Hard code the SUB in QBasic. '$INCLUDE: 'GIFcreate.BM' '************************************ END DEMO *********************************

GIFcreate.BM text $INCLUDE file:

'----------------------------------------------------------------------------- ' GIFcreate.BM Compression Routine v1.00 By Rich Geldreich 1992 ' Converted into one SUB Library routine by Ted Weissgerber 2011 '----------------------------------------------------------------------------- ' For 1 BPP, 4 BPP or 8 BPP images only! 'file$ = save image output filename 'XStart = <-left hand column of area to encode 'YStart = <-upper row of area to encode 'Xend = <-right hand column of area to encode 'Yend = <-lowest row of area to encode " 'NumColors = # of colors on screen: 2(Black & White), 16(SCREEN 12), 256(SCREEN13) ' SUB MakeGIF (file$, Xstart, YStart, Xend, Yend, NumColors) CONST True = -1, False = 0 CONST Table.size = 7177 'hash table's size - must be a prime number! DIM Prefix(Table.size - 1), Suffix(Table.size - 1), Code(Table.size - 1) DIM Shift(7) AS LONG FOR i = 0 TO 7: Shift(i) = 2 ^ i: NEXT 'create exponent array for speed. PWidth% = ABS(Xend - Xstart) + 1 PDepth% = ABS(Yend - Ystart) + 1 'MinX, MinY, MaxX, MaxY are maximum and minimum image coordinates IF Xstart > Xend THEN MaxX = Xstart: MinX = Xend ELSE MaxX = Xend: MinX = Xstart IF Ystart > Xend THEN MaxY = Ystart: MinY = Yend ELSE MaxY = Yend: MinY = Ystart 'Open GIF output file GIF = FREEFILE 'use next free file OPEN file$ FOR BINARY AS #GIF B$ = "GIF87a": PUT #GIF, , B$ 'Put GIF87a header at beginning of file SELECT CASE NumColors 'get color settings CASE 2 'monochrome (B&W) image BitsPixel = 1 '1 bit per pixel StartSize = 3 'first LZW code is 3 bits StartCode = 4 'first free code StartMax = 8 'maximum code in 3 bits CASE 16 '16 colors images SCREENS 7, 8, 9, 12, 13 BitsPixel = 4 '4 bits per pixel StartSize = 5 'first LZW code is 5 bits StartCode = 16 'first free code StartMax = 32 'maximum code in 5 bits CASE 256 '256 color images SCREEN 13 or _NEWIMAGE 256 BitsPixel = 8 '8 bits per pixel StartSize = 9 'first LZW code is 9 bits StartCode = 256 'first free code StartMax = 512 'maximum code in 9 bits END SELECT 'ColorBits = 2 'for EGA ColorBits = 6 'VGA monitors ONLY PUT #GIF, , PWidth% 'put screen's dimensions PUT #GIF, , PDepth% CP = 128 + (ColorBits - 1) * 16 + (BitsPixel - 1) 'pack colorbits and bits per pixel PUT #GIF, , CP Zero$ = CHR$(0) 'PUT a zero into the GIF file PUT #GIF, , Zero$ OUT &H3C7, 0 'start read at color 0 FOR c = 0 TO NumColors - 1 'Get the RGB palette from the screen and put into file R = (INP(&H3C9) * 65280) \ 16128 'C = R * 4.0476190(for 0-255) G = (INP(&H3C9) * 65280) \ 16128 B = (INP(&H3C9) * 65280) \ 16128 red$ = CHR$(R): PUT #GIF, , red$ grn$ = CHR$(G): PUT #GIF, , grn$ blu$ = CHR$(B): PUT #GIF, , blu$ NEXT 'write out an image descriptor sep$ = "," 'image separator PUT #GIF, , sep$ 'write it PUT #GIF, , Minx 'image start locations PUT #GIF, , MinY PUT #GIF, , PWidth% 'store them into the file PUT #GIF, , PDepth% A$ = CHR$(BitsPixel - 1) '# bits per pixel in the image PUT #GIF, , A$ A$ = CHR$(StartSize - 1) 'store the LZW minimum code size PUT #GIF, , A$ CurrentBit = 0: Char& = 0 'Initialize the vars needed by PutCode MaxCode = StartMax 'the current maximum code size CodeSize = StartSize 'the current code size ClearCode = StartCode 'ClearCode & EOF code are the EOFCode = StartCode + 1 'first two entries StartCode = StartCode + 2 'first free code that can be used NextCode = StartCode 'the current code OutBuffer$ = STRING$(5000, 32) 'output buffer; for speedy disk writes Buff& = SADD(OutBuffer$) 'find address of buffer Buff& = Buff& - 65536 * (Buff& < 0) Oseg = VARSEG(OutBuffer$) + (Buff& \ 16) 'get segment + offset >> 4 OAddress = Buff& AND 15 'get address into segment OEndAddress = OAddress + 5000 'end of disk buffer OStartAddress = OAddress 'current location in disk buffer DEF SEG = Oseg GOSUB ClearTree 'clear the tree & output a PC = ClearCode: GOSUB PutCode 'clear code x = Xstart: y = YStart 'X & Y have the current pixel GOSUB GetByte: Prefix = GB 'the first pixel is a special case Done = False 'True when image is complete DO 'while there are more pixels to encode DO 'until we have a new string to put into the table IF Done THEN 'write out the last pixel, clear the disk buffer ' 'and fix up the last block so its count is correct PC = Prefix: GOSUB PutCode 'write last pixel PC = EOFCode: GOSUB PutCode 'send EOF code IF CurrentBit <> 0 THEN PC = 0: GOSUB PutCode 'flush out the last code... PB = 0: GOSUB PutByte OutBuffer$ = LEFT$(OutBuffer$, OAddress - OStartAddress) PUT #GIF, , OutBuffer$ A$ = ";" + STRING$(8, &H1A) 'the 8 EOF chars is not standard, PUT #GIF, , A$ A$ = CHR$(255 - BlockLength) 'correct the last block's count PUT #GIF, LastLoc&, A$ CLOSE #GIF: EXIT SUB '<<<<<<<<<<< End of procedure ELSE 'get a pixel from the screen and find the new string in table GOSUB GetByte: Suffix = GB GOSUB Hash 'is it in hash table? IF Found = True THEN Prefix = Code(Index) 'replace prefix:suffix string with code in table END IF LOOP WHILE Found 'don't stop unless we find a new string PC = Prefix: GOSUB PutCode 'output the prefix to the file Prefix(Index) = Prefix 'put the new string in the table Suffix(Index) = Suffix Code(Index) = NextCode 'we've got to keep track of code! Prefix = Suffix 'Prefix = the last pixel pulled from the screen NextCode = NextCode + 1 'get ready for the next code IF NextCode = MaxCode + 1 THEN 'increase the code size MaxCode = MaxCode * 2 'Note: The GIF89a spec mentions something about a deferred clear code IF CodeSize = 12 THEN 'is the code size too big? PC = ClearCode: GOSUB PutCode 'yup; clear the table and GOSUB ClearTree 'start over NextCode = StartCode CodeSize = StartSize MaxCode = StartMax ELSE CodeSize = CodeSize + 1 'increase code size if not too high (not > 12) END IF END IF LOOP 'while we have more pixels ' 'GOSUB ROUTINES ClearTree: FOR A = 0 TO Table.size - 1 'clears the hashing table Prefix(A) = -1 '-1 = invalid entry Suffix(A) = -1 Code(A) = -1 NEXT RETURN Hash: 'hash the prefix & suffix(there are also many ways to do this...) Index = ((Prefix * 256&) XOR Suffix) MOD Table.size ' Note: the table size(7177 in this case) must be a prime number ' Calculate an offset just in case we don't find what we want first try... IF Index = 0 THEN 'cannot have Table.Size 0! Offset = 1 ELSE Offset = Table.size - Index END IF DO 'loop until we find an empty entry or find what we're lookin for IF Code(Index) = -1 THEN 'is this entry blank? Found = False ' didn't find the string RETURN ELSEIF Prefix(Index) = Prefix AND Suffix(Index) = Suffix THEN Found = True 'found the string RETURN ELSE 'didn't find anything, must retry - this slows hashing down. Index = Index - Offset IF Index < 0 THEN 'too far down the table? wrap back the index to end of table Index = Index + Table.size END IF END IF LOOP PutByte: 'Puts a byte into the GIF file & also takes care of each block. BlockLength = BlockLength - 1 'are we at the end of a block? IF BlockLength <= 0 THEN 'end of block BlockLength = 255 'block length is now 255 LastLoc& = LOC(GIF) + 1 + (OAddress - OStartAddress) 'remember the position BW = 255: GOSUB BufferWrite 'for later fixing END IF BW = PB: GOSUB BufferWrite RETURN BufferWrite: 'Puts a byte into the buffer IF OAddress = OEndAddress THEN 'are we at the end of the buffer? PUT #GIF, , OutBuffer$ 'write it out and OAddress = OStartAddress 'start all over END IF POKE OAddress, BW 'put byte in buffer OAddress = OAddress + 1 'increment position RETURN GetByte: 'This routine gets one pixel from the display GB = POINT(x, y) 'get the "byte" x = x + 1 'increment X coordinate IF x > MaxX THEN 'are we too far? x = Minx 'go back to start y = y + 1 'increment Y coordinate IF y > MaxY THEN Done = True 'flag if too far down END IF RETURN PutCode: 'Puts an LZW variable-bit code into the output file... Char& = Char& + PC * Shift(CurrentBit) 'put the char were it belongs; CurrentBit = CurrentBit + CodeSize 'shifting it to its proper place DO WHILE CurrentBit > 7 'do we have a least one full byte? PB = Char& AND 255: GOSUB PutByte 'mask it off and write it out Char& = Char& \ 256 'shift the bit buffer right 8 bits CurrentBit = CurrentBit - 8 'now we have 8 less bits LOOP 'loop until we don't have a full byte RETURN END SUB


See also:



Navigation:
Keyword Reference - Alphabetical
Keyword Reference - By Usage
Main Wiki Page