aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMasaya Tojo <masaya@tojo.tokyo>2018-06-17 03:11:26 +0900
committerMasaya Tojo <masaya@tojo.tokyo>2018-06-17 03:11:26 +0900
commit9c740e1dc6b65a6b9467948f64584ea3c28856a7 (patch)
tree6d14cc62caeb55db4998152230ac24e414305e70
parent911bb575a9f0ee4ccec99d2a40d562b81fff93c6 (diff)
feat: Change interface
-rw-r--r--canny.rkt92
-rw-r--r--flomap-canny.rkt82
2 files changed, 94 insertions, 80 deletions
diff --git a/canny.rkt b/canny.rkt
index 1387130..41c7373 100644
--- a/canny.rkt
+++ b/canny.rkt
@@ -1,82 +1,14 @@
-#lang typed/racket
+#lang racket
+(require "flomap-canny.rkt")
+(require pict)
+(require racket/draw)
(require images/flomap)
-(require racket/flonum)
-(require typed/racket/draw)
-(require math/array)
-(: flomap-grayscale (-> flomap flomap))
-(define (flomap-grayscale img)
- (inline-build-flomap
- 1 (flomap-width img) (flomap-height img)
- (λ (k x y i)
- (+ (* (flomap-ref img 1 x y) 0.299)
- (* (flomap-ref img 2 x y) 0.587)
- (* (flomap-ref img 3 x y) 0.114)))))
-(provide flomap-grayscale)
-
-(: flomap-canny (-> flomap [#:heigh Flonum] [#:low Flonum] flomap))
-(define (flomap-canny img #:heigh [heigh 1.0] #:low [low 0.2])
- (let ([img
- (case (flomap-components img)
- [(4) (flomap-grayscale img)]
- [(1) img]
- [else (error "flomap-canny: invalid components")])])
- (canny img #:heigh heigh #:low low)))
-(provide flomap-canny)
-
-(define-type Orient (Array (U 'horizontal 'positive-diagonal 'vertical 'negative-diagonal)))
-(: tanθ->orient (-> flomap Orient))
-(define (tanθ->orient fm)
- (build-array
- `#[,(flomap-height fm) ,(flomap-width fm)]
- (lambda ([v : Indexes])
- (let ([y : Index (vector-ref v 0)]
- [x : Index (vector-ref v 1)])
- (let ([t : Flonum (flomap-ref fm 0 x y)])
- (cond
- [(<= -0.4142 t 0.4142) 'horizontal]
- [(<= -0.4142 t 2.4142) 'positive-diagonal]
- [(>= (abs t) 2.4142) 'vertical]
- [else 'negative-diagonal]))))))
-
-(define-syntax-rule (idx w x y) (+ (* w y) x))
-
-(: trace! (-> FlVector flomap Orient Integer Integer Integer Integer Flonum Void))
-(define (trace! vec mag orient w h x y low)
- (let loop ([x x] [y y])
- (when (and (<= 0 x (- w 1)) (<= 0 y (- h 1))
- (< (flvector-ref vec (idx w x y)) 0))
- (define s (flomap-ref mag 0 x y))
- (when (<= low s)
- (flvector-set! vec (idx w x y) s)
- (case (array-ref orient `#(,y ,x))
- [(horizontal)
- (loop (+ x 1) y)
- (loop (- x 1) y)]
- [(positive-diagonal)
- (loop (+ x 1) (+ y 1))
- (loop (- x 1) (- y 1))]
- [(vertical)
- (loop x (+ y 1))
- (loop x (- y 1))]
- [(negative-diagonal)
- (loop (+ x 1) (- y 1))
- (loop (- x 1) (+ y 1))]
- [else
- (error "error")])))))
-
-(: canny (-> flomap [#:heigh Flonum] [#:low Flonum] flomap))
-(define canny
- (lambda (fm #:heigh [heigh 1.0] #:low [low 0.2])
- (let* ([w (flomap-width fm)]
- [h (flomap-height fm)]
- [sx (flomap-gradient-x fm)]
- [sy (flomap-gradient-y fm)]
- [mag (fmsqrt (fm+ (fmsqr sx) (fmsqr sy)))]
- [ori (tanθ->orient (fm/ sx sy))]
- [vec (make-flvector (* w h) -1.0)])
- (for* ([y (in-range h)]
- [x (in-range w)])
- (when (<= heigh (flomap-ref mag 0 x y))
- (trace! vec mag ori w h x y low)))
- (flomap vec 1 w h))))
+(define (canny img #:sigma sigma #:heigh heigh #:low low)
+ (bitmap
+ (flomap->bitmap
+ (flomap-canny (bitmap->flomap (pict->bitmap img))
+ #:sigma sigma
+ #:heigh heigh
+ #:low low))))
+(provide canny)
diff --git a/flomap-canny.rkt b/flomap-canny.rkt
new file mode 100644
index 0000000..636e819
--- /dev/null
+++ b/flomap-canny.rkt
@@ -0,0 +1,82 @@
+#lang typed/racket
+(require images/flomap)
+(require racket/flonum)
+(require math/array)
+
+(: flomap-grayscale (-> flomap flomap))
+(define (flomap-grayscale img)
+ (inline-build-flomap
+ 1 (flomap-width img) (flomap-height img)
+ (λ (k x y i)
+ (+ (* (flomap-ref img 1 x y) 0.299)
+ (* (flomap-ref img 2 x y) 0.587)
+ (* (flomap-ref img 3 x y) 0.114)))))
+
+(: flomap-canny (-> flomap #:sigma Flonum #:heigh Flonum #:low Flonum flomap))
+(define flomap-canny
+ (λ (img #:sigma sigma #:heigh heigh #:low low)
+ (let ([img
+ (case (flomap-components img)
+ [(4) (flomap-grayscale img)]
+ [(1) img]
+ [else (error "flomap-canny: invalid components")])])
+ (canny img sigma heigh low))))
+(provide flomap-canny)
+
+(define-type Orient (Array (U 'horizontal 'positive-diagonal 'vertical 'negative-diagonal)))
+(: tanθ->orient (-> flomap Orient))
+(define (tanθ->orient fm)
+ (build-array
+ `#[,(flomap-height fm) ,(flomap-width fm)]
+ (λ ([v : Indexes])
+ (let ([y : Index (vector-ref v 0)]
+ [x : Index (vector-ref v 1)])
+ (let ([t : Flonum (flomap-ref fm 0 x y)])
+ (cond
+ [(<= -0.4142 t 0.4142) 'horizontal]
+ [(<= -0.4142 t 2.4142) 'positive-diagonal]
+ [(>= (abs t) 2.4142) 'vertical]
+ [else 'negative-diagonal]))))))
+
+(define-syntax-rule (idx w x y) (+ (* w y) x))
+
+(: trace! (-> FlVector flomap Orient Integer Integer Integer Integer Flonum Void))
+(define (trace! vec mag orient w h x y low)
+ (let loop ([x x] [y y])
+ (when (and (<= 0 x (- w 1)) (<= 0 y (- h 1))
+ (< (flvector-ref vec (idx w x y)) 0))
+ (define s (flomap-ref mag 0 x y))
+ (when (<= low s)
+ (flvector-set! vec (idx w x y) s)
+ (case (array-ref orient `#(,y ,x))
+ [(horizontal)
+ (loop (+ x 1) y)
+ (loop (- x 1) y)]
+ [(positive-diagonal)
+ (loop (+ x 1) (+ y 1))
+ (loop (- x 1) (- y 1))]
+ [(vertical)
+ (loop x (+ y 1))
+ (loop x (- y 1))]
+ [(negative-diagonal)
+ (loop (+ x 1) (- y 1))
+ (loop (- x 1) (+ y 1))]
+ [else
+ (error "error")])))))
+
+(: canny (-> flomap Flonum Flonum Flonum flomap))
+(define canny
+ (lambda (fm sigma heigh low)
+ (let* ([w (flomap-width fm)]
+ [h (flomap-height fm)]
+ [b (flomap-gaussian-blur fm sigma)]
+ [sx (flomap-gradient-x b)]
+ [sy (flomap-gradient-y b)]
+ [mag (fmsqrt (fm+ (fmsqr sx) (fmsqr sy)))]
+ [ori (tanθ->orient (fm/ sx sy))]
+ [vec (make-flvector (* w h) -1.0)])
+ (for* ([y (in-range h)]
+ [x (in-range w)])
+ (when (<= heigh (flomap-ref mag 0 x y))
+ (trace! vec mag ori w h x y low)))
+ (flomap vec 1 w h))))