pcmaudio: bugfix corrupted audio, loop mode, adjust examples

examples/pcmtest.pas

@@ -1,32 +1,21 @@
-{$H1536}
-program pcmtest;
+{$H2560}
+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
-		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);
+	open(f, fname, 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.