How to set button%'s background in Racket? - racket

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.

Related

Racket GUI toolkit: how to allow a message% with a long label

Say we have code of the form:
#lang racket/gui
(define my-frame (new frame% [label "test"]))
(define some-string "A very long hello world .......................................................................................................................................................................................................")
(define my-msg (new message% [parent my-frame]
[label some-string]))
(send my-frame show #t)
Code of this form results into an error, because message% expects a label-string, which is a string that consists of 200 charachters or less. How can one have a message% of more than 200 charachters?
Do you really need to use message%? There is text-field%, you can disable it and set its value to your string.
#lang racket/gui
(define my-frame (new frame%
[label "Frame"]
[min-width 1000]
[min-height 500]))
(define some-string "A very long hello world .......................................................................................................................................................................................................")
(define my-msg (new text-field%
[label ""]
[init-value some-string]
;[style (list 'multiple)]
[parent my-frame]
[enabled false]))
(send my-msg set-field-background (make-object color% 240 240 240))
(send my-frame show #t)
If your string contains some newlines, uncomment [style (list 'multiple)] option.

Racket GUI: how to reference widgets created dynamically during the runtime?

This is the first time I use Racket GUI and I must say that I feel really confused.
I have these requirements:
a window composed of several widgets
the widgets state must change with user actions
it is possible to have several instances of these windows in the same time
Because of (3), I created a function create-window which create a new window with the new widgets.
But because of this, I have no global variable to reference my widgets.
How to reference widgets created dynamically during the runtime?
How to organize the GUI code in an idiomatic Racket GUI style?
It depends where the reference needs to occur. Who needs to talk to whom?
For example, if one widget has a callback to another widget in the same frame, and if you're creating both widgets together, then you can just name them and have the callback closure refer to the right name (ie, variable). Here's a little example program:
#lang racket/gui
;; create-hello-window : -> Void
(define (create-hello-window)
(define f (new frame% (label "Example") (width 600) (height 400)))
(define t (new text%))
(define ec (new editor-canvas% (parent f) (editor t)))
(define b (new button% (parent f) (label "Say hello")
(callback (lambda (b ce) (say-hello t)))))
(send f show #t)
(void))
;; say-hello : Editor -> Void
(define (say-hello t)
(send t set-position (send t last-position))
(send t insert "Hello world!\n"))
;; Create two independent hello windows
(for ([i 2]) (create-hello-window))
Notice that the button callback refers to the local variable t (the editor).
For more complicated communication, you need to save references somewhere to the objects you want to refer to. Here's another version of the previous program, where the windows are organized into groups, and each window has a button that writes a greeting to the other windows in the group. The group manages a list of windows and their editors.
#lang racket/gui
;; A HelloWin is (hellowin Editor Frame)
(struct hellowin (editor frame))
;; A HelloGroup is (hellogroup String (Listof HelloWin))
(struct hellogroup (name [wins #:mutable]))
;; create-hello-window : HelloGroup -> Void
(define (create-hello-window group)
(define f
(new frame% (label (hellogroup-name group)) (width 600) (height 400)))
(define t (new text%))
(define ec (new editor-canvas% (parent f) (editor t)))
(define hi-b
(new button% (parent f) (label "Say hello")
(callback (lambda (b ce) (add-to-end t "Hello world!\n")))))
(define greet-b
(new button% (parent f) (label "Greet others in group")
(callback (lambda (b ce) (greet-everyone-else t group)))))
(send f show #t)
(set-hellogroup-wins! group (cons (hellowin t f) (hellogroup-wins group))))
;; add-to-end : Editor String -> Void
(define (add-to-end t str)
(send t set-position (send t last-position))
(send t insert str))
;; greet-everyone-else : Editor HelloGroup -> Void
(define (greet-everyone-else my-t group)
(for ([h (in-list (hellogroup-wins group))])
(define t (hellowin-editor h))
(unless (equal? t my-t)
(add-to-end t (format "~a, hello from another window!\n"
(hellogroup-name group))))))
;; Create two groups, and create windows for each group.
(define group1 (hellogroup "Group 1" null))
(for ([i 3]) (create-hello-window group1))
(define group2 (hellogroup "Group 2" null))
(for ([i 2]) (create-hello-window group2))
My code doesn't use hellowin-frame, but you could use it to write a procedure that closes all of the windows in a group, for example.
Maybe you don't want the group to have direct access to the frame and its widgets. Then you could change the protocol so that groups contain some sort of greeting callbacks, or an object (not the widget itself) implementing a greetable<%> interface that you define, or so on. Then the callback (or greetable<%> object) will have references (or fields) to the widgets but not expose them directly to the group code. Also, maybe a group should be an object with a registration method instead of a struct with a mutable field.

Does racket allow for function overloading?

I am new to Lisp-scheme and fairly new to the functional paradigm as a whole, and am currently doing an assignment which requires me to overload a function with the same name, but different sets of parameters in racket. Below is an example of what I'm trying to achieve:
#lang racket
(define (put-ball-in-box two-by-fours nails ball)
... )
(define (put-ball-in-box box ball)
... )
These are not the actual functions, but close enough. As implied, both functions would put a ball in a box, but one would assemble the box from its components first, then call the other. Obviously, when I try the above in DrRacket or using the command line, I get a module: duplicate definition for identifier ... error.
Is there a way to achieve this in racket?
Maybe the answer is right in front of me, but I have spent the last two hours searching for this and couldn't find anything, so would appreciate any pointers.
Thank you.
It doesn't in the usual sense of "writing another definition somewhere else."
It allows shadowing, which is defining a procedure with the same name as an imported procedure. Thus you can (define + ...) and your definition of + will hide the + from racket/base. If you want the original procedure, then you can do something like the following, where I define + to be either addition or string-appending.
#lang racket/base
(require (rename-in racket/base (+ base:+)))
(define (+ . args)
(if (andmap string? args)
(apply string-append args)
(apply base:+ args)))
Another thing you can do is use racket/match to have different behavior based on the shape of the argument.
#lang racket/base
(require racket/match)
(define (fib . arg)
(match arg
[(list n) (fib n 1 0)]
[(list 1 a b) a]
[(list 0 a b) b]
[(list n a b) (fib (sub1 n) (+ a b) a)]))
This second example still doesn't quite do what you want since you have to go to the original definition point and modify the match clauses. But it might be sufficient for your purposes.
A more complicated example would be to use custom syntax to create a define/overload form. But I think you'll find the racket/match solution to be best.
You have the concept of default values as in JS and PHP:
(define (fib n (a 0) (b 1))
(if (zero? n)
a
(fib (sub1 n) b (+ a b))))
(fib 10) ; ==> 55
Now if you had 5 optional parameters you need to order them and even pass some values just to be able to add a later one. To avoid that you can use keywords:
(define (test name #:nick [nick name] #:job [job "vacant"])
(list name nick job))
(test "sylwester" #:job "programmer")
; ==> ("sylwester" "sylwester" "programmer")
Now Racket has classes. You can call a method like (send object method args ...).
(define circle%
(class object%
(super-new)
(init-field radius)
(define/public (area)
(* radius radius 3.1415))))
(define cube%
(class object%
(super-new)
(init-field side)
(define/public (area)
(* side side))))
(define circle (new circle% [radius 7]))
(define cube (new cube% [side 7]))
(map
(lambda (o) (send o area))
(list circle cube))
; ==> (153.9335 49)
Notice that the two classes hasn't really commited to a joint interface with area so this is pure duck typing. Thus you can make a function that expects a class that implements a message and it doesn't need to worry about other aspects of the class at all.

Racket: Why can't set canvas's background in windows

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.

Moving beyond world/universe

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)