VLC and PLT Scheme [n+1]

I figured out how to playback video inside a PLT Scheme gui window. media-player-window% below is a panel that displays an embedded video and 4 methods for controlling the playback: load, play, stop and release. It is dependent on my vlc foreign function interface, included below the media-player-window% code.

Note that for reasons I don’t fully grok, the mrl for a file is actually “file:///filename.ext”. Yes, THREE slashes.

(define media-player-window%
  (class vertical-panel%

    (define vlc-exception (make-vlc-exception #f 0 ""))
    (define vlc-instance
      (let* ([vlc-args (vector
                        "--ignore-config"
                        (string-append "--plugin-path=" VLC-PLUGIN-PATH)
                        )])
        (libvlc_new (vector-length vlc-args) vlc-args vlc-exception)))

    (define vlc-media #f)
    (define vlc-player #f)

    (define/public (load file)
      (let* ([media-mrl (string-append "file:///" file)])
        (set! vlc-media (libvlc_media_new vlc-instance media-mrl vlc-exception))
        (set! vlc-player (libvlc_media_player_new_from_media vlc-media vlc-exception))
        (libvlc_media_player_set_drawable vlc-player (send vlc-display-panel get-handle) vlc-exception)))

    (define/public (play)
      (libvlc_media_player_play vlc-player vlc-exception))

    (define/public (stop)
      (libvlc_media_player_stop vlc-player vlc-exception))

    (define/public (release)
      (when vlc-player
        (libvlc_media_player_release vlc-player))
      (when vlc-media
        (libvlc_media_release vlc-media))
      (when vlc-instance
        (libvlc_release vlc-instance))
      (set! vlc-player #f)
      (set! vlc-media #f)
      (set! vlc-instance #f))

    (super-new)

    (define vlc-display-panel (new panel% [parent this]))))

vlc-ffi.ss:

#lang scheme

(require scheme/foreign)
(unsafe!)

(provide (all-defined-out))

(define vlc-path "C:\\Program Files (x86)\\VideoLAN\\VLC\\")

(define libvlccore (ffi-lib (string-append vlc-path "libvlccore")))
(define libvlc (ffi-lib (string-append vlc-path "libvlc")))

(define-syntax define-pointer
  (syntax-rules ()
    ((_ ptr-type)
     (define ptr-type
       (_cpointer/null (quote ptr-type))))))

(define-pointer vlc-instance)
(define-pointer vlc-media)
(define-pointer vlc-media-player)

(define-cstruct _vlc-exception ((raised _bool) (code _int32) (message _string)))

(define vlc-state
  (_enum '(libvlc_NothingSpecial libvlc_Opening libvlc_Buffering libvlc_Playing
           libvlc_Paused libvlc_Stopped
           ;;; libvlc_Forward libvlc_Backward
           libvlc_Ended libvlc_Error)))

(define-syntax define-vlc
  (syntax-rules ()
    ((_ fn args)
     (define fn
       (get-ffi-obj (quote fn) libvlc args)))))

(define-vlc libvlc_exception_init (_fun _vlc-exception-pointer -> _void))
(define-vlc libvlc_new         (_fun _int32 (_vector i _string/utf-8)  _vlc-exception-pointer -> vlc-instance))
(define-vlc libvlc_get_version (_fun -> _string/utf-8))
(define-vlc libvlc_release     (_fun vlc-instance -> _void))
(define-vlc libvlc_add_intf    (_fun vlc-instance _string/utf-8 _vlc-exception-pointer -> _void))

;;;
(define-vlc libvlc_media_new          (_fun vlc-instance _string/utf-8 _vlc-exception-pointer -> vlc-media))
(define-vlc libvlc_media_get_duration (_fun vlc-media _vlc-exception-pointer -> _int64))
(define-vlc libvlc_media_get_meta     (_fun vlc-media _int32 _vlc-exception-pointer -> _string))
(define-vlc libvlc_media_get_mrl      (_fun vlc-media _vlc-exception-pointer -> _string))
(define-vlc libvlc_media_release      (_fun vlc-media -> _void))

;;;;;;;;;;;;;;
(define-vlc libvlc_media_player_new_from_media (_fun vlc-media _vlc-exception-pointer -> vlc-media-player))
(define-vlc libvlc_media_player_release        (_fun vlc-media-player -> _void))

(define-vlc libvlc_media_player_play           (_fun vlc-media-player _vlc-exception-pointer -> _void))
(define-vlc libvlc_media_player_pause          (_fun vlc-media-player _vlc-exception-pointer -> _void))
(define-vlc libvlc_media_player_stop           (_fun vlc-media-player _vlc-exception-pointer -> _void))
(define-vlc libvlc_media_player_set_position   (_fun vlc-media-player _float _vlc-exception-pointer -> _void))
(define-vlc libvlc_media_player_set_drawable (_fun vlc-media-player _int32 _vlc-exception-pointer -> _void))

(define-vlc libvlc_media_player_get_time       (_fun vlc-media-player _vlc-exception-pointer -> _int64))
(define-vlc libvlc_media_player_get_position   (_fun vlc-media-player _vlc-exception-pointer -> _float))
(define-vlc libvlc_media_player_get_length     (_fun vlc-media-player _vlc-exception-pointer -> _int64))
(define-vlc libvlc_media_player_get_state      (_fun vlc-media-player _vlc-exception-pointer -> vlc-state))
;;;(define-vlc libvlc_media_player_get_state      (_fun vlc-media-player _vlc-exception-pointer -> _fixnum))