3D Merry Christmas GIFT by Jolly Roger So cool!

[pistol350]

Each one of us deserves a gift, guess who thought about us
Jolly Roger, for sure!!! 

Code Select Expand

'Merry Christmas
'Requires IBasic 1.97 or greater.
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 scene,camera,light,count,textparent,textdown,textup:int
def box[35],floorline[11],present,ribbon1,ribbon2:int
DEF length[35],orientation[35],x[35],y[35],textmaterial[10],pos[3],mult:float
textdown=1
textmaterial=1, 1,1,1, 0,0,0, 1,1,1
'open a window
WINDOW win,0,0,640,480,@CAPTION|@NOAUTODRAW,0,"Merry Christmas from Jolly Roger",mainwindow
IF CREATE3DSCREEN(win,640,480) <> 0
   MESSAGEBOX win, "Could not create Direct3D screen","Error"
   CLOSEWINDOW win
   END
ENDIF
starttimer win,50
D3DSETQUALITY win,@LIGHTON | @FILLSOLID | @SHADEflat
FRONTPEN win,RGB(255,255,255)
BACKPEN win,0
DRAWMODE win,@TRANSPARENT
'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,50,22,-200
D3DCOMMAND camera,@SETORIENTATION,scene,-0.25,0,1,0,1,0
'create and position a light source
light = D3DLIGHT(scene,@LIGHTDIRECTIONAL,1.2,1.2,1.2)
D3DCOMMAND light,@SETPOSITION,scene,35,25,0
D3DCOMMAND light,@SETORIENTATION,scene,-.8,-1,.7,1,1,1
'make floor
for f_line=1 to 10
  floorline[f_line]=D3DSHAPE(scene,@shapecube,200,10,10)
  D3DCOMMAND floorline[f_line],@setposition,scene,0,-17.5,100-f_line*20
next f_line
'make present
present=D3DSHAPE (scene,@shapecube,25,25,25)
D3DCOMMAND present,@setshapecolor,0,1,0
ribbon1=D3DSHAPE (scene,@shapecube,25.5,25.5,4)
D3DCOMMAND ribbon1,@setshapecolor,1,0,0
ribbon2=D3DSHAPE (scene,@shapecube,4,25.5,25.5)
D3DCOMMAND ribbon2,@setshapecolor,1,0,0
'create parent object for text
textparent=D3DSHAPE(scene,@shapecustom)
D3DCOMMAND textparent,@setrotation,scene,0,1,0,.01
gosub setupcubedata
'create text from cubes using cube data
for cube=1 to 34
  box[cube]=D3DSHAPE (textparent,@shapecube,1,length[cube],1)
  D3DCOMMAND box[cube],@addrotation,0,0,-1,orientation[cube]*6.28/360
  D3DCOMMAND box[cube],@setposition,scene,x[cube],y[cube],0
  'colour text
  D3DCOMMAND box[cube],@creatematerial,textmaterial
next cube
lastframetime=GetTickCount()-1
run=1
'process messages until somebody closes us
waituntil run=0
'delete all the frames
D3DDELETE light
D3DDELETE camera
D3DDELETE scene
D3DDELETE textparent
D3DDELETe present
D3DDELETE ribbon1
D3DDELETE ribbon2
for cube=1 to 34
  D3DDELETE box[cube]
next cube
for f_line=1 to 10
  D3DDELETE floorline[f_line]
next f_line
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 @IDTIMER
        'morph text colours
        count=count+1
        if count=120 then count=0
        red=(count<80)*(40-abs(count-40))/40
        green=(count>40)*(40-abs(count-80))/40
        blue=(count<40)*(40-count)/40+(count>80)*(count-80)/40
        textmaterial=1, red,green,blue, 0,0,0, red,green,blue
        for cube=1 to 34
          D3DCOMMAND box[cube],@creatematerial,textmaterial
        next cube
        'move text up if camera close to present
        if textdown=1
          D3DCOMMAND camera,@getposition,scene,pos
          if Abs(pos[0])+abs(pos[2])<100
            D3DCOMMAND textparent,@setvelocity,scene,0,.1,0,0
            textdown=0
          endif
        endif
        'stop text once up
        if textdown=0 & textup=0
          D3DCOMMAND textparent,@getposition,scene,pos
          if pos[1]>20
          D3DCOMMAND textparent,@setvelocity,scene,0,0,0,0
          textup=1
          endif
        endif
   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
        'The camera can move in the scene using the arrow keys
       IF(GETKEYSTATE(0x26))
           D3DCOMMAND camera,@ADDTRANSLATION,0,0,.6*mult
           ENDIF
         IF(GETKEYSTATE(0x28))
         D3DCOMMAND camera,@ADDTRANSLATION,0,0,-.6*mult
      ENDIF
      IF(GETKEYSTATE(0x25))
         D3DCOMMAND camera,@ADDROTATION,0,1,0,-.006*mult
      ENDIF
      IF(GETKEYSTATE(0x27))
         D3DCOMMAND camera,@ADDROTATION,0,1,0,.006*mult
      ENDIF
      'render the scene to the DirectX surface
      D3DRENDER scene,camera
      'add any 2D elements after the scene is rendered
        move win,0,0
      PRINT win,"Move around the scene with the arrow keys"
      'show the DirectX surface   
      DXFLIP win,0,0
   endif
ENDSELECT
RETURN

sub setupcubedata
length[1]=         5, 2.5, 2.5,   5,   5,   2,   2,   2,   5,   1,   1,   2,   3
orientation[1]=    0, -45,  45,   0,   0,  90,  90,  90,   0,   0,   0,   0, -40
x[1]=           -9.5,-8.5,-7.5,-6.5,-4.5,  -3,  -3,  -3,-0.5, 0.5, 0.5, 1.5, 1.3
y[1]=              7, 8.2, 8.2,   7,   7,   9,   7,   5,   7,   9,   7, 8.1,   6
length[14]=        5,   1,   1,   2,   3, 5.5,   3,   6,   6,   5, 2.6, 2.6,   5
orientation[14]=   0,   0,   0,   0, -40,  30, -40, -30,  30,   0, -45,  45,   0
x[14]=           3.5, 4.5, 4.5, 5.5, 5.2, 8.8,   8,-6.5,-6.5,-3.5,-2.7,-1.4,-0.5
y[14]=             7,   9,   7,   8,   6, 6.8,   8,   0,   0,   0, 1.2, 1.2,   0
length[27]=        5,   5,   2,   3,   1,   3,   1,   3
orientation[27]=  20, -20,  90,  90,   0,  90,   0,  90
x[27]=             2,   4,   3, 7.5, 6.5, 7.5, 8.5, 7.5
y[27]=             0,   0,   0,   2,   1,   0,  -1,  -2
return