Shapes in FreeBasic

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
NorbyDroid
Posts: 93
Joined: May 21, 2016 22:55

Shapes in FreeBasic

Post by NorbyDroid »

Would ya like to draw some shapes like Hearts, Pentagons, Heptagons, Hexagons, Octagons, Rhombus, and Stars?

Here is some code do do just that. Lets see if we can come up with even more shapes.

Each shape routine starts with the word Draw and the name of the shape (even shape is a routine). The options are position (x,y) and the size to draw it at. Can this be improved?

I hope ya enjoy the shaping adventure.

Code: Select all

#include "fbgfx.bi"

Const pi=3.14159265
Const Radian=pi/180

Const ScreenWidth=160
Const ScreenHeight=120

Sub DrawHeart(xPos As Integer,yPos As Integer,Size As Single)
  For t as Single= 0 To 2*pi Step 0.01
    Dim As Integer x=xPos+CInt(Size*16*Sin(t)^3)
    Dim As Integer y=yPos-CInt(Size*(13*Cos(t)-5*Cos(2*t)-2*Cos(3*t)-Cos(4*t)))

    PSet (x,y),RGB(255,0,0)
  Next
End Sub

Sub DrawHeptagon(xPos As Integer,yPos As Integer,Size As Integer)
  Dim As Single Angle,nextAngle
  Dim As Integer Vertices(7,2)

  For Hept as Integer= 0 To 6
    Angle=(Hept*2*pi)/7

    Vertices(Hept+1,1)=xPos+Cos(angle)*Size
    Vertices(Hept+1,2)=yPos+Sin(angle)*Size
  Next

  For Hept as Integer= 1 To 7
    Line (Vertices(Hept,1),Vertices(Hept,2))-(Vertices((Hept Mod 7)+1,1),Vertices((Hept Mod 7)+1,2)),RGB(255,255,255)
  Next
End Sub

Sub DrawHexagon(xPos As Integer,yPos As Integer,Size As Integer)
  Dim As Integer x(5),y(5)

  For Hexa As Integer= 0 To 5
    x(Hexa)=xPos+Size*Cos((Hexa*60)*Radian)
    y(Hexa)=yPos+Size*Sin((Hexa*60)*Radian)
  Next

  For Hexa As Integer= 0 To 5
    Line (x(Hexa),y(Hexa))-(x((Hexa+1) Mod 6),y((Hexa+1) Mod 6)),RGB(255,255,255)
  Next
End Sub

Sub DrawOctagon(xPos as Integer,yPos as Integer,Size as Integer)
  For Octagon as Integer= 0 To 7
    Dim As Single Angle=Octagon*(2*pi/8)
        
    Dim As Single x1=xPos+Cos(Angle)*Size
    Dim As Single y1=yPos+Sin(Angle)*Size

    Angle=(Octagon+1)*(2*pi/8)
    Dim As Single x2=xPos+Cos(Angle)*Size
    Dim As Single y2=yPos+Sin(Angle)*Size

    Line (x1,y1)-(x2,y2),RGB(255,255,255)
  Next 
End Sub

Sub DrawPentagon(xPos As Integer,yPos As Integer,size As Single)
  Dim As Single Radius=Size
  Dim as Integer angleOffset=0,numVertices=5
  Dim As Single x(numVertices-1),y(numVertices-1)

  For Pentagon As Integer=0 To numVertices-1
    Dim As Single Angle=(360/numVertices)*Pentagon+angleOffset
    x(Pentagon)=xPos+Radius*Cos(Angle*Radian)
    y(Pentagon)=yPos-Radius*Sin(Angle*Radian)
  Next

  For Pentagon As Integer=0 To numVertices-1
    Line (x(Pentagon),y(Pentagon))-(x((Pentagon+1) Mod numVertices),y((Pentagon+1) Mod numVertices)),RGB(255,255,255)
  Next
End Sub

