3D Merry Christmas by Jolly Roger

[pistol350]

Another one for Christmas by the Master of 3D Jolly Roger himself !
So cute!

Code Select Expand


'Merry Christmas
'Jolly Roger December 2003
AUTODEFINE "OFF"
IF GETDXVERSION < 7
   MESSAGEBOX 0,"This program requires" + chr$(13) + "DirectX 7.0 or greater","Error"
   END
ENDIF

DECLARE "kernel32",GetTickCount(),INT

DECLARE savebitmap(width:INT,height:INT)

DECLARE cone(numberofsections:INT,smooth:INT,bottomfacepresent:INT,heighttowidthratio:FLOAT)

DECLARE cylinder(numberofsections:INT,topfacepresent:INT,bottomfacepresent:INT,smooth:INT)

DEF win:WINDOW
DEF error,run:INT
DEF mult,snowy,treex[9],treez[9],lastcamerax,lastcameraz,camerax,cameraz,cameraposn[3]:FLOAT
DEF scene,camera,light,lastframetime,timesincelastframe,snowmanhead,snowmanbody,yaxispivot,n:INT
DEF ground,normal,facedata[10],vertex1,vertex2,vertex3,vertex4,nose,eye1,eye2,showscene:INT
DEF light2,light3,light4,rand,snow,halfsnowheight,collision,hattop,hatbrim,musicstarttime:INT
DEF treetrunk[9],treetop[9],treemiddle[9],bottomleaves[9],middleleaves[9],topleaves[9]:INT
DEF rd[256,256],gn[256,256],bl[256,256]:CHAR
DEF istranslation,generatingtexture,savingtexture,generatingsnow,proportioncomplete:INT
DEF wrap[13]:FLOAT
DEF file:BFILE
DEF command:STRING
wrap=0,0,0, 0,1,0, 0,0,1, 0,0, .01,.01
halfsnowheight=300

'Open a window
WINDOW win,0,0,640,480,@CAPTION|@NOAUTODRAW,0,"Merry Christmas",mainwindow

'Check if midi file present
error=OPENFILE(file,GETSTARTPATH+"wewishuamerryxmas-edited-recreated.mid","R")
IF error
  'Midi file is not present.Create it
  DECLARE createmidi(w:WINDOW)
  createmidi(win)
ELSE
  'Midi is present.Close it
  CLOSEFILE file
ENDIF
'Declare function to play midi and open midi file
DECLARE "winmm",mciSendStringA(lpszCommand:STRING,lpszReturnString:STRING,cchReturn:INT,hwndCallback:INT),INT
command="open "+CHR$(34)+GETSTARTPATH+"wewishuamerryxmas-edited-recreated.mid"+CHR$(34)+" type MpegVideo alias sound"
mciSendStringA(command,"",0,0)

'Create a 640x480 16 bit colour 3D screen
error=CREATE3DSCREEN(win,640,480,16)
IF error<>0
  'Couldn't open Direct3D screen
  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

error=OPENFILE (file,GETSTARTPATH+"snow-texture.bmp","R")
IF error
  generatingtexture=1
  'Snow texture bitmap is not present so create it
  'Create colour data for snow texture 
  FOR x=0 TO 255
    FOR y=0 TO 255
      rand=RND(20)+210
      rd[x,y]=rand-10:gn[x,y]=rand-10:bl[x,y]=rand
    NEXT y
    'Allow progress bar to be redrawn
    IF x%5=0
      proportioncomplete=x
      WAIT 1
    ENDIF
  NEXT x
  generatingtexture=0
  savingtexture=1
  savebitmap(256,256)
  savingtexture=0
ELSE
  'Snow texture bitmap is present
  CLOSEFILE file
ENDIF

'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,45,-700
D3DCOMMAND camera,@SETORIENTATION,scene,0,0,1,0,1,0

'Create and orient a light source from front left
light = D3DLIGHT(scene,@LIGHTDIRECTIONAL,.75,.75,.75)
D3DCOMMAND light,@SETORIENTATION,scene,-1,-1,1, -1,1,1

