Can anybody give me a simple hello-world example using the racket/gui canvas? Just a very minimal program opening a window with a canvas and drawing a text in the middle. I am a newbie and could not find something similar.
You may want to look at this repo, starting with task 1:
[
1 Like
Here's another example.
#lang racket
(require pict racket/gui/base)
; an example pict to draw
(define p
(scale
(for/fold ([p (filled-rectangle 400 400)])
([i (in-range 7)])
(vc-append
(scale p (/ 1 3))
(hc-append
(scale p (/ 1 3))
(scale p (/ 1 3)))))
10))
;; code that draws the pict into a canvas
;; (this is a simplified version of `show-pict`)
(define (draw c dc)
(define-values (cw ch) (send c get-client-size))
(define w (pict-width p))
(define h (pict-width p))
(draw-pict p dc (- (/ cw 2) (/ w 2)) (- (/ ch 2) (/ h 2))))
(define f (new frame% [label ""] [width 400] [height 400]))
(define c (new canvas% [parent f] [paint-callback draw]))
(send f show #t)
1 Like
I noticed that draw is called always twice on my system: for example at the start and during each window resize. Is this normal or a bug of my window manager?
#lang racket
(require pict racket/gui/base)
; an example pict to draw
(define p
(scale
(for/fold ([p (filled-rectangle 400 400)])
([i (in-range 7)])
(vc-append
(scale p (/ 1 3))
(hc-append
(scale p (/ 1 3))
(scale p (/ 1 3)))))
10))
(define counter
(let ((x 0))
(lambda ()
(set! x (+ x 1))
(printf "counter: ~s\n" x))))
;; code that draws the pict into a canvas
;; (this is a simplified version of `show-pict`)
(define (draw c dc)
(counter)
(define-values (cw ch) (send c get-client-size))
(define w (pict-width p))
(define h (pict-width p))
(draw-pict p dc (- (/ cw 2) (/ w 2)) (- (/ ch 2) (/ h 2))))
(define f (new frame% [label ""] [width 400] [height 400]))
(define c (new canvas% [parent f] [paint-callback draw]))
(send f show #t)
I think I got it:
#lang racket/gui
(define frame (new frame%
[label "Hello, World!"]
[width 300]
[height 200]))
(define panel (new panel%
[parent frame]
[alignment '(center center)]))
(define (draw-text dc text)
(let*-values ([(text-width text-height d a)
(send dc get-text-extent text)]
[(dc-width dc-height)
(send dc get-size)])
(send dc draw-text text
(/ (- dc-width text-width) 2)
(/ (- dc-height text-height) 2))))
(define (do-paint canvas dc)
(draw-text dc "Hello, World!"))
(define canvas (new canvas%
[parent panel]
[paint-callback do-paint]))
(send frame show #t)
Another example without panel but with a custom class and event logging.
#lang racket/gui
(define hello-canvas%
(class canvas%
(init parent)
(super-new (parent parent))
(let ((dc (send this get-dc)))
(send dc set-font (make-font #:size 24 #:face "Fira Code")))
(define/override (on-event event)
(printf "event: x=~s y=~s mouse=~s\n"
(send event get-x)
(send event get-y)
(send event get-event-type)))
(define/override (on-char event)
(printf "event: key=~s\n"
(send event get-key-code)))
(define/public (draw-text-center text)
(let ((dc (send this get-dc)))
(let*-values ([(text-width text-height d a)
(send dc get-text-extent text)]
[(dc-width dc-height)
(send dc get-size)])
(send dc draw-text text
(/ (- dc-width text-width) 2)
(/ (- dc-height text-height) 2)))))
(define/override (on-paint)
(let ((label (let loop ((area this))
(let ((p (send area get-parent)))
(if p
(loop p)
(send area get-label))))))
(send this draw-text-center label)))
))
(define frame (new frame%
[label "Hello, World!"]
[width 600]
[height 400]))
(define canvas (new hello-canvas%
[parent frame]))
(send frame show #t)
Same with bounding box and baseline:
#lang racket/gui
(define shell%
(class canvas%
(init parent)
(super-new (parent parent))
(let ((dc (send this get-dc)))
(send dc set-font (make-font #:size 24 #:face "Fira Code"))
(send dc set-pen "black" 0 'solid)
(send dc set-smoothing 'unsmoothed)
(send dc set-brush "white" 'transparent))
(define/override (on-event event)
(printf "event: x=~s y=~s mouse=~s\n"
(send event get-x)
(send event get-y)
(send event get-event-type)))
(define/override (on-char event)
(printf "event: key=~s\n"
(send event get-key-code)))
(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)
(let ((label (let loop ((area this))
(let ((p (send area get-parent)))
(if p
(loop p)
(send area get-label))))))
(send this draw-text-center label #t #t)))
))
(define frame (new frame%
[label "Hello, World!"]
[width 600]
[height 400]))
(define canvas (new shell%
[parent frame]))
(send frame show #t)
It may just be the vagaries of the different platforms. I don't see it on mac os, and I think that racket avoids offering any guarantees about how many times or at exactly which moments the draw callbacks are called.
1 Like