## Squares

General FreeBASIC programming questions.
counting_pine
Posts: 6225
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs
Arrays don't take Byval or Byref. But -w pedantic shouldn't complain if you omit them.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
Faster than native square root:

http://www.freebasic.net/forum/viewtopic.php?t=10057&highlight=

<EDIT>

Here is an optimized version of it:

Code: Select all

`' Square Roots!' by Kristopher WindsorFunction squareroot (Byval number As Double ) As Double  dim As Double r1=1, r2=any  Do    r2 = r1    r1 = (r1 + number / r1) * .5  Loop Until Abs(r1 - r2) <  .001  Return r1End Functiondim as double tt=timer? sqr(666666669911)? timer-tt=timer? squareroot (666666669911)? timer-tsleep`
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia
This avoids timing the print routines...

Code: Select all

`' Square Roots!' by Kristopher WindsorFunction squareroot (Byval number As Double ) As Double    Dim As Double r1=1, r2=Any    Do        r2 = r1        r1 = (r1 + number / r1) * .5    Loop Until Abs(r1 - r2) <  .001    Return r1End FunctionDim As Double t1, t2, r, s = 666666669911printt1=Timert2=TimerPrint using " ###.### usec.   Empty timing "; (t2 - t1) * 1e6printt1=Timerr = Sqr(s)t2 = TimerPrint using " ###.### usec.   Native FB square root"; (t2 - t1) * 1e6printt1 = Timerr = squareroot(s)t2 = TimerPrint using " ###.### usec.   KW's square root"; (t2 - t1) * 1e6Sleep`
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi Richard
Wow, now you will be able to get really fast division.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
I drew this one up for non-convex poly collisions... Cheap, easy... Just like me.

Question: How do you paint the perfect picture?
Answer: Make yourself perfect and just paint naturally.

Doesn't compile. Treat as pseudo-code. I just thought this would be fun to do after spending so long on SAT. This is so much easier! You can barely tell where it goes screwy.

Code: Select all

`function ProcessHardBodyCollision_PiP ( byref p1 as polygon, byref p2 as polygon ) as point2d        for i as integer = 0 to p2.numvertices-1        if p1.InsidePoly2d ( p2.matrix[i] ) then             return ( p2.center - p1.center ).unit        endif    next        for i as integer = 0 to p1.numvertices-1        if p2.InsidePoly2d ( p1.matrix[i] ) then             return ( p2.center - p1.center ).unit        endif    next        return type(0,0)    end function`
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
Here is Eclipzer's spline slightly faster... Can still be opt'd mo'

Code: Select all

`#include once "fbgfx.bi"#define screen_x 800#define screen_y 600type Colour    as ubyte Red    as ubyte Green    as ubyte Blue    as ubyte Alpha        declare Constructor ()    declare Constructor ( byref rhs as colour )    declare Operator Let ( byref rhs as colour )    declare Operator Let ( byval rhs as integer )        declare sub Set ( byref r as ubyte, byref g as ubyte, byref b as ubyte, byref a as ubyte )        declare function GetInteger () as integer    declare sub Darken ( byref amount as integer )    declare sub Lighten ( byref amount as integer )end TypeConstructor Colour ()    this.red = 255    this.green = 255    this.blue = 255    this.alpha = 255end ConstructorConstructor Colour ( byref rhs as colour )    this.red = rhs.red    this.green = rhs.green    this.blue = rhs.blue    this.alpha = rhs.alphaend Constructor Operator Colour.Let ( byref rhs as colour )    this.red = rhs.red    this.green = rhs.green    this.blue = rhs.blue    this.alpha = rhs.alphaend OperatorOperator Colour.Let ( byval rhs as integer )    this.red = (rhs shr 16) 'AND 255    this.green = (rhs shr 8) 'AND 255    this.blue = (rhs) 'AND 255    this.alpha = (rhs shr 24) 'AND 255end Operatorsub Colour.Set ( byref r as ubyte, byref g as ubyte, byref b as ubyte, byref a as ubyte )    Red=r    Blue=b    Green=g    Alpha=aend subfunction Colour.GetInteger () as integer    return RGBA(Red,Green,Blue,Alpha)end function sub Colour.Darken ( byref amount as integer )    Red -= amount    Green -= amount    Blue -= amount    if red < 0 then red = 0    if green < 0 then green = 0    if blue < 0 then  blue = 0     end subsub Colour.Lighten ( byref amount as integer )      Red += amount    Green += amount    Blue += amount        if red > 0 then red = 255    if green > 0 then green = 255    if blue > 0 then  blue = 255    end subSub sub_line ( byref screenbuffer as fb.image ptr, byval x1 As Integer, byval y1 As Integer, byval x2 As Integer, byval y2 As Integer, byval thickness As Integer, Byref clr As colour )    'Original Author: Quinton Roberts (Eclipzer)    'Optimized by: Rollie Bollocks        dim as ubyte ptr pixdata =  Cast( Ubyte Ptr, screenbuffer ) + Sizeof( FB.IMAGE )       Dim As Integer alpha=clr.alpha      Dim As Integer t2=thickness/2      Dim As Integer bx(1)={x1,x2}    Dim As Integer by(1)={y1,y2}        Dim As Integer LI=0,RI=1    Dim As Integer TI=0,BI=1        If bx(LI)>bx(RI) Then Swap LI,RI    If by(TI)>by(BI) Then Swap TI,BI        Dim As Single dx=(bx(RI)-bx(LI))    Dim As Single dy=(by(RI)-by(LI))        Dim As Single dydx=dy/dx    Dim As Single dydx2=dydx*dydx        Dim As Single b=y1-dydx*x1,d        Dim As Single ndx=-dy    Dim As Single ndy= dx        Dim As Single length=1/Sqr(dx*dx+dy*dy)       Dim As Single nx=ndx*length    Dim As Single ny=ndy*length        Dim As Single px,py      For y As Integer=by(TI)-t2 To by(BI)+t2      For x As Integer=bx(LI)-t2 To bx(RI)+t2                If dx Then 'non-vertical line                    d=(dydx*x-y+b)/Sqr(dydx2+1) 'point-to-line distance equation                  px=x+d*nx 'projected x          py=y+d*ny 'projected y                  Select Case px          Case Is < bx(LI)            Dim As Single xx=x-bx(LI)            Dim As Single yy=y-by(LI)                      d=Sqr(xx*xx+yy*yy)                      Case Is > bx(RI)            Dim As Single xx=x-bx(RI)            Dim As Single yy=y-by(RI)                      d=Sqr(xx*xx+yy*yy)                      Case Else: d=Abs(d)                  End Select                  Else 'vertical line                         Select Case y          Case Is < by(TI)            Dim As Single xx=x-bx(TI)            Dim As Single yy=y-by(TI)                      d=Sqr(xx*xx+yy*yy)                  Case Is > by(BI)              Dim As Single xx=x-bx(BI)            Dim As Single yy=y-by(BI)                      d=Sqr(xx*xx+yy*yy)                    Case Else: d=x-x1          End Select                        End If                    If d<t2 Then          clr.alpha=alpha            if x > 0 and x < screen_x then                if y > 0 and y < screen_y then                    Cast( Uinteger Ptr, pixdata + ( x * screenbuffer->Pitch ) )[ y ] = clr.getinteger                endif            endif                   Elseif (d-t2)<=1 Then          clr.alpha=alpha*(1-(d-t2))             if x > 0 and x < screen_x then                if y > 0 and y < screen_y then                    Cast( Uinteger Ptr, pixdata + ( x * screenbuffer->Pitch ) )[ y ] = clr.getinteger                endif            endif                  End If              Next    Next    End Sub'RANDOMIZE TIMER'Screen 19,32,,fb.gfx_ALPHA_PRIMITIVES''dim shared as fb.image ptr screenbuffer screenbuffer = imagecreate(800,600)dim as double tdim as colour clr clr = RGBA(255,0,0,255)t=timerfor i as integer = 1 to 1000sub_line( screenbuffer, 100, 100, 200, 200, 10, clr )next? timer-tPut (0,0),screenbuffer,transsleep`
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland
rolliebollocks wrote:I drew this one up for non-convex poly collisions... Cheap, easy... Just like me.

Question: How do you paint the perfect picture?
Answer: Make yourself perfect and just paint naturally.

Hi Rollie~
I'm working on the two poly collisions, nearly there.
I've simplified rotate2d to a function, rotating a point around a pivot.
I'll leave community discussion, I've said my piece.
Anyway, in the meantime I've put together a compendium of past snatches, ghosts of past doodles if you like, for ALBERT.

@RICHARD
I'm pleased you've been chosen as moderator.
I don't mind getting kicked out by you, and there would be no hard feelings.

There's something lost and something gained every day, I think maybe you have lost a degree of freedom to gain an axe.

But never mind, If you feel as trussed up as a turkey at times, just think of Mac Pherson in his farewell rant
"Tak' aff these bands frae roun' my hands,
gae back to me my sword"

Here's the little doodle for Albert.

Code: Select all

