I have following code of a countdown timer. It starts all right but it does not stop on pressing the stop button.
#lang racket/gui
(define myframe (new frame% [label "Timer"] [x 500] [y 200] ) )
(define tfsecs (new text-field% [parent myframe] [label "Secs:"]))
(define msgbmi (new message%
[parent myframe] [auto-resize #t] [label ""] ))
(define stopflag #f)
(define (OnButtonPressFn n)
(sleep 1)
(set! n (sub1 n))
(define m 0)
(send msgbmi set-label "")
(for((i (in-naturals)) #:break stopflag)
(set! m (- n i))
; (printf "running; i= ~a~n" m)
(send msgbmi set-label (number->string m))
(sleep 1) ) )
(define startbutton
(new button% [parent myframe] [label "Start"]
(callback (lambda (b e)
(define secs (string->number (send tfsecs get-value)))
(when secs (OnButtonPressFn secs))))))
(define stopbutton
(new button% [parent myframe] [label "Stop"]
(callback (lambda (b e)
(set! stopflag #t)))))
(send myframe show #t)
It stops if I limit the for loop to end it at 0. But I want it to keep showing how much time is over till the stop button is pressed.
Apparently, the stopflag being set by stop button is not being read by running loop. How can this be corrected? How can I make the stop button work properly here?
Let's follow the intended control flow.
First we click the start button. The system generates an event. The event handler (the call back is called) and the click is handled. Then later on the stop button is clicked. The system generates a new event and the event handler for the stop button is called.
The problem in your program is that the event handler for the start button never returns. The system only handles one event at a time, so if you never return from an event handler, any following events will not be handled.
One way to fix the problem is to start a new thread to do the actual work:
(define (OnButtonPressFn n)
(thread (λ ()
(sleep 1)
(set! n (sub1 n))
(define m 0)
(send msgbmi set-label "")
(for((i (in-naturals)) #:break stopflag)
(set! m (- n i))
; (printf "running; i= ~a~n" m)
(send msgbmi set-label (number->string m))
(sleep 1) ) )))
This event handler creates a new thread (that runs concurrently with the event loop) and then returns immediately. The event loop is there able to handle new events. In the mean time the new thread does the work (here printing numbers).
Related
I am looking into GUI development with Racket. I would like to create a tab-panel%, with multiple tabs. The documentation says, that a switch of tab does only call a procedure and does not make a content change happen automatically. I think this is quite clever behavior, but I have a problem implementing an initially empty tab-panel, which only gets content (children) when I select one of the tabs.
This is the code I already have:
#lang racket/gui
(require racket/gui/base)
(define nil '())
(define application-frame
(new frame%
[label "Example"]
[width 400]
[height 300]))
(define menu-bar
(new menu-bar%
[parent application-frame]))
(define file-menu
(new menu%
[label "&File"]
[parent menu-bar]))
(new menu%
[label "&Edit"]
[parent menu-bar])
(new menu%
[label "&Help"]
[parent menu-bar])
(new menu-item%
[label "E&xit"]
[parent file-menu]
[callback
(λ (m event)
(exit nil))])
(define tab-panel
(new tab-panel%
[parent application-frame]
[choices '("&Lookup" "&Training")]
[callback
(λ (tp event)
(case (send tp get-item-label (send tp get-selection))
[("&Lookup")
(send tp change-children
(λ (children)
(list lookup-panel)))]
[("&Training")
(send tp change-children
(λ (children)
(list training-panel)))]))]))
(define get-lookup-panel
(lambda (children)
(let
[(lookup-panel (new panel% [parent tab-panel]))]
[(new message%
[parent lookup-panel]
[label "The content of the lookup panel for the lookup tab."])
lookup-panel])))
(define lookup-panel (new panel% [parent tab-panel]))
(define lookup-panel-content
(new message%
[parent lookup-panel]
[label "The content of the lookup panel for the lookup tab."]))
(define training-panel (new panel% [parent tab-panel]))
(define training-panel-content
(new message%
[parent training-panel]
[label "The content of the training panel for the training tab."]))
(define status-message
(new message%
[parent application-frame]
[label "No events so far..."]
[auto-resize #t]))
(send application-frame show #t)
The problem here is, that initially both children of the tab-panel are visible, although (naturally) only one tab is selected. When I change tab, the behavior is corrected by the lambdas inside the case form.
However, I cannot simply give those panels, which I set as children no parent, because racket will tell me, that I need to specify the required initial argument parent. This means they will be initially added to the tab-panel. Is it necessary to create the panels and then again remove them from the tab-panel? That would seem a bit dirty. I think there is probably a better way.
I already tried to dynamically create the panel, as can be seen in the get-lookup-panel procedure, but I couldn't get that to work in the case form.
What is the correct way to implement it?
edit1
I found a way to define a procedure, which can be used in the way I want to use it:
(define (get-lookup-panel4 children)
(define lookup-panel (new panel% [parent tab-panel]))
(define lookup-panel-message (new message% [parent lookup-panel] [label "LOOKUP"]))
(list lookup-panel))
Which can be used as follows:
(define tab-panel
(new tab-panel%
[parent application-frame]
[choices '("&Lookup" "&Training")]
[callback
(λ (tp event)
(case (send tp get-item-label (send tp get-selection))
[("&Lookup")
(send tp change-children get-lookup-panel4)]
[("&Training")
(send tp change-children
(λ (children)
(list training-panel)))]))]))
But I don't understand what the difference between this procedure and the other one with the let expression is and another problem with this approach is, that I cannot afterwards modify the created panel or message, because their scope is the procedure.
I am creating a GUI for a racket program where a user inputs a title and a blog and then submits it. This is my code for those fields so far:
(define blogPost%
(class horizontal-panel%
(super-new)
(define titleoutput (new text-field% (label " title")
(min-height 20)
(min-width 200)
(vert-margin 20)
(horiz-margin 10)
(parent this)))
(define output (new text-field% (label "blog")
(style '(multiple))
(min-height 20)
(vert-margin 20)
(min-width 400)
(parent this)))
(define (callback button event)
(define title-new-value (send titleoutput get-value))
(define new-value (send output get-value))
(save title-new-value new-value)
(send output set-value "")
(send titleoutput set-value "")
(send howisit show #t))
(define button (new button% (label "Submit")
(vert-margin 0)
(horiz-margin 10)
(parent this)
(callback callback)))
))
It is currently aligned like this:
But I would like the title text box to be above the blog field and the submit button to be centered at the bottom.
I'm assuming that you're running this code in the same way as for your previous question. In that, you used your class like this:
(define f (new frame% [label "blog post GUI"] [min-width 400] [min-height 500]))
(define tib (new blogPost%
[parent f]))
(send f show #t)
Now since you defined blogPost% as a subclass of horizontal-panel%, it also inherits all of the initialization arguments of horizontal-panel%, including the alignment argument. So you can pass the [alignment '(left top)] initialization argument to your blogPost% class:
(define f (new frame% [label "blog post GUI"] [min-width 400] [min-height 500]))
(define tib (new blogPost%
[parent f]
[alignment '(left top)]))
(send f show #t)
If you want to build this default into your blogPost% class, you could add it to the (super-new) form instead:
(define blogPost%
(class horizontal-panel%
(super-new [alignment '(left top)])
...))
However, if you happen to have a (new blogPost% ... [alignment '(left top)] ...) around somewhere else, I believe this will break that code.
So to avoid that, it would probably be best to make the blogPost% class it's own class, so that instead of being a horizontal-panel%, it would have a horizontal-panel%, in the same way that it already has two text-fields and a button.
This is better for the long term because after this change, code that uses blogPost% won't break if you change which initialization arguments you passed to horizontal-panel% (which was implicit in the super-new previously).
(define blogPost%
(class object% ; object% instead of horizontal-panel%
; This argument is explicit now.
; If other code relies on other arguments, specify them here.
(init parent)
(super-new)
(define panel
(new horizontal-panel% ; this new call is explicit now
[parent parent] ; you can later add more arguments
[alignment '(left top)])) ; and it won't break things
(define titleoutput
(new text-field%
[label " title"]
[min-height 20]
[min-width 200]
[vert-margin 20]
[horiz-margin 10]
[parent panel])) ; panel instead of this
(define output
(new text-field%
[label "blog"]
[style '(multiple)]
[min-height 20]
[vert-margin 20]
[min-width 400]
[parent panel])) ; panel instead of this
(define (callback button event)
(define title-new-value (send titleoutput get-value))
(define new-value (send output get-value))
(save title-new-value new-value)
(send output set-value "")
(send titleoutput set-value "")
(send howisit show #t))
(define button
(new button%
[label "Submit"]
[vert-margin 0]
[horiz-margin 10]
[parent panel] ; panel instead of this
[callback callback]))
))
(define f (new frame% [label "blog post GUI"] [min-width 400] [min-height 500]))
(define tib (new blogPost%
[parent f]))
(send f show #t)
Of course, with this method, you won't be able to use the methods defined for horizontal-panel% on instances of your blogPost% class, but in the long run that's a good thing as well. If you ever, in the future, wanted to change the implementation to use something other than a horizontal-panel%, you could.
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.
i have a method that prints messages in a list on a dialog object. The code below is printing "a b c a b c d e" and i want it to be "a b c d e". How do i solve this problem? Is there a method that i can clear all the messages in a dialog object?
#lang racket/gui
(define frame (new frame%
[width 300]
[height 300]
[label "Frame"]))
(new button%
[parent frame]
[label "Messages"]
(callback (lambda (button event)
(send msg-dialog show #t))))
(define msg-dialog (new dialog%
(label "Name")
(parent frame)
(width 300)
(height 300)))
(define (make-msg%)
(new message% [parent msg-dialog]
[label "Message: "]
[min-width 80]
[min-height 30]))
(define (print-msg lst)
(if (null? lst)
(void)
(begin
(send (make-msg%) set-label (symbol->string (car lst)))
(print-msg (cdr lst)))))
(define list '(a b c))
(print-msg list)
(set! list (append list '(d e)))
(print-msg list)
(send frame show #t)
The GUIML library has a function that can do it easily:
(require (planet jphelps/guiml))
(delete-children msg-dialog)
delete-children is implemented like this if you'd rather fork it:
(define (delete-children object (id #f))
(send object change-children (λ (x)
(if id
(filter (λ (widget)
(not (eq? (send widget ___get-guiml-name) id)))
x)
'()))))
Consider using a text-field% instead.
http://docs.racket-lang.org/gui/text-field_.html?q=message%25
For a text field, the most useful methods of a text% object are the following:
(send a-text get-text) returns the current text of the editor.
(send a-text erase) deletes all text from the editor.
(send a-text insert str) inserts str into the editor at the current caret position.
I am trying to get the value of a label after a button is clicked. I know that I can use (send x get-label) to get the value of the label, but it only gets the initial value of the label in my case "No Zip Code Entered". Also, after that button is pressed I would like to run code that queries an API and parses xml information using the zip code from the label. Below is my code:
Thanks in Advanced,
Puzzledplane
GUI:
#lang racket
(require racket/gui/base)
;; Creates a Frame called mainframe
(define mainframe (new frame% [label "Forecaster - Powered by Wunderground API"]
[width 500]
[height 500]
[stretchable-width 500]
[stretchable-height 500]))
;; Creates a Current Conditions group-box-panel
(define maingroup (new group-box-panel%
[label "Current Conditions:"]
[parent mainframe]
[min-height 450]
[stretchable-height 450]))
(define cclabel (new message% [parent maingroup]
[label "Insert Conditions Here from API"] ))
;; Creates a Zip Code group-box-panel
(define zipcodegroup (new group-box-panel%
[label "Zip Code:"]
[parent mainframe]
[min-height 100]
[stretchable-height 100]))
;; Zip Code Message Label -- Defaults to No Zip Code Entered
(define zipcodelabel (new message% [parent zipcodegroup]
[label "No Zip Code Entered"] ))
;; Zip Code Text-Field
(define zipInput
(new text-field%
[parent zipcodegroup]
[label ""]
[init-value ""]
[min-width 5]
[stretchable-width 5]
[callback (lambda(f ev)
(define v (send f get-value))
(unless (string->number v)
(send f set-value (regexp-replace* #rx"[^0-9]+" v ""))))]))
;; Submit Button
(define submit-button
(new button%
[parent zipcodegroup]
[label "Submit"]
[callback (lambda (button event)
(let ([v (send zipInput get-value)])
(send zipcodelabel set-label v)
))]))
;; Show Frame
(send mainframe show #t)
XML Parsing:
#lang racket
(require net/url xml xml/path)
(define curent-cond-url (string->url "http://api.wunderground.com/api/*snip*/conditions/q/autoip.xml"))
(define current-cond-port (get-pure-port curent-cond-url))
(define response (port->string current-cond-port))
(close-input-port current-cond-port)
(define data (xml->xexpr
((eliminate-whitespace '(response))
(read-xml/element (open-input-string response)))))
(define curr-location (se-path*/list '(display_location full) data))
(define curr-weather (se-path*/list '(current_observation weather) data))
(define curr-temp (se-path*/list '(current_observation temp_f) data))
(define curr-humidity (se-path*/list '(current_observation relative_humidity) data))
(define curr-wind (se-path*/list '(current_observation wind_string) data))
(define curr-feels-like (se-path*/list '(current_observation feelslike_f) data))
(define current-conditions
(list (list 'Location: curr-location) (list 'Conditions: curr-weather)
(list 'Temperature: curr-temp) (list 'Feels-Like: curr-feels-like)
(list 'Humidity: curr-humidity) (list 'Wind: curr-wind)))