home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
TPTALK.ZIP
/
TALKEDIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-04-24
|
8KB
|
373 lines
{$I+,F+}
program TalkEdit;
uses Crt;
const PhonemeSize = $023f;
MaxPhoneme = 35;
StartCol = 0;
StartRow = 0;
EndRow = 21;
EndCol = 19;
CmdRow = 24;
EditRow = 23;
EditCol = 1;
RemCol = 67;
PhCol = 1;
ByteCol = 28;
EdCol = 40;
TalkCol = 47;
SaveCol = 54;
SelectCol = 61;
MoreCol = 73;
PgUp = #201;
PgDo = #209;
UpAr = #200;
DoAr = #208;
LfAr = #203;
RiAr = #205;
Home = #199;
EKey = #207;
const SpeedDelay : word = 22;
Resolve : word = 1;
Snd : boolean = true;
type Satype = array[0..64000] of byte;
SaPtr = ^SaType;
string2 = string[2];
var ScreenMax:word;
MaxPhOfs:integer;
SaData : SaPtr;
f,fb : file;
Fsize,Result : word;
Pg,Ph,i:word;
CurCol,CurRow:word;
Key:char;
PhByte,PhOfs:word;
const
rdfile = 'TalkData.Bin';
bkfile = 'BackUp.Bin';
const
PhArray: array[1..35] of string2 =(
'U', 'A', ' ', 'B', 'D', 'G',
'J', 'P', 'T', 'K', 'W', 'Y',
'R', 'L', 'M', 'N', 'S', 'V',
'F', 'H', 'Z', 'AW', 'AH', 'UH',
'AE', 'OH', 'EH', 'OO', 'IH', 'EE',
'WH', 'SH', 'TZ', 'TH', 'ZH' );
{$F+}
procedure Talker(Start:pointer; Size,Speed,Resolve:word; Snd:boolean);
external;
{$L Talker.OBJ}
{$F+}
procedure TalkDataLink; external;
{$L TalkData.OBJ}
procedure TalkIt;
begin
Talker(ptr( seg(TalkDataLink),ofs(TalkDataLink) + pred(Ph) * PhonemeSize ),
PhonemeSize, SpeedDelay, Resolve, Snd);
end;
procedure ByteShow;
begin
gotoxy(ByteCol,CmdRow);
write('Byte: ');
gotoxy(ByteCol+5,CmdRow);
write(PhByte);
end;
procedure ShowData;
var OldCol,OldRow:word;
Mup,Mdo:char;
begin
LowVideo;
OldCol := CurCol;
OldRow := CurRow;
CurCol := StartCol;
CurRow := StartRow;
for i := 0 to ScreenMax do
begin
PhByte := (CurCol+CurRow*succ(EndCol))+PhOfs;
gotoxy(succ(CurCol*4),succ(CurRow));
write(' ');
if PhByte < PhonemeSize then
begin
gotoxy(succ(CurCol*4),succ(CurRow));
write(SaData^[i+PhOfs+(pred(Ph) * PhonemeSize)]);
end;
inc(CurCol);
if CurCol > EndCol then
begin
CurCol := StartCol;
inc(CurRow);
end;
end;
gotoxy(PhCol,CmdRow);
write('[PgUp]/[PgDo] phoneme: ',PhArray[ph]);
ByteShow;
gotoxy(TalkCol,CmdRow);
write('[T]alk');
gotoxy(EdCol,CmdRow);
write('[E]dit');
gotoxy(SaveCol,CmdRow);
write('[S]ave');
gotoxy(SelectCol,CmdRow);
write('Select:',#24,#25,#26,#27);
if PhOfs = 0 then Mup := ' ' else Mup := #30;
if (EndRow*succ(EndCol))+PhOfs < PhonemeSize then Mdo := #31 else Mdo := ' ';
gotoxy(MoreCol,CmdRow);
write('More:',Mup,Mdo);
CurCol := OldCol;
CurRow := OldRow;
end;
Procedure NextP;
begin
CurCol := 0;
CurRow := 0;
PhOfs := 0;
inc(Ph);
if Ph > MaxPhoneme then Ph := 1;
clrscr;
ShowData;
TalkIt;
end;
Procedure PrevP;
begin
CurCol := 0;
CurRow := 0;
PhOfs := 0;
dec(Ph);
if Ph < 1 then Ph := MaxPhoneme;
clrscr;
ShowData;
TalkIt;
end;
procedure ShiftUp;
begin
if CurRow < succ(StartRow) then
begin
CurRow := StartRow;
if PhOfs > 0 then
begin
PhOfs := PhOfs-succ(EndCol);
ShowData;
end;
end
else
dec(CurRow);
end;
procedure ShiftDo;
begin
if CurRow > pred(EndRow) then
begin
CurRow := EndRow;
if PhOfs < MaxPhOfs then
begin
PhOfs := PhOfs+succ(EndCol);
ShowData;
end;
end
else
inc(CurRow);
end;
procedure ShiftLf;
begin
if CurCol = StartCol then
begin
CurCol := EndCol;
end
else
dec(CurCol)
end;
procedure ShiftRi;
begin
inc(CurCol);
if CurCol > EndCol then
begin
CurCol := StartCol;
end;
end;
procedure HomeIt;
begin
CurCol := 0;
CurRow := 0;
end;
procedure EndIt;
begin
CurCol := EndCol;
CurRow := EndRow;
end;
procedure DoEdit;
var ec,er,ei,ErrCode:word;
tb:byte;
OldNum,NewNum:string[8];
begin
ec := EditCol+6;
er := EditRow;
if PhByte >= PhonemeSize then Exit;
HighVideo;
gotoxy(EditCol, EditRow);
write('Edit: ');
gotoxy(EditCol+6,EditRow);
write(SaData^[PhByte+(pred(Ph) * PhonemeSize)]);
str(SaData^[PhByte+(pred(Ph) * PhonemeSize)],NewNum);
while length(NewNum) < 3 do NewNum := NewNum+' ';
ei := 1;
repeat
highVideo;
gotoxy(pred(ec)+ei,er);
if not(((Key >= '0') and (Key <= '9')) or (Key = ' ')) then
Key := ReadKey;
if Key = #$1b then
begin
LowVideo;
gotoxy(EditCol, EditRow);
write(' ');
Exit;
end;
if ((Key >= '0') and (Key <= '9')) or (Key = ' ') then
begin
OldNum := NewNum;
NewNum[ei] := Key;
while NewNum[length(NewNum)] = ' ' do dec(NewNum[0]);
while (NewNum[1] = ' ') and (length(NewNum) > 1) do
delete(NewNum,1,1);
val(NewNum,tb,ErrCode);
while length(NewNum) < 3 do NewNum := NewNum+' ';
if ErrCode <> 0 then
NewNum := OldNum
else
begin
gotoxy(ec,er);
write(NewNum);
if Key <> ' ' then inc(ei);
if ei > 3 then ei := 3;
end;
end;
if (Key = #8) and (ei > 1) then
begin
dec(ei);
end;
LowVideo;
if Key = #13 then
begin
HighVideo;
while NewNum[length(NewNum)] = ' ' do dec(NewNum[0]);
while NewNum[1] = ' ' do delete(NewNum,1,1);
val(NewNum,SaData^[PhByte+(pred(Ph) * PhonemeSize)],ErrCode);
gotoxy(succ(CurCol*4),succ(CurRow));
write(' ');
gotoxy(succ(CurCol*4),succ(CurRow));
write(SaData^[PhByte+(pred(Ph) * PhonemeSize)]);
gotoxy(EditCol, EditRow);
write(' ');
LowVideo;
Exit;
end;
Key := #0;
until false;
end;
procedure CurShow(Sel:word);
begin
gotoxy(succ(CurCol*4),succ(CurRow));
write(' ');
if Sel = 0 then LowVideo else HighVideo;
gotoxy(succ(CurCol*4),succ(CurRow));
if PhByte < PhonemeSize then
write(SaData^[PhByte+(pred(Ph) * PhonemeSize)]);
LowVideo;
end;
procedure SaveIt;
begin
gotoxy(RemCol, EditRow);
write(' ');
HighVideo;
gotoxy(EditCol, EditRow);
write('Save Image (Y/N) ? ');
gotoxy(EditCol+19,EditRow);
Key := upcase(ReadKey);
write(Key);
if Key = 'Y' then
begin
assign(fb,bkfile);
Erase(fb);
ReName(f,bkfile);
assign(f,rdfile);
ReWrite(f,1);
BlockWrite(f,SaData^,Fsize,Result);
Close(f);
HighVideo;
gotoxy(RemCol, EditRow);
write('<Image Saved>');
end;
LowVideo;
gotoxy(EditCol, EditRow);
write(' ');
end;
begin
TextAttr := LightGray;
ScreenMax := pred(succ(EndCol)*succ(EndRow));
MaxPhOfs := PhonemeSize - ScreenMax;
if MaxPhOfs < 0 then MaxPhOfs := 0;
Pg := 1;
Ph := 1;
PhOfs := 0;
PhByte := 0;
GetMem(SaData,sizeof(SaData^));
if ParamCount > 0 then
Assign(f,ParamStr(1))
else
Assign(f,rdfile);
reset(f,1);
Fsize := FileSize(f);
reset(f,1);
BlockRead(f,SaData^,Fsize,Result);
Close(f);
clrscr;
ShowData;
CurCol := 0;
CurRow := 0;
TalkIt;
repeat
PhByte := (CurCol+CurRow*succ(EndCol))+PhOfs;
ByteShow;
CurShow(1);
Key := upcase(ReadKey);
if Key = #0 then Key := char(byte(ReadKey) or $80);
if Key = 'E' then DoEdit;
if Key in ['0'..'9'] then DoEdit;
if (Key = 'X') or (Key = 'Q') then halt;
if Key = 'T' then TalkIt;
CurShow(0);
if Key = PgDo then NextP;
if Key = PgUp then PrevP;
if Key = UpAr then ShiftUp;
if Key = DoAr then ShiftDo;
if Key = LfAr then ShiftLf;
if Key = RiAr then ShiftRi;
if Key = Home then HomeIt;
if Key = EKey then EndIt;
if Key = 'D' then ShowData;
if Key = 'S' then SaveIt;
until false;
end.