' QUADRANT SUNDIAL
' with correction for the coordinates and the equation of time

' Author: Valentin Z. Hristov
'         valhrist@math.bas.bg
'         www.math.bas.bg/complan/valhrist/mystuff.htm

' Advantages: No need to know the N-S direction.

' Disadvantages: Depends on the coordinates and is not suitable for
' using at places with high latitudes and also around the local noon
' (because the changes of the height are very small).


' INSTRUCTIONS for making and using the "quadrant sundial":
'
' Print this file.
'
' Cut along the thick outside boundary of the drawing.
'
' Use glue to stick the left half onto some thin cardboard
' and cut the cardboard. (It is possible to stick directly
' onto the right half if the paper is thick enough.)
'
' Use needle to make two holes:
'  1) in the middle of the small square on the right of the
'     morning part (left of the afternoon part). This is
'     the pinhole for projecting the sun onto the opposite
'     "+" mark as target.
'  2) at the right angle vertex of the quadrant (close to
'     the end of the word MORNING). This is for a two sided
'     string (thread) indicator with something heavy at the
'     gathered two ends.
'
' Fold along the vertical dashed lines to one of the sides.
' The two parts must become perpendicular to the face.
'
' Fold along the horizontal dashed line, putting the tooth-like
' parts (above the small squares) into the small vertical internal
' cuts (at the two ends of the upper rectangle).
'
'
' Keeping the faces vertical and the string hanging free, aim the image
' of the sun to coincide with the "+" target. Fix the string by your
' fingers and read the time for the corresponding month and date !!!
'
' ENJOY !!!


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

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

Dim lat,lon,cm,pi,d2r,r2d,lc,lcr,slc,clc,lr,sl,cl As Double
Dim w,r,h,ha,cha,sd,cd,sh,ch,cs1,cs2,hm,hm1 As Double
Dim x1,y1,x11,y11,x2,y2,x22,y22,ss,cc,xb,yb,xe,ye As Double

Dim eot(366),decl(366),spl1(732),spl2(732) As Double

Dim button,time_int,eot_c,lon_c,dst_c,tf_c,nl,feot,flon,count,i,m As Integer

Dim bm(13) As Integer

Dim p,outtext,datetext(13) As String

Dim ex1,ex2,dst,tf As Boolean

dcSetLineParms dcBLACK,dcSOLID,dcTHICK
dcSetCircleParms dcBLACK,dcSOLID,dcTHICK

dcSetDrawingScale 25.4 'mm

Call Sundial

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

Sub Sundial
Input_constants
If button=0 Then GoTo Cncl
Initial_data
Main
'dcViewAll
Cncl:
End Sub 'Sundial

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

Sub Input_constants

Begin Dialog Constants_input 10,20,200,160,"QUADRANT SUNDIAL"
 Text 20,5,180,10,"QUADRANT SUNDIAL - uses the height (elevation)"
 Text 35,15,180,10,"With corrections for EoT and Longitude"
 Text 20,30,40,10,"Place"
 TextBox 45,30,110,10,.p
 Text 20,40,180,10,"Latitude                 Longitude        Central meridian"
 TextBox 20,50,40,10,.lat
 TextBox 80,50,40,10,.lon
 TextBox 140,50,40,10,.cm
 Text 30,60,180,10,"Decimal degrees!!!       South and West < 0"

 Text 20,75,80,10,"Time interval:"
 OptionGroup .time_int
 OptionButton 70,75,35,10,"15 min"
 OptionButton 110,75,35,10,"30 min"
 OptionButton 150,75,35,10,"60 min"

 Text 20,85,80,10, "EOT correction"
 OptionGroup .eot_c
 OptionButton 130,85,30,10, "Yes"
 OptionButton 160,85,30,10, "No"

 Text 20,95,80,10, "Longitude correction"
 OptionGroup .lon_c
 OptionButton 130,95,30,10, "Yes"
 OptionButton 160,95,30,10, "No"

 Text 20,105,120,10, "Use of Daylight Savings Time"
 OptionGroup .dst_c
 OptionButton 130,105,30,10, "Yes"
 OptionButton 160,105,30,10, "No"

 Text 20,115,120,10, "Time Format"
 OptionGroup .tf_c
 OptionButton 130,115,30,10, "12"
 OptionButton 160,115,30,10, "24"

 Text 50,130,40,10, "Month"
 TextBox 75,130,15,10, .m
 Text 95,130,130,10, "( 1-Jan ... 12-Dec)"

 OKButton 40,145,40,10
 CANCELButton 120,145,40,10
