Партнерка на США и Канаду по недвижимости, выплаты в крипто

30% recurring commission
Выплаты в USDT
Вывод каждую неделю
Комиссия до 5 лет за каждого referral

unit Mouse;

{Примеры использования –

см. mousetst. pas в графике,

mousetxt. pas в текстовом режиме 80*25}

interface

var MousePresent:boolean;

function MouseInit(var nb:integer):boolean;

{ Инициализация мыши - вызывать первой.

Вернет true, если мышь обнаружена }

procedure Mouseshow; {Показать курсор мыши}

procedure MouseHide; {Скрыть курсор мыши}

procedure Mouseread(var x, y,bMask:integer);

{Прочитать позицию мыши.

Вернет через x, y координаты курсора

(для текстового режима см. пример),

через bmask - состояние кнопок

(0-отпущены,1-нажата левая,2-нажата правая,

3-нажаты обе) }

procedure MousesetPos(x, y:word);

{Поставить курсор в указанную позицию}

procedure Mouseminxmaxx(minx, maxx:integer);

{Установить границы перемещения по x}

procedure Mouseminymaxy(miny, maxy:integer);

{Установить границы перемещения по y}

procedure setVideoPage(Page:integer);

{Установить нужную видеостраницу}

procedure GetVideoPage(var Page:integer);

{Получить номер видеостраницы}

function MouseGetb(bMask:word; var count,

Lastx, Lasty:word):word;

procedure MousekeyPreset

(var key, sost, x,y:integer);

implementation

uses Dos;

var r: registers;

Mi:pointer;

function MouseInit(var nb:integer):boolean;

begin

if MousePresent then begin

r. Ax:=0; Intr($33,r);

if r. Ax=0 then begin

nb:=0; MouseInit:=false

end

else begin

nb:=r. Ax; MouseInit:=true

end

else begin

nb:=0; MouseInit:=false

end

end;

procedure Mouseshow;

begin

r. Ax:=1; Intr($33,r)

end;

procedure MouseHide;

НЕ нашли? Не то? Что вы ищете?

begin

r. Ax:=2; Intr($33,r)

end;

procedure Mouseread(var x, y,bMask:integer);

begin

r. Ax:=3; Intr($33,r);

x:=r. cx; y:=r. dx; bMask:=r. Bx

end;

procedure MousesetPos(x, y:word);

begin

r. Ax:=4; r. cx:=x; r. dx:=y;

Intr($33,r)

end;

function MouseGetb(bMask:word;

var count, Lastx, Lasty:word):word;

begin

r. Ax:=5; r. Bx:=bMask;Intr($33,r);

count:=r. Bx; Lastx:=r. cx;

Lasty:=r. dx; MouseGetb:=r. Ax

end;

procedure Mouseminxmaxx(minx, maxx:integer);

begin

r. Ax:=7; r. cx:=minx;

r. dx:=maxx; Intr($33,r)

end;

procedure Mouseminymaxy(miny, maxy:integer);

begin

r. Ax:=8; r. cx:=miny;

r. dx:=maxy; Intr($33,r)

end;

procedure setVideoPage(Page:integer);

begin

r. Ax:=$1D; r. Bx:=Page; Intr($33,r)

end;

procedure GetVideoPage(var Page:integer);

begin

r. Ax:=$1E; Intr($33,r); Page:=r. Bx;

end;

procedure MousekeyPreset

(var key, sost, x,y:integer);

begin

r. Ax:=$6; r. Bx:=key; Intr($33,r);

key:=r. Ax; sost:=r. Bx;

x:=r. cx; y:=r. dx;

end;

begin

GetIntVec($33,Mi);

if Mi=nil then

MousePresent:=false

else if byte(Mi^)=$cE then

MousePresent:=false

else MousePresent:=true

end.

11.2. Тест модуля mouse. pas в графическом режиме (mousetst. pas).

program MouseTst;

uses graph, Mouse, crt;

var grDriver : integer; grMode : integer;

Errcode : integer;

procedure init;

begin

grDriver:=VGA;grMode:=VGAHi;

initgraph(grDriver, grMode, '');

Errcode:=graphresult;

if Errcode <> grOk then begin

writeln('Ошибка инициализации графики:',

grapherrormsg(Errcode)); halt;

end;

var n, x,y, x0,y0,b:integer; s1,s2:string;

begin

init;

mouseinit(n);

mouseshow;

setfillstyle (solidfill, BLACK);

