dim m(14),yn(100),num(32),dw(7),lm(14),nm(7) as string
dim mc(14),md(14),yc(100),ccg(100),ccj(100) as double
dim mml,day,a,b,r,cm,j1,j2,cor as double

mml=29.53058867
day=1/mml
k=9
l=5
cm=.689529644 'corr months

'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

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

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

dcSetTextParms dcBlack, "Tahoma","Bold",0,14,5,0,0
dcCreateText k*.5,l*1.3,0,"JULIAN AND GREGORIAN CALENDAR WITH MOON PHASES"

dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0,0
dcCreateText k*.5,l*1.25,0,"Author: Valentin Hristov, Sofia, Bulgaria"
dcCreateText k*.5,l*1.225,0,"E-mail: valhrist@bas.bg, valhrist@gmail.com"
dcSetTextParms dcBlack, "Tahoma","Standard",0,9,5,0,0
dcCreateText k*.5,l*1.2,0,"Web page: www.math.bas.bg/complan/valhrist/mystuff.htm"

dcSetLineParms dcBLACK, dcSOLID, dcTHICK
dcCreateLine 0,l*.1,k*.005,l*.07
dcCreateLine 0,l*.1,-k*.005,l*.07
dcCreateLine k,l*.1,k*1.005,l*.07
dcCreateLine k,l*.1,k*.995,l*.07
dcCreateLine 0,l*.3,k*.005,l*.27
dcCreateLine 0,l*.3,-k*.005,l*.27
dcCreateLine k,l*.3,k*1.005,l*.27
dcCreateLine k,l*.3,k*.995,l*.27
dcCreateLine 0,l*.5,k*.005,l*.47
dcCreateLine 0,l*.5,-k*.005,l*.47
dcCreateLine k,l*.5,k*1.005,l*.47
dcCreateLine k,l*.5,k*.995,l*.47
dcCreateLine 0,l*.8,k*.005,l*.77
dcCreateLine 0,l*.8,-k*.005,l*.77
dcCreateLine k,l*.8,k*1.005,l*.77
dcCreateLine k,l*.8,k*.995,l*.77
dcCreateLine 0,l,k*.005,l*.97
dcCreateLine 0,l,-k*.005,l*.97
dcCreateLine k,l,k*1.005,l*.97
dcCreateLine k,l,k*.995,l*.97
dcSetLineParms dcBLACK, dcSOLID, dcNORMAL
dcCreateLine 0,0,k*1.05,0
dcCreateLine k,0,k,l*1.35
dcCreateLine k*1.05,0,k*1.05,l*1.35
dcCreateLine k,l,0,l
dcCreateLine k*1.05,l*1.35,0,l*1.35
dcCreateLine 0,l*1.35,0,0
dcSetLineParms dcBLACK, dcSOLID, dcNORMAL
dcCreateLine 0,l*.1,k,l*.1
dcCreateLine 0,l*.5,k,l*.5
dcCreateLine 0,l*.8,k,l*.8
dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcCreateLine 0,l*.3,k,l*.3

'Moon phases
dcSetCircleParms dcBlack,dcFill,dcNormal
'New Moon
for i=0 to 1
 dcCreateCircle k*i,l*1.12,l*.04
next i
dcSetLineParms dcBlack,dcSolid,dcNormal
dcSetCircleParms dcBlack,dcSolid,dcNormal
'Full Moon
dcCreateCircle k*i*.25,l*1.12,l*.04
'Other phases
for i=1 to 3 step 2
 dcCreateLine k*i*.25,l*1.16,k*i*.25,l*1.08
next i
dcCreateCircleEx k*.25,l*1.12,k*.25,l*1.08,k*.25,l*1.16,l*.04,l*.04,0,0
dcCreateCircleEx k*.75,l*1.12,k*.75,l*1.16,k*.75,l*1.08,l*.04,l*.04,0,0
dcSetLineParms dcBlack,dcSolid,dcThin
dcSetCircleParms dcBlack,dcSolid,dcThin
for i=1 to 7
 dcCreateCircleEx k*i*.0625,l*1.12,k*i*.0625,l*1.08,k*i*.0625,l*1.16,l*.04,l*.04,0,0
next i
for i=9 to 15
 dcCreateCircleEx k*i*.0625,l*1.12,k*i*.0625,l*1.16,k*i*.0625,l*1.08,l*.04,l*.04,0,0
