(**************************************************************************

:Remark.			Format: ein TAB in jeder 3. Spalte: ..tab..tab..tab..


:Program.		Rustle

:Contents.		plays white noise

:Bugs.			"Shit happens." (Murphy)


:Copyright.		Freeware---you may copy and use it, but all rights remain
:Copyright.		at the author

:Author.			Thomas Ansorge

:Address.		Dinkelackerring 55, 67435 Neustadt, Deutschland, Europa


:Language.		Modula-2

:Translator.	M2Amiga V4.3 (deutsch)


:History.		1.0 as of 22-Apr-95: seems to work...


**************************************************************************)

(*$ DEFINE DEBUG := FALSE *)


MODULE Rustle;

FROM Arts IMPORT Assert, BreakPoint, returnVal, Terminate, wbStarted;

FROM Audio IMPORT allocate, allocFailed, audioName, channelStolen, free, IOAudio, IOAudioPtr, lock, noWait, pervol;

FROM DosD IMPORT ctrlC, fail, RDArgsPtr;

FROM DosL IMPORT Delay, FreeArgs, ReadArgs;

FROM ExecD IMPORT IOFlagSet, IORequest, MemReqs, MemReqSet, MsgPort, Message, MessagePtr, MsgPortPtr, Node, write;

FROM ExecL IMPORT AbortIO, AllocMem, CloseDevice, CopyMem, CreateMsgPort, DeleteMsgPort, execVersion, FindTask, FreeMem, GetMsg, OpenDevice, Signal, Wait;

FROM ExecSupport IMPORT BeginIO;

FROM GraphicsD IMPORT DisplayFlags, DisplayFlagSet, GfxBase, GfxBasePtr;

FROM GraphicsL IMPORT graphicsBase;

(*
Es muß nicht \source{Randoms} sein, jeder Zufallszahlengenerator sollte es tun...
*)

FROM Randoms IMPORT Rand0, ReduceToByte;

FROM SYSTEM IMPORT ADDRESS, ADR, CAST, LONGSET, SHIFT, SHORTSET;

FROM Terminal IMPORT WriteLn, WriteString;

(* --------------------------------------------------------------------- *)

CONST
	prog_str = "Rustle 1.0/";
	date_str = "(22.04.95)";

	(*$ IF M68881 OR M68040 *)
		ver_str = prog_str + "68020+FPU " + date_str;
	(*$ ELSIF M68020 *)
		ver_str = prog_str + "68020 " + date_str;
	(*$ ELSIF M68010 *)
		ver_str = prog_str + "68010 " + date_str;
	(*$ ELSE *)
		ver_str = prog_str + "68000 " + date_str;
	(*$ ENDIF *)
	
	ver_ptr = ADR ("$VER: " + ver_str);

CONST
	exec_min_version = 36;
	
CONST
	rustle_buffer_size = 32 * 1024; (* Bytes *)
	
	frequency = 400 * 5000; (* 5000? *)
	
CONST
	template = "VOLUME/N";

TYPE
	ChannelArray = ARRAY [0..1] OF SHORTSET;

CONST
	left_channels = ChannelArray {SHORTSET {1}, SHORTSET {2}};
	right_channels = ChannelArray {SHORTSET {0}, SHORTSET {3}};

TYPE
	Status = (doing_nothing, allocating, playing, freeing, quitting);
	Location = (back_home, outside);
	
	IOAudioRec = RECORD
		io: IOAudio;
		status: Status;
		location: Location;
	END; (* RECORD IOAudioRec *)
	
	IOAudioRecPtr = POINTER TO IOAudioRec;

VAR
	(* Pointer *)
	data_ptr: ADDRESS;
	dummy_msg_ptr: IOAudioRecPtr;
	play_port_ptr: MsgPortPtr;
	rdargs_ptr: RDArgsPtr;
	vol: LONGINT;
	vol_ptr: POINTER TO LONGINT;
	
	(* anderes 32bit Zeug *)
	ctrlc_sig: LONGSET;
	play_sig: LONGSET;
	sigs: LONGSET;
	
	(* anderes *)
	alloc_key: INTEGER;
	left_play_req: IOAudioRec;
	right_play_req: IOAudioRec;