setcolor (WHITE);

settextJustify(centertext, centertext);

x0:=-1; y0:=-1;

repeat

mouseread (x, y,b);

if (x<>x0) or (y<>y0) then begin

str (x, s1); str (y, s2);

bar (getmaxx div 2-50,

getmaxy-15,getmaxx div 2+50,getmaxy-5);

outtextxy (getmaxx div 2,

getmaxy-10,s1+' '+s2);

x0:=x; y0:=y;

end;

until keypressed;

mousehide;

closegraph;

end.

11.3. Тест модуля mouse. pas в текстовом режиме (mousetxt. pas).

program MouseTxt;

uses crt, mouse;

var n, x,y, b:integer;

n1,k, lastx, lasty:word;

begin

textmode(3);

mouseinit (n);

mouseshow;

repeat

mouseread (x, y,b);

gotoxy (1,25);

write ('x=',(x div 8 + 1):2,

' y=',(y div 8 + 1):2,' b=',b:2);

until keypressed;

mousehide;

end.

12.1. Учебная игра, использующая собственный файл ресурсов. Первый листинг содержит утилиту для создания файла ресурсов resfile из файлов *.bmp текущей директории, список которых находится в файле filelist. txt. Файлы *.bmp должны быть сохранены в режиме 16 цветов. При необходимости следует изменить в программе константу пути к Паскалю.

uses graph, crt;

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

FileList='filelist. txt';

resfile='attack. res';

const width=32; height=20;

const color: array [0..15] of byte=

(0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15);

const maxx=639; maxy=479;

cx=MAxx div 2; cy=maxy div 2;

type bmpinfo=record

h1,h2:char;

size, reserved, offset, b,width,

height: longint;

plans, bpp:word;

end;

var Driver, Mode: integer;

DriverF: file; List, res:text;

DriverP: pointer; s:string;

procedure Wait;

var ch:char;

begin

reset (Input); repeat until keyPressed;

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

end;

procedure closeMe;

begin

if DriverP <> nil then begin

FreeMem(DriverP, Filesize(DriverF));

close (DriverF);

end;

closegraph;

end;

procedure graphError;

begin

closeMe;

writeln('graphics error:',

grapherrormsg(graphresult));

writeln('Press any key to halt ');

Wait;

halt (graphresult);

end;

procedure InitMe;

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;

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 Error (code:integer; str:string);

begin

Window (cx-140,cy-100,cx+140,

cy-70,Black, YELLOW);

case code of

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

2: s:='Файл '+str+' не формата BMP-16';

3: s:='Файл '+str+' испорчен!';

end;

settextjustify (Lefttext, toptext);

settextstyle(DefaultFont, HorizDir, 1);

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

Wait;

halt(code);

end;

function Draw (x0,y0:integer; fname:string;

transparent:boolean):integer;

var f:file of bmpinfo;

bmpf:file of byte;

res:integer; info:bmpinfo;

x, y:integer; b, bh, bl:byte;

nb, np:integer; tpcolor:byte;

i, j:integer;

begin

assign(f, fname);

{$I-} reset (f); {$I+}

res:=IoResult;

if res <> 0 then Error (1,fname);

read (f, info);

close (f);

if info. bpp<>4 then Error(2,fname);

x:=x0;

y:=y0+info. height;

nb:=(info. width div 8)*4;

if (info. width mod 8) <> 0 then nb:=nb+4;

assign (bmpf, fname);

reset (bmpf);

seek (bmpf, info. offset);

if transparent then begin

read (bmpf, b);

tpcolor:=b shr 4;

seek (bmpf, info. offset);

end

else tpcolor:=17;

for i:=1 to info. height do begin

np:=0;

for j:=1 to nb do begin

read (bmpf, b);

if np<info. width then begin

bh:=b shr 4;

if bh <> tpcolor then

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

inc (x);

inc(np);

end;

if np<info. width then begin

bl:=b and 15;

if bl <> tpcolor then

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

inc(x);

inc(np);

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;

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;

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;

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;

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;

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<currentBottom-height then

Inc(y, height)

else y:=10;

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;

dx:=x; dy:=y;

end;

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

begin

if (x>a) and (x<b) then Between:=true

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;

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;

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)<shootsProbability) then

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

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;

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;

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<maxsprites then

Inc(currentsprites);

if currentBottom<maxy-10-4*height then

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;

until ch=ESC;

closeAll;

end.

Приложение 5. Расширенные коды клавиатуры

