pcmaudio: bugfix corrupted audio, loop mode, adjust examples

examples/pcmtest.pas

@@ -1,32 +1,21 @@
-{$H1536}
+{$H2560}
-program pcmtest;
+program pcmtest2;
 uses pcmaudio;
 
 var filename:string;
     buf:SndBufPtr;
-    f:file;
-    size:integer;
-    i:integer;
-    c:char;
     sampleRate:integer;
     err:integer;
+    done:boolean;
+    c:char;
+
+function readAudioFile(fname:string):SndBufPtr;
+var i,size:integer;
+    c:char;
+    buf:SndBufPtr;
+    f:file;
 begin
-	if ParamCount > 0 then
+	open(f, fname, ModeReadOnly);
-		filename := ParamStr(1)
-	else
-	begin
-		write('Filename> ');
-		readln(filename);
-	end;
-
-	err := 1;
-	if ParamCount > 1 then
-		val(ParamStr(2),sampleRate, err);
-
-	if err <> 0 then
-		sampleRate := 16000;
-
-	open(f, filename, ModeReadOnly);
 	size := FileSize(f);
 	new(buf, size);
 
@@ -41,6 +30,26 @@ begin
 
 	close(f);
 
+	readAudioFile := buf;
+end;
+
+begin
+	if ParamCount > 0 then
+		filename := ParamStr(1)
+	else
+	begin
+		write('Filename> ');
+		readln(filename);
+	end;
+
+	err := 1;
+	if ParamCount > 1 then
+		val(ParamStr(2), sampleRate, err);
+	if err > 0 then
+		sampleRate := 22050;
+
+	buf := readAudioFile(filename);
+
 	PlaySample(buf, sampleRate);
 
 	dispose(buf);

examples/pcmtest2.pas

@@ -50,7 +50,7 @@ begin
 
 	buf := readAudioFile(filename);
 
-	SampleQStart(buf, sampleRate);
+	SampleQStart(buf, false, sampleRate);
 
 	write('Press ESC to stop> ');
 	done := false;

examples/xmas25.pas

