From: Alex Klinkhamer <grencez@gmail.com>
Date: Mon, 21 Jul 2008 20:35:38 +0000 (-0400)
Subject: +rref button (oops), +factorial button
X-Git-Url: https://repo.or.cz/w/lineal.git/commitdiff_plain/e5d03e7aafb2b0a6a21a9b20c38d086420347306

+rref button (oops), +factorial button

The functions nCr and nPr work, I just haven't decided how to integrate
them visually.
---

diff --git a/src/infix-parser.lisp b/src/infix-parser.lisp
index 414bb56..971dd61 100644
--- a/src/infix-parser.lisp
+++ b/src/infix-parser.lisp
@@ -47,6 +47,7 @@
   +subtrn-rank+ 
   +multn-rank+
   +divisn-rank+
+  +factorial-rank+
   +exptn-rank+
   +vip-rank+);< Virtually infinite precedence.
 
@@ -209,7 +210,7 @@
            (setq
              *unwind-rank-fn* this-unwind-rank-fn
              *last-read* nil
-             tail (cdr (rplacd tail (cons val nil))))
+             tail (setf (cdr tail) (cons val nil)))
            (throw 'fn-scope (values)))
           ((< this-rank op-rank)
            (setq *unwind-rank-fn* this-unwind-rank-fn)
@@ -221,6 +222,21 @@
       *unwind-rank-fn* this-unwind-rank-fn)
     nil))
 
+;;; Parse an exclaimation point character.
+(defun factorial-reader (c strm)
+  (declare (ignore c strm)
+           (special *unwind-rank-fn* *last-read*))
+  (unless *last-read*
+    ;; Make sure any negatives are applied.
+    (funcall *unwind-rank-fn*
+             #'lineal.overload::over-factorial nil))
+  (setq *last-read*
+        (lineal.overload::factorial
+          (funcall *unwind-rank-fn*
+                   +factorial-rank+ *last-read*)))
+  nil)
+
+
 (defun open-paren-after-whitespace-peekp ()
   (declare (special *parse-strm* *parse-next*))
   (unless *parse-next*
@@ -392,6 +408,7 @@
     (set-opern-reader #\- +subtrn-rank+ #'subtrn)
     (set-opern-reader #\* +multn-rank+ #'multn)
     (set-opern-reader #\/ +divisn-rank+ #'divisn)
+    (set-macro-character #\! #'factorial-reader)
     (set-opern-reader #\^ +exptn-rank+ #'exptn))
 
 (defun process-infix-from-stream (strm)
diff --git a/src/overload/client-fns.lisp b/src/overload/client-fns.lisp
index 9867e18..5d70d36 100644
--- a/src/overload/client-fns.lisp
+++ b/src/overload/client-fns.lisp
@@ -13,6 +13,7 @@
         ("det" over-det)
         ("dot" over-dot-prod)
         ("expt" exptn)
+        ("factorial" over-factorial)
         ("inverse" over-multv-inverse)
         ("nAr" nAr) ("nCr" nCr) ("nPr" nPr)
         ("orth" over-orth)
diff --git a/src/overload/numbers.lisp b/src/overload/numbers.lisp
index 7c39718..bd57112 100644
--- a/src/overload/numbers.lisp
+++ b/src/overload/numbers.lisp
@@ -9,3 +9,7 @@
 (defmethod mult2n ((a number) (b number)) (* a b))
 (defmethod divis2n ((a number) (b number)) (/ a b))
 
+(defun over-factorial (n)
+  (declare (type (integer 0 *) n))
+  (factorial n))
+
diff --git a/src/webui/calcupage-buttons.lisp b/src/webui/calcupage-buttons.lisp
index 69325df..85b9ecb 100644
--- a/src/webui/calcupage-buttons.lisp
+++ b/src/webui/calcupage-buttons.lisp
@@ -1,3 +1,4 @@
+
 (in-package :lineal.webui)
 
 (defun htm-button
@@ -17,27 +18,27 @@
 (defun opern-button
   (name infixp &key (id "fn1") (input name))
   (htm-input-button
-     name id
-     (if infixp input
-       (concatenate
-         'string "(" input " "))))
+    name id
+    (if infixp input
+      (concatenate
+        'string "(" input " "))))
 
 (defun htm-fnbut
   (name id infix multi-param-p
         &optional (fntext name))
   (htm-input-button
-     name id
-     (if infix
-       (concatenate
-         'string fntext
-         (if multi-param-p "(" " "))
-       (concatenate
-         'string "(" fntext " "))))
+    name id
+    (if infix
+      (concatenate
+        'string fntext
+        (if multi-param-p "(" " "))
+      (concatenate
+        'string "(" fntext " "))))
 
 (defun htm-linalg-buttons (infix)
   (let
     ((linalg-fnlis
-       `("ref" "det"
+       `("rref" "ref" "det"
          nil "transpose" "inverse"
          nil ("dot") ("cross")
          ("proj") ("orth")
@@ -75,7 +76,7 @@
 
 (defun clear-button ()
   (htm-button "clear" "clear" "cleartext()"))
-  
+
 
 (defun ok-button ()
   (htm-button "ok" "ok" "sendCalc()"))
@@ -106,22 +107,26 @@
              strm)))))
     (concatenate
       'string
+      (if infixp
+        (opern-button "!" t)
+        (opern-button "!" nil :input "factorial"))
+      "<br />"
       (htm-fnbut "&radic;" "fn1" infixp nil "sqrt")
       (if infixp
         (opern-button "^" t)
         (opern-button "^" nil :input "expt"))
       (simple-input-button "(")
       (simple-input-button ")")
-      "<br/>" (htm-3digits 7)
+      "<br />" (htm-3digits 7)
       (opern-button "/" infixp)
-      "<br/>" (htm-3digits 4)
+      "<br />" (htm-3digits 4)
       (opern-button "&times;" infixp :input "*")
-      "<br/>" (htm-3digits 1)
+      "<br />" (htm-3digits 1)
       (opern-button "-" infixp)
-      "<br/>"
+      "<br />"
       (simple-input-button "0" "zerodigit")
       (simple-input-button "." "digit")
       (opern-button "+" infixp)
-      "<br/>"
+      "<br />"
       (memory-buttons infixp))))