#lang scheme/base
(require (planet bzlib/base) 
         (planet bzlib/shp)
         scheme/string
         (planet bzlib/file)
         )

(define flash-base-path (make-parameter "/flash")) 

(define (path->id path)
  (string-join (path-helper path) "_"))

(define (path-helper path)
  (cond ((pair? path) path)
        ((string? path) (regexp-split #px"\\/" path ))
        ((path? path) (path-helper (path->string path)))))

(define (flash-path path)
  (build-path* ($htdocs) (flash-base-path) path))

(define (flash-url path)
  (string-join (cons (flash-base-path) (path-helper path)) "/"))

(define (flash (path ($pathinfo)) #:id (id #f) #:base (base (flash-base-path)) #:height (height 400) #:width (width 400))
  (define (helper path id width height)
  `(object ((width ,width) 
            (height ,height) 
            (id ,id))
           (param ((name "movie") (value ,path)) "")
           (param ((name "allowscriptaccess") (value "always")) "")
           (embed ((src ,path)
                   (width ,width)
                   (height ,height)
                   (name ,id)
                   (type "application/x-shockwave-flash")
                   (allowscriptaccess "always")
                   ) "")))
  (helper (flash-url path)
          (if (not id) (path->id path) id)
          (number->string width)
          (number->string height)))

#|
<object width="425" height="344"><param name="movie" value="http://www.youtube.com/v/grCovLMXstY&hl=en&fs=1&"></param><param name="allowFullScreen" value="true"></param><param name="allowscriptaccess" value="always"></param><embed src="http://www.youtube.com/v/grCovLMXstY&hl=en&fs=1&" type="application/x-shockwave-flash" allowscriptaccess="always" allowfullscreen="true" width="425" height="344"></embed></object>
;;|#
(provide/contract
 (flash (->* ()
             ((or/c path-string? (listof string?))
              #:id (or/c false/c string?)
              #:base path-string?
              #:height exact-positive-integer?
              #:width exact-positive-integer?)
             any))
 (flash-base-path (parameter/c path-string?))
 (flash-path (-> (or/c path-string? (listof string?)) path-string?))
 (flash-url (-> (or/c path-string? (listof string?)) path-string?))
 )