made scaling work with pinholes

This commit is contained in:
Robby Findler 2010-09-06 06:24:44 -05:00
parent 986b36d761
commit e3b51e8cf4
3 changed files with 16 additions and 10 deletions

View File

@ -104,11 +104,15 @@
(scale-internal x-factor y-factor image))
(define (scale-internal x-factor y-factor image)
(make-image (make-scale x-factor y-factor (image-shape image))
(make-bb (* x-factor (get-right image))
(* y-factor (get-bottom image))
(* y-factor (get-baseline image)))
#f))
(let ([ph (send image get-pinhole)])
(make-image (make-scale x-factor y-factor (image-shape image))
(make-bb (* x-factor (get-right image))
(* y-factor (get-bottom image))
(* y-factor (get-baseline image)))
#f
(and ph
(make-point (* x-factor (point-x ph))
(* y-factor (point-y ph)))))))
;; overlay : image image image ... -> image
;; places images on top of each other with their upper left corners aligned.

View File

@ -1594,6 +1594,13 @@
(test (pinhole-x (clear-pinhole (rectangle 10 24 'solid 'blue))) => #f)
(test (pinhole-y (clear-pinhole (rectangle 10 24 'solid 'blue))) => #f)
(test (pinhole-x (scale 11 (center-pinhole (rectangle 10 24 'solid 'blue))))
=>
55)
(test (pinhole-y (scale 11 (center-pinhole (rectangle 10 24 'solid 'blue))))
=>
132)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; test errors.

View File

@ -1,10 +1,5 @@
#lang racket/base
;; changed:
;; - simple-shape
;; - np-atomic-shape
;; - atomic-shape
#|
This library is the part of the 2htdp/image