'********************************************************
'* NOT FINISHED YET - VARIANT FOR TESTING               *
'* SDRING.bas is a DeltaCad macro for producing a       *
'* Ring Sundial                                         *
'* with Longitude Correction and EOT correction.        *
'* Design and DeltaCad macro by                         *
'* Wee-Meng Lee (leewm@starhub.net.sg) and              *
'* Valentin Hristov (valhrist@bas.bg)                   *
'* who was inspired by Mac Oglesby to use               *
'* The North American Sundial Society DeltaCad programs *
'* as tutorials (http://sundials.org)                   *
'* This version was finished in January 2007            *
'********************************************************
Option Explicit ' Force all variables to be declared before they are used. No adhoc variables

Dim pi,d2r,r2d,dm,dmr,w,m,x,y,x1,y1,x2,y2,dmm,h,hr,sh,ch As Double
Dim radius,mm,cm as Double
Dim decl(366),eot(366),spl(74) As Double

Dim outtext,p,datetext(13),mon(13) as String

Dim count,ind(37) As Integer

dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcSetCircleParms dcBLACK, dcSOLID, dcTHIN

'Establish the 5 standard line thicknesses in thousands of an inch.
dcSetDrawingData dcLineThin,   .003
dcSetDrawingData dcLineNormal, .008
dcSetDrawingData dcLineThick,  .012
dcSetDrawingData dcLineHeavy,  .024
dcSetDrawingData dcLineWide,   .048

'Maximize the window, close any existing drawing without saving, and start a new drawing.
dcSetDrawingWindowMode dcMaximizeWin
dcCloseWithoutSaving
dcNew ""


'**************************************

'Start of program
init_constants
DateLine
Hours
Latitude
EquationOfTime
Perpendicular

'**************************************
'Start of subroutines

Sub init_constants
pi = 4 * Atn(1)
d2r = pi/180
r2d = 180/pi
dm = 23.43954
dmr = dm*d2r

for count=1 to 365
w=.017202792*(count-(cm-15)/360)
decl(count)=.367402-23.275*cos(w+.178044)-.38506*cos(2*w+.0687076)-.16046*cos(3*w+.451301)+.00315469*cos(4*w+.876643)
next count
decl(366)=decl(1)

for count=1 to 365
w=.017202792*(count-(cm-15)/360)
eot(count)=.00884207-7.36034*cos(w+1.49487)+9.91068*cos(2*w-1.21808)-.306344*cos(3*w+1.82055)+.204774*Cos(4*w-.875115)
next count
eot(366)=eot(1)

ind( 1)=  1 '1Jan
ind( 2)= 11
ind( 3)= 21
ind( 4)= 32 '1Feb
ind( 5)= 42
ind( 6)= 52
ind( 7)= 60 '1Mar
ind( 8)= 70
ind( 9)= 80
ind(10)= 91 '1Apr
ind(11)=101
ind(12)=111
ind(13)=121 '1May
ind(14)=131
ind(15)=141
ind(16)=152 '1Jun
ind(17)=162
ind(18)=172
ind(19)=182 '1Jul
ind(20)=192
ind(21)=202
ind(22)=213 '1Aug
ind(23)=223
ind(24)=233
ind(25)=244 '1Sep
ind(26)=254
ind(27)=264
ind(28)=274 '1Oct
ind(29)=284
ind(30)=294
ind(31)=305 '1Nov
ind(32)=315
ind(33)=325
ind(34)=335 '1Dec
ind(35)=345
ind(36)=355
ind(37)=366 '1Jan

datetext( 1) = "JAN"
datetext( 2) = "FEB"
datetext( 3) = "MAR"
datetext( 4) = "APR"
datetext( 5) = "MAY"
datetext( 6) = "JUN"
datetext( 7) = "JUL"
datetext( 8) = "AUG"
datetext( 9) = "SEP"
datetext(10) = "OCT"
datetext(11) = "NOV"
datetext(12) = "DEC"
datetext(13) = "JAN"

mon( 1) = "J"
mon( 2) = "F"
mon( 3) = "M"
mon( 4) = "A"
mon( 5) = "M"
mon( 6) = "J"
mon( 7) = "J"
mon( 8) = "A"
mon( 9) = "S"
mon(10) = "O"
mon(11) = "N"
mon(12) = "D"
mon(13) = "J"

