How to use on-mouse function in Racket? - racket

I am trying to make a text mover, which is the text will move to where I clicked. Also, when I press "left" key, I can change the color of the text. I think I finished each part the program needs, but I don't know how to put them together now :( I am still confused about how to use on-mouse function.
This is the position of the text part:
(require 2htdp/image)
(require 2htdp/universe)
(define POSN-0 (make-posn 50 50))
(define POSN-1 (make-posn 200 200))
(define POSN-2 (make-posn 100 100))
(define (posn-temp p)
(... (posn-x p) ...
(posn-y p) ...))
This is the color part:
(define Red "red")
(define Black "black")
(define Purple "purple")
(check-expect (RBP Red) "red")
(check-expect (RBP Black) "black")
(check-expect (RBP Purple) "purple")
(define (RBP c)
(cond
[(string=? c Red) "red"]
[(string=? c Black) "black"]
[(string=? c Purple) "purple"]))
This part provides all the information needed for the text-mover application, but I don't know how to use it??
(define-struct tm [str pos col])
(define T1(make-tm "apple" 10 "red"))
(define T2(make-tm "banana" 20 "black"))
(define (tm-temp tm)
(... (tm-str tm) ...
(tm-pos tm) ...
(tm-col tm) ...))
To-draw:
(define bg (square 400 "solid" "white"))
(check-expect
(draw-tm POSN-0)
(place-image
(text "POG!"
25
"red")
50 50
bg))
(define (draw-tm c)
(place-image
(text "POG!"
25
(RBP c))
50 50
bg))
On-key:
(define (change-c c ke)
(cond
[(key=? ke "left") (RBP c)]
[else c]))
On-mouse:
(define (move-tm c )
(cond
[(mouse=? ) ]
[else c]))
Big-bang:
(define (move-text initial-tm)
(big-bang initial-tm
[to-draw draw-tm]
[on-mouse move-tm]
[on-key change-c]))

Read on-mouse description: function called with on-mouse has arguments state x y event and different types of mouse events are described in Mouse event docs. In your case, you will need "button-up" or "drag".
Also, when x or y or color changes, you have to create new instance of struct which represents state, using data from old instance.
Here is example code- run it with (move-text "FooBar"), you can drag displayed text into new position or change color with left key.
(require 2htdp/image)
(require 2htdp/universe)
(define-struct text-state [text position color])
(define (next-color color)
(second (assoc color (list (list "black" "red")
(list "red" "purple")
(list "purple" "black")))))
(define bg (square 400 "solid" "white"))
(define (draw-state state)
(place-image
(text (text-state-text state)
25
(text-state-color state))
(posn-x (text-state-position state))
(posn-y (text-state-position state))
bg))
(define (change-color state key)
(if (key=? key "left")
(make-text-state (text-state-text state)
(text-state-position state)
(next-color (text-state-color state)))
state))
(define (mouse-fn state x y event)
(if (string=? "drag" event)
(make-text-state
(text-state-text state)
(make-posn x y)
(text-state-color state))
state))
(define (move-text text)
(big-bang (make-text-state text (make-posn 50 50) "black")
[to-draw draw-state]
[on-mouse mouse-fn]
[on-key change-color]))

Related

Turning a vector into a list and then into an image in Racket

