(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)))))