_TITLE "_SNDRAW in action by Petr" DIM SHARED left
AS SINGLE, right
AS SINGLE, oblast
AS LONG, a
, r
, b
, rb
, OLDa
, OLDr
, ob
, oldB
, le
AS SINGLE, ri
AS SINGLE, oldleft
, oldright
, linXL
, lm
, rm
, BalL
, BalR
, OvrLd
, FilePercent
AS DOUBLE, SongPos
, FilePos
AS LONG, hodin
, minut
, sekund
, CurrTime
AS STRING, norm
, normL
, normR
, file
AS STRING, size
, oldsize
, lef
AS SINGLE, righ
AS SINGLE, corector
, block
, t
AS _UNSIGNED LONG, c
AS _UNSIGNED LONG, d
AS LONG, i
file$ = "dog.wav" 'Ufo - Phenomenom is my testing LP <- insert your 16bit stereo LPCM WAV file here NEW: INSERT 8bit mono/stereo WAV - NEWEREST: Insert your MP3 here.
VersionMajor
AS STRING * 1 ' Classical way - ASC number of this characters in file is Version number
spd = .4
size = 88200
' program now supported undirectly MP3, directly ID3, WAV 16/8 all uncompressed types. In program you can see how to read MP3 ID3, MP3 heads, WAV head, APIC and RAW.
mp3 = 1
bits = 16
MP3HEADER file$
id3s file$
block = 2 * chan
po$ = "mp3enc --decode " + file$ + " !swapsoundfile!.raw"
RAW = 1
file$ = "!swapsoundfile!.raw"
CLS:
BEEP:
PRINT "External decoder failure. Variable compression is not supported." ELSE PRINT "external decoder not found, file can not be played":
END Header
corector
= RATE
/ _SNDRATE * (16 / bits
)
CIRCLE (160, 100), 100, 15, 6.28, 3.4 CIRCLE (160, 100), 100, 15, 6, 6.28 CIRCLE (160, 100), 76, 22, 6.28, 3.4 CIRCLE (160, 100), 76, 22, 6, 6.28 CIRCLE (160, 100), ra
, 43, 0, 1.1 CIRCLE (160, 100), ra
, 41, 6, 6.28 CIRCLE (160, 100), ra
, 44, 1.1, 1.6 CIRCLE (160, 100), ra
, 2, 1.6, 3.4 LINE (60, 120)-(260, 150), 15, BF
CIRCLE (160 * 3, 100), 100, 15, 6.28, 3.4 CIRCLE (160 * 3, 100), 100, 15, 6, 6.28 PAINT (160 * 3, 105), 15, 15 CIRCLE (160 * 3, 100), 76, 22, 6.28, 3.4 CIRCLE (160 * 3, 100), 76, 22, 6, 6.28 CIRCLE (160 * 3, 100), ra
, 43, 0, 1.1 CIRCLE (160 * 3, 100), ra
, 41, 6, 6.28 CIRCLE (160 * 3, 100), ra
, 44, 1.1, 1.6 CIRCLE (160 * 3, 100), ra
, 2, 1.6, 3.4 LINE (380, 120)-(580, 150), 15, BF
'////////////
LINE (58, 210)-(262, 290), 15, B
LINE (60, 250)-(260, 250), 15
LINE (378, 210)-(582, 290), 15, B
LINE (380, 250)-(580, 250), 15 '/////////////
'LINE (310, 250)-(330, 265), 15, B
clr = 193
clr = 115
clr = 184
LINE (windows
, 350)-(windows
+ 15, 370), clr
, BF
LINE (320 + windows
, 350)-(320 + windows
+ 15, 370), clr
, BF
'///////////////
BalL = 1
BalR = 1
IF bits
= 16 THEN OverLoad
= 0 norm = 0
normL = 1
normR = 1
EffLen = 0
'///specan////
c = 190
c = 188
c = 209
c = 184
LINE (linies
, ll
)-(linies
+ 10, ll
- 5), c
, BF
krok = 41: kro = block
krok = krok + kro
lef = lefi
righ = righi
lef = leftMono
righ = leftMono
lef = lleft8 / 256
righ = rright8 / 256
lef = mono8 / 256
righ = lef
oldleft = left
oldright = right
LEG = lef
RIG = righ
IF bits
= 16 THEN left
= lef
/ RATE
* BalL
* OvrLd
* normL
* corector
ELSE left
= lef
* BalL
* OvrLd
IF bits
= 16 THEN right
= righ
/ RATE
* BalR
* OvrLd
* normR
* corector
ELSE right
= righ
* BalR
* OvrLd
IF left
> 0.74 THEN left
= 0.74 IF right
> 0.74 THEN right
= 0.74 ' protect speakers from damage, 0.74 is maximal value in standard records from studios if is amplitude really in maximum. IF left
< -0.74 THEN left
= -0.74 IF right
< -0.74 THEN right
= -0.74
oblast = oblast + 1
IF RATE
> 44100 THEN frekvence
= RATE
ELSE frekvence
= 44100 FOR plll
= 1 TO frekvence
/ RATE
eff
IF oblast
MOD 5000 * corector
= 0 THEN ob
= 1 le
= le
+ ABS(left
): ri
= ri
+ ABS(right
)
IF bits
= 8 AND oblast
MOD 4 = 0 THEN digi: budzik le
, ri: lin
IF bits
= 16 AND oblast
MOD 2 = 0 THEN digi: budzik le
, ri: lin
IF oblast
> 50000 * corector
THEN oblast
= 0 CC = tahloL(100, 200, 180, BalL)
CC2 = tahloL(430, 530, 180, BalR)
OO = tahloL(80, 180, 420, OverLoad)
IF bits
= 16 THEN OvrLd
= (8 * OO
) + 1 ELSE OvrLd
= OO
+ 1 'set volume UP to 800% before original record
IF oblast
MOD 210 = 0 THEN SongPos
= tahloL
(90, 550, 325, FilePos
/ LOF(1)) 'function is designated with single values. This is not enought for this use. DOUBLE is better if you need calculating in file position (WAV > 1 GB)... but i create it so as it is...
Time
= (SEEK(1) / RATE
) / block
'vraci cas ve vterinach spravne timing Time
CurrTime$
= hodina$
+ ":" + LTRIM$(minuta$
) + ":" + LTRIM$(sekunda$
)
' ------------------------------------------------- ovladani zobrazeni vysledne obrazovky id3
IF scrn
= 1 THEN viewtime
= TIMER + 15: scrn
= 0: vloz
= 1
' ------------------------------------------------
oldsize = size
' REDIM _PRESERVE SHARED effect(size) AS snd
size = (441 * 8) + 10 * (EffLen * 1000)
IF TrueEffect
= 1 THEN Effl
= tahloL
(80, 180, 455, EffLen
)
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REM IF oblast MOD 10 = 0 THEN specan
'this program use control exit and end!
IF _FILEEXISTS("!swapsoundfile!.raw") THEN KILL "!swapsoundfile!.raw" 'if you plays wav, this file not exist LINE (100, 140)-(540, 340), 15, B
LINE (75, 220)-(100, 260), 15, BF
CASE 101 TO 261: barva
= 47 '101,141,181,221,261 CASE 262 TO 381: barva
= 42 '301,341,381 LINE (cary
, 141)-(cary
+ 38, 339), barva
, BF
LINE (cary
, 141)-(cary
+ 38, 339), 17, BF
CIRCLE (160, 100), 78, 0, aC
, -aC
CIRCLE (480, 100), 78, 0, r
, -r
' IF oblast MOD 1000 = 0 THEN PCOPY 1, _DISPLAY
oprava = 4
b = left * oprava
rb = right * oprava
b = 10 * (Le / 5000) / corector 'because in my loop is MOD 5000
rb = 10 * (Ri / 5000) / corector
Le = 0: Ri = 0
aC = ((3.14 - b) + aC) / 2
r = ((3.14 - rb) + r) / 2
ob = 0
OLDaC = aC
OLDr = r
IF bits
= 8 THEN padani
= .0001 ELSE padani
= .0001 IF aC
> 0 THEN aC
= aC
- padani
CIRCLE (160, 100), 78, 0, OLDaC
, -OLDaC
CIRCLE (480, 100), 78, 0, OLDr
, -OLDr
CIRCLE (160, 100), 78, 25, aC
, -aC
CIRCLE (480, 100), 78, 25, r
, -r
SUB lin
'(le AS SINGLE, ri AS SINGLE) SHARED bits
, oldleft
, oldright
, mu
mu = mu + 1
oldleftG = oldleft
oldrightG = oldright
leftG = left * MN
rightG = right * MN
m = 3 '* (left + right) / 2
oldleftG = oldleft
oldrightG = oldright
leftG = left
rightG = right
m = .25
IF linXL
= 0 OR linXL
> 260 THEN linXL
= 60
linXL = linXL + (m / corector)
linX2L = linXL + 320
lxc = linXL - (.1 / corector)
lxc2 = linX2L - (.1 / corector)
oldle = 250 + (oldleftG * 30)
Leprvy = 250 + (leftG * 30)
oldri = 250 + (oldrightG * 30)
RiPrvy = 250 + (rightG * 30)
LINE (linXL
, (oldle
))-(lxc
, Leprvy
), 14, BF
LINE (linX2L
, oldri
)-(lxc2
, RiPrvy
), 14, BF
'deset pasem
lm = (le / 800 / corector) * (120 / corector)
rm = (ri / 800 / corector) * (120 / corector)
IF lm
> 60 THEN lm
= lm
- .01 ' * corector IF rm
> 60 THEN rm
= rm
- .01 '* corector
FOR windows
= 60 TO lm
STEP 20 'maximal signal = 240 clr = 47
clr = 44
clr = 39
LINE (windows
, 350)-(windows
+ 15, 370), clr
, BF
FOR windows
= 60 TO rm
STEP 20 'maximal signal = 240 clr = 47
clr = 44
clr = 39
LINE (320 + windows
, 350)-(320 + windows
+ 15, 370), clr
, BF
tahloL = startvalue
'extra function - shift in song:
songprocento# = (550 - 90) / 100
sngpos# = (MX - 90) / 100 / songprocento#
newpos#
= sngpos#
* LOF(1) newpos# = newpos# + 1
krok = 41 + newpos#
'end this shifting function
procento# = (xx2 - xx1) / 100
tahloL
= (_MOUSEX - xx1
) / 100 / procento#
'return value 0 to 1, 1 is full startvalue = tahloL
LINE (xx1
, yy
)-(xx2
, yy
), 15 LINE (xx1
+ ((xx2
- xx1
) * tahloL
), yy
+ 5)-(xx1
+ ((xx2
- xx1
) * tahloL
) + 5, yy
- 5), 15, BF
id3:
SUB timing
(hodnota
AS DOUBLE) ' calculate time. Writed for Timer, _SndLen. Input format as TIMER or _SNDLEN WITH "." SHARED hodin
, minuta
, sekunda
' try it copying to new program and write "timing TIMER" for current time calculating. IF hodnota
< 60 THEN hodin
= 0: minut
= 0: sekund
= hodnota:
GOTO a1
IF hodnota
> 60 AND hodnota
< 3600 THEN hodin
= 0: minut
= hodnota
/ 60:
GOTO a2
hodin = hodnota / 3600
tecka
= INSTR(0, hodin$
, ".") minut
= (VAL("0." + RIGHT$(hodin$
, LEN(hodin$
) - tecka
)) * 0.6) * 100 a2:
sekund
= (VAL("0." + RIGHT$(minut$
, LEN(minut$
) - tecka
)) * 0.6) * 100 a1:
tecka
= INSTR(0, sekund$
, ".") sets
= (VAL("0." + RIGHT$(sekund$
, LEN(sekund$
) - tecka
)) * 1) * 100
IF sekunda
= 60 THEN sekunda
= 0
SHARED TrueEffect
, start
, c
, t
, RATE
, prubeh
AS LONG, OpoIndex
, DiscCacheIndex
, start
, Effl
, i
, oldeffl
IF TrueEffect
= 0 THEN TrueEffect
= 1 ELSE TrueEffect
= 0 OpoIndex = 0
DiscCacheIndex = 0
prubeh = 0
start = 0
oldeffl = Effl
' d = d + 4
' IF d > LOF(10) THEN EXIT SUB
i = i + 1
DiscCacheIndex
= DiscCacheIndex
+ 1:
IF DiscCacheIndex
>= 88200 THEN DiscCacheIndex
= 0 DiscCache(DiscCacheIndex).L = left
DiscCache(DiscCacheIndex).R = right
prubeh = prubeh + 1
IF DiscCacheIndex
> (Effl
* 5000) THEN start
= 1 OpoIndex = OpoIndex + 1
IF OpoIndex
>= 88200 THEN OpoIndex
= 0
vystup(i).L = DiscCache(OpoIndex).L * .8
vystup(i).R = DiscCache(OpoIndex).R * .8
vystup(i).L = DiscCache(DiscCacheIndex).L
vystup(i).R = DiscCache(DiscCacheIndex).R
IF prubeh
> 40000 THEN prubeh
= 0 IF RATE
> 44100 THEN frekvence
= RATE
ELSE frekvence
= 44100 FOR plll
= 1 TO frekvence
/ RATE
SUB specan
'experimental sub UPGRADED SHARED left
, right
, oldALeft
, oldARight
, RATE
, LeftFreq
, RightFreq
, doba
, LF
, RF
, L0
, L1
, L2
, L3
, L4
, L5
, L6
, L7
, L8
, R0
, R1
, R2
, R3
, R4
, R5
, R6
, R7
, R8
LeftFreq = LeftFreq + 1
RightFreq = RightFreq + 1
RF = RATE / RightFreq
RightFreq = 0: oldARight = 0
' PRINT "RF"; RF: SLEEP
LF = RATE / LeftFreq
LeftFreq = 0: oldALeft = 0
' PRINT LF: SLEEP
'100 Hz frequency = IF rate is 44100, then its 44100/100 = LF or RF muss contains 441 or more (more bass fraquency) samples.
'16000 Hz = 44100 / 16000 = 2.7 ------++++++
' 2.7 2.7
'dobu pridelovani hodnot k jednotlivym frekvencim stanovim na 2000 pruchodu:
pole = 451
doba
= doba
+ 1:
IF doba
> pole
THEN '882 = 50 Hz, lowest, longest signal L0 = 0: L1 = 0: L2 = 0: L3 = 0: L4 = 0: L5 = 0: L6 = 0: L7 = 0: L8 = 0
R0 = 0: R1 = 0: R2 = 0: R3 = 0: R4 = 0: R5 = 0: R6 = 0: R7 = 0: R8 = 0
doba = 0
CASE 220 TO 451: L0
= L0
+ .4 'sub bass area 50 to 100 Hz CASE 900 TO 1800: L2
= L2
+ .4 CASE 1800 TO 3600: L3
= L3
+ .4 CASE 3600 TO 5000: L4
= L4
+ .4 CASE 5000 TO 8000: L5
= L5
+ .4 CASE 8000 TO 11000: L6
= L6
+ .4 CASE 11000 TO 14000: L7
= L7
+ .4 CASE 14000 TO 17000: L8
= L8
+ .4 CASE 900 TO 1800: R2
= R2
+ .4 CASE 1800 TO 3600: R3
= R3
+ .4 CASE 3600 TO 5000: R4
= R4
+ .4 CASE 5000 TO 8000: R5
= R5
+ .4 CASE 8000 TO 11000: R6
= R6
+ .4 CASE 11000 TO 14000: R7
= R7
+ .4 CASE 14000 TO 17000: R8
= R8
+ .4 vykresleni:
m = 1
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (332, ll0
)-(332 + 10, ll0
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (346, ll1
)-(346 + 10, ll1
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (360, ll2
)-(360 + 10, ll2
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (374, ll3
)-(374 + 10, ll3
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (388, ll4
)-(388 + 10, ll4
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (402, ll5
)-(402 + 10, ll5
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (416, ll6
)-(416 + 10, ll6
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (430, ll7
)-(430 + 10, ll7
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (444, ll8
)-(444 + 10, ll8
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (458, rr0
)-(458 + 10, rr0
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (472, rr1
)-(472 + 10, rr1
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (486, rr2
)-(486 + 10, rr2
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (500, rr3
)-(500 + 10, rr3
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (514, rr4
)-(514 + 10, rr4
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (528, rr5
)-(528 + 10, rr5
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (542, rr6
)-(542 + 10, rr6
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (556, rr7
)-(556 + 10, rr7
- 5), c
, BF
'332 TO 580 STEP 14
c = 49
c = 44
c = 43
c = 39
LINE (570, rr8
)-(570 + 10, rr8
- 5), c
, BF
subchunksize
AS LONG ' 4 bytes (lo / hi), $00000010 for PCM audio format
AS STRING * 2 ' 2 bytes (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM) channels
AS INTEGER ' 2 bytes (1 = mono, 2 = stereo) rate
AS LONG ' 4 bytes (sample rate, standard is 44100) ByteRate
AS LONG ' 4 bytes (= sample rate * number of channels * (bits per channel /8)) Block
AS INTEGER ' 2 bytes (block align = number of channels * bits per sample /8) Bits
AS INTEGER ' 2 bytes (bits per sample. 8 = 8, 16 = 16) subchunk2
AS STRING * 4 ' 4 bytes ("data") contains begin audio samples
PRINT "File name: "; file$
COLOR 15:
PRINT "File size: "; H.size
+ 8;
"bytes" PRINT "File format: "; H.fomat
PRINT "Subchunk1 (may be fmt): "; H.sub1
PRINT "Subchunk size: "; H.subchunksize
PRINT "Audio format: ";
CVI(H.format
) ' in this and next line you see two way to get values. This is read as string and then converted using CVI, PRINT "Audio channels: "; H.channels
' but this value is directly read as number INTEGER (2 byte long number), then is not need CVI. PRINT "Audio Sample Rate:"; H.rate
PRINT "Audio Byte Rate:"; H.ByteRate;
"bites per second" PRINT "Block align: "; H.Block;
"bytes (in stereo format 2x more as in mono)" PRINT "Bits per sample:"; H.Bits
block = H.Block
RATE = H.rate
chan = H.channels
bits = H.Bits
IF bits
<> 16 THEN COLOR 39:
PRINT "Ok, this version support 8 bit WAV audio files! Graphic is not full coordinated with this sounds.":
' SLEEP 3: SYSTEM
PRINT "Reading MP3 file headers...."
first8$
= DECtoBIN$
(ASC(MP3.A
)) second3$
= LEFT$(DECtoBIN$
(ASC(MP3.B
)), 3) ' all 11 bites muss be 11111111111, its head identifier second2$
= LEFT$(RIGHT$(DECtoBIN$
(ASC(MP3.B
)), 5), 2) ' 2 bites MPEG audio version ID: 00=2.5, 01 = reserved, 10=layer2, 11=layer1 seco2d2$
= LEFT$(RIGHT$(DECtoBIN$
(ASC(MP3.B
)), 3), 2) ' 2 bites layer description. 00=reserved,01=layer3,10=layer2,11=layer1 seco3d1$
= RIGHT$(DECtoBIN$
(ASC(MP3.B
)), 1) ' 1 bite protection bit. 0=protected by CRC, 1=not protected third4$
= LEFT$(DECtoBIN$
(ASC(MP3.C
)), 4) ' 4 bites for bitrate index. This value CAN NOT BE 1111. thi2r2$
= LEFT$(RIGHT$(DECtoBIN$
(ASC(MP3.C
)), 4), 2) ' 2 bites sampling rate frequency. This we need for us program thi3r1$
= LEFT$(RIGHT$(DECtoBIN$
(ASC(MP3.C
)), 2), 1) ' 1 bite - padding bit. 0=frame not padded, 1=frame padded '
thi4r1$
= RIGHT$(DECtoBIN$
(ASC(MP3.C
)), 1) ' 1 bite - private bit
four2$
= LEFT$(DECtoBIN$
(ASC(MP3.D
)), 2) ' 2 bite - channel mode: 00=stereo, 01=joint stereo, 10=dual stereo, 11=mono fou22$
= LEFT$(RIGHT$(DECtoBIN$
(ASC(MP3.D
)), 7), 2) ' 2 bite - mode extension. ONLY IF IS JOINT STEREO
fou31$
= LEFT$(RIGHT$(DECtoBIN$
(ASC(MP3.D
)), 4), 2) ' copyright - 0=not copyrighted, 1=copyrighted fou41$
= LEFT$(RIGHT$(DECtoBIN$
(ASC(MP3.D
)), 4), 2) ' 0=copy, 1=original fou52$
= RIGHT$(DECtoBIN$
(ASC(MP3.D
)), 2) ' emphasis: 00=none, 01=50/15mS, 10=reserves, 11=CCIT J.17
first11$ = first8$ + second3$
IF first11$
= "11111111111" THEN CASE "00": Version$
= "Layer 2.5": MPG
= 2: MP
= 2.5: FrameSize
= 1152 CASE "10": Vesrion$
= "Layer 2": MPG
= 2: MP
= 2: FrameSize
= 1152 CASE "11": Version$
= "Layer 1": MPG
= 1: MP
= 1: FrameSize
= 384 CASE "01": Version$
= "ERROR!"
CASE "00": layer$
= "ERROR!" CASE "01": layer$
= "Layer 3": LAY
= 3 CASE "10": layer$
= "Layer 2": LAY
= 2 CASE "11": layer$
= "Layer 1": LAY
= 1 CASE "0": protect$
= "Protected by CRC" CASE "1": protect$
= "Not protected" CASE "0000":
'PRINT "Bitrate free" Bitrate = -1
Freq = -1
IF MPG
= 1 THEN pad
= 32: FrameLenghtInBytes
= (12 * Bitrate
* 1000 / Freq
* 10 + pad
) * 4 IF MPG
= 2 THEN pad
= 8: FrameLenghtInBytes
= 144 * Bitrate
* 1000 / Freq
* 10 + pad
IF MPG
= 1 THEN FrameLenghtInBytes
= (12 * Bitrate
* 1000 / Freq
* 10) * 4 IF MPG
= 2 THEN FrameLenghtInBytes
= 144 * Bitrate
* 1000 / Freq
* 10 CASE "00", "01", "10": chan
= 2
IF ch
= chan
AND f
= Freq
THEN pass
= pass
+ 1 ELSE ch
= chan: f
= Freq
'MUSS BE TESTED IN MORE CASES FOR VARIABLE MP3 COMPRESSION COMPATIBILITY!!!!!!!!!!!!!!!!!!!! IF pass
> 10 THEN EXIT DO ' you can see blick character E in program. Its because E is possible in 44 Khz only and sound use variable compression.
PRINT "Bitrate:"; Bitrate;
"kbps" RATE = Freq
SHARED inframe$
, file$
, identit$
, FileCreated
, bVelikost
IF ID3.Identifier$
<> "ID3" THEN PRINT "ID3 mark not found": identit$
= "ID3V1.1":
GOTO ID3V11
identit$ = Version$
Ba$
= DECtoBIN$
(ASC(ID3.BinarSizeA$
)) Bb$
= DECtoBIN$
(ASC(ID3.BinarSizeB$
)) ' FUNCTION converted decimal numbers to binar numbers Bc$
= DECtoBIN$
(ASC(ID3.BinarSizeC$
)) Bd$
= DECtoBIN$
(ASC(ID3.BinarSizeD$
))
h = HEAD(headd$) / 2
PRINT "Head size calculated AS STRING: "; h;
" bytes"
IF VAL(RIGHT$(LEFT$(DECtoBIN$
(ID3.BinarFlags
), 1), 1)) = 0 THEN PRINT "Extended header for ID3TAG is not used" ELSE PRINT "Extended header for ID3TAG is used - not supported by this program" IF VAL(RIGHT$(LEFT$(DECtoBIN$
(ID3.BinarFlags
), 2), 1)) = 1 THEN PRINT "Experimental ID3 TAG!" 'VAL is possile to use because strings contains zero or one
'----------- cteni framu -------------- frames reading
w = 1 ' FRAME head is 10 bytes long. 4 byte = name "AENC" or other, 4 byte size, 2 byte flags. Size is calculated as ASC sum of all four
home: ' bytes.
GET #1, , FRM
' hlava ma 10 bytu: 4 byty jmeno, 4 byty velikost, 2 byty flags. Vse je psano klasicky hexadecimalne, uz zadny nesmysly s bitama. ' minimalni krok k dalsimu zaznamu ma byt 11 bytu (1byt je minimum pro kazdy identifikator, 10 byt
' je velikost hlavy. Velikost framu je dana souctem ASC ctyr bytu v hlave Framu.
FrameSize
= ASC(FRM.SizeA$
) + ASC(FRM.SizeB$
) + ASC(FRM.SizeC$
) + ASC(FRM.SizeD$
) inframe$
= SPACE$(FrameSize
) 'this statement using is Clippy method, thank Clippy! q$ = FRM.Id$
SELECT CASE FRM.Id$
' - - - - - - - - - - - - - - - - X = HAVE OWN SECOND HEAD and can be more defined CASE "AENC": q$
= "Audio encryption:" ' X CASE "APIC": q$
= "Attached Picture:": APICSUB: FC
= 1:
GOTO home
'X have writed. Is in this program. CASE "COMM": q$
= "Comments:" ' X CASE "COMR": q$
= "Commercial frame:" ' X CASE "ENCR": q$
= "Encryption method:" ' X CASE "EQUA": q$
= "Equalization:" ' X CASE "ETCO": q$
= "Event timing codes:" ' X CASE "GEOB": q$
= "General encapsulated object:" ' X CASE "GRID": q$
= "Group identification registration:" ' X CASE "IPLS": q$
= "Involved people list:" CASE "LINK": q$
= "Linked information:" ' X CASE "MCDI": q$
= "Music CD identifier:" ' X CASE "MLLT": q$
= "MPEG location lookup table:" ' X CASE "OWNE": q$
= "Ownership frame:" ' X CASE "PRIV": q$
= "Private frame:" ' X CASE "PCNT": q$
= "Play counter:" ' X CASE "POPM": q$
= "Popularimeter:" CASE "POSS": q$
= "Position synchronisation frame:" ' X CASE "RBUF": q$
= "Recommended buffer size:" ' X CASE "RVAD": q$
= "Relative volume adjustment:" ' X CASE "RVRB": q$
= "Reverb" ' X CASE "SYLT": q$
= "Synchronized lyric / text:" CASE "SYTC": q$
= "Synchronized tempo codes:" ' X CASE "TALB": q$
= "Album / Movie / Show title:" CASE "TBPM": q$
= "Beats per minute:" CASE "TCOM": q$
= "Composer: " CASE "TCON": q$
= "Content type:" ' X - number = style as ID3TAGV1.1 CASE "TCOP": q$
= "Copyright message:" CASE "TDAT": q$
= "Date:" ' numeric record always 4 bytes long CASE "TDLY": q$
= "Playlist delay:" CASE "TENC": q$
= "Encoded by:" CASE "TEXT": q$
= "Lyricist / Text Writer" CASE "TFLT": q$
= "File type:" ' X - 1/2/3/2.5(MPGs)/AAC/VQF/PCM CASE "TIME": q$
= "Time:" ' format HH:MM CASE "TIT1": q$
= "Content group description:" CASE "TIT2": q$
= "Title / songname:" CASE "TIT3": q$
= "Subtitle / Description refinement:" CASE "TKEY": q$
= "Initial key:" CASE "TLAN": q$
= "Language:" CASE "TLEN": q$
= "Length:" CASE "TMED": q$
= "Media type" ' X CASE "TOAL": q$
= "Original album / movie / show title:" CASE "TOFN": q$
= "Original filename:" CASE "TOLY": q$
= "Original lyricist / text writer:" CASE "TOPE": q$
= "Original artist / performer:" CASE "TORY": q$
= "Original release year:" CASE "TOWN": q$
= "File owner / license:" CASE "TPE1": q$
= "Lead performer / Soloist:" CASE "TPE2": q$
= "Band / orchestra / accompaniment:" CASE "TPE3": q$
= "Conductor / performer refinement:" CASE "TPE4": q$
= "Modified by:" CASE "TPOS": q$
= "Part of a set:" CASE "TPUB": q$
= "Publisher:" CASE "TRCK": q$
= "Track number / Position in set:" CASE "TRDA": q$
= "Recording dates:" CASE "TRSN": q$
= "Internet radio station name:" CASE "TRSO": q$
= "Internet radio station owner:" CASE "TSIZ": q$
= "Size:" CASE "TSRC": q$
= "International standard recording code (ISRC):" CASE "TSSE": q$
= "Software / Hardware used for encoding:" CASE "TYER": q$
= "Year:" CASE "TXXX": q$
= "User defined text frame:" ' X - text encoding, description and value CASE "UFID": q$
= "Unique file identifier:" CASE "USER": q$
= "Terms of use:" ' X CASE "USLT": q$
= "Unsychronized lyric/text transcription:" 'X CASE "WCOM": q$
= "Commercial information:" CASE "WCOP": q$
= "Copyright / Legal information:" CASE "WOAF": q$
= "Official audio file webpage:" CASE "WOAR": q$
= "Official artist / performer webpage:" CASE "WOAS": q$
= "Official audio source webpage:" CASE "WORS": q$
= "Official internet radio webpage:" CASE "WPAY": q$
= "Payment:" CASE "WPUB": q$
= "Publishers official webpage:" CASE "WXXX": q$
= "User defined URL link frame:" ' X
PRINT textencod1
, textencod2
OUTList$(w, 0) = q$
OUTList$(0, w) = inframe$
inframe$ = ""
readet = readet + 10 + FrameSize
EndRec:
bVelikost
= SEEK(1) + tis
'-------- russian upgrade -------
' file$ = "soundcopy.mp3"
file$ = "soundcopy.mp3"
'-----------------------------------
ID3V11:
GET #1, , re0$:
IF LEFT$(re0$
, 3) <> "ID3" THEN PRINT "ID3 mark not found! - but i try this" ' its opened, also its posibble to have uncorrect outputs. IF e
< 128 THEN PRINT "Error: LOF returned file length < 128 bytes!" re$ = re0$ + re2$ ' After several attempts, I realized that the begin of the last record may not be the very last recording at the end of the file... :-D
FOR scan
= 1 TO LEN(re$
) ' Here this loop byte to byte scanned re$ for text "TAG" - its definition for ID3 tag begin IF id$
= "TAG" THEN sca
= scan: found
= 1 ' byte position in string, "found" is myself method to prevent uncorrect outputs if file have none or ID3 V.2.2 ID3TAG, but its not usefull at 100% dal:
Autor$
= LEFT$(MID$(re$
, 33 + sca
), 30) ' filtering strings Album$
= LEFT$(MID$(re$
, 63 + sca
), 30) ' This way "integer = ASC(LEFT$(MID$(string$, position), long)) is way how read MP3 HEAD. BUT MP3 HEAD contains MANY tables and recordings. none:
'PRINT re$ ' If you delete this mark "'", you see as its writed in file
PRINT "Song name: "; SongName$
' Song PRINT "Author: "; Autor$
' Author name PRINT "Album: "; Album$
' Album PRINT "Year: "; Rok$
' Year PRINT "Comment: "; Coment$
' Comment PRINT "Track: "; track$
' Track number PRINT "Genre: "; genre$
' Genre
genre:
DATA Blues
,Classic Rock
,Country
,Dance
,Disco
,Funk
,Grunge
,Hip
-Hop
,Jazz
,Metal
,New Age
,Oldies
,Other
,Pop
,R&B
,Rap
,Reggae
,Rock
,Techno
,Industrial
,Alternative
,Ska
,Death Metal
,Pranks
,Soundtrack
,Eurotechno
,Ambient
DATA Trip
-Hop
,Vocal
,Jazz
+Funk
,Fusion
,Trance
,Classical
,Instrumental
,Acid
,House
,Game
,Sound Clip
,Gospel
,Noise
,Alternative Rock
,Bass
,Soul
,Punk
,Space
,Meditative
,Instrumental Pop
,Instrumental Rock
,Ethnic
DATA Gothic
,Darkwave
,Techno
-Industrial
,Electronic
,Jungle
,Pop
-Folk
,Eurodance
,Dream
,Southern Rock
,Comedy
,Cult
,Gangsta
,Top
40,Christian Rap
,Pop
/Funk
,Native American
,Cabaret
,New Wave
,Psychadelic
,Rave
,Show Tunes
DATA Trailer
,Lo
-Fi
,Tribal
,Acid Punk
,Acid Jazz
,Polka
,Retro
,Musical
,Rock & Roll
,Hard Rock
,Folk
,Folk
/Rock
,National Folk
,Swing
,Fast
-Fusion
,Bebop
,Latin
,Revival
,Celtic
,Bluegrass
,Avantgarde
,Gothic Rock
,Progressive Rock
DATA Psychedelic Rock
,Symphonic Rock
,Slow Rock
,Big Band
,Chorus
,Easy Listening
,Acoustic
,Humour
,Speech
,Chanson
,Opera
,Chamber Music
,Sonata
,Symphony
,Booty Bass
,Primus
,Porn Groove
,Satire
,Slow Jam
,Club
,Tango
,Samba
DATA Folklore
,Ballad
,Power Ballad
,Rhytmic Soul
,Freestyle
,Duet
,Punk Rock
,Drum Solo
,Acapella
,Euro
-House
,Dance Hall
,Goa
,Drum & Bass
,Club
-House
,Hardcore
,Terror
,Indie
,BritPop
,Negerpunk
,Polsk Punk
,Beat
,Christian Gangsta Rap
DATA Heavy Metal
,Black Metal
,Crossover
,Contemporary Christian
,Christian Rock
SHARED file$
, inframe$
, id&
, bVelikost
'vstupni souborova pozice je jedno. Vystupni je podstatna.
home:
a = a + 1
PRINT "Picture detected. Begin at: "; a
bmpsize
= CVL(LEFT$(MID$(detect$
, a
+ 2), 4)) 'read bytes 3,4,5,6 - here is saved file lenght PRINT " Bitmap size: "; bmpsize
dd4:
b = a + bmpsize
ee = bmpsize
a = a + 1
IF s$
= "PNG" THEN PRINT "Picture detected. Begin at: "; a
- 1: newA
= a
- 1 'first byte in PNG is for transfer control dd3:
a = newA
ee = b - a
b = b + 12
xt$ = ".png"
CASE "image/gif" 'both type, 87a or 89a not tested a = a + 1
IF s$
= "GIF" THEN PRINT "Picture detected. Begin at: "; a: c
= a
dd2:
a = c
ee = b - a
xt$ = ".gif"
CASE "image/jpe", "image/jpg", "image/jfi"
a = a + 1
dd:
xt$ = ".jpg"
ee = b - c
a = c
konec:
image$ = "swap" + xt$
'PRINT "EE"; ee, picture$: BEEP: SLEEP
bVelikost = b
SHARED kro
, block
, spd
, ko
, quit
CASE "+": spd
= spd
+ .01 CASE "-": spd
= spd
- .01 ko = tahloL(200, 300, 420, spd)
kro
= block
+ INT(-4 + (ko
* 10)) * (block
/ 2)
FUNCTION HEAD
(b
AS STRING) 'BIN to DEC vystup je integer, vstup je string (jmeno FUNKCE je promenna s hodnotou z funkce) DECtoBI2 = DECtoBI2 + (c * 2 ^ Sj)
' PRINT "Si:"; Si
HEAD = DECtoBI2
FUNCTION DECtoBIN$
(vstup
) 'DEC to BIN ok vystup je string, vstup je integer decimal to binary number convertor - FROM QB64WIKI ' BINARY$ = ""
IF vstup
AND 2 ^ rj
THEN BINtoDE$
= BINtoDE$
+ "1" ELSE BINtoDE$
= BINtoDE$
+ "0" DECtoBIN$ = BINtoDE$
FUNCTION BINtoDEC
(b
AS STRING) 'BIN to DEC vystup je integer, vstup je string (jmeno FUNKCE je promenna s hodnotou z funkce) c
= VAL(e$
) ' binary to decimaly number convertor Sj = 7 - Si
DECtoBI = DECtoBI + (c * 2 ^ Sj)
BINtoDEC = DECtoBI
FUNCTION HEXtoDEC
(h
AS STRING) 'Vystup je integer, vstup je string, opacne k funkci HEX$ HEXtoDEC
= VAL("&H" + h$
) ' hexadecimaly to decimaly number convertor
c = BINtoDEC(bi$) ' binary to hexadecimaly number convertor (use binary to decimaly convertor)