I'm trying to create a game whose name is "Same" in Racket 5.0.2 version.
Here is explanation of the game:
http://download.racket-lang.org/docs/5.0.2/html/games/same.html?q=games
I created a row and draw it:
a: width
b: height
r: radius
(define (color x) ///for random colors
(cond [(< (random x) 100) 'blue]
[(< (random x) 200) 'purple]
[(< (random x) 300) 'yellow]
[(< (random x) 400) 'red]
[else 'green]))
(define-struct top (coord color))
(define (row x y)
(if (> x (- a r)) empty
(cons (make-top (make-posn x y)(color 500)) (row (+ x (* 2 r)) y))))
(define (draw-row L)
(if (empty? L) #f
(and
(draw-solid-disk (top-coord (first L)) r (top-color (first L)))
(draw-row (rest L)))))
So I've got a top row included 20 disks with random colors. But I need 200 disks in 20 rows and 10 columns. So I created a board like this:
(define (board x y)
(if (> y (- b r)) empty
(cons (row x y) (board x (+ y (* 2 r))))))
But I couldn't draw it. I tried to create a function as "draw-row" but I got error.
So my question is: How can I draw this board?
You can draw a row, and a board is just a list of rows, so I would expect
(define (draw-board b)
(for-each draw-row b))
to Just Work.
Based on your comment, an example I would expect to work:
(draw-board (board 10 10))
and it does for me, at least.
Related
The on-tick clause includes an option to change the clock tick rate. I have included my code to dynamically change the value depending on the world state value. The code is not working and I can't understand why. Another issue - how are world programs debugged? The "step" option doesn't work.
; physical constants
(define HEIGHT 300)
(define WIDTH 100)
(define YDELTA 3)
; graphical constants
(define BACKG (empty-scene WIDTH HEIGHT))
(define ROCKET (rectangle 5 30 "solid" "red"))
(define ROCKET-CENTER (/ (image-height ROCKET) 2))
(define ROCKET-XPOS 10)
; LRCD -> LRCD
(define (main1 s)
(big-bang s
[to-draw show]
[on-key launch]
[on-tick fly (clock-rate s)]))
; LRCD -> Image
; renders the state as a resting or flying rocket
(define (show x)
(cond
[(string? x) (rocket-ht HEIGHT)]
[(<= -3 x -1)
(place-image (text (number->string x) 20 "red")
ROCKET-XPOS (* 3/4 WIDTH)
(rocket-ht HEIGHT))]
[(>= x 0)
(rocket-ht x)]))
; LRCD -> image
; positions the rocket at correct height
(define (rocket-ht ht)
(place-image ROCKET ROCKET-XPOS (- ht ROCKET-CENTER) BACKG))
; LRCD KeyEvent -> LRCD
; starts the count-down when space bar is pressed,
; if the rocket is still resting
(define (launch x ke)
(cond
[(string? x) (if (string=? ke " ") -3 x)]
[else x]))
; LRCD -> LRCD
; raises the rocket by YDELTA,
; if it is moving already
(define (fly x)
(cond
[(string? x) x]
[(<= -3 x -1) (if (= x -1) HEIGHT (add1 x))]
[else (- x YDELTA)]))
(define (clock-rate s)
(cond
[(number? s) (if (< s 0) 1 1/28)]
[else 1/28]))
I have a plotting library I'm building source, and want to plot slope lines. I have a function (draw-seg-list device color lst) with the lst arg being a list containing lists with the start and stop cords of a line (x0 y0 x1 y1). I want to make a function (make-slope-seg x y m) that then returns the point list for a line segment centered at (x, y) with slope m.
Example: (make-slope-seg 0 0 0) -> (-.05 0 .05 0) and (make-slope-seg .1 .1 1) -> (.05 .05 .15 .15)
The non-working function I have is:
(define (make-slope-cords x y m)
(list (- x .05)
(* y m -1)
(+ x .05)
(* y m)))
Which returns the incorrect lines. If I use :
;makes graphics window
(define window (make-graphics-device 'win32))
;plots blue line for function y = x^2 with black axis
(make-plot window 'simple-plot (list "white" "black" "blue" (list (range -1 1 .01) square)))
;makes list of lists containing the slope and x y cords that the slope lines
;are supposed to be centered at
(define cords (map (lambda (s x y)
(list s x y))
(map (lambda (x) (* 2 x)) (range -1 1 .1))
(range -1 1 .1)
(map square (range -1 1 .1))))
;plots the line segments generated by mapping make-slope-cords to the coordinate list
(draw-seg-list window "red"
(map (lambda (lst)
(make-slope-cords (car lst) (cadr lst) (caddr lst)))
cords))
It outputs the following:
But I want it to output red lines of width .1 (1 square on the grid in the image) with slope being the slope of the blue line(lambda (x) (square x)) at each point spaced by .1 along the x axis.
NOTE: assume that draw-seg-list works. I just need assistance in making the function make-slope-cords produce a the correct list of cordinates
Well experimenting around I was able to determine the answer.
(define (make-sloped-seg x y m)
(define b (- y (* m x)))
(list (- x .03)
(+ (* m (- x .03)) b)
(+ x .03)
(+ (* m (+ x .03)) b)))
It determines the y-intercept (b) at the beginning of the calculation, and then generates the points using the correct intercept
example:
;makes graphics window
(define window (make-graphics-device 'win32))
;plots blue line for function y = x^2 with black axis
(make-plot window 'simple-plot (list "white" "black" "blue" (list (range -1 1 .01) square)))
;makes list of lists containing the slope and x y cords that the slope lines
;are supposed to be centered at
(define cords (map (lambda (s x y)
(list s x y))
(map (lambda (x) (* 2 x)) (range -1 1 .1))
(range -1 1 .1)
(map square (range -1 1 .1))))
;plots the line segments generated by mapping make-slope-cords to the coordinate list
(draw-seg-list window "red"
(map (lambda (lst)
(make-slope-cords (car lst) (cadr lst) (caddr lst)))
cords))
outputs the following:
I am trying to write a representation of pairs that does not use cons, car or cdr but still follows the property of pairs, i.e., (car (cons x y)) should be x and (cdr (cons x y)) should be y.
So here is one solution that I got from the SICP book:
(define (special-cons x y)
(lambda (m) (m x y)))
I was able to write another solution but it can only allow numbers:
(define (special-cons a b)
(* (expt 2 a)
(expt 3 b)))
(define (num-divs n d)
(define (iter x result)
(if (= 0 (remainder x d))
(iter (/ x d) (+ 1 result))
result))
(iter n 0))
(define (special-car x)
(num-divs x 2))
(define (special-cdr x)
(num-divs x 3))
Is there any other solution that allows for pairs for any object x and object y?
What about structs (Racket) or record-types (R6RS)?
In Racket:
#lang racket
(struct cell (x y))
(define (ccons x y) (cell x y))
(define (ccar cl) (cell-x cl))
(define (ccdr cl) (cell-y cl))
(define (cpair? cl) (cell? cl))
(define x (ccons 1 2))
(cpair? x)
=> #t
(ccar (ccons 1 2))
=> 1
(ccdr (ccons 3 4))
=> 4
This is a good way of doing it.
#lang racket
(define (my-cons x y)
(lambda (p)
(if (= p 1) x y)))
(define (my-car pair)
(pair 1))
(define (my-cdr pair)
(pair 2))
Here is the test
> (my-car (my-cons 1 '(2 3 4)))
1
> (my-cdr (my-cons 1 '(2 3 4)))
'(2 3 4)
The classic Ableson and Sussman procedural implementation from Structure and Interpretation of Computer Programs (section 2.1.3):
(define (cons x y)
(define (dispatch m)
(cond ((= m 0) x)
((= m 1) y)
(else (error "Argument not 0 or 1 -- CONS" m))))
dispatch)
(define (car z)
(z 0))
(define (cdr z)
(z 1))
Rptx's solution is roughly equivalent, and this is presented for reference.
I'm writing a Gimp Script-Fu script, and trying to use a nested while loop. x is set to 15, y is set to 30. y loops up to 35, yet x stays at 15 and the loop quits. What is wrong here? Why is the value of x not changed?
(while (< x 20)
(while (< y 35)
(gimp-message (string-append (number->string x) "-" (number->string y)))
(set! y (+ y 1)))
(set! x (+ x 1)))
y is never being reset back to 0. Your code will increment y up to 35, then increment x 20 times, however on each subsequent increment of x y is still set to 35.
If you wanted to go over each combination of values of x and y then you would need code more like this:
(while (< x 20)
(set! y 0)
(while (< y 35)
(gimp-message (string-append (number->string x) "-" (number->string y)))
(set! y (+ y 1))
)
(set! x (+ x 1))
)
Here is a more complete example now that I've had time to work through this question with Gimp (I'm using print instead of gimp-message because I'm working in the console, but it should be interchangeable). To start I'm defining a function called SO that accepts the arguments, x, y that both represents pairs of min and max values:
(define (SO x y)
(let* ((x! (car x)) (y! (car y)))
(while (< x! (car (cdr x)))
(set! y! (car y))
(while (< y! (car (cdr y)))
(print (string-append (number->string x!) "-" (number->string y!)))
(set! y! (+ y! 1))
)
(set! x! (+ x! 1))
)
)
)
Inside this function, I'm pulling out the first and last values of x and y (with (car x) and (car (cdr x)) then I'm using let* to create two inner variables calledx!andy!that I will be altering the value of (to remove side effects of havingxandy` change after the function is called). If you call this function like so:
(SO '(15 20) '(30 35))
You get the following output:
"15-30"
"15-31"
"15-32"
"15-33"
"15-34"
"16-30"
"16-31"
"16-32"
"16-33"
"16-34"
"17-30"
"17-31"
"17-32"
"17-33"
"17-34"
"18-30"
"18-31"
"18-32"
"18-33"
"18-34"
"19-30"
"19-31"
"19-32"
"19-33"
"19-34"
I'm really stuck about somethings and I will try to tell my questions correctly, I hope you can understand. It can be a little bit long so firstly thank you to spends your time to read this.
I'm trying to create a game whose name is "Same" in Racket 5.0.2 version.
Here is explanation of the game: http://download.racket-lang.org/docs/5.0.2/html/games/same.html?q=games
I created a table with disks and draw it:
a: width
b: height
r: radius
(define (color x) ///for random colors
(cond [(< (random x) 100) 'blue]
[(< (random x) 200) 'purple]
[(< (random x) 300) 'yellow]
[(< (random x) 400) 'red]
[else 'green]))
(define-struct top (coord color))
(define (row x y)
(if (> x (- a r)) empty
(cons (make-top (make-posn x y)(color 500)) (row (+ x (* 2 r)) y))))
(define (draw-row L)
(if (empty? L) #f
(and
(draw-solid-disk (top-coord (first L)) r (top-color (first L)))
(draw-row (rest L)))))
(define (board x y)
(if (> y (- b r)) empty
(cons (row x y) (board x (+ y (* 2 r))))))
(for-each draw-row (board 20 20))
So I've 200 disks with random colors...(There are 20 disks in every row)
Here my biggest problems are:
1) To delete the disk, player will input particular line and column. Will I have conditions for every choices?
if line=1 and column=1, delete this disk and its same colored adjacent disks
if line=5 and column=7, delete that disk and its same colored adjacent disks
I hope you have some easier, alternative ways because it looks extremely challenging.
2) How can I compare disk's colors in many lists? It's hard to tell my problem but I'll try.
(define table (board 20 20))
(define row1 (list-ref table 0))
(list-ref row1 0)
It will return:
(make-top (make-posn 20 20) 'yellow)
How can I reach 'yellow in here? And if I reach, how can I compare it with other colors?
Any idea would be great! I've been thinking about these questions for 2 days and still I couldn't do anything.
I shouldn't use mutable structures
Structs come with built in accessors:
> (define my-top (make-top (make-posn 20 20) 'yellow))
> (top-color my-top)
'yellow
> (top-coord my-top)
(make-posn 20 20)
> (top? my-top)
true