Witam!
Aktualnie męczy mnie program, którego zrobienia podjąłem się 3( [!!!] ) raz... Po raz kolejny nie wyszło.
Służy on do raycastingu (patrz: ray casting), czyli renderowania 3D. Oczywiście jest to medoda niedoskonała - tym sposobem można stworzyć swego rodzaju labirynt ;-) . Gdy za pierwszym razem tworzyłem tę aplikację nie podchodziłem do tego poważnie, ostatnio zająłem się tym dla zabicia czasu, jenak za trzecim razem (czyli teraz) chcę się z tym ostatecznie rozprawić. Prosiłbym Ciebie, wejdź na Google graphic i wpisz "Wolfenstein 3D". Nie chcę tworzyć czegoś takiego (nie, nie... żadnych tekstur :-P ). Mój cel jest taki, by co pewną odległość rysować pionową kreskę, tak długą, jak odległość od punktu w którym znajduje się "kamera" do ściany patrząc pod pewnym kątem.
To program wykonany przez mojego kolegę w programie do nauki algorytmiki Scratch. Niestety, ma swoje wady - przez ograniczenia programu Scrath, obraz renderuje się bardzo wolno. Spytał się mnie, czy umiałbym coś takiego zrobić. Odpowiedziałem, że tak, no i... nie udało się [wstyd] . W każdym razie, zastosował on zasadę, że im dalej, tam bardziej zmienia się kolor. W moim kodzie tego nie ma. Jeżeli pomożecie mi rozwiązać aktualny problem, to to będę Wam niezwykle wdzięczny (kolorki dodam potem [green] ).
To wynik działania mojego programu. Występuje tu jakiś dziwny bug. W każdym razie jest źle, bo nie występuje tu efekt rybiego oka - normalnie proste ściany stają się krzywe (patrz pierwszy rysunek).
A oto mapka.
Oto kod Unit'u 1:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Math;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
procedure Przypisz;
{ Private declarations }
public
{ Public declarations }
end;
type
XYFullRec = record
X,Y:extended;
end;
var
XY: TPoint;
XYFull: XYFullRec;
Wysokosc: array[0..90] of integer;
Sciana: array[1..640,1..480]of boolean;
Form1: TForm1;
Mapa: TPicture;
const
Zasieg: integer=128;
implementation
{$R *.dfm}
procedure TForm1.Przypisz;
begin
XYFull.X:=XY.X;
XYFull.Y:=XY.y;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
I,J: integer;
begin
Form1.BorderStyle:=bssingle;
XY.X:=310;
XY.Y:=355;
Przypisz;
Form1.Top:=0;
Form1.Left:=0;
Form1.ClientHeight:=480;
Form1.ClientWidth:=640;
Mapa:=TPicture.Create;
Mapa.Bitmap.LoadFromFile('C:\delphifiles\mapa.bmp');
for I:=1 to 640 do
for J:=1 to 480 do
if Mapa.Bitmap.Canvas.Pixels[I,J]=clblack then
Sciana[I,J]:=true else Sciana[I,J]:=false;
for I:=0 to 90 do
Wysokosc[I]:=0;
//zabiezpieczenia ramki
for I:=1 to 480 do
for J:=1 to 5 do
Sciana[J,I]:=true;
for I:=1 to 480 do
for J:=635 to 640 do
Sciana[J,I]:=true;
for I:=1 to 640 do
for J:=1 to 5 do
Sciana[I,J]:=true;
for I:=1 to 640 do
for J:=475 to 480 do
Sciana[I,J]:=true;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
Lacznie: XYFullRec;
Aktualnie: integer;
Kat: integer;
I: integer;
begin
begin
Kat:=-45;
Przypisz;
for I:=0 to 90 do
begin
Lacznie.X:=0;
Lacznie.Y:=0;
aktualnie:=1;
Kat:=Kat+1;
repeat
begin
Lacznie.X:=Lacznie.X+Sin(degtorad(Kat))*aktualnie;
Lacznie.Y:=Lacznie.Y-(sqr(aktualnie)-Sin(degtorad(Kat))*aktualnie);
Aktualnie:=Aktualnie+1;
end;
until (Sciana[trunc(XYFull.X+Lacznie.X),trunc(XYFull.Y+Lacznie.Y)]=true) or ((Aktualnie-2)=Zasieg);
Wysokosc[I]:=Zasieg-(Aktualnie-2);
end;
Form1.Canvas.Pen.Width:=1;
Form1.Canvas.Pen.Color:=clgray;
Form1.Canvas.Brush.Color:=clgray;
Form1.Canvas.Rectangle(0,240,640,480);
Form1.Canvas.Pen.Color:=clred;
Form1.Canvas.Pen.Width:=5;
for I:=0 to 90 do
begin
Form1.Canvas.MoveTo(i*5,240-Wysokosc[I]);
Form1.Canvas.LineTo(i*5,240+Wysokosc[I]);
end;
Form1.Canvas.Brush.Color:=clwhite;
Form1.Canvas.Pen.Color:=Form1.Canvas.Brush.Color;
Form1.Canvas.Rectangle(450,0,640,480);
end;
end;
end.
Dodam jeszcze, że:
Form1.Color:=clblack;
Jeżeli ktoś chciałby pomóc mi na osobności, chętnie umówię się na Skypa (ewentualnie GG).
Pliki projektu do wglądu za prośbą.
Za pomoc serdecznie dziękuję. :-)
PS: Tylko nie mówcie "Są lepsze sposoby" lub "A po co w Delphi, lepiej w C++". Ja chcę zrobić to metodą raycastingu i właśnie w Delphi (też dlatego, że object pascal najlepiej znam)