'Create and orient a light source from front right
light2 = D3DLIGHT(scene,@LIGHTDIRECTIONAL,.6,.6,.6)
D3DCOMMAND light2,@SETORIENTATION,scene,1,-1,1, 1,1,1

'Create and orient a light source from below
light3 = D3DLIGHT(scene,@LIGHTDIRECTIONAL,1,1,1)
D3DCOMMAND light3,@SETORIENTATION,scene,0,1,0, 0,1,-1

'Create and orient a light source from back
light4 = D3DLIGHT(scene,@LIGHTDIRECTIONAL,1,1,1)
D3DCOMMAND light4,@SETORIENTATION,scene,0,-1,-1, 0,1,1

'Create ground
ground=D3DSHAPE(scene,@SHAPECUSTOM)
vertex1=D3DCOMMAND (ground,@ADDVERTEX,-700,0,700)
vertex2=D3DCOMMAND (ground,@ADDVERTEX,700,0,700)
vertex3=D3DCOMMAND (ground,@ADDVERTEX,700,0,-700)
vertex4=D3DCOMMAND (ground,@ADDVERTEX,-700,0,-700)
normal=D3DCOMMAND (ground,@ADDNORMAL,0,1,0)
facedata=4,vertex1,normal,vertex2,normal,vertex3,normal,vertex4,normal,0
D3DCOMMAND ground,@ADDFACES,facedata
D3DCOMMAND ground,@CUSTOMINIT
D3DCOMMAND ground,@CREATEWRAP,scene,@WRAPFLAT,wrap
D3DCOMMAND ground,@LOADTEXTURE,GETSTARTPATH+"snow-texture.bmp"

'Create trees
FOR n=0 TO 8
  'Create trunks
  treetrunk[n]=cylinder(12,1,0,1)
  D3DCOMMAND treetrunk[n],@SCALE,10,40,10
  D3DCOMMAND treetrunk[n],@SETSHAPECOLOR,.6,.4,0
  'Create leaves
  bottomleaves[n]=cone(12,1,1,1)
  middleleaves[n]=cone(12,1,1,1)
  topleaves[n]=cone(12,1,1,1)
  'Colour bottom faces green
  D3DCOMMAND bottomleaves[n],@SETFACECOLOR,12,0,.55,0
  D3DCOMMAND middleleaves[n],@SETFACECOLOR,12,0,.55,0
  D3DCOMMAND topleaves[n],@SETFACECOLOR,12,0,.55,0
  'Work out pseudo random positions for trees
  treex[n]=FLOOR((n/3)-1)*300+100-RND(200)
  treez[n]=(1-n%3)*300+100-RND(200)
  IF n=4
    'Ensure tree not on top of snowman
    treez[4]=50+RND(50)
  ENDIF
  D3DCOMMAND bottomleaves[n],@SCALE,40,30,40
  D3DCOMMAND bottomleaves[n],@SETPOSITION,scene,treex[n],60,treez[n]
  D3DCOMMAND middleleaves[n],@SCALE,32,22,32
  D3DCOMMAND middleleaves[n],@SETPOSITION,scene,treex[n],90,treez[n]
  D3DCOMMAND topleaves[n],@SCALE,22,15,22
  D3DCOMMAND topleaves[n],@SETPOSITION,scene,treex[n],115,treez[n]
  D3DCOMMAND treetrunk[n],@SETPOSITION,scene,treex[n],20,treez[n]
NEXT n

'Create snowman
snowmanhead=D3DSHAPE(scene,@SHAPESPHERE,14,10)
D3DCOMMAND snowmanhead,@SETPOSITION,scene,0,45,0
snowmanbody=D3DSHAPE(scene,@SHAPESPHERE,22,10)
D3DCOMMAND snowmanbody,@SETPOSITION,scene,0,16,0

