├── video ├── tests │ ├── green.vid │ ├── devices.rkt │ ├── test-utils.rkt │ ├── player.rkt │ ├── video.rkt │ ├── render.rkt │ ├── ffmpeg.rkt │ └── editor.rkt ├── examples │ ├── 3-clips.rkt │ ├── 1-hellocolor.rkt │ ├── 11-include.rkt │ ├── circ.png │ ├── vid.mp4 │ ├── vid.wav │ ├── 8-image.rkt │ ├── 4-filters.rkt │ ├── 12-cut.rkt │ ├── NOTES │ ├── 7-watermark.rkt │ ├── 2-colorfade.rkt │ ├── 6-multitrack.rkt │ ├── 5-project.rkt │ ├── 9-doubletransition.rkt │ └── 10-properties.rkt ├── scribblings │ ├── sample.png │ ├── graphical.scrbl │ ├── viddoclang.rkt │ ├── templates.rkt │ ├── video.scrbl │ ├── installing.scrbl │ ├── utils.rkt │ ├── player.scrbl │ ├── render.scrbl │ ├── extend.scrbl │ └── core.scrbl ├── private │ ├── log.rkt │ ├── utils.rkt │ ├── units.rkt │ ├── silence.rkt │ ├── ffmpeg │ │ ├── main.rkt │ │ ├── libvid.rkt │ │ └── lib.rkt │ ├── debug-mixin.rkt │ ├── tool.rkt │ ├── installer.rkt │ ├── camera-icon.rkt │ ├── lang.rkt │ ├── render-settings.rkt │ ├── init.rkt │ ├── opengl.rkt │ ├── devices.rkt │ └── surface.rkt ├── init.rkt ├── lib │ └── lang │ │ └── reader.rkt ├── units.rkt ├── lang │ └── reader.rkt ├── info.rkt ├── core.rkt ├── lib.rkt ├── devices.rkt ├── version.rkt ├── main.rkt ├── convert.rkt ├── surface.rkt └── raco.rkt ├── .gitignore ├── appveyor.yml ├── .travis-scripts └── setup-linux.sh ├── CONTRIBUTING.md ├── info.rkt ├── .travis.yml ├── README.md ├── CODE_OF_CONDUCT.md ├── LOG └── LICENSE /video/tests/green.vid: -------------------------------------------------------------------------------- 1 | #lang video 2 | (color "green") -------------------------------------------------------------------------------- /video/examples/3-clips.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (clip "vid.mp4") 4 | -------------------------------------------------------------------------------- /video/examples/1-hellocolor.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (color "green") 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | \#* 3 | .\#* 4 | .DS_Store 5 | compiled/ 6 | doc/ 7 | *.bak 8 | -------------------------------------------------------------------------------- /video/examples/11-include.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (external-video "2-colorfade.rkt") 4 | -------------------------------------------------------------------------------- /video/examples/circ.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/videolang/video/HEAD/video/examples/circ.png -------------------------------------------------------------------------------- /video/examples/vid.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/videolang/video/HEAD/video/examples/vid.mp4 -------------------------------------------------------------------------------- /video/examples/vid.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/videolang/video/HEAD/video/examples/vid.wav -------------------------------------------------------------------------------- /video/examples/8-image.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (clip "circ.png" #:properties (hash "length" 200)) 4 | -------------------------------------------------------------------------------- /video/examples/4-filters.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (attach-filter (clip "vid.mp4") (grayscale-filter)) 4 | -------------------------------------------------------------------------------- /video/scribblings/sample.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/videolang/video/HEAD/video/scribblings/sample.png -------------------------------------------------------------------------------- /video/examples/12-cut.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (define v (clip "vid.mp4")) 4 | (cut-producer v #:start 50) 5 | -------------------------------------------------------------------------------- /video/examples/NOTES: -------------------------------------------------------------------------------- 1 | vid.mp4 file from: http://techslides.com/sample-webm-ogg-and-mp4-video-files-for-html5 2 | -------------------------------------------------------------------------------- /video/examples/7-watermark.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (multitrack 4 | (clip "vid.mp4") 5 | (composite-merge 0.1 0.1 0.3 0.3) 6 | (color "red")) 7 | -------------------------------------------------------------------------------- /video/examples/2-colorfade.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (color "green" #:properties (hash "length" 75)) 4 | (fade-transition 25) 5 | (color "blue" #:properties (hash "length" 75)) 6 | -------------------------------------------------------------------------------- /video/examples/6-multitrack.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (multitrack 4 | (clip "vid.mp4" #:properties (hash "start" 50 "end" 200)) 5 | (playlist 6 | (blank 40) 7 | (color "red"))) 8 | -------------------------------------------------------------------------------- /video/examples/5-project.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (color "red" #:properties (hash "length" 75)) 4 | (fade-transition 25) 5 | (clip "vid.mp4" #:properties (hash "start" 50 "end" 100)) 6 | (fade-transition 25) 7 | (color "blue" #:properties (hash "length" 75)) 8 | -------------------------------------------------------------------------------- /video/examples/9-doubletransition.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (multitrack 4 | blocks 5 | (composite-merge 0.1 0.1 0.3 0.3) 6 | circ 7 | (composite-merge 0.6 0.6 0.2 0.2) 8 | red) 9 | 10 | (define blocks (clip "vid.mp4" #:properties (hash "start" 50 "end" 200))) 11 | (define circ (clip "circ.png" #:properties (hash "length" 200))) 12 | (define red (color "red")) 13 | -------------------------------------------------------------------------------- /video/examples/10-properties.rkt: -------------------------------------------------------------------------------- 1 | #lang video 2 | 3 | (clip "vid.mp4" 4 | #:properties (hash "start" 50 5 | "end" (if (equal? (get-property v-clip "vid-key") "block") 6 | 200 7 | 51))) 8 | 9 | (define v-clip 10 | (clip "vid.mp4" 11 | #:properties (hash "vid-key" "block"))) 12 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | version: 1.0.{build} 2 | platform: x64 3 | environment: 4 | PATH: C:\Program Files\Racket;%PATH% 5 | build_script: 6 | - ps: >- 7 | Invoke-WebRequest https://github.com/pauldalewilliams/chocolatey-comm-pkgs/raw/6417a13eaf08f5b1da64589b443da1b752818ab6/racket/racket.7.0.nupkg -OutFile racket.7.0.nupkg 8 | 9 | Invoke-WebRequest https://raw.githubusercontent.com/pauldalewilliams/chocolatey-comm-pkgs/6417a13eaf08f5b1da64589b443da1b752818ab6/racket/racket.nuspec -OutFile racket.nuspec 10 | 11 | choco install C:\projects\video\racket.7.0.nupkg 12 | 13 | raco pkg install --deps search-auto -n video 14 | test_script: 15 | - ps: '# raco test -p video' 16 | -------------------------------------------------------------------------------- /video/private/log.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (all-defined-out)) 20 | 21 | ;; Logging messages can be sent here. 22 | (define-logger video) 23 | -------------------------------------------------------------------------------- /video/init.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; Library to initialize the MLT framework. 20 | ;; Alternatively your program can just call `mlt-factory-init` on its own. 21 | 22 | (require "private/init.rkt") 23 | -------------------------------------------------------------------------------- /.travis-scripts/setup-linux.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # Install ffmpeg 3 | sudo add-apt-repository -y ppa:jonathonf/ffmpeg-3 4 | sudo add-apt-repository -y ppa:jonathonf/tesseract 5 | sudo apt-get -qq update 6 | sudo apt-get install libasound2-dev alsa-utils alsa-oss 7 | sudo modprobe snd-dummy 8 | sudo apt-get install -y ffmpeg 9 | sudo apt-get install -y libav-tools 10 | sudo apt-get install -y libavcodec-dev 11 | sudo apt-get install -y libavcodec-extra 12 | sudo apt-get install -y libavformat-dev 13 | sudo apt-get install -y libavutil-dev 14 | sudo apt-get install -y libswscale-dev 15 | sudo apt-get install -y ladspa-sdk 16 | sudo apt-get install -y libgdk-pixbuf2.0-* 17 | sudo apt-get install -y frei0r-plugins* 18 | sudo apt-get install libdc1394-* 19 | sudo apt-get install libportaudio2 20 | # Turn off the irrelevant libdc1394 warning and ALSA warnings 21 | sudo ln /dev/null /dev/raw1394 22 | export AUDIODEV=null 23 | -------------------------------------------------------------------------------- /video/private/utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; Just a utils file to define some functions that really probably 20 | ;; _should_ be baked into Racket but aren't. 21 | (provide (all-defined-out)) 22 | (require racket/contract/base 23 | racket/runtime-path) 24 | 25 | (define-runtime-path video-dir "..") 26 | -------------------------------------------------------------------------------- /video/scribblings/graphical.scrbl: -------------------------------------------------------------------------------- 1 | #lang reader video/scribblings/viddoclang 2 | 3 | @;{ 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | 20 | @title{Graphical Non-Linear Video Editors} 21 | 22 | The graphical NLVE is very experimental and will likely 23 | break with newer versions of the library. 24 | 25 | You can test drive it by going to 26 | @menuitem["Insert" "Insert Video Editor"] 27 | -------------------------------------------------------------------------------- /video/private/units.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (all-defined-out)) 20 | (require racket/generic 21 | (prefix-in base: racket/base)) 22 | 23 | (define-generics unit-coerce 24 | [unit->number unit-coerce]) 25 | 26 | (struct pixels (val) 27 | #:transparent) 28 | (struct seconds (val) 29 | #:transparent) 30 | (struct dB (val) 31 | #:transparent) 32 | -------------------------------------------------------------------------------- /video/tests/devices.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require rackunit 20 | "test-utils.rkt" 21 | (prefix-in d: "../private/devices.rkt") 22 | "../devices.rkt") 23 | 24 | (check-true (input-devices? (d:mk-input-devices))) 25 | 26 | (let () 27 | (define devices (list-input-devices)) 28 | (check-true (input-devices? devices)) 29 | (cameras devices) 30 | (video-devices devices) 31 | (audio-devices devices) 32 | (void)) 33 | -------------------------------------------------------------------------------- /video/private/silence.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen, Benjamin Chung 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | 20 | (require racket/list) 21 | 22 | (define (parse-silence-detect str) 23 | (define outp 24 | (regexp-match #px"(silence_start: ([\\d\\.]*))|(silence_end: ([\\d\\.]*) \\| silence_duration: ([\\d\\.]*))" str)) 25 | (if outp 26 | (map (lambda str 27 | (let ([strb (list-ref str 0)]) 28 | (if strb (string->number strb) #f))) 29 | (list (third outp) (fifth outp) (sixth outp))) 30 | #f)) 31 | -------------------------------------------------------------------------------- /video/lib/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | video/lib 3 | 4 | #| 5 | Copyright 2016-2017 Leif Andersen 6 | 7 | Licensed under the Apache License, Version 2.0 (the "License"); 8 | you may not use this file except in compliance with the License. 9 | You may obtain a copy of the License at 10 | 11 | http://www.apache.org/licenses/LICENSE-2.0 12 | 13 | Unless required by applicable law or agreed to in writing, software 14 | distributed under the License is distributed on an "AS IS" BASIS, 15 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | See the License for the specific language governing permissions and 17 | limitations under the License. 18 | |# 19 | 20 | #:read read 21 | #:read-syntax read-syntax 22 | #:wrapper1 (λ (x) (list* 'vidlib 'values '() (x))) 23 | #:info make-info 24 | 25 | (require scribble/reader) 26 | 27 | (define (make-info key default use-default) 28 | (case key 29 | [(drracket:toolbar-buttons) 30 | (define camera-button 31 | (dynamic-require 'video/private/camera-icon 'camera-button)) 32 | (list camera-button)] 33 | [else (use-default key default)])) 34 | -------------------------------------------------------------------------------- /video/scribblings/viddoclang.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | #:read scribble:read-inside 20 | #:read-syntax scribble:read-syntax-inside 21 | #:whole-body-readers? #t 22 | #:info (scribble-base-reader-info) 23 | #:language (build-path this-dir "templates.rkt") 24 | #:wrapper1 (lambda (t) (cons 'doc (t))) 25 | 26 | (require (prefix-in scribble: scribble/reader) 27 | (only-in scribble/base/reader scribble-base-reader-info) 28 | (only-in racket/runtime-path define-runtime-path) 29 | (for-syntax (only-in racket/base #%datum))) 30 | 31 | (define-runtime-path this-dir ".") 32 | -------------------------------------------------------------------------------- /video/units.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | 20 | ;; The Units library is still being designed. The idea is 21 | ;; to have Video do the dimentional analysis for you. 22 | ;; For example, add two minutes to 30 seconds should return 23 | ;; either 150 seconds or 2.5 (exact) minutes. 24 | 25 | (require racket/contract/base 26 | "private/units.rkt") 27 | (provide 28 | (contract-out [pixels? (-> any/c boolean?)] 29 | [seconds? (-> any/c boolean?)] 30 | [dB? (-> any/c boolean?)] 31 | [pixels (-> number? pixels?)] 32 | [seconds (-> number? seconds?)] 33 | [dB (-> number? dB?)])) 34 | -------------------------------------------------------------------------------- /video/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | video 3 | 4 | #| 5 | Copyright 2016-2017 Leif Andersen 6 | 7 | Licensed under the Apache License, Version 2.0 (the "License"); 8 | you may not use this file except in compliance with the License. 9 | You may obtain a copy of the License at 10 | 11 | http://www.apache.org/licenses/LICENSE-2.0 12 | 13 | Unless required by applicable law or agreed to in writing, software 14 | distributed under the License is distributed on an "AS IS" BASIS, 15 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | See the License for the specific language governing permissions and 17 | limitations under the License. 18 | |# 19 | 20 | #:read read 21 | #:read-syntax read-syntax 22 | #:wrapper1 (λ (x) (list* 'vid 'values '() (x))) 23 | #:info make-info 24 | 25 | (require scribble/reader 26 | syntax-color/scribble-lexer) 27 | 28 | (define (make-info key default use-default) 29 | (case key 30 | [(drracket:toolbar-buttons) 31 | (define camera-button 32 | (dynamic-require 'video/private/camera-icon 'camera-button)) 33 | (list camera-button)] 34 | [(color-lexer) scribble-lexer] 35 | [(drracket:default-filters) '(("Video Sources" "*.vid"))] 36 | [(drracket:default-extension) "vid"] 37 | [else (use-default key default)])) 38 | -------------------------------------------------------------------------------- /video/private/ffmpeg/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; This module combines all of the ffmpeg bindings for use by other modules 20 | ;; in the video package. 21 | ;; The bindings were split up for two reasons: 22 | ;; (A). Being in one module lead to an very large file 23 | ;; (B). Splitting it up makes it easier to require on part without needing 24 | ;; to require the rest of the bindings. 25 | 26 | (provide (all-defined-out) 27 | (all-from-out "ffmpeg.rkt") 28 | (all-from-out "lib.rkt") 29 | (all-from-out "constants.rkt") 30 | (all-from-out "data.rkt")) 31 | (require "ffmpeg.rkt" 32 | "lib.rkt" 33 | "constants.rkt" 34 | "data.rkt") 35 | -------------------------------------------------------------------------------- /video/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen, Stephen Chang 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (define collection "video") 20 | (define scribblings '(("scribblings/video.scrbl" (multi-page) (language)))) 21 | (define raco-commands '(("video" 22 | (submod video/raco main) 23 | "Preview or Render a Racket Video" 24 | #f))) 25 | 26 | (define drracket-tools '(("private/tool.rkt"))) 27 | (define drracket-tool-names '("Video")) 28 | (define drracket-tool-icons '(#f)) 29 | 30 | (define test-omit-paths 31 | ;; We do not use most of the 'datatype' fields directly, 32 | ;; so don't count them in the line count. 33 | ;; This file WILL be run by inclusion with other modules. 34 | '("private/ffmpeg/data.rkt" 35 | "private/ffmpeg/lib.rkt")) 36 | -------------------------------------------------------------------------------- /video/core.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require racket/contract/base 20 | racket/class 21 | racket/dict 22 | "render.rkt" 23 | "private/video.rkt") 24 | 25 | (provide 26 | (contract-out 27 | [convert (->* [any/c] 28 | [#:renderer (or/c (is-a?/c render%))] 29 | any/c)]) 30 | copy-video 31 | make-video 32 | video? 33 | make-chapter 34 | chapter? 35 | make-properties 36 | properties? 37 | make-service 38 | service? 39 | make-filter 40 | filter? 41 | make-transition 42 | transition? 43 | make-producer 44 | producer? 45 | make-input-device 46 | input-device? 47 | make-blank 48 | blank? 49 | make-playlist 50 | playlist? 51 | make-multitrack 52 | multitrack? 53 | make-field-element 54 | field-element? 55 | make-video-subgraph 56 | video-subgraph?) 57 | -------------------------------------------------------------------------------- /video/private/debug-mixin.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | 20 | ;; This module contains a debug mixin for the video/render class so that it can 21 | ;; use the render/cmdline-ffmpeg proc. 22 | ;; WARNING!!!: Like render/cmdline-ffmpeg, this mixin must not be used outside of 23 | ;; debuging Video itself. 24 | 25 | (provide (all-defined-out)) 26 | (require racket/class 27 | racket/contract/base 28 | graph 29 | (prefix-in ffmpeg: "ffmpeg-pipeline.rkt") 30 | (prefix-in base: racket/base) 31 | "../render.rkt" 32 | (submod "../render.rkt" render-fields)) 33 | 34 | (define (cmdline-mixin %) 35 | (class* % (render<%>) 36 | (super-new) 37 | (inherit-field render-graph) 38 | (define/override (feed-buffers) (void)) 39 | (define/override (write-output) 40 | (ffmpeg:render/cmdline-ffmpeg render-graph)))) 41 | -------------------------------------------------------------------------------- /video/lib.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (except-out (all-from-out racket/base) #%module-begin) 20 | (rename-out [~module-begin #%module-begin]) 21 | λ/video 22 | define/video 23 | define* 24 | define*-values 25 | (all-from-out "base.rkt")) 26 | 27 | (require "base.rkt" 28 | "private/lang.rkt" 29 | (for-syntax racket/base 30 | racket/syntax 31 | syntax/parse)) 32 | 33 | (define-syntax (~module-begin stx) 34 | (syntax-parse stx 35 | [(_ id:id post-process exprs . body) 36 | #:with name (datum->syntax stx (syntax-property stx 'enclosing-module-name) stx) 37 | #'(#%module-begin 38 | (current-video-directory 39 | (let ([p (variable-reference->module-source (#%variable-reference))]) 40 | (if (path? p) 41 | (path-only p) 42 | (current-directory)))) 43 | (provide (rename-out [name id])) 44 | (video-begin "λ/video" post-process exprs . body))])) 45 | -------------------------------------------------------------------------------- /video/devices.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; This is the high level API for users to access the devices on their 20 | ;; machine. 21 | ;; XXX This library is only partialy implemented! 22 | 23 | (require racket/contract/base 24 | "private/devices.rkt") 25 | 26 | (provide 27 | (contract-out 28 | [input-devices? (-> any/c boolean?)] 29 | [list-input-devices (-> input-devices?)] 30 | [screen-captures (-> input-devices? (listof string?))] 31 | [cameras (-> input-devices? (listof string?))] 32 | [video-devices (-> input-devices? (listof string?))] 33 | [audio-devices (-> input-devices? (listof string?))])) 34 | 35 | (define screen-capture-regexp #"Capture screen.*") 36 | 37 | (define (screen-captures dev) 38 | (filter (λ (x) (regexp-match screen-capture-regexp x)) 39 | (video-devices dev))) 40 | 41 | (define (cameras dev) 42 | (filter (λ (x) (not (regexp-match screen-capture-regexp x))) 43 | (video-devices dev))) 44 | 45 | (define (video-devices dev) 46 | (input-devices-video dev)) 47 | 48 | (define (audio-devices dev) 49 | (input-devices-audio dev)) 50 | -------------------------------------------------------------------------------- /video/version.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require racket/contract/base) 20 | (provide (contract-out [version (-> string?)])) 21 | 22 | (define current-version 23 | (mk-version #:major "0" 24 | #:minor "2" 25 | #:patch "3" 26 | #:pre-release #f)) 27 | 28 | (define (version) 29 | (version->string current-version)) 30 | 31 | (module version-infra racket/base 32 | (provide (all-defined-out)) 33 | (struct version (major 34 | minor 35 | patch 36 | pre-release)) 37 | (define (mk-version #:major [major #f] 38 | #:minor [minor #f] 39 | #:patch [patch #f] 40 | #:pre-release [pre-release #f]) 41 | (version major minor patch pre-release)) 42 | (define (version->string v) 43 | (define major (or (version-major v) "0")) 44 | (define minor (or (version-minor v) "0")) 45 | (define patch (or (version-patch v) "0")) 46 | (define pre-release (version-pre-release v)) 47 | (if pre-release 48 | (format "~a.~a.~a-~a" major minor patch pre-release) 49 | (format "~a.~a.~a" major minor patch)))) 50 | (require 'version-infra) 51 | -------------------------------------------------------------------------------- /video/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (except-out (all-from-out racket/base) #%module-begin) 20 | (rename-out [~module-begin #%module-begin]) 21 | λ/video 22 | define/video 23 | define* 24 | define*-values 25 | (all-from-out "base.rkt")) 26 | 27 | (require (prefix-in core: video/core) 28 | (only-in "private/video.rkt" current-video-directory) 29 | "private/lang.rkt" 30 | "base.rkt" 31 | racket/list 32 | racket/path 33 | (except-in pict clip frame blank) 34 | racket/draw 35 | racket/splicing 36 | (for-syntax racket/base 37 | racket/syntax 38 | syntax/parse 39 | syntax/parse/lib/function-header 40 | syntax/kerncase)) 41 | 42 | (define-syntax (~module-begin stx) 43 | (syntax-parse stx 44 | [(_ id:id post-process exprs . body) 45 | #'(#%module-begin 46 | (current-video-directory 47 | (let ([p (variable-reference->module-source (#%variable-reference))]) 48 | (if (path? p) 49 | (path-only p) 50 | (current-directory)))) 51 | (video-begin id post-process exprs . body))])) 52 | -------------------------------------------------------------------------------- /video/private/tool.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/unit 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require drracket/tool 20 | framework 21 | racket/class 22 | racket/gui/base 23 | racket/draw 24 | ffi/unsafe 25 | "ffmpeg/lib.rkt") 26 | 27 | (import drracket:tool^) 28 | (export drracket:tool-exports^) 29 | 30 | (define video-frame-mixin 31 | (mixin (drracket:unit:frame<%>) () 32 | (super-new) 33 | (inherit get-insert-menu 34 | get-editor 35 | get-button-panel 36 | register-toolbar-button) 37 | (new menu-item% 38 | [parent (get-insert-menu)] 39 | [label "Insert Video Editor"] 40 | [callback 41 | (λ (i e) 42 | (define editor (get-editor)) 43 | (define video (new (dynamic-require 'video/private/editor 'video-editor%))) 44 | (send editor insert 45 | (new (dynamic-require 'video/private/editor 'video-snip%) 46 | [editor video])))]))) 47 | 48 | (define (phase1) (void)) 49 | (define (phase2) (void)) 50 | 51 | ;; Only activate the tool when ffmpeg is installed. 52 | ;; Otherwise DrRacket will complain on startup. 53 | ;; (Only applies to linux instilations.) 54 | (when (and (ffmpeg-installed?) (ffmpeg-min-version?)) 55 | (drracket:get/extend:extend-unit-frame video-frame-mixin) 56 | (send (get-the-snip-class-list) add (dynamic-require 'video/private/editor 'video-snip-class))) 57 | -------------------------------------------------------------------------------- /video/scribblings/templates.rkt: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @;{ 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | @(require reprovide/reprovide) 20 | @(reprovide (except-in scribble/manual/lang 21 | inset-flow 22 | image) 23 | (except-in scribble/manual inset-flow) 24 | (except-in scribble/core table) 25 | (except-in pict 26 | colorize 27 | clip 28 | blank) 29 | scribble/example 30 | racket/sandbox 31 | video/base 32 | (prefix-in video: video/version) 33 | video/surface 34 | video/private/utils 35 | racket/sandbox 36 | racket/list 37 | racket/math 38 | "utils.rkt" 39 | (for-label video 40 | video/base 41 | (except-in racket/base filter #%module-begin) 42 | racket/contract/base 43 | racket/set 44 | racket/hash 45 | (except-in racket/class field) 46 | racket/gui/base 47 | racket/draw 48 | video/base 49 | (except-in video/core field-element?) 50 | video/render 51 | video/player 52 | video/init)) 53 | @(provide (all-defined-out)) 54 | 55 | @(define video-evaluator 56 | (make-base-eval 57 | '(require video/base))) 58 | -------------------------------------------------------------------------------- /video/tests/test-utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen, Stephen Chang 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require rackunit 20 | racket/file 21 | racket/class 22 | (prefix-in pict: pict) 23 | "../base.rkt" 24 | (except-in "../core.rkt" field-element?) 25 | "../private/utils.rkt") 26 | (require (for-syntax racket/base 27 | syntax/parse 28 | "../private/utils.rkt")) 29 | (provide check-producer check-transition check-filter) 30 | 31 | (define-syntax (check-producer stx) 32 | (syntax-parse stx 33 | [(_ p (~or (~optional (~seq #:len len)))) 34 | (quasisyntax/loc stx 35 | (begin 36 | #,(syntax/loc stx (check-pred producer? p)) 37 | #,@(cond 38 | [(not (attribute len)) (list)] 39 | [else 40 | (list (syntax/loc stx (check-equal? (get-property p "length") len)))])))])) 41 | 42 | (define-syntax (check-transition stx) 43 | (syntax-parse stx 44 | [(_ p) (syntax/loc stx (check-pred transition? p))])) 45 | 46 | (define-syntax (check-filter stx) 47 | (syntax-parse stx 48 | [(_ p) (syntax/loc stx (check-pred filter? p))])) 49 | 50 | ;; Convert a sequence of picts to a video, with each picture taking 51 | ;; 1 second of time. Returns the resulting video structure, this 52 | ;; structure points to picts backed by temporary files. 53 | ;; (Sequence-of Pict) -> Path 54 | (define (picts->video picts) 55 | (for/playlist ([p picts]) 56 | (define out-file (make-temporary-file "~a.png")) 57 | (send (pict:pict->bitmap p) save-file out-file 'png) 58 | (clip out-file #:properties (hash "length" 1)))) 59 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | Video is still in early stages of development. The basic API is set, although a 2 | lot of the details are subject to change. Once Video reaches v1.0, this API 3 | will be fixed. 4 | 5 | Currently, the `master` git branch is used for development. However, it is 6 | important to try to keep it relatively stable. For example, try not to push 7 | code that breaks the tests. 8 | 9 | Releases get there own branches/tags, which match their release name (v0.0, 10 | v0.1, etc.). These branches should remain stable. Additionally, tags should be 11 | fixed. So if a patch needs to be applied to one of these branches, it is 12 | important to increment the version number (v0.1.1, v0.1.2, etc). Finally, make 13 | sure to update the LOG file whenever a new release is made. 14 | 15 | New releases happen when a major change happens to the language. Currently this 16 | happens 2-3 times a year. 17 | 18 | Pre-Releases get their type following the version number with a dash. 19 | Subsequent versions of the same type get a version number attached to the end. 20 | For example, the following versions indicate pre-release versions: v0.2-alpha, 21 | v0.2-beta.3, v0.2-rc.3, etc. 22 | 23 | Once the project becomes more stable, we will create a more structured 24 | contributing guide. For the moment, however, feel free to open PRs and push 25 | directly to the master branch. 26 | 27 | However, please make sure that you do NOT push broken builds to the `master` 28 | branch. Additionally, and changes that break backwards compatibility MUST be 29 | noted in the `LOG` file. It would also be nice if your changes keep a linear 30 | history, but this is not strictly necessary. 31 | 32 | Any code in the `video/private` folder is not part of the public API, and can 33 | change at any time without notice. Code in `video/tests` are no implementation 34 | code should go there. Documentation for your contributions belongs in 35 | `video/scribblings/`. The identifiers exported by the remaining paths are 36 | either public or protected. If they are documented they are public, and can 37 | only be changed between MAJOR releases. Protected identifiers are not 38 | documented, but still exported by a module (or submodule) outside of these 39 | designated directories. These can change, but should be noted in LOG. 40 | 41 | Some experimental code is allowed in this repo. 42 | However, if it is still extremely experimental please put it in the 43 | http://github.com/videolang/render-prototype git repo. 44 | -------------------------------------------------------------------------------- /video/scribblings/video.scrbl: -------------------------------------------------------------------------------- 1 | #lang reader video/scribblings/viddoclang 2 | 3 | @;{ 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | @title{The Video Language Guide (v@video:version{})} 20 | @author{Leif Andersen} 21 | 22 | @(defmodulelang video) 23 | 24 | @(define (colorize #:color c . content) 25 | (elem #:style (style #f (list (color-property c))) 26 | content)) 27 | 28 | @margin-note{Video is still an experimental language. As of 29 | v0.2, the underlying library and surface syntax are stable. 30 | New functions may be removed or added, but these changes 31 | will be documented, and be marked as deprecated before 32 | removal. The graphical development environment extension is 33 | still under active development and is subject to change.} 34 | 35 | Video Language (or VidLang, sometimes referred to as just Video) 36 | is a DSL for editing...videos. It aims to merge the 37 | capabilities of a traditional graphical non-linear video 38 | editor (NLVE), with the power of a programming language. The 39 | current interface is similar to that of HTML, LaTeX, or 40 | Scribble. VidLang comes with a prototype graphical NLVE for 41 | DrRacket. This extensions is still experimental and highly 42 | unstable. The next version of Video will focus on this 43 | extension and make the tool significantly cleaner and stable. 44 | 45 | In case you found these docs from the Racket website, the 46 | Video website can be found at @url{http://lang.video}. It includes 47 | the Video blog, community projects, tutorials, etc. 48 | 49 | @table-of-contents[] 50 | 51 | @include-section{installing.scrbl} 52 | @include-section{intro.scrbl} 53 | @include-section{api.scrbl} 54 | @include-section{player.scrbl} 55 | @include-section{render.scrbl} 56 | @include-section{graphical.scrbl} 57 | @include-section{core.scrbl} 58 | @include-section{extend.scrbl} 59 | 60 | @index-section[] 61 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | #| 4 | Copyright 2016-2019 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (define collection 'multi) 20 | 21 | (define deps '(("base" "7.0") 22 | "rackunit-lib" 23 | "gui-lib" 24 | "draw-lib" 25 | "images-lib" 26 | "drracket-plugin-lib" 27 | "data-lib" 28 | "pict-lib" 29 | "wxme-lib" 30 | "sandbox-lib" 31 | "at-exp-lib" 32 | "scribble-lib" 33 | "bitsyntax" 34 | "opengl" 35 | "portaudio" 36 | "net-lib" 37 | "syntax-color-lib" 38 | "parser-tools-lib" 39 | ("graph" "0.3.1") 40 | ("libvid-x86_64-macosx" #:platform "x86_64-macosx") 41 | ("libvid-x86_64-win32" #:platform "win32\\x86_64") 42 | ("libvid-i386-win32" #:platform "win32\\i386") 43 | ("libvid-x86_64-linux" #:platform "x86_64-linux") 44 | ("libvid-i386-linux" #:platform "i386-linux") 45 | ("ffmpeg-x86_64-macosx-3-4" #:platform "x86_64-macosx") 46 | ("ffmpeg-x86_64-win32-3-4" #:platform "win32\\x86_64") 47 | ("ffmpeg-i386-win32-3-4" #:platform "win32\\i386"))) 48 | (define build-deps '("scribble-lib" 49 | "racket-doc" 50 | "gui-doc" 51 | "draw-doc" 52 | "ppict" 53 | "reprovide-lang")) 54 | (define test-deps '("cover" 55 | "doc-cover")) 56 | 57 | ;; video/version has the actual version. This one might get out of date 58 | ;; durring pre-releases. 59 | (define version "0.2.3") 60 | (define pkg-authors '(leif)) 61 | (define pkg-desc "Video Language") 62 | 63 | (define install-collection "private/install.rkt") 64 | -------------------------------------------------------------------------------- /video/private/ffmpeg/libvid.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2019 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (all-defined-out)) 20 | (require ffi/unsafe 21 | ffi/unsafe/define 22 | ffi/unsafe/define/conventions 23 | "../log.rkt" 24 | "constants.rkt" 25 | "data.rkt" 26 | "lib.rkt") 27 | 28 | (define (libvid-not-installed) 29 | (log-video-warning "libvideo NOT installed, cannot capture ffmpeg log messages.") 30 | #f) 31 | 32 | (define (((error-libvid-not-installed name)) . rest) 33 | (error name "libvid not installed, cannot use this function")) 34 | 35 | (define libvid-lib 36 | (ffi-lib (string-append "libvid") "0" 37 | #:fail libvid-not-installed)) 38 | (define-ffi-definer define-libvid libvid-lib 39 | #:default-make-fail error-libvid-not-installed 40 | #:make-c-id convention:hyphen->underscore) 41 | 42 | (define racket-log-callback-box (box #f)) 43 | ;#:keep malloc-immobile-cell ??? 44 | (define-libvid set-racket-log-callback 45 | (_fun (_fun #:async-apply (λ (x) (x)) 46 | #:keep racket-log-callback-box 47 | #:atomic? #t 48 | _av-log-constant _string _string 49 | -> _void) -> _void)) 50 | (define-libvid ffmpeg-log-callback _fpointer) 51 | 52 | (define-libvid libvid-get-version-major (_fun -> _int)) 53 | (define-libvid libvid-get-version-minor (_fun -> _int)) 54 | (define-libvid libvid-get-version-patch (_fun -> _int)) 55 | (define-libvid libvid-get-version-prerelease (_fun -> _int)) 56 | 57 | ;; Determin if libvid is installed. 58 | ;; -> boolean? 59 | (define (libvid-installed?) 60 | libvid-lib) 61 | 62 | ;; Get the current version of libvid. 63 | ;; This should match the current version of video, but could be off by 64 | ;; the patch number. 65 | (define (libvid-version) 66 | (mk-version #:major (libvid-get-version-major) 67 | #:minor (libvid-get-version-minor) 68 | #:patch (libvid-get-version-patch))) 69 | -------------------------------------------------------------------------------- /video/tests/player.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require rackunit 20 | racket/gui/base 21 | "../player.rkt" 22 | "../base.rkt" 23 | "../private/video-canvas.rkt" 24 | "../private/utils.rkt" 25 | (prefix-in green: "green.vid")) 26 | 27 | (define vid-mp4 (build-path video-dir "examples/vid.mp4")) 28 | 29 | (let () 30 | (define f (new frame% [label "foo"])) 31 | (define c (new video-canvas% 32 | [width 640] 33 | [height 480] 34 | [parent f])) 35 | (send f show #t) 36 | (define p (new video-player-server% [video green:vid])) 37 | (send p set-canvas c) 38 | (send p play) 39 | (check-true (>= (send p get-video-length) 9999)) 40 | (send p stop) 41 | (check-true (send p is-stopped?)) 42 | (check-false (send p is-paused?)) 43 | ; (send p seek 10) 44 | ; (check-equal? (send p get-position) 10) 45 | (check-equal? (send p get-fps) 25) 46 | (send f show #f)) 47 | 48 | (let () 49 | (define p (new video-player% [video green:vid])) 50 | (send p show #t) 51 | (send p play) 52 | (send p stop) 53 | (send p show #f)) 54 | 55 | (let () 56 | (define p (preview green:vid)) 57 | (send p stop) 58 | (send p show #f)) 59 | 60 | (let p () 61 | (define p (preview green:vid)) 62 | (sleep 3) 63 | (send p stop) 64 | (send p show #f)) 65 | 66 | (let () 67 | (define p (new video-player% [video green:vid])) 68 | (send p show #t) 69 | (send p render-audio #f) 70 | (send p play) 71 | (sleep 1) 72 | (send p stop) 73 | (send p show #f)) 74 | 75 | (let () 76 | (define p (preview (clip vid-mp4))) 77 | (sleep 3) 78 | (send p stop) 79 | (send p show #f)) 80 | 81 | ;; Some stress tests 82 | (let () 83 | (define vid 84 | (multitrack (clip vid-mp4) 85 | (overlay-merge 50 50 100 100) 86 | (color "green"))) 87 | (define p (preview vid)) 88 | (send p stop) 89 | (for ([i (in-range 10)]) 90 | (send p play) 91 | (sleep 2) 92 | (send p stop) 93 | (sleep 0.5)) 94 | (send p show #f)) 95 | -------------------------------------------------------------------------------- /video/private/installer.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; This module runs on install of video. 20 | ;; It checks the version of ffmpeg installed and makes a warning 21 | ;; if the version is old. 22 | ;; Video tries to work with old versions of ffmpeg, but newer versions 23 | ;; will work better. 24 | ;; Finally, the Racket installation process does not offer an option to 25 | ;; refuse to install. So the installation will happen anyway. 26 | ;; This library also prints out the license of the ffmpeg build. 27 | 28 | (provide installer) 29 | 30 | (require "ffmpeg/lib.rkt" 31 | "log.rkt") 32 | 33 | (define (version-check libname version major minor) 34 | (unless (and (= (version-major version) major) 35 | (>= (version-minor version) minor)) 36 | (log-video-warning 37 | "FFmpeg ~a version is old (~a), consider updating to FFmpeg ~a" 38 | libname version ffmpeg-rec-version))) 39 | 40 | (define (check-license libname license) 41 | (log-video-info "License for ~a is: ~a" libname license)) 42 | 43 | (define (installer racket-collects-dir video-collect-dir user? no-modify?) 44 | (cond [(ffmpeg-installed?) 45 | (version-check "libavutil" (avutil-version) 55 58) 46 | (check-license "libavutil" (avutil-license)) 47 | (version-check "libavcodec" (avcodec-version) 57 89) 48 | (check-license "libavcodec" (avcodec-version)) 49 | (version-check "libavformat" (avformat-version) 57 71) 50 | (check-license "libavformat" (avformat-license)) 51 | (version-check "libavfilter" (avfilter-version) 6 82) 52 | (check-license "libavfilter" (avfilter-license)) 53 | (version-check "libswscale" (swscale-version) 4 6) 54 | (check-license "libswscale" (swscale-license)) 55 | (version-check "libswresample" (swresample-version) 2 7) 56 | (check-license "libswresample" (swresample-license)) 57 | (version-check "libavdevice" (avdevice-version) 57 6) 58 | (check-license "libavdevice" (avdevice-license))] 59 | [else 60 | (log-error 'video "FFmpeg NOT installed!")]) 61 | (void)) 62 | -------------------------------------------------------------------------------- /video/tests/video.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require rackunit 20 | (prefix-in file: file/convertible) 21 | "../private/video.rkt" 22 | "../private/render-settings.rkt" 23 | (prefix-in surf: "../base.rkt")) 24 | 25 | ;; Test syntax for the video object hiarachy. 26 | (let () 27 | (define-constructor new-video #f () ()) 28 | (define-constructor new-sub new-video ([hello #f]) ()) 29 | (define-constructor sub-sub new-sub ([world #f]) ()) 30 | (define ss (make-sub-sub)) 31 | (define ss2 32 | (make-sub-sub #:hello "HI" 33 | #:world "YOU")) 34 | (check-true (sub-sub? ss)) 35 | (check-false (new-sub-hello ss)) 36 | (check-false (sub-sub-world ss)) 37 | (check-true (sub-sub? ss2)) 38 | (check-equal? (new-sub-hello ss2) "HI") 39 | (check-equal? (sub-sub-world ss2) "YOU") 40 | (check-false (file:convert (make-new-video) 'mlt)) 41 | (define ss3 (copy-video ss)) 42 | (check-not-equal? ss3 ss) 43 | (check-not-equal? ss3 ss2)) 44 | 45 | ;; Test the basic constructors for video types. 46 | (let () 47 | (make-properties) 48 | (make-service) 49 | (make-filter) 50 | (make-transition) 51 | (make-producer) 52 | (make-blank) 53 | (make-playlist) 54 | (make-multitrack) 55 | (make-field-element) 56 | (make-chapter) 57 | (make-video-subgraph) 58 | (void)) 59 | 60 | ;; Check video properties 61 | (let () 62 | (define c (surf:color "blue" #:properties (hash "bluecolor" 42))) 63 | (define long-c (remove-property c "bluecolor")) 64 | (check-true (dict-has-key? c "bluecolor")) 65 | (check-false (dict-has-key? long-c "bluecolor")) 66 | (check-equal? (get-property c "bluecolor") 42) 67 | (check-equal? (get-property long-c "bluecolor" (λ () 1337)) 1337)) 68 | 69 | ;; Check printing 70 | (let () 71 | (define c (surf:color "blue")) 72 | (check-equal? 73 | (with-output-to-string 74 | (λ () 75 | (display c))) 76 | "#") 77 | ;; Yes, not a perfect match, but it should be good enough 78 | ;; for a simple test 79 | (check-regexp-match 80 | "#]*>" 81 | (with-output-to-string 82 | (λ () 83 | (parameterize ([current-detailed-printing? #t]) 84 | (display c)))))) 85 | 86 | -------------------------------------------------------------------------------- /video/private/camera-icon.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide camera-icon 20 | camera-button) 21 | (require racket/class 22 | racket/draw 23 | racket/path 24 | racket/gui/base 25 | images/icons/style 26 | mrlib/switchable-button 27 | racket/list 28 | "../base.rkt") 29 | 30 | (define height (toolbar-icon-height)) 31 | (define width (* height 2)) 32 | (define lens-dim 2/3) 33 | (define camera (make-object bitmap% width height #f #t)) 34 | 35 | (define dc (make-object bitmap-dc% camera)) 36 | (send dc set-pen 37 | (new pen% [width 0] [color (icon-color->outline-color run-icon-color)])) 38 | (send dc set-brush 39 | (new brush% [color run-icon-color])) 40 | 41 | (define path (new dc-path%)) 42 | (send path move-to 0 0) 43 | (send path line-to 0 height) 44 | (send path line-to (* width lens-dim) height) 45 | (send path line-to (* width lens-dim) (* height 3/4)) 46 | (send path line-to width (* height 9/10)) 47 | (send path line-to width (* height 1/10)) 48 | (send path line-to (* width lens-dim) (* height 1/4)) 49 | (send path line-to (* width lens-dim) 0) 50 | (send path line-to 0 0) 51 | (send dc draw-path path) 52 | 53 | (define camera-icon 54 | (bitmap-render-icon camera)) 55 | 56 | (define camera-button 57 | (list 58 | "Preview Video" 59 | camera-icon 60 | (λ (drr-frame) 61 | (define t (send drr-frame get-definitions-text)) 62 | (define vid-port (open-input-text-editor t 0 'end (λ (s) s) t #t)) 63 | (define program (parameterize ([read-accept-lang #t] 64 | [read-accept-reader #t]) 65 | (read vid-port))) 66 | (parameterize ([current-namespace (make-gui-namespace)]) 67 | (define mod-name (second program)) 68 | (eval `(current-directory ,(let ([v (send t get-filename)]) 69 | (if v 70 | (path-only v) 71 | (current-directory))))) 72 | (eval program) 73 | (eval `(require ',mod-name)) 74 | (eval '(require video/player)) 75 | (eval '(void (preview vid))))) 76 | #f)) 77 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | dist: trusty 3 | sudo: true 4 | # Based from: https://github.com/greghendershott/travis-racket 5 | 6 | env: 7 | global: 8 | # Supply a global RACKET_DIR environment variable. This is where 9 | # Racket will be installed. A good idea is to use ~/racket because 10 | # that doesn't require sudo to install and is therefore compatible 11 | # with Travis CI's newer container infrastructure. 12 | - RACKET_DIR=~/racket 13 | matrix: 14 | # Supply at least one RACKET_VERSION environment variable. This is 15 | # used by the install-racket.sh script (run at before_install, 16 | # below) to select the version of Racket to download and install. 17 | # 18 | # Supply more than one RACKET_VERSION (as in the example below) to 19 | # create a Travis-CI build matrix to test against multiple Racket 20 | # versions. 21 | # - RACKET_VERSION=6.8 22 | # - RACKET_VERSION=RELEASE 23 | # - RACKET_VERSION=6.9 24 | # - RACKET_VERSION=6.10 25 | # - RACKET_VERSION=6.11 26 | # - RACKET_VERSION=6.12 27 | - RACKET_VERSION=7.0 28 | - RACKET_VERSION=7.1 29 | - RACKET_VERSION=7.2 30 | - RACKET_VERSION=7.3 31 | - RACKET_VERSION=HEAD 32 | 33 | matrix: 34 | include: 35 | - os: linux 36 | dist: trusty 37 | sudo: true 38 | - os: osx 39 | allow_failures: 40 | - env: RACKET_VERSION=HEAD 41 | - os: osx 42 | fast_finish: true 43 | 44 | before_install: 45 | - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sudo cat .travis-scripts/setup-linux.sh | bash; fi 46 | # racket 47 | - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket; fi 48 | - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then cat ~/travis-racket/install-racket.sh | bash; fi # pipe to bash not sh! 49 | - export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us 50 | - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew update; fi 51 | - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install racket; fi 52 | # xvfb, enables gtk 53 | - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then export DISPLAY=:99.0; fi 54 | - if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sh -e /etc/init.d/xvfb start; fi 55 | - sleep 3 # give xvfb some time to start 56 | 57 | install: 58 | - raco pkg install --deps search-auto -n video 59 | 60 | # Here supply steps such as raco make, raco test, etc. You can run 61 | # `raco pkg install --deps search-auto` to install any required 62 | # packages without it getting stuck on a confirmation prompt. 63 | script: 64 | - travis_wait 30 raco test -p video 65 | 66 | after_success: 67 | - raco setup --check-pkg-deps --pkgs video 68 | - raco pkg install --deps search-auto cover cover-codecov cover-coveralls 69 | - travis_wait raco cover -b -f codecov -f coveralls -d $TRAVIS_BUILD_DIR/coverage . 70 | - raco pkg install --deps search-auto doc-coverage 71 | - travis_wait raco doc-coverage video/base 72 | -------------------------------------------------------------------------------- /video/scribblings/installing.scrbl: -------------------------------------------------------------------------------- 1 | #lang reader video/scribblings/viddoclang 2 | 3 | @;{ 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | @title{Installing} 20 | 21 | Video uses FFmpeg as part of its back-end. The language 22 | includes FFmpeg for macOS and Windows. Linux (and other OS) 23 | users will need to install FFmpeg themselves. Custom FFmpeg 24 | builds are also an option when needed. Details are provided 25 | for Windows/macOS/Linux. 26 | 27 | @section{Windows} 28 | 29 | Video for Windows comes bundled with FFmpeg. You can 30 | optionally install a different version of FFmpeg. To install 31 | a custom FFmpeg build, open the environment variables window 32 | and add the path to the DLLs to the your library path. Make 33 | sure to use at least the minimum version of FFmpeg as 34 | documented in @secref["ffmpeg-specs"]. 35 | 36 | @section{macOS} 37 | 38 | As with Windows, Video comes bundled with macOS. If you want 39 | to use your own build of FFmpeg, ad the path to the dylib to 40 | your @envvar{LD_LIBRARY_PATH}. 41 | 42 | @section{Linux} 43 | 44 | You need to install FFmpeg. Either from the FFmpeg website, 45 | or from your distro's repository. See 46 | @secref["ffmpeg-specs"] to make sure you have the correct 47 | version installed. 48 | 49 | @section[#:tag "ffmpeg-specs"]{FFmpeg Requirements} 50 | 51 | Video requires at least FFmpeg 3.2, and recommends FFmpeg 52 | 3.3. The full requirements are as follows: 53 | 54 | @margin-note{FFmpeg 4.0 support for Video is still under 55 | development.} 56 | 57 | 58 | Minimum Version: 59 | 60 | @inset-flow[ 61 | @tabular[#:style 'boxed 62 | #:column-properties '(left right) 63 | `(("avutil" "55.58") 64 | ("libavcodec" "57.89") 65 | ("libavformat" "57.71") 66 | ("libavfilter" "6.82") 67 | ("libswscale" "4.6") 68 | ("libswresample" "2.7") 69 | ("libavdevice" "57.6"))]] 70 | 71 | Recommended Version: 72 | 73 | @inset-flow[ 74 | @tabular[#:style 'boxed 75 | #:column-properties '(left right) 76 | `(("libavutil" "55.58") 77 | ("libavcodec" "57.89") 78 | ("libavformat" "57.71") 79 | ("libavfilter" "6.82") 80 | ("libswscale" "4.6") 81 | ("libswresample" "2.7") 82 | ("libavdevice" "57.6"))]] 83 | 84 | Note that the miner version is a minimum, while the major 85 | version is exact. Video has this requirement because major 86 | versions of FFmpeg libraries breaks backwards compatibility. 87 | 88 | You can test your version of FFmpeg with @exec{ffmpeg -v}. 89 | -------------------------------------------------------------------------------- /video/tests/render.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require racket/file 20 | racket/port 21 | racket/class 22 | racket/async-channel 23 | "../render.rkt" 24 | "../base.rkt" 25 | "../private/utils.rkt" 26 | "../private/debug-mixin.rkt") 27 | 28 | (define vid-mp4 (build-path video-dir "examples/vid.mp4")) 29 | 30 | (define the-clip 31 | (playlist 32 | (clip vid-mp4 33 | #:properties (hash "start" 50 34 | "end" 100)))) 35 | 36 | (render the-clip 37 | (make-temporary-file "vidtest~a.mp4")) 38 | 39 | (render the-clip 40 | (make-temporary-file "vidtest~a.mp4") 41 | #:render-mixin cmdline-mixin) 42 | 43 | (let () 44 | (define breaks 45 | (multitrack 46 | (color "green") 47 | (composite-merge 0 0 1/2 1/2) 48 | (color "red"))) 49 | (render breaks (make-temporary-file "color~a.mov") 50 | #:width 1280 51 | #:height 720 52 | #:start 0 53 | #:end 2 54 | #:fps 24)) 55 | 56 | (let () 57 | (define-values (channel stop) 58 | (render/async (multitrack 59 | #:properties (hash "length" 5) 60 | (color "green") 61 | (clip vid-mp4)) 62 | (make-temporary-file "~a.mp4"))) 63 | (let loop () 64 | (define next (async-channel-get channel)) 65 | (unless (eof-object? next) 66 | (loop)))) 67 | 68 | (parameterize ([current-output-port (open-output-nowhere)]) 69 | (render/pretty (multitrack 70 | #:properties (hash "length" 5) 71 | (color "green") 72 | (clip vid-mp4)) 73 | (make-temporary-file "~a.mp4"))) 74 | 75 | (let () 76 | (define video 77 | (color "green" 78 | #:properties (hash "start" 10 79 | "end" 20))) 80 | (define render (make-object render% video)) 81 | (send render setup (make-render-settings #:destination (make-temporary-file "tmp~a.mp4"))) 82 | (send render start-rendering) 83 | (sleep 0.1) 84 | (send render stop-rendering)) 85 | 86 | (let () 87 | (define video 88 | (color "green" 89 | #:properties (hash "start" 1 90 | "end" 1))) 91 | (define render (make-object render% video)) 92 | (send render setup (make-render-settings #:destination (make-temporary-file "tmp~a.mp4"))) 93 | (send render start-rendering) 94 | (sleep 0.1) 95 | (send render stop-rendering)) 96 | 97 | (let () 98 | (define video 99 | (playlist 100 | (chapter (clip vid-mp4)) 101 | (chapter (clip vid-mp4)))) 102 | (render video (make-temporary-file "~a.mp4"))) 103 | -------------------------------------------------------------------------------- /video/convert.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require racket/contract/base 20 | racket/class 21 | racket/set 22 | racket/file 23 | (prefix-in pict: pict) 24 | "private/video.rkt") 25 | (provide convert-database% 26 | gen:video-convertible 27 | (contract-out 28 | [make-base-database (-> (is-a?/c convert-database%))] 29 | [video-convert (-> video-convertible? video?)] 30 | [video-convertible? (-> any/c boolean?)])) 31 | 32 | ;; The conversion database is used by the renderer to 33 | ;; add conversions that objects themselves don't know 34 | ;; how to convert to Videos. For example, picts can 35 | ;; be added to this database. 36 | (define convert-database% 37 | (class object% 38 | (super-new) 39 | 40 | (define the-database (mutable-set)) 41 | 42 | ;; Register a new type of conversion with the database. 43 | ;; The conversion can handle anything where pred evaluates to 44 | ;; #t, and the conversion itself is stored as convert 45 | (define/public (register-conversion pred convert) 46 | (set-add! the-database (cons pred convert))) 47 | 48 | ;; Return #t if `obj` is convertible, #f otherwise. 49 | (define/public (convertible? obj) 50 | (for/fold ([c? #f]) 51 | ([i (in-set the-database)]) 52 | #:break c? 53 | (or c? ((car i) obj)))) 54 | 55 | ;; Query the database to see if any conversions work, 56 | ;; if so, apply the conversion and return the result, 57 | ;; otherwise return #f. 58 | (define/public (maybe-convert obj) 59 | (for/fold ([val #f]) 60 | ([i (in-set the-database)]) 61 | #:break val 62 | (and ((car i) obj) 63 | ((cdr i) obj)))) 64 | 65 | ;; Like maybe-convert, but always return a result or 66 | ;; throw an error on failure 67 | (define/public (convert obj) 68 | (define ret (maybe-convert obj)) 69 | (unless ret 70 | (error 'conversion-table "No registered conversion for: ~a" obj)) 71 | ret))) 72 | 73 | ;; Create a database with known types. 74 | ;; Perhaps this function will one day be moved to another 75 | ;; library outside of the core of video. 76 | (define (make-base-database) 77 | (define the-database (new convert-database%)) 78 | (send the-database register-conversion 79 | pict:pict? 80 | (λ (p) 81 | (define b (pict:pict->bitmap p)) 82 | (define res (make-temporary-file "pict~a.png")) 83 | (send b save-file res 'png 100) 84 | (make-file #:path res))) 85 | the-database) 86 | 87 | (define convert-database<%>/c 88 | (class/c [register-conversion (->m (-> any/c boolean?) (-> any/c video?) void?)] 89 | [maybe-convert (->m any/c (or/c video? #f))] 90 | [convertible? (->m any/c boolean?)] 91 | [convert (->m any/c video?)])) 92 | -------------------------------------------------------------------------------- /video/private/lang.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (all-defined-out)) 20 | (require (prefix-in core: "../core.rkt") 21 | (only-in "video.rkt" current-video-directory) 22 | "../base.rkt" 23 | racket/list 24 | racket/path 25 | (except-in pict clip frame blank) 26 | racket/draw 27 | racket/splicing 28 | (for-syntax racket/base 29 | racket/syntax 30 | syntax/parse 31 | syntax/parse/lib/function-header 32 | syntax/kerncase)) 33 | 34 | (define-syntax (λ/video stx) 35 | (syntax-parse stx 36 | [(_ args:formals body ...) 37 | #'(λ args (video-begin "λ/video" values () body ...))])) 38 | 39 | (define-syntax (define/video stx) 40 | (syntax-parse stx 41 | [(_ args:function-header body ...) 42 | #'(define f.name (λ/video f.args body ...))])) 43 | 44 | (define-syntax (define* stx) 45 | (syntax-parse stx 46 | [(_ arg:id body) 47 | #'(define*-values (arg) body)])) 48 | 49 | (define-syntax (define*-values stx) 50 | (syntax-parse stx 51 | [(_ (arg:id ...) body) 52 | (raise-syntax-error 'define* "cannot be used outside of a module or λ/video")])) 53 | 54 | (define-syntax (video-begin stx) 55 | (syntax-parse stx 56 | [(_ "λ/video" post-process exprs) 57 | #`(post-process (playlist . #,(reverse (syntax->list #'exprs))))] 58 | [(_ id:id post-process exprs) 59 | #`(begin 60 | (define id (post-process (playlist . #,(reverse (syntax->list #'exprs))))) 61 | (provide id))] 62 | [(_ id post-process exprs . body) 63 | (syntax-parse #'body 64 | [(b1 . body) 65 | (define expanded (local-expand #'b1 'module 66 | (append (kernel-form-identifier-list) 67 | (list #'provide #'require #'define*-values)))) 68 | (syntax-parse expanded 69 | #:literals (begin define*-values) 70 | [(begin b1 ...) 71 | #'(video-begin id post-process exprs b1 ... . body)] 72 | [(define*-values (id* ...) b1) 73 | #'(splicing-let-values ([(id* ...) b1]) (video-begin id post-process exprs . body))] 74 | [(id* . rest) ; this bit taken from scribble 75 | #:when (and (identifier? #'id*) 76 | (ormap (lambda (kw) (free-identifier=? #'id* kw)) 77 | (syntax->list #'(require 78 | provide 79 | define-values 80 | define-syntaxes 81 | begin-for-syntax 82 | module 83 | module* 84 | #%require 85 | #%provide 86 | #%declare)))) 87 | #`(begin #,expanded (video-begin id post-process exprs . body))] 88 | [_ 89 | #`(video-begin id post-process (#,expanded . exprs) . body)])])])) 90 | 91 | -------------------------------------------------------------------------------- /video/scribblings/utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (all-defined-out)) 20 | (require pict 21 | ppict/pict 22 | ppict/tag 23 | racket/math 24 | scribble/manual 25 | (except-in scribble/core table) 26 | racket/list) 27 | 28 | (define (playlist-timeline #:distance [distance 5] 29 | #:start [start #f] 30 | #:end [end #f] 31 | . trace) 32 | (define frames 33 | (apply hc-append distance trace)) 34 | (vc-append 35 | 15 36 | frames 37 | (let ([p (hc-append (pict-width frames) 38 | (tag-pict (if start (vline 1 10) (blank)) 'start) 39 | (tag-pict (if end (vline 1 10) (blank)) 'end))]) 40 | (pin-arrow-line 5 p #:label (text "time") 41 | (find-tag p 'start) cc-find 42 | (find-tag p 'end) cc-find)))) 43 | 44 | (define (ellipses #:offset [offset 3] 45 | #:size [size 2]) 46 | (hc-append 47 | offset 48 | (disk size) 49 | (disk size) 50 | (disk size))) 51 | 52 | (define (scale-1080p p [w-size 60] [mode 'inset]) 53 | (scale-to-fit p w-size (* 9/16 w-size) 54 | #:mode mode)) 55 | 56 | (define (shot p) 57 | (clip 58 | (frame 59 | (scale-1080p p)))) 60 | 61 | (define (rotating-rect-clip n) 62 | (build-list n 63 | (λ (f#) 64 | (shot (rotate (filled-rectangle 15 15 #:color "red") 65 | (/ (* f# pi) n 2)))))) 66 | 67 | (define the-rr-clip (rotating-rect-clip 10)) 68 | 69 | (define (ball-drop-clip n) 70 | (build-list n 71 | (λ (f#) 72 | (shot (ppict-do (blank 50) 73 | #:go (coord 1/2 (/ f# n) 'cc) 74 | (disk 25 #:color "green")))))) 75 | 76 | (define the-ball-drop (ball-drop-clip 10)) 77 | 78 | (define (inset-flow . n) 79 | (apply nested #:style 'inset n)) 80 | 81 | (define (grayscale-pict s) 82 | (define buf (pict->argb-pixels s)) 83 | (define gray-buf 84 | (apply bytes 85 | (append* 86 | (for/list ([i (in-range 0 (bytes-length buf) 4)]) 87 | (define a (bytes-ref buf i)) 88 | (define r (bytes-ref buf (+ i 1))) 89 | (define g (bytes-ref buf (+ i 2))) 90 | (define b (bytes-ref buf (+ i 3))) 91 | (define av (exact-floor (/ (+ r g b) 3))) 92 | (list a av av av))))) 93 | (argb-pixels->pict gray-buf (pict-width s))) 94 | 95 | (define the-grr-clip 96 | (map (compose frame grayscale-pict) the-rr-clip)) 97 | 98 | (define the-grall-drop 99 | (map (compose frame grayscale-pict) the-ball-drop)) 100 | 101 | (define (slice lst n m) 102 | (take (drop lst n) (- m n))) 103 | 104 | (define (colorize #:color c . content) 105 | (elem #:style (style #f (list (color-property c))) 106 | content)) 107 | 108 | (define (deprecated-text . content) 109 | (bold (larger (apply colorize #:color "red" content)))) 110 | 111 | (define (note-text . content) 112 | (bold (apply elem #:style (style #f (list (background-color-property "yellow"))) content))) 113 | -------------------------------------------------------------------------------- /video/scribblings/player.scrbl: -------------------------------------------------------------------------------- 1 | #lang reader video/scribblings/viddoclang 2 | 3 | @;{ 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | @title{Player} 20 | @defmodule[video/player] 21 | 22 | VidLang comes with a player to quickly preview videos before 23 | the final render. You can access it from DrRacket with the 24 | @emph{Preview Video} button. It appears next to the run 25 | button when a VidLang file is open. Alternatively, you can use @exec{ 26 | raco video -p } from the command line. 27 | 28 | Several of the features of the video preview are disabled. 29 | This is because they are unstable and not yet ready for 30 | release. They should be available in the next version of 31 | Video, or in the latest unstable build. 32 | 33 | @defproc[(preview [data producer?]) 34 | (is-a?/c video-player%)]{ 35 | 36 | Helper function to create a new @racket[video-player%] 37 | object, and start playback. The resulting 38 | @racket[video-player%] object is returned. 39 | 40 | @racket[data] is the @racket[producer] that the video player will render.} 41 | 42 | @defclass[video-player% frame% ()]{ 43 | 44 | A video player for previewing producers. 45 | 46 | @defconstructor[([video video?])]{ 47 | 48 | Constructs a video player object. This does not 49 | automatically show the video or start the video playback. 50 | Use @method[window<%> show] and 51 | @method[video-player% play], or consider using 52 | @racket[preview] instead. 53 | 54 | @racket[video] is the initial video associated with the 55 | player. This can be changed with @method[video-player% set-video].} 56 | @defmethod[(get-video-length) exact-nonnegative-integer?] 57 | @defmethod[(play) void?] 58 | @defmethod[(pause) void?] 59 | @defmethod[(stop) void?] 60 | @defmethod[(is-stopped?) boolean?] 61 | @defmethod[(seek [frame exact-nonnegative-integer?]) void?] 62 | @defmethod[(set-speed [speed number?]) void?] 63 | @defmethod[(rewind) void?] 64 | @defmethod[(fast-forward) void?] 65 | @defmethod[(get-position) exact-positive-integer?] 66 | @defmethod[(get-fps) number?] 67 | @defmethod[(set-video [video producer?]) void?] 68 | } 69 | 70 | @defclass[video-player-server% object% ()]{ 71 | 72 | Back-end for the @racket[video-player%] class. Can be used 73 | to render a video without the surrounding controls. 74 | 75 | @defmethod[(set-canvas [c canvas?]) void?] 76 | @defmethod[(set-video [v producer?]) void?] 77 | @defmethod[(get-video-length) (and/c real? (>=/c 0))] 78 | @defmethod[(play) void?] 79 | @defmethod[(is-paused?) boolean?] 80 | @defmethod[(get-status) (or/c 'playing 81 | 'paused 82 | 'rewinding 83 | 'fast-forwarding 84 | 'playing-slow 85 | 'stopped)] 86 | @defmethod[(is-stopped?) boolean?] 87 | @defmethod[(pause) boolean?] 88 | @defmethod[(stop) boolean?] 89 | @defmethod[(seek [position (and/c real? (>=/c 0))]) void?] 90 | @defmethod[(set-speed [speed real?]) void?] 91 | @defmethod[(rewind) void?] 92 | @defmethod[(fast-forward) void?] 93 | @defmethod[(get-fps) (and/c real? (>=/c 0))] 94 | @defmethod[(render-audio [render? boolean?]) void?] 95 | @defmethod[(render-video [render? boolean?]) void?]} 96 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Video 2 | ===== 3 | Video is a DSL for describing videos. It is still under heavy development. The API is becoming more stable. Features may get deprecated, but will be marked well before remove. (See the `CONTRIBUTING.md` file for details.) This ReadMe is for stable builds of video except for the *Nightly Development Badges* section. 4 | 5 | # Development Badges 6 | ## Unstable 7 | [![Build Status](https://travis-ci.org/videolang/video.svg?branch=master)](https://travis-ci.org/videolang/video) 8 | [![Build status](https://ci.appveyor.com/api/projects/status/f2t9op5dflo67ls4?svg=true)](https://ci.appveyor.com/project/LeifAndersen/video) 9 | [![Coverage Status](https://coveralls.io/repos/github/videolang/video/badge.svg?branch=master)](https://coveralls.io/github/videolang/video?branch=master) 10 | [![Scribble](https://img.shields.io/badge/Docs-Scribble-blue.svg)](http://docs.racket-lang.org/video@video-unstable/index.html) 11 | [![Project Stats](https://www.openhub.net/p/video/widgets/project_thin_badge.gif)](https://www.openhub.net/p/video) 12 | 13 | ## Testing 14 | [![Build Status](https://travis-ci.org/videolang/video.svg?branch=testing)](https://travis-ci.org/videolang/video) 15 | [![Coverage Status](https://coveralls.io/repos/github/videolang/video/badge.svg?branch=testing)](https://coveralls.io/github/videolang/video?branch=testing) 16 | [![Scribble](https://img.shields.io/badge/Docs-Scribble-blue.svg)](http://docs.racket-lang.org/video@video-testing/index.html) 17 | 18 | ## Stable 19 | [![Build Status](https://travis-ci.org/videolang/video.svg?branch=stable)](https://travis-ci.org/videolang/video) 20 | [![Coverage Status](https://coveralls.io/repos/github/videolang/video/badge.svg?branch=stable)](https://coveralls.io/github/videolang/video?branch=stable) 21 | [![Scribble](https://img.shields.io/badge/Docs-Scribble-blue.svg)](http://docs.racket-lang.org/video@video/index.html) 22 | 23 | # Website 24 | 25 | The video website can be found at [lang.video][3] 26 | 27 | # Install 28 | 29 | Before you can install Video, make sure you have [Racket][1] installed and in your operating systems, path. 30 | 31 | The easiest way to install the stable version of the:w 32 | Video is with `raco`, which comes bundled with [Racket][1] simply run: 33 | 34 | ``` 35 | raco pkg install video 36 | ``` 37 | 38 | If you want a particular build of video, you could alternatively run: 39 | 40 | ``` 41 | raco pkg install video- 42 | ``` 43 | 44 | Where is one of [these versions][8]. These versions are either Video releases or one of: 45 | 46 | * `video` - Stable Video. It is the most tested, and is set to the latest stable release. 47 | * `video-testing` - Less stable than `video`, but can still being developed. This branch is set to the latest released or pre-released version, including alphas, betas, and release candidates. 48 | * `video-unstable` - The least stable of the three main branches. This is the same as the `master` branch. It should build most of the time, but can occasnionally fail. If you are experiencing a bug, it _may_ be fixed in this branch. 49 | 50 | Finally, you can install video directly from the git repo. The `master` branch (`video-unstable`), is the default branch, but you can alternatively checkout different branches or tags. To install directly from the repo: 51 | 52 | ``` 53 | git clone https://github.com/videolang/video.git 54 | cd video 55 | raco pkg install 56 | ``` 57 | 58 | You can optionally check out a different branch using `git checkout`. 59 | 60 | # Uninstall 61 | 62 | To uninstall Video, run: 63 | 64 | ``` 65 | raco pkg remove video 66 | ``` 67 | 68 | # Releases 69 | 70 | You can find the latest releases for video on the [video releases page][2]. The `master` branch tends to be stable, but is not as thoroughly tested. 71 | 72 | # Documentation 73 | 74 | The Documentation for Video can be found at [the Racket package server][4]. 75 | 76 | # Bug reports 77 | 78 | Bugs can be filed either [anonymously][6] or on [Video's bug report tracker][7]. 79 | 80 | # Contributing 81 | 82 | If you want to contribute to video, you can read the [`CONTRIBUTING.md`][5] file.4 83 | 84 | [1]: https://racket-lang.org 85 | [2]: https://github.com/videolang/video/releases 86 | [3]: http://lang.video 87 | [4]: http://docs.racket-lang.org/video@video/index.html 88 | [5]: https://github.com/videolang/video/blob/master/CONTRIBUTING.md 89 | [6]: https://gitreports.com/issue/videolang/video 90 | [7]: https://github.com/videolang/video/issues 91 | [8]: https://pkgd.racket-lang.org/pkgn/search?q=&tags=vidlang+ -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Community Code of Conduct 2 | 3 | Video is dedicated to providing a harassment-free experience for everyone. We 4 | do not tolerate harassment of participants in any form. 5 | 6 | This code of conduct applies to all Video spaces, including our mailing lists 7 | and issue trackers, both online and off. Anyone who violates this code of 8 | conduct may be sanctioned or expelled from these spaces at the discretion of 9 | the Video Anti-Abuse Team. 10 | 11 | Some Video spaces may have additional rules in place, which will be made 12 | clearly available to participants. Participants are responsible for knowing and 13 | abiding by these rules. 14 | 15 | Harassment includes: 16 | 17 | * Offensive comments related to gender, gender identity and expression, sexual 18 | orientation, disability, mental illness, neuro(a)typicality, physical 19 | appearance, body size, age, race, or religion. 20 | 21 | * Unwelcome comments regarding a person’s lifestyle choices and practices, 22 | including those related to food, health, parenting, drugs, and employment. 23 | 24 | * Deliberate misgendering or use of ‘dead’ or rejected names. 25 | 26 | * Gratuitous or off-topic sexual images or behaviour in spaces where they’re 27 | not appropriate. 28 | 29 | * Physical contact and simulated physical contact (eg, textual descriptions 30 | like “*hug*” or “*backrub*”) without consent or after a request to stop. 31 | 32 | * Threats of violence. 33 | 34 | * Incitement of violence towards any individual, including encouraging a person 35 | to commit suicide or to engage in self-harm. 36 | 37 | * Deliberate intimidation. 38 | 39 | * Stalking or following. 40 | 41 | * Harassing photography or recording, including logging online activity for 42 | harassment purposes. 43 | 44 | * Sustained disruption of discussion. 45 | 46 | * Unwelcome sexual attention. 47 | 48 | * Pattern of inappropriate social contact, such as requesting/assuming 49 | inappropriate levels of intimacy with others 50 | 51 | * Continued one-on-one communication after requests to cease. 52 | 53 | * Deliberate “outing” of any aspect of a person’s identity without their 54 | consent except as necessary to protect vulnerable people from intentional 55 | abuse. 56 | 57 | * Publication of non-harassing private communication. 58 | 59 | Video prioritizes marginalized people’s safety over privileged people’s 60 | comfort. The Video Anti-Abuse Team reserves the right not to act on complaints regarding: 61 | 62 | * ‘Reverse’ -isms, including ‘reverse racism,’ ‘reverse sexism,’ and 63 | ‘cisphobia’ 64 | 65 | * Reasonable communication of boundaries, such as “leave me alone,” “go away,” 66 | or “I’m not discussing this with you.” 67 | 68 | * Communicating in a ‘tone’ you don’t find congenial 69 | 70 | * Criticizing racist, sexist, cissexist, or otherwise oppressive behavior or 71 | assumptions 72 | 73 | ## Reporting 74 | 75 | If you are being harassed by a member of Video, notice that someone else is 76 | being harassed, or have any other concerns, please contact the Video Anti-Abuse 77 | Team at [email address or other contact point]. If the person who is harassing 78 | you is on the team, they will recuse themselves from handling your incident. We 79 | will respond as promptly as we can. 80 | 81 | This code of conduct applies to Video spaces, but if you are being harassed by 82 | a member of Video outside our spaces, we still want to know about it. We will 83 | take all good-faith reports of harassment by Video members, especially the 84 | Video administration, seriously. This includes harassment outside our spaces 85 | and harassment that took place at any point in time. The abuse team reserves 86 | the right to exclude people from Video based on their past behavior, including 87 | behavior outside Video spaces and behavior towards people who are not in Video. 88 | 89 | In order to protect volunteers from abuse and burnout, we reserve the right to 90 | reject any report we believe to have been made in bad faith. Reports intended 91 | to silence legitimate criticism may be deleted without response. 92 | 93 | We will respect confidentiality requests for the purpose of protecting victims 94 | of abuse. At our discretion, we may publicly name a person about whom we’ve 95 | received harassment complaints, or privately warn third parties about them, if 96 | we believe that doing so will increase the safety of Video members or the 97 | general public. We will not name harassment victims without their affirmative 98 | consent. 99 | 100 | ## Consequences 101 | 102 | Participants asked to stop any harassing behavior are expected to comply 103 | immediately. 104 | 105 | If a participant engages in harassing behavior, the Video Anti-Abuse Team may 106 | take any action they deem appropriate, up to and including expulsion from all 107 | Video spaces and identification of the participant as a harasser to other Video 108 | members or the general public. 109 | 110 | ## Attribution 111 | 112 | This anti-harassment policy is based on the [example policy from the Geek Feminism wiki][1], created by the Geek Feminism community. 113 | 114 | [1]: http://geekfeminism.wikia.com/wiki/Community_anti-harassment 115 | -------------------------------------------------------------------------------- /video/private/render-settings.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2019 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; This module stores the render-settings struct used by the renderer and 20 | ;; derived classes. 21 | ;; This needs to be in its own module (rather than a submodule) to avoid 22 | ;; a cycle when loading the module. 23 | 24 | ;; Defined in a submodule so that classes 25 | ;; extending this one can make use of it. 26 | 27 | (require racket/struct) 28 | 29 | (provide (all-defined-out)) 30 | 31 | ;; For nice printing of render settings AND video objects 32 | (define current-detailed-printing? (make-parameter #f)) 33 | 34 | (struct render-settings (destination 35 | split-av 36 | width 37 | height 38 | display-aspect-ratio 39 | start 40 | end 41 | fps 42 | video-time-base 43 | audio-time-base 44 | format 45 | video-codec 46 | video-codec-options 47 | audio-codec 48 | audio-codec-options 49 | subtitle-codec 50 | pix-fmt 51 | sample-fmt 52 | sample-rate 53 | channel-layout 54 | speed 55 | render-video? 56 | render-audio? 57 | video-frames 58 | audio-frames 59 | data-frames 60 | seek-point 61 | probesize 62 | rtbufsize) 63 | #:methods gen:custom-write 64 | [(define (write-proc vid port mode) 65 | (if (current-detailed-printing?) 66 | ((make-constructor-style-printer 67 | (λ (obj) "render-settings") 68 | (λ (obj) (list (render-settings-destination obj) 69 | (render-settings-width obj) 70 | (render-settings-height obj) 71 | (render-settings-display-aspect-ratio obj) 72 | (render-settings-video-codec obj) 73 | (render-settings-audio-codec obj) 74 | (render-settings-pix-fmt obj) 75 | (render-settings-sample-fmt obj) 76 | (render-settings-channel-layout obj) 77 | (render-settings-start obj) 78 | (render-settings-end obj) 79 | (render-settings-seek-point obj)))) 80 | vid port mode) 81 | ((make-constructor-style-printer 82 | (λ (obj) "render-settings") 83 | (λ (obj) (list))) 84 | vid port mode)))]) 85 | 86 | (define (make-render-settings #:destination [d #f] 87 | #:split-av [sav #f] 88 | #:width [w 1920] 89 | #:height [h 1080] 90 | #:display-aspect-ratio [dar 16/9] 91 | #:start [s #f] 92 | #:end [e #f] 93 | #:fps [fr #f] 94 | #:video-time-base [vtb #f] 95 | #:audio-time-base [atb #f] 96 | #:format [fo #f] 97 | #:video-codec [vc #f] 98 | #:video-codec-options [vco #f] 99 | #:audio-codec [ac #f] 100 | #:audio-codec-options [aco #f] 101 | #:subtitle-codec [sc #f] 102 | #:pix-fmt [pf 'yuv420p] 103 | #:sample-fmt [sf 'fltp] 104 | #:sample-rate [sr 44100] 105 | #:channel-layout [cl 'stereo] 106 | #:speed [sp 1] 107 | #:render-video? [rv? #t] 108 | #:render-audio? [rc? #t] 109 | #:video-frames [vfr #f] 110 | #:audio-frames [afr #f] 111 | #:data-frames [dfr #f] 112 | #:seek-point [seekp #f] 113 | #:probesize [ps #f] 114 | #:rtbufsize [rtbs #f]) 115 | (render-settings 116 | d sav w h dar s e fr vtb atb fo vc vco ac aco sc pf sf sr cl sp rv? rc? vfr afr dfr seekp ps rtbs)) 117 | -------------------------------------------------------------------------------- /video/tests/ffmpeg.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require rackunit 20 | racket/logging 21 | racket/pretty 22 | "../private/installer.rkt" 23 | (prefix-in green: "green.vid") 24 | (prefix-in video: "../render.rkt") 25 | (submod "../render.rkt" render-fields) 26 | (prefix-in video: "../base.rkt") 27 | "../private/ffmpeg/main.rkt" 28 | "../private/ffmpeg-pipeline.rkt" 29 | "../private/init.rkt" 30 | "../private/utils.rkt" 31 | "../private/log.rkt" 32 | "test-utils.rkt") 33 | 34 | (define-namespace-anchor here-anchor) 35 | (define here (namespace-anchor->namespace here-anchor)) 36 | (define vid-mp4 (build-path video-dir "examples/vid.mp4")) 37 | 38 | ;; Give the logging code a dry run to ensure 39 | ;; that it doesn't crash anything. 40 | ;; Because this is just the info log, we don't 41 | ;; really care about what is or is not in there. 42 | (with-intercepted-logging (λ (l) (void)) 43 | (λ () 44 | (video:render green:vid 45 | (make-temporary-file "~a.mp4") 46 | #:start 0 47 | #:end 10)) 48 | #:logger video-logger 49 | 'debug 50 | 'video) 51 | 52 | (let () 53 | (define r (make-object video:render% (video:clip vid-mp4))) 54 | (send r setup (video:make-render-settings #:destination (make-temporary-file "~a.mp4"))) 55 | (define g (get-field render-graph r)) 56 | (render g)) 57 | 58 | (let () 59 | (define b (file->stream-bundle vid-mp4)) 60 | (define ctx (stream-bundle-avformat-context b)) 61 | ;(avformat-context->list ctx) 62 | (for ([name (in-list _avformat-context-field-names)]) 63 | (define accessor (eval (string->symbol (format "avformat-context-~a" name)) here)) 64 | (with-handlers ([exn:ffmpeg:lib? (λ (e) (void))]) 65 | (accessor ctx)))) 66 | 67 | (let () 68 | (define c (mk-command "str0" "fade")) 69 | (command->string c) 70 | (define c* (mk-command "str1" "fade" #:flags '(enter) #:arg "arg")) 71 | (command->string c*) 72 | (void)) 73 | 74 | (let () 75 | (define i (mk-interval 5 (list (mk-command "str0" "cat")))) 76 | (interval->string i) 77 | (define i* (mk-interval 5 (list (mk-command "str1" "app")) #:end 6)) 78 | (interval->string i*) 79 | (void)) 80 | 81 | (let () 82 | (define tn (mk-trim-node #:start 5 #:end 10)) 83 | (define rsv (mk-reset-timestamp-video-filter)) 84 | (define rsa (mk-reset-timestamp-audio-filter)) 85 | (define rsn (mk-reset-timestamp-node)) 86 | (void)) 87 | 88 | (let () 89 | (check-equal? (color->string '(255 0 0)) 90 | "0xff0000ff") 91 | (check-equal? (color->string "green") 92 | "0x00ff00ff")) 93 | 94 | 95 | (let () 96 | (define b (mk-stream-bundle)) 97 | (check-true (stream-bundle? b)) 98 | (define ci (mk-codec-obj)) 99 | (check-true (codec-obj? ci))) 100 | 101 | (let () 102 | (filter->string 103 | (mk-filter "myfilter" 104 | (hash "a" '("b" "c" "d") 105 | "e" (mk-duration 5) 106 | "f" (mk-interval 8 '())))) 107 | (void)) 108 | 109 | (let () 110 | (build-av-dict (hash "a" "b" "c" "d")) 111 | (void)) 112 | 113 | (let () 114 | (define g (avfilter-graph-alloc)) 115 | (filter->avfilter 116 | (mk-filter "trim" (hash "start" 3 "end" 42)) 117 | g) 118 | (avfilter-graph-free g) 119 | (void)) 120 | 121 | (let () 122 | (define f (file->stream-bundle vid-mp4)) 123 | (check-equal? (maybe-av-find-best-stream (stream-bundle-avformat-context f) 'video) 0) 124 | (define dm (new demux% [bundle f])) 125 | (send dm dump-info) 126 | (send dm init) 127 | (send dm close) 128 | (define f2 (stream-bundle->file (make-temporary-file "~a.mp4") 'vid+aud)) 129 | (define mx (new mux% [bundle f2])) 130 | (send mx dump-info)) 131 | 132 | (let () 133 | (define f (stream-bundle->file (make-temporary-file "~a.mp4") 134 | (mk-stream-bundle 135 | #:streams (vector 'video 136 | 'audio 137 | (mk-codec-obj #:type 'audio 138 | #:id 'aac 139 | #:index 3))))) 140 | (check-true 141 | (stream-bundle? f))) 142 | 143 | ;; Check default constructors for several node types. 144 | (let () 145 | (check-true (sink-node? (mk-sink-node #f))) 146 | (check-true (filter-node? (mk-empty-node))) 147 | (check-true (filter-node? (mk-empty-sink-node))) 148 | (check-true (filter? (mk-empty-video-filter))) 149 | (check-true (mux-node? (mk-mux-node 'video 0 (hash)))) 150 | (check-true (demux-node? (mk-demux-node 12))) 151 | (check-true (filter-node? (mk-split-node)))) 152 | 153 | ;; Check the installer function 154 | (installer #f #f #f #f) 155 | 156 | ;; Check capability to list devices 157 | (let () 158 | (void)) ;; TODO 159 | -------------------------------------------------------------------------------- /video/surface.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; This library is still experimental, and the workings of 20 | ;; the API are liekly to change 21 | 22 | (require "private/surface.rkt" 23 | (except-in "private/ffmpeg-pipeline.rkt" filter?)) 24 | (provide define-producer 25 | ->producer 26 | defproducer 27 | producer? 28 | define-filter 29 | ->filter 30 | deffilter 31 | filter? 32 | 33 | ;; Transitions define three procs: 34 | ;; track1-subgraph : Graph Node -> (U (vertex-subgraph #:source Graph 35 | ;; #:sources Node 36 | ;; #:sinks Node) 37 | ;; #f) 38 | ;; track2-subgraph : Graph Node -> (U (vertex-subgraph #:source Graph 39 | ;; #:sources Node 40 | ;; #:sinks Node) 41 | ;; #f) 42 | ;; combined-subgraph : Graph Node Node -> (U (vertex-subgraph #:source Graph 43 | ;; #:sources (cons Node Node) 44 | ;; #:sinks Node) 45 | ;; #f) 46 | ;; 47 | ;; In all cases the Graph is a context which the transitions can insert nodes 48 | ;; into. If they use this graph, they should return it as #:source. Alternatively, 49 | ;; a transition can create its own graph and return it. 50 | ;; 51 | ;; The track1-subgraph and track2-subgraph procedures are given a pointer to the node 52 | ;; that will feed into it. Do NOT connect any of the subgraphs nodes to it, that is handled 53 | ;; by the runtime. Return the source and sink of the graph in the appropriate fieldds. 54 | ;; 55 | ;; The combined-subgraph procedure is the same as the first two, except 56 | ;; it takes two sources, one for node-a and one for node-b. As such, 57 | ;; the #:sources field should be a PAIR of two nodes. It is connected 58 | ;; to the surrounding graph in the same fashion as the other two 59 | ;; procedures. 60 | ;; 61 | ;; Alternatively, the procedure can return #f. In this case, no 62 | ;; subgraph is inserted into the render graph. Instead, the source 63 | ;; is dumped directly into a black hole sink. This is useful if the 64 | ;; resulting node should NOT be inserted into its external context. 65 | ;; 66 | ;; Frequently, either combined-subgraph or both track1-subgraph 67 | ;; and track2-subgraph will return #f. 68 | ;; 69 | ;; For any procedure that returns a subgraph, it must fill in `length` 70 | ;; in the properties field. For track1-subgraph and track2-subraph, 71 | ;; this length is subtracted from the total length of the playlsit/multitrack. 72 | ;; For combined-subgraph, this length is ADDED to the length of the 73 | ;; playlist/multitrack. This allows producers to remove different 74 | ;; amounts of their surrounding clips. 75 | ;; 76 | ;; Additionally, in order to be used in a playlist, the properties 77 | ;; table for a transition (NOT the subgraph procs) MUST define 78 | ;; `pre-length` and `post-length`. This is used to determine 79 | ;; the time expected to be surrounding the transition. This is 80 | ;; not needed for transitions used in multitracks. 81 | define-transition 82 | ->transition 83 | deftransition 84 | transition? 85 | 86 | ;; Merges have the same API as transitions. The only 87 | ;; diference is they have the keywords #:top #:bottom 88 | ;; rather than up/down 89 | define-merge 90 | ->merge 91 | defmerge 92 | merge? 93 | 94 | ;; The following functions define videograph (and some filtergraph) 95 | ;; level primitives to use in transitions/mergers/filters. 96 | node-counts 97 | node-props 98 | filter-node? 99 | mk-filter-node 100 | mux-node? 101 | mk-mux-node 102 | mk-empty-sink-video-filter 103 | mk-empty-sink-audio-filter 104 | mk-empty-sink-node 105 | mk-empty-video-filter 106 | mk-empty-audio-filter 107 | mk-empty-node 108 | mk-fifo-video-filter 109 | mk-fifo-audio-filter 110 | mk-fifo-node 111 | mk-split-video-filter 112 | mk-split-audio-filter 113 | mk-split-node 114 | mk-trim-video-filter 115 | mk-trim-audio-filter 116 | mk-trim-node 117 | mk-reset-timestamp-video-filter 118 | mk-reset-timestamp-audio-filter 119 | mk-reset-timestamp-node 120 | mk-filter 121 | color->string) 122 | -------------------------------------------------------------------------------- /video/tests/editor.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require rackunit 20 | racket/gui/base 21 | wxme 22 | "../private/editor.rkt") 23 | 24 | (let () 25 | (define 3ed 26 | (new video-editor% 27 | [track-height 10] 28 | [minimum-width 100] 29 | [initial-tracks 3])) 30 | (define new-3ed 31 | (send 3ed copy-self)) 32 | (check-equal? 33 | (send 3ed get-min-height) 34 | 30) 35 | (check-equal? 36 | (send 3ed get-min-width) 37 | 100) 38 | (check-equal? 39 | (send new-3ed get-min-height) 40 | 30) 41 | (check-equal? 42 | (send new-3ed get-min-width) 43 | 100) 44 | (check-equal? 45 | (syntax->datum (send new-3ed read-special #f #f #f #f)) 46 | (syntax->datum (send 3ed read-special #f #f #f #f)))) 47 | 48 | (let () 49 | (define ned 50 | (new video-editor% 51 | [initial-tracks 2] 52 | [track-height 200])) 53 | (send ned add-track) 54 | (check-equal? 55 | (send ned get-min-height) 56 | 600) 57 | (send ned delete-track 1) 58 | (check-equal? 59 | (send ned get-min-height) 60 | 400)) 61 | 62 | (let () 63 | (define ed 64 | (new video-editor%)) 65 | (send ed on-default-event (new mouse-event% [event-type 'right-down])) 66 | (define text-ed 67 | (new video-text%)) 68 | (send text-ed on-event (new mouse-event% [event-type 'right-down])) 69 | (define file-ed 70 | (new video-file%)) 71 | (send file-ed on-event (new mouse-event% [event-type 'right-down]))) 72 | 73 | (let () 74 | (define ed 75 | (new video-editor% [initial-tracks 2])) 76 | (send ed insert-video (new video-snip%) 0 5 10) 77 | (send ed delete-track 0)) 78 | 79 | (let () 80 | (define 4ed 81 | (new video-editor% 82 | [track-height 200] 83 | [minimum-width 500] 84 | [initial-tracks 4])) 85 | (check-equal? 86 | (send 4ed get-min-height) 87 | 800) 88 | (check-equal? 89 | (send 4ed get-min-width) 90 | 500) 91 | (define 4ed-str-out 92 | (new editor-stream-out-bytes-base%)) 93 | (send 4ed write-to-file (make-object editor-stream-out% 4ed-str-out)) 94 | (define 4ed-str 95 | (send 4ed-str-out get-bytes)) 96 | (define 4ed-str-in 97 | (make-object editor-stream-in-bytes-base% 4ed-str)) 98 | (define new-4ed 99 | (new video-editor%)) 100 | (send new-4ed read-from-file (make-object editor-stream-in% 4ed-str-in)) 101 | (check-equal? 102 | (send new-4ed get-min-height) 103 | 800) 104 | (check-equal? 105 | (send new-4ed get-min-width) 106 | 500)) 107 | 108 | (let () 109 | (define vf (new video-file% [file (build-path "hello.mp4")])) 110 | (send vf set-file! (build-path "world.mp4")) 111 | (define vf2 (send vf copy-self)) 112 | (check-equal? (syntax->datum (send vf2 read-special #f #f #f #f)) 113 | (syntax->datum (send vf read-special #f #f #f #f))) 114 | (check-equal? (send vf2 get-file) 115 | (send vf get-file))) 116 | 117 | (let () 118 | (define vs (new video-snip% 119 | [editor (new video-editor%)])) 120 | (define vs2 (send vs copy)) 121 | (define b1 (new editor-stream-out-bytes-base%)) 122 | (define b2 (new editor-stream-out-bytes-base%)) 123 | (send vs2 write (make-object editor-stream-out% b2)) 124 | (send vs write (make-object editor-stream-out% b1)) 125 | (check-equal? (send b1 get-bytes) 126 | (send b2 get-bytes)) 127 | (define b3 (make-object editor-stream-in-bytes-base% (send b1 get-bytes))) 128 | (define b4 (make-object editor-stream-in-bytes-base% (send b1 get-bytes))) 129 | (define b5 (make-object editor-stream-in-bytes-base% (send b1 get-bytes))) 130 | (define vr (new video-snip-reader%)) 131 | (define vsc (new video-snip-class%)) 132 | (define vs3 (send vsc read (make-object editor-stream-in% b3))) 133 | (check-equal? (send vr read-header "0" (make-object editor-stream-in% b5)) 134 | (void))) 135 | 136 | 137 | (let () 138 | (define ve (new video-editor% 139 | [initial-tracks 3] 140 | [track-height 200])) 141 | (send ve set-track-height! 400) 142 | (check-equal? 143 | (send ve get-min-height) 144 | 1200)) 145 | 146 | (let () 147 | (define ve (new video-editor% 148 | [initial-tracks 3] 149 | [track-height 500])) 150 | (send ve insert-video (new video-snip%) 2 5 10) 151 | (send ve delete-track 1) 152 | (define ve2 (send ve copy-self)) 153 | (define b1 (new editor-stream-out-bytes-base%)) 154 | (define b2 (new editor-stream-out-bytes-base%)) 155 | (send ve write-to-file (make-object editor-stream-out% b1)) 156 | (send ve2 write-to-file (make-object editor-stream-out% b2)) 157 | (check-equal? (send b2 get-bytes) 158 | (send b1 get-bytes)) 159 | (define b3 (make-object editor-stream-in-bytes-base% (send b1 get-bytes))) 160 | (define b4 (make-object editor-stream-in-bytes-base% (send b2 get-bytes))) 161 | (send ve read-from-file (make-object editor-stream-in% b3)) 162 | (check-equal? 163 | (send ve get-min-height) 164 | 1000)) 165 | 166 | (let () 167 | (define admin (new editor-admin%)) 168 | (define ve (new video-editor% 169 | [track-height 10] 170 | [initial-tracks 2])) 171 | (send ve set-admin admin) 172 | (define vs (new video-snip% 173 | [editor (new video-editor%)])) 174 | (send ve insert-video vs 1 0 10) 175 | (send ve resize vs 1 1) 176 | (define ve2 (new video-editor% 177 | [track-height 10] 178 | [initial-tracks 2])) 179 | (define vs2 (new video-snip% 180 | [editor (new video-editor%)])) 181 | (send ve2 insert-video vs2 1 0 1) 182 | (check-equal? (syntax->datum (send ve read-special #f #f #f #f)) 183 | (syntax->datum (send ve2 read-special #f #f #f #f))) 184 | (define ve3 (new video-editor% 185 | [track-height 10] 186 | [initial-tracks 2])) 187 | (define vs3 (new video-snip% 188 | [editor (new video-editor%)])) 189 | (send ve3 insert-video vs3 1 0 10) 190 | (check-not-equal? (syntax->datum (send ve read-special #f #f #f #f)) 191 | (syntax->datum (send ve3 read-special #f #f #f #f))) ) 192 | 193 | 194 | (let () 195 | (define ve (new video-editor% 196 | [minimum-width 1000] 197 | [initial-tracks 10] 198 | [track-height 100])) 199 | (define dc (new bitmap-dc% [bitmap (make-object bitmap% 1000 1000)])) 200 | (check-equal? (send ve on-paint #t dc 0 0 1000 1000 0 0 'no-carot) 201 | (void))) 202 | -------------------------------------------------------------------------------- /video/private/init.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2019 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; Library to initialize the MLT framework. 20 | ;; Alternatively your program can just call `mlt-factory-init` on its own. 21 | ;; If you do this though, do make sure to shut things down with mlt-factory-init 22 | 23 | (provide (all-defined-out)) 24 | (require racket/async-channel 25 | racket/match 26 | racket/struct 27 | racket/list 28 | ffi/unsafe 29 | ffi/unsafe/atomic 30 | ffi/unsafe/define 31 | ffi/unsafe/global 32 | "log.rkt" 33 | "ffmpeg/libvid.rkt" 34 | "ffmpeg/main.rkt") 35 | 36 | (define video-key #"VIDEO-FFMPEG-INIT") 37 | 38 | (define ffmpeg-logger (make-logger 'ffmpeg video-logger)) 39 | (define-ffi-definer define-internal #f) 40 | 41 | (define ffmpeg-log-list '()) 42 | (struct ffmpeg-msg (name 43 | level 44 | msg)) 45 | 46 | (define (callback-proc level name msg) 47 | (set! ffmpeg-log-list (cons (ffmpeg-msg name level msg) ffmpeg-log-list))) 48 | 49 | ;; Flush the current log buffer into a list which is returned. 50 | ;; The function runs in automic mode to cooperate with the 51 | ;; actual logging callback. 52 | (define (flush-ffmpeg-log-list!) 53 | (call-as-atomic 54 | (λ () 55 | (define ret ffmpeg-log-list) 56 | (set! ffmpeg-log-list '()) 57 | (reverse ret)))) 58 | 59 | ;; Flush the ffmpeg log. Unlike `flush-ffmpeg-log-list!`, this 60 | ;; function is not atomic, but does put the log into the actual 61 | ;; racket level logging structure. 62 | ;; Returns the number of msgs received and if an 63 | ;; eof character was received. 64 | ;; -> (Values Nnnegative-Integer Boolean) 65 | (define (flush-ffmpeg-log!/tracking) 66 | (define buff (flush-ffmpeg-log-list!)) 67 | (for/fold ([msg-count 0] 68 | [found-eof? #f]) 69 | ([msg (in-list buff)]) 70 | (match msg 71 | [(struct* ffmpeg-msg ([name name*] 72 | [level level] 73 | [msg msg*])) 74 | (define name (or name* "???")) 75 | (define msg (or msg* "???")) 76 | (define log-level 77 | (match level 78 | ['debug 'debug] 79 | ['warning 'warning] 80 | ['error 'error] 81 | ['info 'info] 82 | ['fatal 'fatal] 83 | ['verbose 'info] 84 | [_ 'info])) 85 | (when (log-level? ffmpeg-logger log-level) 86 | (log-message ffmpeg-logger log-level 87 | ;'ffmpeg 88 | (string->symbol name) 89 | (substring msg 0 (sub1 (string-length msg))) 90 | (current-continuation-marks) 91 | #f)) 92 | (values (add1 msg-count) #f)] 93 | [x #:when (eof-object? x) (values msg-count #t)]))) 94 | 95 | ;; Like flush-ffmpeg-log!/tracking, but returns void instead. 96 | (define (flush-ffmpeg-log!) 97 | (flush-ffmpeg-log!/tracking) 98 | (void)) 99 | 100 | (define (stop-ffmpeg-logging/not-running) 101 | (error 'video/init "Not Currently logging")) 102 | (define stop-ffmpeg-logging stop-ffmpeg-logging/not-running) 103 | (define (start-ffmpeg-logging) 104 | (define stop-flag #f) 105 | (define t 106 | (thread 107 | (λ () 108 | (define min-sleep-time 0.1) 109 | (define max-sleep-time 5) 110 | (define delta-sleep-time 0.1) 111 | (let loop ([sleep-time min-sleep-time]) 112 | (define-values (msg-count found-eof?) (flush-ffmpeg-log!/tracking)) 113 | (cond [found-eof? (void)] 114 | [(= msg-count 0) 115 | (unless stop-flag 116 | (sleep sleep-time) 117 | (loop (min (+ sleep-time delta-sleep-time) max-sleep-time)))] 118 | [else (loop min-sleep-time)]))))) 119 | (set! stop-ffmpeg-logging 120 | (λ () 121 | (set! stop-flag #t) 122 | (thread-wait t) 123 | (set! stop-ffmpeg-logging stop-ffmpeg-logging/not-running)))) 124 | (start-ffmpeg-logging) 125 | 126 | ;; Init ffmpeg (ONCE PER PROCESS) 127 | (when (ffmpeg-installed?) 128 | (unless (register-process-global video-key (cast 1 _racket _pointer)) 129 | (when ((version-major (avformat-version)) . < . 58) 130 | (av-register-all)) 131 | (when ((version-major (avfilter-version)) . < . 7) 132 | (avfilter-register-all)) 133 | (avformat-network-init) 134 | (avdevice-register-all))) 135 | 136 | ;; Set up the logger. 137 | ;; This must be done a new time the module is instantiated, and 138 | ;; we unset the logger after its finished. 139 | ;; Only ONE logger can be installed at a time. This is not a problem 140 | ;; as init should only really be running once. 141 | (define callback-executor (make-will-executor)) 142 | (define (finish-execution v) 143 | (set-racket-log-callback #f)) 144 | (will-register callback-executor callback-proc finish-execution) 145 | (unless (or (not (ffmpeg-installed?)) (equal? (getenv "FF_LOG") "stdout")) 146 | (av-log-set-callback #f) 147 | ;; Perminently disable ffmpeg log to racket log libvid. 148 | ;; Its too buggy and will have to wait for the next release. 149 | (define should-log (equal? (getenv "FF_LOG") "racket")) 150 | (when (and should-log (ffmpeg-installed?) (libvid-installed?)) 151 | (set-racket-log-callback callback-proc) 152 | (av-log-set-callback ffmpeg-log-callback) 153 | (thread 154 | (λ () 155 | (will-execute callback-executor))) 156 | (plumber-add-flush! 157 | (current-plumber) 158 | (λ (handler) 159 | (stop-ffmpeg-logging))) 160 | (void))) 161 | 162 | ;; Because portaudio has a nasty tendency to output a lot of garbadge to stdout, only 163 | ;; require it in situations where its actually needed. 164 | (module* portaudio racket 165 | (require ffi/unsafe 166 | ffi/unsafe/global 167 | portaudio) 168 | 169 | (define portaudio-key #"VIDEO-PORTAUDIO-INIT") 170 | (unless (register-process-global portaudio-key (cast 1 _racket _pointer)) 171 | (pa-maybe-initialize))) 172 | 173 | #| 174 | ;; This module simply runs a test to see if ffmpeg, portaudio, 175 | ;; and libvid are installed. Its in a seperate module because video is 176 | ;; still usable without libvid, but putting it in this module allows 177 | ;; us to add checks for CI. 178 | (module* test-lib-install racket/base 179 | (require "ffmpeg/lib.rkt" 180 | "ffmpeg/libvid.rkt" 181 | portaudio) 182 | (unless (ffmpeg-installed?) 183 | (error "Could not find or load ffmpeg")) 184 | (unless (libvid-installed?) 185 | (error "Could not find or load libvid"))) 186 | |# 187 | -------------------------------------------------------------------------------- /video/private/opengl.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; This module provides several low-level opengl calls. It is useful because the 20 | ;; sgl bindings provided with Racket assume the deprecated fixed-function pipeline, 21 | ;; while the opengl package is set up assuming a few old functions (glGetString) 22 | ;; are provided. 23 | ;; 24 | ;; We only seem to need this module in Windows 25 | ;; 26 | ;; Finally, this module is NOT a complete (or anywhere near complete) 27 | ;; set of opengl bindings. Rather, it is only enough to run the video-canvas.rkt 28 | ;; module in this same folder. 29 | 30 | (provide (all-defined-out)) 31 | (require racket/match 32 | racket/vector 33 | ffi/unsafe 34 | ffi/vector 35 | ffi/unsafe/define 36 | ffi/unsafe/define/conventions 37 | (for-syntax syntax/parse 38 | racket/base)) 39 | 40 | (define GL-TEXTURE-2D #x0DE1) 41 | (define GL-TEXTURE0 #x84C0) 42 | (define GL-TEXTURE1 #x84C1) 43 | (define GL-TEXTURE2 #x84C2) 44 | (define GL-ALPHA #x1906) 45 | (define GL-RGB #x1907) 46 | (define GL-RGBA #x1908) 47 | (define GL-BYTE #x1400) 48 | (define GL-UNSIGNED-BYTE #x1401) 49 | (define GL-SHORT #x1402) 50 | (define GL-UNSIGNED-SHORT #x1403) 51 | (define GL-FLOAT #x1406) 52 | (define GL-FIXED #x140C) 53 | 54 | (define GL-MAJOR-VERSION #x821B) 55 | (define GL-MINOR-VERSION #x821C) 56 | 57 | (define _gl-enum _ufixint) 58 | (define _gl-int _int32) 59 | (define _gl-int64 _int64) 60 | (define _gl-byte _byte) 61 | (define _gl-short _int16) 62 | (define _gl-uint _uint32) 63 | (define _gl-sizei _uint32) 64 | (define _gl-sizei-ptr _intptr) 65 | (define _gl-pointer _pointer) 66 | (define _gl-clampf _float) ; <- Should be 32bit. 67 | (define _gl-bitfield _uint) 68 | (define _gl-boolean _bool) 69 | 70 | (define _gl-buffer-mask 71 | (_bitmask `(depth = #x100 72 | stencil = #x400 73 | color = #x4000) 74 | _gl-bitfield)) 75 | 76 | (define-ffi-definer define-internal #f) 77 | 78 | (define gl-get-proc-address 79 | (match (system-type 'os) 80 | ['windows 81 | (define libgl (ffi-lib "opengl32")) 82 | (define-ffi-definer define-libgl libgl) 83 | (define-libgl wglGetProcAddress (_fun _string -> _pointer)) 84 | (define-internal LoadLibraryA (_fun _string -> _intptr)) 85 | (define-internal GetProcAddress (_fun _intptr _string -> _pointer)) 86 | 87 | (define opengl-module (LoadLibraryA "opengl32.dll")) 88 | (λ (str type) 89 | (define maybe-addr (wglGetProcAddress str)) 90 | (define addr 91 | (if (or (ptr-equal? maybe-addr (ptr-add #f -1)) 92 | (ptr-equal? maybe-addr (ptr-add #f 0)) 93 | (ptr-equal? maybe-addr (ptr-add #f 1)) 94 | (ptr-equal? maybe-addr (ptr-add #f 2)) 95 | (ptr-equal? maybe-addr (ptr-add #f 3))) 96 | (GetProcAddress opengl-module str) 97 | maybe-addr)) 98 | (cast addr _pointer type))] 99 | ['unix 100 | (define lib-gl (ffi-lib "libGL" '("1" ""))) 101 | (define-ffi-definer define-libgl lib-gl) 102 | (define-libgl glXGetProcAddress (_fun _string -> _pointer)) 103 | (define-libgl glXGetProcAddressARB (_fun _string -> _pointer)) 104 | (λ (str type) 105 | (cast (glXGetProcAddress str) _pointer type))] 106 | ['macosx 107 | (define gl-lib 108 | ;(ffi-lib "/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL")) 109 | (ffi-lib "/System/Library/Frameworks/OpenGL.framework/OpenGL")) 110 | (λ (str type) 111 | (get-ffi-obj str gl-lib type))])) 112 | 113 | (define-syntax (define-gl stx) 114 | (syntax-parse stx 115 | [(_ name type) 116 | #`(define name (gl-get-proc-address #,(symbol->string (syntax->datum #'name)) type))])) 117 | 118 | (define-gl glGetIntegerv (_fun _gl-enum [out : (_ptr o _gl-int)] -> _void -> out)) 119 | (define-gl glGetInteger64v (_fun _gl-enum [out : (_ptr o _gl-int64)] -> _void -> out)) 120 | (define-gl glGetError (_fun -> _gl-enum)) 121 | (define-gl glGenVertexArrays (_fun _gl-sizei [out : (_ptr o _gl-uint)] -> _void -> out)) 122 | (define-gl glBindVertexArray (_fun _gl-uint -> _void)) 123 | (define (glDeleteVertexArrays arr) 124 | (define-gl glDeleteVertexArrays (_fun _gl-sizei _u32vector -> _void)) 125 | (glDeleteVertexArrays (vector-length arr) arr)) 126 | (define-gl glGenBuffers (_fun _gl-sizei [out : (_ptr o _gl-uint)] -> _void -> out)) 127 | (define-gl glBindBuffer (_fun _gl-uint -> _void)) 128 | (define-gl glBufferData (_fun _gl-enum _gl-sizei-ptr _pointer _gl-enum -> _void)) 129 | (define (glDeleteBuffers buffers) 130 | (define-gl glDeleteBuffers (_fun _gl-sizei _u32vector -> _void)) 131 | (glDeleteBuffers (vector-length buffers) buffers)) 132 | (define-gl glGenTextures (_fun _gl-enum [out : (_ptr o _gl-uint)] -> _void -> out)) 133 | (define-gl glBindTexture (_fun _gl-uint -> _void)) 134 | (define (glDeleteTextures texs) 135 | (define-gl glDeleteTextures (_fun _gl-sizei _u32vector -> _void)) 136 | (glDeleteTextures (vector-length texs) texs)) 137 | (define-gl glActiveTexture (_fun _gl-enum -> _void)) 138 | (define-gl glTexImage2D 139 | (_fun _gl-enum _gl-int _gl-int _gl-sizei _gl-sizei _gl-int _gl-enum _gl-enum _gl-pointer -> _void)) 140 | (define-gl glTexParameteri (_fun _gl-enum _gl-enum _gl-int -> _void)) 141 | (define-gl glCreateShader (_fun _gl-enum -> _gl-uint)) 142 | (define (glShaderSource type sources) 143 | (define-gl glShaderSource (_fun _gl-uint _gl-sizei (_vector i _string) _s32vector -> _void)) 144 | (glShaderSource type (vector-length sources) sources (vector-map string-length sources))) 145 | (define-gl glCompileShader (_fun _gl-uint -> _void)) 146 | (define-gl glCreateProgram (_fun -> _gl-uint)) 147 | (define-gl glAttachShader (_fun _gl-uint _gl-uint -> _void)) 148 | (define-gl glLinkProgram (_fun _gl-uint -> _void)) 149 | (define-gl glDetachShader (_fun _gl-uint _gl-uint -> _void)) 150 | (define-gl glDeleteShader (_fun _gl-uint -> _void)) 151 | (define-gl glUseProgram (_fun _gl-uint -> _void)) 152 | (define-gl glGetUniformLocation (_fun _gl-uint _string -> _gl-int)) 153 | (define-gl glViewport (_fun _gl-int _gl-int _gl-sizei _gl-sizei -> _void)) 154 | (define-gl glClearColor (_fun _gl-clampf _gl-clampf _gl-clampf _gl-clampf -> _void)) 155 | (define-gl glClear (_fun _gl-buffer-mask -> _void)) 156 | (define-gl glUniform1i (_fun _gl-int _gl-int -> _void)) 157 | (define-gl glEnableVertexAttribArray (_fun _gl-uint -> _void)) 158 | (define-gl glDisableVertexAttribArray (_fun _gl-uint -> _void)) 159 | (define-gl glVertexAttribPointer 160 | (_fun _gl-uint _gl-int _gl-enum _gl-boolean _gl-sizei _pointer -> _void)) 161 | (define-gl glDrawArrays (_fun _gl-enum _gl-int _gl-sizei -> _void)) 162 | (define-gl glTexSubImage2D 163 | (_fun _gl-enum _gl-int _gl-int _gl-int _gl-sizei _gl-sizei _gl-enum _gl-enum _pointer -> _void)) 164 | 165 | #| 166 | (require racket/gui/base 167 | racket/class) 168 | (define f (new frame% [label "hello"])) 169 | (define c (new canvas% 170 | [parent f] 171 | [style '(gl no-autoclear)])) 172 | (send c with-gl-context 173 | (λ () 174 | (displayln (glGetIntegerv GL-MAJOR-VERSION)) 175 | (displayln (glGetIntegerv GL-MINOR-VERSION)))) 176 | |# 177 | -------------------------------------------------------------------------------- /LOG: -------------------------------------------------------------------------------- 1 | v0.2.3 2 | Date:TBD 3 | Commit#: TBD 4 | 5 | v0.2.2 6 | Date: 2019-04-30 7 | Commit#: aa958b5ab250c8a202b24444935255d773608ea6 8 | * Video can (sometimes) continue when there is an error in the video stream. 9 | - This is useful for webcams that are not completely standards compliant. 10 | * Video now works with FFmpeg 4. 11 | - Hopefully also with the infrastructure to make future upgrades easier. 12 | * Default Video quality much higher for mp4 files. 13 | * Add L-cut and J-cut functions to base API. 14 | * Add remove-video and remove-audio filters to base API. 15 | * Add a volume filter. 16 | * More work on live streaming. Some initial testing for windows. 17 | * Updare libvid, seems to work on windows now. 18 | 19 | 20 | v0.2.1 21 | Date: 2018-11-05 22 | Commit#: bc751bcf01f6def50f6d2262b9b9ec9dd679fabd 23 | * Fix bug allowing for transparent picture overlays. 24 | * Fix bug preventing `pict`s from being used in `multitrack`. 25 | * Add highpass/lowpass filters 26 | * Fix color filters when written out to mp4 files 27 | * Fix bug in composite-merge where rgb was separated into different videos. 28 | * Update `live-capture` (internal) data structure to use device indexes as well as strings. 29 | * Enable ffmpeg logging at the racket layer IF the FF_LOG environment variable is set to racket. 30 | * Add locks to fix potential inconsistent state in ffmpeg. 31 | * Add a 'mirror' option to the renderer, to output to multiple places at once. 32 | * Renderer can now split output into two files one for video, and one for audio. 33 | * Preview window works again with live webcams 34 | 35 | 36 | v0.2 37 | Date: 2018-09-02 38 | Commit#: 8828d1c287030691cbc12f75fb803265fc3d97bb 39 | * Complete rewrite of compiler (first two passes). 40 | - New compiler creates significantly more stable video programs. 41 | * Can now properly decode wav files 42 | * Remove explicit #:transitions/#:merges keywrods from playlists/filters. 43 | * Fixed bug preventing video from being compiled on systems without ffmpeg. 44 | - (Still requires ffmpeg to run.) 45 | * Improve video player stability. 46 | - Seek bar and counter much more reliable. 47 | - Disable some unstable features, to be enabled for the next release. 48 | * Minimum required version of Racket bumped to 7.0 49 | * Add a --prove flag to raco video to get information about media file. 50 | * When using the video player server, sound stops when the server is out of scope. 51 | * The video-player-server% object is now considerably easier to construct. 52 | * Add #:start/#:end/#:length as special keywords for clip function. 53 | 54 | v0.2-rc.2 55 | Date: 2018-08-13 56 | Commit#: 3ea58fd2b8d5f0b6d4df793fe5999396c570d5e0 57 | * Improve pause responsiveness 58 | * Add `-m` flag to play media files without a video program 59 | * Fix bug where audio wouldn't play on windows 60 | 61 | v0.2-rc.1 62 | Date: 2018-06-14 63 | Commit#: 392dc4290336207a2a7d7cb2781a3a371b62110c 64 | * Pause feature no longer additionally stops the video. 65 | * Improved audio/video syncing in live preview. 66 | * Fixed bugs in front half of Video compiler. 67 | * Made 'canvas' an optional parameter 68 | 69 | v0.2-rc 70 | Date: 2018-06-10 71 | Commit#: d65af7c7826210b6ba8c777bc83b2f4c535be2e7 72 | * Update Video to use a version of libvid that does not segfault. 73 | * More precise dependencies in Video's info file. 74 | * If FF_LOG=stdout, then do no redirection of ffmpeg's logging. 75 | * More complete render parameterization. 76 | * Cleaner error messages. 77 | * Fixed bug preventing Video from rendering audio-only files. 78 | 79 | v0.2-beta.1 80 | Date: 2017-09-20 81 | Commit#: 88b62773d0b444ecf8581c92780b59ed2425b961 82 | * Further documentation improvements. 83 | * Add support for slightly older versions of opengl 84 | * Improve the UI of the video preview tool. 85 | 86 | v0.2-beta 87 | Date: 2017-08-27 88 | Commit#: 12bdbe649bc4b733266e18d6da6df134ef4ebcce 89 | * Documentation Improvements to match the v0.2 API. 90 | * Create stable/testing/unstable(master) branches. 91 | * Fix deadlocks with the player, also solves sever segfaults 92 | * Increased stability of Video (it no longer seems to segfault). 93 | * Add infrastructure to lift ffmpeg logs into Racket logs (require libvid), disabled for this release. 94 | 95 | v0.2-alpha.3 96 | Date: 2017-08-09 97 | Commit#: 263ecfc1538b40539e40961c84ae36d1695d80f9 98 | * Audio works in live preview 99 | * Introduced concept of `merge` for multitrack, replaces transition 100 | * Transitions now only appear in playlists. 101 | * Add CI testing for windows builds 102 | * Add initial opengl bindings for windows. (The Racket ones don't) 103 | * Add legacy opengl support (for opengl v2.1+) 104 | * Remove now deprecated MLT bindings. 105 | 106 | v0.2-alpha.2 107 | Date: 2017-07-30 108 | Commit#: 44ee039ab2785de24c7b957dc9084f1e5d509239 109 | * Fix many bugs related to multitracks and the way it processes transitions 110 | * Fix concurrency bugs with live player. 111 | * Reintroduce most of the unit tests from the v0.1 build. 112 | * Add video/version to track the version more accurately than Racket's info.rkt system. 113 | * Add video-log and ffmpeg-log to print out debug messages. ffmpeg-log not yet hooked up. 114 | 115 | v0.2-alpha.1 116 | Date: 2017-07-18 117 | Commit#: d93040922586b9d29d07236bf727d2f90484cb31 118 | * Fix a few minor bugs preventing Video from running on Windows and Linux. We have now tested it on all three platforms. 119 | * Initial work on live preview. The player has now been updated to show the video in the player window. Additionally Video can now seek video outputs (as well as inputs). 120 | 121 | 122 | v0.2-alpha 123 | Date: 2017-07-11 124 | Commit#: 0dba5893097faef48b9e45900aefcd13137c27d3 125 | This is an alpha version of Video v0.2. The main update here is dropping MLT as a dependency, and bundling FFmpeg for Windows and Mac builds. As such, Video can be used out of the box on now, without the need to hunt down the more obscure MLT library separately. Linux machines must still download the correct version of FFmpeg themselves. However, this is much easier to do. 126 | 127 | Specifically, FFmpeg 3.2 is recommended, but the following specific library versions are also usable: 128 | 129 | * libavcodec v57 130 | * libavformat v57 131 | * libavutil v55 132 | * libswscale v4 133 | * libswresample v2 134 | * libavfilter v6 135 | 136 | Again, these are included for the mac/windows builds, and are all part of an FFmpeg 3.x installation. 137 | 138 | Some notes about why this is still alpha: 139 | 140 | * The video preview currently does not work. People needing access to this feature need to use v0.1.1. 141 | * Video has not been thoroughly tested 142 | 143 | Once the first one has been addressed we can move to beta, and once both have been addressed we can move to rc. 144 | 145 | 146 | 147 | v0.1.1: 148 | Date: 2017-06-12 149 | Commit#: ca7db7f85ab7f19f91e1f63907c275fecdc39349 150 | - Compatibility release for MLT. Development has shifted to the v0.2 line. 151 | - Initial support for FFMPEG. 152 | 153 | 154 | 155 | v0.1: 156 | Date: 2017-05-24 157 | Commit#: f83e0b2e45361c9e188ddd4f6a5e4c8be3c2c006 158 | - Actually adds #lang and syntax for video. 159 | - Adds minimal documentation, needs improvement. 160 | - Add video-editor% widget for DrRacket. 161 | - Build a proper rendering interface. 162 | - (No longer need to explicitly call out to MLT) 163 | - Videos are converted to MLT object automatically. 164 | - Added testing framework. 165 | - Added language forms for writing documentation for Video. 166 | - This was the release associated with the ICFP 2017 Paper: Super 8 Languages for Making Movies (DRAFT) 167 | 168 | 169 | 170 | v0.0: 171 | Date: 2016-11-11 172 | Commit#: 39112ec3b7fbc6b611a67cc5f9ac3c988c50f16d 173 | - First release of Video 174 | - Depends on MLT (not included) 175 | - API still very unstable 176 | - No language yet, just video library. 177 | - Must manually convert video object to MLT ones with `convert-to-mlt!` 178 | - Preview player added. 179 | - This was the version used to build the RacketCon 2016 videos. 180 | -------------------------------------------------------------------------------- /video/private/devices.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2019 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | ;; This module provides helper functions for accessing 20 | ;; I/O devices Video can make use of. 21 | 22 | (provide (all-defined-out)) 23 | (require racket/match 24 | racket/set 25 | racket/logging 26 | "render-settings.rkt" 27 | "ffmpeg/main.rkt" 28 | "ffmpeg-pipeline.rkt" 29 | "init.rkt" 30 | "log.rkt") 31 | 32 | (struct input-devices (video 33 | screen-capture 34 | audio) 35 | #:transparent) 36 | (define (mk-input-devices #:video [v '()] 37 | #:screen-capture [sc '()] 38 | #:audio [a '()]) 39 | (input-devices v sc a)) 40 | 41 | (define (list-input-devices [dev #f]) 42 | (define os-dev 43 | (or dev 44 | (match (system-type 'os) 45 | ['macosx "avfoundation"] 46 | ['unix #f] 47 | ['windows "dshow"]))) 48 | (define log-filter 49 | (match (system-type 'os) 50 | ['macosx "AVFoundation input device"] 51 | ['unix #f] 52 | ['windows "dshow"])) 53 | (match (system-type 'os) 54 | ['unix 55 | (define vid-fmt (av-find-input-format "v4l2")) 56 | (define vid-ctx (avformat-alloc-context)) 57 | (define video-found? 58 | (with-handlers ([exn:fail? (λ (e) #f)] 59 | [exn:ffmpeg:fail? (λ (e) #f)]) 60 | (avformat-open-input vid-ctx "" vid-fmt #f) 61 | #t)) 62 | (define aud-fmt (av-find-input-format "alsa")) 63 | (define aud-ctx (avformat-alloc-context)) 64 | (define audio-found? 65 | (with-handlers ([exn:fail? (λ (e) #f)]) 66 | (avformat-open-input aud-ctx "" aud-fmt #f) 67 | #t)) 68 | (mk-input-devices #:video (if video-found? (list-devices/avdevice vid-ctx) '()) 69 | #:audio (if audio-found? (list-devices/avdevice aud-ctx) '()))] 70 | [(or 'windows 'macosx) 71 | (define video-devices-str 72 | (match (system-type 'os) 73 | ['macosx "AVFoundation video devices:"] 74 | ['windows "DirectShow video devices"])) 75 | (define audio-devices-str 76 | (match (system-type 'os) 77 | ['macosx "AVFoundation audio devices:"] 78 | ['windows "DirectShow audio devices"])) 79 | (define dev-regexp 80 | (match (system-type 'os) 81 | ['macosx #rx"\\[[0-9]*\\] (.*)"] 82 | ['windows #rx" \"(.*)\""])) 83 | 84 | (define curr-list (box #f)) 85 | (define video-list (box '())) 86 | (define audio-list (box '())) 87 | 88 | (flush-ffmpeg-log!) 89 | (with-intercepted-logging 90 | (λ (l) 91 | (match l 92 | [(vector level message data topic) 93 | (match message 94 | [(regexp video-devices-str) 95 | (set-box! curr-list video-list)] 96 | [(regexp audio-devices-str) 97 | (set-box! curr-list audio-list)] 98 | [_ 99 | (define dev-name (cadr (regexp-match dev-regexp message))) 100 | (set-box! (unbox curr-list) 101 | (cons dev-name (unbox (unbox curr-list))))])])) 102 | (λ () 103 | (define fmt (av-find-input-format os-dev)) 104 | (define ctx (avformat-alloc-context)) 105 | (with-handlers* ([exn:ffmpeg:fail? 106 | (λ (e) 107 | (log-video-info "Recieved (probably) expected error ~a" e))]) 108 | (avformat-open-input ctx "" fmt (build-av-dict (hash "list_devices" "true")))) 109 | (flush-ffmpeg-log!)) 110 | #:logger ffmpeg-logger 111 | 'info 112 | (string->symbol log-filter)) 113 | (mk-input-devices #:video (reverse (unbox video-list)) 114 | #:audio (reverse (unbox audio-list)))] 115 | [_ 116 | (error "Not yet implemented for this platform")])) 117 | 118 | ;; Create a strean bundle out of a video/audio input device 119 | ;; The render-settings are determined by the `input-device` datatype 120 | ;; 121 | ;; (or/c nonnegative-integer? string?) 122 | ;; (or/c nonnegative-integer? string?) 123 | ;; render-settings -> stream-bundle 124 | (define (devices->stream-bundle video-dev audio-dev 125 | settings) 126 | (match settings 127 | [(struct* render-settings ([width width] 128 | [height height] 129 | [fps fps] 130 | [pix-fmt pix-fmt] 131 | [probesize probesize] 132 | [rtbufsize rtbufsize])) 133 | (define stream-name ; <- Only needed for debugging 134 | (match (system-type 'os) 135 | ['macosx (format "AVFoundation: ~a:~a" video-dev audio-dev)] 136 | ['unix (or video-dev audio-dev)] 137 | [_ #f])) 138 | (define os-dev 139 | (match (system-type 'os) 140 | ['macosx "avfoundation"] 141 | ['unix (if video-dev "v4l2" "alsa")] 142 | ['windows "dshow"] 143 | [_ 144 | (error "Not yet implemented for this platform")])) 145 | (define dev-spec 146 | (match (system-type 'os) 147 | ['macosx (format "~a:~a" (or video-dev "none") (or audio-dev "none"))] 148 | ['unix (or video-dev audio-dev)] 149 | ['windows 150 | (define vid-str (format "video=\"~a\"" video-dev)) 151 | (define aud-str (format "audio=\"~a\"" audio-dev)) 152 | (if (and vid-str aud-str) 153 | (format "~a:~a" vid-str aud-str) 154 | (or vid-str aud-str))] 155 | [_ 156 | (error "Not yet implemented for this platform")])) 157 | (define fmt (av-find-input-format os-dev)) 158 | (define ctx (avformat-alloc-context)) 159 | (define input-ctx 160 | (avformat-open-input ctx dev-spec fmt 161 | (if video-dev 162 | (build-av-dict 163 | (let* ([r (hash)] 164 | [r (if rtbufsize 165 | (hash-set r "rtbufsize" (format "~a" rtbufsize)) 166 | r)] 167 | [r (if probesize 168 | (hash-set r "probesize" (format "~a" probesize)) 169 | r)] 170 | [r (if (and width height) 171 | (hash-set r "video_size" (format "~ax~a" width height)) 172 | r)] 173 | [r (if fps 174 | (hash-set r "framerate" (format "~a" fps)) 175 | r)] 176 | [r (if pix-fmt 177 | (hash-set r "pixel_format" (format "~a" pix-fmt)) 178 | r)]) 179 | r)) 180 | #f))) 181 | (avformat-context->stream-bundle input-ctx stream-name 182 | #:volatile? #t)])) 183 | -------------------------------------------------------------------------------- /video/scribblings/render.scrbl: -------------------------------------------------------------------------------- 1 | #lang reader video/scribblings/viddoclang 2 | 3 | @;{ 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | @title{Rendering} 20 | @defmodule[video/render] 21 | 22 | The renderer in this section describes the API for rendering 23 | Video files. A simpler interface is to use the @exec{raco 24 | video} tool described in @secref["raco-video"]. 25 | 26 | @section{Render API} 27 | 28 | @defproc[(render [data video?] 29 | [dest (or/c path path-string? #f) "out.mp4"] 30 | [#:dest-filename dest-filename (or/c path-element? string? #f) #f] 31 | [#:render-mixin render-mixin 32 | (-> (is-a?/c render<%>) (is-a?/c render<%>)) 33 | values] 34 | [#:width width nonnegative-integer? 1920] 35 | [#:height height nonnegative-integer? 1080] 36 | [#:start start (or/c nonnegative-integer? #f) #f] 37 | [#:end end (or/c nonnegative-integer? #f) #f] 38 | [#:fps fps (>=/c 0) 25]) 39 | void?]{ 40 | 41 | Renders a video object. This function is completely 42 | synchronous and it is impossible to determine the progress 43 | within Racket. If being asynchronous or just determining 44 | progress is important, use @racket[render/async]. 45 | 46 | @racket[data] is any @racket[video?] object. This can be 47 | set with either @racket[external-video] or any argument that 48 | creates a video object, @racket[playlist] or @racket[clip] for example. 49 | 50 | @racket[dest] is the output file. If the path is relative 51 | it is resolved against @racket[current-directory]. The 52 | output format can be auto-detected by the extension of the 53 | @racket[dest] file. For example, the renderer will produce 54 | an @tt{MP4} file (with appropriate codecs) for a file ending 55 | in @filepath{.mp4}. 56 | 57 | The @racket[render-mixin] parameter specifics an optional 58 | mixin for the renderer. This is useful for altering the 59 | behavior of the renderer, such as to render to an OpenGL 60 | context. 61 | 62 | The @racket[start], @racket[end], @racket[width], and 63 | @racket[height] parameters are all optional, and set their 64 | relative properties in resulting output. Additional options 65 | exist when using the @racket[render%] class directly.} 66 | 67 | @defproc[(render/async [data video?] 68 | [dest (or/c path path-string? #f) "out.mp4"] 69 | [#:dest-filename dest-filename (or/c path-element? string? #f) #f] 70 | [#:render-mixin render-mixin 71 | (-> (is-a?/c render<%>) (is-a?/c render<%>)) 72 | values] 73 | [#:width width nonnegative-integer? 1920] 74 | [#:height height nonnegative-integer? 1080] 75 | [#:start start (or/c nonnegative-integer? #f) #f] 76 | [#:end end (or/c nonnegative-integer? #f) #f] 77 | [#:fps fps (>=/c 0) 25] 78 | [#:mode mode (or/c 'verbose #f) #f]) 79 | (values async-channel? (-> void?))]{ 80 | 81 | Similar to @racket[render], but runs asynchronously. This 82 | is useful for determining the status while still rendering. 83 | 84 | When called, the @racket[render/aync] function begins 85 | rendering and immediately returns an output channel. While 86 | rendering, it places its current status on the channel. The 87 | renderer puts @racket[eof] on the channel to signal that it 88 | has finished and will send no more messages. 89 | 90 | If the optional @racket[mode] flag is set to 91 | @racket['verbose], then the renderer will additionally 92 | return status messages.} 93 | 94 | @defproc[(render/pretty [data video?] 95 | [dest (or/c path path-string? #f) "out.mp4"] 96 | [#:dest-filename dest-filename (or/c path-element? string? #f) #f] 97 | [#:render-mixin render-mixin 98 | (-> (is-a?/c render<%>) (is-a?/c render<%>)) 99 | values] 100 | [#:width width nonnegative-integer? 1920] 101 | [#:height height nonnegative-integer? 1080] 102 | [#:start start (or/c nonnegative-integer? #f) #f] 103 | [#:end end (or/c nonnegative-integer? #f) #f] 104 | [#:fps fps (>=/c 0) 25] 105 | [#:port port (or/c output-port? #f) #f] 106 | [#:mode mode (or/c 'verbose #f)]) 107 | void?]{ 108 | 109 | Similar to @racket[render/async], but will run 110 | synchronously. Additionally, rather than making a channel 111 | and sending data to that channel, the result will be printed to @racket[current-output-port]. 112 | 113 | If @racket[port] is provided, then the output will be sent 114 | to that port rather than #racket[current-output-port]. 115 | 116 | This function is designed to be used directly when repl-like interaction is desired.} 117 | 118 | @section{Render Class} 119 | 120 | The @racket[render%] class interface provides a more 121 | low-level access to Video's rendering interface. Using the 122 | @racket[render] function directly is preferred. 123 | 124 | @deprecated-text{Unlike the previous section, the 125 | @racket[render%] class is unstable. It should remain stable 126 | between patch releases, but can change between minor releases.} 127 | 128 | @defclass[render% object% (render<%>)]{ 129 | 130 | The class used for rendering. By default it outputs the 131 | video directly to the screen. Mixins can be used to extend 132 | this class to change what it outputs too. 133 | 134 | 135 | 136 | @defconstructor[([source video?])]{ 137 | 138 | Constructs the Renderer for the given video 139 | @racket[source]. The renderer can process the video multiple 140 | times, but setup must be called in between uses.} 141 | 142 | @defmethod[(setup [settings render-settings?]) void?]{ 143 | 144 | Sets up the render properties (width, height, etc.). Must 145 | be called between each use of @racket[start-rendering].} 146 | 147 | @defmethod[(start-rendering) void?] 148 | @defmethod[(stop-rendering) void?]} 149 | 150 | @definterface[render<%> ()]{ 151 | An interface for the @racket[render%] class. 152 | } 153 | 154 | @section{Render Settings} 155 | 156 | The @racket[render-settings] struct determines the available settings when rendering. 157 | 158 | @defproc[(render-settings? [settings any/c]) boolean?]{ 159 | 160 | Returns @racket[#t] if @racket[settings] is a 161 | @racket[render-settings?], @racket[#f] otherwise.} 162 | 163 | @defproc[(make-render-settings [#:destination dest (or/c path? path-string? #f) #f] 164 | [#:width width (and/c integer? positive?) 1920] 165 | [#:height height (and/c integer? positive?) 1080] 166 | [#:start start (or/c (and/c real? (>=/c 0)) #f) #f] 167 | [#:end end (or/c (and/c real? (>=/c 0)) #f) #f] 168 | [#:fps fps real? 30] 169 | [#:format format (or/c symbol? #f) #f] 170 | [#:video-codec video-codec (or/c symbol? #f) #f] 171 | [#:audio-codec audio-codec (or/c symbol? #f) #f] 172 | [#:subtitle-codec subtitle-codec (or/c symbol? #f) #f] 173 | [#:pix-fmt pix-fmt symbol? 'yuv420p] 174 | [#:sample-fmt sample-fmt symbol? 'fltp] 175 | [#:sample-rate sample-rate (and/c real? positive?) 44100] 176 | [#:channel-layout channel-layout symbol? 'stereo] 177 | [#:speed speed real? 1]) 178 | render-settings?]{ 179 | 180 | Constructs a @racket[render-settings?] object. Every field is optional. 181 | } 182 | -------------------------------------------------------------------------------- /video/scribblings/extend.scrbl: -------------------------------------------------------------------------------- 1 | #lang reader video/scribblings/viddoclang 2 | 3 | @;{ 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | @title{Extending Video} 20 | 21 | @defmodule[video/convert] 22 | 23 | Video offers several extension points. Both for adding new 24 | syntactic forms into the language, as well as new video 25 | primitives. There is some overlap in what the extensions are 26 | capable of, but each are useful in different circumstances. 27 | 28 | @colorize[#:color "red"]{ 29 | The documentation in this section needs a lot of work.} 30 | 31 | @section{Video Convert} 32 | 33 | @defproc[(video-convertible? [obj any/c]) 34 | boolean?] 35 | @defproc[(video-convert [obj any/c]) 36 | video?] 37 | @defthing[prop:video-convertible struct-type-property?] 38 | @defthing[prop:video-convertible? struct-type-property?] 39 | 40 | @section{Conversion Database} 41 | 42 | @defclass[convert-database% object% ()]{ 43 | @defmethod[(register-conversion [predicate (-> any/c boolean?)] 44 | [converter (-> any/c video?)]) 45 | video?] 46 | @defmethod[(convert [object any/c]) 47 | video?] 48 | @defmethod[(maybe-convert [object any/c]) 49 | (or/c video? #f)] 50 | @defmethod[(convertible? [object any/c]) 51 | boolean?]} 52 | 53 | @section{Core Forms} 54 | 55 | @defmodule[video/surface] 56 | 57 | Video also has basic syntax for creating new types of 58 | producers, transitions, merges, and filters. This API is still 59 | experimental and may change with little notice. Proceed with 60 | caution. 61 | 62 | These forms are for defining producers, filters, transitions, and merges. 63 | Also the forms for building their contracts and writing 64 | their documentation. 65 | 66 | @defform[(define-producer function-header 67 | maybe-subgraph 68 | maybe-properties 69 | maybe-user-properties 70 | body ...) 71 | #:grammar 72 | [(maybe-subgraph (code:line) 73 | (code:line #:subgraph subgraph)) 74 | (maybe-properties (code:line) 75 | (code:line #:properties properties)) 76 | (maybe-user-properties (code:line) 77 | (code:line #:user-properties user-properties))] 78 | #:contracts ([subgraph (or/c procedure? #f)] 79 | [properties procedure?])]{ 80 | } 81 | 82 | @defform[(->producer [extra-args ...] [optional-args ...] maybe-ret) 83 | #:grammar 84 | [(maybe-ret (code:line) 85 | return)]]{ 86 | } 87 | 88 | @defform[(defproducer prototype maybe-return content ...) 89 | #:grammar 90 | [(prototype (id arg-spec ...) 91 | (prototype arg-spec ...)) 92 | (maybe-ret (code:line) 93 | #:return ret)]]{ 94 | } 95 | 96 | @defform[(define-filter function-header 97 | maybe-subgraph 98 | maybe-properties 99 | maybe-source-properties 100 | maybe-user-properties 101 | body ...) 102 | #:grammar 103 | [(maybe-subgraph (code:line) 104 | (code:line #:subgraph subgraph)) 105 | (maybe-properties (code:line) 106 | (code:line #:properties properties)) 107 | (maybe-user-properties (code:line) 108 | (code:line #:user-properties user-properties)) 109 | (maybe-source-properties (code:line) 110 | (code:line #:source-props source-properties))] 111 | #:contracts ([subgraph (or/c procedure? #f)] 112 | [properties procedure?] 113 | [source-props procedure?])]{ 114 | } 115 | 116 | @defform[(->filter [extra-args ...] [optional-args ...] maybe-ret) 117 | #:grammar 118 | [(maybe-ret (code:line) 119 | return)]]{ 120 | } 121 | 122 | @defform[(deffilter prototype maybe-return content ...) 123 | #:grammar 124 | [(prototype (id arg-spec ...) 125 | (prototype arg-spec ...)) 126 | (maybe-ret (code:line) 127 | #:return ret)]]{ 128 | } 129 | 130 | @defform[(define-transition function-header 131 | maybe-track1-subgraph 132 | maybe-track2-subgraph 133 | maybe-combined-subgraph 134 | maybe-properties 135 | maybe-source-properties 136 | maybe-user-properties 137 | maybe-producer-1 138 | maybe-producer-2 139 | body ...) 140 | #:grammar 141 | [(maybe-track1-subgraph (code:line) 142 | (code:line #:track1-subgraph subgraph)) 143 | (maybe-track2-subgraph (code:line) 144 | (code:line #:track2-subgraph subgraph)) 145 | (maybe-combined-subgraph (code:line) 146 | (code:line #:combined-subgraph subgraph)) 147 | (maybe-properties (code:line) 148 | (code:line #:properties properties)) 149 | (maybe-user-properties (code:line) 150 | (code:line #:user-properties user-properties)) 151 | (maybe-source-properties (code:line) 152 | (code:line #:source-props source-properties)) 153 | (maybe-prod1 (code:line) 154 | (code:line #:prod-1 prod1-id)) 155 | (maybe-prod2 (code:line) 156 | (code:line #:prod-2 prod2-id))] 157 | #:contracts ([subgraph (or/c procedure? #f)] 158 | [properties procedure?] 159 | [source-props procedure?])]{ 160 | } 161 | 162 | @defform[(->transition [extra-args ...] [optional-args ...] maybe-ret) 163 | #:grammar 164 | [(maybe-ret (code:line) 165 | return)]]{ 166 | } 167 | 168 | @defform[(deftransition prototype maybe-return content ...) 169 | #:grammar 170 | [(prototype (id arg-spec ...) 171 | (prototype arg-spec ...)) 172 | (maybe-ret (code:line) 173 | #:return ret)]]{ 174 | } 175 | 176 | @defform[(define-merge function-header 177 | maybe-track1-subgraph 178 | maybe-track2-subgraph 179 | maybe-combined-subgraph 180 | maybe-properties 181 | maybe-source-properties 182 | maybe-user-properties 183 | maybe-producer-1 184 | maybe-producer-2 185 | body ...) 186 | #:grammar 187 | [(maybe-track1-subgraph (code:line) 188 | (code:line #:track1-subgraph subgraph)) 189 | (maybe-track2-subgraph (code:line) 190 | (code:line #:track2-subgraph subgraph)) 191 | (maybe-combined-subgraph (code:line) 192 | (code:line #:combined-subgraph subgraph)) 193 | (maybe-properties (code:line) 194 | (code:line #:properties properties)) 195 | (maybe-user-properties (code:line) 196 | (code:line #:user-properties user-properties)) 197 | (maybe-source-properties (code:line) 198 | (code:line #:source-props source-properties)) 199 | (maybe-prod1 (code:line) 200 | (code:line #:prod-1 prod1-id)) 201 | (maybe-prod2 (code:line) 202 | (code:line #:prod-2 prod2-id))] 203 | #:contracts ([subgraph (or/c procedure? #f)] 204 | [properties procedure?] 205 | [source-props procedure?])]{ 206 | } 207 | 208 | @defform[(->merge [extra-args ...] [optional-args ...] maybe-ret) 209 | #:grammar 210 | [(maybe-ret (code:line) 211 | return)]]{ 212 | } 213 | 214 | @defform[(defmerge prototype maybe-return content ...) 215 | #:grammar 216 | [(prototype (id arg-spec ...) 217 | (prototype arg-spec ...)) 218 | (maybe-ret (code:line) 219 | #:return ret)]]{ 220 | } 221 | 222 | -------------------------------------------------------------------------------- /video/raco.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require racket/cmdline 20 | racket/file 21 | racket/path 22 | racket/match 23 | racket/runtime-path 24 | "base.rkt" 25 | "render.rkt" 26 | "convert.rkt" 27 | "private/ffmpeg/ffmpeg.rkt") 28 | ;; Only require this if the -p flag is given, it requires gtk. 29 | ;; (require "player.rkt") 30 | 31 | (define output-path (make-parameter (build-path (current-directory) "out.mp4"))) 32 | (define output-type (make-parameter #f)) 33 | (define output-video-codec (make-parameter 'h264)) 34 | (define output-video? (make-parameter #t)) 35 | (define output-audio? (make-parameter #t)) 36 | (define output-audio-codec (make-parameter 'aac)) 37 | (define output-subtitle-codec (make-parameter #f)) 38 | (define output-pixel-format (make-parameter 'yuv420p)) 39 | (define output-sample-format (make-parameter 'fltp)) 40 | (define output-sample-rate (make-parameter '44100)) 41 | (define output-channel-layout (make-parameter 'stereo)) 42 | (define output-width (make-parameter 1920)) 43 | (define output-height (make-parameter 1080)) 44 | (define output-start (make-parameter #f)) 45 | (define output-end (make-parameter #f)) 46 | (define output-fps (make-parameter 30)) 47 | (define output-verbose (make-parameter #f)) 48 | (define output-silent (make-parameter #f)) 49 | (define output-preview? (make-parameter #f)) 50 | (define output-vframes (make-parameter #f)) 51 | (define output-aframes (make-parameter #f)) 52 | (define output-dframes (make-parameter #f)) 53 | (define input-media? (make-parameter #f)) 54 | (define probe-media? (make-parameter #f)) 55 | 56 | (define rendering-box (box #f)) 57 | 58 | (define (cmd-str->num who val) 59 | (define ret (string->number val)) 60 | (unless ret 61 | (raise-user-error '|raco video| "The ~a parameter must be a number" val)) 62 | ret) 63 | 64 | (define-runtime-path here ".") 65 | 66 | (module+ main 67 | (define video-string 68 | (command-line 69 | #:program "video" 70 | #:once-any 71 | [("--enable-video") "Enable Video Output" 72 | (output-video? #t)] 73 | [("--disable-video") "Disable Video Output" 74 | (output-video? #f)] 75 | #:once-any 76 | [("--enable-audio") "Enable Audio Output" 77 | (output-audio? #t)] 78 | [("--disable-audio") "Disable Audio Output" 79 | (output-audio? #f)] 80 | #:once-each 81 | [("-f" "--format") format 82 | "Output type" 83 | (output-type (string->symbol format))] 84 | [("--video-codec") video-codec 85 | "Output video codec" 86 | (output-video-codec (string->symbol video-codec))] 87 | [("--audio-codec") audio-codec 88 | "Output audio codec" 89 | (output-audio-codec (string->symbol audio-codec))] 90 | [("--subtitle-codec") subtitle-codec 91 | "Output subtitle codec" 92 | (output-subtitle-codec (string->symbol subtitle-codec))] 93 | [("--pixel-format") pixel-format 94 | "Output pixel format" 95 | (output-pixel-format (string->symbol pixel-format))] 96 | [("--sample-format") sample-format 97 | "Output sample format" 98 | (output-sample-format (string->symbol sample-format))] 99 | [("--sample-rate") sample-rate 100 | "Output sample rate" 101 | (output-sample-rate (cmd-str->num "--sample-rate" sample-rate))] 102 | [("--channel-layout") channel-layout 103 | "Output channel layout" 104 | (output-channel-layout (string->symbol channel-layout))] 105 | [("-o" "--out") file 106 | "Output File" 107 | (output-path (path->complete-path file))] 108 | [("-w" "--width") width 109 | "Video width" 110 | (output-width (cmd-str->num "--width" width))] 111 | [("-l" "--height") height 112 | "Video height" 113 | (output-height (cmd-str->num "--height" height))] 114 | [("-s" "--start") start 115 | "Rendering start start" 116 | (output-start (cmd-str->num "--start" start))] 117 | [("-e" "--end") end 118 | "Rendering end position" 119 | (output-end (cmd-str->num "--end" end))] 120 | [("--fps") fps 121 | "Rendering FPS" 122 | (output-fps (cmd-str->num "--fps" fps))] 123 | [("--vframes") vframes 124 | "Number of video frames to output" 125 | (output-vframes (cmd-str->num "--vframes" vframes))] 126 | [("--aframes") aframes 127 | "Number of audio frames to output" 128 | (output-aframes (cmd-str->num "--aframes" aframes))] 129 | [("--dframes") dframes 130 | "Number of data frames to output" 131 | (output-dframes (cmd-str->num "--dframes" dframes))] 132 | [("-v" "--verbose") "Output a copy of the graph used for rendering" 133 | (output-verbose #t)] 134 | [("-q" "--silent") "Do not print any output, used for scripts" 135 | (output-silent #t)] 136 | [("-p" "--preview") "Preview the output in a player" 137 | (output-preview? #t)] 138 | [("-m" "--media") "Play or encode a media file directly" 139 | (input-media? #t)] 140 | [("--probe") "Probe a media file" 141 | (probe-media? #t)] 142 | #:args (video) 143 | video)) 144 | 145 | (define video-path 146 | (with-handlers ([exn:fail 147 | (λ (e) 148 | (raise-user-error '|raco video| 149 | "The file parameter must be a path, given: ~a" 150 | video-string))]) 151 | (string->path video-string))) 152 | 153 | (define video 154 | (if (input-media?) 155 | (clip video-path) 156 | (dynamic-require video-path 'vid))) 157 | 158 | (define render-mixin 159 | #f 160 | #; 161 | (match (output-type) 162 | ["mp4" mp4:render-mixin] 163 | ["jpg" jpg:render-mixin] 164 | ["png" png:render-mixin] 165 | ["xml" xml:render-mixin] 166 | [_ #f])) 167 | 168 | (when (probe-media?) 169 | (av-log-set-callback av-log-default-callback)) 170 | 171 | (cond 172 | [(output-preview?) 173 | (define preview (dynamic-require (build-path here "player.rkt") 'player)) 174 | (void (preview video #:convert-database (make-base-database)))] 175 | [else 176 | (match (output-type) 177 | [_ ;(or "png" "jpg" "mp4" "xml") 178 | (render/pretty video (output-path) 179 | #:probe? (probe-media?) 180 | #:convert-database (make-base-database) 181 | #:start (output-start) 182 | #:end (output-end) 183 | #:width (output-width) 184 | #:height (output-height) 185 | #:render-mixin render-mixin 186 | #:render-video? (output-video?) 187 | #:render-audio? (output-audio?) 188 | #:format (output-type) 189 | #:sample-fmt (output-sample-format) 190 | #:pix-fmt (output-pixel-format) 191 | #:mode (cond 192 | [(output-silent) 'silent] 193 | [(output-verbose) 'verbose] 194 | [else #f]))])])) 195 | #| 196 | (newline) 197 | (let loop () 198 | (let () 199 | (define r (unbox rendering-box)) 200 | (when r 201 | (define len (get-rendering-length r)) 202 | (define pos (get-rendering-position r)) 203 | (if len 204 | (printf "\r~a/~a (~a%) " pos len (* (/ pos len) 100.0)) 205 | (displayln "Unbounded Video")))) 206 | (sleep 1) 207 | (if (thread-running? t) 208 | (loop) 209 | (newline)))] 210 | [_ (void (preview video))])) 211 | |# 212 | -------------------------------------------------------------------------------- /video/private/ffmpeg/lib.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2018 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (provide (all-defined-out)) 20 | (require racket/match 21 | racket/function 22 | racket/list 23 | ffi/unsafe 24 | ffi/unsafe/define 25 | ffi/unsafe/define/conventions 26 | "../log.rkt" 27 | (for-syntax syntax/parse 28 | racket/syntax 29 | racket/base)) 30 | 31 | (struct exn:ffmpeg exn ()) 32 | (struct exn:ffmpeg:lib exn:ffmpeg ()) 33 | (struct exn:ffmpeg:again exn:ffmpeg ()) 34 | (struct exn:ffmpeg:eof exn:ffmpeg ()) 35 | (struct exn:ffmpeg:flush exn:ffmpeg ()) 36 | (struct exn:ffmpeg:stream-not-found exn:ffmpeg ()) 37 | (struct exn:ffmpeg:decoder-not-found exn:ffmpeg ()) 38 | (struct exn:ffmpeg:version exn:ffmpeg ()) 39 | (struct exn:ffmpeg:fail exn:ffmpeg (name message env)) 40 | (struct exn:ffmpeg:fail:decode exn:ffmpeg:fail ()) 41 | 42 | ;; =================================================================================================== 43 | 44 | (define (raise-ffmpeg-error name message . env) 45 | (raise (exn:ffmpeg:fail (format "~a : ~a" name message) (current-continuation-marks) name message 46 | (apply hash env)))) 47 | 48 | ;; =================================================================================================== 49 | 50 | (define ffmpeg-min-version "3.2") 51 | (define ffmpeg-rec-version "4.0") 52 | 53 | (define lib-prefix 54 | (match (system-type 'os) 55 | ['windows ""] 56 | [_ "lib"])) 57 | 58 | (define (ffmpeg-not-installed) 59 | (log-video-error "FFmpeg NOT installed.") 60 | #f) 61 | 62 | (define (((error-not-installed name)) . rest) 63 | (error name "FFmpeg not installed")) 64 | 65 | ;; The ordering of these libraries matters. 66 | ;; This is the order of dependencies so that Racket can 67 | ;; resolve it. 68 | (void 69 | (match (system-type 'os) 70 | ['macosx (ffi-lib (string-append lib-prefix "openh264") "4")] 71 | [_ (void)])) 72 | (define avutil-lib 73 | (ffi-lib (string-append lib-prefix "avutil") '("56" "55" #f) 74 | #:fail ffmpeg-not-installed)) 75 | (define-ffi-definer define-avutil avutil-lib 76 | #:default-make-fail error-not-installed 77 | #:make-c-id convention:hyphen->underscore) 78 | (define swresample-lib 79 | (ffi-lib (string-append lib-prefix "swresample") '("3" "2" #f) 80 | #:fail ffmpeg-not-installed)) 81 | (define-ffi-definer define-swresample swresample-lib 82 | #:default-make-fail error-not-installed 83 | #:make-c-id convention:hyphen->underscore) 84 | (define swscale-lib 85 | (ffi-lib (string-append lib-prefix "swscale") '("5" "4" #f) 86 | #:fail ffmpeg-not-installed)) 87 | (define-ffi-definer define-swscale swscale-lib 88 | #:default-make-fail error-not-installed 89 | #:make-c-id convention:hyphen->underscore) 90 | (define avcodec-lib 91 | (ffi-lib (string-append lib-prefix "avcodec") '("58" "57" #f) 92 | #:fail ffmpeg-not-installed)) 93 | (define-ffi-definer define-avcodec avcodec-lib 94 | #:default-make-fail error-not-installed 95 | #:make-c-id convention:hyphen->underscore) 96 | (define avformat-lib 97 | (ffi-lib (string-append lib-prefix "avformat") '("58" "57" #f) 98 | #:fail ffmpeg-not-installed)) 99 | (define-ffi-definer define-avformat avformat-lib 100 | #:default-make-fail error-not-installed 101 | #:make-c-id convention:hyphen->underscore) 102 | (match (system-type 'os) 103 | ['windows 104 | (define postproc-lib 105 | (ffi-lib (string-append lib-prefix "postproc") '("55" "54" #f))) 106 | (define-ffi-definer define-postproc postproc-lib 107 | #:make-c-id convention:hyphen->underscore) 108 | (void)] 109 | [_ (void)]) 110 | (define avfilter-lib 111 | (ffi-lib (string-append lib-prefix "avfilter") '("7" "6" #f) 112 | #:fail ffmpeg-not-installed)) 113 | (define-ffi-definer define-avfilter avfilter-lib 114 | #:default-make-fail error-not-installed 115 | #:make-c-id convention:hyphen->underscore) 116 | (define avdevice-lib 117 | (ffi-lib (string-append lib-prefix "avdevice") '("58" "57" #f) 118 | #:fail ffmpeg-not-installed)) 119 | (define-ffi-definer define-avdevice avdevice-lib 120 | #:default-make-fail error-not-installed 121 | #:make-c-id convention:hyphen->underscore) 122 | 123 | ;; =================================================================================================== 124 | 125 | (struct version (major 126 | minor 127 | patch) 128 | #:methods gen:custom-write 129 | [(define (write-proc x port mode) 130 | (fprintf port "~a.~a.~a" 131 | (version-major x) 132 | (version-minor x) 133 | (version-patch x)))]) 134 | (define (mk-version #:major [major 0] 135 | #:minor [minor 0] 136 | #:patch [patch 0]) 137 | (version major minor patch)) 138 | (define _version 139 | (make-ctype _uint 140 | (λ (x) 141 | (integer-bytes->integer 142 | (bytes 0 143 | (version-major x) 144 | (version-minor x) 145 | (version-patch x)) 146 | #f #t)) 147 | (λ (x) 148 | (define bitstr (integer->integer-bytes x 4 #f #t)) 149 | (mk-version #:major (bytes-ref bitstr 1) 150 | #:minor (bytes-ref bitstr 2) 151 | #:patch (bytes-ref bitstr 3))))) 152 | 153 | ;; =================================================================================================== 154 | 155 | (define-avutil avutil-version (_fun -> _version)) 156 | (define-avutil avutil-license (_fun -> _string)) 157 | (define-avutil avutil-configuration (_fun -> _string)) 158 | (define-swresample swresample-version (_fun -> _version)) 159 | (define-swresample swresample-license (_fun -> _string)) 160 | (define-swresample swresample-configuration (_fun -> _string)) 161 | (define-swscale swscale-version (_fun -> _version)) 162 | (define-swscale swscale-license (_fun -> _string)) 163 | (define-swscale swscale-configuration (_fun -> _string)) 164 | (define-avcodec avcodec-version (_fun -> _version)) 165 | (define-avcodec avcodec-license (_fun -> _string)) 166 | (define-avcodec avcodec-configuration (_fun -> _string)) 167 | (define-avformat avformat-version (_fun -> _version)) 168 | (define-avformat avformat-license (_fun -> _string)) 169 | (define-avformat avformat-configuration (_fun -> _string)) 170 | (define-avfilter avfilter-version (_fun -> _version)) 171 | (define-avfilter avfilter-license (_fun -> _string)) 172 | (define-avfilter avfilter-configuration (_fun -> _string)) 173 | (define-avdevice avdevice-version (_fun -> _version)) 174 | (define-avdevice avdevice-license (_fun -> _string)) 175 | (define-avdevice avdevice-configuration (_fun -> _string)) 176 | 177 | ;; =================================================================================================== 178 | 179 | (define (ffmpeg-installed?) 180 | (and avutil-lib 181 | swresample-lib 182 | swscale-lib 183 | avcodec-lib 184 | avfilter-lib 185 | avformat-lib 186 | avdevice-lib)) 187 | 188 | ;; Does a check to ensure that the correct version of FFmpeg is installed. If an invalid 189 | ;; version is installed, return #f, otherwise return #t. To be a valid version the `major` field 190 | ;; must match EXACTLY, and the minor field must be AT LEAST the specified version. 191 | ;; Version Int Int -> Boolean 192 | (define (version-check libname version . mm-pair) 193 | (for/or ([mm (in-list mm-pair)]) 194 | (and (= (version-major version) (first mm)) 195 | (>= (version-minor version) (second mm))))) 196 | 197 | ;; Check to ensure that ffmpeg meets the minimum required version. 198 | ;; returns #t if it does, otherwise returns #f. 199 | ;; -> Boolean 200 | (define (ffmpeg-min-version?) 201 | (and (version-check "libavutil" (avutil-version) 202 | '(55 34) '(56 1)) 203 | (version-check "libavcodec" (avcodec-version) 204 | '(57 64) '(58 1)) 205 | (version-check "libavformat" (avformat-version) 206 | '(57 56) '(58 1)) 207 | (version-check "libavfilter" (avfilter-version) 208 | '(6 65) '(6 1)) 209 | (version-check "libswscale" (swscale-version) 210 | '(4 2) '(5 1)) 211 | (version-check "libswresample" (swresample-version) 212 | '(2 3) 213 | '(3 1)) 214 | (version-check "libavdevice" (avdevice-version) 215 | '(57 1) '(58 1)))) 216 | 217 | ;; Test to see if FFMPEG meets the recommended versions. 218 | ;; Video should work with versions lower than this, but will not 219 | ;; perform as well 220 | ;; -> Boolean 221 | (define (ffmpeg-recommended-version?) 222 | (and (version-check "libavutil" (avutil-version) 223 | '(56 14)) 224 | (version-check "libavcodec" (avcodec-version) 225 | '(58 18)) 226 | (version-check "libavformat" (avformat-version) 227 | '(58 12)) 228 | (version-check "libavfilter" (avfilter-version) 229 | '(7 16)) 230 | (version-check "libswscale" (swscale-version) 231 | '(5 1)) 232 | (version-check "libswresample" (swresample-version) 233 | '(3 1)) 234 | (version-check "libavdevice" (avdevice-version) 235 | '(58 3)))) 236 | -------------------------------------------------------------------------------- /video/private/surface.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #| 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | |# 18 | 19 | (require racket/match 20 | racket/contract/base 21 | racket/math 22 | racket/dict 23 | (only-in scribble/manual defproc) 24 | "video.rkt" 25 | (prefix-in internal: "video.rkt") 26 | (for-label "init.rkt" 27 | "../core.rkt") 28 | (for-syntax syntax/parse 29 | syntax/parse/lib/function-header 30 | racket/syntax 31 | racket/base 32 | racket/match 33 | "init.rkt")) 34 | 35 | (provide (all-defined-out)) 36 | 37 | ;; Helpers =========================================================================================== 38 | 39 | (begin-for-syntax 40 | (define-syntax-class doc-header 41 | (pattern (name:id arg-spec ...)) 42 | (pattern (prototype:doc-header arg-spec ...)))) 43 | 44 | ;; Producers ========================================================================================= 45 | 46 | (define-syntax (define-producer stx) 47 | (syntax-parse stx 48 | [(_ f:function-header 49 | (~or (~optional (~seq #:subgraph subgraph) #:defaults ([subgraph #'#f])) 50 | (~optional (~seq #:properties properties-proc) #:defaults ([properties-proc #'values])) 51 | (~optional (~seq #:user-properties user-prop) #:defaults ([user-prop #'user-prop]))) 52 | ... 53 | body ...) 54 | (quasisyntax/loc stx 55 | (define (f.name 56 | #:properties [user-prop (hash)] 57 | #:filters [filters '()] 58 | . f.args) 59 | body ... 60 | (make-producer 61 | #:subgraph subgraph 62 | #:filters filters 63 | #:prop (properties-proc user-prop))))])) 64 | 65 | (define-syntax (->producer stx) 66 | (syntax-parse stx 67 | [(_ [extra-args ...] 68 | [optional-args ...] 69 | (~optional ret? #:defaults ([ret? #'any/c]))) 70 | #'(->* [extra-args ...] 71 | [#:properties (hash/c string? any/c) 72 | #:filters (listof filter?) 73 | optional-args ...] 74 | (and/c producer? ret?))])) 75 | 76 | (define-syntax (defproducer stx) 77 | (syntax-parse stx 78 | [(_ prototype:doc-header 79 | (~optional (~seq #:return ret)) ;; TODO, don't ignore this 80 | content ...) 81 | #'(defproc ((~@ . prototype) 82 | [#:properties properties (hash/c string? any/c) (hash)] 83 | [#:filters filters (listof filter?) '()]) 84 | producer? 85 | content ...)])) 86 | 87 | (define (producer? x) 88 | (internal:producer? x)) 89 | 90 | ;; Filters =========================================================================================== 91 | 92 | (define-syntax (define-filter stx) 93 | (syntax-parse stx 94 | [(_ f:function-header 95 | (~or (~optional (~seq #:properties properties-proc) #:defaults ([properties-proc #'values])) 96 | (~optional (~seq #:user-properties user-prop) #:defaults ([user-prop #'user-prop])) 97 | (~optional (~seq #:source-props source-props-proc) 98 | #:defaults ([source-props-proc 99 | #'(λ () (values #f #f))])) 100 | (~optional (~seq #:subgraph subgraph) 101 | #:defaults ([subgraph #'(λ () #f)]))) 102 | ... 103 | body ...) 104 | (quasisyntax/loc stx 105 | (define (f.name 106 | #:properties [user-prop (hash)] 107 | #:filters [filters '()] 108 | . f.args) 109 | body ... 110 | (make-filter #:source-props-proc source-props-proc 111 | #:subgraph subgraph 112 | #:filters filters 113 | #:prop (properties-proc user-prop))))])) 114 | 115 | (define-syntax (->filter stx) 116 | (syntax-parse stx 117 | [(_ [required ...] 118 | [optional ...] 119 | (~optional ret? #:defaults ([ret? #'any/c]))) 120 | #`(->* [required ...] 121 | [#:properties (or/c dict? #f) 122 | #:filters (or/c list? #f) 123 | optional ...] 124 | (and/c filter? ret?))])) 125 | 126 | (define-syntax (deffilter stx) 127 | (syntax-parse stx 128 | [(_ prototype:doc-header 129 | body ...) 130 | #`(defproc ((~@ . prototype) 131 | [#:filters filters (listof filter?) '()] 132 | [#:properties properties (hash/c string? any/c) (hash)]) 133 | filter? 134 | body ...)])) 135 | 136 | (define (filter? x) 137 | (internal:filter? x)) 138 | 139 | ;; Transitions ======================================================================================= 140 | 141 | (define-syntax (define-transition stx) 142 | (syntax-parse stx 143 | [(_ f:function-header 144 | (~or (~optional (~seq #:properties properties-proc) #:defaults ([properties-proc #'values])) 145 | (~optional (~seq #:user-properties user-prop) #:defaults ([user-prop #'user-prop])) 146 | (~optional (~seq #:source-porps source-props-proc) 147 | #:defaults ([source-props-proc 148 | #'(λ () (values #f #f #f #f))])) 149 | (~optional (~seq #:track1-subgraph track1-subgraph-proc) 150 | #:defaults ([track1-subgraph-proc #'(λ () #f)])) 151 | (~optional (~seq #:track2-subgraph track2-subgraph-proc) 152 | #:defaults ([track2-subgraph-proc #'(λ () #f)])) 153 | (~optional (~seq #:combined-subgraph combined-subgraph-proc) 154 | #:defaults ([combined-subgraph-proc #'(λ () #f)])) 155 | (~optional (~seq #:prod-1 p1) #:defaults ([p1 #'p1])) 156 | (~optional (~seq #:prod-2 p2) #:defaults ([p2 #'p2]))) 157 | ... 158 | body ...) 159 | (quasisyntax/loc stx 160 | (define (f.name #:start [p2 #f] #:end [p1 #f] 161 | #:properties [user-prop (hash)] 162 | . f.args) 163 | body ... 164 | (define trans 165 | (make-transition 166 | #:source-props-proc source-props-proc 167 | #:track1-subgraph track1-subgraph-proc 168 | #:track2-subgraph track2-subgraph-proc 169 | #:combined-subgraph combined-subgraph-proc 170 | #:prop (properties-proc user-prop))) 171 | (if (and p1 p2) 172 | (make-field-element #:element trans #:track p1 #:track-2 p2) 173 | trans)))])) 174 | 175 | (define-syntax (->transition stx) 176 | (syntax-parse stx 177 | [(_ [required ...] 178 | [optional ...] 179 | (~optional ret? #:defaults ([ret? #'any/c]))) 180 | #`(->* [required ...] 181 | [#:properties (or/c dict? #f) 182 | #:start (or/c any/c #f) 183 | #:end (or/c any/c #f) 184 | optional ...] 185 | (and/c (or/c transition? field-element?) ret?))])) 186 | 187 | (define-syntax (deftransition stx) 188 | (syntax-parse stx 189 | [(_ prototype:doc-header 190 | body ...) 191 | #`(defproc ((~@ . prototype) 192 | [#:start start (or/c any/c #f) #f] 193 | [#:end end (or/c any/c #f) #f] 194 | [#:properties properties (hash/c string? any/c) (hash)]) 195 | (or/c transition? field-element?) 196 | body ...)])) 197 | 198 | (define (transition? x) 199 | (internal:transition? x)) 200 | 201 | ;; Merge ============================================================================================= 202 | 203 | (define-syntax (define-merge stx) 204 | (syntax-parse stx 205 | [(_ f:function-header 206 | (~or (~optional (~seq #:properties properties-proc) #:defaults ([properties-proc #'values])) 207 | (~optional (~seq #:user-properties user-prop) #:defaults ([user-prop #'user-prop])) 208 | (~optional (~seq #:source-props source-props-proc) 209 | #:defaults ([source-props-proc 210 | #'(λ () (values #f #f #f #f))])) 211 | (~optional (~seq #:track1-subgraph track1-subgraph-proc) 212 | #:defaults ([track1-subgraph-proc #'(λ () #f)])) 213 | (~optional (~seq #:track2-subgraph track2-subgraph-proc) 214 | #:defaults ([track2-subgraph-proc #'(λ () #f)])) 215 | (~optional (~seq #:combined-subgraph combined-subgraph-proc) 216 | #:defaults ([combined-subgraph-proc #'(λ () #f)])) 217 | (~optional (~seq #:prod-1 p1) #:defaults ([p1 #'p1])) 218 | (~optional (~seq #:prod-2 p2) #:defaults ([p2 #'p2]))) 219 | ... 220 | body ...) 221 | (quasisyntax/loc stx 222 | (define (f.name #:top [p2 #f] #:bottom [p1 #f] 223 | #:properties [user-prop (hash)] 224 | . f.args) 225 | body ... 226 | (define trans 227 | (make-transition 228 | #:source-props-proc source-props-proc 229 | #:track1-subgraph track1-subgraph-proc 230 | #:track2-subgraph track2-subgraph-proc 231 | #:combined-subgraph combined-subgraph-proc 232 | #:prop (properties-proc user-prop))) 233 | (if (and p1 p2) 234 | (make-field-element #:element trans #:track p1 #:track-2 p2) 235 | trans)))])) 236 | 237 | (define-syntax (->merge stx) 238 | (syntax-parse stx 239 | [(_ [required ...] 240 | [optional ...] 241 | (~optional ret? #:defaults ([ret? #'any/c]))) 242 | #`(->* [required ...] 243 | [#:properties (or/c dict? #f) 244 | #:top (or/c any/c #f) 245 | #:bottom (or/c any/c #f) 246 | optional ...] 247 | (and/c (or/c transition? field-element?) ret?))])) 248 | 249 | (define-syntax (defmerge stx) 250 | (syntax-parse stx 251 | [(_ prototype:doc-header 252 | body ...) 253 | #`(defproc ((~@ . prototype) 254 | [#:top top (or/c any/c #f) #f] 255 | [#:bottom bottom (or/c any/c #f) #f] 256 | [#:properties properties (hash/c string? any/c) (hash)]) 257 | (or/c merge? field-element?) 258 | body ...)])) 259 | 260 | (define (merge? x) 261 | (internal:transition? x)) 262 | -------------------------------------------------------------------------------- /video/scribblings/core.scrbl: -------------------------------------------------------------------------------- 1 | #lang reader video/scribblings/viddoclang 2 | 3 | @;{ 4 | Copyright 2016-2017 Leif Andersen 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | @title{Core Library} 20 | @defmodule[video/core] 21 | 22 | @deprecated-text{The documentation for this page is out of 23 | date. Currently the best way to learn about the core of 24 | video is to look at @racketmodname[video/private/video]. Note 25 | that this module is not stable and will change.} 26 | 27 | @defstruct*[video ([mlt-object any/c] [tags (set/c any/c)])]{ 28 | The basic video object. 29 | 30 | @racket[mlt-object] contains the compiled mlt-object, or 31 | @racket[#f] if it has not yet been compiled. This bit of the 32 | library is particularly unstable, and may change if it stops 33 | using MLT as a backend.} 34 | 35 | @defstruct*[(link video) ([source video?] [target video?] [index exact-nonnegative-integer?])]{ 36 | A link object which connects a producer to a consumer. Links 37 | can also connect to and from filters. The most basic and 38 | common connection connects a video producer, to a built in 39 | consumer. The @racket[preview] and @racket[render] functions 40 | handle the linking for you. 41 | 42 | As such, this is only required if you plan to use 43 | @racket[convert-to-mlt!] directly. 44 | 45 | @racket[source] contains the producer that is linked together. 46 | 47 | @racket[target] contains the consumer that receives the 48 | produced video.} 49 | 50 | @defstruct*[(properties video) ([prop (hash/c string? any/c)])]{ 51 | Contains properties attached to video objects. These are 52 | currently only used as to interact with the MLT layer. Such 53 | as to set a consumers resolution, or set a producers length. 54 | 55 | @racket[prop] contains the actual properties table.} 56 | 57 | @defproc[(properties-ref [dict properties?] 58 | [key string?] 59 | [default-type (or/c 'string 'int 'int64 'mlt-position 'double)]) 60 | any/c]{ 61 | 62 | A function to get the properties out of a video object. If 63 | the property associated with @racket[key] does not exist in 64 | the table, it will search the MLT object's properties for 65 | the given @racket[key] if it has already been compiled. 66 | 67 | @racket[dict] is the video object to search. 68 | 69 | The @racket[key] identifies which property to search for. 70 | 71 | @racket[default-type] indicates the assumed type used when 72 | requesting the object from MLT. This is required because MLT 73 | does not store this information and internally represents 74 | everything as a string.} 75 | 76 | @defstruct*[(anim-property video) ([value any/c] [position number?] [length number?])]{ 77 | Used for anim-properties in MLT. 78 | 79 | @racket[value] is the actual property. 80 | 81 | @racket[position] and @racket[length] are extra field when setting the anim property. 82 | } 83 | 84 | @defstruct*[(frame properties) ()]{ 85 | A struct containing a frame object. This currently has no 86 | additional data apart from properties. } 87 | 88 | @defstruct*[(service properties) ([filters (listof filter)])]{ 89 | 90 | A service is the basic type of video object that actually handles data. Services come in four types: 91 | 92 | @itemlist[ 93 | @item{@racket[producer] --- Producers actually create 94 | videos. A producer can be anything from a picture, to a 95 | video file, to text.} 96 | @item{@racket[consumer] --- Consumers consume the content 97 | from a producer (or filter), and stream it to a source that 98 | accepts videos. An example consumer can output the video to 99 | a file.} 100 | @item{@racket[transition] --- A transition combines two 101 | videos together, such as to fade two clips. These are 102 | generally used inside of @racket[playlist]s.} 103 | @item{@racket[filter] --- Filters modify an aspect of the 104 | video, such as to make the video grayscale.}] 105 | 106 | A service can additionally have filters attached to it, stored in @racket[filters].} 107 | 108 | @defstruct*[(filter service) ([type (or/c symbol? #f)] [source (or/c string? #f)])]{ 109 | Filters alter the behavior of a @racket[service] in some 110 | way. They can be used in one of three ways: 111 | 112 | @itemlist[ 113 | @item{Filters can be attached to services directly in the 114 | @racket[filters] field for that service.} 115 | @item{Filters can be linked in between a producer and a 116 | consumer.} 117 | @item{Filters can be added to a @racket[field] that is associated with a @racket[multitrack].}] 118 | 119 | Many @racket[filter]s apply to only one @racket[producer]. 120 | For example, the grayscale filter turns a producer to grayscale. 121 | 122 | Other filters, however, become relevant only when multiple 123 | tracks are used in a @racket[tractor]. For example, a filter 124 | can be used to shrink a video and overlay it on top of 125 | another one. 126 | 127 | @racket[type] stores the type of filter. This presumes that 128 | the needed plugin is installed for MLT. @racket[#f] is the 129 | default type, which is generally @racket['loader]. 130 | 131 | @racket[source] is the source for the filter. This can be 132 | used to set some default properties that MLT uses when setting default values.} 133 | 134 | @defstruct*[(transition service) ([type (or/c symbol? #f)] 135 | [source (or/c string? #f)] 136 | [length integer?])]{ 137 | 138 | Transitions are used for combining two videos, generally 139 | used in conjunction with a @racket[playlist]. 140 | 141 | @racket[type] indicates the type of the transition. 142 | 143 | @racket[source] indicates the source for the transition if 144 | the type requires it. This generally remains @racket[#f]. 145 | 146 | @racket[length] indicates the length of the transition. 147 | Generally the @racket[playlist] associated with this 148 | transition will be shorted by @racket[length] frames.} 149 | 150 | @defstruct*[(consumer service) ([type (or/c symbol? #f)] [target (or/c string? #f)])]{ 151 | Consumers output a video that is produced by the @racket[producer] that they are linked to. 152 | 153 | @racket[type] stores what the consumer outputs. Some common types used are: 154 | 155 | @itemlist[ 156 | @item{@racket['avformat] --- Used for outputting videos 157 | using @tt{FFMPEG}.} 158 | @item{@racket['sdl] --- Used for previewing videos an SDL 159 | window.} 160 | @item{@racket['xml] --- Used for producing an XML file that 161 | the @exec{melt} command line tool can process.}] 162 | 163 | The @racket[target] field indicates the file to create, or 164 | a different parameter that the specific plugin uses. It is 165 | frequently @racket[#f] for the default consumer.} 166 | 167 | @defstruct*[(producer service) ([type (or/c symbol? #f)] 168 | [source (or/c string? #f)] 169 | [start exact-nonnegative-integer?] 170 | [end exact-nonnegative-integer?] 171 | [speed number?] 172 | [seek exact-nonnegative-integer?])]{ 173 | 174 | A @racket[producer] feeds data to consumers or filters. A 175 | producer can be a video, or an image, or an audio clip. 176 | 177 | @racket[type] stores the type of video being inputted. 178 | Unlike with consumers, this should typically be left as the 179 | default @racket[#f] or @racket['loader].@margin-note{Yes, 180 | yes, I know, this is really kludgy. It is currently this way 181 | to deal with @tt{MLT} bugs.} 182 | 183 | @racket[source] is a URI for producer's source. Some example values are: 184 | @itemlist[ 185 | @item{"color:blue"} 186 | @item{"hold:picture.png"} 187 | @item{"video.mp4"} 188 | @item{"xml:mltxml.xml}] 189 | 190 | The @racket[start] and @racket[end] of the producer is 191 | given, or is the length of the producer when it is 192 | @racket[#f]. Note that some producers, such as still images, 193 | do not have a natural start or end, and will fill up as much 194 | time as needed. 195 | 196 | The @racket[speed] of the producer sets the speed the 197 | producer feeds frames into its consumer. A speed of 198 | @racket[1] is regular playing speed. @racket[0] is paused 199 | and will continuously output the same frame. Values greater 200 | than @racket[1] play faster than the producers speed, and 201 | values less than @racket[0] rewind the producer. Finally, 202 | values between @racket[0] and @racket[1] play at a slower 203 | than normal rate. 204 | 205 | @racket[seek] can be combined with @racket[speed] to alter 206 | the way the video is played. @racket[seek] determines the 207 | point where the producer begins to play. Normally this is 208 | the same position as @racket[start], but could be set to the 209 | middle of the clip and @racket[speed] set to a negative 210 | value, to simulate a rewinding clip.} 211 | 212 | @defstruct*[(playlist producer) 213 | ([elements (listof (or/c producer transition blank playlist-producer))])]{ 214 | 215 | A playlist is a list of producers that play one after the 216 | other. 217 | 218 | Transitions can also be put in a playlist and are used to 219 | combine two clips, such as to fade from one video to 220 | another. A transition shortens its two surrounding clips and 221 | producers a new clip for the transition. Note that a 222 | playlist with transitions in it will be shortened by the 223 | length of the transition. 224 | 225 | @racket[elements] is the list of producers and transitions in the video.} 226 | 227 | @defstruct*[(playlist-producer video) ([producer producer?] 228 | [start exact-nonnegative-integer?] 229 | [end exact-nonnegative-integer?])]{ 230 | Don't use this for now. I'm still not entirely sure how its 231 | supposed to work.} 232 | 233 | @defstruct*[(blank video) ([length exact-nonnegative-integer?])]{ 234 | Similar to a producer, but is blank. These can be inserted into playlists.} 235 | 236 | @defstruct*[(multitrack producer) ([tracks (listof producer)] 237 | [field (listof field-element?)])] 238 | @defstruct*[(field-element video) ([element (or/c transition? filter? #f)] 239 | [track (or/c exact-nonnegative-integer? #f)] 240 | [track-2 (or/c exact-nonnegative-integer? #f)])] 241 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | --------------------------------------------------------------------------------