diff options
Diffstat (limited to 'srt2vtt/ui.scm')
-rw-r--r-- | srt2vtt/ui.scm | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/srt2vtt/ui.scm b/srt2vtt/ui.scm new file mode 100644 index 0000000..607c49e --- /dev/null +++ b/srt2vtt/ui.scm @@ -0,0 +1,112 @@ +;;; srt2vtt --- SRT to WebVTT converter +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; srt2vtt 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. +;;; +;;; srt2vtt 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 srt2vtt. If not, see <http://www.gnu.org/licenses/>. + +(define-module (srt2vtt ui) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (srt2vtt subrip) + #:use-module (srt2vtt webvtt) + #:export (main)) + +(define (show-help-and-exit) + (format #t "Usage: srt2vtt [OPTIONS] +Convert SubRip formatted subtitles to WebVTT format.~%") + (display " + -h, --help display this help and exit") + (display " + -v, --version display version and exit") + (display " + -i, --input=FILE-NAME read input from FILE-NAME") + (display " + -o, --output=FILE-NAME write output to FILE-NAME") + (newline) + (exit 0)) + +(define (show-version-and-exit) + (format #t "srt2vtt 0.1~%") + (exit 0)) + +(define (show-usage-and-exit) + (format #t "Try `srt2vtt --help' for more information.~%") + (exit 1)) + +(define (show-wrong-args-and-exit) + (format #t "Invalid arguments~%") + (show-usage-and-exit)) + +(define %default-args + `((input . ,(current-input-port)) + (output . ,(current-output-port)))) + +(define %options + (list (option '(#\h "help") #f #f + (lambda (opt name arg args) + (show-help-and-exit))) + (option '(#\v "version") #f #f + (lambda (opt name arg args) + (show-version-and-exit))) + (option '(#\i "input") #t #f + (lambda (opt name arg args) + (alist-cons 'input arg args))) + (option '(#\o "output") #t #f + (lambda (opt name arg args) + (alist-cons 'output arg args))))) + +(define (make-call-with-port-or-file file-proc) + "Create a new procedure that accepts two arguments: a port or file, +and a procedure. When the returned procedure is called with a port as +the first argument, the second argument is simply applied with that +port. If the first argument is a string, the second argument is +applied with the port corresponding to the file name contained in the +string as opened by FILE-PROC." + (lambda (port-or-file proc) + (if (port? port-or-file) + (proc port-or-file) + (file-proc port-or-file proc)))) + +(define call-with-port-or-input-file + (make-call-with-port-or-file call-with-input-file)) + +(define call-with-port-or-output-file + (make-call-with-port-or-file call-with-output-file)) + +(define (parse-opts args) + "Parse the list of ARGS and return a list of option/value pairs. +When an option isn't specified in ARGS, it defaults to the value in +'%default-args'." + (args-fold args + %options + (lambda (opt name arg args) + (error "Unrecognized option '~a'" name)) + (lambda (arg args) + (error "Extraneous argument '~a'" arg)) + %default-args)) + +(define (convert input-port output-port) + "Read the SubRip formatted subtitles from INPUT-PORT and write the +WebVTT equivalents to OUTPUT-PORT." + (write-webvtts (read-subrips input-port) output-port)) + +(define (main args) + "srt2vtt entry point." + (let ((opts (parse-opts args))) + (call-with-port-or-input-file (assoc-ref opts 'input) + (lambda (input-port) + (call-with-port-or-output-file (assoc-ref opts 'output) + (lambda (output-port) + (convert input-port output-port))))))) |