APSF
//----------------------------------------------------------------------------------------------
sub PageNumbering(c as Canvas, title as string, doPrint as boolean)
   // Handle page numbering
   dim date, page as string, x as integer
  
   c.TextItalic = true
   c.ForeColor(64, 64, 64)
   
   date = DoubleToDate(CurrentDate) + "  " + DoubleToTime(CurrentDate)
   page = "Page " + str(c.PageNumber)
   
   if doPrint then
      c.DrawText(title, 0, c.TextHeight)
      c.DrawText(date, c.Width - c.TextWidth(date), c.TextHeight)
      c.DrawText(page, c.Width - c.TextWidth(page), c.Height)
   else
      c.DrawText(date, 0, c.TextHeight)
      c.DrawText(title, c.TextWidth(date) + 20, c.TextHeight)
      c.DrawText(page, c.Width - c.TextWidth(page), c.TextHeight)
   end

   c.TextItalic = false   
   c.ForeColor(0, 0, 0)
end sub


//----------------------------------------------------------------------------------------------
// Support function which calculates magnification, does the rounding, and formats for the
// best sorting performance.
//
function GetMagnification(telName as string, eyeName as string, aidName as string, _
                          doRound as boolean) as string
   dim mag as double
   mag = Magnification(Telescope(telName), Eyepiece(eyeName), VisualAid(aidName))
   
   if doRound 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
   
   return str(mag)
end function


//----------------------------------------------------------------------------------------------
// A couple of routines to weed out blank statements.
//
function GetFilter(filterName as string) as string
   if filterName = "No Filter" then
      return ""
   else
      return filterName
   end if
end function

function GetAid(aidName as string) as string
   if aidName = "No Observing Aids" then
      return ""
   else
      return aidName
   end if
end function


//----------------------------------------------------------------------------------------------
// A couple of routines to convert names to indicies.
//
function CurrentTelescopeIndex(scopes() as string) as integer
   dim current as TelescopeResource
   current = CurrentTelescope
   if current = nil then
      current = DefaultTelescope
   end if
   if current = nil then
      return 1
   end if
   
   dim i as integer
   for i = 0 to Ubound(scopes)
      if scopes(i) = current.Name then
         return i
      end if
   next
   
   return 1
end function

function CurrentSiteIndex(sites() as string) as integer
   dim current as SiteResource
   current = CurrentSite
   if current = nil then
      current = DefaultSite
   end if
   if current = nil then
      return 1
   end if
   
   dim i as integer
   for i = 0 to Ubound(sites)
      if sites(i) = current.Name then
         return i
      end if
   next
   
   return 1
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

   StartProgress("Collecting Resources...", true, nGlobalObservations)
   for i = 1 to nGlobalObservations
      if i MOD 10 = 0 AND UpdateProgress(i) then
         exit
      end if

      obs = GlobalObservation(i)
      AddToList(obs.Observer, observerList)
      AddToList(obs.Telescope, scopeList)
      AddToList(obs.Site, siteList)
   next
   
   StopProgress()
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(n as integer) as Table
  dim t as Table, row, col as integer
  
  select case n
  case 0
    t = new Table(4, 6)
    t.RowStyle(1) = style_Gray + style_Inverted + style_Bold
    t.RowStyle(3) = style_Gray + style_Inverted + style_Bold
    t.Cell(1, 1) = "Date"
    t.Cell(1, 2) = "Time"
    t.Cell(1, 3) = "Julian"
    t.Cell(1, 4) = "Site"
    t.Cell(1, 5) = "Telescope"
    t.Cell(1, 6) = "Eyepiece"
        
    t.Cell(3, 1) = "Rating"
    t.Cell(3, 2) = ""
    t.Cell(3, 3) = ""
    t.Cell(3, 4) = "Magnification"
    t.Cell(3, 5) = "Filter"
    t.Cell(3, 6) = "Obs Aid"
  case 1
    t = new Table(2, 2)
    t.RowStyle(1) = style_Gray + style_Inverted + style_Bold
    t.RowHeight(2) = 100.0
    t.Cell(1, 1) = "Seeing"
    t.Cell(1, 2) = "Transparency"
  case 2
    t = new Table(2,1)
    t.RowStyle(1) = style_Gray + style_Inverted + style_Bold
    t.Cell(1, 1) = "Notes"
  end select
  
  for row = 1 to t.RowCount
    t.RowHeight(row) = 100.0
  next
 
  return t
