diff --git a/examples/drag-and-drop/drag-and-drop-1.rkt b/examples/drag-and-drop/drag-and-drop-1.rkt index 7ca41b6..6c04ed4 100644 --- a/examples/drag-and-drop/drag-and-drop-1.rkt +++ b/examples/drag-and-drop/drag-and-drop-1.rkt @@ -11,8 +11,6 @@ ;; The world consists of a set of boxes. ;; ;; A box has an id and a position. - -(define-struct world (boxes)) (define-struct box (id x y)) diff --git a/examples/drag-and-drop/drag-and-drop-2.rkt b/examples/drag-and-drop/drag-and-drop-2.rkt index 7ca41b6..b9c264f 100644 --- a/examples/drag-and-drop/drag-and-drop-2.rkt +++ b/examples/drag-and-drop/drag-and-drop-2.rkt @@ -8,11 +8,13 @@ ;; A small drag-and-drop example using the web-world library. ;; -;; The world consists of a set of boxes. -;; -;; A box has an id and a position. +;; The world consists of a set of boxes. It also has a reference +;; to the currently dragged box, if one is being dragged. +(define-struct world (boxes ;; (listof box) + dragged ;; (U box #f) + )) -(define-struct world (boxes)) +;; A box has an id and a position. (define-struct box (id x y)) @@ -21,10 +23,11 @@ ;; Given a world, creates a new world within the boundaries of the playground. (define (add-fresh-box w v) (define-values (max-width max-height) (width-and-height "playground")) - (define new-world (cons (make-box (fresh-id) - (random max-width) - (random max-height)) - w)) + (define new-world (make-world (cons (make-box (fresh-id) + (random max-width) + (random max-height)) + (world-boxes w)) + (world-dragged w))) new-world) @@ -49,14 +52,24 @@ (box-y a-box)))) "box")))])) (view-focus v "playground") - w)) + (world-boxes w))) + + +;; When the mouse is down, we see if the event intersects any of our boxes. +(define (mousedown w v evt) + ...) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define the-view (view-bind-many view.html - ["add" "click" add-fresh-box])) + ["add" "click" add-fresh-box] + ["playground" "mousedown" mousedown] + ["playground" "mousemove" mousemove] + ["playground" "mouseup" mouseup])) -(big-bang (list) +(big-bang (make-world (list) #f) (initial-view the-view) (to-draw draw)) \ No newline at end of file diff --git a/scribblings/manual.scrbl b/scribblings/manual.scrbl index 9b85c5e..a153ffa 100644 --- a/scribblings/manual.scrbl +++ b/scribblings/manual.scrbl @@ -1043,6 +1043,14 @@ Update the attribute @racket[name] with the value @racket[value] at the focus. Remove the attribute @racket[name] at the focus. } +@defproc[(view-width [v view]) number]{ +Get the width at the focus. +} + +@defproc[(view-height [v view]) number]{ +Get the height at the focus. +} + @defproc[(view-css [v view] [name String]) view]{ Get the css value @racket[name] at the focus. } diff --git a/web-world/impl.rkt b/web-world/impl.rkt index 7075ea2..063a4dd 100644 --- a/web-world/impl.rkt +++ b/web-world/impl.rkt @@ -71,6 +71,9 @@ view-css update-view-css + + view-width + view-height view-id diff --git a/web-world/js-impl.js b/web-world/js-impl.js index 64f5178..6db901e 100644 --- a/web-world/js-impl.js +++ b/web-world/js-impl.js @@ -307,6 +307,14 @@ return $(this.getCursor().node[0]).css(name); }; + MockView.prototype.getWidth = function(name) { + return $(this.getCursor().node[0]).width(); + }; + + MockView.prototype.getHeight = function(name) { + return $(this.getCursor().node[0]).height(); + }; + MockView.prototype.updateCss = function(name, value) { return this.act( @@ -2018,6 +2026,20 @@ return view.getCss(name); }); + EXPORTS['view-width'] = makePrimitiveProcedure( + 'view-width', + 1, + function(MACHINE) { + var view = checkMockViewOnElement(MACHINE, 'view-width', 0); + return view.getWidth(); + }); + EXPORTS['view-height'] = makePrimitiveProcedure( + 'view-height', + 1, + function(MACHINE) { + var view = checkMockViewOnElement(MACHINE, 'view-height', 0); + return view.getHeight(); + }); EXPORTS['update-view-css'] = makePrimitiveProcedure( 'update-view-css', diff --git a/web-world/racket-impl.rkt b/web-world/racket-impl.rkt index 669742d..2db8f94 100644 --- a/web-world/racket-impl.rkt +++ b/web-world/racket-impl.rkt @@ -20,6 +20,7 @@ view-text update-view-text view-attr view-has-attr? update-view-attr remove-view-attr view-css update-view-css + view-width view-height view-id view-bind @@ -163,6 +164,12 @@ (define (view-css v attr-name) (error 'view-css "Please run in JavaScript context.")) +(define (view-width v) + (error 'view-width "Please run in JavaScript context.")) + +(define (view-height v) + (error 'view-height "Please run in JavaScript context.")) + (define (update-view-css v attr-name value) (error 'update-view-css "Please run in JavaScript context."))