I'm doing a game project in Racket and I'm stuck on how I can create a callback procedure for my button so I can go from my start menu to my game.. I have this button defined:
(define *starta-spelet*
(new button%
[parent *menyruta*]
[label "Starta Spelet"]
[min-width 130]))
And there is a callback argument for button% (look here https://docs.racket-lang.org/gui/button_.html) but I dont know how I should define my procedure which takes me from my start menu (which contains panel% and fram%) to my game (which is built on a canvas).
Also, the game and the start-menu is created in separate files .rkt files
I appreciate all help I can get. Let me know if I something is unclear.
Here is an example matching your description.
Note that the changes to the content of the-frame is made
in between start-container-sequence and end-container-sequence.
This is done to prevent the system in rendering the GUI before
we have added the game-canvas.
#lang racket
(require racket/gui)
;;; GUI
;; The frame holds either a start-panel or a game-panel
(define the-frame (new frame% [label "A frame"] [min-width 200] [min-height 200]))
;; The start-panel contains a start button
(define (make-start-panel)
(define start-panel (new panel% [parent the-frame]))
(define start-button (new button% [parent start-panel] [label "Start"]
[callback (λ (b e) (on-start-button b e))]))
start-panel)
;; The game-panel contains a canvas
(define (make-game-panel)
(define game-panel (new panel% [parent the-frame])) ; will be set to the-frame later
(define game-canvas (new canvas% [parent game-panel] [min-width 200] [min-height 200]))
game-panel)
;;; Event Handlers
(define (on-start-button button event)
(send the-frame begin-container-sequence)
(send the-frame delete-child the-start-panel)
(make-game-panel)
(send the-frame end-container-sequence))
;;; Begin Program
(define the-start-panel (make-start-panel))
(send the-frame show #t)
Related
Section §2.1.3 at page 90 explains, with a very clear example, that first class functions in a language make functions themselves and data be the same thing looked at from different perspectives, or, to cite the book:
the ability to manipulate procedures as objects automatically provides the ability to represent compound data.
At page 266, exercise 3.22 from Section §3.3.2, proposes the following
Instead of representing a queue as a pair of pointers, we can build a queue as a procedure with local state. The local state will consist of pointers to the beginning and the end of an ordinary list. Thus, the make-queue procedure will have the form
(define (make-queue)
(let ((front-ptr ...)
(rear-ptr ...))
<definitions of internal procedures>
(define (dispatch m) ...)
dispatch))
Complete the definition of make-queue and provide implementations of the queue operations using this representation.
I easily came up with the following (I've used names the-list and last-pair instead of front-ptr and rear-ptr because I found it clearer, in this case):
(define (make-queue)
(let ((the-list '())
(last-pair '()))
(define (dispatch m)
(cond ((eq? m 'empty) (null? the-list))
((eq? m 'front) (if (null? the-list)
(error "can't take front of empty list")
(car the-list)))
((eq? m 'ins) (lambda (e)
(if (null? the-list)
(begin (set! the-list (list e))
(set! last-pair the-list))
(begin (set-cdr! last-pair (list e))
(set! last-pair (cdr last-pair))))
the-list))
((eq? m 'del) (begin
(if (null? the-list)
(error "can't delete from emtpy list")
(set! the-list (if (pair? the-list) (cdr the-list) '())))
the-list))
((eq? m 'disp) (display the-list)) ; added this for convenience
(else "error")))
dispatch))
(define (empty-queue? q) (q 'empty))
(define (front-queue q) (q 'front))
(define (insert-queue! q e) ((q 'ins) e))
(define (delete-queue! q) (q 'del))
(define (display-queue q) (q 'disp))
which seems to work pretty fairly well…
… except for one crucial point!
At the beginning of §3.3.2 the two desired mutators (that are part of the queue interface) are defined like this (my emphasis):
(insert-queue! <queue> <item>)
inserts the item at the rear of the queue and returns the modified queue as its value.
(delete-queue! <queue>)
removes the item at the front of the queue and returns the modified queue as its value, signaling an error if the queue is empty before the deletion.
My solution doesn't abide by those parts of the definition, because both insert-queue! and delete-queue! are returning the-list, which is the bare list, an implementation detail of the queue interface. Indeed, my solution doesn't support things like these
(define q (make-queue)) ; ok
(insert-queue! (insert-queue! q 3) 4) ; doesn't work
(delete-queue! (delete-queue! q)) ; doesn't work
whereas I think it should.
I guess that the solution should see delete-queue! and insert-queue! return a mutated version of the dispatch function.
How do I do that?
No need for that. Simply define
(define (insert-queue! q e)
((q 'ins) e)
q)
(define (delete-queue! q)
(q 'del)
q)
The design is not clean though, as in, these queues are not persistent. The new version and the old share the same underlying buffer (list). There is no old version preserved anymore, just the current version.
So we don't return a new, modified queue; we return the same queue which has been mutated. Conceptually, that is. On a little bit lower level, we return the same dispatch procedure which is a part of the same closure which holds the same internal binding for the internal buffer, which has been mutated.
By the way, using the head sentinel trick, were you start with e.g. (list 1) instead of '(), usually leads to much simplified, clearer code.
I have a school project to create a version of Tetris in racket and I have to
implement a pause/continue button which I'm stuck on.. My try:
(define *my-timer*
(new timer%
[notify-callback (lambda () (send *my-game-canvas* refresh))]))
(define *pause*
(new button%
[parent *my-window*]
[label "Pause"]
[callback (lambda ()
(send *my-timer* stop))]))
At the moment only the pause function is implemented but it doesn't work. I get an error message on the second define.
*my-game-canvas * is the canvas there the game graphics take place.
I appreciate all the answers.
/ Kasper
Edit:
The error I get:
initialization for button%: contract violation
expected: (procedure-arity-includes/c 2)
given: #<procedure:...0160511/game.rkt:61:17>
The problem is this clause:
[callback (lambda ()
(send *my-timer* stop))]
A callback needs to take two arguments: the button and the event.
Try this:
[callback (lambda (button event)
(send *my-timer* stop))]
I have three small images of same size. I want to display them one after another.
(define new1-bitmap
(make-bitmap
(send bird-bitmap get-width)
(send bird-bitmap get-height)))
(define dc-crop
(new bitmap-dc% [bitmap new1-bitmap]))
(define f-crop
(new frame% [label "Random"]))
(send f-crop show #t)
(send dc-crop draw-bitmap-section
bird-bitmap
0
0
0
(round(* (/ (send bird-bitmap get-height) 3) 2))
(send bird-bitmap get-width)
(round(/ (send bird-bitmap get-height) 3)))
(void
(new message% [parent f-crop] [label new1-bitmap]))
(sleep 3)
(send dc-crop draw-bitmap-section
new1-bitmap
0
0
0
(round(/ (send bird-bitmap get-height) 3))
(send bird-bitmap get-width)
(round(/ (send bird-bitmap get-height) 3)))
(void
(new message% [parent f-crop] [label new1-bitmap]))
(sleep 3)
(send dc-crop draw-bitmap-section
new1-bitmap
0
0
0
0
(send bird-bitmap get-width)
(round(/ (send bird-bitmap get-height) 3)))
(void
(new message% [parent f-crop] [label new1-bitmap]))
Above is the code that I thought would work. It only take three images and tries to show them one after another at an interval of 3 seconds. Moreover the final GUI is three times longer than others.
How should I do this?
A simple window with animation can be made using the 2htdp libraries. 2htdp/universe is a handy place to start prototyping simple applications that mainly produce side effects.
The example code uses some of the icons that ship with Racket for convenience.
#lang racket
(require 2htdp/image
2htdp/universe)
(define image1 (bitmap icons/stop-16x16.png))
(define image2 (bitmap icons/bug09.png))
(define image3 (bitmap icons/break.png))
(define image-list (list image1 image2 image3))
(run-movie 3 image-list)
A more sophisticated example using racket/gui requires implementing a timer% rather than using sleep because sleep acts on the thread level. It appears that when running directly from the source, Racket wants to queue both writes to the canvas then go to sleep and then empty the queue and make both writes in succession.
The second tricky bit is the nested send to access the canvas's drawing context.
The code example below is derived from this thread on the Racket email list. It displays an image of one of my current dogs, waits one second, then displays an image of one of my former dogs.
#lang racket/gui
(require 2htdp/image)
(provide (all-defined-out))
(define image1 (make-object bitmap% "scarlett.jpg"))
(define image2 (make-object bitmap% "witty2.jpg"))
(define my-frame (instantiate frame%("my frame")))
(define mcan%
(class canvas%
(override on-paint)
(define on-paint
(lambda()(send (send this get-dc)
draw-bitmap image1 0 0)))
(super-instantiate())))
(define mcan (new mcan% (parent my-frame)
(min-width (image-width image1))
(min-height (image-height image1))))
(define timer
(new timer%
(notify-callback
(lambda()
(send (send mcan get-dc)
draw-bitmap image2 0 0)))))
(send my-frame show #t)
(send timer start 1000)
A third alternative is to use sleep\yield as described in this post on the Racket discussion list.
I've put together the following rudimentary stopwatch in Racket (just learning now, the final aim is a pomodoro-timer).
#lang racket
(define start-time 0)
(define end-times '())
(define (start);; stores start-time
(set! start-time (current-seconds)))
(define (lap);; stores "laps" in list
(set! end-times (cons (current-seconds) end-times)))
(define (stop);; stores final time, displays lap-times in h, m, s and resets end-times
(begin
(set! end-times (cons (current-seconds) end-times))
(display
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
(set! end-times '())
))
While this does exactly what it should, I was wondering how I could avoid mutable state. If I follow HTDP, this is the kind of situation where mutable state is warranted, but after browsing Wadler's "Monads for Functional Programming", I'm still curious about how I could do without set!.
I know that to make it functional, I should add arguments to my functions. For instance, start would become
(define (start [now (current-seconds)])
now)
and a similar approach could work with lap and stop.
Still, while I know that after adding additional arguments to restore functionality, I should also pass arguments rather than storing values in variables, I don't see how in this case I can leverage this to avoid set! as well.
Update: Since all three answers below are highly valuable (thanks!), I didn't mark any of them as the unique correct one. Below is the minimal solution to my initial question. It is a combination of the loop-proposal of #Metaxal, with the example-usage of #Greg Hendershott.
#lang racket
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([t0 (current-seconds)] [times '()])
(match (read-line)
["quit" (reverse
(map (lambda (x)
(let ((the-date (seconds->date x)))
(list
(sub1(date-hour the-date))
(date-minute the-date)
(date-second the-date)))) times))]
["lap" (loop t0 (cons (- (current-seconds) t0) times))]
[_ (loop t0 times)])))
What will likely happen in the following of your program is that you will have a loop.
Then this loop can be a function that takes as input the whole current state, and when you want to update its state, just call the loop again with the new state (you may also call the loop again with the same exact state of course).
Simplified example:
(define (loop [t0 (current-seconds)] [times '()])
;; ... do things here, possibly depending on user input ...
;; then loop with a new state:
(cond [<some-start-condition> (loop (current-seconds) '())]
[<some-lap-condition> (loop t0 (cons (- (current-seconds) t0) times))]
[<some-stop-condition> times])) ; stop, no loop, return value
This certainly changes the approach to your design though.
It's harder to use this approach when designing GUI programs, because the event loop often prevents you from (or makes it difficult) passing values from one event to the next.
However, in Racket, there is (the pedagogical, but still very good) big-bang that is made just for that.
In this case using set! is justified and hard to avoid, because we must "remember" state between invocations of the procedures. What we can do is improving the encapsulation of state, by hiding the variables that change inside a procedure and using a message dispatcher for accessing the procedures that refer to the mutable state. This is very similar to what we do with object-oriented programming, but only lambdas are required to implement it!
(define (make-timer)
; the "attributes" of the object
(let ([start-time 0]
[end-times '()])
; the "methods" of the object
(define (start)
(set! start-time (current-seconds)))
(define (lap)
(set! end-times (append end-times (list (current-seconds)))))
(define (stop)
(lap)
(display
(map (lambda (an-end)
(let ((the-date (seconds->date (- an-end start-time))))
(list
(sub1 (date-hour the-date))
(date-minute the-date)
(date-second the-date))))
end-times))
(set! end-times '()))
; return a dispatch procedure
(lambda (msg)
(case msg
((start) (start)) ; call the start procedure defined above
((lap) (lap)) ; call the lap procedure defined above
((stop) (stop)) ; call the stop procedure defined above
(else (error "unknown message:" msg))))))
I took the liberty of modifying some of your procedures to make them a bit simpler. Here's how we would use the timer object we just created:
(define timer (make-timer))
(timer 'start)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'stop)
=> ((18 0 1) (18 0 2) (18 0 3) (18 0 4))
This technique is called "message passing", learn more about it in the wonderful SICP book.
For a simple example like this, I would probably do what #Metaxal
suggested.
However another approach is that you could explicitly define the state
as a struct:
(struct state (start-time end-times))
Then change the start, lap, and stop to be functions on state:
;; start : -> state
;; stores start-time
(define (start)
(state (current-seconds) '()))
;; lap : state -> state
;; stores "laps" in list
(define (lap st)
(match-define (state start-time end-times) st)
(state start-time
(cons (current-seconds) end-times)))
;; stop : state -> list
;; stores final time, displays lap-times in h, m, s
(define (stop st)
(match-define (state start-time end-times*) st)
(define end-times (cons (current-seconds) end-times*))
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
As in #Metaxal's answer, your "main loop" needs to handle the state and "thread" it through the functions as appropriate:
Example usage:
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([st (start)])
(match (read-line)
["quit" (stop st)]
["lap" (loop (lap st))]
[_ (loop st)])))
Whereas #Óscar López's answer shows a style of OOP as explained in SICP.
A nice thing about Racket (and Scheme) is that you can choose whatever approach on the spectrum you think best fits the problem at hand, and your taste -- simple imperative, OOP imperative, pure functional.
I have not found a solution to use the Clojure REPL with Qt on the web.
Basically the problem is that the REPL hangs as soon as you call QApplication/exec in order to get the UI to display. You cannot C-c C-c back into the REPL, and closing the active Qt window seems to kill the whole Clojure process.
Now simply calling QApplication/processEvents from within an agent is not possible, unless the agent runs in exactly the same thread in which you created your Qt widgets. It took me two days to figure this out and I have seen others have the same issue/problem but without a solution.
So here is mine, in code:
(add-classpath "file:///usr/share/java/qtjambi.jar")
(ns qt4-demo
(:import (com.trolltech.qt.gui QApplication QPushButton QFont QFont$Weight)
(com.trolltech.qt.core QCoreApplication)
(java.util Timer TimerTask)
(java.util.concurrent ScheduledThreadPoolExecutor TimeUnit))
(:require swank.core))
(defn init []
(QApplication/initialize (make-array String 0)))
(def *gui-thread* (new java.util.concurrent.ScheduledThreadPoolExecutor 1))
(def *gui-update-task* nil)
(def *app* (ref nil))
(defn update-gui []
(println "Updating GUI")
(QApplication/processEvents))
(defn exec []
(.remove *gui-thread* update-gui)
(def *gui-update-task* (.scheduleAtFixedRate *gui-thread* update-gui 0 150 (. TimeUnit MILLISECONDS))))
(defn stop []
(.remove *gui-thread* update-gui)
(.cancel *gui-update-task*))
(defmacro qt4 [& rest]
`(do
(try (init) (catch RuntimeException e# (println e#)))
~#rest
))
(defmacro with-gui-thread [& body]
`(.get (.schedule *gui-thread* (fn [] (do ~#body)) (long 0) (. TimeUnit MILLISECONDS))))
(defn hello-world []
(with-gui-thread
(qt4
(let [app (QCoreApplication/instance)
button (new QPushButton "Go Clojure Go")]
(dosync (ref-set *app* app))
(doto button
(.resize 250 100)
(.setFont (new QFont "Deja Vu Sans" 18 (.. QFont$Weight Bold value)))
(.setWindowTitle "Go Clojure Go")
(.show)))))
(exec))
Basically it uses the ScheduledThreadPoolExecutor class in order to execute all Qt-code. You can use the with-gui-thread macro to make it easier to call functions from within the thread.
This makes it possible to change the Qt UI on-the-fly, without recompiling.
If you want to mess with Qt widgets from the REPL, QApplication/invokeLater or QApplication/invokeAndWait are probably what you want. You can use them in conjunction with agents. Given this:
(ns qt4-demo
(:import (com.trolltech.qt.gui QApplication QPushButton)
(com.trolltech.qt.core QCoreApplication)))
(def *app* (ref nil))
(def *button* (ref nil))
(def *runner* (agent nil))
(defn init [] (QApplication/initialize (make-array String 0)))
(defn exec [] (QApplication/exec))
(defn hello-world [a]
(init)
(let [app (QCoreApplication/instance)
button (doto (QPushButton. "Go Clojure Go") (.show))]
(dosync (ref-set *app* app)
(ref-set *button* button)))
(exec))
Then from a REPL:
qt4-demo=> (send-off *runner* hello-world)
#<Agent#38fff7: nil>
;; This fails because we are not in the Qt main thread
qt4-demo=> (.setText #*button* "foo")
QObject used from outside its own thread, object=QPushButton(0x8d0f55f0) , objectThread=Thread[pool-2-thread-1,5,main], currentThread=Thread[main,5,main] (NO_SOURCE_FILE:0)
;; This should work though
qt4-demo=> (QApplication/invokeLater #(.setText #*button* "foo"))
nil
qt4-demo=> (QApplication/invokeAndWait #(.setText #*button* "bar"))
nil
I've written about how to do this with SLIME on my blog (German) as well as on the Clojure mailing-list. The trick is to define appropriate functions on the Emacs side and tell SLIME to use those when making requests. Importantly, this frees you from having to do special incantations when invoking Qt code.
Quoting myself:
Given that we're talking Lisp here,
anyway, the solution seemed to be
obvious: Hack SLIME! So that's what I
did. The code below, when dropped
into your .emacs (at a point at which
SLIME is already fully loaded),
registers three new Emacs-Lisp
functions for interactive use. You
can bind them to whatever keys you
like, or you may even just set the
slime-send-through-qapplication
variable to t after your application
has started and not worry about key
bindings at all. Either should make
your REPL submissions and C-M-x-style
interactive evaluations indirect
through QCoreApplication/invokeAndWait.
Have fun!
(defvar slime-send-through-qapplication nil)
(defvar slime-repl-send-string-fn (symbol-function 'slime-repl-send-
string))
(defvar slime-interactive-eval-fn (symbol-function 'slime-interactive-
eval))
(defun qt-appify-form (form)
(concatenate 'string ;'
"(let [return-ref (ref nil)] "
" (com.trolltech.qt.core.QCoreApplication/invokeAndWait "
" (fn [] "
" (let [return-value (do "
form
" )] "
" (dosync (ref-set return-ref return-value))))) "
" (deref return-ref))"))
(defun slime-interactive-eval (string)
(let ((string (if slime-send-through-qapplication
(qt-appify-form string)
string)))
(funcall slime-interactive-eval-fn string)))
(defun slime-repl-send-string (string &optional command-string)
(let ((string (if slime-send-through-qapplication
(qt-appify-form string)
string)))
(funcall slime-repl-send-string-fn string command-string)))
(defun slime-eval-defun-for-qt ()
(interactive)
(let ((slime-send-through-qapplication t))
(slime-eval-defun)))
(defun slime-repl-closing-return-for-qt ()
(interactive)
(let ((slime-send-through-qapplication t))
(slime-repl-closing-return)))
(defun slime-repl-return-for-qt (&optional end-of-input)
(interactive)
(let ((slime-send-through-qapplication t))
(slime-repl-return end-of-input)))