End Dialog 'Constants_input

'Initialize 
Dim prompt As Constants_input

prompt.p="Lozen - Sofia - Bulgaria"
prompt.lat = 42.6021
prompt.lon = 23.5011
prompt.cm = 30
prompt.time_int = 0
prompt.eot_c = 0
prompt.lon_c = 0
prompt.dst_c = 0
prompt.tf_c = 0
prompt.m = 10

'prompt.p="Equator TEST"
'prompt.lat = 0
'prompt.lon = 0
'prompt.cm = 0

repeat_until_inputcorrect: 'label to return if input is not correct

button = Dialog(prompt)    'get the input

If (button=0) Then GoTo End_input

If test("Latitude",prompt.lat,-90,90) = false Then
  GoTo repeat_until_inputcorrect
End If
If test("Longitude",prompt.lon,-180,180) = false Then
  GoTo repeat_until_inputcorrect
End If
If test("CentralMeridian",prompt.cm,-180,180) = false Then
  GoTo repeat_until_inputcorrect
End If
If test("Month",prompt.m,1,12) = false Then
  GoTo repeat_until_inputcorrect
End If

p=prompt.p
lat=prompt.lat
lon=prompt.lon
cm=prompt.cm
eot_c=prompt.eot_c
dst_c=prompt.dst_c
time_int=prompt.time_int
tf_c=prompt.tf_c
m=prompt.m

if eot_c=0 then feot=1 else feot=0
if lon_c=0 then flon=1 else flon=0
if dst_c=0 then dst=True else dst=False
if time_int=0 then nl=4
if time_int=1 then nl=2
if time_int=2 then nl=1
if tf_c=0 then tf=True else tf=False

End_input:

End Sub 'Input_constants

'*******************
Sub Initial_data

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)=365 '31dec
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)

datetext( 1) = "JANUARY"
datetext( 2) = "FEBRUARY"
datetext( 3) = "MARCH"
datetext( 4) = "APRIL"
datetext( 5) = "MAY"
datetext( 6) = "JUNE"
datetext( 7) = "JULY"
datetext( 8) = "AUGUST"
datetext( 9) = "SEPTEMBER"
datetext(10) = "OCTOBER"
datetext(11) = "NOVEMBER"
datetext(12) = "DECEMBER"
datetext(13) = "JANUARY"

End Sub 'Initial_data

'*******************
Sub Main

pi=4*Atn(1)
d2r=pi/180
r2d=180/pi

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=lat*d2r   'latitude in radians
sl=sin(lr)   'sin(latitude)
cl=cos(lr)   'cos(latitude)

dcSetTextParms dcBLACK,"Tahoma","Bold",0,10,4,0,0
dcCreateText -105,16,0,p
if lat<0 then
 dcCreateText -105,11,0,"Latitude "&CStr(0-lat)&" S"
else
 if lat> 0 then
  dcCreateText -105,11,0,"Latitude "&CStr(lat)&" N"
 else
  dcCreateText -105,11,0,"Latitude "&CStr(lat)
 end if
end if
if lon<0 then
 dcCreateText -65,11,0,"Longitude "&CStr(0-lon)&" W"
else
 if lon>0 then
  dcCreateText -65,11,0,"Longitude "&CStr(lon)&" E"
 else
  dcCreateText -65,11,0,"Longitude "&CStr(lon)&" W"
 end if
