In the current sicp-pict, we treat a picture as a painter, which is a procedure that takes a frame and then draws the picture to a bitmap (so we don't care about its return value, any type is ok).
I tried to define a procedure called apply-painter, which takes a painter and a frame and returns a bitmap:
(define (apply-painter painter frame #:width [width 200] #:height [height 200])
(define-values (bm dc) (make-painter-bitmap width height))
(begin0 bm
(parameterize ([current-bm bm]
[current-dc dc])
;; TODO Apply frame's transformation to bitmap.
(send dc scale 0.99 0.99) ; make the entire unit square visible
(painter frame))))
(define unit-frame (frame (vect 0. 0.) (vect 1. 0.) (vect 0. 1.)))
(define (paint painter #:width [width 200] #:height [height 200])
(make-object image-snip%
(apply-painter painter unit-frame
#:width width
#:height height)))
With apply-painter, we can treat a painter as a procedure that takes a frame and returns a bitmap.
If we regard the type of painter as follow:
(define-type (Bitmap A) ((Instance Bitmap%)))
(define-type Painter (-> Frame (Bitmap Frame)))
Things seem to get interesting:
We can define a transformation f between Frames (marked F),
and define a transformation b between (Instance Bitmap%)s (marked B),
what if we then define a procedure fmap that maps f to b?
p
F -----> B(F) = B
| |
| fmap |
f | -----> | b = fmap(f)
| |
| |
∨ ∨
F -----> B(F) = B
p
p
F -----> B(F) = B
| |
| fmap |
p | -----> | fmap(p)
| |
| |
∨ ∨
B -----> B(B) = B
fmap(p)
I'm not familiar with purely functional languages, but I guess we defined a functor this way?
Then we may be able to construct monad:
(define-type (Bitmap A) (Instance Bitmap%))
(define-type Painter (-> Frame (Bitmap Frame)))
(: fmap (case->
[-> (-> Frame Frame)
(-> (Bitmap Frame) (Bitmap Frame))]
[-> (-> Frame (Bitmap Frame))
(-> (Bitmap Frame) (Bitmap (Bitmap Frame)))]))
(define fmap #;TODO)
(: return Painter)
(define return (compose))
(: join (-> (Bitmap (Bitmap Frame)) (Bitmap Frame)))
(define join identity)
(: compose (-> Painter * Painter))
(define compose superpose)
(: bind (-> (Bitmap Frame) Painter (Bitmap Frame)))
(define bind (λ (bm p) (join ((fmap p) bm))))