'Create nose for snowman
nose=cone(12,1,0,2.8)
D3DCOMMAND nose,@ADDROTATION,1,0,0,-1.571
D3DCOMMAND nose,@SCALE,2,2,2
D3DCOMMAND nose,@SETPOSITION,scene,0,45,-13
'Colour nose orange
D3DCOMMAND nose,@SETSHAPECOLOR,1,.8,0

'Create eyes for snowman
eye1=D3DSHAPE(scene,@SHAPESPHERE,1.5,10)
D3DCOMMAND eye1,@ADDROTATION,1,0,0,-1.571
D3DCOMMAND eye1,@SETPOSITION,scene,-3.5,48,-12
D3DCOMMAND eye1,@SETSHAPECOLOR,.4,.4,.4
eye2=D3DSHAPE(scene,@SHAPESPHERE,1.5,10)
D3DCOMMAND eye2,@ADDROTATION,1,0,0,-1.571
D3DCOMMAND eye2,@SETPOSITION,scene,3.5,48,-12
D3DCOMMAND eye2,@SETSHAPECOLOR,.4,.4,.4

'Create hat for snowman
hattop=cylinder(12,0,0,1)
D3DCOMMAND hattop,@SCALE,10,10,10
D3DCOMMAND hattop,@SETPOSITION,scene,0,65,0
D3DCOMMAND hattop,@SETSHAPECOLOR,.4,.4,.4
hatbrim=cylinder(12,0,1,1)
D3DCOMMAND hatbrim,@SCALE,14,1,14
D3DCOMMAND hatbrim,@SETPOSITION,scene,0,55,0
D3DCOMMAND hatbrim,@SETSHAPECOLOR,.4,.4,.4

'Check if snow.x file exists
error=OPENFILE(file,GETSTARTPATH+"snow.x","R")
IF error
  'Snow object does not exist so create it
  createsnow
  D3DCOMMAND snow,@SAVESHAPE,GETSTARTPATH+"snow.x",@FORMATTEXT,0
ELSE
  CLOSEFILE file
  snow=D3DSHAPE(scene,@SHAPECUSTOM)
  D3DCOMMAND snow,@LOADSHAPE,GETSTARTPATH+"snow.x",0
ENDIF
DELETEFILE(GETSTARTPATH+"temporary.x")
run=1
SETFONT win,"Arial",50,600
FRONTPEN win,255
'Start music
mciSendStringA("play sound","",0,0)
musicstarttime=GetTickCount()

'Wait till music finished before showing 3D scene
WAITUNTIL (GetTickCount()>(musicstarttime+11000))|(run=0)
SETFONT win,"Arial",10,600
FRONTPEN win,0xFFFFFF

lastframetime=GetTickCount()-1
showscene=1
'Process messages until somebody closes us
WAITUNTIL run=0
'Delete all the frames
D3DDELETE light
D3DDELETE light2
D3DDELETE light3
D3DDELETE light4
D3DDELETE camera
FOR n=0 TO 8
  D3DDELETE bottomleaves[n]
  D3DDELETE treetrunk[n]
  D3DDELETE middleleaves[n]
  D3DDELETE topleaves[n]
NEXT n
D3DDELETE snowmanbody
D3DDELETE snowmanhead
D3DDELETE hattop
D3DDELETE hatbrim
D3DDELETE ground
D3DDELETE nose
D3DDELETE eye1
D3DDELETE eye2
D3DDELETE snow
D3DDELETE scene
'Hide cursor.Avoids possible cursor distortion
SETCURSOR win,@CSCUSTOM,0
'Stop midi music
mciSendStringA("close sound","",0,0)
CLOSEWINDOW win
END


