Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Demo,Intro _ "3D models" ... 3D graph + sound

Автор: Altair 22.03.2005 13:20

Итак, вот посмотрите, что у меня получилось smile.gif

DEMO

Программа демонстрирует работу следующих систем:

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

В архиве есть описание программы, и управление (можно самому вращать любую 3D модель. )

линк для скачивания:
http://forum.pascalnet.ru/oleg_z/prog/demo.zip

обязательно высказывайтесь !!!

Автор: AlienEmperor 22.03.2005 13:36

Привет, Oleg_Z ! Чуствую, прога глобальная, вот тока не идет... smile.gif
Какие требования-то у нее ?

Пробовал на двух системах: Win98 SE2, XP Prof w/o sp
Cel 1700, Video on board 8 mb, 128 mb ram, Avance'97 sound

При загрузке - черный экран - затем вылет в винду...

Автор: Altair 22.03.2005 13:39

нет, прога довольно простая! smile.gif это основы 3d гарфики.

просто я архив выложил не тот, скачайте снова.
(в том, который я выложил, не были пути исправленны с абсолютных на относительные, поэтому файл один не находился).

иобязательно высказывайтесьsmile.gif)

Автор: volvo 22.03.2005 13:42

Oleg_Z
smile.gif Музыка хорошо подобрана smile.gif Внушает...
Вот только я не пойму, почему после нажатия на Enter у программы занимает от 3 до 5 секунд чтобы освободить ресурсы?

Автор: Altair 22.03.2005 13:48

выход из графического режима я так понимаю занимает 3-5 секунд. это у всех так. Дело в том, что используется DirectX видеорежим, так что с вопросами о тормозах DirectX видеорежимов (точнее о переключении) к Microsoft smile.gif

+ в коде в конце много деструкторов, все объекты перед выходом уничтожаются сами, а неотдаются на растерзание системе smile.gif

я код хочу выложить smile.gif

Автор: Altair 22.03.2005 13:57

Исходники.

1. сама программа (выложу ее прямо текстом) :

Исходный код

{$APPTYPE GUI}
{$mode objfpc}
{$mode delphi}
uses
sysutils,gxcrt,windows,graphix,gximeff,gxtext,gxmouse, classes,LBAss,bassfpc,
GPAHeader;
Const
MaxPixelCount = 100;
maxlinecount=100;
type
TMyThread=class(TThread)
private
x0,y0:longint;
PixelCount:Word; {количество точек в объекте}
LineCount:Word; {количество линий в объекте}
CUBE :Array[0..MaxPixelCount] of double; {массив точек}
lindex: array[0..maxLinecount] of integer; {линии проиндексированны, это
показывает как они связанны между собой (0 с 1 ...)}
xt,yt,zt:double; {промежуточные переменные для вычисления X,Y в 2D }
sx,sy,sx1,sy1:integer; {переменные для прорисовки ребер (line)}
zzoom:double;
wx,wy,wz:double;
protected
Procedure ROTATE(Xan,Yan,Zan:double);
Procedure DRAW(zoom:double; color:longint);
procedure Execute; override;
public
constructor Create( FILENAME:String; PlusX,PlusY:Longint;z:double);
end;
Procedure TMyThread.ROTATE(Xan,Yan,Zan:double);
var p:byte; {счетчикдля прохода точек}
begin
for p:=0 to PixelCount div 3 do
begin
Yt := cube[p*3+1] * COS(xan) - cube[p*3+2] * SIN(xan);
Zt := cube[p*3+1] * SIN(xan) + cube[p*3+2] * COS(xan);
cube[p*3+1] := Yt;
cube[p*3+2] := Zt;
Xt := cube[p*3] * COS(yan) - cube[p*3+2] * SIN(yan);
Zt := cube[p*3] * SIN(yan) + cube[p*3+2] * COS(yan);
cube[p*3] := Xt;
cube[p*3+2] := Zt;
Xt := cube[p*3] * COS(zan) - cube[p*3+1] * SIN(zan);
Yt := cube[p*3] * SIN(zan) + cube[p*3+1] * COS(zan);
cube[p*3] := Xt;
cube[p*3+1] := Yt;
end
end;
procedure TMyThread.draw(zoom:double; color:longint); {procedure to draw a cube}
var p:byte; {счетчикдля прохода точек}
begin
for p:=0 to LineCount div 2 do begin
sx:=round(zoom*cube[lindex[p*2]*3])+x0;
sy:=round(zoom*cube[lindex[p*2]*3+1])+y0;
sx1:=round(zoom*cube[lindex[p*2+1]*3])+x0;
sy1:=round(zoom*cube[lindex[p*2+1]*3+1])+y0;
line(SX,SY,sx1,sy1,color);
end;
end;

