forum.boolean.name
Страница 1 из 2 1 2 >
Показывать 64 сообщений этой темы на одной странице

forum.boolean.name (http://forum.boolean.name/index.php)
-   Основной форум (http://forum.boolean.name/forumdisplay.php?f=49)
-   -   Моя первая прога :) (http://forum.boolean.name/showthread.php?t=422)

pax 13.12.2005 09:47
Вот накатал:
Код:
program MY_3D;
const
 numpoints=8;
 numlines=12;

var
 points:array[1..numpoints,1..5] of integer;
 lines:array[1..numlines,1..2] of integer;
 distance : integer;
 rx, ry, rz  : real;
  cx, cy  : integer;
 
Procedure RotatePoint(i:integer);
var
  ox,tx,ty,tz, x, y, z: real;
  nx,ny    : integer;
 
begin
 x:=points[i,1];
 y:=points[i,2];
 z:=points[i,3];
 //X rotation
 ty := y * Cos(rx) - z * Sin(rx);
 tz := y * Sin(rx) + z * Cos(rx);
 //Y rotation
 tx := x * Cos(ry) - tz * Sin(ry);
 tz := x * Sin(ry) + tz * Cos(ry);
 //Z rotation
 ox := tx;
 tx := tx * Cos(rz) - ty * Sin(rz);
 ty := ox * Sin(rz) + ty * Cos(rz);
 //Calculate new x and y location with perspective
 nx := Trunc(512 * (tx) / (distance - (tz)))+cx;
 ny := Trunc((512 * ty) / (distance - (tz)))+cy;
 points[i,4] := nx;
 points[i,5] := ny;
end; 

Procedure Rotate3D;
var
  i: integer;
begin
        for i:=1 to numlines do
 begin
        RotatePoint(lines[i,1]);
        RotatePoint(lines[i,2]);
 end;
end;

Procedure Draw3D;
var
  i: integer;
begin
        for i:=1 to numlines do
 begin
        DrawLine(points[lines[i,1],4], points[lines[i,1],5], points[lines[i,2],4], points[lines[i,2],5]);
 end;
end;

begin
        distance:=100;
        cx:=GetWidth/2;
        cy:=GetHeight/2;
       
 points[1,1]:=5;
 points[1,2]:=-5;
 points[1,3]:=-5;
 
 points[2,1]:=5;
 points[2,2]:=-5;
 points[2,3]:=5;

 points[3,1]:=5;
 points[3,2]:=5;
 points[3,3]:=5;
 
 points[4,1]:=5;
 points[4,2]:=5;
 points[4,3]:=-5;
 
 points[5,1]:=-5;
 points[5,2]:=-5;
 points[5,3]:=-5;
 
 points[6,1]:=-5;
 points[6,2]:=-5;
 points[6,3]:=5;

 points[7,1]:=-5;
 points[7,2]:=5;
 points[7,3]:=5;
 
 points[8,1]:=-5;
 points[8,2]:=5;
 points[8,3]:=-5;
 
 lines[1,1]:=1;
 lines[1,2]:=2;
 
 lines[2,1]:=2;
 lines[2,2]:=3;
 
 lines[3,1]:=3;
 lines[3,2]:=4;
 
 lines[4,1]:=4;
 lines[4,2]:=1;
 
 lines[5,1]:=2;
 lines[5,2]:=6;
 
 lines[6,1]:=3;
 lines[6,2]:=7;
 
 lines[7,1]:=4;
 lines[7,2]:=8;
 
 lines[8,1]:=1;
 lines[8,2]:=5;
 
 lines[9,1]:=5;
 lines[9,2]:=6;
 
 lines[10,1]:=6;
 lines[10,2]:=7;
 
 lines[11,1]:=7;
 lines[11,2]:=8;
 
 lines[12,1]:=8;
 lines[12,2]:=5;

 while true do
  begin
 SetColor(255, 255, 255);
  FillRect(0, 0, GetWidth, GetHeight);
        rx:=rx+ToRadians(1);
        ry:=2*rx;
        rz:=3*rx;
        Rotate3D;
 SetColor(255, 0, 0);
        Draw3D;
        Repaint;
        delay(33);
       
        if GetKeyPressed = KE_KEY1 then distance:=distance-10;
        if GetKeyPressed = KE_KEY3 then distance:=distance+10;
        if GetKeyPressed = KE_KEY2 then cy:=cy-2;
        if GetKeyPressed = KE_KEY4 then cx:=cx-2;
        if GetKeyPressed = KE_KEY6 then cx:=cx+2;
        if GetKeyPressed = KE_KEY8 then cy:=cy+2;
  end;


end.
На моем samsung x100 идет со скоростью примерно 2..3 кадра в секунду (я считаю что это не плохо т.к. за один кадр рассчитывается аш 96 синусов или косинусов, не считая простых вычислений).

8)

pax 13.12.2005 10:06
чет я накосячил :@
Код:
Procedure Rotate3D;
var
  i: integer;
begin
        for i:=1 to numpoints do
 begin
        RotatePoint(i);
 end;
end;
Замените эту функцию в проге... так у меня работает приблинительно со скоростью 4-6 кадров в секунду... :)

