;;-------------;; ;; resizebox.l ;; ;;-------------;; (defun draw-corner-dashbox-win! (win x0 y0 x1 y1) (let* ((minx (min x0 x1)) (miny (min y0 y1)) (widx (- (max x0 x1) minx)) (widy (- (max y0 y1) miny))) (draw-rectangle win (get-winprop win 'dashlinegc) minx miny widx widy))) (defun resize-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) (minx nil) (miny nil) (maxx nil) (maxy nil)) (catch 'exit-resize-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-resize-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-resize-some) (throw 'exit-resize-some nil)) ;; ;; I've got coodinates of the square's points already... ;; (setq minx x0 miny y0 maxx (first %pred-position%) maxy (second %pred-position%)) (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-resize-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-resize-some) (throw 'exit-resize-some nil)) (setq prim (resize-some-points-of-primitive minx miny maxx maxy x0 y0 (first %pred-position%) (second %pred-position%) 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 resize-some-points-of-primitive (x0 y0 x1 y1 newx newy newmaxx newmaxy 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 (or (and (< x0 x) (< x x1)) (and (< x1 x) (< x x0))) (or (and (< y0 y) (< y y1)) (and (< y1 y) (< y y0)))) (let ((xm (- x x0)) (xn (- x1 x)) (ym (- y y0)) (yn (- y1 y))) (cons (divide-m-n newx newmaxx xm xn) (cons (divide-m-n newy newmaxy ym yn) info))) e))))) (setq ret (cons points (cons lines aux-info))) ret)) (defun divide-m-n (x1 x2 m n) (// (+ (* x1 n) (* x2 m)) (+ m n)))