procedure TMyThread.Execute;
var i,j,k:byte;
begin
repeat
rotate(wx,wy,wz);
draw(zzoom,rgbcolorrgb(255,255,255));
sleep(20);
draw(zzoom,rgbcolorrgb(0,0,0));
until Terminated;
end;

constructor TMyThread.Create( FILENAME:String; PlusX,PlusY:Longint;z:double);
Var f:Text; i:longint;
Begin
Assign(f,filename); {$I-} reset(f); {$I+}
If IOResult<>0 then halt(1);
Readln(f,PixelCount);
readln(f,LineCount);
for i:=0 to pixelCount do readln(f,cube[i]);
For i:=0 to linecount do readln(f,lindex[i]);
close(f);
x0:=PlusX; y0:=PlusY;
zzoom:=z;
inherited Create(false);
end;

var
t :array[1..20] of TMyThread;
gd,gm:smallint;
caseobj,n,i:byte;
sound:TBASS;
CHsys:PFontFNT;
f:file;
kk,temp:byte;
s:array[1..5] of string;
begin
s[1]:='1.txt'; s[2]:='2.txt'; s[3]:= '3.txt';s[4]:='font2.fnt'; s[5]:='ARYX.S3M';
If GPALoadArchive('mms.gpa') = 0 then
begin
for kk:=1 to 5 do GPAExtractToFileByID(GPAGetIDByName(pchar(s[kk]), false), pchar(s[kk]));
end else halt;
randomize;
InitGraphiX(ig_col16,ig_col16);
SetModeGraphiX(1024,768,ig_col16);
bar(0,0,getmaxx,getmaxy,rgbcolorrgb(0,0,0));
InitMouse;
new(CHsys,LoadFont('font2.fnt'));
CHsys^.outtext(800,8,'Oleg_Z & MeD 2004-2005. ',rgbcolorrgb(165,123,234));
CHsys^.outtext(800,25,'Free Pascal Compiler ver. 1.0.9 ',rgbcolorrgb(255,255,255));
CHsys^.outtext(800,40,'Graphic library "GraphiX"',rgbcolorrgb(255,255,255));
CHsys^.outtext(800,55,'Sound library "BASS" ',rgbcolorrgb(255,255,255));
CHsys^.outtext(800,70,'"3DModels" .Oleg_Z',rgbcolorrgb(255,255,255));
CHsys^.outtext(800,85,'"LBASS" .MeD ',rgbcolorrgb(255,255,255));
CHsys^.outtext(800,115,'"GPA Spec" ',rgbcolorrgb(255,255,255));

sound.initbass;
sound.load_music('aryx.s3m',1,true);
sound.play_music(1);
n:=7;
For i:=1 to n-2 do t[i]:=TMyThread.Create('1.txt',random(getmaxx-400),random(getmaxy),random(30)+10);
For i:=1 to n-2 do begin
t[i].wx:=0.01*(2-random(5)); t[i].wy:=0.01*(2-random(5)); t[i].wz:=0.01*(2-random(5));
end;
t[6]:=TMyThread.Create('2.txt',getmaxx div 2,getmaxy div 2,random(30)+10);
t[6].wx:=0.01*(2-random(5)); t[6].wy:=0.01*(2-random(5));t[6].wz:=0.01*(2-random(5));

t[7]:=TMyThread.Create('3.txt',100,100,random(30)+10);
t[7].wx:=0.01*(2-random(5)); t[7].wy:=0.01*(2-random(5)); t[7].wz:=0.01*(2-random(5));
temp:=0;
repeat
If keypressed then
begin
temp:=ord(readkey);
if (temp<>27) and (temp<>13) then caseobj:=temp-48;
end;
if (caseobj<1) or (caseobj>n) then caseobj:=1;
if IsMouseInArea(getmaxx-10,0,getmaxx,getmaxy)=128 then begin t[caseobj].wy:=t[caseobj].wy+0.01; sleep(100); end;
if IsMouseInArea(0,0,10,getmaxy)=128 then begin t[caseobj].wy:=t[caseobj].wy-0.01; sleep(100); end;
If isMouseInArea(0,0,getmaxx,10)=128 then begin t[caseobj].wx:=t[caseobj].wx+0.01; sleep(100); end;
If ismouseInArea(0,getmaxy-10,getmaxx,getmaxy)=128 then begin t[caseobj].wx:=t[caseobj].wx-0.01; sleep(100); end;
If ismouseinarea(40,40,getmaxx-40,getmaxy-40)=128 then mouseoff else mouseon;
until (IsMouseInArea(0,0,getmaxx,getmaxy)>130) or (temp=13) or (temp=27);
For i:=1 to n do t[i].Terminate;
For i:=1 to n do t[i].Destroy;
sound.donebass;
for kk:=1 to 5 do begin assign(f,s[kk]); erase(f) end;
end.