SUB mainwindow
  SELECT @CLASS
   CASE @IDCHAR
      IF (@CODE = ASC("Q")) | (@CODE = ASC("q")) THEN run = 0
   CASE @IDCREATE
      CENTERWINDOW win
   CASE @IDCLOSEWINDOW
      run=0
   CASE @IDDXUPDATE
     IF showscene
      'Find time since last frame to make things run at a constant speed
      timesincelastframe=GetTickCount()-lastframetime
      IF timesincelastframe>2
        lastframetime=GetTickCount()
        mult=timesincelastframe/8
        istranslation=0
      'Move the camera using the arrow keys
        'Up arrow
      IF(GETKEYSTATE(0x26))
         D3DCOMMAND camera,@ADDTRANSLATION,0,0,mult
            istranslation=1
      ENDIF
        'Down arrow
      IF(GETKEYSTATE(0x28))
         D3DCOMMAND camera,@ADDTRANSLATION,0,0,-mult
            istranslation=1
      ENDIF
        'Left arrow
      IF(GETKEYSTATE(0x25))
         D3DCOMMAND camera,@ADDROTATION,0,1,0,-.005*mult
      ENDIF
        'Right arrow
      IF(GETKEYSTATE(0x27))
         D3DCOMMAND camera,@ADDROTATION,0,1,0,.005*mult
      ENDIF
        'Move snow
        snowy=snowy-mult
        IF snowy<-halfsnowheight THEN snowy=snowy+halfsnowheight
        D3DCOMMAND snow,@SETPOSITION,scene,0,snowy,0
        'Find camera position
        D3DCOMMAND camera,@GETPOSITION,scene,cameraposn
        camerax=cameraposn[0]:cameraz=cameraposn[2]
        'If camera translation then check for collisions
        IF istranslation
          'Check for collisions
          collision=0
          'Check for snowman collision
          IF ABS(camerax)<25
            IF ABS(cameraz)<25
              'Hit snowman
              collision=1
            ENDIF
          ENDIF
          'Check for tree collisions
          FOR n=0 TO 8
            IF ABS(treex[n]-camerax)<15
              IF ABS(treez[n]-cameraz)<15
                'Hit tree
                collision=1
              ENDIF
           ENDIF
          NEXT n
          IF collision
            'Reset camera to position before collision
            camerax=lastcamerax:cameraz=lastcameraz
            D3DCOMMAND camera,@SETPOSITION,scene,camerax,45,cameraz
          ENDIF
        ENDIF
        lastcamerax=camerax:lastcameraz=cameraz
      'Render the scene to the DirectX surface
      D3DRENDER scene,camera
      'Add any 2D elements after the scene is rendered.
      MOVE win,10,10:PRINT win,"Move around the scene using the arrow keys.Press Q to exit"
      'Show the DirectX surface   
      DXFLIP win,0,0
      ENDIF
    ELSE
      IF generatingtexture|savingtexture|generatingsnow
        DXFILL win,0
        MOVE win,100,220
        IF generatingtexture
          PRINT win,"Generating 192k texture"
        ENDIF
        IF savingtexture
          PRINT win,"Saving texture"
        ENDIF
        IF generatingsnow
          PRINT win,"Generating .x file"
        ENDIF
        RECT win,100,250,256,20
        RECT win,100,250,proportioncomplete,20,0xFFFFFF,0xFFFFFF
      ELSE
        DXFILL win,0xFFFFFF
        MOVE win,50,200:PRINT win,"Merry Christmas"
      ENDIF
      DXFLIP win,0,0
    ENDIF
  ENDSELECT
RETURN


SUB savebitmap(width,height)
'N.B.Width and height must be multiples of four for simple method to work
DEF twobytes:WORD
DEF filelength:INT
DEF integer:INT
DEF file:BFILE
DEF byte:CHAR
TYPE threebytes
   DEF blue:CHAR
   DEF green:CHAR
   DEF red:CHAR
