CUBO 3D Pascal

PROGRAM CUBO3D;
{
Autor: RiardozMetal
}

Uses Crt,Graph;
Type Eixos = set of (x,y,z);
const
			
			Npontos = 8; {Numero de pontos do Objeto}
			NFaces = 6;
			TA = 50; {Tamanho Das Arestas}
			Pontos: Array[1..Npontos,x..z] of integer =( {Criação do Espaço do Objeto/Cubo}
				(-TA, -TA, +TA),(+TA, -TA, +TA),(+TA, +TA, +TA),(-TA, +TA, +TA),
				(-TA, -TA, -TA),(+TA, -TA, -TA),(+TA, +TA, -TA),(-TA, +TA, -TA));
			Faces: Array[1..NFaces,1..4] of Integer=( { Nfaces x Pontos por Face }
				(1,2,3,4),(2,6,7,3),(6,5,8,7),(5,1,4,8),(5,6,2,1),(4,3,7,8));
				
		
{* --- Estrutura dos Pontos ---			
			4-------3  8-------7
			|   +   |  |   +   |
			1 ----- 2  5 ----- 6
			 (z > 0)    (z < 0)
OBS: Tem uma figura demostrando como está as divisões do cubo em relação ao codigo.			
*}

				
				
VAR		I,J,N:Integer;
			Xa,Ya,Za:Integer; {Guarda a posição (x,y,z) do ponto Atual}
			Xproj,Yproj: Array[1..Npontos] of Integer; {Projeções de um ponto P(x,y,z) em 2D}
			Rotx,Roty,Rotz:Integer;{Armazena a Rotação dos Pontos}
			RotAngle:Integer;{Define o angulo em que o objeto é girado}
			Drive,Modo:Integer;{Variaveis para o Modo Gráfico}
			CentroX,CentroY:Integer;
			
Function Seno(Angulo:INTEGER):Integer;
Begin
	Seno:=ROUND(SIN(Angulo*pi/180)*128);
End;

Function Coseno(Angulo:INTEGER):Integer;
Begin
	Coseno:=ROUND(COS(Angulo*pi/180)*128);
End;
			
	{-----------------------------------------------------}
	
Function sinus(Angulo:INTEGER):Integer;
Begin
	sinus:=ROUND(SIN(Angulo*pi/180)*128);
End;

Function cosinus(Angulo:INTEGER):Integer;
Begin
	cosinus:=ROUND(COS(Angulo*pi/180)*128);
End;
		{-----------------------------------------------------}	
		
Procedure Rotacao(var Xa,Ya,Za:Integer;phix,phiy,phiz:Integer;Var Xp,Yp:integer);
CONST divd:Word=128;
			Dist=150;
VAR i,j,k:Integer;
		MatrizEuler: Array[1..3,1..3] of Integer;
		Ponto: Array[1..3] of Integer;
		Xi,Yi,Zi:Integer;

BEGIN
{			---  FORMULA DE EULER ---
		  MatrizEuler[1,1]:=(Coseno(phiy) * Coseno(phiZ)) div 180;
			MatrizEuler[1,2]:=(Seno(phiX) * Seno(phiY) * Coseno(phiZ) + Coseno(phiX) * Seno(phiZ)) div 180;
			MatrizEuler[1,3]:=(-Coseno(phiX) * Seno(phiY) + Seno(phiX) * Seno(phiZ)) div 180;
			MatrizEuler[2,1]:=(-Coseno(phiY) * Coseno(phiZ)) div 180;
			MatrizEuler[2,2]:=(-Seno(phiX) * Seno(phiY) * Seno(phiZ) + Coseno(phiX) * Coseno(phiZ)) div 180;
			MatrizEuler[2,3]:=(Coseno(phiX) * Seno(phiY) * Seno(phiZ) + Seno(phiX) * Coseno(phiZ)) div 180;
			MatrizEuler[3,1]:=( Seno(phiY)) div 180;
			MatrizEuler[3,2]:=( -Seno(phiX) * Coseno(phiY)) div 180;
			MatrizEuler[3,3]:=( Coseno(phiX) * Coseno(phiY)) div 180;
			
			Ponto[1]:=Xa;
			Ponto[2]:=YA;
			Ponto[3]:=Za;
			

			
			FOR I:=1 TO 3 DO
				FOR J:=1 TO 3 DO BEGIN
					 Ponto[J]:=MatrizEuler[I,J] * Ponto[J];
				END;
				
			Xa:=Ponto[1];
			Ya:=Ponto[2];
			Za:=Ponto[3];
			--- FIM EULER ---
			}
				
