#! /usr/bin/env fth
\ agn.fth -- Bill Schottstaedt's agn.cl
\     (see clm-2/clm-example.clm and clm-2/bess5.cl)

\ Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
\ Created: 04/12/15 23:30:43
\ Changed: 14/11/17 23:06:11

\ Type do-agn
\ or start the script in a shell.

#t value *clm-c-version*

dl-load sndlib Init_sndlib
*clm-c-version* [if]
	dl-load sndins Init_sndins
[else]
	require clm-ins
[then]
require clm
require env

*argc* 2 > [if]
	*argv* 2 array-ref
[else]
	"agn.fsm"
[then] value agn-test-file
60.0 value agn-time

#t		to *clm-play*
#t		to *clm-statistics*
#t		to *clm-verbose*
44100		to *clm-srate*
2		to *clm-channels*
<'> jc-reverb	to *clm-reverb*
'( :volume 0.8 ) to *clm-reverb-data*
2		to *clm-reverb-channels*
#t		to *clm-delete-reverb*
mus-next	to *clm-header-type*
mus-bfloat	to *clm-sample-type*

: rbell ( x -- r )
	100 f* '( 0 0 10 0.25 90 1 100 1 ) 1.0 envelope-interp
;

: tune ( x -- r )
	{ x }
	#( 1 256/243 9/8 32/27 81/64 4/3
	   1024/729 3/2 128/81 27/16 16/9 243/128 2 ) x 12.0 fmod f>s array-ref
	   2.0 x 12.0 f/ floor f**
	   f*
;

#( 0 0 2 4 11 11 5 6 7 9 2 0 0 ) constant agn-mode
256 constant agn-lim

#f value agn-octs
#f value agn-pits
#f value agn-rhys
#f value agn-amps
#f value agn-begs

: agn-init ( -- )
	agn-lim make-array map!
		1.0 random rbell f2* 4.0 f+ floor
	end-map to agn-octs
	agn-lim make-array map!
		agn-mode 1.0 random 12.0 f* floor f>s array-ref
	end-map to agn-pits
	agn-lim make-array map!
		1.0 random 6.0 f* 4.0 f+
	end-map to agn-rhys
	agn-lim make-array map!
		1.0 random rbell 8.0 f* 1.0 f+
	end-map to agn-amps
	agn-lim make-array map!
		1.0 random 0.9 f<
		if
			1.0 random f2* 4.0 f+
		else
			4.0 random 6.0 f*
		then
	end-map to agn-begs
;

: agn ( fname -- )
	( fname ) io-open-write { io }
	io "\\ from agn.cl (clm-2/clm-example.clm, clm-2/bess5.cl)\n" io-write
	io "\\\n" io-write
	io "%s\n" '( make-default-comment ) io-write-format
	#( '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
	   '( 0 0 60 0.1 80 0.2 90 0.4 95 1 100 0 )
	   '( 0 0 10 1 16 0 32 0.1 50 1 56 0 60 0 90 0.3 100 0 )
	   '( 0 0 30 1 56 0 60 0 90 0.3 100 0 )
	   '( 0 0 50 1 80 0.3 100 0 )
	   '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
	   '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
	   '( 0 0 10 1 32 0.1 50 1 90 0.3 100 0 )
	   '( 0 0 60 0.1 80 0.3 95 1 100 0 )
	   '( 0 0 80 0.1 90 1 100 0 ) ) { wins }
	agn-init
	4 1 do
		0 4 0 { cellbeg cellsiz cellctr }
		1 i s>f i 1- s>f 0.2 { whichway base mi mytempo }
		0.0 0.0 { nextbeg beg }
		begin
			beg agn-time f< cellctr agn-lim < and
		while
			beg nextbeg f+ to beg
			mytempo 1.0 random 0.2 f* 0.9 f+ f* ( r )
			agn-rhys cellctr array-ref f*  0.25 fmax to nextbeg
			16.352 2.0 mi f** f/ ( r1 )
			agn-pits cellctr array-ref tune f* ( r1 r2 )
			2.0 agn-octs cellctr array-ref f** f* { freq } ( r1 )
			freq 100.0 f< if
				nextbeg f2*
			else
				nextbeg
			then { dur } ( r1 )
			agn-amps cellctr array-ref 60.0 base f* 1/f f*
			    0.003 fmax { amp } ( r1 )
			1.0 random f2* base f* { ind } ( r1 )
			base 0.1 f* { revamt } ( r1 )
			10.0 beg beg floor f- f* floor f>s { winnum } ( r1 )
			0.00001 freq 2.0 flogn 4.0 f- 4.0 f**
			    ( r1 r2 ) f* { ranamt }
			io
			"
%f %f %f %f :fm-index %f
	:amp-env %S
	:reverb-amount %f :noise-amount %f fm-violin"
			    '( beg dur freq amp ind
			       wins
			       winnum array-ref revamt ranamt ) io-write-format
			cellctr 1+ to cellctr
			cellctr cellsiz cellbeg + > if
				cellbeg 1+ to cellbeg
				1.0 random 0.5 f> if
					cellsiz whichway + to cellsiz
				then
				cellsiz 16 >
				1.0 random 0.99 f> && if
					-2 to whichway
				else
					cellsiz 12 >
					1.0 random 0.999 f> && if
						-1 to whichway
					else
						cellsiz 4 < if
							1 to whichway
						then
					then
				then
				cellbeg 3 + to cellbeg
				cellbeg to cellctr
			then
		repeat
	loop
	io "\n\n\\ %s ends here\n" '( agn-test-file ) io-write-format
	io io-close
;

: do-agn ( -- )
	agn-test-file undef file-basename ".snd" $+ { sndfile }
	"\\ writing \"%s\"\n" '( agn-test-file ) fth-print
	agn-test-file agn
	:output sndfile agn-test-file clm-load
;

'snd provided? [unless] do-agn [then]

\ agn.fth ends here
