'shuffle' wave files (quick Open Watcom FORTRAN hack)

rearrange.for

* Rearranges patches of a wave-file (shuffles them like a card deck)



      program REARRANGE

       include 'fsublib.fi'



       structure /WAVEHEADER/

        integer		main_id

        integer		length

        integer		wave_id

        integer		fmt_id

        integer		fmt_length

        integer*2	format

        integer*2	channels

        integer		samplerate

        integer		byte_per_second

        integer*2	samplesize

        integer*2	bit

        integer		data_id

        integer		data_length

       end structure



       character*256		arg

       record /WAVEHEADER/	header

       logical			exists

       integer*2		t_h, t_m, t_s, t_ms

       integer*1		buffer(:)

       integer			src, dst, status, size, patchsize



       real			length



       if(iargc() .NE. 4)

     &  stop 'rearrange {infile.wav} {outfile.wav} {patchsize|0}'



       call igetarg(3, arg)

       read(arg,*) length



       call igetarg(1, arg)

       inquire(file=arg, exist=exists)

       if(.not. exists) go to 666



       open(10, file=arg, status='OLD', access='SEQUENTIAL', err=666,

     &       form='UNFORMATTED', recordtype='FIXED', action='READ')

       read(10,err=666) header

       header.samplesize = 2

       size = filesize(10) - isizeof(header)

       allocate(buffer(size), stat=status)

       if(status .NE. 0) go to 666

       read(10,err=666) buffer

       close(10)



       call gettim(t_h, t_m, t_s, t_ms)

       if(length .NE. 0)

     &  patchsize = length*header.samplesize*header.samplerate

       i = 1

       while(i .LE. size) do

	if(length .EQ. 0)

     &   patchsize = urand(t_ms)*header.samplesize*header.samplerate

        if(mod(patchsize, 2)) patchsize = patchsize + 1

        if(i + patchsize .GT. size) quit

	k = int(urand(t_ms)*(size-patchsize)/

     &		(header.channels*header.samplesize))*

     &		header.channels*header.samplesize + 1

        do j = 0, patchsize

	 src = buffer(i+j)

	 dst = buffer(k+j)

	 buffer(i+j) = dst

	 buffer(k+j) = src

	end do

	i = i + patchsize

       end while



       call igetarg(2, arg)

       inquire(file=arg, exist=exists)

       if(exists) call fsystem('del '//arg(:lentrim(arg)))

       open(10, file=arg, status='NEW', access='SEQUENTIAL',err=666,

     &       form='UNFORMATTED', recordtype='FIXED', action='WRITE')

       write(10,err=666) header

       write(10,err=666) buffer

       close(10)



       deallocate(buffer)



       stop 'Finished properly'

666    print *, 'Some kind of error occured - but I don''t care...'

      end