Elemente de programare a PC - urilor

Elemente de programare a PC - urilor

Oferim in continuare citeva exemple de programe, unele in Pascal, altele in C, pentru a permite celor pasionati sa-si insuseasca cunostintele minimale de programare a PC-urilor: lucrul cu tastatura, accesul direct la memorie, lucrul in modul grafic, etc. Pentru cei ce doresc sa aprofundeze acest subiect sau doresc cit mai multe detalii le recomandam, pe linga citirea atenta a help-ului Turbo Pascal-ului sau a Turbo C-ului, folosirea utilitarului TechHelp specializat in descrierea programarii PC-urilor.

Ideea care ar defini cel mai bine acest tip de cunostinte de programare este continuta in cunoscuta expresie : 'Secrete mici, efecte mari !'.

// Un simplu program muzical

#include <stdio.h>

#include <dos.h>

#include <conio.h>

main();

int i,j,nr_octava,i_nota,timp=500;

float masura,durata,durata_masura;

char *linia='42$2R2R4M4F2O2L1R2R2S2S4L4O2O2'; //$4D2D4$3S4L2';

do

break;

case 'D' : i_nota=0;break;

case 'd' : i_nota=1;break;

case 'R' : i_nota=2;break;

case 'r' : i_nota=3;break;

case 'M' : i_nota=4;break;

case 'F' : i_nota=5;break;

case 'f' : i_nota=6;break;

case 'O' : i_nota=7;break;

case 'o' : i_nota=8;break;

case 'L' : i_nota=9;break;

case 'l' : i_nota=10;break;

case 'S' : i_nota=11;break;

} else

sound(nr_octava*octava[i_nota]);

delay(durata*timp);

} /* else */

} /* for */

/* do */

while (!kbhit());

nosound();

Program Citite_Taste;

uses crt;

var c:char;

shift:byte absolute $40:$17;

begin

repeat

c:=readkey;

if (shift and $3>0) then

write(' shift ',c,':',Ord(c))

else write(' ',c,':',Ord(c));

until c=#27;

end.

// Program C pt. afisarea Tabelului codurilor ASCII;

#include <stdio.h>

void main();

Program Tenis;

Uses Crt;

Const viteza=1500;

Type Ecran=Record

car:char;

atrib:byte;

End;

Var

scr:array[1..25,1..80] of Ecran absolute $b800:$0;

x,y,x0,y0:byte;

i,d,s:integer;

u:real;

ok:boolean;

tasta:char;

yP1:array[1..5]of byte;

yP2:array[1..5]of byte;

uP:array[1..5]of real;

Procedure Paleta1(tip:char);

Begin

for i:=1 to 5 do

scr[yP1[i],76].car:=tip;

end;

Procedure Paleta2(tip:char);

Begin

for i:=1 to 5 do

scr[yP2[i],5].car:=tip;

End;

Procedure Mutapaleta1;

Begin

Paleta1(' ');

