Calculating intersection points

New to FreeBASIC? Post your questions here.
Gunslinger
Posts: 35
Joined: Mar 08, 2016 19:10

Calculating intersection points

Postby Gunslinger » Oct 20, 2019 17:15

Hello Everyone,

I have been working on some code for my 3d-world ans i made a simple 2d version of the problem
Don't seem to get it right and it's more complicated then i did think.
I have a part working function but i need some help with the yellow line insite the function crosspoint
it needs to calculate the center value so the intersection point become right and circles end up on the yellow line.
So only the center value needs to be calculated inside the function (see picture)
http://ac1.servegame.com:88/image/Crosspointdata.PNG
Not really difficult juist drives me crazy.

help will be appreciated.
When it works i will share my 3d-code for it at https://www.freebasic.net/forum/viewtopic.php?f=8&t=27809&p=263713#p263713


Code: Select all

declare function my_line(vertex1 as single, vertex2 as single, noise1 as single, noise2 as single, div_noise as ubyte) as single 'my linear interpolation vertex (vector, vector, noise1, noise2, isovalue?)
type crosspointdata
   dim as single D1
   dim as single D2
   dim as ubyte crossed
   dim as single div
end type

function crosspoint(p1 as single, p2 as single, p3 as single, p4 as single, div_noise as ubyte) as single
   static as crosspointdata w(3) ' please load points clockwise
   W(0).d1 = p1: W(0).d2 = p2: W(0).crossed = 0
   W(1).d1 = p2: W(1).d2 = p3: W(1).crossed = 0
   W(2).d1 = p4: W(2).d2 = p3: W(2).crossed = 0
   W(3).d1 = p1: W(3).d2 = p4: W(3).crossed = 0
   for i as ubyte = 0 to 3
      if W(i).d1 <  div_noise andalso W(i).d2  >= div_noise then W(i).crossed = 1
      if W(i).d1 >= div_noise andalso W(i).d2  <  div_noise then W(i).crossed = 1
   next
   
   if W(0).crossed + W(1).crossed + W(2).crossed + W(3).crossed < 1 then return -1: exit function
   
   for i as ubyte = 0 to 3
      if W(i).crossed=1 then
         W(i).div = my_line(-1, 1, W(i).d1, W(i).d2, div_noise)
      end if
   next
   
   if W(0).crossed=1 then circle(W(0).div,-1),.02:draw string (W(0).div,-1.15),"W0=" & str(W(0).div)
   if W(1).crossed=1 then circle(1,W(1).div), .02:draw string (1.25, W(1).div),"W1=" & str(W(1).div)
   if W(2).crossed=1 then circle(W(2).div,1), .02:draw string (W(2).div, 1.15),"W2=" & str(W(2).div)
   if W(3).crossed=1 then circle(-1,W(3).div),.02:draw string (-1.25,W(3).div),"W3=" & str(W(3).div)
   
   for tmp as ubyte = 0 to 2
      'calcualate cross points 2>div_noise 2<div_noise
      if W(0).crossed=1 andalso W(2).crossed=1 andalso W(1).crossed=0 andalso W(3).crossed=0 then
         line (W(2).div,1)-(W(0).div,-1)
         var n1 = (W(2).div - W(0).div)/2
         var n2 = ((W(2).div)) - n1
         circle(n2,0), .02 'the right point
         'print n1, n2
         if n2<0 then
            var n4 = ((W(3).d1 + W(3).d2)/2)
            var n5 = (div_noise-n4) / (1+n2)
            return n4+n5
         else
            var n4 = ((W(1).d1 + W(1).d2)/2)
            var n5 = (div_noise-n4) / (1-n2)
            return n4+n5
         end if
      end if
      
      'calculate 1 corner state
      if W(0).crossed=1 andalso W(1).crossed=1 andalso W(2).crossed=0 andalso W(3).crossed=0 then
         line (1,W(1).div)-(W(0).div,-1)
         
         var n1 = (W(2).div - W(0).div)/2
         var n2 = ((W(2).div)) - n1
         print n1, n2,
         circle(n2,0), .02 'the right point
         
         return 128 +((TIMER*100) MOD 1000)/100
         
      end if
      
      'calcualate conner points 2>div_noise 2<div_noise
      
      
      print "1 rotation"
      swap W(0),W(1)
      swap W(1),W(2)
      swap W(2),W(3)
   next
   
   'beep
   return -1
