src/webui/matrixui.lisp

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