#lang racket #| To use this file, make sure it's in the same directory as your program, and use `(require "videogame-helpers.rkt")` and then your program can use the one exported identifiers, like `house-with-flowers` or `overlap?`. NOTE: You can either download this file (save-to-disk), OR you can copy-paste it into DrRacket AND make sure that window's Language > Choose Language... > The Racket Language. ...If you're getting an error "#lang not defined", it's probably because you pasted the full-racket code into a blank DrRacket window whose language was set to a student-language. Just do the Choose Language to full racket, and save the file, and then it should be good. |# (provide house-with-flowers ; a sample image (not too large -- 250px x 180px) overlap? ; do two rectangles overlap? sawtooth ; ellipse/arc ; make the arc of an ellipse; see also `wedge` in 2htdp/image for a circular version deg->rad ; convert degrees to radians (not commonly needed in this course) rad->deg ; convert radians to degrees (even less commonly needed, for us) ) (require 2htdp/image) (require (prefix-in gui: racket/gui)) (module+ test (require rackunit)) ; overlap? : real,real,real,real, real,real,real,real -> boolean ; Does one rectangle overlap another? ; We represent a rectangle as four reals: the center x,y, width, height. ; (The units can be considered pixels, although it doesn't actually matter ; so long as they're all in the *same* units, of course.) ; ; For barely-touching rectangles, we use the rather odd convention that ; a rectangle is closed along its top and left sides, but open on its ; bottom and right. ; (This way, the squares (i,j,1,1) perfectly tile the plane, for i,j in N.) ; ; A line is a 0-width rectangle, and it can overlap other rectangles/lines. ; (This is a slightly non-standard(?) interpretation of half-open of width 0; ; usually that'd be the empty set, ; since there are no points x which satisfy the constraints a <= x < a. ; But that'd mean an empty-rectangle could never overlap another, and ; we wouldn't get lines.) ; (define (overlap? x1 y1 w1 h1 x2 y2 w2 h2) ; Check dist-btwn-centers, in each dimension: (and (overlap-1d? x1 w1 x2 w2) (overlap-1d? y1 h1 y2 h2))) ; overlap-1d? : real? real? real? real? -> boolean ; Given the centers (x1,x2) and widths (w1,w2) of two half open intervals, ; do they overlap? (define (overlap-1d? x1 w1 x2 w2) (or (< (abs (- x1 x2)) (/ (+ w1 w2) 2)) ; two intervals overlap if the centers are closer than the sum of the 2 radii. ; Use strictly-< to capture open intervals. ; For half-open, the case that the above formula doesn't work for is ; one (or both) of the rectangles being 0-width. So check for the 0-width ; being on the left(closed) side: (= x1 (- x2 (/ w2 2))) ; r1=0 and x1 was on left edge of interval-2 (= x2 (- x1 (/ w1 2))) ; r2=0 and x2 was on left edge of interval-1 )) ; If I had `let*`, I might have written: #;(let* {[r1 (/ w1 2)] ; the radius of the first interval [r2 (/ w2 2)]} ...) (module+ test (check-equal? (overlap-1d? 5 30 10 40) #true) (check-equal? (overlap-1d? 5 2 10 2) #false) ; entirely separate (check-equal? (overlap-1d? 5 100 4 6) #true) (check-equal? (overlap-1d? 5 10 4 6) #true) (check-equal? (overlap-1d? 5 6 10 4) #false) ; borderline / tiling [2,8) [8,10) (check-equal? (overlap-1d? 5 6 0 4) #false) (check-equal? (overlap-1d? 5 0 7 1) #false) (check-equal? (overlap-1d? 5 0 7 5) #true) (check-equal? (overlap-1d? 5 0 7 4) #true) ; 0-width at left edge of another rect (check-equal? (overlap-1d? 5 4 7 0) #false) ; 0-width at right edge of another rect ; these checks are redundant after re-factoring into `overlap-1d?`, ; but hey no reason to remove them: (check-equal? (overlap? 5 5 10 10 6 6 2 2) #true) (check-equal? (overlap? 5 5 10 10 15 6 20 2) #true) (check-equal? (overlap? 5 5 10 10 6 15 2 20) #true) (check-equal? (overlap? 5 5 10 10 15 15 20 20) #true) (check-equal? (overlap? 5 5 10 10 16 16 2 2) #false) (check-equal? (overlap? 5 5 10 10 25 25 20 20) #false) (check-equal? (overlap? 5 5 10 10 -4 -4 2 2) #false) (check-equal? (overlap? 5 5 10 10 -10 -10 20 20) #false) (check-equal? (overlap? 5 5 10 10 5 15 10 10) #false) (check-equal? (overlap? 5 5 10 10 -10 -10 20 20) #false) (check-equal? (overlap? -10 -10 20 20 5 5 10 10) #false) (check-equal? (overlap? 5 5 10 10 5 5 0 8) #true) ; a 0-width rectangle inside a "fat" rectangle (check-equal? (overlap? 0 0 0 10 0 0 0 5) #true) ; two line-segments 0-width rect) overlapping ) #| Detecting overlapping intervals is a bit not-perfectly-elegant. Either: - use closed intervals, but then tiling is bad but the formula is easy/consistent. - use half-open intervals, but then 0-width intervals aren't handled properly w/o extra tweaks. - use half-open intervals but consider 0-width as a line: formula would still needs tweaks, and tiling isn't quite right, but at least we can represent line segments |# ; sawtooth : integer?, (and/c integer? positive?) -> real? ; Return a number between 0 and 1. ; As x increases, it's a rising-then-falling pattern: /\/\/\/\... ; with a period of 2 * `period/2`. ; (bug: this should allow real inputs, not just integer.) ; (define (sawtooth x period/2) (/ (abs (- (modulo (- x period/2) (* 2 period/2)) period/2)) period/2)) (module+ test (check-equal? (sawtooth 0 100) 0/100) (check-equal? (sawtooth 1 100) 1/100) (check-equal? (sawtooth 2 100) 2/100) (check-equal? (sawtooth 99 100) 99/100) (check-equal? (sawtooth 100 100) 100/100) (check-equal? (sawtooth 101 100) 99/100) (check-equal? (sawtooth 102 100) 98/100) (check-equal? (sawtooth 198 100) 2/100) (check-equal? (sawtooth 199 100) 1/100) (check-equal? (sawtooth 200 100) 0/100) (check-equal? (sawtooth 201 100) 1/100) (check-equal? (sawtooth 299 100) 99/100) (check-equal? (sawtooth 300 100) 100/100) (check-equal? (sawtooth 301 100) 99/100) (check-equal? (sawtooth 399 100) 1/100) (check-equal? (sawtooth 400 100) 0/100) (check-equal? (sawtooth 401 100) 1/100) ) (define house-image (above (triangle 60 'solid 'saddleBrown) (square 60 'solid 'darkGoldenRod))) ; one ellipse will serve as two petals: (define petals2 (ellipse 50 10 200 'MediumSeaGreen)) ; make-blossom: natnum -> image ; Return a flower-center, with 2*n petals. ; (define (make-blossom n) (make-blossom-help n n)) ; make-blossom-help: natnum, natnum -> image ; Return a flower with 2*i petals, out of 2*n total. ; (define (make-blossom-help i n) (cond [(zero? i) empty-image] [(positive? i) (overlay (rotate (* i (/ 360 n 2)) petals2) (make-blossom-help (sub1 i) n))])) (define the-blossom (make-blossom 7)) ; Add the stem, whose height is the same as the blossom: (define flower (overlay/offset the-blossom 0 (/ (image-height the-blossom) 2) (line 0 (image-height the-blossom) 'black))) (define house-with-flowers (place-image (circle 30 'solid 'yellow) 250 0 ; house+flowers, enclosed in a scene: (overlay/align 'middle 'bottom (beside/align 'bottom flower flower house-image flower) (empty-scene 250 180)))) ;(save-svg-image house-with-flowers "house-with-flowers.svg") ; ellipse/arc : ; Meant to complement `ellipse` from (lib 2htdp/image). ; Return the arc of an ellipse, from θ1 to θ2 (in degrees); 0 is 3o'clock, 90 is noon. ; NOTE: `wedge` is provided in 2htdp/image, which makes *circular* arcs. ; ; Report bugs to ibarland@radford.edu ; BUG: the bounding box of the image is w x h, instead of its drawable size. ; (But maybe this isn't a bug; that would put the "center" in a hard-to-predict place, ; for other overlay operations.) ; (define/contract (ellipse/arc w h θ1 θ2 mode color) (-> (and/c real? (not/c negative?)) (and/c real? (not/c negative?)) ; w,h real? real? ; θ1 θ2 (or/c "transparent" 'transparent 'solid "solid" natural-number/c) ; mode (or/c string? symbol?) ; color image?) ; (return-type) (define img (gui:make-bitmap w h)) (define img-dc (new gui:bitmap-dc% [bitmap img])) (define color-str (if (symbol? color) (symbol->string color) color)) (define the-color (make-object gui:color% color-str)) (define mode-sym (if (string? mode) ((compose string->symbol string-downcase) mode) mode-sym)) (define mode-sym-num (if (eq? mode-sym 'solid) 255 mode-sym)) ; any number represents a (faded) solid ; Now, set the brush or pen, depending on whether we are outline or solid: ; (cond [(eq? mode-sym-num 'outline) (send img-dc set-brush the-color 'transparent) (send img-dc set-pen the-color 0 'solid)] [(natural-number/c mode-sym-num) (define faded-color (make-color (send the-color red) (send the-color green) (send the-color blue) (/ mode-sym-num 255))) (send img-dc set-brush faded-color 'solid) (send img-dc set-pen faded-color 0 'transparent)] [else (raise-type-error 'ellipse/arc "(or/c 'solid 'outline (in-range 256))" mode)]) ; Finally, call the underling 'draw-arc', and turn the result into a snip: (send img-dc draw-arc 0 0 w h (deg->rad θ1) (deg->rad θ2)) (make-object gui:image-snip% img)) ; deg->rad : real -> real ; rad->deg : real -> real ; Convert an angle in degrees, to radians. ; (define (deg->rad θ) (* θ RAD-PER-DEG)) (define (rad->deg θ) (/ θ RAD-PER-DEG)) (define RAD-PER-DEG (/ 1 (/ 360 2 pi))) (module+ test (define tol 0.00000001) (check-= (deg->rad 180) pi tol) (check-= (deg->rad 90) (* pi 1/2) tol) (check-= (deg->rad 60) (* pi 1/3) tol) (check-= (deg->rad -180) (- pi) tol) (check-= (deg->rad 360) (* 2 pi) tol) (check-= (deg->rad 720) (* 4 pi) tol) (check-= (rad->deg pi) 180 tol) (check-= (rad->deg (* pi 1/2)) 90 tol) (check-= (rad->deg (* pi 1/3)) 60 tol) (check-= (rad->deg (- pi)) -180 tol) (check-= (rad->deg (* 2 pi)) 360 tol) (check-= (rad->deg (* 4 pi)) 720 tol) (define target (gui:make-bitmap 300 100)) (define the-dc (new gui:bitmap-dc% [bitmap target])) (send the-dc set-pen "orange" 0 'transparent) (send the-dc set-brush "orange" 'solid) (send the-dc draw-arc 0 0 200 100 0 pi) (define img (make-object gui:image-snip% target)) (require (only-in 2htdp/image frame scale image-width)) ;(frame (make-object image-snip% target)) (define k 100000) (define tiny (scale (/ 1 k) img)) (define again (scale k tiny)) ; img ;(image=? img (ellipse/arc 200 100 0 180 "solid" "orange")) ) #| @author ibarland @version 2013-Sep-13 @license CC-BY -- share/adapt this file freely, but include attribution, thx. https://creativecommons.org/licenses/by/4.0/ https://creativecommons.org/licenses/by/4.0/legalcode Including a link to the *original* file satisifies "appropriate attribution". |#