end if

dcSetTextParms dcBLACK,"Tahoma","Bold",0,10,5,0,0
dcCreateText 0,-90,0,"Use some editor to see the instructions in the beginning of the file quadm.bas"
dcSetTextParms dcBLACK,"Tahoma","Bold",0,10,4,0,0
dcCreateText 23,16,0,"Author: Valentin Hristov, valhrist@math.bas.bg"
dcSetTextParms dcBLACK,"Tahoma","Bold",0,8.5,4,0,0
dcCreateText 25,11,0,"www.math.bas.bg/complan/valhrist/mystuff.htm"
dcSetTextParms dcBLACK,"Tahoma","Bold",0,7,6,0,0
dcCreateText -33,-5,0,"BEFORE"
dcCreateText -33,-8,0,"LOCAL"
dcCreateText -33,-11,0,"NOON"
dcCreateText -33,-20,0,datetext(m)
dcSetTextParms dcBLACK,"Tahoma","Bold",0,7,4,0,0
dcCreateText 33,-5,0,"AFTER"
dcCreateText 33,-8,0,"LOCAL"
dcCreateText 33,-11,0,"NOON"
dcCreateText 33,-20,0,datetext(m)



dcSetLineParms dcBLACK,dcSOLID,dcTHICK
dcSetCircleParms dcBLACK,dcSOLID,dcTHICK
dcCreateLine -130,0,-110,0
dcCreateLine -20,0,20,0
dcCreateLine 110,0,130,0
dcCreateLine -20,0,-20,-80
dcCreateLine 20,0,20,-80
dcCreateLine 30,-80,20,-80
dcCreateLine -30,-80,-20,-80
dcCreateLine -130,0,-130,20
dcCreateLine 130,0,130,20
dcCreateLine -130,20,-125,20
dcCreateLine 130,20,125,20
dcCreateLine -115,20,-110,20
dcCreateLine 115,20,110,20
dcCreateLine -20,20,-15,20
dcCreateLine 20,20,15,20
dcCreateLine -5,20,5,20
dcCreateLine -125,20,-120,30
dcCreateLine 125,20,120,30
dcCreateLine -120,30,-115,30
dcCreateLine 120,30,115,30
dcCreateLine -115,20,-115,40
dcCreateLine 115,20,115,40
dcCreateLine -15,20,-15,40
dcCreateLine 15,20,15,40
dcCreateLine -15,30,-10,30
dcCreateLine 15,30,10,30
dcCreateLine -10,30,-5,20
dcCreateLine 10,30,5,20
dcCreateLine -115,40,-15,40
dcCreateLine 115,40,15,40
dcCreateLine -110,25,-110,35
dcCreateLine 110,25,110,35
dcCreateLine -20,25,-20,35
dcCreateLine 20,25,20,35

dcSetLineParms dcBLACK,dcSTITCH,dcTHIN
dcCreateLine -110,0,-110,20
dcCreateLine -20,0,-20,20
dcCreateLine 0,0,0,20
dcCreateLine 20,0,20,20
dcCreateLine 110,0,110,20
dcCreateLine -110,20,-20,20
dcCreateLine 110,20,20,20

dcCreateCircle -30,0,.75
dcCreateCircle 30,0,.75
dcCreateCircle -10,10,1
dcCreateCircle 10,10,1

dcCreateCircleEx -30,0,-110,0,-30,-80,80,80,90,1
dcCreateCircleEx 30,0,30,-80,110,0,80,80,90,1

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

dcCreateLine -126,10,-114,10
dcCreateLine 126,10,114,10
dcCreateLine -120,4,-120,16
dcCreateLine 120,4,120,16
dcCreateLine -30,0,-100,0
dcCreateLine 30,0,100,0
dcCreateLine -30,0,-30,-70
dcCreateLine 30,0,30,-70

dcCreateCircle -120,10,3
dcCreateCircle 120,10,3
dcCreateCircle -120,10,6
dcCreateCircle 120,10,6

