< -->
Program Facer;
{$G+}
Uses CRT;
var
S : String;
i : Byte;
{------------------}
Procedure WaitRetrace;Assembler;
asm
push dx
mov dx, 03DAh
@VRTL1:
in al, dx
test al, 8
jnz @VRTL1
@VRTL2:
in al, dx
test al, 8
jz @VRTL2
pop dx
ret
end;
{------------------}
Procedure CursorOff;Assembler;
asm
mov ah, 1
mov ch, $20
int $10
end;
{------------------}
Procedure CursorOn;Assembler;
asm
mov ah, 1
mov ch, 6
mov cl, 7
int $10
end;
{------------------}
Function InitMouse:Boolean;Assembler;
asm
mov ax, 0
int 33h
end;
Procedure ShowMouse;Assembler;
asm
mov ax, 1
int 33h
end;
Procedure HideMouse;Assembler;
asm
mov ax, 2
int 33h
end;
Function MouseButt:Word;Assembler;
asm
mov ax, 3
int 33h
mov ax, bx
end;
Function MouseX:Word;Assembler;
asm
mov ax, 3
int 33h
mov ax, cx
shr ax, 3
inc ax
end;
Function MouseY:Word;Assembler;
asm
mov ax, 3
int 33h
mov ax, dx
shr ax, 3
inc ax
end;
{---------------------}
Function MouseIn(x1, y1, x2, y2 : Word) : Boolean;
begin
MouseIn := (MouseX>=x1) and (MouseX<=x2) and (MouseY>=y1) and (MouseY<=y2);
end;
{[][][][][][][][][][][][}
Procedure SetTxPoint(X,Y,ColorTx,BkColorTx:Byte;C:Char);Assembler;
asm
push ds
mov ax, $B800
mov ds, ax
mov ah, 0
mov bh, 0
mov bl, byte ptr x
cmp bx, 80
ja @1
mov al, byte ptr y
cmp ax, 25
ja @1
dec ax
mov cl, 80
mul cl
dec bx
add bx, ax
mov cl, byte ptr ColorTx
and cl, $8F
mov dl, BkColorTx
mov al, dl
and dl, $7
shl dl, 4
and al, $80
or dl, al
or dl, cl
mov al, byte ptr C
mov ah, dl
shl bx, 1
mov ds:[bx], ax
@1:
pop ds
end;
Procedure LineTx(X1, Y1, X2, Y2 : Byte; ColorTX, BkColor : Byte; C : Char);
var
i : Integer;
dx, dy, D : Real;
begin
D := sqrt(sqr(X1-X2)+sqr(Y1-Y2));
dX := (X2-X1)/D;
dY := (Y2-Y1)/D;
for i := 0 to Round(D) do
SetTxPoint(X1 + Round(dX*i), Y1 + Round(dY*i), ColorTx, BkColor, C)
end;
Procedure FillBarTx(X1, Y1, X2, Y2, ChColor, BkChColor, FillChColor,
FillBkChColor : Byte; C, FillC : Char);
var
i, j, X, Y : Byte;
begin
if X1 360 then z := True else z := False;
if z then
begin
A := Pi/2;
Ya := Round(Y + RadY*sin(A));
Yb := Round(Y + RadY*sin(Grad*180+A));
for i := 0 to 180 do
begin
X1 := Round(X + RadX*cos(Grad*i+A));
Y1 := Round(Y + RadY*sin(Grad*i+A));
if (Y1>Yb) and (Y1-<È"}
begin
FillBarTx(27, 19, 53, 22, Yellow, Black, Yellow, Black, '°', '°');
LineTx(30, 23, 50, 23, Yellow, Black, '°');
LineTx(32, 24, 48, 24, Yellow, Black, '°');
Whiskers(0);
LineTx(33, 22, 47, 22, LightRed, Black, '±');
ArcTx(40, 22, 3, 1, 0, 361, LightRed, Black, Red, Black, '±', '°');
end;
22:{"Ó<->È"}
begin
FillBarTx(27, 19, 53, 22, Yellow, Black, Yellow, Black, '°', '°');
LineTx(30, 23, 50, 23, Yellow, Black, '°');
LineTx(32, 24, 48, 24, Yellow, Black, '°');
Whiskers(0);
LineTx(33, 22, 47, 22, LightRed, Black, '±');
ArcTx(40, 22, 2, 1, 0, 361, LightRed, Black, Red, Black, '±', '°');
end;
23:{"Ó"}
begin
FillBarTx(27, 19, 53, 22, Yellow, Black, Yellow, Black, '°', '°');
LineTx(30, 23, 50, 23, Yellow, Black, '°');
LineTx(32, 24, 48, 24, Yellow, Black, '°');
Whiskers(0);
LineTx(37, 22, 43, 22, LightRed, Black, '±');
ArcTx(40, 22, 1, 1, 0, 361, LightRed, Black, Red, Black, '±', '°');
end;
24:{ßçûê}
begin
FillBarTx(27, 19, 53, 22, Yellow, Black, Yellow, Black, '°', '°');
LineTx(30, 23, 50, 23, Yellow, Black, '°');
LineTx(32, 24, 48, 24, Yellow, Black, '°');
Whiskers(1);
ArcTx(40, 22, 8, 2, 0, 361, LightRed, Black, Red, Black, '±', '°');
LineTx(37, 22, 43, 22, LightRed, Red, '±');
LineTx(37, 22, 35, 24, LightRed, Red, '±');
LineTx(37, 24, 43, 22, LightRed, Red, '±');
LineTx(38, 23, 36, 24, LightRed, Red, '±');
LineTx(34, 22, 27, 20, LightRed, Black, '±');
LineTx(46, 22, 53, 20, LightRed, Black, '±');
end;
end;
end;
Procedure Face(_Ears, _Eyes, _Brows, _Hair, _Nose, _Roth, _Whi : Byte; z: Boolean);
begin
{Ëèöî }
if z then
ArcTx(40, 13, 30, 12, 0, 361, Yellow, Black, Yellow, Black, '±', '°');
Ears(_Ears);
Eyes(_Eyes);
Brows(_Brows);
Hair(_Hair);
Nose(_Nose);
Roth(_Roth);
Whiskers(_Whi);
end;
begin
if not InitMouse then
begin
WriteLn('Óñòðîéñòâî - ìûøü ÍÅ ÍÀÉÄÅÍÎ !!!');
Halt($FFFF);
end;
CursorOff;
ShowMouse;
TextBackGround(Black);
ClrScr;
Face(0, 0, 0, 0, 1, 10, 2, True);
Randomize;
Face(0, 1, 0, 0, 1, 10, 0, True);
While (not KeyPressed) and (MouseButt <> 2) do
begin
i:=Random(6);
WaitRetrace;
Eyes(i);
i := Round(Random(2));
WaitRetrace;
Nose(i);
i := Random(3);
WaitRetrace;
Whiskers(i);
i := Random(25);
WaitRetrace;
Roth(i);
Delay(1000);
end;
While Keypressed do ReadKey;
While MouseButt=2 do;
While (MouseButt <> 2) and (not KeyPressed) do
begin
if MouseButt = 1 then
begin
if MouseIn(1, 1, 1, 1) then Exit;
if MouseIn(23, 9, 33, 11) then
begin
Eyes(5);
Roth(16);
Delay(2000);
Roth(22);
Eyes(0);
end;
if MouseIn(47, 9, 57, 11) then
begin
Eyes(4);
Roth(17);
Delay(3000);
Roth(21);
Eyes(1);
end;
if MouseIn(37, 12, 43, 14) then
begin
Eyes(3);
end;
if MouseIn(35, 15, 45, 17) then
begin
Eyes(2);
Nose(1);
end;
if MouseIn(38, 9, 42, 10) then
begin
Eyes(1);
end;
if MouseIn(14, 13, 26, 17) then
begin
Eyes(0);
Nose(0);
Roth(0);
end;
if MouseIn(54, 13, 65, 17) then
begin
Roth(10);
Eyes(0);
Nose(1);
end;
if MouseIn(29, 18, 51, 19) then Roth(15);
if MouseIn(32, 25, 48, 25) then Roth(24);
if Random < 0.0001 then
begin
Eyes(5);
Eyes(4);
Roth(19);
Delay(2000);
Roth(20);
Eyes(2);
end;
{ GotoXy(1, 1);
Write(' ', MouseX, ' ');
GotoXy(1, 2);
Write(' ', MouseY, ' ');
GotoXy(1, 3);
Write(' ', Random, ' ');}
end;
end;
Eyes(0);
HideMouse;
CursorOn;
end.
Íàçàä