jbclements/sliders.rkt

## sliders.rkt
(require 2htdp/universe)
(require 2htdp/image)

; Copyright 2012, John Clements (clements@brinckerhoff.org)
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
;  http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.

;; TO SHOW TO STUDENTS:
;; - LOCAL
;; - LIST SYNTAX
;; - ERRORS

;; demo of some sliders

;; DATA DEFINITIONS:

;; a world is
;; (make-ws list-of-components maybe-component boolean number number)
;; interp:
;;  - cs: the list of components in the world,
;;  - live: the posn of the component currently being dragged,
;;  - W : the width of the scene, and
;;  - H : the height of the scene
(define-struct ws (cs live W H))

;; a list-of-components is either
;; - empty, or
;; - (cons component list-of-components)

;; a component is (make-component vslider posn)
;; interp:
;; - s : the slider (currently, only sliders are allowed)
;; - posn : the location of the upper-left corner of the component
;;          within the global scene.
(define-struct component (s posn))

;; NOTE: the 'posn' structure is already defined.

;; a maybe-component is either
;; - false, or
;; - a posn
;; interp. false -> no slider is live,
;;  - posn, e.g. (make-posn 30 40) -> the component at 30,40 is live
;; NOTE: if two components have the same x and y, we're in big trouble.

;; a vslider is (make-vslider number number fraction)
;; interp:
;; - W : the width of the slider on the screen
;; - H : the height of the slider on the screen
;; - val : the fraction representing the position of
;;         the slider; 0 is at the bottom, 1 is at the top.
(define-struct vslider (W H val))

;; a fraction is a number between 0.0 and 1.0 inclusive

(define VSLIDER-HANDLE-H 40)
(define SLOT-OFFSET (/ VSLIDER-HANDLE-H 2))

;;;;;;;;;;;;
;;
;;  DRAWING
;;
;;;;;;;;;;;;

;; draw the world
;; world -> image
(define (draw-world ws)
  (place-components (ws-cs ws)
                    (empty-scene (ws-W ws) (ws-H ws))))


;; place-components : list-of-components scene -> scene
;; place all of the given components onto the scene
(define (place-components comps scene)
  (cond [(empty? comps) scene]
        [else (place-components
               (rest comps)
               (place-component (first comps)
                                scene))]))

;; place-component : component scene -> scene
;; place the image of the component onto the scene
;; (tested indirectly.)
(define (place-component c s)
  (place-image (draw-vslider (component-s c))
               (+ (posn-x (component-posn c)) (/ (component-width c) 2))
               (+ (posn-y (component-posn c)) (/ (component-height c) 2))
               s))