Нажатие клавиши преобразуется в двухбайтовый код, называемый скан-ASCII-кодом. Этот код помещается в буфер клавиатуры, откуда ваша программа может считать его с помощью прерывания системы BIOS. Старший байт двухбайтового кода называется скан-кодом и является отображением фактически нажатой клавиши. Скан-код не отражает состояние клавиш Shift, Ctrl или Alt и не является уникальным. Помимо скан-кодов нажатия, существуют коды отпускания клавиш, отличающиеся на шестнадцатеричное значение 80 в сторону увеличения. Младший байт полного кода, называемый ASCII-кодом, также не является уникальным, но полная комбинация скан и ASCII-кода уникальна. Некоторые клавиши не имеют ASCII-кода и вместо него возвращается ноль. Такие двухбайтовые коды называются расширенными. При приеме кода нажатой клавиши через DOS последняя отделяет от общего значения скан-код. Кроме того, работающий в системе русификатор может дополнительно транслировать скан-коды буквенных клавиш в ASCII-коды русских букв.

Исходя из сказанного, при использовании стандартной функции readkey, работающей с ASCII-кодами клавиш, в общем случае является правильной следующая схема обработки на Паскале:

ch := readkey; {Чтение символа в байт ch}

if ch = #0 then begin

{Если нет ASCII-кода, прочитать

дополнительно расширенный код}

ch := readkey;

{Обработка расширенного кода}

end

else

{Обработка ASCII-кода}

На Паскале десятичный код может быть записан в виде #N, где N -- число, например, #65 ('A' латинская). ASCII-коды основных печатных символов можно узнать из Приложения 1, остальные нужные коды приводятся в табл. П5, П6.

Таблица П5. ASCII-коды некоторых клавиш

Enter	13	Пробел	32
Esc	27	BackSpace	8
Tab	9

Таблица П6. Расширенные коды некоторых клавиш

Клавиша	Код	Код с Shift	Код с Ctrl	Код с Alt
F1	59	84	94	104
F2	60	85	95	105
F3	61	86	96	106
F4	62	87	97	107
F5	63	88	98	108
F6	64	89	99	109
F7	65	90	100	110
F8	66	91	101	111
F9	67	92	102	112
F10	68	93	103	113
Стрелка вверх	72
Стрелка вниз	80
Стрелка влево	75
Стрелка вправо	77
Insert	82
Delete	83
Home	71		119
End	79		117
Page Up	73		132
Page Down	81		118

Приложение 6. Правила хорошего кода

Написание красивого и эффективного программного кода -- целое искусство, во многом, увы, подзабытое в связи со взрывным ростом мощности вычислительных устройств, вызвавшим снижение требований к качеству алгоритмов. Это небольшое приложение не может заменить изучения специализированных дисциплин вроде "Технологии программирования" или "Теории алгоритмов и формальных языков", но следование изложенным здесь принципам позволит начинающему программисту привыкать не просто "решать задачи", а делать это возможно более красивым и экономичным с точки зрения вычислительных затрат способом.

1. Структурируйте и выравнивайте код, по крайней мере, так, как сказано в гл. 5. Во всем пособии я тоже форматировал листинги в привычном для себя стиле. Лучше привыкнуть структурировать текст, сдвигая любые вложения и разветвления кода одним-двумя пробелами вправо. Программа при этом не "разъедется" далеко вправо на сложных блоках, а вид текста, открытого в любом редакторе, не будет зависеть от размера отступа табуляции.

2. Давайте переменным осмысленные имена. Переменная с именем Length, или, в крайнем случае, Dlina, сама напомнит о своем назначении, в отличие от L. С другой стороны, не возбраняется использовать стандартные сокращения -- например, S для площади, P для периметра, a, b и c -- для сторон треугольника. Любые индексы естественно выглядят с именами i, j, k и т. д. Но если индекс обозначает номер месяца в году, куда естественней назвать его month, чем i. Хотя Паскаль и не различает регистр букв в именах переменных и служебных словах -- соблюдайте его везде. Большинство профессиональных языков регистр символов различают.

3. Существует множество соглашений об именах переменных -- можно спорить об их достоинствах и недостатках, но бесспорно одно -- соблюдение единообразного стиля именования намного облегчает понимание и модификацию программы. В сложных проектах осмысленных имен переменных может оказаться недостаточно, тогда на помощь придут префиксы. Так, если все имена всех переменных, относящихся к таблице "Студенты", начинаются на st_, а все динамические указатели имеют в имени префикс ptr_ (от англ. "pointer" -- указатель), читать такую программу будет намного проще.

