# GIF_Code
$GIF_OK = 0;
$GIF_ERRCREATE = 1;
$GIF_ERRWRITE = 2;
$GIF_OUTMEM = 3;

# Public methods
#int  GIF_Create(const char *filename, int width, int height,
#		int numcolors, int colorres);
#void GIF_SetColor(int colornum, int red, int green, int blue);
#int  GIF_CompressImage(int left, int top, int width, int height,
#		       int (*getpixel)(int x, int y));
#int  GIF_Close(void);

for ($i = 0; $i < 256; $i++) {
    $Buffer[$i] = 0;
}

$RES_CODES = 2;
$HASH_FREE = 0xFFFF;
$NEXT_FIRST = 0xFFFF;

$MAXBITS = 12;

$MAXSTR = (1 << $MAXBITS);

$HASHSIZE = 9973;
$HASHSTEP = 2039;

sub HASH {
    my($index, $lastbyte) = @_;
    return ((($lastbyte << 8) ^ $index) % $HASHSIZE);
}


sub Create {
    my($filename) = @_;

    if ($filename eq "STDOUT") {
	binmode(STDOUT);
    } else {
	if (!open(OUTFILE, "> $filename", )) {
	    return $GIF_ERRCREATE;
	}
	binmode(OUTFILE);  # For MS-DOG
	select OUTFILE;
    }

    return $GIF_OK;
}


sub Write {
    my($buf, $len) = @_;

    print substr($buf, 0, $len);

    return $GIF_OK;
}


sub WriteByte {
    my($b) = @_;

    print substr($b, 0, 1);

    return $GIF_OK;
}


sub WriteWord {
    my($w) = @_;

    print pack("C", $w & 0xFF);
    print pack("C", $w >> 8);

    return $GIF_OK;
}


sub Close {
    close(OUTFILE);
}


sub InitBitFile {
    $Buffer[$Index = 0] = 0;
    $BitsLeft = 8;
}


sub ResetOutBitFile {
    my($numbytes);
    my($j, $bufferbinary);

    $numbytes = $Index + ($BitsLeft == 8 ? 0 : 1);

    if ($numbytes != 0) {
	if (&WriteByte(pack("c", $numbytes)) != $GIF_OK) {
	    return -1;
	}

	$bufferbinary = "";
	for ($j = 0; $j < $numbytes; $j++) {
	    $bufferbinary .= pack("c", $Buffer[$j]);
	}
	if (&Write($bufferbinary, $numbytes) != $GIF_OK) {
	    return -1;
	}

	for ($j = 0; $j < $numbytes; $j++) {
	    $Buffer[$j] = 0;
	}

	$Buffer[$Index = 0] = 0;
	$BitsLeft = 8;
    }

    return 0;
}


sub WriteBits {
    my($bits, $numbits) = @_;
    my($bitswritten) = 0;
    my($numbytes) = 255;
    my($bufferbinary, $j);


    do {
        # If the buffer is full, write it
	if (($Index == 254 && !$BitsLeft) || $Index > 254) {
	    #print "Index: $Index, BitsLeft: $BitsLeft, numbytes: $numbytes\n";
	    if (&WriteByte(pack("C", $numbytes)) != $GIF_OK) {
		return -1;
	    }

	    $bufferbinary = "";
	    for ($j = 0; $j < $numbytes; $j++) {
		$bufferbinary .= pack("C", $Buffer[$j]);
	    }
	    if (&Write($bufferbinary, $numbytes) != $GIF_OK) {
		return -1;
	    }

	    $Buffer[$Index = 0] = 0;
	    $BitsLeft = 8;
	}

	if ($numbits <= $BitsLeft) {
	    $Buffer[$Index] |= ($bits & ((1 << $numbits) - 1)) << (8 - $BitsLeft);
	    $bitswritten += $numbits;
	    $BitsLeft -= $numbits;
	    $numbits = 0;
	} else {
	    $Buffer[$Index] |= ($bits & ((1 << $BitsLeft) - 1)) << (8 - $BitsLeft);
	    $bitswritten += $BitsLeft;
	    $bits >>= $BitsLeft;
	    $numbits -= $BitsLeft;

	    $Buffer[++$Index] = 0;
	    $BitsLeft = 8;
	}
    } while ($numbits != 0);

    return $bitswritten;
}


