Umiestnenie súboru www.TrSek.com/pas/dascii.pas{ DASCII.PAS Copyright (c) TrSek alias Zdeno Sekerak }
{ Editor znakovej sady ASCII pre textovy rezim. Dokaze editovat }
{ aktualne znaky, ukladat do datoveho suboru a hlavne predefinovat. }
{ Posluzi ak chcete definovat vlastne znaky ASCII pre OS. }
{ }
{ Datum:04.02.1994 http://www.trsek.com }
program defascii;
uses crt,dos,trsek;
const kvad:array[1..8] of byte=
(1,2,4,8,16,32,64,128);
cpasw='kesrt ';
type bj=array[0..255,1..16] of byte;
var x,y,i:integer;
b,znak:byte;
maska:array[1..8,1..16] of byte;
bajt,baj:bj;
fr:array[1..16] of byte;
pasw:string;
ch:char;
z:word;
pv:longint;
f:file of bj;
cis_okna:byte; { uchovavam cislo okna }
procedure writexy(x,y:integer;ch:char);
begin
gotoxy(37-x*3,y+4);
write(ch,ch,ch);
kurzorzap(false);
end;
procedure poloz(x,y:integer);
begin
if maska[x,y]=1 then textbackground(cyan)
else textbackground(blue);
writexy(x,y,' ');
textbackground(red);
end;
procedure writec(fp,fd:integer;s:string;dlz:integer);
var i,y:integer;
begin
i:=0;y:=0;
repeat
i:=i+1;y:=y+1;
if s[i]='^' then begin
textcolor(fp);i:=i+1;
write(s[i]);end
else begin
textcolor(fd);
write(s[i]);end;
until (i>=length(s));
textcolor(fd);
for i:=y to dlz do write(' ');
end;
procedure vykresli;
begin
gotoxy(1,1);
farba(lightgray,black);
write(' X=',x:2,' Y=',y:2,' Znak : ',znak:4,' Jeho ascii zatial : ',chr(znak),' ');
for x:=1 to 8 do
for y:=1 to 16 do maska[x,y]:=round((bajt[znak,y] and kvad[x])/kvad[x]);
farba(blue,yellow);
for x:=1 to 8 do
for y:=1 to 16 do begin
textbackground(blue);
gotoxy(43,y+4);write(bajt[znak,y]:3);
poloz(x,y);
end;
x:=8;y:=1;
end;
procedure vedla;
begin
textbackground(blue);
window(54,5,71,20);clrscr;window(1,1,80,25);
for x:=0 to 15 do
for y:=0 to 15 do begin
if not((x+y*16) in [7,8,10,13]) then begin gotoxy(55+x,y+5);write(chr(x+y*16));end;
end;
end;
function pasword:string;
begin
farba(red,yellow);
gotoxy(18,23);
write(' Pre ascii mensie 128 chcem heslo : ');
pasword:=tread(54,23,7,' ',#0,#0);
gotoxy(18,23);farba(green,yellow);
write(' ');
end;
procedure make(i:integer);
var reg:registers;
begin
if ((pasw<>cpasw) and (i>=0) and (i<=127)) then begin
pasw:=pasword;
if pasw<>cpasw then exit;
end;
reg.es:=seg(bajt[i]);
reg.bp:=ofs(bajt[i]);
reg.ah:=$11;
reg.al:=$10;
reg.bl:=0;
reg.bh:=$10;
reg.cx:=1;
reg.dx:=i;
intr($10,reg);
end;
procedure help;
begin
window(11,3,71,22);
farba(blue,yellow);
clrscr;
writeln;
writeln(' Toto je produkt na zmenu znakovej sady na VGA,SVGA');
writeln;
writeln(' F1 - Tento help');
writeln(' F2 - Nahraje znak do suboru z menom dascii.dat');
writeln(' F3 - Vyberie znak zo suboru z menom dascii.dat');
writeln(' F5 - Predefinuje znak podla predlohy');
writeln(' F6 - Vymaze predlohu, vyplni nulami');
writeln(' F7 - Vlozi znak do virtualneho registra');
writeln(' F8 - Vyberie znak z virtualneho registra');
writeln(' F9 - Vyberie znak z ROM pamete');
writeln(' F10- Ukoncenie prace s mojim produktom');
writeln(' Shift F2 - Nahraje celu znakovu sadu ');
writeln(' Shift F3 - Vyberie celu znakovu sadu zo suboru');
writeln(' Shift F5 - Predefinuje celu znakovu sadu podla predlohy');
writeln(' Shift F6 - Vymaze vsetky predlohy');
writeln(' Shift F9 - Vyberie z ROM pamete vsetky znaky');
writeln(' Prikazom dascii.exe /d - predefinuje ASCII sadu z DOSu');
writeln;
writeln(' Software by TRSEK.');
repeat until (readkey in [#27,#13]);
window(1,1,80,24);
farba(green,white);
lowvideo;
clrscr;
vykresli;vedla;
x:=8;y:=1;
farba(red,yellow);
writexy(x,y,' ');
end;
procedure load(ak:boolean;znak:integer);
var x,y:integer;
begin
assign(f,'dascii.dat');
{$I-}
reset(f);
{$I+}
if ioresult=0 then begin
if znak=257 then read(f,bajt)
else begin
read(f,baj);
for x:=1 to 16 do bajt[znak,x]:=baj[znak,x];
end;
close(f);
end
else begin
gotoxy(20,23);
if ak then begin write(' Subor dascii.dat neexistuje v adresari.');
repeat until (readkey in [#27,#13,#32]);
gotoxy(20,23);farba(green,yellow);
write(' ');end;
end;
end;
procedure save(znak:integer);
var x,y:integer;
begin
assign(f,'ascii.dat');
if znak=257 then begin
rewrite(f);
write(f,bajt);end
else begin
{$I-}
reset(f);
{$I+}
if ioresult=0 then read(f,baj)
else for x:=0 to 255 do for y:=1 to 16 do baj[x,y]:=0;
rewrite(f);
for x:=1 to 16 do baj[znak,x]:=bajt[znak,x];
write(f,baj);
end;
close(f);
end;
procedure ukonc;
begin
farba(black,white);
clrscr;
lowvideo;
end;
procedure napln(znak:integer);
var i:word;
x1:word;
reg:registers;
adresa: ^byte;
begin
reg.ah:=$11;
reg.al:=$30;
reg.bl:=$0;
reg.bh:=$1;
intr($10,reg);
for i:=0 to 15 do begin
adresa := Ptr(reg.es,reg.bp+znak*16+i);
bajt[znak,i+1]:=adresa^;
end;
end;
begin
cis_okna:=get_window(1,1,80,25);
farba(blue,white);
clrscr;
writeln(' ........... Vies co, trochu pockaj. .........');
for i:=0 to 255 do
for y:=1 to 16 do bajt[i,y]:=0;
for i:=1 to 16 do fr[i]:=0;
pasw:='';
if paramcount>0 then
if paramstr(1)='/d' then begin pasw:=cpasw;
load(false,257);
for i:=0 to 255 do make(i);
halt(0);end;
for x:=1 to 8 do
for y:=1 to 16 do maska[x,y]:=0;
farba(green,white);
lowvideo;
clrscr;
textbackground(lightgray);gotoxy(1,25);
writec(red,black,'^F^1Help ^F^2Save ^F^3Load ^F^5Zmen ^F^6Cls ^F^7In ^F^8Out ^F^9ROM ^F^1^0Exit',78);
gotoxy(62,25);write('Software by TRSEK.');
znak:=97;
vykresli;vedla;
x:=8;y:=1;
farba(red,yellow);
writexy(x,y,' ');
repeat
ch:=readkey;
if ch=#13 then begin
maska[x,y]:=abs(maska[x,y]-1);
bajt[znak,y]:=(maska[x,y]*kvad[x]) or (kvad[x] xor bajt[znak,y]);
farba(blue,yellow);
gotoxy(43,y+4);write(bajt[znak,y]:3);
textbackground(red);
end;
if ch=#0 then ch:=readkey;
case ch of
#59:help;
#60:save(znak);
#61:begin load(true,znak);vykresli;end;
#63:make(znak);
#64:begin for i:=1 to 16 do bajt[znak,i]:=0;vykresli;end;
#65:for i:=1 to 16 do fr[i]:=bajt[znak,i];
#66:begin for i:=1 to 16 do bajt[znak,i]:=fr[i];
vykresli;end;
#67:begin napln(znak);vykresli;end;
#85:save(257);
#86:begin load(true,257);vykresli;end;
#88:for i:=0 to 255 do make(i);
#89:begin for i:=0 to 4096 do bajt[i div 16,(i mod 16)+1]:=0;
vykresli;end;
#92:begin
for i:=0 to 255 do napln(i);vykresli;end;
#68:ch:=#27;
#72:begin poloz(x,y);y:=y-1;if y<1 then y:=1; end;
#80:begin poloz(x,y);y:=y+1;if y>16 then y:=16;end;
#77:begin poloz(x,y);x:=x-1;if x<1 then x:=1; end;
#75:begin poloz(x,y);x:=x+1;if x>8 then x:=8; end;
#73:begin if(znak>0) then znak:=znak-1; vykresli;end;
#81:begin if(znak<255) then znak:=znak+1; vykresli;end;
end;
farba(red,yellow);
writexy(x,y,' ');
gotoxy(1,1);
farba(lightgray,black);
write(' X=',x:2,' Y=',y:2,' Znak : ',znak:4,' Jeho ascii zatial : ',chr(znak),' ');
until (ch=#27);
ukonc;
put_window(cis_okna,1,1,80,25);
end.