How to get animation as an image object - image

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.

Related

DrRacket: How to smoothly draw large bitmap on canvas

(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

How to animate points over a function plot in Racket?

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. ;)

Animating a series of images at multiple places using threads

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:

scheme/racket: canvas manipulation

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 .

Why can't I make two make function calls in function body?

So I'm going through the first chapter of How To Design Programs 2nd Edition. I believe I made pretty good progress. But there's a "suggestion" to add another graphic to the grid. Every time I try I get an error. At this point, I'm stuck. Below is the code and the error.
Note: the ROCKET image is in the Chapter 1. I just copy and pasted it into the IDE.
Note: The "suggestion" is: How would change the program so that the rocket lands on a flat rock bed that is 10 pixels higher than the bottom of the scene? Don’t forget to change the scenery, too.
HTDP Chapter 1
Here's code that works.
(define BOARDWIDTH 200)
(define BOARDHEIGHT 200)
(define STARTPOSITION 50)
(define BOARDBKGR "blue")
(define GAMEBOARD (empty-scene BOARDWIDTH BOARDHEIGHT BOARDBKGR))
(define ROCKET .)
(define UFO (overlay (circle 10 "solid" "red")
(rectangle 40 4 "solid" "green")))
(define FLATBED (rectangle 60 10 "outline" "black"))
(define (SPACESHIP option)
(cond
[(= option 1) ROCKET]
[(= option 2) UFO]))
(define SHOWNSHIP (SPACESHIP 1))
(define V 20) ;Velocity
(define A 1) ;Acceleration
(define (distance t) ;t = Time
(- (* V t) (* 1/2 A (sqr t))))
(define SPACESHIP-BOTTOM (- BOARDHEIGHT (/ (image-height SHOWNSHIP) 2)))
(define (render-shownship x y)
(place-image SHOWNSHIP x y GAMEBOARD))
(define (create-rocket-scene.v7 t)
(cond
[(<= (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION (distance t))]
[(> (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION SPACESHIP-BOTTOM)]))
Here's the code that doesn't work:
(define BOARDWIDTH 200)
(define BOARDHEIGHT 200)
(define STARTPOSITION 50)
(define BOARDBKGR "blue")
(define GAMEBOARD (empty-scene BOARDWIDTH BOARDHEIGHT BOARDBKGR))
(define ROCKET .)
(define UFO (overlay (circle 10 "solid" "red")
(rectangle 40 4 "solid" "green")))
(define FLATBED (rectangle 60 10 "outline" "black"))
(define (SPACESHIP option)
(cond
[(= option 1) ROCKET]
[(= option 2) UFO]))
(define SHOWNSHIP (SPACESHIP 1))
(define V 20) ;Velocity
(define A 1) ;Acceleration
(define (distance t) ;t = Time
(- (* V t) (* 1/2 A (sqr t))))
(define SPACESHIP-BOTTOM (- BOARDHEIGHT (/ (image-height SHOWNSHIP) 2)))
(define (render-shownship x y)
(place-image SHOWNSHIP x y GAMEBOARD)
(place-image FLATBED STARTPOSITION 195 GAMEBOARD)) ;offender
(define (create-rocket-scene.v7 t)
(cond
[(<= (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION (distance t))]
[(> (distance t) SPACESHIP-BOTTOM)
(render-shownship STARTPOSITION SPACESHIP-BOTTOM)]))
And the error I get is:
define: expected only one expression for the function body, but found
1 extra part
place-image always takes 4 arguments - the image to be placed, x and y coordinates, and the scene (background) on which to place the image. The problem in your code is that the expression (place-image FLATBED STARTPOSITION 195) is providing only 3 inputs to place-image.
So, back up a little and consider: what does the first expression produce? (place-image SHOWNSHIP x y GAMEBOARD) produces a game board scene with a ship on it, correct? Now on top of that scene you further want to place the FLATBED. So instead of sequencing the place-image function calls, instead consider composing them - i.e. what do you think the missing piece is in (place-image FLATBED STARTPOSITION 195 ____)? upon what scene do you want to place the FLATBED? (Hint: we just answered that above). What expression produces that scene? (hint: you already have that expression).
If you understand the idea, you see that to place multiple images on a scene, you compose or nest the function calls (instead of sequencing them as you are attempting):
(place-image img1 x1 y1 (place-image img2 x2 y2 ...))

Resources