1 files changed, 107 insertions, 0 deletions
diff --git a/dynamic/captcha.scm b/dynamic/captcha.scm
new file mode 100644
index 0000000..c4380fb
--- /dev/null
+++ b/dynamic/captcha.scm
@@ -0,0 +1,107 @@
+(define-module (captcha)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 local-eval)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-1)
+  #:export (new-captcha))
+
+(define proc-mutex (make-mutex))
+
+(define (random-term)
+  (match (random 5)
+    (0 `(* ,(+ 1 (random 10)) x))
+    (1 `(* ,(+ 1 (random 10)) (expt x ,(random 10))))
+    (2 `(* ,(+ 1 (random 10)) (exp x)))
+    (3 `(* ,(+ 1 (random 10)) (cos x)))
+    (4 `(* ,(+ 1 (random 10)) (sin x)))))
+
+(define (sexp->latex sexp)
+  (match sexp
+    (('+ rest ...) (string-join (map sexp->latex rest) " + "))
+    (('* rest ...) (string-join (map sexp->latex rest) " \\cdot "))
+    (('sin term) (format #f "\\sin(~a)" (sexp->latex term)))
+    (('cos term) (format #f "\\cos(~a)" (sexp->latex term)))
+    (('expt term n) (format #f "~a^{~a}" (sexp->latex term) (sexp->latex n)))
+    (('exp term) (format #f "e^{~a}" (sexp->latex term)))
+    ('x "x")
+    (n (cond ((and (number? n) (positive? n)) (format #f "~a" n))
+             ((and (number? n) (negative? n)) (format #f "(~a)" n))
+             ((number? n) "0")
+             (else (error "Do not know how to convert to latex." n))))))
+
+(define (differentiate-sexp sexp)
+  (match sexp
+    (('+ rest ...) `(+ ,@(map differentiate-sexp rest)))
+    (('* coeff term) (if (number? coeff)
+                         `(* ,coeff ,(differentiate-sexp term))
+                         (error "Do not know how to differentiate.")))
+    (('sin term) `(* ,(differentiate-sexp term) (cos ,term)))
+    (('cos term) `(* -1 ,(differentiate-sexp term) (sin ,term)))
+    (('exp term) `(* ,(differentiate-sexp term) (exp ,term)))
+    (('expt term n) `(* ,n (expt ,term ,(- n 1))))
+    ('x 1)
+    (n (if (number? n)
+           0
+           (error "Do not know how to differentiate.")))))
+
+(define (simplify-sexp sexp)
+  (match sexp
+    (('+ rest ...) `(+ ,@(map simplify-sexp rest)))
+    (('* 1 term) (simplify-sexp term))
+    (('* 1 rest ...) (simplify-sexp `(* ,@rest)))
+    (('sin term) `(sin ,(simplify-sexp term)))
+    (('sin term) `(cos ,(simplify-sexp term)))
+    (('exp term) `(exp ,(simplify-sexp term)))
+    (('expt term 1) (simplify-sexp term))
+    (('expt term n) `(expt ,(simplify-sexp term) ,(simplify-sexp n)))
+    (term term)))
+
+(define (random-expression)
+  (let ((n-terms (+ 2 (random 3))))
+    `(+ ,@(map (lambda (x) (random-term)) (iota n-terms)))))
+
+(define (latex->image src)
+  (chdir "/tmp")
+  (with-mutex proc-mutex
+    (call-with-output-file "formula.tex"
+      (lambda (port)
+        (format port "\\def\\formula{~a}
+\\documentclass[border=2pt]{standalone}
+\\usepackage{amsmath}
+\\usepackage{varwidth}
+\\begin{document}
+\\begin{varwidth}{\\linewidth}
+\\[ \\formula \\]
+\\end{varwidth}
+\\end{document}
+" src)))
+    (unless (eqv? 0 (status:exit-val (system "pdflatex formula.tex")))
+      (error "Cannot generate PDF"))
+    (let* ((port (open-input-pipe "convert -density 300 formula.pdf -quality 90 png:-"))
+           (data (get-bytevector-all port)))
+      (unless (eqv? 0 (status:exit-val (close-pipe port)))
+          (error "Cannot generate PNG"))
+      data)))
+
+(define (new-uuid)
+  (with-mutex proc-mutex
+    (let* ((port (open-input-pipe "uuidgen"))
+           (str  (read-line port)))
+      (close-pipe port)
+      str)))
+
+(define (new-captcha)
+  (let* ((lower-bound (random 10))
+         (upper-bound (+ lower-bound 1 (random 9)))
+         (expression (random-expression))
+         (latex-src (sexp->latex (simplify-sexp (differentiate-sexp expression)))))
+    (values (new-uuid)
+            (- (local-eval expression (let ((x upper-bound)) (the-environment)))
+               (local-eval expression (let ((x lower-bound)) (the-environment))))
+            (latex->image (format #f "\\int_{~a}^{~a} ~a \\, dx"
+                                  lower-bound
+                                  upper-bound
+                                  latex-src)))))