Is it in the package catalog? Vincent
At Sat, 11 Oct 2014 20:59:09 +0200, Pierpaolo Bernardi wrote: > > For the record, in case someone else needs a flood-fill, attached > below there's what I ended up using. > > With respect to the GitHub version (which uses an implicit stack) this > one uses a queue for storing the restart points. This probably is > slower but it uses much less memory (proportional to the length of the > frontier of the expanding paint rather than proportional to the area > to be painted). I used it for filling areas of around 100M pixels with > no problems and acceptable performance. > > Also, I made the buffer creation and restoring functions available > externally because these are expensive operations and in this way the > cost can be shared between several calls of the flood-fill function. > > I'm sorry I don't understand who is the author of the original version > to give proper credit. > > USE AS: > > (let ((flood-fill-buffer (flood-fill-make-buffer dc))) > (flood-fill dc x y color1 color2 flood-fill-buffer) > ;; more calls to flood-fill... > (flood-fill-flush-buffer dc flood-fill-buffer)) > > OR AS: > (flood-fill dc x y color1 color2) > > If buffer sharing between calls is not needed. > > Cheers > P. > > ================ > > (require "simple-queue.rkt") > > ;;https://github.com/acmeism/RosettaCodeData/blob/master/Task/Bitmap-Flood-fill/Racket/bitmap-flood-fill.rkt > > ;; flood-fill: bitmap<%> number number color color -> void > ;; An example of flood filling a bitmap. > ;; > ;; We'll use a raw, byte-oriented interface here for demonstration > ;; purposes. Racket does provide get-pixel and set-pixel functions > ;; which work on color% structures rather than bytes, but it's useful > ;; to see that the byte approach works as well. > > (define (flood-fill-make-buffer bm) > (define-values (width0 height0) (send bm get-size)) > (define width (inexact->exact width0)) > (define height (inexact->exact height0)) > (define buffer (make-bytes (* width height 4))) > (send bm get-argb-pixels 0 0 width height buffer) > buffer) > > (define (flood-fill-flush-buffer bm buffer) > (define-values (width0 height0) (send bm get-size)) > (define width (inexact->exact width0)) > (define height (inexact->exact height0)) > (send bm set-argb-pixels 0 0 width height buffer)) > > (define (flood-fill bm start-x start-y target-color replacement-color > (buffer #f)) > (define buffer-supplied buffer) > > ;; The iter function from the original in GitHub - PB > ;; The main loop. > ;; http://en.wikipedia.org/wiki/Flood_fill > #| (define (iter x y) > (when (and (in-bounds? x y) (target-color-at? x y)) > (replace-color-at! x y) > (iter (add1 x) y) > (iter (sub1 x) y) > (iter x (add1 y)) > (iter x (sub1 y)))) > |# > > (define (maybe-enqueue! q x y) > (when (and (in-bounds? x y) (target-color-at? x y)) > (enqueue! q x) > (enqueue! q y))) > > (define (iter x y) > (define q (make-queue)) > (maybe-enqueue! q x y) > (let loop () > (unless (queue-empty? q) > (define x (dequeue! q)) > (define y (dequeue! q)) > (when (and (in-bounds? x y) (target-color-at? x y)) > (replace-color-at! x y) > (maybe-enqueue! q (add1 x) y) > (maybe-enqueue! q (sub1 x) y) > (maybe-enqueue! q x (add1 y)) > (maybe-enqueue! q x (sub1 y))) > (loop)))) > > > ;; With auxillary definitions below: > ;(define width (send bm get-width)) > ;(define height (send bm get-height)) > (define-values (width0 height0) (send bm get-size)) > (define width (inexact->exact width0)) > (define height (inexact->exact height0)) > > (unless buffer-supplied > (set! buffer (flood-fill-make-buffer bm))) > > (define-values (target-red target-green target-blue) > (values (send target-color red) > (send target-color green) > (send target-color blue))) > > (define-values (replacement-red replacement-green replacement-blue) > (values (send replacement-color red) > (send replacement-color green) > (send replacement-color blue))) > > (define (offset-at x y) (* 4 (+ (* y width) x))) > > (define (target-color-at? x y) > (define offset (offset-at x y)) > (and (= (bytes-ref buffer (+ offset 1)) target-red) > (= (bytes-ref buffer (+ offset 2)) target-green) > (= (bytes-ref buffer (+ offset 3)) target-blue))) > > (define (replace-color-at! x y) > (define offset (offset-at x y)) > (bytes-set! buffer (+ offset 1) replacement-red) > (bytes-set! buffer (+ offset 2) replacement-green) > (bytes-set! buffer (+ offset 3) replacement-blue)) > > (define (in-bounds? x y) > (and (<= 0 x) (< x width) (<= 0 y) (< y height))) > > ;; Finally, let's do the fill, and then store the > ;; result back into the bitmap: > (iter start-x start-y) > > (unless buffer-supplied > (flood-fill-flush-buffer bm buffer))) > > ============================================================ > simple-queues.rkt > > #lang racket > > (provide make-queue enqueue! dequeue! queue-empty? queue-length) > > (struct queue > (store front rear) > #:mutable > #:transparent) > > (define (make-queue (init-dim 10)) > (queue (make-vector init-dim #f) > 0 > 0)) > > (define (queue-empty? q) > (match q > ((queue _ front rear) > (= front rear)))) > > (define grow-factor 2) > > (define (enqueue! q v) > (match q > ((queue store front rear) > (define len (vector-length store)) > (let ((new-rear (modulo (add1 rear) len))) > (cond ((= new-rear front) > (let ((new-queue (make-queue (inexact->exact (round (* > (vector-length store) grow-factor)))))) > (let loop () > (cond ((queue-empty? q) > (match new-queue > ((queue store front rear) > (set-queue-store! q store) > (set-queue-front! q front) > (set-queue-rear! q rear))) > (enqueue! q v)) > (else > (enqueue! new-queue (dequeue! q)) > (loop)))))) > (else > (vector-set! store new-rear v) > (set-queue-rear! q new-rear))))))) > > (define (dequeue! q) > (match q > ((queue store front rear) > (let ((new-front (modulo (add1 front) (vector-length store)))) > (set-queue-front! q new-front) > (vector-ref store new-front))))) > > (define (queue-length q) > (match q > ((queue store front rear) > (if (<= front rear) > (- rear front) > (- (+ rear (vector-length store)) front))))) > > == EOF == > > > > > On Sun, Oct 5, 2014 at 10:30 PM, Jens Axel Søgaard > <jensa...@soegaard.net> wrote: > > Maybe this can be used? > > > > https://github.com/acmeism/RosettaCodeData/blob/master/Task/Bitmap-Flood-fill/Racket/bitmap-flood-fill.rkt > > > > /Jens Axel > > > > > > 2014-10-05 22:14 GMT+02:00 Pierpaolo Bernardi <olopie...@gmail.com>: > >> Hello, > >> > >> here's a couple of dumb questions: I did not find a flood-fill method > >> for bitmaps. Am I right it's not there, or I missed it? > >> > >> I tried implementing one myself, but the result is way too slow to be > >> useful. Any recommendation? > >> > >> Cheers > >> P. > >> ____________________ > >> Racket Users list: > >> http://lists.racket-lang.org/users > > > > > > > > -- > > -- > > Jens Axel Søgaard > > ____________________ > Racket Users list: > http://lists.racket-lang.org/users ____________________ Racket Users list: http://lists.racket-lang.org/users