pax 13.12.2005 10:38
вот вся прога со счетчиком фпс... показывает 3-4... на глаз казалось больше :)

Код:
program MY_3D;
const
 numpoints=8;
 numlines=12;

var
 points        :array[1..numpoints,1..5] of integer;
 lines :array[1..numlines,1..2] of integer;
 distance            : integer;
 FPS_LastCount,FPS_Count,MS,MSL:integer;
 rx, ry, rz    : real;
  cx, cy      : integer;
  time: integer;

Procedure RotatePoint(i:integer);
var
  ox,tx,ty,tz, x, y, z: real;
  nx,ny    : integer;
 
begin
 x:=points[i,1];
 y:=points[i,2];
 z:=points[i,3];
 //X rotation
 ty := y * Cos(rx) - z * Sin(rx);
 tz := y * Sin(rx) + z * Cos(rx);
 //Y rotation
 tx := x * Cos(ry) - tz * Sin(ry);
 tz := x * Sin(ry) + tz * Cos(ry);
 //Z rotation
 ox := tx;
 tx := tx * Cos(rz) - ty * Sin(rz);
 ty := ox * Sin(rz) + ty * Cos(rz);
 //Calculate new x and y location with perspective
 nx := Trunc(512 * (tx) / (distance - (tz)))+cx;
 ny := Trunc((512 * ty) / (distance - (tz)))+cy;
 points[i,4] := nx;
 points[i,5] := ny;
end; 

Procedure Rotate3D;
var
  i: integer;
begin
        for i:=1 to numpoints do
 begin
        RotatePoint(i);
 end;
end;

Procedure Draw3D;
var
  i: integer;
begin
        for i:=1 to numlines do
 begin
        DrawLine(points[lines[i,1],4], points[lines[i,1],5], points[lines[i,2],4], points[lines[i,2],5]);
 end;
end;

