'=========================================================================== ' Subject: GRAPHICS FILE FORMATS Date: 06-22-97 (21:29) ' Author: James S. Baughn Code: Text ' Origin: jbaughn@ldd.net Packet: FAQS.ABC '=========================================================================== GRAPHIC FILE FORMATS...IN REAL BASIC CODE! -------------------------------=====------ By James S. Baughn TABLE OF CONTENTS ----------------- Introduction Some useful graphics routines Some background PCX (PC Paintbrush) BMP (Windows bitmaps) ICO (Windows icons) GIF (Graphics Interchange Format) -- Don't get too excited TGA (Truevision Targa) MAP (Fractint palette files) Other sources of information How to contact me Obligatory copyright and other legalese Shameless plug for my homepage Conclusion INTRODUCTION ------------ We've all seen them: the fancy graphics file format specifications that have NO code and very terse explanations. Or the code snippets that load only one particular size file, and have little or no comments. No more! This file is an attempt to explain the various graphics file formats. And unlike other documents, this has REAL BASIC CODE! The file headers are coded in BASIC...so it's as easy as cut-and-paste. I have various sample routines for loading the graphics and palettes. But, note that these are just samples...you'll have to write better code yourself. I can't do ALL the work! But, hopefully, this document will help you write the code without much trouble...and you'll have the satisfied feeling that YOU wrote it. I haven't had the chance to thoroughly test all the code snippets (not to mention spelling and grammar). So, there many be a few (hopefully insignificant) bugs. Get the bug spray ready! Anyone who can spot a bug or mistake will receive a coupon worth $0 towards their next Internet access bill OR one million hand-picked electrons. (Offer not valid in 99.99% of the world.) SOME USEFUL GRAPHICS ROUTINES ----------------------------- Many of the code snippets in this document make use of the following three general purpose functions and subroutines. They may be of some use in your own programs. MakePalette - - - - - - This routine uses the send commands to the VGA's ports to quickly change the palette. This is *MUCH* faster than BASIC's PALETTE USING. The routine expects there to be a SHARED array called PalStr, declared as DIM PalStr AS STRING * 768 for 256 colors or DIM PalStr AS STRING * 48 for 16 colors PalStr is composed of three byte triples for each color. Each triple is in red, green, blue format. So, the triple for intense red would be CHR$(255) + CHR$(0) + CHR$(0) Here is the sub: SUB MakePalette (Colors) FOR i = 1 TO Colors OUT &H3C8, i 'Tell the VGA the color index we want to change OUT &H3C9, (VAL(MID$(PalStr, (3 * i - 2), 1)) \ 4) 'Red OUT &H3C9, (VAL(MID$(PalStr, (3 * i - 1), 1)) \ 4) 'Green OUT &H3C9, (VAL(MID$(PalStr, (3 * i - 0), 1)) \ 4) 'Blue NEXT END SUB The Colors specifies how many colors to change. If you specify 16, the first 48 (16 * 3) bytes of PalStr will be used to change the palette. ReturnNibble - - - - - - - This function splits a byte into two nibbles. This is useful for loading 16-color graphics because the information for two pixels is stored in one bytes. The argument Byte is the actual byte you are interested in, and WhichOne specifies which nibble (the first or second) you want returned. FUNCTION ReturnNibble (Byte, WhichOne) IF WhichOne = 1 THEN IF Byte AND 128 THEN Total = Total + 8 IF Byte AND 64 THEN Total = Total + 4 IF Byte AND 32 THEN Total = Total + 2 IF Byte AND 16 THEN Total = Total + 1 ELSE IF Byte AND 8 THEN Total = Total + 8 IF Byte AND 4 THEN Total = Total + 4 IF Byte AND 2 THEN Total = Total + 2 IF Byte AND 1 THEN Total = Total + 1 END IF ReturnNibble = Total END FUNCTION ReturnBit - - - - - This function returns a single bit from a byte. The argument Byte is the byte you're interested in, and WhichOne is the bit you want returned. This is useful for 2 color pictures. FUNCTION ReturnBit(Byte, WhichOne) SELECT CASE Which CASE 1: IF (Byte AND 128) THEN ReturnBit = 1 CASE 2: IF (Byte AND 64) THEN ReturnBit = 1 CASE 3: IF (Byte AND 32) THEN ReturnBit = 1 CASE 4: IF (Byte AND 16) THEN ReturnBit = 1 CASE 5: IF (Byte AND 8) THEN ReturnBit = 1 CASE 6: IF (Byte AND 4) THEN ReturnBit = 1 CASE 7: IF (Byte AND 2) THEN ReturnBit = 1 CASE 8: IF (Byte AND 1) THEN ReturnBit = 1 END SELECT END FUNCTIN SOME BACKGROUND --------------- There are generally five steps in displaying a graphic file. STEP 1: Define and load the header - - - - - - - - - - - - - - - - - - You must find out the structure of a graphics file, in particular the header. In BASIC you can use a TYPE structure, DIM a variable as this TYPE, and load the header in all at once with GET. This is fairly straightforward once you know the layout of the header. See the individual format sections below for the BASIC code to define each format's header. STEP 2: Select a video mode - - - - - - - - - - - - - - - Using the header information, you need to determine what video mode the image will look best in. You can use the following pseudo-code for this. Colors = Total number of unique colors in file Width = Width of image (note that you can't use Width as a real variable, it's a reserved BASIC statement) Height = Height of image IF Width <= 640 and Height <= 480 and Colors <= 16 THEN ScreenMode = 12 IF Width <= 640 and Height <= 350 and Colors <= 16 THEN ScreenMode = 9 IF Width <= 640 and Height <= 480 and Colors > 16 THEN You could: - Set a SVGA mode using SetVideoMode (see above) - You'll have to find a way to output to the screen on your own - Use ScreenMode = 12 and remap the palette to only 16 colors - Use ScreenMode = 13 and scale the picture or allow the user to pan it - Use a nonstandard VGA mode ("ModeX") supporting 256 colors You'll have to figure this out on your own IF Width > 640 and Width > 480 and Colors <= 16 THEN ScreenMode = 12, allow user to pan the image IF Width > 640 and Width > 480 and Colors > 16 THEN Either ScreenMode = 13 (with panning) or a SVGA mode IF Width <= 320 and Height <= 200 and Colors = 256 THEN ScreenMode = 13 IF Width <= 320 and Height <= 200 and Colors <= 16 THEN IF you want the picture to fill the screen THEN ScreenMode = 13 ELSE you can center the image and use ScreenMode = 12, 9, 7, or another STEP 3: Load palette information - - - - - - - - - - - - - - - - - You'll have to parse the palette information from the file depending on the format. If the number of colors is less than the number available, simply load the palette into PalStr and use MakePalette. If the number of unique colors is greater than that available, you'll have to improvise. You'll have to create an optimized palette that will try to balance the colors well. This can be tricky! You can take the easy way out and convert it to greyscale. For 24-bit files (like TGA), you can use this simple logic: '-- First, make the greyscale palette -- PalStr = STRING$(768, " ") 'Empty out palette FOR I = 0 TO 63 MID$(PalStr, I * 3 + 1, 3) = CHR$(I) + CHR$(I) + CHR$(I) NEXT '^ Combine colors so R = G = B, making it ' all grey MakePalette 256 'Send to VGA card '-- After loading the picture, parse a byte -- 'At this point we assume Red, Green, and Blue hold the intensities for 'a single byte. 'We have to convert it from 0-255 to BIOS-usable 0-63 Red = Red \ 4: Green = Green \ 4: Blue = Blue \ 4 'Now average these intensities together Output = (Red + Green + Blue) \ 3 'And output the pixel PSET (X, Y), Output '-- And then loop back around and handle the next byte... -- OR, you can use a "3-2-2" palette that contains a rainbow of colors, and then match each pixel to this palette. Here's the code: (Note that I haven't had a chance to test this routine. "So many electrons to push, so little time!") '-- First, make "3-2-2" palette -- Index = 1 'Current color index FOR Red = 0 TO 63 STEP 9 'Loop through the three colors FOR Green = 0 TO 63 STEP 9 FOR Blue = 0 TO 63 STEP 21 OUT &H3C8, Index 'Send color index to VGA OUT &H3C9, Red 'Send red intensity to VGA OUT &H3C9, Green 'Ditto OUT &H3C9, Blue 'Ditto Index = Index + 1 'Increment color index NEXT NEXT NEXT '...done! '-- After we load the file and parse a byte... -- 'Use this formula: Output = Red + (Green \ 8) + (Blue \ 64) 'And then output the color PSET (X, Y), Output Fancy graphics programs use quantization and dithering to reduce the color depth. Unfortunately, none of these techniques have been programmed in BASIC (afaik). STEP 4: Load the image into memory - - - - - - - - - - - - - - - - - - There are a couple ways to do this. You can load the WHOLE thing into EMS or XMS memory if available. You'll have to access HIMEM.SYS through interrupts to do this. You could also load a line at a time from the file while displaying it. This is easier to program, but much slower. If the image is small, you may be able to simply load it into a huge or dynamic array in conventional memory. STEP 5: Display it! - - - - - - - - - - - Now loop through the image and display each pixel. The process behind this is different for each format. You may have to decode the bytes, possibly from run-length encoding (RLE, used in BMPs and PCXs) or LZW (GIFs). This can sometimes be tricky to program. And hopefully you'll have an image on the screen! This document doesn't detail saving graphics to disk, but the process is almost the exact opposite. You'll have to fiddle and hack a little on your own to do this. PCX --- (Designed by ZSoft, Corp. for their PC Paintbrush program.) PCX files are supported by most DOS-based programs. They use a fairly efficient run-length encoding algorithm, that is, fortunately for us, easy to use. * PCX code snippet TYPE PCXHeader Manufacturer AS STRING * 1 'Identification - will always be 10 for PCX Version AS STRING * 1 'PCX version: '0 - Version 2.5 '2 - Version 2.8 w/palette information '3 - Version 2.8 w/o palette information '5 - Version 3.0 - 256 colors Encoding AS STRING * 1 'Will be 1 if run length encoding is used '(almost always used) BitsPerPixel AS STRING * 1 'Number of bits needed to represent one pixel 'Generally, '1 - 2 colors (usually black and white) '2 - 4 colors '4 - 16 colors '8 - 256 colors xMin AS INTEGER '\ yMin AS INTEGER ' \ Windows coordinates of this picture, xMax AS INTEGER ' / these numbers can be used to figure the yMax AS INTEGER '/ image's height and width, see below xRes AS INTEGER 'Horizontal resolution of creating device yRes AS INTEGER 'Vertical resolution of creating device 'These two numbers usually specify the 'screen resolution used when this picture 'was created. So, this can be useful to 'determine which screen mode should be used 'to display this picture. Note: Some programs 'won't use these, they'll just set them to 0. ColorMap AS STRING * 48 'Palette information used with Version 3 '(see below) Reserved AS STRING * 1 'Wasted space Planes AS STRING * 1 'Number of planes 'For 16 colors this will be 4 'For 256 colors this will be 1 BytesPerLine AS INTEGER 'Number of bytes per line per plane. Will 'always be even PaletteInfo AS INTEGER '1 - color or black and white '2 - greyscale Filler AS STRING * 58 'Filler used to make the header 128 bytes. 'Note that all PCX files are 58 bytes larger 'than they need to be. However, this filler 'area could be used to embed information 'in the file, such as a copyright. END TYPE DIM PCX As PCXHeader 'Define a place to put the header OPEN FileName$ FOR BINARY AS 1 'Open file GET #1, , PCX 'Load header '-- Determine picture's size -- ImageWidth = PCX.xMax - PCX.xMin + 1 'Width ImageHeight = PCX.yMax - PCX.yMin + 1 'Height '-- Set screen mode -- 'Based on the header information you'll have to decide which screen mode 'to use. (see Step 2 in "Some background" above) SCREEN ScreenMode '-- Load the palette -- 'We need to determine the number of colors. Use BitsPerPixel for this. SELECT CASE PCX.BitsPerPixel CASE 4: '16 color mode 'The 16 color palette is stored in PCX.ColorMap MID$(PalStr, 1, 48) = PCX.ColorMap 'Load it into memory MakePalette 16 'Send to VGA card...and done. CASE 8: '256 color mode 'The 256 color map is stored at the END of the file. SEEK #1, LOF(1) - 767 'Set file pointer to beginning of 'palette table. The character before 'this (LOF(1) - 768) should be 12. GET #1, , PalStr 'Load entire palette into memory. MakePalette 256 'Send to VGA card...done. CASE ELSE: 'Something else? 'This may be some kind of CGA-specific file. Loading the 'palette and displaying this is complicated, and since this is hardly 'ever used, I won't mess with it. END SELECT '* End snippet Now you'll have to decide how to load the picture into memory. See Step 4 in the "Some backround" section above. The pseudo-code for displaying a PCX file is: FOR each byte Foo read from the file IF the top two bits of Foo are 1's THEN Count = 6 lowest bits of Foo Data = next byte following Foo ELSE Count = 1 Data = Foo END IF LINE (X, Y)-(X + Count, Y), Foo (assuming X and Y are the current screen coordinates) NEXT * Here is an example snippet for displaying a 256 color PCX. Note that this code is VERY slow and inefficient. This is just an example, I'll leave it up to you do write a better routine that is faster and supports 2, 4, and 16 color modes. SEEK #1, 129 'Move file pointer to start of data Foo$ = STRING$(1, " ") 'We will only load 1 byte at a time... '...VERY SLOW!!!! In real world programs 'you would load a line at a time or load 'the whole thing into memory and go 'from there. X = 0: Y = 0 'We'll start from the upper left corner DO 'Loop through file GET #1, , Foo$ 'Retrieve ONE character...SLOW! Bar = ASC(Foo$) 'Get its ASCII code IF (Bar AND 192) <> 192 THEN 'If its top 2 bits are not set, then 'this is just a normal byte, no run 'length encoding PSET (X, Y), Bar 'Display pixel X = X + 1 'Update current screen location IF X > ImageWidth THEN 'If at end of line, X = 0: Y = Y + 1 'Move to left of next line IF Y > ImageHeight THEN EXIT DO 'Done! END IF ELSE 'Must be RLE encoded Bar = Bar AND 63 'Get lower 6 bits. This will be the 'number of times this color is repeated GET #1, , Foo$ 'Retrieve next byte Foobar = ASC(Foo$) 'Get ASCII equivalent LINE (X, Y)-(X + Bar), Foobar 'Display it X = X + Bar + 1 'Update screen location IF X > ImageWidth THEN 'If at end of line X = 0: Y = Y + 1 'Move to left of next line IF Y > ImageHeight THEN EXIT DO 'Done! NEXT END IF LOOP UNTIL EOF(1) 'EOF shouldn't ever be reached, but... CLOSE 1 'Can't forget this 'At this point the picture SHOULD be loaded. Famous last words... * End of snippet I'll leave it up to you to improve on the above snippet. (Or, you can simply copy the code from another ABC snippet - he he) BMP --- (Designed by Microsoft as a standard format for Windows) Microsoft developed this format to store device-independent data for Windows. There is also a variation for OS/2. * Start of BMP header TYPE BMPHeader Ident AS STRING * 2 'Will be 'BM' if this is a bitmap FileSize AS LONG 'Size of the file in bytes 'Not really necessary, use LOF instead Reserve AS STRING * 4 'Wasted space Offset AS LONG 'Number of bytes from the end of the 'header to the actual data Version AS LONG '40 - Windows 3.x '12 - OS/2 'Actually, this is the size of the '"BMPInfoHeader", which is the entire 'header minus the first four elements, 'Ident to Offset. These 4 elements are 'actually part of the "BMPFileHeader" 'according to the convuluted specification Cols AS LONG 'Width of image Rows AS LONG 'Height of image Planes AS INTEGER 'Number of planes - should be 1 BitsPerPixel AS INTEGER 'Pretty obvious '-- Note, the following is for a Windows BMP. For OS/2, the 'header ends here and is followed by a colormap of BGR values (not RGB!) Compression AS LONG 'Type of compression used, '0 - None '1 - 8 bit run length encoding '2 - 4 bit run length encoding CompressedSize AS LONG 'Size of image compressed image xScale AS LONG 'Horizontal scale, in pixels per meter yScale AS LONG 'Vertical scale, in pixels per meter 'Not very useful, why such an odd unit? Colors AS LONG 'Number of colors actually used, 'if this is 0 then all possible colors 'are used ImportantColors AS LONG 'Number of colors that are considered '"important." If 0 then all colors 'are "important." END TYPE DIM BMP AS BMPHeader 'Define header OPEN FileName$ FOR BINARY AS 1 'Open file GET #1, , BMP 'Load header quickly '-- Load palette 'The next part of the file is the colormap. Its length is: Length = 4 * 2^BMP.BitsPerPixel 'Each color is represented by four values: blue, green, red, and an 'unused value. (Note that the OS/2 colormap doesn't have the 'wasted unused value) Foo$ = STRING$(Length, 32) 'Get ready to hold palette info GET #1, , Foo$ 'Load it all into memory at once FOR i = 1 TO Length 'Loop through it Blue$ = MID$(Foo$, (i * 4) - 3, 1) Green$ = MID$(Foo$, (i * 4) - 2, 1) Red$ = MID$(Foo$, (i * 4) - 1, 1) MID$(PalStr, ((i * 3) - 2), 3) = Blue$ + Green$ + Red$ NEXT * End of snippet Now you need to set the video mode and then load the BMP. Displaying non-compressed BMPs is incredibly easy. Below is a snippet for displaying BMPs that are not RLE compressed (BMP.Compression = 0). This snippet is slightly faster than the PCX snippet above because it loads one scan line at a time from the file, instead of one byte at a time. * Begin snippet 'First we need to determine how many bytes are in each scan line. Length = (LOF(1) - BMP.Offset) \ BMP.Rows '| ^ This trancutes any remainders '+- You could also use BMP.FileSize 'The above line is a quick way to determine the size of each row. However, 'it may not work if there are excess bits at the end of each scan line. 'Files with 2 or 4 bits per pixel and odd widths sometimes have to be 'padded with extra bits at the end of each scan line. This may fool this 'simple routine. Foo$ = STRING$(Length, 32) 'Allocate space in memory for each row FOR Y = BMP.Rows TO 1 STEP -1 'Rows are stored bottom to top in BMPs GET #1, , Foo$ 'Load row into memory Ptr = 1 'Pointer into memory FOR X = 1 TO BMP.Cols STEP (8 \ BMP.BitsPerPixel) 'Loop through columns '^ Number of columns per byte Bar = ASC(MID$(Foo$, Ptr, 1) 'Extract byte Ptr = Ptr + 1 'Increment pointer IF BitsPerPixel = 8 THEN 'If one byte per pixel... PSET (X - 1, Y - 1), Bar '...simply output that byte ELSEIF BitsPerPixel = 4 THEN 'If one nibble (4 bits) per pixel... PSET (X - 1, Y - 1), ReturnNibble(Bar, 1) '...Extract nibbles... PSET (X, Y - 1), ReturnNibble(Bar, 2) '...and output both ELSEIF BitsPerPixel = 1 THEN 'If only one bit per pixel... FOR I = 1 TO 8 '...loop through the 8 bits and... PSET (X - 1 + I, Y - 1), ReturnBit(Bar, I) '...extract each... NEXT '...and output them END IF NEXT 'Loop to next column NEXT 'Done with that row, move to next CLOSE 1 'Done! * End snippet Parsing and displaying compressed BMPs is a little bit more involved. I'll have to let you discover how to do this on your own. The BMP specification, available at http://www.wotsit.demon.co.uk, explains the RLE compression scheme. ICO --- (Designed by Microsoft for Windows icons) Windows icons have the same format as BMP files. They can be 16x16, 32x32 or 64x64 according to the specification, but almost all icons are 32x32. They can be 2, 8, or 16 colors, but almost all of them are 16 colors. It is possible for multiple icons to be stored in ICO files, but almost always only one is stored. The layout of a ICO file is: Name Bytes Description ---- ----- ----------- Header 126 The header is a modified version of a BMP header. If if we assume all icons are 32x32 with 16 colors, we can safely ignore the header. Icon bitmap 512 The actual icon image. It is stored as four ("AND" bitmap) bits per pixel. There are 32 rows, and each row is 16 bytes, so this adds up to 512. (Tech note: Windows applies this bitmap to the screen using an AND operation. This way parts of the icon can be transparent.) B&W bitmap 128 A monochrome bitmap of the icon stored as 1 bit ("OR" bitmap) per pixel. This bitmap is visible in Windows when you drag an icon - instead of the color bitmap showing, this simpler monochrome bitmap is shown. For simply displaying icons, this bitmap can be safely ignored. (Tech note: Windows applies this bitmap using an OR operation.) TOTAL --> 766 126 + 512 + 128 = 766, which is why all ICOs are always this size. Only the middle 512 bytes are really necessary, though. * Loading and displaying an icon is easy. Here is a snippet: OPEN FileName$ FOR BINARY AS 1 'Open file SEEK #1, 127 'Ignore header Foo$ = STRING$(512, 32) 'Allocated memory for entire icon GET #1, , Foo$ 'Load icon into memory CLOSE 1 'Don't need the file now SCREEN 12 'Change to whatever mode you want Ptr = 1 'Pointer into memory (Foo array) FOR Y = 32 TO 0 STEP -1 'Like BMPs, icon are stored bottom to top FOR X = 0 TO 32 STEP 2 'Column loop Bar = ASC(MID$(Foo$, Ptr, 1))'Extract byte Ptr = Ptr + 1 'Increment pointer PSET (X, Y), ReturnNibble(Bar, 1) 'Output pixels to screen PSET (X + 1, Y), ReturnNibble(Bar, 2) NEXT 'Loop to next byte NEXT 'Loop to next row * End snippet Writing an icon to disk is a little harder. You have to come up with a header and an "OR" bitmap. Other than that, though, it's just the reverse of above. GIF --- (Designed by CompuServe as a way to transfer files on their system, stands for Graphics Interchange Format) Unfortunately, a license with UniSys is required in any commericial or shareware programs that use GIF files. Actually, GIF itself isn't patented, it's the LZW compression scheme. (You probably already knew this, though.) There really isn't any point in explaining this file format since we can't use it legally in our programs. And frankly, our efforts would be better spent trying to write JPEG or PNG graphics programs. However, I don't have a clue how to display these formats because of the compression scheme they use. If you can figure out how to display PNG graphics, you would be the first person (afaik) in the world to write a PNG decoder in BASIC! Choosy programmers DON'T choose GIF! TGA --- (Truevision Targa) TGA are another useful format for storing bitmapped graphics. They are usually 8 bit (256 colors) or 24 bit (16+ million colors), but they don't have to be. * Begin TGA snippet TYPE TGAHeader InfoLength AS STRING * 1 'Length of image information block. 'This block is stored after the header, 'and usually contains copyright info. 'TGA decoders will have to be smart 'enough to skip over the info block. MapType AS STRING * 1 '0 - All pixels are in RGB triples '1 - Colormap ("DAC table") FileType AS STRING * 1 '1 - Uncompressed with a colormap '2 - Uncompress without colormap '9 - Compressed (RLE) with colormap '10- Compressed (RLE) without colormap MapOrigin AS INTEGER 'Color index of the first entry in 'the colormap. Usually 0 MapLength AS INTEGER 'Number of colors in the colormap MapSize AS STRING * 1 'Size of an entry in the colormap. 'Can be 16, 24, or 32 bits. XOrigin AS INTEGER 'The X coordinate of the left corner 'of the image. Usually 0 YOrigin AS INTEGER 'Y coordinate of left corner. Usually 0 Cols AS INTEGER 'Width of image in pixels Rows AS INTEGER 'Height of image in pixels BitsPerPixel AS STRING * 1 'If their is a colormap, this can be '8 or 16. Without a colormap, this can 'be 16, 24, or 32. Flags AS INTEGER 'Additional information about the image 'Bit 0, 1, 2, 3: Wasted filler bits ' Bit 4: Reserved, it is always 0 ' Bit 5: 0 - Origin in lower left corner ' 1 - Origin in upper left corner ' Bit 6 and 7: 00 - Rows stored one after another. (1,2,3,4,5,6,7,8...) ' 01 - Even rows are stored first, then odd rows. ' (2,4,6,...,1,3,5...) A primitive form of ' interlacing? END TYPE DIM TGA AS TGAHeader OPEN FileName$ FOR BINARY AS 1 GET #1, , TGA 'After the header is the information block of length TGA.InfoLength. This 'should be skipped. SEEK #1, 19 + TGA.InfoLength 'The header is 18 bytes. Add one more 'to skip past the info block 'Next is the colormap (aka "DAC table"), if one is present. IF TGA.MapType = 1 THEN 'Is there a colormap? Length = TGA.MapLength * ASC(TGA.MapSize) / 8 '^ Figure length of colormap Foo$ = STRING$(Length, 32) 'Allocate memory GET #1, , Foo$ 'Read palette from disk PalStr = Foo$ '***** Move into palette array MakePalette TGA.MapLength 'Send palette to VGA card END IF * End snippet At this point we are ready to display the picture. The following snippet shows how to load an uncompressed TGA with 256 colors. It is very similar to the one for loading BMP files, it loads one row into memory at a time and displays it. * Begin snippet Foo$ = STRING$(TGA.Cols, 32) 'Allocated space for one row FOR Y = 0 TO TGA.Rows 'Loop through rows -- this 'ignores the some of the stuff in the 'header, which may not work well 'for some images GET #1, , Foo$ 'Load in one row FOR X = 0 TO TGA.Cols 'Loop through columns Bar = ASC(MID$(Foo$, X + 1, 1) 'Extract byte PSET (X, Y), Bar 'Output the byte NEXT NEXT '...done! * This snippet shows how to handle uncompressed TGA files with 16 million colors. Foo$ = STRING$(TGA.Cols * 3, 32) 'Allocated memory - 3 bytes for each 'pixel in the row FOR Y = 0 TO TGA.Rows 'Loop through rows, ignoring header info GET #1, , Foo$ 'Load row into memory Ptr = 1 'Set pointer FOR X = 0 TO TGA.Cols 'Loop through columns Red = ASC(MID$(A$, BufPtr, 1)) 'Extract red value Green = ASC(MID$(A$, BufPtr + 1, 1)) 'Ditto Blue = ASC(MID$(A$, BufPtr + 2, 1)) 'Ditto Ptr = Ptr + 3 'Increment pointer '* Now you'll have to do something with the color values. You 'can convert them to greyscale or use an optimized palette. See 'Step 3 in the "Some background" section for some sample code 'snippets. NEXT NEXT '...done! * End snippet You'll have to figure out how to use compressed TGA files on your own. (In other words, you'll have to snag the code from the ABC packets.) MAP --- (Fractint palette files) MAP files are an easy way to store palette information for 256 color modes. They are simply a series of RGB values separated by spaces, like this: 0 0 255 255 0 0 127 0 127 Comments can be placed after the numbers like this 127 127 127 Another comment that should be ignored by the parsing program ... 123 45 6 End of file, should be 256 lines * Here is the code snippet to handle MAP files. OPEN FileName$ FOR INPUT AS 1 'Don't have to use BINARY for these FOR I = 1 TO 256 INPUT #FileNum, Foo$ 'INPUT may not be the best choice, you 'can use another function that loads in 'one line at a time. Foo$ = RTRIM$(LTRIM$(Foo$)) 'Trim it Bar = INSTR(1, A$, " ") 'Figure out where first number is Red = VAL(LEFT$(A$, Bar)) 'Extract red value Foo$ = RTRIM$(LTRIM$(RIGHT$(Foo$, LEN(Foo$) - Bar))) '^ Parse rest of line (scary code, huh?) Bar = INSTR(1, Foo$, " ") 'Figure out where 2nd number is Green = VAL(LEFT$(B$, Sp2)) 'Extract green value Foo$ = RTRIM$(LTRIM$(RIGHT$(Foo$, LEN(Foo$) - Bar))) Bar = INSTR(1, C$, " ") 'Where is 3rd number? IF Bar = 0 THEN Blue = VAL(C$) 'Load blue value directly ELSE Blue = VAL(LEFT$(C$, Sp3)) 'Extract blue value (in case there is END IF 'a comment after it) MID$(PalStr, ((I - 1) * 3) + 1) = CHR$(Red) + CHR$(Green) + CHR$(Blue) '^ Insert it into palette NEXT 'Loop to next line in MAP file CLOSE 1 'Can't forget to close the file * End MAP file snippet OTHER SOURCES OF INFORMATION ---------------------------- The X2 FTP site in Finland has lots of information on graphics and game programming. ftp://x2ftp.oulu.fi/ Wotsit has a large archive of file format specifications. http://www.wotsit.demon.co.uk C source code for JPEG files can be found in the directory ftp://ftp.uu.net/graphics/jpeg (also has code for GIF and BMP loading) HOW TO CONTACT ME ----------------- Direct all positive feedback to jbaughn@ldd.net or jbaughn@geocities.com This includes suggestions for improvements, questions, praise, job offers, etc. Direct all negative feedback (i.e. flames) to billg@microsoft.com OBLIGATORY COPYRIGHT AND LEGALESE --------------------------------- Since everyone else plasters this stuff all over their work, I guess I will too. This document is (C) COPYRIGHT 1997, James S. Baughn. All rights reserved. This document is protected by international statues (Ha! That ought to scare most people away from plagerizing this...) All trademarks, etc., are the property of their respective holder. (Whatever that means...) If you use any of the code snippets in your own programs, here's what you need to do: 1. Email me at jbaughn@ldd.net telling me how great this document is. This is a required step. (Just kidding) 2. You should give me credit somewhere in your program or documentation. Yeah, right! 3. Visit my homepage (see below) and reload the counter over and over again to inflate my statistics. (Just kidding) DISCLAMER: If any harm results from the viewing or use of this document (i.e. your dog bites you, you become infected with the Good Times virus, the IRS says you owe more taxes, etc.), I AM NOT RESPONSIBLE!!! You are. SHAMELESS PLUG FOR MY HOMEPAGE ------------------------------ No file is complete without a mention of the author's homepage. http://baughn.home.ml.org And you may be interested in a QuickBASIC program I wrote called "Microsoft Simulator" It lets you play the part of Bill Gates and control the day-to-day activities of Microsoft. (i.e. hostile takeovers, releasing upgrades every day, inventing new slogans like "Where do WE want you to go today?", etc.) http://baughn.home.ml.org/mssim.htm CONCLUSION ---------- I hope you find this document useful. If not, well, then maybe you should write your own. Enjoy!