учебник по паскалю. Программа 5 Алгоритм 5 Свойства алгоритма 6 Формы записи алгоритма 6

• Название: Программа 5 Алгоритм 5 Свойства алгоритма 6 Формы записи алгоритма 6
• Анкор: учебник по паскалю.doc
• Дата: 03.02.2017
• Размер: 2.21 Mb.
• Имя файла: учебник по паскалю.doc
• Тип: Программа; #1964
• страница: 33 из 35

bh:=b shr 4;

if bh <> tpcolor then

putpixel (x,y,color[bh]);

inc (x);

inc(np);

end;

if np
bl:=b and 15;

if bl <> tpcolor then

putpixel (x,y,color[bl]);

inc(x);

inc(np);

end;

end;

x:=x0;

dec(y);

end;

close (bmpf);

Draw:=info.height;

end;
var i,j:word;

b:char;

r:integer;

begin

InitMe;

clearscreen;

assign (List,FileList);

{$I-}

reset (List);

{$I+}

if IoResult <> 0 then Error (1,FileList);

assign (res,resfile);

{$I-}

rewrite (res);

{$I+}

if IoResult <> 0 then Error (1,resfile);

settextjustify (centertext,toptext);

while not eof(List) do begin

readLn (List,s);

clearscreen;

Draw (0,0,s,true);

for j:=1 to height do

for i:=1 to width do begin

b:=chr(getpixel (i,j));

write (res,b);

end;

setcolor (BLACK);

outtextxy (cx,maxy-20,'Файл '+s+' ОК');

Wait;

end;

closeMe;

close (res);

close (List);

end.
12.2. Листинг содержит исходный текст игры в стиле Invaders. Компилировать в Паскаль 7. При необходимости изменить константу пути к Паскалю. Требует файла ресурсов, созданного утилитой из листинга 12.1. Требует установленного графического шрифта trip.chr.

uses graph,crt,Dos;

const width=32; height=20;

type Picture=array [0..width-1,0..height-1]

of char;

type sprite=record

state,x,y,Pnum,PREDir: word;

end;

const VGAPath='c:\TP7\egavga.bgi';

FontPath='c:\TP7\Trip.chr';

sprName='attack.res';

const ESC=#27; F1=#59; SPACE=#32;

UP=#72; DOWN=#80; LEFT=#75; RIGHT=#77;

const maxx=639; maxy=479;

cx=maxx div 2; cy=maxy div 2;

maxsprites=11; maxPictures=11;

maxshoots=100;

const LeftDir=0; RightDir=1;

UpDir=2; DownDir=3;

Delta=2; shootradius=5;

var ch:char; s:string;

Hour,min,sec,sec1,secN,secN1,

sec100,secI,secI1:word;

var Driver, Mode, Font1,

currentsprites, currentBottom,

currentshoots, shootx, Lives,

Enemyshooter, Enemies,

shootsProbability: integer;

score,Level:longint;

DriverF,FontF: file;

DriverP,FontP: pointer;

spr: array [1..maxsprites] of sprite;

Pict: array [1..maxPictures] of Picture;

shoots: array [1..maxshoots] of sprite;

shooter,DieMe,InGame,Initshoot:boolean;
procedure Wait;

var ch:char;

begin

reset (Input); repeat until keyPressed;

ch:=readkey; if ch=#0 then readkey;

end;
procedure closeAll;

begin

if FontP <> nil then begin

FreeMem(FontP, Filesize(FontF));

close (FontF);

end;

if DriverP <> nil then begin

FreeMem(DriverP, Filesize(DriverF));

close (DriverF);

end;

closegraph;

end;
procedure graphError;

begin

closeAll;

writeln('graphics error:',

grapherrormsg(graphresult));

writeln('Press any key to halt');

Wait; halt (graphresult);

end;
procedure InitAll;

begin

assign(DriverF, VGAPath);

reset(DriverF, 1);

getmem(DriverP, Filesize(DriverF));

Blockread(DriverF, DriverP^,

Filesize(DriverF));

if registerBGIdriver(DriverP)<0 then

graphError;

Driver:=VGA; Mode:=VGAHi;

initgraph(Driver, Mode,'');

if graphresult < 0 then graphError;

assign(FontF, FontPath);

reset(FontF, 1);

getmem(FontP, Filesize(FontF));

Blockread(FontF, FontP^, Filesize(FontF));

