1) As title says, the objects i draw disappear when i resize the window, but the rectangle stays as is.
2) The origin starts from the top left, but i wish for it to be at the bottom left.
3) I couldn't find any zoom functions, other than in the plot library so if i wish to implement such a thing, one option would to be "zooming" in by drawing bigger objects and refreshing the canvas instead?
(define top-frame (new frame%
[label "KR"]
[width 500]
[height 500]))
;Make a frame by instantiating the frame% class
(define image (pict->bitmap (rectangle 50 50)))
(define canvas (new canvas%
[parent top-frame]
[paint-callback (lambda (canvas dc)
(send dc draw-bitmap image 0 0))]))
(define drawer (send canvas get-dc))
(send top-frame show #t)
; Show the frame by calling its show method
(define (draw-object x)
(sleep/yield 0.1)
(case (first x)
[("LINE") (send drawer draw-line
(second x) (third x)
(fourth x) (fifth x))]
[("CIRCLE") (send drawer draw-bitmap (pict->bitmap (circle (round (fourth x)))) (round (second x)) (round (third x)))]
[("POINT") (send drawer draw-point (round (second x)) (round (third x)))]
[else "Not drawing anything!"]))
(draw-object (find-specific-values (third list-of-objects)))
(map draw-object (map find-specific-values list-of-objects))
ad 1) "...the objects i draw disappear when i resize the window, ..."
When you resize a window the system needs to redraw the contents of the window. A redraw event is issued, and eventually the Racket GUI layer will call the paint-callback. Therefore: Make a function that does all the drawing. Call it from the paint-callback. See similar question here: https://stackoverflow.com/a/16086594/23567
ad 2) One option is to make a coordinate transformation in the drawing context. See set-transformation in the docs for dc<%>. It's someething like this:
(send dc set-transformation
(vector (trans->vector t)
0 0 ; x and y origin
1 -1 ; x and y scale
0)))
The -1 for the y-scale will flip the y-axis. You might want to move the origin.
ad 3) Zooming can be done by changing the x and y scale, and then redrawing.
You can try the scales to 1/2 -1/2 .
Related
(require racket/draw
mred)
(define bitmap-canvas%
(class canvas%
(init-field [bitmap #f])
(inherit get-dc)
(define/override (on-paint)
(send (get-dc) draw-bitmap bitmap 0 0))
(define/public (set-bitmap! new-bitmap)
(displayln "setting bitmap")
(set! bitmap new-bitmap))
(super-new)))
(define bitmap (read-bitmap
"some-stringPath-to-bitmap-source"))
(define f (new frame% [label "foo"] [width 100] [height 100]))
(define the-canvas (new bitmap-canvas% [parent f] [bitmap bitmap] [min-width 500] [min-height 500]))
(send f show #t)
I have to above code to show a bitmap within a Canvas, contained in a Frame. However, when the bitmap has large dimensions, (1200x900) for example, you cannot see all of it. How can I adapt the code so that the entire bitmap is scaled to fit in the canvas?
Thanks
I'm making a GUI visualization for a genetic algorithm, and want to be able to plot the maximization function and the points of each generation of individuals over this function. For each generation, I want only the points to be erased, and the next ones plotted over the already existing function plot.
Using the function plot/dc, I'm achieving to animate each generation of individuals, plotting all the points from a list of coordinates. But this method redraw the canvas each time it runs. So I can't plot the function itself, behind the points. I could make a list of function and points for each generation, but this would be a waste of resources.
Using this code you should be able to simulate my actual state of development.
#lang racket
(require racket/gui plot)
(define main-window (new frame% [label "FUNCTION AND POINTS"] [width 200] [height 600]))
(define canvas-panel (new panel% [parent main-window]))
(define function-canvas (new canvas% [parent canvas-panel]))
(define (plot-points list-of-points)
(for-each
(λ (population)
(plot/dc (points population
#:x-min 0
#:x-max 3
#:y-min 0
#:y-max 9
#:color 'red)
(send function-canvas get-dc)
0 0
(- (send canvas-panel get-width) 40)
(- (send canvas-panel get-height) 40))
(sleep/yield 1))
list-of-points))
(send main-window show #t)
(plot-points '(((1 8) (2 5) (2.5 2))
((2 5) (1.5 6.5) (2 3))
((1.5 3) (2 2) (1.5 3.5))
((2 7) (0.5 1) (2 0.5))
((0.5 9) (0 5) (0.5 0))
((0 1) (1 4.5) (0 8.5))))
Note: The points above was randomly generated, and doesn't correspond to the genetic algorithm output, so there isn't a function that can match this coordinates.
I expect to plot the function graphic behind these points, to be able to see the maximization occurring.
There's a lot being asked here. But essentially you want to put your plot on a non all-white background, that way you can put something else (in this case a function plot) in the background. You can do this with the background-alpha parameter.
Adding this line to your above code:
(plot-background-alpha 0)
will have the points continually build on top of each other. Since you indicated youw anted the points to move, you will also need to clear the screen between each 'frame', you can do this by changing your draw function to:
(define (plot-points list-of-points)
(for-each
(λ (population)
(define dc (send function-canvas get-dc))
(send dc clear)
(plot/dc .... elided ....
dc
0 0
(- (send canvas-panel get-width) 40)
(- (send canvas-panel get-height) 40))
(sleep/yield 1))
list-of-points))
Now to draw your actual background. You could recalculate it each frame, but as you indicated that would be too slow.1 So we can calculate it once, render it as an image, and redraw that each 'frame'. Say the function you want in the background is (+ (sin (* 5 x)) 3), your code would look like:
(define plot-func (function (λ (x) (+ (sin (* 5 x)) 3))
0 (* 2 pi)))
(define plot-background
(plot-bitmap plot-func
#:x-min 0
#:x-max 3
#:y-min 0
#:y-max 9
#:width (- (send canvas-panel get-width) 40)
#:height (- (send canvas-panel get-height) 40)))
Note that get-width and get-height won't store the actual canvas's width/height until after the show method is called.
And now we need to update the draw function to draw this plot to the background:
(define (plot-points list-of-points)
(for-each
(λ (population)
(define dc (send function-canvas get-dc))
(send dc clear)
(send dc draw-bitmap plot-background 0 0)
... elided ...
(sleep/yield 1))
list-of-points))
Putting it all together gives:
#lang racket
(require racket/gui plot)
(define main-window (new frame% [label "FUNCTION AND POINTS"] [width 200] [height 600]))
(define canvas-panel (new panel% [parent main-window]))
(define function-canvas (new canvas% [parent canvas-panel]))
(send main-window show #t)
(plot-background-alpha 0)
(define plot-func (function (λ (x) (+ (sin (* 5 x)) 3))
0 (* 2 pi)))
(define plot-background
(plot-bitmap plot-func
#:x-min 0
#:x-max 3
#:y-min 0
#:y-max 9
#:width (- (send canvas-panel get-width) 40)
#:height (- (send canvas-panel get-height) 40)))
(define (plot-points list-of-points)
(for-each
(λ (population)
(define dc (send function-canvas get-dc))
(send dc clear)
(send dc draw-bitmap plot-background 0 0)
(plot/dc (points population
#:x-min 0
#:x-max 3
#:y-min 0
#:y-max 9
#:color 'red)
dc
0 0
(- (send canvas-panel get-width) 40)
(- (send canvas-panel get-height) 40))
(sleep/yield 1))
list-of-points))
(plot-points '(((1 8) (2 5) (2.5 2))
((2 5) (1.5 6.5) (2 3))
((1.5 3) (2 2) (1.5 3.5))
((2 7) (0.5 1) (2 0.5))
((0.5 9) (0 5) (0.5 0))
((0 1) (1 4.5) (0 8.5))))
1Obviously this depends on the details of what you are calculating and how fast you want to draw it. It might actually be fast enough. ;)
Say I have some long text
(define EXTREMELY-LONG-TEXT "foo foo ...(like 25 times)... foo")
and I need to draw it to a background that is constrained on the x axis but not the y axis. Is there anyway to limit the x direction of the text and have it expand downward by default? Or do I have to define my own function to accomplish this task?
Currently, I have a text adventure game with changing lengths of text and I want to be able to define a constant x for the game to be run at instead of having to define a large background for it to be drawn onto such as
(define BG (empty-scene 500 100))
(overlay/align "center" "top" (text EXTREMELY-LONG-TEXT 16 "black") BG)
You need to do it yourself, but that shouldn't be difficult.
#lang racket
(require 2htdp/image)
(define TEXT-SIZE 16)
(define WIDTH 500)
(define limit (exact-floor (* 2.4 (/ WIDTH TEXT-SIZE))))
(define EXTREMELY-LONG-TEXT (string-append* (make-list 25 "foo ")))
(define (fit-string s)
(string-append*
(map list->string
(add-between (sequence->list (in-slice limit (string->list s)))
'(#\newline)))))
(define BG (empty-scene WIDTH 100))
(overlay/align
"center" "top"
(text (fit-string EXTREMELY-LONG-TEXT) TEXT-SIZE "black") BG)
The formula 2.4 * WIDTH / TEXT-SIZE can be improved further, but it works well enough for this case.
I am trying following code:
#lang racket/gui
(require 2htdp/image)
; list of images to be animated:
(define images (list (circle 30 "outline" "red")
(circle 20 "outline" "red")
(circle 10 "outline" "red")
(circle 5 "outline" "red")))
(define (image->bitmap image) ;from: https://lists.racket-lang.org/users/archive/2014-December/065110.html
(let* ([width (image-width image)]
[height (image-height image)]
[bm (make-bitmap width height)]
[dc (send bm make-dc)])
(send dc clear)
(send image draw dc 0 0 0 0 width height 0 0 #f)
bm))
(define frame (new frame% [label "Frame"] [width 300] [height 300]))
(define canvas (new canvas% [parent frame]))
(define a-dc (send canvas get-dc))
(send frame show #t)
(sleep/yield 1)
(define x 20)
(define y 20)
(define (thunk)
(let loop () ; endless loop
(for ((i images))
(send a-dc draw-bitmap (image->bitmap i) x y)
(sleep 0.5))
(loop)))
(thread thunk)
(set! x 100)
(set! y 100)
(thread thunk)
(set! x 200)
(set! y 200)
(thread thunk)
However, only third animation runs while others show only the largest circle (first image). Apparently, previous threads also take new x and y values. How can I have them preserve initially sent x and y values? I cannot have any argument in thunk function because it has to be sent to thread function that needs an argument-less function argument! (I hope my complex statement/argument is functionally correct).
Where is the problem?
Each thread is referring to the same x and y coordinates. This means all threads are drawing at the same place.
Here is an example that shows that having two different sets of x and y variables work.
#lang racket/gui
(require 2htdp/image)
; list of images to be animated:
(define images (list (circle 30 "outline" "red")
(circle 20 "outline" "red")
(circle 10 "outline" "red")
(circle 5 "outline" "red")))
(define (image->bitmap image) ;from: https://lists.racket-lang.org/users/archive/2014-December/065110.html
(let* ([width (image-width image)]
[height (image-height image)]
[bm (make-bitmap width height)]
[dc (send bm make-dc)])
(send dc clear)
(send image draw dc 0 0 0 0 width height 0 0 #f)
bm))
(define frame (new frame% [label "Frame"] [width 300] [height 300]))
(define canvas (new canvas% [parent frame]))
(define a-dc (send canvas get-dc))
(send frame show #t)
(sleep/yield 1)
(define x 20)
(define y 20)
(define (thunk)
(let loop () ; endless loop
(for ((i images))
(send a-dc draw-bitmap (image->bitmap i) x y)
(sleep 0.5))
(loop)))
(thread thunk)
(define X 100)
(define Y 100)
(define (thunk2)
(let loop () ; endless loop
(for ((i images))
(send a-dc draw-bitmap (image->bitmap i) X Y)
(sleep 0.5))
(loop)))
(thread thunk2)
Rather than having variables for each coordinate, consider storing them in a data structure (for example a hash table) and letting the threads read the coordinates from the data structure.
It would be simpler to have a single drawing function that draws all objects at once.
However if you want multiple threads, then use a function to create the thunk:
(define (make-thunk n)
(lambda ()
(let loop () ... )))
use n to pick out the coordinates of the n'th object ...)) Then create the threads with (thread (make-thunk 0)) (thread (make-thunk 1))
Based on answer by #soegaard I found following animateImageList fn to be very convenient for showing a list of images at multiple places and with different speeds:
#lang racket/gui
(require 2htdp/image)
(define (image->bitmap image) ;from: https://lists.racket-lang.org/users/archive/2014-December/065110.html
(let* ([width (image-width image)]
[height (image-height image)]
[bm (make-bitmap width height)]
[dc (send bm make-dc)])
(send dc clear)
(send image draw dc 0 0 0 0 width height 0 0 #f)
bm))
(define (animateImageList imglist sent-dc x y secs)
(λ ()
(let loop ()
(for ((i imglist))
;(send sent-dc clear) ; this may be added to clear previous image;
(send sent-dc draw-bitmap (image->bitmap i) x y)
(sleep secs))
(loop))))
(define imglist (list (circle 40 "outline" "yellow")
(circle 30 "outline" "red")
(circle 20 "outline" "blue")
(circle 10 "outline" "green")
(circle 5 "outline" "black")))
(define frame (new frame% [label "Frame"] [width 300] [height 300]))
(define canvas (new canvas% [parent frame]))
(define a-dc (send canvas get-dc))
(send frame show #t)
(sleep/yield 1)
(thread (animateImageList imglist a-dc 10 10 0.1))
(thread (animateImageList imglist a-dc 100 100 0.4))
(thread (animateImageList imglist a-dc 200 200 0.7))
Output:
I can get animating images being shown using "universe.rkt" (https://docs.racket-lang.org/teachpack/2htdpuniverse.html?q=universe.rkt) either with animate function or with big-bang.
However, how can I get these animations as image objects which I can place on canvas% objects (may be multiple times) as follows?
(define frame (new frame%
[label "Example"]
[width 500]
[height 500]))
(new canvas% [parent frame]
[paint-callback
(lambda (canvas dc)
(send dc draw-bitmap (image->bitmap flowerImg) 20 20) ; place image
(send dc draw-bitmap (image->bitmap flowerImg) 200 200); place image
)])
(send frame show #t)
The image->bitmap function is from https://lists.racket-lang.org/users/archive/2014-December/065110.html
(define (image->bitmap image)
(let* ([width (image-width image)]
[height (image-height image)]
[bm (make-bitmap width height)]
[dc (send bm make-dc)])
(send dc clear)
(send image draw dc 0 0 0 0 width height 0 0 #f)
bm))
The flowerImg is from: https://docs.racket-lang.org/teachpack/2htdpimage.html
(define flowerImg
(let ([petal (put-pinhole
20 20
(ellipse 100 40 "solid" "purple"))])
(clear-pinhole
(overlay/pinhole
(circle 30 "solid" "yellow")
(rotate (* 60 0) petal)
(rotate (* 60 1) petal)
(rotate (* 60 2) petal)
(rotate (* 60 3) petal)
(rotate (* 60 4) petal)
(rotate (* 60 5) petal)))))
Currently, I am using external programs to capture these animations as videos from screen and convert them to gif file, which I possibly can read as image and place on canvas.