ENDTYPE
DEF colourdata:threebytes
filelength=54+width*height*3
error=OPENFILE (file,GETSTARTPATH+"snow-texture.bmp","W")
'Write header
byte=ASC("B"):WRITE file,byte
byte=ASC("M"):WRITE file,byte
WRITE file,filelength
integer=0:WRITE file,integer
integer=54:WRITE file,integer
integer=40:WRITE file,integer
WRITE file,width
WRITE file,height
twobytes=1:WRITE file,twobytes
twobytes=24:WRITE file,twobytes
integer=0
WRITE file,integer:WRITE file,integer:WRITE file,integer
WRITE file,integer:WRITE file,integer:WRITE file,integer
'Write colour data
FOR y=height-1 TO 0 STEP -1
  FOR x=0 TO width-1
    colourdata.red=rd[x,y]:colourdata.green=gn[x,y]:colourdata.blue=bl[x,y]
    WRITE file,colourdata
  NEXT x
  'Allow progress bar to be redrawn
  IF y%5=0
    proportioncomplete=256*(height-y)/height
    WAIT 1
  ENDIF
NEXT y
CLOSEFILE file
RETURN

SUB createsnow
generatingsnow=1
DEF halfnumberofsnowflakes,facedata[29]:INT
DEF normal0,normal1,normal2,normal3,n:INT
DEF snowflakesize,snowflakex,snowflakey,snowflakez:FLOAT
halfnumberofsnowflakes=300:snowflakesize=1
n=8*halfnumberofsnowflakes
DEF vertex[n]:INT
snow=D3DSHAPE(scene,@SHAPECUSTOM)
normal0=D3DCOMMAND (snow,@ADDNORMAL,0,-1,1)
normal1=D3DCOMMAND (snow,@ADDNORMAL,1,-1,-1)
normal2=D3DCOMMAND (snow,@ADDNORMAL,-1,-1,-1)
normal3=D3DCOMMAND (snow,@ADDNORMAL,0,1,0)
FOR sf=0 TO halfnumberofsnowflakes-1
  snowflakex=-700+RND(1400):snowflakey=RND(halfsnowheight):snowflakez=-700+RND(1400)
  FOR n=0 TO 4 STEP 4
    'If n=4 then create snowflake halfsnowheight above one created when n=0
    'This is to allow the snow to appear to fall continually
    IF n=4 THEN snowflakey=snowflakey+halfsnowheight
    'Create vertices for snowflake
    vertex[sf*8+n]=D3DCOMMAND (snow,@ADDVERTEX,snowflakex,snowflakey,snowflakez+2*snowflakesize)
    vertex[sf*8+n+1]=D3DCOMMAND (snow,@ADDVERTEX,snowflakex+snowflakesize,snowflakey,snowflakez-snowflakesize)
    vertex[sf*8+n+2]=D3DCOMMAND (snow,@ADDVERTEX,snowflakex-snowflakesize,snowflakey,snowflakez-snowflakesize)
    vertex[sf*8+n+3]=D3DCOMMAND (snow,@ADDVERTEX,snowflakex,snowflakey+snowflakesize,snowflakez)
    'Create faces for snowflake
    facedata=3,vertex[sf*8+n+2],normal2,vertex[sf*8+n+1],normal1,vertex[sf*8+n],normal0
    facedata[7]=3,vertex[sf*8+n],normal0,vertex[sf*8+n+1],normal1,vertex[sf*8+n+3],normal3
    facedata[14]=3,vertex[sf*8+n+1],normal1,vertex[sf*8+n+2],normal2,vertex[sf*8+n+3],normal3
    facedata[21]=3,vertex[sf*8+n+2],normal2,vertex[sf*8+n],normal0,vertex[sf*8+n+3],normal3,0
    D3DCOMMAND snow,@ADDFACES,facedata
  NEXT n
  'Allow progress bar to be redrawn 
  IF sf%5=0
    proportioncomplete=256*sf/halfnumberofsnowflakes
    WAIT 1
  ENDIF 
NEXT sf
D3DCOMMAND snow,@CUSTOMINIT
generatingsnow=0
RETURN