Font1:=registerBGifont(FontP);

if Font1 < 0 then graphError;

end;
procedure clearscreen;

begin

setfillstyle (solidfill, White);

bar (0,0,maxx,maxy);

end;
procedure Window

(x1,y1,x2,y2,color,Fillcolor:integer);

begin

setcolor (color);

setfillstyle (1,Fillcolor);

bar (x1,y1,x2,y2);

rectangle (x1+2,y1+2,x2-2,y2-2);

rectangle (x1+4,y1+4,x2-4,y2-4);

setfillstyle (1,DArKGrAy);

bar (x1+8,y2+1,x2+8,y2+8);

bar (x2+1,y1+8,x2+8,y2);

end;
procedure outtextcxy (y:integer; s:string);

begin

settextjustify (centertext,centertext);

outtextxy (cx ,y,s);

end;
procedure start;

begin

clearscreen;

Window (10,10,maxx-10,maxy-10,Blue,White);

settextstyle(Font1, HorizDir, 4);

outtextcxy (25,'Атака из космоса');

settextstyle(Font1, HorizDir, 1);

outtextcxy (maxy-25,

'Нажмите клавишу для начала');

Wait;

end;
procedure restorescreen

(sNum,Dir,Delta:word);

var x,y:word;

begin

x:=spr[sNum].x; y:=spr[sNum].y;

setfillstyle (solidfill,White);

case Dir of

LeftDir: begin

bar(x+width-Delta,y,x+width-1,

y+height-1);

end;

RightDir: begin

bar (x,y,x+Delta,y+height-1);

end;

UpDir: begin

bar (x,y+height-Delta,

x+width-1,y+height-1);

end;

DownDir: begin

bar (x,y,x+width-1,y+Delta);

end;

end;

end;
procedure Drawsprite (sNum:word);

var i,j,x,y,n,b:integer;

begin

N:=spr[sNum].PNum;

x:=spr[sNum].x; y:=spr[sNum].y;

for j:=y to y+height-1 do

for i:=x to x+width-1 do begin

b:=ord(Pict[n,i-x,j-y]);

putpixel(i,j,b);

end;

end;
procedure GoLeft;

var x,d2:word;

begin

x:=spr[1].x; d2:=delta*4;

if x>d2 then begin

restorescreen (1,LeftDir,d2);

Dec(spr[1].x,d2); Drawsprite (1);

end;

end;
procedure GoRight;

var x,d2:word;

begin

x:=spr[1].x;

d2:=delta*4;

if x+width < maxx then begin

restorescreen (1,RightDir,d2);

Inc(spr[1].x,d2);

Drawsprite (1);

end;

end;
procedure showLives;

begin

str(Lives,s);

setfillstyle (solidfill,White);

setcolor (RED); bar (80,0,110,10);

outtextxy (82,2,s);

end;
procedure showscore;

begin

str(score,s);

setfillstyle (solidfill,White);

setcolor (Blue); bar (150,0,250,10);

outtextxy (152,2,s);

end;
procedure showshoots;

begin

str(currentshoots,s);

setfillstyle (solidfill,White);

setcolor (Black); bar (20,0,50,10);

outtextxy (20,2,s);

end;
procedure showLevel;

begin

str(Level,s);

setfillstyle (solidfill,White);

setcolor (Blue); bar (251,0,350,10);

outtextxy (253,2,'Level '+s);

end;
procedure shoot;

var i:integer;

begin

if currentshoots>0 then begin

for i:=1 to maxshoots do

if (sec<>sec1) and (shoots[i].state=0)

then begin

Dec(currentshoots);

showshoots;

spr[1].PNum:=6; Drawsprite (1);

GetTime(Hour,min,sec,sec100);

shootx:=spr[1].x; shooter:=true;

shoots[i].x:=spr[1].x+ (width div 2);

shoots[i].y:=spr[1].y - 5;

shoots[i].PNum:=UpDir;

shoots[i].state:=1;

break;

end;

end;

end;
procedure Help(s:string);

begin

setfillstyle (solidfill,White);

setcolor (Blue);

bar (10,maxy-10,maxx-10,maxy);

outtextxy (10,maxy-9,s);

end;
procedure Error (code:integer; str:string);

begin

Window (cx-120,cy-100,cx+120,cy-70,

Black,YELLOW);

case code of