4. Создавая любую переменную, обратите внимание на следующие моменты:

· какой тип значений может принимать переменная, нельзя ли заменить ее перечислением, множеством или иным "сокращенным" типом данных?

· есть ли ограничения на допустимые значения, если да, где и как они будут учтены?

· что произойдет при переполнении значения или попытке дать переменной недопустимое значение?

5. Закрывайте блоки сразу. Такой блок, как

if условие then begin

end

else begin

end;

или

while условие do begin

end;

пишется сразу, а только потом ветвь алгоритма или тело цикла наполняются содержимым. Это поможет не запутаться в сложном коде и облегчит соблюдение следующего принципа.

6. Не оставляйте неработающее приложение "на завтра". Блочно-модульная структура программы позволяет всегда избежать этого. Подпрограмма может быть пустой "заглушкой", вы можете использовать ничего не делающие условия, пустые блоки, комментарии, но текущий код должен компилироваться, если завтра вы не хотите половину рабочего дня затратить на восстановление в памяти недоделанного сегодня.

7. Доводите программу до отсутствия предупреждений компилятора, а не только ошибок. Неизвестно, как скажутся на самом деле эти "невинные" напоминания. В языке Си конструкция вида if a:=0 допустима и вызовет лишь предупреждение "Possibly incorrect assignment" -- хотя в результате переменная a всегда будет получать значение 0 и ветвь алгоритма, привязанная к этому условию, будет всегда выполняться.

8. Выбирайте более короткие типы данных там, где это уместно: часто byte может заменить word или integer, а string[20] -- просто string.

9. Применяйте возможно более эффективный алгоритм решения -- прежде всего, оценка эффективности связана с зависимостью числа выполняемых операций от размерности данных. Двойной цикл полной обработки всех элементов матрицы прост в изучении, но далеко не всегда является лучшим решением при работе с реальной задачей -- ведь трудоемкость этого алгоритма равна n2, где n -- размерность матрицы.

10. Выбирайте менее трудоемкие операции. Так, n div k лучше, чем Trunc(n/k), а Inc(i); лучше, чем i:=i+1;. Во всех случаях порядковые операторы и операнды работают быстрее, чем вещественные. Поэтому обходитесь порядковыми данными везде, где это возможно. Особенно избегайте без необходимости деления на вещественные числа.

11. Не забывайте о погрешностях при работе с вещественными числами. Хрестоматийное while x<=2.5 doплохо, если x -- вещественный. С другой стороны, while abs(x-2.5)<eps выглядит громоздко и требует лишних вычислений. Лучше всего while x<=2.5+eps, оптимизирующий компилятор все равно преобразует 2.5+eps в константу.

12. Используйте стандартные функции языка, на котором пишете. Мнимая экономия ресурсов, достигнутая написанием собственных подпрограмм нижнего уровня, обернется трудноуловимыми ошибками в больших проектах. После пяти-десяти лет практики это становится ясно каждому программисту, хотя эксперименты с собственными интерфейсами и машинно-ориентированными программами бывают интересны и даже полезны на этапе обучения.

13. Следите за условиями. Если вы проверяете одно и то же условие неоднократно -- скорей всего, у вашей программы не в порядке с логикой. Пример из п. 7.7 показывает это наглядно.

14. Не забывайте о взаимоисключающих условиях. Составной условный оператор if ... else if или же case в таких случаях намного лучше набора коротких условных операторов.

15. Зачастую при написании длинных фрагментов кода удобнее обрабатывать ошибки в виде

if ошибка then завершение;

обработка;

чем по схеме

if верно then обработка

else завершение;

Вообще, избегайте else, находящихся строк через 100 после своего if -- это затрудняет восприятие даже хорошо структурированной программы.

16. Избегайте в циклах вычислений, не зависящих от их параметров! Выражение вроде sin(Pi/n), помещенное в цикл, где n не меняется, выглядит нелепо. Ведь каждое вычисление синуса (как и других стандартных функций) -- это трудоемкое разложение в ряд Фурье, выполняемое машиной.

17. Используйте математику там, где это уместно для сокращения трудоемкости кода и числа сравнений. Проверить, что переменные x и y имеют один знак, можно так:

if (x>0) and (y>0) or (x<0) and (y<0) then...,

а можно и в виде if (x*y>0) then....

