Mon Jul  6 23:50:38 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * Pleated Hyperbolic Paraboloid
diff -rN -u old-qt.examples/src/origami/Makefile new-qt.examples/src/origami/Makefile
--- old-qt.examples/src/origami/Makefile	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.examples/src/origami/Makefile	2014-10-30 07:37:15.000000000 +0100
@@ -0,0 +1,7 @@
+tri.lisp : tri.head.lisp tri.input tri.util.lisp
+	cp tri.head.lisp $@
+	echo ')read "tri.input"' | AXIOMsys
+
+.PHONY: clean
+clean:
+	rm -f tri.lisp
diff -rN -u old-qt.examples/src/origami/origami.lisp new-qt.examples/src/origami/origami.lisp
--- old-qt.examples/src/origami/origami.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.examples/src/origami/origami.lisp	2014-10-30 07:37:15.000000000 +0100
@@ -0,0 +1,272 @@
+;;; Pleated Hyperbolic Paraboloid
+;;;
+;;; Construction using the method in:
+;;; (Non)existence of Pleated Folds: How Paper Folds Between Creases
+;;; 6 Existence of Triangulated Hyperbolic Paraboloid
+;;; http://arxiv.org/abs/0906.4747
+;;;
+;;; depends on: :qt.examples tri.lisp :cl-opengl :cl-glu
+
+(in-package :qt.examples)
+
+(defun triangulid-length (n diagonal-part-length)
+  "Length of the extra fold from ring N to the next."
+  (sqrt (+ (expt (* n diagonal-part-length) 2)
+           (expt (* (1+ n) diagonal-part-length) 2))))
+
+(defun length-in-diagonal-plane (distance-to-plane length)
+  "Length in the r z plane."
+  (sqrt (- (expt length 2)
+           (expt distance-to-plane 2))))
+
+(defun next-vertex (z-x r-x z-y diagonal-part-length
+                    length-in-diagonal-plane n)
+  (multiple-value-bind (r-1 z-1)
+      (v1 z-x z-y
+          r-x
+          diagonal-part-length
+          length-in-diagonal-plane)
+    (multiple-value-bind (r-2 z-2)
+        (v2 z-x z-y
+            r-x
+            diagonal-part-length
+            length-in-diagonal-plane)
+      ;; alternate valley and mountain fold
+      (if (or (and (> z-1 z-2)
+                   (evenp n))
+              (and (< z-1 z-2)
+                   (oddp n)))
+          (values z-1 r-1)
+          (values z-2 r-2)))))
+
+(defun make-grid-points (fold-angle n)
+  "Returns the vertex points for FOLD-ANGLE of the center diagonal
+and N rings."
+  ;; Cylindrical coodinates (θ = 0 or θ = π/2)
+  ;; the x and y axes are the diagonals of the square paper.
+  ;; Due to symetry only one fourth need to be calculated.
+  (let (;; θ = 0
+        (z-x (make-array n
+                         :element-type 'double-float
+                         :initial-element 0d0))
+        (r-x (make-array n
+                         :element-type 'double-float
+                         :initial-element 0d0))
+        ;; θ = π/2
+        (z-y (make-array n
+                         :element-type 'double-float
+                         :initial-element 0d0))
+        
+        (r-y (make-array n
+                         :element-type 'double-float
+                         :initial-element 0d0))
+        (diagonal-part-length 1d0))
+    ;; the innermost square
+    (setf (aref r-x 0) diagonal-part-length)
+    (setf (aref z-y 0)
+          (- (* (cos (/ fold-angle 2)) diagonal-part-length))
+          (aref r-y 0)
+          (* (sin (/ fold-angle 2)) diagonal-part-length))
+
+    (dotimes (ring (1- n))
+      (let ((length-in-diagonal-plane
+             (length-in-diagonal-plane (aref r-y ring)
+                                       (triangulid-length
+                                        (1+ ring)
+                                        diagonal-part-length))))
+        (multiple-value-bind
+              (z1 r1)
+            (next-vertex (aref z-x ring) (aref r-x ring)
+                         (aref z-y ring) diagonal-part-length
+                         length-in-diagonal-plane ring)
+          (setf (aref z-x (1+ ring)) z1)
+          (setf (aref r-x (1+ ring)) r1)))
+      (let ((length-in-diagonal-plane
+             (length-in-diagonal-plane (aref r-x (1+ ring))
+                                       (* (sqrt 2) (+ 2 ring)))))
+        (multiple-value-bind
+              (z2 r2)
+            (next-vertex (aref z-y ring) (aref r-y ring)
+                         (aref z-x (1+ ring)) diagonal-part-length
+                         length-in-diagonal-plane ring)
+          (setf (aref z-y (1+ ring)) z2)
+          (setf (aref r-y (1+ ring)) r2))))
+    (values z-x r-x z-y r-y)))
+
+(defclass origami-view (qt:glwidget)
+  ((object :accessor object)
+   (animate)
+   (rings :initform 4 :accessor rings)
+   (rings-changed :reader rings-changed)
+   (fold-angle :initform Pi :accessor fold-angle)
+   (fold-angle-changed :reader fold-angle-changed))
+  (:metaclass cxx:class))
+
+(defmethod initialize-instance :after ((view origami-view) &rest initargs)
+  (declare (ignore initargs))
+  (cxx:set-minimum-size view 200 200)
+  (setf (slot-value view 'rings-changed)
+        (qt:make-slot #'(lambda (rings)
+                          (setf (rings view) rings)
+                          (make-origami view (fold-angle view)
+                                        (rings view)))))
+  (setf (slot-value view 'fold-angle-changed)
+        (qt:make-slot #'(lambda (fold-angle)
+                          (setf (fold-angle view)
+                                (* (/ pi 180) fold-angle))
+                          (make-origami view (fold-angle view)
+                                        (rings view)))))
+  (let ((animate (make-instance 'qt:timer)))
+    (setf (cxx:interval animate) (* 1/25 1000)
+          (slot-value view 'animate) animate)
+    (qt:connect (qt:get-signal animate "timeout()")
+                (qt:get-slot view "update()"))))
+
+(defun inner-square (z-x r-x z-y r-y)
+  "OpenGL vertices for the inner square."
+  (gl:with-primitive :triangle-strip
+        (gl:normal 0d0 (aref z-y 0) (- (aref r-y 0)))
+        (gl:vertex 0d0 (aref r-y 0) (aref z-y 0))
+        (gl:vertex (aref r-x 0) 0d0 (aref z-x 0))
+
+        (gl:vertex (- (aref r-x 0)) 0d0 (aref z-x 0))
+        (gl:normal 0d0 (- (aref z-y 0)) (- (aref r-y 0)))
+        (gl:vertex 0d0 (- (aref r-y 0)) (aref z-y 0))))
+
+(defun triangle-strip (z-x r-x z-y r-y x-direction y-direction)
+  "Generates a OpenGL triangle strip for one quarter not
+including the inner square part."
+  (declare (type (or (eql 1) (eql -1)) x-direction y-direction))
+  (gl:with-primitives :triangle-strip
+    (loop for i from 0 below (1- (length z-x))
+       do
+         (ring-edge-vertices (aref z-x i) (aref r-x i)
+                             (aref z-y i) (aref r-y i)
+                             x-direction y-direction)
+         (normal (* x-direction (aref r-x i)) 0d0 (aref z-x i)
+                 0d0 (* y-direction (aref r-y i)) (aref z-y i)
+                 (* x-direction (aref r-x (1+ i))) 0d0 (aref z-x (1+ i)))
+       finally
+         (ring-edge-vertices (aref z-x i) (aref r-x i)
+                             (aref z-y i) (aref r-y i)
+                             x-direction y-direction))))
+
+
+(defun ring-edge-vertices (z-x r-x z-y r-y x-direction y-direction)
+  "The two vertices of a fourth of a ring."
+  (let ((r-x (* x-direction r-x))
+        (r-y (* y-direction r-y)))
+    (if (= 0 (* x-direction y-direction ))
+        (progn
+          (gl:vertex 0d0 r-y z-y)
+          (gl:vertex r-x 0d0 z-x))
+        (progn
+          (gl:vertex r-x 0d0 z-x)
+          (gl:vertex 0d0 r-y z-y)))))
+
+(defun normal (mid-x mid-y mid-z
+               x1 y1 z1
+               x2 y2 z2)
+  "Generates a OpenGL normal normal to three points."
+  (let* ((vec1 (vector (- x1 mid-x) (- y1 mid-y) (- z1 mid-z)))
+         (vec2 (vector (- x2 mid-x) (- y2 mid-y) (- z2 mid-z)))
+         (cross-product (vector (- (* (aref vec1 1) (aref vec2 2))
+                                   (* (aref vec2 1) (aref vec1 2)))
+                                (- (* (aref vec2 0) (aref vec1 2))
+                                   (* (aref vec1 0) (aref vec2 2)))
+                                (- (* (aref vec1 0) (aref vec2 1))
+                                   (* (aref vec2 0) (aref vec1 1))))))
+    (gl:normal (aref cross-product 0)
+               (aref cross-product 1)
+               (aref cross-product 2))))
+
+(defun make-hyperbolic-parabolid (z-x r-x z-y r-y)
+  (gl:material :front-and-back :ambient #(0.6 0.6 0.6 1.0))
+  (gl:material :front-and-back :diffuse #(0.4 0.4 0.4 1.0))
+  (inner-square z-x r-x z-y r-y)
+  (triangle-strip z-x r-x z-y r-y 1 1)
+  (triangle-strip z-x r-x z-y r-y -1 1)
+  (triangle-strip z-x r-x z-y r-y 1 -1)
+  (triangle-strip z-x r-x z-y r-y -1 -1))
+
+(defun make-origami (view fold-angle rings)
+  (handler-case
+      (let ((grid-points
+             (multiple-value-list
+              (make-grid-points fold-angle rings))))
+
+        (gl:with-new-list ((object view) :compile)
+          (gl:scale (/ 1.0 rings) (/ 1.0 rings) (/ 1.0 rings))
+          (apply #'make-hyperbolic-parabolid
+                 grid-points)))
+    ((or type-error arithmetic-error) (condition)
+      (warn "Can not fold: ~A." condition)
+     (sb-debug:backtrace 10)
+      (gl:with-new-list ((object view) :compile))))
+  (cxx:update view))
+
+(defmethod cxx:initialize-gl ((view origami-view))
+  (gl:check-error)
+  (gl:clear-color 0 0 0 0)
+  (gl:shade-model :flat)
+  (gl:light :light0 :position '(2 2 1 1))
+  (gl:light :light0 :ambient '(1 1 1 1))
+  (gl:light :light0 :diffuse '(1 1 1 1))
+  (gl:light-model :light-model-two-side 1)
+  (gl:enable :light0 :lighting :normalize :depth-test)
+  ;(gl:enable :line-smooth)
+  (setf (object view) (gl:gen-lists 1))
+  (gl:check-error)
+  (make-origami view 2.5 5)
+  (cxx:start (slot-value view 'animate)))
+
+(defmethod cxx:paint-gl ((view origami-view))
+  (gl:clear :color-buffer :depth-buffer)
+  (gl:load-identity)
+  (gl:translate 0 0 -2)
+  (gl:rotate -60 1 0 0)
+  (gl:rotate (mod (* 4 (/ (get-internal-real-time)
+                          internal-time-units-per-second))
+                  360)
+             0 0 1)
+  (gl:call-list (object view))
+  (gl:check-error))
+
+(defmethod cxx:resize-gl ((view origami-view) width height)
+  (gl:viewport 0 0 width height)
+  (gl:matrix-mode :projection)
+  (gl:load-identity)
+  (glu:perspective 50 (/ width height) 0.5 20)
+  (gl:matrix-mode :modelview)
+  (gl:load-identity)
+  (gl:check-error))
+
+(defclass origami (qt:widget)
+  ((view :initform (make-instance 'origami-view)
+         :reader view))
+  (:metaclass cxx:class))
+
+(defmethod initialize-instance :after ((origami origami) &rest initargs)
+  (declare (ignore initargs))
+  (let ((layout (make-instance 'qt:hbox-layout)))
+    (cxx:add-widget layout (view origami))
+    (let ((fold-angle (make-instance 'qt:slider))
+          (rings (make-instance 'qt:slider)))
+      (cxx:add-widget layout fold-angle)
+      (cxx:add-widget layout rings)
+      (qt:do-delayed-initialize
+        (qt:connect (qt:get-signal fold-angle "valueChanged(int)")
+                    (fold-angle-changed (view origami)))
+        (setf (cxx:minimum fold-angle) 0
+              (cxx:value fold-angle) 150
+              (cxx:maximum fold-angle) 360
+              (cxx:tick-position fold-angle) qt:slider.+ticks-left+
+              (cxx:tick-interval fold-angle) 90)
+        (qt:connect (qt:get-signal rings "valueChanged(int)")
+                    (rings-changed (view origami)))
+        (setf (cxx:minimum rings) 1
+              (cxx:value rings) 20
+              (cxx:maximum rings) 50
+              (cxx:tick-position rings) qt:slider.+ticks-right+
+              (cxx:tick-interval rings) 10)))
+    (cxx:set-layout origami layout)))
diff -rN -u old-qt.examples/src/origami/tri.head.lisp new-qt.examples/src/origami/tri.head.lisp
--- old-qt.examples/src/origami/tri.head.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.examples/src/origami/tri.head.lisp	2014-10-30 07:37:15.000000000 +0100
@@ -0,0 +1,6 @@
+(in-package :qt.examples)
+
+(declaim (inline ^))
+(defun ^ (base power)
+	(expt base power))
+
diff -rN -u old-qt.examples/src/origami/tri.input new-qt.examples/src/origami/tri.input
--- old-qt.examples/src/origami/tri.input	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.examples/src/origami/tri.input	2014-10-30 07:37:15.000000000 +0100
@@ -0,0 +1,8 @@
+-- echo ')read tst.input' | AXIOMsys >tst.output
+a := radicalSolve([R**2+(Z-Z2)**2 = R2**2, (R-D1)**2 + (Z-Z1)**2 = R1**2], [R,Z])
+
+)lisp (load "tri.util.lisp")
+
+rhsmap(list) == map(rhs, list)
+PRINTEXPRESSIONSDEFUN("tri.lisp", '[V1 V2],
+	'[Z1, Z2, D1, R1, R2], map(simplify,map(rhsmap,a))::InputForm)$Lisp
diff -rN -u old-qt.examples/src/origami/tri.util.lisp new-qt.examples/src/origami/tri.util.lisp
--- old-qt.examples/src/origami/tri.util.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.examples/src/origami/tri.util.lisp	2014-10-30 07:37:15.000000000 +0100
@@ -0,0 +1,19 @@
+(defun expression-defun (name variables expressions)
+  `(defun ,name ,variables
+     (values ,@(rest expressions))))
+
+(defun print-to-file (file expression)
+  (with-open-file (out file :direction :output
+                       :if-exists :append :if-does-not-exist :create)
+    (let ((*print-case* :downcase))
+      (print expression out)
+      (terpri out))))
+
+(defun printexpressionsdefun (name function-names variables expressions)
+  (loop
+     for function-name in (first (rest function-names))
+     for expression in (rest (first (rest expressions))) do
+       (print-to-file name (expression-defun function-name
+                                             (rest variables)
+                                             expression))))
+