TriuneCadence/THES/PLAYCOMP.PP

111 lines
2.4 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

PROGRAM play_composition(Input,Output);
{
This program plays notess output by the integrated ANN note generator, the
random composition program, and the classical composition program.
}
{
Copyright 1989 by Wesley R. Elsberry. All rights reserved.
Commercial use of this software is prohibited without written consent of
the author.
For information, bug reports, and updates contact
Wesley R. Elsberry
528 Chambers Creek Drive South
Everman, Texas 76140
Telephone: (817) 551-7018
}
USES
Dos, CRT, misc1;
CONST
Pi = 3.141592653589793;
Exp_Max = 80.0;
Colon = ':';
graphic_string = '0123456789';
note_time = 1800;
rest_time = 550;
{For Play_note}
N_C_mid = 264;
N_D = 297;
N_E = 330;
N_F =352;
N_G = 396;
N_A = 440;
N_B = 495;
N_C_hi = 528;
TYPE
REAL = SINGLE;
{General}
Note_ = (Note_C_Lo,Note_D,Note_E,Note_F,Note_G,Note_A,Note_B,
Note_C_Hi);
VAR
inf : TEXT; {Input file handle}
instr : STRING;
cnote : INTEGER;
inch : CHAR;
{----------------------------------------------------------}
PROCEDURE play_a_note(cn : INTEGER);
VAR
ii : INTEGER;
BEGIN
CASE cn OF
1 : Sound(n_c_mid);
2 : Sound(n_d);
3 : Sound(n_e);
4 : Sound(n_f);
5 : Sound(n_g);
6 : Sound(n_a);
7 : Sound(n_b);
8 : Sound(n_c_hi);
ELSE
NoSound;
END;
Delay(note_time);
NoSound;
Delay(rest_time);
END;
BEGIN {Main}
{get filename}
REPEAT
Write ('File to play? ');
Readln (instr);
instr := FSearch(instr,GetEnv('PATH'));
UNTIL (Length(instr) <> 0);
Assign (inf,instr);
Reset(inf);
WHILE NOT Eof(inf) DO BEGIN
Readln(inf,cnote);
play_a_note(cnote);
IF dir_console_IO(inch) THEN
IF UpCase(inch) = 'Q' THEN BEGIN
NoSound;
EXIT;
END;
END;
NoSound;
END. {Main}