SUB createmidi(w)
DEF d[20]:STRING
DEF data$[70]:ISTRING
DEF mem:MEMORY
DEF file:BFILE
DEF numberofcharacters,filelength,c,bytenumber,startposn,progressbarstep,intdata:INT
DEF byte1,byte2,byte3,d1,d2,d3,d4,d5:CHAR
ALLOCMEM (mem,1,70)
d="C:$s<$qpY)$;:J(>+*00##&gVttAB,'i>7iKhMJ_tt?haFcRwWDn^M>-GX<2-?V\-2ha8M"
d[1]="-H0G?CW14r-EV=6DQdWSFguA2H*M(w$Dd]*%V,WH$(_)w#%rg$##$^R$X%v_2LZW[2L7*8"
d[2]="2gd6<EP>DM4&#]Y'vHV\9i;L/Gd2/$;f$9^#*hTO$W2FW%SR1C#AsKE$;1A'Ej8>V-H0N;"
d[3]="->XfN->XfN->XfN=Ub@W6JVXtLOt*1QW?A;LTl8tQ`*0=LRipaQWl_E8$%018^.Oo7ZC65"
d[4]="KoD.'&Bd8KEJv0;[vK@IQV7pKLV\J-Q^9t)%aBKj5)_\[H-8S@;iF)u=j'1u'9#<5B#R4)"
d[5]="#)kw*B#d:)LJE;fQ`<<ALJE>f7^t^Q6JYP.6Hrul6JYt:6Hsl19AN%*9?hV49AN709?fHL"
d[6]="9\h+c9[-hl9AK`>9?gPj8_j]A8^1Ai8)4H>8'QD67,:;#LJ39PQ]+1sLPgSIQYo'SLP0r="
d[7]="QZPKY%aBKj5)_\[LW`'N7ZW+CKoD.D7Z;o@KoM4p8'Oue2G4%=Gb@c7###$9L._Oe$sNmL"
d[8]="CUw)N-FdL.:QS/G#AsKE$;1A'H*'DN->XgL->XfN->XfN->XfN7h,NF0A\tNLrb2$Qr$&#"
d[9]="2pHW''oX`wM8q78#f/)rLPvk@Is7'C7X9Sk2;Wc:0vTpPR#$<^Lf/\ZJBgE:$`boHLPvqB"
d[10]="#)k0wLs%C:7X9TqKmf,32pO2538P.61JEGK36hTQ1OanD1u8Y0Lk1-0QrcP/7a6:6Lg5(["
d[11]=".*Y#2Qs)b4,gLml#)jwd;bSlJ#.JWU#4qpw$X8-aCQes:B>.ru:RN?Ftt@X[##,,F8RM[("
d[12]="C;+W'->XgL->XfN->XfN#&GE.7aM5X#0/ak4%sveM3NV84&/&)7Yh29G(l-=#.lv$(<pWU"
d[13]="&WAa+6;Be,45V9OI#7pDLqYoR7Z)i-$B-iIR:wpN6qhQaE.J#77*cV&7YUr4-]Bom#/E1b"
d[14]="4%sR[G)$(86-hFD7Z%D=#)kKIR>jIm4%s[WGD?1@LVc5Y7Y-2&%#d,Q5u'\46Jj2[I>e0J"
d[15]="Lq#BI7Z;u$$]I#JR<:c\4\Ts`G)QFE6I,_f7Y;,<3/g++#/rUi4\U$fI>IsH4jQCK7YLu6"
d[16]="%?*PUR=RVi7SIcfGCon>?G\^+&r\j,7TVj;7Yq><I>X5b#.llv6;2QlM0+?q6;0Y67Z%J?"
d[17]="9oM)B#0/ak6;2E\6I1/-7YN+V(Q:4`#.lb[5YQBh5gOMm7Z%PA7>s*1#/WRk5YQ9\M+iKL"
d[18]="6r6.07YVDAG`7iB#/)rvM6CQX6=<'@7Z7G<Ee0FI#/E6&7ne&kM/%Xf5>4>'7Yh&5#)kiO"
d[19]="##$^R"
OPENFILE (file,GETSTARTPATH+"wewishuamerryxmas-edited-recreated.mid","W")
RECT w,0,0,200,20
filelength=1067:numberofcharacters=1335
progressbarstep=5*CEIL(numberofcharacters/100)
FOR c=0 TO numberofcharacters-1 STEP 5
startposn=c%70
IF startposn=0
  data$=d[c/70]
  WRITEMEM mem,1,data$