`Sub ball_not2d(cx As Double,_  'CENTRES               cy As Double,_               radius As Double,_               col() As Uinteger,_  'COLOUR ARAY, 2 Dimensions               offsetX As Double=0,_ 'Bright spot (0 to about .9)               offsetY As Double=0,_               e As Double=0,_        'eccentricity                resolution As Double=32,_  'number of circles drawn               im As Any Pointer=0)        Dim As Double d',px,py    Dim As Integer red,green,blue,r,g,b    Dim As Double ox,oy,nx,ny 'ox,oy offset centres position, nx,ny New moving centres    Dim As Integer n=col(0,0)        ox=cx+offsetX*radius    oy=cy+offsetY*radius    red=col(n,1)     green=col(n,2)    blue=col(n,3)    For d = radius To 0 Step -radius/resolution        nx=(cx-ox)*(d-radius)/radius + cx 'linear mappings for moving centre        ny=(cy-oy)*(d-radius)/radius + cy        r=-red*(d/radius-1)        g=-green*(d/radius-1)        b=-blue*(d/radius-1)        Circle im,(nx,ny),d,rgb(r,g,b),,,e,F    Next dEnd Subdeclare Function r(first As Double, last As Double) As Doubledeclare sub drawpolygon(x() as double,y() as double,colour as uinteger,im as any pointer=0)declare sub drawstars(starx as double,stary as double,size as double,col as uinteger)declare sub paintstring(x as double,_           y as double,_           s as string,_           size as double,_           c as uinteger,_           line_angle as double=0,_           char_angle as double=0,_           thickness_tweak as double=1,_           image as any pointer=0)Dim Shared np(1 To 4) As Doubledim shared as double next_x,next_yDim As Double deg,radians = Atn(1)/45Dim As Single s, c, mod_s, mod_cDim As Integer x, y, xctr, yctr, radiusDim As Single modifierDim As Integer toggledim shared as integer xres,yresxres=1000yres=700#include "fbgfx.bi"Screenres xres,yres,32,1,fb.GFX_ALPHA_PRIMITIVESdim shared img as any pointer    img=imagecreate(xres,yres,rgb(10,10,20))dim as uinteger colour(0,3),blue=rgba(85,85,255,50),white=rgb(205,205,205)#macro galaxy(zz)dim as double x7,y7,s7    dim as uinteger c7  paintstring(200,50,"ALBERT",3,rgb(100,0,0),0,10,1,img)   paintstring(700,300,"Get|",1,rgb(0,100,0),30,30,1,img)   paintstring(next_x,next_y,"well|",1.5,rgb(0,0,100),30,30,1,img)  paintstring(next_x,next_y,"SOON|",1.7,rgb(100,0,100),30,30,1,img)  paintstring(10,.8*yres,"From Rollie~ and Dodicat",1,rgb(10,50,50),0,0,1,img)for z as integer=1 to 50    x7=r(0,xres)    y7=r(0,yres)    s7=r(1,2)    c7=rgb(r(200,255),r(100,200),r(100,200))    drawstars(x7,y7,s7,c7)next z#endmacrocolour(0,0)=0colour(0,1)=100colour(0,2)=50colour(0,3)=150xctr=400yctr=290radius=250modifier = -.045toggle = 0dim looper as doubledim k as integer=1galaxy(0)Do    looper=looper+1*k    screenlock    Cls    put(0,0),img,pset    For deg = 0 To 360 Step .1        s = Sin(deg*radians)        c = Cos(deg*radians)        If deg >= 0 And deg <= 180 Then             mod_s = (180-(deg)) * ((deg)/180) * modifier            mod_c = 0'(180-(deg)) * ((deg)/180) * modifier            If deg >= 45 And deg <= 65 Then                 mod_s = mod_s+(20-(deg-45)) * ((deg-45)/20) * modifier/2                mod_c = mod_c+(20-(deg-45)) * ((deg-45)/20) * modifier*2            End If            If deg >= 45 And deg <= 135 Then                 mod_s = mod_s+-(90-(deg-45)) * ((deg-45)/90) * (modifier*2)                'mod_c = 0'(180-(deg)) * ((deg)/180) * modifier            End If            If deg >= 115 And deg <= 135 Then                 mod_s = mod_s+(20-(deg-115)) * ((deg-115)/20) * modifier/2                mod_c = mod_c+-((20-(deg-115)) * ((deg-115)/20) * modifier*2)            End If        Else            mod_s=0            mod_c=0        End If            y=radius*(s+mod_s)        x=radius*(c+mod_c)            If mod_c<>0 Or mod_s <> 0 Then            ' Pset(xctr+x,yctr+y),white'15            circle (xctr+x,yctr+y),5,white,,,,f        Else            'Pset(xctr+x,yctr+y),blue'9            circle (xctr+x,yctr+y),10,blue        End If            Next         colour(0,1)=100    colour(0,2)=100    colour(0,3)=100    ball_not2d(400-100,290-70,50,colour(),0,0,.2)    ball_not2d(400+100,290-70,50,colour(),0,0,.2)    colour(0,1)=100colour(0,2)=50colour(0,3)=150    ball_not2d(400-100,290,50,colour(),.8*looper/500,0)    ball_not2d(400+100,290,50,colour(),-.8*looper/500,0)    colour(0,1)=100    colour(0,2)=0    colour(0,3)=0    ball_not2d(400,310,50,colour(),0,.9,3)'        for z as double=400-50 to 400+50 step 20        colour(0,1)=255        colour(0,2)=255        colour(0,3)=200    ball_not2d(z,290+90,10,colour(),,4)    ball_not2d(z+10,290+160-(40*(looper-360)/360),10,colour(),,-4)''    colour(0,1)=0    colour(0,2)=50    colour(0,3)=0    ball_not2d(400-270,290,100,colour(),0,0,3)    ball_not2d(400+270,290,100,colour(),0,0,3)next z    screenunlock    sleep 1,1    If toggle = 0 Then         modifier+=.0001        If modifier >= .005 Then toggle=1    Else        modifier-=.0001        If modifier <=-.045 Then toggle = 0            End If  if looper>500 then k=-k  if looper<0 then k=-k  Loop Until inkey =chr(27)Function r(first As Double, last As Double) As Double    Function = Rnd * (last - first) + firstEnd Functionsub drawpolygon(x() as double,y() as double,colour as uinteger,im as any pointer=0)    dim k as integer=ubound(x)+1    dim as integer index,nextindex    dim as double xc,yc    for n as integer=1 to ubound(x)'+1        xc=xc+x(n):yc=yc+y(n)        index=n mod k:nextindex=(n+1) mod k        if nextindex=0 then nextindex=1    line im,(x(index),y(index))-(x(nextindex),y(nextindex)),colour    next  xc=xc/ubound(x):yc=yc/ubound(y)  paint im,(xc,yc),colour,colourend subsub drawstars(starx as double,stary as double,size as double,col as uinteger)    dim as double xstar(8),ystar(8)    dim l as double=4*size    Xstar(1)=starX : Ystar(1)=starY-l  Xstar(2)=starX+size:Ystar(2)=starY-size  Xstar(3)=starX+l:Ystar(3)=starY  Xstar(4)=starX+size:Ystar(4)=starY+size  Xstar(5)=starX:Ystar(5)=starY+l  Xstar(6)=starX-size:Ystar(6)=starY+size  Xstar(7)=starX-l:Ystar(7)=starY  Xstar(8)=starX-size:Ystar(8)=starY-size  drawpolygon(Xstar(),Ystar(),col,img)end subSub rotate(Byval pivot_x As Double,_   'turns about this point           Byval pivot_y As Double,_           Byval first_x As Double,_    'centre for circles           Byval first_y As Double,_           Byval second_x As Double, _   'radius for circles           Byval second_y As Double, _   'aspect           byval arc_1 as double,_       'arcs only for circle, 0 for lines           byval arc_2 as double,_           Byval angle As Double, _      'all below for circles and lines           Byval magnifier As Double,_           Byval dilator as double,_           Byval colour As Integer,_           byval thickness as double,_           Byref shape As String,_           image as any pointer=0)           'rotated line is  (np(1),np(2))-(np(3),np(4))           'rotated circle centre is np(3),np(4)           'shape:           'line - draws the line           'linepoint - does the calculation, draws nothing           'linepointset - does the calculations, sets a pixel at the line ends           'ALSO circle,circlepoint, circlepointset,box, boxfill, circlefill.           'arcs from horizontal positive x axis in DEGREES           'arc1<arc2 always e.g from 330 to 430  shape=lcase\$(shape)      Dim p As Double = 4*Atn(1)  '(pi)Dim radians As DoubleDim line_xvector As DoubleDim line_yvector As DoubleDim pivot_xvector As DoubleDim pivot_yvector As DoubleDim th As Double  th=thickness  Dim sx As Double=second_x  angle=angle mod 360radians=(2*p/360)*angle      'change from degrees to radians#Macro thickline(t)Dim As Double s,h,cDim As Uinteger prime=rgb(255,255,255)h=Sqr(((np(1))-(np(3)))^2+((np(2))-(np(4)))^2)s=((np(4))-np(2))/hc=(np(1)-(np(3)))/hline image, (np(3)+s*t/2,np(4)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),primeline image, (np(3)-s*t/2,np(4)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primeline image, (np(3)+s*t/2,np(4)+c*t/2)-(np(3)-s*t/2,np(4)-c*t/2),primeline image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),primepaint image,((np(3)+np(1))/2, (np(4)+np(2))/2),prime,primeline image, (np(3)+s*t/2,np(4)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colourline image, (np(3)-s*t/2,np(4)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourline image, (np(3)+s*t/2,np(4)+c*t/2)-(np(3)-s*t/2,np(4)-c*t/2),colourline image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colourpaint image,((np(3)+np(1))/2, (np(4)+np(2))/2), colour, colour#EndMacro#macro thickcircle(t)Dim As Uinteger prime=rgb(255,255,255)dim as double xp1,xp2,yp1,yp2dim arc1 as double=arc_1*p/180dim arc2 as double=arc_2*p/180arc1=2*p+(arc1-(radians))arc2=2*p+(arc2-(radians))sx=sx*magnifierif arc1=arc2 then     circle image,(np(3),np(4)),sx+t/2,prime,,,second_y    circle image,(np(3),np(4)),sx-t/2,prime,,,second_y    paint image,(np(3),np(4)+sx),prime,prime    paint image,(np(3)+sx,np(4)),prime,prime    circle image,(np(3),np(4)),sx+t/2,colour,,,second_y    circle image,(np(3),np(4)),sx-t/2,colour,,,second_y    paint image,(np(3),np(4)+sx),colour,colour    paint image,(np(3)+sx,np(4)),colour,colourend ifif arc1<>arc2 then    xp1=np(3)+(sx)*cos(.5*(arc2+arc1))yp1=np(4)-(sx)*sin(.5*(arc2+arc1))circle image,(np(3),np(4)),sx+t/2,prime,arc1,arc2,second_y    circle image,(np(3),np(4)),sx-t/2,prime,arc1,arc2,second_y    line image,(np(3)+(sx+t/2)*cos(arc1),np(4)-(sx+t/2)*sin(arc1))-(np(3)+(sx-t/2)*cos(arc1),np(4)-(sx-t/2)*sin(arc1)),prime    line image,(np(3)+(sx+t/2)*cos(arc2),np(4)-(sx+t/2)*sin(arc2))-(np(3)+(sx-t/2)*cos(arc2),np(4)-(sx-t/2)*sin(arc2)),prime    paint image,(xp1,yp1),prime,prime    circle image,(np(3),np(4)),sx+t/2,colour,arc1,arc2,second_y    circle image,(np(3),np(4)),sx-t/2,colour,arc1,arc2,second_y    line image,(np(3)+(sx+t/2)*cos(arc1),np(4)-(sx+t/2)*sin(arc1))-(np(3)+(sx-t/2)*cos(arc1),np(4)-(sx-t/2)*sin(arc1)),colour    line image,(np(3)+(sx+t/2)*cos(arc2),np(4)-(sx+t/2)*sin(arc2))-(np(3)+(sx-t/2)*cos(arc2),np(4)-(sx-t/2)*sin(arc2)),colour    paint image,(xp1,yp1),colour,colour   end if#endmacromagnifier=dilator*magnifier      pivot_xvector=first_x-pivot_xpivot_yvector=first_y-pivot_ypivot_xvector=dilator*pivot_xvector  pivot_yvector=dilator*pivot_yvector Dim mover(1 To 2,1 To 2) As DoubleDim new_pos(1 To 2) As Doublemover(1,1)=Cos(radians)mover(2,2)=Cos(radians)mover(1,2)=-Sin(radians)mover(2,1)=Sin(radians)line_xvector=magnifier*(second_x-first_x)                   'get the vectorline_yvector=magnifier*(second_y-first_y)                   'get the vectornew_pos(1)=mover(1,1)*pivot_xvector+mover(1,2)*pivot_yvector +pivot_xnew_pos(2)=mover(2,1)*pivot_xvector+mover(2,2)*pivot_yvector +pivot_yDim new_one(1 To 2) As Double            'To hold the turned valuenew_one(1)=mover(1,1)*line_xvector+mover(1,2)*line_yvector +first_xnew_one(2)=mover(2,1)*line_xvector+mover(2,2)*line_yvector +first_yDim xx As Double   'translationDim yy As Double xx=first_x-new_pos(1)yy=first_y-new_pos(2)np(1)=new_one(1)-xx    np(2)=new_one(2)-yy     np(3)=first_x-xx np(4)=first_y-yySelect Case shapeCase "line"    If th<2 Then line image,(np(3),np(4))-(np(1),np(2)),colour Else thickline(th)    End IfCase "circle"    dim arc1 as double=arc_1*p/180dim arc2 as double=arc_2*p/180    if arc1=arc2 then    If th<=3 Then        for n as double=magnifier*sx-1 to magnifier*sx+1 step .5     circle image,(np(3),np(4)),n,colour,,,second_y        'circle image,(np(3),np(4)),magnifier*sx,colour,,,second_y next nElse thickcircle(th)End Ifendifif arc1<>arc2 thenIf th<=3 Then    arc1=2*p+(arc1-(radians))'newarc2=2*p+(arc2-(radians))'new    for n as double=magnifier*sx-1 to magnifier*sx+1 step .5     circle image,(np(3),np(4)),n,colour,arc1,arc2,second_y      ' circle image,(np(3),np(4)),magnifier*sx,colour,arc1,arc2,second_y    next nelse    thickcircle(th)end ifend ifCase "circlefill"    dim as double xp1,xp2,yp1,yp2Dim As Uinteger prime=rgb(255,255,255)dim arc1 as double=arc_1*p/180dim arc2 as double=arc_2*p/180if arc1=arc2 then circle image,(np(3),np(4)),magnifier*sx,colour,,,second_y,Fif arc1<>arc2 then xp1=np(3)+magnifier*sx*cos(.5*(arc2+arc1))*3/4yp1=np(4)-magnifier*sx*sin(.5*(arc2+arc1))*3/4   circle image,(np(3),np(4)),magnifier*sx,prime,arc1,arc2,second_yline image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc2),np(4)-magnifier*sx*sin(arc2)),primeline image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc1),np(4)-magnifier*sx*sin(arc1)),primepaint image,(xp1,yp1),prime,primecircle image,(np(3),np(4)),magnifier*sx,colour,arc1,arc2,second_yline image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc2),np(4)-magnifier*sx*sin(arc2)),colourline image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc1),np(4)-magnifier*sx*sin(arc1)),colourpaint image,(xp1,yp1),colour,colourend if Case"box" line image,(np(3),np(4))-(np(1),np(2)),colour,bCase "boxfill" line image,(np(3),np(4))-(np(1),np(2)),colour,bf        Case "linepoint","circlepoint"  'nothing drawnCase "linepointset","circlepointset" If shape="linepointset" Then Pset image,(np(1),np(2)),colour Pset image,(np(3),np(4)),colour Endif If shape="circlepointset" Then     Pset image,(np(3),np(4)),colour End If        Case Else Print "unknown rotation shape"End Select End Sub'dim shared as double next_x,next_ysub paintstring(x as double,_           y as double,_           s as string,_           size as double,_           c as uinteger,_           line_angle as double=0,_           char_angle as double=0,_           thickness_tweak as double=1,_           image as any pointer=0)dim l as integer=len(s)dim px as double=16*size+xy=y+16*sizedim py as double=y'16*size+ydim z as integer=0dim th as double'=4th=((.5-size)/4.5+5)*thickness_tweakdim sp as double=6dim sp2 as double=6dim pi as double=4*atn(1)dim la as double=(line_angle *.5) dim ca as double=(char_angle*.5) sp2=sp2+30*abs(sin(ca*pi/180-la*pi/180))#macro set(x1,y1,x2,y2,sarc,earc,shape,im)rotate(px,py,x1,y1,x2,y2,sarc,earc,-char_angle,1,size,c,th*size,shape,im)#endmacro#macro spaces(xpixels,ypixels)px=px+(xpixels*size+sp2*size)*cos(line_angle*pi/180)py=py-(ypixels*size+sp2*size)*sin(line_angle*pi/180)next_x=px-16*sizenext_y=py-16*size#endmacrofor n as integer=1 to l        select case mid\$(s,n,1)    case " " spaces(30,30) case "|" z=z+1 px=(x+16*size+z*16*sin(line_angle*pi/180))+1.3*z*(24*size+size*sp*size)*sin(line_angle*pi/180) py=(y+z*16*cos(line_angle*pi/180))+1.3*z*(24*size+size*sp*size)*cos(line_angle*pi/180) next_x=px-16*sizenext_y=py-16*sizecase "1" set(px-8,py-18,px-8,py+16,.0,.0,"line",image)'vert set(px-8,py-16,px-12,py-8,.0,.0,"line",image) spaces(12,12)case "2" set(px-2,py-8,9,1,310,530,"circle",image)'curve set(px-15,py+14,px+5,py-2,.0,.0,"line",image) set(px-16,py+14,px+10,py+14,.0,.0,"line",image)'base spaces(28,28)case "3" set(px-2,py-7,9,1,300,530,"circle",image)'curve top set(px-2,py+6,9,1,190,395,"circle",image)'curve set(px-3,py,px+5,py,.0,.0,"line",image) spaces(28,28)case "4" set(px-16,py+4,px+12,py+4,.0,.0,"line",image)'horiz  set(px-14,py+4,px+4,py-16,.0,.0,"line",image)'slope set(px+4,py-18,px+4,py+16,.0,.0,"line",image) spaces(28,28)case "5" set(px-14,py-16,px+6,py-16,.0,.0,"line",image)'top set(px-12,py-16,px-12,py+1,.0,.0,"line",image)'vert set(px-4,py+6,9,1,210,500,"circle",image)'curve spaces(28,28)case "6" set(px-2,py+6,9,1,360,360,"circle",image)'curve base set(px+16,py+4,27,1,130,180,"circle",image)'curve edge spaces(28,28)case "7" set(px-14,py-16,px+6,py-16,.0,.0,"line",image)'top set(px+5,py-16,px-12,py+16,.0,.0,"line",image)'slope spaces(26,26)case "8" set(px-2,py-7,9,1,320,575,"circle",image)'curve top set(px-2,py+6,9,1,130,415,"circle",image)'curve set(px-9,py-1,px+6,py-1,.0,.0,"line",image) spaces(28,28) case "9" set(px-2,py-6,9,1,360,360,"circle",image)'top  set(px-20,py-4,27,1,310,360,"circle",image) spaces(28,28)case "0" set(px,py-1,15,1,360,360,"circle",image) spaces(36,36)case "." set(px-12,py+12,1,1,360,360,"circle",image) spaces(10,10)case "A" set(px,py-16,px-12,py+16,.0,.0,"line",image) set(px,py-16,px+12,py+16,.0,.0,"line",image) set(px-8,py+3,px+8,py+3,.0,.0,"line",image) spaces(30,30)'36 case "a" set(px-4,py+4,10,1,360,360,"circle",image) set(px+6,py-8,px+6,py+16,.0,.0,"line",image) spaces(26,26)case "B" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px-12,py-14,px-5,py-14,.0,.0,"line",image)'top  set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base  set(px-5,py-6,8,1,290,450,"circle",image)'top loop  set(px-5,py+6,8,1,270,430,"circle",image)'base loop  set(px-12,py,px-2,py,.0,.0,"line",image)'middle  spaces(24,24)case "b"    set(px-2,py+4,10,1,360,360,"circle",image) set(px-12,py-16,px-12,py+16,.0,.0,"line",image) spaces(28,28)case "C"    set(px,py,14,1,60,300,"circle",image)    spaces(25,25)case "c"    set(px-4,py+4,10,1,60,300,"circle",image)    spaces(20,20)    case "D"  set(px-12,py-16,px-12,py+16,.0,.0,"line",image) set(px-5,py,14,1,270,450,"circle",image) set(px-12,py-14,px-5,py-14,.0,.0,"line",image)  set(px-12,py+14,px-5,py+14,.0,.0,"line",image)    'rotate(px,py,px-24,py+20,px-24,py-20,0,0,-line_angle,1,size,rgb(255,0,0),1,"line",image) spaces(30,30)case "d" set(px-4,py+4,10,1,360,360,"circle",image) set(px+6,py-16,px+6,py+16,.0,.0,"line",image) spaces(26,26)case "E" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px-12,py-14,px+6,py-14,.0,.0,"line",image)'top  set(px-12,py+14,px+6,py+14,.0,.0,"line",image)'base  set(px-12,py,px-2,py,.0,.0,"line",image)'middle  spaces(25,25)case "e"  set(px-4,py+4,10,1,0,320,"circle",image)  set(px-12,py+3,px+8,py+3,.0,.0,"line",image)  spaces(26,26)case "F"  set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px-12,py-14,px+6,py-14,.0,.0,"line",image)'top  set(px-12,py,px-2,py,.0,.0,"line",image)'middle  spaces(24,24)case "f"  set(px-2,py-8,10,1,0,170,"circle",image)'curve set(px-12,py-10,px-12,py+16,.0,.0,"line",image)'vert set(px-10,py,px-2,py,.0,.0,"line",image)'middle spaces(28,28) case "G"  set(px,py,14,1,50,350,"circle",image)  set(px,py,px+16,py,.0,.0,"line",image)    spaces(35,35)case "g"    set(px-4,py+4,10,1,360,360,"circle",image) set(px+6,py-6,px+6,py+20,.0,.0,"line",image) set(px-4,py+17,10,1,230,345,"circle",image)  spaces(26,26)case "H" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px+12,py-16,px+12,py+16,.0,.0,"line",image)'vert set(px-12,py,px+12,py,.0,.0,"line",image)'middle spaces(32,32)case "h"  'set(px-6,py+4,10,1,0,150,"circle",image)  set(px-4,py+2,8,1,0,170,"circle",image)'curve right set(px-12,py-16,px-12,py+16,.0,.0,"line",image) set(px+4,py,px+4,py+16,.0,.0,"line",image) spaces(25,25)case "I" set(px,py+16,px,py-16,.0,.0,"line",image)'vert set(px-12,py+14,px+12,py+14,.0,.0,"line",image) set(px-12,py-14,px+12,py-14,.0,.0,"line",image) spaces(30,30)case "i"  set(px-12,py-6,px-12,py+16,.0,.0,"line",image)  set(px-12,py-14,1,1,360,360,"circle",image)  spaces(10,10)case "J"    'set(px-2,py+4,12,1,200,270,"circle",image)    set(px-7,py+8,7,1,220,355,"circle",image) set(px,py-16,px,py+9,.0,.0,"line",image)'vert set(px-12,py-14,px+12,py-14,.0,.0,"line",image)'top spaces(30,30)case "j" set(px,py-6,px,py+20,.0,.0,"line",image) set(px-7,py+20,7,1,220,360,"circle",image) set(px,py-14,1,1,360,360,"circle",image) spaces(22,22)case "K" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px+6,py-16,px-12,py,.0,.0,"line",image)'upper set(px+6,py+16,px-6,py-3,.0,.0,"line",image) spaces(25,25)case "k" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px+3,py-6,px-12,py,.0,.0,"line",image)'upper set(px,py+16,px-8,py-3,.0,.0,"line",image)'lower spaces(20,20)case "L" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px-12,py+14,px+6,py+14,.0,.0,"line",image)'base spaces(25,25)case "l" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert spaces(10,10)case "M" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px+12,py-16,px+12,py+16,.0,.0,"line",image)'vert set(px-12,py-16,px,py,.0,.0,"line",image)'left arm set(px+12,py-16,px,py,.0,.0,"line",image)'right arm  spaces(32,32)case "m" set(px-6,py+2,6,1,0,170,"circle",image)'curve left set(px+6,py+2,6,1,0,170,"circle",image)'curve right set(px-12,py-5,px-12,py+16,.0,.0,"line",image)'vert left set(px+12,py,px+12,py+16,.0,.0,"line",image)'vert right set(px,py+16,px,py,.0,.0,"line",image)'mid arm spaces(32,32)case "N" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px+12,py-16,px+12,py+16,.0,.0,"line",image)'vert set(px-12,py-16,px+12,py+16,.0,.0,"line",image)'middle spaces(32,32)case "n"    set(px-4,py+2,8,1,0,170,"circle",image)'curve right set(px-12,py-5,px-12,py+16,.0,.0,"line",image)'vert left set(px+4,py+16,px+4,py,.0,.0,"line",image)'mid arm spaces(24,24)case "O" set(px,py,14,1,360,360,"circle",image) spaces(36,36)case "o" set(px-4,py+4,10,1,360,360,"circle",image) 'set(px+6,py-16,px+6,py+16,.0,.0,"line",image) spaces(26,26)case "P" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px-12,py-14,px-5,py-14,.0,.0,"line",image)'top  'set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base  set(px-5,py-6,8,1,280,450,"circle",image)'top loop  'set(px-5,py+6,10,1,270,430,"circle",image)'base loop  set(px-12,py+2,px-2,py+2,.0,.0,"line",image)'middle  spaces(24,24)case "p" set(px-5,py+4,10,1,270,435,"circle",image)' loop  set(px-14,py-5,px-2,py-5,.0,.0,"line",image)'top set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base set(px-12,py-6,px-12,py+26,.0,.0,"line",image)'vert spaces(24,24) case "Q" set(px,py,14,1,360,360,"circle",image) set(px+5,py+20,16,1,400,460,"circle",image) spaces(36,36)case "q" set(px-5,py+6,10,1,110,270,"circle",image)' loop set(px-9,py-3,px+2,py-3,.0,.0,"line",image)'top set(px-8,py+16,px,py+16,.0,.0,"line",image)'base set(px,py-3,px,py+26,.0,.0,"line",image)'vert spaces(20,20)case "R" set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert set(px-12,py-14,px-5,py-14,.0,.0,"line",image)'top  'set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base  set(px-5,py-6,8,1,290,450,"circle",image)'top loop  'set(px-5,py+6,10,1,270,430,"circle",image)'base loop  set(px-12,py+2,px-2,py+2,.0,.0,"line",image)'middle  set(px-8-1+3,py+1,px+12-8-1,py+16+1-2,.0,.0,"line",image)'slope  spaces(24,24)case "r"  set(px-4,py+4,10,1,30,130,"circle",image) set(px-12,py-8,px-12,py+16,.0,.0,"line",image) spaces(24,24)case "S" set(px-2,py-7,8,1,20,240,"circle",image)'curve top set(px-2,py+6,8,1,200,500,"circle",image)'curve 'set(px-9,py-1,px+6,py-1,.0,.0,"line",image) spaces(26,26)case "s" set(px-4,py+4,10,1,40,140,"circle",image)'top set(px-1,py-4,10,1,180,240,"circle",image)'topslant set(px-6,py+14,10,1,20,100,"circle",image)'baseslant set(px-4,py+4,10,1,220,325,"circle",image)'base 'set(px-12,py-4,px+2,py+12,.0,.0,"line",image) 'set(px+6,py-8,px+6,py+16,.0,.0,"line",image) spaces(26,26)case "T" set(px,py-12,px,py+16,.0,.0,"line",image)'vert set(px-16,py-12-2,px+16,py-12-2,.0,.0,"line",image) spaces(34,34)case "t" set(px-12,py-16,px-12,py+10,.0,.0,"line",image)'edge set(px-12,py-4,px-2,py-4,.0,.0,"line",image) set(px-4,py+4,10,1,210,320,"circle",image) spaces (24,24)case "U" set(px-12,py-16,px-12,py+8,.0,.0,"line",image)'vert set(px+12,py-16,px+12,py+8,.0,.0,"line",image)'vert set(px,py,14,1,205,335,"circle",image) 'set(px-12,py,px+12,py,.0,.0,"line",image)'middle spaces(33,33)case "u" set(px-4,py+4,10,1,210,360,"circle",image) set(px+6,py-6,px+6,py+16,.0,.0,"line",image) set(px-12,py-6,px-12,py+10,.0,.0,"line",image)'left edge spaces(26,26)case "V" set(px,py+16,px-12,py-16,.0,.0,"line",image) set(px,py+16,px+12,py-16,.0,.0,"line",image) 'set(px-8,py+3,px+8,py+3,.0,.0,"line",image) spaces(32,32)'36       Case "v"  set(px-12,py-6,px-4,py+16,.0,.0,"line",image)'left   set(px-4,py+16,px+4,py-6,.0,.0,"line",image)  spaces(24,24)        Case "W"   set(px-12,py-16,px-8,py+16,.0,.0,"line",image)'vert left set(px+12,py-16,px+8,py+16,.0,.0,"line",image)'vert set(px-8,py+16,px,py,.0,.0,"line",image)'left arm set(px+8,py+16,px,py,.0,.0,"line",image)'right arm spaces(32,32)       Case "w"          set(px-14,py-6,px-8,py+16,.0,.0,"line",image)'vert left          set(px+8,py+16,px+12,py-6,.0,.0,"line",image)'vert right          set(px-8,py+16,px,py,.0,.0,"line",image)'left arm set(px+8,py+16,px,py,.0,.0,"line",image)'right arm          spaces(33,33)        case "X"            set(px-12,py-16,px+12,py+16,.0,.0,"line",image)            set(px+12,py-16,px-12,py+16,.0,.0,"line",image)            spaces(32,32)        case "x"            set(px-12,py-6,px+2,py+16,.0,.0,"line",image)            set(px+2,py-6,px-12,py+16,.0,.0,"line",image)            spaces(22,22)        case "Y"            set(px-12,py-16,px,py,.0,.0,"line",image)            set(px+12,py-16,px,py,.0,.0,"line",image)            set(px,py,px,py+16,.0,.0,"line",image)            spaces(32,32)        case "y"               set(px-4,py+4,8,1,180,380,"circle",image)'top set(px+4,py-6,px+4,py+20,.0,.0,"line",image)'right set(px-6,py+17,10,1,230,345,"circle",image)'base set(px-12,py-6,px-12,py+4,.0,.0,"line",image)'left spaces(24,24)case "Z" set(px-12,py-14,px+12,py-14,.0,.0,"line",image)'top set(px-12,py+14,px+12,py+14,.0,.0,"line",image) set(px+10,py-14,px-10,py+14,.0,.0,"line",image)'slope spaces(30,30)case "z" set(px-16,py-4,px+2,py-4,.0,.0,"line",image)'top set(px-16,py+14,px+2,py+14,.0,.0,"line",image)'base set(px+1,py-5,px-14,py+14,.0,.0,"line",image)'slope spaces(20,20)             '************************************************       case "," set(px-12,py+12,px-18,py+20,.0,.0,"line",image) set(px-12,py+12,1,1,360,360,"circle",image) spaces(10,10) case"£" set(px-5,py-5,8,1,40,220,"circle",image)'top set(px-19-5-5,py+10-5,18,1,320,390,"circle",image) set(px-16,py+16,px+8,py+16,.0,.0,"line",image)'base set(px-16,py+2,px,py+2,.0,.0,"line",image) spaces(28,28)case "\$"  set(px-2,py-7,8,1,20,240,"circle",image)'curve top set(px-2,py+6,8,1,200,495,"circle",image)'curve set(px-2,py-17,px-2,py+17,.0,.0,"line",image) 'set(px-9,py-1,px+6,py-1,.0,.0,"line",image) spaces(26,26)case "%" set(px-10,py-10,6,1,360,360,"circle",image) set(px+10,py+10,6,1,360,360,"circle",image) set(px+8,py-8,px-8,py+8,.0,.0,"line",image) spaces(33,33)case "^" set(px-14,py,px-7,py-16,.0,.0,"line",image) set(px-7,py-16,px,py,.0,.0,"line",image) spaces(20,20) case"&" set(px-2,py-7,8,1,70,220,"circle",image)'curve top set(px-2,py+6,8,1,110,415,"circle",image)'curve set(px-4-4-2,py-8,px+12-4,py+16,.0,.0,"line",image) 'set(px-9,py-1,px+6,py-1,.0,.0,"line",image) spaces(28,28)case "*" set(px-12,py-6-8,px+2,py+16-8,.0,.0,"line",image)            set(px+2,py-6-8,px-12,py+16-8,.0,.0,"line",image)            set(px-16,py-3,px+6,py-3,.0,.0,"line",image)            spaces(24,24)        case "("            set(px+22,py,38,1,150,210,"circle",image)            spaces(12,12)        case ")"       set(px-22-16-6,py,38,1,330,390,"circle",image)            spaces(12,12)        case "-"            set(px-16,py,px+8,py,.0,.0,"line",image)            spaces(26,26)        case "_"            set(px-16,py+16,px+16,py+16,.0,.0,"line",image)            spaces(34,34)            case "+"            set(px-16,py,px+8,py,.0,.0,"line",image)            set(px-4,py+12,px-4,py-12,.0,.0,"line",image)            spaces(26,26)        case "="        set(px-16,py-4,px+8,py-4,.0,.0,"line",image)        set(px-16,py+4,px+8,py+4,.0,.0,"line",image)        spaces(26,26)    case "!"        set(px-12,py-16,px-12,py+6,.0,.0,"line",image)        set(px-12,py+12,1,1,360,360,"circle",image)        spaces(10,10)    case "¬"    set(px-16,py+4,px+8,py+4,.0,.0,"line",image)    set(px+6,py+4,px+6,py+12,.0,.0,"line",image)    spaces(26,26)case "`"    set(px-16,py-16,px-12,py-12,.0,.0,"line",image)    spaces(8,8)case ";"    set(px-12,py-4,1,1,360,360,"circle",image)'top  set(px-12,py+12,px-18,py+20,.0,.0,"line",image) set(px-12,py+12,1,1,360,360,"circle",image) spaces(10,10) case ":"   set(px-12,py-4,1,1,360,360,"circle",image)'top  'set(px-12,py+12,px-18,py+20,.0,.0,"line",image) set(px-12,py+12,1,1,360,360,"circle",image) spaces(10,10)case "@" set(px,py,14,1,0,290,"circle",image) set(px+6,py,7,1,100,365,"circle",image) spaces(36,36)case "'" set(px-12,py-12,px-18,py-4,.0,.0,"line",image) set(px-12,py-12,1,1,360,360,"circle",image) spaces(10,10)case "#" set(px-16,py-4,px+8,py-4,.0,.0,"line",image)set(px-16,py+4,px+8,py+4,.0,.0,"line",image)set(px-8,py-12,px-8,py+12,.0,.0,"line",image)set(px,py-12,px,py+12,.0,.0,"line",image)        spaces(26,26)    case "~"  set(px-8,py+16,14,1,60,120,"circle",image)  set(px+4,py-8,14,1,240,300,"circle",image)  spaces(30,30)case "/"  set(px+14,py-16,px-14,py+16,.0,.0,"line",image)  spaces(34,34)case ""  set(px-14,py-16,px+14,py+16,.0,.0,"line",image)  spaces(34,34)case "["  set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert  set(px-12,py-14,px-4,py-14,.0,.0,"line",image)'top  set(px-12,py+14,px-4,py+14,.0,.0,"line",image)  spaces(14,14)case "]"  set(px-4,py-16,px-4,py+16,.0,.0,"line",image)'vert  set(px-4,py-14,px-12,py-14,.0,.0,"line",image)'top  set(px-12,py+14,px-4,py+14,.0,.0,"line",image)  spaces(16,16)case "{"  set(px+12,py-8,28,1,160,200,"circle",image)  set(px+12,py+8,28,1,160,200,"circle",image)            spaces(8,8)case "}"  set(px-12-16-6,py-8,28,1,340,380,"circle",image)  set(px-12-16-6,py+8,28,1,340,380,"circle",image)            spaces(14,14)case "<"    set(px-16,py,px+4,py-12,.0,.0,"line",image)    set(px-16,py,px+4,py+12,.0,.0,"line",image)    spaces(24,24)case ">"    set(px+4,py,px-16,py-12,.0,.0,"line",image)    set(px+4,py,px-16,py+12,.0,.0,"line",image)    spaces(24,24)case "?"     set(px-5,py-6,8,1,280,490,"circle",image)'top loop     set(px-4,py,px-4,py+8,.0,.0,"line",image)     set(px-4,py+15,1,1,360,360,"circle",image)     spaces(24,24)     case """"  set(px-12,py-16,px-18,py-8,.0,.0,"line",image) set(px-12,py-16,1,1,360,360,"circle",image)  set(px-4,py-16,px-10,py-8,.0,.0,"line",image) set(px-4,py-16,1,1,360,360,"circle",image) spaces(16,16)    case else    draw string(px,py),"?",c    spaces(24,24)    end select    next nend sub'************************* END OF PAINTSTRING ******************************imagedestroy imgSleep `
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia
@ dodicat & rolliebollocks.
Someone has to trash the spam that members do not see, so yes, I have accepted a small moderators hat offered by Counting_pine, but I much prefer to wear my more comfortable Tam O'Shanter. I really hope to waste the minimum time moderating as in ...put those bands a roun' his hands an' swing that bloody axe. Once I have climbed the moderately sloped learning curve I will get back to some good ol' FB community square dancing, whoops, I mean programming.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
@dodicat

Yeah, I agree with you. I hope Albert gets well soon. That was one of my favorites. The doodle that is.

Anyway, I've been playing with DRAW lately. Here is a square going in circles. I guess draw can rotate. Weird.

Code: Select all

`#include once "fbgfx.bi"#define XYLOC(x,y)          "bm" & x & "," & y#define DRAWTO(x,y)         "m" & x & "," & y#define SETCOL(c)           "c" & c#define UP(amt)             "u" & amt#define DOWN(amt)           "d" & amt#define DRAWLEFT(amt)       "l" & amt#define DRAWRIGHT(amt)      "r" & amt#define UPRIGHT(amt)        "e" & amt#define DOWNRIGHT(amt)      "f" & amt#define DOWNLEFT(amt)       "g" & amt#define UPLEFT(amt)         "h" & amt#define DPAINT(c,b)         "p" & c & "," & b#define DSCALE(s)           "s" & s#define DROTATERAD(r)       "a" & r#define DROTATEDEG(r)       "ta" & rsub DrawSquare ( screenbuffer as fb.image ptr = 0, byval x as single, byval y as single, byval size as single=1, byval rotang as integer =0, byval clr as uinteger=&hffffff )        Draw screenbuffer, DROTATEDEG(rotang) & SETCOL(clr) & DSCALE(size) & XYLOC(x,y) & DRAWLEFT(5) & DOWN(5) & DRAWRIGHT(5) & UP(5)end subscreen 19,32dim as integer i=360do    screenlock    cls    DrawSquare ( , 400,300,200, i,RGB(255,0,0) )    screenunlock    sleep 1    i+=1    if i=360 then i=0loop until multikey(fb.sc_escape)    `