So, my brain is fried and in class we are working on Conway's Game of Life in DrRacket. This is an Intro to CS class so this is proving to be difficult for me, since coding is very new to me.
I have used lists in animation before but I am lost as to how to turn a vector into an image. Our prof gave us the hint of turning a vector into a list and then we should be able to create the image. I can turn the vector into a list but then I get lost. Any help, guidance or advice would be so greatly appreciated...greatly greatly appreciated.
This isn't all of the code, just a sample.
(define small-board (vector
(vector 1 0)
(vector 0 1))
)
(define live-square (square 10 "solid" "blue"))
(define dead-square (square 10 "solid" "red"))
;Purpose: Create a function that turns board into an image
;Signature: Vector of Vectors -> Image
;Example
(check-expect (board->image small-board)
(above (beside live-square dead-square)
(beside dead-square live-square))
)
;Code
(define (board->image brd)
...
Since you can turn the 2d vector into a 2d list, I can show you how to turn the 2d list into an image.
(require 2htdp/image)
(define small-board (vector (vector 1 0) (vector 0 1)))
(define small-board-as-list (list (list 1 0) (list 0 1)))
(define live-square (square 10 "solid" "blue"))
(define dead-square (square 10 "solid" "red"))
(define MT empty-image)
Recur over the board and put every rendered row above the rest of the rendered board. Within a helper, recur over the row and put each rendered cell beside the rendered "rest" of the row.
; [List-of [List-of (U 1 0)]] -> Image
(define (board->image b)
(cond [(empty? b) MT]
[else (above (row->image (first b))
(board->image (rest b)))]))
; [List-of (U 1 0)] -> Image
(define (row->image r)
(cond [(empty? r) MT]
[else (beside (cell->image (first r))
(row->image (rest r)))]))
; Cell -> Image
(define (cell->image c)
(if (= 1 c) live-square dead-square))
The recursive structure can be abstracted using foldr:
; [List-of [List-of (U 1 0)]] -> Image
(define (board->image-abs.v1 b)
(foldr (λ (r b) (above (foldr (λ (c r) (beside (cell->image c) r)) MT r) b)) MT b))
We can also use map and apply
; [List-of [List-of (U 1 0)]] -> Image
(define (board->image-abs.v2 b)
(apply above (map (λ (r) (apply beside (map (λ (c) (cell->image c)) r))) b)))
The result
(board->image small-board-as-list)
(board->image-abs.v1 small-board-as-list)
(board->image-abs.v2 small-board-as-list)

Programming Breakout in BSL

I am currently trying to code 'Breakout' in BSL but I'm stuck as I
don't know how to add a welcome and a game-over screen to my code. It is
supposed that the game starts with the welcome screen and when it is
clicked with the mouse on the screen the actual game should start. When
the ball collides with the lower edge of the screen a game-over-screen
is supposed to appear.
I appreciate any tips given!
(define WIDTH 200)
(define HEIGHT 200)
(define BALL-RADIUS 10)
(define BALL-IMG (circle BALL-RADIUS "solid" "red"))
(define MT (empty-scene WIDTH HEIGHT))
(define GAME-OVER
(place-image (text "Game-over" 30 "black")
100 100
MT))
(define WELCOME
(place-image (text "Welcome" 30 "black")
100 100
MT))
(define-struct vel (delta-x delta-y))
; a Vel is a structure: (make-vel Number Number)
; interp. the velocity vector of a moving object
(define-struct ball (loc velocity))
; a Ball is a structure: (make-ball Posn Vel)
; interp. the position and velocity of a object
(define RACKET (rectangle 30 10 "solid" "grey"))
(define-struct world-state (ball racket))
; A WorldState is a structure. (make-world-state Ball Location of
Racket)
; interp. current velocity and location of ball, current location of
racket
; Posn Vel -> Posn
; applies q to p and simulates the movement in one clock tick
(check-expect (posn+vel (make-posn 5 6) (make-vel 1 2))
(make-posn 6 8))
(define (posn+vel p q)
(make-posn (+ (posn-x p) (vel-delta-x q))
(+ (posn-y p) (vel-delta-y q))))
; Ball -> Ball
; computes movement of ball in one clock tick
(define (move-ball ball)
(make-ball (posn+vel (ball-loc ball)
(ball-velocity ball))
(ball-velocity ball)))
; A Collision is either
; - "top"
; - "down"
; - "left"
; - "right"
; - "racket"
; - "none"
; interp. the location where a ball collides with a wall
; Posn -> Collision
; detects with which of the walls (if any) or the racket the ball
collides
(define (collision world-state)
(cond
[(<= (posn-x (ball-loc (world-state-ball world-state))) BALL-
RADIUS) "left"]
[(<= (posn-y (ball-loc (world-state-ball world-state))) BALL-
RADIUS) "top"]
[(>= (posn-x (ball-loc (world-state-ball world-state))) (- WIDTH
BALL-RADIUS)) "right"]
[(>= (posn-y (ball-loc (world-state-ball world-state))) (- HEIGHT
BALL-RADIUS)) "down"]
[(and (>= (posn-y (ball-loc (world-state-ball world-state))) (-
HEIGHT BALL-RADIUS 10))
(<= (- (posn-x (world-state-racket world-state)) 15)
(posn-x (world-state-racket world-state))
(+ (posn-x (world-state-racket world-state)) 15)))
"racket"]
[else "none"]))
; Vel Collision -> Vel
; computes the velocity of an object after a collision
(define (bounce vel collision)
(cond [(or (string=? collision "left")
(string=? collision "right"))
(make-vel (- (vel-delta-x vel))
(vel-delta-y vel))]
[(or (string=? collision "top")
(string=? collision "racket"))
(make-vel (vel-delta-x vel)
(- (vel-delta-y vel)))]
[else vel]))
; render
; WorldState -> Image
; renders ball and
racket at their position
(check-expect (image? (render INITIAL-STATE)) #true)
(define (render world-state)
(place-image BALL-IMG
(posn-x (ball-loc (world-state-ball world-state)))
(posn-y (ball-loc (world-state-ball world-state)))
(place-image RACKET
(posn-x (world-state-racket world-state))
195
(empty-scene WIDTH HEIGHT))))
;tick
; WorldState -> WorldState
; moves ball to its next location
(check-expect (tick INITIAL-STATE) (make-world-state (make-ball (make-posn 21 14) (make-vel 1 2)) (make-posn 20 195)))
(define (tick world-state)
(make-world-state (move-ball (make-ball (ball-loc (world-state-ball world-state))
(bounce (ball-velocity (world-state-ball world-state))
(collision world-state))))
(world-state-racket world-state)))
; A Location is a structure: (make-posn Number Number)
; interp. x and y coordinate of a location on screen.
(define Loc (make-posn 1 1))
; A MouseEvent is one of
; - "button-down"
; - "button-up"
; - "drag"
; - "move"
; - "enter"
; - "leave"
; interp. mouse events, e.g., mouse movements or mouse clicks
(define MOUSE-CLICK "button-down")
; mouse
;
; Game Number Number MouseEvent -> WorldState
; Update position of racket when the mouse moves
;mouse-template
(define (mouse-template world-state mouse-loc-x mouse-loc-y MouseEvent)
(cond
((string=? MouseEvent "button-down")...)
((string=? MouseEvent "button-up")...)
((string=? MouseEvent "drag")...)
((string=? MouseEvent "move")...)
((string=? MouseEvent "enter")...)
((string=? MouseEvent "leave")...)
(else ...)))
(define (mouse world-state mouse-loc-x mouse-loc-y MouseEvent)
(cond
[(and (string=? MouseEvent "move")
(>= mouse-loc-y 180))
(make-world-state (world-state-ball world-state)
(make-posn mouse-loc-x 195))]
[else world-state]))
(define INITIAL-BALL (make-ball (make-posn 20 12)
(make-vel 1 2)))
(define INITIAL-RACKET (make-posn 20 195))
(define INITIAL-STATE (make-world-state INITIAL-BALL INITIAL-RACKET))
; WorldState -> WorldState
; Starts the game
(define (main state)
(big-bang state
(on-tick tick 0.01)
(to-draw render)
(on-mouse mouse)))
; start with INITIAL-STATE
You now have three different states:
welcome
playing
game-over
So far you have only had "playing" and you used your world structure to represent that.
Now you need to introduce two new structures: welcome and game-over.
Rename your old render function render-world (or render-playing).
Then write something like:
(define (render w)
(cond
[(welcome? w) (render-welcome w)]
[(world? w) (render-world w)]
[(game-over? w) (render-game-over w)]))
Of course your initial state should become an instance of welcome, and you also need three different tick functions.

Remove a life from my game when dot passes certain point?

I'm designing a game for a class where:
A colored dot appears from the right side of the screen and moves across the screen to the left on a fixed horizontal axis.
When the dot reaches the middle, the player needs to press a key corresponding to its color. If done at the right time, the score increases by one.
If not, the player loses one life.
I'm having trouble with the following:
[SOLVED] Adding a new dot to the list of dots at random intervals in the game. This will make it so the dots don't appear linearly, and two dots can be generated right after one another.
[SOLVED] Moving the dots across the screen left to right.
[SOLVED] Removing the correct dot when it's in the hitbox area.
Removing a life if a dot goes offscreen.
The language used here is intermediate student with lambda.
Currently, when I press 1 for red, it will remove it as long as a red dot is the first in the list. I need a function that removes that specific red dot.
Here's the code so far; know that it's not finished and thus not working as I intend it to.
; Color Match
; Game structures
(define-struct dot [x color])
(define-struct cm [dots score lives state])
; Constants
(define width 800)
(define height (/ width (/ 16 9)))
(define h-w (/ width 2))
(define h-h (/ height 2))
(define arrow (beside (rectangle 25 10 "solid" "black")
(rotate 135 (right-triangle 18 18 "solid" "black"))))
(define background (empty-scene width height))
(define bars (place-images
(list
(circle (/ width 25) "outline" "black")
(rectangle (+ width 2) (- height 375) "outline" "black"))
(list
(make-posn h-w h-h)
(make-posn h-w h-h))
background))
; Game
(define (main ws)
(big-bang (make-cm empty 0 3 "start")
[on-tick tock]
[to-draw render]
[on-release interact]
))
;; random-color: number -> string
;; consumes a number and returns a color
;; string for the given number
(define (random-color n)
(cond
[(= n 0) "red"]
[(= n 1) "blue"]
[(= n 2) "green"]
[(= n 3) "yellow"]
[else (error "Invalid color chosen.")]))
;; draw-dot: structure -> image
;; consumes a dot structure and draws it as an image
(define (draw-dot struct)
(cond
[(string=? (dot-color struct) "red") (overlay
(rotate 90 arrow)
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]
[(string=? (dot-color struct) "blue") (overlay
(rotate 270 arrow)
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]
[(string=? (dot-color struct) "green") (overlay
(flip-horizontal arrow)
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]
[(string=? (dot-color struct) "yellow") (overlay
arrow
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]))
;; tock: color-match -> color-match
;; placeholder for later worldstate
(define (tock ws)
(cond
[(string=? (cm-state ws) "play")
(make-cm (move-dots (add-dot? (random 50) (cm-dots ws)))
(+ (cm-score ws) 1)
(cm-lives ws)
"play")]
[else ws]))
;; add-dot?: number, list of dots -> list of dots
;; consumes list of dots and number and adds a new dot
;; to the list of dots
(define (add-dot? n lod)
(cond
[(= n 1) (cons (make-dot (+ width 25) (random-color (random 4))) lod)]
[else lod]))
;; render: color-match -> image
;; consumes the current color-match structure and calls the appropriate
;; helper function.
(define (render ws)
(cond
[(string=? (cm-state ws) "start") (render-start ws)]
[(string=? (cm-state ws) "play") (render-play ws)]
[(string=? (cm-state ws) "pause") (render-pause ws)]
[else (error "Invalid gamestate chosen.")]))
;; render-start: color-match -> image
;; helps the render function by displaying the current state
;; as an image.
(define (render-start ws)
(place-image
(above
(text "Instructions" (/ width 20) "red")
(text "Colored shapes will begin appearing from the right of the screen." (/ width 50) "black")
(text "Once they reach the bar in the middle, press the appropriate key." (/ width 50) "black")
(text "1: Red" (/ width 50) "red")
(text "2: Blue" (/ width 50) "blue")
(text "3: Green" (/ width 50) "green")
(text "4: Yellow" (/ width 50) "yellow"))
h-w
h-h
background))
;; draw-dots: list of dots -> image
;; consumes a list of dots and draws them
;; according to their color
(define (draw-dots lod)
(cond
[(empty? lod) bars]
[else (place-image (draw-dot (first lod))
(dot-x (first lod))
h-h
(draw-dots (rest lod)))]))
;; is-visible?: dot -> boolean
;; consumes a dot and determines if it is currently visible
;; on the canvas
(define (is-visible? dot)
(cond
[(> (dot-x dot) -25) #true]
[else #false]))
;; move-dot: dot -> number
;; consumes a dot and returns its new
;; x coordinate
(define (move-dot dot)
(- (dot-x dot) 10))
;; new-dot: dot -> dot
;; consumes a dot and returns a new dot by calling
;; the move-dot function
(define (new-dot dot)
(make-dot (move-dot dot) (dot-color dot)))
;; move-dots: list of dots -> list of dots
;; consumes a list of dots and moves them across the
;; canvas as long as they are in view
(define (move-dots lod)
(cond
[(empty? lod) empty]
[(not (is-visible? (first lod))) (rest lod)]
[else (cons (new-dot (first lod)) (move-dots (rest lod)))]))
;; draw-bars: cm -> image
;; consumes the world state and returns the image of bars
(define (draw-bars ws)
(place-image (draw-dots (cm-dots ws))
h-w
h-h
bars))
;; render-play: color-match -> image
;; helps the render function by displaying the current state
;; as an image.
(define (render-play ws)
(overlay/align "left" "top" (current-lives ws)
(underlay/align "right" "top" (place-image (draw-bars ws)
h-w
h-h
background)
(current-score ws))))
;; current-lives: cm -> image
;; consumes the worldstate and displays the
;; current life count
(define (current-lives ws)
(text (string-append "Lives: " (number->string (cm-lives ws))) 18 "red"))
;; current-score: cm -> image
;; consumes the worldstate and shows the
;; current score
(define (current-score ws)
(text (string-append "Score: " (number->string (cm-score ws))) 18 "black"))
;; render-pause: color-match -> image
;; helps the render function by displaying the current state
;; as an image.
(define (render-pause ws)
(place-image
(text "paused" (/ width 20) "red")
h-w
(- h-h 75)
(render-play ws)))
; (define (check-dot lod key)
; (cond
; [(empty? lod) empty]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "red") (key=? key "1")) (remove (make-dot (dot-x (first lod)) "red") lod)]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "blue") (key=? key "2")) (remove (make-dot (dot-x (first lod)) "blue") lod)]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "green") (key=? key "3")) (remove (make-dot (dot-x (first lod)) "green") lod)]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "yellow") (key=? key "4")) (remove (make-dot (dot-x (first lod)) "yellow") lod)]
; [else lod]))
;; correct-dot? cm, lod, string -> list of dots
;; consumes the world state, its list of dots, a string, and sorts
;; out dots that have been correctly selected
(define (correct-dot? lod c)
(cond
[(empty? lod) empty]
[(and (< (- h-w (+ (/ width 25) 1)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 1))) (string=? (dot-color (first lod)) c)) (correct-dot? (rest lod) c)]
[else (cons (first lod) (correct-dot? (rest lod) c))]))
;; is-it?: list of dots, key -> list of dots
;; consumes a list of dots and a key and returns
;; a new list of dots with one removed if the
;; conditions are met for it
(define (is-it? lod key)
(cond
[(empty? lod) empty]
[(key=? key "up") (correct-dot? lod "red")]
[(key=? key "down") (correct-dot? lod "blue")]
[(key=? key "left") (correct-dot? lod "green")]
[(key=? key "right") (correct-dot? lod "yellow")]
[else lod]))
;; interact: color-match, key -> color-match
;; consumes the current color-match state and returns
;; a new one depending on which key is pressed.
(define (interact ws key)
(cond
[(string=? (cm-state ws) "play")
(cond
[(key=? key "p") (make-cm (cm-dots ws)
(cm-score ws)
(cm-lives ws)
"pause")]
[else (make-cm (is-it? (cm-dots ws) key)
(cm-score ws)
(cm-lives ws)
(cm-state ws))])]
[(and (string=? (cm-state ws) "start") (key=? key "p")) (make-cm (cm-dots ws)
(cm-score ws)
(cm-lives ws)
"play")]
[(and (string=? (cm-state ws) "pause") (key=? key "p")) (make-cm (cm-dots ws)
(cm-score ws)
(cm-lives ws)
"play")]
[else ws]))
(main 200)
In ISL lists are not mutable so the only thing that you are able to do is create a new list with everything except what you want to remove. You could possibly filter through the list with your procedure only accepting the elements you want to keep

