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 ...])
Related
I'm trying to make a basic journal entry language in racket for a class on DSLs (specifically beautiful racket, the training version). I have a correct parser and reader, but I am having difficulty with my macros. Below is my expander code. I am trying to have my DSL be functional rather than imperative (I know I could have a global ledger value that I update, but it is not in the spirit of this project).
I have included the code for the important functions in this module. A lot of them are based off of this tutorial: https://beautifulracket.com/bf/a-functional-expander.html
Right now, when I run my code on this text:
[1920-02-19<equipment-20000><cash-10000,stock-10000>]
[2020-12-20<insurance-500><cash-500>]
I get this output from my display calls:
(#<date 1920-02-19> debits credits)()(#<date 2020-12-20> debits credits)#<void>#<void>
It looks like my lambda is not returning the updated ledger in my journal-entry macro. My knowledge isn't great when it comes to Racket, so I'm not sure what I'm doing wrong here. Any tips?
(define (fold-funcs apl ac-funcs)
(for/fold ([current-apl apl])
([ac-func (in-list ac-funcs)])
(ac-func current-apl)
(display current-apl)))
(define-macro (ac-line ENTRIES ...)
#'(begin
(define ledger empty)
(set! ledger (fold-funcs ledger (list ENTRIES ...)))
(display ledger)))
(provide ac-line)
(define-macro (journal-entry "[" INFO ... "]")
#'(lambda (ledger)
(define entry (list INFO ...))
(define dt (first entry))
(set! entry (rest entry))
(define d (first entry))
(set! entry (rest entry))
(define c (first entry))
(define e (list dt d c))
(display e)
(set! ledger (cons e ledger))
ledger
))
(provide journal-entry)
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?
In an attempt to emulate simple OOP in scheme (just for fun), I have caught myself repeating the following pattern over and over:
(define my-class ; constructor
(let ((let-for-name-encapsulation 'anything))
; object created from data is message passing interface
(define (this data)
(lambda (m)
(cond ((eq? m 'method1) (method1 data))
((eq? m 'method2) (method2 data))
(else (error "my-class: unknown operation error" m)))))
;
(define (method1 data)
(lambda (arg1 ...)
... )) ; code using internal 'data' of object
;
(define (method2 data)
(lambda (arg2 ...)
... ))
;
; returning three arguments constructor (say)
;
(lambda (x y z) (this (list 'data x y z)))))
I decided to wrap everything inside a let ((let-for-name-encapsulation ... so as to avoid leaking names within the global environment while still
being able to use the define construct for each internal function name, which enhances readability. I prefer this solution to the unsightly construct (let ((method1 (lambda (... but I am still not very happy because of the somewhat artificial let-for-name-encapsulation. Can anyone suggests something simple which would make the code look even nicer?. Do I need to learn macros to go beyond this?
I use that pattern often, but you don't actually need to define any variables:
(define binding
(let ()
(define local-binding1 expression)
...
procedure-expression)))
I've seen it in reference implementations of SRFIs so it's a common pattern. Basically it's a way to make letrec without the extra identation and lambdas. It can easily be made a macro to make it even flatter:
(define-syntax define/lexical
(syntax-rules ()
((_ binding body ...)
(define binding
(let ()
body ...)))))
;; test
(define/lexical my-class
(define (this data)
(lambda (m)
(cond ((eq? m 'method1) (method1 data))
((eq? m 'method2) (method2 data))
(else (error "my-class: unknown operation error" m)))))
(define (method1 data)
(lambda (arg1 ...)
... )) ; code using internal 'data' of object
(define (method2 data)
(lambda (arg2 ...)
... ))
;; returning three arguments constructor (say)
(lambda (x y z) (this (list 'data x y z))))
;; it works for procedures that return procedures as well
(define/lexical (count start end step)
(define ...)
(lambda ...))
Of course you could use macros to simplify your object system as well.
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.
In a Computer Science course I am taking, for homework, we were tasked with several different questions all pertaining to message passing. I have been able to solve all but one, which asks for the following:
Write a mailman object factory (make-mailman) that takes in no parameters and
returns a message-passing object that responds to the following messages:
'add-to-route: return a procedure that takes in an arbitrary number of mailbox objects
and adds them to the mailman object's “route”
'collect-letters: return a procedure that takes in an arbitrary number of letter objects and
collects them for future distribution
'distribute: add each of the collected letters to the mailbox on the mailman's route whose
address matches the letter's destination and return a list of any letters whose destinations
did not match any mailboxes on the route (Note: After each passing of
'distribute
the
mailman object should have no collected letters.)
Some remarks that are given to make the code easier include:
If multiple letters are distributed to the same mailbox in one distribution round, any one
of them may be the “latest” letter whose message is returned by passing 'get-latest-message
to the mailbox.
No two mailboxes will have the same address.
No mailbox or letter will be passed to the mailman more than once.
The bad letters returned by distribute do not need to be in a specific order.
Use the . args syntax for accepting arbitrary amount of arguments.
This is what I have been able to figure out for myself:
(define (make-mailman)
(let ((T '()))
(define (route-adder . mobjects)
(assoc mobjects T))
(define (letter-collecter . lobjects)
(assoc lobjects T))
(define (add-to-route mobjects)
(begin (set! T (cons (route-adder . mobjects) T)) 'done))
(define (collect-letters lobjects)
(begin (set! T (cons (sort-strings (letter-collecter . lobjects)) T)) 'done))
(define (dispatch z)
(cond ((eq? z 'add-to-route) add-to-route)
((eq? z 'collect-letters) collect-letters)
((eq? z 'distribute) "unsure of what to do here")
(else "Invalid option")))
dispatch))
Any help that can be given to me here will be appreciated, as I have tried looking at this problem for a while, and cannot figure out what to do from here.
Your code has all kinds of mix-ups. :) Let's proceed step by step.
The dispatch bit is almost OK:
(define (make-mailman)
(let ...
...
(define (dispatch msg) ;; use short but suggestive var names
(cond
((eq? msg 'add-to-route) add-to-route)
((eq? msg 'collect-letters) collect-letters)
((eq? msg 'distribute)
;; "unsure of what to do here" <<-- Distribute the letters, what else?
distribute-the-letters)
(else "Invalid option")))
dispatch))
With such objects, a sample call will be (define ob (make-mailman)) and then ((ob 'add-to-route) box1 box2 ... boxn) etc. So add-to-route procedure must be defined this way:
(define (make-mailman)
(let ((self (list '(ROUTE) ; each mailman has a route, and a mailbag
'(MAILBAG)))) ; use suggestive name here (T, what T?)
...
(define (add-to-route . mailboxes)
(let ((route (assoc 'ROUTE self)))
(set-cdr! route
(append mailboxes ; there will be no duplicates
(cdr route)))
'DONE))
Right? Same with the letters:
(define (collect-letters . letters)
(let ((mailbag (assoc 'MAILBAG self)))
.....
'DONE))
Now we can deal with the missing part, distribute-the-letters:
(define (distribute-the-letters)
;; for each letter in my mailbag
(let* ((mailbag (assoc 'MAILBAG self))
(mailboxes (cdr (assoc 'ROUTE self)))
(letters (cdr mailbag)))
(if (null? letters) ()
(let loop ((letter (car letters))
(letters (cdr letters))
(not-delivered ()))
;; access its address,
(let* ((address (letter 'get-address))
;; (we assume it supports this interface,
;; or maybe that's part of a previous assignment)
;; and find a mailbox on my route such that
(mbx (find-mailbox address mailboxes)))
;; its address matches the letter's
;; and if so,
(if .....
;; put that letter into this mailbox:
((mbx 'put-letter) letter)
;; (we assume it supports this interface,
;; or maybe that's part of a previous assignment)
;; but if not, add letter to the "not-delivered" list
..... )
(if (null? letters)
;; having emptied the mailbag, return the "not-delivered" list
(begin (set-cdr! mailbag nil) not-delivered)
(loop (car letters) (cdr letters) not-delivered)))))))
We assume that both letter and mailbox objects support the message type 'get-address to which they both return the same comparable address type of object, and that mailbox objects support 'put-letter message.
Other than the specifics of the message functionality, it looks like you've nailed it. There are however some errors:
This (route-adder . mobjects) should be (router-adder objects) and similarly for (letter-collector . lobjects).
The use of begin is unneeded. The body of a (define (func . args) <body> ...) is implicitly enclosed in a begin.
Idiomatically your code could be written as:
(define (make-mailman)
(let ((T '()))
;; ...
(lambda (z)
(case z
((add-to-route) add-to-route)
((collect-letters) collect-letters)
((distribute) distribute)
(else (error "Invalid option"))))))
[but you may not know about case nor lambda yet...]
As for solving the actual messaging functionality. You are going to need to maintain a set of mailboxes where each mailbox is going to hold a set of letters. A letter will presumably consist of an address and some content (extra credit for a return-address). The distribute behavior will check the address on each letter and deposit it in its mailbox. The mailman will need to hold letters (while on his route collecting-letters) until instructed to distribute.
For this you might start by building up the lower-levels of the functionality and then using the lower-levels to build up the actual message passing functionality. Starting like, for example:
(define (make-letter addr content)
`(LETTER ,addr ,content))
(define letter-addr cadr)
;; ...
(define (make-mailbox addr)
'(MBOX ,addr))
(define mailbox-letters cddr)
(define (mailbox-letters-add mailbox letter)
(set-cdr! (cdr mailbox) (cons letter (mailbox-letters mailbox))))
;;...