Do you guys know anything about http://en.wikipedia.org/wiki/Binary_space_partitioning ?
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
I liked this one so much I made special subroutine for it:

Code: Select all

`#include once "fbgfx.bi"#define PI 3.1459sub AlbertWeb ( byref screenbuffer as fb.image ptr = 0, byval xctr as integer, byval yctr as integer, byval radius as integer, byval clr as uinteger = RGBA(255,255,255,255) )#define d2r(r) r*(PI/180)    dim as integer span = 30, start_deg = 0    dim as single sine=0.0, cosine=0.0, c_mul, s_mul, x, y    for iRadius as integer = radius to 20 step -(radius*.1)        for iRadians as single = 0 to 360 step .1                        sine = Sin(d2r(iRadians))            cosine = Cos(d2r(iRadians))                        if iRadians mod span = 0 then                start_deg = iRadians                line screenbuffer, ( xctr, yctr ) - ( xctr + ( radius*Cos(d2r(start_deg)) ), yctr+(radius*Sin(d2r(start_deg))) ), clr            endif                        c_mul = -.006            s_mul = -.006                If iRadians >= 45 And iRadians <=135 Then c_mul=c_mul/2            If iRadians >=225 And iRadians <=315 Then c_mul=c_mul/2                If iRadians >=  0 And iRadians <= 45 Then s_mul=s_mul/2            If iRadians >=135 And iRadians <=225 Then s_mul=s_mul/2            If iRadians >=315 And iRadians <=360 Then s_mul=s_mul/2                If iRadians >= 90 And iRadians <= 270 Then c_mul=-c_mul            If iRadians >=180 And iRadians <= 360 Then s_mul=-s_mul                sine =   sine + (span-(iRadians-start_deg))*((iRadians-start_deg)/span) * s_mul            cosine = cosine + (span-(iRadians-start_deg))*((iRadians-start_deg)/span) * c_mul                y = iradius *   sine            x = iradius * cosine                        Line screenbuffer, -(xctr+x,yctr+y), clr                    next    nextend subscreen 19,32dim as double tt=timerAlbertWeb (,400,300,200 )? timer-tsleep`