@@ -0,0 +1,251 @@
+{$H2560}
+{$S8}
+program xmas252;
+uses pcmaudio, fastfire, tiles;
+
+const MAXX = FIREWIDTH;
+      MAXY = FIREHEIGHT;
+
+(* type PixelData = array[0..31999] of integer; *)
+
+type Picture = record
+		magic:integer;
+		mode:integer;
+		palette: array[0..15] of integer;
+		pixels: PixelData;
+	end;
+
+var firecells: FireBuf;
+
+    firepalette: array [0..15] of integer =
+    	{ ( $FFA, $FF8, $FF4, $FF0, $FE0, $FD0, $FA0, $F90,
+    	  $F00, $E00, $D00, $A00, $800, $600, $300, $000); }
+    	{ ( $FFA, $FFA, $FFA, $FFA, $FF0, $FF0, $FF0, $FF0, }
+    	  ( $00F, $00F, $00F, $00F, $00F, $00F, $00F, $00F,
+    	  $FF0, $FD0, $FA0, $C00, $A00, $700, $400, $000);
+    x,y:integer;
+    infile:file;
+    pic:^Picture;
+    tilesheet:^Picture;
+    animationTick:integer;
+    animationHold:integer;
+    animationState:integer;
+
+    filename: string;
+
+    audiodata: SndBufPtr;
+
+procedure createPalette;
+var i:integer;
+begin
+	for i := 15 downto 0 do
+		setpalette(15 - i, firepalette[i]);
+end;
+
+procedure fireItUp;
+var x,y:integer;
+begin
+	y := MAXY - 1;
+	for x := 1 to MAXX - 1 do
+		firecells[y, x] := random and 127;
+end;
+
+
+procedure updateFire;
+var i,x,y:integer;
+begin
+	for y := 0 to MAXY - 2 do
+		for x := 1 to MAXX - 1 do
+		begin
+			i :=
+				((firecells[y + 1, x - 1]
+				+ firecells[y + 1, x]
+				+ firecells[y + 1, x + 1]
+				+ firecells[y + 2, x])
+				) shr 2;
+			if i > 0 then
+				i := i - 1;
+			firecells[y, x] := i;
+		end;
+end;
+
+procedure drawFire(startX,startY:integer);
+var x, y, col, col2:integer;
+begin
+	for y := 0 to MAXY - 1 do
+	begin
+		x := 0;
+		for col in firecells[y] do
+		begin
+			{ scale and clamp color value }
+			col2 := col shr 3;
+			if col2 > FIREMAXCOLOR then col2 := FIREMAXCOLOR;
+
+			putpixel(startX + x, startY + y, col2);
+			x := x + 1;
+		end;
+	end;
+end;
+
+procedure readBackgroundPic(filename:string);
+var i:integer;
+begin
+	open(infile, filename, ModeReadonly);
+	read(infile, pic^);
+	close(infile);
+
+	for i := 0 to 15 do
+		SetPalette(i, pic^.palette[i]);
+	
+	PutScreen(pic^.pixels);
+end;
+
+procedure animate;
+var tileSrcX,tilesrcY:integer;
+begin
+	animationTick := animationTick + 1;
+
+	if animationHold = 0 then
+		animationHold := 40;
+
+	if animationTick < animationHold then
+		exit;
+
+	animationTick := 0;
+
+	case animationState of
+	0: begin
+		tileSrcX := 0;
+		tileSrcY := 0;
+		animationHold := 40;
+	   end;
+	1: begin
+		tileSrcX := 19;
+		tileSrcY := 0;
+		animationHold := 20;
+
+		if random and 7 > 4 then
+			animationState := -1;
+	   end;
+	2: begin
+		tileSrcX := 38;
+		tileSrcY := 0;
+		animationHold := 2;
+	   end;
+	3: begin;
+		tileSrcX := 57;
+		tileSrcY := 0;
+		animationHold := 2;
+	   end;
+	4: begin
+		tileSrcX := 0;
+		tileSrcY := 13;
+		animationHold := 15;
+	   end;
+	5: begin
+		tileSrcX := 57;
+		tileSrcY := 0;
+		animationHold := 2;
+	   end;
+	6: begin
+		tileSrcX := 38;
+		tileSrcY := 0;
+		animationHold := 2;
+	   end;
+	7: begin
+		tileSrcX := 0;
+		tileSrcY := 0;
+		animationHold := 2;
+		animationState := -1;
+	   end;
+	end;
+
+	CopyTilesScr(tilesheet^.pixels,
+		tileSrcX, tileSrcY,
+		34,34,
+		19,13);
+
+	animationState := animationState + 1;
+end;
+
+
+procedure readTilesheet;
+var filename:string;
+    i:integer;
+begin
+	filename := 'tilesheet.pict';
+	open(infile, filename, ModeReadonly);
+	read(infile, tilesheet^);
+	close(infile);
+end;
+
+function newAudioData(fname:string):SndBufPtr;
+var i,size:integer;
+    c:char;
+    buf:SndBufPtr;
+    f:file;
+begin
+	open(f, fname, ModeReadOnly);
+	size := FileSize(f);
+	new(buf, size);
+
+	buf^ := '';
+	write('Reading ', size, ' bytes...');
+	for i := 1 to size do
+	begin
+		read(f,c);
+		AppendChar(buf^,c);
+	end;
+	writeln;
+
+	close(f);
+
+	newAudioData := buf;
+end;
+
+
+begin
+	if ParamCount > 0 then
+		filename := ParamStr(1)
+	else
+		filename := 'xmas25bg.pict';
+
+	Randomize;
+
+	audiodata := newAudioData('fireplace-loop.tdrau');
+
+	InitGraphics;
+
+	new(pic);
+	readBackgroundPic(filename);
+
+	new(tilesheet);
+	readTilesheet;
+
+	SampleQStart(audiodata, true, 22050);
+
+	while not ConAvail do
+	begin
+		fireItUp;
+		FastFireUpdate(firecells);
+		{ updateFire; }
+		FastFireDraw(firecells, 216, 165);
+		{ drawFire(216, 165); }
+		animate;
+	end;
+
+	SampleQStop;
+
+	for y := 0 to MAXY do
+	begin
+		x := firecells[y, 10];
+		drawline(0, y, x, y, 1);
+
+	end;
+
+	InitGraphics;
+
+	dispose(tilesheet);
+	dispose(pic);
+	dispose(audiodata);
+end.

lib/pcmaudio.inc

@@ -2,6 +2,6 @@ type SndBuf = string[32768];
 type SndBufPtr = ^SndBuf;
 
 procedure PlaySample(buf:SndBufPtr;sampleRate:integer); external;
-procedure SampleQStart(buf:SndBufPtr;sampleRate:integer); external;
+procedure SampleQStart(buf:SndBufPtr;loop:boolean;sampleRate:integer); external;
 procedure SampleQStop; external;
 function SampleQSize:integer; external;

lib/pcmaudio.s

@@ -1,25 +1,25 @@
 	.EQU AUDIO_BASE $A00
 	.EQU IRQC_REG $980
 	.EQU IRQC_EN $80
+	.EQU CPU_FREQ 77000000
 
 ; args: sample rate
 START_PCMAUDIO:
 	; calculate clock divider
-	LOADCP 77000000
+	LOADCP CPU_FREQ
 	SWAP
 	LOADCP _DIV
 	CALL
 
 	LOADC AUDIO_BASE + 1
 	SWAP		; put clock divider on ToS
-;	LOADCP 4812	; clock divider for 16KHz sample rate
-;	LOADCP 2406	; clock divider for 32KHz sample rate
 	STOREI 1
 	LOADCP 32768	; set amplitude to biased 0
 	STOREI
 	DROP
+
 	LOADC AUDIO_BASE
-	LOADC 17	; enable channel, enable interrupt
+	LOADC 1	; enable channel
 	STOREI
 	DROP
 	RET
@@ -101,18 +101,14 @@ PLAY1_L0:
 	DROP
 	RET
 
-; start interrupt-driven sample playback
+; set sample queue count and pointer from string header
-; args: pointer to pascal string, sample rate
+; args: pointer to string/SndBufPtr
-SAMPLEQSTART:
+_STR2SMPLQPTR:
-	LOADCP START_PCMAUDIO
-	CALL
-
 	LOADCP SMPLQ_COUNT
 	OVER
 	LOADI		; get string size from header
 	SHR		; divide by 4 to get word count
 	SHR
-
 	STOREI
 	DROP
 
@@ -121,6 +117,38 @@ SAMPLEQSTART:
 	INC 8		; skip rest of header
 	STOREI		; store sample data pointer
 	DROP
+	RET
+
+; start interrupt-driven sample playback
+; args: pointer to pascal string, loop flag, sample rate
+SAMPLEQSTART:
+	LOADCP START_PCMAUDIO ; sample rate is on ToS as arg to subroutine
+	CALL
+
+	SWAP		; swap loop flag and buf ptr
+
+	LOADCP _STR2SMPLQPTR
+	CALL
+
+	; loop flag is now on ToS
+	CBRANCH.Z SQ_S_1
+	; if nonzero, set loop ptr
+	LOADCP SMPLQ_PTR
+	LOADI
+	DEC 8	; subtract offset for string header again
+	BRANCH SQ_S_0
+SQ_S_1:
+	LOADC 0
+SQ_S_0:
+	LOADCP SMPLQ_NEXT
+	SWAP
+	STOREI
+	DROP	
+
+	LOADC AUDIO_BASE
+	LOADC 17	; enable channel, enable interrupt
+	STOREI
+	DROP
 
 	LOADCP SMPLQ_ISR ; set interrupt handler
 	STOREREG IV
@@ -154,6 +182,7 @@ SAMPLEQSIZE:
 
 SMPLQ_PTR: .WORD 0
 SMPLQ_COUNT: .WORD 0
+SMPLQ_NEXT: .WORD 0
 
 SMPLQ_ISR:
 	LOADC IRQC_REG
@@ -170,7 +199,7 @@ SMPLQ_I_L:
 	DROP
 	BRANCH SMPLQ_I_XT	; if null, end interrupt routine
 SMPLQ_I_B:
-	LOADI	; load next word
+	LOADI	; load next word which contains two samples
 	DUP
 
 	BROT	; get high half-word
@@ -205,23 +234,42 @@ SMPLQ_I_B:
 	STOREI
 	DROP
 
-	; check if fifo is full
+	; put up to 16 samples into the sample queue
-	LOADC AUDIO_BASE
+	LOADCP SMPLQ_COUNT
-	LOADI
+	LOADI	; load word counter again
-	LOADC 8	; fifo_full
+	LOADC 7 ; check if count modulo 7 = 0
 	AND
-	CBRANCH.Z SMPLQ_I_L ; next sample if not full
+	CBRANCH.NZ SMPLQ_I_L ; if not, next two samples
 
-	LOADC AUDIO_BASE
+	; check if fifo is full
-	LOADC 17	; re-enable channel interrupt
+	; does not work reliably when running in DRAM,
-	STOREI
+	; maybe because at least one sample has already played
+	; since start of ISR?
+;	LOADC AUDIO_BASE
+;	LOADI
+;	LOADC 8	; fifo_full
+;	AND
+;	CBRANCH.Z SMPLQ_I_L ; next sample if not full
+
+	BRANCH SMPLQ_I_XT
+
+	; end of sample buffer, check for next
+SMPLQ_I_END:
 	DROP
+	DROP
+
+	LOADCP SMPLQ_NEXT	; skip to end
+	LOADI			; if NEXT ptr is zero
+	DUP
+	CBRANCH.Z SMPLQ_I_END1
+
+	LOADCP _STR2SMPLQPTR
+	CALL
 
 	BRANCH SMPLQ_I_XT
 
 	; end playback, set ptr and counter to zero
-SMPLQ_I_END:
+SMPLQ_I_END1:
-	DROP
 	DROP
 	LOADCP SMPLQ_PTR
 	LOADC 0
@@ -238,7 +286,16 @@ SMPLQ_I_END:
 	STOREI
 	DROP
 
+	; exit without enabling interrupts for this channel
+	BRANCH SMPLQ_I_XT2
+
 SMPLQ_I_XT:
+	LOADC AUDIO_BASE
+	LOADC 17	; re-enable channel interrupt
+	STOREI
+	DROP
+
+SMPLQ_I_XT2:
 	LOADC IRQC_REG		; re-enable interrupts
 	LOADC IRQC_EN
 	STOREI