Permalink
Browse files

Initial commit.

  • Loading branch information...
0 parents commit 6accafd57ac0db1dba96dad611f516e43ebd3aca @stassats committed Mar 13, 2010
Showing with 255 additions and 0 deletions.
  1. +56 −0 microdvd.lisp
  2. +25 −0 packages.lisp
  3. +85 −0 subrip.lisp
  4. +9 −0 subtitles.asd
  5. +80 −0 subtitles.lisp
@@ -0,0 +1,56 @@
+;;; -*- Mode: Lisp -*-
+
+;;; This software is in the public domain and is
+;;; provided with absolutely no warranty.
+
+(in-package #:subtitles.microdvd)
+
+(defun read-integer (stream stop-character)
+ (loop for char = (read-char stream)
+ for digit = (digit-char-p char)
+ while digit
+ for result = digit then (+ (* result 10) digit)
+ finally (progn
+ (assert (char= stop-character char))
+ (return result))))
+
+(defun read-frame-number (stream)
+ (assert (char= (read-char stream) #\{))
+ (read-integer stream #\}))
+
+(defun read-text (stream)
+ (read-line stream))
+
+(defun read-frame (stream)
+ (let ((frame (make-instance 'frame)))
+ (with-slots (text start-time end-time) frame
+ (setf start-time (read-frame-number stream)
+ end-time (read-frame-number stream)
+ text (read-text stream))
+ frame)))
+
+(defun write-frame-number (frame stream)
+ (format stream "{~a}{~a}"
+ (start-time frame)
+ (end-time frame)))
+
+(defun write-frame (frame stream)
+ (write-frame-number frame stream)
+ (write-line (text frame) stream))
+
+(defmethod read-subtitles ((type (eql 'microdvd)) stream)
+ (make-instance 'subtitles :contents
+ (loop while (listen stream)
+ collect (read-frame stream))))
+
+(defmethod write-subtitles ((type (eql 'microdvd)) subtitles stream)
+ (loop for frame in (contents subtitles)
+ do (write-frame frame stream)))
+
+(defmethod external-format ((type (eql 'microdvd))
+ &optional (encoding *default-encoding*))
+ (flex:make-external-format encoding :eol-style :crlf))
+
+(register-type 'microdvd
+ (lambda (file-name)
+ (equalp (pathname-type file-name) "sub")))
@@ -0,0 +1,25 @@
+;;; -*- Mode: Lisp -*-
+
+(defpackage #:subtitles
+ (:use #:cl)
+ (:export #:subtitles
+ #:frame
+ #:read-subtitles
+ #:write-subtitles
+ #:external-format
+ #:register-type
+ #:load-subtitle
+ #:save-subtitle
+ #:encode-time
+ #:decode-time
+ #:contents
+ #:text
+ #:start-time
+ #:end-time
+ #:*default-encoding*))
+
+(defpackage #:subtitles.subrip
+ (:use #:cl #:subtitles))
+
+(defpackage #:subtitles.microdvd
+ (:use #:cl #:subtitles))
@@ -0,0 +1,85 @@
+;;; -*- Mode: Lisp -*-
+
+;;; This software is in the public domain and is
+;;; provided with absolutely no warranty.
+
+(in-package #:subtitles.subrip)
+
+(defun parse-time (string &optional (shift 0))
+ "01:36:54,873 => milliseconds"
+ (let ((spec '((0 2 #\: #.(* 60 60 1000))
+ (3 5 #\: #.(* 60 1000))
+ (6 8 #\, 1000)
+ (9 12 nil 1))))
+ (loop for (start end separator ms) in spec
+ sum (* ms
+ (parse-integer string
+ :start (+ start shift)
+ :end (+ end shift)))
+ while separator
+ do (assert (eql separator (char string (+ end shift)))))))
+
+(defun read-time (stream)
+ (let* ((string (read-line stream))
+ (arrow-end (+ (search " --> " string)
+ (length " --> "))))
+ (values (parse-time string)
+ (parse-time string arrow-end))))
+
+(defun read-text (stream)
+ (with-output-to-string (result)
+ (loop with prev-char = #\Newline
+ for char = (read-char stream nil)
+ until (or (null char)
+ (char= prev-char char #\Newline))
+ do (write-char char result)
+ (setf prev-char char))
+ result))
+
+(defun read-frame (stream)
+ (assert (integerp (parse-integer (read-line stream))))
+ (let ((frame (make-instance 'frame)))
+ (with-slots (text start-time end-time) frame
+ (setf (values start-time end-time) (read-time stream)
+ text (read-text stream))
+ frame)))
+
+(defun write-time (ms stream)
+ (multiple-value-bind (h m s ms) (decode-time ms)
+ (let ((spec `((2 #\: ,h)
+ (2 #\: ,m)
+ (2 #\, ,s)
+ (3 nil ,ms))))
+ (loop for (digits separtor value) in spec
+ do (format stream "~v,,,'0@a" digits value)
+ when separtor do (write-char separtor stream)))))
+
+(defun write-timings (frame stream)
+ (write-time (start-time frame) stream)
+ (write-string " --> " stream)
+ (write-time (end-time frame) stream)
+ (terpri stream))
+
+(defun write-frame (frame n stream)
+ (format stream "~a~%" n)
+ (write-timings frame stream)
+ (write-line (text frame) stream)
+ (terpri stream))
+
+(defmethod read-subtitles ((type (eql 'subrip)) stream)
+ (make-instance 'subtitles :contents
+ (loop while (listen stream)
+ collect (read-frame stream))))
+
+(defmethod write-subtitles ((type (eql 'subrip)) subtitles stream)
+ (loop for number from 1
+ for frame in (contents subtitles)
+ do (write-frame frame number stream)))
+
+(defmethod external-format ((type (eql 'subrip))
+ &optional (encoding *default-encoding*))
+ (flex:make-external-format encoding :eol-style :crlf))
+
+(register-type 'subrip
+ (lambda (file-name)
+ (equalp (pathname-type file-name) "srt")))
@@ -0,0 +1,9 @@
+;;; -*- Mode: Lisp -*-
+
+(asdf:defsystem subtitles
+ :serial t
+ :depends-on (flexi-streams)
+ :components ((:file "packages")
+ (:file "subtitles")
+ (:file "subrip")
+ (:file "microdvd")))
@@ -0,0 +1,80 @@
+;;; -*- Mode: Lisp -*-
+
+;;; This software is in the public domain and is
+;;; provided with absolutely no warranty.
+
+(in-package #:subtitles)
+
+(defvar *default-encoding* :utf-8)
+
+(defclass subtitles ()
+ ((contents :initform nil
+ :accessor contents
+ :initarg :contents)))
+
+(defclass frame ()
+ ((text :initform nil
+ :accessor text
+ :initarg :text)
+ (start-time :initform 0
+ :accessor start-time
+ :initarg :start-time)
+ (end-time :initform 0
+ :accessor end-time
+ :initarg :end-time)))
+
+(defgeneric read-subtitles (type stream))
+(defgeneric write-subtitles (type subtitles stream))
+(defgeneric external-format (type &optional encoding))
+
+(defmethod external-format (type &optional (encoding *default-encoding*))
+ (flex:make-external-format encoding))
+
+(defvar *type-mapping* ())
+
+(defun register-type (type function)
+ (let ((acons (assoc type *type-mapping*)))
+ (if acons
+ (setf (cdr acons) function)
+ (push (cons type function) *type-mapping*))))
+
+(defun file-type (file-name)
+ (loop for (type . function) in *type-mapping*
+ when (funcall function file-name) return type))
+;;;
+
+(defun load-subtitle (file-name &optional (type (file-type file-name)))
+ (unless type
+ (error "Couldn't determine type of ~a." file-name))
+ (with-open-file (stream file-name :element-type '(unsigned-byte 8))
+ (let ((flexi (flex:make-flexi-stream stream :external-format
+ (external-format type))))
+ (read-subtitles type flexi))))
+
+(defun save-subtitle (file-name subtitle &optional (type (file-type file-name)))
+ (unless type
+ (error "Couldn't determine type of ~a." file-name))
+ (with-open-file (stream file-name :element-type '(unsigned-byte 8)
+ :direction :output)
+ (let ((flexi (flex:make-flexi-stream stream :external-format
+ (external-format type))))
+ (write-subtitles type subtitle flexi))))
+
+;;;
+
+(defun encode-time (hours minutes seconds milliseconds)
+ (+ milliseconds
+ (* 1000 (+ seconds
+ (* 60 (+ minutes
+ (* 60 hours)))))))
+
+(defun decode-time (time)
+ (flet ((remainder (divisor)
+ (let (remainder)
+ (setf (values time remainder) (truncate time divisor))
+ remainder)))
+ (let ((ms (remainder 1000))
+ (s (remainder 60))
+ (m (remainder 60))
+ (h time))
+ (values h m s ms))))

0 comments on commit 6accafd

Please sign in to comment.