'OHRRPGCE - Allegro music backend
'(C) Copyright 1997-2020 James Paige, Ralph Versteegen, and the OHRRPGCE Developers
'Dual licensed under the GNU GPL v2+ and MIT Licenses. Read LICENSE.txt for terms and disclaimer of liability.

'' The new sfx interface is not completely implemented.

#print
#print WARNING: music_allegro can only play WAV (and sometimes MIDI/BAM) and other problems
#print

#include "config.bi"
#include "backends.bi"
#include "music.bi"
#include "util.bi"
#include "common.bi"


#undef font
#undef readkey
#undef bitmap
#undef ellipse
#undef num_joysticks
#include "allegro.bi"


'this should be in allegro.bi but isn't (for old FB anyway)
#ifndef MIDI_AUTODETECT
#define MIDI_AUTODETECT -1
#endif

TYPE SoundEffect EXTENDS SFXCommonData
  used as bool 'whether this slot is free

  paused as bool
  playing as bool

  buf as SAMPLE ptr
  voice as integer
END TYPE

'''' Module-shared variables

dim shared music_on as bool = NO
dim shared music_vol as single
dim shared music_paused as bool = NO
dim shared music_song as MIDI ptr = 0
dim shared music_length as double = 0

dim shared sound_inited as bool  'Needed for anything but sound_init to work
dim shared sfx_slots(7) as SoundEffect


'The music module needs to manage a list of temporary files to
'delete when closed, mainly for custom, so they don't get lumped
type delitem
	fname as zstring ptr
	nextitem as delitem ptr
end type

dim shared delhead as delitem ptr = null


sub music_init()
	if allegro_initialised = NO then
		allegro_init()
		allegro_initialised = YES
	end if

	if music_on = NO then
		install_sound(DIGI_AUTODETECT, MIDI_AUTODETECT, 0)

		music_vol = 0.5
		music_on = YES
		music_paused = NO

		music_setvolume(music_vol)
	end if	
end sub

sub music_close()
	if music_on then
		'Let Allegro shut down the music systems on exit
		'just stop the song, if playing
		if music_song then
			destroy_midi(music_song)
			music_song = NO
			music_paused = NO
		end if

		if delhead <> null then
			'delete temp files
			dim ditem as delitem ptr
			dim dlast as delitem ptr

			ditem = delhead
			while ditem <> null
				if isfile(*(ditem->fname)) then
					kill *(ditem->fname)
				end if
				deallocate ditem->fname 'deallocate string
				dlast = ditem
				ditem = ditem->nextitem
				deallocate dlast 'deallocate delitem
			wend
			delhead = null
		end if
		'music_on = NO
	end if
end sub

function music_get_info() as string
	return allegro_id
end function

function music_supported_formats() as integer
	return FORMAT_BAM or FORMAT_MIDI
end function

function sound_supported_formats() as integer
	return FORMAT_WAV
end function

function music_settings_menu () as bool
	return NO
end function

sub music_play(filename as string, fmt as MusicFormatEnum)
	if music_on = YES then
		dim songname as string = filename

		if fmt = FORMAT_BAM then
			dim midname as string
			dim as integer flen = filelen(songname)
			'use last 3 hex digits of length as a kind of hash, 
			'to verify that the .bmd does belong to this file
			flen = flen and &h0fff
			midname = tmpdir & trimpath(songname) & "-" & lcase(hex(flen)) & ".bmd"
			'check if already converted
			if isfile(midname) = NO then
				bam2mid(songname, midname)
				'add to list of temp files
				dim ditem as delitem ptr
				if delhead = null then
					delhead = allocate(sizeof(delitem))
					ditem = delhead
				else
					ditem = delhead
					while ditem->nextitem <> null
						ditem = ditem->nextitem
					wend
					ditem->nextitem = allocate(sizeof(delitem))
					ditem = ditem->nextitem
				end if
				ditem->nextitem = null
				'allocate space for zstring
				ditem->fname = allocate(len(midname) + 1)
				*(ditem->fname) = midname 'set zstring
			end if
			songname = midname
			fmt = FORMAT_MIDI
		end if

		'stop current song
		if music_song then
			destroy_midi(music_song)
			music_song = NO
			music_paused = NO
		end if

		log_openfile(songname)
		music_song = load_midi(songname)
		if music_song = 0 then
			debug "Could not load song " + songname
			exit sub
		end if

		get_midi_length(music_song)  'Sets midi_time
		music_length = midi_time  'In seconds!

		play_midi(music_song, 1)
		music_paused = NO
	end if
end sub

sub music_pause()
	if music_on = YES then
		if music_song then
			if music_paused = NO then
				midi_pause
				music_paused = YES
			end if
		end if
	end if
end sub

sub music_resume()
	if music_on then
		if music_song then
			midi_resume
			music_paused = YES
		end if
	end if
end sub

sub music_stop()
	music_pause()
end sub

sub music_setvolume(byval vol as single)
	music_vol = vol
	if music_on = YES then
		'This sets only MIDI volume
		set_volume(-1, music_vol * 255)
	end if
end sub

function music_getvolume() as single
	music_getvolume = music_vol
end function

function music_seekable() as bool
	return NO
end function

function music_gettime() as double
	if music_song then
		return midi_time
	end if
	return -1.0
end function

function music_settime(byval pos_s as double) as bool
	' Allegro allows seeking in MIDI using midi_pos and midi_seek but that requires a beat number
	' not a time in seconds.
	return NO
end function

' Returns length in seconds!
function music_getlength() as double
	if music_song then
		return music_length
	end if
	return -1.0
end function



sub sound_init
  'if this were called twice, the world would end.
  if sound_inited then exit sub
  
  'anything that might be initialized here is done in music_init
  'but, I must do it here too
  music_init
end sub

sub sound_close
  'trying to free something that's already freed... bad!
  if sound_inited = NO then exit sub
  
  dim i as integer
  
  for i = 0 to ubound(sfx_slots)
    with sfx_slots(i)
      if .used then
        deallocate_voice(.voice)
        destroy_sample(.buf)
        .paused = NO
        .playing = NO
        .used = NO
        .buf = 0
      end if
    end with
  next
  
  'let allegro clean up for me
  
  sound_inited = NO
end sub

'UNIMPLEMENTED
sub sound_reset()
end sub

'PARTIALLY UNIMPLEMENTED
' Returns -1 if too many sounds already playing/loaded
function next_free_slot() as integer
  dim i as integer
  dim retake_slot as integer

  'Look for empty slots
  for i = 0 to ubound(sfx_slots)
    if sfx_slots(i).used = NO then
      return i
    end if
  next

  'Look for silent slots
  'UNIMPLEMENTED: .playing does not automatically set to NO;
  'we need to check each sfx
  for i = 0 to ubound(sfx_slots)
    retake_slot = (retake_slot + 1) mod (ubound(sfx_slots)+1)
    with sfx_slots(retake_slot)
      if .playing = NO and .paused = NO then
        sound_unload retake_slot
        return retake_slot
      end if
    end with
  next

  ' evict something
  sound_unload retake_slot
  return retake_slot
end function

function sound_load(slot as integer, f as string, num as integer) as integer
  'slot is the sfx_slots element to use
  'f is the file.
  dim i as integer
  
  with sfx_slots(slot)
    if .used then
      sound_free(slot)
    end if
    
    .used = YES
    .effectID = num
    log_openfile(f)
    .buf = load_wav(f)
    
    if .buf = NULL then
      debug "load_wav " & f & " failed"
      return -1
    end if
    
    .voice = allocate_voice(.buf)
    
    if .voice = -1 then return -1
  end with
  
  return slot 'yup, that's all
  
end function

function sound_load overload(filename as string, num as integer = -1) as integer
  dim slot as integer = next_free_slot()
  sound_load slot, filename, num
  return slot
end function

sub sound_unload(slot as integer)
  with sfx_slots(slot)
    if .used then
      .used = NO
      .playing = NO
      .paused = NO
      deallocate_voice(.voice)
      destroy_sample(.buf)
    end if
  end with
end sub

' UNIMPLEMENTED: volume ignored
sub sound_play(slot as integer, loopcount as integer, volume as single)
  with sfx_slots(slot)
    if .used = NO then exit sub
    if .playing and .paused = NO then exit sub
    if .buf = 0 then exit sub
    
    if loopcount then
      ' Finite loops not supported
      voice_set_playmode(.voice,PLAYMODE_LOOP)
    else
      voice_set_playmode(.voice,PLAYMODE_PLAY)
    end if
    
    .paused = NO
    .playing = YES
    voice_start(.voice)
  end with
end sub

' UNIMPLEMENTED
sub sound_setvolume(slot as integer, volume as single)
end sub

' UNIMPLEMENTED
function sound_getvolume(slot as integer) as single
  return 1.
end function

sub sound_pause(slot as integer)
  with sfx_slots(slot)
    if .used = NO then exit sub
    if .playing = NO then exit sub
    if .paused then exit sub
    
    .paused = YES
    voice_stop(.voice)
  end with
end sub

sub sound_stop(slot as integer)
  with sfx_slots(slot)
    if .used = NO then exit sub
    if .playing = NO then exit sub
    
    .playing = NO
    .paused = NO
    
    voice_stop(.voice)
    voice_set_position(.voice,0)
  end with
end sub

function sound_playing(slot as integer) as bool
  with sfx_slots(slot)
    if .used = NO then return NO

    return voice_get_position(.voice) <> -1
  end with
end function

function sound_slotdata(slot as integer) as SFXCommonData ptr
  if slot < 0 or slot > ubound(sfx_slots) then return NULL
  if sfx_slots(slot).used = NO then return NULL
  return @sfx_slots(slot)
end function

function sound_lastslot as integer
  return ubound(sfx_slots)
end function

' UNIMPLEMENTED
sub sound_free(num as integer)
end sub

function sound_slot_with_id(num as integer) as integer
  for slot as integer = 0 to ubound(sfx_slots)
    if sfx_slots(slot).used andalso sfx_slots(slot).effectID = num then
      return slot
    end if
  next
  return -1
end function
