66 lines
2.4 KiB
Scheme
66 lines
2.4 KiB
Scheme
(define parallel 1)
|
|
|
|
(define (find-comic-image index)
|
|
(call-with-current-continuation
|
|
(lambda (k)
|
|
(with-input-from-request (format #f "https://rain.thecomicseries.com/comics/~a" index) #f
|
|
(lambda () ((make-html-parser
|
|
#:start (lambda (t a s v)
|
|
(when (equal? (alist-ref 'id a) '("comicimage"))
|
|
(k (car (alist-ref 'src a)))))) #:dummy-seed))))))
|
|
|
|
(define (download-comic-image index)
|
|
(format (current-error-port) "* downloading comic image ~a~%" index)
|
|
(call-with-output-file (format #f "rain-~a.png" index)
|
|
(lambda (out)
|
|
(call-with-input-request (find-comic-image index)
|
|
#f
|
|
(lambda (in)
|
|
(copy-port in out)))))
|
|
(format (current-error-port) "* downloaded comic image ~a~%" index))
|
|
|
|
(define (download-all indices)
|
|
(format (current-error-port) "* using ~a threads~%" parallel)
|
|
(for-each download-batch (chop indices parallel)))
|
|
|
|
(define (download-batch batch)
|
|
(let ((threads (map (lambda (index)
|
|
(make-thread
|
|
(lambda ()
|
|
(download-comic-image index))))
|
|
batch)))
|
|
(for-each thread-start! threads)
|
|
(for-each thread-join! threads)))
|
|
|
|
(define (usage)
|
|
(format (current-error-port) "usage: ~a [OPTION ...] INDEX ...~%" (program-name))
|
|
(format (current-error-port) "options:~%")
|
|
(format (current-error-port) " -h|-help display this help message~%")
|
|
(format (current-error-port) " -v|-version display version information~%")
|
|
(format (current-error-port) " -j|-parallel N download N images in parallel~%"))
|
|
|
|
(define parse-command-line
|
|
(match-lambda
|
|
(((or "-h" "-help") . _)
|
|
(usage))
|
|
(((or "-v" "-version") . _)
|
|
(format (current-error-port) "rain.scm 1.0.0~%" (program-name)))
|
|
(((or "-j" "-parallel") n . rest)
|
|
(let ((nn (string->number n)))
|
|
(unless nn
|
|
(usage)
|
|
(exit 1))
|
|
(set! parallel nn)
|
|
(parse-command-line rest)))
|
|
(()
|
|
(usage))
|
|
(indices
|
|
(for-each (lambda (x)
|
|
(when (char=? #\- (string-ref x 0))
|
|
(usage)
|
|
(exit 1)))
|
|
indices)
|
|
(download-all indices))))
|
|
|
|
(define (main args)
|
|
(parse-command-line args))
|