123 lines
4.3 KiB
Common Lisp
123 lines
4.3 KiB
Common Lisp
(in-package #:myoji-accent/index)
|
|
|
|
(defapp index
|
|
:prefix "/"
|
|
:name "苗字アクセント辞典")
|
|
|
|
(defwidget index-page ()
|
|
((last-search :initform nil
|
|
:type '(or string null)
|
|
:documentation "The last received query.")
|
|
(myoji-list :initform nil
|
|
:type 'list
|
|
:documentation "List of myoji that where returned by the last
|
|
search.")))
|
|
|
|
(defparameter *pitch-color* "red"
|
|
"The color of pitch accent lines.")
|
|
|
|
(defmethod reblocks/dependencies:get-dependencies ((widget index-page))
|
|
(append
|
|
(list
|
|
(reblocks-lass:make-dependency
|
|
`(.index-page
|
|
:width "50%"
|
|
:margin auto
|
|
:margin-top "15%"
|
|
(|#page-title|
|
|
:text-align "center"
|
|
:font-size xxx-large
|
|
:margin-bottom "30px")
|
|
(|#search-form|
|
|
:margin auto
|
|
:width "70%"
|
|
:display flex
|
|
(|#query-input|
|
|
:font-size xx-large
|
|
:flex auto)
|
|
(|#submit-button|
|
|
:margin-left "5px"
|
|
:font-size xx-large))
|
|
(|#error-message|
|
|
:margin-top "20px"
|
|
:font-size xx-large
|
|
:text-align center
|
|
:color "red")
|
|
(|#entry-list|
|
|
:margin-top "20px"
|
|
(.myoji-entry
|
|
:font-size xx-large
|
|
:text-align center
|
|
((:parent (:not :first-child))
|
|
:margin-top "10px")))
|
|
(.accented
|
|
(span.tone-h
|
|
:border-top "1px" solid ,*pitch-color*)
|
|
(span.tone-l
|
|
:border-bottom "1px" solid ,*pitch-color*)
|
|
(span.tone-h-change
|
|
:border solid ,*pitch-color*
|
|
:border-width "1px" "1px" "0px" "0px")
|
|
(span.tone-l-change
|
|
:border solid ,*pitch-color*
|
|
:border-width "0px" "1px" "1px" "0px")
|
|
(span.tone-end-change
|
|
:border-right "1px")))))
|
|
(call-next-method)))
|
|
|
|
(defun empty-query-p (query)
|
|
"Return non-nil if QUERY is empty or contains only spaces."
|
|
(null (set-difference (coerce query 'list) '(#\Ideographic_Space #\Space
|
|
#\No-break_Space #\Tab)
|
|
:test 'eql)))
|
|
|
|
(defmethod handle-search ((widget index-page) &key query)
|
|
(if (empty-query-p query)
|
|
(setf (slot-value widget 'last-search) nil
|
|
(slot-value widget 'myoji-list) nil)
|
|
(let ((myoji-list
|
|
(union (mito:retrieve-dao 'myoji-accent/accent:myoji :kanji query)
|
|
(mito:retrieve-dao 'myoji-accent/accent:myoji :reading query))))
|
|
(setf (slot-value widget 'last-search) query
|
|
(slot-value widget 'myoji-list) myoji-list)))
|
|
(reblocks/widget:update widget))
|
|
|
|
(defmethod reblocks/widget:render ((widget index-page))
|
|
(with-slots (last-search myoji-list) widget
|
|
(with-html
|
|
(:div :id "page-title"
|
|
"苗字アクセント辞典")
|
|
(with-html-form (:POST #'(lambda (&key query &allow-other-keys)
|
|
(handle-search widget :query query))
|
|
:id "search-form")
|
|
(:input :id "query-input"
|
|
:type "text"
|
|
:name "query"
|
|
:placeholder "苗字を入力して検索する"
|
|
:value (or (slot-value widget 'last-search) ""))
|
|
(:input :id "submit-button"
|
|
:type "submit"
|
|
:value "検索"))
|
|
(cond
|
|
(myoji-list
|
|
(:div :id "entry-list"
|
|
(dolist (myoji myoji-list)
|
|
(with-accessors ((kanji myoji-kanji)
|
|
(accent-point myoji-accent-point)
|
|
(accent-name myoji-accent-name)
|
|
(accent-html myoji-accent-html))
|
|
myoji
|
|
(:div :class "myoji-entry"
|
|
(format nil "~a " kanji)
|
|
(:raw (format nil "→ <span class=accented>~a</span>"
|
|
accent-html))
|
|
(format nil " [~a] (~a)" accent-point accent-name))))))
|
|
(last-search
|
|
(:div :id "error-message"
|
|
"該当する苗字がみつかりませんでした。"))))))
|
|
|
|
(defmethod reblocks/page:init-page ((app index) (url-path string) expire-at)
|
|
(declare (ignorable url-path expire-at))
|
|
(setf (reblocks/page:get-title) "苗字アクセント辞典")
|
|
(make-instance 'index-page))
|