End Sub

Sub DateLine

dcCreateCircle 4,3.5,2.4

'draw the date line for 1st of month
m=2*Tan(dmr)+.05
dcCreateLine 4.03,3.5+m,4.03,3.5-m
dcCreateLine 3.97,3.5+m,3.97,3.5-m
dcCreateLine 3.97,3.5+m,4.03,3.5+m
dcCreateLine 3.97,3.5-m,4.03,3.5-m
dcCreateLine 3.6,4.735,3.6,2.265
dcCreateLine 4.4,4.735,4.4,2.265

dcSetLineParms dcBLACK, dcSOLID, dcTHICK
dcSetTextParms dcDarkgreen, "Times New Roman","Standard",0,7,4,0,0
'date marks
for count = 1 To 16 step 3
 x1 = 4.07
 y1 = 3.5+2*Tan(decl(ind(count))*d2r)
 x2 = 4.03
 y2 = y1
 dcCreateLine x1,y1,x2,y2
 x1 = 4.1
 outtext = "1 " + datetext((count+2)/3)
 dcCreateText x1,y1,0,outtext
next count
dmm=2*Tan(dmr)+3.5
dcCreateText 4.05,dmm+.06,0,"21 JUN"
dcCreateLine 4.03,dmm,4.1,dmm
dcSetLineParms dcBLACK, dcSOLID, dcTHIN
For count = 1 To 17
 x1 = 4.07
 y1 = 3.5+2*Tan(decl(ind(count))*d2r)
 x2 = 4.03
 y2 = y1
 dcCreateLine x1,y1,x2,y2
 if count=5 or count=8 or count=11 or count=14 then
  dcCreateText 4.1,y1,0,"11"
 end if
 if count=6 or count=9 or count=12 or count=15 then
  dcCreateText 4.1,y1,0,"21"
 end if
next count

dcSetLineParms dcBLACK, dcSOLID, dcTHICK
dcSetTextParms dcDarkgreen, "Times New Roman","Standard",180,7,4,0,0
for count = 19 To 34 step 3
 x1 = 3.93
 y1 = 3.5+2*Tan(decl(ind(count))*d2r)
 x2 = 3.97
 y2 = y1
 dcCreateLine x1,y1,x2,y2
 x1 = 3.9
 outtext = "1 " + datetext((count+2)/3)
 dcCreateText x1,y1,0,outtext
next count
dmm=3.5-2*Tan(dmr)
dcCreateText 3.95,dmm-.06,0,"23 DEC"
dcCreateLine 3.97,dmm,3.9,dmm
dcSetLineParms dcBLACK, dcSOLID, dcTHIN
for count = 19 To 36
 x1 = 3.93
 y1 = 3.5+2*Tan(decl(ind(count))*d2r)
 x2 = 3.97
 y2 = y1
 dcCreateLine x1,y1,x2,y2
 if count=23 or count=26 or count=29 or count=32 then
  dcCreateText 3.9,y1,0,"11"
 end if
 if count=24 or count=27 or count=30 or count=33 then
  dcCreateText 3.9,y1,0,"21"
 end if
next count

dcCreateLine 3.8,4.79,4,4.55
dcCreateLine 4.2,2.21,4,2.45
dcCreateLine 5.79,3.7,5.6,3.5
dcCreateLine 2.21,3.3,2.4,3.5
dcSetLineParms dcRED, dcSTITCH, dcTHIN
dcCreateLine 4,4.8,4,4.55
dcCreateLine 4,2.2,4,2.45
dcCreateLine 5.8,3.5,5.6,3.5
dcCreateLine 2.2,3.5,2.4,3.5
dcSetLineParms dcBLACK, dcSOLID, dcTHIN

'Sliding part

dcCreateLine 0,7.04,0,6.96
dcCreateLine -.04,7,.04,7
dcCreateCircle 0,7,.04

dcCreateLine -.4,7.3,.4,7.3
dcCreateLine -.4,6.7,.4,6.7
dcCreateLine -.4,6.7,-.7,7
dcCreateLine -.4,7.3,-.7,7
dcCreateLine .4,6.7,.7,7
dcCreateLine .4,7.3,.7,7
dcSetLineParms dcBLACK, dcSTITCH, dcTHIN
dcCreateLine -.4,6.8,-.4,7.2
dcCreateLine .4,6.8,.4,7.2

