In 2003, a developer who used the nickname Lysozyme made an interactive simulator of it, written in Blitz3D:
https://www.demonews.com/download/the-a ... mechanism/
Since the source code is included, I tried porting it to FreeBasic+OpenB3D. Here is the ported version:
Code: Select all
#include "openb3d.bi"
const Pi=3.14159265358
screenres 800,600, 32, , &h10002
Graphics3d 800,600,32,1,1
'TEXTURES
Dim shared as any ptr PolkaDotTex(7),BronzeGearTex(225) '225=Drive Wheel Texture
For a as integer=1 To 7
PolkaDotTex(a)=LoadTexture("Textures\color"+str(a)+".jpg")
Next
Dim shared as any ptr BronzeTex: BronzeTex=LoadTexture("Textures\Bronze.jpg")
Dim shared as any ptr CrankTex: CrankTex=LoadTexture("Textures\Crank.jpg")
Dim shared as any ptr SunPointerTex: SunPointerTex=LoadTexture("Textures\Pointer Sun.jpg")
Dim shared as any ptr MoonPointerTex: MoonPointerTex=LoadTexture("Textures\Pointer Moon.jpg")
Dim shared as any ptr CrownGearTex: CrownGearTex=LoadTexture("Textures\Crown Gear.jpg")
Dim shared as any ptr FrontPanelTex: FrontPanelTex=LoadTexture("Textures\Front Panel.jpg")
Dim shared as any ptr RearPanelTex: RearPanelTex=LoadTexture("Textures\Rear Panel.jpg")
Dim shared as any ptr SmallDialTex: SmallDialTex=LoadTexture("Textures\Small Dial.jpg")
BronzeGearTex(15)=LoadTexture("Textures\15 Tooth Gear.jpg")
BronzeGearTex(16)=LoadTexture("Textures\16 Tooth Gear.jpg")
BronzeGearTex(20)=LoadTexture("Textures\20 Tooth Gear.jpg")
BronzeGearTex(24)=LoadTexture("Textures\24 Tooth Gear.jpg")
BronzeGearTex(30)=LoadTexture("Textures\30 Tooth Gear.jpg")
BronzeGearTex(32)=LoadTexture("Textures\32 Tooth Gear.jpg")
BronzeGearTex(36)=LoadTexture("Textures\36 Tooth Gear.jpg")
BronzeGearTex(38)=LoadTexture("Textures\38 Tooth Gear.jpg")
BronzeGearTex(48)=LoadTexture("Textures\48 Tooth Gear.jpg")
BronzeGearTex(54)=LoadTexture("Textures\54 Tooth Gear.jpg")
BronzeGearTex(60)=LoadTexture("Textures\60 Tooth Gear.jpg")
BronzeGearTex(64)=LoadTexture("Textures\64 Tooth Gear.jpg")
BronzeGearTex(96)=LoadTexture("Textures\96 Tooth Gear.jpg")
BronzeGearTex(127)=LoadTexture("Textures\127 Tooth Gear.jpg")
BronzeGearTex(192)=LoadTexture("Textures\192 Tooth Gear.jpg")
BronzeGearTex(222)=LoadTexture("Textures\222 Tooth Gear.jpg")
BronzeGearTex(225)=LoadTexture("Textures\Drive Wheel.jpg")
'GEARS (5 teeth=1 cm)
Dim shared as any ptr GearMesh: GearMesh=LoadMesh("Models\Flat Gear.b3d"):HideEntity GearMesh
Dim shared as any ptr CrankMesh: CrankMesh=LoadMesh("Models\Crank.b3d")
Dim shared Gear(50) as any ptr
dim shared NumGears as integer
Read NumGears
Gear(1)=LoadMesh("Models\Crown Gear.b3d")
Gear(2)=LoadMesh("Models\Drive Wheel.b3d")
Gear(3)=LoadMesh("Models\Drive Wheel.b3d")
For a as integer =4 To NumGears
Gear(a)=CopyMesh(GearMesh)
Next
'SPRITES
Dim shared as any ptr GearToothCountSprite(225),ToothCount(300)
GearToothCountSprite(15)=LoadSprite("Sprites\15.jpg")
GearToothCountSprite(16)=LoadSprite("Sprites\16.jpg")
GearToothCountSprite(20)=LoadSprite("Sprites\20.jpg")
GearToothCountSprite(24)=LoadSprite("Sprites\24.jpg")
GearToothCountSprite(30)=LoadSprite("Sprites\30.jpg")
GearToothCountSprite(32)=LoadSprite("Sprites\32.jpg")
GearToothCountSprite(36)=LoadSprite("Sprites\36.jpg")
GearToothCountSprite(38)=LoadSprite("Sprites\38.jpg")
GearToothCountSprite(45)=LoadSprite("Sprites\45.jpg")
GearToothCountSprite(48)=LoadSprite("Sprites\48.jpg")
GearToothCountSprite(54)=LoadSprite("Sprites\54.jpg")
GearToothCountSprite(60)=LoadSprite("Sprites\60.jpg")
GearToothCountSprite(64)=LoadSprite("Sprites\64.jpg")
GearToothCountSprite(96)=LoadSprite("Sprites\96.jpg")
GearToothCountSprite(127)=LoadSprite("Sprites\127.jpg")
GearToothCountSprite(192)=LoadSprite("Sprites\192.jpg")
GearToothCountSprite(222)=LoadSprite("Sprites\222.jpg")
GearToothCountSprite(225)=LoadSprite("Sprites\225.jpg")
dim shared as any ptr SunAndMoonSprite: SunAndMoonSprite=LoadSprite("Sprites\Sun and Moon.png",3)
dim shared as any ptr SynodicMonthSprite: SynodicMonthSprite=LoadSprite("Sprites\Synodic Month.png",3)
dim shared as any ptr FourYearSprite: FourYearSprite=LoadSprite("Sprites\Four Year Dial.png",3)
For a as integer=1 To 225
If GearToothCountSprite(a)<>0 Then HideEntity GearToothCountSprite(a)
Next
'AXLES
Dim shared as any ptr Axle(15)
Dim shared as any ptr AxleMesh: AxleMesh=LoadMesh("Models\Axle.b3d"):HideEntity AxleMesh
For a as integer=1 To 11:Axle(a)=CopyEntity(AxleMesh):EntityTexture Axle(a),BronzeTex:Next
'SMALL DIALS
Dim shared as any ptr AuxiliaryDialMesh:AuxiliaryDialMesh=LoadMesh("Models\Small Dial.b3d")
Dim shared as any ptr LunarYearDialMesh:LunarYearDialMesh=CopyMesh(AuxiliaryDialMesh)
EntityTexture AuxiliaryDialMesh,SmallDialTex
EntityTexture LunarYearDialMesh,SmallDialTex
'POINTERS
Dim shared as any ptr SunPointerMesh:SunPointerMesh=LoadMesh("Models\pointer.b3d")
Dim shared as any ptr MoonPointerMesh:MoonPointerMesh=CopyMesh(SunPointerMesh)
Dim shared as any ptr FourYearPointerMesh:FourYearPointerMesh=CopyMesh(SunPointerMesh)
Dim shared as any ptr SynodicMonthPointerMesh:SynodicMonthPointerMesh=CopyMesh(SunPointerMesh)
EntityTexture SunPointerMesh,SunPointerTex
EntityTexture MoonPointerMesh,MoonPointerTex
EntityTexture FourYearPointerMesh,BronzeTex
EntityTexture SynodicMonthPointerMesh,BronzeTex
'PANELS
Dim shared as any ptr FrontPanelMesh:FrontPanelMesh=LoadMesh("Models\Panel1.b3d")
Dim shared as any ptr RearPanelMesh:RearPanelMesh=CopyMesh(FrontPanelMesh)
Dim shared as any ptr SidePanelLongMesh1:SidePanelLongMesh1=LoadMesh("Models\Panel2.b3d")
Dim shared as any ptr SidePanelLongMesh2:SidePanelLongMesh2=CopyMesh(SidePanelLongMesh1)
Dim shared as any ptr SidePanelShortMesh1:SidePanelShortMesh1=CopyMesh(SidePanelLongMesh1)
Dim shared as any ptr SidePanelShortMesh2:SidePanelShortMesh2=CopyMesh(SidePanelLongMesh1)
Dim shared as any ptr BasePlateMesh:BasePlateMesh=CopyMesh(SidePanelLongMesh1)
EntityTexture FrontPanelMesh,FrontPanelTex
EntityTexture RearPanelMesh,RearPanelTex
EntityTexture SidePanelLongMesh1,RearPanelTex
EntityTexture SidePanelLongMesh2,RearPanelTex
EntityTexture SidePanelShortMesh1,RearPanelTex
EntityTexture SidePanelShortMesh2,RearPanelTex
EntityTexture BasePlateMesh,RearPanelTex
'2D STUFF
'Global TitleScreenImg=LoadImage("Sprites\Title Screen.jpg")
'CAMERA
Dim shared as any ptr CameraPivot:CameraPivot=CreatePivot()
Dim shared as any ptr Camera:Camera=CreateCamera()
CameraProjMode Camera,1
'LIGHTS
Dim shared as any ptr Light1:Light1=CreateLight(1)
Dim shared as any ptr Light2:Light2=CreateLight(1)
'VARIABLES
Dim shared GearTurned(50) as integer,GearLoc(50,3) as single,GearAng(50,3) as single,GearTeeth(50) as integer,GearPolkaDot(50) as integer,AxlePolkaDot(50) as integer,GearLink(50,4) as integer,GearLinkDir(50,4) as integer,GearAmtTurned(50) as single '1=same dir, -1=opp dir 2=Linked (same speed, same dir)
dim shared CurrGear as integer,TargetGear as integer,BronzeTexture as integer,TurnSpeed as integer
Dim shared AlphaValue(6) as single, AlphaToggle(6) as integer
'Teeth,Polka Dot x,y,x, ax,ay,az, link/dir x 4
Data 33
'1
Data 45,2, -3,0,0, 0,0,-90, 2,1, 3,-1, 0,0, 0,0
Data 225,1, 35.81,7.16,0, 0,0,0, 1,1, 0,0, 0,0, 0,0
Data 225,5, 35.81,-7.16,0, 0,0,0, 1,-1, 4,2, 0,0, 0,0
Data 64,5, 35.81,-15,0, 0,0,0, 3,2, 5,2, 11,-1, 0,0
Data 32,5, 35.81,-20,0, 0,0,0, 4,2, 6,-1, 18,-1, 0,0
'6
Data 38,3, 38.24,-15,16, 0,0,0, 4,-1, 7,2, 0,0, 0,0
Data 48,3, 38.24,-17,16, 0,0,0, 6,2, 8,-1, 0,0, 0,0
Data 24,7, 47.8,-17,22.2, 0,0,0, 7,-1, 9,2, 0,0, 0,0
Data 127,7, 47.8,-25,22.2, 0,0,0, 8,2, 10,-1, 0,0, 0,0
Data 32,4, 35.81,-25,0, 0,0,0, 9,-1, 25,-1, 0,0, 0,0
'11
Data 36,3, 26.2,-15,-12.4, 0,0,0, 4,-1, 12,2, 0,0, 0,0
Data 54,3, 26.2,-17,-12.4, 0,0,0, 11,2, 13,-1, 0,0, 0,0
Data 96,1, 38.9,-17,-32.6, 0,0,0, 12,-1, 14,2, 0,0, 0,0
Data 16,1, 38.9,-25,-32.6, 0,0,0, 13,2, 15,-1, 0,0, 0,0
Data 64,5, 35.81,-25,-44.9, 0,0,0, 14,-1, 16,-1, 0,0, 0,0
'16
Data 32,7, 50.84,-25,-42.4, 0,0,0, 17,2, 15,-1, 0,0, 0,0
Data 48,7, 50.84,-29,-42.4, 0,0,0, 16,2, 0,0, 0,0, 0,0
Data 32,3, 27.23,-20,5.3, 0,0,0, 5,-1, 19,2, 0,0, 0,0
Data 48,3, 27.23,-38,5.3, 0,0,0, 18,2, 0,0, 0,0, 0,0
'20-22 (moving differential gears)
Data 48,1, 13.85,-38,-1.9, 0,0,0, 0,0, 21,2, 0,0, 0,0
Data 32,1, 13.85,-32,-1.9, 0,0,0, 20,2, 22,-1, 0,0, 0,0
Data 64,5, 14.4,-32,13.4, 0,0,0, 26,-1, 21,-1, 0,0, 0,0
'23-24 (differential turntable)
Data 222,6, 27.23,-34,5.3, 0,0,0, 24,2, 0,0, 0,0, 0,0
Data 192,6, 27.23,-36,5.3, 0,0,0, 23,2, 27,-1, 0,0, 0,0
'25-26
Data 32,2, 27.23,-25,5.3, 0,0,0, 10,-1, 26,2, 0,0, 0,0
Data 32,2, 27.23,-32,5.3, 0,0,0, 25,2, 22,-1, 0,0, 0,0
'data 27
Data 48,3, 21.8,-36,43.1, 0,0,0, 24,-1, 28,2, 0,0, 0,0
Data 30,3, 21.8,-38,43.1, 0,0,0, 27,2, 29,-1, 0,0, 0,0
Data 60,4, 35.91,-38,45.3, 0,0,0, 28,-1, 30,2, 0,0, 0,0
Data 20,4, 35.91,-40,45.3, 0,0,0, 29,2, 31,-1, 0,0, 0,0
Data 60,5, 48.2,-40,47.4, 0,0,0, 30,-1, 32,2, 0,0, 0,0
Data 15,5, 48.2,-42,47.4, 0,0,0, 31,2, 33,-1, 0,0, 0,0
Data 60,2, 55.2,-42,37.9, 0,0,0, 32,-1, 0,0, 0,0, 0,0
Data 4,5,4,2,5,7,1,7,2,3,1
Sub ScaleMeshToBox(Mesh as any ptr,x as single,y as single,z as single)
FitMesh Mesh,0,0,0,x,y,z
PositionMesh Mesh,-x/2,-y/2,-z/2
End Sub
Sub SetUpScene()
For a as integer=1 To 5:AlphaValue(a)=1:AlphaToggle(a)=1:Next:AlphaToggle(6)=0
CurrGear=1:TargetGear=5:BronzeTexture=True:TurnSpeed=1
For a as integer=1 To NumGears
Read GearTeeth(a),GearPolkaDot(a)
For b as integer=1 To 3:Read GearLoc(a,b):Next
For b as integer=1 To 3:Read GearAng(a,b):Next
For b as integer=1 To 4:Read GearLink(a,b),GearLinkDir(a,b):Next
Next
For a as integer=1 To 11:Read AxlePolkaDot(a):Next
For a as integer=1 To NumGears
PositionEntity Gear(a),GearLoc(a,1),GearLoc(a,2),GearLoc(a,3)
RotateEntity Gear(a),GearAng(a,1),GearAng(a,2),GearAng(a,3)
dim sc as single=GearTeeth(a)/Pi:dim h as single=2
If a=1 Then h=6
ScaleMeshToBox Gear(a),sc,h,sc
EntityAlpha Gear(a),1
Next
dim as integer n=0
'Position Tooth Counts
For a as integer=1 To NumGears
For b as integer=1 To 4
n=n+1:ToothCount(n)=CopyEntity(GearToothCountSprite(GearTeeth(a)))
dim as single x,y,z,sc, xx,yy,zz
x=EntityX(Gear(a)):y=EntityY(Gear(a)):z=EntityZ(Gear(a)):sc=(GearTeeth(a)/Pi)/2+1
If a=1 Then
If b=1 Then yy=y+sc:zz=z
If b=2 Then yy=y-sc:zz=z
If b=3 Then yy=y:zz=z+sc
If b=4 Then yy=y:zz=z-sc
xx=x
Else
If b=1 Then xx=x+sc:zz=z
If b=2 Then xx=x-sc:zz=z
If b=3 Then xx=x:zz=z+sc
If b=4 Then xx=x:zz=z-sc
yy=y
EndIf
PositionEntity ToothCount(n),xx,yy,zz
EntityParent ToothCount(n),Gear(a)
Next
Next
EntityParent Gear(21),Gear(23)
EntityParent Gear(20),Gear(23)
EntityParent Gear(22),Gear(23)
ScaleMeshToBox CrankMesh,24,24,24
RotateEntity CrankMesh,0,180,90:PositionEntity CrankMesh,-17.5,0,0:EntityParent CrankMesh,Gear(1)
PositionEntity SunPointerMesh,35.81,15,0:ScaleEntity SunPointerMesh,0.13,0.20,0.13
PositionEntity MoonPointerMesh,35.81,17,0:ScaleEntity MoonPointerMesh,0.09,0.20,0.09
PositionEntity FourYearPointerMesh,35.81,-51,-44.9:ScaleEntity FourYearPointerMesh,0.11,0.20,0.11
PositionEntity SynodicMonthPointerMesh,35.91,-51,45.3:ScaleEntity SynodicMonthPointerMesh,0.11,0.20,0.11
RotateEntity SunPointerMesh,0,90,0
RotateEntity MoonPointerMesh,0,90,0
RotateEntity FourYearPointerMesh,0,90,0
RotateEntity SynodicMonthPointerMesh,0,90,0
PositionEntity SunAndMoonSprite,35.81,25,0:ScaleSprite SunAndMoonSprite,10,10
PositionEntity FourYearSprite,35.81,-61,-44.9:ScaleSprite FourYearSprite,10,10
PositionEntity SynodicMonthSprite,35.81,-61,45.3:ScaleSprite SynodicMonthSprite,10,10
EntityParent SunPointerMesh,Gear(2):EntityParent MoonPointerMesh,Gear(10)
EntityParent FourYearPointerMesh,Gear(15):EntityParent SynodicMonthPointerMesh,Gear(30)
PositionEntity AuxiliaryDialMesh,EntityX(Gear(17)),-48,EntityZ(Gear(17)):ScaleMeshToBox AuxiliaryDialMesh,15,2,15
PositionEntity LunarYearDialMesh,EntityX(Gear(33)),-48,EntityZ(Gear(33)):ScaleMeshToBox LunarYearDialMesh,15,2,15
EntityParent AuxiliaryDialMesh,Gear(17):EntityParent LunarYearDialMesh,Gear(33)
PositionEntity FrontPanelMesh,35.81,12,0:ScaleMeshToBox FrontPanelMesh,90,1,180
PositionEntity RearPanelMesh,35.81,-48,0:ScaleMeshToBox RearPanelMesh,90,1,180
PositionEntity BasePlateMesh,35.81,-22,0:ScaleMeshToBox BasePlateMesh,90,1,180
ScaleMeshToBox SidePanelLongMesh1,60,1,180:PositionEntity SidePanelLongMesh1,-9.5,-18,0:RotateEntity SidePanelLongMesh1,0,0,90
ScaleMeshToBox SidePanelLongMesh2,60,1,180:PositionEntity SidePanelLongMesh2,81,-18,0:RotateEntity SidePanelLongMesh2,0,0,90
ScaleMeshToBox SidePanelShortMesh1,60,1,90:PositionEntity SidePanelShortMesh1,35.81,-18,-90:RotateEntity SidePanelShortMesh1,0,90,90
ScaleMeshToBox SidePanelShortMesh2,60,1,90:PositionEntity SidePanelShortMesh2,35.81,-18,90:RotateEntity SidePanelShortMesh2,0,90,90
PositionEntity Axle(1),EntityX(Gear(10)),EntityY(Gear(10)),EntityZ(Gear(10)):ScaleEntity Axle(1),1,42,1
PositionEntity Axle(2),EntityX(Gear(5)),EntityY(Gear(5)),EntityZ(Gear(5)):ScaleEntity Axle(2),2,13,2
PositionEntity Axle(3),EntityX(Gear(30)),EntityY(Gear(30)),EntityZ(Gear(30)):RotateEntity Axle(3),180,0,0:ScaleEntity Axle(3),1,10,1
PositionEntity Axle(4),EntityX(Gear(33)),EntityY(Gear(33)),EntityZ(Gear(33)):RotateEntity Axle(4),180,0,0:ScaleEntity Axle(4),1,6,1
PositionEntity Axle(5),EntityX(Gear(15)),EntityY(Gear(15)),EntityZ(Gear(15)):RotateEntity Axle(5),180,0,0:ScaleEntity Axle(5),1,25,1
PositionEntity Axle(6),EntityX(Gear(16)),EntityY(Gear(16)),EntityZ(Gear(16)):RotateEntity Axle(6),180,0,0:ScaleEntity Axle(6),1,22,1
PositionEntity Axle(7),EntityX(Gear(14)),EntityY(Gear(14)),EntityZ(Gear(14)):ScaleEntity Axle(7),1,8.5,1
PositionEntity Axle(8),EntityX(Gear(9)),EntityY(Gear(9)),EntityZ(Gear(9)):ScaleEntity Axle(8),1,8.5,1
PositionEntity Axle(9),EntityX(Gear(26)),EntityY(Gear(26)),EntityZ(Gear(26)):ScaleEntity Axle(9),2,7,2
PositionEntity Axle(10),EntityX(Gear(19)),EntityY(Gear(19)),EntityZ(Gear(19)):ScaleEntity Axle(10),1,18,1
PositionEntity Axle(11),EntityX(Gear(2)),EntityY(Gear(2)),EntityZ(Gear(2)):ScaleEntity Axle(11),2,8.5,2
EntityParent Axle(1),Gear(10)
EntityParent Axle(2),Gear(5)
EntityParent Axle(3),Gear(30)
EntityParent Axle(4),Gear(33)
EntityParent Axle(5),Gear(15)
EntityParent Axle(6),Gear(17)
EntityParent Axle(7),Gear(14)
EntityParent Axle(8),Gear(8)
EntityParent Axle(9),Gear(26)
EntityParent Axle(10),Gear(19)
EntityParent Axle(11),Gear(2)
PositionEntity Camera,20,0,-200
PositionEntity CameraPivot,EntityX(Gear(5)),EntityY(Gear(5)),EntityZ(Gear(5)):PointEntity Camera,CameraPivot
EntityParent Camera,CameraPivot
RotateEntity CameraPivot,-20,0,0
PositionEntity Light1,0,-100,0:RotateEntity Light1,-90,0,0
PositionEntity Light2,0,100,0:RotateEntity Light2,90,0,0
End Sub
Sub SetUpBronzeGearTextures()
EntityTexture CrankMesh,CrankTex
EntityTexture Gear(1),CrownGearTex
For g as integer=2 To 33
EntityTexture Gear(g),BronzeGearTex(GearTeeth(g))
Next
For a as integer=1 To 11:EntityTexture Axle(a),BronzeTex:Next
End Sub
Sub SetUpPolkaDotTextures()
For g as integer=1 To 33
EntityTexture Gear(g),PolkaDotTex(GearPolkaDot(g))
Next
For a as integer=1 To 11
EntityTexture Axle(a),PolkaDotTex(AxlePolkaDot(a))
Next
End Sub
Sub UpdateTransparencies()
For a as integer=1 To 6
If AlphaToggle(a)=1 Then
AlphaValue(a)=AlphaValue(a)+0.025
If AlphaValue(a)>1 Then AlphaValue(a)=1
Else
AlphaValue(a)=AlphaValue(a)-0.025
If AlphaValue(a)<0 Then AlphaValue(a)=0
EndIf
'Side Panels
If a=1 Then
EntityAlpha SidePanelLongMesh1,AlphaValue(a)
EntityAlpha SidePanelLongMesh2,AlphaValue(a)
EntityAlpha SidePanelShortMesh1,AlphaValue(a)
EntityAlpha SidePanelShortMesh2,AlphaValue(a)
EndIf
'Front/Back Panels
If a=2 Then
EntityAlpha FrontPanelMesh,AlphaValue(a)
EntityAlpha RearPanelMesh,AlphaValue(a)
EndIf
'Base Plate
If a=3 Then
EntityAlpha BasePlateMesh,AlphaValue(a)
EndIf
'Gears+Pointers
If a=4 Then
For g as integer=1 To 33
EntityAlpha Gear(g),AlphaValue(a)
Next
EntityAlpha SunPointerMesh,AlphaValue(a)
EntityAlpha MoonPointerMesh,AlphaValue(a)
EntityAlpha FourYearPointerMesh,AlphaValue(a)
EntityAlpha SynodicMonthPointerMesh,AlphaValue(a)
EndIf
'Axles
If a=5 Then
For g as integer=1 To 11
EntityAlpha Axle(g),AlphaValue(a)
Next
EndIf
If a=6 Then
For tc as integer=1 To 132
EntityAlpha ToothCount(tc),AlphaValue(a)
Next
EntityAlpha SunAndMoonSprite,AlphaValue(a)
EntityAlpha SynodicMonthSprite,AlphaValue(a)
EntityAlpha FourYearSprite,AlphaValue(a)
EndIf
Next
End Sub
Sub UpdateGear(g as integer,direction as single) ' negative direction is clockwise
If direction=0 Then Return
For l as integer=1 To 4
If GearLink(g,l)<>0 And GearTurned(GearLink(g,l))=False Then
dim a1 as single=GearTeeth(g): dim a2 as single=GearTeeth(GearLink(g,l)):dim ratio as single=a1/a2
GearAmtTurned(GearLink(g,l))=direction*GearLinkDir(g,l)*ratio
If GearLinkDir(g,l)=2 Then GearAmtTurned(GearLink(g,l))=direction
TurnEntity Gear(GearLink(g,l)),0,GearAmtTurned(GearLink(g,l)),0
GearTurned(GearLink(g,l))=True
EndIf
Next
End Sub
Sub TurnGears(InputGear as integer,direction as single) 'negative direction is clockwise
For a as integer=1 To 50:GearTurned(a)=False:GearAmtTurned(a)=0:Next
TurnEntity Gear(InputGear),0,direction,0:GearTurned(InputGear)=True:GearAmtTurned(InputGear)=direction
'links to input gear
For g2 as integer=1 To Numgears
For g as integer=1 To NumGears
UpdateGear(g,GearAmtTurned(g))
Next
If g2=6 Then UpdateGear(23,(GearAmtTurned(26)+GearAmtTurned(19))/2)
Next
End Sub
SetUpScene
SetUpBronzeGearTextures
setmouse 400,300,0
While Not MultiKey(1)
dim kk as integer=asc(inkey)
if kk=asc("1") then AlphaToggle(1)=1-AlphaToggle(1)
if kk=asc("2") then AlphaToggle(2)=1-AlphaToggle(2)
if kk=asc("3") then AlphaToggle(3)=1-AlphaToggle(3)
if kk=asc("4") then AlphaToggle(4)=1-AlphaToggle(4)
if kk=asc("5") then AlphaToggle(5)=1-AlphaToggle(5)
if kk=asc("6") then AlphaToggle(6)=1-AlphaToggle(6)
If kk=asc("G") Or kk=asc("g") Then
TargetGear=TargetGear+1
If TargetGear>33 Then TargetGear=1
PositionEntity CameraPivot,EntityX(Gear(TargetGear)),EntityY(Gear(TargetGear)),EntityZ(Gear(TargetGear))
EndIf
If kk=asc("B") Or kk=asc("b") Then
If BronzeTexture=True Then BronzeTexture=False Else BronzeTexture=True
If BronzeTexture=True Then SetUpBronzeGearTextures Else SetUpPolkaDotTextures
EndIf
If kk=Asc("T") Or kk=Asc("t") Then
TurnSpeed=TurnSpeed+1
If TurnSpeed>3 Then TurnSpeed=1
EndIf
'MOUSE CONTROLS
dim mx as integer, my as integer, mousedown as integer
getmouse mx, my, ,mousedown
mx-=400: my-=300
if mousedown=0 then
TurnEntity CameraPivot,-my,-mx,0
else
MoveEntity Camera,0,0,-my
If EntityDistance(Camera,CameraPivot)<5 Or EntityDistance(Camera,CameraPivot)>200 Then MoveEntity Camera,0,0,my
end if
setmouse 400,300,0
If MultiKey(&h4d) Then TurnGears(1,-1*(TurnSpeed^2)) 'right arrow, clockwise
If MultiKey(&h4b) Then TurnGears(1,TurnSpeed^2) 'left arrow, counterclockwise
Dim c as integer=0
If kk=Asc("q") Then c=1
If kk=Asc("a") Then c=-1
If c<>0 Then
EntityAlpha Gear(CurrGear),1
CurrGear=CurrGear+c
If Currgear>NumGears Then CurrGear=1
If CurrGear<1 Then CurrGear=NumGears
EntityAlpha Gear(CurrGear),1
EndIf
UpdateTransparencies
UpdateWorld
RenderWorld
sleep 1
flip
Wend
It also requires the 3d models and the textures from the original package (it is freeware, but since there is no license file I prefer not to republish it)