Search

in:

Forum: Software Development

Forums > Software Development > GET YOUR Z80 and ADPCM HERE > QBASIC Source for encoder/decoder (NOT REALLY NEEDED FOR ANYTHING JUST HERE TO BE COMPLETE)

QBASIC Source for encoder/decoder (NOT REALLY NEEDED FOR ANYTHING JUST HERE TO BE COMPLETE)


MERLiX posts: 58 3 stars United_Kingdom
oh and just incase anyone actually cares heres the encoder... in QBASIC (Ofcourse)

'8-bit > 3-bit Step Table
DATA 1 , 1 , 1,1 , 2, 2 , 2
DATA 3 ,3, 4 , 4 , 5 , 5, 6 , 7
DATA 8 , 9 , 10 , 11 , 12 , 14 , 15 , 17 , 19 , 20
DATA 23 , 25 , 27 , 30 , 33 , 37 , 40 , 44 , 49 , 54
DATA 59 , 65 , 72 , 79 , 87 , 96 , 105 , 116
'Index Adjust Table
DATA -1,-1,1,2

DIM steps(0 TO 42)
DIM adjust(0 TO 3)

FOR tmp = 0 TO 42
READ steps(tmp)
NEXT

FOR tmp = 0 TO 3
READ adjust(tmp)
NEXT


OPEN "soniccd.wav" FOR BINARY AS #1
OPEN "soniccd.ads" FOR BINARY AS #2
OPEN "son.out" FOR BINARY AS #3
'OPEN "comp" FOR OUTPUT AS #4

SEEK #1, 68

c$ = " "

GET #1, , c$
prev = ASC(c$)
index = 0

bitstep(0) = 1
bitstep(1) = 2
bitstep(2) = 4
bitstep(3) = 8
bitstep(4) = 16
bitstep(5) = 32
bitstep(6) = 64
bitstep(7) = 128

DO
GET #1, , c$
dif = prev - ASC(c$)
IF dif < 0 THEN
SB = 1
dif = ABS(dif)
ELSE
SB = 0
END IF
code = INT(2 * dif / steps(index))
IF code > 3 THEN code = 3

pdiff = prev + (steps(index) * code) / 2

'Oh look its code that doesn't even do anything,, its a bug
IF SB = 0 THEN
prev = prev + pdif
ELSE
prev = prev - pdif
END IF


SELECT CASE INT(code)
CASE 0
CASE 1
o(0) = o(0) + bitstep(curbit)
CASE 2
o(1) = o(1) + bitstep(curbit)
CASE 3
o(1) = o(1) + bitstep(curbit)
o(0) = o(0) + bitstep(curbit)
END SELECT

IF SB = 0 THEN

ELSE
o(2) = o(2) + bitstep(curbit)
END IF

'This is my stupid check crap.. not really needed
IF (o(1) AND bitstep(curbit)) 0 THEN
newcode = 2
ELSE
newcode = 0
END IF
IF (o(0) AND bitstep(curbit)) 0 THEN
newcode = newcode + 1
END IF

IF (o(2) AND bitstep(curbit)) 0 THEN
newsb = 1
ELSE
newsb = 0
END IF

IF newcode code THEN PRINT "ERROR CODE "; code, "!"; newcode; "!": END
IF newsb SB THEN PRINT "ERROR SB"; SB, newsb: END

IF newsb = 0 THEN
newvalue = 128 - INT((steps(index) * newcode) / 2)
ELSE
newvalue = 128 + INT((steps(index) * newcode) / 2)
END IF

nv$ = CHR$(newvalue)

PUT #3, , nv$

index = index + adjust(code)
IF index > 42 THEN index = 42
IF index < 0 THEN index = 0

curbit = curbit + 1
IF curbit = 8 THEN
curbit = 0
o$ = CHR$(o(0)) + CHR$(o(1)) + CHR$(o(2))
o(0) = 0
o(1) = 0
o(2) = 0
PUT #2, , o$
LOCATE 24, 1
PRINT LOC(1), LOF(1), code, index;
END IF
LOOP UNTIL EOF(1)
IF curbit 0 THEN
o$ = CHR$(o(0)) + CHR$(o(1)) + CHR$(o(2))
PUT #2, , o$
END IF
CLOSE #1
CLOSE #2