begin
        distance:=100;
        cx:=GetWidth/2;
        cy:=GetHeight/2;
       
 points[1,1]:=5;
 points[1,2]:=-5;
 points[1,3]:=-5;
 
 points[2,1]:=5;
 points[2,2]:=-5;
 points[2,3]:=5;

 points[3,1]:=5;
 points[3,2]:=5;
 points[3,3]:=5;
 
 points[4,1]:=5;
 points[4,2]:=5;
 points[4,3]:=-5;
 
 points[5,1]:=-5;
 points[5,2]:=-5;
 points[5,3]:=-5;
 
 points[6,1]:=-5;
 points[6,2]:=-5;
 points[6,3]:=5;

 points[7,1]:=-5;
 points[7,2]:=5;
 points[7,3]:=5;
 
 points[8,1]:=-5;
 points[8,2]:=5;
 points[8,3]:=-5;
 
 lines[1,1]:=1;
 lines[1,2]:=2;
 
 lines[2,1]:=2;
 lines[2,2]:=3;
 
 lines[3,1]:=3;
 lines[3,2]:=4;
 
 lines[4,1]:=4;
 lines[4,2]:=1;
 
 lines[5,1]:=2;
 lines[5,2]:=6;
 
 lines[6,1]:=3;
 lines[6,2]:=7;
 
 lines[7,1]:=4;
 lines[7,2]:=8;
 
 lines[8,1]:=1;
 lines[8,2]:=5;
 
 lines[9,1]:=5;
 lines[9,2]:=6;
 
 lines[10,1]:=6;
 lines[10,2]:=7;
 
 lines[11,1]:=7;
 lines[11,2]:=8;
 
 lines[12,1]:=8;
 lines[12,2]:=5;

 while true do
  begin
 SetColor(255, 255, 255);
  FillRect(0, 0, GetWidth, GetHeight);
        rx:=rx+ToRadians(1);
        ry:=2*rx;
        rz:=3*rx;
        Rotate3D;
 SetColor(255, 0, 0);
        Draw3D;
 
 time := GetCurrentTime;
 MS:=GetSecond(time);
 If MS<>MSL Then
  begin
        FPS_LastCount:=FPS_Count;
        FPS_Count:=0;
        MSL:=MS;
  end       
 Else
        FPS_Count:=FPS_Count+1;
       
        DrawText('FPS:'+IntegerToString(FPS_LastCount), 0, 0);
        Repaint;
       
        if GetKeyPressed = KE_KEY1 then distance:=distance-10;
        if GetKeyPressed = KE_KEY3 then distance:=distance+10;
        if GetKeyPressed = KE_KEY2 then cy:=cy-2;
        if GetKeyPressed = KE_KEY4 then cx:=cx-2;
        if GetKeyPressed = KE_KEY6 then cx:=cx+2;
        if GetKeyPressed = KE_KEY8 then cy:=cy+2;
  end;
end.

pax 13.12.2005 12:21
Вложений: 1
Несколько опытов по ускорению (теперь 4-5 кадров/сек):
Код:
program MY_3D;
const
* numpoints=8;
* numlines=12;

var
* points        :array[1..numpoints,1..5] of integer;
* lines* :array[1..numlines, 1..2] of integer;

* distance,i* * * * * : integer;
* FPS_LastCount,FPS_Count,MS,MSL: integer;
* * cx, cy* * * * * * : integer;

* rx, ry, rz* * * * : real;
* * Srx,Crx,Sry,Cry,Srz,Crz* : real;
* * ox,tx,ty,tz* * * * : real;
* *
Procedure Rotate3D;
begin
* Srx:=Sin(rx);        Crx:=Cos(rx);
* Sry:=Sin(ry);        Cry:=Cos(ry);
* Srz:=Sin(rz);        Crz:=Cos(rz);
        for i:=1 to numpoints do
* begin
* //X rotation
* ty := points[i,2] * Crx - points[i,3] * Srx;
* tz := points[i,2] * Srx + points[i,3] * Crx;
* //Y rotation
* tx := points[i,1] * Cry - tz * Sry;
* tz := points[i,1] * Sry + tz * Cry;
* //Z rotation
* ox := tx;
* tx := tx * Crz - ty * Srz;
* ty := ox * Srz + ty * Crz;
* //Calculate new x and y location with perspective
* points[i,4] := Trunc(512 * tx / (distance - tz))+cx; //x
* points[i,5] := Trunc(512 * ty / (distance - tz))+cy; //y
* end;
end;

begin
        distance:=100;
        cx:=GetWidth/2;
        cy:=GetHeight/2;
       
* points[1,1]:=5;        points[1,2]:=-5;        points[1,3]:=-5;
*
* points[2,1]:=5;        points[2,2]:=-5;        points[2,3]:=5;

