<commit_before>#lang racket/base

#|
   Copyright 2016-2018 <NAME>

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
|#

;; This module provides helper functions for accessing
;; I/O devices Video can make use of.

(provide (all-defined-out))
(require racket/match
         racket/set
         racket/logging
         "render-settings.rkt"
         "ffmpeg/main.rkt"
         "ffmpeg-pipeline.rkt"
         "init.rkt")

(struct input-devices (video
                       screen-capture
                       audio)
  #:transparent)
(define (mk-input-devices #:video [v '()]
                          #:screen-capture [sc '()]
                          #:audio [a '()])
  (input-devices v sc a))

(define (list-input-devices [dev #f])
  (define os-dev
    (or dev
        (match (system-type 'os)
          ['macosx "avfoundation"]
          ['unix #f]
          ['windows "dshow"])))
  (define log-filter
    (match (system-type 'os)
      ['macosx "AVFoundation input device"]
      ['unix #f]
      ['windows "dshow"]))
  (match (system-type 'os)
    ['unix
     (define vid-fmt (av-find-input-format "v4l2"))
     (define vid-ctx (avformat-alloc-context))
     (define video-found?
       (with-handlers ([exn:fail? (λ (e) #f)]
                       [exn:ffmpeg:fail? (λ (e) #f)])
         (avformat-open-input vid-ctx "" vid-fmt #f)
         #t))
     (define aud-fmt (av-find-input-format "alsa"))
     (define aud-ctx (avformat-alloc-context))
     (define audio-found?
       (with-handlers ([exn:fail? (λ (e) #f)])
         (avformat-open-input aud-ctx "" aud-fmt #f)
         #t))
     (mk-input-devices #:video (if video-found? (list-devices/avdevice vid-ctx) '())
                       #:audio (if audio-found? (list-devices/avdevice aud-ctx) '()))]
    [(or 'windows 'macosx)
     (define video-devices-str
       (match (system-type 'os)
         ['macosx "AVFoundation video devices:"]
         ['windows "DirectShow video devices"]))
     (define audio-devices-str
       (match (system-type 'os)
         ['macosx "AVFoundation audio devices:"]
         ['windows "DirectShow audio devices"]))
     (define dev-regexp
       (match (system-type 'os)
         ['macosx #rx"\\[[0-9]*\\] (.*)"]
         ['windows #rx" \"(.*)\""]))

     (define curr-list (box #f))
     (define video-list (box '()))
     (define audio-list (box '()))
  
     (flush-ffmpeg-log!)
     (with-intercepted-logging
         (λ (l)
           (match l
             [(vector level message data topic)
              (match message
                [(regexp video-devices-str)
                 (set-box! curr-list video-list)]
                [(regexp audio-devices-str)
                 (set-box! curr-list audio-list)]
                [_
                 (define dev-name (cadr (regexp-match dev-regexp message)))
                 (set-box! (unbox curr-list)
                           (cons dev-name (unbox (unbox curr-list))))])]))
       (λ ()
         (define fmt (av-find-input-format os-dev))
         (define ctx (avformat-alloc-context))
         (with-handlers* ([exn:ffmpeg:fail?
                           (λ (e)
                             (unless (eq? (hash-ref (exn:ffmpeg:fail-env e) #f) AVERROR-EXIT)
                               (raise e)))])
           (avformat-open-input ctx "" fmt (build-av-dict (hash "list_devices" "true"))))
         (flush-ffmpeg-log!))
       #:logger ffmpeg-logger
       'info
       (string->symbol log-filter))
     (mk-input-devices #:video (reverse (unbox video-list))
                       #:audio (reverse (unbox audio-list)))]
    [_
     (error "Not yet implemented for this platform")]))

;; Create a strean bundle out of an input device
;; nonnegative-integer nonnegative-integer render-settings -> stream-bundle
(define (devices->stream-bundle video-dev audio-dev
                                settings)
  (match settings
    [(struct* render-settings ([width width]
                               [height height]
                               [fps fps]
                               [pix-fmt pix-fmt]
                               [probesize probesize]))<commit_msg>Produce a log message on expected 'error' in list-devices.<commit_after>#lang racket/base

#|
   Copyright 2016-2018 <NAME>

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
|#

;; This module provides helper functions for accessing
;; I/O devices Video can make use of.

(provide (all-defined-out))
(require racket/match
         racket/set
         racket/logging
         "render-settings.rkt"
         "ffmpeg/main.rkt"
         "ffmpeg-pipeline.rkt"
         "init.rkt"
         "log.rkt")

(struct input-devices (video
                       screen-capture
                       audio)
  #:transparent)
(define (mk-input-devices #:video [v '()]
                          #:screen-capture [sc '()]
                          #:audio [a '()])
  (input-devices v sc a))

(define (list-input-devices [dev #f])
  (define os-dev
    (or dev
        (match (system-type 'os)
          ['macosx "avfoundation"]
          ['unix #f]
          ['windows "dshow"])))
  (define log-filter
    (match (system-type 'os)
      ['macosx "AVFoundation input device"]
      ['unix #f]
      ['windows "dshow"]))
  (match (system-type 'os)
    ['unix
     (define vid-fmt (av-find-input-format "v4l2"))
     (define vid-ctx (avformat-alloc-context))
     (define video-found?
       (with-handlers ([exn:fail? (λ (e) #f)]
                       [exn:ffmpeg:fail? (λ (e) #f)])
         (avformat-open-input vid-ctx "" vid-fmt #f)
         #t))
     (define aud-fmt (av-find-input-format "alsa"))
     (define aud-ctx (avformat-alloc-context))
     (define audio-found?
       (with-handlers ([exn:fail? (λ (e) #f)])
         (avformat-open-input aud-ctx "" aud-fmt #f)
         #t))
     (mk-input-devices #:video (if video-found? (list-devices/avdevice vid-ctx) '())
                       #:audio (if audio-found? (list-devices/avdevice aud-ctx) '()))]
    [(or 'windows 'macosx)
     (define video-devices-str
       (match (system-type 'os)
         ['macosx "AVFoundation video devices:"]
         ['windows "DirectShow video devices"]))
     (define audio-devices-str
       (match (system-type 'os)
         ['macosx "AVFoundation audio devices:"]
         ['windows "DirectShow audio devices"]))
     (define dev-regexp
       (match (system-type 'os)
         ['macosx #rx"\\[[0-9]*\\] (.*)"]
         ['windows #rx" \"(.*)\""]))

     (define curr-list (box #f))
     (define video-list (box '()))
     (define audio-list (box '()))
  
     (flush-ffmpeg-log!)
     (with-intercepted-logging
         (λ (l)
           (match l
             [(vector level message data topic)
              (match message
                [(regexp video-devices-str)
                 (set-box! curr-list video-list)]
                [(regexp audio-devices-str)
                 (set-box! curr-list audio-list)]
                [_
                 (define dev-name (cadr (regexp-match dev-regexp message)))
                 (set-box! (unbox curr-list)
                           (cons dev-name (unbox (unbox curr-list))))])]))
       (λ ()
         (define fmt (av-find-input-format os-dev))
         (define ctx (avformat-alloc-context))
         (with-handlers* ([exn:ffmpeg:fail?
                           (λ (e)
                             (log-video-info "Recieved (probably) expected error ~a" e))])
           (avformat-open-input ctx "" fmt (build-av-dict (hash "list_devices" "true"))))
         (flush-ffmpeg-log!))
       #:logger ffmpeg-logger
       'info
       (string->symbol log-filter))
     (mk-input-devices #:video (reverse (unbox video-list))
                       #:audio (reverse (unbox audio-list)))]
    [_
     (error "Not yet implemented for this platform")]))

;; Create a strean bundle out of an input device
;; nonnegative-integer nonnegative-integer render-settings -> stream-bundle
(define (devices->stream-bundle video-dev audio-dev
                                settings)
  (match settings
    [(struct* render-settings ([width width]
                               [height height]
                               [fps fps]
                               [pix-fmt pix-fmt]
                               [probesize probesize]))
{'fraction_non_alphanumeric': 0.13597153331895623, 'fraction_numerical': 0.003450506793185249, 'mean_word_length': 1.853846153846154, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1430344', 'n_tokens_mistral': 2819, 'n_tokens_neox': 2744, 'n_words': 764}