EvilChicken!
2009-10-15 04:35:13
program TheScriptsSnake;
type
TF = record
C, E, T: TIntegerArray;
A: Integer;
P: TPointArray;
end;
TS = record
L, D, S: Integer;
P: TPointArray;
end;
TG = record
W: TWindowState;
F: TForm;
T: TTimer;
P: Boolean;
G: TF;
S: TS;
R: Integer;
end;
var
G: TG;
procedure ScriptTerminate;
begin
GetSelf.WindowState := G.W;
end;
procedure Reset;
var
i: Integer;
begin
for i := 0 to 3 do
IsArrowDown(i);
with G do
begin
P := False;
with F.Canvas do
begin
Brush.Color := clGreen;
Rectangle(0, 0, 480, 400);
end;
with G do
begin
A := 0;
SetLength(P, A);
end;
with S do
begin
L := 5;
SetLength(P, L);
for i := 0 to High(P) do
P[i] := Point(11, 9 + i);
D := 0;
S := 250;
end;
end;
end;
procedure Update(Sender: TObject);
var
i: Integer;
Z: TPointArray;
begin
with G do
begin
if not P then
begin
P := IsArrowDown(0) or IsArrowDown(1) or IsArrowDown(2) or IsArrowDown(3);
if P then
R := 0;
end;
if P then
begin
with G do
begin
if A = 0 then
begin
A := RandomRange(0, 2) + Integer(RBoolEx(6)) + Integer(RBoolEx(12));
SetLength(T, A);
SetLength(P, A);
for i := 0 to High(T) do
begin
T[i] := Integer(RBoolEx(6)) + Integer(RBoolEx(9))+ Integer(RBoolEx(9));
P[i] := Point(RandomRange(0, 23), RandomRange(0, 19));
end;
end;
end;
with S do
begin
case D mod 2 of
0:
if IsArrowDown(1) then
D := 1
else if IsArrowDown(3) then
D := 3;
1:
if IsArrowDown(0) then
D := 0
else if IsArrowDown(2) then
D := 2;
end;
for i := 0 to 3 do
IsArrowDown(i);
P := CombineTPA([Point(P[0].X + Integer(D mod 2 = 1) * (2 - D), P[0].Y + Integer(D mod 2 = 0) * (-1 + D))], P);
SetLength(P, Length(P) - 1);
end;
for i := 0 to High(G.P) do
if (G.P[i].X = S.P[0].X) and (G.P[i].Y = S.P[0].Y) then
begin
G.P[i] := Point(-1, -1);
Dec(G.A);
SetLength(S.P, Length(S.P) + G.E[G.T[i]]);
IncEx(R, (G.T[i] + 1) * 25);
end;
Z := CombineTPA([Point(0, 0)], S.P);
InvertTPA(Z);
SetLength(Z, Length(Z) - 2);
if TPAInTPA([S.P[0]], Z) or not PointInBox(S.P[0], IntToBox(0, 0, 23, 19)) then
begin
P := False;
Reset;
end;
end;
with F.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clGreen;
Rectangle(0, 0, 480, 400);
end;
for i := 0 to High(G.P) do
with F.Canvas do
begin
Brush.Color := G.C[G.T[i]];
Ellipse(20 * G.P[i].X, 20 * G.P[i].Y, 20 * G.P[i].X + 20, 20 * G.P[i].Y + 20);
end;
for i := 0 to High(S.P) do
with F.Canvas do
begin
Brush.Color := clBlack;
Ellipse(20 * S.P[i].X, 20 * S.P[i].Y, 20 * S.P[i].X + 20, 20 * S.P[i].Y + 20);
end;
with F.Canvas do
begin
Brush.Style := bsClear;
TextOut(0, 0, 'Score: ' + IntToStr(R));
end;
end;
end;
procedure Paint(Sender: TObject);
begin
Reset;
end;
procedure Form;
begin
with G do
begin
F := CreateForm;
with F do
begin
OnPaint := @Paint;
BorderIcons := [biSystemMenu, biMinimize];
BorderStyle := bsSingle;
Caption := 'The_Scripts Snake';
Position := poScreenCenter;
Width := 485;
Height := 405;
end;
T := TTimer.Create(F);
with T do
begin
OnTimer := @Update;
Interval := 100;
Enabled := True;
end;
F.ShowModal;
end;
end;
procedure Setup;
begin
with G do
begin
W := GetSelf.WindowState;
with G do
begin
C := [clYellow, clLime, clBlue, clRed];
E := [1, 0, -1, 2];
end;
end;
end;
procedure ScriptHandler;
var
P: TVariantArray;
begin
Setup;
GetSelf.WindowState := wsMinimized;
ThreadSafeCall('Form', P);
end;
begin
ScriptHandler;
end.Haven't seen much of him, but if he makes something like that simply 'cause he's bored, he has to have at least some talent, yes?
Link to thread: http://www.villavu.com/forum/showthread.php?t=51857