GIF Creation - mkilgore/QB64pe GitHub Wiki

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!
FOR...NEXT 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 (function) - 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: 
[[SUB|SUB]] MakeGIF (file$, Xstart, YStart, Xend, Yend, NumColors)
[[CONST|CONST]] True = -1, False = 0
[[CONST|CONST]] Table.size = 7177   'hash table's size - must be a prime number!

[[DIM|DIM]] Prefix(Table.size - 1), Suffix(Table.size - 1), Code(Table.size - 1)
[[DIM|DIM]] Shift(7) [[AS|AS]] [[LONG|LONG]]
[[FOR...NEXT|FOR]] i = 0 [[TO|TO]] 7: Shift(i) = 2 ^ i: [[NEXT|NEXT]] 'create exponent array for speed.

PWidth% = [[ABS|ABS]](Xend - Xstart) + 1
PDepth% = [[ABS|ABS]](Yend - Ystart) + 1
'MinX, MinY, MaxX, MaxY are maximum and minimum image coordinates
[[IF...THEN|IF]] Xstart > Xend [[THEN|THEN]] MaxX = Xstart: MinX = Xend [[ELSE|ELSE]] MaxX = Xend: MinX = Xstart
[[IF...THEN|IF]] Ystart > Xend [[THEN|THEN]] MaxY = Ystart: MinY = Yend [[ELSE|ELSE]] MaxY = Yend: MinY = Ystart

'Open GIF output file
GIF = [[FREEFILE|FREEFILE]] 'use next free file
[[OPEN|OPEN]] file$ [[FOR...NEXT|FOR]] [[BINARY|BINARY]] [[AS|AS]] #GIF

B$ = "GIF87a": [[PUT|PUT]] #GIF, , B$  'Put GIF87a header at beginning of file

[[SELECT CASE|SELECT CASE]] NumColors       'get color settings
  [[CASE|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|CASE]] 16           '16 colors images [[SCREEN (statement)|SCREEN]]S 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|CASE]] 256   '256 color images [[SCREEN (statement)|SCREEN]] 13 or [[_NEWIMAGE|_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|END SELECT]]

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

[[PUT|PUT]] #GIF, , PWidth% 'put screen's dimensions
[[PUT|PUT]] #GIF, , PDepth%

CP = 128 + (ColorBits - 1) * 16 + (BitsPixel - 1) 'pack colorbits and bits per pixel
[[PUT|PUT]] #GIF, , CP

Zero$ = [[CHR$|CHR$]](0)     'PUT a zero into the GIF file
[[PUT|PUT]] #GIF, , Zero$

[[OUT|OUT]] [[&H|&H]]3C7, 0                'start read at color 0
[[FOR...NEXT|FOR]] c = 0 [[TO|TO]] NumColors - 1  'Get the RGB palette from the screen and put into file
  R = ([[INP|INP]]([[&H|&H]]3C9) * 65280) \ 16128 'C = R * 4.0476190(for 0-255)
  G = ([[INP|INP]]([[&H|&H]]3C9) * 65280) \ 16128
  B = ([[INP|INP]]([[&H|&H]]3C9) * 65280) \ 16128
  red$ = [[CHR$|CHR$]](R): [[PUT|PUT]] #GIF, , red$
  grn$ = [[CHR$|CHR$]](G): [[PUT|PUT]] #GIF, , grn$
  blu$ = [[CHR$|CHR$]](B): [[PUT|PUT]] #GIF, , blu$
[[NEXT|NEXT]]
         'write out an image descriptor