end function


Screenres 1440,900,32
Window (-2,1.3)-(2,-1.3)


DO
CLS

dim as single array(-1 to 1, -1 to 1) = {{126,0,115},{0,0,0},{140,0,132}}
dim as single avg(-1 to 1, -1 to 1)
array(1,1) += ((TIMER*100) MOD 500)/100
'draw grid
line (0,1)-(0,-1),rgb(63,63,63)
line (1,0)-(-1,0),rgb(63,63,63)
line (-1,-1)-(1,-1),rgb(127,127,127)
line (-1,1)-(1,1),rgb(127,127,127)
line (-1,1)-(-1,-1),rgb(127,127,127)
line (1,1)-(1,-1),rgb(127,127,127)
'draw array values
draw string (-1.1,-1.1),"P1=" & str(array(-1,-1))
draw string (-1.1,-0.05),"P2=" & str(array(-1,0))
draw string (-1.1,1.1), "P3=" & str(array(-1,1))
draw string (0,-1.1),   "P4=" & str(array(0,-1))
draw string (0,-0.05),  "P5=" & str(array(0,0))
draw string (0,1.1)  ,  "P6=" & str(array(0,1))
draw string (1.1,-1.1), "P7=" & str(array(1,-1))
draw string (1.1,-0.05),"P8=" & str(array(1,0))
draw string (1.1,1.1) , "P9=" & str(array(1,1))


color rgb(255,0,0)
avg(0,0)=crosspoint(array(-1,-1),array(1,-1),array(1,1),array(-1,1),127)
draw string (0,-.15) , "red=" & str(avg(0,0))



avg(-1,0)= (array(-1,-1)+array(-1,1))/2
avg(1,0)= (array(1,-1)+array(1,1))/2
avg(0,-1)= (array(1,-1)+array(-1,-1))/2
avg(0,1)= (array(-1,1)+array(1,1))/2
avg(-1,-1)= array(-1,-1)
avg(-1,1)= array(-1,1)
avg(1,-1)= array(1,-1)
avg(1,1)= array(1,1)

color rgb(127,0,0)
draw string (-1.15,-1.15),"P1=" & str(avg(-1,-1))
draw string (-1.15,-0.1), "P2=" & str(avg(-1,0))
draw string (-1.15,1.15), "P3=" & str(avg(-1,1))
draw string (0,-1.15),    "P4=" & str(avg(0,-1))
draw string (0,-0.1),     "AVG=" & str((avg(-1,0)+avg(1,0))/2)
draw string (0,1.15)  ,   "P6=" & str(avg(0,1))
draw string (1.15,-1.15), "P7=" & str(avg(1,-1))
draw string (1.15,-0.1),  "P8=" & str(avg(1,0))
draw string (1.15,1.15) , "P9=" & str(avg(1,1))

circle (my_line(-1,0,avg(-1,0),avg(0,0),127),0),.01 ,rgb(255,255,255)
'circle (my_line(1,0,avg(1,0),avg(0,0),127),0),.01, rgb(255,255,255)
circle (0, my_line(1,0,avg(0,1),avg(0,0),127)),.01, rgb(255,255,255)
'circle (0, my_line(-1,0,avg(0,-1),avg(0,0),127)),.01 ,rgb(255,255,255)










'' state 2 coner1 yellow
array(1,1)=122
array(-1,-1)=123
array(1,1) -= ((TIMER*100) MOD 500)/100