1: s:='Файл '+str+' не найден!';

end;

settextjustify (Lefttext, toptext);

settextstyle(DefaultFont, HorizDir, 1);

outtextxy (cx-116,cy-92,s);

Wait; closeAll; halt(code);

end;
procedure DrawField;

var i,x,y:integer;

begin

clearscreen;

with spr[1] do begin

state:=1; Pnum:=1;

x:=maxx div 2;

y:=maxy - 10 - height;

Drawsprite (1);

end;

x:=100;

y:=10;

for i:=2 to currentsprites do begin

spr[i].state:=1;

spr[i].PNum:=7;

spr[i].x:=x; spr[i].y:=y;

Drawsprite (i);

inc(x,50);

if x>maxx-width then begin

x:=100;

if y
Inc(y,height)

else y:=10;

end;

end;

for i:=1 to maxshoots do

shoots[i].state:=0;

shooter:=false;

Enemyshooter:=-1;

sec:=0; secN:=0;

secI1:=100; sec1:=100; secN1:=100;

setfillstyle (solidfill,RED);

FillEllipse (10,5,5,4);

showshoots;

setfillstyle (solidfill,Green);

bar (60,1,72,10);

setfillstyle (solidfill,LightGreen);

bar (62,3,70,8);

showLives;

setfillstyle (solidfill,YELLOW);

setcolor (Black);

for i:=1 to 3 do begin

circle (126+i*2,5,4);

FillEllipse (126+i*2,5,4,4);

end;

showscore;

showLevel;

InGame:=true;

end;
procedure Loadsprites;

var F:text;

n,i,j,r:integer;

b:char;

begin

assign (f,sprName);

{$I-}

reset (f);

{$I+}

if IoResult<>0 then Error (1,sprName);

for n:=1 to maxPictures do

for j:=0 to height-1 do

for i:=0 to width-1 do begin

read (f,b);

Pict [n,i,j]:=b;

end;

close (f);

end;
procedure Deltas (sNum,Dir:integer;

var dx,dy:integer);

var x,y:integer;

begin

x:=spr[sNum].x; y:=spr[sNum].y;

case Dir of

LeftDir: begin

Dec(x,Delta);

if x<0 then x:=0;

end;

RightDir: begin

Inc(x,Delta);

if x>maxx-width then x:=maxx-width;

end;

UpDir: begin

Dec (y,Delta);

if y<10 then y:=10;

end;

DownDir: begin

Inc(y,Delta);

if y>currentBottom then

y:=currentBottom;

end;

end;

dx:=x; dy:=y;

end;
function Between (a,x,b:integer):boolean;

begin

