73 lines
2.4 KiB
Plaintext
73 lines
2.4 KiB
Plaintext
;;;;
|
|
;;;; w w w - s n d . s t k -- WWW for STk (Sound files reader)
|
|
;;;;
|
|
;;;; Copyright © 1996-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|
;;;;
|
|
;;;; Permission to use, copy, modify, distribute,and license this
|
|
;;;; software and its documentation for any purpose is hereby granted,
|
|
;;;; provided that existing copyright notices are retained in all
|
|
;;;; copies and that this notice is included verbatim in any
|
|
;;;; distributions. No written agreement, license, or royalty fee is
|
|
;;;; required for any of the authorized uses.
|
|
;;;; This software is provided ``AS IS'' without express or implied
|
|
;;;; warranty.
|
|
;;;;
|
|
;;;; This version uses some of the enhancements done by Harvey J. Stein:
|
|
;;;; Copyright (c) 1995 Harvey J. Stein (hjstein@math.huji.ac.il)
|
|
;;;;
|
|
;;;; Author: Erick Gallesio [eg@unice.fr]
|
|
;;;; Creation date: 1-Nov-1996 23:39
|
|
;;;; Last file update: 3-Sep-1999 19:57 (eg)
|
|
;;;;
|
|
|
|
;;;; Sound player must be placed in the shell variable PLAY_PRG. If this
|
|
;;;; variable is not set, the program "play" is launched. The play program
|
|
;;;; is called with one parameter: the file to play.
|
|
|
|
|
|
(select-module WWW)
|
|
|
|
(define sound-player (or (getenv "PLAY_PRG") "play"))
|
|
|
|
;=============================================================================
|
|
;
|
|
; U t i l i t i e s
|
|
;
|
|
;=============================================================================
|
|
|
|
(define (get-sound-file url port)
|
|
;; Keep the suffix of the sound file, since some players need it
|
|
(let* ((str-url (url:pretty-url url))
|
|
(tmpname (temporary-file-name))
|
|
(file (open-file tmpname "w")))
|
|
(when file
|
|
(copy-port-image port file)
|
|
(close-output-port file))
|
|
tmpname))
|
|
|
|
;=============================================================================
|
|
;
|
|
; P l a y - s o u n d
|
|
;
|
|
;=============================================================================
|
|
|
|
(define (play-sound txt fd url)
|
|
(let* ((str-url (if (string? url) url (url:unparse-url url)))
|
|
(in-file? (eq? (url:service url) 'file))
|
|
(sound (if in-file?
|
|
(url:filename url)
|
|
(get-sound-file url fd))))
|
|
(when sound
|
|
;; play sound file
|
|
(system (string-append sound-player " " sound))
|
|
;; If sound is in a temporary file, delete it
|
|
(unless in-file?
|
|
(remove-file sound)))))
|
|
|
|
;=============================================================================
|
|
|
|
;;;; Add the sound "viewer"
|
|
(www:add-viewer (string->regexp "\\.au$|\\.wav$") play-sound)
|
|
|
|
(provide "www-snd")
|