Main Menu

Make Cogs - Shapes Example

Started by kevin, February 27, 2023, 09:50:53 PM

Previous topic - Next topic

kevin

Make Cogs - Shapes Example

 Here's a cool old example that you'll find deep inside the PlayBASIC example packs





PlayBASIC Code: [Select]
; PROJECT : Make_Cogs
; AUTHOR : Kevin Picone
; CREATED : 11/04/2006
; EDITED : 21/06/2006
; ---------------------------------------------------------------------



Cog=Create_Cog_Shape(100,80,23)


ScreenCX=GetScreenWidth()/2
ScreenCY=GetScreenHeight()/2

ShapeColour=rgb(255,255,255)

TestShape =newconvexshape(200,4)
TestShape2 =newconvexshape(100,4)
mergeshape testshape2,testshape


Do

cls rgb(100,100,100)

mx=mousex()
my=mousey()
dx#=ScreencX-mx
dy#=ScreencY-mY
lockbuffer

ShadowX#=ScreenCX+(dx#/2)
ShadowY#=ScreenCY+(dy#/2)

ink rgbfade(shapecolour,20)
rotateshape cog,angle#,2

DrawShape Cog,ShadowX#,ShadowY#,2

; draw the foreground version of the spinning cog shape
rotateshape cog,angle#,1
ink ShapeCOlour
inkmode 1

DrawShape cog,ScreenCX,ScreenCY,2
unlockbuffer

; bump the rotation angle
angle#=wrapangle(angle#,1)

sync
loop




Function Create_Cog_Shape(outterRadius,InnerRadius,sides)
sides=sides -(mod(sides,2))
EdgeCount =Sides*2
VertexCount =Sides*2
ThisShape =NewShape(VertexCount+1,EdgeCount+1)

For lp=0 to sides
x#=Cosradius(angle#,OutterRadius)
y#=Sinradius(angle#,OutterRadius)
SetshapeVertex thisshape,Numberofvertex,x#,y#
inc Numberofvertex
x#=Cosradius(angle#,InnerRadius)
y#=Sinradius(angle#,InnerRadius)
SetshapeVertex Thisshape,Numberofvertex,x#,y#
inc Numberofvertex
angle#=angle#+(360.0/Sides)
next


For Vertex=0 to Numberofvertex-2 step 2
NextVertex=vertex+1
if NextVertex=>Numberofvertex then nextVertex=Numberofvertex-NextVertex
SetshapeEdge Thisshape,Edge,vertex,Nextvertex
inc edge

if Outline
SrcVertex=Vertex
NextVertex2=vertex+2
if NextVertex2=>Numberofvertex then nextVertex2=Numberofvertex-NextVertex
else
SrcVertex=NextVertex
NextVertex2=vertex+3
if NextVertex2=>Numberofvertex then nextVertex2=Numberofvertex-NextVertex
endif

SetshapeEdge Thisshape,Edge,Srcvertex,Nextvertex2
inc edge

Outline=1-Outline
next

EndFunction ThisShape