[racket] Moving beyond world/universe

Thanks,

Thats exactly what I needed.

Stephen

PS Here is another version

#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)
  (let ((x (send event get-x))
        (y (send event get-y)))
    (cond
      [(and (send event get-left-down) (send event button-changed?))
       (make-world (cons (cons (cons x y) '()) (world-lines world)))]
      [(and (send event get-left-down) (send event moving?) (not (send
event button-changed?)))
       (make-world (cons (cons (cons x y) (car (world-lines world))) (cdr
(world-lines world))))]
      [else world])))

(define (on-paint world dc)
  (for-each (λ (lines) (send dc draw-lines lines))
            (world-lines world)))

;;;
;;; 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)
    (send (get-dc) set-pen "red" 10 'solid )
    (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)




On Mon, Apr 9, 2012 at 12:12 PM, Jens Axel Søgaard <jensaxel at soegaard.net>wrote:

> Hi Stephen,
>
> Here is how I would do it.
>
> /Jens Axel
>
> #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)
>
>
>
> 2012/4/9 Stephen De Gabrielle <stephen.degabrielle at acm.org>:
> > Hi,
> >
> > 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.
> >
> > Any suggestons would be appreciated.
> >
> > Kind regards,
> >
> > Stephen
> >
> >
> > ;;;;----
> > #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)
> >
> > ;;-----
> >
> > ____________________
> >  Racket Users list:
> >  http://lists.racket-lang.org/users
> >
>
> --
> Jens Axel Søgaard
>



-- 

--
Stephen De Gabrielle
stephen.degabrielle at acm.org
Telephone +44 (0)20 85670911
Mobile        +44 (0)79 85189045
http://www.degabrielle.name/stephen
----
Professor: Oh God! I clicked without reading!
Cubert: And I slightly modified something I own!
Professor: We're monsters!
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20120410/1525f23e/attachment-0001.html>