src/webui/matrixui.lisp

   1
   2 ;V URL: /matrix_select_contents
   3 ;V Return html code for the dropdown menu V
   4 ;V (html's "select" element) to list all  V
   5 ;V stored matrices.                       V
   6 (defun matrix-select-contents ()
   7   (with-html-output-to-string
   8     (s nil)
   9     (:option "Name")
  10     (dolist (v *saved-tuples*)
  11       (with-html-output
  12         (s) (:option (princ v s))))
  13     (dolist (m *saved-matrices*)
  14       (with-html-output
  15         (s) (:option (princ m s))))))
  16
  17 ;V URL: /post_matrix_input
  18 ;V Read input from client, store matrix.V
  19 (defun get-matrix-input
  20   (&aux (cols (read-from-string (parameter "cols"))))
  21   (store-vrbl
  22     (parameter "name")
  23     ;V If there's only one column, user input a vector.V
  24     (if (= cols 1)
  25       (make-tuple
  26         :dim (read-from-string (parameter "rows"))
  27         :elems (mapcar #'car (read-from-string
  28                                (parameter "matrix"))))
  29       (make-mtrix
  30         :dimdom cols
  31         :dimcodom (read-from-string (parameter "rows"))
  32         :elems (read-from-string (parameter "matrix")))))
  33   (matrix-select-contents))
  34
  35 ;V URL: /matrix_request
  36 ;V Pass javascript code back to the client for eval,  V
  37 ;V which stores the matrix's elements in a 2D array   V
  38 ;V named /matrix/. Also pass code that sets variables V
  39 ;V named /rows/ and /cols/ to their obvious values.   V
  40 (defun matrix-request
  41   (&aux (name (parameter "name"))
  42         (s (make-string-output-stream)))
  43   "Return javascript code for storing"
  44   ;^ the named matrix in the variable: /matrix/ ^
  45   (let (matrows)
  46     (let ((m (symbol-value
  47                (find-symbol name :lineal.client-vars))))
  48       ;V State the rows and columns of the matrix, V
  49       ;V store the list of rows in /matrows/       V
  50       (typecase m
  51         (mtrix
  52           (format s "rows = ~D; cols = ~D;"
  53                   (mtrix-dimcodom m)
  54                   (mtrix-dimdom m))
  55           (setq matrows (mtrix-elems m)))
  56         (tuple
  57           (format s "rows = ~D; cols = ~D;"
  58                   (tuple-dim m) 1)
  59           (setq matrows (mapcar #'list (tuple-elems m))))
  60         (otherwise (throw 'unknown-variable name))))
  61     (princ "matrix = new Array(" s)
  62     (loop
  63       :for row :in matrows
  64       :and raystr = "new Array("
  65       :then ",new Array("
  66       :do (princ raystr s)
  67       :do (format s "\"~D\"" (car row))
  68       :do
  69       (loop
  70         :for elem :in (cdr row)
  71         :do (format s ",\"~D\"" elem))
  72       :do (princ ")" s))
  73     (princ ");" s)
  74     (get-output-stream-string s)))
  75
  76 ;V URL /input_matrix
  77 ;V The matrix input page.V
  78 (defun matrix-input-code
  79   (&aux (rows (parameter "rows"))
  80         (cols (parameter "cols")))
  81   (unless (integerp rows) (setq rows 2))
  82   (unless (integerp cols) (setq cols 2))
  83   (with-html-output-to-string
  84     (s nil :prologue t)
  85     (:html
  86       (:head
  87         (jsfile s "matrix-edit")
  88         (jsfile s "connects"))
  89       (:body
  90         (:div (:a :href "/" "Main") " Page" :br
  91               (calcupage-link s))
  92         :br
  93         (:div
  94           (:select
  95             :id "nameSelect"
  96             :onchange (ps-inline (select-name-change))
  97             (princ (matrix-select-contents) s))
  98           " " (:input :type "text" :onfocus "select()" :id "nameField")
  99           " " (:button :tabindex "-1"
 100                        :onclick (ps-inline (recall-matrix))
 101                        "Recall!"))
 102         :br
 103         (:form
 104           :action (ps-inline (reset-fields))
 105           (:table
 106             (:tr (:td "Rows") (:td "Columns") :td)
 107             (:tr (:td (:input :id "rowField" :onfocus "select()" :value rows))
 108                  (:td (:input :id "colField" :onfocus "select()" :value cols))
 109                  (:td (:button :tabindex "-1" "Resize!" )))))
 110         :br
 111         (:form
 112           :action (ps-inline (send-matrix))
 113           (:div :id "fieldDiv")
 114           (:div (:button "Update")))
 115         (:div :id "outDiv" "")
 116         (ps-tag
 117           s
 118           (setf name-field (.get-element-by-id document "nameField")
 119                 name-select (.get-element-by-id document "nameSelect")
 120                 row-field (.get-element-by-id document "rowField")
 121                 col-field (.get-element-by-id document "colField")
 122                 field-div (.get-element-by-id document "fieldDiv")
 123                 out-div (.get-element-by-id document "outDiv"))
 124           (reset-fields))))))
 125