ENDIF
READMEM mem,1,d1,startposn
READMEM mem,1,d2,startposn+1
READMEM mem,1,d3,startposn+2
READMEM mem,1,d4,startposn+3
READMEM mem,1,d5,startposn+4
'Convert five characters to four bytes of data
intdata=52200625*(d1-35)+614125*(d2-35)+7225*(d3-35)+85*(d4-35)+(d5-35)
IF bytenumber<=filelength-4
  WRITE (file,intdata)
  bytenumber=bytenumber+4
ELSE
  'Less than four bytes of data left
  byte1=intdata & 0xFF
  byte2=(intdata & 0xFF00)/0x100
  byte3=(intdata & 0xFF0000)/0x10000
  IF bytenumber<filelength THEN WRITE (file,byte1)
  IF bytenumber<filelength-1 THEN WRITE (file,byte2)
  IF bytenumber<filelength-2 THEN WRITE (file,byte3)
ENDIF
IF c%progressbarstep=0 THEN RECT w,0,0,200*c/numberofcharacters,20,0,0
NEXT c
CLOSEFILE file
FREEMEM mem
RECT w,0,0,200,20,0xFFFFFF,0xFFFFFF
RETURN

SUB cone(numberofsections,smooth,bottomfacepresent,heighttowidthratio)
  DEF shape,vertex[numberofsections+1],topnormal[numberofsections]:INT
  DEF bottomnormal[numberofsections],section,facedata[100],bottomfacenormal:INT
  DEF angle,normaly,xznormalmult:FLOAT
  shape=D3DSHAPE(scene,@SHAPECUSTOM)
  'Create top vertex
  vertex[0]=D3DCOMMAND(shape,@ADDVERTEX,0,2*heighttowidthratio,0)
  'Calculate y component of side normals
  normaly=COS(ATAN(2*heighttowidthratio))
  'Calculate multiplier for x and z components of side normals
  xznormalmult=SIN(ATAN(2*heighttowidthratio))
  'Create bottom vertices and normals for bottom of side faces if needed
  FOR section=0 TO numberofsections-1
    angle=section*6.283/numberofsections
    vertex[section+1]=D3DCOMMAND(shape,@ADDVERTEX,SIN(angle),0,COS(angle))
    IF smooth
      bottomnormal[section]=D3DCOMMAND(shape,@ADDNORMAL,SIN(angle)*xznormalmult,normaly,COS(angle)*xznormalmult)
    ENDIF
  NEXT section
  'Create normals for top of side faces
  FOR section=0 TO numberofsections-1
    angle=(section+.5)*6.283/numberofsections
    topnormal[section]=D3DCOMMAND(shape,@ADDNORMAL,SIN(angle)*xznormalmult,normaly,COS(angle)*xznormalmult)
  NEXT section
  'Create side faces
  FOR section=0 TO numberofsections-1
    IF section<>numberofsections-1
      IF smooth
        facedata=3,vertex[0],topnormal[section],vertex[section+1],bottomnormal[section],vertex[section+2],bottomnormal[section+1],0
      ELSE
        facedata=3,vertex[0],topnormal[section],vertex[section+1],topnormal[section],vertex[section+2],topnormal[section],0
      ENDIF
    ELSE
      IF smooth
        facedata=3,vertex[0],topnormal[0],vertex[numberofsections],bottomnormal[numberofsections-1],vertex[1],bottomnormal[0],0
      ELSE
        facedata=3,vertex[0],topnormal[numberofsections-1],vertex[numberofsections],topnormal[numberofsections-1],vertex[1],topnormal[numberofsections-1],0
      ENDIF
    ENDIF
    D3DCOMMAND shape,@ADDFACES,facedata
  NEXT section
  'Add bottom face if present
  IF bottomfacepresent
    bottomfacenormal=D3DCOMMAND(shape,@ADDNORMAL,0,-1,0)
    facedata[0]=numberofsections
    FOR section=0 TO numberofsections-1
      facedata[1+2*section]=vertex[numberofsections-section],bottomfacenormal
    NEXT section
    facedata[2*numberofsections+1]=0
    D3DCOMMAND shape,@ADDFACES,facedata
  ENDIF
  D3DCOMMAND shape,@CUSTOMINIT