sep$ = ","               'image separator
[[PUT|PUT]] #GIF, , sep$         'write it
[[PUT|PUT]] #GIF, , Minx         'image start locations
[[PUT|PUT]] #GIF, , MinY
[[PUT|PUT]] #GIF, , PWidth%      'store them into the file
[[PUT|PUT]] #GIF, , PDepth%
A$ = [[CHR$|CHR$]](BitsPixel - 1) '# bits per pixel in the image
[[PUT|PUT]] #GIF, , A$
A$ = [[CHR$|CHR$]](StartSize - 1) 'store the LZW minimum code size
[[PUT|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|EOF]] code are the
[[EOF|EOF]]Code = StartCode + 1     'first two entries
StartCode = StartCode + 2   'first free code that can be used
NextCode = StartCode        'the current code

OutBuffer$ = [[STRING$|STRING$]](5000, 32)    'output buffer; for speedy disk writes
Buff& = [[SADD|SADD]](OutBuffer$)                  'find address of buffer
Buff& = Buff& - 65536 * (Buff& < 0)
Oseg = [[VARSEG|VARSEG]](OutBuffer$) + (Buff& \ 16)  'get segment + offset >> 4
OAddress = Buff& [[AND (boolean)|AND]] 15                   'get address into segment
OEndAddress = OAddress + 5000             'end of disk buffer
OStartAddress = OAddress                  'current location in disk buffer
[[DEF SEG|DEF SEG]] = Oseg

[[GOSUB|GOSUB]] ClearTree            'clear the tree & output a
PC = ClearCode: [[GOSUB|GOSUB]] PutCode          'clear code

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

[[DO...LOOP|DO]] 'while there are more pixels to encode
  [[DO...LOOP|DO]] 'until we have a new string to put into the table
    [[IF...THEN|IF]] Done [[THEN|THEN]] 'write out the last pixel, clear the disk buffer
'           'and fix up the last block so its count is correct

      PC = Prefix: [[GOSUB|GOSUB]] PutCode      'write last pixel
      PC = [[EOF|EOF]]Code: [[GOSUB|GOSUB]] PutCode     'send [[EOF|EOF]] code

      [[IF...THEN|IF]] CurrentBit <> 0 [[THEN|THEN]] PC = 0: [[GOSUB|GOSUB]] PutCode    'flush out the last code...
      PB = 0: [[GOSUB|GOSUB]] PutByte
      OutBuffer$ = [[LEFT$|LEFT$]](OutBuffer$, OAddress - OStartAddress)
      [[PUT|PUT]] #GIF, , OutBuffer$
      A$ = ";" + [[STRING$|STRING$]](8, [[&H|&H]]1A)          'the 8 [[EOF|EOF]] chars is not standard,
      [[PUT|PUT]] #GIF, , A$
      A$ = [[CHR$|CHR$]](255 - BlockLength)         'correct the last block's count
      [[PUT|PUT]] #GIF, LastLoc&, A$
      [[CLOSE|CLOSE]] #GIF: [[EXIT SUB|EXIT SUB]]          '<<<<<<<<<<< End of procedure     
    [[ELSE|ELSE]]     'get a pixel from the screen and find the new string in table
      [[GOSUB|GOSUB]] GetByte: Suffix = GB
      [[GOSUB|GOSUB]] Hash                                'is it in hash table?
      [[IF...THEN|IF]] Found = True [[THEN|THEN]] Prefix = Code(Index) 'replace prefix:suffix string with code in table
    [[END IF|END IF]]
  [[LOOP|LOOP]] [[WHILE|WHILE]] Found             'don't stop unless we find a new string

  PC = Prefix: [[GOSUB|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...THEN|IF]] NextCode = MaxCode + 1 [[THEN|THEN]]   'increase the code size
    MaxCode = MaxCode * 2
    'Note: The GIF89a spec mentions something about a deferred clear code
    [[IF...THEN|IF]] CodeSize = 12 [[THEN|THEN]]     'is the code size too big?
      PC = ClearCode: [[GOSUB|GOSUB]] PutCode      'yup; clear the table and
      [[GOSUB|GOSUB]] ClearTree         'start over
      NextCode = StartCode
      CodeSize = StartSize
      MaxCode = StartMax
    [[ELSE|ELSE]] CodeSize = CodeSize + 1 'increase code size if not too high (not > 12)
    [[END IF|END IF]] 
  [[END IF|END IF]]