color rgb(255,255,0)
avg(0,0)=crosspoint(array(-1,-1),array(1,-1),array(1,1),array(-1,1),127)
if avg(0,0) = -99 then beep: avg(0,0) = 126
draw string (-.2,-.15) , "?=" & str(avg(0,0))

avg(-1,0)= (array(-1,-1)+array(-1,1))/2
avg(1,0)= (array(1,-1)+array(1,1))/2
avg(0,-1)= (array(1,-1)+array(-1,-1))/2
avg(0,1)= (array(-1,1)+array(1,1))/2
avg(-1,-1)= array(-1,-1)
avg(-1,1)= array(-1,1)
avg(1,-1)= array(1,-1)
avg(1,1)= array(1,1)

color rgb(127,127,0)
draw string (-1.2,-1.2),"P1=" & str(avg(-1,-1))
draw string (-1.2,-0.15),"P2=" & str(avg(-1,0))
draw string (-1.2,1.2), "P3=" & str(avg(-1,1))
draw string (0,-1.2),   "P4=" & str(avg(0,-1))
draw string (-.2,-0.1),   "AVG=" & str((avg(-1,0)+avg(1,0))/2)
draw string (0,1.2)  ,  "P6=" & str(avg(0,1))
draw string (1.2,-1.2), "P7=" & str(avg(1,-1))
draw string (1.2,-0.15), "P8=" & str(avg(1,0))
draw string (1.2,1.2) , "P9=" & str(avg(1,1))

var yellow1 = my_line(1,0,avg(1,0),avg(0,0),127)
var yellow2 = my_line(-1,0,avg(0,-1),avg(0,0),127)
'circle (my_line(-1,0,avg(-1,0),avg(0,0),127),0),.01 ',rgb(255,255,255)
circle (yellow1,0),.01 ',rgb(255,255,255)
'circle (0, my_line(1,0,avg(0,1),avg(0,0),127)),.01 ',rgb(255,255,255)
circle (0,yellow2 ),.01 ',rgb(255,255,255)


sleep 10

LOOP WHILE INKEY$ = ""


function my_line(vertex1 as single, vertex2 as single, noise1 as single, noise2 as single, isovalue as ubyte) as single 'my linear interpolation vertex (vector, vector, noise1, noise2, isovalue?)
   Static as single liv
   Static as single div_noise1: div_noise1 = abs(noise1 - isovalue)
   Static as single lengte: lengte = div_noise1 + abs(noise2 - isovalue)
   Static as single diff1: diff1 = (lengte - div_noise1) * (1 / lengte)
   Static as single diff2: diff2 = 1-diff1
   liv = ((vertex1 * diff1) + (vertex2 * diff2))
   return liv
end function
Last edited by Gunslinger on Oct 21, 2019 19:51, edited 2 times in total.
integer
Posts: 380
Joined: Feb 01, 2007 16:54
Location: usa

Re: Calculating intersection points

Postby integer » Oct 21, 2019 11:40

seems as if the code the code was duplicated, compilation failed.
removed duplicate. compiled & run.

clarification:
You seek to know the intersection:
YellowSegment Line(x1,y1)-(x2,y2) with the whiteplane X-axis
and
YellowSegment Line(x1,y1)-(x2,y2) with the whiteplane Y-axis

Thus: simple proportioning
YellowPoint1( 0, Y3)
YellowPoint2(X3, 0)

Is that what is wanted?
The confusing part: it appears as if these are curved surfaces instead of simple planes (white, red, yellow).
Gunslinger
Posts: 35
Joined: Mar 08, 2016 19:10

Re: Calculating intersection points

Postby Gunslinger » Oct 21, 2019 14:00

Sorry for the compilation failed stated.

No i don't want to intersect the red and yellow line.
I like to return the right value for P5 so the 2 small yellow circles and up on the yellow line.

I think i need to calculate the intersection point for the gray middle line at horizontal.
And then calculate the value P5 for yellow.. i wish there for a easy solusion :)
fxm
Posts: 9260
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Calculating intersection points

