Cad like manipulation

Readme.org

@@ -35,3 +35,17 @@ You can rotate the preview image with following keys :
 - =M-<up>=, =M=k=    :: translate- along z-axis
 - =M-<down>=, =M-j=  :: translate+ along z-axis
 - =r=                :: reset view
+
+** Mouse
+
+Now it is possible to use the mouse to manipulate the preview image.
+Mouse usage slightly resembles the original OpenScad manipulation.
+The reason behind the ununified usage of C key is laziness (haven't
+found a trivial way to use mouse-wheel without modifier key, or use
+drag with C/M).
+
+- =C-mouse-4=, =C-wheel-up=   :: zoom-out
+- =C-mouse-5=, =C-wheel-down= :: zoom-in
+- =drag-mouse-3=              :: rotate
+- =drag-mouse-1=              :: translate
+

linal-util.el

@@ -0,0 +1,202 @@
+;;; linal-util.el --- Linear algebra functions for scad-preview mode
+;;; Commentary:
+
+;; Copyright (C) 2013-2015 zk_phi
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+;; Author: hooger
+
+;;; Code:
+
+(defun vector_norm (vec)
+  "Calculates Euclidian-norm of an arbitrary length vector VEC."
+  (sqrt (apply '+ (mapcar (lambda (x) (* x x)) vec)))
+  )
+(defun vector_normal (vec)
+  "Returnsed a normal vector, pointing to the same direction as VEC."
+  (let (
+	(vec_n (float (vector_norm vec)))
+	)
+    (mapcar (lambda (x) (/ x vec_n)) vec)
+    )
+  )
+(defun rotation (ang vec &optional deg)
+  "Rotation matrix definition with Rodrigues formula.
+\(Murray et.  al,  A Mathematical Introduction to Robotic Manipulation pp.  29\)
+Rotation vector with ANG around VEC.  ANG is in degree if DEG is non-nil."
+  (when (= (length vec) 3)
+    (let (
+	  (ang
+	   (if deg
+	       (* pi (/ ang (float 180)))
+	     ang
+	     ))
+	  )
+      (let (
+	    (o (vector_normal vec))
+	    (vt (- 1 (cos ang)))
+	    (st (sin ang))
+	    (ct (cos ang))
+	    )
+	`(,(+ (* vt (* (nth 0 o) (nth 0 o))) (* 1 ct))
+	  ,(- (* vt (* (nth 0 o) (nth 1 o))) (* (nth 2 o) st))
+	  ,(+ (* vt (* (nth 0 o) (nth 2 o))) (* (nth 1 o) st))
+
+	  ,(+ (* vt (* (nth 1 o) (nth 0 o))) (* (nth 2 o) st))
+	  ,(+ (* vt (* (nth 1 o) (nth 1 o))) (* 1 ct))
+	  ,(- (* vt (* (nth 1 o) (nth 2 o))) (* (nth 0 o) st))
+
+	  ,(- (* vt (* (nth 2 o) (nth 0 o))) (* (nth 1 o) st))
+	  ,(+ (* vt (* (nth 2 o) (nth 1 o))) (* (nth 0 o) st))
+	  ,(+ (* vt (* (nth 2 o) (nth 2 o))) (* 1 ct))
+	  )))))
+(defun matrixmul3x3 (a b)
+  "Multiplying two 3x3 matrices.
+The two matrices are A and B"
+  (when (and (= (length a) 9) (= (length b) 9) )
+    `(
+      ,(+ (* (nth 0 a) (nth 0 b)) (* (nth 1 a) (nth 3 b)) (* (nth 2 a) (nth 6 b)))
+      ,(+ (* (nth 0 a) (nth 1 b)) (* (nth 1 a) (nth 4 b)) (* (nth 2 a) (nth 7 b)))
+      ,(+ (* (nth 0 a) (nth 2 b)) (* (nth 1 a) (nth 5 b)) (* (nth 2 a) (nth 8 b)))
+      ,(+ (* (nth 3 a) (nth 0 b)) (* (nth 4 a) (nth 3 b)) (* (nth 5 a) (nth 6 b)))
+      ,(+ (* (nth 3 a) (nth 1 b)) (* (nth 4 a) (nth 4 b)) (* (nth 5 a) (nth 7 b)))
+      ,(+ (* (nth 3 a) (nth 2 b)) (* (nth 4 a) (nth 5 b)) (* (nth 5 a) (nth 8 b)))
+      ,(+ (* (nth 6 a) (nth 0 b)) (* (nth 7 a) (nth 3 b)) (* (nth 8 a) (nth 6 b)))
+      ,(+ (* (nth 6 a) (nth 1 b)) (* (nth 7 a) (nth 4 b)) (* (nth 8 a) (nth 7 b)))
+      ,(+ (* (nth 6 a) (nth 2 b)) (* (nth 7 a) (nth 5 b)) (* (nth 8 a) (nth 8 b)))
+      )
+    )
+  )
+(defun matrixvectormul3x1 (mx v)
+  "Multiplying 3x3 matrix with 3x1 vector.
+MX is the matrix, V is the vector"
+  (when (and (= (length mx) 9) (= (length v) 3) )
+    `(
+      ,(+ (* (nth 0 mx) (nth 0 v)) (* (nth 1 mx) (nth 1 v)) (* (nth 2 mx) (nth 2 v)))
+      ,(+ (* (nth 3 mx) (nth 0 v)) (* (nth 4 mx) (nth 1 v)) (* (nth 5 mx) (nth 2 v)))
+      ,(+ (* (nth 6 mx) (nth 0 v)) (* (nth 7 mx) (nth 1 v)) (* (nth 8 mx) (nth 2 v)))
+      )
+    )
+  )
+(defun rot2euler (r &optional deg)
+  "Calculate Euler angles from a rotation matrix by Gregory G. Slabaugh.
+Rotation order is X, Y, Z
+R is the rotation matrix
+if non-nil DEG is result is converted to degree"
+  (when (= (length r) 9)
+    (let
+	(
+	 (x1 0)
+	 (x2 0)
+	 (y1 0)
+	 (y2 0)
+	 (z1 0)
+	 (z2 0)
+	 )
+      (if (= (abs (nth 6 r)) 1)
+	  (progn
+	    (setq z1 0)
+	    (setq z2 0)
+	    (if (= (nth 6 r) -1)
+		(progn
+		  (setq y1 (/ pi 2.0))
+		  (setq y2 (/ pi 2.0))
+		  (setq x1 (+ y1 (atan (nth 1 r) (nth 2 r))))
+		  (setq x2 (+ y2 (atan (nth 1 r) (nth 2 r))))
+		  )
+	      (progn
+		(setq y1 (/ pi -2.0))
+		(setq y2 (/ pi -2.0))
+		(setq x1 (- (atan (- (nth 1 r)) (- (nth 2 r))) y1))
+		(setq x2 (- (atan (- (nth 1 r)) (- (nth 2 r))) y2))
+		)
+	      )
+	    )
+	(progn
+	  (setq y1 (- (asin (nth 6 r))))
+	  (setq y2 (- pi y1))
+	  (setq x1 (atan (/ (nth 7 r) (cos y1)) (/ (nth 8 r) (cos y1))))
+	  (setq x2 (atan (/ (nth 7 r) (cos y2)) (/ (nth 8 r) (cos y2))))
+	  (setq z1 (atan (/ (nth 3 r) (cos y1)) (/ (nth 0 r) (cos y1))))
+	  (setq z2 (atan (/ (nth 3 r) (cos y2)) (/ (nth 0 r) (cos y2))))
+	  )
+	)
+      (if deg
+	  ((lambda (ls) (list (butlast ls 3) (nthcdr 3 ls))) (mapcar (lambda (ang) (* 180 (/ ang (float pi)))) (list x1 y1 z1 x2 y2 z2)))
+	`(,(list x1 y1 z1) ,(list x2 y2 z2))
+	)
+      )
+    )
+  )
+(defun euler2rot (eulerls &optional deg)
+  "Calculate rotation matrix from Euler angles.
+EULERLS is the list of Euler angles,
+if non-nil DEG is result is converted to degree"
+  (matrixmul3x3 (matrixmul3x3 (rotation (nth 2 eulerls) '(0 0 1) deg) (rotation (nth 1 eulerls) '(0 1 0) deg)) (rotation (nth 0 eulerls) '(1 0 0) deg))
+  )
+
+(defun det3x3 (mat)
+  "Calculate the determinant of 3x3 matrix MAT."
+  (when (= (length mat) 9)
+    (+ (- 0 (* (nth 2 mat) (nth 4 mat) (nth 6 mat)))
+       (* (nth 1 mat) (nth 5 mat) (nth 6 mat))
+       (* (nth 2 mat) (nth 3 mat) (nth 7 mat))
+       (- 0 (* (nth 0 mat) (nth 5 mat) (nth 7 mat)))
+       (- 0 (* (nth 1 mat) (nth 3 mat) (nth 8 mat)))
+       (* (nth 0 mat) (nth 4 mat) (nth 8 mat))
+       )
+    )
+  )
+
+(defun invert3x3 (mat)
+  "Invert 3x3 matrix MAT."
+  (when (= (length mat) 9)
+    (let
+	(
+	 (det (det3x3 mat))
+	 (a (float (nth 0 mat)))
+	 (b (float (nth 1 mat)))
+	 (c (float (nth 2 mat)))
+	 (d (float (nth 3 mat)))
+	 (e (float (nth 4 mat)))
+	 (f (float (nth 5 mat)))
+	 (g (float (nth 6 mat)))
+	 (h (float (nth 7 mat)))
+	 (i (float (nth 8 mat)))
+	 )
+      (if (not(= det 0))
+	  (let
+	      (
+	       (A (/ ( - (* e i) (* f h)) det))
+	       (D (/ ( - (* c h) (* b i)) det))
+	       (G (/ ( - (* b f) (* c e)) det))
+	       (B (/ ( - (* f g) (* d i)) det))
+	       (E (/ ( - (* a i) (* c g)) det))
+	       (H (/ ( - (* c d) (* a f)) det))
+	       (C (/ ( - (* d h) (* e g)) det))
+	       (F (/ ( - (* b g) (* a h)) det))
+	       (I (/ ( - (* a e) (* b d)) det))
+	       )
+	    (list A D G B E H C F I)
+	    )
+	)
+      )
+    )
+  )
+
+(provide 'linal-util)
+;;; linal-util ends here
+

scad-preview.el

@@ -51,14 +51,16 @@
 
 ;; 0.1.0 test release
 ;; 0.1.1 fix relative path issue
+;; 0.1.2 added mouse support and rotation/translation according to screen direction
 
 ;;; Code:
 
 (require 'image-mode)
 (require 'compile)
 (require 'scad-mode)
+(require 'linal-util)
 
-(defconst scad-preview-version "0.1.1")
+(defconst scad-preview-version "0.1.2")
 
 ;; + customs
 
@@ -79,8 +81,8 @@
   :group 'scad-preview)
 
 (defcustom scad-preview-window-position 'right
-  "Position of the preview window. The value can be either 'right,
-  'left, 'below, or 'above."
+  "Position of the preview window.
+The value can be either 'right, 'left, 'below, or 'above."
   :group 'scad-preview)
 
 (defcustom scad-preview-window-size 65
@@ -102,8 +104,8 @@
 (defvar scad-preview--scad-process      nil)
 (defvar scad-preview--scad-status       nil)
 
-(defun scad-preview--after-change-function (&rest _)
-  "Mark that the buffer is modified."
+(defun scad-preview--after-change-function (&rest rest)
+  "Mark that the buffer is modified.  Accepts any argument as REST."
   (setq scad-preview--modified-flag t))
 
 (defun scad-preview-reset-camera-parameters ()
@@ -114,8 +116,7 @@
   (scad-preview-refresh))
 
 (defun scad-preview--increment-camera-parameter (index val)
-  "Increment INDEX-th camera parameter by VAL and update the
-preview buffer."
+  "Increment INDEX -th camera parameter by VAL and update the preview buffer."
   (let ((cell (nthcdr index scad-preview--camera-parameters)))
     (setcar cell (+ (car cell) val))
     (scad-preview-refresh)))
@@ -223,6 +224,89 @@ preview buffer."
             (mapc (lambda (f) (when (file-exists-p f) (delete-file f)))
                   scad-preview--temp-files)))
 
+;; + utility functions
+
+(defun scad-preview--euler ()
+  "Return the list of Euler angles."
+  (butlast (nthcdr 3 scad-preview--camera-parameters))
+  )
+
+(defun scad-preview--position ()
+  "Return the list of cartesian coordinates."
+  (butlast scad-preview--camera-parameters 4)
+  )
+
+;; + transformation according to camera axis
+
+(defun scad-preview--absolute-rotate-camera (ang vec &optional deg)
+  "Rotate camera with ANG around a global axis VEC.
+If DEG is not nil, angle is interpreted as degree"
+  (let (
+	(newangles
+	 (car (rot2euler (matrixmul3x3 (rotation ang vec deg) (euler2rot (scad-preview--euler) t) ) t)))
+	(camera-param scad-preview--camera-parameters)
+	)
+    (setq scad-preview--camera-parameters (copy-sequence (append (butlast camera-param 4) newangles (last camera-param))))
+    )
+  (scad-preview-refresh)
+  )
+
+(defun scad-preview--absolute-move-camera (val vec)
+  "Move camera with VAL unit with respect to a global axis VEC."
+  (let (
+	(newpos
+	 ((lambda (ls) (list
+			(+ (nth 0 scad-preview--camera-parameters) (nth 0 ls)
+			   )
+			(+ (nth 1 scad-preview--camera-parameters) (nth 1 ls)
+			   )
+			(+ (nth 2 scad-preview--camera-parameters) (nth 2 ls)
+			   )
+			))
+	  (mapcar (lambda (element) (* element val)) (matrixvectormul3x1 (euler2rot (scad-preview--euler) t) vec))))
+	(camera-param scad-preview--camera-parameters)
+	)
+    (setq scad-preview--camera-parameters (copy-sequence (append newpos (last camera-param 4))))
+    )
+  (scad-preview-refresh)
+  )
+
+(defun scad-preview--rotate-camera-horizontal (val &optional deg)
+  "Rotate the view around the horizontal axis of the screen with VAL.
+VAL is intrepreted as degree if DEG is non-nil"
+  (interactive)
+  (scad-preview--absolute-rotate-camera val (matrixvectormul3x1 (euler2rot (scad-preview--euler) t) '(1 0 0)) deg)
+  )
+
+(defun scad-preview--rotate-camera-vertical (val &optional deg)
+  "Rotate the camera around the vertical axis of the screen with VAL.
+VAL is intrepreted as degree if DEG is non-nil"
+  (interactive)
+  (scad-preview--absolute-rotate-camera val (matrixvectormul3x1 (euler2rot (scad-preview--euler) t) '(0 1 0)) deg)
+  )
+
+(defun scad-mouse-trans (event)
+  "Translate the scad-prview based on the drag EVENT parallel to the screen edges."
+  (interactive "e")
+  (let ((p1 (posn-x-y (event-start event)))
+	(p2 (posn-x-y (event-end event)))
+	)
+    (scad-preview--absolute-move-camera (/(- (car p1) (car p2)) 2) '(1 0 0))
+    (scad-preview--absolute-move-camera (/(- (cdr p1) (cdr p2)) 2) '(0 -1 0))
+    )
+  )
+
+(defun scad-mouse-rot (event)
+  "Rotate the scad-prview based on the drag EVENT around edges parallel to the screen edges."
+  (interactive "e")
+  (let ((p1 (posn-x-y (event-start event)))
+	(p2 (posn-x-y (event-end event)))
+	)
+    (scad-preview--rotate-camera-vertical (/ (- (car p1) (car p2)) 5) t)
+    (scad-preview--rotate-camera-horizontal (/ (- (cdr p1) (cdr p2)) 5) t)
+    )
+  )
+
 ;; + minor-mode for the preview buffer
 
 (defvar scad-preview--image-mode-map
@@ -264,21 +348,25 @@ preview buffer."
     (define-key keymap (kbd "M-<down>") 'scad-preview-trnsz+)
     (define-key keymap (kbd "M-n") 'scad-preview-trnsz+)
     (define-key keymap (kbd "M-j") 'scad-preview-trnsz+)
+    (define-key keymap (kbd "<C-mouse-4>") (lambda () (interactive) (scad-preview--increment-camera-parameter 6 50)))
+    (define-key keymap (kbd "<C-mouse-5>") (lambda () (interactive) (scad-preview--increment-camera-parameter 6 -50)))
+    (define-key keymap (kbd "<drag-mouse-3>") 'scad-mouse-trans)
+    (define-key keymap (kbd "<drag-mouse-1>") 'scad-mouse-rot)
     keymap)
   "Keymap for SCAD preview buffers.")
 
-(defun scad-preview-trnsx+ () (interactive) (scad-preview--increment-camera-parameter 0 10))
-(defun scad-preview-trnsx- () (interactive) (scad-preview--increment-camera-parameter 0 -10))
-(defun scad-preview-trnsz+ () (interactive) (scad-preview--increment-camera-parameter 2 10))
-(defun scad-preview-trnsz- () (interactive) (scad-preview--increment-camera-parameter 2 -10))
-(defun scad-preview-rotx+ () (interactive) (scad-preview--increment-camera-parameter 3 20))
-(defun scad-preview-rotx- () (interactive) (scad-preview--increment-camera-parameter 3 -20))
-(defun scad-preview-roty+ () (interactive) (scad-preview--increment-camera-parameter 4 20))
-(defun scad-preview-roty- () (interactive) (scad-preview--increment-camera-parameter 4 -20))
-(defun scad-preview-rotz+ () (interactive) (scad-preview--increment-camera-parameter 5 20))
-(defun scad-preview-rotz- () (interactive) (scad-preview--increment-camera-parameter 5 -20))
-(defun scad-preview-dist+ () (interactive) (scad-preview--increment-camera-parameter 6 100))
-(defun scad-preview-dist- () (interactive) (scad-preview--increment-camera-parameter 6 -100))
+(defun scad-preview-trnsx+ () "Move camera 10 unit in x direction." (interactive) (scad-preview--increment-camera-parameter 0 10))
+(defun scad-preview-trnsx- () "Move camera 10 unit in x direction." (interactive) (scad-preview--increment-camera-parameter 0 -10))
+(defun scad-preview-trnsz+ () "Move camera 10 unit in z direction." (interactive) (scad-preview--increment-camera-parameter 2 10))
+(defun scad-preview-trnsz- () "Move camera 10 unit in z direction." (interactive) (scad-preview--increment-camera-parameter 2 -10))
+(defun scad-preview-rotx+ () "Increment 1st Euler angle." (interactive) (scad-preview--increment-camera-parameter 3 20))
+(defun scad-preview-rotx- () "Decrement 1st Euler angle." (interactive) (scad-preview--increment-camera-parameter 3 -20))
+(defun scad-preview-roty+ () "Increment 2nd Euler angle." (interactive) (scad-preview--increment-camera-parameter 4 20))
+(defun scad-preview-roty- () "Decrement 2nd Euler angle." (interactive) (scad-preview--increment-camera-parameter 4 -20))
+(defun scad-preview-rotz+ () "Increment 3rd Euler angle." (interactive) (scad-preview--increment-camera-parameter 5 20))
+(defun scad-preview-rotz- () "Decrement 3rd Euler angle." (interactive) (scad-preview--increment-camera-parameter 5 -20))
+(defun scad-preview-dist+ () "Zoom-in camera 100 units." (interactive) (scad-preview--increment-camera-parameter 6 100))
+(defun scad-preview-dist- () "Zoom-out camera 100 units." (interactive) (scad-preview--increment-camera-parameter 6 -100))
 
 (define-derived-mode scad-preview--image-mode fundamental-mode "SCADp"
   "Major mode for SCAD preview buffers."