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

...

Browse Source 
original commit: 0b70f95730e2205588029a12db68dbf959787411
This commit is contained in:
Robby Findler 2000-06-16 20:33:33 +00:00
parent f073367576
commit 78f2e9985e
1 changed files with 40 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
collects/framework/text.ss
View File

@ -69,45 +69,46 @@
(loop this-left
this-right
(cdr canvases))))]))])
(let loop ([left #f]
[top #f]
[right #f]
[bottom #f]
[rectangles rectangles])
(cond
[(null? rectangles)
(when left
(let ([width (- right left)]
[height (- bottom top)])
(when (and (> width 0)
(> height 0))
(invalidate-bitmap-cache left top width height))))]
[else (let* ([r (car rectangles)]
[rleft (rectangle-left r)]
[rright (rectangle-right r)]
[rtop (rectangle-top r)]
[rbottom (rectangle-bottom r)]
[this-left (if (number? rleft)
rleft
min-left)]
[this-right (if (number? rright)
rright
max-right)]
[this-bottom rbottom]
[this-top rtop])
(if (and left top right bottom)
(loop (min this-left left)
(min this-top top)
(max this-right right)
(max this-bottom bottom)
(cdr rectangles))
(loop this-left
this-top
this-right
this-bottom
(cdr rectangles))))]))))]
(when (and min-left max-right)
(let loop ([left #f]
[top #f]
[right #f]
[bottom #f]
[rectangles rectangles])
(cond
[(null? rectangles)
(when left
(let ([width (- right left)]
[height (- bottom top)])
(when (and (> width 0)
(> height 0))
(invalidate-bitmap-cache left top width height))))]
[else (let* ([r (car rectangles)]
[rleft (rectangle-left r)]
[rright (rectangle-right r)]
[rtop (rectangle-top r)]
[rbottom (rectangle-bottom r)]
[this-left (if (number? rleft)
rleft
min-left)]
[this-right (if (number? rright)
rright
max-right)]
[this-bottom rbottom]
[this-top rtop])
(if (and left top right bottom)
(loop (min this-left left)
(min this-top top)
(max this-right right)
(max this-bottom bottom)
(cdr rectangles))
(loop this-left
this-top
this-right
this-bottom
(cdr rectangles))))])))))]
[recompute-range-rectangles
(lambda ()