memo: webspeech.lisp

webspeech.lisp

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :clack)
  (ql:quickload :clack-app-route)
  (ql:quickload :cl-who)
  (ql:quickload :parenscript)
  (ql:quickload :chatai-tan))

(defpackage :webspeech
  (:use :cl
	:cl-who
	:parenscript
	:clack
	:clack.request
	:clack.app.route)
  (:shadowing-import-from :parenscript :call))

(in-package :webspeech)

(setf (html-mode) :html5)

(defvar server)

(defun genhtml (sent)
  (with-html-output-to-string (str nil :prologue t)
    (:html
     :lang "ja"
     (:head
      (:meta :charset "utf-8")
      (:script
       :src "http://ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js")
      (:title "web speech test")
      (:script
       :type "text/javascript"
       (str
	(ps
	  (var recognition (new (webkit-Speech-Recognition)))
	  (with-slots (lang
		       onsoundstart
		       onnomatch
		       onerror
		       onsounded
		       onresult)
		      recognition
	     (setf lang "ja-JP"
		   onsoundstart
		   (lambda ()
		     ((@ (chain ($ "#state")) text)
		      "recognizing"))
		   onnomatch
		   (lambda ()
		     ((@ (chain ($ "#recognizedText"))
			 text)
		      "restart, plz"))
		   onerror
		   (lambda ()
		     ((@ (chain ($ "#recognizedText")) text)
		      "ERROR"))
		   onsounded
		   (lambda ()
		     ((@ (chain ($ "#state")) text)
		      "stopping"))
		   onresult
		   (lambda (event)
		     (with-slots (results) event
			(setf (chain document location)
			      (+ "/?sentence="
				 (getprop results 0 0 'transcript)))))))))))
     (:body
      (:h1 "web speech test")
      (:input
       :type "button" :value "start"
       :onclick (ps (funcall (getprop recognition 'start))))
      (:input
       :type "button" :value "stop"
       :onclick (ps (funcall (getprop recognition 'stop))))
      (:div :id "state"
	    "stopping")
      (:div :id "recognizedText" (esc sent))))))

(defroutes web-speech-app (env)
  (GET "/" #'index)
;  (POST "/chatai" #'query-to-chatai)
  )

(defmacro awhen (test &body forms)
  `(let ((it ,test))
     (when it
       ,@forms)))

(defun index (env)
  (let ((chataied
	 (awhen (query-parameter (make-request env) "sentence")
	   (chatai-tan:chatai it)))
    `(200
      (:content-type "text/html")
      (,(genhtml chataied)))))

(defun test (env)
  `(200
    (:content-type "text/html")
    (,env)))

(defun restart-server ()
  (when (boundp 'server)
    (stop server))
  (setf server (clackup #'web-speech-app)))