Posts: 78
Threads: 21
Joined: Apr 2022
Reputation:
5
Another adaptation of an old QB4.5 program of mine. This is a simulation of a Spirograph. To be precise it simulates the result of a wheel that runs around inside a larger wheel and the patterns that can be created with different diameters of the small wheel and offsets from its centre. It is easy to use and is something of a rabbit hole that you may well disappear down into. While instructions are included in the comments, here is the relevant text -
Quote:To experiment with the patterns that this program can produce it is only necessary to alter the values held in two constants. These constants are SmallDiameter# and Offset#. Changing the value in SmallDiameter# will alter the overall shape of the pattern while altering Offset# will change the "pointyness" of the peaks. To see what I am talking about, simply play around with these constants. Note that it is not necessary to change both values every time that you wish to change the pattern.
If you find values for one or the other of those constants feel free to post them in here. To start you off try a value of 100 for SmallDiameter#. One little warning - it is possible to get the drawing to run off the screen although this doesn't crash the program.
SPIRO.BAS
Code: (Select All) '===========================================================================
' Subject: SIMULATION OF A SPIROGRAPH Date: 02-23-99 (21:53)
' Author: TarotRedhand Code: QB, QBasic, PDS
'===========================================================================
'SPIRO.BAS - A simulation of the most used part of the toy called a
' spirograph. Public domain. Use entirely at own risk. The
' author accepts no liability whatsoever. In the case that I have
' used a registered trademark, I apologise. I do not at this time
' own any trademarks.
'
' There is a toy called a spirograph that is used to make curved patterns.
' This toy consists of a number of pieces that are made from transparent
' plastic and a number of ball-point pens with different coloured inks in them.
' Each piece has gear-teeth along their outside edges. The gear-teeth are
' all of the same size, independent of the piece that they are on. In
' addition each piece has a number of holes in them, which are designed to
' accept a pen point.
'
' This program works in VGA mode 12 graphics and is a simulation of the most
' often used part of that toy. It simulates the use of 2 of the plastic pieces
' to produce a circular pattern. As this program uses double-precision
' numbers and maths, it is comparatively slow. One thing that I have done to
' speed this up is to have 2 identical SUBs with STATIC variables in them.
' This works by ensuring that the built-in functions SIN and COS are only
' called once for each of the 2 angles that are used.
'
' RULES
'
' In order to use this program there are a few rules that you should be aware
' of. DO NOT alter the value of the constant LargeDiameter#. DO NOT place a
' value in the constant SmallDiameter# that is less than or equal to zero or
' greater than or equal to the value in LargeDiameter#. DO NOT place a value
' greater than one or less than or equal to zero in the constant Offset.
' Violation of any of these rules will result in at best, the program
' attempting to draw off of the screen.
'
' Using this program.
'
' To experiment with the patterns that this program can produce it is only
' necessary to alter the values held in two constants. These constants are
' SmallDiameter# and Offset#. Changing the value in SmallDiameter# will alter
' the overall shape of the pattern while altering Offset# will change the
' "pointyness" of the peaks. To see what I am talking about, simply play
' around with these constants. Note that it is not necessary to change both
' values every time that you wish to change the pattern.
'
' Anyway, have fun.
'
' TarotRedhand - 11/1998
'
Const PI# = 3.141592653589793#
Const LargeDiameter# = 478
Const SmallDiameter# = 333
Const CenterX# = 320, CenterY# = 240
Const Offset# = .725
Const Angle1# = 1
Const StartColour = 1
Const EndColour = 13
Const FALSE% = 0
Const TRUE% = Not FALSE%
LC# = (PI# * LargeDiameter#) / 360
A2# = 360 / ((PI# * SmallDiameter#) / LC#)
SmallRadius# = SmallDiameter# / 2
SmallCenterY# = 1 + SmallRadius#
SmallCenterX# = CenterX#
StartX# = CenterX#
StartY# = 1 + SmallRadius# - (SmallRadius# * Offset#)
MyX# = StartX#
MyY# = StartY#
Orbit1 SmallCenterX#, SmallCenterY#, CenterX#, CenterY#, Angle1#, TRUE%
Orbit1 MyX#, MyY#, CenterX#, CenterY#, Angle1#, FALSE%
Orbit2 MyX#, MyY#, SmallCenterX#, SmallCenterY#, -A2#, TRUE%
Screen 12
_FullScreen _SquarePixels
Line (1, 1)-(640, 480), 15, BF
Colour = StartColour
Line (StartX#, StartY#)-(MyX#, MyY#), Colour
Do
For Index% = 1 To 360
Orbit1 SmallCenterX#, SmallCenterY#, CenterX#, CenterY#, Angle1#, FALSE%
Orbit1 MyX#, MyY#, CenterX#, CenterY#, Angle1#, FALSE%
Orbit2 MyX#, MyY#, SmallCenterX#, SmallCenterY#, -A2#, FALSE%
Line -(MyX#, MyY#), Colour
_Delay 0.002
If InKey$ <> "" Then
Exit Do
End If
Next Index%
Colour = Colour + 1
If Colour > EndColour Then Colour = StartColour
Loop
End
Sub Orbit1 (PointX#, PointY#, OrbitX#, OrbitY#, Angle#, FirstTime%)
Static C#, S#
If FirstTime% Then
C# = Cos(Angle# * (PI# / 180#))
S# = Sin(Angle# * (PI# / 180#))
End If
OldX# = PointX# - OrbitX#
OldY# = PointY# - OrbitY#
PointX# = (OldX# * C# - OldY# * S#) + OrbitX#
PointY# = (OldX# * S# + OldY# * C#) + OrbitY#
End Sub
Sub Orbit2 (PointX#, PointY#, OrbitX#, OrbitY#, Angle#, FirstTime%)
Static C#, S#
If FirstTime% Then
C# = Cos(Angle# * (PI# / 180#))
S# = Sin(Angle# * (PI# / 180#))
End If
OldX# = PointX# - OrbitX#
OldY# = PointY# - OrbitY#
PointX# = (OldX# * C# - OldY# * S#) + OrbitX#
PointY# = (OldX# * S# + OldY# * C#) + OrbitY#
End Sub
TR
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
05-10-2022, 03:37 PM
(This post was last modified: 05-10-2022, 03:43 PM by bplus.)
Oh wow! I found a pretty nice one from The Joyful Programmer:
Code: (Select All) Const TRUE = -1
Const FALSE = 0
Dim ToothSize As _Float
Dim Circumference As _Float
Dim Radius As _Float
Dim ArcDegrees As _Float
Dim ArcDegreesHalf As _Float
Dim CutDepth As _Float
Dim CutRadius As _Float
Dim CenterX As _Unsigned Integer
Dim CenterY As _Unsigned Integer
Dim Scale As _Float
Dim NumberOfArcs As _Float
Dim NumberOfTeethHollowGearInside As _Unsigned Long
Dim NumberOfTeethHollowGearOutside As _Unsigned Long
Dim NumberOfTeethSolidGear As _Unsigned Long
Dim SolidGearOffsetRadius As _Float
Dim SolidGearAnglePosition As _Float
Dim SolidGearAngleRotation As _Float
Dim SolidGearPenHoleRadius As _Float
Dim SolidGearOffsetX As _Float
Dim SolidGearOffsetXOld As _Float
Dim SolidGearOffsetY As _Float
Dim SolidGearOffsetYOld As _Float
' DEFINE IMAGES USED IN DEMO
Dim HollowGear As Long
Dim SolidGear As Long
Dim DrawingPaper As Long
Dim HelpMenu As Long
Dim Shared Degree As _Float
Dim PenColor As _Unsigned Long
Dim PenSize As _Unsigned Integer
Dim DrawingSpeed As _Unsigned Integer
Dim PenOn As _Byte
Dim SolidGearMoving As _Byte
Dim SolidGearMinTeeth As _Unsigned Integer
Dim HollowGearMinTeeth As _Unsigned Integer
Dim PenSizeMin As _Unsigned Integer
Dim SolidGearSpeed As Integer
Dim PenHoleDistancePercent As _Float
PenOn = FALSE
SolidGearMoving = FALSE
SolidGearMinTeeth = 14
HollowGearMinTeeth = 24
PenSizeMin = 1
SolidGearSpeed = 1
PenColor = _RGB32(255, 255, 0)
PenSize = PenSizeMin
DrawingSpeed = 1
ToothSize = 3 / 32 ' SIZE IS IN INCHES
Degree = _Pi / 180
Scale = 100
CutDepth = (1 / 16) * Scale ' SIZE IN INCHES
Screen _NewImage(800, 600, 32)
_Title "The Joyful Programmer - Spirograph's Ver 01"
CenterX = _Width(0) / 2
CenterY = _Height(0) / 2
' *** CREATE HELP MENU ***
HelpMenu = _NewImage(270, 260, 32)
_Dest HelpMenu
Line (0, 0)-(_Width(HelpMenu) - 1, _Height(HelpMenu) - 1), _RGB32(160, 160, 160), BF
Line (5, 5)-(_Width(HelpMenu) - 6, _Height(HelpMenu) - 6), _RGB32(250, 250, 250), BF
_SetAlpha 64, _RGB32(160, 160, 160)
_SetAlpha 64, _RGB32(250, 250, 250)
Color _RGB32(0, 0, 200)
_PrintMode _KeepBackground
_PrintString (8, 8), "COMMAND KEYS:"
Color _RGB32(0, 160, 0)
_PrintString (10, 30), "1 = Pen DOWN/UP"
_PrintString (10, 46), "2 = Solid Gear Spin ON/OFF"
_PrintString (10, 62), "3 = Pen Size INCREASE"
_PrintString (10, 78), "4 = Pen Size DECREASE"
_PrintString (10, 94), "5 = CLEAR DRAWING PAPER"
_PrintString (10, 110), "6 = Hollow Gear Size INCREASE"
_PrintString (10, 126), "7 = Hollow Gear Size DECREASE"
_PrintString (10, 142), "8 = Solid Gear Size INCREASE"
_PrintString (10, 158), "9 = Solid Gear Size DECREASE"
_PrintString (10, 174), "0 = Set Random Pen Color"
_PrintString (10, 190), "Q = Pen Hole Move OUT"
_PrintString (10, 206), "A = Pen Hole Move IN"
_PrintString (10, 222), "W = Speed Up Drawing"
_PrintString (10, 238), "S = Slow Down Drawing"
' ------------------------------------------------------------------
NumberOfTeethHollowGearInside = 130
NumberOfTeethHollowGearOutside = NumberOfTeethHollowGearInside + 28
NumberOfTeethSolidGear = 40
PenHoleDistancePercent = 80
HollowGearPixelSize = ((NumberOfTeethHollowGearOutside * ToothSize) / _Pi) * Scale + 1
SolidGearPixelSize = (((NumberOfTeethSolidGear * ToothSize) / _Pi)) * Scale + 1
SolidGearPenHoleRadius = (SolidGearPixelSize / 2 - CutDepth - 14) / 100 * PenHoleDistancePercent + 6
HollowGear = _NewImage(HollowGearPixelSize, HollowGearPixelSize, 32)
SolidGear = _NewImage(SolidGearPixelSize, SolidGearPixelSize, 32)
DrawingPaper = _NewImage(_Width(0), _Height(0), 32)
' DRAW HOLLOW GEAR ON HOLLOWGEAR IMAGE
DrawHollowGear HollowGear, _Width(HollowGear) / 2, _Height(HollowGear) / 2, NumberOfTeethHollowGearInside, NumberOfTeethHollowGearOutside, ToothSize, CutDepth, Scale
DrawSolidGear SolidGear, _Width(SolidGear) / 2, _Height(SolidGear) / 2, NumberOfTeethSolidGear, ToothSize, CutDepth, Scale, SolidGearPenHoleRadius
ToothSpin = (360 / (NumberOfTeethHollowGearInside - NumberOfTeethSolidGear)) / 2
_Dest DrawingPaper
Cls , _RGB32(220, 220, 220)
_Dest 0
SolidGearOffsetRadius = (((NumberOfTeethHollowGearInside * ToothSize) / _Pi) / 2) * Scale - _Height(SolidGear) / 2
SolidGearPenHoleRadius = (SolidGearPixelSize / 2 - CutDepth - 14) / 100 * PenHoleDistancePercent + 6
SolidGearAnglePosition = 0
SolidGearAngleRotation = 0
Circumference1 = (NumberOfTeethHollowGearInside + 1) * ToothSize
Circumference2 = (NumberOfTeethSolidGear + 1) * ToothSize
SolidGearSpin = (Circumference1 / Circumference2)
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
Do
_Limit 30
_Dest DrawingPaper
For i = 1 To DrawingSpeed
k& = _KeyHit
Select Case k&
Case 27 ' <ESC> - EXIT THE DEMO
System
Case 48 ' <0> - CHANGE PEN COLOR
PenColor = _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)
Case 49 ' <1> - TURN ON/OFF PEN
If PenOn = TRUE Then
PenOn = FALSE
Else
PenOn = TRUE
End If
Case 50 ' <2> - TURN ON/OFF SOLID GEARS MOVEMENT
If SolidGearMoving = TRUE Then
SolidGearMoving = FALSE
Else
SolidGearMoving = TRUE
End If
Case 51 ' <3> - PEN SIZE INCREASE
PenSize = PenSize + 1
Case 52 ' <4> - PEN SIZE DECREASE
If PenSize > PenSizeMin Then PenSize = PenSize - 1
Case 53 ' <5> - ERASE DRAWINGS IN DRAWING PAPER
_Dest DrawingPaper
Cls , _RGB32(240, 240, 240)
Case 54 ' <6> - INCREASE HOLLOW GEAR SIZE
_FreeImage HollowGear
NumberOfTeethHollowGearInside = NumberOfTeethHollowGearInside + 1
NumberOfTeethHollowGearOutside = NumberOfTeethHollowGearInside + 28
HollowGearPixelSize = ((NumberOfTeethHollowGearOutside * ToothSize) / _Pi) * Scale + 1
HollowGear = _NewImage(HollowGearPixelSize, HollowGearPixelSize, 32)
DrawHollowGear HollowGear, _Width(HollowGear) / 2, _Height(HollowGear) / 2, NumberOfTeethHollowGearInside, NumberOfTeethHollowGearOutside, ToothSize, CutDepth, Scale
ToothSpin = (360 / (NumberOfTeethHollowGearInside - NumberOfTeethSolidGear)) / 2
SolidGearOffsetRadius = (((NumberOfTeethHollowGearInside * ToothSize) / _Pi) / 2) * Scale - _Height(SolidGear) / 2
Circumference1 = (NumberOfTeethHollowGearInside) * ToothSize
Circumference2 = (NumberOfTeethSolidGear) * ToothSize
SolidGearSpin = (Circumference1 / Circumference2)
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
Case 55 ' <7> - DECREASE HOLLOW GEAR SIZE
_FreeImage HollowGear
If NumberOfTeethHollowGearInside > HollowGearMinTeeth Then NumberOfTeethHollowGearInside = NumberOfTeethHollowGearInside - 1
NumberOfTeethHollowGearOutside = NumberOfTeethHollowGearInside + 28
HollowGearPixelSize = ((NumberOfTeethHollowGearOutside * ToothSize) / _Pi) * Scale + 1
HollowGear = _NewImage(HollowGearPixelSize, HollowGearPixelSize, 32)
DrawHollowGear HollowGear, _Width(HollowGear) / 2, _Height(HollowGear) / 2, NumberOfTeethHollowGearInside, NumberOfTeethHollowGearOutside, ToothSize, CutDepth, Scale
ToothSpin = (360 / (NumberOfTeethHollowGearInside - NumberOfTeethSolidGear)) / 2
SolidGearOffsetRadius = (((NumberOfTeethHollowGearInside * ToothSize) / _Pi) / 2) * Scale - _Height(SolidGear) / 2
Circumference1 = (NumberOfTeethHollowGearInside) * ToothSize
Circumference2 = (NumberOfTeethSolidGear) * ToothSize
SolidGearSpin = (Circumference1 / Circumference2)
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
Case 56 ' <8> - INCREASE SOLID GEAR SIZE
_FreeImage SolidGear
NumberOfTeethSolidGear = NumberOfTeethSolidGear + 1
SolidGearPixelSize = (((NumberOfTeethSolidGear * ToothSize) / _Pi)) * Scale + 1
SolidGear = _NewImage(SolidGearPixelSize, SolidGearPixelSize, 32)
SolidGearPenHoleRadius = (SolidGearPixelSize / 2 - CutDepth - 14) / 100 * PenHoleDistancePercent + 6
DrawSolidGear SolidGear, _Width(SolidGear) / 2, _Height(SolidGear) / 2, NumberOfTeethSolidGear, ToothSize, CutDepth, Scale, SolidGearPenHoleRadius
ToothSpin = (360 / (NumberOfTeethHollowGearInside - NumberOfTeethSolidGear)) / 2
SolidGearOffsetRadius = (((NumberOfTeethHollowGearInside * ToothSize) / _Pi) / 2) * Scale - _Height(SolidGear) / 2
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
Circumference1 = (NumberOfTeethHollowGearInside) * ToothSize
Circumference2 = (NumberOfTeethSolidGear) * ToothSize
SolidGearSpin = (Circumference1 / Circumference2)
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
Case 57 ' <9> - DECREASE SOLID GEAR SIZE
_FreeImage SolidGear
If NumberOfTeethSolidGear > SolidGearMinTeeth Then NumberOfTeethSolidGear = NumberOfTeethSolidGear - 1
SolidGearPixelSize = (((NumberOfTeethSolidGear * ToothSize) / _Pi)) * Scale + 1
SolidGear = _NewImage(SolidGearPixelSize, SolidGearPixelSize, 32)
SolidGearPenHoleRadius = (SolidGearPixelSize / 2 - CutDepth - 14) / 100 * PenHoleDistancePercent + 6
DrawSolidGear SolidGear, _Width(SolidGear) / 2, _Height(SolidGear) / 2, NumberOfTeethSolidGear, ToothSize, CutDepth, Scale, SolidGearPenHoleRadius
ToothSpin = (360 / (NumberOfTeethHollowGearInside - NumberOfTeethSolidGear)) / 2
SolidGearOffsetRadius = (((NumberOfTeethHollowGearInside * ToothSize) / _Pi) / 2) * Scale - _Height(SolidGear) / 2
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
Circumference1 = (NumberOfTeethHollowGearInside) * ToothSize
Circumference2 = (NumberOfTeethSolidGear) * ToothSize
SolidGearSpin = (Circumference1 / Circumference2)
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
Case 113, 81 ' <q> or <Q> - MOVE THE PEN HOLE TO THE OUTSIDE OF THE SOLID GEAR
If PenHoleDistancePercent < 100 Then
_FreeImage SolidGear
SolidGearPixelSize = (((NumberOfTeethSolidGear * ToothSize) / _Pi)) * Scale + 1
SolidGear = _NewImage(SolidGearPixelSize, SolidGearPixelSize, 32)
PenHoleDistancePercent = PenHoleDistancePercent + 1
SolidGearPenHoleRadius = (SolidGearPixelSize / 2 - CutDepth - 14) / 100 * PenHoleDistancePercent + 6
DrawSolidGear SolidGear, _Width(SolidGear) / 2, _Height(SolidGear) / 2, NumberOfTeethSolidGear, ToothSize, CutDepth, Scale, SolidGearPenHoleRadius
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
End If
Case 97, 65 ' <a> or <A> - MOVE THE HOLE TO THE INSIDE OF THE SOLID GEAR
If PenHoleDistancePercent > 0 Then
_FreeImage SolidGear
SolidGearPixelSize = (((NumberOfTeethSolidGear * ToothSize) / _Pi)) * Scale + 1
SolidGear = _NewImage(SolidGearPixelSize, SolidGearPixelSize, 32)
PenHoleDistancePercent = PenHoleDistancePercent - 1
SolidGearPenHoleRadius = (SolidGearPixelSize / 2 - CutDepth - 14) / 100 * PenHoleDistancePercent + 6
DrawSolidGear SolidGear, _Width(SolidGear) / 2, _Height(SolidGear) / 2, NumberOfTeethSolidGear, ToothSize, CutDepth, Scale, SolidGearPenHoleRadius
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
End If
Case 119, 87 ' <W> or <w> - SPEED UP DRAWING
DrawingSpeed = DrawingSpeed + 1
Case 115, 83 ' <S> or <s> - SLOW DOWN DRAWING
If DrawingSpeed > 1 Then
DrawingSpeed = DrawingSpeed - 1
End If
Case Else
End Select
If PenOn = TRUE Then
For x = -(PenSize / 3) To PenSize / 3
For y = -(PenSize / 3) To PenSize / 3
Line (SolidGearHoleXOld + x, SolidGearHoleYOld + y)-(SolidGearHoleX + x, SolidGearHoleY + y), PenColor
Next
Next
End If
If SolidGearMoving = TRUE Then
SolidGearOffsetXOld = SolidGearOffsetX
SolidGearOffsetYOld = SolidGearOffsetY
SolidGearHoleXOld = SolidGearHoleX
SolidGearHoleYOld = SolidGearHoleY
SolidGearAnglePosition = SolidGearAnglePosition + SolidGearSpeed
SolidGearAngleRotation = SolidGearAngleRotation + SolidGearSpin - 1 ' - SolidGearSpeed)
SolidGearOffsetX = CenterX + SolidGearOffsetRadius * Sin(SolidGearAnglePosition * Degree)
SolidGearOffsetY = CenterY - SolidGearOffsetRadius * Cos(SolidGearAnglePosition * Degree)
SolidGearHoleX = SolidGearOffsetX - SolidGearPenHoleRadius * Sin(SolidGearAngleRotation * Degree)
SolidGearHoleY = SolidGearOffsetY - SolidGearPenHoleRadius * Cos(SolidGearAngleRotation * Degree)
End If
Next
_Dest 0
_PutImage (0, 0), DrawingPaper, 0
_PutImage (2, 2), HelpMenu, 0
DisplayImage HollowGear, CenterX, CenterY, 0, 0
DisplayImage SolidGear, SolidGearOffsetX, SolidGearOffsetY, SolidGearAngleRotation, 0
_Display
Loop
System
Sub DrawGearOutline (CenterX As _Unsigned Integer, CenterY As _Unsigned Integer, NumberOfTeeth As _Unsigned Integer, ToothSize As _Float, CutDepth As _Float, Scale As _Float)
Circumference = NumberOfTeeth * ToothSize
Radius = ((Circumference / _Pi) / 2) * Scale
ArcDegrees = (NumberOfTeeth / 360) * Degree
ArcDegreesHalf = ArcDegrees / 2
NumberOfArcs = 360 / NumberOfTeeth
For Degrees = 0 To 359 Step NumberOfArcs
x = CenterX + Radius * Sin(Degrees * Degree)
y = CenterY - Radius * Cos(Degrees * Degree)
x1 = CenterX + (Radius - CutDepth) * Sin((Degrees + NumberOfArcs / 2) * Degree)
y1 = CenterY - (Radius - CutDepth) * Cos((Degrees + NumberOfArcs / 2) * Degree)
x2 = CenterX + Radius * Sin((Degrees + NumberOfArcs) * Degree)
y2 = CenterY - Radius * Cos((Degrees + NumberOfArcs) * Degree)
Line (x, y)-(x1, y1)
Line -(x2, y2)
Next
End Sub
Sub DrawHollowGear (Image As Long, CenterX As _Unsigned Integer, CenterY As _Unsigned Integer, NumberOfInsideTeeth As _Unsigned Integer, NumberOfOutsideTeeth As _Unsigned Integer, ToothSize As _Float, CutDepth As _Float, Scale As _Float)
Dim ImageTemp As Long
Dim CircumferenceInside As _Float
Dim CircumferenceOutside As _Float
Dim RadiusInside As _Float
Dim RadiusOutside As _Float
ImageTemp = _NewImage(_Width(Image), _Height(Image), 32)
_Dest ImageTemp
Color _RGB32(255, 255, 255)
CircumferenceInside = NumberOfInsideTeeth * ToothSize
RadiusInside = ((CircumferenceInside / _Pi) / 2) * Scale
CircumferenceOutside = NumberOfOutsideTeeth * ToothSize
RadiusOutside = ((CircumferenceOutside / _Pi) / 2) * Scale
x = CenterX + (RadiusInside + 15) * Sin(RadiusInside * Degree)
y = CenterY - (RadiusInside + 15) * Cos(RadiusInside * Degree)
Circle (CenterX, CenterY), RadiusInside + 4
Circle (CenterX, CenterY), RadiusOutside - (ToothSize * Scale) - 2
Paint (x, y), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
_SetAlpha 190, _RGB32(255, 255, 255)
_PutImage (0, 0), ImageTemp, Image
Cls
DrawGearOutline CenterX, CenterY, NumberOfInsideTeeth, ToothSize, CutDepth, Scale
DrawGearOutline CenterX, CenterY, NumberOfOutsideTeeth, ToothSize, CutDepth, Scale
Circle (CenterX, CenterY), RadiusInside + 4, _RGB32(255, 255, 255)
Circle (CenterX, CenterY), RadiusOutside - (ToothSize * Scale) - 2, _RGB32(255, 255, 255)
Paint (CenterX, CenterY - (RadiusInside + 3)), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
Paint (CenterX, CenterY - (RadiusOutside - (ToothSize * Scale))), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
Circle (CenterX, CenterY), RadiusInside + 4, _RGB32(0, 0, 0)
Circle (CenterX, CenterY), RadiusOutside - (ToothSize * Scale) - 2, _RGB32(0, 0, 0)
_SetAlpha 0, _RGB32(0, 0, 0)
_SetAlpha 80, _RGB32(255, 255, 255)
_PutImage (0, 0), ImageTemp, Image
_Dest Image
Color _RGBA32(64, 64, 64, 96)
DrawGearOutline CenterX, CenterY, NumberOfInsideTeeth, ToothSize, CutDepth, Scale
DrawGearOutline CenterX, CenterY, NumberOfOutsideTeeth, ToothSize, CutDepth, Scale
_FreeImage ImageTemp
End Sub
Sub DrawSolidGear (Image As Long, CenterX As _Unsigned Integer, CenterY As _Unsigned Integer, NumberOfTeeth As _Unsigned Integer, ToothSize As _Float, CutDepth As _Float, Scale As _Float, SolidGearPenHoleRadius As _Float)
Dim ImageTemp As Long
Dim Circumference As _Float
Dim Radius As _Float
ImageTemp = _NewImage(_Width(Image), _Height(Image), 32)
_Dest ImageTemp
Color _RGB32(200, 200, 200)
Circumference = NumberOfTeeth * ToothSize
Radius = ((Circumference / _Pi) / 2) * Scale
DrawGearOutline CenterX, CenterY, NumberOfTeeth, ToothSize, CutDepth, Scale
x = CenterX
y = CenterY - SolidGearPenHoleRadius
Circle (x, y), 5
Paint (CenterX, CenterY), _RGB32(200, 200, 200), _RGB32(200, 200, 200)
_SetAlpha 200, _RGB32(200, 200, 200)
_PutImage (0, 0), ImageTemp, Image
Cls
_SetAlpha 0, _RGB32(0, 0, 0)
Color _RGB32(32, 32, 32)
Line (CenterX - Radius, CenterY)-(CenterX + Radius, CenterY)
Line (CenterX, CenterY - SolidGearPenHoleRadius + 5)-(CenterX, CenterY + Radius)
Line (CenterX, CenterY - SolidGearPenHoleRadius - 5)-(CenterX, CenterY - Radius)
_SetAlpha 128, _RGB32(32, 32, 32)
_PutImage (0, 0), ImageTemp, Image
_Dest Image
Color _RGBA32(64, 64, 64, 96)
DrawGearOutline CenterX, CenterY, NumberOfTeeth, ToothSize, CutDepth, Scale
Circle (x, y), 5, _RGBA32(64, 64, 64, 200)
_FreeImage ImageTemp
End Sub
Sub DisplayImage (Image As Long, x As Integer, y As Integer, angle As Single, mode As _Byte)
'Image is the image handle which we use to reference our image.
'x,y is the X/Y coordinates where we want the image to be at on the screen.
'angle is the angle which we wish to rotate the image.
'mode determines HOW we place the image at point X,Y.
'Mode 0 we center the image at point X,Y
'Mode 1 we place the Top Left corner of our image at point X,Y
'Mode 2 is Bottom Left
'Mode 3 is Top Right
'Mode 4 is Bottom Right
Dim px(3) As Integer, py(3) As Integer, w As Integer, h As Integer
Dim sinr As Single, cosr As Single, i As _Byte
w = _Width(Image): h = _Height(Image)
Select Case mode
Case 0 'center
px(0) = -w \ 2: py(0) = -h \ 2
px(3) = w \ 2: py(3) = -h \ 2
px(1) = -w \ 2: py(1) = h \ 2
px(2) = w \ 2: py(2) = h \ 2
Case 1 'top left
px(0) = 0: py(0) = 0
px(3) = w: py(3) = 0
px(1) = 0: py(1) = h
px(2) = w: py(2) = h
Case 2 'bottom left
px(0) = 0: py(0) = -h
px(3) = w: py(3) = -h
px(1) = 0: py(1) = 0
px(2) = w: py(2) = 0
Case 3 'top right
px(0) = -w: py(0) = 0
px(3) = 0: py(3) = 0
px(1) = -w: py(1) = h
px(2) = 0: py(2) = h
Case 4 'bottom right
px(0) = -w: py(0) = -h
px(3) = 0: py(3) = -h
px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
End Select
sinr = Sin(angle / 57.2957795131)
cosr = Cos(angle / 57.2957795131)
For i = 0 To 3
x2 = (px(i) * cosr + sinr * py(i)) + x
y2 = (py(i) * cosr - px(i) * sinr) + y
px(i) = x2
py(i) = y2
Next
_MapTriangle _Seamless(0, 0)-(0, h - 1)-(w - 1, h - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2)), , _Smooth
_MapTriangle _Seamless(0, 0)-(w - 1, 0)-(w - 1, h - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2)), , _Smooth
End Sub
This was from way back when Walter agreed to host SmallBASIC at his Forum which is how I came to QB64.
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
Ashish started the thread with this:
Code: (Select All) ' 2022-05-10 Attempt to restore Ashish QB64 Spirograph from a SmallBASIC translation of it
'Coded By Ashish Kushwaha
' signature "if (Me.Success) {Me.Improve();} else {Me.TryAgain();}"
_Title "Spirograph"
Screen _NewImage(700, 700, 32)
Type spirals
x As Single
y As Single
rad As Single
ang As _Float
End Type
Dim Shared spiral(10) As spirals
spiral(0).x = _Width / 2
spiral(0).y = _Height / 2
spiral(0).rad = 160 'confused with SB radian function I will use .r
stroke~& = _RGB(80, 80, 80) 'I guess this is color setting
Do
Cls , _RGB(230, 230, 230)
Circle (spiral(0).x, spiral(0).y), spiral(0).rad, stroke~&
spiral(0).ang = spiral(0).ang + .01
For i = 1 To UBound(spiral)
spiral(i).x = Cos(spiral(i - 1).ang) * spiral(i - 1).rad + spiral(i - 1).x
spiral(i).y = Sin(spiral(i - 1).ang) * spiral(i - 1).rad + spiral(i - 1).y
spiral(i).rad = spiral(i - 1).rad / 1.5
spiral(i).ang = spiral(i - 1).ang * 1.5
Circle (spiral(i).x, spiral(i).y), spiral(i).rad, stroke~&
Next
_Display
_Limit 60
Loop
Which reminds me allot of Sprezzo's efforts of circles within circles... only he did pendulums.
![[Image: image-2022-05-10-120941153.png]](https://i.ibb.co/qjhdDR4/image-2022-05-10-120941153.png)
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
05-10-2022, 04:56 PM
(This post was last modified: 05-10-2022, 09:09 PM by bplus.)
But what we want to see is the line created by the last circle in the chain:
Code: (Select All) ' First Mod of Ashish Spirograph translated to QB64 2022-05-10 b+
_Title "Spirograph by Ashish b+ Mod and trans to QB64"
' what we really want to see is what the Spirograph is drawing
' at least as much seeing the many circled arm swinging around in circle.
xmax = 700: ymax = 700
Type spiro
As Single x, y, r, ang
End Type
Dim spiral(15) As spiro
Screen _NewImage(xmax, ymax, 12)
_ScreenMove 200, 60
s = 2
spiral(0).x = xmax / 2
spiral(0).y = ymax / 2
spiral(0).r = 100
spiral(0).ang = 0
For s = 2 To 5 ' after 5 it gets to full of lines to apreciate but something looks wrong this is not Spirograph!
Cls
Print "S = "; s; " press spacebar when spirograph begins to repeat..."
F = 0
While F = 0
If InKey$ = " " Then F = 1
spiral(0).ang = spiral(0).ang + .01
For i = 1 To s
spiral(i).x = Cos(spiral(i - 1).ang) * spiral(i - 1).r + spiral(i - 1).x
spiral(i).y = Sin(spiral(i - 1).ang) * spiral(i - 1).r + spiral(i - 1).y
spiral(i).r = spiral(i - 1).r / 1.5
spiral(i).ang = spiral(i - 1).ang * 1.5
If i = s Then fcirc spiral(i).x, spiral(i).y, 2, 9
Next
_Display
Wend
Next
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
That is just the beginning of a very long circle filling ride!
And something looks off, a Spirograph drawing does not bulge out on right side not to mention 10 gears is 8 or 9 too many!
Back to drawing board...
b = b + ...
Posts: 249
Threads: 9
Joined: Apr 2022
Reputation:
4
05-10-2022, 06:22 PM
(This post was last modified: 05-10-2022, 06:37 PM by aurel.)
Mark..which version u use ...?
I lost my 1.6 i think on broken hdd
the one posted by TarotRedhand
work with old 1.2 i have in this hdd packed with DavIDE
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
@Aurel QB64 went from version 1.5 to 2.0 skipping over all in between, I believe you commented on it.
Reason was debug was added and we could no longer use function names as temp variables making all previous code that did that incompatible with 2.0+
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
05-10-2022, 06:38 PM
(This post was last modified: 05-10-2022, 08:34 PM by bplus.)
OK next step in story is me trying to get closer to a Spirograph than Ashish:
Here is my first effort 5 years ago almost:
Code: (Select All) _Title "Test 1 Spirograph" ' b+ trans from SB 2022-05-10
'Spirograph test.bas SmallBASIC 0.12.9 (B+=MGA) 2017-07-01
xmax = 700: ymax = 700
Screen _NewImage(xmax, ymax, 12) ' using 16 colors
_ScreenMove 300, 20
Dim Shared pi
pi = _Pi
rO = ymax / 2 - 10 ' fit screen radius of big circle
rI = rO / 2 ' smaller circle that travels inside edge of larger
OI = rO / rI ' rate inner circle spins compared to angle on outer circle
'? OI
Ox = xmax / 2
Oy = ymax / 2
Dim Shared px(20000), py(20000), pIndex
For a = 0 To 2 * pi Step pi / 360 'while the inner circle contacts outer at angle a
Cls
Circle (Ox, Oy), rO, 9
'the origin of inner circle at same angle
Ix = Ox + (rO - rI) * Cos(a)
Iy = Oy + (rO - rI) * Sin(a)
Ia = OI * a 'the angle of the inner points are OI * a on outer circle
'draw line from origin of inner circle to outer edge
Color 12
wheel Ix, Iy, rI, -Ia
For i = 1 To pIndex - 1
PSet (px(i), py(i)), 15
Next
_Display
_Delay .010
Next
Sub wheel (x, y, r, a)
'local i, x1, y1
Circle (x, y), r
For i = 1 To 12
x1 = x + r * Cos(i * 2 * pi / 12 + a)
y1 = y + r * Sin(i * 2 * pi / 12 + a)
Line (x, y)-(x1, y1)
If i = 12 Then
x2 = x + r / 2 * Cos(i * 2 * pi / 12 + a)
y2 = y + r / 2 * Sin(i * 2 * pi / 12 + a)
px(pIndex) = x2
py(pIndex) = y2
pIndex = pIndex + 1
End If
Next
End Sub
![[Image: Test-1-Spirograph.png]](https://i.ibb.co/N7qc4Vn/Test-1-Spirograph.png)
Me thinks if Walter had posted his after Ashish or mine, neither of us would have pursued Spirograph further! ;-))
b = b + ...
Posts: 249
Threads: 9
Joined: Apr 2022
Reputation:
4
05-10-2022, 06:38 PM
(This post was last modified: 05-10-2022, 06:39 PM by aurel.)
ok..maybe i have 1.8..i am not sure
ahhh i need to find download for 2.0 version
and damn..i also lost my Qb64 editor ..grrr
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
05-10-2022, 06:44 PM
(This post was last modified: 05-10-2022, 06:45 PM by bplus.)
@Aurel
Try QB64pe .6 should be better! Editor comes automatic with QB64.
https://github.com/QB64-Phoenix-Edition/...tag/v0.6.0
Steve just posted announcement today!
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
OK to get closer to drawing with a Spirograph, we need to play around within inner gear sizes.
BTW do we need toothed gears? Heck no! Toothed Gears are for people with real Spirographs so circle doesn't slide around. Gears are allot of extra trouble and even Walter's, a very professional looking Spirograph, has the teeth misaligned! (Yeah look closer!)
So in Test 2 we change sizes of inner radius as ratio's to outer radius 1/2, 1/3, 1/4, ...
Code: (Select All) _Title "Test 2 Spirograph - different small gear sizes" 'b+ 2022-05-10 trans from
'Spirograph RO divided by 2 - 10 = RI.bas SmallBASIC 0.12.9 (B+=MGA) 2017-07-01
xmax = 700: ymax = 700
Screen _NewImage(xmax, ymax, 12) ' using 16 colors
_ScreenMove 300, 20
Dim Shared pi
pi = _Pi
Dim Shared px(20000), py(20000), pIndex
rO = ymax / 2 - 10 ' fit screen radius of big circle
Ox = xmax / 2
Oy = ymax / 2
pIndex = 0
For ir = 2 To 10
rI = rO / ir ' smaller circle that travels inside edge of larger
OI = rO / rI ' rate inner circle spins compared to angle on outer circle
For a = 0 To 2 * pi Step pi / 360 'while the inner circle contacts outer at angle a
Cls
Color 15
Print "inner radius = 1 /"; ir; " of outer radius"
Circle (Ox, Oy), rO, 9
'the origin of inner circle at same angle
Ix = Ox + (rO - rI) * Cos(a)
Iy = Oy + (rO - rI) * Sin(a)
Ia = OI * a 'the angle of the inner points are OI * a on outer circle
'draw line from origin of inner circle to outer edge
Color 12
wheel Ix, Iy, rI, -Ia
For i = 0 To pIndex - 1
PSet (px(i), py(i)), 15
Next
_Display
_Delay .01
Next
Next
Sleep
Sub wheel (x, y, r, a)
'local i, x1, y1
Circle (x, y), r
For i = 1 To 12
x1 = x + r * Cos(i * 2 * pi / 12 + a)
y1 = y + r * Sin(i * 2 * pi / 12 + a)
Line (x, y)-(x1, y1)
If i = 12 Then
x2 = x + r / 2 * Cos(i * 2 * pi / 12 + a)
y2 = y + r / 2 * Sin(i * 2 * pi / 12 + a)
px(pIndex) = x2
py(pIndex) = y2
pIndex = pIndex + 1
End If
Next
End Sub
Looks right to me ;-)) as the ratio increases by 1 the number of sides drawn increases by 1. This draws a perfectly enclosed figure each round because the smaller radius divides the larger perfectly.
b = b + ...
|
