Function: calc-pack-items

calc-pack-items is a byte-compiled function defined in calc-vec.el.gz.

Signature

(calc-pack-items MODE ITEMS)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-vec.el.gz
(defun calc-pack-items (mode items)
  (cond ((consp mode)
	 (if (cdr mode)
	     (let* ((size (calc-pack-size (cdr mode)))
		    (len (length items))
		    (new nil)
		    p row)
	       (while (> len 0)
		 (setq p (nthcdr (1- size) items)
		       row items
		       items (cdr p)
		       len (- len size))
		 (setcdr p nil)
		 (setq new (cons (calc-pack-items (cdr mode) row) new)))
	       (calc-pack-items (car mode) (nreverse new)))
	   (calc-pack-items (car mode) items)))
	((>= mode 0)
	 (cons 'vec items))
	((= mode -3)
	 (if (and (math-objvecp (car items))
		  (math-objvecp (nth 1 items))
		  (math-objvecp (nth 2 items)))
	     (if (and (math-num-integerp (car items))
		      (math-num-integerp (nth 1 items)))
		 (if (math-realp (nth 2 items))
		     (cons 'hms items)
		   (error "Seconds must be real"))
	       (error "Hours and minutes must be integers"))
	   (math-normalize (list '+
				 (list '+
				       (if (eq calc-angle-mode 'rad)
					   (list '* (car items)
						 '(hms 1 0 0))
					 (car items))
				       (list '* (nth 1 items) '(hms 0 1 0)))
				 (list '* (nth 2 items) '(hms 0 0 1))))))
	((= mode -13)
	 (if (math-realp (car items))
	     (cons 'date items)
	   (if (eq (car-safe (car items)) 'date)
	       (car items)
	     (if (math-objvecp (car items))
		 (error "Date value must be real")
	       (cons 'calcFunc-date items)))))
	((memq mode '(-14 -15))
	 (let ((p items))
	   (while (and p (math-objvecp (car p)))
	     (or (math-integerp (car p))
		 (error "Components must be integers"))
	     (setq p (cdr p)))
	   (if p
	       (cons 'calcFunc-date items)
	     (list 'date (math-dt-to-date items)))))
	((or (eq (car-safe (car items)) 'vec)
	     (eq (car-safe (nth 1 items)) 'vec))
	 (let* ((x (car items))
		(vx (eq (car-safe x) 'vec))
		(y (nth 1 items))
		(vy (eq (car-safe y) 'vec))
		(z nil)
		(n (1- (length (if vx x y)))))
	   (and vx vy
		(/= n (1- (length y)))
		(error "Vectors must be the same length"))
	   (while (>= (setq n (1- n)) 0)
	     (setq z (cons (calc-pack-items
			    mode
			    (list (if vx (car (setq x (cdr x))) x)
				  (if vy (car (setq y (cdr y))) y)))
			   z)))
	   (cons 'vec (nreverse z))))
	((= mode -1)
	 (if (and (math-realp (car items)) (math-realp (nth 1 items)))
	     (cons 'cplx items)
	   (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
	       (error "Components must be real"))
	   (math-normalize (list '+ (car items)
				 (list '* (nth 1 items) '(cplx 0 1))))))
	((= mode -2)
	 (if (and (math-realp (car items)) (math-anglep (nth 1 items)))
	     (cons 'polar items)
	   (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
	       (error "Components must be real"))
	   (math-normalize (list '* (car items)
				 (if (math-anglep (nth 1 items))
				     (list 'polar 1 (nth 1 items))
				   (list 'calcFunc-exp
					 (list '*
					       (math-to-radians-2
						(nth 1 items))
					       (list 'polar
						     1
						     (math-quarter-circle
						      nil)))))))))
	((= mode -4)
	 (let ((x (car items))
	       (sigma (nth 1 items)))
	   (if (or (math-scalarp x) (not (math-objvecp x)))
	       (if (or (math-anglep sigma) (not (math-objvecp sigma)))
		   (math-make-sdev x sigma)
		 (error "Error component must be real"))
	     (error "Mean component must be real or complex"))))
	((= mode -5)
	 (let ((a (car items))
	       (m (nth 1 items)))
	   (if (and (math-anglep a) (math-anglep m))
	       (if (math-posp m)
		   (math-make-mod a m)
		 (error "Modulus must be positive"))
	     (if (and (math-objectp a) (math-objectp m))
		 (error "Components must be real"))
	     (list 'calcFunc-makemod a m))))
	((memq mode '(-6 -7 -8 -9))
	 (let ((lo (car items))
	       (hi (nth 1 items)))
	   (if (and (or (math-anglep lo) (eq (car lo) 'date)
			(not (math-objvecp lo)))
		    (or (math-anglep hi) (eq (car hi) 'date)
			(not (math-objvecp hi))))
	       (math-make-intv (+ mode 9) lo hi)
	     (error "Components must be real"))))
	((eq mode -10)
	 (if (math-zerop (nth 1 items))
	     (error "Denominator must not be zero")
	   (if (and (math-integerp (car items)) (math-integerp (nth 1 items)))
	       (math-normalize (cons 'frac items))
	     (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
		 (error "Components must be integers"))
	     (cons 'calcFunc-fdiv items))))
	((memq mode '(-11 -12))
	 (if (and (math-realp (car items)) (math-integerp (nth 1 items)))
	     (calcFunc-scf (math-float (car items)) (nth 1 items))
	   (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
	       (error "Components must be integers"))
	   (math-normalize
	    (list 'calcFunc-scf
		  (list 'calcFunc-float (car items))
		  (nth 1 items)))))
	(t
	 (error "Invalid packing mode: %d" mode))))