[APBeta] Global observations script
Jeff Young
jey at adobe.com
Wed Mar 25 03:47:55 PDT 2009
Chris --
I did find one bug in the script -- if you have any observations with no telescope listed (for instance, a naked-eye observation of a comet), then it will throw an exception.
The offending lines are in GetMagnification() where it checks scope.IsBinocular and scope.IsTelescope without first checking if scope <> nil.
But I've also attached a new copy of the script which fixes the bug, and implements some more sophisticated page-breaking rules:
* it attempts to place user images on the same page with their observations
* it includes "continued" headers when breaks occur within the observations for a single target
* it removes the RA/Dec coordinates from moving targets (such as planets and comets)
Cheers,
-- Jeff.
//----------------------------------------------------------------------------------------------
sub DoPageNumbering(c as Canvas, title as string, doPrint as boolean)
// Handle page numbering
dim dateStr, page as string, x as integer
c.TextItalic = true
c.ForeColor(64, 64, 64)
dim now as Date
now = new Date
dateStr = now.ShortDate + " " + now.ShortTime
page = "Page " + str(c.PageNumber)
if doPrint then
c.DrawText(title, 0, c.TextHeight)
c.DrawText(dateStr, c.Width - c.TextWidth(dateStr), c.TextHeight)
c.DrawText(page, c.Width - c.TextWidth(page), c.Height)
else
c.DrawText(dateStr, 0, c.TextHeight)
c.DrawText(title, c.TextWidth(dateStr) + 20, c.TextHeight)
c.DrawText(page, c.Width - c.TextWidth(page), c.TextHeight)
end
c.TextItalic = false
c.ForeColor(0, 0, 0)
end sub
//----------------------------------------------------------------------------------------------
//
sub DoObjectName(c as Canvas, y as integer, obs as APObservation, continued as boolean)
dim s as string
if obs.ID = obs.Name then
s = obs.ID
else
s = obs.ID + " " + obs.Name
end if
if continued then
s = s + " (continued)"
end if
c.TextBold = true
c.DrawText(s, 0, y + c.TextHeight)
if NOT continued then
if obs.Type <> "Planet" AND obs.Type <> "Comet" AND obs.Type <> "Sun" then
s = "RA: " + FormatRA(obs.RA) + " Dec: " + FormatDec(obs.Dec)
c.DrawText(s, c.Width - c.TextWidth(s), y + c.TextHeight)
end if
end if
c.TextBold = false
end sub
//----------------------------------------------------------------------------------------------
//
function FormatDateTime(dateTime as double) as string
dim obsDate as Date
obsDate = new Date(dateTime)
dim s as string
s = obsDate.ShortDate + " " + DoubleToTime(dateTime, false) + " UT"
return s
end function
//----------------------------------------------------------------------------------------------
//
function FormatConditions(seeing as string, trans as string) as string
dim s as string
// Seeing should be either "Seeing 2/5" or "Pickering 6":
//
if InStr(seeing, "/") > 0 then
s = "Seeing " + seeing
elseif InStr(seeing, ".") > 0 then
s = "Pickering " + NthField(seeing, ".", 1)
elseif Len(seeing) > 0 then
s = seeing
end if
// See if we have NELM and/or SQM readings:
//
dim nelm, sqm as string
nelm = Trim(NthField(trans, " ", 1))
sqm = Trim(NthField(trans, " ", 2))
if Left(sqm, 1) = "(" then
sqm = Mid(sqm, 2, sqm.len - 2)
end if
// Format them into "NELM 5.5, SQM 20.7":
//
if Len(nelm) > 0 then
if Len(s) > 0 then
s = s + ", "
end if
s = s + "NELM " + nelm
end if
if Len(sqm) > 0 then
if Len(s) > 0 then
s = s + ", "
end if
s = s + "SQM " + sqm
end if
return s
end function
//----------------------------------------------------------------------------------------------
//
function FormatEquipment(scope as string, ep as string, filter as string, aid as string) as string
dim s as string
s = scope
if Len(ep) > 0 AND ep <> "None" then
s = s + ", " + Trim(ep)
end if
if Len(filter) > 0 AND filter <> "None" then
s = s + ", " + filter
end if
if Len(aid) > 0 AND aid <> "None" then
s = s + ", " + aid
end if
return s
end function
//----------------------------------------------------------------------------------------------
// Support function which calculates magnification and performs optional rounding.
//
function GetMagnification(scopeName as string, epName as string, aidName as string, doRound as boolean) as string
dim scope as TelescopeResource, ep as EyepieceResource, aid as VisualAidResource
scope = TelescopeResource.Get(scopeName)
ep = EyepieceResource.Get(epName)
aid = VisualAidResource.Get(aidName)
if scope = nil then
return "1X"
end if
dim mag as double
if scope.IsBinocular then
mag = scope.Magnification
else
mag = APResource.Magnification(scope, ep, aid)
end if
if doRound AND scope.IsTelescope then
if mag < 200 then
dim dime, dimeFit, quarter, quarterFit as double
dime = Round(mag / 10) * 10
dimeFit = Abs(mag - dime)
quarter = Round(mag / 25) * 25
quarterFit = Abs(mag - quarter)
if quarterFit < dimeFit then
mag = quarter
else
mag = dime
end if
else
mag = Round(mag / 25) * 25
end if
end if
if mag > 0 then
return str(mag) + "X"
else
return "--"
end if
end function
//----------------------------------------------------------------------------------------------
// A couple of routines to convert names to indicies.
//
function CurrentTelescopeIndex(scopes() as string) as integer
dim target as TelescopeResource
target = TelescopeResource.Current
if target = nil then
target = TelescopeResource.Default
end if
if target <> nil then
dim i as integer
for i = 0 to Ubound(scopes)
if scopes(i) = target.Name then
return i
end if
next
end if
return 1
end function
function CurrentSiteIndex(sites() as string) as integer
dim target as SiteResource
target = SiteResource.Current
if target = nil then
target = SiteResource.Default
end if
if target <> nil then
dim i as integer
for i = 0 to Ubound(sites)
if sites(i) = target.Name then
return i
end if
next
end if
return 1
end function
//----------------------------------------------------------------------------------------------
// Searches the open plans for a particular ID. Useful for comets and planets where we can't
// use RA/Dec to fetch images, etc.
//
function GetPlanObject(id as string) as APPlanObject
dim ssPlan as APPlan
ssPlan = APPlan.Plan("Solar_System.apd")
if ssPlan = nil then
ssPlan = APPlan.OpenPlan("C:\Documents and Settings\jey\My Documents\AstroPlanner\Plans\Solar_System.apd")
end if
if ssPlan <> nil then
dim i as integer
for i = 1 to ssPlan.nObjects
if ssPlan.Obj(i).ID = id then
return ssPlan.Obj(i)
end if
next
end if
end function
//----------------------------------------------------------------------------------------------
// Collect a list of all observers, telescopes and sites mentioned in global observations.
//
sub AddToList(s as string, list() as string)
dim i as integer, found as boolean
if Len(s) = 0 then
exit
end if
found = false
for i = 0 to Ubound(list)
if list(i) = s then
found = true
exit
end if
next
if NOT found then
list.Append(s)
end if
end sub
sub CollectResources(observerList() as string, scopeList() as string, siteList() as string)
dim i as integer
dim obs as APObservation
dim session as APSession
for i = 1 to APObservation.Count
obs = APObservation.Observation(i)
AddToList(obs.Telescope(1), scopeList)
next
for i = 1 to APSession.Count
session = APSession.Session(i)
AddToList(session.Observer, observerList)
AddToList(session.Site, siteList)
next
end sub
//----------------------------------------------------------------------------------------------
// Sort "M8" before "M71", not after it (ie: a string compare won't quite do).
//
function CompareIDs(id1 as string, id2 as string) as integer
dim i, cmp as integer
i = 1
while i <= len(id1) AND i <= len(id2)
// If we've gotten to numbers, proceed with numeric compare
dim c1, c2 as string
dim v1, v2 as double
c1 = mid(id1, i, 1)
c2 = mid(id2, i, 1)
if IsNumeric(c1) AND IsNumeric(c2) then
dim j1 as integer
j1 = i + 1
while j1 <= len(id1) AND IsNumeric(mid(id1, j1, 1))
j1 = j1 + 1
wend
dim j2 as integer
j2 = i + 1
while j2 <= len(id2) AND IsNumeric(mid(id2, j2, 1))
j2 = j2 + 1
wend
v1 = val(mid(id1, i))
v2 = val(mid(id2, i))
if v1 < v2 then
return -1
elseif v1 > v2 then
return 1
else // Numbers equal, continue compare after them
if j1 <= len(id1) AND j2 <= len(id2) then
return CompareIDs(mid(id1, j1), mid(id2, j2))
else
return 0
end if
end if
end if
// Continue with single-character string compares
cmp = strcomp(c1, c2, 0)
if cmp < 0 then
return -1
elseif cmp > 0 then
return 1
else
i = i + 1
end if
wend
if len(id1) < len(id2) then
return -1
elseif len(id1) > len(id2) then
return 1
else
return 0
end if
end function
//----------------------------------------------------------------------------------------------
// My first REALBasic class. And dang, am I proud of it.
//
class target
dim ID as string
dim obs(-1) as integer
end class
//----------------------------------------------------------------------------------------------
// Short form constants and table routines.
//
const ID_width = 16.0
const Obs_width = 84.0
function NewShortFormTable() as Table
dim t as table
t = new Table(1, 2)
t.ColumnTitle(1) = "ID"
t.ColumnTitle(2) = "Observations"
t.ColumnWidth(1) = ID_width
return t
end function
//----------------------------------------------------------------------------------------------
// Long form table routines.
//
function ConstructObservationTable() as Table
dim t as Table
t = new Table(3, 1)
dim row as integer
for row = 1 to t.RowCount
t.RowHeight(row) = 100.0
next
return t
end function
function PopulateObservationTable(t as Table, session as APSession, obs as APObservation, _
doRound as boolean, c as Canvas, cellmargin as integer) as integer
t.Cell(1, 1) = FormatDateTime(obs.LocalDateTime) + ", " + session.Site + "; " _
+ FormatConditions(session.Seeing, session.Transparency)
t.Cell(2, 1) = FormatEquipment(obs.Telescope(1), obs.Eyepiece(1), obs.Filter(1), obs.VisualAid(1)) + "; " _
+ GetMagnification(obs.Telescope(1), obs.Eyepiece(1), obs.VisualAid(1), doRound)
dim paras() as string
dim i, nLines, colWidth as integer
colWidth = c.Width - cellmargin
nLines = 0
paras = Split(obs.Notes, Chr(13))
for i = 0 to Ubound(paras)
nLines = nLines + Round((c.TextWidth(paras(i)) * 1.05 / colWidth) + 0.5)
next
t.RowHeight(3) = 20.0 + (nLines * 80.0)
t.Cell(3, 1) = LTrim(obs.Notes)
return nLines - 1
end function
//----------------------------------------------------------------------------------------------
// Main script.
//
sub main()
try // Be a good citizen
dim observerList(-1), scopeList(-1), siteList(-1) as string
CollectResources(observerList, scopeList, siteList)
//
// Throw up a dialog to see if user wants to limit to specific telescopes/sites.
//
const observerCheckbox = "For Specific Observer:"
const observerPopup = ".0"
const telescopeCheckbox = "For Specific Telescope:"
const telescopePopup = ".1"
const siteCheckbox = "At Specific Site:"
const sitePopup = ".2"
const longFormCheckbox = "Include Observation Details"
const pageBreaksCheckbox = "Start Objects at Top of Page"
const roundMagsCheckbox = "Round Magnifications"
const imagesCheckbox = "Include User Images:"
const imagesPerLinePopup = ".3"
const printCheckbox = "Print Report"
dim imagesPerLine(4) as string
imagesPerLine(0) = "2 Images Per Line"
imagesPerLine(1) = "3 Images Per Line"
imagesPerLine(2) = "4 Images Per Line"
imagesPerLine(3) = "5 Images Per Line"
imagesPerLine(4) = "6 Images Per Line"
dim forObserver, forScope, forSite as string
dim doPrint, doLong, doBreaks, doRound, doImages as boolean
dim imagewidth as double
dim dlg as Dialog
dlg = new Dialog
dlg.BooleanParameter(observerCheckbox, Ubound(observerList) >= 0)
dlg.PopupParameter(true, observerPopup, 0, observerList)
dlg.ParameterDependency(observerPopup, observerCheckbox)
dlg.BooleanParameter(telescopeCheckbox, Ubound(scopeList) >= 0)
dlg.PopupParameter(true, telescopePopup, CurrentTelescopeIndex(scopeList), scopeList)
dlg.ParameterDependency(telescopePopup, telescopeCheckbox)
dlg.BooleanParameter(siteCheckbox, Ubound(siteList) >= 0)
dlg.PopupParameter(true, sitePopup, CurrentSiteIndex(siteList), siteList)
dlg.ParameterDependency(sitePopup, siteCheckbox)
dlg.CaptionParameter("If options are not checked, report will include all observers, telescopes and/or sites.", _
3, true, false, false, false, true)
dlg.BooleanParameter(longFormCheckbox, true)
dlg.BooleanParameter(pageBreaksCheckbox, false)
dlg.BooleanParameter(true, roundMagsCheckbox, true)
dlg.BooleanParameter(imagesCheckbox, true)
dlg.PopupParameter(true, imagesPerLinePopup, 0, imagesPerLine)
dlg.ParameterDependency(pageBreaksCheckbox, longFormCheckbox)
dlg.ParameterDependency(roundMagsCheckbox, longFormCheckbox)
dlg.ParameterDependency(imagesCheckbox, longFormCheckbox)
dlg.ParameterDependency(imagesPerLinePopup, imagesCheckbox)
dlg.CaptionParameter("", 1, true, false, false, false, true) // spacer
dlg.BooleanParameter(printCheckbox, true)
if NOT dlg.Show("Observing Report") then
return
end if
if dlg.BooleanParameter(observerCheckbox) then
forObserver = dlg.PopupParameterAsString(observerPopup)
else
forObserver = "All Observers"
end if
if dlg.BooleanParameter(telescopeCheckbox) then
forScope = dlg.PopupParameterAsString(telescopePopup)
else
forScope = "All Telescopes"
end if
if dlg.BooleanParameter(siteCheckbox) then
forSite = dlg.PopupParameterAsString(sitePopup)
else
forSite = "All Sites"
end if
doLong = dlg.BooleanParameter(longFormCheckbox)
doBreaks = dlg.BooleanParameter(pageBreaksCheckbox)
doRound = dlg.BooleanParameter(roundMagsCheckbox)
doImages = dlg.BooleanParameter(imagesCheckbox)
if doImages then
dim i as integer
i = dlg.PopupParameter(imagesPerLinePopup) + 2
imagewidth = (1 / i) * 100.0
end if
doPrint = dlg.BooleanParameter(printCheckbox)
//
// Go through all global observations which match the criteria, building a sorted list of
// unique targets.
//
dim i, j as integer, session as APSession, obs as APObservation
dim targets(-1) as target, nTargets as integer
nTargets = 0
// Our sort is actually n log n, but we report progress exponentailly so that it speeds
// up at the end.
Dialog.StartProgress("Collecting Observations...", true, APSession.Count * APSession.Count)
for i = 1 to APObservation.Count
if i MOD 100 = 0 AND Dialog.UpdateProgress(i * i) then
return
end if
obs = APObservation.Observation(i)
session = APSession.Session(obs)
if forObserver = "All Observers" OR forObserver = session.Observer then
if forSite = "All Sites" OR forSite = session.Site then
if forScope = "All Telescopes" OR forScope = obs.Telescope(1) then
dim upper, lower, middle, cmp as integer
dim found as boolean, t as target
found = false
lower = 0
upper = nTargets
while NOT found AND upper > lower
middle = (lower + upper) / 2
cmp = CompareIDs(obs.ID, targets(middle).ID)
if cmp < 0 then
upper = middle
elseif cmp > 0 then
lower = middle + 1
middle = middle + 1
else
found = true
targets(middle).obs.Append(i)
exit
end if
wend
if NOT found then
t = new target
t.ID = obs.ID
t.obs.Append(i)
targets.Insert(middle, t)
nTargets = nTargets + 1
end if
end if
end if
end if
next
Dialog.StopProgress()
//
// Open a new printer document (or display window)
//
dim reportTitle as string
reportTitle = "Observing Report for " + forObserver + " using " + forScope + " at " + forSite
dim c as Canvas
if doPrint then
c = new Canvas(true)
c.TextFont("Times", 10)
else
c = new Canvas(800, 1000, nil, "Observing Report")
c.TextFont("Times", 12)
end if
if c.Cancelled then
return
end if
dim cellmargin as integer
cellmargin = 0.33 * c.TextHeight
DoPageNumbering(c, reportTitle, doPrint)
if doLong then
//
// Long-form table (in three parts).
//
dim w, h, x, y, y1, theight, imw, margin as integer
dim tbl as Table, s as string, brk as boolean
tbl = ConstructObservationTable()
theight = 0
margin = 3 * c.TextHeight
y = margin
imw = floor(c.Width * imagewidth * 0.01)
dim t as target
for i = 0 to nTargets - 1
t = targets(i)
// Set up the canvas target so we can query images
dim haveImages as boolean
haveImages = false
if doImages then
obs = APObservation.Observation(t.obs(0))
if obs.Type = "Planet" OR obs.Type = "Comet" OR obs.Type = "Sun" then
dim planObj as APPlanObject
planObj = GetPlanObject(obs.ID)
if planObj <> nil then
c.Target(planObj)
haveImages = c.ImageCount > 0
end if
else
c.Target(obs.RA, obs.Dec)
haveImages = c.ImageCount > 0
end if
end if
// Our first test was a bit loose, taking DSS images into account
// as well. Tighten that up now:
if haveImages then
haveImages = false
for j = 1 to c.ImageCount
if c.IsUserImage(j) then
haveImages = true
break
end if
next
end if
for j = 0 to Ubound(t.obs)
obs = APObservation.Observation(t.obs(j))
session = APSession.Session(obs)
// Populate the observation table with values
dim extraLines, testHeight as integer
extraLines = PopulateObservationTable(tbl, session, obs, doRound, c, cellmargin)
testHeight = theight + (extraLines * c.textHeight)
brk = false
if j = 0 AND y > margin AND doBreaks then // new page per object
brk = true
end if
if j = Ubound(t.obs) AND haveImages then // add first row of images if last obs
testHeight = testHeight + imw + c.textHeight
end if
if y + testHeight > c.Height - margin then // fit test
brk = true
end if
if brk then
c.NewPage()
DoPageNumbering(c, reportTitle, doPrint)
y = margin
if j > 0 then
DoObjectName(c, y, obs, true)
y = y + 1.6 * c.TextHeight
end if
end if
if j = 0 then
// Display the object ID/Name, etc. before the first observation
DoObjectName(c, y, obs, false)
y = y + 1.6 * c.TextHeight
end if
// Display/print the table
if theight = 0 then
// Measure the height of the first table to be printed/displayed
y1 = c.DrawTable(tbl, 0, y, c.Width, c.Height, Canvas.grid_Thin)
theight = y1 - y
theight = theight - (extraLines * c.textHeight)
y = y1
else
y = c.DrawTable(tbl, 0, y, c.Width, c.Height, Canvas.grid_Thin)
end if
y = y + 0.5 * c.TextHeight
next
if haveImages then
// Draw user images
y = y + c.TextHeight
x = 0
for j = 1 to c.ImageCount
if c.IsUserImage(j) then
if x + imw > c.Width then
// New row required
x = 0
y = y + imw + margin
end if
if y + imw + margin > c.Height then
// New page required
c.NewPage()
DoPageNumbering(c, reportTitle, doPrint)
y = margin
DoObjectName(c, y, obs, true)
y = y + 2.6 * c.TextHeight
end if
c.DrawImage(j, x, y, imw, obs.Type <> "Planet")
x = x + imw
end if
next
if x > 0 then
y = y + imw + margin
end if
else
y = y + c.TextHeight
end if
next
else
//
// Short-form table.
//
dim lineHeight, header, footer, colWidth as integer
lineHeight = c.TextHeight + cellmargin
header = 1.5 * lineHeight
if doPrint then
footer = 1.5 * lineHeight
else
footer = 0
end if
colWidth = (c.Width * (Obs_width / 100)) - cellmargin
dim linesPerPage, linesOnPage as integer
linesPerPage = (c.Height - (header + footer)) / lineHeight
linesOnPage = 1
dim tbl as Table, y as integer
tbl = NewShortFormTable()
tbl.RowStyle(0) = Table.style_Bold + Table.style_Inverted + Table.style_Gray
dim t as target, dates as string
for i = 0 to nTargets - 1
t = targets(i)
dates = ""
for j = 0 to Ubound(t.obs)
if j > 0 then dates = dates + ", "
obs = APObservation.Observation(t.obs(j))
dates = dates + FormatDateTime(obs.LocalDateTime)
next
dim nLines as integer
nLines = Round((c.TextWidth(dates) * 1.05 / colWidth) + 0.5)
linesOnPage = linesOnPage + nLines
if linesOnPage > linesPerPage then
// Create a new page
y = c.DrawTable(tbl, 0, header, c.Width, c.Height, Canvas.grid_Thin)
tbl.Close()
c.NewPage()
DoPageNumbering(c, reportTitle, doPrint)
linesOnPage = 1 + nLines
tbl = NewShortFormTable()
tbl.RowStyle(0) = Table.style_Bold + Table.style_Inverted + Table.style_Gray
end if
if linesOnPage > 1 + nLines then
tbl.AddRow()
end if
tbl.RowHeight(tbl.RowCount()) = (nLines * 80.0) + 20.0
tbl.Cell(tbl.RowCount(), 1) = t.ID
tbl.Cell(tbl.RowCount(), 2) = dates
next
y = c.DrawTable(tbl, 0, header, c.Width, c.Height, Canvas.grid_Thin)
tbl.Close()
end if
c.Close()
catch
print "My bad. Observing Report script generated an exception."
end try
end sub
More information about the APBeta
mailing list