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)))) (send dc draw-bitmap bm 0 0))))
(define/public (set-bm b) (define/public (set-bm b)
(set! bm b) (set! bm b)
(min-width (send bm get-width)) (min-width (if bm (send bm get-width) 0))
(min-height (send bm get-height)) (min-height (if bm (send bm get-height) 0))
(refresh)) (refresh))
(super-new (stretchable-width #f) (super-new (stretchable-width #f)
(stretchable-height #f) (stretchable-height #f)

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

@ -11,7 +11,7 @@
(define-type Bitmap-Message% (define-type Bitmap-Message%
(Class (init [parent (Instance Horizontal-Panel%)]) (Class (init [parent (Instance Horizontal-Panel%)])
[set-bm ((Instance Bitmap%) -> Void)])) [set-bm ((U (Instance Bitmap%) #f) -> Void)]))
(require/typed "bitmap-message.rkt" (require/typed "bitmap-message.rkt"
[bitmap-message% Bitmap-Message%]) [bitmap-message% Bitmap-Message%])
@ -68,8 +68,7 @@
(new choice% (new choice%
[label (string-constant fonts)] [label (string-constant fonts)]
[parent info-bar] [parent info-bar]
[choices (map (λ: ((x : String)) (format "~a~a" x (get-w-size tmp-bdc x))) [choices (get-face-list)]
(get-face-list))]
[callback [callback
(λ: ([x : Any] [y : Any]) (λ: ([x : Any] [y : Any])
(let ([old (preferences:get 'drracket:large-letters-font)] (let ([old (preferences:get 'drracket:large-letters-font)]
@ -118,7 +117,7 @@
(send txt lock #t) (send txt lock #t)
(send txt end-edit-sequence) (send txt end-edit-sequence)
(send count set-label (format columns-string (get-max-line-width txt))) (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 ;; CHANGE - get-face can return #f
@ -135,18 +134,11 @@
(loop (+ i 1) (cdr faces))])])))) (loop (+ i 1) (cdr faces))])]))))
(send txt auto-wrap #f) (send txt auto-wrap #f)
(update-txt " ") (update-txt "")
(send text-field focus) (send text-field focus)
(send dlg show #t) (send dlg show #t)
(and ok? (send text-field get-value))) (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)) (: get-max-line-width ((Instance Text:Basic%) -> Real))
(define (get-max-line-width txt) (define (get-max-line-width txt)
(let loop ([i (+ (send txt last-paragraph) 1)] (let loop ([i (+ (send txt last-paragraph) 1)]