next i
for i=2 to 10 step 8
 dcCreateCircleEx k*i*.0625-l*.04*Sqr(2)/4,l*1.12,k*i*.0625,l*1.08,k*i*.0625,l*1.16,l*.04*3*Sqr(2)/4,l*.04*3*Sqr(2)/4,0,0
next i
for i=6 to 14 step 8
 dcCreateCircleEx k*i*.0625+l*.04*Sqr(2)/4,l*1.12,k*i*.0625,l*1.16,k*i*.0625,l*1.08,l*.04*3*Sqr(2)/4,l*.04*3*Sqr(2)/4,0,0
next i
a=(-2+sqr(2))/(4*sqr(2+sqr(2)))
b=(6+sqr(2))/(4*sqr(2+sqr(2)))
for i=1 to 9 step 8
 dcCreateCircleEx k*i*.0625+l*.04*a,l*1.12,k*i*.0625,l*1.08,k*i*.0625,l*1.16,l*.04*b,l*.04*b,0,0
next i
for i=7 to 15 step 8
 dcCreateCircleEx k*i*.0625-l*.04*a,l*1.12,k*i*.0625,l*1.16,k*i*.0625,l*1.08,l*.04*b,l*.04*b,0,0
next i
a=-(2+sqr(2))/(4*sqr(2-sqr(2)))
b=(6-sqr(2))/(4*sqr(2-sqr(2)))
for i=3 to 11 step 8
 dcCreateCircleEx k*i*.0625+l*.04*a,l*1.12,k*i*.0625,l*1.08,k*i*.0625,l*1.16,l*.04*b,l*.04*b,0,0
next i
for i=5 to 13 step 8
 dcCreateCircleEx k*i*.0625-l*.04*a,l*1.12,k*i*.0625,l*1.16,k*i*.0625,l*1.08,l*.04*b,l*.04*b,0,0
next i

'Line marks
for i=0 to 32
 dcCreateLine k*i/32,l,k*i/32,l*1.02
next i
for i=0 to 16
 dcCreateLine k*i/16,l,k*i/16,l*1.035
next i
for i=0 to 8
 dcCreateLine k*i/8,l,k*i/8,l*1.05
next i
for i=0 to 4
 dcCreateLine k*i/4,l,k*i/4,l*1.065
next i


'Corrections for the centuries and years in the century
for i=0 to 99
 if i<10 then
  yn(i)="0"+CStr(i)
 else
  yn(i)=CStr(i)
 end if
 a=365*i +Int(i/4)
 yc(i)=(a-Int(a/mml)*mml)/mml	'Year in the century
 a=36524*(i-20)+Int((i-20)/4)
 ccg(i)=(a-Int(a/mml)*mml)/mml	'Gregorian centuries
 a=36525*(i-20)+13
 ccj(i)=(a-Int(a/mml)*mml)/mml	'Julian centuries
next i

'move the years in the century to allow better placement of the months
for i=0 to 99
 if yc(i)>=.5 then yc(i)=yc(i)-1
 yc(i)=yc(i)+.5
next i

'Months
m( 1)="JAN"
m( 2)="Mar"
m( 3)="Jan"
m( 4)="FEB"
m( 5)="Apr"
m( 6)="Feb"
m( 7)="May"
m( 8)="Jun"
m( 9)="Jul"
m(10)="Aug"
m(11)="Sep"
m(12)="Oct"
m(13)="Nov"
m(14)="Dec"

md( 1)=0
md( 2)=60
md( 3)=1
md( 4)=31
md( 5)=91
md( 6)=32
md( 7)=121
md( 8)=152
md( 9)=182
md(10)=213
md(11)=244
md(12)=274
md(13)=305
md(14)=335

for i=1 to 14
mc(i)=(md(i)-int(md(i)/mml)*mml)/mml
next i

dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcSetTextParms dcBlack, "Tahoma","Standard",-90,10,6,0,0
a=mc(14)-mc(1)
for i=1 to 14
 if i=1 or i=4 then
  dcSetLineParms dcBlack, dcSOLID, dcTHIN
  dcSetTextParms dcBlack, "Tahoma","Bold",-90,10,6,0,0
 end if
  dcCreateLine k*(cm-mc(i)),l*.8,k*(cm-mc(i)),l*.82
  dcCreateLine k*(cm-mc(i)),l*.82,k*(cm-a*(i-1)/13),l*.86
  dcCreateText k*(cm-a*(i-1)/13),l*.865,0,m(i)
 dcSetLineParms dcBLACK, dcSOLID, dcTHIN
 dcSetTextParms dcBlack, "Tahoma","Standard",-90,10,6,0,0