[[LOOP|LOOP]]         'while we have more pixels

'                              [[GOSUB|<span style="color:blue;">GOSUB</span>]] ROUTINES
ClearTree:
[[FOR...NEXT|FOR]] A = 0 [[TO|TO]] Table.size - 1 'clears the hashing table
    Prefix(A) = -1 '-1 = invalid entry
    Suffix(A) = -1
    Code(A) = -1
[[NEXT|NEXT]]
[[RETURN|RETURN]]

Hash:   'hash the prefix & suffix(there are also many ways to do this...)
Index = ((Prefix * 256&) [[XOR (boolean)|XOR]] Suffix) [[MOD|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...THEN|IF]] Index = 0 [[THEN|THEN]]          'cannot have Table.Size 0!
  Offset = 1
[[ELSE|ELSE]]
  Offset = Table.size - Index
[[END IF|END IF]]

[[DO...LOOP|DO]]      'loop until we find an empty entry or find what we're lookin for
  [[IF...THEN|IF]] Code(Index) = -1 [[THEN|THEN]] 'is this entry blank?
    Found = False ' didn't find the string
    [[RETURN|RETURN]]
  [[ELSEIF|ELSEIF]] Prefix(Index) = Prefix [[AND (boolean)|AND]] Suffix(Index) = Suffix [[THEN|THEN]]        
    Found = True  'found the string
    [[RETURN|RETURN]]
  [[ELSE|ELSE]] 'didn't find anything, must retry - this slows hashing down.
    Index = Index - Offset
    [[IF...THEN|IF]] Index < 0 [[THEN|THEN]] 'too far down the table? wrap back the index to end of table
      Index = Index + Table.size
    [[END IF|END IF]]
  [[END IF|END IF]]
[[LOOP|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...THEN|IF]] BlockLength <= 0 [[THEN|THEN]]                  'end of block
  BlockLength = 255                       'block length is now 255
  LastLoc& = [[LOC|LOC]](GIF) + 1 + (OAddress - OStartAddress)  'remember the position
  BW = 255: [[GOSUB|GOSUB]] BufferWrite             'for later fixing
[[END IF|END IF]]
BW = PB: [[GOSUB|GOSUB]] BufferWrite 
[[RETURN|RETURN]]

BufferWrite:                             'Puts a byte into the buffer
[[IF...THEN|IF]] OAddress = OEndAddress [[THEN|THEN]]           'are we at the end of the buffer?
    [[PUT|PUT]] #GIF, , OutBuffer$               'write it out and
    OAddress = OStartAddress             'start all over
[[END IF|END IF]]
[[POKE|POKE]] OAddress, BW                        'put byte in buffer
OAddress = OAddress + 1                  'increment position
[[RETURN|RETURN]] 

GetByte:                 'This routine gets one pixel from the display
GB = [[POINT|POINT]](x, y)                         'get the "byte"
x = x + 1 'increment X coordinate
[[IF...THEN|IF]] x > MaxX [[THEN|THEN]]                         'are we too far?
    x = Minx                             'go back to start
    y = y + 1                            'increment Y coordinate
    [[IF...THEN|IF]] y > MaxY [[THEN|THEN]] Done = True         'flag if too far down
[[END IF|END IF]]
[[RETURN|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...LOOP|DO]] [[WHILE|WHILE]] CurrentBit > 7                  'do we have a least one full byte?
  PB = Char& [[AND|AND]] 255: [[GOSUB|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]]                                     'loop until we don't have a full byte
[[RETURN|RETURN]]
[[END SUB|END SUB]]'' ''

See also:

Navigation:
Go to Keyword Reference - Alphabetical
Go to Keyword Reference - By usage
Go to Main WIKI Page
⚠️ **GitHub.com Fallback** ⚠️