dcSetTextParms dcBLACK,"Tahoma","Bold",0,9,21,0,0
for i=1 to (bm(m+1)-bm(m))
 r=35+35*i/(bm(m+1)-bm(m))
 if i<=bm(m+1)-bm(m) and i=int(i/5)*5+1 then
  dcSetCircleParms dcBLACK,dcSOLID,dcTHICK
 else
  dcSetCircleParms dcBLACK,dcSOLID,dcTHIN
 end if
 dcCreateCircleEx -30,0,-100,0,-30,-100,r,r,90,1
 dcCreateCircleEx 30,0,30,-100,30,0,r,r,90,1
'' dcCreateLine -30-r,0,-30-r,2
'' dcCreateLine 30+r,0,30+r,2
 if i<=bm(m+1)-bm(m) and i=int(i/5)*5+1 then
  dcCreateText -65-35*i/(bm(m+1)-bm(m)),4,0,""&CStr(i)&""
  dcCreateText 65+35*i/(bm(m+1)-bm(m)),4,0,""&CStr(i)&""
 end if
 dcSetLineParms dcBLACK,dcSOLID,dcTHIN
next i

'hight (altitude) scales

for i=0 to 90
 ss=sin(i*d2r)
 cc=cos(i*d2r)
 if i=int(i/5)*5 then
  dcCreateLine 30+80*ss,-80*cc,30+77*ss,-77*cc
  dcCreateLine -30-80*ss,-80*cc,-30-77*ss,-77*cc
 else
  dcCreateLine 30+80*ss,-80*cc,30+78.5*ss,-78.5*cc
  dcCreateLine -30-80*ss,-80*cc,-30-78.5*ss,-78.5*cc
 end if
next i

