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.
Related
I'm trying to execute a custom made #lang on a given string (not in a file). Let's call it broccoli.
Setup
My lang is defined as so:
broccoli/main.rkt
(module reader racket/base
(require broccoli/private/reader)
(provide read read-syntax)) ; basically a reprovide
broccoli/private/reader.rkt
(provide
(rename-out
[my-read read]
[my-read-syntax read-syntax]))
(define (my-read in)
(syntax->datum
(my-read-syntax #f in)))
(define (my-read-syntax src in)
(with-syntax ([parse-tree (parse src (make-tokenizer in src))]) ; brag stuff
(strip-context
#'(module program broccoli/private/expander
parse-tree))))
broccoli/private/expander.rkt
(provide
(rename-out [module-begin #%module-begin]))
(define-syntax-rule (module-begin expr)
(#%module-begin
(provide meal)
(define meal (transform 'expr)))) ; some kind of computation
It works fairly well used the classic way :
#lang broccoli
Hello world!
will produce:
(module program broccoli/private/expander
(program
(sentence (word "Hello") (word "world"))))
which will then expand into:
(provide meal)
(define meal (list 42 38)) ; the result is for the sake of the example, don't mind it
But I'm trying to apply it to an arbitrary string I get from a network request, and send back the result.
And this time, it gets more complicated.
Here's what I tried:
Try #1
(define text "Hello world!")
(define evaluator (make-evaluator 'broccoli text)) ; Error: no #%module-begin found
(evaluator 'meal)
Try #2
(define text "Hello world!")
(define module (broccoli-read-syntax #f (open-input-string text)))
(define evaluator (make-module-evaluator #:language 'broccoli/private/expander module))
(evaluator 'meal) ; Error: meal undefined
Try #3
(define text "Hello world!")
(define evaluator (make-module-evaluator (string-append "#lang broccoli " text)))
(evaluator 'meal) ; Error: meal undefined
Try #4 (it works but it's not what I want)
(define text "Hello world!")
(define module (broccoli-read-syntax #f (open-input-string text)))
(define ns (make-base-namespace))
(eval module ns)
(namespace-require ''program ns)
(define result (eval 'meal ns))
This last result works correctly, but it doesn't use a sandbox, and uses eval directly.
I'm sure there's a better way, but I don't get what's going wrong.
I was sooo close!
I had to require the generated module inside the evaluator (which implies providing #%app, #%top, #%top-interaction, require and quote from the expander).
(define evaluator (make-module-evaluator (string-append "#lang broccoli\n" text)))
(evaluator '(require 'program)) ; missing step
(evaluator 'meal)
What I find weird in this solution is that it doesn't behave the same way the documentation says:
> (define base-module-eval
(make-module-evaluator '(module m racket/base
(define (f) later)
(define later 5))))
> (base-module-eval 'later)
5
I suggest using read-lang-module to turn the string into a syntax object representing a module. And then use make-module-evaluator.
I've been learning racket for a few days and I'm puzzled with this task, I'm trying to find empty lines in a text file and select a random empty line to INSERT the text "calculation here", this is as far as I have gotten so far.
for example: myfile.txt has the contents:
line1
line2
line3
line4
after the script is run, myfile.txt should now look like:
line1
calculation here
line2
line3
line4
or:
line1
line2
line3
calculation here
line4
un-working code below:
#lang racket
(define (write-to-file host text) (
with-output-to-file host (
lambda () (
write text))
#:exists 'replace))
(define empty-lines '()) ;store line number of empty line (if any)
(define (file-lines text-file)
(file->lines text-file))
(define (add-to-list line-num)
(set! empty-lines (cons line-num empty-lines)))
(let loop ((l (file-lines "myfile.txt")))
(cond ((null? l) #f)
(else
(printf "~s\n" (first l)) ; just for debugging
(cond ((equal? (first l) "") (add-to-list (first l)))(else #f))
(loop (rest l)))))
;now i need to select a random line from the list of empty-lines.
;and write "calculations here" to that line
there's no problem with the read lines method i am using, the problem is detecting and selecting a random empty space to insert my text.
Given a file name, you can read it into a list of lines using file->lines. So for instance:
(for ([line (in-list (file->lines "some-file"))])
(displayln (cond [(zero? (string-length line)) (make-random-line)]
[else line])))
Where make-random-line is some function you define to return a
random string, as you said you wanted to do.
The above reads the entire file into a list in memory. For larger files, it would be better to process things line by line. You can do this using the in-lines sequence:
(with-input-from-file "some-file"
(thunk
(for ([line (in-lines)])
(displayln (cond [(zero? (string-length line)) (make-random-line)]
[else line])))))
Update
Now that I understand your question:
#lang racket
(define lines (file->lines "some-file-name"))
(define empty-line-numbers (for/list ([line (in-list lines)]
[n (in-naturals)]
#:when (zero? (string-length line)))
n))
(define random-line-number (list-ref empty-line-numbers
(random (length empty-line-numbers))))
(for ([line (in-list lines)]
[n (in-naturals)])
(displayln (cond [(= n random-line-number) "SOME NEW STRING"]
[else line])))
(define (read-next-line-iter file)
(let ((line (read-line file)))
(unless (eof-object? line)
(display line)
(newline)
(read-next-line-iter file))))
(call-with-input-file "foobar.txt" read-next-line-iter)
http://rosettacode.org/wiki/Read_a_file_line_by_line#Racket
this function can help you read a file line by line.
check if the length is 0. and replace that line with the comment
look for 2 concurrent \n in the file. I am pretty sure there is a way in racket to do that. store those indices in a list select a pair randomly and replace the second \n with "calculation here\n".
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.
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)