nice code.
* add a FillPolygon-Routine (when two rays are to near, fillarea will not work correct)
* I filter the segs-list. I only calculate ray-segments-collisions, when a collision is possible (this speed up the code, i can handle here over 400 boxes with nearly the same speed)
Code: Select all
EnableExplicit
;Original Polygon-Routine from
;http://www.purebasic.fr/english/viewtopic.php?f=12&t=42870&start=0
Structure pippoint
x.i
y.i
EndStructure
Procedure FilledPolygon(List points.pippoint(),color,midx=0,midy=0,spr=#PB_Any)
Protected miny,maxy,cy,oddnodes
Protected x.d,y.d,x1.d,y1.d,x2.d,y2.d
Protected iNodes.i, i.i
If spr<>#PB_Any
Protected startx,offx,starty
Protected SprWidth=SpriteWidth(spr)
Protected SprHeight=SpriteHeight(spr)
Protected sprxmid=SprWidth/2
Protected sprymid=SprHeight/2
Protected width,width2
EndIf
;NewList nodes.i()
Dim nodes.i( ListSize(points()) )
;Find least and most y values to restrict area to transverse when filling..
ResetList(points())
If NextElement(points())
miny=points()\y;OutputHeight()-1
maxy=points()\y
While NextElement(points())
If points()\y<miny:miny=points()\y:EndIf
If points()\y>maxy:maxy=points()\y:EndIf
Wend
EndIf
For cy=miny To maxy
y=cy
oddnodes=#False
;ClearList(nodes())
;LastElement(points())
iNodes=-1
x1=points()\x
y1=points()\y
ForEach points()
x2=points()\x
y2=points()\y
If ((y2<Y) And y1>=Y) Or (y1<Y And y2>=Y)
iNodes+1
;AddElement(nodes())
nodes(iNodes)=(x2+(Y-y2) / (y1-y2) * (x1-x2))
EndIf
x1=x2
y1=y2
Next
If iNodes>-1
nodes(iNodes+1)=nodes(iNodes)
SortArray(nodes(),#PB_Sort_Ascending,0,iNodes)
For i=0 To iNodes Step 2
If spr<>#PB_Any
startx=sprxmid+ nodes(i)-midx
width=nodes(i+1)-nodes(i)+1
offx=0
If startx<0
offx=-startx
width-offx
startx=0
EndIf
starty=sprymid+y-midy
If starty>=0 And starty<SprWidth And startx<SprWidth And width>0
If offx>0
ClipSprite(spr,1,1,1,1)
ZoomSprite(spr,offx+1,1)
DisplayTransparentSprite(spr,nodes(i),y)
ZoomSprite(spr,#PB_Default,#PB_Default)
ClipSprite(spr,#PB_Default,#PB_Default,#PB_Default,#PB_Default)
EndIf
If startx+width>SprWidth
width2=startx+width-SprWidth
ClipSprite(spr,1,1,1,1)
ZoomSprite(spr,width2,1)
DisplayTransparentSprite(spr,nodes(i)+offx+width-width2,y)
ZoomSprite(spr,#PB_Default,#PB_Default)
ClipSprite(spr,#PB_Default,#PB_Default,#PB_Default,#PB_Default)
EndIf
ClipSprite(spr,
startx,
starty,
width,
1)
DisplayTransparentSprite(spr,nodes(i)+offx,y)
ClipSprite(spr,#PB_Default,#PB_Default,#PB_Default,#PB_Default)
Else
ClipSprite(spr,1,1,1,1)
ZoomSprite(spr,nodes(i+1)-nodes(i)+1,1)
DisplayTransparentSprite(spr,nodes(i),y)
ZoomSprite(spr,#PB_Default,#PB_Default)
ClipSprite(spr,#PB_Default,#PB_Default,#PB_Default,#PB_Default)
EndIf
Else
LineXY(nodes(i),Y,nodes(i+1),y,color)
EndIf
Next
EndIf
Next
EndProcedure
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0:MessageRequester("Error", "Can't open the sprite system", 0):End:EndIf
If OpenWindow(0, 0, 0,800, 600,"lighting", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0:MessageRequester("Error", "Can't open windowed screen!", 0):EndIf
If OpenWindowedScreen(WindowID(0), 0, 0, 800, 600, 0, 0, 0,#PB_Screen_NoSynchronization)=0:MessageRequester("Error", "Can't open windowed screen!", 0):EndIf
Structure seg
*pt1.pt
*pt2.pt
DoDelete.d
EndStructure
Structure xy
x.d
y.d
EndStructure
Structure ray
a.xy
b.xy
EndStructure
Structure pt
x.d
y.d
angle.d
*seg.seg
*startseg.seg
*endseg.seg
EndStructure
Global NewList pt.pt()
Global NewList Seg.seg()
NewList *segs.seg()
NewList ligne.pippoint()
#MaxDistance=10000.0
Procedure.d Intersection(*ray.ray,*seg.seg)
Protected r_dx.d,r_dy.d,s_dx.d,s_dy.d
Protected t2.d,t1.d
Protected r_mag.d,s_mag.d
r_dx.d = *ray\b\x-*ray\a\x
r_dy.d = *ray\b\y-*ray\a\y
s_dx.d = *seg\pt2\x-*seg\pt1\x
s_dy.d = *seg\pt2\y-*seg\pt1\y
T2.d = (r_dx*(*seg\pt1\y-*ray\a\y) + r_dy*(*ray\a\x-*seg\pt1\x))/(s_dx*r_dy - s_dy*r_dx);
If T2<0 Or T2>1:ProcedureReturn #MaxDistance:EndIf ;
T1.d = (*seg\pt1\x+s_dx*T2-*ray\a\x)/r_dx;
If T1<0 Or IsInfinity(t1):ProcedureReturn #MaxDistance:EndIf
ProcedureReturn t1
EndProcedure
Procedure AddSegment(x1,y1,x2,y2)
AddElement(seg()):;seg()\x1=x1:seg()\y1=y1:seg()\x2=x2:seg()\y2=y2
AddElement(pt())
pt()\x=x1:pt()\y=y1
pt()\seg=@seg()
seg()\pt1=@pt()
AddElement(pt())
pt()\x=x2:pt()\y=y2
pt()\seg=@seg()
seg()\pt2=@pt()
EndProcedure
Define i,ii, size, rx,ry,oldmili
Define x.d,y.d
Define an
Define *oldseg,segcount,*curseg,closest.d,retour.d
Define oldAngle.d,angle.d
Define modedebug.i=0
Define f.d=0.0001
Define Ray.ray
Define Segment.ray
Define LightMaskFlicker,LightMaskFlickerTimer
Define LightMaskFlickerDX.d,LightMaskFlickerDy.d
CreateImage(0,800,600,32)
CreateSprite(0,800,600)
CreateSprite(1,450,450,#PB_Sprite_AlphaBlending)
CreateSprite(2,450,450,#PB_Sprite_AlphaBlending)
;-Draw Lightning-Mask 1
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AllChannels)
BackColor(RGBA(0,0,0,0));mid
GradientColor(0.4,RGBA(0,0,0,50))
GradientColor(0.6,RGBA(0,0,0,200))
FrontColor(RGBA(0,0,0,255))
CircularGradient(225,225,200)
Box(0,0,800,600)
StopDrawing()
StartDrawing(SpriteOutput(1))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(0),0,0)
StopDrawing()
;-Draw Lightning-Mask 1
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AllChannels)
BackColor(RGBA(0,0,0,0));mid
GradientColor(0.4,RGBA(0,0,0,60))
GradientColor(0.6,RGBA(0,0,0,210))
FrontColor(RGBA(0,0,0,255))
CircularGradient(225,225,201)
Box(0,0,800,600)
StopDrawing()
StartDrawing(SpriteOutput(2))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(ImageID(0),0,0)
StopDrawing()
;-Draw Background Image
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Gradient)
BackColor($000088)
GradientColor(0.4, $008888)
GradientColor(0.6, $888800)
FrontColor($880000)
CircularGradient(400,300,450)
Box(0,0,800,600)
DrawingMode(#PB_2DDrawing_Default)
StopDrawing()
;-Create "Shadow-Level"
;external box// Fenêtre englobante
Addsegment(-1,-1,800,-1)
addsegment(800,-1,800,600)
Addsegment(800,600,-1,600)
Addsegment(-1,600,-1,-1)
;random squares// carrés aléatoires
CompilerIf #False
For i=1 To 400
size=Random(50,10)
rx=Random(750,50)
ry=Random(550,50)
Addsegment(rx,ry,rx+size,ry)
Addsegment(rx+size,ry,rx+size,ry+size)
Addsegment(rx+size,ry+size,rx,ry+size)
Addsegment(rx,ry+size,rx,ry)
Next i
CompilerElse
For i=1 To 400
size=Random(50,10)
rx=Random(750,50)
ry=Random(550,50)
Addsegment(rx,ry,rx+Random(50,0)-25,ry+Random(50,0)-25)
Next i
CompilerEndIf
;One Circle
For an=0 To 359 Step 36
AddSegment(200+20*Cos(Radian(an)),200+20*Sin(Radian(an)),200+20*Cos(Radian(an+36)),200+20*Sin(Radian(an+36)))
Next an
MouseLocate(230,202)
Repeat
Repeat:Until WindowEvent()=0:Delay(1)
FlipBuffers():ExamineKeyboard():ExamineMouse():
x.d=MouseX():y.d=MouseY()
oldmili=ElapsedMilliseconds()
If KeyboardReleased(#PB_Key_Space):modedebug=~modedebug:EndIf
If KeyboardPushed(#PB_Key_Left)
x-1
MouseLocate(x,y)
EndIf
If KeyboardPushed(#PB_Key_Right)
x+1
MouseLocate(x,y)
EndIf
If KeyboardPushed(#PB_Key_Up )
y-1
MouseLocate(x,y)
EndIf
If KeyboardPushed(#PB_Key_Down)
y+1
MouseLocate(x,y)
EndIf
If ElapsedMilliseconds()>LightMaskFlickerTimer
LightMaskFlickerTimer=ElapsedMilliseconds()+4000/30
LightMaskFlicker!1
LightMaskFlickerDX=(Random(2,0)-1)/5
LightMaskFlickerDy=(Random(2,0)-1)/5
EndIf
x+LightMaskFlickerDX
y+LightMaskFlickerDy
ClearList(ligne())
; Get all angles
ForEach pt()
angle.d=ATan2(pt()\x-x,pt()\y-y)
pt()\angle.d=angle
Next
SortStructuredList(pt(),#PB_Sort_Ascending,OffsetOf(pt\angle),#PB_Double)
; seg-angle-sort and find activ segments
ClearList (*segs())
Define a1.d,a2.d
ForEach seg()
seg()\DoDelete=#False
a1=seg()\pt1\angle
a2=seg()\pt2\angle
If (a2<a1 And a1-a2<#PI) Or (a2>a1 And a2-a1>#PI)
seg()\pt2\startseg=@seg()
seg()\pt2\endseg=0
seg()\pt1\startseg=0
seg()\pt1\endseg=@seg()
Else
seg()\pt2\startseg=0
seg()\pt2\endseg=@seg()
seg()\pt1\startseg=@seg()
seg()\pt1\endseg=0
EndIf
If a1-a2>#PI Or a2-a1>#PI
AddElement(*segs())
*segs()=@seg()
EndIf
Next
;Calculate rays
*oldseg=0:segcount=0
FirstElement(pt())
Define DoLoop=#True
Define ptAngle.d
;Segment-Managment
While DoLoop
ptAngle=pt()\angle
Repeat
;add new segments
If pt()\startseg
AddElement(*segs())
*segs()=pt()\startseg
EndIf
;mark segments to die
If pt()\endseg
pt()\endseg\DoDelete=#True
EndIf
If NextElement(pt())
If pt()\angle>ptAngle+f
Break
EndIf
Else
DoLoop=#False
Break
EndIf
ForEver
;Calculate 2 Rays
For ii=-1 To 1 Step 2
angle.d=ptangle+f*ii
ray\a\x=x:ray\a\y=y
ray\b\x=Cos(angle)+x:ray\b\y=Sin(angle)+y
closest=#MaxDistance
ForEach *segs()
retour=Intersection(@ray,*segs())
If retour=#MaxDistance:Continue:EndIf
If retour<closest
closest=retour
*curseg=*segs()
EndIf
Next
If closest=#MaxDistance:Continue:EndIf
rx=x+(ray\b\x-x) * closest
ry=y+(ray\b\y-y) * closest
If *oldseg=0 Or ligne()\x<>rx Or ligne()\y<>ry
If *oldseg<>*curseg
AddElement(ligne())
*oldseg=*curseg
segcount=0
Else
If segcount=0
AddElement(ligne())
EndIf
segcount+1
EndIf
ligne()\x=rx
ligne()\y=ry
EndIf
Next
;Remove unneeded segments
ForEach *segs()
If *segs()\DoDelete
*segs()\DoDelete=#False
DeleteElement(*segs())
EndIf
Next
Wend
;Drawing Background
StartDrawing(ScreenOutput())
DrawImage(ImageID(0),0,0)
ForEach seg()
LineXY(seg()\pt1\x,seg()\pt1\y,seg()\pt2\x,seg()\pt2\y,RGB(255,0,0))
Next
StopDrawing()
;Draw light-mask
If modedebug=0
FilledPolygon(ligne(),#Black,Int(x),Int(y),1+LightMaskFlicker)
EndIf
;calculate shadow-mask
StartDrawing(SpriteOutput(0))
If modedebug=0
Box(0,0,800,600,RGB(1,1,1))
FilledPolygon(ligne(),#Black)
Else
Box(0,0,800,600,RGB(0,0,0))
ForEach ligne()
LineXY(x,y,ligne()\x,ligne()\y,RGB(0,255,0))
Circle(ligne()\x,ligne()\y,2,RGB(0,255,0))
Next
EndIf
StopDrawing()
;draw shadow-mask
DisplayTransparentSprite(0,0,0)
;draw HUD
StartDrawing(ScreenOutput())
Circle(MouseX(),MouseY(),5,RGB(255,0,0))
DrawText(0,0,"Press [SPACE] "+Right("0000"+Str(ElapsedMilliseconds()-oldmili),4)+"s polygon:"+ListSize(ligne())+" "+x+" "+y)
StopDrawing()
Until KeyboardPushed(#PB_Key_Escape)