#!/usr/bin/q --
#! -c main ARGS

/* audio_player.q: graphical sound file player, shows how to implement a
   graphical wave display using GGI in a Tk window */

/* This file is part of the Q programming system.

   The Q programming system is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   The Q programming system is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

/* Note that the actual wave drawing operation is implemented by a C routine
   in the draw_wave module, in order to achieve the efficiency needed to draw
   the display at a speed of multiple frames per second. */

import audio, sndfile, tk, ggi, draw_wave;

/* The main entry point. NAME is the name of the sound file to be played. */

public play NAME;

/* Audio parameters (same as in audio_examp.q, see there for details). */

def RATE = 44100, FORMAT = PA_INT16, CHANNELS = 2, BUFSIZE = 2048, NBUFS = 0,
  INFO = (RATE,CHANNELS,FORMAT,BUFSIZE,NBUFS);

// def _ = setenv "PA_MIN_LATENCY_MSEC" "10";

/* Colors for the wave display. */

def BACK = (0,0,0), FORE = (0xffff,0xffff,0xffff), WAVCOL = (0,0xffff,0);

/* The FPS value determines the number of display frames to draw per second.
   FRAMESIZE is the corresponding number of audio frames which have to be
   drawn at each iteration. */

def FPS = 10, FRAMESIZE = round (RATE/FPS);

/* Check system for available realtime thread priorities. */

def POL = SCHED_FIFO, PRIO = maxprio;

testprio PRIO		= setsched this_thread 0 0 || true
			    where () = setsched this_thread POL PRIO;
			= false otherwise;

maxprio			= until (neg testprio) (+1) 1 - 1;

/* Execute a task in realtime. */

special realtime X;

realtime X		= setsched TH 0 0 || Y
			    where TH = this_thread,
			      Y = setsched TH POL PRIO || X;

/* Function to read samples from a sound file. */

sf_read			= sf_read_float if FORMAT = PA_FLOAT32;
			= sf_read_int if FORMAT = PA_INT32;
			= sf_read_short if FORMAT = PA_INT16;

/* The play loop. In each iteration we read FRAMESIZE samples from the sound
   file, draw them on the screen and play them back. Please note that this is
   a fairly simplistic implementation. In production code, we would probably
   run playback and user interface in two different threads communicating
   over a semaphore, to avoid dropouts in the playback caused by delays during
   drawing and other GUI processing. */

play NAME		= realtime (play_loop (init_state NAME));

play_loop STATE:Tuple	= () if not tk_ready;
			= play_loop (tk_read STATE) if tk_check;
			= play_loop (update_state STATE) otherwise;
play_loop STATE		= () otherwise;

/* Initialize the application. The state of the application is kept in a tuple
   with the following components:
   - NAME: The name of the soundfile.
   - SF: The soundfile.
   - F: The sample read function (depends on the soundfile format).
   - OUT: The audio output stream.
   - VIS: The ggi visual on which the wave is rendered.
   - WD, HT: The dimensions of the visual.
   - WH: Height of the wave display for each channel.
   - LT, LC, RT, RC: Top and center Y values of the display for the left
     and right channel, respectively.
   - POS: Current position of the progress scale.
   - I: Current audio frame number.
   - N: Total number of audio frames.
   - WAV: Current part of the wave being played.
   - PLAY: Flag indicating whether we are currently playing back. */

init_state NAME		= init_display VIS ||
			  (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   0.0,0,sf_frames SF,WAV,true)
  where OUT:AudioStream = open_audio_stream AUDIO_OUT PA_WRITE INFO,
    SF:SndFile = sf_open NAME SFM_READ (), F = sf_read,
    WAV:ByteStr = F SF FRAMESIZE,
    WIN = tk_quit ||
    tk "wm withdraw .; set argc 0; set argv {}" ||
    tk (sprintf "source %s" (str (prefix "audio_player"++".tcl"))) ||
    tk "proc exit { {returnCode 0} } { q audio_player::quit_cb }" ||
    tk "winfo id $widget(Canvas1)",
    VIS = ggi_open (sprintf "%s:-keepcursor -inwin=%s" (target,WIN)),
    _ = ggi_set_mode VIS "" || ggi_set_flags VIS GGI_FLAG_ASYNC,
    _ = ggi_set_background VIS BACK || ggi_set_foreground VIS FORE,
    (WD,HT) = sscanf (ggi_get_mode VIS) "%dx%d",
    WH = (HT-20) div 2,
    LT = 20, LC = LT+WH div 2,
    RT = LT+WH, RC = RT+WH div 2;

init_state _		= tk_quit otherwise;

target			= "directx" if pos "mingw" sysinfo >= 0;
			= "x" otherwise;

/* Update the application. */

