Skip to content
Browse files

Animated GIF support

  • Loading branch information...
1 parent f6e0b76 commit 7d0b81debe08dcbbce481b624f17058d7bccfca3 @hanshuebner hanshuebner committed May 27, 2012
Showing with 240 additions and 5 deletions.
  1. +3 −3 Makefile
  2. +79 −0 animated-gif.lisp
  3. +24 −0 cl-gd-glue.c
  4. +3 −2 cl-gd.asd
  5. +88 −0 doc/index.html
  6. +25 −0 gd-uffi.lisp
  7. +5 −0 specials.lisp
  8. +13 −0 test/.gitignore
View
6 Makefile
@@ -1,11 +1,11 @@
# this should work for FreeBSD and most Linux distros
-cl-gd-glue.so:
+cl-gd-glue.so: cl-gd-glue.c
gcc -I/usr/local/include -fPIC -c cl-gd-glue.c
ld -shared -lgd -lz -lpng -ljpeg -lfreetype -lm -lc cl-gd-glue.o -o cl-gd-glue.so -L/usr/local/lib
rm cl-gd-glue.o
# this should work for Mac OS X
-cl-gd-glue.dylib:
- gcc -arch i386 -arch x86_64 -lgif -lgd -lpng -lz -lfreetype -ljpeg -dynamiclib cl-gd-glue.c -o cl-gd-glue.dylib -I/opt/local/include -L/opt/local/lib
+cl-gd-glue.dylib: cl-gd-glue.c
+ gcc -arch x86_64 -lgif -lgd -lpng -lz -lfreetype -ljpeg -dynamiclib cl-gd-glue.c -o cl-gd-glue.dylib -I/opt/local/include -L/opt/local/lib
View
79 animated-gif.lisp
@@ -0,0 +1,79 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-GD; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/gd/gd-uffi.lisp,v 1.33 2009/11/23 17:05:39 edi Exp $
+
+;;; Copyright (c) 2012, Hans Huebner. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-gd)
+
+;; GIF animation context, contains plist with animation parameters.
+(defvar *current-animation*)
+
+(defun add-image-to-animation (image
+ &key
+ (local-color-map-p nil local-color-map-provided-p)
+ (left-offset 0)
+ (top-offset 0)
+ (delay nil delay-provided-p)
+ (disposal :none)
+ last-image
+ (animation *current-animation*))
+ (gd-image-gif-anim-add (img image)
+ (getf animation :anim-pointer)
+ (if local-color-map-provided-p
+ (if local-color-map-p 1 0)
+ (if (getf animation :global-color-map-p) 0 1))
+ left-offset
+ top-offset
+ (or (when delay-provided-p
+ delay)
+ (getf animation :default-delay)
+ (error "no delay specified and no default-delay set in animation context"))
+ (ecase disposal
+ (:none +gd-disposal-none+)
+ (:restore-background +gd-disposal-restore-background+)
+ (:restore-previous +gd-disposal-restore-previous+))
+ (when last-image
+ (img last-image))))
+
+(defmacro with-animated-gif ((filename
+ &key
+ (background-image '*default-image*)
+ global-color-map-p
+ (loop-count -1)
+ (animation '*current-animation*)
+ default-delay)
+ &body body)
+ `(let ((,animation (list :anim-pointer (gd-image-gif-anim-begin-wrap (img ,background-image)
+ ,filename
+ (if ,global-color-map-p 1 0)
+ ,loop-count)
+ :global-color-map-p ,global-color-map-p
+ :default-delay ,default-delay)))
+ (unwind-protect
+ (progn ,@body)
+ (gd-image-gif-anim-end-wrap (getf ,animation :anim-pointer)))))
+
View
24 cl-gd-glue.c
@@ -185,3 +185,27 @@ int gdImageGetGetInterlaced (gdImagePtr im) {
int gdImageGetGetTransparent (gdImagePtr im) {
return gdImageGetTransparent(im);
}
+
+/* GIF animation support */
+
+void*
+gdImageGifAnimBeginWrap(gdImagePtr im,
+ char* filename,
+ int globalCM,
+ int loops)
+{
+ FILE* out = fopen(filename, "w");
+
+ if (out) {
+ gdImageGifAnimBegin(im, out, globalCM, loops);
+ }
+
+ return out;
+}
+
+void
+gdImageGifAnimEndWrap(void* out)
+{
+ gdImageGifAnimEnd(out);
+ fclose(out);
+}
View
5 cl-gd.asd
@@ -40,7 +40,7 @@
:defaults (parse-namestring *load-truename*)))
(defsystem :cl-gd
- :version "0.5.8"
+ :version "0.6.0"
:serial t
:description "Interface to the GD graphics library"
:components ((:file "packages")
@@ -54,6 +54,7 @@
(:file "colors")
(:file "drawing")
(:file "strings")
- (:file "misc"))
+ (:file "misc")
+ (:file "animated-gif"))
:depends-on (#-(or :clisp :openmcl) :uffi
#+(or :clisp :openmcl) :cffi-uffi-compat))
View
88 doc/index.html
@@ -184,6 +184,11 @@
<li><a href="#draw-string"><code>draw-string</code></a>
<li><a href="#draw-freetype-string"><code>draw-freetype-string</code></a>
</ul>
+ <li><a href="#animated-gif">Animated GIF creation</a></li>
+ <ul>
+ <li><a href="#with-animated-gif"><code>with-animated-gif</code></a>
+ <li><a href="#add-image-to-animation"><code>add-image-to-animation</code></a>
+ </ul>
<li><a href="#misc">Miscellaneous</a>
<ul>
<li><a href="#do-rows"><code>do-rows</code></a>
@@ -1189,6 +1194,89 @@
:if-exists :supersede))
</pre>
+<br>&nbsp;<br><h3><a href="#contents" class=none name="animated-gif">Animated GIF creation</a></h3>
+
+CL-GD supports the creation of animated GIF images. Reading animated
+GIFs is not supported by GD, and consequently not supported by CL-GD.
+When opening an animated GIF, only the first frame in the file is
+read.
+<p>
+In order to create an animated GIF, a background image must be created
+which defines the canvas for the animation. Then, the animation is
+created using the WITH-ANIMATED-GIF macro and images are added to the
+animation with ADD-IMAGE-TO-ANIMATION.
+<p>
+The color map can either be shared by all frames, or each frame can
+have its own color map. If a shared color map is desired, the
+:GLOBAL-COLOR-MAP-P keyword argument of WITH-ANIMATED-GIF must be set.
+
+<p><br>[Macro]
+<br><a class=none name="with-animated-gif"><b>with-animated-gif</b> <i>(filename <tt>&amp;key</tt>
+ animation background-image global-color-map-p loop-count default-delay)
+ form*</i> =&gt; <i>results</i></a>
+
+<blockquote><br>
+
+Establish a GIF animation context. <code><i>filename</i></code>
+specifies the GIF file to write. <code><i>animation</i></code>
+specifies the name of the animation context variable. It does not
+normally need to be set, but it may be useful when multiple animated
+GIFs need to be created at the same time. Pass a symbol to use as
+context variable name. <code><i>background-image</i></code> specifies
+the background image to use for the animation, it defaults to
+*DEFAULT-IMAGE*. <code><i>global-color-map-p</i></code> specifies
+whether a global colormap that is shared between all frames should be
+used, or each frame has its own
+colormap. <code><i>loop-count</i></code> sets the loop counter. -1
+means loop forever, 0 means that the animation is executed once,
+positive values indicate the number of
+repetitions. <code><i>default-delay</i></code> indicates the default
+frame delay in 1/100s of a second. It can be overridden for each
+fream in ADD-IMAGE-TO-ANIMATION.
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="add-image-to-animation"><b>add-image-to-animation</b> <i>image <tt>&amp;key</tt>
+ local-color-map-p left-offset top-offset delay disposal last-image animation</i> =&gt; <i>char</i></a>
+
+<blockquote><br>
+
+Add one frame to an animated GIF. <code><i>image</i></code> is the
+image to add. <code><i>local-color-map-p</i></code>, if non-NIL,
+specifies that the image has a local color map and should not use the
+global color map. <code><i>left-offset</i></code>
+and <code><i>top-offset</i></code> specify where this frame should be
+placed on the background. <code><i>delay</i></code> specifies the
+delay for this frame in 1/100s of a
+second. <code><i>disposal</i></code> specifies how the frame is
+treated after it has been displayed. It can be one of :NONE (the
+frame just stays on the background), :RESTORE-BACKGROUND (the affected
+area will be set to the first color of the palette) or
+:RESTORE-PREVIOUS (the previous contents of the image is
+restored). <code><i>last-image</i></code> can be specified to enable
+the GIF animation optimizer. If specified, only the changed pixels
+will be contained in the frame. This works best with a global color
+map, and a transparent color is required for it to work properly.
+</blockquote>
+
+<pre>
+(<a class=noborder href="#with-image*">with-image*</a> (100 100)
+ (<a class=noborder href="#with-animated-gif">with-animated-gif</a> ("test-anim.gif"
+ :global-color-map-p nil
+ :loop-count -1
+ :default-delay 5)
+ (loop with last-image
+ for i from 0 upto 100 by 10
+ for cim = (<a class=noborder href="#create-image">create-image</a> 100 100)
+ do (<a class=noborder href="#allocate-color">allocate-color</a> 0 0 0 :image cim)
+ (<a class=noborder href="#draw-arc">draw-arc</a> 50 50 i i 0 360 :filled t :color (<a class=noborder href="#allocate-color">allocate-color</a> 0 0 255 :image cim) :image cim)
+ (<a class=noborder href="#add-image-to-animation">add-image-to-animation</a> cim :last-image last-image)
+ (when last-image
+ (<a class=noborder href="#destroy-image">destroy-image</a> last-image))
+ (setf last-image cim)
+ finally (<a class=noborder href="#destroy-image">destroy-image</a> last-image))))
+</pre>
+
<br>&nbsp;<br><h3><a href="#contents" class=none name="misc">Miscellaneous</a></h3>
Things that didn't seem to fit into one of the other categories...
View
25 gd-uffi.lisp
@@ -729,3 +729,28 @@
((ptr :pointer-void))
:returning :void
:module "gd")
+
+(def-function ("gdImageGifAnimBeginWrap" gd-image-gif-anim-begin-wrap)
+ ((im gd-image-ptr)
+ (filename :cstring)
+ (global-cm :int)
+ (loops :int))
+ :returning :pointer-void
+ :module "gd")
+
+(def-function ("gdImageGifAnimAdd" gd-image-gif-anim-add)
+ ((im gd-image-ptr)
+ (out :pointer-void)
+ (local-cm :int)
+ (left-ofs :int)
+ (top-ofs :int)
+ (delay :int)
+ (disposal :int)
+ (previm gd-image-ptr))
+ :returning :void
+ :module "gd")
+
+(def-function ("gdImageGifAnimEndWrap" gd-image-gif-anim-end-wrap)
+ ((out :pointer-void))
+ :returning :void
+ :module "gd")
View
5 specials.lisp
@@ -121,6 +121,11 @@ WITH-FONT.")
(defconstant +gd-cmp-true-color+ 256
"One image is a true-color image, the other one is palette-based.")
+(defconstant +gd-disposal-unknown+ 0)
+(defconstant +gd-disposal-none+ 1)
+(defconstant +gd-disposal-restore-background+ 2)
+(defconstant +gd-disposal-restore-previous+ 2)
+
(defvar *shared-library-directories*
`(,(namestring (make-pathname :name nil
:type nil
View
13 test/.gitignore
@@ -0,0 +1,13 @@
+anti-aliased-lines.png
+brushed-arc.png
+chart.png
+circle.png
+clipped-tangent.png
+demooutp.png
+one-line.jpg
+one-line.png
+one-pixel.jpg
+one-pixel.png
+triangle.png
+zappa-ellipse.png
+zappa-green.jpg

0 comments on commit 7d0b81d

Please sign in to comment.
Something went wrong with that request. Please try again.