next i

dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0,0

'Years in the century
for i=0 to 99
 if yn(i) mod 4=0 then
  dcSetLineParms dcBlack, dcSOLID, dcTHIN
  dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0,0
 end if
  dcCreateLine k*(1-yc(i)),l*.5,k*(1-yc(i)),l*(.515+i*.002)
  dcCreateText k*(1-yc(i)),l*(.54+i*.002),0,yn(i)
 dcSetLineParms dcBLACK, dcSOLID, dcTHIN
 dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0,0
next i
i=15
  dcCreateLine -k*yc(i),l*.5,-k*yc(i),l*(.515+i*.002)
  dcCreateText -k*yc(i),l*(.54+i*.002),0,yn(i)

'Gregorian centuries
dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0,0

for i=15 to 40
 if i mod 4=0 then
  dcSetLineParms dcBlack, dcSOLID, dcTHIN
  dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0,0
 end if
 dcCreateLine k*(1-ccg(i)),l*.3,k*(1-ccg(i)),l*(.25+i*.0045)
 dcCreateText k*(1-ccg(i)),l*(.26+i*.0045),0,yn(i)
 dcSetLineParms dcBLACK, dcSOLID, dcTHIN
 dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0,0
next i
i=20
dcSetLineParms dcBlack, dcSOLID, dcTHIN
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0,0
dcCreateLine 0,l*.3,0,l*(.25+i*.0045)
dcCreateText 0,l*(.26+i*.0045),0,yn(i)
dcSetLineParms dcBLACK, dcSOLID, dcTHIN
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0,0


'Julian centuries
dcSetLineParms dcBlack, dcSOLID, dcTHIN
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0,0
for i=0 to 40
 dcCreateLine k*(1-ccj(i)),l*.1,k*(1-ccj(i)),l*(.11+i*.003)
 dcCreateText k*(1-ccj(i)),l*(.13+i*.003),0,yn(i)
next i
i=23
dcCreateLine k*(2-ccj(i)),l*.1,k*(2-ccj(i)),l*(.11+i*.003)
dcCreateText k*(2-ccj(i)),l*(.13+i*.003),0,yn(i)

dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0,0
dcCreateText .5*k,l*.94,0,"Month"
dcCreateText .5*k,l*.76,0,"Year in the century"
dcCreateText .5*k,l*.48,0,"Full centuries Gregorian (new) style"
dcCreateText .5*k,l*.28,0,"Full centuries Julian (old) style"
dcSetTextParms dcBlack, "Tahoma","Standard",90,10,5,0,0
dcCreateText 1.03*k,l*.6,0,"Glue the INNER part here!"
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0,0

'**********************
'Movable part
'**********************

k=9.05

dcSetLineParms dcBLACK, dcSOLID, dcTHICK
dcCreateLine 0,-l*.2,k*.005,-l*.23
dcCreateLine 0,-l*.2,-k*.005,-l*.23
dcCreateLine k,-l*.2,k*1.005,-l*.23
dcCreateLine k,-l*.2,k*.995,-l*.23

dcSetLineParms dcBLACK, dcSOLID, dcThin
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0
dcCreateLine -k*.05,-l*.2,k,-l*.2
dcCreateLine 0,-l*.2,0,-l*1.2
dcCreateLine k,-l*.2,k,-l*1.2
dcCreateLine k,-l*1.2,-k*.05,-l*1.2
dcCreateLine -k*.05,-l*1.2,-k*.05,-l*.2

'Dates in the month
for i=1 to 30
 dcCreateLine k*(i-1)*day,-l*.2,k*(i-.5)*day,-l*.25
 dcCreateLine k*(i-.5)*day,-l*.25,k*i*day,-l*.2
 dcCreateLine k*(i-.5)*day,-l*.2,k*(i-.5)*day,-l*.25
 dcCreateText k*(i-.5)*day,-l*.28,0,Cstr(i)
next i
for i=1 to 60
  dcCreateLine k*(i-.5)*day/2,-l*.2,k*(i-.5)*day/2,-l*.225
next i
for i=30 to 31
 dcCreateLine k*(-1+(i-1)*day),-l*.2,k*(-1+(i-.5)*day),-l*.25
 dcCreateLine k*(-1+(i-.5)*day),-l*.25,k*(-1+i*day),-l*.2
 dcCreateLine k*(-1+(i-.5)*day),-l*.2,k*(-1+(i-.5)*day),-l*.25
 dcCreateText k*(-1+(i-.5)*day),-l*.28,0,Cstr(i)
