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

stop doing slow computation whose results were useless

Browse Source 
also, clean up drawing of 'insert large letters' dialog
so that you don't see a little white sliver when there are
no characters typed
This commit is contained in:
Robby Findler 2014-08-09 23:14:44 -05:00
parent 13316f1df9
commit 6b563a89c8
2 changed files with 6 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/drracket-pkgs/drracket/drracket/private/bitmap-message.rkt
View File

@ -13,8 +13,8 @@
(send dc draw-bitmap bm 0 0))))
(define/public (set-bm b)
(set! bm b)
(min-width (send bm get-width))
(min-height (send bm get-height))
(min-width (if bm (send bm get-width) 0))
(min-height (if bm (send bm get-height) 0))
(refresh))
(super-new (stretchable-width #f)
(stretchable-height #f)

14
pkgs/drracket-pkgs/drracket/drracket/private/insert-large-letters.rkt
View File

@ -11,7 +11,7 @@
(define-type Bitmap-Message%
(Class (init [parent (Instance Horizontal-Panel%)])
[set-bm ((Instance Bitmap%) -> Void)]))
[set-bm ((U (Instance Bitmap%) #f) -> Void)]))
(require/typed "bitmap-message.rkt"
[bitmap-message% Bitmap-Message%])
@ -68,8 +68,7 @@
(new choice%
[label (string-constant fonts)]
[parent info-bar]
[choices (map (λ: ((x : String)) (format "~a~a" x (get-w-size tmp-bdc x)))
(get-face-list))]
[choices (get-face-list)]
[callback
(λ: ([x : Any] [y : Any])
(let ([old (preferences:get 'drracket:large-letters-font)]
@ -118,7 +117,7 @@
(send txt lock #t)
(send txt end-edit-sequence)
(send count set-label (format columns-string (get-max-line-width txt)))
(send dark-msg set-bm bm)))
(send dark-msg set-bm (if (equal? str "") #f bm))))
;; CHANGE - get-face can return #f
@ -140,13 +139,6 @@
(send dlg show #t)
(and ok? (send text-field get-value)))
(: get-w-size ((Instance Bitmap-DC%) String -> String))
(define (get-w-size dc face-name)
(let ([font (send the-font-list find-or-create-font 24 face-name 'default 'normal 'normal)])
(let-values ([(w h a d) (send dc get-text-extent "w" font)])
(format " (~a)" (floor (inexact->exact w))))))
(: get-max-line-width ((Instance Text:Basic%) -> Real))
(define (get-max-line-width txt)
(let loop ([i (+ (send txt last-paragraph) 1)]