racket / draw Goto Github PK
View Code? Open in Web Editor NEWLicense: Other
License: Other
Loading the attached file causes the following error in DrRacket v8.2 [cs]:
memcpy: contract violation
expected: exact-nonnegative-integer?
given: #<eof>
context:
(read-png-bytes . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/draw-lib/racket/draw/unsafe/png.rkt> 228 0 9596 169))
(read-png . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/draw-lib/racket/draw/unsafe/png.rkt> 328 0 14170 620))
(|do-load-bitmap/dispatch/known method in bitmap%| . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/draw-lib/racket/draw/private/bitmap.rkt> 454 4 16403 648))
(|do-load-bitmap/port method in bitmap%| . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/draw-lib/racket/draw/private/bitmap.rkt> 423 4 14973 1116))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/draw-lib/racket/draw/private/syntax.rkt> 234 25 9144 19))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/draw-lib/racket/draw/private/bitmap.rkt> 169 2 4792 42346))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(do-make-object/real-class . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3581 0 194297 1099))
(|load-file method in image-snip%| . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/snip-lib/racket/snip/private/snip.rkt> 1099 2 39480 2600))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(do-make-object/real-class . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3581 0 194297 1099))
(|read method in image-snip-class%| . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/snip-lib/racket/snip/private/snip.rkt> 820 2 29301 2758))
(|read-snips-from-file method in editor%| . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/wxme/editor.rkt> 606 2 20616 8597))
(|do-read-from-file method in text%| . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/wxme/text.rkt> 2821 2 132288 583))
(|do-insert-file method in text%| . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/wxme/text.rkt> 2736 2 128336 2697))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/editor.rkt> 238 23 8905 1268))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/editor.rkt> 225 19 8223 2280))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/framework/private/editor-misc.rkt> 127 10 5004 644))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/framework/private/frame.rkt> 1408 2 55910 9283))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/framework/private/frame.rkt> 762 2 30458 7931))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/framework/private/frame.rkt> 1058 2 42186 11053))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/framework/private/frame.rkt> 256 2 9082 7172))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/frame.rkt> 814 4 34087 1456))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/unit.rkt> 1411 4 64079 169500))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/module-language.rkt> 1620 4 74932 16237))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/debug.rkt> 1844 4 77409 7759))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/module-language-tools.rkt> 88 4 3392 5267))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/syncheck/gui.rkt> 2110 6 107995 25119))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/gui-debugger/debug-tool.rkt> 1169 6 56967 21765))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/macro-debugger/tool.rkt> 120 6 3595 11521))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/quickscript/tool.rkt> 94 6 2796 12976))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/deinprogramm-signature/deinprogramm/signature/tool.rkt> 18 6 412 2572))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/htdp-lib/stepper/xml-tool.rkt> 339 8 13619 3018))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/htdp-lib/stepper/stepper-tool.rkt> 173 2 5725 2601))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/htdp-lib/test-engine/test-tool.rkt> 68 6 2399 5471))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/htdp-lib/xml/text-box-tool.rkt> 21 5 397 646))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(continue-make-object . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3607 0 195511 2890))
(do-make-object/real-class . #(struct:srcloc #<path:/usr/local/racket/collects/racket/private/class-internal.rkt> 3581 0 194297 1099))
(create-new-drscheme-frame . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/unit.rkt> 5640 2 260334 393))
(#f . #(struct:srcloc #<path:/usr/local/racket/collects/racket/contract/private/arrow-higher-order.rkt> 375 33 20717 125))
(#f . #(struct:srcloc #<path:/usr/local/racket/collects/racket/contract/private/arrow-val-first.rkt> 489 18 20850 36))
(#f . #(struct:srcloc #<path:/usr/local/racket/collects/racket/contract/private/arrow-val-first.rkt> 489 18 20850 36))
(loop . #(struct:srcloc ".../private/map.rkt" 40 19 1374 258))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/drracket/drracket/private/main.rkt> 908 1 38354 1991))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/wx/common/queue.rkt> 435 6 19067 1056))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/wx/common/queue.rkt> 486 32 21054 120))
(#f . #(struct:srcloc #<path:/usr/local/racket/share/pkgs/gui-lib/mred/private/wx/common/queue.rkt> 634 3 26076 58))
I am drawing bitmaps to the output like so
#lang racket
(require racket/draw)
(define imageWidth 64)
(define imageHeight 64)
(define target (make-bitmap imageWidth imageHeight))
(define dc (new bitmap-dc% [bitmap target]))
(define (set-frame dc color)
(send dc set-pen "black" 2 'solid)
(send dc set-brush color 'solid)
)
(define (display-frame dc)
(send dc draw-rectangle 0 0 imageWidth imageHeight)
target
)
(set-frame dc (make-color 255 255 255))
(display-frame dc)
(set-frame dc (make-color 255 0 0))
(display-frame dc)
(set-frame dc (make-color 0 255 0))
(display-frame dc)
(set-frame dc (make-color 0 0 255))
(display-frame dc)
However if I try to loop and send the bitmap to the output like so I don't see anything
#lang racket
(require racket/draw)
(define imageWidth 64)
(define imageHeight 64)
(define target (make-bitmap imageWidth imageHeight))
(define dc (new bitmap-dc% [bitmap target]))
(define (set-frame dc color)
(send dc set-pen "black" 2 'solid)
(send dc set-brush color 'solid)
)
(define (display-frame dc)
(send dc draw-rectangle 0 0 imageWidth imageHeight)
target
)
(for ([x (in-range 4)])
(set-frame dc (make-color 255 0 0))
(display-frame dc)
)
I am not sure why its not working, but I am sure I am just making some noobie mistake.
Class sections lack a <h3>
title
neither
@include-section["color-class.scrbl"]
in https://github.com/racket/draw/blob/master/draw-doc/scribblings/draw/draw.scrbl
or @defclass/title[color% object% ()]{
in https://github.com/racket/draw/blob/master/draw-doc/scribblings/draw/color-class.scrbl
does not cause a title for the section to be generated
but the first section 1. Overview does have a title
https://github.com/racket/draw/blob/master/draw-doc/scribblings/draw/guide.scrbl
@title[#:tag "overview"]{Overview}
As I wrote this issue I found
This form is normally used to create a section to be rendered on its own HTML. The 'hidden style is used because the definition box serves as a title.
So maybe this is intentional?
I'd prefer a <h3>
heading "6 class%" followed by the definition box but I'm guessing that adding @title[#:tag "color%"]{color%}
is the wrong way to achieve this. (I'm assuming it is desirable)
The other option would be to change
(list* (title #:style 'hidden (to-element (decl-name decl)))
to
(list* (title #:style #f (to-element (decl-name decl)))
but that would also affect defmixin/title
and definterface/title
.
PS I noticed this because I went looking to click the title to find the manual source like I could do for section 1:
Is your feature request related to a problem? Please describe.
It is not possible to draw the letters "V" and "A" correctly next to each other, because the library racket/draw does not expose the kerning table of a font.
Describe the solution you'd like
I would like to have a function, which returns the kerning similar to kerning-value of "sfont".
It would be nice to have a function, which calculates the kerning between two strings or characters. It seems to me that currently this is the only way to calculate the kerning between two strings:
#lang racket/gui
(define font (make-font #:size 16 #:face "Latin Modern Roman"))
(define frame (new frame% [label ""]))
(define canvas (new canvas% [parent frame]))
(define dc (send canvas get-dc))
(define left "A")
(define right "V")
(define both (string-append left right))
(define-values (left-text-width left-text-height left-baseline-height left-extra-height)
(send dc get-text-extent left font #t))
(values left-text-width left-text-height left-baseline-height left-extra-height)
(printf "\n")
(define-values (right-text-width right-text-height right-baseline-height right-extra-height)
(send dc get-text-extent right font #t))
(values right-text-width right-text-height right-baseline-height right-extra-height)
(printf "\n")
(define-values (both-text-width both-text-height both-baseline-height both-extra-height)
(send dc get-text-extent both font #t))
(values both-text-width both-text-height both-baseline-height both-extra-height)
(printf "\n")
(- (+ left-text-width right-text-width)
both-text-width)
The combine?
argument to draw-text
seems to shift circumflexes one character space to the left. The program:
#lang racket
(require racket/draw)
(define (draw t combine?)
(define b (make-object bitmap% 100 100))
(define dc (send b make-dc))
(send dc translate 20 20)
(send dc scale 5 5)
(send dc draw-text t 0 0 combine?)
b)
Produces:
What version of Racket are you using?
8.7 [cs]
What program did you run?
#lang racket/gui
(define (frame-label area)
(let ((p (send area get-parent)))
(if p
(frame-label p)
(send area get-label))))
(define hello%
(class canvas%
(init parent)
(super-new (parent parent))
(let ((dc (send this get-dc)))
(send dc set-font (make-font #:size 80 #:face "Latin Modern Roman"))
(send dc set-pen "black" 0 'solid)
(send dc set-smoothing 'unsmoothed)
(send dc set-brush "white" 'transparent))
(define/public (draw-text-center text bounding-box baseline)
(let ((dc (send this get-dc)))
(let*-values ([(dc-width dc-height) (send dc get-size)]
[(text-width text-height baseline-height extra-height)
(send dc get-text-extent text)])
(let* ((offset-x (/ (- dc-width text-width) 2))
(offset-y (/ (- dc-height text-height) 2))
(baseline-y (- (+ offset-y text-height) baseline-height))
(margin-x (- (+ offset-x text-width) 1)))
(send dc draw-text text offset-x offset-y)
(when bounding-box
(send dc draw-rectangle offset-x offset-y text-width text-height))
(when baseline
(send dc draw-line offset-x baseline-y margin-x baseline-y))))))
(define/override (on-paint)
(send this draw-text-center (frame-label this) #t #t))
))
(define frame (new frame%
[label "Hello, World!"]
[width 700]
[height 200]))
(define hello (new hello% [parent frame]))
(send frame show #t)
What should have happened?
The following is a comparison between the text rendered by Inkscape (top) and the way the above program renders the text (bottom).
You can see the gap between the "W" and the "o" is too big.
If you got an error message, please include it here.
none
Please include any other relevant details
OS: Debian GNU/Linux 12 (bookworm)
I have discussed it in the Racket forum.
The distance between two text lines are called "leading".
In most fonts a recommended leading is part of the font.
Currently, there is method of font% that computes the leading.
There are several places in racket/draw/private/color.rkt
where two names differ by a space, but are defined as the same color. However, "cornflowerblue"
and "cornflower blue"
seem to break this pattern. Is there a reason why they are different?
Definition of "cornflowerblue"
:
https://github.com/racket/draw/blob/master/draw-lib/racket/draw/private/color.rkt#L143
("cornflowerblue" . #(100 149 237))
Definition of "cornflower blue"
:
https://github.com/racket/draw/blob/master/draw-lib/racket/draw/private/color.rkt#L249
("cornflower blue" . #(68 64 108))
It looks like "cornflowerblue"
without the space has the same RGB values as the X11 cornflower blue on https://en.wikipedia.org/wiki/Cornflower_blue, so where do the RGB values for "cornflower blue"
with the space come from? Is it a mistake or intentional?
This example shows a rotating text.
Zooming in on the text (on macOS use ctrl and swipe up with two fingers to zoom in)
shows that the letters are "dancing". It looks as if each letter is rotated individually
instead of the text being drawn as a whole.
The expected result can be seen here (using p5.js):
https://processing.org/examples/textrotation.html
The example also shows that the thickness of the line varies.
Zoom in on the line and it becomes apparent that the line at some angles shrink in width.
In an animation this looks odd.
Turning on smoothing fixes the line thickness problem - but the reason for turning
it off was for speed.
Screen recording:
#lang racket/base
(require racket/gui)
(define width 640)
(define height 360)
(define angle 0.0) ; the rotation angle
(define (radians a) (* pi (/ a 180.)))
; A frame containing a single canvas with a timer that continously calls draw.
(define top-frame #f)
(define top-canvas #f)
(define top-timer #f)
(define dc #f) ; drawing context of the canvas
(define red-pen
(new pen%
[color "red"]
[width 4]
[style 'solid]
[cap 'round]
[join 'round]
[stipple #f]))
(define white-pen
(new pen%
[color "white"]
[width 1]
[style 'solid]
[cap 'round]
[join 'round]
[stipple #f]))
(define large-font
(make-object font% 24 'modern))
(define (draw)
(define old-transformation #f)
(when dc
(send dc set-background "black")
(send dc clear)
(send dc set-font large-font)
; (send dc set-smoothing 'smoothed)
; (send dc set-smoothing 'unsmoothed)
(send dc set-pen white-pen)
(send dc set-text-foreground "white")
(set! old-transformation (send dc get-transformation))
(define angle1 (radians 45))
(send dc translate 100.5 180.5)
(send dc rotate angle1)
(send dc draw-text "45 DEGREES" 0 0)
(send dc draw-line 0 0 150 0)
(send dc set-transformation old-transformation)
(set! old-transformation (send dc get-transformation))
(define angle2 (radians 270))
(send dc translate 200.5 180.5)
(send dc rotate angle2)
(send dc draw-text "180 DEGREES" 0 0)
(send dc draw-line 0 0 150 0)
(send dc set-transformation old-transformation)
(set! old-transformation (send dc get-transformation))
(define angle3 (radians angle))
(send dc translate 440.5 180.5)
(send dc rotate angle3)
(send dc draw-text (~a (modulo (inexact->exact (round angle)) 360) " DEGREES") 0 0)
(send dc draw-line 0 0 150 0)
(send dc set-transformation old-transformation)
(set! angle (+ angle 0.25))
(send dc set-pen red-pen)
(send dc draw-point 100.5 180.5)
(send dc draw-point 200.5 180.5)
(send dc draw-point 440.5 180.5)))
(define my-frame%
(class frame%
(define/augment (on-close)
(when top-timer
(send top-timer stop)))
(super-new)))
(define my-canvas%
(class canvas%
(define/override (on-paint) ; repaint (exposed or resized)
(define dc (send this get-dc))
(send this suspend-flush)
(handle-on-paint dc)
(send this resume-flush))
(super-new)))
(define (start-gui)
(define frame (new my-frame%
[label "sketch"]))
(set! top-frame frame)
(define canvas (new my-canvas%
[parent frame]
[min-width width]
[min-height height]))
(set! top-canvas canvas)
(set! dc (send top-canvas get-dc))
(define timer (new timer%
[notify-callback handle-on-timer]
[interval (inexact->exact (floor (/ 1000 30)))])) ; milliseconds
(set! top-timer timer)
(send frame show #t))
(define (handle-on-paint dc)
(when dc
(draw)))
(define (handle-on-timer)
(send top-canvas on-paint))
(start-gui)
I happened to try this while looking into racket/gui#307:
#lang racket/base
(require racket/class
racket/draw)
(define p (new pen%))
(send p get-color)
(send p set-color "notacolor")
(send p get-color)
=>
(object:color% ...)
get-color: broke its own contract
promised: (is-a?/c color%)
produced: #f
in: the range of
the get-color method in
brush%/c
contract from:
<pkgs>/draw-lib/racket/draw.rkt
contract on: brush%
blaming: <pkgs>/draw-lib/racket/draw.rkt
(assuming the contract is correct)
at: <pkgs>/draw-lib/racket/draw.rkt:85:19
context...:
/Users/bogdan/sandbox/racket/racket/collects/racket/contract/private/blame.rkt:346:0: raise-blame-error
.../private/arrow-higher-order.rkt:375:33
body of "/var/folders/11/9c7x7y096r9g35f9th6b93qc0000gn/T/tmp.ArY5q8ZT/draw.rkt"
The brush%
class has the same issue.
When I render the following 2htdp/image
expression:
(overlay (text "3" 120 "yellow") (square 120 "solid" "dark brown"))
I get a picture that looks like this:
Note that it's not centered. If an actual Helvetica font is used, it produces a centered 3. Also if I use some other font like 'default
, it works correctly:
To understand why, consider this program:
(require racket/draw)
(define text-sizing-bm (make-object bitmap-dc% (make-object bitmap% 1 1)))
(define ft (send the-font-list find-or-create-font 120 'swiss 'normal 'normal #f 'default #t))
(send text-sizing-bm get-text-extent "3" ft)
This produces (values 67.0 121.0 33.0 0.0)
on my machine but (values 67.0 139.0 27.0 0.0)
on a different machine (thanks @ccshan) with Helvetica installed.
It's not clear to me what the bug is here but the drawing definitely seems wrong.
Steps to reproduce:
raco macro-stepper file.rkt
where file.rkt
is:#lang racket
(struct a ())
The following error would appear:
cairo_quartz_get_cg_context_with_clip: implementation not found; arguments: #<cpointer>
context...:
/Users/sorawee/projects/racket/racket/share/pkgs/draw-lib/racket/draw/private/emoji.rkt:159:7: draw-loop
/Users/sorawee/projects/racket/racket/share/pkgs/draw-lib/racket/draw/private/dc.rkt:1457:4: do-text method in dc%
...
internal error: attempt to deschedule the current thread in atomic mode
context...:
/Users/sorawee/projects/racket/extra-pkgs/gui/gui-lib/mred/private/wx/common/queue.rkt:634:3
...
internal error: terminated in atomic mode!
I'm using Mac M1.
Hi! 👋
Found an inconsistency with current behavior and the docs, thought it was worth making an issue.
Per the documentation at https://docs.racket-lang.org/draw/bitmap-dc_.html
A bitmap% object must be supplied at initialization or installed into a bitmap DC using set-bitmap before any other method of the DC is called, except get-text-extent, get-char-height, or get-char-width. If any other bitmap-dc% method is called before a bitmap is selected, the method call is ignored.
Also in the docs for get-text-extent
Unlike most methods, this method can be called for a bitmap-dc% object without a bitmap installed.
However, when I try:
(define text-size-dc-unset (new bitmap-dc%))
(send text-size-dc-unset get-text-extent "Pickles")
I get an error:
get-text-extent in dc<%>: drawing context is not ok: (wrapper-object:bitmap-dc% ...)
Which probably comes from here:
draw/draw-lib/racket/draw/private/dc.rkt
Line 1363 in 01e00ba
The other two methods, get-char-width and get-char-height work fine, its just this one :/
I'm using Racket v8.4 on a MacBook Pro (2019).
@bennn and I have the following code that causes a segfault:
#lang racket/base
(require pict
racket/class
redex/reduction-semantics
redex/pict)
(define-language nats
[nat Z])
(define p (term->pict nats (term Z)))
(define b (pict->bitmap p))
(define w (pict-width p)) ; 105.7587890625 should be 106
(define h (pict-height p)) ; 14.2802734375 should be 15
(define pixbuf (make-bytes (* 4 (inexact->exact (ceiling (* w h))))))
(send b get-argb-pixels 0 0 w h pixbuf)
pixbuf
Looking at this, w
and h
are obviously wrong, and we should have gotten them with get-width
and get-hight
on the bitmap directly rather than getting them from the pict.
However, because we are passing non exact-nonnegative-integer? we would expect a contract violation, especially given the contract for the get-argb-pixels
method:
(get-argb-pixels (->*m
(exact-nonnegative-integer?
exact-nonnegative-integer?
exact-nonnegative-integer?
exact-nonnegative-integer?
(and/c bytes? (not/c immutable?)))
(any/c any/c #:unscaled? any/c)
void?))
However, what happens is we get a segfault.
Furthermore, if we pass in another incorrect value, say w=0.5 and h=0.5, rather than getting a segault, we just get a buffer filled with some data.
I have a GIF file I'm trying to load into a bitmap and I get this failure:
> (define img (build-path "003.gif"))
> (define bmp
(let ([in (open-input-file img)])
(define bitmap (make-object bitmap% in 'gif/alpha))
(close-input-port in)
bitmap))
; vector-set!: index is out of range
; index: 4096
; valid range: [0, 4095]
; vector: '#(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
; -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1...
; [,bt for context]
> ,bt
; vector-set!: index is out of range
; index: 4096
; valid range: [0, 4095]
; vector: '#(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1...
; context...:
; /usr/share/racket/pkgs/draw-lib/racket/draw/private/lzw.rkt:124:6: loop
; /usr/share/racket/pkgs/draw-lib/racket/draw/gif.rkt:113:0: read-image
; /usr/share/racket/pkgs/draw-lib/racket/draw/gif.rkt:141:6: loop
; /usr/share/racket/pkgs/draw-lib/racket/draw/gif.rkt:128:0: read-gif
; /usr/share/racket/pkgs/draw-lib/racket/draw/gif.rkt:182:0: gif->rgba-rows
; /usr/share/racket/pkgs/draw-lib/racket/draw/private/bitmap.rkt:381:4: do-load-bitmap method in bitmap%
; /usr/share/racket/pkgs/draw-lib/racket/draw/private/syntax.rkt:234:25
; /usr/share/racket/pkgs/draw-lib/racket/draw/private/bitmap.rkt:156:2
; /usr/share/racket/collects/racket/private/class-internal.rkt:3553:0: continue-make-object
; /usr/share/racket/collects/racket/private/class-internal.rkt:3553:0: continue-make-object
; /usr/share/racket/collects/racket/private/class-internal.rkt:3507:0: do-make-object
; /usr/share/racket/pkgs/xrepl-lib/xrepl/xrepl.rkt:1443:0
; /usr/share/racket/collects/racket/private/misc.rkt:88:7
It appears to be a problem with gif->rgba-rows, but I'm not familiar enough with the internals to say for sure. For reference, here's the GIF I'm using.
Now that the #:callback-exns?
option for _fun
has been added (in racket/racket@bf8741e), maybe guard-foreign-escape
should use it:
draw/draw-lib/racket/draw/unsafe/callback.rkt
Lines 7 to 18 in 253dbf8
If pen width is 1 and you use 'long-dash
or any other variant, dashes are only drawn on the horizontal lines. If width is set to 2, they appear fine.
Repro is here, runs in drracket or racket-mode:
#lang racket/base
(require racket/draw
racket/class)
(define (draw-box broken)
(define canvas (make-bitmap 51 28))
(define dc (send canvas make-dc))
(send dc set-brush "WhiteSmoke" 'solid)
(send dc set-pen "black"
(if broken 1 2) ; BUG
'long-dash)
(send dc draw-rectangle 1 1 50 25)
canvas)
(printf "BUG: only dashed on the sides:~n")
(draw-box 'broken)
(printf "correctly dashed, but needs to be 2x wide:~n")
(draw-box #f)
I can't track this down. The cairo binding code is really dense for me.
The procedure (send a-bitmap has-alpha-channel?)
led me to believe that it would report whether the loaded image has an alpha channel, but apparently it only says whether the bitmap has been created with an alpha channel or not. I would like to request a feature that determines whether a source image has an alpha channel.
I was told that 'unknown/mask
would only produce a mask if the source image had an alpha channel, but that is not the case - 'unknown/mask
always produces a mask, it's just the mask will be completely black if there is no alpha.
Some time ago I did a deep dive into the racket/draw
contracts. Here is an observation that led me to some bugs: class contracts do not provide a guarantee on objects that are created from within the contract boundary.
The numbers given to in-region?
are expected to be real?
. If you give imaginary numbers
(define reg (new region%))
(send reg in-region? 0+i 0+i)
the correct error from the region%
class contract is raised:
; in-region?: contract violation
; expected: real?
; given: 0+1i
; in: the 1st argument of
; the in-region? method in
; region%/c
However, regions can be created indirectly via the clipping region
(define r-dc (new record-dc%))
(send r-dc set-clipping-rect 0 0 550 400)
(define reg (send r-dc get-clipping-region))
(send reg in-region? 0+i 0+i)
and such will give an internal error since the region was not created through the protected region%
class:
; cairo_in_fill: given value does not fit primitive C type
; C type: _double*
; value: 0.0+1.0i
The fifth argument to get-argb-pixels
is expected to be bytes?
(define bmp (make-bitmap 550 400))
(send bmp get-argb-pixels 0 0 0 0 #f)
and gives an error as such
; get-argb-pixels: contract violation
; expected: bytes?
; given: #f
; in: an and/c case of
; the 5th argument of
; the get-argb-pixels method in
; the range of ...
But bitmaps can be created through the make-bitmap
method of canvases
(define frame (new frame% [label "Example"]))
(define canvas (new canvas% [parent frame]))
(define bmp (send canvas make-bitmap 550 400))
(send bmp get-argb-pixels 0 0 0 0 #f)
and in such a case an internal error is raised because it's unprotected
; bytes-length: contract violation
; expected: bytes?
; given: #f
The blink-caret
method of snips expects a dc<%>
(define sn (new snip%))
(send sn blink-caret #f #f #f)
and the contract gives this error
; blink-caret: contract violation
; expected: (is-a?/c dc<%>)
; given: #f
; in: the 1st argument of
; the blink-caret method in
; the 2nd conjunct of ...
However, cloning the snip constructs a new object that is not protected
(define sn (new snip%))
(define sn2 (send sn copy))
(send sn2 blink-caret #f #f #f)
and gives this different error
; blink-caret method of snip%: expected argument of type <dc<%> instance>; given: #f; other arguments: #f #f
which doesn't come from a contract check, but is a (usually redundant) defensive check that is present in the blink-caret
method.
These are just a few instances I found in racket/draw
—there are probably quite a few more. I'm not sure what the takeaway is. My thought is that using (is-a?/c my-class%)
and then subsequently assuming that objects satisfy the class contract on my-class%
is dangerous since it assumes that my-class%
objects are only constructed through the protected constructor. Using object/c
contracts everywhere instead of is-a?/c
isn't a panacea either because, as far as I know, they will not get collapsed and wrappers might quickly accumulate. So while these bugs that I mentioned can be fixed individually, I feel as though there is a deeper concern here with respect to class contracts in general.
While reading draw/private/dc
I saw a line that may or may not be a bug.
In make-pattern-surface
a new surface s
is created.
Then a cairo context cr2
is created and a few settings are made using cr2
.
But in line 868 the setting is made to cr
and not cr2
.
I am wondering whether this was on purpose?
https://github.com/racket/draw/blob/master/draw-lib/racket/draw/private/dc.rkt#L868
This is not a regression from 7.4.
The program:
#lang racket
(require pict racket/draw)
(define (thing dc)
(define b (send dc get-brush))
(send dc set-brush "black" 'solid)
(send dc draw-rectangle 0 0 100 100)
(send dc set-brush b)
;; whiteout
(define r (send dc get-clipping-region))
(send dc set-clipping-rect 0 0 50 50)
(send dc erase)
(send dc set-clipping-region r))
(define bit (make-object bitmap% 100 100))
(thing (send bit make-dc))
bit
(define dc2 (new record-dc% [width 100] [height 100]))
(thing dc2)
(send dc2 get-recorded-datum)
(define x (send dc2 get-recorded-procedure))
(define bit1 (make-object bitmap% 100 100))
(x (send bit1 make-dc))
bit1
Produces the following in drracket:
The first image is what I would expect. The second image seems to be the result of the clipping rect not being set. (In general, any drawing I do after calling erase
still happens). Oddly the call to set-clipping-region
that corrisponds to set-clipping-rect
appears in the recorded datum.
Is your feature request related to a problem? Please describe.
When using the racket/draw
package, one often wants to draw a circle and square. This is done by using draw-ellipse
and draw-rectangle
, respectively, but this requires repeating information, which can clutter a codebase.
Describe the solution you'd like
The methods draw-circle
and draw-square
should be added to the dc<%>
interface in the racket/draw
library. The methods should simply defer to the draw-ellipse
and draw-rectangle
methods. Probably the only design decision would be whether draw-circle
takes in a radius or diameter argument. I think radius is more natural but diameter is more consistent, being the "size" of the bounding box, with the rest of the racket/draw
methods.
Describe alternatives you've considered
n/a
Do you want to contribute to this feature
I'm interested in helping out contributing this feature. I have not contributed to Racket before, but since this feature should be as straightforward as it gets (simply defer down to the existing draw-ellipse
and draw-rectangle
), it seems like a good one to start with. This is the main reason for me creating this feature request.
[Optional] Additional context
n/a
I would like to request that a make-bitmap
method be added to dc<%>
. I would like it to behave like the existing make-bitmap
function, with the following differences:
The backing scale is automatically inherited from the dc it is created from, and
it automatically chooses between make-bitmap
, make-platform-bitmap
, and make-screen-bitmap
depending on what is most appropriate for the drawing context (if relevant).
For example, the drawing context produced by the get-dc
method of canvas<%>
would presumably use make-screen-bitmap
to create a bitmap, while drawing contexts that don’t actually draw to bitmaps like post-script-dc%
and record-dc%
would just return a bitmap created with the make-bitmap
function. Instances of bitmap-dc%
would create bitmaps with the same properties as the currently-installed bitmap.
This would make it significantly easier for functions like blur
from pict to do the right thing, avoiding bugs like racket/pict#52. I’m not sure it’s currently even possible to handle the second point with the existing interface.
On my machine, macOS 10.13.6, the draw-bitmap
method of bitmap-dc%
appears to ignore the current smoothing setting if the bitmap to be drawn has a backing scale greater than 1.0. This program reproduces the problem:
#lang racket
(require racket/draw)
(define (make-point-bitmap backing-scale)
(define bmp (make-bitmap 3 3 #:backing-scale backing-scale))
(define dc (new bitmap-dc% [bitmap bmp]))
(send dc set-smoothing 'unsmoothed)
(send dc draw-point 1.5 1.5)
bmp)
(define (blow-up bmp scale)
(define bmp* (make-bitmap (* (send bmp get-width) scale)
(* (send bmp get-height) scale)))
(define dc (new bitmap-dc% [bitmap bmp*]))
(send dc set-smoothing 'unsmoothed)
(send dc set-scale scale scale)
(send dc draw-bitmap bmp 0 0)
bmp*)
(send (blow-up (make-point-bitmap 1.0) 100) save-file "blown-up-1.png" 'png)
(send (blow-up (make-point-bitmap 2.0) 100) save-file "blown-up-2.png" 'png)
The program produces the following images as output:
I would expect them to be the same, but the second is antialiased while the first one isn’t.
When I run the program below using racket.exe on a Windows machine, the warning below is printed out to the console. On a GUI application, a console window will open to print out this warning. This warning is only printed in the Chez version or Racket 7.6
Interestingly, the warning is not printed out when the code is run inside DrRacket, so it is disabled somehow, but I could not find how to disable this warning in my application.
This problem has existed in Racket 7.5 CS as well and I reported it on the racket-users list, but it was lost, so I am reporting here to keep track of the issue.
#lang racket
(require pict)
(text "Hello" '(bold . "Helvetica") 14)
$ racket text-h14.rkt
(racket.exe:59720): Pango-WARNING **: 15:12:31.361: couldn't load font "Helvetica Bold Not-Rotated 14px", falling back to "Sans Bold Not-Rotated 14px", expect ugly output.
#<pict>
There is a workaround here to prevent a problem with Pango's Core Text backed by loading AppKit, but it is specific to "x86_64-macosx/3m"
:
draw/draw-lib/racket/draw/unsafe/pango.rkt
Lines 49 to 55 in 253dbf8
Perhaps it should use (system-type 'os)
or 'os*
to also apply to, say, "aarch64-macosx/cs"
? Or maybe the underlying problem has been fixed?
The program below draws a rotating circle drawn with black outline and white interior on a gray background.
The circle has has center in the rotation center, so the expected result is a static image.
However the smoothing settings 'unsmoothed and 'aligned reveals a problem.
Using 'unsmoothed the outline pulses (the thickness varies).
Using 'aligned one sees the brush color "bleed" through the outline.
#lang racket/base
(require racket/gui)
(define width 640)
(define height 360)
(define angle 0.0) ; the rotation angle
; A frame containing a single canvas with a timer that continously calls draw.
(define top-frame #f)
(define top-canvas #f)
(define top-timer #f)
(define dc #f) ; drawing context of the canvas
(define red-pen
(new pen%
[color "red"]
[width 4]
[style 'solid]
[cap 'round]
[join 'round]
[stipple #f]))
(define black-pen
(new pen%
[color "black"]
[width 1]
[style 'solid]
[cap 'round]
[join 'round]
[stipple #f]))
(define white-pen
(new pen%
[color "white"]
[width 1]
[style 'solid]
[cap 'round]
[join 'round]
[stipple #f]))
(define white-brush (new brush% [color "black"]))
(define (draw)
(define old-transformation #f)
(when dc
(send dc set-background "darkgray")
(send dc clear)
; (send dc set-smoothing 'smoothed) ; looks ok
(send dc set-smoothing 'unsmoothed) ; outline pulses
; (send dc set-smoothing 'aligned) ; outline is slightly off
(send dc set-pen white-pen)
(send dc set-text-foreground "white")
(set! old-transformation (send dc get-transformation))
(send dc translate 440.5 180.5)
(send dc rotate angle)
(send dc set-brush white-brush)
(send dc draw-ellipse -50 -50 100 100)
(send dc set-transformation old-transformation)
(set! angle (+ angle 0.025))))
(define my-frame%
(class frame%
(define/augment (on-close)
(when top-timer
(send top-timer stop)))
(super-new)))
(define my-canvas%
(class canvas%
(define/override (on-paint) ; repaint (exposed or resized)
(define dc (send this get-dc))
(send this suspend-flush)
(handle-on-paint dc)
(send this resume-flush))
(super-new)))
(define (start-gui)
(define frame (new my-frame%
[label "sketch"]))
(set! top-frame frame)
(define canvas (new my-canvas%
[parent frame]
[min-width width]
[min-height height]))
(set! top-canvas canvas)
(set! dc (send top-canvas get-dc))
(define timer (new timer%
[notify-callback handle-on-timer]
[interval (inexact->exact (floor (/ 1000 30)))])) ; milliseconds
(set! top-timer timer)
(send frame show #t))
(define (handle-on-paint dc)
(when dc
(draw)))
(define (handle-on-timer)
(send top-canvas on-paint))
(start-gui)
A declarative, efficient, and flexible JavaScript library for building user interfaces.
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
An Open Source Machine Learning Framework for Everyone
The Web framework for perfectionists with deadlines.
A PHP framework for web artisans
Bring data to life with SVG, Canvas and HTML. 📊📈🎉
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
Some thing interesting about web. New door for the world.
A server is a program made to process requests and deliver data to clients.
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
Some thing interesting about visualization, use data art
Some thing interesting about game, make everyone happy.
We are working to build community through open source technology. NB: members must have two-factor auth.
Open source projects and samples from Microsoft.
Google ❤️ Open Source for everyone.
Alibaba Open Source for everyone
Data-Driven Documents codes.
China tencent open source team.