Zander671/truth-table
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add pretty print and latin truth values support

Browse Source
This commit is contained in:
Alexander Rosenberg
2024-09-10 22:19:43 -07:00
parent c86b38db09
commit edd4f53a68
3 changed files with 139 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
web.lisp
View File

@ -43,6 +43,10 @@
:accessor truth-table-data)
(format :initform "html"
:accessor truth-table-format)
(pretty-print :initform t
:accessor truth-table-pretty-print)
(latin-truths :initform nil
:accessor truth-table-latin-truths)
(output-visible :initform t
:accessor truth-table-output-visible))
(:documentation "Class to hold the generated table."))
@ -58,13 +62,17 @@ reblocks bug.")
(defmethod render ((table truth-table))
"Render TABLE."
(with-slots (data format output-visible) table
(let* ((html-text (convert-truth-table-to-html data))
(with-slots (data format pretty-print latin-truths output-visible) table
(let* ((html-text (convert-truth-table-to-html data
:pretty-print pretty-print
:latin-truths latin-truths))
(other-text
(when output-visible
(if (equal format "html")
html-text
(typeset-table-to-format data format)))))
(typeset-table-to-format data format
:pretty-print pretty-print
:latin-truths latin-truths)))))
(when data
(with-html
(:div :class "label" "Output:")
@ -80,7 +88,8 @@ reblocks bug.")
(if output-visible
"⏷"
"⏵"))
(if (or (equal format "ascii")
(if (or pretty-print
(equal format "ascii")
(equal format "unicode"))
(:pre :id "output-area" :hidden (not output-visible)
other-text)
@ -171,7 +180,7 @@ reblocks bug.")
(defmethod handle-generate-request ((page page)
&key prop-str implicit-and multi-char-names
format include-vars subexps)
format include-vars subexps latin pretty)
"Handler for requests to generate truth tables."
(with-slots (table error-box) page
(setf (truth-table-format table) format
@ -186,7 +195,9 @@ reblocks bug.")
(setf (truth-table-data table) (create-truth-table parsed-exp
:vars vars
:include-vars include-vars
:include-intermediate subexps)))
:include-intermediate subexps)
(truth-table-latin-truths table) latin
(truth-table-pretty-print table) pretty))
((or proposition-parse-error proposition-eval-error) (e)
(setf (error-box-message error-box) (princ-to-string e))))
(setf (truth-table-data table) nil))
@ -200,15 +211,18 @@ reblocks bug.")
(:h1 "Truth Table Generator")
(with-html-form (:POST (lambda (&key prop-str implicit-and
multi-char-names format
include-vars subexps
include-vars subexps latin
pretty
&allow-other-keys)
(handle-generate-request
page :prop-str prop-str
:implicit-and implicit-and
:implicit-and implicit-and
:multi-char-names multi-char-names
:format format
:include-vars include-vars
:subexps subexps)))
:subexps subexps
:pretty pretty
:latin latin)))
(:div :id "main-controls-wrapper"
(:input :id "prop-input-field"
:type "text"
@ -236,6 +250,16 @@ reblocks bug.")
:checked t
:style "margin-left: 10px;")
(:label :for "subexps" "Include Sub-expressions")
(:input :type "checkbox"
:name "pretty"
:checked t
:style "margin-left: 10px;")
(:label :for "pretty" "Pretty Print")
(:input :type "checkbox"
:name "latin"
:checked nil
:style "margin-left: 10px;")
(:label :for "latin" "Latin Truth Values")
(:select :name "format" :style "margin-left: 10px;"
(:option :value "html" "HTML")
(:option :value "latex" "LaTeX")