Sub DrawRhombus(xPos As Integer,yPos As Integer,Size As Integer)
  Dim as Integer x1=xPos,y1=yPos-Size
  Dim as Integer x2=xPos + Size,y2=yPos
  Dim as Integer x3=xPos,y3=yPos + Size
  Dim as Integer x4=xPos-Size,y4=yPos
    
  Line (x1,y1)-(x2,y2),RGB(255,255,255)
  Line (x2,y2)-(x3,y3),RGB(255,255,255)
  Line (x3,y3)-(x4,y4),RGB(255,255,255)
  Line (x4,y4)-(x1,y1),RGB(255,255,255)
End Sub

Sub DrawShape(xPos as Integer,yPos as Integer,Size as Integer)
  Dim Points(23) as Double

  For Shape As Integer=0 to 4
    Points(Shape*2)=xPos+COS((Shape*2*pi)/5)*Size
    Points(Shape*2+1)=yPos-SIN((Shape*2*pi)/5)*Size
    Points(Shape*2+10)=xPos+COS(((Shape*2+1)*pi)/5)*(Size*0.5)
    Points(Shape*2+11)=yPos-SIN(((Shape*2+1)*pi)/5)*(Size*0.5)
  Next

  For Shape As Integer=0 To 4
    Line (Points(Shape*2),Points(Shape*2+1))-(Points(((Shape+1) Mod 5)*2),Points(((Shape+1) Mod 5)*2+1)),RGB(255,255,255)
    Line (Points(Shape*2),Points(Shape*2+1))-(Points(Shape*2+10),Points(Shape*2+11)),RGB(255,255,255)
    Line (Points(Shape*2+10),Points(Shape*2+11))-(Points(((Shape+1) Mod 5)*2+10),Points(((Shape+1) Mod 5)*2+11)),RGB(255,255,255)
  Next
End Sub

Sub DrawStar(xPos as Integer,yPos as Integer,Size as Integer)
  Dim Points(23) as Double
    
  Dim rotationOffset as Double=-pi/2
    
  For Star As Integer=0 to 4
    Points(Star*2)=xPos+COS((Star*2*pi)/5-rotationOffset)*Size
    Points(Star*2+1)=yPos-SIN((Star*2*pi)/5-rotationOffset)*Size
    Points(Star*2+10)=xPos+COS(((Star*2+1)*pi)/5-rotationOffset)*(Size*0.5)
    Points(Star*2+11)=yPos-SIN(((Star*2+1)*pi)/5-rotationOffset)*(Size*0.5)
  Next

  For Star As Integer = 0 To 4
    Line (Points(Star*2),Points(Star*2+1))-(Points(Star*2+10),Points(Star*2+11)),RGB(255,255,255)
    Line (Points(Star*2+10),Points(Star*2+11))-(Points(((Star+1) Mod 5)*2),Points(((Star+1) Mod 5)*2+1)),RGB(255,255,255)
  Next
End Sub

ScreenRes ScreenWidth,ScreenHeight,32

'DrawHeart(ScreenWidth\2,ScreenHeight\2,2)
'DrawPentagon(ScreenWidth\2,ScreenHeight\2,32)
'DrawHeptagon(ScreenWidth\2,ScreenHeight\2,32)
'DrawHexagon(ScreenWidth\2,ScreenHeight\2,32)
'DrawOctagon(ScreenWidth\2,ScreenHeight\2,32)
'DrawRhombus(ScreenWidth\2,ScreenHeight\2,16)
'DrawShape(ScreenWidth\2,ScreenHeight\2,32)
'DrawStar(ScreenWidth\2,ScreenHeight\2,32)
Sleep
RetardedAndProud
Posts: 36
Joined: Jun 09, 2024 18:26

Re: Shapes in FreeBasic

Post by RetardedAndProud »

Plugin to @NorbyDroid code.

Code: Select all