LBASS Прикрепленный файл  LBass.pas ( 2.02 килобайт ) Кол-во скачиваний: 1125

GPAHeader Прикрепленный файл  GPAHeader.pas ( 2.34 килобайт ) Кол-во скачиваний: 1121


FPC, GraphiX, DirectXDist и BASS, Вы можете скачать отсюда:
http://forum.pascalnet.ru/index.php?showtopic=3958
GPASpec отсюда:
http://forum.pascalnet.ru/index.php?showtopic=4435

Автор: Dark 23.03.2005 8:05

Даа... не подумал ты о нас ;)
у меня просто моник не держит 1024*768... =(

Автор: AlienEmperor 23.03.2005 11:49

Да, ничего себе штучка... Музон классный... Тока, слышь... Лучше б ты протекстурил хотя бы одну фигуру... Текстурирование ведь это и есть самое интересное...

P.S. Ну вот, "Battle Zone" уже можно спокойно написать... smile.gif

Автор: Altair 23.03.2005 15:02

Dark, я выложу специально версию под меньшие разрешения (лень писать автодетект для демки).
AlienEmperor, работаю сейчас над текстурированием....

Автор: AlienEmperor 23.03.2005 16:25

Даешь текстурирование!

Автор: Altair 23.03.2005 16:50

Согласен, только не все так просто - это не куб, здесь может какая-то плоскость текстурируемая быть частично только видна!
То есть кроме вычисления видимостиплоскостей вообще, надо все время просчитывать границы видимости каждой плоскости.

Автор: AlienEmperor 23.03.2005 16:52

Хе-хе... В том-то и оно! Лично у меня с текстурированием (не под DX конечно - там халява...) такие проблемки возникли, что я аж на пол-года ударился на Турбо 7.1 спрайтовый движок писать... Правда, потихоньку отходить начинаю .... smile.gif

Автор: Altair 23.03.2005 17:04

А какие есть наработки?

Автор: AlienEmperor 23.03.2005 17:06

Я покопаю кой-чего... Тока это время займет... Чего найду - скину.

Автор: Altair 23.03.2005 17:17

Спасибо!

Автор: MeD 25.03.2005 0:23

Вот изминенный LBass ( теперь FGLBass ). Пока главным изминением является возможность работы с DX8 (DMO) effect.
Также изменено/добавлено/исправлено:
- Громкость.
- Загрузка музыки.
- Проигрывание музыки.
- Пауза.
- FX эффекы. ( на встроеной звуковухе помойму не работает )
- Обшее и екушие время проигрываемого файла.

Писал для себя, поэтому есле что не так и чего не хватает, то извините ))


Прикрепленные файлы
Прикрепленный файл  FGLBass.rar ( 1.54 килобайт ) Кол-во скачиваний: 894

Автор: Altair 25.03.2005 6:54

Цитата
FX эффекы. ( на встроеной звуковухе помойму не работает )

Я вчера вечером был подопытной крысой smile.gif
Или я глухой, или у меня тупая аудиокарта (AC97) но я ничего не услышал smile.gif

Автор: SHnur 26.03.2005 16:05

Классная демка =]
Нечего не скажеш ... :D

Автор: AlienEmperor 28.03.2005 12:08

Кстати, Олег! А почему бы тебе не написать прогу-бенч на 32битном компиляторе ? Потом проверили бы на разных классах машин, чтобы прикинуть скорость работы своих VESA - приложений на разных машинах...

Автор: Altair 28.03.2005 19:16

Цитата
прогу-бенч
А что это? smile.gif
Цитата
на 32битном компиляторе
я только на таких и пишу smile.gif

Автор: Дож 11.05.2005 20:44

Супеп! Вот только следы от миши на объектах остаются...

Автор: Altair 11.05.2005 23:34

ну мышу вообще бы убрать но я ее убрал только в центре экрана а по краям(еслимышь в пределах 5 пикс. от границы) оставил smile.gif
Убрать не сложно - при закрашивании фигуры надо курсор отлючить smile.gif