18. Прекращайте циклы, когда результат уже достигнут. Приоритет средств при этом следующий:

· использование циклов repeat-until или while-do вместо for;

· операторы break или exit;

· в последнюю очередь -- goto, и только в случаях, описанных в п. 16.2.

19. Временный "рабочий" массив того же порядка, что создаваемый или прочитанный из файла -- почти всегда не лучшее решение. Его использование говорит о том, что задача решается "в лоб" и не оптимальным способом. Допустимым считается использование одномерного рабочего массива при обработке матричных данных -- если размерность его не превышает большей из размерностей матрицы.

20. Именуйте размерные константы массивов. Никому не нужны несколько циклов с верхними границами-"близнецами". А что, если размерность обрабатываемых данных придется изменить?

21. Передавайте значения подпрограммам преимущественно по адресу, а не по значению. Для матричных и векторных данных старайтесь делать это всегда. Применение векторных данных имеет приоритет перед матричными.

22. Не делайте подпрограммы зависимыми от глобальных данных. Несоблюдение этого правила существенно уменьшит вероятность повторного использования кода вами или другим разработчиком.

23. Не пишите подпрограмм, возвращающих более одного объекта -- скаляра, вектора или матрицы. В крайнем случае, можно отдельным параметром передавать или возвращать размерность векторных данных. Избегайте подпрограмм, которые ничего не возвращают. Разработка сложных подпрограмм облегчается, если их "точка выхода" и возвращаемое значение указаны единственным и последним оператором. Для перехода из тела подпрограммы в точку возврата в этом случае не грешно использовать даже goto:

function Test (a, b:integer):integer;

label end_of_Test;

var error:integer;

begin

error:=0;

if (a<0) or (b<0) then begin

error:=1;

goto end_of_Test;

end;

. . .

end_of_Test:

Test:=error;

end;

24. Нужно приучить себя не только правильно называть переменные и функции, но и выделять все логические части задачи при проектировании иерархии подпрограмм. Например, если функция ищет в наборе данных элемент по какому-то признаку и создает новый в том случае, когда искомый элемент обнаружен, то лучше разделить ее на две -- функцию поиска и функцию создания нового узла, которая будет вызываться из первой. Достаточно придерживаться подобных незамысловатых приемов, чтобы повысить сопровождаемость приложения в разы. Если посмотреть на вопрос с другой стороны, не заставляйте одну подпрограмму выполнять несколько функций -- она окажется бесполезна с точки зрения повторного использования кода. Так, определение длины ломаной линии можно реализовать одной подпрограммой, но гораздо лучше, если задача разбита на подпрограммы вычисления длины и вычисления расстояния между двумя точками.

25. При работе с динамическими объектами пишите код так, чтобы открытые объекты всегда закрывались, как только они станут не нужны. В идеале порядок закрытия объектов должен быть обратным по отношению к порядку открытия (последний занявший память объект освобождает ее первым). Следует также избегать функций перераспределения ранее выделенной динамической памяти.

26. Проверить логику своей программы легче всего по принципу "Одна правка -- одно место в программе". Если при добавлении в меню нового пункта или, еще хуже, простом изменении размерности одномерного массива приходится переписывать несколько удаленных друг от друга фрагментов кода -- программа написана плохо.

27. Если написанная вами программа не работает или работает "криво", ошибка лежит на вашей совести, а компьютер с компилятором ни в чем не виноваты. "Отладка", при которой программист хаотически меняет то одно, то другое место в коде и на которую уходит до 90% времени написания, на самом деле -- свидетельство не слишком качественной работы. Хорошо написанной программе нужна не столько отладка, сколько тестирование на различных допустимых, недопустимых и "пограничных" наборах данных. Кстати, обдумывание и написание тестов до тестируемого кода способствует и улучшению, и большей устойчивости конечного продукта.

Резюмируя, можно сказать, что все большие программы на свете написаны только за счет одного -- правильного структурирования кода. И хороший программист -- не тот, кто "знает языки", а тот, кто умеет писать легко читаемый, понимаемый и модифицируемый код, максимально используя стандартные средства языка разработки.

Оглавление (стр. 11 )

Партнерка на США и Канаду по недвижимости, выплаты в крипто

Приложение 5. Расширенные коды клавиатуры

Приложение 6. Правила хорошего кода

Рекомендуемая литература

Домашний очаг

Справочная информация

Техника

Общество

Образование и наука

Мир

Бизнес и финансы