;;-----------;; ;; movebox.l ;; ;;-----------;; (defun move-boxes-win! (win x y xwid ywid) (let ((now (list x y))) (if %pred-position% (when (not (equal %pred-position% (list x y))) (draw-xorbox-win! win (first %pred-position%) (second %pred-position%) (+ (first %pred-position%) xwid) (+ (second %pred-position%) ywid)) (draw-xorbox-win! win x y (+ x xwid) (+ y ywid))) (draw-xorbox-win! win x y (+ x xwid) (+ y ywid))) (setq %pred-position% now))) (defun get-position:move-boxes (win x y xwid ywid (end-by-release nil)) (let ((save-bp-handler (get-winprop win 'button-press-handler)) (save-br-handler (get-winprop win 'button-release-handler)) (save-mn-handler (get-winprop win 'motion-notify-handler)) (save-event-mask (window-event-mask win)) (%pred-position% nil) (%end% nil)) (print 'enter-move-boxes-mode) (put-winprop win (if (not end-by-release) 'button-release-handler 'button-press-handler) nil) (put-winprop win (if end-by-release 'button-release-handler 'button-press-handler) #'(lambda (win code x y) (setq %end% t) (setq %pred-position% (list x y)))) (put-winprop win 'motion-notify-handler `(lambda (win x y) (move-boxes-win! win x y ,xwid ,ywid))) (setf (window-event-mask win) '(:exposure :button-press :button-release :pointer-motion)) (move-boxes-win! win x y xwid ywid) (loop-disable-other-win win #'(lambda () %end%)) (setf (window-event-mask win) save-event-mask) (put-winprop win 'button-press-handler save-bp-handler) (put-winprop win 'button-release-handler save-br-handler) (put-winprop win 'motion-notify-handler save-mn-handler) (print 'exit-move-boxes-mode) %pred-position%)) (defun draw-corner-xorbox-win! (win x0 y0 x y) (let* ((minx (min x0 x)) (miny (min y0 y)) (widx (- (max x0 x) minx)) (widy (- (max y0 y) miny))) (draw-rectangle win (get-winprop win 'xorgc) minx miny widx widy))) (defun drag-corner-boxes-win! (win x0 y0 x y) (let ((now (list x y))) (if %pred-position% (when (not (equal %pred-position% (list x y))) (draw-corner-xorbox-win! win x0 y0 (first %pred-position%) (second %pred-position%)) (draw-corner-xorbox-win! win x0 y0 x y)) (draw-corner-xorbox-win! win x0 y0 x y)) (setq %pred-position% now))) (defun move-some-points (win code x0 y0 prim (end-by-release nil)) (let ((save-bp-handler (get-winprop win 'button-press-handler)) (save-br-handler (get-winprop win 'button-release-handler)) (save-mn-handler (get-winprop win 'motion-notify-handler)) (save-event-mask (window-event-mask win)) (%pred-position% nil) (%end% nil) (xwid nil) (ywid nil) (minx nil) (miny nil) (maxx nil) (maxy nil)) (catch 'exit-move-some (put-winprop win (if (not end-by-release) 'button-release-handler 'button-press-handler) nil) (put-winprop win (if end-by-release 'button-release-handler 'button-press-handler) #'(lambda (win code x y) (setq %end% (if (eq code *end-mode*) 'exit-move-some t)) (setq %pred-position% (list x y)))) (put-winprop win 'motion-notify-handler `(lambda (win x y) (drag-corner-boxes-win! win ,x0 ,y0 x y))) (setf (window-event-mask win) '(:exposure :button-press :button-release :pointer-motion)) (loop-disable-other-win win #'(lambda () %end%)) (if (eq %end% 'exit-move-some) (throw 'exit-move-some nil)) ;; ;; I've got coodinates of the square's points already... ;; (setq xwid (abs (- x0 (first %pred-position%))) ywid (abs (- y0 (second %pred-position%)))) (setq minx (min x0 (first %pred-position%)) miny (min y0 (second %pred-position%))) (setq maxx (+ minx xwid) maxy (+ miny ywid)) (setq xwid (// xwid 2) ywid (// ywid 2) x0 (// (+ minx maxx) 2) y0 (// (+ miny maxy) 2)) (comment draw-xorline-win! win minx miny maxx maxy) (draw-corner-xorbox-win! win minx miny maxx maxy) (draw-corner-dashbox-win! win minx miny maxx maxy) (setq %pred-position% nil) (setq %end% nil) (put-winprop win 'button-press-handler #'(lambda (win code x y) (setq %end% (if (eq code *end-mode*) 'exit-move-some t)) (setq %pred-position% (list x y)))) (put-winprop win 'motion-notify-handler `(lambda (win x y) (move-boxes-win! win x y ,xwid ,ywid))) (setf (window-event-mask win) '(:exposure :button-press :button-release :pointer-motion)) (move-boxes-win! win x0 y0 xwid ywid) (loop-disable-other-win win #'(lambda () %end%)) (if (eq %end% 'exit-move-some) (throw 'exit-move-some nil)) (setq prim (move-some-points-of-primitive minx maxx miny maxy (- (first %pred-position%) x0) (- (second %pred-position%) y0) prim))) (clear-win win) (if grid (grid-win win)) (draw-skeleton-win win prim) (redraw-win win) (setf (window-event-mask win) save-event-mask) (put-winprop win 'button-press-handler save-bp-handler) (put-winprop win 'button-release-handler save-br-handler) (put-winprop win 'motion-notify-handler save-mn-handler) prim)) (defun move-some-points-of-primitive (xmin xmax ymin ymax offx offy prim) (let ((ret nil) (points (get-points prim)) (lines (get-lines prim)) (aux-info (get-aux-info prim)) (now nil)) (setq points (mapcar points `(lambda (e) (let* ((x (first e)) (y (second e)) (info (cddr e))) (if (and (< xmin x) (< x xmax) (< ymin y) (< y ymax)) (cons (+ x offx) (cons (+ y offy) info)) e))))) (setq ret (cons points (cons lines aux-info))) ret))