GStest
; http://rafb.net/paste/results/wMmfaj42.html
; Author: DarkDragon (updated for PB 4.00 by Andre)
; Date: 19. February 2006
; OS: Windows
; Demo: Yes
#SLen=10000*4
Structure WAVE
wFormatTag.w
nChannels.w
nSamplesPerSec.l
nAvgBytesPerSec.l
nBlockAlign.w
wBitsPerSample.w
cbSize.w
EndStructure
Structure WAVE_EX
RiffSig.l
RiffCount.l
WaveSig.l
fmtSig.l
TWaveFormat.l
w.WAVE
DataSig.l
DataCount.l
EndStructure
Procedure WAV_CreateSound(Filename.s, *SoundData, SoundDataSize.l, Bits.b,
SampleRate.l)
If Bits = 0 : Bits =
8 : EndIf
If Bits > 32 : Bits =
32 : EndIf
pFile = CreateFile(#PB_Any, Filename)
If pFile
WaveFormatEx.WAVE_EX
With WaveFormatEx
\RiffSig
= $46464952
\RiffCount
= SizeOf(WAVE_EX) + SoundDataSize
\WaveSig
= $45564157
\fmtSig
= $20746D66
\TWaveFormat =
SizeOf(WAVE)
\w\wFormatTag
=
#WAVE_FORMAT_PCM
\w\nChannels
= 1
\w\nSamplesPerSec
= SampleRate
\w\wBitsPerSample
= Bits
\w\nBlockAlign
= (WaveFormatEx\w\nChannels *
WaveFormatEx\w\wBitsPerSample) /8
\w\nAvgBytesPerSec
= WaveFormatEx\w\nSamplesPerSec *
WaveFormatEx\w\nBlockAlign
\w\cbSize
= 0
\DataSig
= $61746164
\DataCount
= SoundDataSize
EndWith
WriteData(pFile, @WaveFormatEx, SizeOf(WAVE_EX))
WriteData(pFile, *SoundData, SoundDataSize)
CloseFile(pFile)
ProcedureReturn 1
EndIf
EndProcedure
Procedure WAV_Load_Sound(Filename.s, *Size.LONG, *Bits.LONG,
*SampleRate.LONG)
*Size\l = 0
pFile = ReadFile(#PB_Any, Filename)
If pFile
WaveFormatEx.WAVE_EX
ReadData(pFile, @WaveFormatEx, SizeOf(WAVE_EX))
If WaveFormatEx\RiffSig = $46464952 And
WaveFormatEx\WaveSig = $45564157 And WaveFormatEx\fmtSig = $20746D66 And
WaveFormatEx\DataSig = $61746164
SoundDataSize = WaveFormatEx\DataCount
*Size\l
= SoundDataSize
*SampleRate\l =
WaveFormatEx\w\nSamplesPerSec
*Bits\l
= WaveFormatEx\w\wBitsPerSample
*SoundData = AllocateMemory(SoundDataSize)
ReadData(pFile, *SoundData, SoundDataSize)
EndIf
CloseFile(pFile)
ProcedureReturn *SoundData
EndIf
EndProcedure
Procedure Rect(Value.d)
Value = Sin(Value)*2
Result = 0
If Result = 0
If Value > 0
Result = 1
Else
Result = -1
EndIf
EndIf
ProcedureReturn Result
EndProcedure
SampleRate = 11025
Global Dim SoundWaves.b(#SLen)
w = 2*#PI*500
For t=1 To #SLen
SoundWaves(t) =
t&(t>>8);t&t>>4|t>>7|t>>5|t>>14
;t&0x256?t>>4:t>>10
;(t&(-t>>4)) |
((t<<4)&(t>>8));((t>>5)|(t>>2)*(t>>5));t&(t>>8);(127
+ 127 * Sin(k * w / SampleRate))
Next
WAV_CreateSound("test1.wav", @SoundWaves(), #SLen, 8, SampleRate)
Global Dim SoundWaves2.b(0)
;SoundWaves2() = WAV_Load_Sound("test1.wav", @Size.l, @Bits.l, @SR.l)
Debug Size
Debug Bits
Debug SR
Debug CompareMemory(@SoundWaves(), @SoundWaves2(), #SLen)
; IDE Options = PureBasic 5.30 (Windows - x86)
; CursorPosition = 112
; FirstLine = 81
; Folding = -
; EnableXP
sample_len equ 32768
LD HL,sample
ld bc,sample_len
ld de,0
gens:
push de
ld a,e
dup 8
sra d
rr e
edup
and e
sub e
pop de
inc de
ld (hl),a
inc hl
dec bc
ld a,b:or c:jr nz,gens
После нескольких правок GS запел, но пустой экран с воспроизведением
звука выглядел слегка убого, размер кода позволял, и я решил добавить
анимацию. Выбор пал на нелюбимые риндексом атрибуты. Во-первых, вывод на
экран осуществляется проще, без лишних процедур подсчета адреса на экране,
вывода точки и прочих. device zxspectrum128
ORG #6000
begin
colortab: db 42h
db 56h
db 77h
db 7Ah
db 50h
db 40h
db 40h
db 40h
db 41h
db 4Dh
db 6Fh
db 7Eh
db 71h
db 48h
db 40h
db 40h
runi:
;+---+---+---+
;| 1 | 2 | 3 |
;+---+---+---+
;| 4 | | 5 |
;+---+---+---+
;| 6 | 7 | 8 |
;+---+---+---+
opcodes:
dec e;1
dec d;1
nop ;2
dec d;2
inc e;3
dec d;3
inc e;5
nop ;5
dec e;6
inc d;6
nop ;7
inc d;7
inc e;8
inc d;8
dec e;4
nop ;4
sample_len equ 32768
LD HL,sample
ld bc,sample_len
ld de,0
gens:
push de
ld a,e
dup 8
sra d
rr e
edup
and e
sub e
pop de
inc de
ld (hl),a
inc hl
dec bc
ld a,b:or c:jr nz,gens
call load_sam
; draw grid
ld hl,$4000,c,$AA
drgr: ld (hl),c
inc l:jr nz,drgr
;or a
rrc c
inc h
ld a,h:cp $58:jr nz,drgr
eor_2:
call play
opv1:ld a,-1
inc a:ld (opv1+1),a
and 7:ld c,a,b,0
ld hl,opcodes
add hl,bc
add hl,bc
ld a,(hl):inc hl:ld (op1),a
ld a,(hl):ld (op2),a
ld hl,50*4
eor_lp: ei:halt:halt
push hl
push de
ld hl,$5800
ld b,colortab/256
xor_lp:
ld a,l
sub e
xor d
; rra
and $0F
ld c,a,a,(bc),(hl),a
inc hl
ld a,l:and 31:jr nz,xor_lp
next_r:
inc d
ld a,h:cp $5B:jr nz,xor_lp
pop de
op1: inc d
op2: inc e
pop hl;$5B00
dec hl
ld a,h:or l:jr z,eor_2
jp eor_lp
;-------------------------------------------------------------------------load_sam:
LD A ,$F3;#F3 Warm restart
CALL SC;and WC
LD A ,$38;#38 Load FX sample to memory
CALL SC
LD A,$D1;Open Stream
CALL SC
LD HL,sample;$6614
LD DE,$7D37
L65DE: LD A ,(HL)
OUT ($B3), A
INC HL
L65E2: IN A,(GSCOM)
RLCA
JR C ,L65E2
DEC E
JR NZ ,L65DE
DEC D
JR NZ ,L65DE
LD A,$D2
CALL SC;Open Stream
ret
play:
; LD A ,$3F
; OUT (GSDAT), A
; LD A ,$2B
; CALL SC;Set FX Master Volume
LD A ,$1
OUT (GSDAT), A
LD A ,$31
call SC;OUT (GSDAT), A;#31 Play module
;
; LD A,$01;C#0
; OUT (GSDAT), A
LD A ,$40;#40 Set FX Sample Playing Note
CALL SC
xx: LD A ,$01;C#0
OUT (GSDAT), A
LD A ,$39;#39 Play FX
GSCOM EQU 187;$BB
GSDAT EQU 179;$B3
SC: OUT (GSCOM),A;SC #NN
WCLP: IN A,(GSCOM)
RRCA
RET NC
JR WCLP
sample:
end
display /d,runi
display /d,end-begin
savesna "!gst.sna",runi;begin
savebin "gstest_",begin,end-begin