VAR (* Flags *)
	audio_open := BOOLEAN {FALSE};
	quit := BOOLEAN {FALSE};
	runtime_error := BOOLEAN {TRUE};
	
(* --------------------------------------------------------------------- *)

PROCEDURE Err (condition: BOOLEAN; msg: ARRAY OF CHAR); FORWARD;
	
(* --------------------------------------------------------------------- *)
	
PROCEDURE AbortChannel (VAR play_rec: IOAudioRec);
	
	BEGIN (* Prozedur AbortChannel *)
		
	IF play_rec.location = outside THEN
		AbortIO (ADR (play_rec));
					
	ELSE (* IF play_req.location = outside THEN *)
		Err (FALSE, ver_str + ": message not in use!");
	END; (* IF play_req.location = outside THEN *)
END AbortChannel; (* Prozedur *)
	
(* --------------------------------------------------------------------- *)
	
PROCEDURE AllocChannel (VAR play_req: IOAudioRec; channels: ChannelArray; key: INTEGER);
	
	(* play_req MUSS VAR sein wegen ADR (play_req) weiter unten!!! *)
	
	BEGIN (* Prozedur AllocChannel *)
		IF play_req.location = back_home THEN
			play_req.io.request.message.node.pri := -100;
			play_req.io.request.unit := NIL;
			play_req.io.request.command := allocate;
			play_req.io.request.flags := noWait;
			play_req.io.request.error := 0;
			play_req.io.allocKey := key;
			play_req.io.data := ADR (channels);
			play_req.io.length := SIZE (channels);
			play_req.io.period := 0;
			play_req.io.volume := 0;
			play_req.io.cycles := 0;
			
			play_req.status := allocating;
			play_req.location := outside;
			
			BeginIO (ADR (play_req));
				
		ELSE (* IF play_req.location = back_home THEN *)
			Err (FALSE, ver_str + ": message already in use!");
		END; (* IF play_req.location = back_home THEN *)
	END AllocChannel; (* Prozedur *)
	
(* --------------------------------------------------------------------- *)

(*
Diese Prozedur bricht das Programm sauber und kontextabhängig (Workbench oder 
CLI) ab, falls \source{condition = FALSE}. Dabei wird \source{msg} als Fehlertext
ausgegeben.
*)

PROCEDURE Err (condition: BOOLEAN; msg: ARRAY OF CHAR);
	
	BEGIN (* Prozedur Err *)
	
	IF wbStarted THEN
		Assert (condition, ADR (msg));
	
	ELSE (* IF wbStarted *)
		IF NOT condition THEN
			WriteString (msg);
			WriteLn;
			
			returnVal := fail;
			Terminate ();
		END; (* If NOT condition *)
	END; (* IF wbStarted *)
END Err; (* Prozedur *)
	
(* --------------------------------------------------------------------- *)
	