* points[3,1]:=5;        points[3,2]:=5;        points[3,3]:=5;
*
* points[4,1]:=5;        points[4,2]:=5;        points[4,3]:=-5;
*
* points[5,1]:=-5;        points[5,2]:=-5;        points[5,3]:=-5;
*
* points[6,1]:=-5;        points[6,2]:=-5;        points[6,3]:=5;

* points[7,1]:=-5;        points[7,2]:=5;        points[7,3]:=5;
*
* points[8,1]:=-5;        points[8,2]:=5;        points[8,3]:=-5;
*
* lines[1,1]:=1;        lines[1,2]:=2;
*
* lines[2,1]:=2;        lines[2,2]:=3;
* *
* lines[3,1]:=3;        lines[3,2]:=4;
* *
* lines[4,1]:=4;        lines[4,2]:=1;
* *
* lines[5,1]:=2;        lines[5,2]:=6;
* *
* lines[6,1]:=3;        lines[6,2]:=7;
* *
* lines[7,1]:=4;        lines[7,2]:=8;
* *
* lines[8,1]:=1;        lines[8,2]:=5;
* *
* lines[9,1]:=5;        lines[9,2]:=6;
* *
* lines[10,1]:=6;        lines[10,2]:=7;
* *
* lines[11,1]:=7;        lines[11,2]:=8;
* *
* lines[12,1]:=8;        lines[12,2]:=5;

* while true do
* * begin
* SetColor(255, 255, 255);
* FillRect(0, 0, GetWidth, GetHeight);*
* *
* * rx:=rx+ToRadians(1);
* * ry:=2*rx;
* * rz:=3*rx;
* *
* Rotate3D;
* *
* SetColor(255, 0, 0);
* //Draw3D;
* for i:=1 to numlines do
* begin
* * DrawLine(points[lines[i,1],4], points[lines[i,1],5], points[lines[i,2],4], points[lines[i,2],5]);
* end;
* *
* MS:=GetSecond(GetCurrentTime);
* If MS<>MSL Then
* * begin
* * FPS_LastCount:=FPS_Count;
* * FPS_Count:=0;
* * MSL:=MS;
* * end       
* Else
* * FPS_Count:=FPS_Count+1;
* *
* * SetColor(0, 0, 255);
* * DrawText('FPS:'+IntegerToString(FPS_LastCount), 0, 0);
* *
* Repaint;
* *
* if GetKeyPressed = KE_KEY1 then distance:=distance-10;
* if GetKeyPressed = KE_KEY3 then distance:=distance+10;
* if GetKeyPressed = KE_KEY2 then cy:=cy-2;
* if GetKeyPressed = KE_KEY4 then cx:=cx-2;
* if GetKeyPressed = KE_KEY6 then cx:=cx+2;
* if GetKeyPressed = KE_KEY8 then cy:=cy+2;
* * end;
end.
И сам мидлет (8 кб)

pax 13.12.2005 14:42
Вложений: 1
Вот еще один вариант... народ, скажите какой быстрее, а то у меня пашут с одинаковой скоростью...
Код:
program MY_3D;
const
 numpoints=8;
 numlines=12;

var
 points        :array[1..numpoints,1..5] of integer;
 lines :array[1..numlines, 1..2] of integer;
 SinCosAng :array[0..359, 1..2] of real;
 distance,i    : integer;
 FPS_LastCount,FPS_Count,MS,MSL: integer;
  cx, cy      : integer;
 
 rx, ry, rz    : Integer;
  Srx,Crx,Sry,Cry,Srz,Crz : real;
  ox,tx,ty,tz    : real;
 
procedure CreateAngles;
begin
        for i:=0 to 359 do
 begin
        SinCosAng[i,1]:=sin(ToRadians(i));
        SinCosAng[i,2]:=cos(ToRadians(i));
        SetColor(255, 255, 255);
        FillRect(0, 0, GetWidth, GetHeight);
        SetColor(0, 0, 255);
        DrawText('Loading: '+IntegerToString(i*100/360)+'%', 0, 0);
        Repaint;
 end;