Postby fxm » Oct 21, 2019 14:27

Your request is still not clear to me.
dodicat
Posts: 5990
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Calculating intersection points

Postby dodicat » Oct 21, 2019 18:37

Here is a 2D line intersection method (co-ordinate geometry).

Code: Select all

Type Pt
    As Double x,y
End Type

Type Line
    As Pt s,f
    declare sub draw(col as ulong)
End Type

sub line.draw(col as ulong)
    ..draw string(s.x,s.y),"("+str(s.x)+" , "+str(s.y)+")"
    ..draw string(f.x,f.y),"("+str(f.x)+" , "+str(f.y)+")"
    line(s.x,s.y)-(f.x,f.y),col
    end sub


Function isleft(L As Line,p As Pt) As Long 'for function intersect
    Return  Sgn((L.s.x-L.f.x)*(p.y-L.f.y)-(p.x-L.f.x)*(L.s.y-L.f.y))<0
End Function

Function intersects(L1 As Line,L2 As Line) As Long 'do 2 lines intersect?
    If isleft(L2,L1.s) = isleft(L2,L1.f) Then Return 0
    If isleft(L1,L2.s) = isleft(L1,L2.f) Then Return 0
    Return -1
End Function

Function intersection(L1 As Line,L2 As Line) As Pt 'point of intersection of 2 lines
    Dim As Double z=(L1.f.x-L1.s.x):If z=0 Then z=1e-6
    Var M1=(L1.f.y-L1.s.y)/z
    z=(L2.f.x-L2.s.x):If z=0 Then z=1e-6
    Var M2=(L2.f.y-L2.s.y)/z
    z=(L1.f.x-L1.s.x):If z=0 Then z=1e-6
    Var C1=(L1.s.y*L1.f.x-L1.s.x*L1.f.y)/z
    z=(L2.f.x-L2.s.x):If z=0 Then z=1e-6
    Var C2=(L2.s.y*L2.f.x-L2.s.x*L2.f.y)/z
    z=Iif (M1-M2<>0,M1-M2,1e-6)
    Return Type((C2-C1)/z,(M1*C2-M2*C1)/z)
End Function

screen 20,32

dim as line grey=type<line>((100,400),(900,400))
dim as line yellow=type<line>((400,700),(600,200))

grey.draw(rgb(200,200,200))
yellow.draw(rgb(200,200,0))

if intersects(grey,yellow) then
    var I=intersection(grey,yellow)
    draw string(I.x,I.y),"("+str(I.x)+" , "+str(I.y)+")"
    end if

sleep
 
D.J.Peters
Posts: 7838
Joined: May 28, 2005 3:28

Re: Calculating intersection points

Postby D.J.Peters » Oct 21, 2019 19:07

In 3D the white lines (2D from top) are faces so you need a 3D segemt face intersection or 3D ray triangle intersection !

Joshy
Gunslinger
Posts: 35
Joined: Mar 08, 2016 19:10

Re: Calculating intersection points

Postby Gunslinger » Oct 21, 2019 20:15

Thanks dodicat that is juist what i needed.
I think i can finish the code with this.

D.J.Peters wrote:In 3D the white lines (2D from top) are faces so you need a 3D segemt face intersection or 3D ray triangle intersection !

Joshy

I don't need to go 3D intersections of planes.
This function is to make the full resolution fit seamless to half resolution grid (chunks) on a 2D-plane in a way
Where 127 is the surface value for ISO-surface.
It is already working only not seamless for now.

I hope this explanation makes more sense.
dodicat
Posts: 5990
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Calculating intersection points

Postby dodicat » Oct 22, 2019 12:09

For fun.
The grey triangle lies in 3D space.
The ray goes towards the mouse (whose z value is 500 into the screen), from it's start position. If it intersects the triangle the intersection points are shown, otherwise is is a miss.
Note I have shown the miss ray even although it might be behind the triangle.
Use arrow keys to move the ray start position.

Code: Select all