Here's another:

Code: Select all

`#include once "fbgfx.bi"sub AlienMicroChip ( byref screenbuffer as fb.image ptr=0, byval xctr as integer, byval yctr as integer, byval radius2 as single )    dim as single x1=any, x2=any, y1=any, y2=any, s=any, c=any, deg1=any, deg2=any, radius1 = 1        Dim As Double radians=Atn(1)/45    Do        For deg2 = 0 To 360 Step 12            For deg1 = 0 To 360 Step 5                        c=Cos(deg1*radians)*Sin(Log(deg2*radius2*radians))                s=Sin(deg1*radians)*Cos(Log(deg2*radius2*radians))                        x1=radius1*c                y1=radius1*s                                Pset(xctr+x1,yctr+y1), RGBA (deg1, deg2, radius1+radius2 mod 255, 255-deg1 )            Next            radius1+=1e-2            radius2-=1e-2        Next    Loop Until radius1>=radius2end subscreen 19, 32AlienMicroChip (,400,300,900)Sleep`
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia
@rolliebollocks; an interesting spiders web, but the curve sag looks wrong.

A spiders web is visible when it caries droplets of dew. It then sags under that weight (until the droplets evaporate or the spider shakes them off). Gravity would cause each individual thread to hang in a catenary. A catenary is a horrible hyperbolic function but could be approximated by a section of an upright parabola. At every node where threads join the sum of all tension vector forces would be zero, but I think it might be possible to quickly fake that. A structural design engineer would build an enormous but sparse stiffness matrix for the structure and then solve that for the final position of all nodes. I assume a spider builds the radial framework first, then adds the spiral starting at the centre and working outwards.

