suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use a new strategy for computing the baseline for the various beside functions

Browse Source 
Instead of just taking the maximum  value of any of the baselines in the
beside case, look for the largest difference between the bottom and
the baseline and take the location of that image's baseline as the combined
baseline. If the differences are equal, take the one that is furthest away
from the top

closes PR 14760
This commit is contained in:
Robby Findler 2014-10-03 15:48:54 -05:00
parent 36ff6d5dbb
commit 868140d91c
2 changed files with 36 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt
View File

@ -220,7 +220,8 @@
(car rst)
(if (< dx 0) 0 dx)
(if (< dy 0) 0 dy)
first-pinhole?)
first-pinhole?
#f)
(cdr rst)))])))
(define (find-x-spot x-place image)
@ -250,7 +251,8 @@
image2
(if (< dx 0) 0 dx)
(if (< dy 0) 0 dy)
#t))
#t
#f))
(define/chk (underlay/xy image dx dy image2)
(overlay/δ image2
@ -259,17 +261,27 @@
image
(if (< dx 0) (- dx) 0)
(if (< dy 0) (- dy) 0)
#f
#f))
(define (overlay/δ image1 dx1 dy1 image2 dx2 dy2 first-pinhole?)
(define (overlay/δ image1 dx1 dy1 image2 dx2 dy2 first-pinhole? beside-baseline?)
(make-image (make-overlay (make-translate dx1 dy1 (image-shape image1))
(make-translate dx2 dy2 (image-shape image2)))
(make-bb (max (+ (get-right image1) dx1)
(+ (get-right image2) dx2))
(max (+ (get-bottom image1) dy1)
(+ (get-bottom image2) dy2))
(max (+ (get-baseline image1) dy1)
(+ (get-baseline image2) dy2)))
(if beside-baseline?
(let ([δ1 (- (get-bottom image1) (get-baseline image1))]
[δ2 (- (get-bottom image2) (get-baseline image2))]
[b1 (+ (get-baseline image1) dy1)]
[b2 (+ (get-baseline image2) dy2)])
(cond
[(= δ1 δ2) (max b1 b2)]
[(< δ1 δ2) b2]
[else b1]))
(max (+ (get-baseline image1) dy1)
(+ (get-baseline image2) dy2))))
#f
(if first-pinhole?
(let ([ph (send image1 get-pinhole)])
@ -316,6 +328,7 @@
(car rst)
(get-right fst)
(if (< dy 0) 0 dy)
#t
#t)
(cdr rst)))])))
@ -354,7 +367,8 @@
(car rst)
(if (< dx 0) 0 dx)
(get-bottom fst)
#t)
#t
#f)
(cdr rst)))])))
(define/chk (overlay/offset image1 dx dy image2)
@ -382,7 +396,8 @@
snd
(if (< dx 0) 0 dx)
(if (< dy 0) 0 dy)
#t)))
#t
#f)))
;
@ -473,6 +488,7 @@
scene
(if (< dx 0) (- dx) 0)
(if (< dy 0) (- dy) 0)
#f
#f))))
(define/chk (scene+line image x1 y1 x2 y2 color)

13
pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt
View File

@ -1040,6 +1040,19 @@
=>
(text "ab" 18 "blue"))
(test (beside/align "bottom"
empty-image
(text "please?" 12 "green"))
=>
(text "please?" 12 "green"))
(test (beside/align "bottom"
(text "feed me " 18 "red")
(text "please?" 12 "green") empty-image)
=>
(beside/align "bottom"
(text "feed me " 18 "red")
(text "please?" 12 "green")))
;; make sure this doesn't crash (there was a bug that would be triggered by drawing these guys)
(test (equal? (scale 0.1 (text "Howdy!" 12 'black))
(scale 0.1 (text "Howdy!" 12 'red)))