http://www.bowron.us/wordpress/blog/

Please update your feed reader accordingly.

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))

Anyway, I got it to work so here’s the function. No error checking or success fail notification.

#lang scheme

(provide twitter)

(require net/base64)
(require net/url)

(define (strip-crlf b64-bytes)
  (subbytes b64-bytes 0 (- (bytes-length b64-bytes) 2)))

;;; note that this uses the very insecure basic authorization method...
(define (twitter username password status)
  (let* ([basic-auth (strip-crlf (base64-encode (string->bytes/utf-8 (string-append username ":" password))))])
    (let ([url 
           (make-url
            "http"
            #f
            "twitter.com"
            80
            #t
            (list 
             (make-path/param "statuses" (list))
             (make-path/param "update.xml" (list)))
            (list
             (cons 'status status))
            #f)])
      (let ([port 
             (post-impure-port
              url
              #""
              (list
               (string-append "Authorization: Basic " (bytes->string/utf-8 basic-auth))))])
        (close-input-port port)))))

• It seems that the best way to elegantly and efficiently write a function to find a key in a hash table, dictionary, etc is to write a function with two return values. First value is whether or not the item was located, second value is the actual value for the key. Only problem I’m not sure that there are any cases where having a key in the hash table with the value of FALSE would be treated any differently then just not having the key in the table in the first place.
• If we accept that there are functions that must return multiple values to be useful or efficient, [e.g. HashLookup or yuv2rgb()], then as far as I can see, you have three options:
  1. Language support for real multiple values returned from functions
  2. user kludged multiple values using list or a data structure
  3. language kludge it by using output variables passed by reference or mutable data structure to the function.

  I don’t like option 2 because it forces consing / memory allocation when it could potentially be avoided and option 3 requires mutable data structures or pass by reference, and those are not very Functional Programming friendly.

Delicious.

This is what I came up with:

(define-syntax complete-or 
  (syntax-rules ()
    ((_) #f)
    ((_ e) e)
    ((_ e1 e2 e3 ...)
     (let ((t e1))
       (if t 
	   (begin0 t e2 e3 ...)
	   (complete-or e2 e3 ...))))))

The basic use case was this… I had a function that called two other functions and returned true if either of them returned true, but it needed to call both in either case. One function checked to see if the duration needed to be updated and returned whether it updated it or not, and the other checked whether metadata had changed in the file and updated the database and returned true if it had. Then the caller needed to post a signal if any fields had changed.

This seemed like a good approach.

The function that uses it, looks like this:

(define (schemep3-database-reload-item item force?)
  (let ((filename (schemep3-database-index->filename item)))
    (if (file-exists? filename)
        (when (complete-or
               (schemep3-database-reload-duration item filename force?)
               (schemep3-database-reload-metadata item filename force?))
            (call-update-hooks item))
        (printf "File Does Not Exist: ~A~%" filename))))

Without a non-shortcutting or, it looked kinda like this:

(define (schemep3-database-reload-item item force?)
  (let ((filename (schemep3-database-index->filename item)))
    (if (file-exists? filename)
        (let ([modified (schemep3-database-reload-duration item filename force?)])
          (when (schemep3-database-reload-metadata item filename force?)
            (set! modified #t))
          (when modified
            (call-update-hooks item)))
        (printf "File Does Not Exist: ~A~%" filename))))

    (define/public (play file-index callback)
      (let ((file (schemep3-database-index->filename file-index)))
        (if (not (file-exists? file))
            (values #f #f)
            (with-finalized-binding           
             (lambda () (call-vlc libvlc_media_new (get-vlc-instance) (path->mrl file)))
             (lambda (media)
               (with-finalized-binding
                (lambda () (call-vlc libvlc_media_player_new_from_media media))
                (lambda (media-player)
                  (call-vlc libvlc_media_player_play media-player)
                  (internal-playback-loop media-player callback))
                libvlc_media_player_release))
             libvlc_media_release))))

Var Bar = NULL;
Variable Foo = LibrarySprocketNew();
if ( Foo )
{
    Bar = LibrarySprocketBeFancy( Foo );
    LibrarySprocketRelease( Foo );
}
return Bar;

In my scheme code, this would end up looking like this:

(let ([return-value #f])
  (and-let* ([foo (library_sprocket_new)])
    (set! return-value (do-something-fancy-with-foo foo))
    (library_sprocket_release foo))
  return-value)

But that isnt very functional… And it’s ugly and kludgish…

so, I came up with this macro:

(define-syntax with-finalized-binding 
  (syntax-rules ()
    ((_ initial-value-thunk value-thunk finalize-thunk)
     (and-let* ((v (initial-value-thunk)))
       (dynamic-wind
        void
        (lambda () (value-thunk v))
        (lambda () (finalize-thunk v)))))))

so now the code would look something like this:

(with-finalized-binding
 (lambda () (library_sprocket_new))
 (lambda (foo) (do-something-fancy-with-foo foo))
 (lambda (foo) (library_sprocket_release foo)))

It’s not perfect, but I think its more elegant than it was.

This is how I actually use it in my vlc backend code:

    (define/public (play file-index callback)
      (let ((file (schemep3-database-index->filename file-index)))
        (if (not (file-exists? file))
            (values #f #f)
            (with-finalized-binding           
             (lambda () (call-vlc libvlc_media_new (get-vlc-instance) (path->mrl file)))
             (lambda (media)
               (with-finalized-binding
                (lambda () (call-vlc libvlc_media_player_new_from_media media))
                (lambda (media-player)
                  (call-vlc libvlc_media_player_play media-player)                  
                  (internal-playback-loop media-player callback))
                (lambda (media-player) (libvlc_media_player_release media-player))))
             (lambda (media) libvlc_media_release media)))))

#lang scheme

(require "vlc-ffi.ss")

(define (play-to-end media-player e)
  (let loop ()
    (let ([state (libvlc_media_player_get_state media-player e)]
          [time (libvlc_media_player_get_time media-player e)])
      (printf "State: ~A Time: ~A~%" state time)
      (unless (member state '(#f libvlc_Stopped libvlc_Ended libvlc_Error))
        (sleep .5)
        (loop)))))

(define (vlc-play media-path)
  (unless (file-exists? media-path)
    (raise (format "Missing File!: ~A" media-path)))

  (printf "VLC Version: ~A~%" (libvlc_get_version))
  (let ([e (make-vlc-exception #f 0 "")])
    (let* ([vlc-args (vector
                      "--plugin-path=C:\\Program Files\\VideoLAN\\VLC\\plugins"
                      "-I" "dummy")]
           [vlc (libvlc_new (vector-length vlc-args) vlc-args e)])
      (let* ([media-mrl (string-append "file://" media-path)]
             [vlc-media
              (libvlc_media_new vlc media-mrl e)]
             [vlc-media-player (libvlc_media_player_new_from_media vlc-media e)])
        (libvlc_media_player_play vlc-media-player e)
        (play-to-end vlc-media-player e)
        (libvlc_media_player_stop vlc-media-player e)
        (libvlc_media_player_release vlc-media-player)
        (libvlc_media_release vlc-media)
        (libvlc_release vlc)))))

(vlc-play "path/to/fiile.mp3")

So, I ditched the mplayer playback backend for schemep3 and converted to libvlc. The biggest benefit is that with mplayer I was communicating via input and output ports but with libvlc the communication is at the API layer.

With mplayer, to get the playback position, I had to write a special string to the player input port, and poll its output port and parse every line looking for important strings. With libvlc, I just call libvlc_media_player_get_time.

So here’s the code… You’ll probably have to change the location of the actually library [dll,dylib,so] depending on your setup. In the next few days I will publish a sample that plays back an mp3 file.

#lang scheme

(require scheme/foreign)
(unsafe!)

(provide (all-defined-out))

(define libvlccore (ffi-lib "bin/libvlccore"))
(define libvlc (ffi-lib "bin/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_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_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))