end;

function NornalizeAngle(DegAngle:integer):integer;
var temp:integer;
begin
        temp:=DegAngle/360;
        NornalizeAngle:=DegAngle-360*temp;
end;
 
Procedure Rotate3D;
begin
        for i:=1 to numpoints do
 begin
        //X rotation
        ty := points[i,2] * SinCosAng[rx,2] - points[i,3] * SinCosAng[rx,1];
        tz := points[i,2] * SinCosAng[rx,1] + points[i,3] * SinCosAng[rx,2];
        //Y rotation
        tx := points[i,1] * SinCosAng[ry,2] - tz * SinCosAng[ry,1];
        tz := points[i,1] * SinCosAng[ry,1] + tz * SinCosAng[ry,2];
        //Z rotation
        ox := tx;
        tx := tx * SinCosAng[rz,2] - ty * SinCosAng[rz,1];
        ty := ox * SinCosAng[rz,1] + ty * SinCosAng[rz,2];
        //Calculate new x and y location with perspective
        points[i,4] := Trunc(512 * tx / (distance - tz))+cx; //x
        points[i,5] := Trunc(512 * ty / (distance - tz))+cy; //y
 end;
end;

begin
        CreateAngles;
        distance:=100;
        cx:=GetWidth/2;
        cy:=GetHeight/2;
 
 points[1,1]:=5;        points[1,2]:=-5;        points[1,3]:=-5;
 
 points[2,1]:=5;        points[2,2]:=-5;        points[2,3]:=5;
 
 points[3,1]:=5;        points[3,2]:=5;        points[3,3]:=5;
 
 points[4,1]:=5;        points[4,2]:=5;        points[4,3]:=-5;
 
 points[5,1]:=-5;        points[5,2]:=-5;        points[5,3]:=-5;
 
 points[6,1]:=-5;        points[6,2]:=-5;        points[6,3]:=5;
 
 points[7,1]:=-5;        points[7,2]:=5;        points[7,3]:=5;
 
 points[8,1]:=-5;        points[8,2]:=5;        points[8,3]:=-5;
 
 lines[1,1]:=1;        lines[1,2]:=2;
 
 lines[2,1]:=2;        lines[2,2]:=3;
 
 lines[3,1]:=3;        lines[3,2]:=4;
 
 lines[4,1]:=4;        lines[4,2]:=1;
 
 lines[5,1]:=2;        lines[5,2]:=6;
 
 lines[6,1]:=3;        lines[6,2]:=7;
 
 lines[7,1]:=4;        lines[7,2]:=8;
 
 lines[8,1]:=1;        lines[8,2]:=5;
 
 lines[9,1]:=5;        lines[9,2]:=6;
 
 lines[10,1]:=6;        lines[10,2]:=7;
 
 lines[11,1]:=7;        lines[11,2]:=8;
 
 lines[12,1]:=8;        lines[12,2]:=5;

 while true do
  begin
        SetColor(255, 255, 255);
        FillRect(0, 0, GetWidth, GetHeight);
 
  rx:= NornalizeAngle(rx+1);
  ry:= NornalizeAngle(2*rx);
  rz:= NornalizeAngle(3*rx);
 
        Rotate3D;
 
        SetColor(255, 0, 0);
        //Draw3D;
        for i:=1 to numlines do
        begin
  DrawLine(points[lines[i,1],4], points[lines[i,1],5], points[lines[i,2],4], points[lines[i,2],5]);
        end;
 
        MS:=GetSecond(GetCurrentTime);
        If MS<>MSL Then
  begin
  FPS_LastCount:=FPS_Count;
  FPS_Count:=0;
  MSL:=MS;
  end       
        Else
  FPS_Count:=FPS_Count+1;
         
  SetColor(0, 0, 255);
  DrawText('FPS:'+IntegerToString(FPS_LastCount), 0, 0);
 
        Repaint;
 
        if GetKeyPressed = KE_KEY1 then distance:=distance-10;
        if GetKeyPressed = KE_KEY3 then distance:=distance+10;
        if GetKeyPressed = KE_KEY2 then cy:=cy-2;
        if GetKeyPressed = KE_KEY4 then cx:=cx-2;
        if GetKeyPressed = KE_KEY6 then cx:=cx+2;
        if GetKeyPressed = KE_KEY8 then cy:=cy+2;
  end;
