Wrap text when displaying text as an image in racket - scheme

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.

Related

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 .

Racket merging two images (background picture with another one) image->color-list

I have one question about Racket. How can I merge two images (first, into lists and then from lists into one image). I found a procedure:
(define (outerProcedure)
(define (colourLists bg fg)
(let ((color-lst1 (image->color-list bg))
(color-lst2 (image->color-list fg)))
<inner body>))
<outer body>
; colourLists is called at some point in the outer body
(colourLists bg fg)) ; bg and fg were defined somewhere else
But I cound not begin with it, Can You please help me?
Regards
Helena
You don't actually need to turn each image into a list of colors. The overlay function and friends will compose images for you:
(define (compose-two-images img1 img2)
(overlay img1 img2))
I'm not sure exactly how this fits into the sample code you posted, you may want to be more specific about what outerProcedure is supposed to do.
Here is an example:
#lang racket
(require 2htdp/image)
(define (color-add c1 c2)
(make-color (quotient (+ (color-red c1) (color-red c2)) 2)
(quotient (+ (color-green c1) (color-green c2)) 2)
(quotient (+ (color-blue c1) (color-blue c2)) 2)))
(define width 100)
(define height 100)
(define background (rectangle width height "solid" "transparent"))
(define image1 (overlay background (rectangle 50 50 "solid" "yellow")))
(define image2 (overlay background (triangle 100 "solid" "blue")))
(define colors1 (image->color-list image1))
(define colors2 (image->color-list image2))
(define colors3 (map color-add colors1 colors2))
(define image3 (color-list->bitmap colors3 width height))
image3

Using struct in Racket

I am a newbie in Racket. I was trying question 1 from here. Following is the code that I could make :
#lang racket
(require 2htdp/image)
(require rackunit)
(require rackunit/text-ui)
(require "extras.rkt")
(define curr-dir "n")
(define curr-x 30)
(define curr-y 40)
;; Structure that I thought about
(define-struct robot (x y direction))
(define irobot (make-robot curr-x curr-y curr-dir))
(define MAX_HEIGHT 200)
(define MAX_WIDTH 400)
(define (render-robot)
(place-image
(crop 14 0 10 20 (circle 10 "solid" "blue"))
19 10
(circle 10 "solid" "red"))
)
(define (spawn-robot x y direction)
(place-image
(cond
[(string=? "n" direction) (rotate 90 (render-robot))]
[(string=? "e" direction) (render-robot)]
[(string=? "w" direction) (rotate 180 (render-robot))]
[(string=? "s" direction) (rotate 270 (render-robot))]
)
x y
(empty-scene MAX_WIDTH MAX_HEIGHT)
)
)
(define (initial-robot x y)
(if (and (<= x (- MAX_HEIGHT 10)) (<= y (- MAX_WIDTH 10)))
(spawn-robot x y curr-dir)
(error "The placement of the robot is wrong!")
)
)
(define robot1 (initial-robot curr-x curr-y))
;;-----------------------------------------------------;;
;; Doubt Here (Make the robot turn left)
(define (robot-left robot-obj)
(set! curr-dir "w") ;; Hard coded for north direction
(initial-robot curr-x curr-y)
)
;; Doubt Here (Function checks whether robot is facing north or not.)
(define (robot-north? robot-obj)
(if (string=? "n" curr-dir) (true) (false))
)
In the interpreter I tries this out:
I was thinking that the code is probably going fine but still some doubts cropped up in my mind:
In the code according to me using a Structure (make-struct) should
have been good but according to explanation of the question I think
the instance of robot is the result of the function initial-robot.
Is using a Structure feasible?
In the functions robot-left and robot-north? how should I use
robot1 as the argument? Setting a global variable that stores the
current direction of the object can to used for the functions
mentioned. What should I do here?
Any suggestion is welcome.
Thanks!
You are correct that a struct would be a better choice:
1) You wouldn't be limited to a single robot in your code, and
2) You would be programming in a functional manner, which is what the assignment wants.
So, with your robot struct:
(define-struct robot (x y direction))
Make sure you give a proper data definition to the struct.
;; A Robot is a (make-robot x y direction), where:
;; - x is an integer
;; - y is an integer
;; - direction is a string
Although, I'd recommend using symbols instead of strings for direction.
(robot-left):
;; Turns a robot to the left.
;; Robot -> Robot
(define (robot-left robot-obj)
(make-robot (robot-x robot-obj)
(robot-y robot-obj)
"w"))
(robot-north?):
;; Does robot-obj face north?
;; Robot -> Boolean
(define (robot-north? robot-obj)
(string=? (robot-direction robot-obj) "n"))
Now, to incorporate these functions into your code, you need to make sure that you separate the idea of data and output images, which you currently don't.
(initial-robot) should not render at all. It should just return an instance of a Robot, as defined in our data definition.
Notice that the spec given in this homework assignment does not require you to render at all. This would be a separate undertaking. All functions that they ask you to define strictly deal with data. Afterwards, you can consider rendering to test your functions visually, as an extra to the unit tests you should also create for each function.
The code that I've provided you should be a good starting point for figuring out how you would design the rest of your functions. Don't worry about rendering until the end! Don't forget that every signature given in the homework assignment that mentions Robot is referencing the data definition that we have created for our robot struct.

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