rem DBC Challenges rem Gambling challenge rem by TheComet rem setup screen set display mode 800,600,32 sync on sync rate 60 backdrop off color backdrop 0 show mouse autocam off randomize timer() rem dimensions dim grav#(2) dim dx#(2) dim dy#(2) dim block(9) block(0)=1 rem generate media gosub generate_dice gosub generate_blocks gosub generate_board rem make sky create bitmap 1,512,512 for t=0 to 10000 ink rgb(rnd(255),rnd(255),rnd(255)),0 dot rnd(512),rnd(512) next t get image 1,0,0,128,128 delete bitmap 1 make object sphere 30,200 position object 30,0,0,0 texture object 30,1 set object 30,1,0,0 delete image 1 rem make banner make object plain 31,500,120 position object 31,0,211,400 lock object on 31 color object 31,0 rem line up blocks for t=3 to 11 position object t,((t-3)*10)-40,0,0 next t rem main loop position camera 100,100,100 roll=1 ink rgb(255,255,255),0 set text size 25 help=1 do rem toggle help if mouseclick()=2 and toggle=0 then inc help:toggle=1:if help=2 then help=0 if mouseclick()=0 then toggle=0 if help=0 then hide object 31 else show object 31 rem rotate sky rotate object 30,wrapvalue(object angle x(30)+2),wrapvalue(object angle y(30)+3),wrapvalue(object angle z(30)+1) rem camera set camera to follow 0,0,0,0,60,50,10,0 point camera 0,0,-20 rem roll dice if roll=1 r=rnd(100) if help=1 center text 400,20,"Shake mouse to roll dice..." center text 400,50,"Click mouse to let go..." endif oldmovex=movex oldmovey=movey movex=abs(mousemovex()/4) movey=abs(mousemovey()/4) inc acc1,oldmovex-movex:inc accx,acc1 inc acc2,oldmovey-movey:inc accy,acc2 position object 1,-15,10,-30 position object 2,15,10,-30 rotate object 1,wrapvalue(object angle x(1)+accx),wrapvalue(object angle y(1)+accx),wrapvalue(object angle z(1)+accx) rotate object 2,wrapvalue(object angle x(2)+accy),wrapvalue(object angle y(2)+accy),wrapvalue(object angle z(2)+accy) if mouseclick()=1 if accx>20 or accx<-20 if accy>20 or accy<-20 roll=2 time=0 randomize r else if help=1 then center text 400,80,"Spin faster!" endif else if help=1 then center text 400,80,"Spin faster!" endif endif endif rem drop dice if roll=2 for t=1 to 2 x#=object position x(t) y#=object position y(t) z#=object position z(t) grav#(t)=grav#(t)-0.1 inc y#,grav#(t) if y#<-14.5 grav#(t)=0-(grav#(t)/1.2) if grav#(t)<0 then grav#(t)=0 y#=-14.5 if t=1 then accx=accx/2:if accx<2 then accx=0:if set1=0 then rotate object 1,rnd(360),rnd(360),0:set1=1 if t=2 then accy=accy/2:if accy<2 then accy=0:if set2=0 then rotate object 2,rnd(360),rnd(360),0:set2=1 endif position object t,x#,y#,z# next t if time<50 rotate object 1,wrapvalue(object angle x(1)+accx),wrapvalue(object angle y(1)+accx),0 rotate object 2,wrapvalue(object angle x(2)+accy),wrapvalue(object angle y(2)+accy),0 else for t=1 to 2:rotate object t,curveangle(dx#(t),object angle x(t),20),curveangle(dy#(t),object angle y(t),20),0:next t endif rem destination angle inc time if time>50 for t=1 to 2 x#=object angle x(t) y#=object angle y(t) if x#<45 or x#=>315 then dx#(t)=0 if x#=>45 and x#<135 then dx#(t)=90 if x#=>135 and x#<225 then dx#(t)=180 if x#=>225 and x#<315 then dx#(t)=270 if y#<45 or y#=>315 then dy#(t)=0 if y#=>45 and y#<135 then dy#(t)=90 if y#=>135 and y#<225 then dy#(t)=180 if y#=>225 and y#<315 then dy#(t)=270 next t endif rem choose if time>100 then roll=3 endif rem determin numbers if roll=3 rem dice 1 x=object angle x(1) y=object angle y(1) if x>80 and x<100 then x=90 if x>170 and x<190 then x=180 if x>260 and x<280 then x=270 if x>350 or x<10 then x=0 if y>80 and y<100 then y=90 if y>170 and y<190 then y=180 if y>260 and y<280 then y=270 if y>350 or y<10 then y=0 if x=0 n1=5 endif if x=90 if y=0 then n1=2 if y=90 then n1=3 if y=180 then n1=1 if y=270 then n1=4 endif if x=180 n1=6 endif if x=270 if y=0 then n1=1 if y=90 then n1=4 if y=180 then n1=2 if y=270 then n1=3 endif rem dice 2 x=object angle x(2) y=object angle y(2) if x>80 and x<100 then x=90 if x>170 and x<190 then x=180 if x>260 and x<280 then x=270 if x>350 or x<10 then x=0 if y>80 and y<100 then y=90 if y>170 and y<190 then y=180 if y>260 and y<280 then y=270 if y>350 or y<10 then y=0 if x=0 n2=5 endif if x=90 if y=0 then n2=2 if y=90 then n2=3 if y=180 then n2=1 if y=270 then n2=4 endif if x=180 n2=6 endif if x=270 if y=0 then n2=1 if y=90 then n2=4 if y=180 then n2=2 if y=270 then n2=3 endif roll=4 rem set block options block1=n1 block2=n2 block3=n1+n2 if block3>9 then block3=0 endif rem choose if roll=4 rem user help if help=1 then center text 400,20,"Click either "+str$(n1)+", "+str$(n2)+", or "+str$(n1+n2) rem roll dice to a still-stand for t=1 to 2 x#=object position x(t) y#=object position y(t) z#=object position z(t) grav#(t)=grav#(t)-0.1 inc y#,grav#(t) if y#<-14.5 grav#(t)=0-(grav#(t)/1.2) if grav#(t)<0 then grav#(t)=0 y#=-14.5 endif position object t,x#,y#,z# next t set1=0 set2=0 rem scale picked block bigger x=mousex() y=mousey() success=1 lose=1 for t=3 to 11 if block(t-2)=0 then success=0 if t-2=block1 or t-2=block2 or t-2=block3 if block(t-2)=0 lose=0 rem scale bigger dx=object screen x(t) dy=object screen y(t) dist=((x-dx)*(x-dx))+((y-dy)*(y-dy)) if dist<400 scale object t,140,140,140 else scale object t,100,100,100 endif rem select if mouseclick()=1 and dist<400 then block(t-2)=1:scale object t,100,100,100:roll=1:exit endif endif next t if success=1 then win=1:lose=0 endif rem rotate blocks for t=3 to 11 if block(t-2)=1 xrotate object t,curveangle(235,object angle x(t),20) else xrotate object t,curveangle(90,object angle x(t),20) endif next t rem loser if lose=1 make object plain 21,500,500 position object 21,0,0,200 lock object on 21 color object 21,rgb(255,255,255) ghost object on 21,1 for t=255 to 0 step -1 color object 21,rgb(t,t,t) sync next t repeat center text 400,280,"LOSER!!" sync until mouseclick()=1 roll=1 for t=1 to 9:block(t)=0:next t lose=0 delete object 21 endif rem winner if win=1 make object plain 21,500,500 position object 21,0,0,200 lock object on 21 color object 21,rgb(255,255,255) ghost object on 21,1 for t=255 to 0 step -1 color object 21,rgb(t,t,t) sync next t repeat:until mouseclick()=0 repeat center text 400,280,"Congratulations!!" sync until mouseclick()=1 roll=1 for t=1 to 9:block(t)=0:next t lose=0 delete object 21 endif rem refresh screen sync rem end of main loop loop rem ********************************************* rem * SUBROUTINES * rem ********************************************* generate_dice: rem generate dice images create bitmap 1,64,64 ink rgb(255,255,255),0:box 0,0,63,63 ink 0,0:for t=0 to 3:circle 32,32,t:next t get image 1,0,0,64,64 ink rgb(255,255,255),0:box 0,0,63,63 ink 0,0:for t=0 to 3:circle 16,16,t:circle 48,48,t:next t get image 2,0,0,64,64 ink rgb(255,255,255),0:box 0,0,63,63 ink 0,0:for t=0 to 3:circle 16,16,t:circle 32,32,t:circle 48,48,t:next t get image 3,0,0,64,64 ink rgb(255,255,255),0:box 0,0,63,63 ink 0,0:for t=0 to 3:circle 16,16,t:circle 48,48,t:circle 16,48,t:circle 48,16,t:next t get image 4,0,0,64,64 ink rgb(255,255,255),0:box 0,0,63,63 ink 0,0:for t=0 to 3:circle 16,16,t:circle 48,48,t:circle 16,48,t:circle 48,16,t:circle 32,32,t:next t get image 5,0,0,64,64 ink rgb(255,255,255),0:box 0,0,63,63 ink 0,0:for t=0 to 3:circle 16,16,t:circle 48,48,t:circle 16,48,t:circle 48,16,t:circle 16,32,t:circle 48,32,t:next t get image 6,0,0,64,64 delete bitmap 1 rem generate dice for t=1 to 2 make object plain t,0,0 restore dice for limb=1 to 6 read flag if flag=0 read sizex read sizey read x read y read z read ax read ay read az make object plain t+1,sizex,sizey position object t+1,x,y,z rotate object t+1,ax,ay,az endif make mesh from object 1,t+1 delete object t+1 add limb t,limb,1 delete mesh 1 next limb next t rem texture dice for r=1 to 2:for t=1 to 6:texture limb r,t,t:next t:next r rem delete images for t=1 to 6:delete image t:next t return generate_blocks: rem arrays dim t$(8) t$(0)="." t$(1)="J" t$(2)="A" t$(3)="C" t$(4)="K" t$(5)="P" t$(6)="O" t$(7)="T" t$(8)="." rem make a wooden texture create bitmap 1,32,64 ink rgb(90,49,6),0 box 0,0,31,63 for t=0 to 1000 ink rgb(rnd(60)+70,rnd(40),rnd(6)),0 sx=rnd(32) sy=rnd(64) ex=rnd(32) ey=rnd(64) f=rnd(1) if f=1 then line sx,sy,sx,ey else line sx,sy,ex,sy next t get image 1,0,0,32,64 delete bitmap 1 rem print numbers 1-9 on texture ink rgb(255,255,255),0 set text size 40 create bitmap 1,32,64 for t=2 to 10 paste image 1,0,0 center text 16,10,str$(t-1) get image t,0,0,32,64 next t delete bitmap 1 rem print letters .jackpot. onto texture create bitmap 1,32,64 for t=11 to 19 paste image 1,0,0 center text 16,10,t$(t-11) get image t,0,0,32,64 next t delete bitmap 1 rem generate blocks for t=3 to 11 make object plain t,0,0 restore block for limb=1 to 22 read flag if flag=0 read sizex read sizey read x read y read z read ax read ay read az make object plain t+1,sizex,sizey position object t+1,x,y,z rotate object t+1,ax,ay,az endif if flag=1 read x1 read y1 read z1 read x2 read y2 read z2 read x3 read y3 read z3 make object triangle t+1,x1,y1,z1,x2,y2,z2,x3,y3,z3 endif make mesh from object 1,t+1 delete object t+1 add limb t,limb,1 delete mesh 1 next limb set object t,1,0,0 texture object t,1 next t rem texture blocks for t=3 to 11 texture limb t,1,t-1 texture limb t,2,t+8 next t rem clean up for t=1 to 19:delete image t:next t rem undim undim t$(8) return generate_board: rem make glass like stuff... uhm, It doesn't look like glass, but forget about that... create bitmap 1,64,64 ink RGB(2,142,125),0 box 0,0,63,63 ink RGB(4,174,210),0 x=rnd(64):y=rnd(64) for r=0 to 1:for t=0 to 20:circle x+r,y,t:next t:next r ink RGB(3,126,152),0 x=rnd(64):y=rnd(64) for r=0 to 1:for t=0 to 20:circle x+r,y,t:next t:next r get image 1,0,0,64,64 delete bitmap 1 rem make red fur create bitmap 1,128,128 ink RGB(154,20,1),0 box 0,0,127,127 for t=0 to 10000 ink rgb(rnd(50)+80,rnd(20),1),0 dot rnd(128),rnd(128) next t get image 2,0,0,128,128 delete bitmap 1 rem generate board make object plain 12,0,0 restore board for limb=1 to 5 read flag if flag=2 read sizex read sizey read sizez read x read y read z make object box 13,sizex,sizey,sizez position object 13,x,y,z endif make mesh from object 1,13 delete object 13 add limb 12,limb,1 delete mesh 1 next limb rem texture board texture limb 12,1,2 for t=2 to 5:texture limb 12,t,1:next t rem clean up delete image 1 delete image 2 return rem ********************************************* rem * DATA STATEMENTS * rem ********************************************* dice: data 0,10,10,0,0,5,0,0,0,0,10,10,0,0,-5,0,0,0,0,10,10,5,0,0,0,90,0,0,10,10,-5,0 data 0,0,270,0,0,10,10,0,5,0,90,0,0,0,10,10,0,-5,0,270,0,0 block: data 0,10,20,0,0,-2,0,0,0,0,10,20,0,0,2,180,0,0,0,4,20,-5,0,0,0,90,0,0,4,20,5 data 0,0,0,270,0,0,6,4,0,16,0,90,0,0,0,6,4,0,-16,0,270,0,0,1,-5,10,-2,-5,10,2,-3,16 data -2,1,-5,10,2,-3,16,2,-3,16,-2,1,-5,-10,-2,-5,-10,2,-3,-16,-2,1,-5,-10,2,-3,-16,2,-3,-16,-2,1 data 5,10,-2,5,10,2,3,16,-2,1,5,10,2,3,16,2,3,16,-2,1,5,-10,-2,5,-10,2,3,-16,-2,1,5,-10 data 2,3,-16,2,3,-16,-2,1,-5,10,-2,-3,16,-2,5,10,-2,1,-3,16,-2,5,10,-2,3,16,-2,1,-5,10,2,-3 data 16,2,5,10,2,1,-3,16,2,5,10,2,3,16,2,1,-5,-10,-2,-3,-16,-2,5,-10,-2,1,-3,-16,-2,5,-10,-2 data 3,-16,-2,1,-5,-10,2,-3,-16,2,5,-10,2,1,-3,-16,2,5,-10,2,3,-16,2 board: data 2,90,1,50,0,-20,-17 data 2,90,20,16,0,-14,0 data 2,1,26,50,-45,-13,-17 data 2,1,26,50,45,-13,-17 data 2,90,26,1,0,-13,-42