src/webui/psfiles/calcupage-buttons.lisp

   1
   2 (defvar calc-in)
   3
   4 (defun add-break (elem)
   5   (.append-child elem (.create-element document "br")))
   6
   7 ;V Insert text into /calc-in/ at cursor and give it focus.V
   8 (defun uinput (str)
   9   (defvar curpos (+ calc-in.selection-start str.length))
  10   (setf
  11     calc-in.value
  12     (+ (.substring calc-in.value 0 calc-in.selection-start)
  13        str (.substring calc-in.value calc-in.selection-end)))
  14   (setf calc-in.selection-start curpos
  15         calc-in.selection-end curpos)
  16   (.focus calc-in))
  17
  18 ;V Called when the "clear" button is pressed.V
  19 (defun cleartext ()
  20   (setf calc-in.value "")
  21   (.focus calc-in))
  22
  23 ;V Called when the "OK" button is pressed.V
  24 (defun send-calc ()
  25   (post-params
  26     "/process"
  27     (+ "text=" (.replace calc-in.value (regex "/\\+/g") "%2B"))
  28     (lambda (response)
  29       (setf (slot-value (.get-element-by-id document "resultPre")
  30                         'inner-h-t-m-l)
  31             response)
  32       (.focus calc-in))))
  33
  34 (defun show-a-button (name elem onclick width fcolor bcolor)
  35   (unless width (setf width 25))
  36   (unless fcolor (setf fcolor "#000000"))
  37   (unless bcolor (setf bcolor "#D3D3D3"))
  38   (let ((b (.create-element document "button")))
  39     (setf b.inner-h-t-m-l name)
  40     (.set-attribute
  41       b "style"
  42       (+ "color: " fcolor "; background-color: " bcolor
  43          "; height: 25px; width: " width "px"))
  44     (.set-attribute b "onclick" onclick)
  45     (.append-child elem b)))
  46
  47 ;-- BEGIN SPECIAL BUTTON CREATORS --
  48 (defun show-input-button (name elem tosend width fcolor bcolor)
  49   (show-a-button name elem (+ "uinput(\"" tosend "\")")
  50                  width fcolor bcolor))
  51
  52 (defun show-num (name elem)
  53   (show-input-button
  54     name elem name 25 "white" "black"))
  55
  56 ;V Use the button operation as a name.V
  57 (defun show-binop (name elem width fcolor bcolor)
  58   (show-input-button
  59     name elem name width fcolor bcolor))
  60
  61 (defun show-func (name elem width fcolor bcolor)
  62   (show-input-button name elem (+ "(" name " ")
  63                      width fcolor bcolor))
  64
  65 (defun clear-button (elem)
  66   (show-a-button "clear" elem "cleartext()" 45 "white" "darkred"))
  67
  68 (defun ok-button (elem)
  69   (show-a-button "ok" elem "sendCalc()" 25 "white" "green"))
  70
  71 (defun memory-buttons (elem)
  72   (show-input-button "recall" elem "(recall \\\"" 50 "white" "DarkSlateGray")
  73   (show-input-button "store" elem "(store \\\"" 50 "white" "SlateBlue"))
  74
  75 ;-- END SPECIAL BUTTON CREATORS --
  76
  77 ;V Show the calculator-layout thing. V
  78 (defun show-standops (elem)
  79   (show-input-button "^" elem "(expt ")
  80   (clear-button elem)
  81   (add-break elem)
  82   (show-input-button "&radic;" elem "(sqrt ")
  83   (show-binop "(" elem)
  84   (show-binop ")" elem)
  85   (show-func "/" elem)
  86   (add-break elem)
  87   (show-num "7" elem) (show-num "8" elem) (show-num "9" elem)
  88   (show-input-button "&times;" elem "(* ")
  89   (add-break elem)
  90   (show-num "4" elem) (show-num "5" elem) (show-num "6" elem)
  91   (show-func "-" elem)
  92   (add-break elem)
  93   (show-num "1" elem) (show-num "2" elem) (show-num "3" elem)
  94   (show-func "+" elem)
  95   (add-break elem)
  96   (show-input-button "0" elem "0" 50 "white" "black")
  97   (show-num "." elem)
  98   (ok-button elem)
  99   (add-break elem)
 100   (memory-buttons elem))
 101
 102 ;V Show linear algebra functions/operations.V
 103 ;V (not linear operators :)                 V
 104 (defun show-linops (elem)
 105   (show-func "rr-ef" elem 40)
 106   (show-func "r-ef" elem 40)
 107   (show-func "det" elem 35)
 108   (add-break elem)
 109   (show-func "transpose" elem  80)
 110   (show-func "inverse" elem 60)
 111   (add-break elem)
 112   (show-func "dot" elem 35)
 113   (show-func "cross" elem 45)
 114   (show-func "proj" elem 40)
 115   (show-func "orth" elem 40)
 116   (add-break elem)
 117   (show-func "cat" elem 35)
 118   (show-func "vcat" elem 40)
 119   (show-func "crop" elem 40)
 120   (show-func "vcrop" elem 45))
 121
 122
 123 (defun append-name-buttons (names vardiv)
 124   (defvar curbutt) (defvar curname)
 125   (dotimes (x names.length)
 126     (setf curname (aref names x)
 127           curbutt (.create-element document "button")
 128           curbutt.inner-h-t-m-l curname)
 129     ;V When you click on a name, call the uinput V
 130     ;V function with the name as an argument.    V
 131     (.set-attribute curbutt "onClick"
 132                     (+ "uinput(\"" curname "\");"))
 133     (.append-child vardiv curbutt)))
 134