This my code:
#lang racket
(require racket/gui)
(define-values (screen-width screen-height) (get-display-size))
(define *app-width* 400)
(define *app-height* 125)
(define *vm-frame* (new frame%
[label "Test"]
[width *app-width*]
[height *app-height*]
[x (- (quotient screen-width 2) (quotient *app-width* 2))]
[y (- (quotient screen-height 2) (quotient *app-height* 2))]
))
(define frame-canvas%
(class canvas%
(super-new)
(inherit get-dc)
(define/override (on-paint)
(let ([my-dc (get-dc)])
(send my-dc clear)
(send my-dc set-background "black")))))
(let ([frame-canvas (new frame-canvas% [parent *vm-frame*])])
(send *vm-frame* show #t))
On mac os, this is normal, show a app with a black background.
But on windows, background is white.
Why? Racket version is 5.3, it's a 5.3 bug?
Reverse the order of set-background and clear.
The call to clear uses the color of the current background to do the fill. If somehow your on-paint were called at least more than once, then you would observe a black background, since the second time around, the current background color would be black. I suspect this is what explains the platform-specific difference you observed.
Related
I wrote a function in Racket to produce something similar to the following fractal.
(define CUT-OFF 5)
(define CIRCLE-MODE "outline")
(define (circle-fractal size colour)
(local [(define full-circle (circle size CIRCLE-MODE colour))]
(cond [(<= size CUT-OFF) full-circle]
[else
(overlay/align "middle" "middle"
full-circle
(beside (circle-fractal (/ size 2) colour)
(circle-fractal (/ size 2) colour)))])))
It passes my tests.
I changed the code, thinking the below would be more readable.
(define (circle-fractal size colour)
(local [(define full-circle (circle size CIRCLE-MODE colour))
(define half-circle (circle-fractal (/ size 2) colour))]
(cond [(<= size CUT-OFF) full-circle]
[else
(overlay/align "middle" "middle"
full-circle
(beside half-circle half-circle))])))
Now the function doesn't terminate. Racket reaches its memory limit with no output.
Does each corecursive call somehow not approach the trivial case after this change?
In the first version (circle-fractal (/ size 2) colour) is evaluated only if size > CUT-OFF. In the second it's called regardless of size. This way you lost your recursion base case.
Try:
(define (circle-fractal size colour)
(define full-circle (circle size CIRCLE-MODE colour))
(cond [(<= size CUT-OFF) full-circle]
[else
(define half-circle (circle-fractal (/ size 2) colour))
(overlay/align "middle" "middle"
full-circle
(beside half-circle half-circle))]))
I'm playing a little with Racket big-bang mechanism, but I cannot get both smooth and fast going projectile. There's so much ugly flickering. Here's my code:
(require 2htdp/universe
2htdp/image)
(define gx 0)
(define gy 0.35)
(struct ballstate (x y vx vy) #:transparent)
(define startstate (ballstate 10 590 7 -20))
(define (make-new-state old)
(define newvx (+ (ballstate-vx old) gx))
(define newvy (+ (ballstate-vy old) gy))
(ballstate (+ (ballstate-x old) newvx)
(+ (ballstate-y old) newvy)
newvx
newvy))
(define (main)
(big-bang startstate
[on-tick make-new-state]
[to-draw place-ball-at]
[on-key reset]))
(define (place-ball-at s)
(place-image (circle 10 "solid" "red")
(ballstate-x s)
(ballstate-y s)
(empty-scene 800 600)))
(define (reset s ke)
startstate)
(main)
The question is: how to make it better, faster, smoother and flicker-free?
Here are two things that might help:
The on-tick clause takes an optional parameter that determines the time between two ticks. The default is 1/28, so if you lower this you will get more frames resulting in a smoother animation.
If your program takes longer than the time between each tick to produce an image, you will see stuttering. Precomputing everything that can be precomputed is a good thing. For example, there is no reason to produce a new empty scene each time, so below I have simply stored it in a variable.
(define (main)
(big-bang startstate
[on-tick make-new-state 1/50]
[to-draw place-ball-at]
[on-key reset]))
(define background (empty-scene 800 600))
(define (place-ball-at s)
(place-image (circle 10 "solid" "red")
(ballstate-x s)
(ballstate-y s)
background))
I am trying to implement the guess my number game in racket, and in a functional way, for educational purposes. My problem is that I have to stop the function with an error as in (error "YOU GUESSED!"). The error function is what I could find in the racket documentation. Is there an errorless way to stop this conditional?
Note: I read about stop-when, but I don't want to go into big-bang yet.
(define guess-my-number (lambda ()
(letrec ([my-number (random 100)]
[choices-left 7]
[game (lambda (choices-left)
(if (> choices-left 0)
(let ([user-guess (read)])
(cond [(> user-guess my-number) (display "That was too high!")]
[(< user-guess my-number) (display "That was too small!")]
[(= user-guess my-number) (error "YOU GUESSED!")])
(game (- choices-left 1)))
(display "Here ends the game!!")))])
(game choices-left))))
Chris' answer is perfect. This is really a comment -- except it's a bit long and you can't do code blocks in comments here.
The way you're coding it is a great way to understand how Racket works at a "low level", and is a very traditional way to code this in Scheme.
Another traditional way in Scheme is to use a couple features:
The shorthand way to define a function.
A named let, using the typical name loop.
That version:
(define (guess-my-number-v2)
(let ([number (random 100)])
(let loop ([guesses-left 7])
(cond [(> guesses-left 0)
(define user-guess (read))
(cond [(> user-guess number)
(display "That was too high!")
(loop (sub1 guesses-left))]
[(< user-guess number)
(display "That was too low!")
(loop (sub1 guesses-left))]
[else (display "YOU GUESSED!")])]
[else
(displayln "Here ends the game!!")]))))
What's interesting is that this expands to almost exactly the same thing as your first version.
The (let loop (guesses-left 7]) ...) form is essentially defining a function named loop, much like your original one named game. (In fact you could say (let game ([guesses-left 7]) ...), too.)
One benefit is that it's not as deeply indented and doesn't march off the right side of the screen.
Finally here's a version that's a bit more "Racket-y" in making more use of define:
(define (guess-my-number-v3)
(define number (random 100))
(define (guess guesses-left)
(cond [(> guesses-left 0)
(define user-guess (read))
(cond [(> user-guess number)
(display "That was too high!")
(guess (sub1 guesses-left))]
[(< user-guess number)
(display "That was too low!")
(guess (sub1 guesses-left))]
[else (display "YOU GUESSED!")])]
[else
(displayln "Here ends the game!!")]))
(guess 7))
Although this is in more of a "modern" Racket style, it's not inherently "better". It, too expands to almost exactly the same thing as the original. In fact most Racket programmers would find all 3 styles easy to understand.
Anyway, all 3 versions "loop" by recursively calling a function, as you were already doing. The way to "terminate the loop" is simply... don't call the function again. That's the key point in Chris' answer.
Yes. Do the (game (- choices-left 1)) recursion inside the cond branches where you want to reloop:
(define guess-my-number (lambda ()
(letrec ([my-number (random 100)]
[choices-left 7]
[game (lambda (choices-left)
(if (> choices-left 0)
(let ([user-guess (read)])
(cond [(> user-guess my-number) (display "That was too high!")
(game (- choices-left 1))]
[(< user-guess my-number) (display "That was too small!")
(game (- choices-left 1))]
[(= user-guess my-number) (display "YOU GUESSED!")]))
(display "Here ends the game!!")))])
(game choices-left))))
I add a button% to a dialog% like below:
(new button%
[label "ok"]
[parent pop-dialog%]
[callback
(lambda (b e)
(exit))])
Sorry, my complete code is below:
#lang racket
(require racket/gui)
(define *my-frame* (new frame%
[label "VersionMonitor"]
[width 300]
[height 200]
))
(define pop-dialog
(new dialog%
[label "bogga wogga"]
[parent *my-frame*]
[width 200]
[height 100]
))
(new canvas%
[parent pop-dialog]
[paint-callback
(lambda (canvas info-dc)
(send info-dc clear)
(send info-dc set-background "white"))])
(new button%
[label "ok"]
[parent pop-dialog]
[callback
(lambda (b e)
(exit))])
(send *my-frame* show #t)
(send pop-dialog show #t)
And now you can see the gray area. My real problem is how to set button%'s area's background
?
But the button% has a rectangle around it, beyond itself. The background is gray, I want
set its color to white, but didn't find a way to do it.
I don't see the problem you're reporting. In particular, I'm running this program:
#lang racket
(require mred)
(define pop-dialog
(new dialog% [label "bogga wogga"]))
(new button%
[label "ok"]
[parent pop-dialog]
[callback
(lambda (b e)
(exit))])
(send pop-dialog show #t)
... and I don't see a rectangle around the button. I don't think I can attach a screenshot in ...
oh, wait, maybe I can:
If this doesn't match what you're seeing, see if you can create a small program that illustrates the problem.
Also, the racket mailing list is probably going to give you prompt-er responses, for issues like this.
I thought I'd try a simple GUI app using the world/universe mutation-free approach, but trying to implement the 'world/universe' program design myself.
I've got my little sketch below, but I quickly came to conclusion that while I could use the teachpack, I don't know how to achieve the teachpack functionality myself.
I'm guessing I should use continuations, but that doesn't seem to be the approach in the universe.rkt source.
I could always just stuff the program into the canvas class, (as earlier games like slidey and same seem to do), but I really want to get a handle on how to implement the 'world/universe' style of program control.
;;;;----
#lang racket/gui
; simple drawing program
; mousedown starts recording a list of points
; mousechanged starts recording a new list
; paint callback paints the list of lists as lines.
(define diagramframe (new frame% [label "paint"] [width 300]
[height 300] [x 1000][y 300]))
;(define lines '(((0 . 0) (0 . 300) (250 . 250) (150 . 176))))
(define lines '(((0 . 0) (0 . 300) (250 . 250) (150 . 176))
((10 . 4) (280 . 10))))
(define paintcanvas%
(class canvas%
(init-field mouse-event-callback)
(super-new)
(define dc (send this get-dc))
(define/override (on-event mouse-event)
(mouse-event-callback mouse-event))))
(define (paint-cb c dc)
(for-each (λ (line) (send dc draw-lines line)) lines))
(define (me-cb mouse-event)
(let ((x (send mouse-event get-x))
(y (send mouse-event get-y)))
(when (and (send mouse-event get-left-down)
(send mouse-event moving?))
(if (send mouse-event button-changed?)
; if true append as new list
'()
; if false append existing list
'()))))
(define Paintcanvas (new paintcanvas%
[parent diagramframe]
[paint-callback paint-cb]
[mouse-event-callback me-cb]))
(define (main world)
(when world (main (??? world)))
(send diagramframe show #t))
(main lines)
(send diagramframe show #t)
;;-----
Here is how I would do it.
Note that the GUI event loop acts as the program main.
Use timer events to implement on-tick.
#lang racket/gui
;;;
;;; WORLD
;;;
(define-struct world (lines))
(define the-world (make-world '((0 . 0) (0 . 300) (250 . 250) (150 . 176) (10 . 4) (280 . 10))))
;;;
;;; USER LAND
;;;
(define (on-mouse-event world event)
(if (and (send event get-left-down)
(send event moving?)
#; (send event button-changed?))
(let ((x (send event get-x))
(y (send event get-y)))
(make-world (cons (cons x y) (world-lines world))))
world))
(define (on-paint world dc)
(send dc draw-lines
(map pair->point (world-lines world))))
(define (pair->point p)
(make-object point% (car p) (cdr p)))
;;;
;;; SYSTEM
;;;
(define user:on-paint on-paint)
(define diagramframe (new frame% [label "paint"] [width 300] [height 300] [x 1000][y 300]))
(define paintcanvas%
(class canvas%
(inherit get-dc refresh)
(super-new)
(define/override (on-paint)
(send (get-dc) suspend-flush)
(user:on-paint the-world (get-dc))
(send (get-dc) resume-flush))
(define/override (on-event mouse-event)
(let* ([old-world the-world]
[new-world (on-mouse-event the-world mouse-event)])
(if (eq? old-world new-world)
(super on-event mouse-event)
(begin
(set! the-world new-world)
(refresh)))))))
(define paintcanvas (new paintcanvas% [parent diagramframe]))
(send diagramframe show #t)