'********************************************************
'* NOT FINISHED YET - VARIANT FOR TESTING               *
'* SDBoxNP.bas is a DeltaCad macro for producing a      *
'* Pocket Folding Polar Nodus Box Gnomonless Sundial    *
'* with Longitude Correction and EOT Correction.        *
'* Created by Valentin Hristov (valhrist@bas.bg).       *
'* Two cuts on the edges are used as a nodus.           *
'* I was inspired by Mac Oglesby to use the             *
'* North American Sundial Society DeltaCad programs     *
'* as tutorials (http://sundials.org)                   *
'* and made with DeltaCad (www.deltacad.com)            *
'* different types of sundials.                         *
'********************************************************

'* Please, read not only the lines below, but also the file sdboxarb.txt
'* in the .zip package for more important details.

'* To assemble the sundial, cut along the solid lines, make mountain folds
'* along the lines with long dashes, and valley folds along the lines
'* with short dashes.

'* Printing landscape on A4 paper gives a really portable sundial.
'* You can use a copy machine to enlarge to A3 if you wish to have
'* a bigger size.

'* If you want to use the sundial at different places, then it is
'* suitable to give zero values for latitude, longitude, and central
'* meridian. The Equation Of Time will be included, but you will have to
'* make correction for the longitude with respect to the central meridian
'* of the time zone (1 gegree = 4 minutes). While cutting keep the
'* semi-circles with the degrees in order to be able to adjust the slope
'* for the latitude by suitable folding.

'* You can see the picture of another type of sundial generated by one
'* of my DeltaCad macros at
'* www.flickr.com/photos/Valentin_Hristov/261303801/
'* Click on the button "All sizes" to see a bigger photo with details.
'* I am very grateful to my friends Daniela (www.danyo.net) and
'* Todor (www.todor.org) who converted my drawing into a real art piece!!!

'* There is a Demo version of DeltaCad at www.deltacad.com.
'* Use the menu "Options - Macro - Run..." or the separate "Macro"
'* button - "Edit Macro List", add the file, and "Run Macro".
'* In the dialog box use DECIMAL DEGREES. Negative values indicate
'* South for latitude and West for longitude and central meridian.

'* E N J O Y !!!

Option Explicit ' Force all variables to be declared before they are used. No adhoc variables

dcSetLineParms dcBlack, dcSolid, dcThin

Dim l,p,lon,cm,rot,i,pi,d2r,r2d,dm,dmr,w,ll,ud,lol,s,cs As Double
Dim ha,ham,ham1,has,has1,lc,hac,tir,hacr,thac,xe,ye,xb,yb As Double
Dim x,y,d,h,lcr,slc,clc,lr,sl,cl,dr,sd,cd,ir,si,ci As Double
Dim xN0,yN0,zN0,xZ0,yZ0,zZ0,xZZ0,yZZ0,zZZ0,rr,sr,cr as Double
Dim xNN0,yNN0,zNN0,lNN0,xNN,yNN,xpr,ypr,zpr,dsr,sds,cds as Double
Dim lpr0,xpr0,ypr0,zpr0,lpr1,xpr1,ypr1,zpr1,cg,gr,g,sg as Double
Dim x0,y0,z0,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,shac,chac as Double
Dim beta,betar,sb,cb,feot,flon,ceot,clon as Double

Dim decl(366),eot(366),spl(732) As Double

Dim button,count,nl,ind(37),ind1,spring,nom,bb,ee As Integer

Dim outtext As String

Dim bm(13),datetext(13) As String

Dim hhv,hhb,hhe,nlcheck As Boolean


dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcSetCircleParms dcBLACK, dcSOLID, dcTHIN
dcSetTextParms dcPurple, "Tahoma","Bold",0,12,21,0,0

'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
call sundial
'*************
Sub Sundial
init_constants
Input_constants_of_sundial
if button=0 then goto cncl
Angles
'Vectors
'Preparation
Main
Latitude
'Pieces
'dcViewAll  ' view the whole drawing
cncl:
End Sub
'End of program
'*************

