Stammtisch & Café | | | | | 
Peter
Mallow | Kann mir jemand mal bitte ein Beispiel für ein einfaches 3D-Objekt geben? z.B. ein Würfel
Habe kein Plan, wie man 3D-Objekte standartmäßig speichert bzw. wie sowas aussieht.
Werden einfach nur die Punkte geladen und dann per Linien miteinander verbunden? Ich lass die Punkte mit Profan berechnen und anzeigen - ohne DirektX oder OpenGL
Suche anfängerfreundliche, übersichtliche, kostenlose Literatur in deutscher Sprache. |
| | | | WinXP Pro SP2, XProfan 9 + XPSE
AMD Athlon 64 X2 3800 | 02.09.2006 ▲ |
| | |
| | 
Jac
de
Lad | Laut deiner Signatur haste XProfan 9, OpenGL benötigt aber XProfan 10. Natürlich kann man es auch vorher verwenden, aber da sind keine profaninternen Befehle drin. Falls du schon bei der Subscriptionaktion mitmachst, müsste bei der letzten Lieferung per Email eine recht umfangreiche Hilfe zum Thema OpenGL mit einigen guten Beispielen dabeisein.
Jac  |
| | | | Profan² 2.6 bis XProfan 11.1+XPSE+XPIA+XPRR (und irgendwann XIDE)
Core2Duo E8500/T2250, 8192/1024 MB, Radeon HD4850/Radeon XPress 1250, Vista64/XP | 02.09.2006 ▲ |
| | |
| |
Peter
Mallow | hi
Hab gefunden, was ich gesucht habe: Okrea und Objekte
---
Kann mir jemand die Prozeduren goto und cube erklähren?
Wie sind die Parameter für goto? x-Richtung, y-Richtung, z-Richtung ?
Und in welcher Reihenfolge werden die Paramter für Cube weitergegeben?
breite, höhe, tiefe ??
Brauch hilfe, stelle fest, dass wenn ich z.B. IFs Tisch darstellen will, dass das nicht wie ein Tisch aussieht xD
Hier mein Code (versuche mir eine eigene 3D-Engine aufzubauen und den Tisch damit dazustellen). Bis jetzt gibts nur die Befehle cube und gotoP (goto = gotoP):
KompilierenMarkierenSeparierenDef DEGsin(1) sin(Pi()/180*@!(1))
Def DEGcos(1) cos(Pi()/180*@!(1))
Declare alpha!, betha!
Declare xP!, yP!, zP!, posx!, posy!, posz!
Declare x0%, y0%, x!, y!, m%
Declare w1!, w2!, w3!, v1!, v2!, v3!
Declare Edit_Alpha&,Edit_Betha&,B_OK&
Proc SetAngles
Parameters a!,b!
alpha! = a!
betha! = b!
w1! = -1*DEGcos(a!)*DEGsin(b!)
w2! = DEGsin(a!)*DEGsin(b!)
w3! = DEGcos(b!)
v1! = DEGsin(a!)
v2! = DEGcos(a!)
v3! = 0
Return 1
EndProc
Proc CalcP
Parameters xP!,yP!,zP!
x! = x0%+(xP!*v1! + yP!*v2! + zP!*v3!)*m%
y! = y0%-(xP!*w1! + yP!*w2! + zP!*w3!)*m%
EndProc
Proc DrawArea
Parameters x1!,y1!,z1!,x2!,y2!,z2!,x3!,y3!,z3!,x4!,y4!,z4!
CalcP(x1!,y1!,z1!)
MoveTo x!,y!
CalcP(x2!,y2!,z2!)
LineTo x!,y!
CalcP(x3!,y3!,z3!)
LineTo x!,y!
CalcP(x4!,y4!,z4!)
LineTo x!,y!
CalcP(x1!,y1!,z1!)
LineTo x!,y!
EndProc
Proc Cube
Parameters b!,h!,t! t!,h!,b!
Vorne Unten Links: posx!,posy!,posz!
Vorne Unten Rechts: posx!+b!,posy!,posz!
Hinten Unten Links: posx!,posy!+t!,posz!
Hinten Unten Rechts: posx!+b!,posy!+t!,posz!
Vorne Oben Links: posx!,posy!,posz!+h!
Vorne Oben Rechts: posx!+b!,posy!,posz!+h!
Hinten Oben Links: posx!,posy!+t!,posz!+h!
Hinten Oben Rechts: posx!+b!,posy!+t!,posz!+h!
DrawArea posx!,posy!,posz!, posx!+b!,posy!,posz!, posx!+b!,posy!+t!,posz!, posx!,posy!+t!,posz! Boden
DrawArea posx!,posy!,posz!+h!, posx!+b!,posy!,posz!+h!, posx!+b!,posy!+t!,posz!+h!, posx!,posy!+t!,posz!+h! Boden
DrawArea posx!,posy!+t!,posz!, posx!,posy!,posz!, posx!,posy!,posz!+h!, posx!,posy!+t!,posz!+h! Wand dicht an Z-Achse
DrawArea posx!+b!,posy!+t!,posz!, posx!+b!,posy!,posz!, posx!+b!,posy!,posz!+h!, posx!+b!,posy!+t!,posz!+h! Wand weit weck an Z-Achse
DrawArea posx!,posy!,posz!, posx!+b!,posy!,posz!, posx!+b!,posy!,posz!+h!, posx!,posy!,posz!+h! Wand dicht an X-Achse
DrawArea posx!,posy!+t!,posz!, posx!+b!,posy!+t!,posz!, posx!+b!,posy!+t!,posz!+h!, posx!,posy!+t!,posz!+h! Wand weit weck an X-Achse
EndProc
Proc GoToP
Parameters b!,h!,t!
posx! = b!
posy! = h!
posz! = t!
EndProc
m% = 50 Maßstab 1 Einheit = m! Pixel
x0% = 200
y0% = 270
---------------
Cls
@Create(Text,%HWnd,Alpha:,10,10,100,20)
Edit_Alpha& = @Create(Edit,%HWnd,100,120,10,100,20)
@Create(Text,%HWnd,Betha:,10,40,100,20)
Edit_Betha& = @Create(Edit,%HWnd,30,120,40,100,20)
B_OK& = @Create(Button,%HWnd,OK,250,25,50,20)
While 1
If @Clicked(B_OK&)
SetAngles(@Val(@GetText$(Edit_Alpha&)),@Val(@GetText$(Edit_Betha&)))
Rectangle 0,70-470,400
Koordinatensystem
CalcP(0,2,0) Y
Line x0%,y0% - (x!),(y!)
DrawText (x!)+5,(y!)-10,Z
CalcP(0,0,2) Z
Line x0%,y0% - (x!),(y!)
DrawText (x!)+5,(y!)-10,Y
CalcP(2,0,0) X
Line x0%,y0% - (x!),(y!)
DrawText (x!)+5,(y!)-10,X
gotoP 0,0,0
IFs Tisch
Platte
cube 1,0.03,1
Bein 1
gotoP -0.4,-1,-0.4
cube 0.05,1,0.05
Bein 2
gotoP 0.4,-1,-0.4
cube 0.05,1,0.05
Bein 3
gotoP 0.4,-1,0.4
cube 0.05,1,0.05
Bein 4
gotoP -0.4,-1,0.4
cube 0.05,1,0.05
EndIf
WaitInput
WEnd
|
| | | | WinXP Pro SP2, XProfan 9 + XPSE
AMD Athlon 64 X2 3800 | 03.09.2006 ▲ |
| | |
| |  | Das Schlimmste wird sein das Du die Zeichenreihenfolge der Meshes errechnen musst! Das benötigt einfach viel Energie!
Ich suche grad mal was raus...mom...
Hier vielleicht hilfts Dir:
KompilierenMarkierenSeparieren $I mouse.inc
decimals 5
DEF Polygon(3) !GDI32,Polygon
declare tx1!,ty1!,tz1!,tx2!,ty2!,tz2!,tx3!,ty3!,tz3!,tx4!,ty4!,tz4!,tx5!,ty5!,tz5!,cx%,pg#,xd!,yd!,zd!needs engine
declare dist!,dist1!,dist2!,dist3!,distlb&mesh/vertex-distances
declare tmp1%,tmp2%,tmp3%,tmp4%,tmp5%,tmp6%,tmp7%,tmp8%,tmp9%,tmp10%,tmps$
declare vpx!,vpy!,vpz!,vpa!,vprx!,vpry!,vprz!viewport
declare fps&,efps&,tm&
declare mx!,my!,_sense%needs engine
def !cam_w 1024
def !cam_h 0768
def !cam_fx 0512
def !cam_fy 0384
def !vpa 10
SetMousePos 512,384
def 3dx(2) (((vpx!+@!(1)))/(vpz!+@!(2)))+!cam_fx
def 3dy(2) (((vpy!+@!(1)))/(vpz!+@!(2)))+!cam_fy
def 3dx(2) ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100))+!cam_fx
def 3dy(2) ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100))+!cam_fy
def 3dx(2) ( ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100)) * cos(vprx!) + @!(2)*sin(vprx!)) +!cam_fx
def 3dy(2) ( ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100)) ) +!cam_fy
def 3dx(2) ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100))+!cam_fx
def 3dy(2) ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100))+!cam_fy
x´ = x * cos (a) + z * sin (a)
z´ = - x * sin (a) + z * cos (a)
declare vtex_s% vertex-stack
declare vtex_x![250]
declare vtex_y![250]
declare vtex_z![250]
declare mesh_s%
declare meshs_f%
declare mesh%[250,4]
declare obj_s% object-stack
declare object%[100,2] object-stack
declare scene_s% scenerende-vertexstack
destroywindow(main(init_engine()))
end
proc main
if @%(1)
if init_objects()
Dim Pg#,50
mcls 1024,768
startpaint -1
usefont MS Sans Serif,14,0,0,0,0
textcolor rgb(255,255,255),-1
endpaint
while _sense%
cls
fps.cnt.eng
case %mousepressed=1 : vpz!=vpz!-4
case %mousepressed=2 : vpz!=vpz!+4
mx!=%mousex-!cam_fx
my!=%mousey-!cam_fy
vpx!=mx!/5
vpy!=my!/5
vpy!=my!
startpaint -1
cls 0
usepen 0,1,rgb(192,0,0)
usebrush 1,rgb(255,0,0)
if draw_scene(calc_scene())
endif
drawtext 0,755,iF, +str$(efps&)+ fps
endpaint
showwindow(distlb&,0)
mcopybmp 0,0 - 1024,768 > 0,0;0
showwindow(distlb&,1)
getmessage
case equ(%scankey,65) : dec _sense%
if 1equ(%scankey,66)
whileloop 8
rotatevertex &loop,0.009,0
wend
whileloop 9,16,1
rotatevertex &loop,-0.050,0
wend
endif
wend
dispose pg#
endif
return %hwnd
endif
return %hinstance
endproc
proc fps.cnt.eng
fps&=fps&+1
if (&gettickcount>tm&)
efps&=fps&
tm&=tm&+1000
fps&=0
endif
endproc
proc rotatevertex
parameters vn%,xr!,yr!,zr!
declare vx!,vz!,vy!
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_x![vn%]=vx!*cos(xr!) + vz!*sin(xr!)
vtex_z![vn%]=(vx!*-1)*sin(xr!) + vz!*cos(xr!)
x´ = x * cos (a) + z * sin (a)
z´ = - x * sin (a) + z * cos (a)
endproc
proc calc_scene
cx%=0
sendmessage(distlb&,$0184,0,0)
meshs_f%=0
while cx%<mesh_s%
inc cx%
if calc_mesh(cx%)
endif
wend
endproc
proc draw_scene
locate 1,1
cx%=0
while cx%<meshs_f%
inc cx%
if draw_mesh(val(substr$(getstring$(distlb&,meshs_f%-cx%),2, )))
endif
wend
endproc
proc calc_mesh
tx5!=vpx!
ty5!=vpy!
tz5!=vpz!
tx1!=(vtex_x![mesh%[@%(1),1]])
tx2!=(vtex_x![mesh%[@%(1),2]])
tx3!=(vtex_x![mesh%[@%(1),3]])
tx4!=(vtex_x![mesh%[@%(1),4]])
ty1!=(vtex_y![mesh%[@%(1),1]])
ty2!=(vtex_y![mesh%[@%(1),2]])
ty3!=(vtex_y![mesh%[@%(1),3]])
ty4!=(vtex_y![mesh%[@%(1),4]])
tz1!=(vtex_z![mesh%[@%(1),1]])
tz2!=(vtex_z![mesh%[@%(1),2]])
tz3!=(vtex_z![mesh%[@%(1),3]])
tz4!=(vtex_z![mesh%[@%(1),4]])
xd! = ((tx4!+tx1!+tx2!+tx3!)/4+vpx! ) /2
yd! = ((ty4!+ty1!+ty2!+ty3!)/4+vpy! ) /2
zd! = ((tz4!+tz1!+tz2!+tz3!)/4+vpz! ) /2
dist!= sqrt(xd!*xd! + yd!*yd! + zd!*zd!) /8
if dist!<99
if dist!>=10
inc meshs_f%
tmps$=str$(dist!)+ +str$(@%(1))+ +str$(xd!)+ +str$(yd!)+ +str$(zd!)
sendmessage (distlb&,$180,0,addr(tmps$))
elseif dist!>=1
inc meshs_f%
tmps$=0+str$(dist!)+ +str$(@%(1))+ +str$(xd!)+ +str$(yd!)+ +str$(zd!)
sendmessage (distlb&,$180,0,addr(tmps$))
endif
endif
endproc
proc draw_mesh
tx1!=vtex_x![mesh%[@%(1),1]]
ty1!=vtex_y![mesh%[@%(1),1]]
tz1!=vtex_z![mesh%[@%(1),1]]
tx2!=vtex_x![mesh%[@%(1),2]]
ty2!=vtex_y![mesh%[@%(1),2]]
tz2!=vtex_z![mesh%[@%(1),2]]
tx3!=vtex_x![mesh%[@%(1),3]]
ty3!=vtex_y![mesh%[@%(1),3]]
tz3!=vtex_z![mesh%[@%(1),3]]
tx4!=vtex_x![mesh%[@%(1),4]]
ty4!=vtex_y![mesh%[@%(1),4]]
tz4!=vtex_z![mesh%[@%(1),4]]
tmp1%=3dx(tx1!,tz1!)
tmp2%=3dy(ty1!,tz1!)
tmp3%=3dx(tx2!,tz2!)
tmp4%=3dy(ty2!,tz2!)
tmp5%=3dx(tx3!,tz3!)
tmp6%=3dy(ty3!,tz3!)
tmp7%=3dx(tx4!,tz4!)
tmp8%=3dy(ty4!,tz4!)
if drawpoly( tmp1%,tmp2% , tmp3%,tmp4% , tmp5%,tmp6% ,tmp7%,tmp8% )
endif
endproc
proc init_objects
if push_3d_box (-25,-25,-25 , 25,25,25)
if push_3d_box (-10,-10,-10 , 10,10,10)
if push_3d_box (-100,-25,.1 , -50,25,50)
if push_3d_box (50,-25,.1 , 100,25,50)
return obj_s%
endif
endif
endif
return 0
endproc
proc init_engine
return init_mainWindow(clear_3d_stacks())
endproc
proc init_mainWindow
if @%(1)
windowstyle 80
window 0,0 - 1024,768
distlb&=createsortedlistbox(%hwnd,,0,0,180,50)
setfont distlb&,createfont (Small Fonts,8,0,0,0,0)
showwindow(distlb&,0)
return %hwnd
endif
return 0
endproc
proc push_3d_box
parameters x!,y!,z!,xt!,yt!,zt!
inc obj_s%
tmp1%=push_vertex(x!,y!,z!)
tmp2%=push_vertex(xt!,y!,z!)
tmp3%=push_vertex(xt!,y!,zt!)
tmp4%=push_vertex(x!,y!,zt!)
tmp5%=push_vertex(x!,yt!,z!)
tmp6%=push_vertex(xt!,yt!,z!)
tmp7%=push_vertex(xt!,yt!,zt!)
tmp8%=push_vertex(x!,yt!,zt!)
if push_mesh(tmp1%,tmp2%,tmp3%,tmp4%)1 top
if push_mesh(tmp5%,tmp6%,tmp7%,tmp8%)2 bottom
if push_mesh(tmp4%,tmp3%,tmp7%,tmp8%)2 back
if push_mesh(tmp1%,tmp2%,tmp6%,tmp5%)2 front
if push_mesh(tmp1%,tmp4%,tmp8%,tmp5%)2 left
if push_mesh(tmp2%,tmp3%,tmp7%,tmp6%)2 right
endif
endif
endif
endif
endif
endif
return obj_s%
endproc
proc push_mesh(vtexn1,vtexn2,vtexn3)
parameters vtexn1%,vtexn2%,vtexn3%,vtexn4%
inc mesh_s%
mesh%[mesh_s%,1]=vtexn1%
mesh%[mesh_s%,2]=vtexn2%
mesh%[mesh_s%,3]=vtexn3%
mesh%[mesh_s%,4]=vtexn4%
return mesh_s%
endproc
proc clear_3d_stacks()
_sense%=1
vpx!=0
vpy!=0
vpz!=-200
vpa!=1
vprx!=0
vpry!=0
vprz!=0
clear vtex_z![]
clear vtex_y![]
clear vtex_x![]
vtex_s%=0
obj_s%=0
mesh_s%=0
efps&=0
fps&=0
tm&=&gettickcount
return 1
endproc
proc push_vertex(x!,y!,z!)
parameters x!,y!,z!
inc vtex_s%
vtex_x![vtex_s%]=x!
vtex_y![vtex_s%]=y!
vtex_z![vtex_s%]=z!
return vtex_s%
endproc
Proc DrawPoly
Parameters X%,y%,xx%,yy%,xxx%,yyy%,xxxx%,yyyy%
Long pg#,0 = x%
Long pg#,4 = y%
Long pg#,8 = xx%
Long pg#,12= yy%
Long pg#,16= xxx%
Long pg#,20= yyy% Long pg#,24= xxxx%
Long pg#,24= xxxx%
Long pg#,28= yyyy%
Polygon (%hdc,pg#,4)
Endproc
tx1!=3dx(x!,z!)
tx2!=3dx(xt!,z!)
tx3!=3dx(x!,zt!)
tx4!=3dx(xt!,zt!)
ty1!=3dy(y!,z!)
ty2!=3dy(yt!,z!)
ty3!=3dy(y!,zt!)
ty4!=3dy(yt!,zt!)
line tx1!,ty1! - tx2!,ty1!
line tx1!,ty1! - tx1!,ty2!
line tx1!,ty2! - tx2!,ty2!
line tx2!,ty1! - tx2!,ty2!
line tx3!,ty3! - tx4!,ty3!
line tx3!,ty3! - tx3!,ty4!
line tx3!,ty4! - tx4!,ty4!
line tx4!,ty3! - tx4!,ty4!
line tx1!,ty1! - tx3!,ty3!
line tx2!,ty2! - tx4!,ty4!
line tx1!,ty2! - tx3!,ty4!
line tx2!,ty1! - tx4!,ty3!
proc 3d_lin
parameters x1!,y1!,z1!,x2!,y2!,z2!
line 3dx(x1!,z1!),3dy(y1!,z1!) - 3dx(x2!,z2!),3dy(y2!,z2!)
endproc
KompilierenMarkierenSeparierenmouseinc for 3der
procedure.inc must be before
declare mouse_g2lstrc#
def mouse_g2lx(0) long(mouse_g2lstrc#,0)
def mouse_g2ly(0) long(mouse_g2lstrc#,4)
dim mouse_g2lstrc#,8
Def mouse_event(5) !USER32,mouse_event
def mouse_c2s(2) !USER32,ClientToScreen
proc mouse_g2l
parameters hdl&
clear mouse_g2lstrc#
mouse_c2s (hdl&,mouse_g2lstrc#)
endproc
proc mouse.exitappp
dispose mouse_g2lstrc#
dispose RECT_alaMouse#
dispose RECT_alaMouse_thread#
dispose GlobMousePos#
dispose GlobMousePos_thread#
endproc
Def GetAsyncKeyState(1) !USER32,GetAsyncKeyState
Def lm_(0) Neq(GetAsyncKeyState(1),0)
Def rm_(0) Neq(GetAsyncKeyState(2),0)
DEF SetCursorPos(2) !USER32,SetCursorPos
DEF GetCursorPos(1) !USER32,GetCursorPos
DEF LMousefield(4) and(and(gt(L_Mousex%,@%(1)),gt(L_Mousey%,@%(2))),and(lt(L_Mousex%,@%(3)),lt(L_Mousey%,@%(4))))
DEF Mousefield(4) and(and(gt(L_Mousex%,@%(1)),gt(L_Mousey%,@%(2))),and(lt(L_Mousex%,@%(3)),lt(L_Mousey%,@%(4))))
DEF GMousefield(4) and(and(gt(G_Mousex%,@%(1)),gt(G_Mousey%,@%(2))),and(lt(G_Mousex%,@%(3)),lt(G_Mousey%,@%(4))))
Def ClipCursor(1) !USER32,ClipCursor
Declare RECT_alaMouse#
Dim RECT_alaMouse#,16
Declare RECT_alaMouse_thread#
Dim RECT_alaMouse_thread#,16
Declare G_Mousex%,G_Mousey%
Declare L_Mousex%,L_Mousey%
Declare G_Mousex_thread%,G_Mousey_thread%
Declare GlobMousePos#
Dim GlobMousePos#,8
Declare GlobMousePos_thread#
Dim GlobMousePos_thread#,8
Proc GetMousePos
GetCursorPos(globMousepos#)
Let G_Mousex%=long(GlobMousePos#,0)
Let G_MouseY%=long(GlobMousePos#,4)
Let L_Mousex%=sub(G_Mousex%,%Winleft)
Let L_MouseY%=sub(G_Mousey%,%WinTop)
Endproc
Proc GetMousePos_thread
GetCursorPos(globMousepos_thread#)
Let G_Mousex_thread%=long(GlobMousePos_thread#,0)
Let G_MouseY_thread%=long(GlobMousePos_thread#,4)
Endproc
Proc SetMousePos
Parameters X%,Y%
SetcursorPos (X%,Y%)
Endproc
Proc ClipMouse
Parameters X%,y%,xx%,yy%
Long RECT_alaMouse#,0 = x%
Long RECT_alaMouse#,4 = y%
Long RECT_alaMouse#,8 = xx%
Long RECT_alaMouse#,12= yy%
ClipCursor (RECT_alaMouse#)
dispose rect#
Endproc
KompilierenMarkierenSeparieren $P*
$I mouse.inc
decimals 5
DEF Polygon(3) !GDI32,Polygon
declare tx1!,ty1!,tz1!,tx2!,ty2!,tz2!,tx3!,ty3!,tz3!,tx4!,ty4!,tz4!,tx5!,ty5!,tz5!,cx%,pg#,xd!,yd!,zd!needs engine
declare dist!,dist1!,dist2!,dist3!,distlb&mesh/vertex-distances
declare tmp1%,tmp2%,tmp3%,tmp4%,tmp5%,tmp6%,tmp7%,tmp8%,tmp9%,tmp10%,tmps$
declare vpx!,vpy!,vpz!,vpa!,vprx!,vpry!,vprz!viewport
declare fps&,efps&,tm&
declare mx!,my!,_sense%needs engine
declare box1%
def !cam_w 1024
def !cam_h 0768
def !cam_fx 0512
def !cam_fy 0384
def !vpa 10
SetMousePos 512,384
def 3dx(2) (((vpx!+@!(1)))/(vpz!+@!(2)))+!cam_fx
def 3dy(2) (((vpy!+@!(1)))/(vpz!+@!(2)))+!cam_fy
def 3dx(2) ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100))+!cam_fx
def 3dy(2) ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100))+!cam_fy
def 3dx(2) ( ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100)) * cos(vprx!) + @!(2)*sin(vprx!)) +!cam_fx
def 3dy(2) ( ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100)) ) +!cam_fy
def 3dx(2) ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100))+!cam_fx
def 3dy(2) ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100))+!cam_fy
x´ = x * cos (a) + z * sin (a)
z´ = - x * sin (a) + z * cos (a)
declare vtex_s% vertex-stack
declare vtex_x![250]
declare vtex_y![250]
declare vtex_z![250]
declare mesh_s%
declare meshs_f%
declare mesh%[250,4]
declare obj_s% object-stack
declare object%[100,2] object-stack
declare scene_s% scenerende-vertexstack
destroywindow(main(init_engine()))
end
proc main
if @%(1)
if init_objects()
Dim Pg#,50
mcls 1024,768
startpaint -1
usefont MS Sans Serif,14,0,0,0,0
textcolor rgb(255,255,255),-1
endpaint
while _sense%
cls
fps.cnt.eng
case %mousepressed=1 : vpz!=vpz!-4
case %mousepressed=2 : vpz!=vpz!+4
mx!=%mousex-!cam_fx
my!=%mousey-!cam_fy
vpx!=mx!/5
vpy!=my!/5
vpy!=my!
startpaint -1
cls 0
usepen 0,1,rgb(192,0,0)
usebrush 1,rgb(255,0,0)
if draw_scene(calc_scene())
endif
drawtext 0,755,iF+str$(efps&)+ fps
endpaint
showwindow(distlb&,0)
mcopybmp 0,0 - 1024,768 > 0,0;0
showwindow(distlb&,1)
getmessage
case equ(%scankey,65) : dec _sense%
locate 1,1
print %scankey<37>39^38|40
if 1equ(%scankey,66)
rotateobject box1%,mx!/1000,my!/1000,0
endif
wend
dispose pg#
endif
return %hwnd
endif
return %hinstance
endproc
proc rotateobject
parameters obn%,x!,y!,z!
whileloop object%[obn%,1],object%[obn%,2],1
rotatevertex &loop,x!,y!,z!
wend
endproc
proc fps.cnt.eng
fps&=fps&+1
if (&gettickcount>tm&)
efps&=fps&
tm&=tm&+1000
fps&=0
endif
endproc
proc rotatevertex
parameters vn%,xr!,yr!,zr!
declare vx!,vz!,vy!
ifnot xr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_x![vn%]=vx!*cos(xr!) + vz!*sin(xr!)
vtex_z![vn%]=(vx!*-1)*sin(xr!) + vz!*cos(xr!)
endif
ifnot yr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_y![vn%]=vy!*cos(yr!) + vz!*sin(yr!)
vtex_z![vn%]=(vy!*-1)*sin(yr!) + vz!*cos(yr!)
endif
ifnot zr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_x![vn%]=vx!*cos(zr!)-vy!*sin(zr!)
vtex_y![vn%]=vx!*sin(zr!)+vy!*cos(zr!)
endif
endproc
proc calc_scene
cx%=0
sendmessage(distlb&,$0184,0,0)
meshs_f%=0
while cx%<mesh_s%
inc cx%
if calc_mesh(cx%)
endif
wend
endproc
proc draw_scene
locate 1,1
cx%=0
while cx%<meshs_f%
inc cx%
if draw_mesh(val(substr$(getstring$(distlb&,meshs_f%-cx%),2, )))
endif
wend
endproc
proc calc_mesh
tx5!=vpx!
ty5!=vpy!
tz5!=vpz!
tx1!=(vtex_x![mesh%[@%(1),1]])
tx2!=(vtex_x![mesh%[@%(1),2]])
tx3!=(vtex_x![mesh%[@%(1),3]])
tx4!=(vtex_x![mesh%[@%(1),4]])
ty1!=(vtex_y![mesh%[@%(1),1]])
ty2!=(vtex_y![mesh%[@%(1),2]])
ty3!=(vtex_y![mesh%[@%(1),3]])
ty4!=(vtex_y![mesh%[@%(1),4]])
tz1!=(vtex_z![mesh%[@%(1),1]])
tz2!=(vtex_z![mesh%[@%(1),2]])
tz3!=(vtex_z![mesh%[@%(1),3]])
tz4!=(vtex_z![mesh%[@%(1),4]])
xd! = ((tx4!+tx1!+tx2!+tx3!)/4+vpx! ) /2
yd! = ((ty4!+ty1!+ty2!+ty3!)/4+vpy! ) /2
zd! = ((tz4!+tz1!+tz2!+tz3!)/4+vpz! ) /2
dist!= sqrt(xd!*xd! + yd!*yd! + zd!*zd!) /8
if dist!<99
if dist!>=10
inc meshs_f%
tmps$=str$(dist!)+ +str$(@%(1))+ +str$(xd!)+ +str$(yd!)+ +str$(zd!)
sendmessage (distlb&,$180,0,addr(tmps$))
elseif dist!>=1
inc meshs_f%
tmps$=0+str$(dist!)+ +str$(@%(1))+ +str$(xd!)+ +str$(yd!)+ +str$(zd!)
sendmessage (distlb&,$180,0,addr(tmps$))
endif
endif
endproc
proc draw_mesh
tx1!=vtex_x![mesh%[@%(1),1]]
ty1!=vtex_y![mesh%[@%(1),1]]
tz1!=vtex_z![mesh%[@%(1),1]]
tx2!=vtex_x![mesh%[@%(1),2]]
ty2!=vtex_y![mesh%[@%(1),2]]
tz2!=vtex_z![mesh%[@%(1),2]]
tx3!=vtex_x![mesh%[@%(1),3]]
ty3!=vtex_y![mesh%[@%(1),3]]
tz3!=vtex_z![mesh%[@%(1),3]]
tx4!=vtex_x![mesh%[@%(1),4]]
ty4!=vtex_y![mesh%[@%(1),4]]
tz4!=vtex_z![mesh%[@%(1),4]]
drawpoly 3dx(tx1!,tz1!),3dy(ty1!,tz1!) , 3dx(tx2!,tz2!),3dy(ty2!,tz2!) , 3dx(tx3!,tz3!),3dy(ty3!,tz3!) ,3dx(tx4!,tz4!),3dy(ty4!,tz4!)
endproc
proc init_objects
box1%=push_3d_box (-25,-25,-25 , 25,25,25)
return obj_s%
endproc
proc init_engine
return init_mainWindow(clear_3d_stacks())
endproc
proc init_mainWindow
if @%(1)
windowstyle 80
window 0,0 - 1024,768
distlb&=createsortedlistbox(%hwnd,,0,0,180,50)
setfont distlb&,createfont (Small Fonts,8,0,0,0,0)
showwindow(distlb&,0)
return %hwnd
endif
return 0
endproc
proc beginobject
inc obj_s%
object%[obj_s%,1]=vtex_s%+1
return 1
endproc
proc endobject
object%[obj_s%,2]=vtex_s%
return obj_s%
endproc
proc push_3d_box
parameters x!,y!,z!,xt!,yt!,zt!
beginobject
tmp1%=push_vertex(x!,y!,z!)
tmp2%=push_vertex(xt!,y!,z!)
tmp3%=push_vertex(xt!,y!,zt!)
tmp4%=push_vertex(x!,y!,zt!)
tmp5%=push_vertex(x!,yt!,z!)
tmp6%=push_vertex(xt!,yt!,z!)
tmp7%=push_vertex(xt!,yt!,zt!)
tmp8%=push_vertex(x!,yt!,zt!)
return endobject(push_mesh(tmp1%,tmp2%,tmp3%,tmp4%),push_mesh (tmp5%,tmp6%,tmp7%,tmp8%),push_mesh (tmp4%,tmp3%,tmp7%,tmp8%),push_mesh (tmp1%,tmp2%,tmp6%,tmp5%),push_mesh (tmp1%,tmp4%,tmp8%,tmp5%),push_mesh (tmp2%,tmp3%,tmp7%,tmp6%))
endproc
proc push_mesh(vtexn1,vtexn2,vtexn3)
parameters vtexn1%,vtexn2%,vtexn3%,vtexn4%
inc mesh_s%
mesh%[mesh_s%,1]=vtexn1%
mesh%[mesh_s%,2]=vtexn2%
mesh%[mesh_s%,3]=vtexn3%
mesh%[mesh_s%,4]=vtexn4%
return mesh_s%
endproc
proc clear_3d_stacks()
_sense%=1
vpx!=0
vpy!=0
vpz!=-200
vpa!=1
vprx!=0
vpry!=0
vprz!=0
clear vtex_z![]
clear vtex_y![]
clear vtex_x![]
vtex_s%=0
obj_s%=0
mesh_s%=0
efps&=0
fps&=0
tm&=&gettickcount
return 1
endproc
proc push_vertex(x!,y!,z!)
parameters x!,y!,z!
inc vtex_s%
vtex_x![vtex_s%]=x!
vtex_y![vtex_s%]=y!
vtex_z![vtex_s%]=z!
return vtex_s%
endproc
Proc DrawPoly
Parameters X%,y%,xx%,yy%,xxx%,yyy%,xxxx%,yyyy%
Long pg#,0 = x%
Long pg#,4 = y%
Long pg#,8 = xx%
Long pg#,12= yy%
Long pg#,16= xxx%
Long pg#,20= yyy% Long pg#,24= xxxx%
Long pg#,24= xxxx%
Long pg#,28= yyyy%
Polygon (%hdc,pg#,4)
Endproc
tx1!=3dx(x!,z!)
tx2!=3dx(xt!,z!)
tx3!=3dx(x!,zt!)
tx4!=3dx(xt!,zt!)
ty1!=3dy(y!,z!)
ty2!=3dy(yt!,z!)
ty3!=3dy(y!,zt!)
ty4!=3dy(yt!,zt!)
line tx1!,ty1! - tx2!,ty1!
line tx1!,ty1! - tx1!,ty2!
line tx1!,ty2! - tx2!,ty2!
line tx2!,ty1! - tx2!,ty2!
line tx3!,ty3! - tx4!,ty3!
line tx3!,ty3! - tx3!,ty4!
line tx3!,ty4! - tx4!,ty4!
line tx4!,ty3! - tx4!,ty4!
line tx1!,ty1! - tx3!,ty3!
line tx2!,ty2! - tx4!,ty4!
line tx1!,ty2! - tx3!,ty4!
line tx2!,ty1! - tx4!,ty3!
proc 3d_lin
parameters x1!,y1!,z1!,x2!,y2!,z2!
line 3dx(x1!,z1!),3dy(y1!,z1!) - 3dx(x2!,z2!),3dy(y2!,z2!)
endproc
KompilierenMarkierenSeparieren $P*
$I mouse.inc
decimals 5
DEF Polygon(3) !GDI32,Polygon
declare tx1!,ty1!,tz1!,tx2!,ty2!,tz2!,tx3!,ty3!,tz3!,tx4!,ty4!,tz4!,tx5!,ty5!,tz5!,cx%,pg#,xd!,yd!,zd!needs engine
declare dist!,dist1!,dist2!,dist3!,distlb&mesh/vertex-distances
declare tmp1%,tmp2%,tmp3%,tmp4%,tmp5%,tmp6%,tmp7%,tmp8%,tmp9%,tmp10%,tmps$
declare vpx!,vpy!,vpz!,vpa!,vprx!,vpry!,vprz!viewport
declare fps&,efps&,tm&
declare mx!,my!,_sense%needs engine
declare box1%,box2%
def !cam_w 1024
def !cam_h 0768
def !cam_fx 0512
def !cam_fy 0384
def !vpa 10
SetMousePos 512,384
def 3dx(2) ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100))+!cam_fx
def 3dy(2) ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100))+!cam_fy
declare vtex_s% vertex-stack
declare vtex_x![250]
declare vtex_y![250]
declare vtex_z![250]
declare mesh_s%
declare meshs_f%
declare mesh%[250,4]
declare obj_s% object-stack
declare object%[100,2] object-stack
declare objpos![100,3] object-pos
declare scene_s% scenerende-vertexstack
destroywindow(main(init_engine()))
end
proc main
if @%(1)
if init_objects()
Dim Pg#,50
mcls 1024,768
startpaint -1
usefont MS Sans Serif,14,0,0,0,0
textcolor rgb(255,255,255),-1
endpaint
while _sense%
cls
fps.cnt.eng
mx!=%mousex-!cam_fx
my!=%mousey-!cam_fy
vpx!=mx!/5
vpy!=my!/5
vpy!=my!
startpaint -1
cls 0
usepen 0,1,rgb(192,0,0)
usebrush 1,rgb(255,0,0)
if draw_scene(calc_scene())
endif
drawtext 0,755,iF+str$(efps&)+ fps
endpaint
showwindow(distlb&,0)
mcopybmp 0,0 - 1024,768 > 0,0;0
showwindow(distlb&,1)
getmessage
case equ(%scankey,65) : dec _sense%
locate 1,1
print %scankey<37>39^38|40
if 1equ(%scankey,66)
moveobject box2%,mx!/1000,my!/1000,0
rotateobject box2%,0.1,0.1,0
rotateobjectvsobject box1%,0.1,0.0,0.1,box2%
rotateobjectvsobject box3%,0.005,0.0,0.0,box2%
endif
case %mousepressed=1 : moveobject box1%,0,0,1
case %mousepressed=2 : moveobject box1%,0,0,-1
wend
dispose pg#
endif
return %hwnd
endif
return %hinstance
endproc
proc rotateobject
parameters obn%,x!,y!,z!
whileloop object%[obn%,1],object%[obn%,2],1
rotatevertex &loop,x!,y!,z!
wend
endproc
proc rotateobjectvsobject
parameters obn%,x!,y!,z!,vs%
if vs%
tx1!=objpos![vs%,1]
ty1!=objpos![vs%,2]
tz1!=objpos![vs%,3]
else
tx1!=vpx!
ty1!=vpy!
tz1!=vpz!
endif
moveobject obn%,tx1!*-1,ty1!*-1,tz1!*-1
whileloop object%[obn%,1],object%[obn%,2],1
rotatevertex &loop,x!,y!,z!
wend
moveobject obn%,tx1!,ty1!,tz1!
endproc
proc fps.cnt.eng
fps&=fps&+1
if (&gettickcount>tm&)
efps&=fps&
tm&=tm&+1000
fps&=0
endif
endproc
proc rotatevertex
parameters vn%,xr!,yr!,zr!
declare vx!,vz!,vy!
ifnot xr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_x![vn%]=vx!*cos(xr!) + vz!*sin(xr!)
vtex_z![vn%]=(vx!*-1)*sin(xr!) + vz!*cos(xr!)
endif
ifnot yr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_y![vn%]=vy!*cos(yr!) + vz!*sin(yr!)
vtex_z![vn%]=(vy!*-1)*sin(yr!) + vz!*cos(yr!)
endif
ifnot zr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_x![vn%]=vx!*cos(zr!)-vy!*sin(zr!)
vtex_y![vn%]=vx!*sin(zr!)+vy!*cos(zr!)
endif
endproc
proc calc_scene
cx%=0
sendmessage(distlb&,$0184,0,0)
meshs_f%=0
while cx%<mesh_s%
inc cx%
if calc_mesh(cx%)
endif
wend
endproc
proc draw_scene
locate 1,1
cx%=0
while cx%<meshs_f%
inc cx%
if draw_mesh(val(substr$(getstring$(distlb&,meshs_f%-cx%),2, )))
endif
wend
endproc
proc calc_mesh
tx5!=vpx!
ty5!=vpy!
tz5!=vpz!
tx1!=(vtex_x![mesh%[@%(1),1]])
tx2!=(vtex_x![mesh%[@%(1),2]])
tx3!=(vtex_x![mesh%[@%(1),3]])
tx4!=(vtex_x![mesh%[@%(1),4]])
ty1!=(vtex_y![mesh%[@%(1),1]])
ty2!=(vtex_y![mesh%[@%(1),2]])
ty3!=(vtex_y![mesh%[@%(1),3]])
ty4!=(vtex_y![mesh%[@%(1),4]])
tz1!=(vtex_z![mesh%[@%(1),1]])
tz2!=(vtex_z![mesh%[@%(1),2]])
tz3!=(vtex_z![mesh%[@%(1),3]])
tz4!=(vtex_z![mesh%[@%(1),4]])
xd! = ((tx4!+tx1!+tx2!+tx3!)/4+vpx! )
yd! = ((ty4!+ty1!+ty2!+ty3!)/4+vpy! )
zd! = ((tz4!+tz1!+tz2!+tz3!)/4+vpz! )
dist!= sqrt(xd!*xd! + yd!*yd! + zd!*zd!) /16
if dist!<99
if dist!>=10
inc meshs_f%
tmps$=str$(dist!)+ +str$(@%(1))
sendmessage (distlb&,$180,0,addr(tmps$))
elseif dist!>=1
inc meshs_f%
tmps$=0+str$(dist!)+ +str$(@%(1))
sendmessage (distlb&,$180,0,addr(tmps$))
endif
endif
endproc
proc draw_mesh
tx1!=vtex_x![mesh%[@%(1),1]]
ty1!=vtex_y![mesh%[@%(1),1]]
tz1!=vtex_z![mesh%[@%(1),1]]
tx2!=vtex_x![mesh%[@%(1),2]]
ty2!=vtex_y![mesh%[@%(1),2]]
tz2!=vtex_z![mesh%[@%(1),2]]
tx3!=vtex_x![mesh%[@%(1),3]]
ty3!=vtex_y![mesh%[@%(1),3]]
tz3!=vtex_z![mesh%[@%(1),3]]
tx4!=vtex_x![mesh%[@%(1),4]]
ty4!=vtex_y![mesh%[@%(1),4]]
tz4!=vtex_z![mesh%[@%(1),4]]
drawpoly 3dx(tx1!,tz1!),3dy(ty1!,tz1!) , 3dx(tx2!,tz2!),3dy(ty2!,tz2!) , 3dx(tx3!,tz3!),3dy(ty3!,tz3!) ,3dx(tx4!,tz4!),3dy(ty4!,tz4!)
endproc
Proc scaleobject
parameters objn%,x!,y!,z!
whileloop object%[objn%,1],object%[objn%,2],1
vtex_x![&loop]=vtex_x![&loop]*x!
vtex_y![&loop]=vtex_y![&loop]*y!
vtex_z![&loop]=vtex_z![&loop]*z!
wend
endproc
proc moveobject
parameters objn%,x!,y!,z!
objpos![objn%,1]=objpos![objn%,1]+x!
objpos![objn%,2]=objpos![objn%,2]+y!
objpos![objn%,3]=objpos![objn%,3]+z!
whileloop object%[objn%,1],object%[objn%,2],1
vtex_x![&loop]=vtex_x![&loop]+x!
vtex_y![&loop]=vtex_y![&loop]+y!
vtex_z![&loop]=vtex_z![&loop]+z!
wend
endproc
proc init_objects
box1%=push_3d_box()
moveobject box1%,-30,0,0
box2%=push_3d_box()
moveobject box2%,0,0,0
return obj_s%
endproc
proc init_engine
return init_mainWindow(clear_3d_stacks())
endproc
proc init_mainWindow
if @%(1)
windowstyle 80
window 0,0 - 1024,768
distlb&=createsortedlistbox(%hwnd,,0,0,180,50)
setfont distlb&,createfont (Small Fonts,8,0,0,0,0)
showwindow(distlb&,0)
return %hwnd
endif
return 0
endproc
proc beginobject
inc obj_s%
object%[obj_s%,1]=vtex_s%+1
objpos![obj_s%,1]=0
objpos![obj_s%,2]=0
objpos![obj_s%,3]=0
return 1
endproc
proc endobject
object%[obj_s%,2]=vtex_s%
return obj_s%
endproc
proc push_3d_box
declare x!,y!,z!,xt!,yt!,zt!
x!=-10
y!=-10
z!=-10
xt!=10
yt!=10
zt!=10
beginobject
tmp1%=push_vertex(x!,y!,z!)
tmp2%=push_vertex(xt!,y!,z!)
tmp3%=push_vertex(xt!,y!,zt!)
tmp4%=push_vertex(x!,y!,zt!)
tmp5%=push_vertex(x!,yt!,z!)
tmp6%=push_vertex(xt!,yt!,z!)
tmp7%=push_vertex(xt!,yt!,zt!)
tmp8%=push_vertex(x!,yt!,zt!)
return endobject(push_mesh(tmp1%,tmp2%,tmp3%,tmp4%),push_mesh (tmp5%,tmp6%,tmp7%,tmp8%),push_mesh (tmp4%,tmp3%,tmp7%,tmp8%),push_mesh (tmp1%,tmp2%,tmp6%,tmp5%),push_mesh (tmp1%,tmp4%,tmp8%,tmp5%),push_mesh (tmp2%,tmp3%,tmp7%,tmp6%))
endproc
proc push_mesh(vtexn1,vtexn2,vtexn3)
parameters vtexn1%,vtexn2%,vtexn3%,vtexn4%
inc mesh_s%
mesh%[mesh_s%,1]=vtexn1%
mesh%[mesh_s%,2]=vtexn2%
mesh%[mesh_s%,3]=vtexn3%
mesh%[mesh_s%,4]=vtexn4%
return mesh_s%
endproc
proc clear_3d_stacks()
_sense%=1
vpx!=0
vpy!=0
vpz!=200
vpa!=1
vprx!=0
vpry!=0
vprz!=0
clear vtex_z![]
clear vtex_y![]
clear vtex_x![]
vtex_s%=0
obj_s%=0
mesh_s%=0
efps&=0
fps&=0
tm&=&gettickcount
return 1
endproc
proc push_vertex(x!,y!,z!)
parameters x!,y!,z!
inc vtex_s%
vtex_x![vtex_s%]=x!
vtex_y![vtex_s%]=y!
vtex_z![vtex_s%]=z!
return vtex_s%
endproc
Proc DrawPoly
Parameters X%,y%,xx%,yy%,xxx%,yyy%,xxxx%,yyyy%
Long pg#,0 = x%
Long pg#,4 = y%
Long pg#,8 = xx%
Long pg#,12= yy%
Long pg#,16= xxx%
Long pg#,20= yyy% Long pg#,24= xxxx%
Long pg#,24= xxxx%
Long pg#,28= yyyy%
Polygon (%hdc,pg#,4)
Endproc
tx1!=3dx(x!,z!)
tx2!=3dx(xt!,z!)
tx3!=3dx(x!,zt!)
tx4!=3dx(xt!,zt!)
ty1!=3dy(y!,z!)
ty2!=3dy(yt!,z!)
ty3!=3dy(y!,zt!)
ty4!=3dy(yt!,zt!)
line tx1!,ty1! - tx2!,ty1!
line tx1!,ty1! - tx1!,ty2!
line tx1!,ty2! - tx2!,ty2!
line tx2!,ty1! - tx2!,ty2!
line tx3!,ty3! - tx4!,ty3!
line tx3!,ty3! - tx3!,ty4!
line tx3!,ty4! - tx4!,ty4!
line tx4!,ty3! - tx4!,ty4!
line tx1!,ty1! - tx3!,ty3!
line tx2!,ty2! - tx4!,ty4!
line tx1!,ty2! - tx3!,ty4!
line tx2!,ty1! - tx4!,ty3!
proc 3d_lin
parameters x1!,y1!,z1!,x2!,y2!,z2!
line 3dx(x1!,z1!),3dy(y1!,z1!) - 3dx(x2!,z2!),3dy(y2!,z2!)
endproc
KompilierenMarkierenSeparieren $P*
$I mouse.inc
decimals 5
DEF Polygon(3) !GDI32,Polygon
Def keyy(1) !USER32,GetKeyState
declare tx1!,ty1!,tz1!,tx2!,ty2!,tz2!,tx3!,ty3!,tz3!,tx4!,ty4!,tz4!,tx5!,ty5!,tz5!,cx%,pg#,xd!,yd!,zd!needs engine
declare dist!,dist1!,dist2!,dist3!,distlb&mesh/vertex-distances
declare tmp1%,tmp2%,tmp3%,tmp4%,tmp5%,tmp6%,tmp7%,tmp8%,tmp9%,tmp10%,tmps$
declare vpx!,vpy!,vpz!,vpa!,vprx!,vpry!,vprz!viewport
declare fps&,efps&,tm&
declare mx!,my!,_sense%needs engine
declare box1%,box2%
def !cam_w 1024
def !cam_h 0768
def !cam_fx 0512
def !cam_fy 0384
def !vpa 10
SetMousePos 512,384
showcursor 0
def 3dx(2) ((!vpa*(vpx!+@!(1)))/((vpz!+@!(2))/100))+!cam_fx
def 3dy(2) ((!vpa*(vpy!+@!(1)))/((vpz!+@!(2))/100))+!cam_fy
declare vtex_s% vertex-stack
declare vtex_x![250]
declare vtex_y![250]
declare vtex_z![250]
declare mesh_s%
declare meshs_f%
declare mesh%[250,4]
declare obj_s% object-stack
declare object%[100,2] object-stack
declare objpos![100,3] object-pos
declare scene_s% scenerende-vertexstack
destroywindow(main(init_engine()))
end
proc main
if @%(1)
if init_objects()
Dim Pg#,50
mcls 1024,768
startpaint -1
usefont MS Sans Serif,14,0,0,0,0
textcolor rgb(255,255,255),-1
endpaint
while _sense%
cls
fps.cnt.eng
mx!=%mousex-!cam_fx
my!=%mousey-!cam_fy
iF neq(%mousex ,512)
SetMousePos 512,384
endif
vpx!=mx!/5
vpy!=my!/5
vpy!=my!
startpaint -1
cls 0
usepen 0,1,rgb(192,0,0)
usebrush 1,rgb(255,0,0)
if draw_scene(calc_scene())
endif
drawtext 0,755,iF+str$(efps&)+ fps
endpaint
showwindow(distlb&,0)
mcopybmp 0,0 - 1024,768 > 0,0;0
showwindow(distlb&,1)
getmessage
case equ(%scankey,65) : dec _sense%
locate 1,1
print %scankey<37>39^38|40
if 1equ(%scankey,66)
moveobject box2%,mx!/1000,my!/1000,0
rotateobject box2%,0.1,0.1,0
rotateworld mx!/-1000,0.0,0,0
endif
case or( lt(keyy(38),-1) , %mousepressed=1 ) : vpz!=vpz!+1.1
case or( lt(keyy(40),-1) , %mousepressed=2 ): vpz!=vpz!-1.1
case lt(keyy(37),-1) : moveworld -0.5,0,0
case lt(keyy(39),-1) : moveworld 0.5,0,0
case %mousepressed=1 : moveobject box1%,0,0,1
case %mousepressed=2 : moveobject box1%,0,0,-1
wend
dispose pg#
endif
return %hwnd
endif
return %hinstance
endproc
proc moveworld
parameters x!,y!,z!
whileloop obj_S%
moveobject &loop,x!,y!,z!
wend
endproc
proc rotateworld
parameters x!,y!,z!
whileloop obj_S%
rotateobjectvsobject &loop,x!,y!,z!,0
wend
endproc
proc rotateobject
parameters obn%,x!,y!,z!
whileloop object%[obn%,1],object%[obn%,2],1
rotatevertex &loop,x!,y!,z!
wend
endproc
proc rotateobjectvsobject
parameters obn%,x!,y!,z!,vs%
if vs%
tx1!=objpos![vs%,1]
ty1!=objpos![vs%,2]
tz1!=objpos![vs%,3]
else
tx1!=vpx!
ty1!=vpy!
tz1!=vpz!
endif
moveobject obn%,tx1!*-1,ty1!*-1,tz1!
whileloop object%[obn%,1],object%[obn%,2],1
rotatevertex &loop,x!,y!,z!
wend
moveobject obn%,tx1!,ty1!,tz1!*-1
endproc
proc fps.cnt.eng
fps&=fps&+1
if (&gettickcount>tm&)
efps&=fps&
tm&=tm&+1000
fps&=0
endif
endproc
proc rotatevertex
parameters vn%,xr!,yr!,zr!
declare vx!,vz!,vy!
ifnot xr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_x![vn%]=vx!*cos(xr!) + vz!*sin(xr!)
vtex_z![vn%]=(vx!*-1)*sin(xr!) + vz!*cos(xr!)
endif
ifnot yr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_y![vn%]=vy!*cos(yr!) + vz!*sin(yr!)
vtex_z![vn%]=(vy!*-1)*sin(yr!) + vz!*cos(yr!)
endif
ifnot zr!=0
vx!=vtex_x![vn%]
vy!=vtex_y![vn%]
vz!=vtex_z![vn%]
vtex_x![vn%]=vx!*cos(zr!)-vy!*sin(zr!)
vtex_y![vn%]=vx!*sin(zr!)+vy!*cos(zr!)
endif
endproc
proc calc_scene
cx%=0
sendmessage(distlb&,$0184,0,0)
meshs_f%=0
while cx%<mesh_s%
inc cx%
if calc_mesh(cx%)
endif
wend
endproc
proc draw_scene
locate 1,1
cx%=0
while cx%<meshs_f%
inc cx%
if draw_mesh(val(substr$(getstring$(distlb&,meshs_f%-cx%),2, )))
endif
wend
endproc
proc calc_mesh
tx5!=vpx!
ty5!=vpy!
tz5!=vpz!
tx1!=(vtex_x![mesh%[@%(1),1]])
tx2!=(vtex_x![mesh%[@%(1),2]])
tx3!=(vtex_x![mesh%[@%(1),3]])
tx4!=(vtex_x![mesh%[@%(1),4]])
ty1!=(vtex_y![mesh%[@%(1),1]])
ty2!=(vtex_y![mesh%[@%(1),2]])
ty3!=(vtex_y![mesh%[@%(1),3]])
ty4!=(vtex_y![mesh%[@%(1),4]])
tz1!=(vtex_z![mesh%[@%(1),1]])
tz2!=(vtex_z![mesh%[@%(1),2]])
tz3!=(vtex_z![mesh%[@%(1),3]])
tz4!=(vtex_z![mesh%[@%(1),4]])
xd! = ((tx4!+tx1!+tx2!+tx3!)/4+vpx! )
yd! = ((ty4!+ty1!+ty2!+ty3!)/4+vpy! )
zd! = ((tz4!+tz1!+tz2!+tz3!)/4+vpz! )
dist!= sqrt(xd!*xd! + yd!*yd! + zd!*zd!) /8
case zd! > -20 : return
if dist!<99
if dist!>=10
inc meshs_f%
tmps$=str$(dist!)+ +str$(@%(1))
sendmessage (distlb&,$180,0,addr(tmps$))
elseif dist!>=1
inc meshs_f%
tmps$=0+str$(dist!)+ +str$(@%(1))
sendmessage (distlb&,$180,0,addr(tmps$))
endif
endif
locate 1,1
print zd!,-
endproc
proc draw_mesh
tx1!=vtex_x![mesh%[@%(1),1]]
ty1!=vtex_y![mesh%[@%(1),1]]
tz1!=vtex_z![mesh%[@%(1),1]]
tx2!=vtex_x![mesh%[@%(1),2]]
ty2!=vtex_y![mesh%[@%(1),2]]
tz2!=vtex_z![mesh%[@%(1),2]]
tx3!=vtex_x![mesh%[@%(1),3]]
ty3!=vtex_y![mesh%[@%(1),3]]
tz3!=vtex_z![mesh%[@%(1),3]]
tx4!=vtex_x![mesh%[@%(1),4]]
ty4!=vtex_y![mesh%[@%(1),4]]
tz4!=vtex_z![mesh%[@%(1),4]]
drawpoly 3dx(tx1!,tz1!),3dy(ty1!,tz1!) , 3dx(tx2!,tz2!),3dy(ty2!,tz2!) , 3dx(tx3!,tz3!),3dy(ty3!,tz3!) ,3dx(tx4!,tz4!),3dy(ty4!,tz4!)
endproc
Proc scaleobject
parameters objn%,x!,y!,z!
whileloop object%[objn%,1],object%[objn%,2],1
vtex_x![&loop]=vtex_x![&loop]*x!
vtex_y![&loop]=vtex_y![&loop]*y!
vtex_z![&loop]=vtex_z![&loop]*z!
wend
endproc
proc moveobject
parameters objn%,x!,y!,z!
objpos![objn%,1]=objpos![objn%,1]+x!
objpos![objn%,2]=objpos![objn%,2]+y!
objpos![objn%,3]=objpos![objn%,3]+z!
whileloop object%[objn%,1],object%[objn%,2],1
vtex_x![&loop]=vtex_x![&loop]+x!
vtex_y![&loop]=vtex_y![&loop]+y!
vtex_z![&loop]=vtex_z![&loop]+z!
wend
endproc
proc init_objects
box1%=push_3d_box()
moveobject box1%,0,0,-50
box2%=push_3d_box()
moveobject box2%,-30,-30,-50
return obj_s%
endproc
proc init_engine
return init_mainWindow(clear_3d_stacks())
endproc
proc init_mainWindow
if @%(1)
windowstyle 80
window 0,0 - 1024,768
distlb&=createsortedlistbox(%hwnd,,0,0,180,50)
setfont distlb&,createfont (Small Fonts,8,0,0,0,0)
showwindow(distlb&,0)
return %hwnd
endif
return 0
endproc
proc beginobject
inc obj_s%
object%[obj_s%,1]=vtex_s%+1
objpos![obj_s%,1]=0
objpos![obj_s%,2]=0
objpos![obj_s%,3]=0
return 1
endproc
proc endobject
object%[obj_s%,2]=vtex_s%
return obj_s%
endproc
proc push_3d_box
declare x!,y!,z!,xt!,yt!,zt!
x!=-10
y!=-10
z!=-10
xt!=10
yt!=10
zt!=10
beginobject
tmp1%=push_vertex(x!,y!,z!)
tmp2%=push_vertex(xt!,y!,z!)
tmp3%=push_vertex(xt!,y!,zt!)
tmp4%=push_vertex(x!,y!,zt!)
tmp5%=push_vertex(x!,yt!,z!)
tmp6%=push_vertex(xt!,yt!,z!)
tmp7%=push_vertex(xt!,yt!,zt!)
tmp8%=push_vertex(x!,yt!,zt!)
return endobject(push_mesh(tmp1%,tmp2%,tmp3%,tmp4%),push_mesh (tmp5%,tmp6%,tmp7%,tmp8%),push_mesh (tmp4%,tmp3%,tmp7%,tmp8%),push_mesh (tmp1%,tmp2%,tmp6%,tmp5%),push_mesh (tmp1%,tmp4%,tmp8%,tmp5%),push_mesh (tmp2%,tmp3%,tmp7%,tmp6%))
endproc
proc push_mesh(vtexn1,vtexn2,vtexn3)
parameters vtexn1%,vtexn2%,vtexn3%,vtexn4%
inc mesh_s%
mesh%[mesh_s%,1]=vtexn1%
mesh%[mesh_s%,2]=vtexn2%
mesh%[mesh_s%,3]=vtexn3%
mesh%[mesh_s%,4]=vtexn4%
return mesh_s%
endproc
proc clear_3d_stacks()
_sense%=1
vpx!=0
vpy!=0
vpz!=0
vpa!=1
vprx!=0
vpry!=0
vprz!=0
clear vtex_z![]
clear vtex_y![]
clear vtex_x![]
vtex_s%=0
obj_s%=0
mesh_s%=0
efps&=0
fps&=0
tm&=&gettickcount
return 1
endproc
proc push_vertex(x!,y!,z!)
parameters x!,y!,z!
inc vtex_s%
vtex_x![vtex_s%]=x!
vtex_y![vtex_s%]=y!
vtex_z![vtex_s%]=z!
return vtex_s%
endproc
Proc DrawPoly
Parameters X%,y%,xx%,yy%,xxx%,yyy%,xxxx%,yyyy%
Long pg#,0 = x%
Long pg#,4 = y%
Long pg#,8 = xx%
Long pg#,12= yy%
Long pg#,16= xxx%
Long pg#,20= yyy% Long pg#,24= xxxx%
Long pg#,24= xxxx%
Long pg#,28= yyyy%
Polygon (%hdc,pg#,4)
Endproc
tx1!=3dx(x!,z!)
tx2!=3dx(xt!,z!)
tx3!=3dx(x!,zt!)
tx4!=3dx(xt!,zt!)
ty1!=3dy(y!,z!)
ty2!=3dy(yt!,z!)
ty3!=3dy(y!,zt!)
ty4!=3dy(yt!,zt!)
line tx1!,ty1! - tx2!,ty1!
line tx1!,ty1! - tx1!,ty2!
line tx1!,ty2! - tx2!,ty2!
line tx2!,ty1! - tx2!,ty2!
line tx3!,ty3! - tx4!,ty3!
line tx3!,ty3! - tx3!,ty4!
line tx3!,ty4! - tx4!,ty4!
line tx4!,ty3! - tx4!,ty4!
line tx1!,ty1! - tx3!,ty3!
line tx2!,ty2! - tx4!,ty4!
line tx1!,ty2! - tx3!,ty4!
line tx2!,ty1! - tx4!,ty3!
proc 3d_lin
parameters x1!,y1!,z1!,x2!,y2!,z2!
line 3dx(x1!,z1!),3dy(y1!,z1!) - 3dx(x2!,z2!),3dy(y2!,z2!)
endproc
|
 | | | | | | |
|
AntwortenThemenoptionen | 2.032 Betrachtungen |
ThemeninformationenDieses Thema hat 3 Teilnehmer: |
(289)
Deutsch
English
Français
Español
Italia