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))]
Related
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)
The URI structure of my website changed drastically recently and I need to redirect all of the old pages to their corresponding new pages. I have a dotted list of pairs of all of the old and new URIs. At the moment I am trying to define easy handlers for each in a loop:
(let ((redirects '(("/old/uri/example-1" . "/new/uri/example-1"))))
(dolist (redirect redirects)
(hunchentoot:define-easy-handler (???? :uri (first redirect)) ()
(redirect (rest redirect)))
))
Maybe there is a better way. Assuming define-easy-handler is correct, it requires a function symbol for each easy handler. I tried the following to no avail:
Placing a (gensym) where it expects a function symbol
Using lists rather than dotted lists and calling (first redirect) where it expects a symbol
Placing a quasiquote around the whole thing and an unquote around (first redirect)
What would be a good way to accomplish this?
Let's guess: DEFINE-EASY-HANDLER is a macro.
Three typical ways to solve that:
call the underlying layer instead and don't use the macro - if the underlying layer is available for the programmer
write and use a macro which
expands (defredirects (a . a1) (b . b1) (c . c1))) into
(progn
(hunchentoot:define-easy-handler (f-a ... a) () (... a1))
(hunchentoot:define-easy-handler (f-b ... b) () (... b1))
(hunchentoot:define-easy-handler (f-c ... c) () (... c1)))
Generate the form you want to call and use eval (or compile and funcall if possible) in the loop for each form.
Although you already solved the problem I figured I might add this as an alternative. If you don't want to make a whole custom acceptor, you can add an around-method on HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST for HUNCHENTOOT:EASY-HANDLER.
Let's make an acceptor and one page first:
(defparameter *acceptor* (make-instance 'hunchentoot:easy-acceptor :port 4242))
(hunchentoot:define-easy-handler (foo :uri "/foo") ()
(format nil "<html><body><h1>Test</h1><p>foo</p></body></html>"))
(hunchentoot:start *acceptor*)
Then redirect /bar and /quux to /foo:
;; A simple helper to create prefix dispatchers.
(defun make-redirect-list (redirects)
(mapcar (lambda (redirect)
(destructuring-bind (from . to) redirect
(hunchentoot:create-prefix-dispatcher from
(lambda ()
(hunchentoot:redirect to)))))
redirects))
(defparameter *redirects* (make-redirect-list
'(("/bar" . "/foo")
("/quux" . "/foo"))))
(defmethod hunchentoot:acceptor-dispatch-request :around
((acceptor hunchentoot:easy-acceptor) request)
(dolist (redirect *redirects*)
;; Match the request against the prefix dispatchers in *REDIRECTS*...
(let ((handler (funcall redirect request)))
(when handler
;; and call the corresponding handler if a match is found.
(return-from hunchentoot:acceptor-dispatch-request
(funcall handler)))))
;; Unless a handler was found, call next method to
;; handle the request normally.
(call-next-method))
Edit: Use around method instead of before. I initially figured that letting it call the main method normally would be necessary for any logging/etc. happening there, but after further testing it doesn't seem to be.
This solution works. I definitely appreciate feedback regarding whether or not it's best practice.
(defun add-redirect (name from to)
(eval `(hunchentoot:define-easy-handler (,name :uri ,from) ()
(redirect ,to))))
(defun add-redirects (redirects)
(dolist (redirect redirects)
(add-redirect (first redirect) (second redirect) (third redirect))
))
(add-redirects
'(
(redirect-1 "/redirect-1/" "/destination-1/")
(redirect-2 "/redirect-2/" "/destination-2/")
(redirect-3 "/redirect-3/" "/destination-3/")
))
All the basic examples for Application Delivery show how to replace the toplevel function with your own. Once that function is done, the application exits. I was wondering what's the best way to create a toplevel function for an application that is long running. My code is
(ql:quickload :my-app)
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server) ; Essentially creates a hunchentoot handler and returns
(loop for x = (read-line)
when (string= x "q") do (quit)
do (format t "Type q to quit~%" x)))
(save-application "my-app" :toplevel-function #'main :prepend-kernel t)
Is there a better way? I don't like the loop but something which frees up the terminal is also ok.
As you say, once the main function is done, the application exits. Ergo, you need to keep the function running until you wish to exit the application.
The simplest solution is to just leave the main loop in an infinite loop of sleep:
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server)
(loop (sleep 60)))
As you are starting a Swank server, you might want to include functionality for cleanly exiting the application through a SLIME connection. You could, for example, write something like the following, using the bt-semaphore package:
(defvar *quit-my-app* (bt-semaphore:make-semamphore))
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server)
(bt-semaphore:wait-on-semaphore *quit-my-app*)
(my-app:clean-up)) ; or whatever you need to do for cleaning up
(defun quit-my-app ()
(bt-semaphore:signal-semaphore *quit-my-app*))
Now you can simply evaluate (quit-my-app) on a SLIME connection to shut down the application.
You could also use the main thread for maintenance duties. In my server, I perform simple log rotation there:
(defun seconds-until-tomorrow ()
(multiple-value-bind (second minute hour day month year daylight-p zone)
(decode-universal-time (+ (get-universal-time) (* 60 60 26))) ; safely tomorrow
(declare (ignore second minute hour daylight-p))
(- (encode-universal-time 0 0 0 day month year zone)
(get-universal-time))))
(defun main ()
(swank:create-server :dont-close t)
(let (cur-logfile
cur-logfile-name
;; assuming that start-server returns the Hunchentoot acceptor
(acpt (my-app:start-server)))
(loop
(let* ((lf-stem (log-file-name))
(logfile-name (merge-pathnames lf-stem *temp-path*))
(new-logfile (open logfile-name :direction :output
:if-exists :append
:if-does-not-exist :create)))
(setf (hunchentoot:acceptor-message-log-destination acpt) new-logfile
(hunchentoot:acceptor-access-log-destination acpt) new-logfile)
(when cur-logfile
(close cur-logfile)
(run-program "/usr/bin/xz" (list (princ-to-string cur-logfile-name))))
(setf cur-logfile new-logfile
cur-logfile-name logfile-name)
(when (bt-semaphore:wait-on-semaphore *quit-my-app* (seconds-until-tomorrow))
(return)))))
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 am looking for a general way for Emacs to do some checks, and (bing) when something is true or false.
I have 2 examples at the moment. There is an auction website, and I figured it would be nice for Emacs to check whether there has been an update. I did this using R (Emacs-ESS) to load source code of the website. Then I use a selfmade function in Emacs to:
Switch buffer, reload the URL info, send the info to the screen, (sleep-for ) to wait a little. Search for "Today". Then it has to check the value after this string, if it is higher than 0, then it means I have something new of interest, and it PINGS.
This is a long introduction, but I really like that this works.
I now do the same with Gnus, I have a timer that runs a function that opens Gnus every 10 seconds, searches for "Inbox", checks the value, and if it is higher than 0 then it notifies me (otherwise it just switches the buffer back). The only problem is that this takes around 0.5 seconds, in which you can see point move to another buffer and switch back.
Is there a general approach to have these automated things be done, without disturbing the user?
EDIT: Wouldn't it be nice for Emacs to perform a check to see whether there is a new post with our favorite tag here on Stackoverflow?
Emacs is single-threaded, so we are screwed - there is not way to do this without bothering the user at all.
The trick is to select a good balance between the frequency and cost of the check so that the user can bear it.
Here is the code I used once:
(defvar sds-new-mail-line nil "cache")
(defun sds-new-mail-line (&optional arg)
"add or remove the mode-line new-mail marker"
(or sds-new-mail-line (error "sds-new-mail-line has not been initialized"))
(let* ((mlf (default-value 'mode-line-format))
(already-have (eq sds-new-mail-line (car mlf))))
(if (or (eq arg nil) (< arg 0))
(when already-have
(setq-default mode-line-format (cdr mlf)))
(unless already-have
(setq-default mode-line-format (cons sds-new-mail-line mlf))))))
(defun sds-gnus-scan-mail ()
"check for new mail, notify if there is some"
(when (gnus-alive-p)
(with-current-buffer gnus-group-buffer
(gnus-group-get-new-news 3)
(gnus-group-get-new-news 2)
(goto-char (point-min))
;; look for new messages in groups of level 1 and 2
(cond ((search-forward-regexp "^ *s[12] *[1-9][0-9]*n" nil t)
(message "you have new mail! (%s)" (user-time-format))
(sds-new-mail-line 1)
(ding))
(t (sds-new-mail-line -1)
(message "no new mail (%s)" (user-time-format))))
(goto-char (point-min)))))
(defun sds-gnus-load-hook ()
(unless sds-new-mail-line ; init
(let ((str "mail") (map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1] 'ignore)
(define-key map [mode-line mouse-1] read-mail-command)
(add-text-properties 0 (length str)
(list 'display gnus-mode-line-image-cache
'help-echo "you have new mail - read it!"
'local-map map)
str)
(setq sds-new-mail-line str))
(gnus-demon-add-handler 'sds-gnus-scan-mail 3 t))
(add-hook 'gnus-summary-prepared-hook 'gnus-summary-first-unread-subject)
(add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-catchup))
;; cannot use gnus-load-hook here!
(eval-after-load "gnus-start" '(sds-gnus-load-hook))
I am sure you can adapt it to your needs.