End Sub

Sub Hours
dcSetTextParms dcDarkgreen, "Times New Roman","Standard",0,10,21,0,0
dcCreateText 0,2.6,0,"This Hour Ring faces Celestial North"
dcCreateText 0,4.2,0,"This Hour Ring faces Celestial South"
dcCreateText 0,3.8,0,"Wee-Meng Lee   leewm@starhub.net.sg"
dcCreateText 0,3.6,0,"http://leewm.freeshell.org/origami/"
dcCreateText 0,3.2,0,"Valentin Hristov   valhrist@bas.bg"
dcCreateText 0,3.0,0,"www.math.bas.bg/complan/valhrist/mystuff.htm"
dcSetTextParms dcDarkgreen, "Times New Roman","Standard",180,7,4,0,0

dcSetLineParms dcBLACK, dcSOLID, dcTHIN

dcCreateCircle 0,0,2
dcCreateCircleEx 0,0,2.38,.3,-2.38,.3,2.4,2.4,0
dcCreateCircleEx 0,0,-2.38,-.3,2.38,-.3,2.4,2.4,0
dcSetLineParms dcBlack,dcSolid,dcThick
for count=0 to 23.999 step 1
h=-count*15
hr=h*d2r
sh=sin(hr)
ch=cos(hr)
x=2*ch
y=2*sh
dcCreateLine x,y,x*1.05,y*1.05
dcSetTextParms dcRed, "Times New Roman","Standard",-90+h,10,5,0,0
dcCreateText x*1.162,y*1.162,0,CStr(count+1)
dcSetTextParms dcBlue, "Times New Roman","Standard",90+h,10,5,0,0
dcCreateText x*1.092,y*1.092,0,CStr(count)
next count

dcSetLineParms dcBlack,dcSolid,dcNormal
for count=0 to 23.999 step .5
h=-count*15
hr=h*d2r
sh=sin(hr)
ch=cos(hr)
x=2*ch
y=2*sh
dcCreateLine x,y,x*1.03,y*1.03
next count

dcSetLineParms dcBlack,dcSolid,dcThin
for count=0 to 23.999 step .25
h=-count*15
hr=h*d2r
sh=sin(hr)
ch=cos(hr)
x=2*ch
y=2*sh
dcCreateLine x,y,x*1.02,y*1.02
next count

'Back Hour Scale

'dcSetCircleParms dcBlack,dcStitch,dcThin
'dcCreateCircle 0,7,2.4
dcSetCircleParms dcBlack,dcSolid,dcThin
dcCreateCircle 0,7,2

for count=0 to 23.999 step 1
h=count*15
hr=h*d2r
sh=sin(hr)
ch=cos(hr)
x=2*ch
y=2*sh
dcSetLineParms dcBlack,dcSolid,dcThick
dcCreateLine x,7+y,x*1.05,7+y*1.05
dcSetTextParms dcRed, "Times New Roman","Standard",-90+h,10,5,0,0
dcCreateText x*1.165,7+y*1.165,0,CStr(count+1)
dcSetTextParms dcBlue, "Times New Roman","Standard",90+h,10,5,0,0
dcCreateText x*1.095,7+y*1.095,0,CStr(count)
dcSetLineParms dcBlack,dcSolid,dcThin
if count<>int(count/2)*2 then
 hr=(h+3.75)*d2r
 sh=sin(hr)
 ch=cos(hr)
 x1=2.4*ch
 y1=2.4*sh
 dcCreateLine x1,7+y1,1.1*x1,7+1.1*y1
 hr=(h-3.75)*d2r
 sh=sin(hr)
 ch=cos(hr)
 x2=2.4*ch
 y2=2.4*sh
 dcCreateLine x2,7+y2,1.1*x2,7+1.1*y2
 dcCreateLine 1.1*x1,7+1.1*y1,1.1*x2,7+1.1*y2
 dcSetCircleParms dcBlack,dcStitch,dcThin
 dcCreateCircleEx 0,7,x2,7+y2,x1,7+y1,2.4,2.4,0,0
 dcSetCircleParms dcBlack,dcSolid,dcThin
 hr=(h+26.25)*d2r
 sh=sin(hr)
 ch=cos(hr)
 x2=2.4*ch
 y2=2.4*sh
 dcCreateCircleEx 0,7,x1,7+y1,x2,7+y2,2.4,2.4,0,0