{---   Equação Certa / mas de outro cara :(
      i:=(cosinus(phiy)*Xa-sinus(phiy)*Za) div divd;
      j:=(cosinus(phiz)*Ya-sinus(phiz)*i) div divd;
      k:=(cosinus(phiy)*Za+sinus(phiy)*Xa) div divd;
			
      xa:=(cosinus(phiz)*i+sinus(phiz)*Ya) div divd;
      ya:=(cosinus(phix)*j+sinus(phix)*k) div divd;
      za:=(cosinus(phix)*k-sinus(phix)*j) div divd;  ---}
			
		{ "Minhas" equações, Baseadas em matriz de Rotação}	
			{-- Armazena a posição "original" do ponto no momonto da rotação-- }
			Xi:=Xa; Yi:=YA; Zi:=Za;
			
			{--- Matriz de Rotação Z ---}
			Xa:=(Coseno(phiZ) * Xa -   Seno(phiZ) * Ya) div 128;
			Ya:=(  Seno(phiZ) * Xi + Coseno(phiZ) * Ya) div 128;
						   Xi:=Xa;Yi:=Ya;
				
			  {--- Matriz de Rotação Y ---}
			Xa:=(Coseno(phiY) * Xi -   Seno(phiY) * Zi) div 128;
			Za:=(  Seno(phiY) * Xi + Coseno(phiY) * Zi) div 128;
			Xi:=Xa; Zi:=Za;
					
			{--- Matriz de Rotação X ---}
			Ya:=(Coseno(phiX) * Yi -   Seno(phiX) * Zi) div 128;
			Za:=(  Seno(phiX) * Yi + Coseno(phiX) * Zi) div 128;
			Yi:=Ya; Zi:=Za;
			
			
			{--- Gerar pespectiva ---}
			xp:=160+(-xA*dist) div (zA-dist);
      yp:=160+(-yA*dist) div (zA-dist);

			
END;
			
procedure CriarFace(x1,y1,x2,y2,x3,y3,x4,y4:word; c:byte);
	begin
	  line(x1,y1,x2,y2);
	  line(x2,y2,x3,y3);
	  line(x3,y3,x4,y4);
	  line(x4,y4,x1,y1);
	end;
			
			
BEGIN
	writeln('CUBO 3D');
	writeln('====================');
	writeln('Use as teclas: X, Y, Z');

	Drive:=VGA;
	Modo:=VGAhi;
	InitGraph(Drive,Modo,'.\');
	{--- Demostrações ----}
	Line(1,1,GetMaxX div 2,GetMaxY div 2);
	SetColor(Blue);
	Line(GetMaxX div 2,0, GetMaxX div 2, GetMaxY);
	SetColor(Green);
	Line(0,GetMaxY div 2,GetMaxX,GetMaxY div 2);
	SetColor(Red);
	SetFillStyle(1,REd);
	Bar((GetMaxX div 2)-1,(GetMaxY div 2)-1,(GetMaxX div 2)+1,(GetMaxY div 2)+1);
	PutPixel((GetMaxX div 2)+Pontos[1,x],GetMaxY div 2+Pontos[1,y],green);
	PutPixel((GetMaxX div 2)+Pontos[2,x],GetMaxY div 2+Pontos[2,y],green);
	PutPixel((GetMaxX div 2)+Pontos[3,x],GetMaxY div 2+Pontos[3,y],green);
	PutPixel((GetMaxX div 2)+Pontos[4,x],GetMaxY div 2+Pontos[4,y],green);
	
	{--- Codigo ---}
	RotAngle:=2;
	CentroX:=GetMaxX div 2;
	CentroY:=GetMaxY div 2;
	
	REPEAT
		FOR N:=1 TO Npontos DO
		BEGIN
			Xa:=Pontos[n,x];
			Ya:=Pontos[n,y];
			Za:=Pontos[n,z];
			{--- FUNÇÕES QUE PRECISAM SER CRIADAS ---}
			
			Rotacao(Xa,Ya,Za,Rotx,Roty,Rotz,Xproj[n],Yproj[n]);
			
			{Rotate(Xa,Ya,Za,Rotx,Roty,Rotz);}
			{Conv3dto2d(Xproj[n],Yproj[n],Xa,Ya,Za);}
			{Inc(Xproj[n],CentroX); Inc(Yproj[n],CentroY);}
		END;
		
		FOR N:=1 TO Nfaces DO BEGIN
		  {If not checkfront(Xproj[Faces[n,1]],Yproj[Faces[n,1]],
								Xproj[Faces[n,2]],Yproj[Faces[n,2]],
								Xproj[Faces[n,3]],Yproj[Faces[n,3]]) THEN}
			CriarFace(Xproj[Faces[n,1]],Yproj[Faces[n,1]],
								Xproj[Faces[n,2]],Yproj[Faces[n,2]],
								Xproj[Faces[n,3]],Yproj[Faces[n,3]],
								Xproj[Faces[n,4]],Yproj[Faces[n,4]],$FF);
								
								SetColor(Green); {Lina ponto 1}
								Line(0,0,Xproj[1],Yproj[1]);
								SetColor(Blue); {Linha ponto 2}
								Line(GetMaxX,0,Xproj[2],Yproj[2]);
								SetColor(Red);
		END;
		{Colocar a Primeira Face em destaque !}
		SetColor(Yellow);
		CriarFace(Xproj[Faces[1,1]],Yproj[Faces[1,1]],
								Xproj[Faces[1,2]],Yproj[Faces[1,2]],
								Xproj[Faces[1,3]],Yproj[Faces[1,3]],
								Xproj[Faces[1,4]],Yproj[Faces[1,4]],$FF);
		
		
		CASE Upcase(READKEY) OF
			'X':inc(rotx,RotAngle);
			'Y':inc(roty,RotAngle);
			'Z':inc(rotz,RotAngle);
			'0':rotx:=0;
			#27:HALT;
		END;
		
		ClearDevice;
		
		SetColor(Blue);
		Line(GetMaxX div 2,0, GetMaxX div 2, GetMaxY);
		SetColor(Green);
		Line(0,GetMaxY div 2,GetMaxX,GetMaxY div 2);
		
			PutPixel((GetMaxX div 2)+Pontos[1,x],GetMaxY div 2-Pontos[1,y],green);
			PutPixel((GetMaxX div 2)+Pontos[2,x],GetMaxY div 2-Pontos[2,y],green);
			SetColor(Green);
			OutTextXY((GetMaxX div 2)+Pontos[1,x],GetMaxY div 2-Pontos[1,y],'1');
			SetColor(Blue);
			OutTextXY((GetMaxX div 2)+Pontos[2,x]+2,GetMaxY div 2-Pontos[2,y],'2');
			
			{PutPixel((GetMaxX div 2)+Pontos[3,x],GetMaxY div 2+Pontos[3,y],green);
			PutPixel((GetMaxX div 2)+Pontos[4,x],GetMaxY div 2+Pontos[4,y],green);}
			SetColor(Red);
		
	UNTIL FALSE;
	

	
	CloseGraph;


END.

https://www.youtube.com/watch?v=onYrRV0yLp4