'**************************************
'Start of subroutines
'''''''''''''''''''''''''''''''''''''''
Sub Input_constants_of_sundial
Begin Dialog CONSTANTS_INPUT 13,15,200,178, "Input data for the sundial"
 Text 15,0,180,10, "POLAR NODUS BOX SUNDIAL"
 Text 15,8,180,10, "with corrections for the latitude and the EOT"
 Text 15,20,150,10, "Place"
 TextBox 88,20,99,10, .p
 Text 15,32,180,10, "Latitude(N>0)  Longitude(E>0)  Central meridian(E>0)"
 TextBox 15,44,30,10, .l
 TextBox 65,44,30,10, .lon
 TextBox 115,44,30,10, .cm
 Text 15,56,150,10, "  Use decimal degrees !!!"
 Text 15,74,150,10, "Period"
 OptionGroup .per
 OptionButton 50,68,85,10, "21 December - 21 June"
 OptionButton 50,80,85,10, "21 June - 21 December"

 Text 15,104,150,10, "Time interval"
 OptionGroup .time_int
 OptionButton 70,92,45,10, "15 minutes"
 OptionButton 70,104,45,10, "30 minutes"
 OptionButton 70,116,85,10, "60 minutes"

 Text 15,128,150,10, "EOT correction"
 OptionGroup .eot_c
 OptionButton 20,140,30,10, "Yes"
 OptionButton 20,152,30,10, "No"

 Text 115,128,150,10, "Longitude correction"
 OptionGroup .lon_c
 OptionButton 120,140,30,10, "Yes"
 OptionButton 120,152,30,10, "No"

 OKButton 42,164,37,12
 CANCELButton 116,164,37,12
End Dialog

'Initialize 
Dim prompt As constants_input

prompt.p = "Lozen-Sofia-Bulgaria"
prompt.l = 42.6
prompt.lon = 23.5
prompt.cm = 30

repeat_until_inputcorrect: 'label to return if input is not correct

button=Dialog(prompt)

If (button=0) Then GoTo end_input

If test("l",prompt.l,-90,90) = false Then
  GoTo repeat_until_inputcorrect
End If
If test("lon",prompt.lon,-180,180) = false Then
  GoTo repeat_until_inputcorrect
End If
If test("cm",prompt.cm,-180,180) = false Then
  GoTo repeat_until_inputcorrect
End If
'If test("d",prompt.d,-180,180) = false Then
'  GoTo repeat_until_inputcorrect
'End If
'If test("i",prompt.i,0,180) = false Then
'  GoTo repeat_until_inputcorrect
'End If
'If test("rot",prompt.rot,-90,90) = false Then
'  GoTo repeat_until_inputcorrect
'End If
'nlcheck = false
'if nl = 1 or nl = 2 or nl = 4 then nlcheck = true
'if nlcheck = false then
' GoTo repeat_until_inputcorrect
'end if

'Set program variables with input variables, angles in degrees
p = prompt.p
l = prompt.l
lon = prompt.lon
cm = prompt.cm
'd = prompt.d
d=0
'i = prompt.i
i=l
'rot=prompt.rot
rot=0
'nl=prompt.nl
nl=4

'per=CBool(0)
'time_int=CBool(0)
'eotc=CBool(0)
'lonc=CBool(0)

if prompt.per=0 then spring=1 else spring=0
if prompt.time_int=0 then nl=4
if prompt.time_int=1 then nl=2
if prompt.time_int=2 then nl=1
if prompt.eot_c=0 then feot=1 else feot=0
if prompt.lon_c=0 then flon=1 else flon=0


'feot=prompt.feot
'flon=prompt.flon
'without "+0" does not work ?!?

'if feot<>0 then feot=1
'if flon<>0 then flon=1

end_input:

End Sub

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

bm( 1)=  1 '1jan
bm( 2)= 32 '1feb
bm( 3)= 60
bm( 4)= 91
bm( 5)=121
bm( 6)=152
bm( 7)=182
bm( 8)=213
bm( 9)=244
bm(10)=274
bm(11)=305
bm(12)=335 '1dec
bm(13)=366 '1jan

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

datetext( 1) = "J"
datetext( 2) = "F"
datetext( 3) = "M"
datetext( 4) = "A"
datetext( 5) = "M"
datetext( 6) = "J"
datetext( 7) = "J"
datetext( 8) = "A"
datetext( 9) = "S"
datetext(10) = "O"
datetext(11) = "N"
datetext(12) = "D"
datetext(13) = "J"
'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"
End Sub

Sub Angles

lc=lon-cm    'longitude correction
lcr=lc*d2r   'longitude correction in radians
slc=sin(lcr) 'sin(longitude correction)
clc=cos(lcr) 'cos(longitude correction)

lr=l*d2r     'longitude in radians
sl=sin(lr)   'sin(latitude)
cl=cos(lr)   'cos(latitude)

dr=d*d2r     'declination in radians
sd=sin(dr)   'sin(declination)
cd=cos(dr)   'cos(declination)

ir=i*d2r     'inclination in radians
si=sin(ir)   'sin(inclination)
ci=cos(ir)   'cos(inclination)

rr=rot*d2r   'rotation in radians
sr=sin(rr)   'sin(rotation)
cr=cos(rr)   'cos(rotation)

End Sub

Sub Vectors
'Celestial North
xN0=0
yN0=0
zN0=1
' 0 hours without longitude correction
xZ0=0
yZ0=-1
zZ0=0
' 0 hours with longitude correction
xZZ0=-slc
yZZ0=-clc
zZZ0=0
End Sub

Sub Preparation
dcCreateCircle 0,0,.02

x0=xN0
y0=yN0
z0=zN0
convert
xNN0=x4                       'Celestian N in new coordinates
yNN0=y4
zNN0=z4
lNN0=Sqr(xNN0*xNN0+yNN0*yNN0)
xNN=xNN0/lNN0                 'Unit projection of N in the plane
yNN=yNN0/lNN0
if zNN0<0 then
 xpr=xNN0
 ypr=yNN0
 zpr=1+zNN0
else
 xpr=-xNN0
 ypr=-yNN0
 zpr=1-zNN0
end if
lpr0=Sqr(xpr*xpr+ypr*ypr+zpr*zpr)
xpr0=xpr/lpr0                    'Unit vector for projection
ypr0=ypr/lpr0
zpr0=zpr/lpr0
lpr1=Sqr(xpr*xpr+ypr*ypr)
xpr1=xpr/lpr1                    'Unit vector in the plane
ypr1=ypr/lpr1
zpr1=0
if xpr1>=0 then
 betar=arcsin(ypr1)
else
 if ypr1>=0 then
  betar=arccos(xpr1)
 else
  betar=-arccos(xpr1)
 end if
end if
beta=betar*r2d  'angle of the projection in the plane
sb=sin(betar)
cb=cos(betar)

cg=xpr0*xpr1+ypr0*ypr1+zpr0*zpr1 'cos(gnomon)
gr=arccos(cg) 'angle of gnomon in radians
g=gr*r2d      'angle of gnomon in degrees
sg=Sqr(1-cg*cg) 'sin(gnomon)
dcCreateLine 0,0,cg,sg
End Sub

Sub Convert
'rotation to horizontal plane
x1=x0
y1=sl*y0+cl*z0
z1=-cl*y0+sl*z0
'rotation for declination of the plane
x2=cd*x1-sd*y1
y2=sd*x1+cd*y1
z2=z1
'rotation for the inclination of the plane
x3=x2
y3=ci*y2+si*z2
z3=-si*y2+ci*z2
'rotation of the box in its plane
x4=cr*x3+sr*y3
y4=-sr*x3+cr*y3
z4=z3
End Sub

Sub Main

dcSetTextParms dcDarkPurple, "Tahoma","Bold",0,12,21,0,0
dcCreateText 0,2.8,0,"NORTH"
dcSetTextParms dcDarkPurple, "Tahoma","Bold",180,12,21,0,0
dcCreateText 0,-2.8,0,"SOUTH"

dcCreateLine -5,2.5,-1,2.5
dcCreateLine 1,2.5,5,2.5
dcCreateLine -2,3.45,-1,3.5
dcCreateLine -1,3.5,1,3.5
dcCreateLine 1,3.5,2,3.45
dcCreateLine -5,-2.5,-1,-2.5
dcCreateLine 1,-2.5,5,-2.5
dcCreateLine -2,-3.45,-1,-3.5
dcCreateLine -1,-3.5,1,-3.5
dcCreateLine 1,-3.5,2,-3.45
dcCreateLine -2,-3.45,-2,-2.5
dcCreateLine -2,2.5,-2,3.45
dcCreateLine 2,-3.45,2,-2.5
dcCreateLine 2,2.5,2,3.45
dcCreateLine -5,-2.5,-5,2.5
dcCreateLine 5,-2.5,5,2.5

dcSetLineParms dcBlack, dcCutting, dcThin
dcCreateLine -2,-2.5,-2,2.5
dcCreateLine 2,-2.5,2,2.5
dcCreateLine -3,-2.5,-3,2.5
dcCreateLine 3,-2.5,3,2.5
dcCreateLine -1,-2.5,0,-3.5
dcCreateLine 0,-3.5,1,-2.5
dcCreateLine -1,2.5,0,3.5
dcCreateLine 0,3.5,1,2.5
dcSetLineParms dcBlack, dcStitch, dcThin
dcCreateLine -1,2.5,1,2.5
dcCreateLine -1,-2.5,1,-2.5
dcCreateLine -1,-3.5,-1,3.5
dcCreateLine 1,-3.5,1,3.5
dcCreateLine 4,-2.5,4,2.5
dcCreateLine -4,-2.5,-4,2.5

dcSetCircleParms dcBlack, dcArrow, dcThin
dcCreateCircleEx -1, 2.5,-1.5, 3.5,-2, 3,.9,.9,0,2
dcCreateCircleEx -1,-2.5,-2,-3,-1.5,-3.5,.9,.9,0,1
dcCreateCircleEx  1, 2.5, 2, 3, 1.5, 3.5,.9,.9,0,1
dcCreateCircleEx  1,-2.5, 1.5,-3.5, 2,-3,.9,.9,0,2


if l>=0 then
 ll=CStr(l)+" N"
 ud=0
 dcSetTextParms dcDarkPurple, "Tahoma","Bold",0,12,21,0,0
else
 ll=CStr(-Val(l))+" S"
 ud=180
 dcSetTextParms dcDarkPurple, "Tahoma","Bold",180,12,21,0,0
end if

if spring=1 then
 dcCreateText 0,0,0,"21 December - 21 June"
else
 dcCreateText 0,0,0,"21 June - 21 December"
end if

if lon>=0 then lol=CStr(lon)+" E" else lol=CStr(-Val(lon))+" W"
dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,12,21,0,0
dcCreateText -2.2,0,0,p
dcCreateText -2.4,1,0,"Latitude "+ll
dcCreateText -2.4,-1,0,"Longitude "+lol
dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,10,21,0,0
'dcCreateText -2.6,1.5,0,"Declination "+CStr(d)
'dcCreateText -2.6,0,0,"Inclination "+CStr(i)
'dcCreateText -2.6,-1.5,0,"Rotation "+CStr(rot)
if flon=1 then
 dcCreateText -2.8,1.2,0,"With Longitude correction"
else
 dcCreateText -2.8,1.2,0,"Without Longitude correction"
end if
if feot=1 then
 dcCreateText -2.8,-1.2,0,"With EOT correction"
else
 dcCreateText -2.8,-1.2,0,"Without EOT correction"
end if

dcSetLineParms dcBlack, dcSolid, dcThin

dcSetTextParms dcBlack,"Tahoma","Bold",90,10,21,0,0
dcCreateText 2.3,0,0,"Author: Valentin Hristov, Sofia, Bulgaria"
dcCreateText 2.5,0,0,"E-mail: valhrist@bas.bg"
dcSetTextParms dcBlack,"Tahoma","Standard",90,8,21,0,0
dcCreateText 2.7,0,0,"Web page: www.math.bas.bg/complan/valhrist/mystuff.htm"
dcCreateText 4.3,0,0,"Cut along the solid lines."
dcCreateText 4.5,0,0,"Make mountain folds along the lines with long dashes."
dcCreateText 4.7,0,0,"Make valley folds along the lines with short dashes."

dcSetTextParms dcBlue,"Tahoma","Standard",0,8,21,0,0
dcCreateText 0,2.35,0,"Civil (Winter) time"
dcCreateText 0,-.15,0,"Civil (Winter) time"
dcSetTextParms dcRed,"Tahoma","Standard",180,8,21,0,0
dcCreateText 0,.15,0,"Daylight Savings (Summer) Time"
dcCreateText 0,-2.35,0,"Daylight Savings (Summer) Time"
dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,10,21,0,0
dcCreateText 1.3,1.25,0,"MONTH"
dcCreateText 1.6,1.25,0,"MORNING"
dcSetTextParms dcDarkPurple, "Tahoma","Bold",90,10,21,0,0
dcCreateText -1.3,-1.25,0,"MONTH"
dcCreateText -1.6,-1.25,0,"AFTERNOON"
dcSetTextParms dcBlack,"Tahoma","Standard",0,12,21,0,0

dcSetLineParms dcBlack, dcSolid, dcThin
for y=-3.5 to 3.5 step 7
for x=-2 to 2
 dcCreateline x-.1,y,x+.1,y
 dcCreateline x,y-.1,x,y+.1
next x
next y

dcSetLineParms dcRED, dcSolid, dcThin
for y=-3.5 to 3.5 step 7
for x=-3 to 3 step 6
 dcCreateline x-.1,y,x+.1,y
 dcCreateline x,y-.1,x,y+.1
next x
next y

dcSetLineParms dcBlack, dcSolid, dcThin


'for count=1 to 13
'if count-1=Int((count-1)/3)*3 then dcSetLineParms dcBlack, dcSolid,dcThick
'dcSetTextParms dcDarkGreen, "Tahoma","Bold",-90,7,21,0,0
'dcCreateLine -2,1.5-bm(count)/366,s+1,1.5-bm(count)/366
'dcCreateText 1.3,1,0,"MONTH"
'if count<13 then dcCreateText 1.1,1.455-bm(count)/366,0,datetext(count)
'dcSetTextParms dcDarkGreen, "Tahoma","Bold",90,7,21,0,0
'dcCreateLine -1,-.5-bm(count)/366,s+2,-.5-bm(count)/366
'dcCreateText -1.3,-1,0,"MONTH"
'if count<13 then dcCreateText -1.1,-.545-bm(count)/366,0,datetext(count)
''dcSetTextParms dcDarkGreen, "Tahoma","Standard",ud,7,21,0,0
'dcSetLineParms dcBlack, dcSolid, dcThin
'next count

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Left and Right Nodus
dcCreateLine -2.15,-1.15,-2,-1.23
dcCreateLine -2.15,-1.15,-2,-1.07
dcCreateLine -2.15,-1.35,-2,-1.27
dcCreateLine -2.15,-1.35,-2,-1.43
dcCreateLine -1.85,-1.15,-2,-1.23
dcCreateLine -1.85,-1.15,-2,-1.07
dcCreateLine -1.85,-1.35,-2,-1.27
dcCreateLine -1.85,-1.35,-2,-1.43
dcCreateLine 2.15,1.15,2,1.23
dcCreateLine 2.15,1.15,2,1.07
dcCreateLine 2.15,1.35,2,1.27
dcCreateLine 2.15,1.35,2,1.43
dcCreateLine 1.85,1.15,2,1.23
dcCreateLine 1.85,1.15,2,1.07
dcCreateLine 1.85,1.35,2,1.27
dcCreateLine 1.85,1.35,2,1.43
'Hour lines 1
cs=0                         'counter for spline
for ha=0 to 23.999 step 1/nl
 ' civil and daylight savings labels
 if ha=Int(ha) then
  dcSetLineParms dcDarkPurple,dcSolid,dcThick
  dcSetSplineParms dcDarkPurple,dcSolid,dcThick
 end if
 ham=ha-1
 ham=ham-Int(ham/12)*12+1 'ha (12)
 ham1=ham
 ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12)

 hhv=False
 hhb=True
 hhe=False
' for count=1 to 366 'max number of points in Spline is 248
' for count=1 to 366 step 2
 if spring=1 then nom=183 else nom=184
 for ind1=1 to nom
  if spring=1 then
   if ind1<12 then count=354+ind1 else count=ind1-11
  else
   count=171+ind1
  end if
  hac=ha*15+flon*lc-feot*eot(count)/4
  hacr=hac*d2r
  shac=sin(hacr)
  chac=cos(hacr)
  dsr=decl(count)*d2r
  sds=sin(-dsr)
  cds=cos(-dsr)
  x0=-shac*cds
  y0=-chac*cds
  z0=sds

  convert
  
  if z1<0 and z3<0 then
   if x4<=0 then
    cs=cs+1
    if 1-x4/z4<=-1 then
     spl(2*cs-1)=-2+2*z4/x4
     spl(2*cs)=1.25-2*y4/x4
    else
     spl(2*cs-1)=1-x4/z4
     spl(2*cs)=1.25-y4/z4
    end if
    xe=spl(2*cs-1)
    ye=spl(2*cs)
    if hhb=True then
     xb=spl(2*cs-1)
     yb=spl(2*cs)
     if spring=1 then
      if ha=Int(ha) then
       dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
       if xb>-1.95 then
        dcCreateText xb,yb+.07,0,CStr(ham)
       else
        dcCreateText xb-.07,yb,0,CStr(ham)
       end if
      end if
     else
      if ha=Int(ha) then
       dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
       if xb>-1.95 then
        dcCreateText xb,yb-.07,0,CStr(ham1)
       else
        dcCreateText xb-.07,yb,0,CStr(ham1)
       end if
      end if
     end if
     hhb=False
     hhv=True
    end if
   end if
  else
   if cs>2 then
    dcCreateSpline spl(1),cs,False
    cs=0
   else
    if cs=2 then
     dcCreateLine spl(1),spl(2),spl(3),spl(4)
    'else
     'dcCreateCircle spl(1),spl(2),.02
    end if
    cs=0
   end if
  end if
 next ind1

 hhe=False
 if cs>2 then                       'if the hour line finishes at 365
  dcCreateSpline spl(1),cs,False
 else
  if cs=2 then
   dcCreateLine spl(1),spl(2),spl(3),spl(4)
  'else
   'dcCreateCircle spl(1),spl(2),.02
  end if
 end if
if spring=1 then
 if ha=Int(ha) and hhe=False and hhv=True then
  dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
  if xb>-1.95 then
   dcCreateText xe,ye-.07,0,CStr(ham1)
  else
   dcCreateText xe-.07,ye,0,CStr(ham1)
  end if
 end if
else
 if ha=Int(ha) and hhe=False and hhv=True then
  dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
  if xb>-1.95 then
   dcCreateText xe,ye+.07,0,CStr(ham)
  else
   dcCreateText xe-.07,ye,0,CStr(ham)
  end if
 end if
end if
 cs=0
 dcSetLineParms dcBlack,dcThin
 dcSetSplineParms dcBlack,dcThin

next ha

'Date lines 1
cs=0                         'counter for spline
if spring=1 then
 bb=1
 ee=19
else
 bb=19
 ee=37
end if
for i=bb to ee
count=ind(i)
for ha=0 to 23.999 step .05
' ' civil and daylight savings labels
 if ha=Int(ha) then
  dcSetLineParms dcDarkPurple,dcSolid,dcThick
  dcSetSplineParms dcDarkPurple,dcSolid,dcThick
 end if
 ham=ha-1
 ham=ham-Int(ham/12)*12+1 'ha (12)
 ham1=ham
 ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12)

' hhv=False
' hhb=True
' hhe=False
' for count=1 to 366 'max number of points in Spline is 248
' for count=1 to 366 step 2
  hac=ha*15+flon*lc-feot*eot(count)/4
  hacr=hac*d2r
  shac=sin(hacr)
  chac=cos(hacr)
  dsr=decl(count)*d2r
  sds=sin(-dsr)
  cds=cos(-dsr)
  x0=-shac*cds
  y0=-chac*cds
  z0=sds

  convert
  
  if z1<0 and z3<0 then
   if x4<=0 then
    cs=cs+1
    if 1-x4/z4<=-1 then
     spl(2*cs-1)=-2+2*z4/x4
     spl(2*cs)=1.25-2*y4/x4
    else
     spl(2*cs-1)=1-x4/z4
     spl(2*cs)=1.25-y4/z4
    end if
    xe=spl(2*cs-1)
    ye=spl(2*cs)
    if hhb=True then
     xb=spl(2*cs-1)
     yb=spl(2*cs)
     if ha=Int(ha) then
      dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
      if xb>-1.95 then
       dcCreateText xb,yb+.07,0,CStr(ham)
      else
       dcCreateText xb-.07,yb,0,CStr(ham)
      end if
     end if
     hhb=False
     hhv=True
    end if
   end if
  else
   if cs>2 then
    dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,8,21,0,0
    if (i+1)/3=int((i+1)/3) then
     dcSetLineParms dcBLACK, dcSOLID, dcTHICK
     dcSetSplineParms dcBLACK, dcSOLID, dcTHICK
     dcCreateText 1.1,1.25-tan(decl(ind(i)+15)*d2r),0,datetext(int(i+1)/3)
    else
     dcSetLineParms dcBLACK, dcSOLID, dcTHIN
     dcSetSplineParms dcBLACK, dcSOLID, dcTHIN
    end if
    dcCreateSpline spl(1),cs,False
    cs=0
   else
    if cs=2 then
     dcCreateLine spl(1),spl(2),spl(3),spl(4)
    'else
     'dcCreateCircle spl(1),spl(2),.02
    end if
    cs=0
   end if
  end if
 next ha

 hhe=False
 if cs>2 then
    if (i+1)/3=int((i+1)/3) then
     dcSetLineParms dcBLACK, dcSOLID, dcTHICK
     dcSetSplineParms dcBLACK, dcSOLID, dcTHICK
    else
     dcSetLineParms dcBLACK, dcSOLID, dcTHIN
     dcSetSplineParms dcBLACK, dcSOLID, dcTHIN
    end if
  dcCreateSpline spl(1),cs,False
 else
  if cs=2 then
   dcCreateLine spl(1),spl(2),spl(3),spl(4)
  'else
   'dcCreateCircle spl(1),spl(2),.02
  end if
 end if
' if ha=Int(ha) and hhe=False and hhv=True then
'  dcSetTextParms dcRed, "Tahoma","Standard",0,8,21,0,0
'  if xb>-1.95 then
'   dcCreateText xe,ye-.07,0,CStr(ham1)
'  else
'   dcCreateText xe-.07,ye,0,CStr(ham1)
'  end if
' end if
 cs=0
 dcSetLineParms dcBlack,dcThin
 dcSetSplineParms dcBlack,dcThin
next i

''''''''''''''''''''''''''''''Second  nodus

'Hour lines 2
cs=0                         'counter for spline
for ha=0 to 23.999 step 1/nl
 ' civil and daylight savings labels
 if ha=Int(ha) then
  dcSetLineParms dcDarkPurple,dcSolid,dcThick
  dcSetSplineParms dcDarkPurple,dcSolid,dcThick
 else
  dcSetLineParms dcBlack,dcSolid,dcThin
  dcSetSplineParms dcBlack,dcSolid,dcThin
 end if

 ham=ha-1
 ham=ham-Int(ham/12)*12+1 'ha (12)
 ham1=ham
 ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12)

 hhv=False
 hhb=True
 hhe=False
' for count=1 to 366 'max number of points in Spline is 248
' for count=1 to 366 step 2
' for ind1=1 to 181
'  if ind1<12 then count=354+ind1 else count=ind1-11
 if spring=1 then nom=183 else nom=184
 for ind1=1 to nom
  if spring=1 then
   if ind1<12 then count=354+ind1 else count=ind1-11
  else
   count=171+ind1
  end if
  hac=ha*15+flon*lc-feot*eot(count)/4
  hacr=hac*d2r
  shac=sin(hacr)
  chac=cos(hacr)
  dsr=decl(count)*d2r
  sds=sin(-dsr)
  cds=cos(-dsr)
  x0=-shac*cds
  y0=-chac*cds
  z0=sds

  convert
  
  if z1<0 and z3<0 then
   if x4>=0 then
    cs=cs+1
    if -1-x4/z4>=1 then
     spl(2*cs-1)=2+2*z4/x4
     spl(2*cs)=-1.25+2*y4/x4
    else
     spl(2*cs-1)=-1-x4/z4
     spl(2*cs)=-1.25-y4/z4
    end if
    xe=spl(2*cs-1)
    ye=spl(2*cs)
    if hhb=True then
     xb=spl(2*cs-1)
     yb=spl(2*cs)
     if spring=1 then
      if ha=Int(ha) then
       dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
       if xb<1.95 then
        dcCreateText xb,yb+.07,0,CStr(ham)
       else
        dcCreateText xb+.07,yb,0,CStr(ham)
       end if
      end if
     else
      if ha=Int(ha) then
       dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
       if xb<1.95 then
        dcCreateText xb,yb-.07,0,CStr(ham1)
       else
        dcCreateText xb+.07,yb,0,CStr(ham1)
       end if
      end if
     end if
     hhb=False
     hhv=True
    end if
   end if
  else
   if cs>2 then
    dcCreateSpline spl(1),cs,False
    cs=0
   else
    if cs=2 then
     dcCreateLine spl(1),spl(2),spl(3),spl(4)
    'else
     'dcCreateCircle spl(1),spl(2),.02
    end if
    cs=0
   end if
  end if
 next ind1

 hhe=False
 if cs>2 then                       'if the hour line finishes at 365
  dcCreateSpline spl(1),cs,False
 else
  if cs=2 then
   dcCreateLine spl(1),spl(2),spl(3),spl(4)
  'else
   'dcCreateCircle spl(1),spl(2),.02
  end if
 end if
if spring=1 then
 if ha=Int(ha) and hhe=False and hhv=True then
  dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0
  if xb<1.95 then
   dcCreateText xe,ye-.07,0,CStr(ham1)
  else
   dcCreateText xe+.07,ye,0,CStr(ham1)
  end if
 end if
else
 if ha=Int(ha) and hhe=False and hhv=True then
  dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
  if xb<1.95 then
   dcCreateText xe,ye+.07,0,CStr(ham)
  else
   dcCreateText xe+.07,ye,0,CStr(ham)
  end if
 end if
end if
 cs=0
 dcSetLineParms dcBlack,dcThin
 dcSetSplineParms dcBlack,dcThin

next ha

'Date lines 2
cs=0                         'counter for spline
if spring=1 then
 bb=1
 ee=19
else
 bb=19
 ee=37
end if
for i=bb to ee
count=ind(i)
for ha=0 to 23.999 step .05
 ' civil and daylight savings labels
 if ha=Int(ha) then
  dcSetLineParms dcDarkPurple,dcSolid,dcThick
  dcSetSplineParms dcDarkPurple,dcSolid,dcThick
 end if
 ham=ha-1
 ham=ham-Int(ham/12)*12+1 'ha (12)
 ham1=ham
 ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12)

' hhv=False
' hhb=True
' hhe=False
' for count=1 to 366 'max number of points in Spline is 248
' for count=1 to 366 step 2
  hac=ha*15+flon*lc-feot*eot(count)/4
  hacr=hac*d2r
  shac=sin(hacr)
  chac=cos(hacr)
  dsr=decl(count)*d2r
  sds=sin(-dsr)
  cds=cos(-dsr)
  x0=-shac*cds
  y0=-chac*cds
  z0=sds

  convert
  
  if z1<0 and z3<0 then
   if x4>=0 then
    cs=cs+1
    if -1-x4/z4>=1 then
     spl(2*cs-1)=2+2*z4/x4
     spl(2*cs)=-1.25+2*y4/x4
    else
     spl(2*cs-1)=-1-x4/z4
     spl(2*cs)=-1.25-y4/z4
    end if
    xe=spl(2*cs-1)
    ye=spl(2*cs)
    if hhb=True then
     xb=spl(2*cs-1)
     yb=spl(2*cs)
     if ha=Int(ha) then
      dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0
      if xb<1.95 then
       dcCreateText xb,yb+.07,0,CStr(ham)
      else
       dcCreateText xb+.07,yb,0,CStr(ham)
      end if
     end if
     hhb=False
     hhv=True
    end if
   end if
  else
   if cs>2 then
    dcSetTextParms dcDarkPurple, "Tahoma","Bold",90,8,21,0,0
    if (i+1)/3=int((i+1)/3) then
     dcSetLineParms dcBLACK, dcSOLID, dcTHICK
     dcSetSplineParms dcBLACK, dcSOLID, dcTHICK
     dcCreateText -1.1,-1.25-tan(decl(ind(i)+15)*d2r),0,datetext(int(i+1)/3)
    else
     dcSetLineParms dcBLACK, dcSOLID, dcTHIN
     dcSetSplineParms dcBLACK, dcSOLID, dcTHIN
    end if
    dcCreateSpline spl(1),cs,False
    cs=0
   else
    if cs=2 then
     dcCreateLine spl(1),spl(2),spl(3),spl(4)
    'else
     'dcCreateCircle spl(1),spl(2),.02
    end if
    cs=0
   end if
  end if
 next ha

 hhe=False
 if cs>2 then                       'if the hour line finishes at 365
    if (i+1)/3=int((i+1)/3) then
     dcSetLineParms dcBLACK, dcSOLID, dcTHICK
     dcSetSplineParms dcBLACK, dcSOLID, dcTHICK
    else
     dcSetLineParms dcBLACK, dcSOLID, dcTHIN
     dcSetSplineParms dcBLACK, dcSOLID, dcTHIN
    end if
  dcCreateSpline spl(1),cs,False
 else
  if cs=2 then
   dcCreateLine spl(1),spl(2),spl(3),spl(4)
  'else
   'dcCreateCircle spl(1),spl(2),.02
  end if
 end if
 cs=0
' if ha=Int(ha) and hhe=False and hhv=True then
'  dcSetTextParms dcRed, "Tahoma","Standard",0,8,21,0,0
'  if xb<1.95 then
'   dcCreateText xe,ye-.07,0,CStr(ham1)
'  else
'   dcCreateText xe+.07,ye,0,CStr(ham1)
'  end if
' end if
 cs=0
 dcSetLineParms dcBlack,dcThin
 dcSetSplineParms dcBlack,dcThin
next i

End Sub

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

dcCreateLine -7,-2,-7,2
dcCreateLine 7,-2,7,2

dcCreateCircleEx -5,0,-5,2.5,-5,-2.5,2.5,2.5,0,0
dcCreateCircleEx 5,0,5,-2.5,5,2.5,2.5,2.5,0,0

for count=90 to 270 step 2
x=cos(count*d2r)
y=sin(count*d2r)
dcCreateLine -5+2.5*x,2.5*y,-5+2.55*x,2.55*y
next count

for count=90 to 270 step 10
x=cos(count*d2r)
y=sin(count*d2r)
dcCreateLine -5+2.5*x,2.5*y,-5+2.6*x,2.6*y
next count

for count=90 to 270 step 20
x=cos(count*d2r)
y=sin(count*d2r)
dcCreateLine -5+2.5*x,2.5*y,-5+2.65*x,2.65*y
next count

for count=-90 to 90 step 2
x=cos(count*d2r)
y=sin(count*d2r)
dcCreateLine 5+2.5*x,2.5*y,5+2.55*x,2.55*y
next count

for count=-90 to 90 step 10
x=cos(count*d2r)
y=sin(count*d2r)
dcCreateLine 5+2.5*x,2.5*y,5+2.6*x,2.6*y
next count

for count=-90 to 90 step 20
x=cos(count*d2r)
y=sin(count*d2r)
dcCreateLine 5+2.5*x,2.5*y,5+2.65*x,2.65*y
next count

if l>=0 then ll=l else ll=90+l

x=cos((90+2*ll)*d2r)
y=sin((90+2*ll)*d2r)
dcCreateLine -5+2.5*x,2.5*y,-5,2.5
dcCreateLine -5+2.5*x,2.5*y,-5,-2.5

x=cos((90-2*ll)*d2r)
y=sin((90-2*ll)*d2r)
dcCreateLine 5+2.5*x,2.5*y,5,2.5
dcCreateLine 5+2.5*x,2.5*y,5,-2.5

End Sub

Sub Pieces

dcCreateLine -5,0,-6,0
dcCreateLine -6,0,-6,1
dcCreateLine -6,1,-6-sqr(2)/2,1+sqr(2)/2
dcCreateLine -6-sqr(2)/2,1+sqr(2)/2,-6,1+sqr(2)
dcCreateLine -6,1+sqr(2),-6+sqr(2)/2,1+sqr(2)/2
dcCreateLine -6+sqr(2)/2,1+sqr(2)/2,-5,1
dcCreateLine -6,0,-6,-1
dcCreateLine -6,-1,-6-sqr(2)/2,-1-sqr(2)/2
dcCreateLine -6-sqr(2)/2,-1-sqr(2)/2,-6,-1-sqr(2)
dcCreateLine -6,-1-sqr(2),-6+sqr(2)/2,-1-sqr(2)/2
dcCreateLine -6+sqr(2)/2,-1-sqr(2)/2,-5,-1
dcCreateLine 5,0,6,0
dcCreateLine 6,0,6,1
dcCreateLine 6,1,6+sqr(2)/2,1+sqr(2)/2
dcCreateLine 6+sqr(2)/2,1+sqr(2)/2,6,1+sqr(2)
dcCreateLine 6,1+sqr(2),6-sqr(2)/2,1+sqr(2)/2
dcCreateLine 6-sqr(2)/2,1+sqr(2)/2,5,1
dcCreateLine 6,0,6,-1
dcCreateLine 6,-1,6+sqr(2)/2,-1-sqr(2)/2
dcCreateLine 6+sqr(2)/2,-1-sqr(2)/2,6,-1-sqr(2)
dcCreateLine 6,-1-sqr(2),6-sqr(2)/2,-1-sqr(2)/2
dcCreateLine 6-sqr(2)/2,-1-sqr(2)/2,5,-1

dcCreateLine -5,3.5,-5,4.5
dcCreateLine -5,4.5,-6,4.5
dcCreateLine -6,4.5,-6,3.5
dcCreateLine -6,3.5,-7,3.5
dcCreateLine -7,3.5,-7,2.5
dcCreateLine -7,2.5,-6,2.5
dcCreateLine -6,2.5,-5,3.5
dcCreateLine 5,3.5,5,4.5
dcCreateLine 5,4.5,6,4.5
dcCreateLine 6,4.5,6,3.5
dcCreateLine 6,3.5,7,3.5
dcCreateLine 7,3.5,7,2.5
dcCreateLine 7,2.5,6,2.5
dcCreateLine 6,2.5,5,3.5
dcCreateLine -5,-3.5,-5,-4.5
dcCreateLine -5,-4.5,-6,-4.5
dcCreateLine -6,-4.5,-6,-3.5
dcCreateLine -6,-3.5,-7,-3.5
dcCreateLine -7,-3.5,-7,-2.5
dcCreateLine -7,-2.5,-6,-2.5
dcCreateLine -6,-2.5,-5,-3.5
dcCreateLine 5,-3.5,5,-4.5
dcCreateLine 5,-4.5,6,-4.5
dcCreateLine 6,-4.5,6,-3.5
dcCreateLine 6,-3.5,7,-3.5
dcCreateLine 7,-3.5,7,-2.5
dcCreateLine 7,-2.5,6,-2.5
dcCreateLine 6,-2.5,5,-3.5

End Sub
'''''''''''''''''''''''''''''''''''''''
Function arcsin(ByVal x) As Double
If Abs(x) > 0.999999999999 Then x = sgn(x)*0.999999999999
  arcsin = Atn(x/Sqr(1-x*x))
End Function


Function arccos(ByVal x) As Double
  arccos = pi/2-arcsin(x)
End Function

Function test(varname,x,minval,maxval) As boolean
If IsNumeric(x) = false Then
test = false
outtext = varname & " must be numeric"
MsgBox outtext
exit Function
End If
If x < minval Or x > maxval Then
outtext = varname & " must be between " & chr$(13) & minval & "  and  " & maxval
MsgBox outtext
exit Function
End If
test = true
End Function