dr racket code error beginning student language

I am writing a function that consumes two images and produces true if the first is larger than the second
here is my code
(require 2htdp/image)
(check-expect(image1 30 40)false)
(check-expect(image1 50 20)true)
(define(image1 x y)
(begin
( circle x "solid" "blue")
(circle y "solid" "blue")
(if(> x y)
"true"
"false")))
(image1 500 100)
But it is showing the same error again and again by highlighting this portion of the code ->(circle y "solid" "blue") the error is-> define: expected only one expression for the function body, but found 2 extra parts kindly tell me what is wrong
The values true and false are simply written as true and false.
(define (image1 x y)
(circle x "solid" "blue")
(circle y "solid" "blue")
(if (> x y)
true
false))
Note that the your function doesn't use the images, so you can write
(define (image1 x y)
(if (> x y)
true
false))
But I guess it was just an example.
UPDATE
You can use local definitions to give names to temporary values:
(define (image1 x y)
(local
[(define c1 (circle x "solid" "blue"))
(define c2 (circle y "solid" "blue"))]
(if (> x y)
true
false)))
UPDATE
(define (larger? image1 image2)
(and (> (image-width image1) (image-width image2)
(> (image-height image1) (image-height image2)))
UPDATE
Here is a complete example:
(define circle1 (circle 20 "solid" "blue"))
(define circle2 (circle 30 "solid" "blue"))
(define (larger? image1 image2)
(and (> (image-width image1) (image-width image2))
(> (image-height image1) (image-height image2))))
(larger? circle1 circle2)

How to paint on previous picture in the functional way in Racket

This code maintains number of ticks, but all ways paints on a new screen
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(define pasaulis (empty-scene 100 100))
(define (trace-circle t)
(place-image (circle 5 "solid" "blue")
(+ 50(* 40 (cos (/ t 100))))
(+ 50(* 40 (sin (/ t 100))))
pasaulis))
(define (render t)
(text (number->string t) 12 "red"))
(big-bang 1000000
(on-tick sub1 1/500)
(to-draw trace-circle)
(stop-when zero?)
(record? true))
The following code does maintain picture, but I could not have number of ticks passed to the pain handler.
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(require picturing-programs)
(define (move-right-10 picture)
(beside (rectangle 10 0 "solid" "white")
picture))
(big-bang pic:calendar
(on-draw show-it 500 100)
(on-tick move-right-10 1/22))
I just cannot figure it out. how to have draw function with number of ticks, while modifying the screen. Is the big-bang function suitable at all for the purpose?
Here is an example:
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(struct world (ticks pic))
(define pasaulis (empty-scene 1000 1000))
(define (render w)
(world-pic w))
(define (handle-on-tick w)
(define t (world-ticks w))
(define p (world-pic w))
(define new-ticks (+ t 1))
(define new-pic (overlay/xy (text (number->string t) 12 "red")
(* -10 t) (* -10 t)
p))
(world new-ticks new-pic))
(define (stop? w)
(= (world-ticks w) 50))
(big-bang (world 0 pasaulis)
(on-tick handle-on-tick 1/5)
(to-draw render)
(stop-when stop?))