sub FreeStrtab {
    if ($#StrHsh != -1) { @StrHsh = (); }
    if ($#StrNxt != -1) { @StrNxt = (); }
    if ($#StrChr != -1) { @StrChr = (); }

}


sub AllocStrtab {
    my($i);

    &FreeStrtab;

    for ($i = 0; $i < $MAXSTR; $i++) {
	$StrChr[$i] = 0;  # ??? or set to $HASH_FREE
    }
    for ($i = 0; $i < $MAXSTR; $i++) {
	$StrNxt[$i] = 0;  # ??? or set to $HASH_FREE
    }
    for ($i = 0; $i < $HASHSIZE; $i++) {
	$StrHsh[$i] = $HASH_FREE;  
    }
    
    return $GIF_OK;
}


sub AddCharString {
    my($index, $b) = @_;
    my($hshidx);

    if ($NumStrings >= $MAXSTR) {
	return 0xFFFF;
    }
    
    # search the string table until a free position is found
    $hshidx = &HASH($index, $b);
    while ($StrHsh[$hshidx] != 0xFFFF) {
	$hshidx = ($hshidx + $HASHSTEP) % $HASHSIZE;
    }

    # Insert new string
    $StrHsh[$hshidx] = $NumStrings;
    $StrChr[$NumStrings] = $b;
    $StrNxt[$NumStrings] = ($index != 0xFFFF) ? $index : $NEXT_FIRST;

    return $NumStrings++;
}


sub FindCharString {
    my($index, $b) = @_;
    my($hshidx, $nxtidx);
    
    if ($index == 0xFFFF) {
	return $b;
    }

    $hshidx = &HASH($index, $b);
    while (($nxtidx = $StrHsh[$hshidx]) != 0xFFFF) {
	if ($StrNxt[$nxtidx] == $index && $StrChr[$nxtidx] == $b) {
	    return $nxtidx;
	}
	$hshidx = ($hshidx + $HASHSTEP) % $HASHSIZE;
    }

    # No match is found
    return 0xFFFF;

}


sub ClearStrtab {
    my($codesize) = @_;
    my($q, $w, $wp);

    # No Strings currently in the table
    $NumStrings = 0;

    # Mark entire hashtable as free
    for ($q = 0; $q < $HASHSIZE; $q++) {
	$StrHsh[$q] = $HASH_FREE;
    }
    
    $w = (1 << $codesize) + $RES_CODES;
    for ($q = 0; $q < $w; $q++) {
	&AddCharString(0xFFFF, $q);
    }
}


sub LZW_Compress {
    my($codesize) = @_;
  
    my($c, $index, $clearcode, $endofinfo, $numbits, $limit, $errcode);

    my($prefix) = 0xFFFF;
    $index = 0;

    &InitBitFile;

    $clearcode = (1 << $codesize);
    $endofinfo = $clearcode + 1;

    $numbits = $codesize + 1;
    $limit = (1 << $numbits) - 1;
    
    if (($errcode = &AllocStrtab()) != $GIF_OK) {
	return $errcode;
    }
    &ClearStrtab($codesize);

    &WriteBits($clearcode, $numbits);

    # Pack image
    while (($c = &InputByte) != -1) {
	if (($index = &FindCharString($prefix, $c)) != 0xFFFF) {
	    $prefix = $index;
	} else {
	    &WriteBits($prefix, $numbits);

	    if (&AddCharString($prefix, $c) > $limit) {
		if (++$numbits > 12) {
		    &WriteBits($clearcode, $numbits - 1);
		    &ClearStrtab($codesize);
		    $numbits = $codesize + 1;
		}
		$limit = (1 << $numbits) - 1;
	    }
	    $prefix = $c;
	}
    }

    if ($prefix != 0xFFFF) {
	&WriteBits($prefix, $numbits);
    }

    &WriteBits($endofinfo, $numbits);
    &ResetOutBitFile;
    &FreeStrtab;

    return $GIF_OK;
}


sub BitsNeeded {
    my($n) = @_;
    my($ret) = 1;

    if (!$n--) {
	return 0;
    }
    while ($n >>= 1) {
	++$ret;
    }
    return $ret;
}


sub InputByte {
    my($ret);

    if ($RelPixY >= $ImageHeight) { 
	return -1; 
    }
    $ret = &GetPixel($ImageLeft + $RelPixX, $ImageTop + $RelPixY);
    if (++$RelPixX >= $ImageWidth) {
	$RelPixX = 0;
	++$RelPixY;
    }
    return $ret;
}


sub WriteScreenDescriptor {
    my($tmp);

     if (&WriteWord($sdLocalScreenWidth) != $GIF_OK) 
    {
	return $GIF_ERRWRITE;
    }

     if (&WriteWord($sdLocalScreenHeight) != $GIF_OK) 
    {
	return $GIF_ERRWRITE;
    }

    $tmp = ($sdGlobalColorTableFlag << 7)
	| ($sdColorResolution << 4)
	| ($sdSortFlag << 3)
	| ($sdGlobalColorTableSize);
    if (&WriteByte(pack("C", $tmp)) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }

    if (&WriteByte(pack("C", $sdBackgroundColorIndex)) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }
    if (&WriteByte(pack("C", $sdPixelAspectRatio)) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }

    return $GIF_OK;
}


sub WriteImageDescriptor {
    my($tmp);

    if (&WriteByte($idSeparator) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }
    if (&WriteWord($idLeftPosition) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }
    if (&WriteWord($idTopPosition) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }
    if (&WriteWord($idWidth) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }
    if (&WriteWord($idHeight) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }
    $tmp = ($idLocalColorTableFlag << 7)
	| ($idInterlaceFlag << 6) 
	| ($idSortFlag << 5) 
	| ($idReserved << 3) 
	| $idLocalColorTableSize;
    if (&WriteByte(pack("C", $tmp)) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }
    
    return $GIF_OK;
}


# Public functions

sub GIF_Create {
    my($filename, $width, $height, $numcolors, $colorres) = @_;

    my($q, $tabsize, $bp);
    
    $NumColors = $numcolors ? (1 << &BitsNeeded($numcolors)) : 0;
    $BitsPrPrimColor = $colorres;
    $ScreenHeight = $height;
    $ScreenWidth = $width;

    if (&Create($filename) != $GIF_OK) {
	return $GIF_ERRCREATE;
    }

    # Write GIF signature
    if (&Write("GIF87a", 6) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }

    $sdLocalScreenWidth = $width;
    $sdLocalScreenHeight = $height;
    if ($NumColors != 0) {
	$sdGlobalColorTableSize = &BitsNeeded($NumColors) - 1;
	$sdGlobalColorTableFlag = 1;
    } else {
	$sdGlobalColorTableSize = 0;
	$sdGlobalColorTableFlag = 0;
    }

    $sdSortFlag = 0;
    $sdColorResolution = $colorres - 1;
    $sdBackgroundColorIndex = 0;
    $sdPixelAspectRatio = 0;

    if (&WriteScreenDescriptor != $GIF_OK) {
	return $GIF_ERRWRITE;
    }

    # Allocate color table
    if ($#ColorTable != -1) {
	@ColorTable = ();
    }

    if ($NumColors != 0) {
	$tabsize = $NumColors * 3;
	for ($q = 0; $q < $tabsize; $q++) {
	    $ColorTable[$q] = 0;
	}
    }

    return 0;
}


sub GIF_SetColor {
    my($colornum, $red, $green, $blue) = @_;
    my($maxcolor, $p);

    $maxcolor = (1 << $BitsPrPrimColor) - 1;
    $p = $colornum * 3;
    $ColorTable[$p++] = ($red * 255) / $maxcolor;
    $ColorTable[$p++] = ($green * 255) / $maxcolor;
    $ColorTable[$p] = ($blue * 255) / $maxcolor;
}


sub GIF_CompressImage {
    my($left, $top, $width, $height) = @_;
    my($codesize, $errcode, $i, $colortemplate);

    if ($width < 0) { 
	$width = $ScreenWidth;
	$left = 0;
    }
    if ($height < 0) {
	$height = $ScreenHeight;
	$top = 0;
    }
    if ($left < 0) 
      { $left = 0; }
    if ($top < 0) 
      { $top = 0; }

    $colortemplate = "";
    for ($i = 0; $i < $NumColors*3; $i++) {
	$colortemplate .= pack("c", $ColorTable[$i]);
    }
    if ($NumColors != 0) {
	if ((&Write($colortemplate, $NumColors*3)) != $GIF_OK) {
	    return $GIF_ERRWRITE;
	}
    }
       
    $idSeparator = ',';
    $idLeftPosition = $ImageLeft = $left;
    $idTopPosition = $ImageTop = $top;
    $idWidth = $ImageWidth = $width;
    $idHeight = $ImageHeight = $height;
    $idLocalColorTableSize = 0;
    $idReserved = 0;
    $idSortFlag = 0;
    $idInterlaceFlag = 0;
    $idLocalColorTableFlag = 0;

    if (&WriteImageDescriptor != $GIF_OK) {
	return $GIF_ERRWRITE;
    }

    $codesize = &BitsNeeded($NumColors);
    if ($codesize == 1) {
	++$codesize;
    }
    if (&WriteByte(pack("C", $codesize)) != $GIF_OK) {
	return $GIF_ERRWRITE;
    }

    $RelPixX = $RelPixY = 0;

    if (($errcode = &LZW_Compress($codesize)) != $GIF_OK) {
	return $errcode;
    }

    if (&WriteByte(pack("C", 0x00)) != $GIF_OK) { 
	return $GIF_ERRWRITE; 
    }

    return $GIF_OK;
}


sub GIF_Close {
    $idSeparator = ';';
    if (&WriteImageDescriptor != $GIF_OK) {
        return $GIF_ERRWRITE;
    }
    
    &Close;

    return $GIF_OK;
}

sub PutPixel {
    my($x, $y, $color) = @_;
    #print "$x\t$y\t$color\n";
    $Screen[$x][$y] = $color;
}


sub GetPixel {
    my($x, $y) = @_;
    return $Screen[$x][$y];
}



1;