' ******************************************************************************************** ' *** *** ' *** *** ' *** C A L E N D A R C U R V E S *** ' *** *** ' *** *** ' ******************************************************************************************** Sub Main() ' main procedure is required ' This program is for educational purposes, it works but its focus is on showing programming ' methods, the end result is usable but not intended to be used without the added human touch. ' NOTE: Most recent update October 27, 2009 ' ' CODE EXTRACTED FROM: MAIN-calendar-curves.bas ' and added in: MAIN-v-dials.bas ) ' and added in: MAIN-m-dials.bas ) extracts but no analemmas ' and added in: analemma.bas ) and refined just for calendar info ' ' STOP causes script error, use EXIT FUNCTION instead ' ' AUTHOR: Simon Wheaton-Smith ' ********************************************************************* ' Initial house keeping - clear the screen - set the drafting area unit ' ********************************************************************* If (dcSelectAll) Then dcEraseSelObjs End If dcSetDrawingScale 0.5 ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** Begin Dialog aaaaa 20, 20, 360, 250, "C A L E N D A R C U R V E S: for analemmas please use ANALEMMA.BAS [October 31, 2009]" Text 5, 10, 330, 10, "1. h-dial" Text 95, 10, 330, 10, "[horizontal dial] " Text 5, 20, 330, 10, "2. v-dial" Text 95, 20, 330, 10, "[vertical dial] " Text 5, 30, 330, 10, "3. v-dec" Text 95, 30, 330, 10, "[vertical decliner] " Text 5, 40, 330, 10, "4. p-dial" Text 95, 40, 330, 10, "[polar axis aligned dial] " Text 5, 50, 330, 10, "5. m-dial" Text 95, 50, 330, 10, "[true E or W meridian dial] " Text 5, 60, 330, 10, "6. armillary dial" Text 95, 60, 330, 10, "[plate parallels N:S polar axis] " Text 5, 70, 330, 10, "7. equatorial dial" Text 95, 70, 330, 10, "[plate parallels the equator] " Text 5, 80, 330, 10, "0. TOOL: ANY dial with an SD, allows the degree lines to be rotated by some degrees" Text 5, 90, 330, 10, " such As the SD, simplifying transposing calendar curves to a dial plate." TextBox 5, 105, 15, 10, .mychc OKButton 25, 105, 30, 10 CancelButton 65, 105, 30, 10 Text 110, 105, 210, 10, "DECL 0 (Mar, Sep) and 23.5 (Jun, Dec) assumed" Text 110, 115, 210, 10, "DECL Feb, Apr, Aug, Oct " Text 240, 115, 210, 10, " [10 or 12]" TextBox 280, 115, 20, 10, .mydec10 Text 110, 125, 210, 10, "DECL Jan, May, Jly, Nov " Text 240, 125, 210, 10, " [18 or 20]" TextBox 280, 125, 20, 10, .mydec18 Text 5, 140, 330, 10, "OPTIONS DRAWING SCALE must be 1 [this sets it]" Text 5, 150, 220, 10, "VIEW SC must be 1 [this sets it]" Text 5, 160, 260, 10, "FILE Set Print REGION Print SCALE you must set to 1" Text 5, 170, 330, 10, "even so, double check after printing, may need rescaling" Text 5, 190, 340, 10, "For analemmas run: ANALEMMA.BAS located in the ANALEMMA folder." Text 5, 200, 340, 10, "Declinations: 0 (Mar, Sep), 10 or 12 (Feb, Apr, Aug, Oct), 18 or 20 (Jan, May, Jly, Nov), 23.5 (Jun, Dec)" Text 5, 210, 340, 10, "See: Illustrating Time's Shadow: chapter 22, declination curves; chapter 24, analemmas." Text 5, 220, 330, 10, "See: Illustrating Time's Shadow: chapter 16, 17, 19 for case studies" Text 5, 230, 340, 40, "www.illustratingshadows.com Simon Wheaton-Smith " 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 parameters Dim chc As Integer Dim doit As Integer Dim myd10, myd18 As Single ' ******************************************************************** ' Now get the data ' ******************************************************************** ' first set the defaults - here bbbbb.mylat uses the structure ' from aaaaa bbbbb.mychc = "1" bbbbb.mydec10 = "10" ' or 12 bbbbb.mydec18 = "18" ' or 20 ccccc = Dialog(bbbbb) ' which causes the answer to be returned chc = bbbbb.mychc myd10 = bbbbb.mydec10 myd18 = bbbbb.mydec18 ' CANCEL button returns 0 ' OK button returns -1 ' you can determine the button with - Print ccccc, lat, lng, ref If ccccc <> -1 Then Stop End If If chc = 1 Then doit = calendarS ((myd10),(myd18)) End If If chc = 2 Then doit = vCalAnl ((myd10),(myd18)) End If If chc = 3 Then doit = vDecAs0and6 ((myd10),(myd18)) End If If chc = 4 Then doit = polar ((myd10),(myd18)) End If If chc = 5 Then doit = meridian ((myd10),(myd18)) End If If chc = 6 Then doit = armillary ((myd10),(myd18)) End If If chc = 7 Then doit = equatorial ((myd10),(myd18)) End If If chc = 0 Then doit = calendarI ((myd10),(myd18)) End If End Sub ' *********** ' *** END *** ' *********** ' ***************************************************************************** ' *** *** ' *** [1] S I M P L E C A L E N D A R C U R V E S *** ' *** *** ' ***************************************************************************** Function calendarS (d10 As Single, d18 As Single) As Integer ' ********************************************************************* ' A horizontal dial macro with calendar lines ' ********************************************************************* ' This is a calendar dial, in that the solstice, and equinox lines are ' shown. The hour lines are not terminated by the calendar curves because ' the nodus identifies the calendar line or date in question, and extended ' hour lines allow a style longer than dial center to nodus, to enhance ' dial accuracy. ' BUG: between 12 and 1 if hour sub-divisions are used ' BUG: high latitude winter calendar line is in bounds but wrong ' NOTE: Most recent update July 6, 2007 ' ********************************************************************* ' Initial house keeping - clear the screen - set the drafting area unit ' ********************************************************************* If (dcSelectAll) Then dcEraseSelObjs End If dcSetDrawingScale 0.80 ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** ' Begin Dialog aaaaa 20, 20, 280,150, "h-dial and calendar using gnomon linear height" Text 5, 15, 60,10, "Enter latitude" TextBox 65, 15, 50, 10, .mylat Text 125, 15, 60,10, "lat 0 to animate" Text 125, 25, 60,10, "NOT if epileptic" 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 ' the next text string is for the nodus to dial plate linear distance Text 5, 60, 60, 10, "Gnomon lin ht" TextBox 65, 60, 30, 10, .myglh ' the last text string is for hour divisions Text 125, 60, 60, 10, "Hr ln div 1,2,4" TextBox 125, 75, 50, 10, .mydvh Text 5, 105, 210, 40, "www.illustratingshadows.com" OKButton 65, 75, 40, 10 CancelButton 65, 90, 40, 10 End Dialog ' ---------------------------------------------------------------------------- ' PHASE 1: get dial location and gnomon(nodus) dimensions ' ---------------------------------------------------------------------------- ' 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 ' ******************************************************************** ' first set the defaults - here bbbbb.mylat uses the structure ' from aaaaa 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 ' here the dialog is invoked and the button results returned to ccccc ' page 20 and 24 etc of Basic discusses the Dialog function ccccc = Dialog(bbbbb) ' which causes the answer to be returned 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 ' CANCEL button returns 0 ' ' OK button returns -1 ' ' you can determine the button with - Print ccccc, lat, lng, ref ' If latitude zero is entered, set it to 10 and animate to 60 Dim animate As Single animate = 0 bgnlat = lat endlat = lat If lat = 0 Then animate = 1 ' say we will animate bgnlat = 10 ' start at latitude 25 endlat = 60 ' end at the north pole End If ' if animated must clear the screen For lat = bgnlat To endlat Step 1 cls ' ************************************************************************** ' *** 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 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,7, 20,0,0 dcCreateText -1.25, -0.3, 0, "h-dial and calendar using gnomon linear height" 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") dcCreateText -1.25, -0.8, 0, "Declinations used are: 0, " + Str(d10) + ", " + Str(d18) + ", 23.44" dcCreateText -1.25, -0.7, 0, "Hours below horizontal use the 90 reference line below horizontal." 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(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 And h<0 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) ElseIf hr > 12 and h>0 Then ' --------------- ' afternoon hours ' --------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 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 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 ' for the hour (hr) calculate the calendar data for this ' local apparent time (LAT) which is NOT longitude adjusted for ' the reference longitude. This is ok because we are drawing ' calendar lines without regard to actual hour lines. ' if you desire, the calendar line points can be calculated for ' legal time hours (11 am and 1 pm would not have the same hour ' because of longitude differences unless the dial design ' longitude was on the legal time meridian. If you did this then ' the calendar line x,y would be used for BOTH the calendar lines ' as well as drawing the hour lines. ' This program draws legal time hour lines bounded by the box, ' and the calendar lines are based on the nodus and the calendar ' lines do not constrain the hour lines which thus allows a long ' style with a nodus partially long it. ' starts at 0700 ends ad 1700 because 6 am and 6 pm have meaningless ' calendar data ' also data is meaningless at noon 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), -d18, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0, glh ) ' last parm = decl sz = Cal ( (hr), (lat), d18 , 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), -d10, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0, glh ) ' last parm = decl sz = Cal ( (hr), (lat), d10 , 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) ' ------------------------------------------------------------------------- ' from the dial center which is at 0,0 draw a line whose ' angle is latitude and whose ' length is based on the gnomon linear height ' ' sll = style linear length (dial center to nodus) = glh / sin(latitude) ' ' but as DeltaCAD doesn't draw vectors, we need the x,y of the nodus ' ' we have an angle (latitude), and a distance (glh/sin(latitude) ' x ' ' sll \ | y ' \ | ' \ lat| ' \ | ' \ | ' * ' assuming a center of 0,0 (dial center) we can calculate the ' x,y values by... ' ' x = sin(latitude) * sll x is obviously gnomon linear height! ' y = cos(latitude) * sll and sll = glh/sin(lat) ' ' actually it is simpler than that... 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 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.3, 1.1, 1.3 ' if animated, repeat otherwise it drops out If animate <> 1 Then ' Stop ' not needed as (1) STOP causes SCRIPT ERROR and (2) the FOR loop ' ' handled it all anyway End If Next lat calendarS = 0 Exit Function End Function ' ***************************************************************************** ' *** *** ' *** [2] 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 *** ' *** *** ' **************************************************************************** Function vCalAnl ( d10 As Single, d18 As Single) As Integer ' ********************************************************************* ' Initial house keeping - clear the screen - set the drafting area unit ' ********************************************************************* If (dcSelectAll) Then dcEraseSelObjs End If dcSetDrawingScale 0.80 ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** ' Begin Dialog aaaaa 20, 20, 280,160, "v-dial ~ calendar ~ using gnomon linear height" 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 125, 60, 60, 10, "Hr ln div 1,2,4" TextBox 125, 75, 50, 10, .mydvh Text 5, 105, 210, 40, "www.illustratingshadows.com" OKButton 65, 75, 40, 10 CancelButton 65, 90, 40, 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 = "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 ' CANCEL button returns 0 ' ' OK button returns -1 ' ' you can determine the button with - Print ccccc, lat, lng, ref ' If latitude zero is entered, set it to 10 and animate to 60 Dim animate As Single 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.20, -0.4, 0, "Lat: " dcCreateText 0.40, -0.4, 0, Format(90-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 ' ---------------------------------------------------------------------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 21,0,0 dcCreateText -0.35, -0.7, 0, "Hours above horizontal use the 90 reference line below horizontal." dcCreateText -0.35, -0.75, 0, "Declinations used are: 0, " + Str(d10) + ", " + Str(d18) + ", 23.44" 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") 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), -d18 , glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), d18 , 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), -d10 , glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), d10 , 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 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 vCalAnl = 1 Exit Function End Function ' ***************************************************************************** ' *** *** ' *** [3] V E R T I C A L D E C L I N E R F A C E S E Q U A T O R *** ' *** *** ' *** complete dial, *** ' *** *** ' ***************************************************************************** Function vDecAs0and6 ( d10 As Single, d18 As Single ) As Integer dcSetDrawingScale 0.80 Begin Dialog aaaaa 20, 20, 260,160, "Vertical decliner: integrated and complete:" 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, 60, 10, "- SW and + SE" Text 5, 50, 60, 10, "Gnomon lin ht" TextBox 95, 50, 30, 10, .myglh Text 5, 60, 60, 10, "Hr ln div 1,2,4" TextBox 95, 60, 30, 10, .mydvh Text 5, 90, 210, 40, "www.illustratingshadows.com" OKButton 5, 75, 40, 10 CancelButton 55, 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 Dim glh As Single ' gnomon linear height Dim dvh As Single ' hour division normally 1, 2, 4 Dim hr As Single Dim dbg As Single ' debugging ' ***************************************************************************** ' *** Now get the lat, long, and reference longitude *** ' ***************************************************************************** bbbbb.mylat = "32.75" ' original dial real latitude bbbbb.mylng = "108.2" ' original dial real longitude bbbbb.myref = "105.0" ' legal time meridian bbbbb.mydec = -45 ' wall declination from SOUTH bbbbb.myglh = "0.2" ' gnomon linear height bbbbb.mydvh = "1" ' 1=1hour 2=30mins etc ' note that lat will eventually become SH ' note that lng will eventually become DL but reduced to be -15 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 0.3 , -1.2, 0, "Declinations used are: 0, " + Str(d10) + ", " + Str(d18) + ", 23.44" 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), -d18 , glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), d18 , 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), -d10 , glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), d10 , 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 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 vDecAs0and6 = 1 End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [4] D I A L P L A T E F O R *** ' *** polar *** ' *** west meridian *** ' *** east meridian *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function polar (d10 As Single, d18 As Single) As Integer ' ********************************************************************* ' A generic definition is required for a screen input area ' ********************************************************************* Begin Dialog aaaaa 20, 20, 300,160, "Polar/Meridian dial 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" 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 *** ' ***************************************************************************** If ccccc = -1 Then 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, "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, " + Str(d10) + ", " + Str(d18) + ", 23.44" ' *** 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 *** -18 For h = -5 to 5 step 0.1 decl = -d18 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 = -d10 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 *** 18 For h = -5 to 5 step 0.1 decl = d18 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 = d10 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 polar = 1 End Function ' ***************************************************************************** ' *** *** ' *** [5] S I M P L E S T T R U E E A S T / W E S T *** ' *** *** ' ***************************************************************************** ' *************************************************************************************************** ' *** *** ' *** *** ' *** A meridian dial macro for DeltaCAD but in conversational mode as *** ' *** opposed to the more modern object oriented mode, but with notes *** ' *** page numbers refer to Manual.pdf or Basic.pdf provided with deltacad *** ' *** *** ' *** *** ' *** This is pure east or pure west, no declination. Thus is designed for *** ' *** portable dials, or for fixed ones on some sort of a column but on *** ' *** on true cardinal point orientation. *** ' *** *** ' *** *** ' *************************************************************************************************** Function meridian(d10 As Single, d18 As Single) As Integer ' ********************************************************************* ' Initial house keeping - clear the screen - set the drafting area unit ' ********************************************************************* ' select all objects that may exist on the screen ' then erase them all If (dcSelectAll) Then dcEraseSelObjs End If dcSetDrawingScale 0.5 ' ********************************************************************* ' A generic definition is required for a screen input area ' ******************************************************************** ' ' Here a box on the screen for user dialog is structurally defined, ' it is only a definition of the generic area, it does not create it ' ..... Dialog aaaaa ' ' To create the area, there must be a Dim statement making a label ' relate to this definition ' ..... Dim bbbbb as aaaaa ' ' To use bbbbb there must be a ..... yyy = Dialog(xxxxx) which causes ' human interaction. So... ' ' create an area on the screen starting at x=20, y=20 ' whose size is 200 left to right and 100 top to bottom ' whose title is "Location" - where 0,0 is top left Begin Dialog aaaaa 20, 20, 230,170, "Non declining meridian dial: (July 8, 2008)" Text 5, 15, 60,10, "Enter latitude" TextBox 65, 15, 50, 10, .mylat ' the second text string is for longitude Text 5, 25, 60, 10, "Enter longitude" ' which has its own inpout area also TextBox 65, 25, 50, 10, .mylng ' the third text stringis the legal time zone meridian longitude Text 5, 35, 60, 10, "Enter ref longitude" ' and its inpout area TextBox 65, 35, 50, 10, .myref ' a fourth text string is for gnomon linear height Text 5, 45, 60, 10, "Gnomon ln ht" ' which has its own input area TextBox 65, 45, 50, 10, .myglh ' a fifth text string is for is this an E or W dial Text 5, 55, 60, 10, "E or W dial" ' which has its own input area TextBox 65, 55, 20, 10, .myeorw ' the last text string is for hour divisions Text 140, 60, 60, 10, "Hr ln div 1,2,4" TextBox 140, 75, 50, 10, .mydvh Text 5, 110, 210, 40, "www.illustratingshadows.com" Text 5, 150, 220, 40, "For declining meridian dial use: MAIN-v-decs.bas" ' and two buttons for what the user means, location first, button size ' next - and all such boxes must have at least one button by the way OKButton 65, 75, 40, 10 CancelButton 65, 90, 40, 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, and a reference longitude Dim lat As Single Dim lng As Single Dim ref As Single Dim dvh As Single ' ******************************************************************** ' Now get the lat, long, and reference longitude ' ******************************************************************** ' first set the defaults - here bbbbb.mylat uses the structure ' from aaaaa bbbbb.mylat = "32.75" bbbbb.mylng = "108.2" bbbbb.myref = "105.0" bbbbb.myglh = "0.25" ' 0.3 if east is better bbbbb.myeorw = "W" ' east or west face bbbbb.mydvh = "4" ' 1=1hour 2=30mins etc ' here the dialog is invoked and the button results returned to ccccc ' page 20 and 24 etc of Basic discusses the Dialog function ccccc = Dialog(bbbbb) ' which causes the answer to be returned lat = bbbbb.mylat lng = bbbbb.mylng ref = bbbbb.myref glh = bbbbb.myglh eorw = bbbbb.myeorw dvh = bbbbb.mydvh ' divide hours by this ' If east and default gnomon linear height bump it up a bit If (glh = 0.25 And UCase(eorw) = "E") Then glh = 0.38 End If ' CANCEL button returns 0 ' OK button returns -1 ' you can determine the button with - Print ccccc, lat, lng, ref ' ***************************************************************************** ' *** 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 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,8, 20,0,0 ' p231 of Manual dcCreateText 0, -0.3, 0, "meridian dial" dcCreateText 0.5, -0.3, 0, UCase(eorw) dcCreateText 0.0, -0.35, 0, "Lat: " dcCreateText 0.5, -0.35, 0, Format(lat, "00.0") dcCreateText 0.0, -0.4, 0, "Long: " dcCreateText 0.5, -0.4, 0, Format(lng, "00.0") dcCreateText 0.0, -0.45, 0, "Declinations are: 0, " + Str(d10) + ", " + Str(d18) + ", 23.44" ' gnomon linear height is important for meridian dials as distance relates ' to height, whereas h and v dial hour lines are angular related. For a non ' longitude corrected meridian dial the gnomon linear height equals the ' distance from the gnomon base to 3pm or 9am, but this is longitude ' corrected so we need to print the gnomon dcSetLineParms dcBLACK,dcSOLID,dcTHICK dcCreateLine 0.0, 1.05, 0.0+glh, 1.05 ' dccreatetext (0.0+1.1*glh), 1.05, 0, "gnomon lin ht" dcCreateText 0.0, 1.1, 0, "gnomon linear height" ' ************************************************************************ ' first, draw a usable meridian line fitting with the final dial plate box ' ************************************************************************ ' whereas the non declining v-dial and the h-dial are radiating lines ' the m-dial or meridian dial is somewhat different. ' As with an h-dial and a v-dial, a boundary box is assumed, its dimensions ' go from 0,0 on the botton meft to 1,1 on the top right. And for this dial ' a west facing non declining dial is chosen, for the northern hemisphere. ' ' For latitudes 0 to 45 degrees ' ' 0,1 1,1 ' xxxxxxxxxxxxx ' x /x ' x / x this angle at the apex is the latitude. At latitude 0 the ' x / x line would be vertical, thus its angle with the edge ' x / x of the box would be 0 ' x / x the sides of the boundary box are each 1 ' x / x thus the coordinates of the end of the equinox line of the ' x / x meridian dial are (X,0) ' xxxxxxxxxxxxx now, X = 1 - a1 ' 0,0 1,0 a1 = tan(lat)/1 = tan(lat) ' <---><------> so ' X a1 X = 1 - tan(lat) ' <---- 1 ----> ' ' so... the meridian line is drawn from (1,1) to (1-tan(lat),0) mtopx = 1 mtopy = 1 mbotx = 1 - Tan(Rad(lat)) mboty = 0 ' this works for latitudes from 0 to 45, but over 45 degrees, the line moves ' so far to the left that it exits the borders. we need to let the line move ' up the left side. If lat <= 45 Then dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' page 228 Manual dcCreateLine mtopx, mtopy, mbotx, mboty ' thus at this point we have the meridian dial's equinox line drawn and ' conatined within the box, the box as of yet has not been drawn. Else ' if lat greater than 45 then the x coordinate of the bottom of the ' equinox line is 0, and we must calculate an appropriate Y value. ' ' For latitudes 0 to 45 degrees ' ' 0,1 1,1 ' xxxxxxxxxxxxx ' x /x ' x / x this angle at the apex is the latitude. At latitude 0 the 'b1 x / x line would be vertical, thus its angle with the edge ' x / x of the box would be 0 ' x / x for latitudes greater than 45, the line hits the left edge ' x/ x thus the coordinates of the end of the equinox line of the 'Y x x meridian dial are now (0,Y) ' xxxxxxxxxxxxx ' 0,0 1,0 tan(colat) = b1/1 = b1 ' Y = 1 - b1 = 1 - tan(90 - lat) ' ' so... the meridian line is drawn from (1,1) to (0, 1-tan(90-lat)) mbotx = 0 mboty = 1 - Tan(rad(90-lat)) dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' page 228 Manual dcCreateLine mtopx, mtopy, mbotx, mboty End If ' ************************************************************************ ' FIRST, locate the points on either side of the gnomon's base where the ' summer and winter solstice shadow will impinge for 6pm LAT ' ************************************************************************ ' First, lets gather the x,y for the solstice lines for LAT 6pm ' this will be used for the solstice curves ' the distance from the equinox line to a solstice line is ' found from: tan(23.5) = dist.fr.gnomon.base / glh ' thus: dist.fr.gnomon.base = glh * tan(23.5) ' and we can use the same method for finding the x,y of ' the summer and the solstice points for 6pm LAT ' ' ' * winter solstice shadow point for 6pm LAT ' \ ' \ <-- the linear distance from gnomon base to solstice ' \ shadow tip for 6pm LAT is simply ' * gnomon base gnomon linear height * tan(23.5) ' \ [23.5 is solstice solar declination] ' \ ' \ ' * summer solstice shadow point for 6pm LAT ' starting coordinates for declination curves, for comments see more detailed code below for dec=23.5 Dim sx10, sy10, wx10, wy10 As Single lat6distsolstc = glh * Tan ( rad (d10) ) wx10 = 1 - lat6distsolstc * Cos ( rad(lat)) ' minus as left of 1,1 wy10 = 1+ lat6distsolstc * Sin ( rad(lat)) ' plus as above 1,1 sx10 = 1+ lat6distsolstc * Cos ( rad(lat)) ' plus as right of 1,1 sy10 = 1 - lat6distsolstc * Sin ( rad(lat)) ' minus as below 1,1 ' starting coordinates for declination curves, for comments see more detailed code below for dec=23.5 Dim sx18, sy18, wx18, wy18 As Single lat6distsolstc = glh * Tan ( rad (d18) ) wx18 = 1 - lat6distsolstc * Cos ( rad(lat)) ' minus as left of 1,1 wy18 = 1+ lat6distsolstc * Sin ( rad(lat)) ' plus as above 1,1 sx18 = 1+ lat6distsolstc * Cos ( rad(lat)) ' plus as right of 1,1 sy18 = 1 - lat6distsolstc * Sin ( rad(lat)) ' minus as below 1,1 ' following code has notes for the above declinations lat6distsolstc = glh * Tan ( rad (23.5) ) ' here is the distance ' below we define the summer and the winter solstice x,y points for LAT 6pm summerx = 0 summery = 0 winterx = 0 wintery = 0 ' so now calculate the x,y values for summer and winter ' and each time we do an hour line and its x,y points for the summer ' and winter solstice, we will replace summer|winter_x|y with that new point ' ' * winter solstice shadow point for 6pm LAT ' | \ ' y | \ <--- the angle is latitude ' diff +---- * gnomon base ' x \ ' diff \ ' * summer solstice shadow point for 6pm LAT ' the x differential is: lat6distsolstc * cos (latitude) ' the y differential is: lat6distsolstc * sin (latitude) winterx = - lat6distsolstc * Cos ( rad(lat)) ' minus as left of 1,1 wintery = lat6distsolstc * Sin ( rad(lat)) ' plus as above 1,1 summerx = lat6distsolstc * Cos ( rad(lat)) ' plus as right of 1,1 summery = - lat6distsolstc * Sin ( rad(lat)) ' minus as below 1,1 ' the above four lines prime an x,y difference from 1,1 which is the top ' right which is the gnomon base and the top right of the boundary box ' the above four are differences from 1,1 so we need to remember that before ' we use them, and for fun lets put circles at those points which will show ' how the x and y differences from 1,1 are used winterx = 1 + winterx wintery = 1 + wintery summerx = 1 + summerx summery = 1 + summery dcCreateCircle winterx, wintery, 0.01 dcCreateCircle summerx, summery, 0.01 dcSetTextParms dcRED,"Ariel","Bold",0,8, 20,0,0 dcCreateText winterx, wintery+0.05, 0, "sub" dcCreateText summerx+0.05, summery, 0, "style" dcSetLineParms dcRED,dcSOLID,dcTHIN dcCreateLine winterx, wintery, summerx, summery ' at this point, winter|summer x|y are absolute coordinates of the 6pm LAT ' solstice shadows, and they will be used for drawing the winter|summer ' calendar or declination line, when that is done for the first of the hours ' to be drawn in the main loop, which is coming up next. And each time an ' hour line and its two solstice points calculated, and drawn, then ' we will replace winter|summer x|y with the absolute coordinates of the ' just drawn hour, so that the next hour will be able to draw calendar ' lines, and so on. ' yes, these coordinates could be in an array, and other techniques used ' however the focus of this macro is to show the implementation of ' trigonometric methods in BASIC, it is certainly not intended to be an ' example of efficiency. ' yes, much of what is being done should be done by functions or sub ' routines but again the focus is not on how to program in BASIC but to ' see how an implemenation is done for educational purposes. ' ************************************************************************ ' we have now completed locating the points on either side of the gnomon's ' Base where the summer and winter solstice shadow will impinge for 6pm LAT ' ************************************************************************ ' ************************************************************************ ' NEXT, the main loop will locate the point on the equinox line for each ' Hour in question ' ************************************************************************ ' ************************************************************************ ' *** T H I S I S T H E M A I N L O O P ' ************************************************************************ For hr = 5 To 1 Step -(1/dvh) ' allows 30 or 15 min lines ' we shall display the hours 1, 2, 3, 4, and 5pm that is it ' but we will start with 5pm, we will not do 6pm because depending on ' the dial's longitude:reference longitude we could go in the ' wrong direction for the first hour line, and there is little point ' anyway, and the point of this program is to show techniques of ' coding ' we shall assume a gnomon whose linear height is "glh" units ' * <------ gnomon's style ' /y <- this angle is 15 degrees per hour, and ' / y is 0 at 6pm LAT (local apparent time) ' / y thus it is... ' / xxxxxxxxxxx 6 - (hour + (long-ref) ) ' dist on equ line ' ' given tan (hour angle) = dist on equinox line / gnomon linear height ' distance down the equinox line is thus ' ' distance on equinox line = gnomon linear height * tan (net hour angle) ' ' *** EAST OR WEST DIAL *** ' longitude correction to hour angle is added if west, subtracted if east If UCase(eorw) = "W" Then eqnxdist = glh * Tan ( rad (15 * ((6-hr)) + (lng - ref)) ) ' | ' plus if west ' minus if east End If If UCase(eorw) = "E" Then eqnxdist = glh * Tan ( rad (15 * ((6-hr)) - (lng - ref)) ) End If ' that is nice, but what are the x,y of the hour line point on the ' equninox line ' 0,1 1,1 ' xxxxxxxxxxxxx ) ' x /x ) y shift from 1,1 is simple trig ' x / x ) ' x / x ) ' x / <--- x ----- x,y of point on equinox line ' x / x ] ' x/ x ] ' x x ] actual Y ordinate of point is 1-(y shift from 1,1) ' xxxxxxxxxxxxx ] ' 0,0 1,0 ' eqnxdist is a hypotenuse of the x,y pair from 1,1 ' and the angle of the slope from the right side is the latitude ' cos(lat) = (y shift from 1,1) / eqnxdist ' sin(lat) = (x shift from 1,1) / eqnxdist ' and as the side is 1 unit ' thus Y ordinate = 1 - (eqnxdist * cos(lat) ) ' X ordinate = 1 - (eqnxdist * sin(lat) ) thishrx = 1 - ( eqnxdist * Sin( rad(lat) ) ) thishry = 1 - ( eqnxdist * Cos( rad(lat) ) ) ' put a little circle on the equinox line for where this hour line will be ' the circle size is proportional to the hour If ( hr - Int(hr) ) = 0 Then dcCreateCircle thishrx, thishry, hr/200 ' page 154 Manual End If ' say what the time is ' dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 ' page 231 of Manual ' dccreatetext thishrx+0.02, thishry+0.02, 0, hr ' page 187 of Manual ' ' the location for the text saying the hour woule be better off elsewhere ' ' see where it was moved to - the solstice points below ' at this point we have a dot where the hour line hits the equinox line ' and we know that location as: thishrx, thishry ' so we must know how long the hour line will be and thus the x,y for the ' end of that hour line (one for winter, one for summer) ' and then draw the hour line (one for winter, one for summer) ' and because we know the end points of that hour line, we can ' then draw a calendar line from ' winterx, wintery to the winter x & y for this hour line and... ' summerx, summery to the summer x & y for this hour line ' and having done so, move the hour line'e end points to the ' summer|winter x|y as preparation for the next hour line ' >>>>> this is the guts of drawing an hour line and ' >>>>> the end points adding to the two calendar lines ' if we are to draw an hour line perpendicular to the equinox line ' we need to know the end points. There will be a summer end point ' and a winter end point. ' the first step is to calculate the length of the hour line, and ' given that, simple trig derives the x and y displacements from the ' center point of that hour line, which is where the hour line ' intersects the equinox line, which we have just calculated as: ' ' center of the hour line is on the equinox line: thishrx, thishry ' so how long is the hour line? ' the picture is simple but hard to do with characters... ' ' ' ' H [c] gnomon tip or nodus ' O | [cb] = gnomon linear height ' U | ' R |gnomon ' | ' *----------------------------+ - - * ' [a] [b] [d] ' thishrx, ' thishry ' ' as discussed in the proof section of Illustrating Sahdows, a line ' is drawn from the hour point on the equniox line [a] to the top of ' the gnomon [c], and that line is rotated down to the extension of ' the equinox line, becoming [the line [ad] ' from point [d] a line is drawn for the sun's declination (23.5 for the ' solstices) back to the hour line, at point [e], and [ae] is the length ' from the hour line on the equinox to the tip of the hour line. ' then the same old tricks are used to get the summer|winter x|y ' differences from the hour line center, and then ' the same old tricks are used to convert them to absolute coordinates ' and then the hour line can be drawn, the calendar lines can be drawn and ' the accumulators winter|summer x|y updated for the next hour. ' calculate [ac]: tan(cab) = gnomon linear height / hour line distance ' and we also have: sin(cab) = gnomon linear height / line ac ' thus: ac = glh / sin(cab) ' and as: cab = atan(glh / hour line dist) ' then: ac = glh / sin( atan(glh/hrlndist)) ' ' or... ac = sqrt( ab**2 + cd**2 ) [pythagorus] ac = Sqr ( (eqnxdist * eqnxdist ) + ( glh*glh) ) ad = ac ' just to make things match the description. ' length of hour line from line center to solstice tip is ' tan(23.5) * ad lnh = Tan(rad(23.5)) * ad ' now we convert lnh (the hour line's linear length) to x and y displacements ' so now calculate the x,y values for summer and winter ' (yes, this is the same method as we used earlier) ' ' * winter solstice shadow point for 6pm LAT ' | \ ' y | \ <--- the angle is latitude ' diff +---- * gnomon base ' x \ ' diff \ ' * summer solstice shadow point for 6pm LAT ' the x differential is: lnh * cos (latitude) ' the y differential is: lnh * sin (latitude) lnhwx = - lnh * Cos ( rad(lat)) ' minus as left of 1,1 lnhwy = lnh * Sin ( rad(lat)) ' plus as above 1,1 lnhsx = lnh * Cos ( rad(lat)) ' plus as right of 1,1 lnhsy = - lnh * Sin ( rad(lat)) ' minus as below 1,1 lnhwx = thishrx + lnhwx lnhwy = thishry + lnhwy lnhsx = thishrx + lnhsx lnhsy = thishry + lnhsy ' put circles for the intersection point of the hour line and solstice If ( hr - Int(hr) ) = 0 Then dcCreateCircle lnhwx, lnhwy, 0.01 dcCreateCircle lnhsx, lnhsy, 0.01 End If ' say what the time is dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 ' *** EAST OR WEST DIAL *** ' change what hour is shown, and reverse summer and winter If ( hr - Int(hr) ) = 0 Then If UCase(eorw) = "W" Then dcCreateText lnhwx+0.02, lnhwy-0.01, 0, hr ' std time dcCreateText lnhsx+0.02, lnhsy-0.01, 0, hr+1 ' dylght svngs End If If UCase(eorw) = "E" Then dcCreateText lnhwx+0.02, lnhwy-0.02, 0, 12-hr ' std time dcCreateText lnhsx+0.02, lnhsy-0.02, 0, 12-(hr-1) ' dylght svngs End If End If ' use different lines for partial hours 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 ' draw the summer and winter halves of the hour line dcCreateLine thishrx, thishry, lnhwx, lnhwy dcCreateLine thishrx, thishry, lnhsx, lnhsy ' draw the solstice curve or line - line for starters dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color dcCreateLine lnhwx, lnhwy, winterx, wintery dcCreateLine lnhsx, lnhsy, summerx, summery ' now reset the points for the next hour line's calendar points winterx = lnhwx wintery = lnhwy summerx = lnhsx summery = lnhsy ' potential improvemnts ' The x,y coordinates of the 6pm LAT and hour lines for summer could ' be saved in an array, similarly for the winter, and then a spline could ' be drawn using the two arrays. This would be a curved line. ' >>>>>>>>>>>>>>>> this is end of the the guts of drawing an hour line ' >>>>>>>>>>>>>>>> and the end points adding to the two calendar lines ' ======================================================================= ' we have drawn an hour line, drawn iots two calendar lines and we have ' updated the data for the next set of calendar lines, so all we need ' do is see if we need to draw more hour, that is what NEXT HR does ' ======================================================================= ' for logic notes, see above code for decl=23.5 lnh = Tan(rad(d10)) * ad lnhwx = thishrx - lnh * Cos ( rad(lat)) ' minus as left of 1,1 lnhwy = thishry + lnh * Sin ( rad(lat)) ' plus as above 1,1 lnhsx = thishrx + lnh * Cos ( rad(lat)) ' plus as right of 1,1 lnhsy = thishry - lnh * Sin ( rad(lat)) ' minus as below 1,1 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color If hr <> 5 Then dcCreateLine lnhwx, lnhwy, wx10, wy10 dcCreateLine lnhsx, lnhsy, sx10, sy10 End If wx10 = lnhwx wy10 = lnhwy sx10 = lnhsx sy10 = lnhsy ' for logic notes, see above code for decl=23.5 lnh = Tan(rad(d18)) * ad lnhwx = thishrx - lnh * Cos ( rad(lat)) ' minus as left of 1,1 lnhwy = thishry + lnh * Sin ( rad(lat)) ' plus as above 1,1 lnhsx = thishrx + lnh * Cos ( rad(lat)) ' plus as right of 1,1 lnhsy = thishry - lnh * Sin ( rad(lat)) ' minus as below 1,1 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color If hr <> 5 Then dcCreateLine lnhwx, lnhwy, wx18, wy18 dcCreateLine lnhsx, lnhsy, sx18, sy18 End If wx18 = lnhwx wy18 = lnhwy sx18 = lnhsx sy18 = lnhsy Next hr ' ************************************************************************ ' last, everything is done, display the window and exit ' ************************************************************************ ' draw a box around everything dcCreateBox 0, 0, 1, 1 dcCreateBox -0.2, -0.2, 1.2, 1.2 ' *** EAST OR WEST DIAL *** ' the image must be mirrored if an east facing dial If UCase(eorw) = "w" Then dcViewBox -0.5, -0.5, 1.5, 1.5 End If If UCase(eorw) = "E" Then dcSelectAll dcMirrorSelObjs 2, -2, 2, 2 dcUnSelectAll dcViewBox 3, -0.5, 4.5, 1.5 End If End If ' ***************************************************************************** ' *** this ends the entire program *** ' ***************************************************************************** meridian = 1 End Function ' ***************************************************************************** ' ***************************************************************************** ' *** *** ' *** [6] ARMILLARY a full dial plate of curves *** ' *** with longitude correction *** ' *** *** ' ***************************************************************************** ' ***************************************************************************** Function armillary (d10 As Single, d18 As Single) As Integer ' ********************************************************************* ' A generic definition is required for a screen input area ' ********************************************************************* Begin Dialog aaaaa 20, 20, 350,120, "Armillary dial plate options" 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" Text 5, 85, 210, 20, "www.illustratingshadows.com" 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.mylng = "108.2" bbbbb.myref = "105" bbbbb.mydvh = "2" ccccc = Dialog(bbbbb) glh = bbbbb.myglh ' nodus to dial plate linear ht r = glh many = "F" lng = bbbbb.mylng ref = bbbbb.myref dvh = bbbbb.mydvh ' ***************************************************************************** ' *** ARMILLARY 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, "Dialplate of armillary dial." dcCreateText 2.0, glh-0.8, 0, "June solstice is south." dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcSetTextParms dcBLACK,"Ariel","Bold",0,12, 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) ) Next jd 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 = -d10 to d10 step d10 ' 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 ' *** DECLINATION LINES *** dcSetLineParms dcBROWN,dcSOLID,dcTHIN dcCreateLine leftx,0,rightx,0 ' equinox line For h = -d18 to d18 step d18 ' 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 2.0 'dcViewBox -3, -3, 3, 3 End If armillary = 1 End Function ' ***************************************************************************** ' *** *** ' *** [7] C A L E N D A R ON DIAL PLATE F O R E Q U A T O R I A L *** ' *** *** ' *** full dial plate *** ' *** *** ' ***************************************************************************** Function equatorial (d10 As Single, d18 As Single) 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" Text 155, 15, 120, 40, "[affects direction of offset]" 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" 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)) h = d10 dcCreateText 0 ,r * Tan(rad(90-h)) ,0, Format(h,"00") dcCreateCircle 0 , 0 , r * Tan(rad(90-h)) h = d18 dcCreateText 0 ,r * Tan(rad(90-h)) ,0, Format(h,"00") dcCreateCircle 0 , 0 , r * Tan(rad(90-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 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,28,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 ' 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 2.0 End If equatorial = 1 End Function ' ***************************************************************************** ' *** *** ' *** [0] I N V O L V E D C A L E N D A R C U R V E S *** ' *** *** ' ***************************************************************************** ' ********************************************************************* ' A "horizontal" dial macro with calendar lines ' ' except the longitude correction is excluded, longitude and ' reference are set to 0 degrees ' and SH is used as opposed to latitude, ' and hours are irrelevant, but shown anyway as hrs from "noon" ' a note added that the "noon" hour here goes to SH on the final dial ' and some comments are removed ' ********************************************************************* ' This is a calendar dial, in that the solstice, and equinox lines are ' shown. The hour lines are not terminated by the calendar curves because ' the nodus identifies the calendar line or date in question, and extended ' hour lines allow a style longer than dial center to nodus, to enhance ' dial accuracy. ' ********************************************************************* Function calendarI(d10 As Single, d18 As Single) As Integer ' ********************************************************************* ' Initial house keeping - clear the screen - set the drafting area unit ' ********************************************************************* ' select all objects that may exist on the screen then erase them all If (dcSelectAll) Then dcEraseSelObjs End If dcSetDrawingScale 0.4 ' 0.80 dcCreateBox -1, 0, 1, 1 ' p184 Manual left, bottom, right, top dcCreateBox -1.3, -.2, 1.3, 1.2 ' p184 Manual left, bottom, right, top dcViewBox -1.1, -1.3, 1.1, 1.3 ' page 225 Manual left, bot, top, rt ' ******************************************************************** ' A generic definition is required for a screen input area ' ******************************************************************** Begin Dialog aaaaa 10, 10, 350,225, "Calendar curves - SH [style height] based" Text 5, 15, 60,40, "Enter SH style height" TextBox 65, 15, 50, 10, .mylat Text 240, 15, 150, 10, "For SH consider gnomon lin ht" Text 240, 25, 150, 10, "20 0.20" Text 240, 35, 150, 10, "10 0.10" Text 240, 45, 150, 10, " 5 0.07" Text 240, 55, 150, 10, " 2 0.03" Text 240, 65, 150, 10, "if <2 use polar dial curves" Text 240, 75, 100, 10, "Gnomon lin ht" TextBox 320, 75, 20, 10, .myglh Text 5, 65, 100, 10, "H (hour lines) or D (degrees)" TextBox 125, 65, 10, 10, .myhord Text 150, 65, 70, 10, "i.e. dial or protractor" Text 51, 75, 100, 10, "rotate IF D/degrees:" Text 51, 85, 140, 30, "*** rotate changes the degree headings to simplify applying to a real dial plate ***" TextBox 125, 75, 20, 10, .myshift Text 150, 75, 80, 10, "i.e. shift by SD" Text 240,110, 60, 10, "Hour line div 1,2,4" TextBox 320,110, 20, 10, .mydvh Text 5, 110, 200, 20, "Default solar declinations used are:-" Text 65, 120, 20, 10, "23.5" TextBox 95, 120, 20, 10, .my20 TextBox 125, 120, 20, 10, .my11 Text 5, 150, 210, 20, "www.illustratingshadows.com" Text 5, 180, 180, 20, "Hour lines are reference only" Text 125, 15, 60, 10, "If Decl<>0 then" Text 125, 25, 60, 10, "animate shadow" Text 125, 35, 60, 10, "NOT if epileptic" TextBox 195, 15, 20, 10, .mydec Text 240,150, 210, 20, "Drawing scale 0.8-0.04" TextBox 320,150, 20, 10, .myds Text 5, 200, 230, 20, "See: ILLUSTRATING TIME'S SHADOW (Book 3) ch 16, 17, 19, 22 " Text 5, 210, 200, 20, "and earlier books: Book 1: ch 16, Book 2: ch 6, 12" OKButton 240,180, 40, 10 CancelButton 290,180, 40, 10 End Dialog ' ---------------------------------------------------------------------------- ' PHASE 1: get dial location and gnomon(nodus) dimensions ' ---------------------------------------------------------------------------- ' ******************************************************************** ' 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 Dim dec As Single ' declination of sun to animate nodus Dim my20val As Single ' the standards for the curves Dim my11Val As Single Dim shift As Single ' adjust displayed angles Dim hord As String Dim ds As Single ' ******************************************************************** ' Now get the lat, long, and reference longitude ' ******************************************************************** ' first set the defaults - here bbbbb.mylat uses the structure ' from aaaaa bbbbb.mylat = "32.75" ' style height for dial plate bbbbb.myglh = "0.3" ' gnomon linear height bbbbb.mydvh = "1" ' 1=1hour 2=30mins etc bbbbb.mydec = "0" bbbbb.my20 = d18 bbbbb.my11 = d10 bbbbb.myhord= "H" ' pseudo hours lines or true degrees bbbbb.myshift= 0 ' add to displayed angles bbbbb.myds = 0.4 ' controls line widths etc ' here the dialog is invoked and the button results returned to ccccc ccccc = Dialog(bbbbb) ' which causes the answer to be returned glh = bbbbb.myglh ' nodus to dial plate linear ht lat = bbbbb.mylat ' latitude lng = 0 ' longitude ref = 0 ' legal time meridian longitude dvh = bbbbb.mydvh ' divide hours by this dec = bbbbb.mydec ' declination for moving shadow my20val = bbbbb.my20 my11Val = bbbbb.my11 hord = UCase(bbbbb.myhord) ' H or D shift = bbbbb.myshift ds = bbbbb.myds ' drawing scale ' *** CORRECT PARAMETERS BASED ON THE CONTEXT *** dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' if a shift value then force degrees because shift is meaningless for hours If shift <> 0 Then hord = "D" dcCreateText 0.5, 1.15, 0, "Degrees forced as shift entered" dcSetTextParms dcDARKGREEN,"Ariel","Bold",0,6, 20,0,0 dcCreateText -1, 1.15, 0, "Dark green angled line on substyle and nodus is horizontal for east/west dials" End If dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' if not hour display then is degrees, and inhibit animation If hord <> "H" Then dec = 0 dcCreateText 0, -0.1, 0, "Animation probibited as in degree mode" End If ' If declination zero is entered then we will animate the shadow Dim animate As Single ' 0 = no animate, 1 = animate animate = 0 If dec <> 0 Then animate = 1 ' say we will animate If dec > 23.5 Then ' and fix out of bounds declinations dec = 23.5 End If If dec < -23.5 Then dec = -23.5 End If End If ' check SH as positive If lat <0 Then lat = - lat End If ' control line width as well as character size dcSetDrawingScale ds ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** If ccccc = -1 Then ' the ok button was used ' ************************************************************************** ' *** 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,8, 20,0,0 dcCreateText -1.20, -0.3, 0, "Calendar curves using SH (style height)" dcCreateText 0.0, -0.3, 0, Format(lat,"0.00") dcCreateText -1.20, -0.4, 0, "Align central hour X here, with final dial's SD." If hord = "H" Then dcCreateText -1.20, -0.5, 0, "The 'hours' on this plate, other than 'X', are meaningless." dcCreateText -1.20, -0.6, 0, " they may be used for rescaling curves on paper." Else dcCreateText -1.20, -0.5, 0, "The 'hours' on this plate are not hours, they are degrees," dcCreateText -1.20, -0.6, 0, " so you can copy over actual hour line angles." End If If hord <> "H" Then dcCreateText -1.20, -0.7, 0, "The SD entered was:" dcCreateText 0, -0.7, 0, Format(shift, "00.00") End If dcCreateText -1.20, -0.8, 0, "Declinations used are:" dcCreateText -0.3, -0.8, 0, "23.5" dcCreateText 0, -0.8, 0, Format(my20val,"00.0") dcCreateText .3, -0.8, 0, Format(my11Val,"00.0") dcCreateText .5, -0.8, 0, "Gnomon linear height:" dcCreateText 1.1, -0.8, 0, Format(glh, "0.000") If dvh <> 1 And hord = "H" Then dcCreateText 0.5, -0.6, 0, "However, check 11-1 partial hours" End If ' ---------------------------------------------------------------------------- ' PHASE 2: draw normal hours that extend to the box limits ' ---------------------------------------------------------------------------- Dim aalo, aahi, aast As Single If hord = "H" Then aalo = 6 aahi = 18 aast = 1/dvh ' 1/dvh allows hour divisions Else aalo = -90 aahi = 90 aast = 1 End If For hr = aalo To aahi Step aast ' for the hour (hr) calculate the hour line angle (h) for this ' longitude adjusted for the reference longitude ' show the angle If hord = "H" Then h = Hla ( (hr), (lat), (lng), (ref) ) Else h = hr End If If animate = 1 Then ' thick hour lines for animation dcSetLineParms dcBLACK,dcSOLID,dcTHICK ' set black as default line color Else dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color End If If animate = 0 Then If hord = "H" Then If ( hr - Int(hr) ) <> 0 Then dcSetLineParms dcBLACK,dcSTITCH,dcTHIN ' but if not full hour change End If Else If ( hr/10 - Int(hr/10) ) <> 0 Then dcSetLineParms dcBLACK,dcSTITCH,dcTHIN ' but if not full hour change End If End If End If If ( hord = "H" And hr < 12) Or (hord <> "H" And hr < 0) Then ' -------------------------------------------------------------------- ' morning hours ~ NOTE code for keeping lines in a boxed area ' --------------------------------------------------------------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 21,0,0 If hord = "H" Then dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 21,0,0 End If If Abs(h) < 45 Then ' lines touch top of box hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then If hord = "H" Then dcCreateText (hx), 1.1, 0, Abs(12-hr) Else If ( (hr/10 - Int(hr/10)) ) = 0 Then dcCreateText (hx), 1.02, 0, Format(shift+h ,"00.0") dcSetTextParms dcRED,"Ariel","Bold",0,6, 21,0,0 dcCreateText (hx), 1.06, 0, Format(shift-h ,"00.0") End If End If End If Else ' lines touch side of box hy = Tan(rad((90-h))) dcCreateLine 0,0,-1,-hy ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then If hord = "H" Then dcCreateText -1.1, -hy, 0, Abs(12-hr) Else If ( (hr/10 - Int(hr/10)) ) = 0 Then dcCreateText -1.1, -hy, 0, Format(shift+h,"00.0") dcSetTextParms dcRED,"Ariel","Bold",0,6, 21,0,0 dcCreateText -1.1, -(hy+0.03), 0, Format(shift-h,"00.0") End If End If End If End If ElseIf ( hord = "H" And hr = 12) Then ' ------------- ' noon hours ' ------------- dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 21,0,0 hx = Tan(rad((h))) dcCreateLine 0,0,hx,1 ' say that it is 12 noon dcCreateText (hx), 1.1, 0, "X" Else ' --------------- ' afternoon hours ' --------------- dcSetTextParms dcBLACK,"Ariel","Bold",0, 6, 21,0,0 If hord = "H" Then dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 21,0,0 End If 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 ' page 185 Manual ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then If hord = "H" Then dcCreateText (hx), 1.1, 0, Abs(hr-12) Else If ( (hr/10 - Int(hr/10)) ) = 0 Then dcCreateText (hx), 1.02, 0, Format(shift+h,"00.0") dcSetTextParms dcRED,"Ariel","Bold",0,6, 21,0,0 dcCreateText (hx), 1.06, 0, Format(shift-h,"00.0") End If End If End If Else hy = Tan(rad((90-h))) dcCreateLine 0, 0, 1, hy ' display numbers for pure hours only If ( hr - Int(hr) ) = 0 Then If hord = "H" Then dcCreateText 1.1, hy, 0, Abs(hr-12) Else If ( (hr/10 - Int(hr/10)) ) = 0 Then dcCreateText 1.1, hy, 0, Format(shift+h,"00.0") dcSetTextParms dcRED,"Ariel","Bold",0,6, 21,0,0 ' dccreatetext (hy), 1.1, 0, Format(shift+h,"00.0") dcCreateText 1.1, hy+0.03, 0, Format(shift-h,"00.0") ' show angle complement End If End If End If End If End If Next hr ' ------------------------------------------------------------------------- ' PHASE 3: draw calendar lines ' ------------------------------------------------------------------------- Dim nwx As Single ' new x,y coordinates for a Dim nqx As Single ' new calendar point Dim nsx As Single Dim nwy As Single Dim nqy As Single ' *** NQY *** is used elsewhere in animation Dim nsy As Single Dim wx, wy, qx, qy, sx, sy As Single ' prior coordinates of a calendar point ' 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 ' for the hour (hr) calculate the calendar data for this ' local apparent time (LAT) which is NOT longitude adjusted for ' the reference longitude. This is ok because we are drawing ' calendar lines without regard to actual hour lines. ' if you desire, the calendar line points can be calculated for ' legal time hours (11 am and 1 pm would not have the same hour ' because of longitude differences unless the dial design ' longitude was on the legal time meridian. If you did this then ' the calendar line x,y would be used for BOTH the calendar lines ' as well as drawing the hour lines. ' This program draws legal time hour lines bounded by the box, ' and the calendar lines are based on the nodus and the calendar ' lines do not constrain the hour lines which thus allows a long ' style with a nodus partially long it. ' starts at 0700 ends ad 1700 because 6 am and 6 pm have meaningless ' calendar data ' also data is meaningless at noon 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 negative (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 If animate = 1 Then dcSetLineParms dcBLUE,dcSOLID,dcTHICK End If 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 If animate = 1 Then dcSetLineParms dcGREEN,dcSOLID,dcTHICK End If ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN If animate = 1 Then dcSetLineParms dcRED,dcSOLID,dcTHICK End If 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 3 continued: draw more calendar lines ' ------------------------------------------------------------------------- ' 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 wz = Cal ( (hr), (lat), -my20val, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), my20val , 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 animate = 1 Then dcSetLineParms dcBLUE,dcSOLID,dcTHICK End If 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 If animate = 1 Then dcSetLineParms dcGREEN,dcSOLID,dcTHICK End If ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN If animate = 1 Then dcSetLineParms dcRED,dcSOLID,dcTHICK End If ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If Next hr ' ------------------------------------------------------------------------- ' PHASE 3 continued: draw even more calendar lines ' ------------------------------------------------------------------------- ' 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 wz = Cal ( (hr), (lat), -my11Val, glh ) ' last parm = decl qz = Cal ( (hr), (lat), 0.0 , glh ) ' last parm = decl sz = Cal ( (hr), (lat), my11Val , 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 animate = 1 Then dcSetLineParms dcBLUE,dcSOLID,dcTHICK End If 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 If animate = 1 Then dcSetLineParms dcGREEN,dcSOLID,dcTHICK End If ok = Dln ( (qx), (qy), (nqx), (nqy) ) dcSetLineParms dcRED,dcSOLID,dcTHIN If animate = 1 Then dcSetLineParms dcRED,dcSOLID,dcTHICK End If ok = Dln ( (sx), (sy), (nsx), (nsy) ) End If wx = nwx wy = nwy qx = nqx qy = nqy sx = nsx sy = nsy End If Next hr ' ------------------------------------------------------------------------- ' PHASE 4: draw the gnomon to the nodus (for calendar lines) ' ------------------------------------------------------------------------- ' from the dial center which is at 0,0 draw a line whose ' angle is latitude and whose ' length is based on the gnomon linear height ' ' sll = style linear length (dial center to nodus) = glh / sin(latitude) ' ' but as DeltaCAD doesn't draw vectors, we need the x,y of the nodus ' ' we have an angle (latitude), and a distance (glh/sin(latitude) ' x ' ' sll \ | y ' \ | ' \ lat| ' \ | ' \ | ' * ' assuming a center of 0,0 (dial center) we can calculate the ' x,y values by... ' ' x = sin(latitude) * sll x is obviously gnomon linear height! ' y = cos(latitude) * sll and sll = glh/sin(lat) ' ' actually it is simpler than that... 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.005 ' circle for base of nodus If shift <> 0 Then ' draw a horizontal or vertical line in case this is a vertical great decliner ' from nodusx, nodusy Dim shiftcomp As Single shiftcomp = shift refx = 0.5 refy = refx * Tan(rad(-shiftcomp)) dcSetLineParms dcDARKGREEN,dcSOLID,dcTHIN ' line on substyle below nodus dcCreateLine 0, nodusy, 0-refx, nodusy-refy dcCreateLine 0, nodusy, 0+refx, nodusy+refy ' line on nodus dcCreateLine nodusx, nodusy, nodusx+0-refx, nodusy-refy dcCreateLine nodusx, nodusy, nodusx+0+refx, nodusy+refy End If End If ' if animated, then run a nodus tip for the nodus shadow If animate = 0 Then ' ------------------------------------------------------------------------- ' PHASE 5: draw boundaries and display the final product - if no animation ' ------------------------------------------------------------------------- ' draw a box around everything dcCreateBox -1, 0, 1, 1 dcCreateBox -1.3, -.2, 1.3, 1.2 dcViewBox -1.1, -1.3, 1.1, 1.3 ' Stop Exit Function ' exit function avoids the script error that happens with STOP Else For hr = 6 To 17.9 Step 0.05 Dim mys As Single ' my shadow tip Dim myh As Single ' my hour line angle If (hr < 11.9 Or hr > 12.1) Then ' above IF solves any hour line issues between 11 and 1 If ( (hr*4) - Int(hr*4) ) <> 0 Then ' above IF stops whiting out real hour lines ' get the nodus shadow tip for this decl for this hour mys = Cal ( (hr), (lat), dec, glh ) ' last parm = decl ' get the LAT hour line angle also myh = Hla ( (hr), (lat), (0), (0) ) ' long=ref=0 means LAT hours ' get x,y for nodus tip ' ' example of bad programming method, here we are using someone ' elses variables (nwx, nwy) and they don't know it - see phase 3 nwx = Sin(rad((myh))) * mys nwy = Cos(rad((myh))) * mys If (nwx > -1 And nwx < 1 And nwy > -1 And nwy < 1 ) Then ' above IF ensures lines will be in the box ' example of bad programming method, here we are using someone ' elses variables (nqy) and they don't know it - see phase 3 If ( (dec < 0 And nwy>nqy) Or (dec>=0) ) Then ' draw nodus shadow dcSetCircleParms dcBLUE,dcSOLID,dcTHIN dcCreateCircle nwx, nwy, 0.01 dcCreateCircle nwx, nwy, 0.005 ' draw outline of gnomon shadow itself dcSetLineParms dcRED,dcSTITCH,dcTHIN dcCreateLine nodusx, nodusy, nwx, nwy ' nodus to shadow tip dcSetLineParms dcBLUE,dcSOLID,dcTHIN dcCreateLine 0, nodusy, nwx, nwy ' dial center dcCreateLine 0,0, nwx, nwy ' dial center to shadow tip ' pause Dim v As Single Dim w As Single v = Timer * 100 ' i is in 1/100 of a Second w = v+3 ' j is 2/100 into the future Do While v < w w = w ' do nothing v = Timer * 100 ' get the time again Loop ' save a good final set of x,y for the shadow tip Dim snx, sny As Single snx = nwx sny = nwy ' now we should remove the shadow outline ' 1. The best way would be to use LAYERS and to have the default layer ' hold the hour and calendar lines, and the box, and a second layer ' to hold the gnomon shadow. Unfortunatley, while you can easily ' delete a layer in DeltaCAD, not so easy in a script. And the next ' LAYER method is to have a new layer per shadow, and turn prior layers ' off, however than can consume expensive resources. ' 2. The next best method would be to delete shadow lines by re-drawing ' them with a null color, but DeltaCAD has no ability to undraw a ' line. ' 3. So we could re-draw the lines as white lines, but that would place ' white lines over existing hour lines and damage them, but it works. ' 4. Or we could make the shadow lines unique by color, type, or thickness ' and then run all objects looking for the unique type and delete that ' object. That works but dcGetLineParms doesnt always return the ' info we need, hence why we must use dcGetLineData, however that has ' its own quirks. ' 5. Regardless of the method used, it appears that actual drawing and ' displaying are asynchronous with the dc commands or functions. ' Hence... lines still seem to be cloberred ' Hence... sometimes the drawing stops until the end if the ' computer is busy. Happens if any programs are open even ' if they are not doing anything. ' So, "yer pays yer money and takes yer choice" ' ' remove outline of gnomon shadow ' ' better than nothing but the deleted lines still overwrite the good hour lines ' dcsetlineparms dcwhite,dcstitch,dcthin ' dccreateline nodusx, nodusy, nwx, nwy ' nodus to shadow tip ' dcsetlineparms dcwhite,dcsolid,dcthin ' dccreateline 0, nodusy, nwx, nwy ' dial center ' dccreateline 0,0, nwx, nwy ' dial center to shadow tip ' this is no better, and using layers doesnt work either Dim obt As Long ' the variables seem Dim lnc As Long ' to need to be defined Dim lnt As Long ' one at a time Dim lnw As Long Dim lnxaro As Long ' and data type is very critical Dim lnxa As Double Dim lnxb As Double Dim lnxc As Double Dim lnxd As Double Dim lnxlyr As String ' and not mentioned in manual is ' ' how you make the string big ' ' enough. It says to be big but ' ' doesnt show you how, the assignment ' ' on the next line is how. lnxlyr = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ' ok, get the very first object the screen ever saw obt = dcGetFirstObject ("") ' and While obt <> dcNone ' as long as we have an object If obt = dcLine Then ' see if it is a line ' dcgetlineparms lnc,lnt,lnw ' <<< this doesnt work for some reason dcGetLineData lnxa, lnxb, lnxc, lnxd, lnc, lnt, lnw, lnxlyr, lnxaro If lnw = dcTHIN Then ' if line get uniqueness dcEraseCurrentObject ' erasing the line End If End If obt = dcGetNextObject ' and do for all objects on all layers Wend End If End If End If End If Next hr End If ' use the last good x,y of the shadow tip for a final shadow dcSetLineParms dcBLACK,dcSOLID,dcTHICK dcCreateLine 0, nodusy, snx, sny ' nodus tip to shadow dcCreateLine nodusx, nodusy, snx, sny ' nodus tip to shadow dcCreateLine 0,0, snx, sny ' dial center to shadow tip ' redraw the gnomon dcSetLineParms dcRED,dcSOLID,dcTHICK 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 ' ------------------------------------------------------------------------- ' PHASE 5: draw boundaries and display the final product - after animation ' ------------------------------------------------------------------------- ' draw a box around everything dcCreateBox -1, 0, 1, 1 dcCreateBox -1.3, -.2, 1.3, 1.2 dcViewBox -1.1, -1.3, 1.1, 1.3 ' ***************************************************************************** ' *** this ends the entire program *** ' ***************************************************************************** calendarI = 1 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 (-5, -5, 5, 5) ) 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 (-5, -5, 5, 5) ) 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 *** ' ***********