secret
Last active

Pixel sort like thing in racket

  • Download Gist
expl.md
Markdown

Similar to Kim Asendorf's pixels sorting but in racket.

Use:

(glitch y-pred x-pred img)

Where:

  • y-pred is a function which takes two pixels (color r g b a) and compares them for sorting on columns.
  • x-pred is a function which takes two pixels (color r g b a) and compares them for sorting on rows.
  • img is an image?

Examples:

Original:

Imgur

Glitched:

(glitch (white? 140) (white? 140) 
        (bitmap/url "http://mysticmesseneger.webs.com/Rocky%20Mountains.jpg"))

Imgur

(glitch (black? 110) (white? 100)
        (bitmap/url "http://mysticmesseneger.webs.com/Rocky%20Mountains.jpg"))

Imgur

Original:

Imgur

Glitched:

(glitch (black? 60) (black? 60) 
        (bitmap/url "http://www.artrenewal.org/artwork/186/186/1971/mona_lisa-large.jpg"))

Imgur

pxlsrt.rkt
Racket
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
#lang racket
 
(require 2htdp/image)
 
(define (colorsort a b)
(>
(+ (color-red a)
(color-green a)
(color-blue a))
(+ (color-red b)
(color-green b)
(color-blue b))))
 
(define (partition-by pred lst)
(define (loop pred lst acc)
(cond
[(empty? lst) (reverse (map reverse acc))]
[(empty? acc)
(loop pred
(rest lst)
(list (list (first lst))))]
[(pred (first lst))
(loop pred
(rest lst)
(cons (list (first lst)) acc))]
[else
(loop pred
(rest lst)
(cons (cons (first lst) (first acc)) (rest acc)))]))
(loop pred lst '()))
 
(define (chunk-list-all lst n)
(if (<= (length lst) n) (list lst)
(cons (take lst n)
(chunk-list-all (drop lst n) n))))
 
(define (translate matrix)
(if (empty? (first matrix)) '()
(cons (map first matrix)
(translate (map rest matrix)))))
 
(define (black? threshold)
(λ (c)
(and
(< (color-red c) threshold)
(< (color-green c) threshold)
(< (color-blue c) threshold))))
 
(define (white? threshold)
(λ (c)
(and
(> (color-red c) threshold)
(> (color-green c) threshold)
(> (color-blue c) threshold))))
 
(define (sort-single-list pred lst)
(apply append
(map (λ (l) (sort l colorsort))
(partition-by pred lst))))
 
(define (sort-list-of-lists pred lsts)
(map (λ (l) (sort-single-list pred l)) lsts))
 
(define (glitch y-pred x-pred img)
(define pixels (image->color-list img))
(define w (image-width img))
(define h (image-height img))
(color-list->bitmap
(apply append
(sort-list-of-lists x-pred
(translate
(sort-list-of-lists y-pred
(translate (chunk-list-all pixels w))))))
w h))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.