end if
next count

dcSetLineParms dcBlack,dcSolid,dcNormal
for count=0 to 23.999 step .5
h=count*15
hr=h*d2r
sh=sin(hr)
ch=cos(hr)
x=2*ch
y=2*sh
dcCreateLine x,7+y,x*1.03,7+y*1.03
next count

dcSetLineParms dcBlack,dcSolid,dcThin
for count=0 to 23.999 step .25
h=count*15
hr=h*d2r
sh=sin(hr)
ch=cos(hr)
x=2*ch
y=2*sh
dcCreateLine x,7+y,x*1.02,7+y*1.02
next count

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Latitude

dcCreateCircleEx 4,3.5,5.79,3.7,2.2,3.5,1.8,1.8,0,0
dcCreateCircleEx 4,3.5,2.21,3.3,4.8,3.5,1.8,1.8,0,0

dcCreateCircleEx 4,3.5,3.8,4.79,4,2.2,1.3,1.3,0,0
dcCreateCircleEx 4,3.5,4.2,2.21,4,4.8,1.3,1.3,0,0

dcSetLineParms dcBLACK, dcSOLID, dcTHICK
for count=-90 to 90 step 15
if count<0 then
 p=" S"
else
 if count>0 then
  p=" N"
 else
  p=""
 end if
end if
dcSetTextParms dcBlue, "Times New Roman","Standard",-90+count,10,5,0,0
x1=1.3*cos(count*d2r)
y1=1.3*sin(count*d2r)
x2=1.4*x1/1.3
y2=1.4*y1/1.3
dcCreateLine 4+x1,3.5+y1,4+x2,3.5+y2
dcCreateText 4+x1*1.55/1.3,3.5+y1*1.55/1.3,0,CStr(abs(count))+p
x2=1.8*x1/1.3
y2=1.8*y1/1.3
x1=1.7*x1/1.3
y1=1.7*y1/1.3
dcCreateLine 4+x1,3.5+y1,4+x2,3.5+y2
next count

dcSetLineParms dcBLACK, dcSOLID, dcTHIN
for count=-90 to 90 step 5
x1=1.3*cos(count*d2r)
y1=1.3*sin(count*d2r)
x2=1.35*x1/1.3
y2=1.35*y1/1.3
dcCreateLine 4+x1,3.5+y1,4+x2,3.5+y2
x2=1.8*x1/1.3
x2=1.8*x1/1.3
y2=1.8*y1/1.3
x1=1.75*x1/1.3
y1=1.75*y1/1.3
if abs(count)>3 then dcCreateLine 4+x1,3.5+y1,4+x2,3.5+y2
next count

End Sub


Sub EquationOfTime

dcSetLineParms dcPurple, dcSOLID, dcTHIN
dcSetSplineParms dcPurple, dcSOLID, dcTHIN

For m=-15 To 15 Step 5
mm=M/4*d2r
'mm=(90+M/4)*d2r
x1=2*Cos(mm)
y1=2*Sin(mm)
x2=3.132*Cos(mm)
y2=3.132*Sin(mm)
dcCreateLine x1,y1,x2,y2
Next m

For m=-50 To 50 Step 5
mm=m*d2r
x1=2*Cos(mm)
y1=2*Sin(mm)
x2=1.9*Cos(mm)
y2=1.9*Sin(mm)
dcCreateLine 4+x1,3.5+y1,4+x2,3.5+y2
dcSetTextParms dcPurple, "Times New Roman","Bold",90+m,6,21,0,0
dcCreateText 4+1.85*cos(mm),3.5+1.85*sin(mm),0,abs(m)
Next m

For m=-50 To 50
mm=m*d2r
x1=2*Cos(mm)
y1=2*Sin(mm)
x2=1.95*Cos(mm)
y2=1.95*Sin(mm)
dcCreateLine 4+x1,3.5+y1,4+x2,3.5+y2
Next m
dcSetTextParms dcPurple, "Times New Roman","Bold",90,7,21,0,0
dcCreateText 5.9,3.42,0,"E"
dcCreateText 5.9,3.58,0,"W"
dcSetCircleParms dcPurple,dcSolid,dcThin
dcCreateCircleEx 4,3.5,4+cos(50*d2r),3.5-sin(50*d2r),4+cos(50*d2r),3.5+sin(50*d2r),2,2,0,0

