3D '1000 Ibasic forum members by Jolly Roger

[pistol350]

You're curious to see what it is right
Copy, paste and run ^^

Code Select Expand

'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



[GWS]

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

[pistol350]

LOL