Program MusicWriter;
{$M 65520, 0, 655360}
{$G+}
Uses ProgFace, MusicShu;
var
C, CC : Char;
S, Df : String;
BgFrq, dFrq, Fru : Real;
Sharp : Boolean;
i, j : Word;
Lg : Longint;
X, Xp : Byte;
tmpS : String;
Pause, PrevPause : Boolean;
Procedure WaitRetrace;Assembler;
asm
mov dx, 03DAh
@VRTL1:
in al, dx
test al, 8
jnz @VRTL1
@VRTL2:
in al, dx
test al, 8
jne @VRTL2
end;
Procedure Sound(Freq : Word);Assembler;
asm
mov bx, sp
mov bx, ss:[bx+4]
mov ax, 34DDh
mov dx, 12h
cmp dx, bx
jnb @1
div bx
mov bx, ax
in al, 61h
test al, 3
jnz @2
or al, 3
out 61h, al
mov al, 0B6h
out 43h, al
@2:
mov al, bl
out 42h, al
mov al, bh
out 42h, al
@1:
end;
{------------------------}
Procedure NoSound;Assembler;
asm
in al, 61h
and al, 0FCh
out 61h, al
end;
Procedure SetTxPoint(X,Y,ColorTx,BkColorTx:Byte;C:Char);Assembler;
asm
push ds
mov ax, $B800
mov ds, ax
mov ah, 0
mov bh, 0
mov bl, byte ptr x
cmp bx, 80
ja @1
mov al, byte ptr y
cmp ax, 25
ja @1
dec ax
mov cl, 80
mul cl
dec bx
add bx, ax
mov cl, byte ptr ColorTx
and cl, $8F
mov dl, BkColorTx
mov al, dl
and dl, $7
shl dl, 4
and al, $80
or dl, al
or dl, cl
mov al, byte ptr C
mov ah, dl
shl bx, 1
mov ds:[bx], ax
@1:
pop ds
end;
var
Timer, Timer1 : Longint;
Function GetTimer : Longint;Assembler;
asm
mov ah, 0
int $1A
mov ax, dx
mov dx, cx
end;
Procedure Inform;
begin
ZZCursor;
Str(i, tmpS);
WriteLine('Количествоянот:я'+tmpS, WinAttr);
Str(BgFrq:0:1, tmpS);
WriteLine(';яНачальнаяячастотая:я'+tmpS+' ', WinAttr);
end;
{------------------------}
const
KeybTable : String[44] = 'zxcvbnm,./asdfghjkl;''qwertyuiop[]`1234567890';
KeybShiftTable : String[44] = 'ZXCVBNM<>?ASDFGHJKL:"QWERTYUIOP{}~!@#$%^&*()';
begin
asm
mov ax, 3
int 10h
end;
ResetTimer;
CursorOff;
SetWindChar(' ');
SaveBar(20,10, 60, 12);
SetAttr(Red, Cyan,WinAttr);
SetAttr(Green,Blue,WBorderAttr);
SetAttr(Green, Blue,WinHAttr);
WaitRetrace;
SetWindow(20,10, 60, 12, 1, 'Введите имя файла для записи', True);
Repeat
S := '';
Repeat
ZZCursor;
WriteLine(S + ' ', WinAttr);
C := ReadKey;
if (C in ['A'..'Z']) or (C in ['a'..'z']) then S := S + C;
if C = #0 then if ReadKey = #83 then S := '';
if C = #8 then S[0]:= Char(Length(S)-1);
Until (C = #27) or (C = #13);
Until (Length(S)<=8) or (C=#27);
if (C = #27) or (S='') then S := 'ю' else S := S + '.MZP';
UndoMenu;
SaveBar(1,20, 80, 24);
SetWindChar('°');
SetAttr(Green, Black,WinAttr);
SetAttr(Black,Green,WBorderAttr);
SetAttr(Red, Green,WinHAttr);
{ WaitRetrace;}
SetWindow(1, 20, 80, 24, 2, 'Окно нажатийянаяклавиши ('+S+')', True);
BgFrq := 27.50;
SetNewMusTable(BgFrq, exp(ln(2)/12));
i := 0;
While not KeyPressed do;
C := ReadKey;
CC := C;
Timer := GetTimer;
Pause := True;
PrevPause := Pause;
While (CC <> #27) and (i CC) and Pause then
Timer := GetTimer;
if not Pause then
begin
While not KeyPressed do;
Pause := True;
end
else
begin
Repeat
CC := C;
if not KeyPressed then Pause := True;
While KeyPressed do C := ReadKey;
Until (C<>CC) or Pause;
Pause := False;
end;
if C = #27 then Break;
if (C = '-') or (C = '_') then
begin
BgFrq := BgFrq/2;
SetNewMusTable(BgFrq, exp(ln(2)/12));
Inform;
Continue;
end;
if (C = '+') or (C = '=') then
begin
BgFrq := BgFrq*2;
SetNewMusTable(BgFrq, exp(ln(2)/12));
Inform;
Continue;
end;
if (C <> CC) and not KeyPressed then
inc(i);
Inform;
Xp := X;
X := 0;
if Pos(C, KeybTable)<>0 then
X := Pos(C, KeybTable);
if Pos(C, KeybShiftTable)<>0 then
X := Pos(C, KeybShiftTable)+44;
if X <> 0 then
MusicPhrase.MusicNotes[i].freq := ROGnots[X].freq;
if Xp <> 0 then
begin
if ROGnots[Xp].Sharp then
SetTxPoint(79-Round((ROGnots[Xp].NPos+23)*78/52), 22, Green, Black, '°')
else
SetTxPoint(79-Round((ROGnots[Xp].NPos+23)*78/52), 23, Green, Black, '°');
end;
if X <> 0 then
begin
if ROGnots[X].Sharp then
SetTxPoint(79-Round((ROGnots[X].NPos+23)*78/52), 22, LightRed, Black, 'ы')
else
SetTxPoint(79-Round((ROGnots[X].NPos+23)*78/52), 23, LightRed, Black, 'ы');
end;
if not KeyPressed and ((C = ' ') or Pause) then
begin
MusicPhrase.MusicNotes[i].freq := 0;
if (C <> CC) or not Pause then
NoSound;
end
else
Sound(MusicPhrase.MusicNotes[i].freq);
MusicPhrase.MusicNotes[i-1].ling := Round((GetTimer-Timer)*4000/18);
end;
NoSound;
MusicPhrase.Leng := i;
UndoMenu;
PlayMusic(MusicPhrase);
if S <> 'ю' then
begin
SetWindChar(' ');
SaveBar(1,10, 80, 12);
SetAttr(Red, Cyan,WinAttr);
SetAttr(Green,Blue,WBorderAttr);
SetAttr(Green, Blue,WinHAttr);
WaitRetrace;
SetWindow(1,10, 80, 12, 1, 'Введите описание файла', True);
Repeat
Df := '';
Repeat
ZZCursor;
WriteLine(Df + ' ', WinAttr);
C := ReadKey;
if (C in [#32..#255]) then Df := Df + C;
if C = #0 then if ReadKey = #83 then Df := '';
if C = #8 then Df[0]:= Char(Length(Df)-1);
Until (C = #27) or (C = #13);
Until (Length(Df)<=80) or (C=#27);
if C = #27 then Df := 'Shyar Music Writer. Файл '+S;
UndoMenu;
end;
if S = 'ю' then
begin
SetMusicName('Временный файл Shyar Music Writer');
S := 'SHMWTMP.MZP';
end;
SaveMusicPhrase(MusicPhrase, S);
ZZCursor;
RestoreScreen;
CursorOn;
end.
< -->