Each one of us deserves a gift, guess who thought about us ???
Jolly Roger, for sure!!! :o
'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