Oh and heres the decode routine

'8-bit > 3-bit Step Table
DATA 1 , 1 , 1,1 , 2, 2 , 2
DATA 3 ,3, 4 , 4 , 5 , 5, 6 , 7
DATA 8 , 9 , 10 , 11 , 12 , 14 , 15 , 17 , 19 , 20
DATA 23 , 25 , 27 , 30 , 33 , 37 , 40 , 44 , 49 , 54
DATA 59 , 65 , 72 , 79 , 87 , 96 , 105 , 116
'Index Adjust Table
DATA -1,-1,1,2

DIM steps(0 TO 42)
DIM adjust(0 TO 3)

FOR tmp = 0 TO 42
READ steps(tmp)
NEXT

FOR tmp = 0 TO 3
READ adjust(tmp)
NEXT


OPEN "soniccd.ads" FOR BINARY AS #1
OPEN "soniccd.out" FOR BINARY AS #2
OPEN "decomp" FOR OUTPUT AS #4
'SEEK #1, 68

o$ = " "

prev = 128
index = 0

bitstep(0) = 1
bitstep(1) = 2
bitstep(2) = 4
bitstep(3) = 8
bitstep(4) = 16
bitstep(5) = 32
bitstep(6) = 64
bitstep(7) = 128

curbit = 7

DO
curbit = curbit + 1
IF curbit = 8 THEN
curbit = 0
LOCATE 24, 1
PRINT LOC(1), LOF(1);
GET #1, , o$
o(0) = ASC(MID$(o$, 1, 1))
o(1) = ASC(MID$(o$, 2, 1))
o(2) = ASC(MID$(o$, 3, 1))
END IF

sb = o(2) AND 1
code = (o(1) AND 1) * 2 + (o(0) AND 1)

FOR tmp = 0 TO 2
o(tmp) = INT(o(tmp) \ 2)
NEXT

IF sb 0 THEN
value = prev + (steps(index) * code) / 2
IF value > 255 THEN value = 255
ELSE
value = prev - (steps(index) * code) / 2
IF value < 0 THEN value = 0
END IF

index = index + adjust(code)
IF index > 42 THEN index = 42
IF index < 0 THEN index = 0

c$ = CHR$(value)
PUT #2, , c$
PRINT curbit, code, sb

LOOP UNTIL EOF(1)
CLOSE #1
CLOSE #2

Well thus ends my saga of attempted z80,, may it rot in hell.

Show posts:
Jump to forum:

Current Poll

All your base are belong to us
  • you bet!
  • what?!?
View Results
(Votes: 198)
Cookies must be allowed to vote

Online users

61 online users

Shoutbox

tomman, 09:00 CEST, 2014/04/08: (Note to myself: try Fusion on Debian Jessie...)
tomman, 09:00 CEST, 2014/04/08: Twitter? Social networking? HELL NO :P
Eidolon, 11:05 CET, 2014/03/22: Good to see you around, Steve! Just installing Fusion on my new laptop to enjoy a round of Lunar The Silver Star once again :)
zyrobs, 00:32 CET, 2014/03/08: I would but I can't figure out how Twitter works. Typical Web2.0 BS, optimized for stupid people...
King, 16:59 CET, 2014/02/26: Followed!
sith-smasher, 14:46 CET, 2014/02/22: A sign of Snakey; good that you are ok man! I hope life is treating you better than before. Peace.
Snake, 06:01 CET, 2014/02/20: Everybody in the world follow me on twitter @RealSteveSnake - just because.
King, 20:57 CET, 2014/02/17: SNAKKEEEEEEEE! :D
Snake, 19:21 CET, 2014/02/16: *waves*
King, 18:49 CET, 2014/02/15: Awesome, let him know we miss him and that we're glad he's okay! :)
RSS feed Wiki RSS feed Articles RSS feed Forums