How to sense multiple key presses with Racket's `big-bang` - scheme

I'm developing a simple Asteroids game in Racket and everything works well, except I want allow the player to move and fire at the same time.
Here are the control keys:
Left / right to rotate
Up / down to speed up, slow down
Space to fire.
And my on-key handler:
(define (direct-ship w a-key)
(define a-ship (world-ship w))
(define a-direction
(+ (ship-direction a-ship)
(cond
[(key=? a-key "left") -5]
[(key=? a-key "right") 5]
[else 0])))
(define a-speed
(+ (ship-speed a-ship)
(cond
[(key=? a-key "up") 1]
[(key=? a-key "down") -1]
[else 0])))
(define bullets
(cond
[(key=? a-key " ") (cons (new-bullet a-ship) (world-bullets w))]
[else (world-bullets w)]))
(world (world-asteroids w)
(ship (ship-pos a-ship) a-direction a-speed)
bullets
(world-score w)))
Given the signature of this proc it makes sense to me that it'll only handle a single char at a time. So maybe I need to use a different handler? Or different keys?
See the full source on github:
https://github.com/ericclack/racket-examples/blob/master/asteroids4.rkt

The problem is that the on-key handler is only called for one key at a time. Even if you are able to press, say, right arrow and up arrow at the exact same time, on-key will be called twice.
One way to handle this is for each key to store information in a global table on whether the key is up or down. Given such a table you can use it in on-key to check the state of keys other than the one currently being handled.
The following are snippets from a Space Invaders clone. First the global keyboard table.
;;; Keyboard
; The keyboard state is kept in a hash table.
; Use key-down? to find out, whether a key is pressed or not.
(define the-keyboard (make-hasheq))
(define (key-down! k) (hash-set! the-keyboard k #t))
(define (key-up! k) (hash-set! the-keyboard k #f))
(define (key-down? k) (hash-ref the-keyboard k #f))
Then the handling of events - which due to the context were done without big-bang, but it is idea that matters here.
;;; Canvas
; Key events sent to the canvas updates the information in the-keyboard.
; Paint events calls draw-world. To prevent flicker we suspend flushing
; while drawing commences.
(define game-canvas%
(class canvas%
(define/override (on-event e) ; mouse events
'ignore)
(define/override (on-char e) ; key event
(define key (send e get-key-code))
(define release (send e get-key-release-code))
(when (eq? release 'press) ; key down?
(key-down! key))
(when (eq? key 'release) ; key up?
(key-up! release)
(when (eq? release #\space)
(play-sound "shoot.mp3" #t))))
(define/override (on-paint) ; repaint (exposed or resized)
(define dc (send this get-dc))
(send this suspend-flush)
(send dc clear)
(draw-world the-world dc)
(send this resume-flush))
(super-new)))
As you can see the key event handler does nothing more than store whether keys are up and down (and for some odd reason play the "shoot.mp3" sample). So where do the player actually move (according to the arrow keys)?
The actual movement is handled in on-tick (or the equivalent thereof).
Handling movement in on-tick ensures that the player doesn't move an extra distance when keys are pressed.

Related

Functions operating on two lists

I am working on a Racket program for a class and I am totally stumped as to
how to implement one of the features.
The program uses Big-Bang and is supposed to implement a simple Space Invaders game.
I have everything working except one piece, and that is - how to handle the case
when a missile collides with an invader. The reason I'm struggling is that I don't
know how to write a function where I have two lists of arbitrary size, and I have
to check the fields of each object in one list with each object in another list and
remove an object in each list if they have the same values.
The world state is the game:
(define-struct game (invaders missiles tank))
where invaders and missiles are
both lists.
To produce the next state of the game, I implement a function called 'tock'.
Normally, I would just do:
(define (tock s)
(make-game (next-invaders (game-invaders s))
(next-missiles (game-missiles s))
(next-tank (game-tank s)))
But since the contents of the invaders and missiles lists might impact each other due to a collision, I can't simply update the positions independently and move on, I have to remove any collisions and then update the positions.
So I've tried:
(define (tock s)
(make-game (check-collision (game-invaders s)
(game-missiles s)
(game-tank s))
But this makes check-collision take a tank, which it doesn't need.
(define (tock s)
(make-game (next-invaders (game-invaders s) (game-missiles s))
(next-missiles (game-missiles s) (game-invaders s))
(next-tank (game-tank s))))
In this version, I have a function called next-invaders which takes the list of invaders and missiles, and a function
called next-missiles which takes the list of missiles and invaders. The first function checks each invader against each missile, attempts to remove any collided invaders and returns the remaining invaders. The second function checks each missile against each invader and attempts to remove any collided missiles and returns the remaining missiles. The answers should be the same, but it's duplicate work and I'm worried about a possible race condition. I don't know how else to construct a single expression where one function only needs two fields and the other one needs three
and I still wind up producing the next state of the game.
Here's an example of next-invaders. If there are no invaders, it does nothing. If there are invaders but no missiles,
it just moves each invader (move-invader) and recursively calls itself to iterate through all invaders. If there
are both missiles and invaders, then I check for a collision between the first invader in the list, and every
missile in the list; so check collision is recursive.
(define (next-invaders loi lom)
(cond [(empty? loi) empty]
[(empty? lom) (move-invader (first loi) (next-invaders (rest loi) lom))]
[(check_collision (first loi) lom)
(next-invaders (cons (rest loi) empty) lom)]
[else
(move-invader (first loi)
(next-invaders (rest loi) lom))]))
Is the 'answer' to check-collision the correct way to "remove" the collided invader from the list of invaders?
(define (check_collision i lom)
(cond [(empty? lom) false]
[(and (<= (- (missile-x (first lom)) (invader-x i)) HIT-RANGE)
(<= (- (missile-y (first lom)) (invader-y i)) HIT-RANGE))
true]
[else (check_collision i (rest lom))]))
Is this the correct way to test each element of each list against one another?
Update: Still going in circles on this problem. check-collision works and invader-function works, but when I return to missile-function, I don't know how to indicate that a missile needs to be deleted in the case where there was a collision detected in invader-function.
(define-struct invader (x y dx))
;; Invader is (make-invader Number Number Number)
;; interp. the invader is at (x, y) in screen coordinates
;; the invader along x by dx pixels per clock tick
(define-struct missile (x y))
;; Missile is (make-missile Number Number)
;; interp. the missile's location is x y in screen coordinates
(define-struct collision (invaders missiles))
(define (tock s)
(make-game (handle-invaders (collision-invaders (next-invaders-and-missiles (make-collision (game-invaders s) (game-missiles s)))))
(handle-missiles (collision-missiles (next-invaders-and-missiles (make-collision (game-invaders s) (game-missiles s)))))
(handle-tank (game-tank s))))
(define (next-invaders-and-missiles c)
(cond [(and (empty? (collision-invaders c)) (empty? (collision-missiles c))) (make-collision empty empty)]
[(or (empty? (collision-invaders c)) (empty? (collision-missiles c))) (make-collision (collision-invaders c) (collision-missiles c))]
[else
(missile-function (make-collision (collision-invaders c) (collision-missiles c)))]))
;; Collision -> list Of Missiles
;; produce an updated listOf Missiles taking collisions into account
(define (missile-function c)
(cond [(empty? (collision-missiles c)) (make-collision (collision-invaders c) empty)]
[else
(if (< (length (invader-function (first (collision-missiles c)) (collision-invaders c))) (length (collision-invaders c)))
(make-collision (collision-invaders c) (remove (first (collision-missiles c)) (collision-missiles c)))
(missile-function (make-collision (collision-invaders c) (rest (collision-missiles c)))))]))
;; Missile, listOf Invaders -> listOf Invaders
;; produce an updated listOf Invaders taking collisions into account
(define (invader-function m loi)
(cond [(empty? loi) empty]
[else
(if (check-collision? (first loi) m)
(remove (first loi) loi)
(invader-function m (rest loi)))]))
;; Invader, Missile -> Boolean
;; produce true if the coordinates of a missile are within HIT-RANGE of the coordinates of an invader
(define (check-collision? i m)
(and (<= (- (missile-x m) (invader-x i)) HIT-RANGE) (<= (- (missile-y m) (invader-y i)) HIT-RANGE)))
I haven't reviewed all the code, but the general solution is to have one function that takes the lists of missiles and invaders, checks for all the collisions, and then returns both updated lists by returning a pair of lists. So something like this:
(define (tock s)
(let* [(next (next-invaders-and-missiles (game-invaders s) (game-missiles s)))
(next-invaders (first next))
(next-missiles (rest next))]
(make-game next-invaders next-missiles (game-tank s))))
(define (next-invaders-and-missiles loi lom)
... ;; code that finds collisions and removes them from both lists
(cons new-loi new-lom))

Racket gui key-event: ignore case

I'm pretty new to racket, and I'm trying to write a game and I'm currently writing my input controller.
I'm using gui/canvas key events (https://docs.racket-lang.org/gui/key-event_.html) e.g.
(define game-canvas%
(class canvas%
...
;TODO: ignore case
(define/override (on-char ke)
(case (send ke get-key-code)
['release
(send controller key-up (send ke get-key-release-code)))
]
[else
(send controller key-down (send ke get-key-code)))
]
))
...
))
(define dinosaur-controller%
(class controller%
...
(define/override (key-down key-code)
(case key-code
[(#\a)
(DO STUFF)]))
))
However, one problem I have is that the key-codes are case sensitive, e.g. 'a' is different to 'A', so if caps-lock is on, then my controller doesn't work. Is there anyway around this, that would avoid writing (case key-code [(#\a #\A)]) for every key?
First define a helper function
(define (key-downcase-key k)
(cond
[(char? k) (char-downcase k)]
[else k]))
Then use
(case (key-downcase k)
[(#\a) ... as before ...])

RACKET How do I create a score counter?

I need to create a score counter for my tetris game project in Racket and I'm stuck... It's ment to count +100, +250, +400 or +600 depending if one, two, three or four rows get deleted. The main problem for me is that I dont know in what class% I'm supposed to do it in.. The result should look something like this:
I have the the other parts done, only the score window is missing. The only idea I have on how to create it is with a button that you can click and the score gets updated. The callback procedure for that button would look something like this:
[callback (lambda (button event)
(cond
((eq? delete-row 1) (send *score-button* set-label (+ (send *score-button* get-label) 100)))
((eq? delete-row 2) (send *score-button* set-label (+ (send *score-button* get-label) 250)))
((eq? delete-row 3) (send *score-button* set-label (+ (send *score-button* get-label) 400)))
((eq? delete-row 4) (send *score-button* set-label (+ (send *score-button* get-label) 600)))
))]
delete-row is the procedure that takes care of the rows if they get filled (not mentioned in the code). However, I'm not sure if it even works and it feels very unprofessional, rather doing it some other way...
Anyone with an idea on how I can create this score counter? I appreciate all answers!
This page show the various types of GUI elements:
http://docs.racket-lang.org/gui/Widget_Gallery.html?q=text%25
Is it a message% you want?

How can I improve this auxilary function in Racket?

I'm working in HtDP, Chapter 4 using the BSL language.
The problem I was working on is:
Exercise 136: If you run main, press the space bar (fire a shot), and
wait for a good amount of time, the shot disappears from the canvas.
When you shut down the world canvas, however, the result is a world
that still contains this invisible shot.
Design an alternative tock function, which not just moves shots one
pixel per clock tick but also eliminates those whose coordinates
places them above the canvas. Hint: You may wish to consider the
design of an auxiliary function for the recursive cond clause.
The solution that I came up with is below (in a spoiler). However, I feel that I'm doing something redundant. Basically my application of the auxiliary function isn't quite correct.
(define (main w0)
(big-bang w0
(on-tick ticking)
(on-key fire-key)
(to-draw to-render)))
(define HEIGHT 100)
(define WIDTH 80)
(define TURRET-X-POS (/ WIDTH 2))
(define BKGRND (empty-scene WIDTH HEIGHT))
(define SHOT-IMG (triangle 4 "solid" "red"))
(define (to-render w0)
(cond
[(empty? w0) BKGRND]
[else (place-image SHOT-IMG TURRET-X-POS (first w0) (to-render (rest w0)))]))
(define (fire-key w0 ke)
(cond
[(key=? ke " ") (cons HEIGHT w0)]
[else w0]))
(define (ticking w0)
(cond
[(empty? w0) empty]
[(empty? (only-inbound-shots w0)) empty]
[else (cons (sub1 (first (only-inbound-shots w0)))
(ticking (rest (only-inbound-shots w0))))]))
(define (only-inbound-shots w0)
(cond
[(< (first w0) -4) (rest w0)]
[else w0]))
UPDATE:
(This is much cleaner than before)
(define HEIGHT 100) ;height of scene
(define WIDTH 80) ;width of scene
(define TURRET-X-POS (/ WIDTH 2)) ;position of turret, ie. shot's x-coordinate
(define BKGRND (empty-scene WIDTH HEIGHT)) ; scene itself
(define SHOT-IMG (triangle 4 "solid" "red")) ;image representing the shot
(define Y-BOUNDARY -4) ;y-coordinate where shot is no longer visible in scene
;List-of-numbers -> List-of-numbers
;renders all shots fired
(define (to-render w0)
(cond
[(empty? w0) BKGRND]
[else (place-image SHOT-IMG TURRET-X-POS (first w0)
(to-render (rest w0)))]))
;List-of-numbers, key event -> List-of-numbers
;only allows the space bar to fire a shot
;one space bar event produces one shot
(define (fire-key w0 ke)
(cond
[(key=? ke " ") (cons HEIGHT w0)]
[else w0]))
;List-of-numbers -> List-of-numbers
;during each clock tick, the y-coordinate each of the shot
; in List-of-numbers is updated
;each y-coordinate decreases by -1
(define (ticking w0)
(cond
[(empty? w0) w0]
[else (only-inbound-shots (update-shots w0) Y-BOUNDARY)]))
;List-of-numbers -> List-of-numbers
;does the actual updating of the shots in List-of-numbers
;each shot's value is decreased by -1
(define (update-shots w0)
(cond
[(empty? w0) w0]
[else (cons (sub1 (first w0)) (update-shots (rest w0)))]))
;List-of-numbers -> List-of-numbers
;checks to see if the first shot in the List-of-numbers has gone past the Y-BOUNDARY
;if so then remove shot from the List-of-numbers and return the rest of the List
;otherwise return the List without change
(define (only-inbound-shots w0 y-boundary)
(cond
[(empty? w0) w0]
[(< (first w0) y-boundary) (rest w0)]
[else w0]))
;List-of-numbers -> List-of-numbers
;creates the world of shots
;seed value is empty, additional values created by space bar
(define (main w0)
(big-bang w0
(on-tick ticking)
(on-key fire-key)
(to-draw to-render)))
TESTS added:
I'm still working on the tests.
(define test-shots
(cons -6 (cons -5 (cons 10 empty))))
(define test-shots-2
(cons -6 (cons 2 (cons 7 empty))))
(define test-shots-3
(cons 4 (cons 9 (cons 10 empty))))
(check-expect (to-render test-shots)
(place-image SHOT-IMG TURRET-X-POS -6
(place-image SHOT-IMG TURRET-X-POS -5
(place-image SHOT-IMG TURRET-X-POS 10
BKGRND))))
(check-expect (to-render test-shots-2)
(place-image SHOT-IMG TURRET-X-POS -6
(place-image SHOT-IMG TURRET-X-POS 2
(place-image SHOT-IMG TURRET-X-POS 7
BKGRND))))
TEST with world functions added:
(define HEIGHT 1) ; makes test a little faster
(check-expect
(fire-key
(ticking
(ticking
(ticking
(ticking
(fire-key
(ticking
(ticking
(ticking
(ticking (fire-key empty " ")))))
" ")))))
" ")
(cons -3 (cons 1 empty))
The usual comments about missing contracts, purpose statements, and data definitions apply here. As well as tests of the individual functions; a big reason why world.ss/universe.ss are really nice libraries is that they enable one to test functions that are conceptually performing Input/Output.
I'm inferring a lot about what your data definition is from the code, but (1.) you should not put that onus on the reader, and (2.) it could lead to mistakes in my reasoning.
It looks to me like you have deviated significantly from the template in your definition of ticking; it does not look like any template I can think of. A similar comment applies to only-inbound-shots
You may want to break ticking up into multiple subroutines, and then compose them.
An example of what I mean by this: If you were to make a function to take the average of a list of numbers, a simple way to do it is to make two new functions: the first produces the sum of the numbers, and the second produces the length of the list; these are trivial to write via the Design Recipe. Then average is:
;; average : [Listof Number] -> Number
;; produces average value of input (x_1 x_2 ... x_n
(define (average l)
(/ (sum-of-list l) (length-of-list l)))
But if you were to try to do it in a single definition of average that followed the template for [Listof Number], you would have some problems getting the right answer. (I do not think it can be done properly without using an accumulator or two.)
That factoring into very simple subroutines and then composing them at the end to get the desired effect is what I mean by breaking ticking up and then composing the pieces. (If you're not destructuring your input, function composition is a perfectly valid design process: see HtDP section 3.1.)
More importantly, though, I think is to make some tests for the individual functions. Especially only-inbound-shots: I suggest you think about this function on its own.
Pretend that you don't know who might call it, and only that they will obey its contract (e.g. they will only pass in a World, whatever you defined that to be here).
And then make sure you produce the right answer for any possible legal input they provide.
Don't think about how you use it yourself in your other code above, because you don't want to try to keep all that in your head at the same time. Its actually simpler to generalize here, and think about what only-inbound-shots should do on any possible input.
To provide you with some concrete food for thought on the matter of testing, here are some hypothetical pictures describing the inputs you might try to handle in your tests:
, ,
Update 28 Feb 2013:
While I still recommend writing individual unit tests of each of your functions, end-to-end testing is also important. In this case, the game as currently rendered won't tell you if have shots lying outside the scene or not (because place-image, unlike say overlay, automatically crops them from the rendering).
So, if you want to debug the game while it is running, it can be useful to get that kind of information. Say like a drop down bit of text that renders on top of the game (one often sees this in video games to show you things like Frame Rate). So here is one strategy for getting that information out while the game is running: Swap in an alternative rendering function, that is layered on top of your existing one, but prints out other information about the world w0 argument.
(In this case, it might be useful to see its length, though one can imagine extracting other information.)
;; List-of-numbers -> Image
;; Renders w0 via to-render, with a printout of shot count in top left corner.
(define (to-render-with-count w0)
(place-image/align (text (number->string (length w0)) 30 'blue)
0 0 "left" "top"
(to-render w0)))
Then you hook in to-render-with-count in your big-bang invocation. It may also be useful to slow down the clock tick rate, so that you can see what happens as keystrokes and clock ticks are intermixed, so I have made that change too (in the on-tick clause):
(define (main w0)
(big-bang w0
(on-tick ticking 0.1)
(on-key fire-key)
(to-draw to-render-with-count)))
Now, I can interactively notice interesting trends. Trends that yield situations like this:
How is it that I have 148 balls on the screen but only four are showing? What kind of world would have that happen? (If you close the window created by big-bang, it will return the current world to the Interactions Window, so you will see right there exactly what kind of World would have that happen.)
I put the final answer here because the original question has a lot going on already.
(define HEIGHT 200) ;height of scene
(define WIDTH 80) ;width of scene
(define TURRET-X-POS (/ WIDTH 2)) ;position of turret, ie. where shot's x-coordinate
(define BKGRND (empty-scene WIDTH HEIGHT)) ; scene itself
(define SHOT-IMG (triangle 4 "solid" "red")) ;image representing the shot
(define Y-BOUNDARY -4) ;y-coordinate where shot is no longer visible in scene
;List-of-numbers -> List-of-numbers
;renders all shots fired
(define (to-render w0)
(cond
[(empty? w0) BKGRND]
[else (place-image SHOT-IMG TURRET-X-POS (first w0) (to-render (rest w0)))]))
;List-of-numbers, key event -> List-of-numbers
;only allows the space bar to fire a shot
;one space bar event produces one shot
(define (fire-key w0 ke)
(cond
[(key=? ke " ") (cons HEIGHT w0)]
[else w0]))
;List-of-numbers -> List-of-numbers
;updates world state every clock tick
(define (ticking w0)
(cond
[(empty? w0) w0]
[else (remove-outbound-shots (update-shots w0) Y-BOUNDARY)]))
;List-of-numbers -> List-of-numbers
;updates all shots
(define (update-shots w0)
(cond
[(empty? w0) w0]
[else (cons (sub1 (first w0)) (update-shots (rest w0)))]))
;List-of-numbers -> List-of-numbers
;removes all shots exceeding the y-boundary from list
(define (remove-outbound-shots w0 y-boundary)
(cond
[(empty? w0) w0]
[(< (first w0) y-boundary) (remove-outbound-shots (rest w0) y-boundary)]
[else (cons (first w0) (remove-outbound-shots (rest w0) y-boundary))]))
;List-of-numbers -> List-of-numbers
;creates the world of shots
;seed value is empty, additional values created by space bar
(define (main w0)
(big-bang w0
(on-tick ticking)
(on-key fire-key)
(to-draw to-render)))
Tests:
(define test-shots-1
(cons 1 (cons 4 (cons 10 (cons -6 (cons -5 (cons 1 (cons 4 (cons 10 (cons 10 (cons -6 (cons -9 empty))))))))))))
(define test-shots-4
(cons 10 (cons -6 (cons -5 (cons 1 (cons 4 (cons 10 empty)))))))
(check-expect (remove-outbound-shots test-shots-4 -4) (list 10 1 4 10))
(check-expect (remove-outbound-shots test-shots-1 -4) (list 1 4 10 1 4 10 10))

Scheme redefine a list

I have a list called hand and another one called deck, the main goal here is to take the first card (or element ) in the list deck and put it in the list hand when i call the fnction draw...
> (draw hand deck)
(2 C)
> (draw hand deck)
(2 C) (3 H)
> (draw hand deck)
(2 C) (3 H) (K D)
but everytime i call it the hand never changes value...
I'm clueless is there a way like in O-Object to change the content of hand permenantly?
and i initialy define hand empty because the player has no card to start.
(define hand '())
A functional solution, with draw being side-effect free:
;; Returns a cons whose car will be the new hand and cdr being the
;; rest of the original deck
(define (draw deck hand)
(if (not (null? deck))
(cons (cons (car deck) hand) (cdr deck))
(cons hand ())))
;; Gets the new hand from the cons returned by draw.
(define (hand cards) (car cards))
;; Gets the new deck from the cons returned by draw.
(define (deck cards) (cdr cards))
;; test
(define cards (draw '(1 2 3 4 5) ()))
cards
=> ((1) 2 3 4 5)
(hand cards)
=> (1)
(deck cards)
=> (2 3 4 5)
;; draw again
(set! cards (draw (deck cards) (hand cards)))
cards
=> ((2 1) 3 4 5)
(hand cards)
=> (2 1)
(deck cards)
=> (3 4 5)
You cannot change the contents of a list, but you can change which list a name refers to. So:
(let ((some-list '("post")))
(display "initially: ")
(display some-list)
(newline)
(set! some-list (cons "first" some-list))
(display "added first: ")
(display some-list)
(newline)
(set! some-list '(a completely new list))
(display "finally: ")
(display some-list)
(newline)
some-list)
Now each of the lists '("post") '("first" "post") and '(a completely new list) are unchangeable ("immutable") lists, but the name some-list first points to one, then another, then the third.
Caveat: For many problems, you will want to avoid set! and try to think about the problem a different way. For example, if you work with worlds and universes for your game,
http://pre.plt-scheme.org/plt/doc/teachpack/2htdpuniverse.html
then you'll want your updaters to return a new state of the world rather than using set! to modify the old one.
Oh, and next you will find that changing what list a name refers to inside a function will not change what the name refers to from the perspective of whoever called the function. So:
(define (foo lst)
(set! lst '(hi))
(display "within foo: ")
(display lst)
(newline)
lst)
(define my-list '(hello))
(foo my-list)
(display "after foo: ")
(display my-list)
(newline)
(set! my-list (foo my-list))
(display "using the result of foo: ")
(display my-list)
(newline)
Vijay has the best solution for Scheme. However, if you really want to make this work by changing the lists permanently, you'll need to use set-car! and set-cdr!. This is not natural in Scheme, and requires a couple of hacks to make it work:
First define hand and deck:
(define hand '(dummy))
(define deck '((2 C) (3 H) (K D)))
hand has to start with an existing element so that it has some existing list structure to modify. You can't use set-car! and set-cdr! with nil ( '() ).
Now write draw:
(define (draw from to)
; push the top element of `from` onto `to`
(set-cdr! to (copy to))
(set-car! to (car from))
; pop the top element of `from` off
(set-car! deck (cadr deck))
(set-cdr! deck (cddr deck)))
; also we need to define copy
(define (copy l)
(map (lambda (x) x) l))
This means the last element of your hand will always be dummy. It would be better to add a check for the initial case and overwrite it instead of pushing:
(define (draw from to)
; push the top element of `from` onto `to` (just overwrite the first time)
(when (pair? (cdr to))
(set-cdr! to (copy to)))
(set-car! to (car from))
; pop the top element of `from` off
(set-car! deck (cadr deck))
(set-cdr! deck (cddr deck)))
Also you should check that from isn't empty before doing anything.

Resources