Wednesday Workshop - BlitzCoder.net

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0|554|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
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+f*200,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=oldysp*cosit+oldxsp*cossp
				c\ysp=oldxsp*sinit+oldysp*sinsp
;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=xmove*c\spmax
	c\ysp=ymove*c\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\size*Sgn(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\size*Sgn(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)\move*Sin(dir*90)
					pc(p)\xsp=pc(p)\xsp+pc(p)\move*Cos(dir*90)
				EndIf
			Next
			If p=usemouse Then
				pc(p)\xsp=pc(p)\xsp+pc(p)\move*keep(MouseXSpeed()/9.,-1,1,0)
				pc(p)\ysp=pc(p)\ysp+pc(p)\move*keep(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\size*2,c\size*2,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,cr*2,cr*2,dx,dy,1,1)=0 Then Return 0
	xdist=Abs(cx-dx)
	ydist=Abs(cy-dy)
	Return Sqr(xdist*xdist+ydist*ydist)<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\size*2,c\size*2)=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/xdist*Sgn(xdist)
	Else
		xstep#=xdist/ydist*Sgn(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