Type vector
    As Double x,y,z
    #define vct Type<vector>
    #define dot *
    #define cross ^
End Type

Type Line
    As vector s,f
    Declare Sub Draw(As Ulong,As Long, As Line)
End Type

Type plane
    As vector v1,v2,v3
    Declare Sub Draw(col As Ulong)
End Type

Sub line.draw(col As Ulong,hit As Long,L As Line)
    ..draw String(s.x,s.y),"("+Str(s.x)+" , "+Str(s.y)+" , "+Str(s.z)+")",col
    If hit Then
        ..draw String(f.x,f.y),"("+Str(f.x)+" , "+Str(f.y)+" , "+Str(f.z)+")",col
        Line(s.x,s.y)-(f.x,f.y),col
    Else
        ..draw String(L.f.x,L.f.y),"("+Str(L.f.x)+" , "+Str(L.f.y)+" , "+Str(L.f.z)+")  miss ",col\2
        Line(L.s.x,L.s.y)-(L.f.x,L.f.y),col\2
    End If
End Sub

Sub plane.draw(col As Ulong)
    Line(v1.x,v1.y)-(v2.x,v2.y),col
    Line(v2.x,v2.y)-(v3.x,v3.y),col
    Line(v1.x,v1.y)-(v3.x,v3.y),col
    dim as vector ctr=type((v1.x+v2.x+v3.x)/3,(v1.y+v2.y+v3.y)/3)
    paint (ctr.x,ctr.y),col,col
    ..draw String(v1.x,v1.y-16),"("+Str(v1.x)+" , "+Str(v1.y)+" , "+Str(v1.z)+")"
    ..draw String(v2.x,v2.y-16),"("+Str(v2.x)+" , "+Str(v2.y)+" , "+Str(v2.z)+")"
    ..draw String(v3.x,v3.y-16),"("+Str(v3.x)+" , "+Str(v3.y)+" , "+Str(v3.z)+")"
End Sub

