examples/drag-and-drop/drag-and-drop-1.rkt
#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))