How might a realistic random web be generated on the screen, with or without the spider building it. Pick random points around the screen, plus one random midpoint, then put on a spiral?
How can a web once constructed be quickly given a realistic looking pearl necklace sag due to dew loading?
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
@Richard

That was Albert's creation. I dug it up and made it into a sub and through it in the Lib because I thought it was cool. I've been collecting demo's and whatnot, putting them together. I realized I don't have to do this all myself, as long as I'm not making money or taking credit no one will care if I add their examples or anything to my Lib and then explain the usage.

So I added Bezier's and that web, some star curves from one of Rel's demo's he called supershapes...

I tried to add Coder's Jeff's rigid body lib but it broke... Anyway, putting the finishing touches on 2d, and then I'm going to make a game I think.

I want real-ish 2d physics so, I'll probably have to research and do it from scratch...

I went through your primitives Lib, it doesn't compile, some of the files are missing. I noticed you had Holes though...

I want holes. And knots. I'm going to add Knots.

Geometry is fascinating.
Posts: 2149
Joined: May 24, 2007 22:10
Location: The Netherlands
Spiderweb with dew droplets, i think i have some code which can do that. Lets try...

To code i'm am thniking about:

Code: Select all

`#lang "fblite"OPTION EXPLICITOPTION BYVAL#Define MAXATOMS 400#Define MAXLINKS 1000#Define THICKLINE 1'const g as double = 0'9.81 'm/s^2const kAtom as double = 5 'N/mconst kLink as double = 20 'N/mconst pi as double = 3.14159265359const atomicMass as double = 1.66e-27 'kgconst mArgon as double = 4 '39.95 'no unitconst mArgonMol as double = mArgon / 1000.0 'kg/molconst angstrom as double = 1e-10 'mconst rArgon as double =  100e-12 '98e-12const univGasConst as double = 8.314 'J/mol Kconst mol as double = 6.02e+23 'particlesconst dIron as double = 2.28 * angstrom 'mconst mIron as double = 55.85 'no unittype atomType rho as double 'kg/m^3 r as double m as double x as double y as double vx as double vy as double Fx as double Fy as double Cat as integerend typetype linkType  id1 as integer  id2 as integer  initLength as doubleend typetype configType  Id as integer  Cat as integerend typetype xyType  x as integer  y as integerend typedeclare sub flipScreen()declare sub plotWorld()declare sub plotLine (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)declare sub plotSquare (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)declare sub plotSquareFilled (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)declare sub plotAtom (atom as atomType)declare sub plotlink (link as linkType)declare sub plotCircle (x as double, y as double, r as double, c as integer)declare function distAtom(b1 as atomType, b2 as atomType) as doubledeclare sub powerMeter(p as double)declare function waitForKey() as stringdim as integer i, j, k, x, y, filedim as string configText, configChardim as configType configArray(100,100)dim as configType ptr a1ptr, a2ptrdim as integer configFileXsize, configFileYsizedim as double volume, temperature, vAverage, alfadim shared as atomType atom(MAXATOMS)dim shared as atomType edge(10)dim as atomType ptr pAtomdim shared as linkType link(MAXLINKS)dim as integer nAtoms, nLinks, id1, id2, iShow = 0dim shared as integer scrnw, scrnh, scrnh1 'in pixelsdim shared as double ppm 'pixels per meterdim as double t,dtdim as string keydim as double F, edgeDistdim as xyType linkMatrix(4)dim shared as double wx1, wx2, wx3, wx4dim shared as double wy1, wy2, wy3, wy4dim shared as double x0, y0, y133dim as double startTime'---------- Program starts here ----------linkMatrix(0).x = +1: linkMatrix(0).y = 0linkMatrix(1).x = -1: linkMatrix(1).y = +1linkMatrix(2).x = 0:  linkMatrix(2).y = +1linkMatrix(3).x = +1: linkMatrix(3).y = +1'---------- From file to 2d-array ----------j = 0file = freefileopen "config.txt" for input as #filewhile not eof(file)  input #file, configText  for i = 1 to len(configText)    configChar = mid(configText,i,1)    if configChar = "-" then      configArray(i,j).cat = 0      print ".";    else      configArray(i,j).cat = val(configChar)      print str(configArray(i,j).cat);    end if  next  print  j+=1wendconfigFileXsize = len(configText)configFileYsize = jclose fileprint "configFileXsize:"; configFileXsizeprint "configFileYsize:"; configFileYsizerandomize timertemperature = 300 'K'----- set atom number 0 manually -----i = 0atom(i).cat = 1atom(i).r = rArgon * 4atom(i).m = mArgon * atomicMass * 4volume = 1.25 * pi * atom(i).r ^ 3atom(i).rho = atom(i).m / volumeatom(i).x = 99 * angstromatom(i).y = 48 * angstromvAverage = sqr((3 * univGasConst * temperature) / mArgonMol)alfa = rnd(1) * 2 * piatom(i).vx = cos(alfa) * vAverageatom(i).vy = sin(alfa) * vAverageatom(i).Fx = 0atom(i).Fy = 0x0 = atom(i).xy0 = atom(i).y + 20 * angstrom'---------- 2d-array to list ----------i = 1 'to count number of balls / atomsfor y = 0 to configFileYsize-1  for x = 0 to configFileXsize-1    if (configArray(x,y).cat <> 0) then      configArray(x,y).id = i      atom(i).cat = configArray(x,y).cat      atom(i).r = rArgon      atom(i).m = mArgon * atomicMass      if (atom(i).cat = 3) then atom(i).m /= 20      volume = 1.25 * pi * atom(i).r ^ 3      atom(i).rho = atom(i).m / volume      atom(i).x = (x - 3) * 3 * angstrom      atom(i).y = (((configFileYsize - 1) - y) + 0) * 3 * angstrom - angstrom * 2      vAverage = sqr((3 * univGasConst * temperature) / mArgonMol)      alfa = rnd(1) * 2 * pi      atom(i).vx = cos(alfa) * vAverage      atom(i).vy = sin(alfa) * vAverage      atom(i).Fx = 0      atom(i).Fy = 0      i+=1    end if    if (i > MAXATOMS) then      print "Error: Too much atoms!"      sleep 3000      end(-1)    end if  nextnextnAtoms = iprint "Number of atoms:"; nAtoms'atom(133).cat = 1y133 = atom(133).y'---------- Make links ----------i = 0 'to count number of linksfor y = 0 to configFileYsize-1  for x = 0 to configFileXsize-1    a1ptr = @configArray(x,y)    if (a1ptr->cat <> 0) then      for k = 0 to 3        a2ptr = @configArray(x+linkMatrix(k).x, y+linkMatrix(k).y)        if (a1ptr->cat = a2ptr->cat) then          link(i).id1 = a1ptr->id          link(i).id2 = a2ptr->id          link(i).initLength = distAtom(atom(a1ptr->id), atom(a2ptr->id))          i+=1        end if        if (i > MAXLINKS) then          print "Error: Too much links!"          sleep 3000          end(-1)        end if      next    end if  nextnextnLinks = iprint "Number of links:"; nLinks'---------- Setup graphic screen ----------screen 20,,2 '19=800x600 20=1024x768screenset 0, 1screeninfo scrnw, scrnhscrnh1 = scrnh - 1ppm = 7e10 'pixels per meter (1e9 = 1 pixel / nm)color 0,15line (0,0)-(scrnw-1, scrnh-1),15,bf'---------- Plot container ----------'      *--------* . . . wy4'      |        |   |'  *---2        3---4 . wy3''  *---0        1------ wy2'  .   |        |   .'  .   *--------* . . . wy1'  .   .        .   .' wx1 wx2      wx3 wx4 wy1 = angstrom * 2wy2 = wy1 + angstrom * 30wy3 = wy2 + angstrom * 10wy4 = wy3 + angstrom * 30wx1 = angstrom * 5wx2 = wx1 + angstrom * 5wx3 = wx2 + angstrom * 50wx4 = wx3 + angstrom * 7edge(0).x = wx2 - angstrom: edge(0).y = wy2 - angstromedge(1).x = wx3 + angstrom: edge(1).y = wy2 - angstromedge(2).x = wx2 - angstrom: edge(2).y = wy3 + angstromedge(3).x = wx3 + angstrom: edge(3).y = wy3 + angstromedge(4).x = wx4 - angstrom: edge(4).y = wy3 + angstromfor i = 0 to 4  edge(i).r = angstrom  edge(i).cat = 0 'blacknext'pulleyedge(5).x = wx4 + angstrom * 70edge(5).y = wy2 + 3 * angstromedge(5).r = 2 * angstromedge(5).cat = 4'pulley centreedge(6).x = edge(5).xedge(6).y = edge(5).yedge(6).r = angstrom / 3edge(6).cat = 4'pulley weightedge(7).x = edge(5).x + edge(5).redge(7).y = edge(5).y - 20 * angstromedge(7).r = angstrom * 3edge(7).cat = 4'---------- Plot atoms and links ----------for i = 0 to nAtoms-1 plotAtom atom(i)nextfor i = 0 to nLinks-1  plotLink link(i)nextplotWorldscreencopy 0, 1sleep 1000'---------- Run loop ----------startTime = timert = 0: dt = 1e-15 'secondswhile(inkey\$ = "")  'reset forces, add boundaries later  for i = 1 to nAtoms-1    atom(i).Fx = 0    atom(i).Fy = 0  next  atom(0).Fy = -3e-11  atom(0).Fx = 10 * (x0 - atom(0).x)  atom(133).Fx = +5e-11  atom(133).Fy = 1 * (y133 - atom(133).y)  'check collisions with walls  for i = 0 to nAtoms-1    pAtom = @atom(i)        'check collisions in main chamber    if (pAtom->x > edge(0).x) and (pAtom->x < edge(3).x) then      if (pAtom->y < edge(0).y) then        'lower wall wy1        edgeDist = (pAtom->y - pAtom->r) - wy1        if (edgeDist < 0) then pAtom->Fy -= kAtom * edgeDist      end if      if (pAtom->y > edge(3).y) then        'upper wall wy4        edgeDist = wy4 - (pAtom->y + pAtom->r)        if (edgeDist < 0) then pAtom->Fy += kAtom * edgeDist      end if      if (pAtom->y < edge(0).y) or (pAtom->y > edge(3).y) then        'left wall        edgeDist = (pAtom->x - pAtom->r) - wx2        if (edgeDist < 0) then pAtom->Fx -= kAtom * edgeDist        'right wall        edgeDist = wx3 - (pAtom->x + pAtom->r)        if (edgeDist < 0) then pAtom->Fx += kAtom * edgeDist      end if    'check collisions to outside wall (right area)    elseif (pAtom->x > edge(4).x) then      if (pAtom->y > edge(4).y) then        'left wall of right area        edgeDist = (pAtom->x - pAtom->r) - wx4        if (edgeDist < 0) then pAtom->Fx -= kAtom * edgeDist      end if    'check collisions in connecting tubes    else      'upper wall tubes      edgeDist = wy3 - (pAtom->y + pAtom->r)      if (edgeDist < 0) then pAtom->Fy += kAtom * edgeDist    end if        if (pAtom->x < edge(0).x) or (pAtom->x > edge(3).x) then      'lower wall tubes      edgeDist = (pAtom->y - pAtom->r) - wy2      if (edgeDist < 0) then pAtom->Fy -= kAtom * edgeDist    end if        'check collisions with edges 0...3    if (pAtom->y > edge(0).y) and (pAtom->y < edge(3).y) then      'Main chamber      if (pAtom->x > edge(0).x) and (pAtom->x < edge(3).x) then        for j = 0 to 3          edgeDist = distAtom(edge(j), *pAtom) - (pAtom->r + edge(j).r)          if (edgeDist < 0) then            alfa = atan2( pAtom->y - edge(j).y, pAtom->x - edge(j).x )            F = kAtom * edgeDist            pAtom->Fx -= F * cos(alfa)            pAtom->Fy -= F * sin(alfa)          end if        next      end if      'Right area edges 4      if (pAtom->x > edge(4).x) then        edgeDist = distAtom(edge(4), *pAtom) - (pAtom->r + edge(4).r)        if (edgeDist < 0) then          alfa = atan2( pAtom->y - edge(4).y, pAtom->x - edge(4).x )          F = kAtom * edgeDist          pAtom->Fx -= F * cos(alfa)          pAtom->Fy -= F * sin(alfa)        end if      end if    end if  next    'check for collisions between atoms  for i = 0 to nAtoms-1    for j = i+1 to nAtoms-1      'skip same type / category      if (atom(j).cat <> atom(i).cat) then        edgeDist = distAtom(atom(i), atom(j)) - (atom(i).r + atom(j).r)        if(edgeDist < 0) then          alfa = atan2( atom(i).y - atom(j).y, atom(i).x - atom(j).x )          F = kAtom * edgeDist          atom(i).Fx -= F * cos(alfa)          atom(i).Fy -= F * sin(alfa)          atom(j).Fx -= F * cos(alfa+pi)          atom(j).Fy -= F * sin(alfa+pi)        end if      end if    next  next    'go through forces by links  for i = 0 to nLinks-1    id1 = link(i).id1    id2 = link(i).id2    alfa = atan2( atom(id1).y - atom(id2).y, atom(id1).x - atom(id2).x )    F = kLink * (link(i).initLength - distAtom(atom(id1), atom(id2)))    atom(id1).Fx += F * cos(alfa)    atom(id1).Fy += F * sin(alfa)    atom(id2).Fx += F * cos(alfa+pi)    atom(id2).Fy += F * sin(alfa+pi)  next    'Calculate Velocities  for i = 0 to nAtoms-1    atom(i).vy += (atom(i).Fy / atom(i).m) * dt    atom(i).vx += (atom(i).Fx / atom(i).m) * dt  next    'Calculate Positions  for i = 0 to nAtoms-1    atom(i).x += atom(i).vx * dt    atom(i).y += atom(i).vy * dt  next    if (iShow < 10) then    iShow += 1  else    iShow = 0    'screensync    'erase    line (0,0)-(scrnw-1, scrnh-1),15,bf    locate 12,2: print "Starting temperature [K]:"; temperature;    locate 13,2: print "Time [ps]:"; int(t * 1e12);    plotWorld    'draw new positions    for i = 0 to nAtoms-1      plotAtom atom(i)    next    for i = 0 to nLinks-1      plotLink link(i)    next    flipScreen()  end if  'if (int(t * 1e12) > 10.0) then exit while  t += dtwend locate 2,60: print "Time = "; timer - startTimelocate 4,60: print "End!";flipScreen()key = waitForKey()'---------- Subroutines go here ----------sub flipScreen()  static as integer page1 = 0  static as integer page2 = 1  page1 = page1 xor 1  page2 = page2 xor 1  screenset page1, page2end subsub plotWorld()  dim as integer i  'bottom half  plotLine (wx1, wy2, wx2 - angstrom, wy2, 0)  plotLine (wx2, wy2 - angstrom, wx2, wy1, 0)  plotLine (wx2, wy1, wx3, wy1, 0)  plotLine (wx3, wy1, wx3, wy2 - angstrom, 0)  plotLine (wx3 + angstrom, wy2, wx4 + angstrom * 50, wy2, 0)  'top half  plotLine (wx1, wy3, wx2 - angstrom, wy3, 0)  plotLine (wx2, wy3 + angstrom, wx2, wy4, 0)  plotLine (wx2, wy4, wx3, wy4, 0)  plotLine (wx3, wy4, wx3, wy3 + angstrom, 0)  plotLine (wx3 + angstrom, wy3, wx4 - angstrom, wy3, 0)  plotLine (wx4, wy3 + angstrom, wx4, wy4, 0)  'smooth edges  for i = 0 to 4    plotAtom(edge(i))  next  'rod connecting blocker  plotLine (atom(0).x, atom(0).y, x0, y0, atom(0).cat)  'pulley  plotAtom(edge(5))  plotAtom(edge(6))  plotLine (edge(5).x, edge(5).y + edge(5).r, atom(133).x, atom(133).y, edge(5).cat)  '  edge(7).y = edge(5).y - 40 * angstrom + distAtom(edge(5), atom(133))  plotAtom(edge(7))  plotLine (edge(5).x + edge(5).r, edge(5).y, edge(7).x, edge(7).y, edge(5).cat)end subsub plotLine (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)  line(int(x1*ppm+0.5), scrnh1-int(y1*ppm+0.5))_     -(int(x2*ppm+0.5), scrnh1-int(y2*ppm+0.5)), c  #IFDEF THICKLINE  line(int(x1*ppm+1.5), scrnh1-int(y1*ppm+1.5))_     -(int(x2*ppm+1.5), scrnh1-int(y2*ppm+1.5)), c  #ENDIFend subsub plotSquare (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)  line(int(x1*ppm+0.5), scrnh1-int(y1*ppm+0.5))_     -(int(x2*ppm+0.5), scrnh1-int(y2*ppm+0.5)), c, bend subsub plotSquareFilled (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)  line(int(x1*ppm+0.5), scrnh1-int(y1*ppm+0.5))_     -(int(x2*ppm+0.5), scrnh1-int(y2*ppm+0.5)), c, bfend subsub plotlink (l as linkType)  dim as integer x1, y1, x2, y2, c  x1 = (atom(l.id1).x * ppm + 0.5)  y1 = (atom(l.id1).y * ppm + 0.5)  x2 = (atom(l.id2).x * ppm + 0.5)  y2 = (atom(l.id2).y * ppm + 0.5)  c = atom(l.id1).cat 'use lookuptable for color later  line (x1, (scrnh1) - y1) - (x2, (scrnh - 1) - y2), cend subsub plotAtom (a as atomType)  dim as integer x, y, r, c  x = int(a.x * ppm + 0.5)  y = int(a.y * ppm + 0.5)  r = int(a.r * ppm + 0.5)  c = a.cat 'use lookuptable for color later  circle(x, (scrnh1) - y), r, c,',,,f  #IFDEF THICKLINE  circle(x, (scrnh1) - y), r+1, c,',,,f  #ENDIF  'plot force indicator  'plotLine(a.x, a.y, a.x + a.Fx, a.y + a.Fy, c)end subsub plotCircle (x as double, y as double, r as double, c as integer) circle(int(x*ppm+0.5), scrnh1-int(y*ppm+0.5)), int(r*ppm+0.5), c,',,,fend subfunction distAtom(b1 as atomType, b2 as atomType) as double return sqr( (b1.x-b2.x)*(b1.x-b2.x) + (b1.y-b2.y)*(b1.y-b2.y) ) 'return sqr( (b1.x-b2.x)^2 + (b1.y-b2.y)^2 )end functionsub powerMeter(p as double)  dim i, j as integer  dim pRef as double 'W  j = 2  locate 21+j, 80: print "Power indicator";  for i = j to 10    pRef = 10^(-5-i)    locate 23+i,85: print "[W*10^";-5-i;"]";    if (p > pRef) then      line (650-10,355+i*16)-(650+10,355+10+i*16),4,bf    else      line (650-10,355+i*16)-(650+10,355+10+i*16),14,bf      line (650-10,355+i*16)-(650+10,355+10+i*16),4,b    end if  nextend subfunction waitForKey() as string  dim as string key = ""  while key = ""    key = inkey\$  wend  return keyend function`

It needs the file "config.txt" contaning:

Code: Select all

`--------------------------------------------------------7-7-7-7-7-7----------------------------------2-2-2---2---------------------------------------44--7---5-----------------------------------2-44------55-----------------------------------7-333---7---------------------------------------333----------------------------------------44-333----5-------------3----3----------------44-333----55-----------33---33-------------------333----------------333--333---------333333333333333333333333333333333333333-------333333333333333333333333333333333333333-------333333333333333333333333333333333333333-----------------333-------------------------------------------333----2--------------------------------------333---7-7----------------------------------2--333----2------------------------------------7-333---7-7----------------------------------2---6----6---------------------------------------666--666-----------------------------------2-2-6-2--6-------------------------------------7-7-7-7-7-7-------------------------------------------------------------------------------------------------------------------------------------------------------------------`

Only no gravity used currently.
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland
badidea wrote:Spiderweb with dew droplets, i think i have some code which can do that. Lets try...

Nice bit of work, I get 300k temperature.
@Richard
COSH is an important function when towing.
It is assumed that the tow-wire hangs between the tug and tow in a catenery, thus the estimated lowest part of the wire can be calculated.
Tow wire dragging along the seabed is a no no.
@Rollie
This can't compete with Albert's web, or your functionilation of it.
I have simplified rotatepoint2d to the point that I'm surprised it still works.
Must nip back over to community discussion to see if there are any more fors.
I've nearly done the polygons.

Code: Select all

`'WEBtype point2d    as double x,y    end typefunction rotatepoint2d(pivot As point2d,_                         _point as point2d,_                          angle As Double,_                        dilator as double=1) as point2d      Dim pi As Double=4*Atn(1)     #define rad *pi/180dim as point2d npnp.x=dilator*(Cos(angle rad)*(_point.x-pivot.x)-Sin(angle rad)*(_point.y-pivot.y)) +pivot.xnp.y=dilator*(Sin(angle rad)*(_point.x-pivot.x)+Cos(angle rad)*(_point.y-pivot.y)) +pivot.yreturn npEnd functiondim as integer xres,yresscreeninfo xres,yresscreenres xres,yres,32dim as point2d piv,pt,tempdim as double dil,k=1piv.x=xres/2piv.y=yres/2pt.x=piv.x+yres/4pt.y=piv.ydim pi as double=4*atn(1)#define rad *pi/180for z as double=1 to 6000 step 1    if z mod 30=0 then        line(piv.x,piv.y)-(piv.x+1.5*piv.x*cos(z rad),piv.y+1.5*piv.y*sin(z rad)),rgb(100,100,100)        end if    if z mod 30=0 then k=-1.5*.001*z    if z mod 60=0 then k=2.5*.001*z    dil=dil+k*.001 temp= rotatepoint2d(piv,pt,z,dil) pset(temp.x,temp.y) if z mod 25=0 then circle(temp.x,temp.y),2,rgb(200,200,200),,,,F 'dew?next zsleep`
Posts: 2149
Joined: May 24, 2007 22:10
Location: The Netherlands

### spiderweb

Ok, this looks like one thread in a web with (atomic sized) dew droplets and gravity:

Code: Select all

`#lang "fblite"OPTION EXPLICITOPTION BYVAL#Define MAXATOMS 40#Define MAXLINKS 1000#Define THICKLINE 1const g as double = 9.81 'm/s^2const kAtom as double = 5 'N/mconst kLink as double = 20 / 1000 'N/mconst pi as double = 3.14159265359const atomicMass as double = 1.66e-27 * 10 'kgconst mArgon as double = 4 '39.95 'no unitconst mArgonMol as double = mArgon / 1000.0 'kg/molconst angstrom as double = 1e-10 'mconst rArgon as double =  100e-12 '98e-12const univGasConst as double = 8.314 'J/mol Kconst mol as double = 6.02e+23 'particlesconst dIron as double = 2.28 * angstrom 'mconst mIron as double = 55.85 'no unittype atomType rho as double 'kg/m^3 r as double m as double x as double y as double vx as double vy as double Fx as double Fy as double Cat as integerend typetype linkType  id1 as integer  id2 as integer  initLength as doubleend typetype configType  Id as integer  Cat as integerend typetype xyType  x as integer  y as integerend typedeclare sub flipScreen()declare sub plotLine (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)declare sub plotAtom (atom as atomType)declare sub plotlink (link as linkType)declare function distAtom(b1 as atomType, b2 as atomType) as doubledeclare function waitForKey() as stringdim as integer i, j, k, x, y, filedim as string configText, configChardim as configType configArray(100,100)dim as configType ptr a1ptr, a2ptrdim as integer configFileXsize, configFileYsizedim as double volume, temperature, vAverage, alfadim shared as atomType atom(MAXATOMS)dim as atomType ptr pAtomdim shared as linkType link(MAXLINKS)dim as integer nAtoms, nLinks, id1, id2, iShow = 0dim shared as integer scrnw, scrnh, scrnh1 'in pixelsdim shared as double ppm 'pixels per meterdim as double t,dtdim as string keydim as double F, edgeDistdim as xyType linkMatrix(4)dim as double startTime'---------- Program starts here ----------linkMatrix(0).x = +1: linkMatrix(0).y = 0linkMatrix(1).x = -1: linkMatrix(1).y = +1linkMatrix(2).x = 0:  linkMatrix(2).y = +1linkMatrix(3).x = +1: linkMatrix(3).y = +1'---------- From file to 2d-array ----------j = 0file = freefileopen "config.txt" for input as #filewhile not eof(file)  input #file, configText  for i = 1 to len(configText)    configChar = mid(configText,i,1)    if configChar = "-" then      configArray(i,j).cat = 0      print ".";    else      configArray(i,j).cat = val(configChar)      print str(configArray(i,j).cat);    end if  next  print  j+=1wendconfigFileXsize = len(configText)configFileYsize = jclose fileprint "configFileXsize:"; configFileXsizeprint "configFileYsize:"; configFileYsizerandomize timertemperature = 3 'Ki = 0 'to count number of balls / atomsfor y = 0 to configFileYsize-1  for x = 0 to configFileXsize-1    if (configArray(x,y).cat <> 0) then      configArray(x,y).id = i      atom(i).cat = configArray(x,y).cat      atom(i).r = rArgon      atom(i).m = mArgon * atomicMass      if (atom(i).cat = 3) then atom(i).m /= 20      volume = 1.25 * pi * atom(i).r ^ 3      atom(i).rho = atom(i).m / volume      atom(i).x = (x - 3) * 3 * angstrom      atom(i).y = (((configFileYsize - 1) - y) + 0) * 3 * angstrom - angstrom * 2      vAverage = sqr((3 * univGasConst * temperature) / mArgonMol)      alfa = rnd(1) * 2 * pi      atom(i).vx = cos(alfa) * vAverage      atom(i).vy = sin(alfa) * vAverage      atom(i).Fx = 0      atom(i).Fy = 0      i+=1    end if    if (i > MAXATOMS) then      print "Error: Too much atoms!"      sleep 3000      end(-1)    end if  nextnextnAtoms = iprint "Number of atoms:"; nAtoms'---------- Make links ----------i = 0 'to count number of linksfor y = 0 to configFileYsize-1  for x = 0 to configFileXsize-1    a1ptr = @configArray(x,y)    if (a1ptr->cat <> 0) then      for k = 0 to 3        a2ptr = @configArray(x+linkMatrix(k).x, y+linkMatrix(k).y)        if (a1ptr->cat = a2ptr->cat) then          link(i).id1 = a1ptr->id          link(i).id2 = a2ptr->id          link(i).initLength = distAtom(atom(a1ptr->id), atom(a2ptr->id))          i+=1        end if        if (i > MAXLINKS) then          print "Error: Too much links!"          sleep 3000          end(-1)        end if      next    end if  nextnextnLinks = i+1print "Number of links:"; nLinks'---------- Setup graphic screen ----------screen 20,,2 '19=800x600 20=1024x768screenset 0, 1screeninfo scrnw, scrnhscrnh1 = scrnh - 1ppm = 7e10 'pixels per meter (1e9 = 1 pixel / nm)color 0,15line (0,0)-(scrnw-1, scrnh-1),15,bf'---------- Plot atoms and links ----------for i = 0 to nAtoms-1  plotAtom atom(i)nextfor i = 0 to nLinks-1  plotLink link(i)nextscreencopy 0, 1sleep 1000atom(0).vx = 0atom(0).vy = 0atom(nLinks-1).vx = 0atom(nLinks-1).vy = 0'---------- Run loop ----------startTime = timert = 0: dt = 1e-14 'secondswhile(inkey\$ = "")  'reset forces, add boundaries later  for i = 0 to nAtoms-1    atom(i).Fx = 0    atom(i).Fy = atom(i).m * -g * 1e13  next  'check for collisions between atoms  for i = 0 to nAtoms-1    for j = i+1 to nAtoms-1      'skip same type / category      if (atom(j).cat <> atom(i).cat) then        edgeDist = distAtom(atom(i), atom(j)) - (atom(i).r + atom(j).r)        if(edgeDist < 0) then          alfa = atan2( atom(i).y - atom(j).y, atom(i).x - atom(j).x )          F = kAtom * edgeDist          atom(i).Fx -= F * cos(alfa)          atom(i).Fy -= F * sin(alfa)          atom(j).Fx -= F * cos(alfa+pi)          atom(j).Fy -= F * sin(alfa+pi)        end if      end if    next  next    'go through forces by links  for i = 0 to nLinks-1    id1 = link(i).id1    id2 = link(i).id2    alfa = atan2( atom(id1).y - atom(id2).y, atom(id1).x - atom(id2).x )    F = kLink * (link(i).initLength - distAtom(atom(id1), atom(id2)))    atom(id1).Fx += F * cos(alfa)    atom(id1).Fy += F * sin(alfa)    atom(id2).Fx += F * cos(alfa+pi)    atom(id2).Fy += F * sin(alfa+pi)  next    'add friction  for i = 0 to nLinks-1    atom(i).Fx -= atom(i).vx / 1e15    atom(i).Fy -= atom(i).vy / 1e15  next  atom(0).Fx = 0  atom(0).Fy = 0  atom(nLinks-1).Fx = 0  atom(nLinks-1).Fy = 0  'Calculate Velocities  for i = 0 to nAtoms-1    atom(i).vy += (atom(i).Fy / atom(i).m) * dt    atom(i).vx += (atom(i).Fx / atom(i).m) * dt  next    'Calculate Positions  for i = 0 to nAtoms-1    atom(i).x += atom(i).vx * dt    atom(i).y += atom(i).vy * dt  next    if (iShow < 10) then    iShow += 1  else    iShow = 0    'screensync    'erase    line (0,0)-(scrnw-1, scrnh-1),15,bf    locate 12,2: print "Starting temperature [K]:"; temperature;    locate 13,2: print "Time [ps]:"; int(t * 1e12);    'draw new positions    for i = 0 to nAtoms-1      plotAtom atom(i)    next    for i = 0 to nLinks-1      plotLink link(i)    next    flipScreen()    sleep 1,1  end if  'if (int(t * 1e12) > 10.0) then exit while  t += dtwend locate 2,60: print "Time = "; timer - startTimelocate 4,60: print "End!";flipScreen()key = waitForKey()'---------- Subroutines go here ----------sub flipScreen()  static as integer page1 = 0  static as integer page2 = 1  page1 = page1 xor 1  page2 = page2 xor 1  screenset page1, page2end subsub plotLine (x1 as double, y1 as double, x2 as double, y2 as double, c as integer)  line(int(x1*ppm+0.5), scrnh1-int(y1*ppm+0.5))_     -(int(x2*ppm+0.5), scrnh1-int(y2*ppm+0.5)), c  #IFDEF THICKLINE  line(int(x1*ppm+1.5), scrnh1-int(y1*ppm+1.5))_     -(int(x2*ppm+1.5), scrnh1-int(y2*ppm+1.5)), c  #ENDIFend subsub plotlink (l as linkType)  dim as integer x1, y1, x2, y2, c  x1 = (atom(l.id1).x * ppm + 0.5)  y1 = (atom(l.id1).y * ppm + 0.5)  x2 = (atom(l.id2).x * ppm + 0.5)  y2 = (atom(l.id2).y * ppm + 0.5)  c = atom(l.id1).cat 'use lookuptable for color later  line (x1, (scrnh1) - y1) - (x2, (scrnh - 1) - y2), cend subsub plotAtom (a as atomType)  dim as integer x, y, r, c  x = int(a.x * ppm + 0.5)  y = int(a.y * ppm + 0.5)  r = int(a.r * ppm + 0.5)  c = a.cat 'use lookuptable for color later  circle(x, (scrnh1) - y), r, c,',,,f  #IFDEF THICKLINE  circle(x, (scrnh1) - y), r+1, c,',,,f  #ENDIF  'plot force indicator  'plotLine(a.x, a.y, a.x + a.Fx, a.y + a.Fy, c)end subfunction distAtom(b1 as atomType, b2 as atomType) as double  return sqr( (b1.x-b2.x)*(b1.x-b2.x) + (b1.y-b2.y)*(b1.y-b2.y) )end functionfunction waitForKey() as string  dim as string key = ""  while key = ""    key = inkey\$  wend  return keyend function`

which now needs this as "config.txt":

Code: Select all

`------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------333333333333----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------`

BTW, the previous example was a simulation of a brownian ratchet: http://en.wikipedia.org/wiki/Brownian_ratchet
The 300K is define in the code, try increasing it and it goes berserk.