' ********************************************************************As********************** ' *** *** ' *** on the gnomon *** ' *** A N A L E M M A or *** ' *** or the hour line on a dial plate *** ' *** *** ' ******************************************************************************************** Sub Main() ' NOTE: Most recent updates ' This is open source, do with it what you will. But somewhere along ' the line some credit would be nice. ' Aug 12 2009 better 10 degree delimeters on equatorial dial plate analemma ' beter color for analemma on v-dial ' Aug 18 2009 clearer prompts for choice 6 ' Aug 23 2009 added a new choice "0" to calculate an SD and DL for choice 6 ' AND fixed choice 5 which sometimes didnt draw lines ' AND choice 4 cleaner JD display on the mid year analemma ' Aug 24 2009 choice 0 then 6 now shows hours shifted due to DL ' And a note On final resulting dial does consider dial longitude ' And new choice 8 being 0 then 6 with extra things done ' And hours are adjuted for the DL in choice 8 ' Aug 26 2009 V-DEC choice 8 needed eot and decl signs reversed, fixed bug ' Aug 27 2009 Also choice 6 has special code for if invoked by "0" to ' reverse sign of EOT and DECL ' Aug 29 2009 Polar dial added ' Aug 30 2009 Meridian E and W dial added, with analemmas only on hour and half ' hour, and hour marking only on the hours ' and detailed single analemma or full dial plate for armillary ' Aug 31 2009 Armillary now has all choices and all are choice 1 to clean up code ' Equatorial dial longitude corrected has all choices and is now choice 2 ' and choices 1-6 now in logical order ' Sep 1 2009 Better noon LAT on polar and meridian dials, better sunset line ' on equatorial dial, and "F" is default for armillary and equatorial ' Gnomon depiction is vastly improved ' Sep 2 2009 typo in a comment ' Sep 5 2009 INFO button notes expanded ' Oct 26 2009 Hour labels on choice 2 Q-dial ' ' AUTHOR: Simon Wheaton-Smith ' Good notes are found in: analemma.xls and .odf ' Good notes are found in: analemma.pdf ' Runs on Vista and XP ' ********************************************************************* ' Initial house keeping - set the drafting area unit ' ********************************************************************* dcSetDrawingScale 1.0 ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** Begin Dialog aaaaa 20, 20, 400, 250, "DIAL DESIGNER with analemmas, hours, declination curves for a,q,p,m,h,v,v-dec dials: September 5, 2009" TextBox 5, 10, 10, 10, .mychc Text 45, 10, 330, 10, "1. Armillary dial: Single dialplate analemma, Full dialplate of analemmas, Bobbin on gnomon" Text 45, 20, 330, 10, "2. Equatorial dial: Single dialplate analemma, Full dialplate of analemmas, Bobbin on gnomon" Text 45, 30, 330, 10, "3. Polar and Meridian: (meridian is both east and west)" Text 45, 40, 330, 10, "4. Horizontal dial: hour lines, calendar curves, analemmas. [Can use DL from choice 0]" Text 45, 50, 330, 10, "5. Vertical dial: hour lines, calendar curves, analemmas." Text 45, 60, 330, 10, "6. Vertical decliner: dial [hour lines, calendar curves, analemmas, rotation]." Text 45, 70, 330, 10, "**** choice 9 and 0 are obsolete and retained for no good reason ****" Text 45, 80, 330, 10, "9. TOOL: Constructor: analemmas with x,y pairs [usable with h dials]" Text 45, 90, 330, 10, "0. TOOL: Calculator: v-dec tool sets lat=SH, long=DL and invokes 4 but with reversed analemma" OKButton 5, 105, 30, 10 CancelButton 45, 105, 30, 10 PushButton 85, 105, 30, 10, "INFO " Text 45, 120, 330, 10, "OPTIONS DRAWING SCALE must be 1 [this sets it]" Text 45, 130, 220, 10, "VIEW SC must be 1 [this sets it]" Text 45, 140, 260, 10, "FILE Set Print REGION Print SCALE you must set to 1" Text 45, 150, 330, 10, "even so, double check after printing, may need rescaling" Text 45, 170, 220, 40, "www.illustratingshadows.com" Text 45, 180, 220, 40, "Program may end in BASIC SCRIPT ERROR if run standalone." Text 45, 190, 180, 40, "Ignore BASIC SCRIPT ERROR message." Text 45, 210, 240, 20, "Good notes are found in: analemma.xls and .ods" Text 45, 220, 320, 20, "~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ analemma.pdf ~ ~ ~ ~ ~ ~ ~ ~ read before using for good insight" Text 45, 230, 320, 20, "~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ Illustrating Times Shadow chapter 24 ~ ~ ~ ~ best insight" End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** ' ' this defines "bbbbb" as an instance of aaaaa dialog Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** Dim chc As Single ' ******************************************************************** ' Define DL and SH for choice 0 to invoke choice 6 ' ******************************************************************** ' Dim DL0to6 As Single Dim SH0to6 As Single DL0to6 = 0 SH0to6 = 0 ' ******************************************************************** ' Now get the data ' ******************************************************************** ' set the defaults bbbbb.mychc = "1" ' here the dialog is invoked and the button results returned to ccccc ' page 20 and 24 etc of DeltaCAD Basic discusses the Dialog function ccccc = Dialog(bbbbb) ' which causes the answer to be returned chc = bbbbb.mychc ' CANCEL button returns 0 ' OK button returns -1 If ccccc = 0 Then Stop End If If ccccc > 0 Then Begin Dialog mmmmm 20, 20, 400, 250, "DIAL DESIGNER" Text 5, 10, 330, 10, "NOTES ON TECHNIQUE FOR THE VARIOUS DIAL TYPES: The armillary and equatorial dials use the " Text 5, 20, 330, 10, "declination and EOT directly. The armillary is a special case as the gnomon and dial plate " Text 5, 30, 330, 10, "analemma formula are symmetrical. " Text 5, 50, 330, 10, "The equatorial dial full plate uses polar coordinates whereby the EOT is converted to degrees" Text 5, 60, 330, 10, "with the hour and longitude difference added which then becomes the angle, and the declination" Text 5, 70, 330, 10, "is used to derive a radius, and these two are then converted to X:Y coordinates. " Text 5, 90, 330, 10, "The polar and meridian dials use declination and EOT directly." Text 5, 110, 330, 10, "The horizontal, vertical, and vertical decliner dials require solar altitude and azimuth " Text 5, 120, 330, 10, "to be derived. " Text 5, 140, 330, 10, "Gnomon based 3d analemmas, bobbin or bowling ball: these have to be based on an average EOT." Text 5, 150, 330, 10, "Gnomon based 2d analemmas: figure of 8: can be precise but must be rotated." Text 5, 160, 330, 10, "Gnomon based analemmas require a fixed dial plate lie to read the time." Text 5, 170, 330, 10, "Dial plate analemmas are specific to the hour." Text 5, 190, 330, 10, "Chapter 24 of Illustrating Time's Shadow is the best discussion on all analemma aspects" Text 5, 200, 330, 10, "Free booklet: analemma.pdf : has good notes on analemma topics" OKButton 5, 220, 30, 10 End Dialog Dim nnnnn As mmmmm ddddd = Dialog(nnnnn) Stop End If ' *** CLEAR THE SCREEN *** cls ' *** WHAT ARE WE SUPPOSED TO DO *** If chc = 1 Then armillary (123) End If If chc = 2 Then equatorial (123) End If If chc = 3 Then polar (123) End If If chc = 4 Then ok = hDial ( 3.2 , 32.75, 6) End If If chc = 5 Then vDial End If If chc = 6 Then vDec End If ' *** THESE ARE OBSOLETE *** but stay here for no good reason If chc = 9 Then toolCalculateHDP(123) End If If chc = 0 Then toolCalculateVD ' and this then invokes choice 6 by the way End If End Sub ' *********** ' *** END *** ' *********** ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 1 ] *** ' *** *** ' *** ANALEMMA FOR ARMILLARY bobbin with details *** ' *** one analemma with details *** ' *** a full dial plate of analemmas *** ' *** with longitude correction *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function armillary (iii As Integer) ' ********************************************************************* ' A generic definition is required for a screen input area ' ********************************************************************* ' Begin Dialog aaaaa 20, 20, 350,120, "[1] Armillary dial analemma options" Text 5, 15, 90, 40, "Analemma type" TextBox 95, 15, 50, 10, .mymany Text 165, 15, 150, 40, "S=single, F=full dial plate, B=gnomon bobbin" Text 5, 25, 90, 40, "Enter SH style height" TextBox 95, 25, 50, 10, .myglh Text 5, 35, 90, 40, "Longitude" TextBox 95, 35, 50, 10, .mylng Text 5, 45, 90, 40, "Legal meridian" TextBox 95, 45, 50, 10, .myref Text 5, 55, 90, 40, "Hr division" TextBox 95, 55, 50, 10, .mydvh Text 165, 55, 90, 40, "1, 2, or 4 if MULTIPLE" Text 5, 85, 210, 20, "www.illustratingshadows.com" Text 5, 95, 220, 20, "Program may end in BASIC SCRIPT ERROR." Text 5, 105, 180, 20, "Ignore BASIC SCRIPT ERROR message." OKButton 5, 70, 40, 10 CancelButton 95, 70, 40, 10 End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' Dim glh As Single Dim jd,h As Single Dim lng,ref As Single Dim eot As Single Dim decl As Single Dim x,y,xd As Single Dim r,v,dvh As Single Dim many As String Dim lastx As Single Dim lasty As Single Dim frstx As Single Dim frsty As Single Dim yExtreme As Single Dim lineY As Single Dim leftx,rightx As Single Dim hx, hy As Single ' ******************************************************************** ' Now get the parameters ' ******************************************************************** bbbbb.myglh = "3.375" ' gnomon linear height bbbbb.mymany = "F" bbbbb.mylng = "108.2" bbbbb.myref = "105" bbbbb.mydvh = "2" ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht r = glh many = UCase(bbbbb.mymany) lng = bbbbb.mylng ref = bbbbb.myref dvh = bbbbb.mydvh ' ***************************************************************************** ' *** ARMILLARY ANALEMMA AS A GNOMON BOBBIN ~ with many x,y etc details *** ' ***************************************************************************** If many="B" Then ' ************************************************************************** ' *** this is the main program to draw the armillary gnomon itself *** ' ************************************************************************** ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also ' Font dcSetTextParms dcBLACK,"Ariel","Bold",0, 6, 8,0,0 ' p231 of Manual dcCreateText 2.0, -1.9, 0, "Analemma on bobbin of armillary dial." dcCreateText 2.0, -2.0, 0, "December solstice is south." dcCreateText 2.0, -2.1, 0, "Gnomon linear height in inches:" dcCreateText 3.2, -2.1, 0, Format(glh,"00.0") lineY = 2.1 dcCreateText 2, liney, 0, "JD" dcCreateText 2.3, liney, 0, "EOT m.m" dcCreateText 2.7, liney, 0, "DECL" dcCreateText 3.1, liney, 0, "X" dcCreateText 3.5, liney, 0, "Y" lineY = 2.0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 For jd = 1 To 361 Step 10 eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) y = r * Tan( rad(decl) ) V = r / Cos( rad(decl) ) x = V * Tan( rad(eot/4) ) If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y If jd<150 Then dcCreateText x,y, 0, jd End If lastx = x lasty = y End If dcCreateText 2, liney, 0, Format(jd, "000") dcCreateText 2.3, liney, 0, Format(eot, "00.0") dcCreateText 2.7, liney, 0, Format(decl,"00.0") dcCreateText 3.1, liney, 0, Format(x, "00.00") dcCreateText 3.5, liney, 0, Format(y, "00.00") liney = liney - 0.1 Next jd dcCreateLine lastx,lasty,frstx,frsty yExtreme = r * Tan( rad(23.44) ) - r * Tan( rad(-23.44) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' p231 of Manual dcCreateText 2.0, -2.2, 0, "Solstice to solstice distance:" dcCreateText 3.2, -2.2, 0, yExtreme dcCreateLine -1,0,1,0 ' equinox line dcCreateText 1.1,0, 0, "Equinox line E<->W" dcCreateText 1.1,-0.1, 0, "cross lines are 1 inch" dcCreateLine 0,-1,0,1 ' north south line dcSetDrawingScale 1.0 'dcViewBox -2, -2, 2, 2 End If ' ***************************************************************************** ' *** ARMILLARY ANALEMMA AS ON DIAL PLATE ~ with many x,y etc details *** ' ***************************************************************************** If many = "S" Then ' ************************************************************************** ' *** this is the main program to draw the armillary dial plate *** ' ************************************************************************** ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also ' Font dcSetTextParms dcBLACK,"Ariel","Bold",0, 6, 8,0,0 ' p231 of Manual dcCreateText 2.0, -1.9, 0, "Analemma on dialplate of armillary dial." dcCreateText 2.0, -2.0, 0, "June solstice is south." dcCreateText 2.0, -2.1, 0, "Gnomon linear height in inches:" dcCreateText 3.2, -2.1, 0, Format(glh,"00.0") lineY = 2.1 dcCreateText 2, liney, 0, "JD" dcCreateText 2.3, liney, 0, "EOT m.m" dcCreateText 2.7, liney, 0, "DECL" dcCreateText 3.1, liney, 0, "X" dcCreateText 3.5, liney, 0, "Y" lineY = 2.0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' p231 of Manual For jd = 1 To 361 Step 10 eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' *** NOTE *** This is exactly the same for the 3d bobbin choice except the ' analemma is rotated about both the East-West and the North-South ' axes, and this done by reversing the X and Y sign below. y = - r * Tan( rad(decl) ) V = r / Cos( rad(decl) ) x = - V * Tan( rad(eot/4) ) If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y If jd<150 Then dcCreateText x,y, 0, jd End If lastx = x lasty = y End If ' indicate declination every 10 degrees, approx If jd = 21 Then dcCreateLine x-0.5,y,x+0.5,y End If If jd = 51 Then dcCreateLine x-0.5,y,x+0.5,y End If If jd =111 Then dcCreateLine x-0.5,y,x+0.5,y End If If jd =141 Then dcCreateLine x-0.5,y,x+0.5,y End If dcCreateText 2, liney, 0, Format(jd, "000") dcCreateText 2.3, liney, 0, Format(eot, "00.0") dcCreateText 2.7, liney, 0, Format(decl,"00.0") dcCreateText 3.1, liney, 0, Format(x, "00.00") dcCreateText 3.5, liney, 0, Format(y, "00.00") liney = liney - 0.1 Next jd dcCreateLine lastx,lasty,frstx,frsty yExtreme = r * Tan( rad(23.44) ) - r * Tan( rad(-23.44) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' p231 of Manual dcCreateText 2.0, -2.2, 0, "Solstice to solstice distance:" dcCreateText 3.2, -2.2, 0, yExtreme dcCreateLine -1,0,1,0 ' equinox line dcCreateText 1.1,0, 0, "Equinox line E<->W" dcCreateText 1.1,-0.1, 0, "cross lines are 1 inch" dcCreateLine 0,-1,0,1 ' north south line dcSetDrawingScale 1.0 'dcViewBox -2, -2, 2, 2 End If ' ***************************************************************************** ' *** ARMILLARY ANALEMMA AS A FULL DIAL PLATE LONGITUDE CORRECTED *** ' ***************************************************************************** If many = "F" Then ' ************************************************************************** ' *** this is the main program to draw the armillary gnomon itself *** ' ************************************************************************** ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also ' Font dcSetTextParms dcBLACK,"Ariel","Bold",0, 9, 8,0,0 ' p231 of Manual dcCreateText 2.0, glh-0.7, 0, "Analemma on dialplate of armillary dial." dcCreateText 2.0, glh-0.8, 0, "June solstice is south." dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' p231 of Manual For h = -6 to +6 step 1 ' get hour line displacement xd = (h * glh * Tan(rad(15))) + glh * Tan(rad(ref-lng)) For jd = 1 To 361 Step 10 eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' *** NOTE *** This is exactly the same for the 3d bibbin choice except the ' analemma is rotated about both the East-West and the North-South ' axes, and this done by reversing the X and Y sign below. y = - r * Tan( rad(decl) ) V = r / Cos( rad(decl) ) x = xd + - V * Tan( rad(eot/4) ) If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y If jd<150 Then dcCreateText x,y, 0, jd End If lastx = x lasty = y End If Next jd dcCreateLine lastx,lasty,frstx,frsty dcCreateText x,y+0.1, 0, Format(12+h,"0") ' save X extremes for calendar curves with a fudge of 0.5 If h = -6 Then leftx = x - 0.5 End If If h = 6 Then rightx = x + 0.5 End If Next h yExtreme = r * Tan( rad(23.44) ) - r * Tan( rad(-23.44) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,9, 8,0,0 ' p231 of Manual dcCreateText 2.0, glh-0.9, 0, "Solstice to solstice distance:" dcCreateText 3.7, glh-0.9, 0, yExtreme dcCreateText -4, glh-0.1, 0, "below is hour line separation" dcCreateLine -4, glh-0.2, -4+glh*Tan(rad(15)), glh-0.2 ' hour line separation dcCreateText -4, glh-0.35, 0, "inches:" dcCreateText -3.5,glh-0.35, 0, Format(glh*Tan(rad(15)),"00.0") ' *** GNOMON dcSetTextParms dcDARKBLUE,"Ariel","Bold",0,9, 8,0,0 ' p231 of Manual dcSetLineParms dcBLUE,dcSOLID,dcNORMAL dcCreateText -4, glh-0.7, 0, "Below is gnomon linear height" dcCreateLine -4, glh-0.8, glh-4, glh-0.8 ' gnomon line dcCreateText -4, glh-0.95, 0, "Gnomon linear height in inches:" dcCreateText -2.0, glh-0.95, 0, Format(glh,"0.00") ' and local apparent time noon line which is also gnomon dcCreateLine 0, 0, 0, glh dcCreateText 0.1, glh-0.1, 0, "Left is gnomon linear height on local apparent noon line" ' *** DECLINATION LINES *** dcSetLineParms dcBROWN,dcSOLID,dcTHIN dcCreateLine leftx,0,rightx,0 ' equinox line For h = -20 to +20 step 5 ' 5 degree calendar lines but you could use ' 0, 12, 20, 23.44 or anything else dcSetLineParms dcBLACK,dcSOLID,dcTHIN If h = 0 Then dcSetLineParms dcBLUE,dcSOLID,dcTHIN End If dcCreateLine leftx, glh*Tan(rad(h)),rightx, glh*Tan(rad(h)) Next h dcCreateLine leftx, glh*Tan(rad(23.44)), rightx, glh*Tan(rad(23.44)) dcCreateLine leftx, glh*Tan(rad(-23.44)),rightx, glh*Tan(rad(-23.44)) ' *** HOUR LINES IF NOT CORRECTED FOR EOT *** for the quarter hours xd = glh*Tan(rad(15)) + glh * Tan(rad(ref-lng)) For h = -7 to +5 step 1/dvh dcSetLineParms dcBROWN,dcSOLID,dcTHIN dcCreateLine h*glh*Tan(rad(15))+xd, -glh*Tan(rad(23.44)), h*glh*Tan(rad(15))+xd, glh*Tan(rad(23.44)) Next h dcSetDrawingScale 1.0 'dcViewBox -2, -2, 2, 2 End If End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 2 ] *** ' *** *** ' *** ANALEMMA FOR EQUATORIAL bobbin with details *** ' *** one analemma with details *** ' *** a full dial plate of analemmas *** ' *** with longitude correction *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function equatorial(iii As Integer) Begin Dialog aaaaa 20, 20, 300, 70, "[2] Equatorial dial analemma options" Text 5, 15, 80, 40, "Kind of analemma" TextBox 75, 15, 20, 10, .mymany Text 105, 15, 200, 40, "S=Single, F=full dial plate, B=gnomon bobbin" Text 5, 30, 210, 20, "www.illustratingshadows.com" Text 5, 40, 220, 20, "Program may end in BASIC SCRIPT ERROR." Text 5, 50, 180, 20, "Ignore BASIC SCRIPT ERROR message." OKButton 200, 30, 40, 10 CancelButton 200, 40, 40, 10 End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** Dim bbbbb As aaaaa bbbbb.mymany = "F" ' ******************************************************************** ' Now get the parameters ' ******************************************************************** ccccc = Dialog(bbbbb) If bbbbb.mymany = "B" Then equatorialB(123) End If If bbbbb.mymany = "S" Then equatorialS(123) End If If bbbbb.mymany = "F" Then equatorialF(123) End If End Function ' ***************************************************************************** ' *** *** ' *** A N A L E M M A ON GNOMON F O R E Q U A T O R I A L *** ' *** *** ' ***************************************************************************** Function equatorialB(iii As Integer) ' ********************************************************************* ' A generic definition is required for a screen input area ' ********************************************************************* Begin Dialog aaaaa 20, 20, 250, 70, "Radius on circle for times to be read in inches." Text 5, 15, 80, 40, "Radius for time reading" TextBox 95, 15, 50, 10, .myglh Text 5, 30, 210, 20, "www.illustratingshadows.com" Text 5, 40, 220, 20, "Program may end in BASIC SCRIPT ERROR." Text 5, 50, 180, 20, "Ignore BASIC SCRIPT ERROR message." OKButton 200, 15, 40, 10 CancelButton 200, 30, 40, 10 End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' Dim glh As Single Dim meYear As String Dim jd As Single Dim eot As Single Dim decl As Single Dim x As Single Dim y As Single Dim r As Single Dim v As Single Dim lastx As Single Dim lasty As Single Dim frstx As Single Dim frsty As Single Dim yExtreme As Single Dim lineY As Single ' ******************************************************************** ' Now get the parameters ' ******************************************************************** bbbbb.myglh = "6.0" ' glh here is actuallly radius ' of the circle on which time is read ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht r = glh ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** If ccccc = -1 Then ' ************************************************************************** ' *** this is the main program to draw the armillary gnomon itself *** ' ************************************************************************** Dim h, hx, hy As Single ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also ' Font dcSetTextParms dcBLACK,"Ariel","Bold",0, 6, 8,0,0 ' p231 of Manual lineY = 1.5 dcCreateText 3, liney, 0, "JD" dcCreateText 3.3, liney, 0, "EOT m.m" dcCreateText 3.7, liney, 0, "DECL" dcCreateText 4.1, liney, 0, "X" dcCreateText 4.5, liney, 0, "Y" lineY = lineY - 0.1 ' Summer in the north hemisphere, winter in the south hemisphere dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 For jd = 1 To 365 Step 10 eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) y = r * Tan( rad(decl) ) x = r * Tan( rad(EOT/4)) If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lasty,lastx,y,x If jd<365 Then dcCreateText y,x, 0, jd End If lastx = x lasty = y End If dcCreateText 3, liney, 0, Format(jd, "000") dcCreateText 3.3, liney, 0, Format(eot, "00.0") dcCreateText 3.7, liney, 0, Format(decl,"00.0") dcCreateText 4.1, liney, 0, Format(x, "00.00") dcCreateText 4.5, liney, 0, Format(y, "00.00") liney = liney - 0.1 Next jd yExtreme = r * Tan( rad(23.44) ) - r * Tan( rad(-23.44) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 dcCreateLine -1, 0, 1, 0 dcCreateLine 0, -1, 0, 1 liney = -0.5 dcCreateText 0.2,liney , 0, "Crossing lines are 1 inch." liney = liney - 0.1 dcCreateText 0.2, liney , 0, "Analemma on gnomon of equatorial dial." liney = liney - 0.1 dcCreateText 0.2, liney , 0, "Radius from gnomon base for reading time in inches:" dcCreateText 2.0, liney , 0, Format(glh,"00.0") dcSetDrawingScale 1.0 End If End Function ' ***************************************************************************** ' *** *** ' *** A N A L E M M A ON DIAL PLATE F O R E Q U A T O R I A L *** ' *** *** ' *** single analemma for both seasons *** ' *** *** ' ***************************************************************************** Function equatorialS (iii As Integer) ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** ' Begin Dialog aaaaa 20, 20, 250, 110, "Height of nodus from dial plate in inches." Text 5, 15, 80, 40, "M=mid year E=end of year" TextBox 95, 15, 50, 10, .myyear Text 5, 25, 80, 40, "Nodus linear height" TextBox 95, 25, 50, 10, .myglh Text 5, 70, 210, 20, "www.illustratingshadows.com" Text 5, 80, 220, 20, "Program may end in BASIC SCRIPT ERROR." Text 5, 90, 180, 20, "Ignore BASIC SCRIPT ERROR message." OKButton 95, 40, 40, 10 CancelButton 95, 55, 40, 10 End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' Dim glh As Single Dim meYear As String Dim jd As Single Dim eot As Single Dim decl As Single Dim x As Single Dim y As Single Dim r As Single Dim v As Single Dim lastx As Single Dim lasty As Single Dim frstx As Single Dim frsty As Single Dim yExtreme As Single Dim lineY As Single ' ******************************************************************** ' Now get the parameters ' ******************************************************************** bbbbb.myglh = "1.0" ' gnomon linear height bbbbb.myyear = "M" ' end or mid-year ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht meYear = bbbbb.myyear ' part of year r = glh ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** If ccccc = -1 Then ' ************************************************************************** ' *** this is the main program to draw the armillary gnomon itself *** ' ************************************************************************** Dim h, hx, hy As Single ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal lineY = 2.0 dcCreateText 2, liney, 0, "JD" dcCreateText 2.3, liney, 0, "EOT m.m" dcCreateText 2.7, liney, 0, "DECL" dcCreateText 3.1, liney, 0, "X" dcCreateText 3.5, liney, 0, "Y" lineY = 1.9 ' Summer in the north hemisphere, winter in the south hemisphere dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color ' set the text color, font, size, etc also ' Font dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 If meYear = "M" Or meYear="m" Then For jd = 105 To 240 Step 10 eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) y = r / Tan( rad(decl) ) x = Tan( rad(EOT/4)) * r / Sin(rad(decl)) If jd = 105 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lasty,lastx,y,x If jd<245 Then If ((jd<150) Or (jd>200)) Then dcCreateText y,x, 0, jd End If End If lastx = x lasty = y End If ' indicate declination every 10 degrees, approx If jd = 105 Then dcCreateLine y,x-0.2, y,x+0.2 End If If jd = 145 Then dcCreateLine y,x-0.2, y,x+0.2 End If If jd = 205 Then dcCreateLine y,x-0.2, y,x+0.2 End If If jd = 235 Then dcCreateLine y,x-0.2, y,x+0.2 End If dcCreateText 2, liney, 0, Format(jd, "000") dcCreateText 2.3, liney, 0, Format(eot, "00.0") dcCreateText 2.7, liney, 0, Format(decl,"00.0") dcCreateText 3.1, liney, 0, Format(x, "00.00") dcCreateText 3.5, liney, 0, Format(y, "00.00") liney = liney - 0.1 Next jd End If ' Summer in the north hemisphere, winter in the south hemisphere If meYear = "E" Or meYear="e" Then ' last part of year For jd = 295 To 365 Step 10 eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) y = r / Tan( rad(decl) ) x = Tan( rad(EOT/4)) * r / Sin(rad(decl)) If jd = 295 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine -lasty,lastx,-y,x If jd<340 Then dcCreateText -y,x, 0, jd End If lastx = x lasty = y End If ' indicate declination every 10 degrees, approx If jd = 295 Then dcCreateLine -y,x-0.2,-y,x+0.2 End If If jd = 325 Then dcCreateLine -y,x-0.2,-y,x+0.2 End If dcCreateText 2, liney, 0, Format(jd, "000") dcCreateText 2.3, liney, 0, Format(eot, "00.0") dcCreateText 2.7, liney, 0, Format(decl,"00.0") dcCreateText 3.1, liney, 0, Format(x, "00.00") dcCreateText 3.5, liney, 0, Format(y, "00.00") liney = liney - 0.1 Next jd ' first part of year For jd = 1 To 54 Step 10 eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) y = r / Tan( rad(decl) ) x = Tan( rad(EOT/4)) * r / Sin(rad(decl)) dcCreateLine -lasty,lastx,-y,x If jd>10 Then dcCreateText -y,x, 0, jd End If lastx = x lasty = y ' indicate declination every 10 degrees, approx If jd = 21 Then dcCreateLine -y,x-0.2,-y,x+0.2 End If If jd = 51 Then dcCreateLine -y,x-0.2,-y,x+0.2 End If dcCreateText 2, liney, 0, Format(jd, "000") dcCreateText 2.3, liney, 0, Format(eot, "00.0") dcCreateText 2.7, liney, 0, Format(decl,"00.0") dcCreateText 3.1, liney, 0, Format(x, "00.00") dcCreateText 3.5, liney, 0, Format(y, "00.00") liney = liney - 0.1 Next jd End If yExtreme = r * Tan( rad(23.44) ) - r * Tan( rad(-23.44) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' p231 of Manual dcCreateLine -1,0,1,0 dcCreateText 1.1,0, 0, "Y (left:right). Lines are 1 inch." dcCreateLine 0,-1,0,1 ' north south line dcCreateText 2.0, liney, 0, "Analemma on dialplate of equatorial dial." liney = liney - 0.1 dcCreateText 2.0, liney, 0, "Gnomon linear height in inches:" dcCreateText 3.2, liney, 0, Format(glh,"00.0") dcSetDrawingScale 1.0 End If End Function ' ***************************************************************************** ' *** *** ' *** A N A L E M M A ON DIAL PLATE F O R E Q U A T O R I A L *** ' *** *** ' *** full dial plate *** ' *** *** ' ***************************************************************************** Function equatorialF (iii As Integer) ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** Begin Dialog aaaaa 20, 20, 300, 160, "Height of nodus from dial plate in inches." Text 5, 15, 80, 40, "M=mid year E=end of year" TextBox 95, 15, 50, 10, .myyear Text 5, 25, 80, 40, "Nodus linear height" TextBox 95, 25, 50, 10, .myglh Text 5, 35, 80, 40, "Longitude" TextBox 95, 35, 50, 10, .mylng Text 5, 45, 80, 40, "Legal meridian" TextBox 95, 45, 50, 10, .myref Text 5, 55, 80, 40, "Latitude" TextBox 95, 55, 50, 10, .mylat Text 125, 55, 80, 40, "for sunset line" OKButton 95, 70, 40, 10 CancelButton 95, 85, 40, 10 Text 5, 100, 210, 20, "www.illustratingshadows.com" Text 5, 120, 210, 20, "www.illustratingshadows.com" Text 5, 130, 280, 20, "Program may end in BASIC SCRIPT ERROR. Ignore BASIC SCRIPT ERROR message." Text 5, 140, 280, 10, " " End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' Dim glh As Single Dim meYear As String Dim jd As Single Dim eot As Single Dim decl As Single Dim x,y As Single Dim lng,ref As Single Dim r,v As Single Dim lat As Single Dim lastx As Single Dim lasty As Single Dim frstx As Single Dim frsty As Single Dim yExtreme As Single ' ******************************************************************** ' Now get the parameters ' ******************************************************************** bbbbb.myglh = "1.0" ' gnomon linear height bbbbb.myyear = "M" ' end or mid-year bbbbb.mylng = "108.2" bbbbb.myref = "105" bbbbb.mylat = "32.75" ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht meYear = bbbbb.myyear ' part of year r = glh lng = bbbbb.mylng ref = bbbbb.myref lat = bbbbb.mylat ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** If ccccc = -1 Then ' ************************************************************************** ' *** this is the main program to draw the armillary gnomon itself *** ' ************************************************************************** Dim h, hx, hy As Single ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' Summer in the north hemisphere, winter in the south hemisphere dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color ' set the text color, font, size, etc also ' Font dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' *** DECLINATION circles *** dcSetTextParms dcBLACK,"Ariel","Bold",0,15,8,0,0 ' the 15 is font ' 23.44, 20, 15, 10, 5, 0 however 5, 0 is a bit optimistic as it is at infinity dcSetCircleParms dcBLUE, dcNORMAL, dcTHIN dcCreateText 0 ,r * Tan(rad(90-23.44)) ,0, "23.44" dcCreateCircle 0 , 0 , r * Tan(rad(90-23.44)) For h = 10 to 20 step 2 dcCreateText 0 ,r * Tan(rad(90-h)) ,0, Format(h,"00") dcCreateCircle 0 , 0 , r * Tan(rad(90-h)) Next h ' *** LOCAL APPARENT TIME NOON *** uses a declination of 10 to 23.44 for the line dcCreateLine 0,r * Tan(rad(90-23.44)),0,r * Tan(rad(90-10)) dcCreateLine 0,r * -Tan(rad(90-23.44)),0,r * -Tan(rad(90-10)) ' *** DO 24 corrected hour lines for longitude - and their analemmas Dim hrangle ' longitude correction differs deending on MAR-SEP or SEP to MAR dcSetTextParms dcBLACK,"Ariel","Bold",0,10,8,0,0 ' the 10 is font h = lng - ref If UCase(meyear) = "M" Then h = ref - lng End If ' For hrangle = 0+h to 345+h step 15 ' h is the angle of the line which starts at 0,0 ' we need an x and y end point ' "y" is the radius of the hour lines ' = r * Tan(rad(90-10)) ' deltacad bug RAD here <-----------> does not work hx = r * Tan(rad(90-10)) * Sin(hrangle*2*3.1416/360) hy = r * Tan(rad(90-10)) * Cos(hrangle*2*3.1416/360) dcCreateLine 0,0,hx,hy ' dcSetTextParms dcBLACK,"Ariel","Bold",0,8,8,0,0 If UCase(meyear) = "M" Then dcCreateText hx,hy ,0, Format ( ((hrangle-h)/15), "00") Else dcCreateText hx,hy ,0, Format ( (24-((hrangle-h)/15)), "00") End If ' ' ' DO THE MID YEAR (March to September) ANALEMMA IF WE ARE MID YEAR 105 to 240 ' FYI: end of year is 295 to 365 and 1 To 54 ' If UCase(meYear) = "M" Then For jd = 105 To 240 Step 10 ' the EOT is in minutes eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) ' so make the EOT in degrees eot = eot/4 ' so make eot now degrees on the dial plate adjusted for lng and eot eot = hrangle + eot ' get the declination in degrees decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' so make it a distance decl = r * Tan(rad(90-decl)) ' now EOT is a radial and decl is a distance and is this a polar coordinate ' decl = radius of this coordinate ' eot = angle of this coordinate y = decl * Sin(rad(eot)) x = decl * Cos(rad(eot)) ' If jd = 105 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lasty,lastx,y,x If jd<245 Then If ((jd<150) Or (jd>200)) Then dcCreateText y,x, 0, jd End If End If lastx = x lasty = y End If Next jd End If ' ' DO THE END YEAR (March to September) ANALEMMA 295 to 365 and 1 To 54 ' If UCase(meYear) = "E" Then For jd = 295 To 365 Step 10 ' the EOT is in minutes eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) ' so make the EOT in degrees eot = eot/4 ' so make eot now degrees on the dial plate adjusted for lng and eot eot = hrangle + eot ' get the declination in degrees decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' so make it a distance decl = r * Tan(rad(90-decl)) ' now EOT is a radial and decl is a distance and is this a polar coordinate ' decl = radius of this coordinate ' eot = angle of this coordinate y = decl * Sin(rad(eot)) x = decl * Cos(rad(eot)) ' If jd = 295 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lasty,lastx,y,x If jd>245 Then If jd<240 Then dcCreateText y,x, 0, jd End If End If lastx = x lasty = y End If Next jd For jd = 1 To 54 Step 10 ' the EOT is in minutes eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) ' so make the EOT in degrees eot = eot/4 ' so make eot now degrees on the dial plate adjusted for lng and eot eot = hrangle + eot ' get the declination in degrees decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' so make it a distance decl = r * Tan(rad(90-decl)) ' now EOT is a radial and decl is a distance and is this a polar coordinate ' decl = radius of this coordinate ' eot = angle of this coordinate y = decl * Sin(rad(eot)) x = decl * Cos(rad(eot)) ' If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lasty,lastx,y,x If jd<245 Then If jd>10 Then dcCreateText y,x, 0, jd End If End If lastx = x lasty = y End If Next jd End If ' ' Next hrangle ' *** DO SUNSET LINE y = r * Tan(rad(lat)) ' mid year uses a line above dial center If UCase(meYear) = "E" Then ' mid year uses a line above dial center y = - y End If x = r * Tan(rad(90-10)) dcSetLineParms dcBLACK,dcSOLID,dcTHICK dcCreateLine - x, y, r * x, y dcCreateText -2, y+0.05, 0, "Sunrise/set for relevant declination" yExtreme = r * Tan( rad(23.44) ) - r * Tan( rad(-23.44) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,14,8,0,0 ' p231 of Manual - 14 is font ' *** DO A 1 INCH AND A GNOMON LINE ALSO dcSetLineParms dcBLUE,dcSOLID,dcNORMAL dcSetTextParms dcBLUE,"Ariel","Bold",0,10,8,0,0 dcCreateLine 0 ,0 ,0 ,glh ' north south line dcCreateText 0 ,glh+0.1 ,0, "Vertical line is gnomon" dcSetLineParms dcBROWN,dcSOLID,dcNORMAL dcSetTextParms dcBROWN,"Ariel","Bold",0,10,8,0,0 dcCreateLine -1 , 0 ,1 ,0 dcCreateText -1 ,-0.3 ,0, "Horizontal line is 1 inch." dcSetLineParms dcBLACK,dcSOLID,dcNORMAL If UCase(meyear) = "M" Then dcCreateText -1 ,-0.45 ,0, "Mid year is: March through September" End If If UCase(meyear) = "E" Then dcCreateText -1 ,-0.45 ,0, "Year end is: September through March" End If dcSetDrawingScale 1.0 End If End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 3 ] *** ' *** *** ' *** A N A L E M M A O N D I A L P L A T E F O R *** ' *** polar *** ' *** west meridian *** ' *** east meridian *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function polar (iii As Integer) ' ********************************************************************* ' A generic definition is required for a screen input area ' ********************************************************************* Begin Dialog aaaaa 20, 20, 300,160, "[3] Polar/Meridian analemma options" Text 5, 10, 60, 10, "Enter dial type" TextBox 65, 10, 30, 10, .mytyp Text 105, 10, 180, 10, "[P=polar, and E=east and W=west meridian]" Text 5, 20, 60, 10, "Enter latitude" TextBox 65, 20, 30, 10, .mylat Text 105, 20, 180, 10, "[only used for E=east and W=west meridian]" Text 5, 30, 60, 10, "Enter longitude" TextBox 65, 30, 30, 10, .mylng Text 105, 30, 180, 10, "[DL 0 to 15 if used with v-dec +W -E of meridian]" Text 5, 40, 60, 10, "Enter ref longitude" TextBox 65, 40, 30, 10, .myref Text 105, 40, 150, 10, "[0 if used with a v-dec dial]" Text 5, 50, 60, 10, "Gnomon lin ht" TextBox 65, 50, 30, 10, .myglh Text 135, 60, 60, 10, "Hr ln div 1,2,4" TextBox 105, 60, 30, 10, .mydvh Text 5, 105, 210, 40, "www.illustratingshadows.com" Text 5, 120, 220, 40, "Program ends in BASIC SCRIPT ERROR if run standalone." Text 5, 130, 220, 40, "Some analemmas may have very obvious abberations." Text 5, 140, 180, 40, "Ignore BASIC SCRIPT ERROR message." OKButton 65, 75, 30, 10 CancelButton 65, 90, 30, 10 End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' Dim glh, dvh As Single Dim lng, ref As Single Dim jd, eot As Single Dim lat,colat As Single Dim decl As Single Dim x,y As Single Dim r As Single Dim v As Single Dim lastx As Single Dim lasty As Single Dim frstx As Single Dim frsty As Single Dim yExtreme As Single Dim typ As String ' ******************************************************************** ' Now get the parameters ' ******************************************************************** bbbbb.myglh = "1.0" ' gnomon linear height bbbbb.mydvh = "1" ' 1=1 hour 2=30 mins etc bbbbb.mylat = "32.75" ' lat if meridian not polar bbbbb.mylng = "108.2" ' longitude bbbbb.myref = "105" ' legal meridian bbbbb.mytyp = "P" ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht lng = bbbbb.mylng ref = bbbbb.myref dvh = bbbbb.mydvh lat = bbbbb.mylat typ = UCase(bbbbb.mytyp) ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** ' ccccc = -1 means the ok button was used and not the cancel button If ccccc = -1 Then ' ************************************************************************** ' *** this is the main program to draw the armillary gnomon itself *** ' ************************************************************************** Dim h, hx, hy As Single ' DeltaCAD is fussy about data attributes colat = 90 - lat ' co latitude if meridian (not if polar) cls ' clear the screen ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also ' Font dcSetTextParms dcBLACK,"Ariel","Bold",0, 6, 8,0,0 ' p231 of Manual y = glh - 0.2 dcCreateText 0, -y-0.2, 0, "Analemma on dialplate of polar dial." dcCreateText 0, -y-0.3, 0, "Gnomon linear height in inches:" dcCreateText 1.2, -y-0.3, 0, Format(glh,"00.0") dcCreateText 0, -y-0.4, 0, "Declinations are: 0, 5, 10, 15, 20, 23.44" ' *** ANALEMMAS *** For h = -4 to 4 step 1/dvh ' analemmas for every hour and if desired half hor ' but not for the quarters If ( h - Int(h) = 0 ) Or ( h - Int(h) = 0.5 ) Then For jd = 1 To 361 Step 10 ' standard EOT in minutes and DECLINATION in degrees for this JD of 1 to 365 ' the -1 puts the EOT and DECL the correct way for the gnomon eot = - 1* ( 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) ) decl = - 1* (23.45 * Sin(rad(0.9678*(jd-80))) ) ' from style to hour line = sh * tan(lha from noon) ' distance up an hour line to a calendar line = sh * tan (declination) / cos (time ) ' x and y here are for theJD's legal time and sun's declination ' there is no hour line as such, only the analemma x = glh * Tan( rad(ref-lng+(15*(h+eot/60))) ) y = glh * Tan( rad(decl) ) / Cos(rad(ref-lng+(15*(h+eot/60)))) dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y If jd<150 And h = - 4 Then dcCreateText x,y, 0, jd End If If jd>200 And h = 4 And jd < 340 Then dcCreateText x,y, 0, jd End If lastx = x lasty = y End If ' indicate declination every 5 degrees, approx, based on jd If jd = 21 Then dcCreateLine x-0.05,y,x+0.05,y End If If jd = 51 Then dcCreateLine x-0.05,y,x+0.05,y End If If jd =111 Then dcCreateLine x-0.05,y,x+0.05,y End If If jd =141 Then dcCreateLine x-0.05,y,x+0.05,y End If Next jd End If Next h dcCreateLine lastx,lasty,frstx,frsty ' *** CALENDAR CURVES *** -23.44 For h = -5 to 5 step 0.1 decl = -23.44 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) dcSetLineParms dcBLUE,dcSOLID,dcTHIN If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** -20 For h = -5 to 5 step 0.1 decl = -20 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** -15 For h = -5 to 5 step 0.1 decl = -15 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** -10 For h = -5 to 5 step 0.1 decl = -10 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** -5 For h = -5 to 5 step 0.1 decl = -5 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** 23.44 For h = -5 to 5 step 0.1 decl = 23.44 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) dcSetLineParms dcRED,dcSOLID,dcTHIN If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** 20 For h = -5 to 5 step 0.1 decl = 20 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** 15 For h = -5 to 5 step 0.1 decl = 15 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** 10 For h = -5 to 5 step 0.1 decl = 10 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** CALENDAR CURVES *** 5 For h = -5 to 5 step 0.1 decl = 5 x = glh * Tan( rad(15*(h+eot/60)) ) y = glh * Tan( rad(decl) ) / Cos(rad(15*(h+eot/60))) If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h ' *** PURE HOUR LINES *** For h = -5 to 5 step 1/dvh ' from style to hour line = sh * tan(lha from noon) ' distance up an hour line to a calendar line = sh * tan (declination) / cos (time ) ' x and y here are for theJD's legal time and sun's declination ' there is no hour line as such, only the analemma x = glh * Tan( rad(ref-lng+(15*h)) ) y = glh * Tan( rad(23.44) ) / Cos(rad(ref-lng+(15*h))) dcSetLineParms dcBROWN,dcSOLID,dcTHIN ' set black as default line color dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 dcCreateLine x,y,x,-y If (h - Int(h)) = 0 Then If typ = "P" Then dcCreateText x, y+0.1, 0, Format( 12+ h, "00") dcCreateText x, -y-0.1, 0, Format( 12+ h+1,"00") End If If typ = "W" Then dcSetTextParms dcBLACK,"Ariel","Bold", 0-colat,6, 8,0,0 dcCreateText x, y+0.2, 0, Format( 6+h, "00") dcCreateText x, -y-0.2, 0, Format( 6+h+1,"00") End If If typ = "E" Then dcSetTextParms dcBLACK,"Ariel","Bold", colat,6, 8,0,0 dcCreateText x, y+0.2, 0, Format( 12-h, "00") dcCreateText x, -y-0.2, 0, Format( 12-h+1,"00") End If End If Next h ' *** EQUINOX LINE *** For h = -5 to 5 step 0.1 decl = 5 x = glh * Tan( rad(15*(h+eot/60)) ) y = 0 If h = -5 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty,x,y lastx = x lasty = y End If Next h dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' *** DRAW ONE GNOMON LINEAR HEIGHT LINE ON LOCAL APPARENT NOON dcSetLineParms dcBLACK,dcSOLID,dcNORMAL dcCreateLine 0, 0 , 0, glh ' *** DRAW ONE GNOMON LINEAR HEIGHT LINE ON TOP OF LOCAL APPARENT NOON MAKING A "T" x = glh/2 dcCreateText -x, glh+0.1, 0, "T lines below are gnomon linear height" dcCreateLine -x, glh, x, glh ' *** SELECT AND ROTATE if a meridian dial If typ = "E" Then dcSelectObjInBox -5, -3, 5, 3 dcRotateSelObjs -colat dcUnSelectAll End If If typ = "W" Then dcSelectObjInBox -5, -3, 5, 3 dcRotateSelObjs colat dcUnSelectAll End If dcSetDrawingScale 1.0 dcViewBox -4, -2, 4, 2 End If End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 4 ] *** ' *** *** ' *** S I M P L E H O R I Z O N T A L S U N D I A L *** ' *** *** ' *** but allows for calendar based on gnomon linear height *** ' *** and also provides analemmas *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function hDial(DL0to6a As Single, SH0to6a As Single, chc As Integer) ' ********************************************************************* ' Initial house keeping - set the drafting area unit ' ********************************************************************* dcSetDrawingScale 0.80 ' ********************************************************************* ' A generic definition is required for a screen input area ' ********************************************************************* Begin Dialog aaaaa 20, 20, 300,160, "[4] Horizontal dial analemma options" Text 5, 15, 60,10, "Enter latitude" TextBox 65, 15, 30, 10, .mylat Text 105, 15, 50,10, "30 to 55" Text 5, 30, 60, 10, "Enter longitude" TextBox 65, 30, 30, 10, .mylng Text 105, 30, 180, 10, "[DL 0 to 15 if used with v-dec +W -E of meridian]" Text 5, 45, 60, 10, "Enter ref longitude" TextBox 65, 45, 30, 10, .myref Text 105, 45, 150, 10, "[0 if used with a v-dec dial]" Text 5, 60, 60, 10, "Gnomon lin ht" TextBox 65, 60, 30, 10, .myglh Text 135, 75, 60, 10, "Hr ln div 1,2,4" TextBox 105, 75, 20, 10, .mydvh Text 5, 105, 210, 40, "www.illustratingshadows.com" Text 5, 120, 220, 40, "Program ends in BASIC SCRIPT ERROR if run standalone." Text 5, 130, 220, 40, "Some analemmas may have very obvious abberations." Text 5, 140, 180, 40, "Ignore BASIC SCRIPT ERROR message." OKButton 65, 75, 30, 10 CancelButton 65, 90, 30, 10 End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** ' ' this defines "bbbbb" as an instance of aaaaa dialog Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' ' define a lat and a long, a reference longitude, Dim lat As Single ' nodus to dial plate linear height Dim lng As Single ' and hour divisions Dim ref As Single Dim glh As Single Dim dvh As Single ' ******************************************************************** ' Now get the lat, long, and reference longitude ' ******************************************************************** bbbbb.mylat = SH0to6a ' latitude for dial plate bbbbb.mylng = DL0to6a bbbbb.myref = "0" bbbbb.myglh = "0.2" ' gnomon linear height bbbbb.mydvh = "1" ' 1=1hour 2=30mins etc ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht lat = bbbbb.mylat ' latitude lng = bbbbb.mylng ' longitude ref = bbbbb.myref ' legal time meridian longitude dvh = bbbbb.mydvh ' divide hours by this ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** If ccccc = -1 Then ' ************************************************************************** ' *** this is the main program to draw the horizontal dial itself *** ' ************************************************************************** ' calculate hour line angles next, but first define them Dim h, hx, hy As Single ' the formula is... hourlineangle = atan ( sin(lat) * tan (lha) ) ' almost all systems us radians ' the formula also needs adjustment for longitude displacement ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,7, 20,0,0 If chc = 6 Then dcCreateText -1.25, -0.3, 0, "normal h-dial: calendar using gnomon linear height" End If If chc = 0 Then dcCreateText -1.25, -0.3, 0, "h-dial for v-dec: calendar using gnomon linear height" End If dcCreateText 0.20, -0.4, 0, "Lat: " dcCreateText 0.40, -0.4, 0, Format(lat, "00.0") dcCreateText 0.60, -0.4, 0, "d.Long: " dcCreateText 1.00, -0.4, 0, Format(lng-ref, "00.0") If dvh <> 1 Then dcCreateText -1.25, -0.4, 0, "check 11-1" End If dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 21,0,0 dcCreateText -0.35, -0.7, 0, "Hours below horizontal use the 90 reference line below horizontal." ' ---------------------------------------------------------------------------- ' PHASE 2: draw normal hours that extend to the box limits ' ---------------------------------------------------------------------------- For hr = 6 To 18 Step (1/dvh) ' 1/dvh allows hour divisions ' ================================================================= ' for the hour (hr) calculate the hour line angle (h) for this ' longitude adjusted for the reference longitude ' show the angle h = Hla ( (hr), (lat), (lng), (ref) ) ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then ' show the time in hours dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 dcCreateText (-1.2+((hr-6)/5)), -0.5, 0, Abs(hr) ' show the angle dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 21,0,0 dcCreateText (-1.2+((hr-6)/5)), -0.6, 0, Format(h, "00.0") End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color If ( hr - Int(hr) ) <> 0 Then dcSetLineParms dcBLUE,dcSTITCH,dcTHIN ' but if not full hour change End If If hr < 12 Then ' -------------------------------------------------------------------- ' morning hours ~ NOTE code for keeping lines in a boxed area ' --------------------------------------------------------------------- If Abs(h) < 45 Then ' lines touch top of box dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then dcCreateText (hx), 1.1, 0, Abs(hr) End If Else ' lines touch side of box dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 hy = Tan(rad((90-h))) dcCreateLine 0,0,-1,-hy ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then dcCreateText -1.1, -hy, 0, Abs(hr) End If End If ElseIf hr = 12 Then ' ------------- ' noon hours ' ------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 21,0,0 hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' say that it is 12 noon dcCreateText (hx), 1.1, 0, Abs(hr) Else ' --------------- ' afternoon hours ' --------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 If h < 0 Then h = -1 * h End If If h < 45 Then hx = Abs(Tan(rad((h)))) ' (( )) solves type mismatch dcCreateLine 0, 0, hx, 1 ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then dcCreateText (hx), 1.1, 0, Abs(hr) End If Else hy = Tan(rad((90-h))) If ref <= lng Then dcCreateLine 0, 0, 1, hy Else If deg(Atn(Sin(rad(lat))*Tan(rad((hr*15) +(ref-lng)))))< 0 Then dcCreateLine 0, 0, 1, -hy Else dcCreateLine 0, 0, 1, hy End If End If ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then If ref <= lng Then dcCreateText 1.1, hy, 0, Abs(hr) Else If hr < 18 Then dcCreateText 1.1, hy, 0, Abs(hr) Else dcCreateText 1.1, -hy, 0, Abs(hr) End If End If End If End If End If ' ========================================================================= Next hr ' ------------------------------------------------------------------------- ' PHASE 3: draw calendar lines ' ------------------------------------------------------------------------- Dim wx, wy, qx, qy, sx, sy As Single ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then ' this is a usable hour, we have three declinations (-23.5, 0, 23.5) ' we have the hour ' we have the gnomon linear height ' first get the winter, equinox, and summer distances on the LAT ' hour lines, we do not draw the LAT hour line. wz = Cal ( (hr), (lat), -23.5, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +23.5 , glh ) ' last parm = decl ' get the LAT hour line angle also zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours ' and zh can be negatove (am) or positive (pm) ' we have an hour line angle (LAT), and a distance ' ' nwx nqx nsx ' ' wz \ | nwy ' \ | ' qz \ zh| nqy ' \ | ' sz \ | ns ' * ' ' assuming a center of 0,0 (dial center) we can calculate the ' x,y values for each declination by... ' ' x = sin(h) * z ' y = cos(h) * z nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then ' this is not the first time around so we can draw a line ' from (sx,sy) to (nsx,nsy) and so on ' the calendar lines can get excessive ' the best code would take each line segment and if it impacts ' a boundary then shorten the line segment. ' the next best code is probably what is in Function Dln ' Then the next best would be a table of latitudes and what ' hours are acceptable as limits, and so on. ' This code doesnt like winter lines at higher latitudes, ' so it tests the "y" values against the equinox Y value dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' page 228 Manual If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' eqxinox lines can also get excessive dcSetLineParms dcGREEN,dcSOLID,dcTHIN ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If ' and make these new points be the start for the next calendar line's points wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr ' ------------------------------------------------------------------------- ' PHASE 3a: draw more calendar lines - July & May, and, November & January ' ------------------------------------------------------------------------- ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points If animate <> 1 Then For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then wz = Cal ( (hr), (lat), -18.0, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +18.0 , glh ) ' last parm = decl zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' page 228 Manual If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' dcsetlineparms dcgreen,dcsolid,dcthin ' ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr End If ' ------------------------------------------------------------------------- ' PHASE 3b: more calendar lines - August & April, and, October & February ' ------------------------------------------------------------------------- ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points If animate <> 1 Then For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then wz = Cal ( (hr), (lat), -10.0, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +10.0 , glh ) ' last parm = decl zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then dcSetLineParms dcBLUE,dcSOLID,dcTHIN If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' dcsetlineparms dcgreen,dcsolid,dcthin ' ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr End If ' ------------------------------------------------------------------------- ' PHASE 4: draw the gnomon to the nodus (for calendar lines) ' ------------------------------------------------------------------------- nodusx = glh nodusy = (Cos(rad(lat)) * glh) / Sin(rad(lat)) dcSetLineParms dcRED,dcSOLID,dcTHIN dcCreateLine 0, 0, nodusx, nodusy ' draw the gnomon's style dcCreateLine 0, nodusy, nodusx, nodusy ' draw the gnomon's lin ht dcCreateLine 0, 0 , 0, nodusy ' draw the sub-style dcCreateCircle nodusx, nodusy, 0.01 ' circle for nodus dcCreateCircle 0, 0, 0.01 ' circle for dial center dcCreateCircle 0, nodusy, 0.01 ' circle for base of nodus ' ------------------------------------------------------------------------- ' PHASE 4a: draw analemma ' ------------------------------------------------------------------------- Dim dl As Single Dim h1,h2 As Single Dim meYear As String Dim jd As Single Dim eot As Single Dim decl As Single Dim alt As Single Dim azi As Single Dim x,y,r,v As Single Dim lastx,lasty As Single Dim frstx,frsty As Single Dim lineY,lx,ly As Single Dim degtorad As Single Dim radtodeg As Single Dim signofX As Single Dim yDisp As Single dl = lng-ref ' longitude diff from meridian, + is west h1 = 10 h2 = 15 degtorad = 2*3.14159/360 radtodeg = 360 / (2*3.1416) ' *** CALCULATE Y DISPLACEMENT yDisp = Cal ( (12), (lat), +23.5 , glh ) + glh / Tan(DegToRad*lat) For hr = h1 to h2 step 1 ' unless 12 noon retain this sign for all x in an hour signOfX = 0 dcSetLineParms dcBROWN,dcSOLID,dcTHIN For jd = 1 To 365 Step 2 ' *** GET EOT AND DECLINATION *** eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' *** If invoked by choice 0 then must reverse sign of DECL and EOT ' because analemma needs rotating end over end and left to right ' since while a v-dial and h-dial have a lat to co-lat relationship ' (1) the longitude correction is reversed - hence left to right, and ' (2) winter and summer are reversed - hence top to bottom If chc = 0 Then eot = - eot decl = - decl End If ' *** GET ALTITUDE AND AZIMUTH FOR TODAY, THIS HOUR, AT THIS LATITUDE AND LONGITUDE.DIFF ' hr = corected time considering longitude ' amh = local apparent time amh = hr - (dl/15) - (eot/60) alt = RadToDeg*(asn(Sin(DegToRad*(decl))*Sin(DegToRad*Lat)+Cos(DegToRad*decl)*Cos(DegToRad*Lat)*Cos(DegToRad*(15*(12-(amh)))))) azi = RadToDeg*(Atn(Sin(DegToRad*(15*(12-amh)))/(Sin(DegToRad*Lat)*Cos(DegToRad*(15*(12-amh)))-Tan(DegToRad*decl)*Cos(DegToRad*Lat)))) y = yDisp + Cos(degtorad*azi) * glh / Tan(degtorad*(alt)) x = -(glh/Tan(degtorad*alt)) * Sin(degtorad*(azi)) ' manage sign reversals If jd = 1 Then signOfX = x End If If (signofx>0 And x < 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If If (signofx<0 And x > 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If If y < 0 Then ' x = x * (-1) y = y * (-1) End If If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else If Abs(y) < 1 Then dcCreateLine lastx,lasty, x,y End If lastx = x lasty = y End If dcSetTextParms dcBLACK,"Ariel","Bold",0, 4, 8,0,0 If jd =45 And Abs(y) < 1 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "1q" End If If jd =90+45 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "2q" End If If jd =190+45 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "3q" End If If jd =270+45 And Abs(y) < 1 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "4q" End If Next jd dcCreateLine lastx,lasty, frstx,frsty Next hr ' ------------------------------------------------------------------------- ' PHASE 5: draw the boundaries and display the final product ' ------------------------------------------------------------------------- ' draw a box around everything dcCreateBox -1, 0, 1, 1 dcCreateBox -1.2, -.2, 1.2, 1.2 ' smaller box and NS line dcCreateBox -0.5, 0, 0.5, 1.0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN dcCreateLine 0, nodusy, 0, 1 ' draw the gnomon's style dcViewBox -1.1, -1.4, 1.1, 1.3 End If Exit Function End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 5 ] *** ' *** *** ' *** S I M P L E V E R T I C A L S U N D I A L *** ' *** *** ' *** but allows for calendar based on gnomon linear height *** ' *** and also provides analemmas *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function vDial ' ********************************************************************* ' Initial house keeping - set the drafting area unit ' ********************************************************************* dcSetDrawingScale 0.80 ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** ' Begin Dialog aaaaa 20, 20, 280,160, "[5] Vertical dial analemma options" Text 5, 15, 60,10, "Enter latitude" TextBox 65, 15, 50, 10, .mylat Text 125, 15, 60,10, "lat 25 to 55" Text 5, 30, 60, 10, "Enter longitude" TextBox 65, 30, 50, 10, .mylng Text 5, 45, 60, 10, "Enter ref longitude" TextBox 65, 45, 50, 10, .myref Text 5, 60, 60, 10, "Gnomon lin ht" TextBox 65, 60, 30, 10, .myglh Text 145, 60, 60, 10, "Hr ln div 1,2,4" TextBox 125, 60, 20, 10, .mydvh Text 5, 105, 210, 40, "www.illustratingshadows.com" Text 5, 120, 220, 40, "Program ends in BASIC SCRIPT ERROR if run standalone." Text 5, 130, 220, 40, "Some analemmas may have very obvious abberations." Text 5, 140, 180, 40, "Ignore BASIC SCRIPT ERROR message." OKButton 65, 75, 40, 10 CancelButton 65, 90, 40, 10 End Dialog ' ******************************************************************** ' The generic definition must then be generated with a name ' ******************************************************************** Dim bbbbb As aaaaa ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' ' define a lat and a long, a reference longitude, Dim lat As Single ' nodus to dial plate linear height Dim lng As Single ' and hour divisions Dim ref As Single Dim glh As Single Dim dvh As Single ' ******************************************************************** ' Now get the lat, long, and reference longitude ' ******************************************************************** bbbbb.mylat = "32.75" ' latitude for dial plate bbbbb.mylng = "108.2" bbbbb.myref = "105.0" bbbbb.myglh = "0.2" ' gnomon linear height bbbbb.mydvh = "1" ' 1=1hour 2=30mins etc ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht lat = 90-bbbbb.mylat ' ~~~ 90-latitude for vdial lng = bbbbb.myref ' ~~~ longitude is meridian for vdial ref = bbbbb.mylng ' ~~~ legal meridian is longitude for vdial dvh = bbbbb.mydvh ' ~~~ divide hours by this cls ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** If ccccc = -1 Then ' ************************************************************************** ' *** this is the main program to draw the horizontal dial itself *** ' ************************************************************************** ' calculate hour line angles next, but first define them Dim h, hx, hy As Single ' DeltaCAD is fussy about data attributes ' the formula is... hourlineangle = atan ( sin(lat) * tan (lha) ) ' almost all systems us radians ' the formula also needs adjustment for longitude displacement ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,7, 20,0,0 dcCreateText -1.25, -0.3, 0, "v-dial and calendar using gnomon linear height" dcCreateText -0.40, -0.4, 0, "Lat: " dcCreateText -0.1 , -0.4, 0, Format(90-lat, "00.0") dcCreateText 0.15, -0.4, 0, "coLat: " dcCreateText 0.40, -0.4, 0, Format(lat, "00.0") dcCreateText 0.60, -0.4, 0, "d.Long: " dcCreateText 1.00, -0.4, 0, Format(lng-ref, "00.0") If dvh <> 1 Then dcCreateText -1.25, -0.4, 0, "check 11-1" End If ' ---------------------------------------------------------------------------- ' PHASE 2: draw normal hours that extend to the box limits ' ---------------------------------------------------------------------------- For hr = 6 To 18 Step (1/dvh) ' 1/dvh allows hour divisions ' ================================================================= ' for the hour (hr) calculate the hour line angle (h) for this ' longitude adjusted for the reference longitude ' show the angle h = Hla ( (hr), (lat), (lng), (ref) ) ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then ' show the time in hours dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 dcCreateText (-1.2+((hr-6)/5)), -0.5, 0, Abs(24-hr) ' ~~~ flip hour ' show the angle dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 21,0,0 dcCreateText (-1.2+((hr-6)/5)), -0.6, 0, Format(h, "00.0") dcCreateText -0.35, -0.7, 0, "Hours above horizontal use the 90 reference line below horizontal." End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color If ( hr - Int(hr) ) <> 0 Then dcSetLineParms dcBLUE,dcSTITCH,dcTHIN ' but if not full hour change End If If hr < 12 Then ' -------------------------------------------------------------------- ' morning hours ~ NOTE code for keeping lines in a boxed area ' ~~~ become afternoon hours on vdial ' --------------------------------------------------------------------- If Abs(h) < 45 Then ' lines touch top of box dcSetTextParms dcBLACK,"Ariel","Bold",180,8, 21,0,0 ' ~~~ flip text hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then dcCreateText (hx), 1.1, 0, Abs( 24- hr) ' ~~~ flip hour End If Else ' lines touch side of box dcSetTextParms dcBLACK,"Ariel","Bold",180,8, 20,0,0 ' ~~~ flip text hy = Tan(rad((90-h))) dcCreateLine 0,0,-1,-hy ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then dcCreateText -1.1, -hy, 0, Abs( 24- hr) ' ~~~ flip hour End If End If ElseIf hr = 12 Then ' ------------- ' noon hours ' ------------- dcSetTextParms dcBLACK,"Ariel","Bold",180,10, 21,0,0 ' ~~~ flip text hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' say that it is 12 noon dcCreateText (hx), 1.1, 0, Abs(hr) Else ' --------------- ' afternoon hours ' ~~~ become morning hours on vdial ' --------------- dcSetTextParms dcBLACK,"Ariel","Bold",180,8, 21,0,0 ' ~~~ flip text If h < 0 Then h = -1 * h End If If h < 45 Then hx = Abs(Tan(rad((h)))) ' (( )) solves type mismatch dcCreateLine 0, 0, hx, 1 ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then dcCreateText (hx), 1.1, 0, Abs(24-hr) ' ~~~ vdial hour flip End If Else hy = Tan(rad((90-h))) If ref <= lng Then dcCreateLine 0, 0, 1, hy Else If deg(Atn(Sin(rad(lat))*Tan(rad((hr*15) +(ref-lng)))))< 0 Then dcCreateLine 0, 0, 1, -hy Else dcCreateLine 0, 0, 1, hy End If End If ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then If ref <= lng Then dcCreateText 1.1, hy, 0, Abs(24-hr) ' ~~~ vdial hour flip Else If hr < 18 Then dcCreateText 1.1, hy, 0, Abs(24-hr) ' ~~~ vdial hour flip Else dcCreateText 1.1, -hy, 0, Abs(24-hr) ' ~~~ vdial hour flip End If End If End If End If End If ' ========================================================================= Next hr ' ------------------------------------------------------------------------- ' PHASE 3: draw calendar lines ' ------------------------------------------------------------------------- Dim wx, wy, qx, qy, sx, sy As Single ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then ' this is a usable hour, we have three declinations (-23.5, 0, 23.5) ' we have the hour ' we have the gnomon linear height ' first get the winter, equinox, and summer distances on the LAT ' hour lines, we do not draw the LAT hour line. wz = Cal ( (hr), (lat), -23.5, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +23.5 , glh ) ' last parm = decl ' get the LAT hour line angle also zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours ' and zh can be negatove (am) or positive (pm) ' we have an hour line angle (LAT), and a distance ' ' nwx nqx nsx ' ' wz \ | nwy ' \ | ' qz \ zh| nqy ' \ | ' sz \ | ns ' * ' ' assuming a center of 0,0 (dial center) we can calculate the ' x,y values for each declination by... ' ' x = sin(h) * z ' y = cos(h) * z nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then ' this is not the first time around so we can draw a line ' from (sx,sy) to (nsx,nsy) and so on ' the calendar lines can get excessive ' the best code would take each line segment and if it impacts ' a boundary then shorten the line segment. ' the next best code is probably what is in Function Dln ' Then the next best would be a table of latitudes and what ' hours are acceptable as limits, and so on. ' This code doesnt like winter lines at higher latitudes, ' so it tests the "y" values against the equinox Y value dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' page 228 Manual If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' eqxinox lines can also get excessive dcSetLineParms dcGREEN,dcSOLID,dcTHIN ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If ' and make these new points be the start for the next calendar line's points wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr ' ------------------------------------------------------------------------- ' PHASE 3a: draw more calendar lines - July & May, and, November & January ' ------------------------------------------------------------------------- ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points If animate <> 1 Then For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then wz = Cal ( (hr), (lat), -18.0, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +18.0 , glh ) ' last parm = decl zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' page 228 Manual If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' dcsetlineparms dcgreen,dcsolid,dcthin ' ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr End If ' ------------------------------------------------------------------------- ' PHASE 3b: more calendar lines - August & April, and, October & February ' ------------------------------------------------------------------------- ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points If animate <> 1 Then For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then wz = Cal ( (hr), (lat), -10.0, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +10.0 , glh ) ' last parm = decl zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then dcSetLineParms dcBLUE,dcSOLID,dcTHIN If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' dcsetlineparms dcgreen,dcsolid,dcthin ' ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr End If ' ------------------------------------------------------------------------- ' PHASE 4: draw the gnomon to the nodus (for calendar lines) ' ------------------------------------------------------------------------- nodusx = glh nodusy = (Cos(rad(lat)) * glh) / Sin(rad(lat)) dcSetLineParms dcRED,dcSOLID,dcTHIN dcCreateLine 0, 0, nodusx, nodusy ' draw the gnomon's style dcCreateLine 0, nodusy, nodusx, nodusy ' draw the gnomon's lin ht dcCreateLine 0, 0 , 0, nodusy ' draw the sub-style dcCreateCircle nodusx, nodusy, 0.01 ' circle for nodus dcCreateCircle 0, 0, 0.01 ' circle for dial center dcCreateCircle 0, nodusy, 0.01 ' circle for base of nodus ' ------------------------------------------------------------------------- ' PHASE 4a: draw analemma ' ------------------------------------------------------------------------- Dim dl As Single Dim h1,h2 As Single Dim meYear As String Dim jd As Single Dim eot As Single Dim decl As Single Dim alt As Single Dim azi As Single Dim x,y,r,v As Single Dim lastx,lasty As Single Dim frstx,frsty As Single Dim lineY,lx,ly As Single Dim degtorad As Single Dim radtodeg As Single Dim signofX As Single Dim yDisp As Single dl = lng-ref ' longitude diff from meridian, + is west h1 = 9 h2 = 15 degtorad = 2*3.14159/360 radtodeg = 360 / (2*3.1416) ' *** OFFSET FOR ANALEMMA yDisp = Cal ( (12), (lat), +23.5 , glh ) + glh / Tan(DegToRad*lat) dcSetLineParms dcBROWN,dcSOLID,dcTHIN For hr = h1 to h2 step 1 ' unless 12 noon retain this sign for all x in an hour signOfX = 0 For jd = 1 To 365 Step 2 ' *** GET EOT AND DECLINATION *** ~~~ both have signs reversed for vdial eot = - 1 * (7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) ) decl = - 23.45 * Sin(rad(0.9678*(jd-80))) ' *** GET ALTITUDE AND AZIMUTH FOR TODAY, THIS HOUR, AT THIS LATITUDE AND LONGITUDE.DIFF ' hr = corected time considering longitude ' amh = local apparent time amh = hr - (dl/15) - (eot/60) alt = RadToDeg*(asn(Sin(DegToRad*(decl))*Sin(DegToRad*Lat)+Cos(DegToRad*decl)*Cos(DegToRad*Lat)*Cos(DegToRad*(15*(12-(amh)))))) azi = RadToDeg*(Atn(Sin(DegToRad*(15*(12-amh)))/(Sin(DegToRad*Lat)*Cos(DegToRad*(15*(12-amh)))-Tan(DegToRad*decl)*Cos(DegToRad*Lat)))) y = yDisp + Cos(degtorad*azi) * glh / Tan(degtorad*(alt)) x = -(glh/Tan(degtorad*alt)) * Sin(degtorad*(azi)) ' manage sign reversals If jd = 1 Then signOfX = x End If If (signofx>0 And x < 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If If (signofx<0 And x > 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If If y < 0 Then ' x = x * (-1) y = y * (-1) End If If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else ' *** clip size of analemma ~~~ especially for vdials If Abs(y) < 1 Then dcCreateLine lastx,lasty, x,y End If lastx = x lasty = y End If dcSetTextParms dcBLACK,"Ariel","Bold",180, 4, 8,0,0 ' ~~~ flip text If jd =45 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "1q" End If If jd =90+45 And Abs(y) < 1 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "2q" End If If jd =190+45 And Abs(y) < 1 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "3q" End If If jd =270+45 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "4q" End If Next jd dcCreateLine lastx,lasty, frstx,frsty Next hr ' ------------------------------------------------------------------------- ' PHASE 5: draw the boundaries and display the final product ' ------------------------------------------------------------------------- ' draw a box around everything dcCreateBox -1, 0, 1, 1 dcCreateBox -1.2, -.2, 1.2, 1.2 ' smaller box and NS line dcCreateBox -0.5, 0, 0.5, 1.0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN dcCreateLine 0, nodusy, 0, 1 ' draw the gnomon's style ' rotate dial plate by 180 degrees ~~~ make vdial from hdial dcSelectObjInBox -1.3, -.2, 1.3, 2.2 dcRotateSelObjs 180 dcUnSelectAll dcViewBox -1.1, -1.3, 1.1, 1.3 End If Exit Function End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 6 ] *** ' *** *** ' *** V E R T I C A L D E C L I N E R F A C I N G E Q U A T O R *** ' *** *** ' *** complete dial, uses choice 0, 6 code, and rotates the dial *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function vDec() dcSetDrawingScale 0.80 Begin Dialog aaaaa 20, 20, 260,160, "[6] Vertical declinerArmillary dial analemma options" Text 5, 10, 60, 10, "Enter latitude" TextBox 95, 10, 50, 10, .mylat Text 5, 20, 60, 10, "Enter longitude" TextBox 95, 20, 50, 10, .mylng Text 5, 30, 60, 10, "Enter ref longitude" TextBox 95, 30, 50, 10, .myref Text 5, 40, 60, 10, "Declination from S" TextBox 95, 40, 50, 10, .mydec Text 155, 40, 120, 10, "- SW + SE -45 1 Then dcCreateText 0, -0.8, 0, "Check 11-1 hour lines closely" dcCreateText -1.2 , -0.9, 0, "Lat: " dcCreateText -1.0, -0.9, 0, Format(lat, "00.0") dcCreateText -0.6, -0.9, 0, "Long: " dcCreateText -0.1, -0.9, 0, Format(-1*lng, "#00.0") dcCreateText 0.3, -0.9, 0, "Dec: " dcCreateText 0.6, -0.9, 0, Int(-dec) If dec <0 Then dcCreateText 0.9,-0.9, 0, "SE /*" Else dcCreateText 0.9,-0.9, 0, "SW *\" End If dcCreateText -1.2 , -1.0, 0, "SD: " dcCreateText -1.0, -1.0, 0, Format(sdvert, "00.0") dcCreateText -0.6, -1.0, 0, "SH: " dcCreateText -0.1, -1.0, 0, Format(sh, "00.0") ' *** DL is the derived difference in longitude *** dcCreateText 0.3 , -1.0, 0, "DL=" dcCreateText 0.6 , -1.0, 0, Format(-((360/(2*3.1416))*(Atn(Tan(2*3.1416/360*(dec))/Sin(2*3.1416/360*(lat))))-(lng-ref)), "00.0") ' *** SHOW what we have so far *** dcViewBox -1.1, -1.1, 1.1, 1.3 ' *** CALCULATE DL for second major phase *** DL0to6 = -((360/(2*3.1416))*(Atn(Tan(2*3.1416/360*(dec))/Sin(2*3.1416/360*(lat))))-(lng-ref)) SH0to6 = sh ' *** CORRECT the hours since there is a rotation when DL reduced to +/- 15 *** ' and yes, of course a loop would be better technique If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If ' tell user to add or subtract hours If dec >0 Then dcCreateText -1.2 , -1.1, 0, "If original DL exceeded +/- 15, hour labels were adjusted by ADDING:" dcCreateText 1.0, -1.1, 0, hsf End If If dec <0 Then dcCreateText -1.2 , -1.1, 0, "If original DL exceeded +/- 15, hour labels were adjusted by SUBTRACTING:" dcCreateText 1.0, -1.1, 0, hsf hsf = -1 * hsf End If dcCreateText 1.1, -1.1, 0, "hours" dcCreateText -1.2 , -1.2, 0, "This dial has considered dial vs legal longitude." dcCreateText -1.25, -1.3, 0, "Final hour line angles from SD are (i.e. adjust by SD):- " ' *** NOW we are ready for the second major phase *** lat = SH0to6 ' latitude for dial plate is now the SH lng = DL0to6 ' longitude for the plate is now DL ref = "0" ' and the legal meridian is now 0 ' ***************************************************************************** ' *** *** ' *** In this second phase, lng, ref, are the derived DL and 0 *** ' *** since we use horizontal dial code for what is really a v dial *** ' *** *** ' *** And lat is the derived SH *** ' *** *** ' ***************************************************************************** If ccccc = -1 Then ' ************************************************************************** ' *** this is the main program to draw the horizontal dial itself *** ' ************************************************************************** ' calculate hour line angles next, but first define them Dim h, hx, hy As Single ' DeltaCAD is fussy about data attributes ' the formula is... hourlineangle = atan ( sin(lat) * tan (lha) ) ' almost all systems us radians ' the formula also needs adjustment for longitude displacement ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 21,0,0 ' ---------------------------------------------------------------------------- ' PHASE 2: draw normal hours that extend to the box limits ' ---------------------------------------------------------------------------- For hr = 6 To 18 Step 1/dvh ' 1/dvh allows hour divisions ' ================================================================= ' for the hour (hr) calculate the hour line angle (h) for this ' longitude adjusted for the reference longitude ' show the angle h = Hla ( (hr), (lat), (lng), (ref) ) ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then ' show the time in hours dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 21,0,0 dcCreateText (-1.2+((hr-6)/5)), -1.4, 0, Abs(24-hr)+hsf ' show the angle dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 21,0,0 dcCreateText (-1.2+((hr-6)/5)), -1.5, 0, Format(h, "00.0") End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color If ( hr - Int(hr) ) <> 0 Then dcSetLineParms dcBLUE,dcSTITCH,dcTHIN ' but if not full hour change End If If hr < 12 Then ' -------------------------------------------------------------------- ' morning hours ~ NOTE code for keeping lines in a boxed area ' --------------------------------------------------------------------- If Abs(h) < 45 Then ' lines touch top of box dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then dcCreateText (hx), 1.1, 0, Abs(24-hr)+hsf End If Else ' lines touch side of box dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 hy = Tan(rad((90-h))) dcCreateLine 0,0,-1,-hy ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then dcCreateText -1.1, -hy, 0, Abs(24-hr)+hsf End If End If ElseIf hr = 12 Then ' ------------- ' noon hours ' ------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 21,0,0 hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' say that it is 12 noon dcCreateText (hx), 1.1, 0, Abs(hr)+hsf Else ' --------------- ' afternoon hours ' --------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 If h < 0 Then h = -1 * h End If If h < 45 Then hx = Abs(Tan(rad((h)))) ' (( )) solves type mismatch dcCreateLine 0, 0, hx, 1 ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then dcCreateText (hx), 1.1, 0, Abs(24-hr)+hsf End If Else hy = Tan(rad((90-h))) If ref <= lng Then dcCreateLine 0, 0, 1, hy Else If deg(Atn(Sin(rad(lat))*Tan(rad((hr*15) +(ref-lng)))))< 0 Then dcCreateLine 0, 0, 1, -hy Else dcCreateLine 0, 0, 1, hy End If End If ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then If ref <= lng Then dcCreateText 1.1, hy, 0, Abs(24-hr)+hsf Else If hr < 18 Then dcCreateText 1.1, hy, 0, Abs(24-hr)+hsf Else dcCreateText 1.1, -hy, 0, Abs(24-hr)+hsf End If End If End If End If End If ' ========================================================================= Next hr ' ------------------------------------------------------------------------- ' PHASE 3: draw calendar lines ' ------------------------------------------------------------------------- Dim wx, wy, qx, qy, sx, sy As Single ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then ' this is a usable hour, we have three declinations (-23.5, 0, 23.5) ' we have the hour ' we have the gnomon linear height ' first get the winter, equinox, and summer distances on the LAT ' hour lines, we do not draw the LAT hour line. wz = Cal ( (hr), (lat), -23.5, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +23.5 , glh ) ' last parm = decl ' get the LAT hour line angle also zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours ' and zh can be negatove (am) or positive (pm) ' we have an hour line angle (LAT), and a distance ' ' nwx nqx nsx ' ' wz \ | nwy ' \ | ' qz \ zh| nqy ' \ | ' sz \ | ns ' * ' ' assuming a center of 0,0 (dial center) we can calculate the ' x,y values for each declination by... ' ' x = sin(h) * z ' y = cos(h) * z nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then ' this is not the first time around so we can draw a line ' from (sx,sy) to (nsx,nsy) and so on ' the calendar lines can get excessive ' the best code would take each line segment and if it impacts ' a boundary then shorten the line segment. ' the next best code is probably what is in Function Dln ' Then the next best would be a table of latitudes and what ' hours are acceptable as limits, and so on. ' This code doesnt like winter lines at higher latitudes, ' so it tests the "y" values against the equinox Y value dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' page 228 Manual If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' eqxinox lines can also get excessive dcSetLineParms dcGREEN,dcSOLID,dcTHIN ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If ' and make these new points be the start for the next calendar line's points wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr ' ------------------------------------------------------------------------- ' PHASE 3a: draw more calendar lines - July & May, and, November & January ' ------------------------------------------------------------------------- ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points If animate <> 1 Then For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then wz = Cal ( (hr), (lat), -18.0, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +18.0 , glh ) ' last parm = decl zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' page 228 Manual If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' dcsetlineparms dcgreen,dcsolid,dcthin ' ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr End If ' ------------------------------------------------------------------------- ' PHASE 3b: more calendar lines - August & April, and, October & February ' ------------------------------------------------------------------------- ' set the summer and winter x,y coordinates to 0 to begin with wx = 0 ' these, when 0, tell the calendar wy = 0 ' line draw to draw nothing qx = 0 ' if non zero then calendar lines qy = 0 ' are drawn sx = 0 ' and either way the three x,y pair sy = 0 ' are updated with this hours points If animate <> 1 Then For hr = 6 To 17.9 Step 0.1 If (hr < 11.5 Or hr > 12.5) Then wz = Cal ( (hr), (lat), -10.0, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), +10.0 , glh ) ' last parm = decl zh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours nwx = Sin(rad((zh))) * wz nqx = Sin(rad((zh))) * qz nsx = Sin(rad((zh))) * sz nwy = Cos(rad((zh))) * wz nqy = Cos(rad((zh))) * qz nsy = Cos(rad((zh))) * sz If (wx<>0 And wy<>0 And qx<>0 And qy<>0 And sx<>0 And sy<>0) Then dcSetLineParms dcBLUE,dcSOLID,dcTHIN If (wy > qy) And (nwy > qy) Then ok = Dln ( (wx), (wy), (nwx), (nwy) ) End If ' dcsetlineparms dcgreen,dcsolid,dcthin ' ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If ' ========================================================================= Next hr End If ' ------------------------------------------------------------------------- ' PHASE 4: draw the gnomon to the nodus (for calendar lines) ' ------------------------------------------------------------------------- ' put gnomon where it will better represent the gnomon nodusx = glh If dec > 0 Then nodusx = -glh nodusy = (Cos(rad(lat)) * glh) / Sin(rad(lat)) dcSetLineParms dcRED,dcSOLID,dcTHIN dcCreateLine 0, 0, nodusx, nodusy ' draw the gnomon's style dcCreateLine 0, nodusy, nodusx, nodusy ' draw the gnomon's lin ht dcCreateLine 0, 0 , 0, nodusy ' draw the sub-style dcCreateCircle nodusx, nodusy, 0.01 ' circle for nodus dcCreateCircle 0, 0, 0.01 ' circle for dial center dcCreateCircle 0, nodusy, 0.01 ' circle for base of nodus ' ------------------------------------------------------------------------- ' PHASE 4a: draw analemma ' ------------------------------------------------------------------------- Dim dl As Single Dim h1,h2 As Single Dim meYear As String Dim jd As Single Dim eot As Single Dim decl As Single Dim alt As Single Dim azi As Single Dim x,y,r,v As Single Dim lastx,lasty As Single Dim frstx,frsty As Single Dim lineY,lx,ly As Single Dim degtorad As Single Dim radtodeg As Single Dim signofX As Single Dim yDisp As Single dl = lng-ref ' longitude diff from meridian, + is west h1 = 9 h2 = 15 degtorad = 2*3.14159/360 radtodeg = 360 / (2*3.1416) ' *** CALCULATE Y DISPLACEMENT yDisp = Cal ( (12), (lat), +23.5 , glh ) + glh / Tan(DegToRad*lat) For hr = h1 to h2 step 1 ' unless 12 noon retain this sign for all x in an hour signOfX = 0 dcSetLineParms dcBROWN,dcSOLID,dcTHIN For jd = 1 To 365 Step 2 ' *** GET EOT AND DECLINATION *** eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' *** must reverse sign of DECL and EOT ' because analemma needs rotating end over end and left to right ' since while a v-dial and h-dial have a lat to co-lat relationship ' (1) the longitude correction is reversed - hence left to right, and ' (2) winter and summer are reversed - hence top to bottom eot = - eot decl = - decl ' *** GET ALTITUDE AND AZIMUTH FOR TODAY, THIS HOUR, AT THIS LATITUDE AND LONGITUDE.DIFF ' hr = corected time considering longitude ' amh = local apparent time amh = hr - (dl/15) - (eot/60) alt = RadToDeg*(asn(Sin(DegToRad*(decl))*Sin(DegToRad*Lat)+Cos(DegToRad*decl)*Cos(DegToRad*Lat)*Cos(DegToRad*(15*(12-(amh)))))) azi = RadToDeg*(Atn(Sin(DegToRad*(15*(12-amh)))/(Sin(DegToRad*Lat)*Cos(DegToRad*(15*(12-amh)))-Tan(DegToRad*decl)*Cos(DegToRad*Lat)))) y = yDisp + Cos(degtorad*azi) * glh / Tan(degtorad*(alt)) x = -(glh/Tan(degtorad*alt)) * Sin(degtorad*(azi)) ' manage sign reversals If jd = 1 Then signOfX = x End If If (signofx>0 And x < 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If If (signofx<0 And x > 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If If y < 0 Then ' x = x * (-1) y = y * (-1) End If If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else If Abs(y) < 1 Then dcCreateLine lastx,lasty, x,y End If lastx = x lasty = y End If dcSetTextParms dcBLACK,"Ariel","Bold",0, 4, 8,0,0 If jd =45 And Abs(y) < 1 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "1q" End If If jd =90+45 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "2q" End If If jd =190+45 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "3q" End If If jd =270+45 And Abs(y) < 1 And (hr = 9 Or hr = 15) Then dcCreateText x,y, 0, "4q" End If Next jd dcCreateLine lastx,lasty, frstx,frsty Next hr ' ------------------------------------------------------------------------- ' PHASE 5: draw the boundaries and display the final product ' ------------------------------------------------------------------------- ' NS line dcSetLineParms dcBLUE,dcSOLID,dcTHIN dcCreateLine 0, nodusy, 0, 1 ' draw the gnomon's style ' rotate drawing area If (dcSelectObjInBox (-1.2, -.2, 1.2, 1.2) ) Then dcRotateSelObjs 180+sdvert End If ' draw a box around everything dcCreateBox -1, 0, 1, 1 dcCreateBox -1.2, -.2, 1.2, 1.2 dcCreateBox -0.5, 0, 0.5, 1.0 dcViewBox -1.1, -1.6, 1.1, 1.3 dcUnSelectAll End If End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 9 ] *** ' *** *** ' *** A N A L E M M A ON DIAL PLATE F O R HORIZONTAL DIALS *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function toolCalculateHDP (iii As Integer) ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** Dim glh As Single Dim dl As Single Dim hr,h1,h2 As Single Dim meYear As String Dim jd As Single Dim eot As Single Dim decl As Single Dim alt As Single Dim azi As Single Dim x,y,r,v As Single Dim lastx,lasty As Single Dim frstx,frsty As Single Dim lineY,lx,ly As Single Dim lat As Single Dim degtorad As Single Dim radtodeg As Single Dim signofX As Single Begin Dialog aaaaa 20, 20, 250, 130, "[9] ANALEMMA DIALPLATE CONSTRUCTOR WITH X,Y" Text 5, 15, 160, 40, "Nodus linear height in inches" TextBox 180, 15, 50, 10, .myglh Text 5, 25, 160, 40, "Long diff from meridian (+ve if h-dial and west)" TextBox 180, 25, 50, 10, .mydl Text 5, 35, 160, 40, "Latitude" TextBox 180, 35, 50, 10, .mylat Text 5, 45, 160, 40, "Single hour [8 to 16], 0 for all hours" TextBox 180, 45, 50, 10, .myhr Text 5, 85, 210, 20, "www.illustratingshadows.com" Text 5, 95, 220, 20, "Program may end in BASIC SCRIPT ERROR." Text 5, 105, 180, 20, "Ignore BASIC SCRIPT ERROR message." OKButton 180, 65, 40, 10 CancelButton 180, 75, 40, 10 End Dialog Dim bbbbb As aaaaa bbbbb.myglh = "1.0" ' gnomon linear height bbbbb.mydl = "0.0" ' h-dial + if west of meridian ' ' v-dial - if west of meridian bbbbb.myhr = "12.0" ' hour of day for analemma bbbbb.mylat = "32.75" ' latitude Begin Dialog paws 20, 20, 80, 40 , "Enter for next hour" OKButton 30, 15, 30, 10 End Dialog Dim ppp As paws liney = 2.0 ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht dl = bbbbb.mydl ' longitude diff from meridian, + is west hr = bbbbb.myhr ' hour h1 = hr h2 = hr lat = bbbbb.mylat ' latitude degtorad = 2*3.14159/360 radtodeg = 360 / (2*3.1416) dcCreateText 2.3, liney, 0, "JD" dcCreateText 2.6, liney, 0, "EOT" dcCreateText 3.0, liney, 0, "DECL" dcCreateText 3.4, liney, 0, "AZI" dcCreateText 3.8, liney, 0, "ALT" dcCreateText 4.4, liney, 0, "X" dcCreateText 4.8, liney, 0, "Y" ' -------------------------------------------------------------------------------- ' *** Set hour range or one hour depending on input If hr = 0 Then h1 = 8 h2 = 16 End If ' *** LX is a starting column for columns of X,Y pairs lx = -5.0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color For hr = h1 to h2 step 1 ly = -0.1 dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' p231 of Manual dcCreateText lx, ly, 0, "X" dcCreateText lx-0.2, ly, 0, Format(hr, "00") dcCreateText lx+0.28, ly, 0, "Y" ly = ly -0.1 ' unless 12 noon retain this sign for all x in an hour signOfX = 0 liney = liney - 0.1 dcCreateText 2.0, liney, 0, Format(hr, "00") liney = liney - 0.1 For jd = 1 To 365 Step 10 ' *** GET EOT AND DECLINATION *** eot = 7.5 * Sin(RAD(jd-5))-10.2*Sin(RAD(1.93*(jd-80)))+0.5*Sin(RAD(1.5*(jd-62))) decl = 23.45 * Sin(rad(0.9678*(jd-80))) ' *** GET ALTITUDE AND AZIMUTH FOR TODAY, THIS HOUR, AT THIS LATITUDE AND LONGITUDE.DIFF ' hr = corected time considering longitude ' amh = local apparent time amh = hr - (dl/15) - (eot/60) alt = RadToDeg*(asn(Sin(DegToRad*(decl))*Sin(DegToRad*Lat)+Cos(DegToRad*decl)*Cos(DegToRad*Lat)*Cos(DegToRad*(15*(12-(amh)))))) azi = RadToDeg*(Atn(Sin(DegToRad*(15*(12-amh)))/(Sin(DegToRad*Lat)*Cos(DegToRad*(15*(12-amh)))-Tan(DegToRad*decl)*Cos(DegToRad*Lat)))) y = Cos(degtorad*azi) * glh / Tan(degtorad*(alt)) x = -(glh/Tan(degtorad*alt)) * Sin(degtorad*(azi)) ' manage sign reversals If jd = 1 Then signOfX = x End If If (signofx>0 And x < 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If If (signofx<0 And x > 0 And hr <> 12) Then x = x * (-1) y = y * (-1) End If ' *** CALCULATE X and Y FOR THIS ANALEMMA POINT liney = liney - 0.1 dcCreateText 2.3, liney, 0, Format(jd, "000") dcCreateText 2.6, liney, 0, Format(eot, "00.0") dcCreateText 3.0, liney, 0, Format(decl,"00.0") dcCreateText 3.4, liney, 0, Format(azi, "00.00") dcCreateText 3.8, liney, 0, Format(alt, "00.00") dcCreateText 4.4, liney, 0, Format(x, "00.00") dcCreateText 4.8, liney, 0, Format(y, "00.00") ' *** SHOW IMMEDIATE COLUMN FOR THIS ANALEMMA dcCreateText lx, ly, 0, Format(x, "00.00") dcCreateText lx+0.28, ly, 0, Format(y, "00.00") ly = ly -0.1 If jd = 1 Then lastx = x lasty = y frstx = x frsty = y Else dcCreateLine lastx,lasty, x,y lastx = x lasty = y End If Next jd dcCreateLine lastx,lasty, frstx,frsty ccccc = Dialog(ppp) lx = lx + 0.7 Next hr ' -------------------------------------------------------------------------------- yExtreme = r * Tan( rad(23.44) ) - r * Tan( rad(-23.44) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 8,0,0 ' p231 of Manual dcCreateLine -1,0,1,0 dcCreateText 1.1,0, 0, "Y (left:right). Lines are 1 inch." dcCreateLine 0,-1,0,1 ' north south line liney = liney - 0.1 dcCreateText 2.3, liney, 0, "Analemma on dialplate of horizontal dial." liney = liney - 0.1 dcCreateText 2.3, liney, 0, "Gnomon linear height in inches:" dcCreateText 3.5, liney, 0, Format(glh,"00.0") dcSetDrawingScale 1.0 End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [ 0 ] *** ' *** *** ' *** V E R T I C A L D E C L I N E R F A C I N G E Q U A T O R *** ' *** *** ' *** calculator for SD SH and DL only *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function toolCalculateVD() dcSetDrawingScale 0.80 Begin Dialog aaaaa 20, 20, 220,90, "[0] VDEC Calculator for SD, SH, and DL and invoker" Text 5, 10, 60, 10, "Enter latitude" TextBox 65, 10, 50, 10, .mylat Text 5, 20, 60, 10, "Enter longitude" TextBox 65, 20, 50, 10, .mylng Text 5, 30, 60, 10, "Enter ref longitude" TextBox 65, 30, 50, 10, .myref Text 125, 10, 60, 10, "Declination from S" TextBox 125, 20, 50, 10, .mydec Text 125, 30, 60, 10, "- SW and + SE" Text 5, 50, 210, 40, "www.illustratingshadows.com" OKButton 65, 65, 40, 10 CancelButton 65, 75, 40, 10 End Dialog Dim bbbbb As aaaaa ' ***************************************************************************** ' *** Now define the initial general working variables *** ' ***************************************************************************** ' ' define a lat and a long, a ref longitude and hour divisions Dim lat As Single Dim lng As Single Dim ref As Single Dim dec As Single Dim hsf As Integer ' hours shifted due to dl ' ***************************************************************************** ' *** Now get the lat, long, and reference longitude *** ' ***************************************************************************** bbbbb.mylat = "32.75" bbbbb.mylng = "108.2" bbbbb.myref = "105.0" bbbbb.mydec = -45 ccccc = Dialog(bbbbb) lat = bbbbb.mylat lng = bbbbb.mylng ref = bbbbb.myref dec = bbbbb.mydec dec = - dec hsf = 0 ' ----------------------------------------------------------------------------- ' h-dial to v-dial: BUT we must now make some changes for this to be vertical ' ----------------------------------------------------------------------------- ' lat = lat ' lng = lng * -1 ' and we must flip the longitude sign ref = ref * -1 ' *** STYLE DISTANCE from the vertical line *** true SD is sdvert Dim sdvert As Single Dim sdhorz As Single sdvert = deg(Atn(Sin(rad(dec)) / Tan(rad(lat)) )) ' *** STYLE HEIGHT *** true SH Dim sh As Single sh = DEG( ASN( Cos(rad(lat)) * Cos(rad(dec)) ) ) dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText -1.25, -0.8, 0, "Original v-dec parms are:- " dcCreateText -1.25, -0.9, 0, "Lat: " dcCreateText -1.0, -0.9, 0, Format(lat, "00.0") dcCreateText -0.6, -0.9, 0, "Long: " dcCreateText -0.1, -0.9, 0, Format(-1*lng, "#00.0") dcCreateText 0.3, -0.9, 0, "Dec: " dcCreateText 0.6, -0.9, 0, Int(-dec) If dec <0 Then dcCreateText 0.9,-0.9, 0, "SE /*" Else dcCreateText 0.9,-0.9, 0, "SW *\" End If dcCreateText -1.25, -1.0, 0, "SD: " dcCreateText -1.0, -1.0, 0, Format(sdvert, "00.0") dcCreateText -0.6, -1.0, 0, "SH: " dcCreateText -0.1, -1.0, 0, Format(sh, "00.0") dcCreateText 0.3 , -1.0, 0, "DL=" dcCreateText 0.6 , -1.0, 0, Format(-((360/(2*3.1416))*(Atn(Tan(2*3.1416/360*(dec))/Sin(2*3.1416/360*(lat))))-(lng-ref)), "00.0") dcViewBox -1.1, -1.1, 1.1, 1.3 DL0to6 = -((360/(2*3.1416))*(Atn(Tan(2*3.1416/360*(dec))/Sin(2*3.1416/360*(lat))))-(lng-ref)) SH0to6 = sh If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 > 15 Then DL0to6 = DL0to6 -15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If If DL0to6 <-15 Then DL0to6 = DL0to6 +15 hsf = hsf+1 End If dcCreateText -1.25, -1.1, 0, "If original DL exceeds +/- 15 then final hour labels need adjusting by:" dcCreateText 1.6, -1.1, 0, hsf dcCreateText 1.7, -1.1, 0, "hours" dcCreateText -1.25, -1.2, 0, "Rotate final dial by original SD, and another 180 degrees" dcCreateText -1.25, -1.3, 0, "The original and final DL have considered dial vs legal longitude." ' *** tell it choice 0 called it so EOT & DECL signs reversed chc = 0 ok = hDial ( (DL0to6), (SH0to6) , 0) ' ***************************************************************************** ' *** this ends the entire program *** ' ***************************************************************************** End Function ' ***************************************************************************** ' *** Useful routines or functions - Functions must be defined at the end *** ' *** after the main profram which is sub(xx) ... end sub *** ' ***************************************************************************** ' ***************************************************************************** ' *** MINOR FUNCTIONS *** these are subservient to major functions *** ' ***************************************************************************** ' ' Convert degrees to radians ' Function Rad ( n As Single ) As Single ' page 83 basic.pdf for functions Rad = (n * 2 * 3.1416) / 360 End Function ' ' Convert radians to degrees ' Function Deg ( n As Single ) As Single ' page 83 basic.pdf for functions Deg = (360 * n) / (2 * 3.1416) End Function ' ' asn which Delta CAD and their BASIC supplier do not provide ' Function asn (n As Single) As Single If Abs(n) > 0.99999 Then asn = 1 * sgn(n) Else q = Atn(n/Sqr(1-n*n)) asn = q End If End Function ' ' acs which Delta CAD and their BASIC supplier do not provide ' Function acs (n As Single) As Single acs = (3.1416/2) - asn (n) End Function ' ' CLS ~ clear the screen area and pause for it to take effect ' Function cls Dim i As Single Dim j As Single ' pause ' this is bad coding practice ~ using one variable for two different uses i = Timer * 100 ' i is in 1/100 of a Second j = i+2 ' j is 2/100 into the future Do While i < j j=j ' do nothing i = Timer * 100 ' get the time again Loop ' try anything that works To Erase the screen If (dcSelectObjInBox (-9, -9, 9, 9) ) Then dcEraseSelObjs ElseIf (dcSelectAll) Then dcEraseSelObjs End If For i = 1 To 500 Step 1 dcSetLineParms dcWHITE,dcSOLID,dcTHICK dcCreateLine -2,(i-250)/100, 2, (i-250)/100 Next i If (dcSelectObjInBox (-9, -9, 9, 9) ) Then dcEraseSelObjs ElseIf (dcSelectAll) Then dcEraseSelObjs End If End Function ' ***************************************************************************** ' *** MAJOR FUNCTIONS *** these may use minor functions *** ' ***************************************************************************** ' -------------------------------------------------- ' Return the hour line angle for a set of parameters ' -------------------------------------------------- Function Hla ( Hr As Single, lat As Single, mylong As Single, reflong As Single) As Single Hla = Deg (Atn (Tan(Rad((15*hr)+(reflong-mylong))) * Sin(Rad(lat)))) End Function ' -------------------------------------------------------- ' Return the azimuth Azi in degrees (decl= -23.5 to +23.5) ' -------------------------------------------------------- Function Azi ( Hr As Single, lat As Single, decl As Single ) As Single ' ensure hour in formula below is hours from noon th = hr If th > 12 Then th = th - 12 Else th = 12 - th End If tz = Deg(Atn(Sin(Rad((15*th)))/(Sin(Rad(lat))*Cos(Rad((15*th)))-Tan(Rad(decl))*Cos(Rad(lat))))) ' ensure that negative azimuths are handles correctly If tz > 90 Then ' test this first tz = 180 - tz End If If tz < 0 Then ' test this second tz = 180 + tz End If azi = tz End Function ' --------------------------------------------------------- ' Return the altitude Alt in degrees (decl= -23.5 to +23.5) ' --------------------------------------------------------- Function Alt ( Hr As Single, lat As Single, decl As Single ) As Single ' ensure hour in formula below is hours from noon th = hr If th > 12 Then th = th - 12 Else th = 12 - th End If ta = Deg(Asn(Sin(Rad(decl))*Sin(Rad(lat))+Cos(Rad(decl))*Cos(Rad(lat))*Cos(Rad(15*th)))) ' If below the hoprizon, return 0 or leave it as, whatever you decide If ta < 0 Then ta = ta ' ta = 0 End If Alt = ta End Function ' ----------------------------------------------------------------------------------------- ' Return the distance on an hour line for a lat, hour, and decl for a gnomon linear height ' ----------------------------------------------------------------------------------------- Function Cal ( Hr As Single, lat As Single, decl As Single, aglh As Single ) As Single ' first, convert gnomon linear height to style length as that is what the formula wants ' ' /| ' sll / | ' / | glh sin(latitude) = glh / sll ' /lat | thus ' --------- sll = glh / sin(lat) ' sll = aglh / Sin (rad(lat)) ' get the azimuth xazi = Azi ( (hr), (lat), (decl) ) ' if azi is negative, handle it If xazi <0 Then xazi = 180 - azi End If ' get the altitude xalt = Alt ( (hr), (lat), (decl) ) ' second, ensure hour in formula below is hours from noon th = hr If th > 12 Then th = th - 12 Else th = 12 - th End If ' DIST from dial center based on style length (not gnomon linear height) but as ' we just converted it, we are ok ' SIN(RADIANS(lat))*stylelength*(SIN(RADIANS(180-azi))) / ' (TAN(RADIANS(alt))*SIN((ATAN(SIN(RADIANS(lat))*TAN(RADIANS(15*(12-(hhhh/100)))))))) top = Sin(Rad(lat)) * sll * (Sin(Rad((180-xazi)))) ' bot = Tan(Rad((xalt))) * Sin(Atn( Sin(Rad(lat)) * Tan(Rad(15*(12-th))) )) ' use th asis as it ' is already hours from noon bot = Tan(Rad((xalt))) * Sin(Atn( Sin(Rad(lat)) * Tan(Rad(15*(th))) )) ' handle 6 am, 6 pm, and noon when 0 can be a factor If bot = 0 Then td = 0 Else td = top / bot End If ' correct some large values If td < 0 Then td = td * -1 End If Cal = td ' note that for 6 hours from noon this is meaningless ' note that for noon this is meaningless End Function ' ----------------------------------------------------------------------------------------- ' Only actually draw this line segment if all coordinates actually fit mostly in the box ' For the winter curve at high latitudes, it draws within the box but it is wrong. ' That bug needs fixing. ' ----------------------------------------------------------------------------------------- Function Dln ( x1 As Single, y1 As Single, x2 As Single, y2 As Single ) As Single Dln = 0 ' return 0 if not drawn xl = -1 ' establish limits on the xr = +1 ' left, right, yb = 0.01 ' top and bottom of yt = +1 ' what is an acceptable line If (x1 > xl And x1 < xr) Then If (y1 > yb And y1 < yt) Then If (x2 > xl And x2 < xr) Then If (y2 > yb And y2 < yt) Then dcCreateLine x1, y1, x2, y2 Dln = 1 ' return 1 if drawn End If End If End If End If End Function '*** End *** ' *********** ' *** END *** ' ***********