how to find algorythm for sound encode?

[SeregaZ]

i have some DPCM, and i thought i solve this encoding but i test with already prepeared samples and it is work fine. but now i start work with new samples and try to encode from 8 bit PCM into 4 bit DPCM. for decode - i have table and with it no any problem. for encode - i try to make back-ward table, but probably i am not understand something... and i need to some residue probably - to count more accurate. now i just didnt see it in my head...

if you know about encode-decode wav samples and you have some advise - it will be nice

to see difference between original and encode-decode:

Code: Select all

DataSection
  ; piece 8bit MK3
  datamk38bit:
  Data.a $80,$80,$80,$8D,$62,$81,$8E,$8E,$B9,$AC,$81,$56,$81,$74,$67,$92,$67,$64,$6B,$5E,$89,$96,$99,$B8
  Data.a $99,$6E,$99,$7A,$4F,$5C,$71,$46,$3F,$4C,$45,$70,$9B,$B0,$C5,$C8,$C8,$9D,$7E,$71,$5C,$4F,$4C,$61
  
  ; original 4bit MK3
  datamk34bit:
  Data.a $00,$40,$6F,$04,$C7,$FF,$C7,$7C,$AF,$C3,$47,$62,$FE,$E7,$4F,$F5,$4B,$7B,$57,$25,$F0,$CE,$CD,$5A

  ; piece jim 8bit
  datajim8bit:
  Data.a $80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$7F,$7F,$7F,$7F,$7F,$7D,$7C,$7B,$7B
  Data.a $7D,$7F,$82,$87,$8B,$8C,$8A,$86,$81,$7E,$7E,$7E,$80,$84,$86,$83,$7E,$79,$76,$72,$6F,$70,$71,$75
  enddatajim8bit:

EndDataSection


Global Dim pikarray.b(15) ;{
; original table. not need to edit. as is.
pikarray(0)  = 0
pikarray(1)  = 1
pikarray(2)  = 3
pikarray(3)  = 7
pikarray(4)  = $D   ; 13
pikarray(5)  = $15  ; 21
pikarray(6)  = $1F  ; 31
pikarray(7)  = $2B  ; 43
pikarray(8)  = 0
pikarray(9)  = -1
pikarray(10) = -3
pikarray(11) = -7
pikarray(12) = -$D  ; -13
pikarray(13) = -$15 ; -21
pikarray(14) = -$1F ; -31
pikarray(15) = -$2B ; -43
;}

;{ bits operations
Macro SetBit(Var, Bit) ; 
  Var | (Bit)
EndMacro 
Macro ClearBit(Var, Bit) ; 
  Var & (~(Bit))
EndMacro 
Macro TestBit(Var, Bit)
  Bool(Var & (Bit))
EndMacro
Macro NumToBit(Num) ;
  (1<<(Num))
EndMacro
Macro GetBits(Var, StartPos, EndPos)
  ((Var>>(StartPos))&(NumToBit((EndPos)-(StartPos)+1)-1))
EndMacro
;}

;{ 
; just first version. i keep values just in case
Procedure.a GetEncodeValueOr(value.b)
  
  ret.a = 0
  
  Select value
    Case 0
      ret = 0
    Case 1 To 2
      ret = 1
    Case 3 To 6
      ret = 2
    Case 7 To 12
      ret = 3
    Case 13 To 20
      ret = 4
    Case 21 To 30
      ret = 5
    Case 31 To 42
      ret = 6
    Case 43 To 55
      ret = 7
    Case -2 To -1
      ret = 9
    Case -6 To -3
      ret = 10
    Case -12 To -7
      ret = 11
    Case -20 To -13
      ret = 12
    Case -30 To -21
      ret = 13
    Case -42 To -31
      ret = 14
    Case -55 To -43
      ret = 15
  EndSelect
  
  ProcedureReturn ret
  
EndProcedure
;}

Procedure.a GetEncodeValue(value.b)
  
  ret.a = 0
  
  ; this case is not fine. it need to some more tune limitations
  Select value
    Case 0
      ret = 0
    Case 1
      ret = 1
    Case 2 To 3
      ret = 2
    Case 4 To 7
      ret = 3
    Case 8 To 13
      ret = 4
    Case 14 To 21
      ret = 5
    Case 22 To 31
      ret = 6
    Case 32 To 127
      ret = 7
      
    Case -1
      ret = 9
    Case -3 To -2
      ret = 10
    Case -7 To -4
      ret = 11
    Case -13 To -8
      ret = 12
    Case -21 To -14
      ret = 13
    Case -31 To -22
      ret = 14
    Case -127 To -32
      ret = 15
  EndSelect
  
  ProcedureReturn ret
  