'hour lines
for h=0 to 23.99 step 1/nl
 ' civil and daylight savings labels
 hm=h-1
 hm=hm-Int(hm/12)*12+1 'h (12)
 hm1=hm
 hm1=hm1-Int(hm1/12)*12+1 'h+1 (12)
 if h=int(h) then
  dcSetLineParms dcDarkPurple,dcSolid,dcThick
 else
  if 2*h=int(2*h) then
   dcSetLineParms dcBlue,dcSOLID,dcTHIN
  else
   dcSetLineParms dcGreen,dcSOLID,dcTHIN
  end if
 end if

 ex1=False
 ex2=False
 'for i=1 to 366 step 2
 for i=bm(m) to bm(m+1)-1 step 1
  ha=h*15+flon*lc-feot*eot(i)/4
  ha=ha-180
  cha=cos(ha*d2r)
  sd=sin(decl(i)*d2r)
  cd=cos(decl(i)*d2r)
  sh=sl*sd+cl*cd*cha   'sin(height)
  ch=sqr(1-sh*sh)

  if sh>=0 and ha<=0 then
   'r=35+35*i/366
   r=35+35*(i-bm(m)+1)/(bm(m+1)-bm(m))
   x1=-30-r*sh
   y1=-ch*r
   if ex1=False then
    xb=x1
    yb=y1
    if h=int(h) then
     dcSetTextParms dcBLUE,"Tahoma","Bold",0,8,21,0,0
     if tf then
      dcCreateText xb,yb,0,hm
     else
      dcCreateText xb,yb,0,h
     end if
    end if
    ex1=True
   else
    dcCreateLine x11,y11,x1,y1
    if i>=bm(m+1)-1 and ex1=True then
     xe=x1
     ye=y1
     if h=int(h) then
      if dst then
       dcSetTextParms dcRED,"Tahoma","Bold",0,8,21,0,0
       if tf then
        dcCreateText xe,ye,0,hm1
       else
        dcCreateText xe,ye,0,h+1
       end if
      else
       dcSetTextParms dcBLUE,"Tahoma","Bold",0,8,21,0,0
       if tf then
        dcCreateText xe,ye,0,hm
       else
        dcCreateText xe,ye,0,h
       end if
      end if
     end if
    end if
   end if
   x11=x1
   y11=y1
  else
   if ex1=True then
    xe=x1
    ye=y1
    if h=int(h) then
     if dst then
      dcSetTextParms dcRED,"Tahoma","Bold",0,8,21,0,0
      if tf then
       dcCreateText xe,ye,0,hm1
      else
       dcCreateText xe,ye,0,h+1
      end if
     else
      dcSetTextParms dcBLUE,"Tahoma","Bold",0,8,21,0,0
      if tf then
       dcCreateText xe,ye,0,hm
      else
       dcCreateText xe,ye,0,h
      end if
     end if
    end if
   end if
   ex1=False
  end if

  if sh>=0 and ha>=0 then
   'r=35+35*i/366
   r=35+35*(i-bm(m)+1)/(bm(m+1)-bm(m))
   x2=30+r*sh
   y2=-ch*r
   if ex2=False then
    xb=x2
    yb=y2
    if h=int(h) then
     dcSetTextParms dcBLUE,"Tahoma","Bold",0,8,21,0,0
     if tf then
      dcCreateText xb,yb,0,hm
     else
      dcCreateText xb,yb,0,h
     end if
    end if
    ex2=True
   else
    dcCreateLine x22,y22,x2,y2
    if i>=bm(m+1)-1 and ex2=True then
     xe=x2
     ye=y2
     if h=int(h) then
      if dst then
       dcSetTextParms dcRED,"Tahoma","Bold",0,8,21,0,0
       if tf then
        dcCreateText xe,ye,0,hm1
       else
        dcCreateText xe,ye,0,h+1
       end if
      else
       dcSetTextParms dcBLUE,"Tahoma","Bold",0,8,21,0,0
       if tf then
        dcCreateText xe,ye,0,hm
       else
        dcCreateText xe,ye,0,h
       end if
      end if
     end if
    end if
   end if
   x22=x2
   y22=y2
  else
   if ex2=True then
    xe=x2
    ye=y2
    if h=int(h) then
     if dst then
      dcSetTextParms dcRED,"Tahoma","Bold",0,8,21,0,0
      if tf then
       dcCreateText xe,ye,0,hm1
      else
       dcCreateText xe,ye,0,h+1
      end if
     else
      dcSetTextParms dcBLUE,"Tahoma","Bold",0,8,21,0,0
      if tf then
       dcCreateText xe,ye,0,hm
      else
       dcCreateText xe,ye,0,h
      end if
     end if
    end if
   end if
   ex2=False
  end if
 next i
next h

'maximal height (elevation)
h=12
dcSetLineParms dcRed,dcSOLID,dcNormal

ex1=False
ex2=False
'for i=1 to 366 step 2
for i=bm(m) to bm(m+1)-1
 ha=h*15'+flon*lc-feot*eot(i)/4
 ha=ha-180
 cha=cos(ha*d2r)
 sd=sin(decl(i)*d2r)
 cd=cos(decl(i)*d2r)
 sh=sl*sd+cl*cd*cha   'sin(height)
 ch=sqr(1-sh*sh)

 if sh>=0 and ha<=0 then
  'r=35+35*i/366
  r=35+35*(i-bm(m)+1)/(bm(m+1)-bm(m))
  x1=-30-r*sh
  y1=-ch*r
  if ex1=False then
   ex1=True
  else
   dcCreateLine x11,y11,x1,y1
  end if
  x11=x1
  y11=y1
 else
  ex1=False
 end if
 
 if sh>=0 and ha>=0 then
  r=35+35*(i-bm(m)+1)/(bm(m+1)-bm(m))
  x2=30+r*sh
  y2=-ch*r
  if ex2=False then
   ex2=True
  else
   dcCreateLine x22,y22,x2,y2
  end if
  x22=x2
  y22=y2
 else
  ex2=False
 end if
next i

End Sub 'Main

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