end function


function PopulateObservationTable(n as integer, t as Table, obs as APGlobalObservation, _
                                  doRound as boolean, c as Canvas, cellmargin as integer) as integer
  select case n
  case 0
    t.Cell(2, 1) = obs.Date
    t.Cell(2, 2) = obs.Time
    t.Cell(2, 3) = format(obs.Julian,"0.0000")
    t.Cell(2, 4) = obs.Site
    t.Cell(2, 5) = obs.Telescope
    t.Cell(2, 6) = obs.Eyepiece
  
    t.Cell(4, 1) = str(obs.Rating)
    t.Cell(3, 2) = obs.User1Title
    t.Cell(4, 2) = obs.User1
    t.Cell(3, 3) = obs.User2Title
    t.Cell(4, 3) = obs.User2
    t.Cell(4, 4) = GetMagnification(obs.Telescope, obs.Eyepiece, obs.Aid, doRound)
    t.Cell(4, 5) = obs.Filter
    t.Cell(4, 6) = obs.Aid
    return 0
  case 1
    t.Cell(2, 1) = obs.Seeing
    t.Cell(2, 2) = obs.Transparency
    return 0
  case 2
    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(2) = 20.0 + (nLines * 80.0)
    
    t.Cell(2, 1) = LTrim(obs.Notes)
    return nLines - 1
  end select
end function


