mirror of
https://github.com/rabbibotton/clog.git
synced 2026-02-03 14:22:11 -08:00
rewrite size and move code
This commit is contained in:
David Botton
parent
180b64c6ca
commit
5281c593ef
1 changed files with 73 additions and 71 deletions
|
|
@ -257,8 +257,7 @@ return t on success"
|
|||
:left (position-left control)
|
||||
:width (client-width control)
|
||||
:height (client-height control))
|
||||
(jquery-execute placer (format nil "draggable({snap:'.placer',snapMode:'inner',cursor:'crosshair'})~
|
||||
.resizable({alsoResize:'#~A',autoHide:true})"
|
||||
(jquery-execute placer (format nil "resizable({alsoResize:'#~A',autoHide:true})"
|
||||
(html-id control)))
|
||||
;; setup placer events
|
||||
(setf (tab-index placer) "-1") ; must have a tab-index to accept keyboard input
|
||||
|
|
@ -301,96 +300,99 @@ return t on success"
|
|||
:height (client-height control))
|
||||
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
||||
(set-properties-after-geomentry-change control))))
|
||||
(set-on-touch-start placer (lambda (obj data)
|
||||
(declare (ignore obj))
|
||||
(setf touch-x (getf data :X))
|
||||
(setf touch-y (getf data :Y)))
|
||||
:cancel-event t)
|
||||
(set-on-touch-move placer (lambda (obj data)
|
||||
(declare (ignore obj))
|
||||
(set-geometry control :top (+ (position-top control)
|
||||
(- (getf data :y) touch-y))
|
||||
(set-on-pointer-move content nil)
|
||||
(set-geometry placer :top (+ (position-top control)
|
||||
(- (getf data :screen-y) touch-y))
|
||||
:left (+ (position-left control)
|
||||
(- (getf data :x) touch-x)))
|
||||
(setf touch-x (getf data :X))
|
||||
(setf touch-y (getf data :Y)))
|
||||
:cancel-event t)
|
||||
(set-on-touch-end placer (lambda (obj data)
|
||||
(declare (ignore obj data))
|
||||
(set-geometry placer :units ""
|
||||
:top (top control)
|
||||
:left (left control))
|
||||
(select-control control)
|
||||
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
||||
(set-properties-after-geomentry-change control))
|
||||
(- (getf data :screen-x) touch-x))))
|
||||
:cancel-event t)
|
||||
(set-on-mouse-up placer (lambda (obj data)
|
||||
(set-on-touch-end placer (lambda (obj data)
|
||||
(declare (ignore obj data))
|
||||
(set-geometry control :units ""
|
||||
:top (top placer)
|
||||
:left (left placer))
|
||||
(setf (background-color placer) "")
|
||||
(set-geometry placer :units ""
|
||||
:top (top control)
|
||||
:left (left control))
|
||||
(select-control control)
|
||||
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
||||
(set-properties-after-geomentry-change control))
|
||||
:cancel-event t)
|
||||
(set-on-mouse-down placer
|
||||
(lambda (obj data)
|
||||
(declare (ignore obj))
|
||||
(let ((last (current-control app))
|
||||
(shift (getf data :shift-key)))
|
||||
(if (and (select-tool app)
|
||||
(not (equal (value (select-tool app)) "")))
|
||||
(when (do-drop-new-control app content data :win win)
|
||||
(incf-next-id content)))
|
||||
(cond ((and last
|
||||
shift)
|
||||
(let* ((control1 last)
|
||||
(control2 control)
|
||||
(placer1 (get-placer control1))
|
||||
(placer2 (get-placer control2)))
|
||||
(place-inside-bottom-of control1 control2)
|
||||
(place-after control2 placer2)
|
||||
(place-after control2 placer2)
|
||||
(set-geometry placer1 :top (position-top control1)
|
||||
:left (position-left control1)
|
||||
:width (client-width control1)
|
||||
:height (client-height control1))
|
||||
(set-geometry placer2 :top (position-top control2)
|
||||
:left (position-left control2)
|
||||
:width (client-width control2)
|
||||
:height (client-height control2)))
|
||||
(select-control control)
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win))
|
||||
(t
|
||||
(select-control control)))
|
||||
(when win
|
||||
(window-focus win))))
|
||||
:cancel-event t)
|
||||
:cancel-event t)
|
||||
(flet ((mouse-move (obj data)
|
||||
(declare (ignore obj))
|
||||
(set-geometry placer
|
||||
:top (+ (position-top control)
|
||||
(- (getf data :screen-y) touch-y))
|
||||
:left (+ (position-left control)
|
||||
(- (getf data :screen-x) touch-x)))))
|
||||
(set-on-pointer-up placer (lambda (obj data)
|
||||
(declare (ignore obj data))
|
||||
(set-on-pointer-move content nil)
|
||||
(setf (background-color placer) "")
|
||||
(set-geometry control :units ""
|
||||
:top (top placer)
|
||||
:left (left placer))
|
||||
(set-geometry placer :units ""
|
||||
:top (top control)
|
||||
:left (left control))
|
||||
(select-control control)
|
||||
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
||||
(set-properties-after-geomentry-change control))
|
||||
:cancel-event t)
|
||||
(set-on-pointer-down placer
|
||||
(lambda (obj data)
|
||||
(declare (ignore obj))
|
||||
(let ((last (current-control app))
|
||||
(shift (getf data :shift-key)))
|
||||
(if (and (select-tool app)
|
||||
(not (equal (value (select-tool app)) "")))
|
||||
(when (do-drop-new-control app content data :win win)
|
||||
(incf-next-id content)))
|
||||
(cond ((and last
|
||||
shift)
|
||||
(let* ((control1 last)
|
||||
(control2 control)
|
||||
(placer1 (get-placer control1))
|
||||
(placer2 (get-placer control2)))
|
||||
(place-inside-bottom-of control1 control2)
|
||||
(place-after control2 placer2)
|
||||
(place-after control2 placer2)
|
||||
(set-geometry placer1 :top (position-top control1)
|
||||
:left (position-left control1)
|
||||
:width (client-width control1)
|
||||
:height (client-height control1))
|
||||
(set-geometry placer2 :top (position-top control2)
|
||||
:left (position-left control2)
|
||||
:width (client-width control2)
|
||||
:height (client-height control2)))
|
||||
(select-control control)
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win))
|
||||
(last
|
||||
(set-on-pointer-move content #'mouse-move)
|
||||
(setf (background-color placer) (rgba 0 0 255 0.10))
|
||||
(setf touch-x (getf data :screen-x))
|
||||
(setf touch-y (getf data :screen-y)))
|
||||
(t
|
||||
(select-control control)))
|
||||
(when win
|
||||
(window-focus win))))
|
||||
:capture-pointer t))
|
||||
(set-on-mouse-double-click placer
|
||||
(lambda (obj data)
|
||||
(declare (ignore obj data))
|
||||
(setf (hiddenp placer) t)
|
||||
(on-populate-control-list-win content :win win))
|
||||
:cancel-event t)
|
||||
(on-populate-control-list-win content :win win)))
|
||||
(set-on-event placer "resize"
|
||||
(lambda (obj)
|
||||
(set-properties-after-geomentry-change obj)))
|
||||
(declare (ignore obj))
|
||||
(set-on-pointer-move content nil)
|
||||
(setf (background-color placer) "")))
|
||||
(set-on-event placer "resizestop"
|
||||
(lambda (obj)
|
||||
(set-properties-after-geomentry-change obj)
|
||||
(jquery-execute placer "trigger('clog-builder-snap-shot')"))
|
||||
:cancel-event t)
|
||||
(set-on-event placer "drag"
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(set-geometry control :units ""
|
||||
:top (top placer)
|
||||
:left (left placer))
|
||||
(set-properties-after-geomentry-change control)))))
|
||||
:cancel-event t)))
|
||||
|
||||
(defun on-populate-loaded-window (content &key win)
|
||||
"Setup html imported in to CONTENT for use with Builder"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue