60 lines
1.9 KiB
Racket
60 lines
1.9 KiB
Racket
#lang planet dyoo/whalesong
|
|
|
|
(require (planet dyoo/whalesong/web-world)
|
|
(planet dyoo/whalesong/resource))
|
|
|
|
(define-resource view.html)
|
|
(define-resource style.css)
|
|
|
|
;; A small drag-and-drop example using the web-world library.
|
|
;;
|
|
;; The world consists of a set of shapes.
|
|
;;
|
|
;; A shape has an id and a position.
|
|
(define-struct shape (id x y))
|
|
|
|
|
|
|
|
;; add-fresh-shape: world view -> world
|
|
;; Given a world, creates a new world within the boundaries of the playground.
|
|
(define (add-fresh-shape w v)
|
|
(define-values (max-width max-height) (width-and-height v "playground"))
|
|
(define new-world (cons (make-shape (fresh-id)
|
|
(random max-width)
|
|
(random max-height))
|
|
w))
|
|
new-world)
|
|
|
|
|
|
|
|
(define (width-and-height v element-id)
|
|
(define focused (view-focus v element-id))
|
|
(values (view-width focused)
|
|
(view-height focused)))
|
|
|
|
|
|
(define (draw w v)
|
|
(foldl (lambda (a-shape v)
|
|
(cond
|
|
[(view-focus? v (shape-id a-shape))
|
|
v]
|
|
[else
|
|
(view-append-child v
|
|
(xexp->dom `(span (@ (class "shape")
|
|
(id ,(shape-id a-shape))
|
|
(style ,(format "position: absolute; left: ~apx; top: ~apx"
|
|
(shape-x a-shape)
|
|
(shape-y a-shape))))
|
|
"shape")))]))
|
|
(view-focus v "playground")
|
|
w))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define the-view (view-bind-many view.html
|
|
["add" "click" add-fresh-shape]))
|
|
|
|
(big-bang (list)
|
|
(initial-view the-view)
|
|
(to-draw draw))
|