[racket] Moving beyond world/universe

From: Jens Axel Søgaard (jensaxel at soegaard.net)
Date: Mon Apr 9 07:12:42 EDT 2012

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


Posted on the users mailing list.