3D cube is OK

Discuss any general programming issues here
Post Reply
ArtBlink
Posts: 437
Joined: Mon Nov 01, 2010 10:37 am
Location: Albert - France
Contact:

3D cube is OK

Post by ArtBlink » Wed Dec 08, 2010 1:47 am

Try this code,

3D equation is very good

Code: Select all

@SCREEN {Mode = "ask", Width = 640, Height = 480}
FC=200
CX=0
CY=0
CZ=200
	Dim CO[314] 
	Dim SI[314] 
	Dim X[8]  
	Dim Y[8]  
	Dim Z[8]  
	Dim X1[8]  
	Dim Y1[8]  
	Dim Z1[8] 
	Dim XE[8] 
	Dim YE[8] 
	Dim ZZ[8] 
	Dim P1[8] 
	Dim C[8]
	Dim V[6]
	Dim couleur[6]

	couleur={$AA0000,$00AA00,$0000AA,$AAAA00,$00AAAA,$AA00AA}
	
	coord={
	-0.500000,0.500000,0.500000,
	0.500000,0.500000,0.500000,
	0.500000,0.500000,-0.500000,
	-0.500000,0.500000,-0.500000,
	-0.500000,-0.500000,0.500000,
	0.500000,-0.500000,0.500000,
	0.500000,-0.500000,-0.500000,
	-0.500000,-0.500000,-0.500000,
	-0.500000,0.500000,0.500000
	
	}
	
	For i=0 To 23
		coord[i]=coord[i]*100
	Next

P1={
	0, 1, 2, 3,
	7, 6, 5, 4,
	0, 4, 5, 1,
	1, 5, 6, 2,
	2, 6, 7, 3,
	3, 7, 4, 0
	}
	
For I=0 To 313
	CO[I]=Cos(I*0.02)*400 
	SI[I]=Sin(I*0.02)*400 
Next 

Function Controle()
	If IsKeyDown("Left")=True Then Gauche() 
	If IsKeyDown("Right")=True Then Droite() 
	If IsKeyDown("Up")=True Then Haut() 
	If IsKeyDown("Down")=True Then Bas() 
	If IsKeyDown("*")=True Then ZDown()
	If IsKeyDown("$")=True Then ZUp()
	If IsKeyDown("a")=True Then Zoomin() 
	If IsKeyDown("z")=True Then Zoomout() 
	If IsKeyDown("e")=True Then SetFormStyle(#ANTIALIAS)
	If IsKeyDown("r")=True Then SetFormStyle(#NORMAL)
	If IsKeyDown("t")=True Then SetFillStyle(#FILLCOLOR) 
	If IsKeyDown("u")=True Then SetFillStyle(#FILLGRADIENT, #LINEAR, $880000, $FFFFFF)
	If IsKeyDown("y")=True Then SetFillStyle(#FILLNONE)  
	

EndFunction
Function ZUp()
	AZ=AZ+1
	If AZ>313 Then AZ=0
EndFunction
Function Zdown()
	AZ=AZ-1
	If AZ<0 Then AZ=313
	EndFunction

Function Gauche()
	AY=AY+1
	If AY>313 Then AY=0
EndFunction

Function Droite()
	AY=AY-1
	If AY<0 Then AY=313
EndFunction

Function Haut()
	AX=AX+1
	If AX>313 Then AX=0
EndFunction
	
Function Bas()
	AX=AX-1
	If AX<0 Then AX=313
EndFunction

Function Zoomin()
	CZ=CZ+10
	If CZ>500 Then CZ=500
EndFunction

Function Zoomout()
	CZ=CZ-10
	If CZ<40 Then CZ=40
EndFunction

Function PRG()
	Controle() 
	Flip 
	Cls 
	TextOut(#CENTER,0,"LE cube en 640x480")
	TextOut(#CENTER,10,"Avec Hollywood")
	TextOut(0,20,"Arrow Key to turn objet")
	TextOut(0,30,"Key a = Zoom backward")
	TextOut(0,40,"Key z = Zoom forward")
	TextOut(0,50,"Key e = Antialiasing On")
	TextOut(0,60,"Key r = Antialiasing Off")
	TextOut(0,70,"Key t = 3D color")
	TextOut(0,80,"Key y = 3D line")
	TextOut(0,90,"Key u = 3D Good")
	TextOut(0,100,"Key  $ = Rot Z")
	TextOut(0,110,"Key  * = Rot Z")
	TextOut(0,120,"ctrl + c = EXIT")
	
	For I=0 To 7
		Y1=(coord[I*3+1]*CO[AX]+coord[I*3+2]*SI[AX])/400
		Z1=(-coord[I*3+1]*si[AX]+coord[I*3+2]*co[AX])/400
		X1=(coord[I*3]*CO[AY]+Z1*SI[AY])/400
		ZZ[I]=(-coord[I*3]*SI[AY]+Z1*CO[AY])/400
		X=(X1*CO[AZ]+Y1*SI[AZ])/400
		Y=(-X1*SI[AZ]+Y1*CO[AZ])/400	
		Z=CZ+ZZ[I]
		D=FC/(Sqrt(X^2+Y^2+Z^2))
		XE[I]=320+X*D
		YE[I]=240+Y*D
	Next
	
	For I=0 To 5
		GP1=P1[I*4]
		GP2=P1[I*4+1]
		GP3=P1[I*4+2]
		GP4=P1[I*4+3]
		Test=((XE[GP2]-XE[GP1])*(YE[GP4]-YE[GP1])-(XE[GP4]-XE[GP1])*(YE[GP2]-YE[GP1]))		
		V[0]=XE[GP1]
		V[1]=YE[GP1]
		V[2]=XE[GP2]
		V[3]=YE[GP2]
		V[4]=XE[GP3]
		V[5]=YE[GP3]
		V[6]=XE[GP4]
		V[7]=YE[GP4]
		
		If Test<0.0 Then Polygon(CX,CY,v,4,couleur[I])
	Next
	
EndFunction

BeginDoubleBuffer

SetInterval(1,PRG,1)

Repeat
WaitEvent
Forever

PEB
Posts: 246
Joined: Sun Feb 21, 2010 1:28 am

Re: 3D cube is OK

Post by PEB » Wed Dec 08, 2010 1:55 pm

Nice demo!

User avatar
Tuxedo
Posts: 225
Joined: Sun Feb 14, 2010 12:41 pm

Re: 3D cube is OK

Post by Tuxedo » Wed Dec 08, 2010 8:32 pm

REALLY nice! :)
Simone"Tuxedo"Monsignori, Perugia, ITALY.

ArtBlink
Posts: 437
Joined: Mon Nov 01, 2010 10:37 am
Location: Albert - France
Contact:

Re: 3D cube is OK

Post by ArtBlink » Thu Dec 09, 2010 5:31 pm

Thanks,

I have the same thing with spaceship and other with cow

I optimise hollywood 3D code and when i finish it, i post code or i give link to a lha archive. ;-)

Respect

HelmutH
Posts: 198
Joined: Fri Feb 19, 2010 1:41 pm
Location: Oberhausen / Germany
Contact:

Re: 3D cube is OK

Post by HelmutH » Thu Dec 09, 2010 10:16 pm

Great ArtBlink, keep it up.
greeting Helmut

Post Reply