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 = 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
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
maybe before encode - i need to make some a little lower volume for that part, where is too high piks? because table of MK3 can have 43 as maximum.