;;; Copyright © 2019 - 2022 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.

(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)))))