You're curious to see what it is right ??? ;D ;D ;D
Copy, paste and run ^^
'1000 IBasic forum members
'IB Standard 3D
'Jolly Roger Oct 2004
IF GETDXVERSION < 7
MESSAGEBOX 0,"This program requires" + chr$(13) + "DirectX 7.0 or greater","Error"
END
ENDIF
DECLARE "kernel32",GetTickCount(),INT
DEF win:WINDOW
DEF error,run:INT
DEF mult:FLOAT
DEF scene,camera,light,light2,lastframetime,timesincelastframe,shape:INT
'Global variables required for extrusion
DEF lineclosed[50],numberofpointsinline[50],pointx[10000],pointy[10000],numberoflines:INT
DEF linewidth,extrusionheight:INT
'Open a window
WINDOW win,0,0,640,480,@NOAUTODRAW,0,"",mainwindow
'Create a 3D screen for object preview
error=CREATE3DSCREEN(win,640,480,16)
IF error<>0
MESSAGEBOX win, "Could not create Direct3D screen","Error"
CLOSEWINDOW win
END
ENDIF
D3DSETQUALITY win,@LIGHTON | @FILLSOLID | @SHADEGOURAUD
FRONTPEN win,RGB(255,255,255)
BACKPEN win,0
DRAWMODE win,@TRANSPARENT
'Hide cursor
SETCURSOR win,@CSCUSTOM,0
DECLARE extrusionobject(objectparent:INT)
DECLARE lineangle(x1:INT,y1:INT,x2:INT,y2:INT)
'The parent scene frame
scene = D3DSCENE(win)
D3DCOMMAND scene,@SETSCENEBACKCOLOR,.2,.2,1
'Create and position the camera
camera = D3DCAMERA(scene)
D3DCOMMAND camera,@SETPOSITION,scene,0,0,-2000
D3DCOMMAND camera,@SETORIENTATION,scene,0,0,1,0,1,0
'Create and orient a red light source
light = D3DLIGHT(scene,@LIGHTDIRECTIONAL,1,0,0)
D3DCOMMAND light,@SETORIENTATION,scene,1,0,1, 0,1,0
'Create and orient a green light source
light2 = D3DLIGHT(scene,@LIGHTDIRECTIONAL,0,0,1)
D3DCOMMAND light2,@SETORIENTATION,scene,-1,0,1, 0,1,0
'Create object by extrusion
GOSUB readextrusionobjectdata
shape=extrusionobject(scene)
D3DCOMMAND shape,@SETROTATION,scene,0,1,0,.008
lastframetime=GetTickCount()-1
run=1
'Process messages until somebody closes us
WAITUNTIL run=0
'Delete all the frames
D3DDELETE light
D3DDELETE light2
D3DDELETE camera
D3DDELETE shape
D3DDELETE scene
CLOSEWINDOW win
END
SUB mainwindow
SELECT @class
CASE @IDKEYDOWN
IF @CODE=(0x1B)
'Escape key pressed
run = 0
ENDIF
CASE @IDCLOSEWINDOW
run=0
CASE @IDDXUPDATE
'Find time since last frame to make things run at a constant speed
timesincelastframe=GetTickCount()-lastframetime
IF timesincelastframe>2
lastframetime=GetTickCount()
mult=timesincelastframe/8
'Move the frames according to their current rotation, direction and velocity
D3DMOVE win,mult
'Render the scene to the DirectX surface
D3DRENDER scene,camera
'Add any 2D elements after the scene is rendered.
MOVE win,5,5
PRINT win,"Press Esc key to exit"
'Show the DirectX surface
DXFLIP win,0,0
ENDIF
ENDSELECT
RETURN
SUB extrusionobject(objectparent)
DEF objecthandle,pointsinline,vertex0[1000],vertex1[1000],vertex2[1000],vertex3[1000],verticescreated:INT
DEF faceinfo[9],topfacenormal,bottomfacenormal,actualhalfwidth:INT
DEF endfacenormal1,endfacenormal2,normal1,normal2,pointsused:INT
DEF linesegmentangle[1000],pointangle[1000],linesegmentangledifference[1000]:FLOAT
DEF halfextrusionheight:FLOAT
halfextrusionheight=extrusionheight/2.0
pointsused=0
objecthandle=D3DSHAPE(objectparent,@SHAPECUSTOM)
FOR linenumber=0 TO numberoflines-1
'Work out line angles
pointsinline=numberofpointsinline[linenumber]
linesegmentangledifference[0]=0:linesegmentangledifference[pointsinline-1]=0
FOR point=0 TO pointsinline-2
linesegmentangle[point]=lineangle(pointx[pointsused+point],pointy[pointsused+point],pointx[pointsused+point+1],pointy[pointsused+point+1])
NEXT point
IF lineclosed[linenumber]
linesegmentangle[pointsinline-1]=lineangle(pointx[pointsused+pointsinline-1],pointy[pointsused+pointsinline-1],pointx[pointsused],pointy[pointsused])
ENDIF
'Work out angles at points
IF lineclosed[linenumber]=0
pointangle[0]=linesegmentangle[0]
ELSE
linesegmentangledifference[0]=linesegmentangle[0]-linesegmentangle[pointsinline-1]
IF ABS(linesegmentangledifference[0])>3.142
linesegmentangledifference[0]=linesegmentangledifference[0]-6.283*SGN(linesegmentangledifference[0])
ENDIF
pointangle[0]=linesegmentangle[pointsinline-1]+linesegmentangledifference[0]/2
ENDIF
IF pointsinline>2
FOR point=1 TO pointsinline-2
linesegmentangledifference[point]=linesegmentangle[point]-linesegmentangle[point-1]
IF ABS(linesegmentangledifference[point])>3.142
linesegmentangledifference[point]=linesegmentangledifference[point]-6.283*SGN(linesegmentangledifference[point])
ENDIF
pointangle[point]=linesegmentangle[point-1]+linesegmentangledifference[point]/2
NEXT point
ENDIF
IF lineclosed[linenumber]=0
pointangle[pointsinline-1]=linesegmentangle[pointsinline-2]
ELSE
linesegmentangledifference[pointsinline-1]=linesegmentangle[pointsinline-1]-linesegmentangle[pointsinline-2]
IF ABS(linesegmentangledifference[pointsinline-1])>3.142
linesegmentangledifference[pointsinline-1]=linesegmentangledifference[pointsinline-1]-6.283*SGN(linesegmentangledifference[pointsinline-1])
ENDIF
pointangle[pointsinline-1]=linesegmentangle[pointsinline-2]+linesegmentangledifference[pointsinline-1]/2
ENDIF
'Create vertices.Four per point in line
FOR point=0 TO pointsinline-1
IF (point=0 | point=pointsinline-1) & lineclosed[linenumber]=0
actualhalfwidth=.5*linewidth
ELSE
IF ABS(linesegmentangledifference[point])<2.1
actualhalfwidth=.5*linewidth/COS(ABS(linesegmentangledifference[point]/2))
ELSE
actualhalfwidth=linewidth
ENDIF
ENDIF
vertex0[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,pointx[pointsused+point]-actualhalfwidth*cos(pointangle[point]),pointy[pointsused+point]+actualhalfwidth*SIN(pointangle[point]),halfextrusionheight)
vertex1[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,pointx[pointsused+point]+actualhalfwidth*cos(pointangle[point]),pointy[pointsused+point]-actualhalfwidth*SIN(pointangle[point]),halfextrusionheight)
vertex2[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,pointx[pointsused+point]+actualhalfwidth*COS(pointangle[point]),pointy[pointsused+point]-actualhalfwidth*SIN(pointangle[point]),-1*halfextrusionheight)
vertex3[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,pointx[pointsused+point]-actualhalfwidth*COS(pointangle[point]),pointy[pointsused+point]+actualhalfwidth*SIN(pointangle[point]),-1*halfextrusionheight)
NEXT point
'Create top faces
topfacenormal=D3DCOMMAND(objecthandle,@ADDNORMAL,0,0,1)
FOR point=0 TO pointsinline-2
faceinfo=4,vertex0[point],topfacenormal,vertex1[point],topfacenormal,vertex1[point+1],topfacenormal,vertex0[point+1],topfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
NEXT point
'Create bottom faces
bottomfacenormal=D3DCOMMAND(objecthandle,@ADDNORMAL,0,0,-1)
FOR point=0 TO pointsinline-2
faceinfo=4,vertex2[point],bottomfacenormal,vertex3[point],bottomfacenormal,vertex3[point+1],bottomfacenormal,vertex2[point+1],bottomfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
NEXT point
'Create side faces
FOR point=0 TO pointsinline-2
IF linesegmentangledifference[point]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[point]),-SIN(linesegmentangle[point]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[point]),-SIN(pointangle[point]),0)
ENDIF
IF linesegmentangledifference[point+1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[point]),-SIN(linesegmentangle[point]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[point+1]),-SIN(pointangle[point+1]),0)
ENDIF
faceinfo=4,vertex3[point],normal1,vertex0[point],normal1,vertex0[point+1],normal2,vertex3[point+1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
IF linesegmentangledifference[point]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[point]),SIN(linesegmentangle[point]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[point]),SIN(pointangle[point]),0)
ENDIF
IF linesegmentangledifference[point+1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[point]),SIN(linesegmentangle[point]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[point+1]),SIN(pointangle[point+1]),0)
ENDIF
faceinfo=4,vertex1[point],normal1,vertex2[point],normal1,vertex2[point+1],normal2,vertex1[point+1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
NEXT point
'Add end faces/close object
IF lineclosed[linenumber]
'Close object
'Top face
faceinfo=4,vertex1[0],topfacenormal,vertex0[0],topfacenormal,vertex0[pointsinline-1],topfacenormal,vertex1[pointsinline-1],topfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
'Bottom face
faceinfo=4,vertex3[0],bottomfacenormal,vertex2[0],bottomfacenormal,vertex2[pointsinline-1],bottomfacenormal,vertex3[pointsinline-1],bottomfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
'Side faces
IF linesegmentangledifference[0]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[pointsinline-2]),-SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[0]),-SIN(pointangle[0]),0)
ENDIF
IF linesegmentangledifference[pointsinline-1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[pointsinline-2]),-SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[pointsinline-1]),-SIN(pointangle[pointsinline-1]),0)
ENDIF
faceinfo=4,vertex0[0],normal1,vertex3[0],normal1,vertex3[pointsinline-1],normal2,vertex0[pointsinline-1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
IF linesegmentangledifference[0]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[pointsinline-2]),SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[0]),SIN(pointangle[0]),0)
ENDIF
IF linesegmentangledifference[pointsinline-1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[pointsinline-2]),SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[pointsinline-1]),SIN(pointangle[pointsinline-1]),0)
ENDIF
faceinfo=4,vertex2[0],normal1,vertex1[0],normal1,vertex1[pointsinline-1],normal2,vertex2[pointsinline-1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
ELSE
'Add endfaces
endfacenormal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-SIN(linesegmentangle[0]),-COS(linesegmentangle[0]),0)
faceinfo=4,vertex3[0],endfacenormal1,vertex2[0],endfacenormal1,vertex1[0],endfacenormal1,vertex0[0],endfacenormal1
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
endfacenormal2=D3DCOMMAND (objecthandle,@ADDNORMAL,SIN(linesegmentangle[pointsinline-2]),COS(linesegmentangle[pointsinline-2]),0)
faceinfo=4,vertex0[pointsinline-1],endfacenormal2,vertex1[pointsinline-1],endfacenormal2,vertex2[pointsinline-1],endfacenormal2,vertex3[pointsinline-1],endfacenormal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
ENDIF
pointsused=pointsused+pointsinline
NEXT linenumber
D3DCOMMAND objecthandle,@CUSTOMINIT
RETURN objecthandle
SUB lineangle(x1,y1,x2,y2)
DEF angle:FLOAT
DEF dx,dy:INT
dx=x2-x1:dy=y2-y1
IF dy=0
IF dx<0
angle=3.124+1.571
ELSE
angle=1.571
ENDIF
ELSE
angle=ATAN(dx/dy)
IF dy<0 THEN angle=3.142+angle
IF angle<0 THEN angle=6.283+angle
ENDIF
RETURN angle
SUB readextrusionobjectdata
linewidth=20
extrusionheight=20
numberoflines=27
lineclosed=0,1,1,1,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1
numberofpointsinline=3,15,15,15,2,2,2,20,14,3,11,2,9,6,2,13,6,11,11
numberofpointsinline[19]=9,13,9,10,12,5,10,4
pointx=-397,-360,-357,-172,-204,-225,-233,-248,-244,-229,-216,-176
pointx[12]=-153,-132,-117,-113,-124,-141,10,-12,-33,-52,-60,-60,-60
pointx[25]=-44,-20,20,42,63,60,50,31,202,180,159,126,107,111,119,130
pointx[41]=147,183,210,231,239,239,231,-393,-233,-313,-313,-393,-237
pointx[54]=-160,-117,-96,-80,-73,-73,-88,-105,-124,-149,-145,-117,-100
pointx[67]=-84,-88,-100,-120,-140,-149,-157,39,18,-4,-25,-33,-33,-25
pointx[81]=0,20,39,46,50,54,54,54,60,75,180,159,140,134,147,166,180
pointx[98]=180,170,155,134,242,242,362,343,326,315,311,311,326,343
pointx[112]=366,-317,-345,-368,-385,-393,-408,-404,-320,-189,-220,-233
pointx[124]=-240,-240,-233,-220,-197,-157,-136,-128,-136,-157,-60,-60
pointx[136]=-44,-21,0,10,79,79,79,86,103,126,143,151,155,155,155,246
pointx[152]=239,242,258,271,286,303,315,326,340,334,-389,-380,-360
pointx[165]=-341,-320,-305,-284,-265,-260,-216,-160,-136,-128,-149
pointx[176]=-168,-189,-208,-216,-212,-204,-176,-149,-73,-73,-60,-48
pointx[188]=-29,-12,2,14,14,71,71,79,103,126,126,126,111,90,67,166
pointx[204]=239,235,218,199,180,170,166,170,187,214,235,290,282,290
pointx[218]=311,326,414,395,380,374,380,402,420,418,395,378,239,246
pointx[232]=246,239
pointy=385,421,277,412,412,397,385,345,313,300,284,280,284,292,309
pointy[15]=345,380,404,408,404,397,385,360,340,317,300,284,284,296
pointy[29]=317,349,376,400,397,404,404,381,353,324,300,288,280,277
pointy[43]=280,296,313,332,372,128,136,128,-23,-20,-20,141,145,141
pointy[57]=136,117,96,84,80,77,77,69,60,52,29,8,-2,-10,-14,-18,141
pointy[74]=65,69,65,52,33,12,-2,-14,-14,-10,-2,4,21,44,8,-6,-10,80
pointy[92]=77,69,56,40,33,20,8,4,-2,-6,80,-6,80,73,65,56,37,12,4,-2
pointy[112]=-2,-134,-134,-147,-263,-294,-300,-214,-210,-166,-170,-178
pointy[124]=-195,-218,-235,-250,-260,-260,-242,-214,-187,-170,-246
pointy[135]=-162,-155,-151,-151,-162,-162,-195,-214,-235,-242,-242
pointy[146]=-235,-220,-199,-174,-151,-235,-180,-162,-155,-174,-187
pointy[157]=-174,-159,-155,-166,-220,-471,-362,-351,-359,-383,-359
pointy[168]=-347,-366,-463,-414,-414,-406,-395,-378,-366,-370,-380
pointy[179]=-410,-431,-450,-460,-463,-471,-380,-374,-383,-402,-383
pointy[190]=-370,-387,-458,-326,-454,-454,-454,-442,-423,-410,-402
pointy[201]=-399,-399,-406,-410,-387,-374,-370,-374,-391,-420,-439
pointy[212]=-454,-458,-446,-450,-380,-374,-366,-370,-362,-366,-378
pointy[223]=-391,-406,-410,-423,-446,-450,-446,109,109,101,101
RETURN
If we can get a group of happy campers like that on this forum - Paul will finally have reached a just reward .. :)
best wishes, :)
Graham
LOL ;)