Operator + (v1 As vector,v2 As vector) As vector
Return vct(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator

Operator -(v1 As vector,v2 As vector) As vector
Return vct(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator

Operator * (f As Single,v1 As vector) As vector 'scalar*vector
Return vct(f*v1.x,f*v1.y,f*v1.z)
End Operator

Operator * (v1 As vector,v2 As vector) As Double 'dot product
Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Operator

Operator ^ (v1 As vector,v2 As vector) As vector 'cross product
Return vct(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator

Function length(v As vector) As Double
    Return Sqr(v.x*v.x+v.y*v.y+v.z*v.z)
End Function

Function normalize(v As vector) As vector
    Dim n As Single=length(v)
    If n=0 Then n=1e-20
    Return vct(v.x/n,v.y/n,v.z/n)
End Function

Function shortline(fp As vector,p As vector,lngth As Double) As vector
    Dim As Double diffx=p.x-fp.x,diffy=p.y-fp.y,diffz=p.z-fp.z
    Dim As Double L=Sqr(diffx*diffx+diffy*diffy+diffz*diffz)
    Return Type(fp.x+lngth*diffx/L,fp.y+lngth*diffy/L,fp.z+lngth*diffz/L)
End Function

Function planedistance(S As PLANE,p As vector,Byref ip As vector=vct(0,0,0)) As Double
    Dim As vector unitcross=normalize((s.v1-s.v2) cross (S.v2-S.v3))
    Dim As Double dist=unitcross dot (p-s.v1)'pv
    Dim As vector ip1=p+dist*unitcross
    Dim As Double d1=length(s.v1-ip1)
    unitcross=-1*unitcross
    Dim As vector ip2=p+dist*unitcross
    Dim As Double d2=length(s.v1-ip2)
    If d1 <= d2 Then ip=ip1 Else ip=ip2
    Return dist
End Function

Function planeintersect(p As plane,L As Line) As vector
    Dim As vector Ip
    Var d=length(L.f-L.s)
    For n As Single=0 To d Step .5
        Var v=shortline(L.s,L.f,n)
        Var x=planedistance(p,v,ip)
        If x<=.5 Then Return ip
    Next n
End Function

Function PointInPlane(T As plane,p As vector) As Long
    Var Area=.5*length((T.v2-T.v1) cross (T.v3-T.v1))'area of planer triangle
    Var a=.5*length( (T.v1-p) cross (T.v2-p)) /(area)'areas of sub triangles
    Var b=.5*length( (T.v2-p) cross (T.v3-p)) /(area)
    Var c=.5*length( (T.v3-p) cross (T.v1-p)) /(area)
    Return a+b+c<1.001
End Function

Dim As Long mx,my
Dim As plane p=Type<plane>((222,150,0),(200,450,-55),(600,160,200)) 'fixed
Dim As Line L  'variable
L.s=Type(300,300,-300)
dim as string ik
Screen 20,32

Do
    Getmouse mx,my
     ik=inkey
    if ik= chr(255) + "K"  then L.s.x-=10
    if ik= chr(255) + "M"  then L.s.x+=10
    if ik= chr(255) + "P"  then L.s.y+=10
    if ik= chr(255) + "H"  then L.s.y-=10
    L.f=Type(mx,my,500)
    Var i=planeintersect(p,L)
    Var nl=Type<Line>(L.s,i)
    Screenlock
    Cls
    p.draw(Rgb(100,100,100))
    nl.draw(Rgb(100,200,100),PointInPlane(p,i),L)
    Screenunlock
    Sleep 1,1
Loop Until ik=chr(27)


 
Gunslinger
Posts: 35
Joined: Mar 08, 2016 19:10

Re: Calculating intersection points

Postby Gunslinger » Oct 22, 2019 21:23

Very funny i almost fixed my code my why :)
the yellow line is tested to works fine
now it seems i still have to patch the red P6 value to get the right result.

Code: Select all

declare function my_line(vertex1 as single, vertex2 as single, noise1 as single, noise2 as single, div_noise as ubyte) as single 'my linear interpolation vertex (vector, vector, noise1, noise2, isovalue?)
type crosspointdata
   dim as single D1
   dim as single D2
   dim as ubyte crossed
   dim as single div
end type

function crosspoint(p1 as single, p2 as single, p3 as single, p4 as single, div_noise as ubyte) as single
   static as crosspointdata w(3) ' please load points clockwise
   W(0).d1 = p1: W(0).d2 = p2: W(0).crossed = 0
   W(1).d1 = p2: W(1).d2 = p3: W(1).crossed = 0
   W(2).d1 = p4: W(2).d2 = p3: W(2).crossed = 0
   W(3).d1 = p1: W(3).d2 = p4: W(3).crossed = 0
   for i as ubyte = 0 to 3
      W(i).div = my_line(-1, 1, W(i).d1, W(i).d2, div_noise)
      if W(i).d1 <  div_noise andalso W(i).d2  >= div_noise then W(i).crossed = 1
      if W(i).d1 >= div_noise andalso W(i).d2  <  div_noise then W(i).crossed = 1
   next
   
   var all_crossed = W(0).crossed + W(1).crossed + W(2).crossed + W(3).crossed
   if all_crossed < 1 or all_crossed >3 then return -1: exit function
   
   if W(0).crossed=1 then circle(W(0).div,-1),.02:draw string (W(0).div,-1.15),"W0=" & str(W(0).div)
   if W(1).crossed=1 then circle(1,W(1).div), .02:draw string (1.25, W(1).div),"W1=" & str(W(1).div)
   if W(2).crossed=1 then circle(W(2).div,1), .02:draw string (W(2).div, 1.15),"W2=" & str(W(2).div)
   if W(3).crossed=1 then circle(-1,W(3).div),.02:draw string (-1.25,W(3).div),"W3=" & str(W(3).div)
   
   for tmp as ubyte = 0 to 2
      'calcualate cross points 2>div_noise 2<div_noise
      if W(0).crossed=1 andalso W(2).crossed=1 andalso W(1).crossed=0 andalso W(3).crossed=0 then
         line (W(2).div,1)-(W(0).div,-1)
         var n1 = (W(2).div - W(0).div)/2
         var n2 = ((W(2).div)) - n1
         circle(n2,0), .02 'the right point
         'print n1, n2
         if n2<0 then
            var n4 = ((W(3).d1 + W(3).d2)/2)
            var n5 = (div_noise-n4) / (1+n2)
            return n4+n5
         else
            var n4 = ((W(1).d1 + W(1).d2)/2)
            var n5 = (div_noise-n4) / (1-n2)
            return n4+n5
         end if
      end if
      
      'calculate 1 corner state
      if W(0).crossed=1 andalso W(1).crossed=1 andalso W(2).crossed=0 andalso W(3).crossed=0 then
         line (1,W(1).div)-(W(0).div,-1)
         var n1 = (1-W(0).div) / (1+W(1).div)
         var n2 = W(0).div + n1
         var n4 = ((W(1).d1 + W(1).d2)/2)
         var n5 = (div_noise-n4)  / (1-n2)
         
         'print ((W(3).d1 + W(3).d2)/2)-(n1*n4)
         print n1, n2, n4, n5', n4+n5
         circle(n2,0), .02 'the right point
         
         return n4+n5 '124.24
      end if
      
      print "1 rotation"
      swap W(0),W(1)
      swap W(1),W(2)
      swap W(2),W(3)
   next
   
   'beep
   return -1
end function


Screenres 1440,900,32
Window (-2,1.3)-(2,-1.3)


DO
CLS
color rgb(255,255,255)
dim as single array(-1 to 1, -1 to 1) = {{122,0,124},{0,0,0},{147.5,0,128}}
dim as single avg(-1 to 1, -1 to 1)
array(1,1) += ((TIMER*100) MOD 200)/100
'draw grid
line (0,1)-(0,-1),rgb(63,63,63)
line (1,0)-(-1,0),rgb(63,63,63)
line (-1,-1)-(1,-1),rgb(127,127,127)
line (-1,1)-(1,1),rgb(127,127,127)
line (-1,1)-(-1,-1),rgb(127,127,127)
line (1,1)-(1,-1),rgb(127,127,127)
'draw array values
draw string (-1.1,-1.1),"P1=" & str(array(-1,-1))
draw string (-1.1,-0.05),"P2=" & str(array(-1,0))
draw string (-1.1,1.1), "P3=" & str(array(-1,1))
draw string (0,-1.1),   "P4=" & str(array(0,-1))
draw string (0,-0.05),  "P5=" & str(array(0,0))
draw string (0,1.1)  ,  "P6=" & str(array(0,1))
draw string (1.1,-1.1), "P7=" & str(array(1,-1))
draw string (1.1,-0.05),"P8=" & str(array(1,0))
draw string (1.1,1.1) , "P9=" & str(array(1,1))


color rgb(255,0,0)
avg(0,0)=crosspoint(array(-1,-1),array(1,-1),array(1,1),array(-1,1),127)
draw string (0,-.15) , "red=" & str(avg(0,0))



avg(-1,0)= (array(-1,-1)+array(-1,1))/2
avg(1,0)= (array(1,-1)+array(1,1))/2
avg(0,-1)= (array(1,-1)+array(-1,-1))/2
avg(0,1)= (array(-1,1)+array(1,1))/2
avg(-1,-1)= array(-1,-1)
avg(-1,1)= array(-1,1)
avg(1,-1)= array(1,-1)
avg(1,1)= array(1,1)

color rgb(127,0,0)
draw string (-1.15,-1.15),"P1=" & str(avg(-1,-1))
draw string (-1.15,-0.1), "P2=" & str(avg(-1,0))
draw string (-1.15,1.15), "P3=" & str(avg(-1,1))
draw string (0,-1.15),    "P4=" & str(avg(0,-1))
'draw string (0,-0.1),     "AVG=" & str((avg(-1,0)+avg(1,0))/2)
draw string (0,1.15)  ,   "P6=" & str(avg(0,1))
draw string (1.15,-1.15), "P7=" & str(avg(1,-1))
draw string (1.15,-0.1),  "P8=" & str(avg(1,0))
draw string (1.15,1.15) , "P9=" & str(avg(1,1))

circle (my_line(-1,0,avg(-1,0),avg(0,0),127),0),.01 ,rgb(255,255,255)
'circle (my_line(1,0,avg(1,0),avg(0,0),127),0),.01, rgb(255,255,255)
circle (0, my_line(1,0,avg(0,1),avg(0,0),127)),.01, rgb(255,255,255)
'circle (0, my_line(-1,0,avg(0,-1),avg(0,0),127)),.01 ,rgb(255,255,255)






'' state 2 coner state yellow
array(1,1)=122
array(-1,-1)=126.5
array(1,1) -= ((TIMER*100) MOD 500)/25

color rgb(255,255,0)
avg(0,0)=crosspoint(array(-1,-1),array(1,-1),array(1,1),array(-1,1),127)
if avg(0,0) = -99 then avg(0,0) = 126
draw string (-.3,-.15) , "yellow=" & str(avg(0,0))

avg(-1,0)= (array(-1,-1)+array(-1,1))/2
avg(1,0)= (array(1,-1)+array(1,1))/2
avg(0,-1)= (array(1,-1)+array(-1,-1))/2
avg(0,1)= (array(-1,1)+array(1,1))/2
avg(-1,-1)= array(-1,-1)
avg(-1,1)= array(-1,1)
avg(1,-1)= array(1,-1)
avg(1,1)= array(1,1)

color rgb(127,127,0)
draw string (-1.2,-1.2), "P1=" & str(avg(-1,-1))
draw string (-1.2,-0.15),"P2=" & str(avg(-1,0))
draw string (-1.2,1.2),  "P3=" & str(avg(-1,1))
draw string (0,-1.2),    "P4=" & str(avg(0,-1))
'draw string (-.2,-0.1),  "AVG=" & str((avg(-1,0)+avg(1,0))/2)
draw string (0,1.2)  ,   "P6=" & str(avg(0,1))
draw string (1.2,-1.2),  "P7=" & str(avg(1,-1))
draw string (1.2,-0.15), "P8=" & str(avg(1,0))
draw string (1.2,1.2) ,  "P9=" & str(avg(1,1))

var yellow1 = my_line(1,0,avg(1,0),avg(0,0),127)
var yellow2 = my_line(-1,0,avg(0,-1),avg(0,0),127)
'circle (my_line(-1,0,avg(-1,0),avg(0,0),127),0),.01 ',rgb(255,255,255)
circle (yellow1,0),.01 ',rgb(255,255,255)
'circle (0, my_line(1,0,avg(0,1),avg(0,0),127)),.01 ',rgb(255,255,255)
circle (0,yellow2 ),.01 ',rgb(255,255,255)


'sleep
Dim As Integer x, y, buttons, res

   locate 2,2
    res = GetMouse (x, y, , buttons)
   Print PMap(x, 2), PMap(y, 3)
   sleep 10
LOOP WHILE INKEY$ = ""


function my_line(vertex1 as single, vertex2 as single, noise1 as single, noise2 as single, isovalue as ubyte) as single 'my linear interpolation vertex (vector, vector, noise1, noise2, isovalue?)
   Static as single liv
   Static as single div_noise1: div_noise1 = abs(noise1 - isovalue)
   Static as single lengte: lengte = div_noise1 + abs(noise2 - isovalue)
   Static as single diff1: diff1 = (lengte - div_noise1) * (1 / lengte)
   Static as single diff2: diff2 = 1-diff1
   liv = ((vertex1 * diff1) + (vertex2 * diff2))
   return liv
end function


Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 1 guest