src/webui/calcupage-buttons.lisp

   1
   2 (defun htm-button
   3   (text id action)
   4   (with-html-output-to-string
   5     (strm)
   6     (:input :type "button"
   7             :id id
   8             :onclick action
   9             :value text)))
  10
  11 (defun htm-input-button (name id tosend)
  12   (htm-button
  13     name id
  14     (concatenate 'string "uinput(\"" tosend "\")")))
  15
  16 (defun opern-button
  17   (name infixp &key (id "fn1") (input name))
  18   (htm-input-button
  19     name id
  20     (if infixp input
  21       (concatenate
  22         'string "(" input " "))))
  23
  24 (defun htm-fnbut
  25   (name id infix multi-param-p
  26         &optional (fntext name))
  27   (htm-input-button
  28     name id
  29     (if infix
  30       (concatenate
  31         'string fntext
  32         (if multi-param-p "(" " "))
  33       (concatenate
  34         'string "(" fntext " "))))
  35
  36 (defun htm-linalg-buttons (infix)
  37   (let
  38     ((linalg-fnlis
  39        `("rref" "ref" "det"
  40          nil "transpose" "inverse"
  41          nil ("dot") ("cross")
  42          ("proj") ("orth")
  43          nil ("cat") ("vcat") ("crop") ("vcrop"))))
  44     (with-output-to-string (strm)
  45       (mapc
  46         (lambda (args)
  47           (princ
  48             (cond
  49               ((not args) "<br/>")
  50               ((stringp args)
  51                (htm-fnbut
  52                  args
  53                  (format nil "fn~A" (length args))
  54                  infix nil))
  55               (t (destructuring-bind
  56                    (name &optional id) args
  57                    (htm-fnbut
  58                      name
  59                      (if id id
  60                        (format nil "fn~A" (length name)))
  61                      infix t))))
  62             strm))
  63         linalg-fnlis))))
  64
  65
  66 ; (show-a-button "ok" elem "sendCalc()" 25 "white" "green"))
  67 ;(show-a-button "clear" elem "cleartext()" 45 "white" "darkred"))
  68
  69 ;-- BEGIN SPECIAL BUTTON CREATORS --
  70
  71 ;V Use the button operation as a name.V
  72 (defun simple-input-button (name &optional (id "fn1"))
  73   (htm-input-button name id name))
  74
  75 (defun clear-button ()
  76   (htm-button "clear" "clear" "cleartext()"))
  77
  78
  79 (defun ok-button ()
  80   (htm-button "ok" "ok" "sendCalc()"))
  81
  82
  83 (defun memory-buttons (infix)
  84   (concatenate
  85     'string
  86     (htm-input-button
  87       "recall" "recall"
  88       (if infix "recall(\\\"" "(recall \\\""))
  89     (htm-input-button
  90       "store" "store"
  91       (if infix "store(\\\"" "(store \\\""))))
  92
  93 ;-- END SPECIAL BUTTON CREATORS --
  94
  95 (defun htm-standard-math-buttons (infixp)
  96   (labels
  97     ((htm-3digits
  98        (x)
  99        (with-output-to-string (strm)
 100          (dotimes (i 3)
 101            (princ
 102              (simple-input-button
 103                (princ-to-string (+ i x))
 104                "digit")
 105              strm)))))
 106     (concatenate
 107       'string
 108       (if infixp
 109         (opern-button "!" t)
 110         (opern-button "!" nil :input "factorial"))
 111       "<br />"
 112       (htm-fnbut "&radic;" "fn1" infixp nil "sqrt")
 113       (if infixp
 114         (opern-button "^" t)
 115         (opern-button "^" nil :input "expt"))
 116       (simple-input-button "(")
 117       (simple-input-button ")")
 118       "<br />" (htm-3digits 7)
 119       (opern-button "/" infixp)
 120       "<br />" (htm-3digits 4)
 121       (opern-button "&times;" infixp :input "*")
 122       "<br />" (htm-3digits 1)
 123       (opern-button "-" infixp)
 124       "<br />"
 125       (simple-input-button "0" "zerodigit")
 126       (simple-input-button "." "digit")
 127       (opern-button "+" infixp)
 128       "<br />"
 129       (memory-buttons infixp))))
 130