next i
for i=59 to 62
  dcCreateLine k*(-1+(i-.5)*day/2),-l*.2,k*(-1+(i-.5)*day/2),-l*.225
next i

'********************
'Calendar
'********************

a=.9/25

for j=0 to 5
 for i=0 to 12
  s=-5+i+j*7
  if s>0 and s<32 then dcCreateText k*(1.5+i)/30,l*(-.65-j*.05),0,CStr(s)
 next i
next j

nm(0)="A"
nm(1)="B"
nm(2)="C"
nm(3)="D"
nm(4)="E"
nm(5)="F"
nm(6)="G"
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0
for j=0 to 6
 for i=0 to 12
  cor=(18+j-i) mod 7
  dcCreateText k*(16.5+i)/30,-l*(.3+a*(j+9.5)),0,nm(cor)
 next i
next j
dcSetTextParms dcBlack, "Tahoma","Standard",-90,10,5,0
dcCreateText -.03*k,-l*.7,0,"Glue the MIDDLE part here!"
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0

'***********************
'Calendar - movable part
'***********************

k=9.1

dcCreateLine 0,-l*1.3,k*1.05,-l*1.3
dcCreateLine k*1.05,-l*1.3,k*1.05,-l*2.2
dcCreateLine k*1.05,-l*2.2,0,-l*2.2
dcCreateLine k,-l*2.2,k,-l*1.3
dcCreateLine 0,-l*2.2,0,-l*1.3

dw(1)="Mo"
dw(2)="Tu"
dw(3)="We"
dw(4)="Th"
dw(5)="Fr"
dw(6)="SA"
dw(7)="SU"

dcCreateLine k*4/30,-l*1.575,k*11/30,-l*1.575
dcCreateLine k*4/30,-l*1.625,k*11/30,-l*1.625
dcCreateLine k*4/30,-l*1.925,k*11/30,-l*1.925
dcCreateLine k*4/30,-l*1.575,k*4/30,-l*1.925
dcCreateLine k*11/30,-l*1.575,k*11/30,-l*1.925

dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0
for i=1 to 7
 if i>5 then dcSetTextParms dcBlack, "Tahoma","Bold",0,9,5,0
 dcCreateText k*(3.5+i)/30,-l*1.6,0,dw(i)
next i

dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0

dcCreateLine k*16/30,-l*(1.3+a*9),k*29/30,-l*(1.3+a*9)
dcCreateLine k*16/30,-l*(1.3+a*16),k*29/30,-l*(1.3+a*16)
dcCreateLine k*19/30,-l*(1.3+a*0),k*19/30,-l*(1.3+a*25)
dcCreateLine k*26/30,-l*(1.3+a*0),k*26/30,-l*(1.3+a*25)
dcCreateLine k*16/30,-l*(1.3+a*9),k*16/30,-l*(1.3+a*16)
dcCreateLine k*29/30,-l*(1.3+a*9),k*29/30,-l*(1.3+a*16)

'Full centuries Julian (old) style
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0
for i=1 to 21
 j1=int((i-1)/7)
 j2=(i-1) mod 7
 dcCreateText k*(26.5+j1)/30,-l*(1.3+a*(j2+9.5)),0,yn(i)
next i

'Full centuries Gregorian (new) style
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0
for i=15 to 25
 j=2*i-int(i/4)-3
 j1=int(j/7)-3
 j2=j mod 7
 if i mod 4=0 then dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0
 dcCreateText k*(18.5-j1)/30,-l*(1.3+a*(j2+9.5)),0,yn(i)
 dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0
next i

'Years in the century
for i=0 to 50
 j=i+int(i/4)
 j1=int(j/7)
 j2=j mod 7
 if i mod 4=0 then dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0
 dcCreateText k*(19.5+j2)/30,-l*(1.3+a*(j1+16.5)),0,yn(i)
 dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0
next i
for i=51 to 99
 j=i+int(i/4)
 j1=int(j/7)
 j2=j mod 7
 if i mod 4=0 then dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0
 dcCreateText k*(19.5+j2)/30,-l*(1.3+a*(j1-8.5)),0,yn(i)
 dcSetTextParms dcBlack, "Tahoma","Standard",0,10,5,0
next i

