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

Fix DrRacket's insert-large-letters

Browse Source 
This is a temporary fix in the sense that the typed/mred
wrapper that this relies on is incomplete. Once the typed
racket/gui bindings are merged, a more complete
insert-large-letters will be checked in.

Closes PR 14362
This commit is contained in:
Asumu Takikawa 2014-02-21 14:39:01 -05:00
parent 6710d08ff1
commit 2295f71dbe
2 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -160,7 +160,7 @@
(define-values (tw raw-th td ta) (send bdc get-text-extent str the-font)) (define-values (tw raw-th td ta) (send bdc get-text-extent str the-font))
(define th (let-values ([(_1 h _2 _3) (send bdc get-text-extent "X" the-font)]) (define th (let-values ([(_1 h _2 _3) (send bdc get-text-extent "X" the-font)])
(max raw-th h))) (max raw-th h)))
(define tmp-color (make-color 0 0 0)) (define tmp-color (make-object color%))
(: get-char (Real Real -> Char)) (: get-char (Real Real -> Char))
(define (get-char x y) (define (get-char x y)
@ -170,8 +170,8 @@
comment-character comment-character
#\space))) #\space)))
(define bitmap (define bitmap
(make-bitmap (make-object bitmap%
(max 1 (assert (exact-floor tw) positive?)) (max 1 (exact-floor tw))
(assert (exact-floor th) positive?) (assert (exact-floor th) positive?)
#t)) #t))

14
pkgs/typed-racket-pkgs/typed-racket-more/typed/mred/mred.rkt
View File

@ -35,14 +35,19 @@
[show (Any -> Void)]))) [show (Any -> Void)])))
(define-type Bitmap% (define-type Bitmap%
(Class [get-width (-> Integer)] (Class (init-rest (U (List Exact-Positive-Integer Exact-Positive-Integer)
(List Exact-Positive-Integer Exact-Positive-Integer Any)
(List Exact-Positive-Integer Exact-Positive-Integer Any Any)
(List Exact-Positive-Integer Exact-Positive-Integer Any Any Real)))
[get-width (-> Integer)]
[get-height (-> Integer)])) [get-height (-> Integer)]))
(define-type Font-List% (define-type Font-List%
(Class (Class
[find-or-create-font [find-or-create-font
(case-> (Integer Symbol Symbol Symbol -> (Instance Font%)) (case-> (Integer Symbol Symbol Symbol -> (Instance Font%))
(Integer String Symbol Symbol Symbol -> (Instance Font%)))])) (Integer String Symbol Symbol Symbol -> (Instance Font%))
(Integer String Symbol Symbol Symbol Symbol -> (Instance Font%)))]))
(define-type Font% (define-type Font%
(Class [get-face (-> (Option String))] (Class [get-face (-> (Option String))]
@ -101,7 +106,10 @@
[draw-text (String Number Number -> Void)])) [draw-text (String Number Number -> Void)]))
(define-type Color% (define-type Color%
(Class [red (-> Number)])) (Class (init-rest (U Null
(List Byte Byte Byte)
(List Byte Byte Byte Real)))
[red (-> Number)]))
(define-type Snip% (define-type Snip%
(Class [get-count (-> Integer)])) (Class [get-count (-> Integer)]))