diff --git a/ffmpeg-definitions.rkt b/ffmpeg-definitions.rkt index 7b81477..5e02972 100644 --- a/ffmpeg-definitions.rkt +++ b/ffmpeg-definitions.rkt @@ -6,6 +6,8 @@ (for-syntax racket/base) "private/utils.rkt" "private/cstruct-helper.rkt" + let-assert + define-return ) (provide fmpg-init @@ -485,27 +487,30 @@ (define-syntax check-support (syntax-rules () - ((_ from until lib) - (let ((major-version (car (ffmpeg-version lib)))) - (cond - ((or (< major-version from) (> major-version until)) - (error - (format "Unsupported major version of ffmpeg library ~a: ~a (~a).\nSupported range: ~a - ~a" - 'lib major-version (ffmpeg-version-string lib) from until))) - (else - (info-sound "Supported ffmpeg library ~a - version ~a between ~a and ~a" - lib (ffmpeg-version-string lib) from until) - ) + ((_ lib version-hash) + (let ((from (car (hash-ref lib version-hash))) + (until (cadr (hash-ref lib version-hash)))) + (let ((major-version (car (ffmpeg-version lib)))) + (cond + ((or (< major-version from) (> major-version until)) + (error + (format "Unsupported major version of ffmpeg library ~a: ~a (~a).\nSupported range: ~a - ~a" + 'lib major-version (ffmpeg-version-string lib) from until))) + (else + (info-sound "Supported ffmpeg library ~a - version ~a between ~a and ~a" + lib (ffmpeg-version-string lib) from until) + ) + ) ) ) ) ) ) -(check-support 58 60 'avutil) -(check-support 60 62 'avcodec) -(check-support 60 62 'avformat) -(check-support 4 6 'swresample) +(check-support 'avutil valid-ffmpeg-versions) +(check-support 'avcodec valid-ffmpeg-versions) +(check-support 'avformat valid-ffmpeg-versions) +(check-support 'swresample valid-ffmpeg-versions) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Constants diff --git a/info.rkt b/info.rkt index c32d7cd..2bc0aa6 100644 --- a/info.rkt +++ b/info.rkt @@ -20,7 +20,7 @@ ) (define deps - '("racket/gui" "racket/base" "racket" "finalizer" "draw-lib" "net-lib" "simple-log" "racket-sprintf") + '("racket/gui" "racket/base" "racket" "finalizer" "draw-lib" "net-lib" "simple-log" "racket-sprintf" "define-return" "let-assert") ) (define build-deps diff --git a/private/utils.rkt b/private/utils.rkt index bd1e5c0..783cbed 100644 --- a/private/utils.rkt +++ b/private/utils.rkt @@ -21,21 +21,19 @@ sync-log-sound integer->int-bytes int-bytes->integer - - let/assert - make-assert - a-eq? a-!eq? - a->? a-<=? a->=? a-int-bytes and vise versa. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (define-syntax-rule (integer->int-bytes v size signed? big? bs pos) (if (= size 3) (if big? @@ -137,102 +214,6 @@ u)) (integer-bytes->integer bs signed? big? start end)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; let/assert - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - (define-syntax make-assert - (syntax-rules () - ((_ name not-name pred) - (begin - (define-syntax name - (syntax-rules () - ((_ const) - (λ (x) (pred x const))))) - (define-syntax not-name - (syntax-rules () - ((_ const) - (λ (x) (not (pred x const)))))) - ) - ) - ) - ) - - (make-assert a-eq? a-!eq? eq?) - - (define a-nullptr? (a-eq? #f)) - (define a-!nullptr? (a-!eq? #f)) - - (make-assert a->? a-<=? >) - (make-assert a->=? a-=) - (make-assert a-=? a-!=? =) - - (define a-true? (a-eq? #t)) - (define a-false? (a-eq? #f)) - - (struct exn:let/assert exn (value) #:transparent) - - (define (raise-let/assert v) - (raise (exn:let/assert "let/assert" (current-continuation-marks) v))) - - (define (let/assert-value r) - (exn:let/assert-value r)) - - (define-syntax assert-expr - (syntax-rules () - ((_ expr cond retval) - (let ((a expr)) (if (cond a) a (raise-let/assert retval)))) - ((_ expr) - expr) - ) - ) - - (define-syntax let/assert - (syntax-rules () - ((_ ((v rest ...) ...) b1 ...) - (with-handlers ([exn:let/assert? let/assert-value]) - (let* ((v (assert-expr rest ...)) - ...) - b1 - ... - ) - ) - ) - ) - ) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; define/return - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (struct exn:return exn (value) #:transparent) - - (define (raise-return v) - (raise (exn:return "return" (current-continuation-marks) v))) - - (define (return-value r) - (exn:return-value r)) - - (define-syntax return - (syntax-rules () - ((_ val) - (raise-return val)))) - - (define-syntax define/return - (syntax-rules () - ((_ (name ...) b1 ...) - (define (name ...) - (with-handlers ([exn:return? return-value]) - b1 - ... - ) - ) - ) - ) - ) - - - + ) ; end of module