dcCreateLine 6,3.5,6.4,3.5
dcCreateText 6.1,3.5,0,"Central Meridian"
dcCreateText 6.2,3.5,0,"of the Time Zone"
dcSetTextParms dcPurple, "Times New Roman","Bold",45,7,21,0,0
dcCreateText 4+2.1*cos(45*d2r),3.5-2.1*sin(45*d2r),0,"to East from the Central Meridian"
dcSetTextParms dcPurple, "Times New Roman","Bold",135,7,21,0,0
dcCreateText 4+2.1*cos(45*d2r),3.5+2.1*sin(45*d2r),0,"to West from the Central Meridian"

For count=1 To 37
radius=2.4+.002*ind(count)
spl(2*count-1)=radius*Cos(eot(ind(count))/4*d2r)
spl(2*count)=radius*Sin(eot(ind(count))/4*d2r)
Next count

dcCreateSpline spl(1),37,False

dcSetCircleParms dcPurple,dcSolid,dcThin
For count=1 To 37 step 3
radius=2.4+.002*ind(count)
dcCreateCircleEx 0,0,cos(-3.75*d2r),sin(-3.75*d2r),cos(3.75*d2r),sin(3.75*d2r),radius,radius,0,0
if count<37 then
 dcSetTextParms dcPurple, "Times New Roman","Standard",0,5,21,0,0
 dcCreateText (2.43+.002*ind(count))*cos(4.7*d2r),(2.43+.002*ind(count))*sin(4.7*d2r),0,mon((count+2)/3)
 dcSetTextParms dcPurple, "Times New Roman","Standard",180,5,21,0,0
 dcCreateText (2.43+.002*ind(count))*cos(4.7*d2r),-(2.43+.002*ind(count))*sin(4.7*d2r),0,mon((count+2)/3)
end if
Next count

dcSetTextParms dcPurple, "Times New Roman","Standard",90,5,21,0,0
dcCreateText 3.167,.08,0,"fast"
dcCreateText 3.167,-.095,0,"slow"
dcSetTextParms dcPurple, "Times New Roman","Standard",0,6,21,0,0
dcCreateText -2.8,.2,0,"Design and"
dcCreateText -2.8,.08,0,"DeltaCad macro:"
dcCreateText -2.8,-.08,0,"Wee-Meng Lee and"
dcCreateText -2.8,-.2,0,"Valentin Hristov"

dcCreateLine 2.38,.3,3.2,.3
dcCreateLine 2.38,-.3,3.2,-.3
dcCreateLine 3.2,.3,3.2,-.3
dcCreateLine -2.38,.3,-3.2,.3
dcCreateLine -2.38,-.3,-3.2,-.3
dcCreateLine -3.2,.3,-3.2,-.3

End Sub

Sub Perpendicular

dcSetLineParms dcBLACK, dcSTITCH, dcTHIN

dcCreateLine 5.25,1,5.25,.4
dcCreateLine 5.25,6,5.25,6.6

dcSetLineParms dcBLACK, dcSOLID, dcTHIN

dcCreateLine 4.2,1,4.2,.4
dcCreateLine 6.3,1,6.3,.4
dcCreateLine 4.2,.7,4.8,.7
dcCreateLine 5.6,.7,6.3,.7
dcCreateLine 4.2,1,6.3,1
dcCreateLine 4.2,.4,6.3,.4
dcCreateLine 4.7,.85,4.7,1
dcCreateLine 4.7,.55,4.7,.4
dcCreateLine 5.8,.85,5.8,.7
dcCreateLine 5.8,.55,5.8,.7

dcCreateLine 4.2,6,4.2,6.6
dcCreateLine 6.3,6,6.3,6.6
dcCreateLine 4.2,6.3,4.8,6.3
dcCreateLine 5.6,6.3,6.3,6.3
dcCreateLine 4.2,6,6.3,6
dcCreateLine 4.2,6.6,6.3,6.6
dcCreateLine 4.7,6.15,4.7,6
dcCreateLine 4.7,6.45,4.7,6.6
dcCreateLine 5.8,6.15,5.8,6.3
dcCreateLine 5.8,6.45,5.8,6.3

End Sub