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)
Related
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]))
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)
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
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?))
I'm playing a little with Racket big-bang mechanism, but I cannot get both smooth and fast going projectile. There's so much ugly flickering. Here's my code:
(require 2htdp/universe
2htdp/image)
(define gx 0)
(define gy 0.35)
(struct ballstate (x y vx vy) #:transparent)
(define startstate (ballstate 10 590 7 -20))
(define (make-new-state old)
(define newvx (+ (ballstate-vx old) gx))
(define newvy (+ (ballstate-vy old) gy))
(ballstate (+ (ballstate-x old) newvx)
(+ (ballstate-y old) newvy)
newvx
newvy))
(define (main)
(big-bang startstate
[on-tick make-new-state]
[to-draw place-ball-at]
[on-key reset]))
(define (place-ball-at s)
(place-image (circle 10 "solid" "red")
(ballstate-x s)
(ballstate-y s)
(empty-scene 800 600)))
(define (reset s ke)
startstate)
(main)
The question is: how to make it better, faster, smoother and flicker-free?
Here are two things that might help:
The on-tick clause takes an optional parameter that determines the time between two ticks. The default is 1/28, so if you lower this you will get more frames resulting in a smoother animation.
If your program takes longer than the time between each tick to produce an image, you will see stuttering. Precomputing everything that can be precomputed is a good thing. For example, there is no reason to produce a new empty scene each time, so below I have simply stored it in a variable.
(define (main)
(big-bang startstate
[on-tick make-new-state 1/50]
[to-draw place-ball-at]
[on-key reset]))
(define background (empty-scene 800 600))
(define (place-ball-at s)
(place-image (circle 10 "solid" "red")
(ballstate-x s)
(ballstate-y s)
background))