View of /skeleton-edit/resizebox.l

Parent Directory

Revision Log

*** empty log message ***

;;-------------;;
;; 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)))