Category : Pascal Source Code
Archive   : TALKPAS.ZIP
Filename : TALKEDIT.PAS
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('
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.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/