update_state STATE	= tk_read STATE if tk_check;
update_state (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= update_display (VIS,WD,HT,WH,LT,LC,RT,RC)
			  NAME I WAV ||
			  tk_set "pos" (str (I/N*100.0)) ||
			  write_audio_stream OUT WAV ||
			  next_state
			  (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   val (tk_get "pos"),I,N,WAV,PLAY)
			    if PLAY;
update_state STATE	= tk_read STATE otherwise;

next_state (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   POS,I+FRAMESIZE,N,WAV1,PLAY)
			    if #WAV1 > 0 where WAV1:ByteStr = F SF FRAMESIZE;
			= (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   POS,I,N,WAV,false)
			    otherwise;

/* Callbacks. */

play_cb (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   POS,I,N,WAV,true);

stop_cb (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= update_display (VIS,WD,HT,WH,LT,LC,RT,RC)
			  NAME I WAV ||
			  tk_set "pos" (str (I/N*100.0)) ||
			  (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   val (tk_get "pos"),I,N,WAV,false)
			    if PLAY;
stop_cb STATE		= STATE otherwise;

start_cb (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= update_display (VIS,WD,HT,WH,LT,LC,RT,RC)
			  NAME I WAV ||
			  tk_set "pos" "0.0" ||
			  (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   0.0,0,N,WAV,PLAY)
			    where
			      WAV = sf_seek SF 0 SEEK_SET || F SF FRAMESIZE;

end_cb (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= update_display (VIS,WD,HT,WH,LT,LC,RT,RC)
			  NAME I WAV ||
			  tk_set "pos" (str (I/N*100.0)) ||
			  (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   val (tk_get "pos"),I,N,WAV,PLAY)
			    where I = trim N FRAMESIZE,
			      WAV = sf_seek SF I SEEK_SET || F SF FRAMESIZE;

trim N K		= N div K * K if N mod K <> 0;
			= (N div K-1) * K otherwise;

pos_cb POS1 (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= update_display (VIS,WD,HT,WH,LT,LC,RT,RC)
			  NAME I WAV ||
			  (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   POS1,I,N,WAV,PLAY)
			    where I = trim (round (POS1/100.0*N)) FRAMESIZE,
 			      WAV = sf_seek SF I SEEK_SET || F SF FRAMESIZE
			    if POS1<>POS;
pos_cb POS STATE	= STATE otherwise;

expose_cb C (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,POS,I,N,WAV,PLAY)
			= update_display (VIS,WD,HT,WH,LT,LC,RT,RC)
			  NAME I WAV ||
			  (NAME,SF,F,OUT,VIS,WD,HT,WH,LT,LC,RT,RC,
			   POS,I,N,WAV,PLAY)
			    if not PLAY and then (C>0);
expose_cb C STATE	= STATE otherwise;

quit_cb STATE		= tk_quit || STATE;

/* Initialize the display. */

init_display VIS	= ggi_clear VIS || ggi_flush VIS;

/* Update the display. */

update_display (VIS,WD,HT,WH,LT,LC,RT,RC) NAME I WAV
			= show_wave (VIS,WD,HT,WH,LT,LC,RT,RC) WAV ||
			  show_time VIS I || show_name VIS NAME ||
			  ggi_flush VIS;

/* Draw the wave in a box, centered around a horizontal zero line. This is
   done once for each channel in a stereo signal. */

show_wave (VIS,WD,HT,WH,LT,LC,RT,RC) WAV
			= ggi_set_foreground VIS BACK ||
			  ggi_draw_box VIS (0,LT) (WD,WH) ||
			  ggi_draw_box VIS (0,RT) (WD,WH) ||
			  ggi_set_foreground VIS WAVCOL ||
			  ggi_draw_hline VIS (0,LC) WD ||
			  ggi_draw_hline VIS (0,RC) WD ||
			  draw_wave VIS (0,LT) (WD,WH) 0 2 FORMAT WAV ||
			  ggi_puts VIS (5,LT) "L" ||
			  draw_wave VIS (0,RT) (WD,WH) 1 2 FORMAT WAV ||
			  ggi_puts VIS (5,RT) "R";

/* Update the current time in the upper-left corner of the display. */

show_time VIS I		= ggi_set_foreground VIS FORE ||
			  ggi_puts VIS (5,5) (sprintf "%02d:%02d" (MIN,SEC))
			    where
			      SEC = I div RATE,
			      MIN = SEC div 60, SEC = SEC mod 60;

/* Display the name of the sound file at the top of the display. */

show_name VIS NAME	= ggi_set_foreground VIS FORE ||
			  ggi_puts VIS (100,5) (shorten NAME);

def MAXLEN = 30, DELIM = ifelse (pos "mingw" sysinfo >= 0) "/\\" "/";

shorten NAME		= NAME if #NAME <= MAXLEN;
			= ifelse (null SUFF) (last PARTS) (".../" ++ last SUFF)
  where PARTS = split DELIM NAME,
    SUFF = scan1 (lambda X (lambda Y (Y++"/"++X))) (reverse PARTS),
    SUFF = takewhile (compose (<=MAXLEN-4) (#)) SUFF;

/* Main program to be invoked from the shell. */

main [PROG,NAME]	= fprintf ERROR "%s: %s could not be found, please check your installation\n"
			  (PROG,TCL) || exit 1
			    if not isfile (fopen TCL "r")
			    where TCL = prefix "audio_player"++".tcl";
			= play NAME || exit 0
			    where SF:SndFile = sf_open NAME SFM_READ ();
			= fprintf ERROR "%s: bad sound file\n" PROG ||
			  exit 1
			    otherwise;
main [PROG|_]		= fprintf ERROR "Usage: %s file\n" PROG ||
			  exit 1
			    otherwise;

prefix NAME		= substr ANAME 0 (#ANAME-2)
			    where ANAME:String = which NAME;
			= NAME otherwise;