EndProcedure

TestNumberb.b
TestNumbera.b

;{ this part for tests original samples. how they are will encode with new table
If blablabla; = 0 ; uncomment here to check it too
Debug "MK3 8bit"
OutText$ = ""
tik = 0
For m = ?datamk38bit To ?datamk34bit - 1
  TestNumbera = PeekA(m)
  OutText$ + "$" + RSet(Hex(TestNumbera, #PB_Ascii), 2, "0") + " "
  tik + 1
  If tik = 12
    tik = 0
    OutText$ + Chr(10)
  EndIf
Next
Debug OutText$


Debug "MK3 into 4bit"
oldvalue = $80
f = 0
OutText$ = ""
tik = 0
For m = ?datamk38bit To ?datamk34bit
  If f = 0
    f = 1
    newvalue = PeekA(m)
    TestNumberb = newvalue - oldvalue
    second = GetEncodeValue(TestNumberb)
    oldvalue = newvalue
  Else
    f = 0
    newvalue = PeekA(m)
    TestNumberb = newvalue - oldvalue
    first = GetEncodeValue(TestNumberb)
    oldvalue = newvalue
    
    OutText$ + "$" + RSet(Hex((first << 4 + second), #PB_Ascii), 2, "0") + " "
    tik + 1
    If tik = 12
      tik = 0
      OutText$ + Chr(10)
    EndIf        
  EndIf 
Next
Debug OutText$


Debug "MK3 4bit"
OutText$ = ""
tik = 0
For m = ?datamk34bit To ?datajim8bit - 1
  TestNumbera = PeekA(m)
  OutText$ + "$" + RSet(Hex(TestNumbera, #PB_Ascii), 2, "0") + " "
  tik + 1
  If tik = 12
    tik = 0
    OutText$ + Chr(10)
  EndIf
Next
Debug OutText$


Debug "MK3 4 => 8"
DPCMinpval.a
DPCMforwrite = $80
OutText$ = ""
tik = 0
For m = ?datamk34bit To ?datajim8bit - 1
  DPCMinpval = PeekA(m)
  
  ; split 8bit value into two 4bit
  DPCMfirst  = GetBits(DPCMinpval, 0, 3) ; get %0000xxxx
  DPCMsecond = GetBits(DPCMinpval, 4, 7) ; get %xxxx0000
  
  DPCMforwrite + pikarray(DPCMfirst)
  OutText$ + "$" + RSet(Hex(DPCMforwrite), 2, "0") + " "
  tik + 1
  DPCMforwrite + pikarray(DPCMsecond)
  OutText$ + "$" + RSet(Hex(DPCMforwrite), 2, "0") + " "
  tik + 1
  If tik = 12
    tik = 0
    OutText$ + Chr(10)
  EndIf
Next
Debug OutText$
EndIf
;}

Debug "JIM"
Debug "8bit"
OutText$ = ""
tik = 0
For m = ?datajim8bit To ?enddatajim8bit - 1
  TestNumbera = PeekA(m)
  OutText$ + "$" + RSet(Hex(TestNumbera, #PB_Ascii), 2, "0") + " "
  tik + 1
  If tik = 12
    tik = 0
    OutText$ + Chr(10)
  EndIf
Next
Debug OutText$

Debug "into 4bit"
f = 0
OutText$ = ""
tik = 0
tik2 = 0
WriteValue.a
Jim4BitMem = AllocateMemory(24)          ; reserve memory for convertin result
oldvalue = $80                           ; starting value
For m = ?datajim8bit To ?enddatajim8bit  ; cycle from start memory to end of memory with this data
  If f = 0
    f = 1                                ; flag, order of bits
    newvalue = PeekA(m)                  ; read from memory
    TestNumberb = newvalue - oldvalue    ; get distinction
    second = GetEncodeValue(TestNumberb) ; get value from "back-table"
    oldvalue = newvalue
  Else
    f = 0                                ; flag, order of bits
    newvalue = PeekA(m)                  ; read from memory
    TestNumberb = newvalue - oldvalue    ; get distinction
    first = GetEncodeValue(TestNumberb)  ; get value from "back-table"
    oldvalue = newvalue
    
    WriteValue = first << 4 + second     ; move bytes and make value for write
    OutText$ + "$" + RSet(Hex(WriteValue, #PB_Ascii), 2, "0") + " " ; text for showing in debug window
    tik + 1
    
    If tik = 12
      tik = 0
      OutText$ + Chr(10) ; next string in a window
    EndIf 
    
    tik2 + 1
    PokeA(Jim4BitMem + tik2, WriteValue) ; write into memory
    
  EndIf 
Next
Debug OutText$


Debug "4 => 8"
DPCMinpval.a
DPCMforwrite = $80
OutText$ = ""
tik = 0
For m = Jim4BitMem To Jim4BitMem + 23
  DPCMinpval = PeekA(m)
  
  ; split 8bit value into two 4bit
  DPCMfirst  = GetBits(DPCMinpval, 0, 3) ; get %0000xxxx
  DPCMsecond = GetBits(DPCMinpval, 4, 7) ; get %xxxx0000
  
  DPCMforwrite + pikarray(DPCMfirst)
  OutText$ + "$" + RSet(Hex(DPCMforwrite), 2, "0") + " "
  tik + 1
  DPCMforwrite + pikarray(DPCMsecond)
  OutText$ + "$" + RSet(Hex(DPCMforwrite), 2, "0") + " "
  tik + 1
  If tik = 12
    tik = 0
    OutText$ + Chr(10)
  EndIf
Next
Debug OutText$

[SeregaZ]

probably i need some residue, but not sure how to count it. so my result is:

that lines cant be 100% same, but need to be closer as much passible.

Code: Select all

DataSection

  datajim8bit: ; original
  Data.a  $80,$7F,$80,$80,$80,$7F,$81,$7D
  Data.a  $82,$81,$7D,$83,$7E,$80,$81,$7E
  Data.a  $80,$80,$7D,$81,$7F,$7F,$80,$80
  Data.a  $7F,$80,$80,$7E,$81,$7E,$80,$7F
  Data.a  $7F,$80,$80,$7D,$82,$7E,$7F,$80
  Data.a  $7F,$81,$7E,$7F,$80,$7F,$80,$81
  Data.a  $7D,$83,$7E,$80,$7F,$81,$7C,$83
  Data.a  $7C,$83,$7C,$85,$7A,$87,$76,$8B
  Data.a  $6E,$A0,$6C,$60,$AB,$4D,$A1,$75
  Data.a  $73,$82,$85,$73,$85,$81,$75,$88
  Data.a  $77,$84,$7E,$7C,$81,$7D,$80,$82
  Data.a  $7B,$82,$7D,$81,$7E,$7F,$81,$7D
  Data.a  $80,$7F,$7F,$81,$7E,$80,$7F,$7F
  Data.a  $80,$7F,$7E,$81,$7C,$80,$80,$7F
  Data.a  $7D,$81,$7F,$7D,$80,$7F,$7E,$7F
  Data.a  $81,$7E,$7F,$83,$7B,$83,$7E,$7D
  Data.a  $82,$7C,$81,$7F,$7E,$83,$7E,$7E
  Data.a  $82,$7D,$81,$7E,$7F,$7F,$7E,$80
  Data.a  $7F,$7F,$80,$80,$7E,$80,$80,$7D
  Data.a  $80,$7E,$7F,$7E,$80,$80,$7E,$80
  Data.a  $80,$7D,$81,$7F,$7E,$80,$7E,$81
  Data.a  $7D,$80,$7F,$7F,$80,$80,$7F,$7F
  Data.a  $7F,$80,$7F,$7E,$81,$7E,$7E,$80
  enddatajim8bit:
  
EndDataSection

Enumeration
  #Window
  #Canvas
  #Button
  #TrackBar
EndEnumeration

; original decode table. not need to edit. as is.
Global Dim pikarray.b(15) ;{
pikarray(0)  = 0
pikarray(1)  = 1
pikarray(2)  = 3
pikarray(3)  = 7
pikarray(4)  = $D   ; 13
pikarray(5)  = $15  ; 21
pikarray(6)  = $1F  ; 31
pikarray(7)  = $2B  ; 43
pikarray(8)  = 0
pikarray(9)  = -1
pikarray(10) = -3
pikarray(11) = -7
pikarray(12) = -$D  ; -13
pikarray(13) = -$15 ; -21
pikarray(14) = -$1F ; -31
pikarray(15) = -$2B ; -43
;}

;{ bits operations
Macro NumToBit(Num)
  (1<<(Num))
EndMacro
Macro GetBits(Var, StartPos, EndPos)
  ((Var>>(StartPos))&(NumToBit((EndPos)-(StartPos)+1)-1))
EndMacro
;}

; paint image on a window
Procedure CanvPaint(forot.l, fordo.l, box.a, xshif.a)
  
  If StartDrawing(CanvasOutput(#Canvas))
    If box
      Box(0, 0, 880, 280, 0)
      Line(0, $80, 880, 1, RGB(0, 200, 0))
      color = RGB(240, 240, 240)
    Else
      color = RGB(80, 80, 250)
    EndIf
    x = 10
    oldx = 0
    oldy = $80
    For m = forot To fordo
      y = PeekA(m)
      ; count direction
      ; x always bigger oldx
      If y <> oldy
        height = oldy - y
      Else
        height = 1
      EndIf
      Line(x, y, oldx - x, height, color)
      oldx = x
      oldy = y
      x + xshif
    Next
    StopDrawing()
  EndIf
  
EndProcedure

Procedure.a GetEncodeValue(value.b)
  
  ret.a = 0
  
  Select value
    Case 0
      ret = 0
    Case 1 To 2
      ret = 1
    Case 3 To 6
      ret = 2
    Case 7 To 12
      ret = 3
    Case 13 To 20
      ret = 4
    Case 21 To 30
      ret = 5
    Case 31 To 42
      ret = 6
    Case 43 To 127
      ret = 7
    Case -2 To -1
      ret = 9
    Case -6 To -3
      ret = 10
    Case -12 To -7
      ret = 11
    Case -20 To -13
      ret = 12
    Case -30 To -21
      ret = 13
    Case -42 To -31
      ret = 14
    Case -127 To -43
      ret = 15
  EndSelect
  
  ProcedureReturn ret
  
EndProcedure

Procedure DPCMEncode(forstart.l, forend.l, memory.l)
  
  Number.a
  OldNumber.a
  TestValue.b
  FlagOrder.a
  First.a
  Second.a
  MemShift.l
  
  OldNumber = $80 ; 0x80
  FlagOrder = 0
  MemShift  = 0
  For m = forstart To forend
    If FlagOrder = 0
      FlagOrder = 1
      
      Number = PeekA(m)                  ; read from mem
      TestValue = Number - OldNumber     ; count value
      First = GetEncodeValue(TestValue)  ; get value from table
      OldNumber = Number
    Else
      FlagOrder = 0
      
      Number = PeekA(m)                  ; read from mem
      TestValue = Number - OldNumber     ; count value
      Second = GetEncodeValue(TestValue) ; get value from table
      OldNumber = Number
      
      PokeA(memory + MemShift, second << 4 + first) ; write into memory encoded byte
      MemShift + 1                       ; move memory pointer to next byte
    EndIf
  Next
  
EndProcedure

Procedure DPCMDecode(forstart.l, size.l, memory.l)
  
  Number.a
  MemShift.l
  MemWriteValue.b
  
  MemShift = 0
  MemWriteValue = $80
  For m = forstart To forstart + size - 1
    Number = PeekA(m)
    
    ; split 8bit value into two 4bit
    DPCMfirst  = GetBits(Number, 0, 3) ; get %0000xxxx
    DPCMsecond = GetBits(Number, 4, 7) ; get %xxxx0000
    
    MemWriteValue + pikarray(DPCMfirst) 
    PokeB(memory + MemShift, MemWriteValue)
    MemShift + 1
    
    MemWriteValue + pikarray(DPCMsecond) 
    PokeB(memory + MemShift, MemWriteValue)
    MemShift + 1
  Next
  
EndProcedure

Procedure WavHeaderCreation(*memst, freq.l, size.l, bits.a)
  
             ;RIFF
             PokeB(*memst, $52):PokeB(*memst+1, $49):PokeB(*memst+2,$46):PokeB(*memst+3, $46)
             
             ;size
             PokeL(*memst+4, size+44-8)
             
             ;WAVE
             PokeB(*memst+8, $57):PokeB(*memst+9, $41):PokeB(*memst+10,$56):PokeB(*memst+11, $45)
    
             ;fmt
             PokeB(*memst+12, $66):PokeB(*memst+13, $6d):PokeB(*memst+14,$74):PokeB(*memst+15, $20) 
    
             ;size
             PokeB(*memst+16, $10)
    
             ;PCM 01
             PokeB(*memst+20, $01)
    
             ;mono stereo
             PokeB(*memst+22, $01)
    
             ;freq - 10400
             PokeL(*memst+24, freq)
    
             ;kbs
             PokeL(*memst+28, freq)
    
             ;bytes - 1
             PokeB(*memst+32, $01)
    
             ;bit
             PokeB(*memst+34, bits)
        
             ;data    
             PokeB(*memst+36, $64)
             PokeB(*memst+37, $61)
             PokeB(*memst+38, $74)
             PokeB(*memst+39, $61)
             
             ;sizedata
             PokeL(*memst+4, size)             
  
EndProcedure

OldTrackBarValue = 5
If OpenWindow(#Window, 100, 100, 900, 340, "")
  
  CanvasGadget(#Canvas, 10, 10, 880, 280)
  
  ButtonGadget(#Button, 10, 310, 50, 20, "play")
  
  TrackBarGadget(#TrackBar, 100, 310, 100, 20, 1, 10)
  SetGadgetState(#TrackBar, OldTrackBarValue)

  
  CanvPaint(?datajim8bit, ?enddatajim8bit - 1, 1, OldTrackBarValue)
  
  ; encode
  size = ?enddatajim8bit - ?datajim8bit ; count memory size, what need for encoded
  size = size / 2
  If size
    EncodedMem = AllocateMemory(size)
    If EncodedMem                           ; * 2 = for avoide odd-numbered
      DPCMEncode(?datajim8bit, ?datajim8bit + (size * 2), EncodedMem)
    Else
      Debug "mem problem"
    EndIf
  EndIf
  
  ; decode
  If EncodedMem 
    
    decodedsize = size * 2
    DecodedMem = AllocateMemory(decodedsize)
    If DecodedMem
      DPCMDecode(EncodedMem, size, DecodedMem)
      CanvPaint(DecodedMem, DecodedMem + decodedsize - 1, 0, OldTrackBarValue)
      WavMem = AllocateMemory(decodedsize + 44)
      If WavMem
        CopyMemory(DecodedMem, WavMem+44, decodedsize)
        WavHeaderCreation(WavMem, 6500, decodedsize, 8)
      EndIf
    Else
      Debug "mem problem"
    EndIf
    
  EndIf
  
  Repeat
     Select WaitWindowEvent()

       Case #PB_Event_Gadget

         Select EventGadget()
           
           Case #Button
             If EventType() = #PB_EventType_LeftClick
               If WavMem
                 ; not plays :((( too short piece?
                 sndPlaySound_(WavMem, #SND_MEMORY | #SND_ASYNC | #SND_NODEFAULT)
               EndIf
             EndIf
           Case #TrackBar
             If EventType() = #PB_EventType_LeftClick
               NewTrackBarValue = GetGadgetState(#TrackBar)
               If NewTrackBarValue <> OldTrackBarValue
                 OldTrackBarValue = NewTrackBarValue
                 CanvPaint(?datajim8bit, ?enddatajim8bit - 1, 1, OldTrackBarValue)
                 If DecodedMem
                   CanvPaint(DecodedMem, DecodedMem + decodedsize - 1, 0, OldTrackBarValue)
                 EndIf
               EndIf
             EndIf

         EndSelect

       Case #PB_Event_CloseWindow
         qiut = 1
   
     EndSelect
   Until qiut = 1

EndIf

End

with this part looks like more accurate:

Code: Select all

Procedure DPCMEncode(forstart.l, forend.l, memory.l)
  
  Number.a
  OldNumber.a
  TestValue.b
  FlagOrder.a
  First.a
  Second.a
  MemShift.l
  
  OldNumber = $80 ; 0x80
  FlagOrder = 0
  MemShift  = 0
  For m = forstart To forend
    If FlagOrder = 0
      FlagOrder = 1
      
      Number = PeekA(m)                  ; read from mem
      TestValue = Number - OldNumber     ; count value
      First = GetEncodeValue(TestValue)  ; get value from table
      OldNumber = OldNumber + pikarray(First) ;Number
    Else
      FlagOrder = 0
      
      Number = PeekA(m)                  ; read from mem
      TestValue = Number - OldNumber     ; count value
      Second = GetEncodeValue(TestValue) ; get value from table
      OldNumber = OldNumber + pikarray(Second) ;Number
      
      PokeA(memory + MemShift, second << 4 + first) ; write into memory encoded byte
      MemShift + 1                       ; move memory pointer to next byte
    EndIf
  Next
  
EndProcedure

need to test with real samples and hear - how they sound after this.


nope. sound bad hiss. *crying