(define (color-map->palette color-map transparency-index)
  (let* ((count (color-map-count color-map))
         (palette (make-vector count)))
    (color-map-for-each-indexed
     (lambda (color i)
       (if (and transparency-index (= i transparency-index))
           (vector-set! palette i (imlib2:color/rgba 0 0 0 0))
           (let ((r (color-red color))
                 (g (color-green color))
                 (b (color-blue color)))
             (vector-set! palette i (imlib2:color/rgba r g b 255)))))
     color-map)
    palette))

(define (hole? width height l t w h)
  (or (> l 0) (< (+ l w) width)
      (> t 0) (< (+ t h) height)))

(define (gif->imlib2-images gif)
  (let* ((global-color-map (gif-color-map gif))
         (width (gif-width gif))
         (height (gif-height gif))
         (frame-count (gif-frame-count gif))
         (bg-index (gif-bg-index gif))
         (image (imlib2:image-create width height))
         (last #f))
    (let loop ((i 0)
               (images '()))
      (if (< i frame-count)
          (let* ((frame (gif-frame-ref gif i))
                 (l (frame-left frame))
                 (t (frame-top frame))
                 (w (frame-width frame))
                 (h (frame-height frame))
                 (local-color-map (frame-color-map frame))
                 (color-map (or global-color-map local-color-map))
                 (metadata (frame-metadata frame))
                 (disposal (alist-ref 'disposal metadata))
                 (transparency-index (alist-ref 'transparency-index metadata))
                 (palette (if color-map (color-map->palette color-map transparency-index) #f)))
            (assert palette "No palette specified")
            (assert (<= (+ l w) width) "Frame width overflow")
            (assert (<= (+ t h) height) "Frame height overflow")
            (when (hole? width height l t w h)
              (assert disposal "No disposal specified for empty pixels"))

            (let loop ((y 0))
              (when (< y height)
                (let loop ((x 0))
                  (when (< x width)
                    (let ((color
                           (if (hole? width height l t w h)
                               (case disposal
                                 ((unspecified none last)
                                   (assert last "No previous frame encountered")
                                   (receive
                                    (r g b a)
                                    (imlib2:image-pixel/rgba last x y)
                                    (imlib2:color/rgba r g b a)))
                                 ((background)
                                  (vector-ref palette bg-index)))
                               (vector-ref palette (frame-pixel frame (- x l) (- y t))))))
                      (imlib2:image-draw-pixel image color x y))
                    (loop (add1 x))))
                (loop (add1 y))))
            (when (not (eqv? disposal last))
              (set! last image))
            (loop (add1 i) (cons image images)))
          (reverse images)))))

(define (argb->uint32 a r g b)
  (bitwise-ior
   (arithmetic-shift a 24)
   (arithmetic-shift r 16)
   (arithmetic-shift g 8)
   b))

(define (color-map->palette color-map transparency-index)
  (let* ((count (color-map-count color-map))
         (palette (make-vector count)))
    (color-map-for-each-indexed
     (lambda (color i)
       (if (and transparency-index (= i transparency-index))
           (vector-set! palette i (argb->uint32 0 0 0 0))
           (let ((r (color-red color))
                 (g (color-green color))
                 (b (color-blue color)))
             (vector-set! palette i (argb->uint32 255 r g b)))))
     color-map)
    palette))

(define (hole? width height l t w h)
  (or (> l 0) (< (+ l w) width)
      (> t 0) (< (+ t h) height)))

(define imlib2:image-data-pixel/uint32
  (foreign-lambda* unsigned-int32 (((c-pointer unsigned-int32) ptr) (int x) (int y) (int w)) "C_return(ptr[y*w+x]);"))

(define (gif->imlib2-images gif)
  (let* ((global-color-map (gif-color-map gif))
         (width (gif-width gif))
         (height (gif-height gif))
         (frame-count (gif-frame-count gif))
         (bg-index (gif-bg-index gif))
         (data (make-u32vector (* width height)))
         (last #f))
    (let loop ((i 0)
               (images '()))
      (if (< i frame-count)
          (let* ((frame (gif-frame-ref gif i))
                 (l (frame-left frame))
                 (t (frame-top frame))
                 (w (frame-width frame))
                 (h (frame-height frame))
                 (local-color-map (frame-color-map frame))
                 (color-map (or global-color-map local-color-map))
                 (metadata (frame-metadata frame))
                 (disposal (alist-ref 'disposal metadata))
                 (transparency-index (alist-ref 'transparency-index metadata))
                 (palette (if color-map (color-map->palette color-map transparency-index))))
            (assert palette "No palette specified")
            (assert (<= (+ l w) width) "Frame width overflow")
            (assert (<= (+ t h) height) "Frame height overflow")
            (when (hole? width height l t w h)
              (assert disposal "No disposal specified for empty pixels"))

            (let loop ((y 0))
              (when (< y height)
                (let loop ((x 0))
                  (when (< x width)
                    (let* ((index (+ (* y width) x))
                           (color
                            (if (hole? width height l t w h)
                                (if (eqv? disposal 'background)
                                    (vector-ref palette bg-index)
                                    (begin
                                      (assert last "No previous frame encountered")
                                      (u32vector-ref last index)))
                                (vector-ref palette (%frame-pixel frame (- x l) (- y t))))))
                      (u32vector-set! data index color))
                    (loop (add1 x))))
                (loop (add1 y))))

            (when (not (eqv? disposal 'last))
              (set! last data))
            (let ((image (imlib2:image-create-using-copied-data
                          width height
                          (make-locative (u32vector->blob/shared data)))))
              (loop (add1 i) (cons image images))))
          (reverse images)))))

(define (argb->uint32 a r g b)
  (bitwise-ior
   (arithmetic-shift a 24)
   (arithmetic-shift r 16)
   (arithmetic-shift g 8)
   b))

(define (color-map->palette color-map transparency-index)
  (let* ((count (color-map-count color-map))
         (palette (make-vector count)))
    (color-map-for-each-indexed
     (lambda (color i)
       (if (and transparency-index (= i transparency-index))
           (vector-set! palette i (argb->uint32 0 0 0 0))
           (let ((r (color-red color))
                 (g (color-green color))
                 (b (color-blue color)))
             (vector-set! palette i (argb->uint32 255 r g b)))))
     color-map)
    palette))

(define (gif->imlib2-images gif)
  (let* ((global-color-map (gif-color-map gif))
         (width (gif-width gif))
         (height (gif-height gif))
         (frame-count (gif-frame-count gif))
         (bg-index (gif-bg-index gif))
         (size (* width height))
         (data (make-u32vector size))
         (last #f))
    (let loop ((i 0)
               (images '()))
      (if (< i frame-count)
          (let* ((frame (gif-frame-ref gif i))
                 (l (frame-left frame))
                 (t (frame-top frame))
                 (w (frame-width frame))
                 (h (frame-height frame))
                 (hole? (or (> l 0) (< (+ l w) width)
                            (> t 0) (< (+ t h) height)))
                 (local-color-map (frame-color-map frame))
                 (color-map (or global-color-map local-color-map))
                 (metadata (frame-metadata frame))
                 (disposal (alist-ref 'disposal metadata))
                 (transparency-index (alist-ref 'transparency-index metadata))
                 (palette (and color-map (color-map->palette color-map transparency-index))))
            (assert palette "No palette specified")
            (assert (<= (+ l w) width) "Frame width overflow")
            (assert (<= (+ t h) height) "Frame height overflow")
            (when hole?
              (assert disposal "No disposal specified for empty pixels")
              (if (eqv? disposal 'background)
                  (let ((bg (vector-ref palette bg-index)))
                    (set! data (make-u32vector size bg)))
                  (begin
                    (assert last "No previous frame encountered")
                    (set! data (subu32vector last 0 (u32vector-length last))))))

            (do ((y 0 (fx+ y 1)))
                ((fx= y h))
              (do ((x 0 (fx+ x 1)))
                  ((fx= x w))
                (let ((index (fx+ (fx* (fx+ y t) width) (fx+ x l)))
                      (color (vector-ref palette (%frame-pixel frame x y))))
                  (u32vector-set! data index color))))

            (when (not (eqv? disposal 'last))
              (set! last data))
            (let ((image (imlib2:image-create-using-copied-data
                          width height
                          (make-locative (u32vector->blob/shared data)))))
              (loop (add1 i) (cons image images))))
          (reverse images)))))