RETURN shape

SUB cylinder(numberofsections,topfacepresent,bottomfacepresent,smooth)
'Function creates a cylinder with the given number of sections.Minimum number of sections is three.
'topfacepresent,bottomfacepresent and smooth should be 0 or 1.
'If smooth is set to one then cylinder sides will appear smooth if @SHADEGOURAUD used.
'If smooth set to zero then sides will appear flat even if @SHADEGOURAUD is used.
'Jolly Roger March 2003
DEF shape,numberofvertices,topnormal,bottomnormal:INT
DEF x,z:FLOAT
IF numberofsections>2
  shape=D3DSHAPE(scene,@SHAPECUSTOM)
  numberofvertices=numberofsections*2
  DEF vertex[numberofvertices],normal[numberofsections],facedata[((2*numberofsections)+5)]:INT
  'Create vertices and side face normals
  FOR section=0 TO numberofsections-1
    x=SIN(6.28*section/numberofsections)
    z=COS(6.28*section/numberofsections)
    IF smooth=0
      normal[section]=D3DCOMMAND(shape,@ADDNORMAL,SIN(6.28*(section+.5)/numberofsections),0,COS(6.28*(section+.5)/numberofsections))
    ELSE
      normal[section]=D3DCOMMAND(shape,@ADDNORMAL,x,0,z)
    ENDIF
    vertex[section]=D3DCOMMAND (shape,@ADDVERTEX,x,1,z)
    vertex[section+numberofsections]=D3DCOMMAND (shape,@ADDVERTEX,x,-1,z)
  NEXT section
  'Create faces
  IF topfacepresent=1
     'Top face
     facedata[0]=numberofsections
     topnormal=D3DCOMMAND(shape,@ADDNORMAL,0,1,0)
     FOR section=0 TO numberofsections-1
       facedata[section*2+1]=vertex[section],topnormal
     NEXT section
     facedata[2*numberofsections+1]=0
     D3DCOMMAND (shape,@ADDFACES,facedata)
  ENDIF
  IF bottomfacepresent=1
     'Bottom face
     facedata[0]=numberofsections
     bottomnormal=D3DCOMMAND(shape,@ADDNORMAL,0,-1,0)
     FOR section=0 TO numberofsections-1
       facedata[section*2+1]=vertex[2*numberofsections-section-1],bottomnormal
     NEXT section
     facedata[2*numberofsections+1]=0
     D3DCOMMAND (shape,@ADDFACES,facedata)
  ENDIF
  'Side faces
  facedata[0]=4
  FOR section=0 TO numberofsections-1
    facedata[1]=vertex[section],normal[section],vertex[section+numberofsections],normal[section]
    IF section<>numberofsections-1
      facedata[5]=vertex[section+1+numberofsections],normal[section+1],vertex[section+1],normal[section+1]
    ELSE
      facedata[5]=vertex[numberofsections],normal[0],vertex[0],normal[0]
    ENDIF
    IF smooth=0
      facedata[6]=normal[section]
      facedata[8]=normal[section]
    ENDIF
    facedata[9]=0
    D3DCOMMAND (shape,@ADDFACES,facedata)
  NEXT section
  D3DCOMMAND shape,@CUSTOMINIT
ENDIF
RETURN shape