;; draw a vertical slider
;; slider -> image
(define (draw-vslider vs)
  (local
    [(define w (vslider-W vs))
     (define h (vslider-H vs))
     (define slot-len (- h (* 2 SLOT-OFFSET)))
     (define slider-pixels (- (+ slot-len SLOT-OFFSET)
                              (* slot-len (vslider-val vs))))]
    (place-image
     (overlay
      (text (number->string (min 99 (round (* (vslider-val vs) 100))))
            35
            "solid")
      (rectangle w VSLIDER-HANDLE-H "solid" (make-color #xE0 #xD0 #x90)))
     (/ w 2) slider-pixels
     (add-line (rectangle w h "solid" "white")
               (/ w 2) SLOT-OFFSET (/ w 2) (- h SLOT-OFFSET)
               (make-pen "black" 7 "solid" "round" "round")))))


;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  HANDLING MOUSE EVENTS
;;
;;;;;;;;;;;;;;;;;;;;;;;;;

;; handle a mouse event;
;; world number number string -> world
(define (meh ws x y event)
  ;; BUTTON-DOWN EVENT:
  (cond [(string=? event "button-down")
         (local
           [(define chosen-component (xy->component (ws-cs ws) x y))]
           ;; missed all components, leave the world state alone:
           (cond [(false? chosen-component) ws]
                 ;; hit one: turn it on:
                 [else
                  (make-ws (components-posn-update
                            (ws-cs ws)
                            chosen-component
                            y)
                           chosen-component
                           (ws-W ws)
                           (ws-H ws))]))]
        ;; BUTTON-UP EVENT:
        [(string=? event "button-up")
         ;; turn the live one off:
         (make-ws (ws-cs ws) #f (ws-W ws) (ws-H ws))]
        ;; OTHER EVENT:
        [else
         (cond [(false? (ws-live ws)) ws]
               [else
                ;; one of them is already live
                (make-ws (components-posn-update (ws-cs ws) (ws-live ws) y)
                         (ws-live ws)
                         (ws-W ws)
                         (ws-H ws))])]))


;; components-posn-update : list-of-components posn number
;; return a list of components with the chosen component updated
;; to the position indicated by the mouse
(define (components-posn-update comps live y)
  (cond [(empty? comps) (error 'components-posn-update
                               "no matching component")]
        [else (cond
                [(equal? (component-posn (first comps)) live)
                 ;; found it!
                 (cons (component-posn-update (first comps) y)
                       (rest comps))]
                [else ;; keep searching:
                 (cons (first comps)
                       (components-posn-update (rest comps) live y))])]))

;; component-posn-update : component number -> component
;; update the given component to reflect the y position of the mouse
;; (tested indirectly.)
(define (component-posn-update c y)
  (make-component
   (slider-posn-update (component-s c) (- y (posn-y (component-posn c))))
   (component-posn c)))

;; slider-posn-update: slider number -> slider
;; given a vertical slider and a Y mouse position relative to the
;; slider, update the slider accordingly
(define (slider-posn-update vs ypos)
  (local
    [(define range (- (vslider-H vs)
                      (* 2 SLOT-OFFSET)))
     (define capped (max SLOT-OFFSET
                         (min (- (vslider-H vs) SLOT-OFFSET)
                              ypos)))
     (define new-posn (- 1.0
                         (/ (- capped SLOT-OFFSET) range)))]
    (make-vslider (vslider-W vs) (vslider-H vs) new-posn)))

;; component-width : the width of the component
;; [tested indirectly]
(define (component-width c) (vslider-W (component-s c)))

;; component-height : the height of the component
;; [tested indirectly]
(define (component-height c) (vslider-H (component-s c)))

;; determine which component a mouse position is in
;; xy->component : number number -> maybe-component
(define (xy->component components x y)
  (cond [(empty? components) false]
        [else (local [(define fc (first components))]
                (cond [(in-bounding-box? fc x y)
                       (component-posn fc)]
                      [else (xy->component (rest components) x y)]))]))

;; in-bounding-box? : component pixels pixels -> boolean
;; determine whether an x and a y are in the bounding box of a
;; component.
(define (in-bounding-box? component x y)
  (local [(define p (component-posn component))]
  (and (<= (posn-x p) x (sub1 (+ (posn-x p)
                                 (component-width component))))
       (<= (posn-y p) y (sub1 (+ (posn-y p)
                                 (component-height component)))))))


;;;;;;;;;;;;;;;;
;;
;;   BIG BANG
;;
;;;;;;;;;;;;;;;;


(big-bang (make-ws (list
                    (make-component (make-vslider 50 400 0.2)
                                    (make-posn 50 30))
                    (make-component (make-vslider 50 400 0.2)
                                    (make-posn 105 30))
                    (make-component (make-vslider 50 400 0.2)
                                    (make-posn 160 30))
                    (make-component (make-vslider 50 400 0.2)
                                    (make-posn 215 30))
                    (make-component (make-vslider 50 400 0.2)
                                    (make-posn 270 30)))
                   #f
                   375 460)
          [on-mouse meh]
          [to-draw draw-world])


;*******
;
;   TEST CASES
;
;*******


(check-expect
 (draw-vslider
  (make-vslider 50 200 1.0))
 (place-image
  (overlay
   (text "99" 35 "black")
   (rectangle 100 40 "solid" (make-color #xE0 #xD0 #x90)))
  25 20
  (add-line (rectangle 50 200 "solid" "white")
            25 20 25 180
            (make-pen "black" 7 "solid" "round" "round"))))

(check-expect
 (draw-vslider
  (make-vslider 50 300 0.5))
 (place-image
  (overlay
   (text "50" 35 "black")
  (rectangle 100 40 "solid" (make-color #xE0 #xD0 #x90)))
  25 150
  (add-line (rectangle 50 300 "solid" "white")
            25 20 25 280
            (make-pen "black" 7 "solid" "round" "round"))))

(check-expect
 (slider-posn-update (make-vslider 50 540 0.2) 145)
 (make-vslider 50 540 3/4))

(check-expect
 (place-components
  (list (make-component (make-vslider 30 100 1/2) (make-posn 15 10))
        (make-component (make-vslider 40 80 3/4) (make-posn 45 5)))
  (empty-scene 400 500))
 (place-image (draw-vslider (make-vslider 40 80 3/4))
  65 45
  (place-image (draw-vslider (make-vslider 30 100 1/2))
               30 60
               (empty-scene 400 500))))

(check-expect
 (components-posn-update
  (list (make-component (make-vslider 30 100 1/2) (make-posn 15 10))
        (make-component (make-vslider 40 80 3/4) (make-posn 45 5)))
  (make-posn 45 5)
  0)
 (list (make-component (make-vslider 30 100 1/2) (make-posn 15 10))
        (make-component (make-vslider 40 80 1) (make-posn 45 5))))

(define test-component (make-component (make-vslider 30 40 1/2)
                                          (make-posn -50 16)))
(check-expect (in-bounding-box? test-component -51 16) #f)
(check-expect (in-bounding-box? test-component -50 15) #f)
(check-expect (in-bounding-box? test-component -50 16) #t)
(check-expect (in-bounding-box? test-component -21 16) #t)
(check-expect (in-bounding-box? test-component -20 16) #f)
(check-expect (in-bounding-box? test-component -21 55) #t)
(check-expect (in-bounding-box? test-component -21 56) #f)

(define example-components
  (list (make-component (make-vslider 100 150 0.1) (make-posn 30 40))
        (make-component (make-vslider 10 30 0.5) (make-posn 140 20))))

(check-expect (xy->component example-components 0 0) false)
(check-expect (xy->component example-components 30 40) (make-posn 30 40))
(check-expect (xy->component example-components 35 45) (make-posn 30 40))
(check-expect (xy->component example-components 130 45) false)
(check-expect (xy->component example-components 141 45) (make-posn 140 20))


(check-expect
 (draw-world (make-ws (list
                       (make-component (make-vslider 50 150 0.3)
                                       (make-posn 23 49)))
                      #t
                      500 300))
 (place-image (draw-vslider (make-vslider 50 150 0.3))
              (+ 23 25) (+ 49 75)
              (empty-scene 500 300)))


(check-expect
 (meh (make-ws (list (make-component (make-vslider 50 540 0.2)
                                     (make-posn 0 0)))
               (make-posn 0 0)
               50 540)
      100 145 "move")
 (make-ws (list (make-component (make-vslider 50 540 3/4)
                                (make-posn 0 0)))
          (make-posn 0 0)
          50 540))

;; ignored move:
(check-expect
 (meh (make-ws (list
                (make-component (make-vslider 50 540 1/5)
                                (make-posn 0 0)))
               #f
               50 540)
      100 145 "move")
 (make-ws (list
           (make-component (make-vslider 50 540 1/5) (make-posn 0 0)))
          #f
          50 540))


;; missed click:
(check-expect
 (meh (make-ws (list
                (make-component (make-vslider 50 540 1/5)
                                (make-posn 0 0)))
               #f
               50 540)
      100 145 "button-down")
 (make-ws (list
           (make-component (make-vslider 50 540 1/5)
                           (make-posn 0 0)))
          #f
          50 540))

;; hit click
(check-expect
 (meh (make-ws (list
                (make-component (make-vslider 50 540 1/5)
                                (make-posn 0 0)))
               #f
               50 540)
      40 145 "button-down")
 (make-ws  (list
            (make-component (make-vslider 50 540 3/4)
                            (make-posn 0 0)))
           (make-posn 0 0)
           50 540))


;; release:
(check-expect
 (meh (make-ws (list
                (make-component (make-vslider 50 540 1/5)
                                (make-posn 0 0))) #t
               50 540)
      100 145 "button-up")
 (make-ws (list (make-component (make-vslider 50 540 1/5)
                                (make-posn 0 0))) #f
           50 540))
	(require 2htdp/universe)
	(require 2htdp/image)

	; Copyright 2012, John Clements (clements@brinckerhoff.org)
	;
	; Licensed under the Apache License, Version 2.0 (the "License");
	; you may not use this file except in compliance with the License.
	; You may obtain a copy of the License at
	;
	; http://www.apache.org/licenses/LICENSE-2.0
	;
	; Unless required by applicable law or agreed to in writing, software
	; distributed under the License is distributed on an "AS IS" BASIS,
	; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	; See the License for the specific language governing permissions and
	; limitations under the License.

	;; TO SHOW TO STUDENTS:
	;; - LOCAL
	;; - LIST SYNTAX
	;; - ERRORS

	;; demo of some sliders

	;; DATA DEFINITIONS:

	;; a world is
	;; (make-ws list-of-components maybe-component boolean number number)
	;; interp:
	;; - cs: the list of components in the world,
	;; - live: the posn of the component currently being dragged,
	;; - W : the width of the scene, and
	;; - H : the height of the scene
	(define-struct ws (cs live W H))

	;; a list-of-components is either
	;; - empty, or
	;; - (cons component list-of-components)

	;; a component is (make-component vslider posn)
	;; interp:
	;; - s : the slider (currently, only sliders are allowed)
	;; - posn : the location of the upper-left corner of the component
	;; within the global scene.
	(define-struct component (s posn))

	;; NOTE: the 'posn' structure is already defined.

	;; a maybe-component is either
	;; - false, or
	;; - a posn
	;; interp. false -> no slider is live,
	;; - posn, e.g. (make-posn 30 40) -> the component at 30,40 is live
	;; NOTE: if two components have the same x and y, we're in big trouble.

	;; a vslider is (make-vslider number number fraction)
	;; interp:
	;; - W : the width of the slider on the screen
	;; - H : the height of the slider on the screen
	;; - val : the fraction representing the position of
	;; the slider; 0 is at the bottom, 1 is at the top.
	(define-struct vslider (W H val))

	;; a fraction is a number between 0.0 and 1.0 inclusive

	(define VSLIDER-HANDLE-H 40)
	(define SLOT-OFFSET (/ VSLIDER-HANDLE-H 2))

	;;;;;;;;;;;;
	;;
	;; DRAWING
	;;
	;;;;;;;;;;;;

	;; draw the world
	;; world -> image
	(define (draw-world ws)
	(place-components (ws-cs ws)
	(empty-scene (ws-W ws) (ws-H ws))))


	;; place-components : list-of-components scene -> scene
	;; place all of the given components onto the scene
	(define (place-components comps scene)
	(cond [(empty? comps) scene]
	[else (place-components
	(rest comps)
	(place-component (first comps)
	scene))]))

	;; place-component : component scene -> scene
	;; place the image of the component onto the scene
	;; (tested indirectly.)
	(define (place-component c s)
	(place-image (draw-vslider (component-s c))
	(+ (posn-x (component-posn c)) (/ (component-width c) 2))
	(+ (posn-y (component-posn c)) (/ (component-height c) 2))
	s))


	;; draw a vertical slider
	;; slider -> image
	(define (draw-vslider vs)
	(local
	[(define w (vslider-W vs))
	(define h (vslider-H vs))
	(define slot-len (- h (* 2 SLOT-OFFSET)))
	(define slider-pixels (- (+ slot-len SLOT-OFFSET)
	(* slot-len (vslider-val vs))))]
	(place-image
	(overlay
	(text (number->string (min 99 (round (* (vslider-val vs) 100))))
	35
	"solid")
	(rectangle w VSLIDER-HANDLE-H "solid" (make-color #xE0 #xD0 #x90)))
	(/ w 2) slider-pixels
	(add-line (rectangle w h "solid" "white")
	(/ w 2) SLOT-OFFSET (/ w 2) (- h SLOT-OFFSET)
	(make-pen "black" 7 "solid" "round" "round")))))


	;;;;;;;;;;;;;;;;;;;;;;;;;
	;;
	;; HANDLING MOUSE EVENTS
	;;
	;;;;;;;;;;;;;;;;;;;;;;;;;

	;; handle a mouse event;
	;; world number number string -> world
	(define (meh ws x y event)
	;; BUTTON-DOWN EVENT:
	(cond [(string=? event "button-down")
	(local
	[(define chosen-component (xy->component (ws-cs ws) x y))]
	;; missed all components, leave the world state alone:
	(cond [(false? chosen-component) ws]
	;; hit one: turn it on:
	[else
	(make-ws (components-posn-update
	(ws-cs ws)
	chosen-component
	y)
	chosen-component
	(ws-W ws)
	(ws-H ws))]))]
	;; BUTTON-UP EVENT:
	[(string=? event "button-up")
	;; turn the live one off:
	(make-ws (ws-cs ws) #f (ws-W ws) (ws-H ws))]
	;; OTHER EVENT:
	[else
	(cond [(false? (ws-live ws)) ws]
	[else
	;; one of them is already live
	(make-ws (components-posn-update (ws-cs ws) (ws-live ws) y)
	(ws-live ws)
	(ws-W ws)
	(ws-H ws))])]))


	;; components-posn-update : list-of-components posn number
	;; return a list of components with the chosen component updated
	;; to the position indicated by the mouse
	(define (components-posn-update comps live y)
	(cond [(empty? comps) (error 'components-posn-update
	"no matching component")]
	[else (cond
	[(equal? (component-posn (first comps)) live)
	;; found it!
	(cons (component-posn-update (first comps) y)
	(rest comps))]
	[else ;; keep searching:
	(cons (first comps)
	(components-posn-update (rest comps) live y))])]))

	;; component-posn-update : component number -> component
	;; update the given component to reflect the y position of the mouse
	;; (tested indirectly.)
	(define (component-posn-update c y)
	(make-component
	(slider-posn-update (component-s c) (- y (posn-y (component-posn c))))
	(component-posn c)))

	;; slider-posn-update: slider number -> slider
	;; given a vertical slider and a Y mouse position relative to the
	;; slider, update the slider accordingly
	(define (slider-posn-update vs ypos)
	(local
	[(define range (- (vslider-H vs)
	(* 2 SLOT-OFFSET)))
	(define capped (max SLOT-OFFSET
	(min (- (vslider-H vs) SLOT-OFFSET)
	ypos)))
	(define new-posn (- 1.0
	(/ (- capped SLOT-OFFSET) range)))]
	(make-vslider (vslider-W vs) (vslider-H vs) new-posn)))

	;; component-width : the width of the component
	;; [tested indirectly]
	(define (component-width c) (vslider-W (component-s c)))

	;; component-height : the height of the component
	;; [tested indirectly]
	(define (component-height c) (vslider-H (component-s c)))

	;; determine which component a mouse position is in
	;; xy->component : number number -> maybe-component
	(define (xy->component components x y)
	(cond [(empty? components) false]
	[else (local [(define fc (first components))]
	(cond [(in-bounding-box? fc x y)
	(component-posn fc)]
	[else (xy->component (rest components) x y)]))]))

	;; in-bounding-box? : component pixels pixels -> boolean
	;; determine whether an x and a y are in the bounding box of a
	;; component.
	(define (in-bounding-box? component x y)
	(local [(define p (component-posn component))]
	(and (<= (posn-x p) x (sub1 (+ (posn-x p)
	(component-width component))))
	(<= (posn-y p) y (sub1 (+ (posn-y p)
	(component-height component)))))))


	;;;;;;;;;;;;;;;;
	;;
	;; BIG BANG
	;;
	;;;;;;;;;;;;;;;;




	(big-bang (make-ws (list
	(make-component (make-vslider 50 400 0.2)
	(make-posn 50 30))
	(make-component (make-vslider 50 400 0.2)
	(make-posn 105 30))
	(make-component (make-vslider 50 400 0.2)
	(make-posn 160 30))
	(make-component (make-vslider 50 400 0.2)
	(make-posn 215 30))
	(make-component (make-vslider 50 400 0.2)
	(make-posn 270 30)))
	#f
	375 460)
	[on-mouse meh]
	[to-draw draw-world])



	;*******
	;
	; TEST CASES
	;
	;*******


	(check-expect
	(draw-vslider
	(make-vslider 50 200 1.0))
	(place-image
	(overlay
	(text "99" 35 "black")
	(rectangle 100 40 "solid" (make-color #xE0 #xD0 #x90)))
	25 20
	(add-line (rectangle 50 200 "solid" "white")
	25 20 25 180
	(make-pen "black" 7 "solid" "round" "round"))))

	(check-expect
	(draw-vslider
	(make-vslider 50 300 0.5))
	(place-image
	(overlay
	(text "50" 35 "black")
	(rectangle 100 40 "solid" (make-color #xE0 #xD0 #x90)))
	25 150
	(add-line (rectangle 50 300 "solid" "white")
	25 20 25 280
	(make-pen "black" 7 "solid" "round" "round"))))

	(check-expect
	(slider-posn-update (make-vslider 50 540 0.2) 145)
	(make-vslider 50 540 3/4))

	(check-expect
	(place-components
	(list (make-component (make-vslider 30 100 1/2) (make-posn 15 10))
	(make-component (make-vslider 40 80 3/4) (make-posn 45 5)))
	(empty-scene 400 500))
	(place-image (draw-vslider (make-vslider 40 80 3/4))
	65 45
	(place-image (draw-vslider (make-vslider 30 100 1/2))
	30 60
	(empty-scene 400 500))))

	(check-expect
	(components-posn-update
	(list (make-component (make-vslider 30 100 1/2) (make-posn 15 10))
	(make-component (make-vslider 40 80 3/4) (make-posn 45 5)))
	(make-posn 45 5)
	0)
	(list (make-component (make-vslider 30 100 1/2) (make-posn 15 10))
	(make-component (make-vslider 40 80 1) (make-posn 45 5))))

	(define test-component (make-component (make-vslider 30 40 1/2)
	(make-posn -50 16)))
	(check-expect (in-bounding-box? test-component -51 16) #f)
	(check-expect (in-bounding-box? test-component -50 15) #f)
	(check-expect (in-bounding-box? test-component -50 16) #t)
	(check-expect (in-bounding-box? test-component -21 16) #t)
	(check-expect (in-bounding-box? test-component -20 16) #f)
	(check-expect (in-bounding-box? test-component -21 55) #t)
	(check-expect (in-bounding-box? test-component -21 56) #f)

	(define example-components
	(list (make-component (make-vslider 100 150 0.1) (make-posn 30 40))
	(make-component (make-vslider 10 30 0.5) (make-posn 140 20))))

	(check-expect (xy->component example-components 0 0) false)
	(check-expect (xy->component example-components 30 40) (make-posn 30 40))
	(check-expect (xy->component example-components 35 45) (make-posn 30 40))
	(check-expect (xy->component example-components 130 45) false)
	(check-expect (xy->component example-components 141 45) (make-posn 140 20))



	(check-expect
	(draw-world (make-ws (list
	(make-component (make-vslider 50 150 0.3)
	(make-posn 23 49)))
	#t
	500 300))
	(place-image (draw-vslider (make-vslider 50 150 0.3))
	(+ 23 25) (+ 49 75)
	(empty-scene 500 300)))


	(check-expect
	(meh (make-ws (list (make-component (make-vslider 50 540 0.2)
	(make-posn 0 0)))
	(make-posn 0 0)
	50 540)
	100 145 "move")
	(make-ws (list (make-component (make-vslider 50 540 3/4)
	(make-posn 0 0)))
	(make-posn 0 0)
	50 540))

	;; ignored move:
	(check-expect
	(meh (make-ws (list
	(make-component (make-vslider 50 540 1/5)
	(make-posn 0 0)))
	#f
	50 540)
	100 145 "move")
	(make-ws (list
	(make-component (make-vslider 50 540 1/5) (make-posn 0 0)))
	#f
	50 540))



	;; missed click:
	(check-expect
	(meh (make-ws (list
	(make-component (make-vslider 50 540 1/5)
	(make-posn 0 0)))
	#f
	50 540)
	100 145 "button-down")
	(make-ws (list
	(make-component (make-vslider 50 540 1/5)
	(make-posn 0 0)))
	#f
	50 540))

	;; hit click
	(check-expect
	(meh (make-ws (list
	(make-component (make-vslider 50 540 1/5)
	(make-posn 0 0)))
	#f
	50 540)
	40 145 "button-down")
	(make-ws (list
	(make-component (make-vslider 50 540 3/4)
	(make-posn 0 0)))
	(make-posn 0 0)
	50 540))


	;; release:
	(check-expect
	(meh (make-ws (list
	(make-component (make-vslider 50 540 1/5)
	(make-posn 0 0))) #t
	50 540)
	100 145 "button-up")
	(make-ws (list (make-component (make-vslider 50 540 1/5)
	(make-posn 0 0))) #f
	50 540))