src/webui/calcupage-buttons.lisp

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