Need to account for the pageX and pageY of the playground

examples/drag-and-drop/drag-and-drop-1.rkt

@@ -8,56 +8,52 @@
 
 ;; A small drag-and-drop example using the web-world library.
 ;;
-;; The world consists of a set of boxes.
+;; The world consists of a set of shapes.
 ;;
-;; A box has an id and a position.
+;; A shape has an id and a position.
-(define-struct box (id x y))
+(define-struct shape (id x y))
 
 
 
-;; add-fresh-box: world view -> world
+;; add-fresh-shape: world view -> world
 ;; Given a world, creates a new world within the boundaries of the playground.
-(define (add-fresh-box w v)
+(define (add-fresh-shape w v)
   (define-values (max-width max-height) (width-and-height v "playground"))
-  (define new-world (cons (make-box (fresh-id)
+  (define new-world (cons (make-shape (fresh-id)
-                                    (random max-width)
+                                      (random max-width)
-                                    (random max-height))
+                                      (random max-height))
                           w))
   new-world)
 
 
 
-;; FIXME: do some javascript stuff here to get at this.
-;;
 (define (width-and-height v element-id)
   (define focused (view-focus v element-id))
-  (printf "width is: ~s\n" (view-width focused))
   (values (view-width focused)
           (view-height focused)))
 
 
 (define (draw w v)
-  (foldl (lambda (a-box v)
+  (foldl (lambda (a-shape v)
            (cond
-            [(view-focus? v (box-id a-box))
+            [(view-focus? v (shape-id a-shape))
              v]
             [else
              (view-append-child v
-                                (xexp->dom `(span (@ (class "box")
+                                (xexp->dom `(span (@ (class "shape")
-                                                    (id ,(box-id a-box))
+                                                     (id ,(shape-id a-shape))
-                                                    (style ,(format "position: absolute; left: ~apx; top: ~apx"
+                                                     (style ,(format "position: absolute; left: ~apx; top: ~apx"
-                                                                   (box-x a-box)
+                                                                     (shape-x a-shape)
-                                                                   (box-y a-box))))
+                                                                     (shape-y a-shape))))
-                                                 "box")))]))
+                                                  "shape")))]))
          (view-focus v "playground")
          w))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define the-view (view-bind-many view.html
-                                 ["add" "click" add-fresh-box]))
+                                 ["add" "click" add-fresh-shape]))
-  
+
 (big-bang (list)
           (initial-view the-view)
           (to-draw draw))
-          

examples/drag-and-drop/drag-and-drop-2.rkt

@@ -8,63 +8,93 @@
 
 ;; A small drag-and-drop example using the web-world library.
 ;;
-;; The world consists of a set of boxes.  It also has a reference
+;; The world consists of a set of shapes.  It also has a reference
-;; to the currently dragged box, if one is being dragged.
+;; to the currently dragged shape, if one is being dragged.
-(define-struct world (boxes  ;; (listof box)
+(define-struct world (shapes  ;; (listof shape)
-                      dragged ;; (U box #f)
+                      dragged ;; (U shape #f)
                       ))
 
-;; A box has an id and a position.
+;; A shape has an id and a position.
-(define-struct box (id x y))
+(define-struct shape (id x y))
 
 
 
-;; add-fresh-box: world view -> world
+;; add-fresh-shape: world view -> world
 ;; Given a world, creates a new world within the boundaries of the playground.
-(define (add-fresh-box w v)
+(define (add-fresh-shape w v)
-  (define-values (max-width max-height) (width-and-height "playground"))
+  (define-values (max-width max-height) (width-and-height v "playground"))
-  (define new-world (make-world (cons (make-box (fresh-id)
+  (define new-world (make-world (cons (make-shape (fresh-id)
                                                 (random max-width)
                                                 (random max-height))
-                                      (world-boxes w))
+                                      (world-shapes w))
                                 (world-dragged w)))
   new-world)
 
 
 
-;; FIXME: do some javascript stuff here to get at this.
+(define (width-and-height v element-id)
-;;
+  (define focused (view-focus v element-id))
-(define (width-and-height element-id)
+  (values (view-width focused)
-  (values 500 500))
+          (view-height focused)))
 
 
 (define (draw w v)
-  (foldl (lambda (a-box v)
+  (foldl (lambda (a-shape v)
            (cond
-            [(view-focus? v (box-id a-box))
+            [(view-focus? v (shape-id a-shape))
-             v]
+             (define focused (view-focus v (shape-id a-shape)))
+             (update-view-css (update-view-css focused "left" (format "~apx" (shape-x a-shape)))
+                              "top"
+                              (format "~apx" (shape-y a-shape)))]
             [else
              (view-append-child v
-                                (xexp->dom `(span (@ (class "box")
+                                (xexp->dom `(span (@ (class "shape")
-                                                    (id ,(box-id a-box))
+                                                    (id ,(shape-id a-shape))
                                                     (style ,(format "position: absolute; left: ~apx; top: ~apx"
-                                                                   (box-x a-box)
+                                                                   (shape-x a-shape)
-                                                                   (box-y a-box))))
+                                                                   (shape-y a-shape))))
-                                                 "box")))]))
+                                                 "shape")))]))
          (view-focus v "playground")
-         (world-boxes w)))
+         (if (shape? (world-dragged w))
+             (cons (world-dragged w) (world-shapes w))
+             (world-shapes w))))
 
 
-;; When the mouse is down, we see if the event intersects any of our boxes.
+;; When the mouse is down, should see if the event intersects any of our shapes.
 (define (mousedown w v evt)
-  ...)
+  (cond
+   [(empty? (world-shapes w))
+    w]
+   [else
+    (make-world (rest (world-shapes w))
+                (first (world-shapes w)))]))
+
+
+(define (mouseup w v evt)
+  (cond [(shape? (world-dragged w))
+         (make-world (cons (world-dragged w)
+                           (world-shapes w))
+                     #f)]
+        [else
+         w]))
+
+
+(define (mousemove w v evt)
+  (cond
+   [(shape? (world-dragged w))
+    (make-world (world-shapes w)
+                (make-shape (shape-id (world-dragged w))
+                            (event-ref evt "pageX")
+                            (event-ref evt "pageY")))]
+  [else
+   w]))
 
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define the-view (view-bind-many view.html
-                                 ["add" "click" add-fresh-box]
+                                 ["add" "click" add-fresh-shape]
                                  ["playground" "mousedown" mousedown]
                                  ["playground" "mousemove" mousemove]
                                  ["playground" "mouseup" mouseup]))

examples/drag-and-drop/style.css

@@ -9,7 +9,7 @@
 }
 
 
-.box {
+.shape {
     position: relative;
     background-color: orange;
     border: 1px solid black;