reformatting
svn: r9852
This commit is contained in:
Eli Barzilay
parent
b56df5be44
commit
e62d2bf9ea
|
|
@ -15,7 +15,7 @@
|
|||
|#
|
||||
|
||||
#reader scribble/reader
|
||||
(module gif scheme/base
|
||||
#lang scheme/base
|
||||
(require scheme/contract
|
||||
scribble/srcdoc)
|
||||
|
||||
|
|
@ -27,36 +27,41 @@
|
|||
(define GifVersionPrefix #"GIF89a")
|
||||
|
||||
(provide/doc
|
||||
(proc-doc gif-stream? (([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[@t] if @scheme[v] is a GIF stream created by @scheme[gif-write],
|
||||
@scheme[#f] otherwise.})
|
||||
(proc-doc image-ready-gif-stream? (([v any/c]) () . ->d . [_ boolean?])
|
||||
(proc-doc gif-stream?
|
||||
(([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[@t] if @scheme[v] is a GIF stream created by
|
||||
@scheme[gif-write], @scheme[#f] otherwise.})
|
||||
(proc-doc image-ready-gif-stream?
|
||||
(([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[#t] if @scheme[v] is a GIF stream that is not in
|
||||
@scheme['done] mode, @scheme[#f] otherwise.})
|
||||
(proc-doc image-or-control-ready-gif-stream? (([v any/c]) () . ->d . [_ boolean?])
|
||||
(proc-doc image-or-control-ready-gif-stream?
|
||||
(([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[#t] if @scheme[v] is a GIF stream that is in
|
||||
@scheme['init] or @scheme['image-or-control] mode, @scheme[#f] otherwise.})
|
||||
(proc-doc empty-gif-stream? (([v any/c]) () . ->d . [_ boolean?])
|
||||
@scheme['init] or @scheme['image-or-control] mode, @scheme[#f]
|
||||
otherwise.})
|
||||
(proc-doc empty-gif-stream?
|
||||
(([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[#t] if @scheme[v] is a GIF stream that in
|
||||
@scheme['init] mode, @scheme[#f] otherwise.})
|
||||
(proc-doc gif-colormap? (([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[#t] if @scheme[v] represets a colormap, @scheme[#f] otherwise.
|
||||
A colormap is a list whose size is a power of @math{2} between @math{2^1} and @math{2^8},
|
||||
and whose elements are vectors of size 3 containing colors
|
||||
(i.e., exact integers between @math{0} and @math{255} inclusive).})
|
||||
(proc-doc color? (([v any/c]) () . ->d . [_ boolean?])
|
||||
(proc-doc gif-colormap?
|
||||
(([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[#t] if @scheme[v] represets a colormap,
|
||||
@scheme[#f] otherwise. A colormap is a list whose size is a power
|
||||
of @math{2} between @math{2^1} and @math{2^8}, and whose elements
|
||||
are vectors of size 3 containing colors (i.e., exact integers
|
||||
between @math{0} and @math{255} inclusive).})
|
||||
(proc-doc color?
|
||||
(([v any/c]) () . ->d . [_ boolean?])
|
||||
@{The same as @scheme[byte?].})
|
||||
(proc-doc dimension? (([v any/c]) () . ->d . [_ boolean?])
|
||||
(proc-doc dimension?
|
||||
(([v any/c]) () . ->d . [_ boolean?])
|
||||
@{Returns @scheme[#t] if @scheme[v] is an exact integer between
|
||||
@scheme[#x0] and @scheme[#xFFFF] inclusive, @scheme[#f]
|
||||
otherwise.}))
|
||||
|
||||
(define-struct gif-stream (port
|
||||
SWidth
|
||||
SHeight
|
||||
SBackGroundColor
|
||||
SColorMap
|
||||
[FileState #:mutable]))
|
||||
(define-struct gif-stream
|
||||
(port SWidth SHeight SBackGroundColor SColorMap [FileState #:mutable]))
|
||||
|
||||
(define (image-ready-gif-stream? g)
|
||||
(and (gif-stream? g)
|
||||
|
|
@ -89,14 +94,7 @@
|
|||
|
||||
(define (bits-per-pixel ColorMap)
|
||||
(case (length ColorMap)
|
||||
[(2) 1]
|
||||
[(4) 2]
|
||||
[(8) 3]
|
||||
[(16) 4]
|
||||
[(32) 5]
|
||||
[(64) 6]
|
||||
[(128) 7]
|
||||
[(256) 8]
|
||||
[(2) 1] [(4) 2] [(8) 3] [(16) 4] [(32) 5] [(64) 6] [(128) 7] [(256) 8]
|
||||
[else (error 'bits-per-pixel
|
||||
"strange colormap size: ~e"
|
||||
(length ColorMap))]))
|
||||
|
|
@ -104,7 +102,8 @@
|
|||
(define (WRITE g bytes)
|
||||
(write-bytes bytes (gif-stream-port g)))
|
||||
|
||||
(provide/doc (proc-doc gif-state (([stream gif-stream?]) () . ->d . [_ symbol?])
|
||||
(provide/doc (proc-doc gif-state
|
||||
(([stream gif-stream?]) () . ->d . [_ symbol?])
|
||||
@{Returns the state of @scheme[stream].}))
|
||||
(define (gif-state GifFile)
|
||||
(gif-stream-FileState GifFile))
|
||||
|
|
@ -122,32 +121,26 @@
|
|||
[cmap (or/c false/c gif-colormap?)])
|
||||
()
|
||||
. ->d . [_ gif-stream?])
|
||||
@{Writes the start of a GIF file to the given output port, and returns
|
||||
a GIF stream that adds to the output port.
|
||||
@{Writes the start of a GIF file to the given output port, and
|
||||
returns a GIF stream that adds to the output port.
|
||||
|
||||
The width and height determine a virtual space for the overall GIF
|
||||
image. Individual images added to the GIF stream must fit within this
|
||||
virtual space. The space is initialized by the given background color.
|
||||
The width and height determine a virtual space for the overall
|
||||
GIF image. Individual images added to the GIF stream must fit
|
||||
within this virtual space. The space is initialized by the
|
||||
given background color.
|
||||
|
||||
Finally, the default meaning of color numbers (such as the background color)
|
||||
is determined by the given colormap, but individual images
|
||||
within the GIF file can have their own colormaps.
|
||||
Finally, the default meaning of color numbers (such as the
|
||||
background color) is determined by the given colormap, but
|
||||
individual images within the GIF file can have their own
|
||||
colormaps.
|
||||
|
||||
A global colormap need not be supplied, in which case a colormap must
|
||||
be supplied for each image. Beware that the bg-color is ill-defined if
|
||||
a global colormap is not provided.}))
|
||||
(define (gif-start port
|
||||
Width
|
||||
Height
|
||||
BackGround
|
||||
ColorMap)
|
||||
A global colormap need not be supplied, in which case a
|
||||
colormap must be supplied for each image. Beware that the
|
||||
bg-color is ill-defined if a global colormap is not
|
||||
provided.}))
|
||||
(define (gif-start port Width Height BackGround ColorMap)
|
||||
(define GifFile
|
||||
(make-gif-stream port
|
||||
Width
|
||||
Height
|
||||
BackGround
|
||||
ColorMap
|
||||
'init))
|
||||
(make-gif-stream port Width Height BackGround ColorMap 'init))
|
||||
|
||||
(when ColorMap
|
||||
(unless (BackGround . < . (length ColorMap))
|
||||
|
|
@ -200,43 +193,39 @@
|
|||
[bstr bytes?])
|
||||
()
|
||||
. ->d . [_ void?])
|
||||
@{Writes an image to the given GIF stream. The @scheme[left], @scheme[top],
|
||||
@scheme[width], and @scheme[height] values specify the location and
|
||||
size of the image within the overall GIF image's virtual space.
|
||||
@{Writes an image to the given GIF stream. The @scheme[left],
|
||||
@scheme[top], @scheme[width], and @scheme[height] values
|
||||
specify the location and size of the image within the overall
|
||||
GIF image's virtual space.
|
||||
|
||||
If @scheme[interlaced?] is true, then @scheme[bstr] should provide bytes
|
||||
ininterlaced order instead of top-to-bottom order. Interlaced order is:
|
||||
If @scheme[interlaced?] is true, then @scheme[bstr] should
|
||||
provide bytes ininterlaced order instead of top-to-bottom
|
||||
order. Interlaced order is:
|
||||
|
||||
@(itemize
|
||||
@item{every 8th row, starting with 0}
|
||||
@(itemize @item{every 8th row, starting with 0}
|
||||
@item{every 8th row, starting with 4}
|
||||
@item{every 4th row, starting with 2}
|
||||
@item{every 2nd row, starting with 1})
|
||||
|
||||
If a global color is provided with @scheme[gif-start], a @scheme[#f] value
|
||||
can be provided for @scheme[cmap].
|
||||
If a global color is provided with @scheme[gif-start], a
|
||||
@scheme[#f] value can be provided for @scheme[cmap].
|
||||
|
||||
The @scheme[bstr] argument specifies the pixel content of the image. Each
|
||||
byte specifies a color (i.e., an index in the colormap). Each row is
|
||||
provided left-to-right, and the rows provided either top-to-bottom or
|
||||
in interlaced order (see above). If the image is prefixed with a
|
||||
control that specifies an transparent index (see @scheme[gif-add-control]),
|
||||
then the corresponding ``color'' doesn't draw into the overall GIF
|
||||
The @scheme[bstr] argument specifies the pixel content of the
|
||||
image. Each byte specifies a color (i.e., an index in the
|
||||
colormap). Each row is provided left-to-right, and the rows
|
||||
provided either top-to-bottom or in interlaced order (see
|
||||
above). If the image is prefixed with a control that specifies
|
||||
an transparent index (see @scheme[gif-add-control]), then the
|
||||
corresponding ``color'' doesn't draw into the overall GIF
|
||||
image.
|
||||
|
||||
An exception is raised if any byte value in @scheme[bstr] is larger than the
|
||||
colormap's length, if the @scheme[bstr] length is not @scheme[width] times
|
||||
@scheme[height], or if the @scheme[top], @scheme[left], @scheme[width], and
|
||||
@scheme[height] dimensions specify a region beyond the overall GIF image's
|
||||
virtual space.}))
|
||||
(define (gif-add-image GifFile
|
||||
Left
|
||||
Top
|
||||
Width
|
||||
Height
|
||||
Interlace
|
||||
ColorMap
|
||||
Line)
|
||||
An exception is raised if any byte value in @scheme[bstr] is
|
||||
larger than the colormap's length, if the @scheme[bstr] length
|
||||
is not @scheme[width] times @scheme[height], or if the
|
||||
@scheme[top], @scheme[left], @scheme[width], and
|
||||
@scheme[height] dimensions specify a region beyond the overall
|
||||
GIF image's virtual space.}))
|
||||
(define (gif-add-image GifFile Left Top Width Height Interlace ColorMap Line)
|
||||
|
||||
(unless ColorMap
|
||||
(unless (gif-stream-SColorMap GifFile)
|
||||
|
|
@ -270,8 +259,7 @@
|
|||
(when ColorMap
|
||||
(WRITE GifFile (color-map->bytes ColorMap)))
|
||||
|
||||
(let* ([cmap (or ColorMap
|
||||
(gif-stream-SColorMap GifFile))])
|
||||
(let* ([cmap (or ColorMap (gif-stream-SColorMap GifFile))])
|
||||
|
||||
(check-line-bytes (length cmap) Line)
|
||||
|
||||
|
|
@ -306,39 +294,44 @@
|
|||
[transparent (or/c false/c color?)])
|
||||
()
|
||||
. ->d . [_ void?])
|
||||
@{Writes an image-control command to a GIF stream. Such a control must
|
||||
appear just before an image, and it applies to the following image.
|
||||
@{Writes an image-control command to a GIF stream. Such a control
|
||||
must appear just before an image, and it applies to the
|
||||
following image.
|
||||
|
||||
The GIF image model involves processing images one by one, placing
|
||||
each image into the specified position within the overall image's
|
||||
virtual space. An image-control command can specify a delay before an
|
||||
image is added (to create animated GIFs), and it also specifies how
|
||||
the image should be kept or removed from the overall image before
|
||||
proceeding to the next one (also for GIF animation).
|
||||
The GIF image model involves processing images one by one,
|
||||
placing each image into the specified position within the
|
||||
overall image's virtual space. An image-control command can
|
||||
specify a delay before an image is added (to create animated
|
||||
GIFs), and it also specifies how the image should be kept or
|
||||
removed from the overall image before proceeding to the next
|
||||
one (also for GIF animation).
|
||||
|
||||
The @scheme[disposal] argument specifies how to proceed:
|
||||
|
||||
@(itemize
|
||||
@item{@scheme['any] : doesn't matter (perhaps because the next image
|
||||
completely overwrites the current one)}
|
||||
@(itemize @item{@scheme['any] : doesn't matter (perhaps because
|
||||
the next image completely overwrites the
|
||||
current one)}
|
||||
@item{@scheme['keep] : leave the image in place}
|
||||
@item{@scheme['restore-bg] : replace the image with the background color}
|
||||
@item{@scheme['restore-prev] : restore the overall image content to the
|
||||
content before the image is added})
|
||||
@item{@scheme['restore-bg] : replace the image with
|
||||
the background color}
|
||||
@item{@scheme['restore-prev] : restore the overall
|
||||
image content to the content before the image
|
||||
is added})
|
||||
|
||||
If @scheme[wait-for-input?] is true, then the display program may wait for
|
||||
some cue from the user (perhaps a mouse click) before adding the
|
||||
image.
|
||||
If @scheme[wait-for-input?] is true, then the display program
|
||||
may wait for some cue from the user (perhaps a mouse click)
|
||||
before adding the image.
|
||||
|
||||
The @scheme[delay] argument specifies a delay in 1/100s of a
|
||||
second.
|
||||
|
||||
If the @scheme[transparent] argument is a color, then it
|
||||
determines an index that is used to represent transparent pixels in the
|
||||
follow image (as opposed to the color specified by the colormap for the index).
|
||||
determines an index that is used to represent transparent
|
||||
pixels in the follow image (as opposed to the color specified
|
||||
by the colormap for the index).
|
||||
|
||||
An exception is raised if a control is already added to @scheme[stream]
|
||||
without a corresponding image.}))
|
||||
An exception is raised if a control is already added to
|
||||
@scheme[stream] without a corresponding image.}))
|
||||
|
||||
(define (gif-add-control GifFile
|
||||
Disposal
|
||||
|
|
@ -371,13 +364,14 @@
|
|||
[iteration dimension?])
|
||||
()
|
||||
. ->d . [_ void?])
|
||||
@{Writes a control command to a GIF stream for which no images or other
|
||||
commands have already been written. The command causes the animating
|
||||
sequence of images in the GIF to be repeated `iteration-dimension'
|
||||
times, where 0 can be used to mean ``infinity.''
|
||||
@{Writes a control command to a GIF stream for which no images or
|
||||
other commands have already been written. The command causes
|
||||
the animating sequence of images in the GIF to be repeated
|
||||
`iteration-dimension' times, where 0 can be used to mean
|
||||
``infinity.''
|
||||
|
||||
An exception is raise if some control or image has been added to the
|
||||
stream already.}))
|
||||
An exception is raise if some control or image has been added
|
||||
to the stream already.}))
|
||||
(define (gif-add-loop-control GifFile
|
||||
Iterations)
|
||||
(WRITE GifFile #"\x21\xFF\x0BNETSCAPE2.0\x03\x01")
|
||||
|
|
@ -396,10 +390,9 @@
|
|||
. ->d . [_ void?])
|
||||
@{Adds a generic comment to the GIF stream.
|
||||
|
||||
An exception is raised if an image-control command was just written to
|
||||
the stream (so that an image is required next).}))
|
||||
(define (gif-add-comment GifFile
|
||||
Str)
|
||||
An exception is raised if an image-control command was just
|
||||
written to the stream (so that an image is required next).}))
|
||||
(define (gif-add-comment GifFile Str)
|
||||
(WRITE GifFile #"\x21\xFE")
|
||||
(let loop ([pos 0])
|
||||
(when (pos . < . (bytes-length Str))
|
||||
|
|
@ -418,12 +411,11 @@
|
|||
(([stream image-or-control-ready-gif-stream?])
|
||||
()
|
||||
. ->d . [_ void?])
|
||||
@{Finishes
|
||||
writing a GIF file. The GIF stream's output port is not
|
||||
automatically closed.
|
||||
@{Finishes writing a GIF file. The GIF stream's output port is
|
||||
not automatically closed.
|
||||
|
||||
An exception is raised if an image-control command was just written to
|
||||
the stream (so that an image is required next).}))
|
||||
An exception is raised if an image-control command was just
|
||||
written to the stream (so that an image is required next).}))
|
||||
(define (gif-end GifFile)
|
||||
(WRITE GifFile #";")
|
||||
(set-gif-stream-FileState! GifFile 'done))
|
||||
|
|
@ -449,8 +441,8 @@
|
|||
RunningBits RunningCode MaxCode1
|
||||
CrntShiftState CrntShiftDWord)
|
||||
(let-values ([(CrntShiftState CrntShiftDWord)
|
||||
(let loop ([CrntShiftDWord (bitwise-ior
|
||||
CrntShiftDWord
|
||||
(let loop ([CrntShiftDWord
|
||||
(bitwise-ior CrntShiftDWord
|
||||
(arithmetic-shift Code CrntShiftState))]
|
||||
[CrntShiftState (+ CrntShiftState RunningBits)])
|
||||
(if (CrntShiftState . >= . 8)
|
||||
|
|
@ -511,7 +503,8 @@
|
|||
(let loop ([CrntShiftState CrntShiftState]
|
||||
[CrntShiftDWord CrntShiftDWord])
|
||||
(when (CrntShiftState . > . 0)
|
||||
(write-buffered-byte (bitwise-and CrntShiftDWord #xff) buf port)
|
||||
(write-buffered-byte (bitwise-and CrntShiftDWord #xff)
|
||||
buf port)
|
||||
(loop (arithmetic-shift CrntShiftDWord -8)
|
||||
(- CrntShiftState 8))))
|
||||
(unless (zero? (bytes-ref buf 0))
|
||||
|
|
@ -573,39 +566,39 @@
|
|||
()
|
||||
. ->d .
|
||||
(values [_ bytes?] [_ gif-colormap?] [_ (or/c false/c color?)]))
|
||||
@{Each
|
||||
image in a GIF stream is limited to 256 colors, including the
|
||||
transparent ``color,'' if any. The @scheme[quantize] function helps converts a
|
||||
24-bit image (plus alpha channel) into an indexed-color image,reducing
|
||||
the number of colors if necessary.
|
||||
@{Each image in a GIF stream is limited to 256 colors, including the
|
||||
transparent ``color,'' if any. The @scheme[quantize] function
|
||||
helps converts a 24-bit image (plus alpha channel) into an
|
||||
indexed-color image,reducing the number of colors if necessary.
|
||||
|
||||
Given a set of pixels expressed in ARGB format
|
||||
(i.e., each four bytes is a set of values for one pixel: alpha, red, blue, and green),
|
||||
@scheme[quantize] produces produces
|
||||
Given a set of pixels expressed in ARGB format (i.e., each four
|
||||
bytes is a set of values for one pixel: alpha, red, blue, and
|
||||
green),@scheme[quantize] produces produces
|
||||
|
||||
@(itemize
|
||||
@item{bytes for the image (i.e., a array of colors, expressed as a byte string)}
|
||||
@(itemize @item{bytes for the image (i.e., a array of colors,
|
||||
expressed as a byte string)}
|
||||
@item{a colormap}
|
||||
@item{either @scheme[#f] or a color index for the transparent ``color''})
|
||||
@item{either @scheme[#f] or a color index for the
|
||||
transparent ``color''})
|
||||
|
||||
The conversion treats alpha values less than 128 as transparent
|
||||
pixels, and other alpha values as solid.
|
||||
|
||||
The quantization process first attempts to use all (non-transparent)
|
||||
colors in the image. if that fails, it reduces the image to 12-bit
|
||||
color (3 bits per each of red, green, and blue) by rounding up pixel
|
||||
values, and tries again. If that fails, it reduces the image to 6-bit
|
||||
color (2 bits per each of red, green, and blue).
|
||||
The quantization process first attempts to use all
|
||||
(non-transparent) colors in the image. if that fails, it reduces
|
||||
the image to 12-bit color (3 bits per each of red, green, and
|
||||
blue) by rounding up pixel values, and tries again. If that
|
||||
fails, it reduces the image to 6-bit color (2 bits per each of
|
||||
red, green, and blue).
|
||||
|
||||
To convert a collection of images all with the same quantization,
|
||||
simply append them for the input of a single call of @scheme[quantize], and
|
||||
then break apart the result bytes.}))
|
||||
simply append them for the input of a single call of
|
||||
@scheme[quantize], and then break apart the result bytes.}))
|
||||
(define (quantize argb)
|
||||
(let* ([len (quotient (bytes-length argb) 4)]
|
||||
[result (make-bytes len)]
|
||||
[rgb-key (lambda (r g b)
|
||||
(bitwise-ior (bitwise-ior
|
||||
(arithmetic-shift r 16)
|
||||
(bitwise-ior (bitwise-ior (arithmetic-shift r 16)
|
||||
(arithmetic-shift g 8))
|
||||
b))]
|
||||
[key->rgb (lambda (k)
|
||||
|
|
@ -655,9 +648,7 @@
|
|||
(unless (= this-idx 256)
|
||||
(bytes-set! result i this-idx)
|
||||
(loop (add1 i) (+ pos 4))))))
|
||||
(if ((hash-count table) . > . (if transparent
|
||||
255
|
||||
256))
|
||||
(if ((hash-count table) . > . (if transparent 255 256))
|
||||
;; Try again
|
||||
(loop (cdr masks))
|
||||
;; Found an ok quantization
|
||||
|
|
@ -674,9 +665,7 @@
|
|||
[(<= cnt 128) 128]
|
||||
[else 256])]
|
||||
[t (make-vector size #(0 0 0))])
|
||||
(hash-for-each
|
||||
table
|
||||
(lambda (k v)
|
||||
(vector-set! t v (key->rgb k))))
|
||||
(for ([(k v) table])
|
||||
(vector-set! t v (key->rgb k)))
|
||||
(vector->list t))
|
||||
transparent)))))))
|
||||
transparent))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user