rendered paste body(define-struct decbox (pt dx dy colormain colorstripes colorinside))
;; pt : posn
;; dx : num
;; dy : num
;; colormain : symbol
;; colorstripes : symbol
;; colorinside : symbol
;; Some settings, here for practical reasons.
(define WINDOWW 700)
(define WINDOWH 500)
(define BACKGROUND 'firebrick)
(define SLEEPTIME .05)
;; A list of all the colors!
(define COLORS (list 'OrangeRed 'Tomato 'DarkRed 'Red 'Firebrick 'Crimson 'DeepPink 'Maroon 'IndianRed 'MediumVioletRed 'VioletRed 'LightCoral 'HotPink 'PaleVioletRed 'LightPink 'RosyBrown 'Pink 'Orchid 'LavenderBlush 'Snow 'Chocolate 'SaddleBrown 'Brown 'DarkOrange 'Coral 'Sienna 'Orange 'Salmon 'Peru 'DarkGoldenrod 'Goldenrod 'SandyBrown 'LightSalmon 'DarkSalmon 'Gold 'Yellow 'Olive 'Burlywood 'Tan 'NavajoWhite 'PeachPuff 'Khaki 'DarkKhaki 'Moccasin 'Wheat 'Bisque 'PaleGoldenrod 'BlanchedAlmond 'MediumGoldenrod 'PapayaWhip 'MistyRose 'LemonChiffon 'AntiqueWhite 'Cornsilk 'LightGoldenrodYellow 'OldLace 'Linen 'LightYellow 'SeaShell 'Beige 'FloralWhite 'Ivory 'Green 'LawnGreen 'Chartreuse 'GreenYellow 'YellowGreen 'OliveDrab 'MediumForestGreen 'DarkOliveGreen 'DarkSeaGreen 'Lime 'DarkGreen 'LimeGreen 'ForestGreen 'SpringGreen 'MediumSpringGreen 'SeaGreen 'MediumSeaGreen 'Aquamarine 'LightGreen 'PaleGreen 'MediumAquamarine 'Turquoise 'LightSeaGreen 'MediumTurquoise 'Honeydew 'MintCream 'RoyalBlue 'DodgerBlue 'DeepSkyBlue 'CornflowerBlue 'SteelBlue 'LightSkyBlue 'DarkTurquoise 'Cyan 'Aqua 'DarkCyan 'Teal 'SkyBlue 'CadetBlue 'DarkSlateGray 'LightSlateGray 'SlateGray 'LightSteelBlue 'LightBlue 'PowderBlue 'PaleTurquoise 'LightCyan 'AliceBlue 'Azure 'MediumBlue 'DarkBlue 'MidnightBlue 'Navy 'Blue 'Indigo 'BlueViolet 'MediumSlateBlue 'SlateBlue 'Purple 'DarkSlateBlue 'DarkViolet 'DarkOrchid 'MediumPurple 'MediumOrchid 'Magenta 'Fuchsia 'DarkMagenta 'Violet 'Plum 'Lavender 'Thistle 'GhostWhite 'White 'WhiteSmoke 'Gainsboro 'LightGray 'Silver 'Gray 'DarkGray 'DimGray 'Black))
;; random-item : list -> any
;; returns a random item from a list
(define (random-item alist)
; ...(first alist)...
; ...(rest alist)...
; ...(empty? alist)...
(list-ref alist (random (length alist))))
;; rand-decbox : posn -> decbox
;; make a randomly colored decbox, at the given posn.
(define (rand-decbox aposn)
; ...(posn-x aposn)...
; ...(posn-y aposn)...
(make-decbox aposn (+ (random 5) 1) (+ (random 5) 1) (random-item COLORS) (random-item COLORS) (random-item COLORS)))
;; draw-decbox : decbox -> true
;; Draw a decorated box.
(define (draw-decbox adecbox)
; ...(decbox-pt adecbox)...
; ...(decbox-dx adecbox)...
; ...(decbox-dy adecbox)...
; ...(decbox-colormain adecbox)...
; ...(decbox-colorstripes adecbox)...
; ...(decbox-colorinside adecbox)...
; ...(posn-x (decbox-pt adecbox))...
; ...(posn-y (decbox-pt adecbox))...
(and (draw-solid-rect (decbox-pt adecbox) 100 100
(decbox-colormain adecbox))
(draw-solid-rect (make-posn (+ (posn-x (decbox-pt adecbox)) 25) (posn-y (decbox-pt adecbox))) 50 100
(decbox-colorstripes adecbox))
(draw-solid-rect (make-posn (posn-x (decbox-pt adecbox)) (+ (posn-y (decbox-pt adecbox)) 25)) 100 50
(decbox-colorstripes adecbox))
(draw-solid-rect (make-posn (+ (posn-x (decbox-pt adecbox)) 25) (+ (posn-y (decbox-pt adecbox)) 25)) 50 50
(decbox-colorinside adecbox))))
;; clear-decbox : decbox -> true
;; Clear a decbox, filling the background color!
(define (clear-decbox adecbox)
; ...(decbox-pt adecbox)...
; ...(decbox-dx adecbox)...
; ...(decbox-dy adecbox)...
; ...(decbox-colormain adecbox)...
; ...(decbox-colorstripes adecbox)...
; ...(decbox-colorinside adecbox)...
; ...(posn-x (decbox-pt adecbox))...
; ...(posn-y (decbox-pt adecbox))...
(draw-solid-rect (decbox-pt adecbox) 100 100 BACKGROUND))
;; update-decbox : decbox -> decbox
;; Update a decbox.
(define (update-decbox adecbox)
; ...(decbox-pt adecbox)...
; ...(decbox-dx adecbox)...
; ...(decbox-dy adecbox)...
; ...(decbox-colormain adecbox)...
; ...(decbox-colorstripes adecbox)...
; ...(decbox-colorinside adecbox)...
; ...(posn-x (decbox-pt adecbox))...
; ...(posn-y (decbox-pt adecbox))...
(make-decbox (decbox-newposn adecbox) (decbox-bouncex adecbox) (decbox-bouncey adecbox)
(decbox-colormain adecbox) (decbox-colorstripes adecbox) (decbox-colorinside adecbox)))
;; decbox-newposn : decbox -> posn
;; Find the new posn of a decbox.
(define (decbox-newposn adecbox)
; ...(decbox-pt adecbox)...
; ...(decbox-dx adecbox)...
; ...(decbox-dy adecbox)...
; ...(decbox-colormain adecbox)...
; ...(decbox-colorstripes adecbox)...
; ...(decbox-colorinside adecbox)...
; ...(posn-x (decbox-pt adecbox))...
; ...(posn-y (decbox-pt adecbox))...
(make-posn (+ (posn-x (decbox-pt adecbox)) (decbox-bouncex adecbox)) (+ (posn-y (decbox-pt adecbox)) (decbox-bouncey adecbox))))
;; decbox-bouncex : decbox -> num
;; Find the new dx by bounceing
(define (decbox-bouncex adecbox)
; ...(decbox-pt adecbox)...
; ...(decbox-dx adecbox)...
; ...(decbox-dy adecbox)...
; ...(decbox-colormain adecbox)...
; ...(decbox-colorstripes adecbox)...
; ...(decbox-colorinside adecbox)...
; ...(posn-x (decbox-pt adecbox))...
; ...(posn-y (decbox-pt adecbox))...
(cond [(or (<= (posn-x (decbox-pt adecbox)) 0) (>= (+ 100(posn-x (decbox-pt adecbox))) WINDOWW)) (* -1 (decbox-dx adecbox))]
[else (decbox-dx adecbox)]))
;; decbox-bouncey : decbox -> num
;; Find the new dy by bounceing
(define (decbox-bouncey adecbox)
; ...(decbox-pt adecbox)...
; ...(decbox-dx adecbox)...
; ...(decbox-dy adecbox)...
; ...(decbox-colormain adecbox)...
; ...(decbox-colorstripes adecbox)...
; ...(decbox-colorinside adecbox)...
; ...(posn-x (decbox-pt adecbox))...
; ...(posn-y (decbox-pt adecbox))...
(cond [(or (<= (posn-y (decbox-pt adecbox)) 0) (>= (+ 100 (posn-y (decbox-pt adecbox))) WINDOWH)) (* -1 (decbox-dy adecbox))]
[else (decbox-dy adecbox)]))
;; move-decbox : decbox -> true
;; Move a decbox around. Shouldn't ever return.
(define (move-decbox adecbox)
; ...(decbox-pt adecbox)...
; ...(decbox-dx adecbox)...
; ...(decbox-dy adecbox)...
; ...(decbox-colormain adecbox)...
; ...(decbox-colorstripes adecbox)...
; ...(decbox-colorinside adecbox)...
; ...(posn-x (decbox-pt adecbox))...
; ...(posn-y (decbox-pt adecbox))...
(and (draw-decbox adecbox) (sleep-for-a-while SLEEPTIME) (clear-decbox adecbox) (move-decbox (update-decbox adecbox))))
;; gogogadget : posn -> true
;; Make the whole thing go!
(define (gogogadget aposn)
(and (start WINDOWW WINDOWH) (draw-solid-rect (make-posn 0 0) WINDOWW WINDOWH BACKGROUND) (move-decbox (rand-decbox aposn))))
(gogogadget (make-posn 1 1))