{ 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.