(define sound-list dict:new())
(define sounds-loaded #f)

(define ignore-any-sounds #f)

(constant snd-info-idx-file-name 0)
(constant snd-info-idx-flags 1)
(constant snd-info-idx-channel 2)
(constant snd-info-idx-precedence 3)
(constant snd-info-idx-replacement 4) ;; #t: classic sound; #f: no replacement; otherwise: symbol
(constant snd-info-idx-chunk 5)


define register-sound(id channel precedence file-name classic flags)
  ;if {not symbol? replace} {replace := id}
  ;; last is chunk object
  assert {symbol? id} "sound id should be a symbol"
  assert between?(channel 1 4) string-append("bad channel for sound " symbol->string(id))
  assert number?(precedence) string-append("bad precedence for sound " symbol->string(id))
  define snd-info (make-vector #t file-name flags channel precedence classic #nil)
  dict:put! sound-list id snd-info


define load-sounds()
  define mk-fname(fname)
    string-append make-data-path("sound/") fname ".opus"
  define load-sound(fname)
    if {string? fname}
      then
        define chunk sdl:mixer-load-chunk(mk-fname(fname))
        if {null? chunk}
          printf "ERROR loading sound \"%s\" (%s)\n" fname mk-fname(fname)
        chunk
      else
        #nil
  ;;
  if {not sounds-loaded}
    then
      printf "loading sounds...\n"
      define stt {- ticks-msec()}
      (sdl:mixer-init 'OPUS)
      (sdl:mixer-open)
      define it dict:iter:new(sound-list)
      define value
      while dict:iter:next(it)
        {value := dict:iter:value(it)}
        {value[snd-info-idx-chunk] := load-sound(value[snd-info-idx-file-name])}
      {stt := {stt + ticks-msec()}}
      printf "loaded in %o msecs.\n" stt
      gset! sounds-loaded #t


define find-sound(id)
  assert {symbol? id} "sound id should be a symbol"
  define snd-info dict:find(sound-list id)
  define rnd-list
  if {false? snd-info}
    error string-append("sound \"" symbol->string(id) "\" not found!")
    if {pair? {rnd-list := assq('GD_SP_FAKE snd-info[snd-info-idx-flags])}}
      find-sound list-ref(cdr(rnd-list) game:random(list-length(cdr(rnd-list))))
      snd-info

;; 4 channels
(define chan-ids #('GD_S_NONE 'GD_S_NONE 'GD_S_NONE 'GD_S_NONE 'GD_S_NONE))
(define chan-precs #(0 0 0 0 0))
(define chan-looped #(#f #f #f #f #f))
;; start new sound on the frame update?
(define chan-start #(#f #f #f #f #f))


define reset-sounds()
  gset! chan-ids #('GD_S_NONE 'GD_S_NONE 'GD_S_NONE 'GD_S_NONE 'GD_S_NONE)
  gset! chan-precs #(0 0 0 0 0)
  gset! chan-looped #(#f #f #f #f #f)
  gset! chan-start #(#f #f #f #f #f)
  sdl:mixer-halt-channel #t


define update-sounds()
  ;; restart all sounds which need to be restarted
  define snd
  define chan
  iterate
    init {chan := 0}
    repeat {chan <> vector-length(chan-start)}
      if chan-start[chan]
        then
          {chan-start[chan] := #f}
          {snd := find-sound(chan-ids[chan])}
          if {null? snd[snd-info-idx-chunk]}
            sdl:mixer-halt-channel chan
            sdl:mixer-play-channel chan snd[snd-info-idx-chunk] chan-looped[chan]
      if {not sdl:mixer-channel-playing?(chan)}
        then
          {chan-precs[chan] := 0}
          {chan-looped[chan] := #f}
          {chan-ids[chan] := 'GD_S_NONE}
      inc! chan
    else #void


define play-sound-intr(id)
  ; sorry!
  define snd-info find-sound(id)
  define chunk snd-info[snd-info-idx-chunk]
  define chan snd-info[snd-info-idx-channel]
  define prec snd-info[snd-info-idx-precedence]
  define flags snd-info[snd-info-idx-flags]
  define loop? {any-true? assq('GD_SP_LOOPED flags)}
  define force? {any-true? assq('GD_SP_FORCE flags)}
  define free? {chan-ids[chan] eq? 'GD_S_NONE}
  ;;
  define stop-sound()
    if chan-looped[chan]
      then
        ; only interrupt looped sounds; non-looped sounds will go away automatically
        {chan-ids[chan] := 'GD_S_NONE}
        {chan-precs[chan] := 0}
        {chan-looped[chan] := #f}
        {chan-start[chan] := #t}
  ;;
  define do-play()
    ;printf "do-play: %o\n" id
    cond
      {{not {null? chunk}} and
       {free? or force? or {not {chan-ids[chan] eq? id}}}}
        {chan-precs[chan] := prec}
        {chan-ids[chan] := id}
        {chan-looped[chan] := loop?}
        {chan-start[chan] := #t}
      else #void
  ;; channel 1 is for small sounds
  define play-chan-1()
    {force? := #t}  ;; always
    if {prec >= chan-precs[chan]}
      do-play()
  ;; other channels
  define play-chan-other()
    if {free? or force? or {prec > chan-precs[chan]}}
      do-play()
  ;; main
  ;printf "sound: %o\n" id
  cond
    {id eq? 'GD_S_NONE} stop-sound()
    {chan = 1} play-chan-1()
    else play-chan-other()

define play-sound(id)
  if {not ignore-any-sounds}
    play-sound-intr id


define stop-amoeba-magic-sounds()
  case chan-ids[3]
    (GD_S_AMOEBA GD_S_AMOEBA_MAGIC GD_S_MAGIC_WALL)
      {chan-ids[3] := 'GD_S_NONE}
      {chan-precs[3] := 0}
      {chan-looped[3] := #f}
      {chan-start[3] := #t}
    else
      #void


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sound list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(register-sound 'GD_S_NONE 1 0 #nil #t #nil)

;; channel 1: small sounds, ie. diamonds falling, boulders rolling.
;; diamond collect sound has precedence over everything.
;; CHANNEL 1 SOUNDS ARE ALWAYS RESTARTED, so no need for GD_SP_FORCE flag.
(register-sound 'GD_S_STONE               1 10 "stone"          #t #nil)
(register-sound 'GD_S_NUT                 1  8 "nut"            #f #nil) ;; nut falling is relatively silent, so low precedence
(register-sound 'GD_S_NUT_CRACK           1 12 "nut_crack"      #f #nil) ;; higher precedence than a stone bouncing
(register-sound 'GD_S_DIRT_BALL           1  8 "dirt_ball"      #f #nil) ;; sligthly lower precedence, as stones and diamonds should be "louder"
(register-sound 'GD_S_NITRO               1 10 "nitro"          #f #nil)
(register-sound 'GD_S_FALLING_WALL        1 10 "falling_wall"   'GD_S_STONE #nil)
(register-sound 'GD_S_EXPANDING_WALL      1 10 "expanding_wall" 'GD_S_STONE #nil)
(register-sound 'GD_S_WALL_REAPPEAR       1  9 "wall_reappear"  #f #nil)
(register-sound 'GD_S_DIAMOND_RANDOM      1 10 #nil             #t '((GD_SP_FAKE . (GD_S_DIAMOND_1 GD_S_DIAMOND_2 GD_S_DIAMOND_3 GD_S_DIAMOND_4 GD_S_DIAMOND_5 GD_S_DIAMOND_6 GD_S_DIAMOND_7 GD_S_DIAMOND_8))))
(register-sound 'GD_S_DIAMOND_1           1 10 "diamond_1"      #t #nil)
(register-sound 'GD_S_DIAMOND_2           1 10 "diamond_2"      #t #nil)
(register-sound 'GD_S_DIAMOND_3           1 10 "diamond_3"      #t #nil)
(register-sound 'GD_S_DIAMOND_4           1 10 "diamond_4"      #t #nil)
(register-sound 'GD_S_DIAMOND_5           1 10 "diamond_5"      #t #nil)
(register-sound 'GD_S_DIAMOND_6           1 10 "diamond_6"      #t #nil)
(register-sound 'GD_S_DIAMOND_7           1 10 "diamond_7"      #t #nil)
(register-sound 'GD_S_DIAMOND_8           1 10 "diamond_8"      #t #nil)
;; collect sounds have higher precedence than falling sounds and the like
(register-sound 'GD_S_DIAMOND_COLLECT     1 100 "diamond_collect"     #t #nil)
(register-sound 'GD_S_SKELETON_COLLECT    1 100 "skeleton_collect"    'GD_S_DIAMOND_COLLECT #nil)
(register-sound 'GD_S_PNEUMATIC_COLLECT   1  50 "pneumatic_collect"   'GD_S_DIAMOND_RANDOM #nil)
(register-sound 'GD_S_BOMB_COLLECT        1  50 "bomb_collect"        'GD_S_DIAMOND_RANDOM #nil)
(register-sound 'GD_S_CLOCK_COLLECT       1  50 "clock_collect"       #t #nil)
(register-sound 'GD_S_SWEET_COLLECT       1  50 "sweet_collect"       'GD_S_NONE #nil)
(register-sound 'GD_S_KEY_COLLECT         1  50 "key_collect"         'GD_S_DIAMOND_RANDOM #nil)
(register-sound 'GD_S_DIAMOND_KEY_COLLECT 1  50 "diamond_key_collect" 'GD_S_DIAMOND_RANDOM #nil)
(register-sound 'GD_S_SLIME               1   5 "slime"               'GD_S_NONE #nil) ;; slime has lower precedence than diamond and stone falling sounds
(register-sound 'GD_S_LAVA                1   5 "lava"                'GD_S_NONE #nil) ;; lava has low precedence, too
(register-sound 'GD_S_REPLICATOR          1   5 "replicator"          'GD_S_NONE #nil)
(register-sound 'GD_S_ACID_SPREAD         1   3 "acid_spread"         'GD_S_NONE #nil) ;; same for acid, even lower
(register-sound 'GD_S_BLADDER_MOVE        1   5 "bladder_move"        'GD_S_NONE #nil) ;; same for bladder
(register-sound 'GD_S_BLADDER_CONVERT     1   8 "bladder_convert"     'GD_S_NONE #nil)
(register-sound 'GD_S_BLADDER_SPENDER     1   8 "bladder_spender"     'GD_S_NONE #nil)
(register-sound 'GD_S_BITER_EAT           1   3 "biter_eat"           'GD_S_NONE #nil) ;; very low precedence. biters tend to produce too much sound

;; channel 2: walking; also time running out sound.
(register-sound 'GD_S_DOOR_OPEN           2  10 "door_open"        #t #nil)
(register-sound 'GD_S_WALK_EARTH          2  10 "walk_earth"       #t #nil)
(register-sound 'GD_S_WALK_EMPTY          2  10 "walk_empty"       #t #nil)
(register-sound 'GD_S_STIRRING            2  10 "stirring"         #t #nil)
(register-sound 'GD_S_BOX_PUSH            2  10 "box_push"         'GD_S_STONE #nil)
(register-sound 'GD_S_TELEPORTER          2  10 "teleporter"       'GD_S_NONE #nil)
(register-sound 'GD_S_TIMEOUT_1           2  20 "timeout_1"        #t #nil) ;; timeout sounds have increasing precedence so they are always started
(register-sound 'GD_S_TIMEOUT_2           2  21 "timeout_2"        #t #nil) ;; timeout sounds are examples which do not need "force restart" flag
(register-sound 'GD_S_TIMEOUT_3           2  22 "timeout_3"        #t #nil)
(register-sound 'GD_S_TIMEOUT_4           2  23 "timeout_4"        #t #nil)
(register-sound 'GD_S_TIMEOUT_5           2  24 "timeout_5"        #t #nil)
(register-sound 'GD_S_TIMEOUT_6           2  25 "timeout_6"        #t #nil)
(register-sound 'GD_S_TIMEOUT_7           2  26 "timeout_7"        #t #nil)
(register-sound 'GD_S_TIMEOUT_8           2  27 "timeout_8"        #t #nil)
(register-sound 'GD_S_TIMEOUT_9           2  28 "timeout_9"        #t #nil)
(register-sound 'GD_S_TIMEOUT             2 150 "timeout"          'GD_S_NONE '((GD_SP_FORCE)))
(register-sound 'GD_S_EXPLOSION           2 100 "explosion"        #t '((GD_SP_FORCE)))
(register-sound 'GD_S_BOMB_EXPLOSION      2 100 "bomb_explosion"   'GD_S_EXPLOSION '((GD_SP_FORCE)))
(register-sound 'GD_S_GHOST_EXPLOSION     2 100 "ghost_explosion"  'GD_S_EXPLOSION '((GD_SP_FORCE)))
(register-sound 'GD_S_VOODOO_EXPLOSION    2 100 "voodoo_explosion" 'GD_S_EXPLOSION '((GD_SP_FORCE)))
(register-sound 'GD_S_NITRO_EXPLOSION     2 100 "nitro_explosion"  'GD_S_EXPLOSION '((GD_SP_FORCE)))
(register-sound 'GD_S_BOMB_PLACE          2  10 "bomb_place"       'GD_S_NONE #nil)
;; precedence larger than normal, but smaller than timeout sounds
(register-sound 'GD_S_SWITCH_BITER        2  10 "switch_biter"      #nil 'GD_S_NONE)
(register-sound 'GD_S_SWITCH_CREATURES    2  10 "switch_creatures"  #nil 'GD_S_NONE)
(register-sound 'GD_S_SWITCH_GRAVITY      2  10 "switch_gravity"    #nil 'GD_S_NONE)
(register-sound 'GD_S_SWITCH_EXPANDING    2  10 "switch_expanding"  #nil 'GD_S_NONE)
(register-sound 'GD_S_SWITCH_CONVEYOR     2  10 "switch_conveyor"   #nil 'GD_S_NONE)
(register-sound 'GD_S_SWITCH_REPLICATOR   2  10 "switch_replicator" #nil 'GD_S_NONE)

;; channel 3: amoeba sound, magic wall sound, cave cover & uncover sound, and the crack sound (gate open)
(register-sound 'GD_S_WATER               3  20 "water"            'GD_S_NONE '((GD_SP_LOOPED)))
(register-sound 'GD_S_AMOEBA              3  30 "amoeba"           #t         '((GD_SP_LOOPED)))
(register-sound 'GD_S_MAGIC_WALL          3  35 "magic_wall"       #t         '((GD_SP_LOOPED)))
(register-sound 'GD_S_AMOEBA_MAGIC        3  40 "amoeba_and_magic" #t         '((GD_SP_LOOPED)))
(register-sound 'GD_S_PNEUMATIC_HAMMER    3  50 "pneumatic"        #t         '((GD_SP_LOOPED)))
(register-sound 'GD_S_COVER               3 100 "cover"            #t         '((GD_SP_LOOPED)))
;(register-sound 'GD_S_CRACK               3 150 "crack"            #t         #nil)
(register-sound 'GD_S_GRAVITY_CHANGE      3 160 "gravity_change"   'GD_S_NONE #nil)
(register-sound 'GD_S_FINISHED            3 200 "finished"         #t         '((GD_SP_FORCE))) ;GD_SP_LOOPED

;; other sounds
;; the bonus life sound has nothing to do with the cave
;; playing on channel 4
(register-sound 'GD_S_BONUS_LIFE          4  1 "bonus_life" 'GD_S_NONE #nil)
(register-sound 'GD_S_ENOUGH_DIAMONDS     4  2 "crack"      'GD_S_NONE #nil)
(register-sound 'GD_S_CRACK               4  6 "crack"      #t         #nil)