Sub DrawLeaf(xPos as Integer,yPos as Integer,Size as Integer)
  yPos += Size * 2
  For t As Single = 0 To 2 * pi Step 0.0001
    Dim As Double r = (1 + 0.9 * Cos( 8 * t)) * _
                      (1 + 0.1 * Cos(24 * t)) * _
                      (0.9 + 0.1 * Cos(200 * t)) * _
                      (1 + Sin(t))
    Dim As Integer x = Sin(t) * Size * r
    Dim As Integer y = Cos(t) * Size * r
    ' Rotate to point upwards
    Dim As Integer nx = xPos + CInt(x * Cos(90 * Radian) - y * Sin(90 * Radian))
    Dim As Integer ny = yPos - CInt(x * Sin(90 * Radian) + y * Cos(90 * Radian))

    PSet (nx, ny), RGB(CInt(Rnd * 255), CInt(Rnd * 255), CInt(Rnd * 255))
  Next
End Sub
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Shapes in FreeBasic

Post by Roland Chastain »

Not sure that a horse is a shape, but here you are.

Code: Select all

Sub DrawHorse(xPos As Integer,yPos As Integer,Size As Single)

  ' https://www.freebasic-portal.de/code-beispiele/grafik-und-fonts/fb-pferd-in-freebasic-zeichen-8.html

  Type TPoint
    x as single
    y as single
  End Type

  Dim POINTS1(1 to 419) as const TPoint = { _
    (05.296, 01.649), _
    (05.595, 01.855), _
    (05.913, 02.028), _
    (06.233, 02.194), _
    (06.541, 02.384), _
    (06.733, 02.576), _
    (06.906, 02.851), _
    (07.060, 03.190), _
    (07.197, 03.573), _
    (07.317, 03.981), _
    (07.423, 04.397), _
    (07.516, 04.800), _
    (07.597, 05.173), _
    (07.668, 05.496), _
    (07.729, 05.751), _
    (07.782, 05.918), _
    (07.815, 05.974), _
    (07.876, 06.075), _
    (07.981, 06.274), _
    (08.143, 06.622), _
    (08.373, 07.172), _
    (08.686, 07.976), _
    (08.960, 08.571), _
    (09.034, 08.733), _
    (08.830, 08.824), _
    (08.392, 08.659), _
    (07.954, 08.508), _
    (07.784, 08.487), _
    (07.601, 08.471), _
    (07.395, 08.460), _
    (07.153, 08.453), _
    (06.867, 08.449), _
    (06.116, 08.449), _
    (05.630, 08.451), _
    (05.057, 08.452), _
    (04.384, 08.453), _
    (04.144, 08.119), _
    (03.980, 07.715), _
    (04.065, 07.361), _
    (04.215, 07.044), _
    (04.420, 06.761), _
    (04.668, 06.505), _
    (04.948, 06.271), _
    (05.250, 06.055), _
    (05.562, 05.850), _
    (05.778, 05.645), _
    (06.015, 05.478), _
    (06.421, 05.367), _
    (06.742, 05.271), _
    (06.921, 05.178), _
    (07.105, 04.836), _
    (07.123, 04.472), _
    (07.005, 04.183), _
    (06.803, 03.964), _
    (06.641, 03.871), _
    (06.487, 03.890), _
    (06.309, 04.005), _
    (06.077, 04.200), _
    (05.758, 04.459), _
    (05.321, 04.768), _
    (04.735, 05.110), _
    (04.641, 05.211), _
    (04.445, 05.452), _
    (04.177, 05.794), _
    (03.868, 06.198), _
    (03.548, 06.624), _
    (03.246, 07.033), _
    (02.993, 07.387), _
    (02.819, 07.644), _
    (02.753, 07.767), _
    (02.774, 08.165), _
    (02.859, 08.538), _
    (03.020, 08.867), _
    (03.272, 09.131), _
    (03.625, 09.311), _
    (04.420, 09.563), _
    (05.023, 09.750), _
    (05.461, 09.885), _
    (05.756, 09.979), _
    (05.933, 10.040), _
    (06.017, 10.090), _
    (06.032, 10.140), _
    (05.946, 10.470), _
    (05.873, 10.810), _
    (05.830, 11.140), _
    (05.835, 11.460), _
    (05.904, 11.790), _
    (06.054, 12.120), _
    (06.226, 12.400), _
    (06.409, 12.670), _
    (06.591, 12.950), _
    (06.763, 13.240), _
    (06.912, 13.530), _
    (07.030, 13.850), _
    (07.101, 14.260), _
    (07.094, 14.700), _
    (07.023, 15.130), _
    (06.902, 15.510), _
    (06.747, 15.810), _
    (06.570, 15.970), _
    (06.403, 15.930), _
    (06.092, 15.770), _
    (05.735, 15.550), _
    (05.431, 15.310), _
    (05.277, 15.100), _
    (05.174, 14.540), _
    (05.157, 14.260), _
    (05.122, 14.130), _
    (04.885, 13.950), _
    (04.557, 13.890), _
    (04.191, 13.920), _
    (03.841, 14.020), _
    (03.559, 14.170), _
    (03.428, 14.300), _
    (03.353, 14.480), _
    (03.322, 14.740), _
    (03.318, 15.080), _
    (03.326, 15.520), _
    (03.332, 16.100), _
    (03.530, 16.370), _
    (03.655, 16.700), _
    (03.728, 17.090), _
    (03.771, 17.500), _
    (03.805, 17.900), _
    (03.853, 18.270), _
    (03.934, 18.590), _
    (04.072, 18.810), _
    (04.357, 19.060), _
    (04.706, 19.310), _
    (05.085, 19.520), _
    (05.459, 19.680), _
    (05.794, 19.750), _
    (06.056, 19.710), _
    (06.208, 19.540), _
    (06.733, 19.540), _
    (07.059, 19.540), _
    (07.265, 19.540), _
    (07.431, 19.540), _
    (07.637, 19.540), _
    (07.963, 19.540), _
    (08.488, 19.540), _
    (08.782, 19.390), _
    (09.234, 19.250), _
    (09.553, 19.080), _
    (09.893, 18.880), _
    (10.230, 18.650), _
    (10.560, 18.420), _
    (10.840, 18.190), _
    (11.070, 17.990), _
    (11.230, 17.820), _
    (11.700, 17.160), _
    (11.970, 16.690), _
    (12.110, 16.370), _
    (12.150, 16.170), _
    (12.150, 16.050), _
    (12.170, 15.980), _
    (12.350, 15.740), _
    (12.570, 15.550), _
    (12.820, 15.420), _
    (13.100, 15.330), _
    (13.400, 15.280), _
    (13.730, 15.270), _
    (14.070, 15.280), _
    (14.430, 15.330), _
    (14.800, 15.390), _
    (15.180, 15.470), _
    (15.560, 15.560), _
    (15.950, 15.650), _
    (16.330, 15.750), _
    (16.710, 15.840), _
    (17.080, 15.920), _
    (17.450, 15.990), _
    (17.790, 16.030), _
    (18.040, 16.040), _
    (18.310, 16.040), _
    (18.630, 16.010), _
    (18.980, 15.960), _
    (19.390, 15.890), _
    (19.860, 15.800), _
    (20.180, 15.740), _
    (20.450, 15.700), _
    (20.700, 15.690), _
    (20.940, 15.720), _
    (21.190, 15.800), _
    (21.470, 15.930), _
    (21.810, 16.130), _
    (22.210, 16.410), _
    (22.700, 16.770), _
    (23.010, 16.960), _
    (23.330, 17.080), _
    (23.660, 17.150), _
    (23.990, 17.170), _
    (24.330, 17.130), _
    (24.660, 17.040), _
    (24.980, 16.910), _
    (25.280, 16.730), _
    (25.560, 16.510), _
    (25.800, 16.300), _
    (25.950, 16.120), _
    (26.040, 15.890), _
    (26.120, 15.490), _
    (26.210, 14.830), _
    (26.270, 14.420), _
    (26.320, 14.030), _
    (26.370, 13.660), _
    (26.390, 13.300), _
    (26.380, 12.940), _
    (26.330, 12.580), _
    (26.290, 12.470), _
    (26.200, 12.280), _
    (26.080, 12.030), _
    (25.930, 11.740), _
    (25.750, 11.400), _
    (25.550, 11.030), _
    (25.340, 10.650), _
    (25.120, 10.270), _
    (24.900, 09.897), _
    (24.680, 09.544), _
    (24.480, 09.224), _
    (24.300, 08.949), _
    (24.140, 08.731), _
    (23.850, 08.298), _
    (23.660, 07.941), _
    (23.530, 07.660), _
    (23.420, 07.457), _
    (23.290, 07.331), _
    (23.290, 06.946), _
    (23.300, 06.569), _
    (23.310, 06.198), _
    (23.340, 05.830), _
    (23.380, 05.501), _
    (23.300, 05.389), _
    (23.050, 05.526), _
    (22.840, 05.731), _
    (22.680, 05.993), _
    (22.560, 06.302), _
    (22.480, 06.647), _
    (22.430, 07.017), _
    (22.410, 07.401), _
    (22.410, 07.788), _
    (22.440, 08.166), _
    (22.480, 08.526), _
    (22.540, 08.856), _
    (22.600, 09.146), _
    (22.700, 09.459), _
    (22.830, 09.787), _
    (22.990, 10.120), _
    (23.160, 10.460), _
    (23.330, 10.790), _
    (23.480, 11.110), _
    (23.620, 11.400), _
    (23.730, 11.660), _
    (23.800, 11.890), _
    (23.850, 12.260), _
    (23.880, 12.640), _
    (23.860, 13.020), _
    (23.810, 13.390), _
    (23.720, 13.730), _
    (23.590, 14.050), _
    (23.410, 14.320), _
    (23.190, 14.540), _
    (22.920, 14.690), _
    (22.620, 14.790), _
    (22.300, 14.850), _
    (21.970, 14.880), _
    (21.640, 14.880), _
    (21.310, 14.880), _
    (20.980, 14.870), _
    (21.110, 14.550), _
    (21.250, 14.230), _
    (21.390, 13.900), _
    (21.520, 13.580), _
    (21.640, 13.250), _
    (21.740, 12.920), _
    (21.810, 12.590), _
    (21.850, 12.260), _
    (21.850, 11.920), _
    (21.810, 11.580), _
    (21.710, 11.240), _
    (21.550, 10.880), _
    (21.320, 10.540), _
    (21.040, 10.220), _
    (20.740, 09.924), _
    (20.430, 09.648), _
    (20.130, 09.397), _
    (19.860, 09.172), _
    (19.650, 08.976), _
    (19.500, 08.811), _
    (19.440, 08.678), _
    (19.450, 08.382), _
    (19.640, 07.984), _
    (19.840, 07.710), _
    (20.060, 07.419), _
    (20.270, 07.119), _
    (20.440, 06.816), _
    (20.520, 06.520), _
    (20.480, 06.237), _
    (20.350, 05.983), _
    (20.160, 05.736), _
    (19.930, 05.491), _
    (19.670, 05.243), _
    (19.400, 04.989), _
    (19.110, 04.724), _
    (18.830, 04.442), _
    (18.560, 04.139), _
    (18.410, 03.906), _
    (18.220, 03.581), _
    (18.010, 03.235), _
    (17.790, 02.940), _
    (17.590, 02.767), _
    (17.040, 02.553), _
    (16.920, 02.444), _
    (16.820, 02.143), _
    (16.630, 01.806), _
    (16.420, 01.766), _
    (16.020, 01.824), _
    (15.580, 01.951), _
    (15.220, 02.118), _
    (15.260, 02.258), _
    (15.450, 02.568), _
    (15.710, 02.802), _
    (16.020, 02.986), _
    (16.360, 03.150), _
    (16.680, 03.320), _
    (16.970, 03.524), _
    (17.060, 03.622), _
    (17.240, 03.838), _
    (17.490, 04.138), _
    (17.780, 04.490), _
    (18.080, 04.859), _
    (18.370, 05.213), _
    (18.610, 05.518), _
    (18.770, 05.741), _
    (18.840, 05.849), _
    (18.890, 06.150), _
    (18.880, 06.406), _
    (18.780, 06.694), _
    (18.570, 07.094), _
    (18.260, 07.045), _
    (18.290, 06.817), _
    (18.130, 06.445), _
    (17.970, 06.185), _
    (17.750, 05.942), _
    (17.500, 05.701), _
    (17.220, 05.447), _
    (16.940, 05.167), _
    (16.670, 04.846), _
    (16.510, 04.623), _
    (16.340, 04.356), _
    (16.170, 04.058), _
    (15.980, 03.741), _
    (15.780, 03.416), _
    (15.560, 03.096), _
    (15.330, 02.794), _
    (15.080, 02.520), _
    (14.800, 02.287), _
    (14.510, 02.107), _
    (14.300, 01.982), _
    (14.240, 01.649), _
    (12.520, 01.649), _
    (12.950, 02.107), _
    (13.360, 02.489), _
    (13.730, 02.800), _
    (14.050, 03.047), _
    (14.330, 03.236), _
    (14.540, 03.373), _
    (14.690, 03.464), _
    (14.760, 03.515), _
    (14.970, 03.755), _
    (15.200, 04.030), _
    (15.430, 04.323), _
    (15.670, 04.617), _
    (15.880, 04.893), _
    (16.050, 05.134), _
    (16.170, 05.322), _
    (16.340, 05.647), _
    (16.470, 06.004), _
    (16.530, 06.380), _
    (16.490, 06.761), _
    (16.380, 06.959), _
    (16.140, 07.335), _
    (15.850, 07.769), _
    (15.600, 08.139), _
    (15.470, 08.326), _
    (15.180, 08.588), _
    (14.780, 08.817), _
    (14.460, 08.878), _
    (14.090, 08.765), _
    (13.800, 08.674), _
    (13.570, 08.602), _
    (13.370, 08.548), _
    (13.180, 08.508), _
    (12.970, 08.481), _
    (12.720, 08.465), _
    (12.400, 08.456), _
    (11.990, 08.453), _
    (10.800, 08.453), _
    (10.590, 08.173), _
    (10.380, 07.891), _
    (10.180, 07.605), _
    (09.979, 07.317), _
    (09.785, 07.025), _
    (09.597, 06.730), _
    (09.415, 06.432), _
    (09.240, 06.131), _
    (09.071, 05.826), _
    (08.910, 05.518), _
    (08.756, 05.205), _
    (08.610, 04.890), _
    (08.472, 04.570), _
    (08.342, 04.246), _
    (08.222, 03.919), _
    (08.111, 03.587), _
    (08.010, 03.251), _
    (07.918, 02.911), _
    (07.837, 02.566), _
    (07.767, 02.217), _
    (07.700, 01.941), _
    (07.541, 01.649) _
  }

  Dim POINTS2(1 to 5) as const TPoint = { _
    (00.842, 01.649), _
    (27.220, 01.649), _
    (27.220, 01.052), _
    (00.842, 01.052), _
    (00.842, 01.649) _
  }

  Const CORRECTION_X = 0.428
  Const CORRECTION_Y = -0.7
  
  Dim i as integer

  #macro DrawPolygon(array)
  i = lbound(array)
  PSet (Size * (array(i).x + CORRECTION_X) + xPos, Size * (20 - (array(i).y + CORRECTION_Y)) + yPos), &HFFFFFF
  i += 1
  Do
    Line -(Size * (array(i).x + CORRECTION_X) + xPos, Size * (20 - (array(i).y + CORRECTION_Y)) + yPos), &HFFFFFF
    i += 1
  Loop While i <= ubound(array)
  #endmacro
  
  DrawPolygon(POINTS1)
  DrawPolygon(POINTS2)
End Sub

'DrawHorse(0,0,5)

' Size 1 =>  30 x  20
' Size 5 => 150 x 100
Post Reply