deps on define-return and let-assert + library messages

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)
+    ((_ lib version-hash)
-     (let ((major-version (car (ffmpeg-version lib))))
+     (let ((from (car (hash-ref lib version-hash)))
-       (cond
+           (until (cadr (hash-ref lib version-hash))))
-         ((or (< major-version from) (> major-version until))
+       (let ((major-version (car (ffmpeg-version lib))))
-          (error
+         (cond
-           (format "Unsupported major version of ffmpeg library ~a: ~a (~a).\nSupported range: ~a - ~a"
+           ((or (< major-version from) (> major-version until))
-                   'lib major-version (ffmpeg-version-string lib) from until)))
+            (error
-         (else
+             (format "Unsupported major version of ffmpeg library ~a: ~a (~a).\nSupported range: ~a - ~a"
-          (info-sound "Supported ffmpeg library ~a - version ~a between ~a and ~a"
+                     'lib major-version (ffmpeg-version-string lib) from until)))
-                      lib (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 'avutil valid-ffmpeg-versions)
-(check-support 60 62 'avcodec)
+(check-support 'avcodec valid-ffmpeg-versions)
-(check-support 60 62 'avformat)
+(check-support 'avformat valid-ffmpeg-versions)
-(check-support 4 6 'swresample)
+(check-support 'swresample valid-ffmpeg-versions)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Constants

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

private/utils.rkt

@@ -21,21 +21,19 @@
            sync-log-sound
            integer->int-bytes
            int-bytes->integer
-
+           valid-ffmpeg-versions
-           let/assert
-           make-assert
-           a-eq? a-!eq?
-           a->? a-<=? a->=? a-<? a-=? a-!=?
-           a-nullptr? a-!nullptr?
-           a-true? a-false?
-           
-           define/return
-           return
-           
            )
 
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Create log definitions
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
   (sl-def-log racket-sound sound)
 
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Provide some loop constructions
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
   (define-syntax while
     (syntax-rules ()
       ((_ cond body ...)
@@ -77,6 +75,80 @@
                                          (do-for-f))))))
            (do-for-f))))))
 
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Loading libraries
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define valid-ffmpeg-versions
+    (make-hash (list (list 'avutil 58 60 "libavcodec")
+                      (list 'avcodec 60 62 "libavutil")
+                      (list 'avformat 60 62 "libswresample")
+                      (list 'swresample 4 6 "libavformat")
+                      ))
+    )
+
+  (define (version-str kind)
+    (let ((v (hash-ref valid-ffmpeg-versions kind)))
+      (format "  - ~a~a - ~a~a\n" (caddr v) (car v) (caddr v) (cadr v))
+      )
+    )
+
+  (define (lib-not-found-message orig-libs libs-path)
+    (displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs libs-path))
+    (let ((st (system-type 'os*)))
+      (cond ((eq? st 'windows)
+             (displayln
+              (format
+               "\nLibraries for Windows should have been downloaded to\n\n  - ~a\n"
+               (soundlibs-directory))))
+            ((eq? st 'linux)
+             (displayln
+               (string-append
+                "Make sure you have installed the following libraries,\n"
+                "e.g. on a debian based system with apt:\n"
+                "\n"
+                "  FLAC   : sudo apt install libflac12\n"
+                "  mpg123 : libmpg123-0\n"
+                "  libao  : libao4\n"
+                "  ffmpeg : libavcodec60 libavutil58 libswresample4 libavformat60\n"
+                "\n"
+                )))
+            ((eq? st 'macosx)
+             (displayln
+              (string-append
+               "Make sure you have the right libraries installed, using 'homebrew', see https://brew.sh/\n"
+               "\n"
+               "  brew install ffmpeg-full\n"
+               "  brew install libao\n"
+               "  brew install mpg123\n"
+               "  brew install flac\n"
+               "\n"
+               )))
+            (else
+             (displayln
+              (string-append
+               "Make sure you have the right libraries installed on your system and reachable by racket\n"
+               "\n"
+               "You need following libraries:\n"
+               "\n"
+               "- xiph libao (https://xiph.org).\n"
+               "- xiph libFLAC (https://xiph.org).\n"
+               "- ffmpeg of the right version (https://ffmpeg.org).\n"
+               "- libmpg123 (https://mpg123.org).\n"
+               "\n")
+              ))
+            )
+      (displayln
+       (string-append "NB. currently supported major versions for the ffmpeg libraries are:\n"
+                      "\n"
+                      (version-str 'avcodec)
+                      (version-str 'avutil)
+                      (version-str 'swresample)
+                      (version-str 'avformat)
+                      "\n"
+                      ))
+      )
+    )
 
   (define (build-lib-path p)
     (if (eq? (system-type 'os) 'macosx)
@@ -90,7 +162,7 @@
     (let ((libs-path (build-lib-path (get-lib-search-dirs))))
       (if (null? libs-to-try)
           (begin
-            (displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs libs-path))
+            (lib-not-found-message orig-libs libs-path)
             #f)
           (ffi-lib (car libs-to-try) versions
                    #:get-lib-dirs (λ () libs-path)
@@ -106,6 +178,11 @@
   (define (get-lib libs-to-try versions)
     (get-lib* libs-to-try libs-to-try versions))
 
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; integer->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