//----------------------------------------------------------------------------------------------
// Main script.
//

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

   SetBooleanParameter(observerCheckbox, Ubound(observerList) >= 0)
   SetPopupParameter(true, observerPopup, 0, observerList)
   ParameterDependency(observerPopup, observerCheckbox)
   
   SetBooleanParameter(telescopeCheckbox, Ubound(scopeList) >= 0)
   SetPopupParameter(true, telescopePopup, CurrentTelescopeIndex(scopeList), scopeList)
   ParameterDependency(telescopePopup, telescopeCheckbox)

   SetBooleanParameter(siteCheckbox, Ubound(siteList) >= 0)
   SetPopupParameter(true, sitePopup, CurrentSiteIndex(siteList), siteList)
   ParameterDependency(sitePopup, siteCheckbox)

   SetCaptionParameter("If options are not checked, report will include all observers, telescopes and/or sites.", _
                       3, true, false, false, false, true)
   
   SetBooleanParameter(longFormCheckbox, false)
   SetBooleanParameter(pageBreaksCheckbox, false)
   SetBooleanParameter(true, roundMagsCheckbox, true)
   SetBooleanParameter(imagesCheckbox, false)
   SetPopupParameter(true, imagesPerLinePopup, 0, imagesPerLine)
   ParameterDependency(pageBreaksCheckbox, longFormCheckbox)
   ParameterDependency(roundMagsCheckbox, longFormCheckbox)
   ParameterDependency(imagesCheckbox, longFormCheckbox)
   ParameterDependency(imagesPerLinePopup, imagesCheckbox)
   
   SetCaptionParameter("", 1, true, false, false, false, true)    // spacer
   
   SetBooleanParameter(printCheckbox, false)

   if NOT EditParameters("Observing Report") then
      exit
   end if
   if GetBooleanParameter(observerCheckbox) then
      forObserver = GetPopupParameterAsString(observerPopup)
   else
      forObserver = "All Observers"
   end if
   if GetBooleanParameter(telescopeCheckbox) then
      forScope = GetPopupParameterAsString(telescopePopup)
   else
      forScope = "All Telescopes"
   end if
   if GetBooleanParameter(siteCheckbox) then
      forSite = GetPopupParameterAsString(sitePopup)
   else
      forSite = "All Sites"
   end if
   doLong = GetBooleanParameter(longFormCheckbox)
   doBreaks = GetBooleanParameter(pageBreaksCheckbox)
   doRound = GetBooleanParameter(roundMagsCheckbox)
   doImages = GetBooleanParameter(imagesCheckbox)
   if doImages then
      dim i as integer
      i = GetPopupParameter(imagesPerLinePopup) + 2
      imagewidth = (1 / i) * 100.0
   end if
   doPrint = GetBooleanParameter(printCheckbox)


   //
   // Go through all global observations which match the criteria, building a sorted list of
   // unique targets.
   //

   dim i, k as integer, obs as APGlobalObservation
   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.
   StartProgress("Collecting Observations...", true, nGlobalObservations * nGlobalObservations)

   for i = 1 to nGlobalObservations
      if i MOD 10 = 0 AND UpdateProgress(i * i) then
         exit
      end if

      obs = GlobalObservation(i)
      
      if forObserver = "All Observers" OR forObserver = obs.observer then
         if forScope = "All Telescopes" OR forScope = obs.telescope then
            if forSite = "All Sites" OR forSite = obs.site 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
   
   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, 800, "Observing Report")
      c.TextFont("Times", 12)
   end if
   if c.Cancelled then
      exit
   end if
   dim cellmargin as integer
   cellmargin = 0.33 * c.TextHeight
   
   PageNumbering(c, reportTitle, doPrint)
   
   if doLong then
      //
      // Long-form table (in three parts).
      //
      dim i, j, k, w, h, x, y, y1, theight, imw as integer
      dim tables(2) as Table, s as string, break as boolean

      for k = 0 to 2
         tables(k) = ConstructObservationTable(k)
      next
      theight = 0
      y = 2 * c.TextHeight
      imw = floor(c.Width * imagewidth * 0.01)
    
      dim t as target, gobs as APGlobalObservation 
      for i = 0 to nTargets - 1
         t = targets(i)

         for j = 0 to Ubound(t.obs)
            gobs = GlobalObservation(t.obs(j))
            
            // Populate the observation table with values
            dim extraLines, extraHeight as integer
            extraLines = 0
            for k = 0 to 2
               extraLines = extraLines + PopulateObservationTable(k, tables(k), gobs, doRound, c, cellmargin)
            next
            extraHeight = extraLines * c.textHeight

            // New page?
            break = (j = 0 AND y > 2 * c.TextHeight AND doBreaks)
            if break OR theight + extraHeight > (c.Height - c.TextHeight) - y then
               c.NewPage()
               PageNumbering(c, reportTitle, doPrint)
               y = 2 * c.TextHeight
            end if
            
            if j = 0 then
               // Display the object ID/Name, etc. before the first observation
               s = gobs.ID + "   " + gobs.Name
               c.TextBold = true
               c.DrawText s, 0, y + c.TextHeight
               s = "RA: " + FormatRA(gobs.RA) + "  Dec: " + FormatDec(gobs.Dec)
               c.DrawText s, c.Width - c.TextWidth(s), y + c.TextHeight
               c.TextBold = 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 = y
               for k = 0 to 2
                  y1 = c.DrawTable(tables(k), 0, y1, c.Width, c.Height, grid_Thin)
               next
               theight = y1 - y
               theight = theight - (extraLines * c.textHeight)
               y = y1
            else
               for k = 0 to 2
                  y = c.DrawTable(tables(k), 0, y, c.Width, c.Height, grid_Thin)
               next
            end if
            y = y + 0.5 * c.TextHeight
         next

         if doImages then
            // Draw user images, if available
            y = y + c.TextHeight
            x = 0
            gobs = GlobalObservation(t.obs(0))
            c.Target(gobs.RA, gobs.Dec)
            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
                  end if
                  
                  if y + imw > c.Height then
                     // New page required
                     c.NewPage()
                     PageNumbering(c, reportTitle, doPrint)
                     y = 2 * c.TextHeight
                  end if
                  c.DrawImage(j, x, y, imw)
                  x = x + imw
               end if
            next
            if x > 0 then
               y = y + imw + 2 * c.TextHeight
            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) = style_Bold + style_Inverted + style_Gray
      
      dim t as target, dates as string   
      for i = 0 to nTargets - 1
         t = targets(i)
         dates = ""      
         for k = 0 to Ubound(t.obs)
            if k > 0 then dates = dates + ", "
         
            dim gobs as APGlobalObservation
            gobs = GlobalObservation(t.obs(k))
            dates = dates + gobs.Time + " " + gobs.Date
         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, grid_Thin)
            tbl.Close()
         
            c.NewPage()
            PageNumbering(c, reportTitle, doPrint)
            linesOnPage = 1 + nLines
            tbl = NewShortFormTable()
            tbl.RowStyle(0) = style_Bold + style_Inverted + 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, grid_Thin)
      tbl.Close()
   end if
   
   c.Close()

catch
   print "My bad.  Observing Report script generated an exception."
end try