src/webui/calcupage-buttons.lisp

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