#|
   I have not tested this at all --ian
 




From: "john almon" <johnalmon@netzero.net>
To: <ian@rice.edu>
Subject: comp 210   --->    hw-11
Date: Sat, 17 Nov 2001 01:09:38 -0600

I starting thinking about the palette slider you mentioned in the homework for part 1, so I had to implement it.
 
Just me and the good ol' help desk...Execute the attached file to see...
 
Can my lab partner and I use this implentation for part 1 of Homework 11 ?
 
Please advise.
 
Thanks,
 
-John Almon
|#

(define min-sat 0)
(define max-sat 255)
(define num-rects 900)
(define rect-size 16)
(define rects-across 30)
(define rects-down (/ num-rects rects-across))
(define ex-horiz-space 0)
(define ex-vert-space 0)
(define p-width (+ ex-horiz-space (* rects-across rect-size)))
(define p-height (+ ex-vert-space (* rect-size (/ num-rects rects-across))))
(define no-pen (make-object pen% "BLACK" 1 'transparent)) 
(define no-brush (make-object brush% "BLACK" 'transparent)) 
 
 
(define (fori= start stop step accum body!)
  (cond [(>= start stop) (void)]
        [else (begin (body! start accum)
                     (fori= (+ step start) stop step accum body!))]))


(define p-frame (make-object frame% "Blue Palette" #f p-width p-height))
(define palette (make-object canvas% p-frame '(border)))
;(send palette init-auto-scrollbars p-width (* 3 p-height) 1.0 0.0)


(define (draw-recs a-slider a-symbol)
    (send dc set-pen no-pen)
    (letrec ((draw-my-recs (lambda (_) '(vscroll border)
            (fori= 0 (- p-height rect-size) rect-size _ 
                   (lambda (y _)
                     (fori= 0 (- p-width rect-size) rect-size y
                            (lambda (x y)
                              (send dc set-brush    
                                    (make-object brush%
                                      (make-color
                                       (round (* (/ y rect-size) (/ max-sat rects-down)))
                                       (round (* (/ x rect-size)(/ max-sat rects-across)))
                                       (send my-slider get-value)) 'solid)) 
                              (send dc draw-rectangle x y rect-size rect-size))))))))
         
   (draw-my-recs 'null)))


(define my-slider (make-object slider% #f min-sat max-sat p-frame draw-recs 0 '(horizontal)))

(define dc (send palette get-dc))



(send palette on-paint)
(send p-frame show #t) 
(sleep/yield 1)