if (x>a) and (x
else Between:=false;

end;
procedure shootMovies;

var i,d,n:integer;

x,y:word;

found:boolean;

begin

for i:=1 to maxshoots do

if shoots[i].state=1 then begin

x:=shoots[i].x; y:=shoots[i].y;

d:=shoots[i].PNum;

setfillstyle (solidfill,White);

setcolor (White);

fillellipse(x,y,shootradius,shootradius);

if d=updir then begin

setfillstyle (solidfill,RED);

if y<15 then begin

shoots[i].state:=0; continue;

end;

found:=false;

for n:=2 to currentsprites do begin

if spr[n].state=1 then begin

if (Between(spr[n].x,x,

spr[n].x+width)) and

(Between(spr[n].y,y,

spr[n].y+height)) then begin

shoots[i].state:=0;

found:=true;

spr[n].state:=2;

Inc(spr[n].PNum);

Inc(score,10+5*n);

showscore;

break;

end;

end;

end;

if not found then Dec(y,Delta);

end

else begin

setfillstyle (solidfill,Blue);

if y>maxy-10-(height div 2) then begin

shoots[i].state:=0;

continue;

end;

found:=false;

if Between(spr[1].x,x,spr[1].x+width)

and

Between(spr[1].y,y,spr[1].y+height)

then begin

shoots[i].state:=0; found:=true;

Inc(spr[1].Pnum); DieMe:=true;

Help ('you are missed one life :-(');

Drawsprite (1);

end;

if not found then Inc(y,Delta);

end;

if not found then begin

fillellipse(x,y,shootradius,shootradius);

shoots[i].x:=x; shoots[i].y:=y;

end;

end;

end;
procedure Enemiesstep;

var i,k,Dir,dx,dy,n:integer;

begin

Enemies:=0;

for i:=2 to currentsprites do begin

if spr[i].state=1 then begin

Inc(Enemies);

for k:=1 to 3 do begin

dir:=random(4);

if dir=spr[i].pREDir then break;

end;

spr[i].pREDir:=dir;

Deltas (i, dir, dx, dy);

restorescreen (i,Dir,Delta);

spr[i].x:=dx; spr[i].y:=dy;

Drawsprite (i);

Initshoot:=false;

GetTime(Hour,min,secN1,sec100);

if (secN1<>secN) and

(1+random(100)
Initshoot:=true;

if Initshoot then begin

secN:=secN1;

for n:=1 to maxshoots do

if (shoots[n].state=0) and

(Enemyshooter<>i) then begin

Enemyshooter:=i;

shoots[n].x:=dx+ (width div 2);

shoots[n].y:=dy +height +5;

shoots[n].PNum:=DownDir;

shoots[n].state:=1;

break;

end;

end;

end

else if spr[i].state=2 then begin

GetTime (Hour,min,secI,sec100);

Drawsprite (i);

if secI<>secI1 then begin

secI1:=secI;

if (spr[i].PNum<11) then

Inc(spr[i].PNum)

else begin

spr[i].state:=0;

setfillstyle (solidfill, White);

bar (spr[i].x,spr[i].y,

spr[i].x+width-1,spr[i].y+height-1);

end;

end;

end;

end;

end;
procedure Timefunctions;

var i:integer;

begin

if not InGame then Exit;

GetTime(Hour,min,sec1,sec100);

if (shooter) and (sec<>sec1) then begin

spr[1].PNum:=1;

if shootx=spr[1].x then Drawsprite (1);

shooter:=false;

end;

if (DieMe) and (sec<>sec1) then begin

if spr[1].Pnum<5 then begin

sec:=sec1; Inc(spr[1].PNum);

Drawsprite (1); DieMe:=true;

end

else begin

DieMe:=false;

if Lives>0 then begin

Dec(Lives); showLives;

spr[1].PNum:=1;

Drawsprite (1);

end

else InGame:=false;

end;

end;

end;
function getlongintTime:longint;

{Вернет системное время как longint}

var Hour,minute,second,sec100: word;

var k,r:longint;

begin

GetTime (Hour, minute, second, sec100);

k:=Hour; r:=k*360000;

k:=minute; Inc (r,k*6000);

k:=second; Inc(r,k*100);

Inc(r,sec100); getlongintTime:=r;

end;
procedure Delay (ms:word);

var endTime,curTime : longint;

cor:boolean;

begin

cor:=false;

endTime:=getlongintTime + ms div 10;

if endTime>8639994 then cor:=true;

repeat

curTime:=getlongintTime;

if cor=true then begin

if curTime<360000 then

Inc (curTime,8639994);

end;

until curTime>endTime;

end;
label 10,20;

begin

randomize; InitAll; InGame:=false;

start;

settextstyle (DefaultFont,HorizDir,1);

settextjustify (Lefttext,toptext);

Loadsprites;

currentBottom:=200; currentshoots:=50;

Lives:=3; score:=0; Level:=1;

shootsProbability:=5;

currentsprites:=5;

10:

DrawField;

if Level>1 then begin

str(Level-1,s);

Help ('cool, you''re complete level '+s);

end

else Help

('Let''s go! Kill them, invaders!');

repeat

if InGame then repeat

Enemiesstep;

if Enemies=0 then begin

Inc(score,100+Level*10);

if shootsProbability<100 then

Inc (shootsProbability);

if currentsprites
Inc(currentsprites);

if currentBottom
Inc(currentBottom,10);

currentshoots:=50;

Delay(1000);{Пауза перед след. уровнем}

Inc(Level);

goto 10;

end;

shootMovies;

if not InGame then begin

Help ('sorry, you''re dead');

end;

Timefunctions;

until keypressed;

ch:=readkey;

case ch of

SPACE:

if not DieMe and InGame then shoot;

#0: begin

ch:=readkey;

case ch of

F1: Help

('Sorry, there''s no help here :-)');

LEFT: if not DieMe and InGame

then GoLeft;

RIGHT: if not DieMe and InGame

then GoRight;

UP: if not DieMe and InGame

then shoot;

end;

end;

end;

until ch=ESC;

closeAll;

end.