|
Основной форум Сюда все проблемы связанные с программированием. |
26.12.2005, 21:07
|
#1
|
|
Ответ на 3D куб PAX !
Написано всё понятным языком !
program NewProject;
var i,x1,y1,x2,y2,x3,y3,x4,y4,x5,y5,x6,y6,x7,y7,x8,y8 :integer;
modD,trafD:integer;
Procedure Rect(x1,y1,x2,y2,x3,y3,x4,y4,x5,y5,x6,y6,x7,y7,x8,y8:integer);
begin
SetColor(0,0,0);
{Передний квадрат }
DrawLine(x1,y1,x2,y2);
DrawLine(x2,y2,x3,y3);
DrawLine(x3,y3,x4,y4);
DrawLine(x4,y4,x1,y1);
{Задний квадрат }
DrawLine(x5,y5,x6,y6);
DrawLine(x6,y6,x7,y7);
DrawLine(x7,y7,x8,y8);
DrawLine(x8,y8,x5,y5);
{Соединение квадратов}
DrawLine(x1,y1,x5,y5);
DrawLine(x2,y2,x6,y6);
DrawLine(x3,y3,x7,y7);
DrawLine(x4,y4,x8,y8);
end;
Procedure Key;
var keyAction:integer;
begin
keyAction := keyToAction(getKeyClicked);
if modD=1 then
begin
if keyAction = GA_UP then y1:=y1-1;
if keyAction = GA_RIGHT then x1:=x1+1;
if keyAction = GA_DOWN then y1:=y1+1;
if keyAction = GA_LEFT then x1:=x1-1;
end;
if modD=2 then
begin
if keyAction = GA_UP then y2:=y2-1;
if keyAction = GA_RIGHT then x2:=x2+1;
if keyAction = GA_DOWN then y2:=y2+1;
if keyAction = GA_LEFT then x2:=x2-1;
end;
if modD=3 then
begin
if keyAction = GA_UP then y3:=y3-1;
if keyAction = GA_RIGHT then x3:=x3+1;
if keyAction = GA_DOWN then y3:=y3+1;
if keyAction = GA_LEFT then x3:=x3-1;
end;
if modD=4 then
begin
if keyAction = GA_UP then y4:=y4-1;
if keyAction = GA_RIGHT then x4:=x4+1;
if keyAction = GA_DOWN then y4:=y4+1;
if keyAction = GA_LEFT then x4:=x4-1;
end;
if modD=5 then
begin
if keyAction = GA_UP then y5:=y5-1;
if keyAction = GA_RIGHT then x5:=x5+1;
if keyAction = GA_DOWN then y5:=y5+1;
if keyAction = GA_LEFT then x5:=x5-1;
end;
if modD=6 then
begin
if keyAction = GA_UP then y6:=y6-1;
if keyAction = GA_RIGHT then x6:=x6+1;
if keyAction = GA_DOWN then y6:=y6+1;
if keyAction = GA_LEFT then x6:=x6-1;
end;
if modD=7 then
begin
if keyAction = GA_UP then y7:=y7-1;
if keyAction = GA_RIGHT then x7:=x7+1;
if keyAction = GA_DOWN then y7:=y7+1;
if keyAction = GA_LEFT then x7:=x7-1;
end;
if modD=8 then
begin
if keyAction = GA_UP then y8:=y8-1;
if keyAction = GA_RIGHT then x8:=x8+1;
if keyAction = GA_DOWN then y8:=y8+1;
if keyAction = GA_LEFT then x8:=x8-1;
end;
if keyAction = GA_GAMEC then
begin
modD:=modD+1;
if modD=9 then modD:=1;
end;
if keyAction = GA_GAMED then
begin
trafD:=trafD+1;
if trafD=2 then trafD:=0;
end;
end;
Procedure Modes;
begin
SetColor(255, 0, 0);
DrawText('Mod='+IntegerToString(modD), 0, 0);
if trafD=0 then DrawText('OFF',(GetWidth - GetStringWidth('OFF')), 0);
if trafD=1 then DrawText('ON',(GetWidth - GetStringWidth('ON')), 0);
if trafD=1 then
begin
if modD=1 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('1',x1-3,y1-3);DrawEllipse(x1-2,y1-2,4,4);
if modD=2 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('2',x2-3,y2-3);DrawEllipse(x2-2,y2-2,4,4);
if modD=3 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('3',x3-3,y3-6);DrawEllipse(x3-2,y3-2,4,4);
if modD=4 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('4',x4-3,y4-6);DrawEllipse(x4-2,y4-2,4,4);
if modD=5 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('5',x5-3,y5-3);DrawEllipse(x5-2,y5-2,4,4);
if modD=6 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('6',x6-3,y6-3);DrawEllipse(x6-2,y2-6,4,4);
if modD=7 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('7',x7-3,y7-6);DrawEllipse(x7-2,y7-2,4,4);
if modD=8 then SetColor(255, 0, 0); else SetColor(0, 0, 255);
DrawText('8',x8-3,y8-6);DrawEllipse(x8-2,y8-2,4,4);
end;
end;
Procedure CLS;
begin
SetColor(255, 255, 255);
FillRect(0, 0, GetWidth, GetHeight);
end;
begin
{Передний Квадрат}
x1:=35;y1:=35;
x2:=85;y2:=35;
x3:=85;y3:=85;
x4:=35;y4:=85;
{Задний Квадрат}
x5:=40;y5:=30;
x6:=90;y6:=30;
x7:=90;y7:=70;
x8:=40;y8:=70;
modD:=1;
trafD:=0;
repeat
Modes;
Key;
Rect(x1,y1,x2,y2,x3,y3,x4,y4,x5,y5,x6,y6,x7,y7,x8,y8);
Delay(100);
Repaint;
CLS;
until i=2
end.
Дерзайте
|
|
|
27.12.2005, 22:25
|
#2
|
Unity/C# кодер
Регистрация: 03.10.2005
Адрес: Россия, Рязань
Сообщений: 7,568
Написано 3,006 полезных сообщений (для 5,323 пользователей)
|
program MY_3D;
const
Steps=5;
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;
Step,Direction,Faza:Integer;
Function ISgn(Val:Integer):Integer;
Begin
if val=0 then ISgn:=1 else
ISgn:=Val/Abs(Val);
End;
Procedure UpdateCube;
var P1,P2:Integer;
Begin
if Step>Steps then
Begin
Direction:=-Direction;
if Direction>0 then Faza:=Faza+1;
If Faza>4 then Faza:=1;
Step:=0;
end
else
Step:=Step+1;
If Faza=1 then Begin P1:=1;P2:=7; End;
If Faza=2 then Begin P1:=2;P2:=8; End;
If Faza=3 then Begin P1:=3;P2:=5; End;
If Faza=4 then Begin P1:=4;P2:=6; End;
points[P1,1]:=points[P1,1]+Direction*ISgn(points[P1,1]);
points[P1,2]:=points[P1,2]+Direction*ISgn(points[P1,2]);
points[P1,3]:=points[P1,3]+Direction*ISgn(points[P1,3]);
points[P2,1]:=points[P2,1]+Direction*ISgn(points[P2,1]);
points[P2,2]:=points[P2,2]+Direction*ISgn(points[P2,2]);
points[P2,3]:=points[P2,3]+Direction*ISgn(points[P2,3]);
end;
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
Direction:=1;
Faza:=1;
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;
UpdateCube;
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;
Delay(30);
end;
end.
|
(Offline)
|
|
27.12.2005, 23:06
|
#3
|
|
вообще я писал для нашего информатика 3д куб... мы 'алго' изучаем
ето паскаль по хохольски (как ето - лутче неспрашивать)
program example_3d;
var vx,vy,vz,d:real;
run:boolean;
key:integer;
key_press:integer;
speed:real;
procedure b3d(var nx,ny:integer;x3d,y3d,z3d,vx,vy,vz,distance:real);
var ty,tz,tx,ox:real;
begin
ty := ((y3d * Cos(vx)) - (z3d * Sin(vx)));
tz := ((y3d * Sin(vx)) + (z3d * Cos(vx)));
tx := ((x3d * Cos(vy)) - (tz * Sin(vy)));
tz := ((x3d * Sin(vy)) + (tz * Cos(vy)));
ox := tx;
tx := ((tx * Cos(vz)) - (ty * Sin(vz)));
ty := ((ox * Sin(vz)) + (ty * Cos(vz)));
nx := Trunc(512 * (tx) / (distance - (tz)) + 320);
ny := Trunc(240 - (512 * ty) / (distance - (tz)));
end;
procedure line3d(zl1x,zl1y,zl1z,zl2x,zl2y,zl2z,vx,vy,vz,d:real);
var nx,ny,nx2,ny2:integer;
begin
b3d(nx,ny,zl1x,zl1y,zl1z,vx,vy,vz,d);
b3d(nx2,ny2,zl2x,zl2y,zl2z,vx,vy,vz,d);
line(nx-50,ny-50,nx2-50,ny2-50);
end;
procedure cube(var vx,vy,vz,d:real);
begin
line3d(0,0,0,1,0,0,vx,vy,vz,d);
line3d(0,0,0,0,1,0,vx,vy,vz,d);
line3d(0,0,0,0,0,1,vx,vy,vz,d);
line3d(1,0,0,1,1,0,vx,vy,vz,d);
line3d(1,0,0,1,0,1,vx,vy,vz,d);
line3d(0,0,1,1,0,1,vx,vy,vz,d);
line3d(0,0,1,0,1,1,vx,vy,vz,d);
line3d(0,1,1,1,1,1,vx,vy,vz,d);
line3d(1,1,0,1,1,1,vx,vy,vz,d);
line3d(0,1,0,1,1,0,vx,vy,vz,d);
line3d(0,1,0,0,1,1,vx,vy,vz,d);
line3d(1,0,1,1,1,1,vx,vy,vz,d);
end;
Function ReadKey: integer;
Var
i,j,k : integer;
Begin
j:=0;
k:=0;
if isevent=true then
begin
Event( i, j, k);
end;
ReadKey := j;
end;
begin
d:=10;
speed:=0.04;
vx:=0.2;
vy:=0.5;
vz:=0;
run:=true;
key_press:=1;
key:=999;
while run=true do
begin
if key=39 then
begin
vy:=vy+speed;
key_press:=1;
end;
if key=37 then
begin
vy:=vy-speed;
key_press:=1;
end;
if key=40 then
begin
vx:=vx-speed;
key_press:=1;
end;
if key=38 then
begin
vx:=vx+speed;
key_press:=1;
end;
if key<>0 then
begin
clear;
cube(vx,vy,vz,d);
if key_press=0 then run:=false;
end;
key_press:=0;
key:=ReadKey;
end;
end.
|
|
|
27.12.2005, 23:14
|
#4
|
Unity/C# кодер
Регистрация: 03.10.2005
Адрес: Россия, Рязань
Сообщений: 7,568
Написано 3,006 полезных сообщений (для 5,323 пользователей)
|
Originally posted by jimon@Dec 27 2005, 11:06 PM
вообще я писал для нашего информатика 3д куб... мы 'алго' изучаем
ето паскаль по хохольски (как ето - лутче неспрашивать)
|
А скока этот алго весит? может выложишь?
|
(Offline)
|
|
28.12.2005, 14:03
|
#5
|
|
вот вчера портировал на midletpascal
вышло конешно тупо - портирование прямое : тоесть то что нереализовано тут, просто навязавается
делал под разрешение 128*128
на мобилке 6 фпс ! :o
алго в атаче
код здесь
program example_3d;
var vx,vy,vz,d:real;
* *run:boolean;
* *speed:real;
nx,ny,nx2,ny2:integer;
procedure b3d(o,x3d,y3d,z3d,vx,vy,vz,distance:real);
* *var ty,tz,tx,ox:real;
* *begin
* *ty := ((y3d * Cos(vx)) - (z3d * Sin(vx)));
* *tz := ((y3d * Sin(vx)) + (z3d * Cos(vx)));
* *tx := ((x3d * Cos(vy)) - (tz * Sin(vy)));
* *tz := ((x3d * Sin(vy)) + (tz * Cos(vy)));
* *ox := tx;
* *tx := ((tx * Cos(vz)) - (ty * Sin(vz)));
* *ty := ((ox * Sin(vz)) + (ty * Cos(vz)));
if o=0 then
begin
* *nx := Trunc(512 * (tx) / (distance - (tz)) + 320);
* *ny := Trunc(240 - (512 * ty) / (distance - (tz)));
end;
if o=1 then
begin
* *nx2 := Trunc(512 * (tx) / (distance - (tz)) + 320);
* *ny2 := Trunc(240 - (512 * ty) / (distance - (tz)));
end;
end;
procedure line3d(zl1x,zl1y,zl1z,zl2x,zl2y,zl2z,vx,vy,vz,d:real);
var m1,m2:integer;
* begin
m1:=280;
m2:=200;
* b3d(0,zl1x,zl1y,zl1z,vx,vy,vz,d);
* b3d(1,zl2x,zl2y,zl2z,vx,vy,vz,d);
* drawline(nx-m1,ny-m2,nx2-m1,ny2-m2);
*
end;
procedure cube(vx,vy,vz,d:real);
begin
* line3d(0,0,0,1,0,0,vx,vy,vz,d);
* line3d(0,0,0,0,1,0,vx,vy,vz,d);
* line3d(0,0,0,0,0,1,vx,vy,vz,d);
* line3d(1,0,0,1,1,0,vx,vy,vz,d);
* line3d(1,0,0,1,0,1,vx,vy,vz,d);
* line3d(0,0,1,1,0,1,vx,vy,vz,d);
* line3d(0,0,1,0,1,1,vx,vy,vz,d);
* line3d(0,1,1,1,1,1,vx,vy,vz,d);
* line3d(1,1,0,1,1,1,vx,vy,vz,d);
* line3d(0,1,0,1,1,0,vx,vy,vz,d);
* line3d(0,1,0,0,1,1,vx,vy,vz,d);
* line3d(1,0,1,1,1,1,vx,vy,vz,d);
end;
begin
* d:=20;
*
* speed:=0.04;
* vx:=0.2;
* vy:=0.5;
* vz:=0;
* run:=true;
*
* nx:=0;
* ny:=0;
* nx2:=0;
* ny2:=0;
* while run=true do
* begin
* if getKeyPressed = KE_KEY8 then vy:=vy+speed;
* if getKeyPressed = KE_KEY2 then vy:=vy-speed;
*
* if getKeyPressed = KE_KEY4 then vx:=vx-speed;
* *
* if getKeyPressed = KE_KEY6 then vx:=vx+speed;
* if getKeyPressed = KE_KEY0 then run:=false;
setcolor(255,255,255);
*fillRect(0, 0, 200, 200);
setcolor(0,0,0);
* cube(vx,vy,vz,d);
* repaint;
*
*
* end;
end.
неругатся на меня
to diplomat : ПОСМОТРИ НА ЕТО думаю сразуже признаеш украинцев как программистов !
|
|
|
20.02.2007, 00:48
|
#6
|
Модератор
Регистрация: 21.12.2006
Сообщений: 564
Написано 79 полезных сообщений (для 203 пользователей)
|
Re: 3D куб!
У меня есть алго. когдато в школе скатал.
а где-то на форуме качал 3д куб без исходника - у меня идет со средним ФПС = 80. Это хорошо или плохо. А кубит крутится с бешеной скоростью. Трубка- сониерик к310
|
(Offline)
|
|
21.02.2007, 18:23
|
#7
|
Разработчик
Регистрация: 09.01.2007
Сообщений: 217
Написано 0 полезных сообщений (для 0 пользователей)
|
Re: 3D куб!
вообще я писал для нашего информатика 3д куб... мы 'алго' изучаем
ето паскаль по хохольски (как ето - лутче неспрашивать)
|
У нас была какая-то фигня, токо команды сокращенна и все на украинском.
все команды в списочке справа
код типа:
алг tt(ціл a,b,c)
арг a,b
рез с
поч
ввести a,b
c:=a+b
вивести с
кін
Структура тож как у паскаля
|
(Offline)
|
|
21.02.2007, 22:44
|
#8
|
ПроЭктировщик
Регистрация: 13.11.2006
Сообщений: 101
Написано 6 полезных сообщений (для 6 пользователей)
|
Re: 3D куб!
ЫЫЫЫ....
Это ещё стебнее чем в экселе (половина на русском, половина на буржуйском). Я то материмся, когда приходилось постоянно язык переключать, но ТАКОГО стёба я ещё не видел
поч-кiн вместо begin-end совсем убило
|
(Offline)
|
|
21.02.2007, 23:04
|
#9
|
|
Re: 3D куб!
почему ? почати - закiнчити, довольно нормальные сокращения
хотя там сокращения от слов початок - кiнець
|
|
|
22.02.2007, 17:15
|
#10
|
Зануда с интернетом
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений (для 20,935 пользователей)
|
Re: 3D куб!
2pilgrim
такие посты убивай сразу.
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
|
(Offline)
|
|
22.02.2007, 17:46
|
#11
|
ПроЭктировщик
Регистрация: 20.10.2006
Сообщений: 102
Написано одно полезное сообщение
|
Re: 3D куб!
Смотри доубиваешься и последние три человека перестанут сюда заглядывать.
А что он не так сказал или ты любишь Ющенко?
И такие вещи не в форуме ,а через личку пишут, если пошла речь о чистоте форума.
|
(Offline)
|
|
22.02.2007, 20:49
|
#12
|
Спящий разум
Регистрация: 08.03.2006
Сообщений: 784
Написано 89 полезных сообщений (для 156 пользователей)
|
Re: 3D куб!
to Chip
1. Такого рода сообщения
И такие вещи не в форуме ,а через личку пишут, если пошла речь о чистоте форума.
|
необходимо постить в разделе "Порядок на форуме".
2. Выдвигать требования
Смотри доубиваешься и последние три человека перестанут сюда заглядывать.
|
на форуме также необходимо в разделе "Порядок на форуме".
3. Форум аполитичен
и разжигание конфликтов на почве национальностей (вышеудаленные посты о споре кто лучше : украинцы или русские) запрещено правилами форума.
С уважением, администрация форума (from impersonalis)
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 16:41.
|