Wednesday Workshop - Socoder

Wednesday Workshop - Socoder

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|617\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
Wednesday Workshop #010 (17 Aug 2005) The Sports Challenge Sports!? Ten, to me, instantly brings to mind Daley Thompson's Decathlon. Strange but true.. So this week, being number ten and all, is the plain and simple "Make a Sports game" challenge. Anything goes, from "Bunch of real olympic events" to "Make up your own olympic events", from "Football" to "Super Deadly Ball", whatever you want, so long as it's Sports related. (Except Pong, of course!)

Not Pong by coorrae for Workshop #010 Table air hockey with decent physics, and a swirling thing in the middle. Cursors for player 1, Mouse for player 2 ;Use arraw keys only. ;Player 2 uses the mouse. Const scx=800,scy=600 Global players Graphics scx,scy,0,2 AppTitle "Not Pong!" Repeat players=Input("How many human players? 0-2 ") Until players=1 Or players=2 Or players=0 Global usemouse=0 If players=2 Then usemouse=2 EndIf SetBuffer BackBuffer() HidePointer SeedRnd MilliSecs() Type circle Field x#,y#,xsp#,ysp#,spmax# Field move#,size Field wall.wall,wallside Field tarx,tary Field hp,hitpuck,time End Type Type wall Field x1#,y1#,x2#,y2#,angle Field xsp1#,ysp1#,xsp2#,ysp2# Field static Field cossp#,sinsp#,cosit#,sinit# End Type Dim cos2#(360),sin2#(360) For ang=0 To 360 If ang<=180 Then cos2(ang)=+(090-ang).011111111 Else cos2(ang)=-(270-ang).011111111 EndIf If ang<=90 Then sin2(ang)=+(ang+000).011111111 ElseIf ang>=270 Then sin2(ang)=+(ang-360).011111111 Else sin2(ang)=+(ang-180).011111111 EndIf Next Dim key(2,4) key(1,1)=208 key(1,2)=203 key(1,3)=200 key(1,4)=205 key(2,1)=31 key(2,2)=30 key(2,3)=17 key(2,4)=32 Dim score(2) Dim pc.circle(2) For f=1 To 2 pc(f)=newcircle(150+f200,270,30,1.5,5,Null) Next Global puck.circle=newcircle(450,150+Rnd(-20,20),20,.1,10,Null) Global middle.wall=newwall(scx/2-80,scy/2,scx/2+80,scy/2,2,0) newwall(000,scy/2-100,scx/2-200,000,0) newwall(000,scy/2+100,scx/2-200,scy,0) newwall(scx,scy/2-100,scx/2+200,000,0) newwall(scx,scy/2+100,scx/2+200,scy,0) main() MoveMouse scx/2,scy/2 ;######################################################################### Function main() timer=CreateTimer(50) Repeat wait=WaitTimer(timer) For f=1 To wait controls() MoveMouse scx/2,scy/2 updatewalls() updatecircles() Next drawcircles() drawwalls() Flip Cls Until KeyHit(1) End End Function Function l_________UPDATE_________l() End Function ;######################################################################### Function updatecircles() For c.circle=Each circle If c\wall<>Null Then If c\wallside=1 Then c\x=c\wall\x1:c\y=c\wall\y1 If c\wallside=2 Then c\x=c\wall\x2:c\y=c\wall\y2 EndIf ; If c<>pc(usemouse) Then c\xsp=keep(c\xsp,-c\spmax,+c\spmax,0) c\ysp=keep(c\ysp,-c\spmax,+c\spmax,0) ; EndIf ; If c=pc(usemouse) Then ; steps=(Abs(c\xsp)+Abs(c\ysp))/10 ; If steps=0 Then steps=1 ; For f=1 To steps ; c\x=c\x+c\xsp/steps ; c\y=c\y+c\ysp/steps ; collision(c) ; Next ; Else c\x=c\x+c\xsp c\y=c\y+c\ysp collision(c) If c<>puck Then c\xsp=curve(c\xsp,0,.1) c\ysp=curve(c\ysp,0,.1) EndIf ; EndIf ; If c=pc(usemouse) Then ; c\xsp=0 ; c\ysp=0 ; EndIf Next End Function ;######################################################################### Function collision(c.circle) c\hitpuck=0 If c\x<000+c\size(c<>puck) Then c\x=c\size :c\xsp=-c\xsp:If c=puck Then c\x=scx/2:c\xsp=0:c\ysp=0:score(2)=score(2)+1 If c\y<000+c\size Then c\y=c\size :c\ysp=-c\ysp If c\x>scx-c\size(c<>puck) Then c\x=scx-c\size:c\xsp=-c\xsp:If c=puck Then c\x=scx/2:c\xsp=0:c\ysp=0:score(1)=score(1)+1 If c\y>scy-c\size Then c\y=scy-c\size:c\ysp=-c\ysp If c<>puck Then c2.circle=puck If dotincircle(c\x,c\y,c2\x,c2\y,c\size+c2\size)=1 Then c\hitpuck=1 ;puck moves out of circle flipped=0 xmove=Sgn(c2\x-c\x) ymove=Sgn(c2\y-c\y) Repeat c2\x=c2\x+xmove c2\y=c2\y+ymove If collidewall(c2) Then c2\x=c2\x-xmove c2\y=c2\y-ymove moveout(c,c2) Exit EndIf Until dotincircle(c\x,c\y,c2\x,c2\y,c\size+c2\size)=0 ang=ATan2(c\y-c2\y,c\x-c2\x)+180 speed#=(Abs(c2\xsp)+Abs(c2\ysp))/2 c2\xsp=Cos(ang)(Abs(c\xsp)+Abs(speed)) c2\ysp=Sin(ang)(Abs(c\ysp)+Abs(speed)) ; c2\x=c2\x+c2\xsp ; c2\y=c2\y+c2\ysp EndIf EndIf If c\wall=Null Then For w.wall=Each wall If circleonwall(c,w) Then c\x=c\x-c\xsp c\y=c\y-c\ysp If w\static=1 Then cossp#=w\cossp sinsp#=w\sinsp cosit#=w\cosit sinit#=w\sinit Else cossp#=(Abs(Cos2(w\angle))-.5)2 sinsp#=(Abs(Sin2(w\angle))-.5)2 cosit#=(1-Abs(cossp))Sgn(Cos2(w\angle)) sinit#=(1-Abs(sinsp))Sgn(Sin2(w\angle)) EndIf If cossp>1 Or cossp<-1 Then RuntimeError "cossp="+cossp If sinsp>1 Or sinsp<-1 Then RuntimeError "sinsp="+sinsp oldxsp#=c\xsp oldysp#=c\ysp c\xsp=oldyspcosit+oldxspcossp c\ysp=oldxspsinit+oldyspsinsp ;RuntimeError "cossp="+cossp+" sinsp="+sinsp+" w\angle="+w\angle+" c\xsp="+c\xsp+" c\ysp="+c\ysp+" cos2(w\angle)="+Cos2(w\angle)+" sin2(w\angle)="+Sin2(w\angle)+" oldxsp="+oldxsp+" oldysp="+oldysp EndIf Next EndIf End Function ;######################################################################### Function moveout(c.circle,c2.circle) xmove=Sgn(c\x-c2\x) ymove=Sgn(c\y-c2\y) Repeat c\x=c\x+xmove c\y=c\y+ymove ; If collidewall(c) Then Return Until dotincircle(c\x,c\y,c2\x,c2\y,c\size+c2\size)=0 c\x=c\x+xmove c\y=c\y+ymove c\xsp=xmovec\spmax c\ysp=ymovec\spmax End Function ;######################################################################### Function collidewall(c.circle) For w.wall=Each wall If circleonwall(c,w) Then Return 1 EndIf Next End Function ;######################################################################### Function controls() For p=1 To 2 If p>players Then tarx=puck\x If p=1 Then tarx=tarx-puck\size If p=2 Then tarx=tarx+puck\size tary=puck\y If p=1 Then tarx=tarx+puck\xsp(Abs(puck\y-pc(p)\y)/9) If p=2 Then tarx=tarx+puck\xsp(Abs(puck\y-pc(p)\y)/9) If p=1 Then tary=tary+puck\ysp(Abs(puck\x-pc(p)\x)/9) If p=2 Then tary=tary+puck\ysp(Abs(puck\x-pc(p)\x)/9) If p=1 Then If pc(p)\x>puck\x+puck\size And pc(p)\x<puck\x+150 Then tary=puck\y+puck\sizeSgn(pc(p)\y-puck\y) tarx=puck\x EndIf Else If pc(p)\x<puck\x-puck\size And pc(p)\x>puck\x-150 Then tary=puck\y+puck\sizeSgn(pc(p)\y-puck\y) tarx=puck\x EndIf EndIf If p=1 Then If tarx>scx/2-20 Then tarx=scx/2-(puck\x-scx/2) If p=2 Then If tarx<scx/2+20 Then tarx=scx/2+(scx/2-puck\x) If pc(p)\hp>10 Then tary=scy-puck\y pc(p)\xsp=pc(p)\xsp+Sgn(tarx-pc(p)\x)pc(p)\move pc(p)\ysp=pc(p)\ysp+Sgn(tary-pc(p)\y)pc(p)\move pc(p)\tarx=tarx pc(p)\tary=tary pc(p)\hp=pc(p)\hp+pc(p)\hitpuck If MilliSecs()-pc(p)\time>100 Then pc(p)\time=MilliSecs() If pc(p)\hp>0 Then pc(p)\hp=pc(p)\hp-1 EndIf Else For dir=1 To 4 If KeyDown(key(p,dir)) Then pc(p)\ysp=pc(p)\ysp+pc(p)\moveSin(dir90) pc(p)\xsp=pc(p)\xsp+pc(p)\moveCos(dir90) EndIf Next If p=usemouse Then pc(p)\xsp=pc(p)\xsp+pc(p)\movekeep(MouseXSpeed()/9.,-1,1,0) pc(p)\ysp=pc(p)\ysp+pc(p)\movekeep(MouseYSpeed()/9.,-1,1,0) EndIf EndIf Next End Function ;######################################################################### Function updatewalls() For w.wall=Each wall If w\static=0 Then updatewall(w) If w=middle Then ang=ATan2(scy/2-w\y1,scx/2-w\x1) w\xsp1=Cos(ang+90) w\ysp1=Sin(ang+90) w\xsp2=Cos(ang-90) w\ysp2=Sin(ang-90) EndIf w\x1=w\x1+w\xsp1 w\y1=w\y1+w\ysp1 w\x2=w\x2+w\xsp2 w\y2=w\y2+w\ysp2 w\x1=keep(w\x1,0,scx,0) w\x2=keep(w\x2,0,scx,0) w\y1=keep(w\y1,0,scy,0) w\y2=keep(w\y2,0,scy,0) EndIf Next End Function ;######################################################################### Function updatewall(w.wall) w\angle=keep(ATan2(w\y2-w\y1,w\x2-w\x1),0,180,1) If w\static=1 Then w\cossp=(Abs(Cos2(w\angle))-.5)2 w\sinsp=(Abs(Sin2(w\angle))-.5)2 w\cosit=(1-Abs(w\cossp))Sgn(cos2(w\angle)) w\sinit=(1-Abs(w\sinsp))Sgn(sin2(w\angle)) EndIf End Function ;######################################################################### Function l__________DRAW__________l() End Function ;######################################################################### Function drawcircles() For c.circle=Each circle Color 255,255,255 Oval c\x-c\size,c\y-c\size,c\size2,c\size2,1 ; Color 255,0,0 ; Rect c\tarx,c\tary,4,4 Next Color 0,0,255 For p=1 To 2 Text pc(p)\x,pc(p)\y,score(p),1,1 Next Color 255,255,255 End Function ;######################################################################### Function drawwalls() For w.wall=Each wall Line w\x1,w\y1,w\x2,w\y2 Next End Function Function l__________MISC__________l() End Function ;######################################################################### Function dotincircle(dx,dy,cx,cy,cr) If RectsOverlap(cx-cr,cy-cr,cr2,cr2,dx,dy,1,1)=0 Then Return 0 xdist=Abs(cx-dx) ydist=Abs(cy-dy) Return Sqr(xdistxdist+ydistydist)<cr End Function ;######################################################################### Function keep#(num#,min=1,max=360,wrap=1) ;keep number in bounds If wrap=0 Then If num<min Then num=min ElseIf num>max num=max EndIf Else ;wrap number While num<min: num=num+(max-min): Wend While num>max: num=num-(max-min): Wend EndIf Return num End Function ;######################################################################### Function curve#(num#,dest#=0,speed#=.01,away=0) If away=0 Then If num<dest Then num=num+speed If num>dest Then num=num-speed If Abs(dest-num)<speed Then num=dest Else If num<dest Then num=num-speed If num>dest Then num=num+speed EndIf Return num End Function ;######################################################################### Function newwall.wall(x1,y1,x2,y2,circles=2,static=1) w.wall=New wall w\x1=x1 w\y1=y1 w\x2=x2 w\y2=y2 w\static=static If circles>0 Then newcircle(0,0,2,0,0,w,1) If circles=2 Then newcircle(0,0,2,0,0,w,2) EndIf updatewall(w) Return w End Function ;######################################################################### Function newcircle.circle(x,y,size,move#,spmax#,w.wall,side=0) c.circle=New circle c\x=x c\y=y c\size=size c\move=move c\spmax=spmax c\wall=w c\wallside=side Return c End Function ;######################################################################### Function circleonwall(c.circle,w.wall) startx=w\x1:xsize=w\x2-w\x1 starty=w\y1:ysize=w\y2-w\y1 If w\x2<w\x1 Then startx=w\x2:xsize=w\x1-w\x2 If w\y2<w\y1 Then starty=w\y2:ysize=w\y1-w\y2 If RectsOverlap(startx,starty,xsize,ysize,c\x-c\size,c\y-c\size,c\size2,c\size2)=0 Then Return 0 xdist#=Int(w\x2)-Int(w\x1) ydist#=Int(w\y2)-Int(w\y1) If Abs(xdist)>Abs(ydist) Then xstep#=Sgn(xdist) ystep#=ydist/xdistSgn(xdist) Else xstep#=xdist/ydistSgn(ydist) ystep#=Sgn(ydist) EndIf x1#=Int(w\x1) y1#=Int(w\y1) Repeat If Int(x1)=Int(w\x2) If Int(y1)=Int(w\y2) Then Exit x1=x1+xstep y1=y1+ystep If dotincircle(x1,y1,c\x,c\y,c\size) Then Repeat c\x=curve(c\x,x1,1,1) c\y=curve(c\y,y1,1,1) Until dotincircle(x1,y1,c\x,c\y,c\size) =0 Return 1 EndIf Forever End Function ;######################################################################### Function template() End Function

