DarkBASIC Pro
Versão de Avaliação
Patch 5.7
USB Dongle
Forum
Indique
Lista de Email
Diário Antigo
Outros Produtos
Cartography Shop
DarkMatter
Local DBPro Sites
Italy
UK
Visualizador de Códig Fonte
Este é o Código Fonte de "L-Type".
Cor:
Verde
Laranha
Branco
Tam. Fonte:
Padrão
Grande
` This code is copyright Dark Basic Software Limited 2002 Rem Project: LTypeDemo Rem Created: 07/08/2002 05:57:18 rem Hours: 25 rem Init for best performance sync on : sync rate 60 : backdrop off : hide mouse if check display mode(1024,768,32)=1 then set display mode 1024,768,32 rem Loading screen load bitmap "media\gfx\backdrop.jpg",1 copy bitmap 1,0,0,640,480,0,0,0,screen width(),screen height() sync : delete bitmap 1 rem Setup strapline gosub _create_strap rem Load sky set camera range 1,10000 load object "media\sky\ds.x",1 set object texture 1,2,1 set object light 1,0 rem Load ship load object "media\ship\ship.x",101 scale object 101,50,50,50 xrotate object 101,270 fix object pivot 101 rotate object 101,0,0,0 rem Create landscape load image "media\ground\ground.bmp",1 make matrix 1,3000,1500,15,15 prepare matrix texture 1,1,1,1 position matrix 1,-750,-300,0 gosub _newmatrix rem Ship exhaust load image "media\gfx\plasma.bmp",11 load image "media\gfx\fire.bmp",12 load image "media\gfx\debris.bmp",13 make particles 1,11,20,35.0 position particles 1,0,0,500 rotate particles 1,0,0,90 set particle velocity 1,10.0 set particle life 1,5 rem Debris cloud make particles 21,13,10,200.0 position particles 21,0,0,500 set particle velocity 21,40.0 set particle emissions 21,0 set particle speed 21,0.03 rotate particles 21,90,0,0 set particle life 21,10 hide particles 21 rem Load scuds and rockets for sc=1 to 9 objid=200+sc rem scud load object "media\scud\fire.x",objid scale object objid,1000,1000,1000 position object objid,sc*50,-100,500 set object speed objid,100 set object light objid,0 yrotate object objid,70 hide limb objid,2 play object objid hide object objid rem missile load object "media\scud\scud.x",100+objid scale object 100+objid,500,500,500 set object light 100+objid,0 hide object 100+objid xrotate object 100+objid,90 fix object pivot 100+objid rem particle for missile make particles 1+sc,12,10,30.0 set particle life 1+sc,10 hide particles 1+sc next sc rem Make explosion objects load bitmap "media\explosion\explode.jpg",1 xx#=512.0/4.0 yy#=512.0/4.0 for y=0 to 2 for x=0 to 3 get image 501+x+(y*4),(x*xx#),(y*yy#),(x*xx#)+xx#,(y*yy#)+yy# next x next y get image 513,0,0,32,32 get image 514,0,0,32,32 get image 515,0,0,32,32 get image 516,0,0,32,32 for ex=1 to 5 make object plain 500+ex,256,256 position object 500+ex,0,0,500 set object light 500+ex,0 ghost object on 500+ex,2 set object 500+ex,1,1,1 hide object 500+ex next ex delete bitmap 1 rem Create laser for ship load image "media\gfx\laser.bmp",102 for bu=1 to 5 bobj=101+bu make object plain bobj,256,64 texture object bobj,102 position object bobj,0,0,500 set object light bobj,0 ghost object on bobj,2 hide object bobj next bu rem Load gameover image load image "media\gfx\gameover.bmp",601 load image "media\gfx\bestmiles.bmp",602 rem Load sounds load sound "media\sounds\jet.wav",1 : loop sound 1 load sound "media\sounds\fire.wav",2 load sound "media\sounds\shipbang.wav",3 load sound "media\sounds\rocket.wav",4 load sound "media\sounds\scudbang.wav",5 load sound "media\sounds\start.wav",6 load sound "media\sounds\gameover.wav",7 rem Setup camera set camera fov 30 position camera 0,0,-1000 rotate camera 0,0,0 play sound 6 rem Setup arrays and vars dim exc(10) bestmiles=1000 gwrapspeed#=0.0 fuel#=100.0 gameover=0 rem Ensure random different randomize timer() rem Main loop do rem Control scroll speed if gameover=0 if gwrapspeed#<8.0 then gwrapspeed#=gwrapspeed#+0.1 else rem game over prompt position camera camera position x(),camera position y()+3.0,camera position z() if bestgame=0 then paste image 601,(screen width()-512)/2,(screen height()-256)/2 if bestgame=1 then paste image 602,(screen width()-512)/2,(screen height()-256)/2 dec gameovercount rem restart game if gameovercount<=0 rem reset camera position camera 0,0,-1000 rem reset ship rotate object 101,0,0,0 show particles 1 show object 101 sx#=0 : sy#=0 fuel#=100.0 miles#=0.0 loop sound 1 rem reset matrix gosub _newmatrix rem reset scuds for sc=1 to 9 : hide object 200+sc : position object 200+sc,10000,0,0 : next sc rem reset missiles for sc=1 to 9 : hide object 300+sc : hide particles 1+sc : next sc rem reset game play sound 6 gameover=0 bestgame=0 miles=0 endif endif rem Control ship lift=0 : firegun=0 if gameover=0 and killship=0 if upkey()=1 and sy#<350.0 then iy#=6.0 : lift=1 if fuel#<2.0 then iy#=-3.0 if downkey()=1 then iy#=-6.0 : lift=2 if leftkey()=1 and sx#>-450.0 then ix#=-6.0 if rightkey()=1 and sx#<450.0 then ix#=6.0 if shiftkey()=1 then firegun=1 ix#=ix#/1.2 : iy#=iy#/1.2 sx#=sx#+ix# : sy#=sy#+iy# position object 101,sx#,sy#,500 endif rem Ensure ship cannot enter ground gh#=get matrix height(1,7+((sx#-200)/200.0),5)-300 if sy#
30.0 killship=1 else sy#=gh# endif endif rem Animate ship if lift=1 then srx#=srx#+0.8 if lift=2 then srx#=srx#-0.8 xrotate object 101,srx# srx#=srx#/1.05 rem Make particles emerge from ship position particles 1,sx#-20,sy#+5,500+25 rem Control wrapping sky yrotate object 1,wrapvalue(object angle y(1)-(gwrapspeed#/32.0)) rem Control tilt of camera tiltc#=curveangle(iy#*-1.0,tiltc#,20.0) zrotate camera tiltc# rem Control ground wrapping gwrap#=gwrap#+gwrapspeed# if gwrap#>=400.0 rem shift old ground gwrap#=gwrap#-400.0 shift matrix left 1 : shift matrix left 1 rem create new ground mh#=rnd(500) set matrix height 1,13,0,0 set matrix height 1,14,0,0 for z=1 to 13 h#=mh#*cos((z-7)*20) set matrix height 1,13,z,h# set matrix height 1,14,z,h# if z=5 then platy#=h# mh#=mh#+(rnd(20)-10) next z set matrix height 1,13,14,0 set matrix height 1,14,14,0 update matrix 1 rem if random chance if rnd(3)=0 rem place scud for sc=1 to 9 objid=200+sc if object visible(objid)=0 and object visible(100+objid)=0 then exit next sc if sc<=9 position object objid,(3000-750)-500,-300+platy#,500 yrotate object objid,45+rnd(60) show object objid endif endif endif position matrix 1,-750-200-gwrap#,-300,0 rem Control scuds for sc=1 to 9 rem keep with ground objid=200+sc position object objid,object position x(objid)-gwrapspeed#,object position y(objid),object position z(objid) rem if close to X of ship, fire if abs((sx#+400+rnd(200))-object position x(objid))<200.0 and object playing(objid)=0 and gameover=0 rem fire animation play object objid endif if object playing(objid)=1 and object frame(objid)>10 and object visible(objid)=1 and object visible(100+objid)=0 rem position missile position object 100+objid,object position x(objid)+50,object position y(objid)+10,object position z(objid) rotate object 100+objid,270,0,60 position particles 1+sc,50,-300,0 show object 100+objid show particles 1+sc play sound 4 endif rem keep missiles with ground too position object 100+objid,object position x(100+objid)-8.0,object position y(100+objid),object position z(100+objid) position particles 1+sc,particles position x(1+sc)-8.0,-300,0 position particle emissions 1+sc,object position x(objid)/30.0,(object position y(100+objid)+300)/30.0,object position z(100+objid)/30.0 rem when off screen, reset if object position x(objid)<-600 hide object objid endif rem control missile if object visible(100+objid)=1 rem move until leave position object 100+objid,object position x(100+objid)-gwrapspeed#,object position y(100+objid)+4.0,object position z(100+objid) rem when leave screen if object position x(100+objid)<-3000 or object position y(100+objid)>2000 hide object 100+objid hide particles 1+sc endif endif if object visible(100+objid)=1 rem when hit ship dx#=abs(object position x(100+objid)-sx#) dy#=abs(object position y(100+objid)-sy#) if dx#<10 and dy#<50 then killship=1 endif next sc rem Fire the ships gun if guncool>0 then dec guncool if firegun=1 and guncool=0 for bu=1 to 5 bobj=101+bu if object visible(bobj)=0 then exit next bu if bopbj<=106 position object bobj,sx#,sy#,500+25 show object bobj guncool=5 : fuel#=fuel#-0.05 play sound 2 endif endif rem Handle bullets for bu=1 to 5 bobj=101+bu if object visible(bobj)=1 rem move bullet position object bobj,object position x(bobj)+64,object position y(bobj),object position z(bobj) if object position x(bobj)>500 then hide object bobj endif if object visible(bobj)=1 rem ensure bullet cannot enter ground gh#=get matrix height(1,7+((object position x(bobj)-200)/200.0),4)-300 if object position y(bobj)
100.0 then fuel#=100.0 rem make a noise play sound 5 endif next sc endif next bu rem Trigger ship explosion if killship=1 and shipexplosion=0 ex=1 : exc(ex)=501 : position object 500+ex,sx#-20,sy#+5,500+25 show object 500+ex hide particles 1 position particles 21,sx#-20,sy#+5,500+25 set particle emissions 21,20 show particles 21 play sound 3 shipexplosion=1 endif rem Control explosions for ex=1 to 5 if exc(ex)>0 exc(ex)=exc(ex)+1 if exc(ex)>515 rem end particle and explosion set particle emissions 21,0 hide object 500+ex exc(ex)=0 if ex=1 rem destroy ship stop sound 1 hide object 101 shipexplosion=0 killship=0 gameover=1 : gameovercount=200 play sound 7 endif else rem update explosion texture object 500+ex,exc(ex) if ex=1 rem rock ship rotate object 101,object angle x(101)+10,object angle y(101)+5,object angle z(101)+15 endif endif endif next ex rem During game if gameover=0 rem Reduce fuel slowly fuel#=fuel#-0.05 : if fuel#<0 then fuel#=0.0 rem Gain miles slowly miles=miles+1 : miles#=miles#+0.01 : if miles#>100.0 then miles#=100.0 endif rem Show fuel set cursor 0,0 : print "FUEL" if fuel#<20 then rr=255 else rr=0 box 32,2,38+((screen width()-16)/100)*fuel#,10,rgb(rr,100,100),rgb(rr,100,100),rgb(rr,255,255),rgb(rr,255,255) rem Show miles set cursor 0,13 : print "MILES" box 32,15,38+((screen width()-16)/100)*miles#,15+8,rgb(0,100,0),rgb(0,100,0),rgb(0,255,0),rgb(0,255,0) set cursor (38+((screen width()-16)/100)*miles#)+4,13 : print str$(miles) rem Record and show best miles set cursor screen width()-110,13 : print "BEST MILES "+str$(bestmiles) if miles>bestmiles then bestmiles=miles : bestgame=1 rem Move strap line gosub _control_strap rem Update screen sync rem Endloop loop _newmatrix: tr#=50 for x=0 to 15 set matrix height 1,x,0,0 for z=1 to 14 h#=cos((z-7)*20)*100.0 h#=h#+tr# if x<13 then h#=250.0 n#=0.25+(rnd(10)*0.75) n#=n#*cos((z-8)*20) set matrix height 1,x,z,h# set matrix normal 1,x,z,n#,n#,n# next z set matrix height 1,x,14,0 tr#=tr#+(rnd(50)-25) next x update matrix 1 return rem Demo Subroutines _create_strap: load image "media\gfx\prompt.bmp",2 load image "media\gfx\strapblank.bmp",3 strapx1=0 : sprite 1,strapx1,480-63,2 strapx2=1024 : sprite 2,strapx2,480-63,2 set sprite alpha 1,196 : set sprite alpha 2,196 set sprite 1,0,1 return _control_strap: dec strapx1 : if strapx1<=-1024 then strapx1=strapx2+1023 dec strapx2 : if strapx2<=-1023 then strapx2=strapx1+1024 sprite 1,strapx1,screen height()-63,2 sprite 2,strapx2,screen height()-63,3 return
Selecionar todo o Código
Ver este Download
Copyright © 2003 Dark Basic Software Limited.
Virtual Object Informática Ltda.®