playmake.mod

MODULE PlayMake;

	(********************************************************)
	(*							*)
	(*	Program to make some tables needed for		*)
	(*	playing music.  The data file produced		*)
	(*	by this program can be incorporated into	*)
	(*	an assembly language source file.		*)
	(*							*)
	(*  Programmer:		P. Moylan			*)
	(*  Last edited:	15 March 1995			*)
	(*  Status:		Working				*)
	(*							*)
	(********************************************************)

FROM FileSys IMPORT
    (* type *)	File,
    (* proc *)	OpenFile, CloseFile, WriteRecord;

FROM IOErrorCodes IMPORT
    (* type *)	ErrorCode,
    (* proc *)	TranslateErrorCode;

FROM Conversions IMPORT
    (* proc *)	ShortCardToString, CardinalToString;

FROM Windows IMPORT
    (* type *)	Window, Colour, FrameType, DividerType,
    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn,
		ReadChar, PressAnyKey;

FROM MATHLIB IMPORT
    (* proc *)	Exp, Log, Sin;

(************************************************************************)

TYPE Note = SHORTCARD [0..63];

VAR
    log: Window;
    linecount: CARDINAL;
    CRLF: ARRAY [0..1] OF CHAR;

(************************************************************************)

PROCEDURE SendByteToFile (f: File;  value: SHORTCARD);

    (* Writes one value to the file, with a new line every eight values.*)

    VAR buffer: ARRAY [0..31] OF CHAR;
	status: ErrorCode;

    BEGIN
	status := OK;
	IF linecount = 8 THEN
	    buffer := "   db ";
	    buffer[0] := CHR(13);  buffer[1] := CHR(10);
	    buffer[2] := CHR(9);  buffer[5] := CHR(9);
	    status := WriteRecord (f, ADR(buffer), 6);
	    linecount := 0;
	ELSE
	    buffer := ",";
	    status := WriteRecord (f, ADR(buffer), 1);
	END (*IF*);
	IF status = OK THEN
	    ShortCardToString (value, buffer, 4);
	    status := WriteRecord (f, ADR(buffer), 4);
	END (*IF*);
	INC (linecount);
	IF status <> OK THEN
	    TranslateErrorCode (status, buffer);
	    WriteString (log, buffer);
	END (*IF*);
    END SendByteToFile;

(************************************************************************)

PROCEDURE SendWordToFile (f: File;  value: CARDINAL);

    (* Writes one value to the file, with a new line every eight values.*)


    VAR buffer: ARRAY [0..31] OF CHAR;
	status: ErrorCode;

    BEGIN
	status := OK;
	IF linecount = 8 THEN
	    buffer := "   dw ";
	    buffer[0] := CHR(13);  buffer[1] := CHR(10);
	    buffer[2] := CHR(9);  buffer[5] := CHR(9);
	    status := WriteRecord (f, ADR(buffer), 6);
	    linecount := 0;
	ELSE
	    buffer := ",";
	    status := WriteRecord (f, ADR(buffer), 1);
	END (*IF*);
	IF status = OK THEN
	    CardinalToString (value, buffer, 6);
	    status := WriteRecord (f, ADR(buffer), 6);
	END (*IF*);
	INC (linecount);
	IF status <> OK THEN
	    TranslateErrorCode (status, buffer);
	    WriteString (log, buffer);
	END (*IF*);
    END SendWordToFile;

(************************************************************************)

PROCEDURE MakeDataFile;

    (* Initialises the global data. *)

    CONST PI =  3.141592653589793240;

    VAR step, scale: LONGREAL;
	j, value: SHORTCARD;  note: Note;
	ch: CHAR;
	f: File;  status: ErrorCode;
	buffer: ARRAY [0..31] OF CHAR;

    BEGIN
	(* Open the data file. *)

	status := OpenFile (f, "PLAYDATA.TXT", TRUE);
	IF status = DuplicateFileName THEN
	    WriteString (log, "PLAYDATA.TXT already exists.  Overwrite? ");
	    ReadChar (log, ch);
	    WriteLn (log);
	    IF CAP(ch) = 'Y' THEN
		status := OpenFile (f, "PLAYDATA.TXT", FALSE);
	    END (*IF*);
	END (*IF*);
	IF status <> OK THEN
	    TranslateErrorCode (status, buffer);
	    WriteString (log, buffer);
	    PressAnyKey (log);
	    RETURN;
	END (*IF*);

	(* Create the note-to-interval map. *)

	buffer := "    StepTable:";
	status := WriteRecord (f, ADR(buffer), 14);
	IF status <> OK THEN
	    TranslateErrorCode (status, buffer);
	    WriteString (log, buffer);
	    PressAnyKey (log);
	    RETURN;
	END (*IF*);

	linecount := 8;

	scale := Exp(Log(2.0)/12.0);
	step := 110.0;
	SendWordToFile (f, 0);
	FOR note := 1 TO MAX(Note) DO
	    SendWordToFile (f, VAL(CARDINAL, step));
	    step := step*scale;
	END (*FOR*);

	(* Create the waveform array. *)

	status := WriteRecord (f, ADR(CRLF), 2);
	IF status = OK THEN
	    status := WriteRecord (f, ADR(CRLF), 2);
	END (*IF*);
	IF status = OK THEN
	    buffer := "    Wave:";
	    status := WriteRecord (f, ADR(buffer), 9);
	END (*IF*);
	IF status <> OK THEN
	    TranslateErrorCode (status, buffer);
	    WriteString (log, buffer);
	    PressAnyKey (log);
	    RETURN;
	END (*IF*);

	linecount := 8;

	FOR j := 0 TO 255 DO
	    value := VAL(SHORTCARD,
			42.0*(1.0 + Sin(VAL(LONGREAL,j)*PI/128.0)));
	    SendByteToFile (f, value);
	END (*FOR*);
	status := WriteRecord (f, ADR(CRLF), 2);

	CloseFile (f);

    END MakeDataFile;

(************************************************************************)

BEGIN
    CRLF[0] := CHR(13);  CRLF[1] := CHR(10);
    OpenWindow (log, blue, cyan, 2,22, 2,77, simpleframe, nodivider);
    MakeDataFile;
    CloseWindow (log);
END PlayMake.