From 868140d91ce3bde73dad74c8bd245d47dd7597e3 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 3 Oct 2014 15:48:54 -0500 Subject: [PATCH] use a new strategy for computing the baseline for the various beside functions 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 --- .../htdp-lib/2htdp/private/image-more.rkt | 30 ++++++++++++++----- .../htdp-test/2htdp/tests/test-image.rkt | 13 ++++++++ 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt index 086a677c6e..0342369272 100644 --- a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt @@ -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) diff --git a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt index 9fbc7daff2..e417c48948 100644 --- a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt +++ b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt @@ -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)))