dcSetTextParms dcBlack, "Tahoma","Standard",0,10,4,0
dcCreateText k*16.5/30,-l*(1.3+a*7.5),0,"Gregorian"
dcCreateText k*16.5/30,-l*(1.3+a*8.5),0,"(new) style"
dcCreateText k*26.5/30,-l*(1.3+a*7.5),0,"Julian"
dcCreateText k*26.5/30,-l*(1.3+a*8.5),0,"(old) style"

'Letters for the months
dcCreateText k*15.5/30,-l*(1.3+a*17.5),0,"A"
dcCreateText k*16/30,-l*(1.3+a*17.5),0,"-"
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,4,0
dcCreateText k*16.35/30,-l*(1.3+a*17.5),0,"JAN(leap)"
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,4,0
dcCreateText k*15.5/30,-l*(1.3+a*18.5),0,"B"
dcCreateText k*16/30,-l*(1.3+a*18.5),0,"-"
dcCreateText k*16.35/30,-l*(1.3+a*18.5),0,"Jan"
dcCreateText k*15.5/30,-l*(1.3+a*19.5),0,"D"
dcCreateText k*16/30,-l*(1.3+a*19.5),0,"-"
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,4,0
dcCreateText k*16.35/30,-l*(1.3+a*19.5),0,"FEB(leap)"
dcSetTextParms dcBlack, "Tahoma","Standard",0,10,4,0
dcCreateText k*15.5/30,-l*(1.3+a*20.5),0,"E"
dcCreateText k*16/30,-l*(1.3+a*20.5),0,"-"
dcCreateText k*16.35/30,-l*(1.3+a*20.5),0,"Feb"
dcCreateText k*15.5/30,-l*(1.3+a*21.5),0,"E"
dcCreateText k*16/30,-l*(1.3+a*21.5),0,"-"
dcCreateText k*16.35/30,-l*(1.3+a*21.5),0,"Mar"
dcCreateText k*15.5/30,-l*(1.3+a*22.5),0,"A"
dcCreateText k*16/30,-l*(1.3+a*22.5),0,"-"
dcCreateText k*16.35/30,-l*(1.3+a*22.5),0,"Apr"
dcCreateText k*15.5/30,-l*(1.3+a*23.5),0,"C"
dcCreateText k*16/30,-l*(1.3+a*23.5),0,"-"
dcCreateText k*16.35/30,-l*(1.3+a*23.5),0,"May"
dcCreateText k*26.5/30,-l*(1.3+a*17.5),0,"F"
dcCreateText k*27/30,-l*(1.3+a*17.5),0,"-"
dcCreateText k*27.35/30,-l*(1.3+a*17.5),0,"Jun"
dcCreateText k*26.5/30,-l*(1.3+a*18.5),0,"A"
dcCreateText k*27/30,-l*(1.3+a*18.5),0,"-"
dcCreateText k*27.35/30,-l*(1.3+a*18.5),0,"Jul"
dcCreateText k*26.5/30,-l*(1.3+a*19.5),0,"D"
dcCreateText k*27/30,-l*(1.3+a*19.5),0,"-"
dcCreateText k*27.35/30,-l*(1.3+a*19.5),0,"Aug"
dcCreateText k*26.5/30,-l*(1.3+a*20.5),0,"G"
dcCreateText k*27/30,-l*(1.3+a*20.5),0,"-"
dcCreateText k*27.35/30,-l*(1.3+a*20.5),0,"Sep"
dcCreateText k*26.5/30,-l*(1.3+a*21.5),0,"B"
dcCreateText k*27/30,-l*(1.3+a*21.5),0,"-"
dcCreateText k*27.35/30,-l*(1.3+a*21.5),0,"Oct"
dcCreateText k*26.5/30,-l*(1.3+a*22.5),0,"E"
dcCreateText k*27/30,-l*(1.3+a*22.5),0,"-"
dcCreateText k*27.35/30,-l*(1.3+a*22.5),0,"Nov"
dcCreateText k*26.5/30,-l*(1.3+a*23.5),0,"G"
dcCreateText k*27/30,-l*(1.3+a*23.5),0,"-"
dcCreateText k*27.35/30,-l*(1.3+a*23.5),0,"Dec"

dcSetTextParms dcBlack, "Tahoma","Standard",90,10,5,0,0
dcCreateText 1.037*k,-l*1.75,0,"Glue the OUTER part here!"
dcSetTextParms dcBlack, "Tahoma","Bold",0,10,5,0,0
dcCreateText k*22.5/30,-l*1.75,0,"CUT THIS WINDOW!"
dcCreateText k*7.5/30,-l*1.775,0,"CUT THIS WINDOW!"