PROCEDURE HandlePlayMessage (VAR play_req: IOAudioRec; channels: ChannelArray; key: INTEGER);
	
	(* play_req MUSS VAR sein wegen ADR (...) weiter unten!!! *)
	
	(* global: data_ptr *)
		
	(* ------------------------------------------------------------------ *)

	PROCEDURE GetAudioConstant (): LONGCARD;
		
		BEGIN (* Funktion GetAudioConstant *)
		
		IF pal IN graphicsBase^.displayFlags THEN
			RETURN 3546895;
			
		ELSE (* IF pal IN graphicsBase^.displayFlags *)
			RETURN 3579545;
		END; (* IF pal IN graphicsBase^.displayFlags THEN ELSE *)
	END GetAudioConstant; (* Funktion *)
		
	(* ------------------------------------------------------------------ *)

	BEGIN (* Prozedur HandlePlayMessage *)
	
	CASE play_req.status OF
		|allocating:
			IF play_req.location = back_home THEN
				IF play_req.io.request.error = 0 THEN
					WITH  play_req.io DO
						request.command := write;
						request.flags := pervol; (* = 12, SHORTSET {3, 2} *)
						data := data_ptr;
						length := rustle_buffer_size;
						period := GetAudioConstant () DIV frequency;
						
						IF vol_ptr # NIL THEN
							volume := vol_ptr^;
						
						ELSE (* IF vol_ptr # NIL *)
							volume := 4;
						END; (* IF vol_ptr # NIL THEN ELSE *)
						
						cycles := 0;
					END; (* WITH  play_req.io.request *)
	
					play_req.status := playing;
					play_req.location := outside;
					
					BeginIO (ADR (play_req));
				
				ELSIF play_req.io.request.error = allocFailed THEN
					IF NOT quit THEN
						Delay (100);
						AllocChannel (play_req, channels, key);
					
					ELSE (* IF NOT quit THEN *)
						play_req.status := quitting;
					END; (* IF NOT quit THEN *)
					
				ELSE (* IF play_req.io.request.error = 0 *)
					Err (FALSE, ver_str + ": allocation failed!");
				END; (* IF play_req.io.request.error = 0 *)
			
			ELSE (* IF play_req.location = back_home THEN *)
				Err (FALSE, ver_str + ": message already in use!");
			END; (* IF play_req.location = back_home THEN *)

		|playing:
			IF NOT quit THEN
				AllocChannel (play_req, channels, key);
			
			ELSE (* IF NOT quit THEN *)
				play_req.status := quitting;
			END; (* IF NOT quit ELSE *)
	END; (* CASE play_req.status OF *)
END HandlePlayMessage; (* Prozedur *)
	
(* --------------------------------------------------------------------- *)

(*
Für weißes Rauschen brauchen wir einen zufällig gefüllten Bereich CHIP-Speicher.
*)

PROCEDURE InitRustleBuffer (): ADDRESS;
	
	TYPE
		RustleBuffer = ARRAY [1..rustle_buffer_size] OF SHORTCARD;
		RustleBufferPtr = POINTER TO RustleBuffer;
	
	VAR
		buffer_ptr: RustleBufferPtr;
		
		i: [1..rustle_buffer_size];
	
	BEGIN (* Funktion InitRustleBuffer *)
		buffer_ptr := AllocMem (rustle_buffer_size, MemReqSet {public, chip});
		Err (buffer_ptr # NIL, ver_str + ": no chip memory, no rustle.");
		
		FOR i := 1 TO rustle_buffer_size DO
			buffer_ptr^ [i] := ReduceToByte (Rand0 ());
		END; (* FOR i := 1 TO rustle_buffer_size *)
		
		RETURN buffer_ptr;
	END InitRustleBuffer; (* Funktion *)

(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)

BEGIN (* Program Rustle *)
	Err (execVersion >= exec_min_version, ver_str + ": Kickstart 2.0 Minimum!");
	
	IF wbStarted THEN
	ELSE (* IF wbStarted *)
		rdargs_ptr := ReadArgs (ADR (template), ADR (vol_ptr), NIL);
	END; (* IF wbStarted ELSE *)
	
	IF vol_ptr # NIL THEN
		IF (vol_ptr^ < 0) OR (vol_ptr^ > 64) THEN
			WriteString (ver_str + ": 0 <= VOLUME <= 64, using default (4)");
			WriteLn;
			
			vol_ptr := NIL;
		END; (* IF (vol_ptr^ < 0) OR (vol_ptr^ > 64) THEN *)
	END; (* IF vol_ptr # NIL THEN *)
	
	data_ptr := InitRustleBuffer ();
	
	ctrlc_sig := CAST (LONGSET, SHIFT (LONGINT (1), ctrlC));
	
	play_port_ptr := CreateMsgPort ();
	Err (play_port_ptr # NIL, ver_str + ": no message port to open Audio.device!");
	play_sig := CAST (LONGSET, SHIFT (LONGINT (1), play_port_ptr^.sigBit));
	
	left_play_req.io.request.message.replyPort := play_port_ptr;
	
	OpenDevice (ADR (audioName), 0, ADR (left_play_req.io), LONGSET {});
	Err (left_play_req.io.request.error = 0, ver_str + ": Audio.device did not open!");
	audio_open := TRUE;
	
	CopyMem (ADR (left_play_req), ADR (right_play_req), SIZE (left_play_req));
	
	alloc_key := left_play_req.io.allocKey;
	
	left_play_req.location := back_home;
	right_play_req.location := back_home;
	
	REPEAT
		IF left_play_req.status = doing_nothing THEN
			AllocChannel (left_play_req, left_channels, alloc_key);
		END; (* IF left_play_req.status = doing_nothing *)

(*
Solange wir keinen \source{allocKey} vom Audio-Device haben, dürfen wir nur
den einen Kanal alloziieren und müssen warten, bis wir ihn haben.
*)

		IF alloc_key # 0 THEN
			IF right_play_req.status = doing_nothing THEN
				AllocChannel (right_play_req, right_channels, alloc_key);
			END; (* IF right_play_req.status = doing_nothing *)
		END; (* IF alloc_key # 0 *)
		
		sigs := Wait (ctrlc_sig + play_sig);

(* 
Ein Play-Request kam zurück. Normalerweise passiert das hier nur in den 
folgenden Fällen:\begin{itemize}
\item Ein Kanal wurde gerade (hoffentlich) erfolgreich alloziiert.
\item Ein Kanal wurde uns genommen.
\item Ein Kanal wurde mit \source{AbortIO ()} abgebrochen.
\end{itemize}
*)
		
		IF play_sig <= sigs THEN
			dummy_msg_ptr := GetMsg (play_port_ptr);
			
			IF dummy_msg_ptr # NIL THEN
				Signal (FindTask (NIL), play_sig);
				
				IF alloc_key = 0 THEN
					alloc_key := dummy_msg_ptr^.io.allocKey;
				END; (* IF alloc_key = 0 THEN *)
				
				dummy_msg_ptr^.location := back_home;
				
				IF dummy_msg_ptr = ADR (left_play_req) THEN
					HandlePlayMessage (left_play_req, left_channels, alloc_key);
					
				ELSIF dummy_msg_ptr = ADR (right_play_req) THEN
					HandlePlayMessage (right_play_req, right_channels, alloc_key);
				
				ELSE (* Hey, was ist das bloß für eine Nachricht??? *)
					Err (FALSE, ver_str + ": got unexpected message (???)");
				END; (* ELSIF dummy_msg_ptr = ADR (right_play_req) ELSE *)
			END; (* IF dummy_msg_ptr # NIL *)
		END; (* IF play_sig <= sigs *)
		
(*
Control-C? Wenn ja, Schleife verlassen, aufräumen, Programm beenden.
*)

		IF ctrlc_sig <= sigs THEN
			WriteString ("***Break");
			WriteLn;
			
			AbortChannel (left_play_req);
			AbortChannel (right_play_req);
			
			quit := TRUE;
			
			(*$ IF DEBUG *)
			Terminate ();
			(*$ ENDIF *)
		END; (* IF ctrlc_sig <= sigs *)
	UNTIL (left_play_req.status = quitting) AND (right_play_req.status = quitting);
				
	runtime_error := FALSE;
	
CLOSE; (* -------------------------------------------------------------- *)
	IF NOT runtime_error THEN
		IF audio_open THEN
			CloseDevice (ADR (left_play_req.io));
			audio_open := FALSE;
		END; (* IF audio_open *)
		
		IF play_port_ptr # NIL THEN
			DeleteMsgPort (play_port_ptr);
			play_port_ptr := NIL;
		END; (* IF play_port_ptr # NIL *)
		
		IF data_ptr # NIL THEN
			FreeMem (data_ptr, rustle_buffer_size);
			data_ptr := NIL;
		END; (* IF data_ptr # NIL *)
	END; (* IF NOT runtime_error THEN *)
	
	IF rdargs_ptr # NIL THEN
		FreeArgs (rdargs_ptr);
		rdargs_ptr := NIL;
	END; (* IF rdargs_ptr # NIL THEN *)
END Rustle.