Kerby by Jayenkai for Workshop #010 Throw the ball against the Kerb Spacebar and Up to Jump Click to download this entry

Killer Football by Magicman for Workshop #010 It's so good it will entertain you for seconds! Spacebar and Cursors Click to download this entry

Speed Shooting by HoboBen for Workshop #010 Shoot faster than the enemy and win! Spacebar for OnionHead, and Down for SpamMan Click to download this entry

Oscar's Pool by oscar for Workshop #010 here is my entry so far(won't get a chance to finish it ) Mouse Graphics 800,600,32,0 Global rectx, recty, Recth, rectw Global xW, yW Global power =0 Global dirX=1, dirY=0 xW=230 yW=270 Type NWball Field X Field Y Field size Field Ydir Field Xdir End Type SetBuffer BackBuffer() ball_start() While Not KeyHit(1) Cls table() ; draw line If Not power<>0 Or MouseDown(1) Then Line MouseX(),MouseY(),xW +5,yW +5 ;draw cue ball drawballWHITE (1,xW,YW) ;click mouse If MouseDown(1) Then For r=1 To 30 If power <30 Then power=power+1 Next EndIf ;move white ball If Not MouseDown(1) Then If power>0 Then xW=xW + power * dirX power=power-1 EndIf EndIf If xW <= rectx Then dirX= dirX* -1 xW= rectX+10 EndIf If xW => rectX + rectW -10 Then dirX=-1 xW =rectX + rectW -10 EndIf move_ball() Flip Wend End Function table() rectX=200 rectY=150 rectW=400 rectH=250 Color 100,100,100 Rect 190,140,420,269 Color 10,150,10 Rect rectX,rectY,rectW,rectH,1 ;holes Color 0,0,0 Oval 193,143,12,12,1 Oval 400,140,12,12,1 Oval 593,143,12,12,1 Oval 193,393,12,12,1 Oval 400,397,12,12,1 ;ball Line Color 150,150,150 Line 250,150,250,399 End Function Function drawballWHITE(num,xW,yW) Color 255,255,255 Oval xW,yW,10,10,1 Color 255,255,255 End Function Function ball_start() ; create balls For blah=1 To 15 If setup=0 Then ball.NWball= New NWball ball\Xdir=1 Select blah Case 1 ball\X=500 ball\Y=275 Case 2 ball\X=510 ball\Y=270 Case 3 ball\X=510 ball\Y=280 Case 4 ball\X=520 ball\Y=285 Case 5 Color 200,200,200 ball\X=520 ball\Y=275 Case 6 ball\X=520 ball\Y=265 Case 7 ball\X=530 ball\Y=260 Case 8 ball\X=530 ball\Y=270 Case 9 ball\X=530 ball\Y=280 Case 10 ball\X=530 ball\Y=290 Case 11 ball\X=540 ball\Y=255 Case 12 ball\X=540 ball\Y=265 Case 13 ball\X=540 ball\Y=275 Case 14 ball\X=540 ball\Y=285 Case 15 ball\X=540 ball\Y=295 End Select EndIf Next setup=1 End Function Function move_ball() For ball.NWball =Each NWball ;if white htis another ball If xW => ball\X And xW <= ball\X +5 Then ; if red ball hits right of table If ball\X => rectW+ rectX -15 Then ball\X= rectW+ rectX -15 ball\Xdir= ball\Xdir -1 ball\X =ball\X + power ball\Xdir Else ball\X =ball\X + power * ball\Xdir EndIf ; if red ball hits left of table If ball\X <=rectX +15 Then ball\X = rectX +15 ball\Xdir = ball\Xdir -1 ball\X = ball\X + power ball\Xdir Else ball\X =ball\X + power * ball\Xdir EndIf EndIf Color 255,0,0 Oval ball\X,ball\Y,10,10,1 Color 200,200,200 Next End Function

Crazy Pool by firemaker103 for Workshop #010 You have no control of where the ball goes! Click the mouse button Click to download this entry

Cheerleading is NOT a real sport, sports game. by tikiman for Workshop #010 There are 3 levels of arrow punching mayhem to be had. Cursors Click to download this entry

Track 'n' Field : 100 meter dash by jayparker for Workshop #010 For now you have to settle for 100 metres dash. =) Cursors / Z+C Click to download this entry

Copyright Jayenkai - 2017+ | Thanks to Shroom_Monk for CSS/Dev Tips | Uses a Jay-Tweaked version of CBParser.
Page Took : 0.119

Wednesday Workshop - Socoder