January 15, 2021, 05:08:37 PM

Author Topic: [bb] Intersections by Subirenihil [ 1+ years ago ]  (Read 403 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Intersections by Subirenihil [ 1+ years ago ]
« on: June 29, 2017, 12:28:39 AM »
Title : Intersections
Author : Subirenihil
Posted : 1+ years ago

Description : Have fun!

Code :
Code: BlitzBasic
  1. Graphics 1280,1024,32,1
  2. SetBuffer BackBuffer()
  3.  
  4. SeedRnd MilliSecs()
  5.  
  6. Type pt
  7.         Field x#,y#
  8. End Type
  9.  
  10. Type ln
  11.         Field p1.pt,p2.pt
  12. End Type
  13.  
  14. Type arc
  15.         Field c.pt,r#,a1#,a2#
  16. End Type
  17.  
  18. p1.pt=New pt
  19. p1x#=Rnd#(0,1280)
  20. p1y#=Rnd#(0,1024)
  21.  
  22. l1.ln=New ln
  23. If l1p1=Null Then l1p1=New pt
  24. If l1p2=Null Then l1p2=New pt
  25. l1p1x#=Rnd#(0,1280)
  26. l1p1y#=Rnd#(0,1024)
  27. l1p2x#=640;Rnd#(0,1280)
  28. l1p2y#=512;Rnd#(0,1024)
  29.  
  30. l2.ln=New ln
  31. If l2p1=Null Then l2p1=New pt
  32. If l2p2=Null Then l2p2=New pt
  33. l2p1x#=Rnd#(0,1280)
  34. l2p1y#=Rnd#(0,1024)
  35. l2p2x#=Rnd#(0,1280)
  36. l2p2y#=Rnd#(0,1024)
  37.  
  38. a1.arc=New arc
  39. If a1c=Null Then a1c.pt=New pt
  40. a1cx#=640;Rnd#(0,1280)
  41. a1cy#=512;Rnd#(0,1024)
  42. a1
  43. #=Rnd#(50,250)
  44. a1a1#=Rnd#(0,360)
  45. a1a2#=Rnd#(0,360)
  46.  
  47. a2.arc=New arc
  48. If a2c=Null Then a2c.pt=New pt
  49. a2cx#=Rnd#(0,1280)
  50. a2cy#=Rnd#(0,1024)
  51. a2
  52. #=Rnd#(50,250)
  53. a2a1#=Rnd#(0,360)
  54. a2a2#=Rnd#(0,360)
  55.  
  56. Local tmp1.pt
  57. Local tmp2.ln
  58. Local tmp3.ln
  59. Repeat
  60.         l1p1x#=MouseX()
  61.         l1p1y#=MouseY()
  62.         If tmp1 <> Null Delete tmp1
  63.         If tmp2 <> Null Delete tmp2p1:Delete tmp2p2:Delete tmp2
  64.         If tmp3 <> Null Delete tmp3p1:Delete tmp3p2:Delete tmp3
  65.         Cls
  66.         tmp1.pt=IntersectionLineLine(l1,l2)
  67.         tmp2.ln=IntersectionLineArc(l1,a1)
  68.         DrawArc a1
  69.         DrawArc a2
  70.         DrawLn l1
  71.         DrawLn l2
  72.         DrawPt p1
  73.        
  74.         DrawPt tmp1
  75.         If tmp2<>Null Then DrawPt tmp2p1
  76.         If tmp2<>Null Then DrawPt tmp2p2
  77.         If tmp3<>Null Then DrawPt tmp3p1
  78.         If tmp3<>Null Then DrawPt tmp3p2
  79.         Flip
  80. Until KeyHit(1)
  81. End
  82.  
  83. Function DrawPt(p.pt)
  84.         If p <> Null
  85.                 Color 255,0,0
  86.                 Line px-5,py,px+5,py
  87.                 Line px,py-5,px,py+5
  88.         EndIf
  89. End Function
  90.  
  91. Function DrawLn(l.ln)
  92.         If l <> Null
  93.                 If lp1 <> Null And lp2 <> Null
  94.                         Color 0,255,0
  95.                         Line lp1x,lp1y,lp2x,lp2y
  96.                 EndIf
  97.         EndIf
  98. End Function
  99.  
  100. Function DrawArc(a.arc)
  101.         If a <> Null
  102.                 If ac <> Null
  103.                         If aa1>=aa2 Then aa2=aa2+360
  104.                         LockBuffer GraphicsBuffer()
  105.                         asteps#=Floor#(((a
  106. *6.2831853072)*(aa2-aa1))/360)+1
  107.                         For a1=0 To asteps
  108.                                 angle#=aa1#+((a1/asteps#)*(aa2-aa1))
  109.                                 WritePixel acx#+a
  110. #*Cos#(angle#),acy#-a
  111. #*Sin#(angle#),255
  112.                         Next
  113.                         UnlockBuffer GraphicsBuffer()
  114.                 EndIf
  115.         EndIf
  116. End Function
  117.  
  118. Function IntersectionLineLine.pt(l1.ln,l2.ln)
  119.         If l1 <> Null And l2 <> Null
  120.                 If l1p1 <> Null And l1p2 <> Null And l2p1 <> Null And l2p2 <> Null
  121.                         Local x1#=l1p1x,y1#=l1p1y,x2#=l1p2x,y2#=l1p2y
  122.                         Local x3#=l2p1x,y3#=l2p1y,x4#=l2p2x,y4#=l2p2y
  123.                         Local x#,y#,ab#,am#,bb#,bm#
  124.                
  125.                         If x1<>x2
  126.                                 am=(y2-y1)/(x2-x1)
  127.                                 ab=y1-am*x1
  128.                
  129.                                 If x3<>x4
  130.                                         bm=(y4-y3)/(x4-x3)
  131.                                         bb=y3-bm*x3
  132.                                         If am<>bm
  133.                                                 x=(bb-ab)/(am-bm)
  134.                                                 y=am*x+ab
  135.                                         Else
  136.                                                 Return Null
  137.                                         EndIf
  138.                                 Else
  139.                                         x=x3
  140.                                         y=am*x+ab
  141.                                         If y3=y4 And (x=x3 Or y=y3) Then Return Null
  142.                                 EndIf
  143.                         Else
  144.                                 x=x1
  145.                                 If x3<>x4
  146.                                         bm=(y4-y3)/(x4-x3)
  147.                                         bb=y3-bm*x3
  148.                                         y=bm*x+bb
  149.                                         If y1=y2 And (x=x1 Or y=y1) Then Return Null
  150.                                 Else
  151.                                         Return Null
  152.                                 EndIf
  153.                         EndIf
  154.                
  155.                         If Abs(x1-x2)<Abs(x1-x)+Abs(x2-x) Then Return Null
  156.                         If Abs(y1-y2)<Abs(y1-y)+Abs(y2-y) Then Return Null
  157.                         If Abs(x3-x4)<Abs(x3-x)+Abs(x4-x) Then Return Null
  158.                         If Abs(y3-y4)<Abs(y3-y)+Abs(y4-y) Then Return Null
  159.                        
  160.                         r.pt=New pt
  161.                         rx=x
  162.                         ry=y
  163.                         Return r
  164.                 Else
  165.                         Return Null
  166.                 EndIf
  167.         Else
  168.                 Return Null
  169.         EndIf
  170. End Function
  171.  
  172. Function IntersectionLineArc.ln(l1.ln,a1.arc)
  173.         If l1 <> Null And a1 <> Null
  174.                 If l1p1 <> Null And l1p2 <> Null And a1c <> Null
  175.                         Local rtn.ln=Null
  176.                         Local x#
  177.                         Local y#
  178.                         Local x1#=l1p1x
  179.                         Local y1#=l1p1y
  180.                         Local x2#=a1cx
  181.                         Local y2#=a1cy
  182.                         Local f#=l1p2x-l1p1x
  183.                         Local g#=l1p2y-l1p1y
  184.                         Local r#=a1
  185.  
  186.                         Local t#
  187.                         Local root#
  188.                         root = r*r*(f*f+g*g)-(f*(y2-y1)-g*(x2-x1))*(f*(y2-y1)-g*(x2-x1))
  189.                        
  190.                         If root<0.0
  191.                                 Return Null
  192.                         ElseIf root = 0.0
  193.                                 rtn.ln=New ln
  194.                                 rtnp1=New pt
  195.                                 rtnp2=Null
  196.                                
  197.                                 t = (f*(x2-x1)+g*(y2-y1))/(f*f+g*g)
  198.                                 If t>=0 And t<=1 Then
  199.                                         rtnp1x = x1+f*t
  200.                                         rtnp1y = y1+g*t
  201.                                         ang#=ATan2#(x2-rtnp1x,y2-rtnp1y):If ang<0 Then ang=360+ang
  202.                                         ang=(ang+90) Mod 360
  203.                                         If a1a1>ang# Or a1a2<ang# Then Delete rtnp1
  204.                                 Else
  205.                                         Delete rtnp1
  206.                                 EndIf
  207.                                 If rtnp1=Null And rtnp2=Null Then Delete rtn
  208.                                 Return rtn
  209.                         ElseIf 0.0 < root
  210.                                 root#=Sqr#(root)
  211.                                 rtn.ln=New ln
  212.                                 rtnp1=New pt
  213.                                 rtnp2=New pt
  214.                
  215.                                 t = ((f*(x2-x1)+g*(y2-y1))-root)/(f*f+g*g)
  216.                                 If t>=0 And t<=1 Then
  217.                                         rtnp1x = x1+f*t
  218.                                         rtnp1y = y1+g*t
  219.                                         ang#=ATan2#(x2-rtnp1x,y2-rtnp1y):If ang<0 Then ang=360+ang
  220.                                         ang=(ang+90) Mod 360
  221.                                         If a1a1>ang# Or a1a2<ang# Then Delete rtnp1
  222.                                 Else
  223.                                         Delete rtnp1
  224.                                 EndIf
  225.                
  226.                                 t = ((f*(x2-x1)+g*(y2-y1))+root)/(f*f+g*g)
  227.                                 If t>=0 And t<=1 Then
  228.                                         rtnp2x = x1+f*t
  229.                                         rtnp2y = y1+g*t
  230.                                         ang#=ATan2#(x2-rtnp2x,y2-rtnp2y):If ang<0 Then ang=360+ang
  231.                                         ang=(ang+90) Mod 360
  232.                                         If a1a1>ang# Or a1a2<ang# Then Delete rtnp2
  233.                                 Else
  234.                                         Delete rtnp2
  235.                                 EndIf
  236.                                 If rtnp1=Null And rtnp2=Null Then Delete rtn
  237.                                 Return rtn
  238.                         EndIf
  239.                 Else
  240.                         Return Null
  241.                 EndIf
  242.         Else
  243.                 Return Null
  244.         EndIf
  245. End Function


Comments : none...

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal