Code archives/Graphics/Catmull perimeter
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Use the space bar to generate a new random perimeter and then drag any control point with the left mouse button. | |||||
'Catmull perimeter 'By Thomas Stevenson 'war-game-programming.com 'Adapted from code by ImaginaryHuman which was 'Adapted from code by Warpy and Matt McFarland Type Point Field x:Int Field y:Int End Type Const Accuracy:Double=0.05 'Lower has more line segments SeedRnd(MilliSecs()) 'Different each time SetGraphicsDriver GLMax2DDriver() Graphics 800,600,0 SetBlend LIGHTBLEND Local ControlPoint:Int Local Counter:Int glEnable(GL_LINE_SMOOTH) 'Quick antaliasing hack glHint(GL_LINE_SMOOTH_HINT,GL_NICEST) glLineWidth(3.0) Local NumPoints=Rand(4,30) Local Points:Point[]=Catmull_Create(NumPoints) Repeat Cls If MouseDown(1) 'check for point drag ControlPoint=Catmull_Find(Points) If ControlPoint 'Catmull_Find() returns NumPoints for point 0 ControlPoint=ControlPoint Mod NumPoints 'if non 0 then mouse is near (+/-7) of a control point Points[ControlPoint].x=MouseX() Points[ControlPoint].y=MouseY() EndIf EndIf 'Draw segments Counter=Catmull_Draw(Points,$00FFFFFF) 'Info text DrawText "Control Points: "+String(NumPoints),10,5 DrawText "Segiments (cps/0.05): "+String(Counter),10,20 DrawText "Curves (=cps): "+String(NumPoints),10,35 DrawText "Spacebar: New random shape",550,10 DrawText "Escape: Exit",550,30 DrawText "Left Mouse: Drag points",550,50 Catmull_Info(Points,60) Flip If KeyHit(KEY_SPACE) NumPoints=Rand(7,30) Points=Catmull_Create(NumPoints) 'returns array of point types EndIf If KeyHit(KEY_ESCAPE) Then Exit If AppTerminate() Then Exit Forever End Function Catmull_Draw(p:Point[],clr) Local PrevX:Double,PrevY:Double Local bytes:Byte Ptr = Varptr clr SetColor bytes[2],bytes[1],bytes[0] Local CM_Counter=0 'Accuracy = constant set by Main a:Double=0.5 For i=1 To p.length 'calc indexs of four control points for curve from i to i+1 'wrap index if Sj>=p.length s0=(i-1); s1=(i+0) Mod p.length; s2=(i+1) Mod p.length; s3=(i+2) Mod p.length For T:Double=0 To 1 Step Accuracy x:Double=a*( (2*p[S1].x)+(p[S2].x-p[S0].x)*T.. +(2*p[S0].x-5*p[S1].x+4*p[S2].x-p[S3].x)*T*T.. +(3*p[S1].x-p[S0].x-3*p[S2].x+p[S3].x) *T*T*T) Y:Double=a*( (2*p[S1].y)+(p[S2].y-p[S0].y)*T +(2*p[S0].y-5*p[S1].y+4*p[S2].y-p[S3].y)*T*T +(3*p[S1].y-p[S0].y-3*p[S2].y+p[S3].y) *T*T*T) If PrevX=0 And PrevY=0 PrevX=X; PrevY=Y EndIf DrawLine PrevX,PrevY,X,Y,False PrevX=X; PrevY=Y CM_Counter:+1 Next Next Return CM_Counter End Function Function Catmull_Create:Point[](np,r1=80,r2=230) Local Pts:Point[]=New Point[np] For p:Int=0 To np-1 Local deg:Int=P*(360/np) Mod 360 Pts[p]=New Point Local h=Rand(r1,r2) Pts[p].x=400+h*Cos(deg) Pts[p].y=300+h*Sin(deg) Next Return Pts End Function Function Catmull_Info(p:Point[],y) 'Draw controls excluding duplicates For i=0 To p.length-1 SetColor $88,$88,$88 'mark the point DrawLine p[i].x-7,p[i].y-7,p[i].x+7,p[i].y+7 DrawLine p[i].x-7,p[i].y+7,p[i].x+7,p[i].y-7 SetColor 255,0,0 'point number DrawText i,p[i].x+5,p[i].y+5 SetColor 255,255,255 'xy info DrawText RSet(i,3)+RSet(P[i].x,6)+RSet(P[i].y,6),10,y+i*15 Next End Function Function Catmull_Find(p:Point[]) 'Point 0= Point n If InsideRect(MouseX(),MouseY(),p[0].x-7,p[0].y-7,14,14) Then Return p.length For i=1 To p.length-1 If InsideRect(MouseX(),MouseY(),p[i].x-7,p[i].y-7,14,14) Then Return i Next 'Not found Return 0 End Function Function InsideRect(x,y,x2,y2,w,h) If x<x2 Then Return False If x>(x2+w) Then Return False If y<y2 Then Return False If y>(y2+h) Then Return False Return True End Function |
Comments
None.
Code Archives Forum