if (tasta=#80) and (yP1[i]<24) then

for i:=1 to 5 do Inc(yP1[i]);

if (tasta=#72) and (yP1[i]>6) then

for i:=1 to 5 do Dec(yP1[i]);

End;

Procedure Mutapaleta2;

Begin

Paleta2(' ');

if (tasta=#122) and (yP2[i]<24) then

for i:=1 to 5 do Inc(yP2[i]);

if (tasta=#119) and (yP2[i]>6) then

for i:=1 to 5 do Dec(yP2[i]);

End;

procedure cantec;

begin sound(400);delay(800);

sound(500);delay(800);

sound(600);delay(800);

sound(650);delay(800);

sound(600);delay(800);

sound(700);delay(800);

sound(650);delay(1000);

end;

Begin

Clrscr;

d:=0;s:=0;

clrscr;

For x:=1 to 80 do begin

scr[1,x].car :=#219;

scr[25,x].car:=#219;

end;

For y:=2 to 9 do begin  

scr[y,1].car :=#219;

scr[y,80].car:=#219;

end;

For y:=17 to 24 do begin

scr[y,1].car :=#219;

scr[y,80].car:=#219;

end;

x0:=40;

y0:=13;

u:=20*PI/180;

x:=x0;

y:=y0;

for i:=1 to 5 do begin

yP1[i]:=10+i;

yP2[i]:=10+i;

uP[i]:=(i/3*PI-PI)/15;

end;

tasta:=' ';

repeat  

if ((u>=0) and (u<PI/2) or (u > 3*PI/2) and (u<2*PI)) then inc(x)

else dec(x);

y:=y0+Trunc(Abs(x-x0) * Sin(u)/Cos(u));

if scr[y,x].car<>' ' then begin

if (y=1)or(y=25) then begin

u:=2*PI-u;x0:=x;

if y=1 then y0:=2 else y0:=24;

end;

if (x=1)or(x=80) then begin

u:=PI+u;if u>2*Pi then u:=u-2*PI;

y0:=y;

if x=1 then x0:=2 else x0:=79;

end;

if x=76 then begin

for i:=1 to 5 do

if y=yP1[i] then begin

sound(1000);

u:=PI+u+uP[i];

if u>2*Pi then u:=u-2*PI;

x0:=x;y0:=y;

end;

nosound;

end;

if x=5 then begin

for i:=1 to 5 do

if y=yP2[i] then begin

sound(600);

u:=PI+u+uP[i];

if u>2*Pi then u:=u-2*PI;

x0:=x;y0:=y;

end;

nosound;

end;

end

else if not (((x=1)or(x=80)) and((y<17)and(y>8))) then

begin

scr[y,x].car:='0';

i:=1;

ok:=false;

repeat

ok:=keypressed;

inc(i);

until (i=viteza)or ok;

if ok then begin

tasta:=readkey;

if tasta = #0 then tasta:=readkey;

mutapaleta1;

mutapaleta2;

end;

Paleta1(#219);

Paleta2(#219);

scr[y,x].car:=' ';

scr[y,x].car:=' ';

end

else begin

sound(800);

if (x>=80)and(y>9)and(y<17) then d:=d+1;

if (x<=1)and(y>9)and(y<17) then s:=s+1;

textcolor(2);

textbackground(7);

gotoxy(39,2);

write('SCOR');

gotoxy(38,3);

write(' ',d,' : ',s);

if (d=5)or(s=5) then begin

gotoxy(35,10);

write(' G A M E O V E R ');

cantec; nosound;

halt;

end;

delay(1500);

paleta1(' ');

paleta2(' ');

x0:=40;

y0:=13;

u:=20*PI/180;

x:=x0;

y:=y0;

for i:=1 to 5 do begin

yP1[i]:=10+i;

yP2[i]:=10+i;

uP[i]:=(i/3*PI-PI)/5;

end;

tasta:=' ';

nosound;

end;

until tasta=#27;

End.

Program Biliard;

uses Graph,Crt;

Const nr_obiecte=10;

raza=25;

pasx=3;pasy=2;

viteza=10;

var

grDriver,grMode,ErrCode: Integer;

i,xMax,yMax,xtmp,ytmp:word;

x,y:Array[1..nr_obiecte] of word;

sensx,sensy:Array[1..nr_obiecte] of shortint;

Procedure Deseneaza(x,y,color:word);

Const bucati=12;

Var x1,y1,unghi,Xasp,Yasp:word;

Begin

SetWriteMode(XORPut);SetColor(color);

GetAspectRatio(Xasp, Yasp);

unghi:=0;

x1:=x+Trunc(raza*cos(unghi*2*PI/bucati));

y1:=y+Trunc(raza*sin(unghi*2*PI/bucati)*Xasp/Yasp);

For unghi:=1 to bucati do begin

xtmp:=x+Trunc(raza*cos(unghi*2*PI/bucati));

ytmp:=y+Trunc(raza*sin(unghi*2*PI/bucati)*Xasp/Yasp);

Line(x1,y1,xtmp,ytmp);Line(x,y,x1,y1);

x1:=xtmp;y1:=ytmp;

end;

End;

begin

grDriver := Detect;

InitGraph(grDriver, grMode,'');

ErrCode := GraphResult;

if ErrCode = grOk then

begin

xMax:=GetMaxX;yMax:=GetMaxY;

Rectangle(0,0,xMax,yMax);

Randomize;

For i:=1 to nr_obiecte do begin

x[i]:=raza+Random(xMax-2*raza);y[i]:=raza+Random(yMax-2*raza);

sensx[i]:=-1+(i mod 2)*2;sensy[i]:=-sensx[i];

Deseneaza(x[i],y[i],i);

end;

Repeat

For i:=1 to nr_obiecte do begin

Deseneaza(x[i],y[i],i);

xtmp:=x[i]+pasx*sensx[i];ytmp:=y[i]+pasy*sensy[i];

If (xtmp>raza) and (xtmp<xMax-raza) then x[i]:=xtmp

else sensx[i]:=-sensx[i];

If (ytmp>raza) and (ytmp<yMax-raza) then y[i]:=ytmp

else sensy[i]:=-sensy[i];

Deseneaza(x[i],y[i],i);

Delay(100-10*viteza);

end;

Until KeyPressed;

Readln;

CloseGraph;

end

else

Writeln('Graphics error:', GraphErrorMsg(ErrCode));

end.

// Program C de umplere a ecranului text prin acces direct la memoria ecran

#include <dos.h>

#include <conio.h>

struct scrcar far *ecran;

int lin,col;

int culoare=BLUE,fundal=LIGHTGRAY;

void main(void)

getch();

Program Acces_direct_ecran_grafic320_200;

Uses crt;

Const maxl=200-1;

maxc=320-1;

mijl=maxc div 2;

Type Matrice=array[0..maxl,0..maxc] of byte;

var

scr:Matrice absolute $A000:0;

i,j,k,l,c,x:integer;

ok:char;

BEGIN

asm

mov ah,0

mov al,13h

int 10h;

end;

randomize;x:=random(maxc);

for k:=1 to 2 do

for i:=0 to maxl do

for j:=0 to mijl do

scr[i,j+k*mijl]:=random(maxc) ;

k:=0;

repeat

repeat

for i:=0 to maxl do

for j:=0 to mijl do begin

l:=i;c:=j+k*mijl;

if (scr[(l-1)mod maxl,c]<scr[l,c])and

(scr[l,(c-1)mod mijl]<scr[l,c]) then

scr[i,j+((k+1)mod 2)*mijl]:=(scr[(l-1)mod maxl,c]+scr[l,(c-1)mod mijl]+ x)div 3-1

else if (scr[l,(c+1)mod mijl]>scr[l,c])and

(scr[(l+1)mod maxl,c]>scr[l,c]) then

scr[i,j+((k+1)mod 2)*mijl]:=(scr[(l+1)mod maxl,c]+scr[l,(c+1)mod mijl]+ x) div 3+1

else scr[i,j+((k+1)mod 2)*mijl]:=scr[l,c]+1;

end;

k:=(k+1) mod 2;

until keypressed;

ok:=readkey;x:=random(maxc);

if ok<>#27 then ok:=readkey;

until ok=#27;

asm

mov ax,0

int 10h

end;

END.

Program Mouse;

uses Crt,Graph,Dos;

var

grDriver,grMode,ErrCode : Integer;

mfunc,buton,mx,my,xf,yf,x,y:word;

xi,yi:integer;

s1,s2,s3:string[5];

P : pointer;

Size : Word;

procedure MouseAsm;ASSEMBLER;

ASM

MOV AX,mfunc

MOV BX,buton

MOV CX,mx

MOV DX,my

INT $33

MOV mfunc,AX

MOV buton,BX

MOV mx,CX

MOV my,DX

end;

Begin

grDriver := Detect;

InitGraph(grDriver,grMode,'');

ErrCode := GraphResult;

if ErrCode = grOk then

begin

if mem[memW[0:$cc+2]:memW[0:$cc]]=$cf then

begin

outtext('Mouse-ul nu este instalat!');

readln;closegraph;halt;

end;

mfunc:=0;mouseasm;

mfunc:=1;mouseasm;

mfunc:=3;

mouseasm;xi:=mx;yi:=my;

setactivepage(1);

rectangle(xi,yi,mx,my);

Size := ImageSize(xi,yi,mx,my);

GetMem(P, Size);

GetImage(xi,yi,mx,my,P^);

putimage(xi,yi,P^,XORput);

setactivepage(0);

PutImage(100, 100, P^, ORPut);

repeat

mouseasm;

xi:=mx;yi:=my;

while buton=1 do

begin

PutImage(100, 100, P^,XORPut);

mouseasm;

setactivepage(1);

rectangle(xi,yi,mx,my);

Size := ImageSize(xi,yi,mx,my);

GetMem(P, Size);

GetImage(xi,yi,mx,my,P^);

putimage(xi,yi,P^,XORput);

setactivepage(0);

PutImage(100, 100, P^, ORPut);

end;

until keypressed;

mfunc:=2;mouseasm;

CloseGraph;

end

else

WriteLn('Graphics error:',GraphErrorMsg(ErrCode));

end.

// Program C de generare a efectului grafic-plasma-prin utilizarea unor functii ale modului grafic

#include <graphics.h>

#include <stdlib.h>

#include <stdio.h>

#include <conio.h>

#include <math.h>

#include <dos.h>

int MX,MY;

int p1,p2,p3,p4,r1,r2,r3,r4;

void plasma(int x1,int x2,int y1,int y2)

int gdriver = VGA, gmode = VGAHI, errorcode,i;

double red=20,green=30,blue=40;

struct palettetype pal;

void main(void)

/* grab a copy of the palette */

getpalette(&pal);

for (i=0; i<pal.size; i++)

setrgbpalette(pal.colors[i], red+i, green+i, blue+i);

randomize();

MX=getmaxx();MY=getmaxy();

putpixel(0,0,MAXCOLORS/2);

putpixel(0,MY,MAXCOLORS/2);

putpixel(MX,0,MAXCOLORS/2);

putpixel(MX,MY,MAXCOLORS/2);

plasma(0,MX,0,MY);

// rotate palette

while(!kbhit())

closegraph();

Program Sarpe;

Uses Crt;

Const

sc=#219;

lungmax=95;

maxnext=10;

xlimit=[1,80];

ylimit=[1,25];

Var

sx,sy:array[1..95] of byte;

c:char;

i,primul,ultimul,next,tdelay,idelay:integer;

xnext,ynext:byte;

Begin

clrscr;

randomize;

for i:=1 to 79 do begin gotoxy(i,1);write(sc);gotoxy(i,25);write(sc);end;

for i:=1 to 24 do begin gotoxy(1,i);write(sc);gotoxy(80,i);write(sc);end;

primul:=2;ultimul:=1;

for i:=primul downto ultimul do begin sx[i]:=40;sy[i]:=13;end;

next:=0;idelay:=100;

for i:=primul downto ultimul do begin

gotoxy(sx[i],sy[i]);write(sc);

end;

c:=readkey;

while next<maxnext do

begin

xnext:=2+random(78);ynext:=2+random(23);

inc(next);gotoxy(xnext,ynext);write(next);

repeat

if keypressed then begin

c:=readkey;tdelay:=idelay;

if c=#0 then c:=readkey;

end

else tdelay:=tdelay*97 div 100;

case c of

'1'..'9':

idelay:=100+100 div (ord(c)-ord('1')+1);

#75:

begin

gotoxy(sx[ultimul],sy[ultimul]);write(' ');

if primul=lungmax then begin

sx[1]:=sx[primul]-1;sy[1]:=sy[primul];

primul:=1

end

else begin

inc(primul);

sx[primul]:=sx[primul-1]-1;sy[primul]:=sy[primul-1];

end;

if ultimul=lungmax then ultimul:=1

else inc(ultimul);

end;

#77:

begin

gotoxy(sx[ultimul],sy[ultimul]);write(' ');

if primul=lungmax then begin

sx[1]:=sx[primul]+1;sy[1]:=sy[primul];

primul:=1

end

else begin

inc(primul);

sx[primul]:=sx[primul-1]+1;sy[primul]:=sy[primul-1];

end;

if ultimul=lungmax then ultimul:=1

else inc(ultimul);

end;

#72:

begin

gotoxy(sx[ultimul],sy[ultimul]);write(' ');

if primul=lungmax then begin

sx[1]:=sx[primul];sy[1]:=sy[primul]-1;

primul:=1

end

else begin

inc(primul);

sx[primul]:=sx[primul-1];sy[primul]:=sy[primul-1]-1;

end;

if ultimul=lungmax then ultimul:=1

else inc(ultimul);

end;

#80:

begin

gotoxy(sx[ultimul],sy[ultimul]);write(' ');

if primul=lungmax then begin

sx[1]:=sx[primul];sy[1]:=sy[primul]+1;

primul:=1

end

else begin

inc(primul);

sx[primul]:=sx[primul-1];sy[primul]:=sy[primul-1]+1;

end;

if ultimul=lungmax then ultimul:=1

else inc(ultimul);

end;

end;

if primul > ultimul then

for i:=primul downto ultimul do begin

gotoxy(sx[i],sy[i]);write(sc);

if (sx[primul]=sx[i]) and (sy[primul]=sy[i]) and (i<>primul) then

c:=#27;

end

else

begin

for i:=ultimul to lungmax do begin

gotoxy(sx[i],sy[i]);write(sc);

if (sx[primul]=sx[i]) and (sy[primul]=sy[i]) and (i<>primul) then

c:=#27;

end;

for i:=1 to primul do begin

gotoxy(sx[i],sy[i]);write(sc);

if (sx[primul]=sx[i]) and (sy[primul]=sy[i]) and (i<>primul) then

c:=#27;

end;

end;

if (sx[primul] in xlimit)or(sy[primul] in ylimit) then c:=#27;

delay(tdelay);

until (c=#27) or ((sx[primul]=xnext)and(sy[primul]=ynext));

sound(next*30);

if c=#27 then next:=maxnext

else

if ultimul-next <= 0 then begin

for i:=lungmax+ultimul-next to lungmax do begin

sx[i]:=sx[ultimul];sy[i]:=sy[ultimul];

end;

for i:=1 to ultimul do begin

sx[i]:=sx[ultimul];sy[i]:=sy[ultimul];

end;

ultimul:=lungmax+ultimul-next;

end

else begin

for i:=ultimul-next to ultimul do begin

sx[i]:=sx[ultimul];sy[i]:=sy[ultimul];

end;

ultimul:=ultimul-next;

end;

delay(tdelay);

nosound;

end;

End.

Program Scan_Taste;

Uses Crt,Dos;

Var

tasta:byte;

KbdIntVec:procedure;

Procedure KeyClick; interrupt;

begin

Port[$20]:=$20;

end;

Begin

GetIntVec($9,@KbdIntVec);

SetIntVec($9,Addr(KeyClick));

tasta:=0;

repeat

repeat until tasta<>Port[$60];

tasta:=Port[$60];

gotoxy(20,2);write(tasta:3);

until tasta=129;

SetIntVec($9,@KbdIntVec);

End.

Program Taste_muzicale_V2;

Uses Crt,Dos;

Const

Nota_Do:array[1..4] of integer=(33,66,132,264);

Raport:array[1..10]of real=(24/24,27/24,30/24,32/24,36/24,40/24,45/24,

48/24,51/24,54/24);

Nota:array[1..10]of string[3]=('Do','Re','Mi','Fa','Sol','La','Si',

'Do','Re','Mi');

CodT:array[1..4]of byte=(44,30,16,2);

Type Pixel=Record

atrib:byte;

car:char;

end;

Var

tasta:byte;i:integer;

KbdIntVec:procedure;

ecran:array[1..25,1..80]of Pixel absolute $b800:0000;

Procedure KeyClick; interrupt;

begin

Port[$20]:=$20;

end;

Begin

ClrScr;

GetIntVec($9,@KbdIntVec);

SetIntVec($9,Addr(KeyClick));

tasta:=0;

repeat

repeat until tasta<>Port[$60];

tasta:=Port[$60];

if (tasta>=CodT[1])and(tasta<CodT[1]+10) then

begin

gotoxy(5*(tasta+1-CodT[1]),24);write(Nota[tasta+1-CodT[1]]);

sound( Trunc( Raport[ tasta+1-CodT[1] ] * Nota_Do[1] ) )

end

else

if (tasta>=CodT[2])and(tasta<CodT[2]+10) then

begin

gotoxy(5*(tasta+1-CodT[2]),22);write(Nota[tasta+1-CodT[2]]);

sound( Trunc( Raport[ tasta+1-CodT[2] ] * Nota_Do[2] ) )

end

else

if (tasta>=CodT[3])and(tasta<CodT[3]+10) then

begin

gotoxy(5*(tasta+1-CodT[3]),20);write(Nota[tasta+1-CodT[3]]);

sound( Trunc( Raport[ tasta+1-CodT[3] ] * Nota_Do[3] ) )

end

else

if (tasta>=CodT[4])and(tasta<CodT[4]+10) then

begin

gotoxy(5*(tasta+1-CodT[4]),18);write(Nota[tasta+1-CodT[4]]);

sound( Trunc( Raport[ tasta+1-CodT[4] ] * Nota_Do[4] ) )

end

else nosound;

until tasta=129;

SetIntVec($9,@KbdIntVec);

End.

Program Testare_VESA;

uses dos;

type tmoduri=array[1..256] of word;

var imod,vseg,x,y:word; cbank,c:longint; rg:registers;

ntbanks:longint; opt:char;

vesabuf:record sign:longint; vers:word; oem:pchar;

capab:longint; list:^tmoduri;

reserv:array[1..512] of byte end;

vesamod:record attr:word; wina,winb:byte;

gran,winsiz,sega,segb:word; pagfun:pointer;

bytes,width,height:word;

charw,charh,planes,bits,nbanks,model,sbank,

nrimpg,reservb,rms,rfp,gms,gfs,bms,bfs:byte;

reserv:array[1..512] of byte end;

function hexa(v:word):string;

const s:string[16]='0123456789abcdef';

function hexb(b:byte):string;

begin

hexb:=s[b div 16+1]+s[b mod 16+1];

end;

begin

hexa:=hexb(hi(v))+hexb(lo(v));

end;

procedure setbank(b:longint);

begin

vseg:=$a000;

if b<>cbank then with rg,vesamod do begin

cbank:=b; ax:=$4f05; bx:=0;

dx:=b*64 div gran; intr(16,rg);

end;

end;

procedure putpixel(x,y:word; cul:longint);

var l:longint; m,z:word;

begin

with rg,vesamod do case bits of

4: begin

l:=longint(bytes)*y+x div 8;

port[$3ce]:=3; port[$3cf]:=0;

port[$3ce]:=5; port[$3cf]:=2;

port[$3ce]:=8; port[$3cf]:=128 shr (x and 7);

setbank(l shr 16);

z:=mem[vseg:word(l)]; mem[vseg:word(l)]:=cul;

end;

8: begin

l:=longint(bytes)*y+x; setbank(l shr 16);

mem[vseg:word(l)]:=cul;

end;

15,16: begin

l:=longint(bytes)*y+x*2; setbank(l shr 16);

memw[vseg:word(l)]:=cul;

end;

24: begin

l:=longint(bytes)*y+x*3;

z:=word(l); m:=l shr 16; setbank(m);

if z<$fffe then move(cul,mem[vseg:z],3)

else begin

mem[vseg:z]:=lo(cul);

if z=$ffff then setbank(m+1);

mem[vseg:z+1]:=lo(cul shr 8);

if z=$fffe then setbank(m+1);

mem[vseg:z+2]:=cul shr 16;

end;

end;

end;

end;

begin

with rg, vesabuf, vesamod do begin

ax:=$4f00; es:=seg(vesabuf); di:=ofs(vesabuf);

sign:=$41534556; intr(16,rg);

if al<>$4f then begin

writeln('Standardul VESA nu e implementat');

exit end;

imod:=1;

while list^[imod]<>$ffff do begin

ax:=3; intr(16,rg); ax:=$4f01; cx:=list^[imod];

es:=seg(vesamod); di:=ofs(vesamod);

intr(16,rg);

if attr and 16<>0 then begin

writeln(oem,' VESA Versiune ',hi(vers),'.',lo(vers));

writeln(hexa(list^[imod]),

' Rezolutie: ',width,' x ',height,

' Culori: ',longint(1) shl bits);

write('Doriti testare (D/N)? '); readln(opt);

end else opt:='N';

if upcase(opt)='D' then begin

ax:=$4f02; bx:=list^[imod];

intr(16,rg); cbank:=-1;

ntbanks:=longint(bytes)*height div gran div 1024;

for x:=0 to ntbanks do begin

setbank(x); mem[$a000:$ffff]:=0;

fillchar(mem[$a000:0],$ffff,0);

end;

case bits of

4,8: c:=15;

15: c:=32767;

16: c:=65535;

24: c:=longint(1) shl 24-1;

end;

for x:=0 to width-1 do begin

putpixel(x,0,c); putpixel(x,height-1,c);

end;

for y:=0 to height-1 do begin

putpixel(0,y,c); putpixel(width-1,y,c);

end;

for x:=0 to 191 do for y:=0 to 191 do begin

case bits of

4: c:=(y div 48)*4+x div 48;

8: c:=(y div 12)*4+x div 12;

15,16: c:=(y div 6)*(1 shl rfp)+x div 6;

24: c:=longint(x)*65536+y;

end;

putpixel(x+4,y+4,c);

end;

readln;

end;

inc(imod);

end;

ax:=3; intr(16,rg);

end;

end.