end.
Мидлет прилагается :)

SubZer0 13.12.2005 19:54
ты рулишь! я на MidpX пробовал, на мобилу еще не заливал, там фпс 60... :)

pax 13.12.2005 21:31
Ктонить, помогите написать функцию преобразования строки в число вещественного типа (real), я сидел часа два... ниче не получилось :( , или объясните как пользоваться вот этим оператором, я ваще не могу понять для чего второй параметр нужен...

function StringToReal(str:string; base:integer):real;

Transforms the string into the real number. The second parameter is the base for transformation.

pax 13.12.2005 21:52
Цитата:
Originally posted by SubZer0@Dec 13 2005, 07:54 PM
ты рулишь! я на MidpX пробовал, на мобилу еще не заливал, там фпс 60... :)
Кстати у меня на MidpX примерно 110 кадров/с.

pax 14.12.2005 23:05
Люди найдите ошибку!
(Ошибка в функции Function RealFromString(Val:String):Real;)
у меня из-за нее мидлет не работает :(

Код:
Function Repl(Str:String;Chr1,Chr2:Char):String;
var i:integer;
Begin
        For i:=0 to Length(Str)-1 do
 If GetChar(str,i)=Chr1 then Str:=SetChar(str,Chr2,i)
 Repl:=Str;
End;


Function XStepPY(X,Y:Integer):Integer;
var i,s:integer;
Begin
s:=1;
        If Y>0 then
 for i:=1 to Y do s:=s*x
        else
 If Y=0 then s:=1
        else s:=-1;
        XStepPY:=s;
End;


Function RSgn(Val:Real):Real;
Begin
        RSgn:=Val/RAbs(Val);
End;


Function RealFromString(Val:String):Real;
Var A,P,i:Integer;
 B:real;
 S:string;
Begin
        B:=0;
        A:=StringToInteger(Val);
        S:=Repl(Val,',','.');
        P:=Pos(S,'.');
        S:=Copy(S,P+1,Length(S)-1);
        if P=-1 then
 RealFromString:=A
        else       
 begin
  for i:=0 to Length(S)-1 do
          B:=B+StringToInteger(GetChar(S,i))/XStepPY(10,i+1);
  B:=B*RSgn(A);
  RealFromString:=A+B;
 end;
end;

DiS[IP] 03.03.2006 19:49
У меня эта прога дает на Moto С380 от 12 до 15 ни ниже вот! :)
MidlrtPascal 2.02 может оптимизации у них в коде

oposum_2000 27.11.2006 19:28
Re: Моя первая прога :)
 
na k750i fps : 80

Buregon 14.12.2006 21:36
Re: Моя первая прога :)
 
фпс - 112-114
нокиа 6151
зашибись програмка=)

EVIL_USER 15.12.2006 00:00
Re: Моя первая прога :)
 
Siemens c75
18 стабильно

А эмул СХ65 за 200 выжимает...
MidpX 110...

IVenoMI 20.12.2006 03:56
Re: Моя первая прога :)
 
То что эмуль выжимает много - это ясно...

А в остальном : аппараты без поддержки граф ускоритель: 7 - 15 фпс, с ускорителем : 60 - 130 фпс...

Bekon352 22.07.2007 02:17
Re: Моя первая прога :)
 
PAX молоток мужик я блин такое никогда не напишу(((((((


Часовой пояс GMT +4, время: 10:11.
Страница 1 из 2 1 2 >
Показывать 64 сообщений этой темы на одной странице

vBulletin® Version 3.6.5.
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Перевод: zCarot