/*
   FWCalendar.rexx Macro
   Creates calendars on FinalWriter v 4.x (SoftWood) & PageStream v 3.x
   $VER: FWCalendar.rexx v4.00c (21 Jun 2000)
   ©Ron Goertz (goertz@earthlink.net)
*/
options results
signal on syntax

call AddLibraries
bguiopen = bguiopen()
if ErrorCount > 0 then call Cleanup

address value DetermineHost()
call GetSetupInfo
call SetVariables

/*************************/
/***//* Yearly Calendar  */
/*************************/
if CalType == 2 then do
  EventCount = 389
  if App == 'FW' then VIEW 20
  else if App == 'PGS' then do
    if DoHide == 1 then HIDEWINDOW
    else DISPLAY SCALE 25
    REFRESH OFF
  end

  Gen$ = GeneratingY$
  Do i = 1 to words(GenYVars)
    InsertPos = pos('%s', Gen$)
    if InsertPos == 0 then leave
    Gen$ = left(Gen$, InsertPos - 1)''value(word(GenYVars, i))''substr(Gen$, InsertPos + 2)
  end
  Req = OpenBusy(Gen$'...', EventCount)

  call MiniCalPreCalc(FYMiniCal, MiniCalWidth)

  Year = EnteredYear
  CalTop = Margin.Top
  do r = 0 to 3
    Margin.Top = CalTop + r * (7*Height.FYMiniCal + MiniCalSpacing)
    do c = 0 to 2
      Month = r * 3 + c + 1
      Mn = right(Month, 2, '0')
      TempDate = Year''Mn'01'
      if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
      interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
      call DrawMiniCal(0, MiniCalWidth, FYMiniCal)
    end
  end

  if DoCopyright == 1 then call RightText(PrintText(0, CalTop + 28 * Height.FYMiniCal + 3 * MiniCalSpacing, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)

  call Cleanup
end
/**/

/*************************/
/***//* Monthly Calendar */
/*************************/
Year = EnteredYear

PrevMonth = Month - 1
if PrevMonth = 0 then do
  PrevMonth = 12
  PrevYear = Year - 1
end
else PrevYear = Year

NextMonth = Month + 1
if NextMonth = 13 then do
  NextMonth = 1
  NextYear = Year + 1
end
else NextYear = Year

if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
  StartDST = DateInfo('I', Year'04'right(CalculateDate( 4, 'Monday', 7,  ''), 2, '0'), 'S') /* First Sunday in April */
  EndDST   = DateInfo('I', Year'10'CalculateDate(10, 'Friday', 31, ''), 'S') /* Last Sunday in October */
end

if DoPhases ~= 0 then CountPhases = 1
if DoJulian ~= 0 then CountJulian = 1
if DoJulianLeft ~= 0 then CountJulianLeft = 1
if DoSunRise ~= 0 then CountSunRise = 1
if DoSunSet ~= 0 then CountSunSet = 1
EventCount = 40 +,
             (MonthLength.Month + 5) * (1 + CountSunRise + CountSunSet + DoDateBox + CountJulian + CountJulianLeft) +,
             HighlightCount * (DoBackgrounds + DoHighlights) +,
             (DoExtended*2 + 8) * DoBackgrounds +,
             ImageCount * DoImages +,
             DoMiniCals * (MonthLength.NextMonth + MonthLength.PrevMonth + 4) +,
             CountPhases * 5

if App == 'FW' then VIEW 20
else if App == 'PGS' then do
  if DoHide == 1 then HIDEWINDOW
  else DISPLAY SCALE 25
end

Gen$ = GeneratingM$
Do i = 1 to words(GenMVars)
  InsertPos = pos('%s', Gen$)
  if InsertPos == 0 then leave
  Gen$ = left(Gen$, InsertPos - 1)''value(word(GenMVars, i))''substr(Gen$, InsertPos + 2)
end
Req = OpenBusy(Gen$'...', EventCount)

/************************/
/* Finally, the program */
/************************/
if App == 'PGS' then do
  if DoHide == 1 then REFRESH OFF
end

TempDate  = Year''Mn'01'
IDay      = DateInfo('I', TempDate, 'S') - 1
interpret 'StartYear = Day.'DateInfo('W', Year'0101', 'S')

YearOffset = 7 - StartYear
if YearOffset == 7 then YearOffset = 0

if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then do
  LeapYear = 1
  MonthLength.2 = 29
end
else LeapYear = 0

if (PrevYear//4 == 0 & PrevYear//100 > 0) | PrevYear//400 == 0 Then PrevLeapYear = 1
else PrevLeapYear = 0

interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
if (DoHighlights == 1) | (DoImages == 1) then call SetHighLights
if DoPhases ~= 0 then call GetPhases(Year, Month)

/* In PGS, no other objects should be drawn overlapping 0,0 */
PrefsString = 'FWC'TempDate''PrefsFile
if (length(PrefsString) > 31) & (App == 'FW') then do
  StringCount = trunc(length(PrefsString) / 25)
  NextString = 0
  do i = StringCount to 0 by -1
    PrintString = substr(PrefsString, (i * 25) + 1, 25)
    if NextString ~= 0 then PrintString = PrintString'|'NextString'|'
    NextString = PrintText(0, 0, 4pt, 'N', White$, 100, PrintString)
  end
end
else call PrintText(0, 0, 4pt, 'N', White$, 100, PrefsString)

/***//* Draw dates and optional highlights */
Day             = - StartDate
GridLineTop.    = CalTop
GridLineBottom. = CalTop + BoxHeight*5
GridLineLeft.   = Margin.Left
GridLineRight.  = CalRight
GridLineRight.6 = 0
BackBox.        = 0

Width.WidthOfDate1 = GetFontWidth(Date, 'N', '1')
Width.WidthOfDate8 = GetFontWidth(Date, 'N', '8')

Do CRow = 0 to 5
  if (CRow = 5) & (DoTopExtraWk ~= 1) then do
    CurrentRow = CRow
    BoxTop = CalTop + BoxHeight*4.5
    BHeight = BoxHeight/2
  end
  else if (CRow = 5) & (DoTopExtraWk == 1) then do
    CurrentRow = 0
    BoxTop = CalTop
    BHeight = BoxHeight
  end
  else do
    CurrentRow = CRow
    BoxTop  = CalTop + BoxHeight*CurrentRow
    BHeight = BoxHeight
  end
                 
  Do CurrentColumn = 0 to 6
    Day = Day + 1
    JulianDay = IDay + Day
    BoxLeft = Margin.Left + BoxWidth * CurrentColumn

    /* Days for previous & next months */
    If ((Day < 1) | (Day > MonthLength.Month)) then do

      /* Previous month */
      if Day < 1 then do
        PrintDay = MonthLength.PrevMonth + Day
        GridLineTop.CurrentColumn = CalTop + BoxHeight
        GridLineLeft.0 = Margin.Left + BoxWidth * (CurrentColumn + 1)
      end

      /* Next month */
      else do
        PrintDay = Day - MonthLength.Month
        interpret 'GridLineBottom.'CurrentColumn+1' = 'CalTop + BoxHeight*4
        CalRow = CurrentRow + 1
        if GridLineRight.CalRow == CalRight then GridLineRight.CalRow = Margin.Left + BoxWidth * CurrentColumn
      end

      if DoExtended then do
        if (CurrentColumn = Day.Sunday | CurrentColumn = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then do
          BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
          call UpdateBusy(Req, 1)
        end

        DayType = 'Extended'
        if BackBox.JulianDay ~= 0 then TextColor = AltColor.Extended
        else TextColor = Color.Extended
        DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, PrintDay)
        call UpdateBusy(Req, 1)
        if DoDateBox == 1 then do
          if BackBox.JulianDay ~= 0 then BoxColor = AltColor.Extended
          else BoxColor = Color.Extended
          call BoxDate(DayID, BoxColor)
          call UpdateBusy(Req, 1)
        end
        call DoOptions
      end
    end

    /* Days for current month */
    else do
      if CurrentRow = 5 then do
        PrevJulianDay = JulianDay - 7
        call DrawLine(BoxLeft, BoxTop, BoxLeft + BoxWidth, BoxTop, 'HL', Line.Grid)
        if BackBox.PrevJulianDay ~= 0 then call HalveBox(BackBox.PrevJulianDay)
        call UpdateBusy(Req, 1)
      end

      if CRow ~= CurrentRow then do
        GridLineTop.CurrentColumn = CalTop
        interpret 'GridLineTop.'CurrentColumn+1' = 'CalTop
        GridLineRight.6 = Margin.Left + BoxWidth * (CurrentColumn + 1)
      end

      if (CurrentColumn = Day.Sunday | CurrentColumn = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then BackBox.JulianDay = -1

      /* Print Highlight */
      if Highlight.Month.Day ~= '' & DoHighlights == 1 then do
        if TopOption ~= 0 then Highlight.Month.Day = '//'Highlight.Month.Day
        DailyHLCount = 0
        SearchPos    = 1
        Found        = 1
        do until Found == 0
          Found = pos('//', Highlight.Month.Day, SearchPos)
          if Found > 0 then do
            HighlightText = substr(Highlight.Month.Day, SearchPos, Found - SearchPos)
            SearchPos = Found + 2
          end
          else HighlightText = substr(Highlight.Month.Day, SearchPos)

          /* Draw background colors for highlight days */
          if DoBackgrounds == 1 then do
            if right(HighlightText, 1) == '#' then do
              BoxColor = Background.HighlightH
              if (BoxColor ~= White$) then TextColor = AltColor.HighlightH
              else TextColor = Color.HighlightH
            end
            else do
              BoxColor = Background.Highlight
              if (BoxColor ~= White$) then TextColor = AltColor.Highlight
              else TextColor = Color.Highlight
            end
            if (BackBox.JulianDay < 1 ) & (BoxColor ~= White$) then do
              BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, BoxColor, 1)
              call UpdateBusy(Req, 1)
            end
          end
          else do
            if right(HighlightText, 1) == '#' then TextColor = Color.HighlightH
            else TextColor = Color.Highlight
          end

          Select
            when Day < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
            when Day < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
            otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
          end

          call PrintHighlight(compress(HighlightText, '#'))
          call UpdateBusy(Req, 1)

          DailyHLCount = DailyHLCount + 1
        end
      end
      else do
        if DoDailyColors == 1 then do
          Select
            when CurrentColumn == Day.Sunday then TextColor = Color.Sunday
            when CurrentColumn == Day.Monday then TextColor = Color.Monday
            when CurrentColumn == Day.Tuesday then TextColor = Color.Tuesday
            when CurrentColumn == Day.Wednesday then TextColor = Color.Wednesday
            when CurrentColumn == Day.Thursday then TextColor = Color.Thursday
            when CurrentColumn == Day.Friday then TextColor = Color.Friday
            when CurrentColumn == Day.Saturday then TextColor = Color.Saturday
          end
        end
        else if BackBox.JulianDay ~= 0 then TextColor = AltColor.Date
        else TextColor = Color.Date
      end

      if DoMatchColors ~= 1 then do
        if DoDailyColors == 1 then do
          Select
            when CurrentColumn == Day.Sunday then TextColor = Color.Sunday
            when CurrentColumn == Day.Monday then TextColor = Color.Monday
            when CurrentColumn == Day.Tuesday then TextColor = Color.Tuesday
            when CurrentColumn == Day.Wednesday then TextColor = Color.Wednesday
            when CurrentColumn == Day.Thursday then TextColor = Color.Thursday
            when CurrentColumn == Day.Friday then TextColor = Color.Friday
            when CurrentColumn == Day.Saturday then TextColor = Color.Saturday
          end
        end
        else if BackBox.JulianDay ~= 0 then TextColor = AltColor.Date
        else TextColor = Color.Date
      end

      /* Print Day */
      DayType = 'Normal'
      DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, Day)
      call UpdateBusy(Req, 1)
      if DoDateBox == 1 then do
        call BoxDate(DayID, TextColor)
        call UpdateBusy(Req, 1)
      end
      call DoOptions
      if BackBox.JulianDay == -1 then do
        BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
        call UpdateBusy(Req, 1)
      end
    end

    if (CRow == 5) & (Day == MonthLength.Month) then leave CRow
  end
  if Day >= MonthLength.Month then leave
end
/**/

/***//* Draw grids */
LowRow = CRow
if LowRow = 3 then GridLineBottom. = CalTop + BoxHeight*4

/* Draw note box */
if DoNoteBox then do
  PrevTop = CalTop
  PrevBottom = GridLineBottom.
  do i = 0 to 7
    if GridLineTop.i > PrevTop then TopNoteLeft = max(i - 1, 0)
    if GridLineTop.i < PrevTop then TopNoteRight = i
    PrevTop = GridLineTop.i
  end
  do i = 0 to 7
    if GridLineBottom.i < PrevBottom then BottomNoteLeft = max(i - 1, 0)
    if GridLineBottom.i > PrevBottom then BottomNoteRight = i
    PrevBottom = GridLineBottom.i
  end

  if (symbol('TopNoteLeft') == 'LIT') & (symbol('TopNoteRight') == 'LIT') then do
    TopNoteleft = 0
    TopNoteRight = 0
  end

  if (symbol('BottomNoteLeft') == 'LIT') & (symbol('BottomNoteRight') == 'LIT') then do
    BottomNoteleft = 0
    BottomNoteRight = 0
  end
  if (symbol('BottomNoteLeft') == 'VAR') & (symbol('BottomNoteRight') == 'LIT') then BottomNoteRight = 7

  if TopNoteRight ~= TopNoteLeft then do
    LeftEdge = Margin.Left + BoxWidth*TopNoteLeft
    RightEdge = Margin.Left + BoxWidth*TopNoteRight
    call DrawLine(LeftEdge, CalTop, RightEdge, CalTop, 'HL', Line.NoteBox)
    if TopNoteLeft == 0 then call DrawLine(Margin.Left, CalTop, Margin.Left, GridLineTop.0, 'HL', Line.NoteBox)
    call PrintText(LeftEdge + DateOffset, CalTop, Date, 'N', Color.NoteBox, Width.Date, Note$':')
  end

  if BottomNoteRight ~= BottomNoteLeft then do
    LeftEdge = Margin.Left + BoxWidth*BottomNoteLeft
    RightEdge = Margin.Left + BoxWidth*BottomNoteRight
    call DrawLine(LeftEdge, GridLineBottom.BottomNoteLeft, RightEdge, GridLineBottom.BottomNoteLeft, 'HL', Line.NoteBox)
    call DrawLine(RightEdge, GridLineBottom.BottomNoteLeft, RightEdge, GridLineBottom.BottomNoteRight, 'HL', Line.NoteBox)
    call PrintText(LeftEdge + DateOffset, GridLineBottom.BottomNoteRight, Date, 'N', Color.NoteBox, Width.Date, Note$':')
  end
end

/* Draw vertical grid */
do i = 0 to 7
  LeftEdge = Margin.Left + BoxWidth*i
  if DoExtended then do
    if GridLineTop.i > CalTop then do
      call DrawLine(LeftEdge, CalTop, LeftEdge, GridLineTop.i, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
    if GridLineBottom.i < GridLineBottom.8 then do
      call DrawLine(LeftEdge, GridLineBottom.i, LeftEdge, GridLineBottom.8, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
  end
  call DrawLine(LeftEdge, GridLineTop.i, LeftEdge, GridLineBottom.i, 'HL', Line.Grid)
  call UpdateBusy(Req, 1)
end
 
/* Draw horizontal grid */
do i = 0 to min(LowRow + 1, 5)
  TopEdge = CalTop + BoxHeight * i
  if DoExtended then do
    if GridLineLeft.i > Margin.Left then do
      call DrawLine(Margin.Left, TopEdge, GridLineLeft.i, TopEdge, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
    if GridLineRight.i < CalRight then do
      call DrawLine(GridLineRight.i, TopEdge, CalRight, TopEdge, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
  end
  call DrawLine(GridLineLeft.i, TopEdge, GridLineRight.i, TopEdge, 'HL', Line.Grid)
  call UpdateBusy(Req, 1)
end

if GridLineRight.6 ~= 0 then call DrawLine(Margin.Left, CalTop, GridLineRight.6, CalTop, 'HL', Line.Grid)
/**/

/***//* Draw headers & minicals */
/* Create month/year header */
Text.Top = Margin.Top + ((7*Height.MiniCal) - Height.Header)/HeaderLoc
MonthID = PrintText(Margin.Left, Text.Top , Header, 'N', Color.Header, Width.Header, Month.Month' 'Year)
call UpdateBusy(Req, 1)

/* Create weekday titles */
Text.Top = CalTop - (Height.Weekday * 1.15)
Do i = 0 to 6
  WeekdayID.i = PrintText(1, Text.Top, Weekday, 'N', Color.Weekday, Width.Weekday, Day.i)
  call UpdateBusy(Req, 1)
End

if App == 'FW' then REDRAW

/* Position month/year header */
call CenterText(MonthID, Margin.Left + PrintWidth/2, .9 * (PrintWidth - DoMiniCals * (2 * MiniCalWidth)), 0)
call UpdateBusy(Req, 1)

/* Position weekday titles */
MaxWidth = GetMaxWidth('WeekdayID', 6)
if MaxWidth == 0 then MaxWidth = BoxWidth

Do i = 0 to 6
  call CenterText(WeekdayID.i, Margin.Left + (i + .5) * BoxWidth, 0, .9 * min(1, BoxWidth/MaxWidth))
  call UpdateBusy(Req, 1)
end

if DoMiniCals = 1 then do
  call MiniCalPreCalc(MiniCal, MiniCalWidth)
  call DrawMiniCal(-1, MiniCalWidth, MiniCal)
  call DrawMiniCal(+1, MiniCalWidth, MiniCal)
end
/**/

if DoCopyright == 1 then call RightText(PrintText(0, Margin.Top + PrintHeight, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)
if App == 'FW' then SELECTOBJECT
else if App == 'PGS' then SELECTOBJECT NONE

call Cleanup
exit
/**/

/*********************************************/
/*              Subroutines                  */
/*********************************************/
/***//*******  AddLibraries (AL) Subroutine  ***********/
AddLibraries:
  PortList     = show('P')
  ErrorCount   = 0
  WarningCount = 0
  Req          = 0
  bguiopen     = 0

  Storage         = 'RAM:FWC/'
  Notice$         = 'notice'
  Critical$       = 'Critical error'
  See$            = 'see'
  SeeOutput$      = 'see the output above for details'
  ForDetails$     = 'for details'
  ForwardLog$     = 'Forward log file to'
  Unable$         = 'if you are unable to resolve the problem.'
  ForwardContent$ = 'Forward contents of output to'
  SeeShell$       = 'see the shell output for details'
  OK$             = '_OK'

  AL_Libs        = 'rexxsupport.library rexxbgui.library bgui.library'
  AL_MinVersions = ' 34.9                4.0             41.10       '
  AL_Offsets     = '-30                -30              -30          '
  do AL_i = 1 to words(AL_Libs)
    AL_Lib        = word(AL_Libs, AL_i)
    AL_MinVersion = word(AL_MinVersions, AL_i)
    AL_Offset     = word(AL_Offsets, AL_i)
    if exists('LIBS:'AL_Lib) then do
      AL_InstalledVersion = libver(AL_Lib)
      if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
        call AddMsg('E', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
      end
      else if pos('rexx', AL_Lib) > 0 then call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
    end
    else call AddMsg('E', AL_lib' is required but could not be found.')
  end

  AL_Libs        = 'rexxtricks.library date.library rexxmathlib.library'
  AL_MinVersions = '  0                33.310       38.1               '
  AL_Offsets     = '-30              -492          -30                 '
  AL_Variables   = 'RexxTricks         DateLib      RexxMathLib        '
  do AL_i = 1 to words(AL_Libs)
    AL_Lib        = word(AL_Libs, AL_i)
    AL_MinVersion = word(AL_MinVersions, AL_i)
    AL_Offset     = word(AL_Offsets, AL_i)
    AL_Variable   = word(AL_Variables, AL_i)
    if exists('LIBS:'AL_lib) then do
      AL_InstalledVersion = libver(AL_lib)
      if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == '') then do
        call AddMsg('W', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
        interpret Al_Variable' = 0'
      end
      else do
        call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
        interpret Al_Variable' = 1'
      end
    end
    else interpret Al_Variable' = 0'
  end
  if (DateLib == 1) | (RexxMathLib == 1) then PhaseLib = 1
  else PhaseLib = 0

  if ErrorCount > 0 then call Cleanup
  return
/**/

/***//*******  AddMsg (AM) Subroutine  ***********/
AddMsg:
  parse arg AM_MsgType, AM_Msg

  if AM_MsgType == 'E' then do
    if symbol('ErrorCount') == 'LIT' then ErrorCount = 0
    ErrorCount = ErrorCount + 1
    Error.ErrorCount = AM_Msg
  end
  else do
    if symbol('WarningCount') == 'LIT' then WarningCount = 0
    WarningCount = WarningCount + 1
    Warning.WarningCount = AM_Msg
  end

  return 0
/**/

/***//*******  AssignHighlight (AH) Subroutine  ***********/
AssignHighlight:
  parse arg AH_Month, AH_Day, AH_Event

  if upper(left(AH_Month, 9)) == 'HIGHLIGHT' then do
    AH_Event = strip(substr(AH_Month, pos('=', AH_Month) + 1))
    if right(AH_Event, 2) == '*/' then AH_Event = strip(left(AH_Event, lastpos('/*', AH_Event) - 1))
    AH_Event = substr(AH_Event, 2, Length(AH_Event) - 2)

    AH_DateString = DetermineDate1(AH_Month, AH_Day, AH_Event)
    AH_Month = word(AH_DateString, 1)
    AH_Day = word(AH_DateString, 2)
  end

  AH_DateString = DetermineDate2(AH_Month, AH_Day, Year)
  AH_Month = word(AH_DateString, 1)
  AH_Day = word(AH_DateString, 2)

  if Highlight.AH_Month.AH_Day == '' then Highlight.AH_Month.AH_Day = AH_Event
  else Highlight.AH_Month.AH_Day = Highlight.AH_Month.AH_Day'//'AH_Event
  HighlightCount = HighlightCount + 1

  do AH_i = 0 to ImageClass.Count - 1
    if pos(upper(ImageClass.AH_i), upper(AH_Event)) > 0 then do
      Image.AH_Month.AH_Day = AH_i
      ImageCount = ImageCount + 1
      leave
    end
  end

  return 0
/**/

/***//*******  AssignImage (AI) Subroutine  ***********/
AssignImage:
  parse arg AI_Month, AI_Day, AI_Image

  if DoImages ~= 1 then return 0
  if upper(left(AI_Month, 5)) == 'IMAGE' then do
    AI_Image = strip(substr(AI_Month, pos('=', AI_Month) + 1))
    if right(AI_Image, 2) == '*/' then AI_Image = strip(left(AI_Image, lastpos('/*', AI_Image) - 1))
    AI_Image = substr(AI_Image, 2, Length(AI_Image) - 2)

    AI_DateString = DetermineDate1(AI_Month, AI_Day, AI_Image)
    AI_Month = word(AI_DateString, 1)
    AI_Day = word(AI_DateString, 2)
  end

  AI_Image = strip(AI_Image, 'B', '" '||"'")
  parse var AI_Image AI_Image ',' AI_DX ',' AI_DY
  if (pos('/', AI_Image) == 0) & (pos(':', AI_Image) == 0) then AI_Image = ScriptDir'Images/'strip(AI_Image, 'B', ' "'||"'")
  AI_DX = strip(AI_DX);if AI_DX == '' then AI_DX = 0
  AI_DY = strip(AI_DY);if AI_DY == '' then AI_DY = 0
  AI_DateString = DetermineDate2(AI_Month, AI_Day, Year)
  AI_Month = word(AI_DateString, 1)
  AI_Day = word(AI_DateString, 2)

  if exists(AI_Image) then do
    ICCount = ImageClass.Count
    Image.AI_Month.AI_Day = ICCount
    ImageClass.ICCount = ''
    ImageFile.ICCount = AI_Image
    ImageDX.ICCount = AI_DX
    ImageDY.ICCount = AI_DY
    ImageClass.Count = ImageClass.Count + 1
  end
  return 0
/**/

/***//*******  BoxDate (BD) Subroutine  ***********/
BoxDate:
  parse arg BD_ID, BD_DateBoxColor

  BD_DateBoxWidth = (DateOffset + GetWidth(BD_ID)) * 1.1
  BD_DateBoxHeight = Height.Date

  call DrawBox(BoxLeft, BoxTop, BD_DateBoxWidth, BD_DateBoxHeight, 'HL', BD_DateBoxColor, 0, 0, 0)
  return
/**/

/***//*******  CalculateDate (CD) Subroutine  ***********/
CalculateDate:
/* Month    is the month in which the highlight occurs                        */
/* HighDate is the highest (numerical) date on which the highlight will occur */
/* HighDay  is the weekday on which the month starts when HighDate will occur */
/* Event    is the highlight text                                             */
  parse arg CD_Month, CD_HighDay, CD_HighDate, CD_Event

  if CD_Month = 13 then CD_Month = Mn - 0

  if datatype(CD_HighDate) == 'CHAR' then do
    CD_HighDate = upper(left(CD_HighDate, 1))
    interpret 'CD_EventOffset = Day.'CD_HighDay' - StartDate'

    CD_Day  = 1 + CD_EventOffset
    if CD_Day < 1 then CD_Day = CD_Day + 7

    do until CD_Day > Monthlength.Month
      CD_WN = trunc((right(DateInfo('J', Year''right(CD_Month, 2, '0')''right(CD_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
      if CD_HighDate == 'A' then call AssignHighlight(CD_Month, CD_Day, CD_Event)
      else if (CD_HighDate == 'E') & (CD_WN//2 == 0) then call AssignHighlight(CD_Month, CD_Day, CD_Event)
      else if (CD_HighDate == 'O') & (CD_WN//2 == 1) then call AssignHighlight(CD_Month, CD_Day, CD_Event)
      CD_Day = CD_Day + 7
    end
  end
  else do
    interpret 'CD_HighDay = Day.'CD_HighDay
    interpret 'CD_First = Day.'DateInfo('W', Year''right(CD_Month, 2, '0')'01', 'S')

    CD_Day = CD_HighDate + (CD_HighDay - CD_First)
    if CD_First < CD_HighDay then CD_Day = CD_Day - 7
    if CD_Event ~= '' then call AssignHighlight(CD_Month, CD_Day, CD_Event)
    else return CD_Day
  end
return 0
/**/

/***//*******  CalculateEDate (CED) Subroutine  ***********/
CalculateEDate:
/* DaysPastEaster is the number of days past Easter when the event occurs */
/* Event          is the highlight text                                   */
  parse arg CED_DaysPastEaster, CED_EasterEvent

  CED_EasterEventDate = DateInfo('S', EasterSerial + CED_DaysPastEaster, 'I')
  CED_EasterEventMonth = strip(substr(CED_EasterEventDate, 5, 2), 'L', '0')
  CED_EasterEventDay = strip(right(CED_EasterEventDate, 2), 'L', '0')
  call AssignHighlight(CED_EasterEventMonth, CED_EasterEventDay, CED_EasterEvent)
return 0
/**/

/***//*******  CalculateImage (CI) Subroutine  ***********/
CalculateImage:
/* Month    is the month in which the highlight occurs                        */
/* HighDate is the highest (numerical) date on which the highlight will occur */
/* HighDay  is the weekday on which the month starts when HighDate will occur */
/* Event    is the highlight text                                             */
  parse arg CI_Month, CI_HighDay, CI_HighDate, CI_Image

  if DoImages ~= 1 then return 0

  if CI_Month = 13 then CI_Month = Mn - 0

  if datatype(CI_HighDate) == 'CHAR' then do
    CI_HighDate = upper(left(CI_HighDate, 1))
    interpret 'CI_EventOffset = Day.'CI_HighDay' - StartDate'

    CI_Day  = 1 + CI_EventOffset
    if CI_Day < 1 then CI_Day = CI_Day + 7

    do until CI_Day > Monthlength.Month
      CI_WN = trunc((right(DateInfo('J', Year''right(CI_Month, 2, '0')''right(CI_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
      if CI_HighDate == 'A' then call AssignImage(CI_Month, CI_Day, CI_Image)
      else if (CI_HighDate == 'E') & (CI_WN//2 == 0) then call AssignImage(CI_Month, CI_Day, CI_Image)
      else if (CI_HighDate == 'O') & (CI_WN//2 == 1) then call AssignImage(CI_Month, CI_Day, CI_Image)
      CI_Day = CI_Day + 7
    end
  end
  else do
    interpret 'CI_HighDay = Day.'CI_HighDay
    interpret 'CI_First = Day.'DateInfo('W', Year''right(CI_Month, 2, '0')'01', 'S')

    CI_Day = CI_HighDate + (CI_HighDay - CI_First)
    if CI_First < CI_HighDay then CI_Day = CI_Day - 7
    if CI_Event ~= '' then call AssignImage(CI_Month, CI_Day, CI_Image)
    else return CI_Day
  end
return 0
/**/

/***//*******  CenterText (CT) Subroutine  ***********/
CenterText:
  parse arg CT_id, CT_CenterPoint, CT_MaxWidth, CT_WidthPercent

  if App = 'FW' then do
    GETOBJECTCOORDS CT_id; Parse Var result . . CT_Text.Bottom CT_Text.Width CT_Text.Height
    if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
    else CT_Text.Width = CT_Text.Width * CT_WidthPercent
    CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
    SETOBJECTCOORDS CT_id 1 CT_Text.Left CT_Text.Bottom CT_Text.Width CT_Text.Height
  end
  else if App == 'PGS' then do
    GETTEXTOBJ POSITION CT_Text OBJECTID CT_id WINDOW winName
    CT_Text.Width = CT_Text.Right - CT_Text.Left
    if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
    else CT_Text.Width = CT_Text.Width * CT_WidthPercent
    CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
    EDITTEXTOBJ POSITION CT_Text.Left CT_Text.Top (CT_Text.Left + CT_Text.Width) CT_Text.Bottom OBJECTID CT_id WINDOW winName
  end
  return
/**/

/***//*******  CheckShanghai (CS) Subroutine  ***********/
CheckShanghai:
  if RexxTricks == 1 then do
    if DoShanghai ~= 0 then PubScreen = AppScreen
    else PubScreen = DefPubScreen
  end
  return
/**/

/***//*******  Cleanup () Subroutine  ***********/
Cleanup:
  signal off syntax
  call close('DataFile')

  if Req ~= 0 then do
    call bguiwinclose(Req)
    Req = 0
  end
  if VariablesSet == 1 then do
    interpret UserPrefs
    if App == 'FW' then do
      SELECTOBJECT
      VIEW FinalView
      if upper(DecimalFormat) = 'COMMA' then DOCITEMPREFS DECIMAL Comma
    end
  end
  if App == 'PGS' then do
    LOCKINTERFACE FALSE
    LOADSETTINGS default
    REFRESH ON
    REFRESHWINDOW
    DISPLAY SCALE FinalView
    REVEALWINDOW ALL
  end

  if (ErrorCount == 0) & (CalType == 1) & (LaunchM ~= '') then interpret LaunchM
  if (ErrorCount == 0) & (CalType == 2) & (LaunchY ~= '') then interpret LaunchY

  LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  if LogOpen == 1 then OutType = 'File'
  if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
    LogOpen = 1
    call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
    OutType = 'CON'
  end

  if LogOpen == 1 then do
    call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
    call writeln('FWCLog', 'Application: 'PgmVersion)
    call writeln('FWCLog', 'Current Dir: 'CurrentDir)
    call writeln('FWCLog', ' Script Dir: 'ScriptDir)
    call writeln('FWCLog', '       Host: 'CallHost)
    call writeln('FWCLog', '   Calendar: 'Calendar||'0a'x)
  end

  if (ErrorCount > 0) | (WarningCount > 0) then do
    do i = 1 to ErrorCount
      call writeln('FWCLog', Error.i)
    end

    do i = 1 to WarningCount
      call writeln('FWCLog', Warning.i)
    end

    if PrefsFile ~= 'Default' then do
      if (exists(PrefsFile)) & (word(statef(PrefsFile), 2) > 2) then do
        call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
        if open('DataFile', PrefsFile) then do
          do until eof('DataFile')
            Ln = ReadLn('DataFile')
            if pos('End Pass One', Ln) > 0 then
              if (SettingHighlights ~= 1) & (ListHighlightData ~= 1) then leave
            call writeln('FWCLog', Ln)
          end
          call close('DataFile')
        end
      end
    end

    if ErrorCount > 0 then ErrorType = Critical$
    else ErrorType = Noncritical$
    FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
    Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
    ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
    if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
    if (OutType == 'File') & (bguiopen == 0) then do
      call open('CON', 'CON:10/10/500/300/FWCalendar notice/WAIT/CLOSE')
        call writeln('CON', FileMsg)
      call close('CON')
    end
    if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
    if (OutType == 'CON') & (bguiopen == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  end
  else do
    if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  end

  address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  address command 'delete >NIL: 'Storage'FWCTemp quiet'
  call close('FWCLog')
  if bguiopen = 1 then call bguiclose()

  exit
/**/

/***//*******  ConvertJ (CJ) Subroutine  ***********/
/* Routine to convert from 'J' & 'F' to normal dates obtained from the Sky & Telescope */
/* web site. The basic program from which the following was derived originally    */
/* appeared in Astronomical Computing, Sky & Telescope, May, 1984                 */
ConvertJ:
  parse arg CJ_F, CJ_J

  CJ_F = CJ_F + 0.5
  if CJ_F >= 1 then do
    CJ_F = CJ_F - 1
    CJ_J = CJ_J + 1
  end
  CJ_A1 = trunc((CJ_J / 36524.25) - 51.12264)
  CJ_A = CJ_J + 1 + CJ_A1 - trunc(CJ_A1 / 4)
  CJ_B = CJ_A + 1524
  CJ_C = trunc((CJ_B / 365.25) - 0.3343)
  CJ_D = trunc(365.25 * CJ_C)
  CJ_E = trunc((CJ_B - CJ_D) / 30.61)
  CJ_D = CJ_B - CJ_D - trunc(30.61 * CJ_E) + CJ_F
  CJ_M = CJ_E - 1
  CJ_Y = CJ_C - 4716
  IF CJ_E > 13.5 then CJ_M = CJ_M - 12
  IF CJ_M < 2.5 then CJ_Y = CJ_Y + 1
  CJ_Day = trunc(CJ_D)

  return right(CJ_Y, 4, '0')' 'right(CJ_M, 2, '0')' 'right(CJ_Day, 2, '0')' 'CJ_D - CJ_Day
/**/

/***//*******  ControlMX (CM) Subroutine  ***********/
ControlMX:
  parse arg CM_Group

  pos = pos.CM_Group

  do CM_i = 0 to 1
    option = Option.pos
    if option ~= 0 then do
      do dst = 0 to GroupCount
        if CM_Group = dst then iterate
        interpret 'call bguiset('grp.dst',winID,'Action.CM_i','option')'

        if ((Do.option == 'Julian') | (Do.option == 'JulianLeft')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveJulian == 1))) then
          interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothJ')'
        if Do.option = 'BothJ' then do
          interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Julian')'
          interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.JulianLeft')'
        end

        if ((Do.option == 'Sunrise') | (Do.option == 'Sunset')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveSunCalc == 1))) then
          interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothS')'
        if Do.option = 'BothS' then do
          interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunrise')'
          interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunset')'
        end

      end
    end
    interpret 'Option.'pos' = bguiget('grp.CM_Group', MX_Active)'
  end

  if (Do.option == 'Julian') | (Do.option == 'JulianLeft') then ActiveJulian.CM_Group = 1
  else ActiveJulian.CM_Group = 0
  if (Do.option == 'Sunrise') | (Do.option == 'Sunset') then ActiveSunCalc.CM_Group = 1
  else ActiveSunCalc.CM_Group = 0

  ActiveJulian = 0
  ActiveSunCalc = 0
  do grp = 0 to GroupCount
    ActiveJulian = ActiveJulian + ActiveJulian.grp
    ActiveSunCalc = ActiveSunCalc + ActiveSunCalc.grp
  end

  if ActiveJulian == 1 then
    do grp = 0 to GroupCount
      if ActiveJulian.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothJ')'
    end

  if ActiveSunCalc == 1 then
    do grp = 0 to GroupCount
      if ActiveSunCalc.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothS')'
    end

  return
/**/

/***//*******  DateInfo (PROCEDURE) Subroutine  ***********/
DateInfo: PROCEDURE
  /* DateInfo('I', '19780101', 'S') = 2443510  */
  /* Date('I', '19780101', 'S') = 0            */
  /* Option 'C' returns days since Jan 1, xx00 */
  parse arg Option, Date, Format

  if Option == '' then Option = 'N'
  if Date == '' then do
    Date = Date('S')
    Format = 'S'
  end

  Option = upper(left(Option, 1))
  Format = upper(left(Format, 1))
  if (Format == 'I') | (Format = '') then do
    Format = 'I'

    /* Routine to convert from a serial date to year/month/day obtained from the        */
    /* Sky & Telescope web site. The basic program from which the following was         */
    /* derived originally appeared in Astronomical Computing, Sky & Telescope,May, 1984 */
    A1 = trunc((Date / 36524.25) - 51.12264)
    A = Date + 1 + A1 - trunc(A1 / 4)
    B = A + 1524
    C = trunc((B / 365.25) - 0.3343)
    D = trunc(365.25 * C)
    E = trunc((B - D) / 30.61)
    D = B - D - trunc(30.61 * E)
    Month = E - 1
    Year = C - 4716
    IF E > 13.5 then Month = Month - 12
    IF Month < 2.5 then Year = Year + 1
    Day = trunc(D)
    J = Date
  end
  else do
    Year  = left(Date, 4) - 0
    Month = substr(Date, 5, 2) - 0
    Day   = right(Date, 2) - 0
    /* The following two lines are modified from PerpetualCalendar.bas that */
    /* appeared in Astronomical Computing, Sky & Telescope, July, 1985      */
    Temp = 0; if Month <= 2 then Temp = -1
    J = 367*Year-trunc(7*(Year+trunc((Month + 9)/12))/4)+trunc(275*Month/9)+1721031-trunc(3*(trunc((Year+Temp)/100)+1)/4) + Day - 2
  end

  select
    when Option == 'B' then do
      return J - 1721060
    end
    when Option == 'C' then do
      return J + 2 - DateInfo('I', left(right(Year, 4, '0'), 2)'000101', 'S')
    end
    when (Option == 'D') | (Option == 'J') then do
      DayCount = 0
      MonthLength.1    = 31
      MonthLength.2    = 28
      MonthLength.3    = 31
      MonthLength.4    = 30
      MonthLength.5    = 31
      MonthLength.6    = 30
      MonthLength.7    = 31
      MonthLength.8    = 31
      MonthLength.9    = 30
      MonthLength.10   = 31
      MonthLength.11   = 30
      MonthLength.12   = 31
      if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29

      do I = (Month - 1) to 1 by -1
        DayCount = DayCount + MonthLength.I
      end
      if Option == 'D' then return DayCount + Day
      else return right(Year, 2)''right(DayCount + Day, 3, '0')
    end
    when Option == 'E' then do
      return right(Day, 2, '0')'/'right(Month, 2, '0')'/'right(Year, 2, '0')
    end
    when Option == 'I' then return J
    when (Option == 'M') | (Option == 'N') then do
      Select
        when Month ==  1 then Month = 'January'
        when Month ==  2 then Month = 'February'
        when Month ==  3 then Month = 'March'
        when Month ==  4 then Month = 'April'
        when Month ==  5 then Month = 'May'
        when Month ==  6 then Month = 'June'
        when Month ==  7 then Month = 'July'
        when Month ==  8 then Month = 'August'
        when Month ==  9 then Month = 'September'
        when Month == 10 then Month = 'October'
        when Month == 11 then Month = 'November'
        when Month == 12 then Month = 'December'
      end
      if Option == 'M' then return Month
      else return right(Day, 2, '0')' 'left(Month, 3)' 'Year
    end
    when Option == 'O' then return right(Year, 2, '0')'/'right(Month, 2, '0')'/'right(Day, 2, '0')
    when Option == 'S' then return right(Year, 4, '0')''right(Month, 2, '0')''right(Day, 2, '0')
    when Option == 'U' then return right(Month, 2, '0')'/'right(Day, 2, '0')'/'right(Year, 2, '0')
    when Option == 'W' then do
      J = J + 1
      Weekday = J - 7 * trunc(J / 7)
      Select
        when Weekday == 0 then return 'Sunday'
        when Weekday == 1 then return 'Monday'
        when Weekday == 2 then return 'Tuesday'
        when Weekday == 3 then return 'Wednesday'
        when Weekday == 4 then return 'Thursday'
        when Weekday == 5 then return 'Friday'
        when Weekday == 6 then return 'Saturday'
      end
    end
    otherwise return 0
  end
/**/

/***//*******  DetermineDate1 (DD1) Subroutine  ***********/
DetermineDate1:
  parse arg DD1_Month, DD1_Day, DD1_Event

  DD1_Ln = DD1_Month
  DD1_Month = pos('.', DD1_Ln) + 1
  DD1_Day   = pos('.', DD1_Ln, DD1_Month) + 1
  DD1_Event = pos('=', DD1_Ln) + 1
  DD1_Month = substr(DD1_Ln, DD1_Month, DD1_Day - DD1_Month - 1)
  if DD1_Month == '13' then DD1_Month = Mn - 0
  DD1_Day   = upper(strip(substr(DD1_Ln, DD1_Day, DD1_Event - DD1_Day - 1)))
  if left(DD1_Day, 2) = '32' then DD1_Day = overlay(MonthLength.DD1_Month, DD1_Day)
  return DD1_Month' 'DD1_Day
/**/

/***//*******  DetermineDate2 (DD2) Subroutine  ***********/
DetermineDate2:
  parse arg DD2_Month, DD2_Day, DD2_Year

  DD2_DateString = DD2_Year''right(DD2_Month, 2, '0')''right(strip(DD2_Day, 'T', 'PN'), 2, '0')
  DD2_Weekday = DateInfo('W', DD2_DateString, 'S')
  if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Saturday') then do
    DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 2), 'I')
    DD2_Month = substr(DD2_NewDay, 5, 2) - 0
    DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  end
  else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Saturday') then do
    DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 1), 'I')
    DD2_Month = substr(DD2_NewDay, 5, 2) - 0
    DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  end
  else if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Sunday') then do
    DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 1), 'I')
    DD2_Month = substr(DD2_NewDay, 5, 2) - 0
    DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  end
  else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Sunday') then do
    DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 2), 'I')
    DD2_Month = substr(DD2_NewDay, 5, 2) - 0
    DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  end
  DD2_Day = strip(DD2_Day, 'T', 'PN')

  return DD2_Month' 'DD2_Day
/**/

/***//*******  DetermineHost () Subroutine  ***********/
DetermineHost:
  parse source . . . FullCallPath . CallHost
  CallHost = strip(CallHost)
  ScriptDir = PathPart(FullCallPath)

  CurrentDir = upper(Pragma('D'))
  if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'

  owner = ReadEnv('Owner')
  if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
    App     = 'FW'
    AppName = 'FINALWRITER'
    if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
    else HostPort = CallHost
    address value HostPort
    if owner == 'rgoertz' then do
      if CallHost == 'REXX' then CLEARDOC FORCE
      else do
        CLEARDOC
        if result == 1 then exit
      end
    end
    else do
      CLEARDOC
      if result == 1 then exit
    end

    GETDOCITEMPREFS Decimal; DecimalFormat = result
    DOCITEMPREFS Decimal Period
  end
  else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
    App     = 'PGS'
    AppName = 'PAGESTREAM'
    HostPort = 'PAGESTREAM'
  end
  else do
    call AddMsg('E', 'Unable to determine host!')
    call Cleanup
  end

  AppScreen = ''
  DefPubScreen = ''
  if RexxTricks == 1 then do
    if (pubscreenlist('ScreenList') > 0) then do
      do i = 1 to ScreenList.0
        if pos(AppName, upper(ScreenList.i)) > 0 then do
          AppScreen = ScreenList.i
          leave
        end
      end
    end
  end

  return HostPort
/**/

/***//*******  DoOptions (DO) Subroutine  ***********/
DoOptions:
  DO_PrevDay = Day - 7

  if (DayType == 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Extended
  else if (DayType == 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Extended

  /***//* DoJulian & DoJulianLeft */
  if (DoJulian ~= 0) | (DoJulianLeft ~= 0) then do
    DO_JDay = right(DateInfo('J', JulianDay, 'I'), 3)
    if (Day <= 0) & (PrevMonth = 12) then DO_JDayLeft = right(365 + PrevLeapYear - DO_JDay, 3, '0')
    else DO_JDayLeft = right(365 + LeapYear - DO_JDay, 3, '0')

    if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Julian
    else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Julian

    if DoJulian ~= 0 then do
      DO_Text2Print = Text.Julian''DO_JDay
      if DoJulianLeft == DoJulian then DO_Text2Print = DO_Text2Print'/'DO_JDayLeft
      call UpdateBusy(Req, 1)
      JID.Day = PrintOption(DoJulian)
      if (CurrentRow = 5) & (left(DoJulian, 1) ~= 'T') then call Move(JID.DO_PrevDay, 0, -BoxHeight / 2)
    end

    if (DoJulianLeft ~= 0) & (DoJulianLeft ~= DoJulian) then do
      DO_Text2Print = DO_JDayLeft
      call UpdateBusy(Req, 1)
      JIDL.Day = PrintOption(DoJulianLeft)
      if (CurrentRow = 5) & (left(DoJulianLeft, 1) ~= 'T') then call Move(JIDL.DO_PrevDay, 0, -BoxHeight / 2)
    end
  end
  /**/

/***//* DoSunrise & DoSunset */
  if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
    SRSS$ = GetSRSS(JulianDay)

    if DoSunRise ~= 0 then do
      if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunrise
      else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunrise
      DO_Text2Print = Text.Sunrise''word(SRSS$, 1)
      if DoSunSet == DoSunRise then DO_Text2Print = DO_Text2Print'/'word(SRSS$, 3)
      call UpdateBusy(Req, 1)
      SRID.Day = PrintOption(DoSunRise)
      if (CurrentRow = 5) & (left(DoSunRise, 1) ~= 'T') then call Move(SRID.DO_PrevDay, 0, -BoxHeight / 2)
    end

    if (DoSunSet ~= 0) & (DoSunSet ~= DoSunRise) then do
      if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunset
      else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunset
      DO_Text2Print = Text.Sunset''word(SRSS$, 3)
      call UpdateBusy(Req, 1)
      SSID.Day = PrintOption(DoSunSet)
      if (CurrentRow = 5) & (left(DoSunSet, 1) ~= 'T') then call Move(SSID.DO_PrevDay, 0, -BoxHeight / 2)
    end
  end
  /**/

/***//* DoWeekNumber */
  if (DoWeekNumber ~= 0) & (CurrentColumn = 0) then do
    if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.WeekNumber
    else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.WeekNumber
    DO_WN = trunc((right(DateInfo('J', JulianDay, 'I'), 3) - YearOffset - 1)/7 + 1)
    DO_Text2Print = Text.WeekNumber''DO_WN
    call UpdateBusy(Req, 1)
    WNID.Day = PrintOption(DoWeekNumber)
    if (CurrentRow = 5) & (left(DoWeekNumber, 1) ~= 'T') then call Move(WNID.DO_PrevDay, 0, -BoxHeight / 2)
  end
  /**/

  /***//* DoImages */
  if DoImages == 1 then do
    if Image.Month.Day ~= '' then do
      ImageNumber = Image.Month.Day
      ImageDX = ImageDX.ImageNumber
      ImageDY = ImageDY.ImageNumber
      if ImageType.ImageNumber == '' then do
        DO_Cmd = Storage''GfxApp' >ENV:FWCTemp '
        DO_InsertPos = pos('%s', GfxCmd)
        DO_Cmd = DO_Cmd''left(GfxCmd, DO_InsertPos - 1)''ImageFile.ImageNumber''substr(GfxCmd, DO_InsertPos + 2)
        address command DO_Cmd
        DO_Template = GfxTemplate
        DO_InfoLine = ReadEnv('FWCTemp')
        if DO_InfoLine ~= '' then do
          interpret "parse var DO_InfoLine "DO_Template
          DO_ImageType = upper(strip(ImgDT))
          DO_Width = strip(ImgWidth)
          DO_Height = strip(ImgHeight)
          if (datatype(DO_ImageType) ~= 'CHAR') | (datatype(DO_Width) ~= 'NUM') | (datatype(DO_Height) ~= 'NUM') then do
            call AddMsg('W', DO_InfoLine)
            Image.Month.Day = ''
          end
          else do
            ImageType.ImageNumber = DO_ImageType
            if DO_ImageType ~= 'POST' then do
              ImageWidth.ImageNumber = DO_Width / 72
              ImageHeight.ImageNumber = DO_Height / 72
              if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
                EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
                ImageWidth.ImageNumber  = ImageWidth.ImageNumber / EnlFactor
                ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
              end
            end
          end
        end
      end

      call UpdateBusy(Req, 1)

      if ImageType.ImageNumber ~= '' then do
        if App == 'FW' then do
          if ImageWidth.ImageNumber == 0 then do
            INSERTIMAGE ImageFile.ImageNumber POSITION 1 '-1' '-1' '-1' '-1'
            ImageID.Day = result
            GETOBJECTCOORDS ImageID.Day
            parse var result . . . ImageWidth.ImageNumber ImageHeight.ImageNumber
            if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
              EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
              ImageWidth.ImageNumber  = ImageWidth.ImageNumber / EnlFactor
              ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
            end
            DELETEOBJECT ImageID.Day
          end
          Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
          Image.Top  = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
          INSERTIMAGE ImageFile.ImageNumber POSITION 1 Image.Left Image.Top ImageWidth.ImageNumber ImageHeight.ImageNumber
          ImageID.Day = result
          OBJECTTOBACK ImageID.Day
          if BackBox.JulianDay ~= 0 then OBJECTTOBACK BackBox.JulianDay
        end
        else if App == 'PGS' then do
          DO_ImgType = ImageType.ImageNumber
          if PGSFilter.DO_ImgType == '' then PGSFilter.DO_ImgType = DO_ImgType
          if ImageWidth.ImageNumber == 0 then do
            PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType WINDOW winName
            ImageID.Day = result
            if ImageType.ImageNumber == 'POST' then GETDRAWING POSITION Image OBJECTID ImageID.Day WINDOW winName
            else GETPICTURE POSITION Image OBJECTID ImageID.Day WINDOW winName
            DELETEOBJECT OBJECTID ImageID.Day WINDOW winName
            ImageWidth.ImageNumber = Image.Right - Image.Left
            ImageHeight.ImageNumber = Image.Bottom - Image.Top
            if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
              EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
              ImageWidth.ImageNumber  = ImageWidth.ImageNumber / EnlFactor
              ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
            end
          end
          Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
          Image.Top  = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
          PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType AT Image.Left Image.Top WINDOW winName
          ImageID.Day = result
          if ImageType.ImageNumber == 'POST' then EDITDRAWING POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
          else EDITPICTURE POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
          SENDTOBACK OBJECTID ImageID.Day WINDOW winName
          if BackBox.JulianDay ~= 0 then SENDTOBACK OBJECTID BackBox.JulianDay WINDOW winName
        end
      end
    end

    if (CurrentRow = 5) & (Image.Month.DO_PrevDay ~= '') then do
      ImageNumber = Image.Month.DO_PrevDay
      if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
        EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
        Image.Width  = ImageWidth.ImageNumber/EnlFactor
        Image.Height = ImageHeight.ImageNumber/EnlFactor
      end
      else do
        Image.Width = ImageWidth.ImageNumber
        Image.Height = ImageHeight.ImageNumber
      end
      Image.Left = BoxLeft + (BoxWidth - Image.Width)/2
      Image.Top  = BoxTop - BHeight + (BHeight - Image.Height)/2

      if App == 'FW' then do
        SETOBJECTCOORDS ImageID.DO_PrevDay 1 Image.Left Image.Top Image.Width Image.Height
        OBJECTTOBACK ImageID.DO_PrevDay
      end
      else if App == 'PGS' then do
        if ImageType.ImageNumber == 'POST' then EDITDRAWING POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) ADJUST SCALECONTENT OBJECTID ImageID.DO_PrevDay WINDOW winName
        else EDITPICTURE POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) OBJECTID ImageID.DO_PrevDay WINDOW winName
        SENDTOBACK OBJECTID ImageID.DO_PrevDay WINDOW winName
      end
    end
  end
  /**/

/***//* DoPhases */
  if Day < 1 then do
    DO_PrintColor = Color.Extended
    DO_MoonDay = PrintDay
    DO_MoonMonth = PrevMonth
    DO_MoonYear = PrevYear
  end
  else if Day > MonthLength.Month then do
    DO_PrintColor = Color.Extended
    DO_MoonDay = PrintDay
    DO_MoonMonth = NextMonth
    DO_MoonYear = NextYear
  end
  else do
    DO_PrintColor = Color.Moon
    DO_MoonDay = Day
    DO_MoonMonth = Month
    DO_MoonYear = EnteredYear
  end
  if (DoPhases ~= 0) & (MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay ~= '') then do
    select
      when right(DoPhases, 1) == 'L' then DO_MoonLeft = BoxLeft + (MoonRadius * 1.2)
      when right(DoPhases, 1) == 'C' then DO_MoonLeft = BoxLeft + BoxWidth / 2
      when right(DoPhases, 1) == 'R' then DO_MoonLeft = BoxLeft + BoxWidth - (MoonRadius * 1.2)
    end
    if left(DoPhases, 1) == 'T' then DO_DX = MoonRadius * 1.2
    else if left(DoPhases, 1) == 'B' then DO_DX = BHeight - (MoonRadius * 1.2)
    MoonID.Day = DrawMoon(MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay, DO_MoonLeft, BoxTop + DO_DX, DO_PrintColor)
    if left(DoPhases, 1) == 'T' then MoonID.Day = 0
    call UpdateBusy(Req, 1)
  end
  if (CurrentRow = 5) & (MoonPhase.EnteredYear.Month.DO_PrevDay ~= '') then call Move(MoonID.DO_PrevDay, 0, -BoxHeight / 2)
  /**/

  return
/**/

/***//*******  DoSetupReq () Subroutine  ***********/
DoSetupReq:
  ActiveJulian   = 0
  ActiveJulian.  = 0
  ActiveSunCalc  = 0
  ActiveSunCalc. = 0
  Option.        = 0

  if (PrefsName == 'Default') & (PrefsFile ~= 'Default') then DisplayName = PrefsFile
  else DisplayName = PrefsName

  do opt = 1 + (PhaseLib ~= 1) to 5 + 3 * exists(Storage'suncalc')
    interpret 'DoValue = Do'Do.opt
    if (DoValue ~= 0) & (length(DoValue) == 1) then DoValue = 'B'DoValue
    interpret 'posn = Option.'opt
    if ((DoValue == 0) | (symbol(DoValue) == 'LIT')) & (posn == 0) then interpret 'Option.'DoValue' = MXPos.'Do.opt
  end

  do i = 0 to 4
    grp = pos.i
    option = Option.grp
    if (Do.option == 'Sunset') & (DoSunrise == DoSunset) then interpret 'Option.'pos.i' = 'MXPos.BothS
    else if (Do.option == 'JulianLeft') & (DoJulian == DoJulianLeft) then interpret 'Option.'pos.i' = 'MXPos.BothJ
  end

  call bguilist('monthlist_',January$,February$,March$,April$,May$,June$,July$,August$,September$,October$,November$,December$)
  call bguilist('mxopts_',None$,Phases$,Weeknumber$,Julian$,JulLeft$,JulJulLeft$,Sunrise$,Sunset$,RiseSet$)

  call UpdateBusy(Req, 1)
  g=bguivgroup(,
    bguiinfo('dummy_',,esc||'c'DisplayName)bguilayout(LGO_FixMinHeight, 1)||,
    bguimx('mainswitcher_',,bguilist('mainpnames_',OptLayout$,Variables$,Top$,Bottom$),'T')bguilayout(LGO_FixMinHeight,1)||,
    bguipages('mainpages_',,
      bguivgroup(,
        bguihgroup(,
          bguivgroup(,
            bguicheckbox('minicals_',MiniCals$, DoMiniCals)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('highlights_',Highlights$, DoHighlights)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('images_',Images$, DoImages)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('dateboxes_',BoxDates$, DoDateBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
          )||,
          bguivarspace(10)||,
          bguivgroup(,
            bguicheckbox('backgrounds_',Backgrounds$, DoBackgrounds)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('extended_',Extended$, DoExtended)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('toplong_',TopLong$, DoTopExtraWk)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('notebox_',NoteBox$, DoNoteBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
          ),
        ,-2,'F',Options$)||,
        bguivgroup(,
          bguihgroup(,
            bguivarspace(40)||,
            bguistring('topmargin_',,Margin.Top,8)bguilayout(LGO_FixMinHeight, 1)bguilayout(LGO_Weight,20)||,
            bguivarspace(40),
          )||,
          bguihgroup(,
            bguivarspace(20)||,
            bguistring('leftmargin_',,Margin.Left,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
            bguicycle('orientation_',,bguilist('orientlist_',Wide$,Tall$))bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
            bguistring('rightmargin_',,Margin.Right,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
            bguivarspace(20),
          )||,
          bguihgroup(,
            bguivarspace(40)||,
            bguistring('bottommargin_',,Margin.Bottom,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
            bguivarspace(40),
          ),
        ,-2,'F',OrientMarg$),
      )||,
      bguivgroup(,
        bguihgroup(,
          bguicycle('fontvar_',,'FontVarName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
          bguistring('fontvalue_',,value(CurrentFontName),256)bguilayout(LGO_FixMinHeight,1)||,
          bguiibutton('addfont_','B','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
        ,-2,'F',Fonts$)||,
        bguivgroup(,
          bguihgroup(,
            bguicycle('colorvar_',,'ColorVarName')bguilayout(LGO_FixMinHeight, 1)||,
            bguicycle('colorlist_',,'ColorList')bguilayout(LGO_FixMinHeight, 1),
          )||,
          bguihgroup(,
            bguivarspace(1)||,
            bguicheckbox('matchcolors_',MatchColors$, DoMatchColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
          )||,
          bguihgroup(,
            bguivarspace(1)||,
            bguicheckbox('dailycolors_',DailyColors$, DoDailyColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
          ),
        ,-2,'F',Colors$)||,
        bguivgroup(,
          bguihgroup(,
            bguivarspace(40)||,
            bguibutton('sethighlights_',Highlights$)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
            bguivarspace(40),
          )||,
          bguihgroup(,
            bguicycle('currentvar_',,'MiscVarName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
            bguistring('currentvalue_',,VarVal,256)bguilayout(LGO_FixMinHeight,1)||,
            bguiibutton('addvar_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
          ),
        ,-2,'F',MiscVar$),
      ,-2)||,
      bguihgroup(,
        bguivarspace(40)||,
        bguivgroup(,
          bguimx('topcenter_',Top$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
        ,-3,'F')||,
        bguivgroup(,
          bguimx('topright_',Top$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
        ,-3,'F'),
      )||,
      bguihgroup(,
        bguivgroup(,
          bguimx('bottomleft_',Bottom$||'0a'x||Left$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
        ,-3,'F')||,
        bguivgroup(,
          bguimx('bottomcenter_',Bottom$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
        ,-3,'F')||,
        bguivgroup(,
          bguimx('bottomright_',Bottom$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
        ,-3,'F'),
      ),
    )||,
    bguihgroup(,
      bguicycle('monthchoice_',,'monthlist_')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
      bguistring('yearchoice_',,Year,5)bguilayout(LGO_FixMinHeight, 1),
    )||,
    bguihgroup(,
      bguibutton('monthly_',Monthly$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
      bguibutton('yearly_',WholeYear$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
      bguivarspace(2)||,
      bguibutton('reset_',Reset$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
      bguibutton('load_',Load$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
      bguivarspace(2)||,
      bguibutton('cancel_',Cancel$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
    ),
  ,'-3','-3')



  call UpdateBusy(Req, 1)
  winID=bguiwindow(VarGUITitle$,g,0,0,,PubScreen)

  if App == 'PGS' then do
    FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
    call UpdateBusy(Req, 1)
    FontwinID=bguiwindow(SelectFont$':',FontGroup,20,50,,PubScreen)
  end

  ExportwinID = bguiwindow('',bguivgroup(bguiinfo('dummy_',,esc''Exporting$'...')),0,0,,PubScreen)

  UCMN = upper(CurrentMiscName)
  if (UCMN == 'GFXAPPPATH') | (UCMN == 'SUNCALCPATH') | (UCMN == 'GFXAPP') then VarReqGad = 1
  else VarReqGad = 0
  call bguiset(obj.addvar_, winID, GA_Disabled, ~VarReqGad)

  do i = 0 to GroupCount
    interpret 'call bguiset('grp.i',winID,MX_Active,Option.'pos.i')'
    call ControlMX(i)
    if PhaseLib ~= 1 then interpret 'call bguiset('grp.i',winID,MX_DisableButton,1)'
    if ~exists(Storage'suncalc') then interpret 'call bguiset('grp.i',winID,MX_DisableButton,6,MX_DisableButton,7,MX_DisableButton,8)'
  end
  call bguiset(obj.orientation_,winID,CYC_Active,OrientChoice)
  call bguiset(obj.monthchoice_,winID,CYC_Active,CalMonth-1)
  call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(CurrentColorName),'ColorList')))
  CurrentColor = bguiget(obj.colorlist_, CYC_Active)
  call bguiset(obj.currentvar_,,BT_Key,'09'x)
  call bguiset(obj.currentvalue_,,BT_Key,'0d'x)
  call bguiset(obj.images_,winID,GA_Disabled,~exists(Storage''GfxApp))
  call bguiaddmap(obj.mainswitcher_,obj.mainpages_,MX_Active,PAGE_Active)
  call bguiwintabcycleorder(winID,obj.topmargin_||obj.leftmargin_||obj.rightmargin_||obj.bottommargin_)
  if DoExtended == 1 then do
    call bguiset(obj.toplong_,winID, GA_Selected, 0, GA_Disabled, 1)
    DoTopExtraWk = 0
    call bguiset(obj.notebox_,winID, GA_Selected, 0, GA_Disabled, 1)
    DoNoteBox = 0
  end

  if bguiwinopen(winID)=0 then bguierror(12)

  if Req ~= 0 then do
    call bguiwinclose(Req)
    Req = 0
  end

  CalType = 0
  Reset   = 0
  do while 1
    call bguiwinwaitevent(winID,'ID')
    select
      when (id == id.cancel_) | (id == id.winclose) then do
        call bguiwinclose(winID)
        call Cleanup
      end
      when id == id.reset_ then do
        Reset = 1
        PrefsFile = 'Default'
        call WriteEnv('FWCalendar', PrefsFile, 'B')
      end
      when id == id.load_ then do
        CurrentPrefs = PrefsFile
        PrefsFile = bguifilereq(ScriptDir''"FWCalendar.prefs", SelectFile$':', winID,DOPATTERNS,PatVar)
        if PrefsFile == '' then PrefsFile = CurrentPrefs
        else do
          if exists(PrefsFile) then do
            Reset = 1
            call WriteEnv('FWCalendar', PrefsFile, 'B')
          end
          else do
            call bguireq(PrefsFile' 'CantFind$'...','*'OK$,'FWCalendar 'Notice$,winID)
            PrefsFile = CurrentPrefs
          end
        end
      end
      when id == id.minicals_ then     DoMiniCals = sign(bguiget(obj.minicals_, GA_Selected))
      when id == id.highlights_ then   DoHighlights = sign(bguiget(obj.highlights_, GA_Selected))
      when id == id.extended_ then do
        DoExtended = sign(bguiget(obj.extended_, GA_Selected))
        if DoExtended == 1 then do
          call bguiset(obj.toplong_,winID, GA_Selected, 0, GA_Disabled, 1)
          DoTopExtraWk = sign(bguiget(obj.toplong_, GA_Selected))
          call bguiset(obj.notebox_,winID, GA_Selected, 0, GA_Disabled, 1)
          DoNoteBox = sign(bguiget(obj.notebox_, GA_Selected))
        end
        else do
          call bguiset(obj.toplong_,winID, GA_Disabled, 0)
          call bguiset(obj.notebox_,winID, GA_Disabled, 0)
        end
      end
      when id == id.toplong_ then      DoTopExtraWk = sign(bguiget(obj.toplong_, GA_Selected))
      when id == id.notebox_ then      DoNoteBox = sign(bguiget(obj.notebox_, GA_Selected))
      when id == id.dateboxes_ then    DoDateBox = sign(bguiget(obj.dateboxes_, GA_Selected))
      when id == id.backgrounds_ then  DoBackgrounds = sign(bguiget(obj.backgrounds_, GA_Selected))
      when id == id.images_ then       DoImages = sign(bguiget(obj.images_, GA_Selected))
      when id == id.matchcolors_ then  DoMatchColors = sign(bguiget(obj.matchcolors_, GA_Selected))
      when id == id.dailycolors_ then  DoDailyColors = sign(bguiget(obj.dailycolors_, GA_Selected))
      when id == id.topmargin_ then    Margin.Top = bguiget(obj.topmargin_, STRINGA_TextVal)
      when id == id.leftmargin_ then   Margin.Left = bguiget(obj.leftmargin_, STRINGA_TextVal)
      when id == id.rightmargin_ then  Margin.Right = bguiget(obj.rightmargin_, STRINGA_TextVal)
      when id == id.bottommargin_ then Margin.Bottom = bguiget(obj.bottommargin_, STRINGA_TextVal)
      when id == id.orientation_ then do
        if bguiget(obj.orientation_,CYC_Active) == 0 then Orientation = 'Wide'
        else Orientation = 'Tall'
      end
      when id == id.fontvalue_ then do
        call bguireq('1b'x||"c"MustUse$,"*"OK$,'',winID)
        call bguiset(obj.fontvalue_, winID,STRINGA_TextVal, value(CurrentFontName))
      end
      when id == id.addfont_ then do
        if App == 'FW' then do
          FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$':', winID,,'#?')
          if FontFile ~= '' then call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,FontFile)
        end
        else if App == 'PGS' then do
          call bguiwinbusy(winID)
          call bguiwinopen(FontwinID)
          do while 1
            call bguiwinwaitevent(FontwinID,'ID')
            if id = id.winclose then leave
            if id = id.fontlistview_ then do
              call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
              leave
            end
          end
          call bguiwinclose(FontwinID)
          call bguiwinready(winID)
        end
      end
      when id == id.fontvar_ then do
        interpret CurrentFontName" = "QuoteIt(bguiget(obj.fontvalue_, STRINGA_TextVal))
        CurrentFontName = value('FontVarName.'bguiget(obj.fontvar_, CYC_Active))
        call bguiset(obj.fontvalue_,winID,STRINGA_TextVal,Value(CurrentFontName))
      end
      when id == id.addvar_ then do
        if (upper(CurrentMiscName) == 'GFXAPPPATH') | (upper(CurrentMiscName) == 'GFXAPP') then do
          Value = bguifilereq(GfxAppPath, SelectApp$':', winID,,'#?')
          if Value ~= '' then do
            GPath = pathpart(Value)
            GFile = filepart(Value)
            if upper(CurrentMiscName) == 'GFXAPPPATH' then call bguiset(obj.currentvalue_, winID, STRINGA_TextVal,GPath)
            else call bguiset(obj.currentvalue_, winID, STRINGA_TextVal,GFile)
            interpret 'GfxAppPath = 'QuoteIt(GPath)
            interpret 'GfxApp = 'QuoteIt(GFile)
            if (exists(GfxAppPath''GfxApp)) & (~exists(Storage''GfxApp)) then do
              address command 'copy 'GfxAppPath''GfxApp' 'Storage
              call bguiset(obj.images_,winID,GA_Disabled,~exists(Storage''GfxApp))
            end
          end
        end

        else if (upper(CurrentMiscName) == 'SUNCALCPATH') then do
          Value = bguifilereq(CurrentDir, SelectApp$':', winID,,'#?')
          if (Value ~= '') & (upper(right(Value, 7)) == 'SUNCALC') then do
            Value = pathpart(Value)
            call bguiset(obj.currentvalue_, winID, STRINGA_TextVal,Value)
            interpret 'SuncalcPath = 'QuoteIt(Value)
            if (exists(SuncalcPath'suncalc')) & (~exists(Storage'Suncalc')) then do
              address command 'copy 'SunCalcPath'suncalc 'Storage
              do i = 0 to GroupCount
                interpret 'call bguiset('grp.i',winID,MX_EnableButton,6,MX_EnableButton,7,MX_EnableButton,8)'
              end
            end
          end
        end
      end
      when id == id.colorvar_ then do
        interpret CurrentColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
        CurrentColorName = value('ColorVarName.'bguiget(obj.colorvar_, CYC_Active))
        call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(CurrentColorName),'ColorList')))
        CurrentColor = bguiget(obj.colorlist_, CYC_Active)
      end
      when id == id.colorlist_ then do
        if (pos('BACKGROUND.', upper(CurrentColorName)) == 0) & (bguiget(obj.colorlist_, CYC_Active) == ColorList.Count - 1) then do
          call bguireq('1b'x||"c"NotClear$,"*"OK$,'',winID)
          call bguiset(obj.colorlist_, winID, CYC_Active, CurrentColor)
        end
      end
      when id == id.currentvar_ then do
        Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
        if datatype(Value) == 'CHAR' then Value = QuoteIt(Value)
        if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
          IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
          interpret 'ImageFile.'IC' = 'Value
        end
        else interpret CurrentMiscName' = 'Value
        CurrentMiscName = value('MiscVarName.'bguiget(obj.currentvar_, CYC_Active))
        if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
          IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
          call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,value('ImageFile.IC'))
        end
        else call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,Value(CurrentMiscName))
        UCMN = upper(CurrentMiscName)
        if (UCMN == 'GFXAPPPATH') | (UCMN == 'SUNCALCPATH') | (UCMN == 'GFXAPP') then VarReqGad = 1
        else VarReqGad = 0
        call bguiset(obj.addvar_, winID, GA_Disabled, ~VarReqGad)
      end
      when id == id.currentvalue_ then do
        if (upper(CurrentMiscName) == 'GFXAPPPATH') | (upper(CurrentMiscName) == 'GFXAPP') | (upper(CurrentMiscName) == 'SUNCALCPATH') then do
          call bguireq('1b'x||"c"MustUse$,"*"OK$,'',winID)
          call bguiset(obj.currentvalue_, winID,STRINGA_TextVal, value(CurrentMiscName))
        end
      end
      when id == id.sethighlights_ then do
        call bguiwinbusy(winID)
        do until DS_Done == 1
          DS_Done = EditHighlight()
        end
        call bguiwinready(winID)
      end
      when id == id.monthly_ then do
        CalType = 1
        EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
        Month = bguiget(obj.monthchoice_, CYC_Active) + 1
      end
      when id == id.yearly_ then do
        CalType = 2
        EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
      end
      when id == id.bottomleft_ then call ControlMX(0)
      when id == id.bottomcenter_ then call ControlMX(1)
      when id == id.bottomright_ then call ControlMX(2)
      when id == id.topcenter_ then call ControlMX(3)
      when id == id.topright_ then call ControlMX(4)
      otherwise nop
    end
    if (CalType ~= 0) | (Reset == 1) then leave
  end

  if CalType ~= 0 then do
    interpret CurrentFontName" = "QuoteIt(bguiget(obj.fontvalue_, STRINGA_TextVal))
    interpret CurrentColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'

    Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
    if datatype(Value) == 'CHAR' then  Value = QuoteIt(Value)
    if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
      IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
      interpret 'ImageFile.'IC' = 'Value
    end
    else interpret CurrentMiscName' = 'Value
  end
  return
/**/

/***//*******  DrawBox (DB) Subroutine  ***********/
DrawBox:
  parse arg DB_x1, DB_y1, DB_width, DB_height, DB_Weight, DB_LineColor, DB_FillBool, DB_FillColor, DB_SendToBack

  if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0

  if App == 'FW' then do
    if DB_Weight == 'HL' then DB_Weight = 'Hairline'
    else if DB_Weight == 0 then do
      DB_Weight = 'None'
      if DB_FillColor ~= '<'Clear$'>' then DB_LineColor = DB_FillColor
    end

    if DB_FillBool == 1 then DB_FillBool = 'Solid'
    else do
      DB_FillBool = 'Transparent'
      DB_FillColor = DB_LineColor
    end

    BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_LineColor'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
    DRAWBOX 1 DB_x1 DB_y1 DB_width DB_height; DB_id = result
    if DB_SendToBack == 1 then OBJECTTOBACK
  end
  else if App == 'PGS' then do
    if DB_Weight == 'HL' then DB_Weight = 0.3pt
    else DB_Weight = DB_Weight'pt'

    if DB_FillBool == 1 then DB_FillBool = 'ON'
    else DB_FillBool = 'OFF'

    If DB_Weight == 0 then DB_LineBool = 'OFF'
    else DB_LineBool = 'ON'

    DRAWBOX DB_x1 DB_y1 DB_x1+DB_width DB_y1+DB_height WINDOW winName; DB_id = result
    STROKED DB_LineBool OBJECT WINDOW winName
    SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECT WINDOW winName
    SETCOLORSTYLE '"'DB_LineColor'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
    FILLED DB_FillBool OBJECT WINDOW winName
    SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECT WINDOW winName
    if DB_SendToBack == 1 then SENDTOBACK OBJECTID DB_id WINDOW winName
  end
  return DB_id
/**/

/***//*******  DrawHalf (DH) Subroutine  ***********/
DrawHalf:
  parse arg DH_Side

  if App == 'FW' then do
    if DH_Side == 'L' then DH_sign = -1
    else DH_sign = 1

    STARTPATH 1 DM_CtrX (DM_CtrY + MoonRadius)
    CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY + MoonRadius) (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY + MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius)) DM_CtrY
    CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY - MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY - MoonRadius) DM_CtrX (DM_CtrY - MoonRadius)
    ENDPATH Close
  end
  else if App == 'PGS' then do
    if DH_Side == 'L' then DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
    else DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
  end
  return result
/**/

/***//*******  DrawLine (DL) Subroutine  ***********/
DrawLine:
  parse arg DL_x1, DL_y1, DL_x2, DL_y2, DL_Weight, DL_Color

  if App == 'FW' then do
    if DL_Weight == 'HL' then DL_Weight = 'Hairline'
    else if DL_Weight == 0 then DL_Weight = 'None'

    LINEPREFS LINEWT DL_Weight LINECOLOR '"'DL_Color'"'
    DRAWLINE 1 DL_x1 DL_y1 DL_x2 DL_y2
  end
  else if App == 'PGS' then do
    if DL_Weight == 'HL' then DL_Weight = '0.3pt'
    else DL_Weight = DL_Weight'pt'

    DRAWLINE DL_x1 DL_y1 DL_x2 DL_y2 WINDOW winName
    STROKED ON OBJECT WINDOW winName
    SETSTROKEWEIGHT DL_Weight STROKENUMBER 0 OBJECT
    SETCOLORSTYLE '"'DL_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
  end
  return
/**/

/***//*******  DrawMiniCal (DMC) Subroutine  ***********/
DrawMiniCal:
  parse arg DMC_MiniDirection, DMC_CalWidth, DMC_FontType

  DMC_ColumnWidth = DMC_CalWidth/8
  DMC_BoxCount = 0

  DMC_MiniMonth = Month + DMC_MiniDirection
  if DMC_MiniMonth == 0 | DMC_MiniMonth == 13 then do
    DMC_MiniMonth = abs(DMC_MiniMonth - 12)
    Year = EnteredYear + DMC_MiniDirection
  end
  else Year = EnteredYear
  Mn = right(DMC_MiniMonth, 2, '0')
  if DoHighlights == 1 then call SetHighlights

  if DMC_MiniDirection < 0 then do
    DMC_StartColumn = StartDate - MonthLength.DMC_MiniMonth//7
    If DMC_StartColumn < 0 then DMC_StartColumn = DMC_StartColumn + 7
    DMC_MiniCalLeft = Margin.Left + ShiftLMini
  end
  else if DMC_MiniDirection > 0 then do
    DMC_StartColumn = StartDate + MonthLength.Month//7
    If DMC_StartColumn > 6 then DMC_StartColumn = DMC_StartColumn - 7
    DMC_MiniCalLeft = FullWidth - Margin.Right - DMC_CalWidth + ShiftRMini
  end
  else do
    DMC_StartColumn = StartDate
    DMC_MiniCalLeft = Margin.Left + c * (DMC_CalWidth + MiniCalSpacing)
  end

  /* Print Month & Year */
  DMC_ID.0 = PrintText(1, Margin.Top, DMC_FontType, 'N', Color.MiniCal, Width.DMC_FontType, Month.DMC_MiniMonth' 'Year)
  call UpdateBusy(Req, 1)
  if App == 'FW' then do
    Redraw
    GetObjectCoords DMC_ID.0; Parse var RESULT . . DMC_Text.Top DMC_Text.Width .
    DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
    SetObjectCoords DMC_ID.0 1 DMC_Text.Left DMC_Text.Top DMC_Text.Width Height.DMC_FontType
  end
  else if App == 'PGS' then do
    GETTEXTOBJ POSITION DMC_Text OBJECTID DMC_ID.0 WINDOW winName
    DMC_Text.Width = DMC_Text.Right - DMC_Text.Left
    DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
    EDITTEXTOBJ POSITION DMC_Text.Left DMC_Text.Top (DMC_Text.Left + DMC_Text.Width) DMC_Text.Bottom OBJECTID DMC_ID.0 WINDOW winName
  end

  /* Print Days */
  DMC_Column = DMC_StartColumn
  DMC_Day = 0
  DMC_Row = 1
  Do Until DMC_Day = MonthLength.DMC_MiniMonth
    DMC_Day = DMC_Day + 1
    DMC_Char1 = left(right(DMC_Day, 2, ' '), 1)
    DMC_Char2 = right(DMC_Day, 1)
    if (Highlight.DMC_MiniMonth.DMC_Day == '') | (symbol('Highlight.DMC_MiniMonth.DMC_Day') == 'LIT') then do
      DMC_Style = 'N'
      if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest * 2 - NormalWidth.DMC_Char1 - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
      else DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
    end
    else do
      DMC_Style = 'B'
      if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest * 2 - BoldWidth.DMC_Char1 - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
      else DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
    end

    DMC_Text.Right = (DMC_Column + 1.5) * DMC_ColumnWidth
    DMC_Text.Top   = Margin.Top + DMC_Row*Height.DMC_FontType

    DMC_Text.Left = DMC_MiniCalLeft + DMC_Text.Right - DMC_CenterAdj
    DMC_ID.DMC_Day = PrintText(DMC_Text.Left, DMC_Text.Top, DMC_FontType, DMC_Style, Color.MiniCal, Width.DMC_FontType, DMC_Day)
    call UpdateBusy(Req, 1)

    if pos('#', Highlight.DMC_MiniMonth.DMC_Day) > 0 then do
      DMC_BoxCount = DMC_BoxCount + 1
      DMC_Box.Left = DMC_MiniCalLeft + (DMC_Column + .5) * DMC_ColumnWidth
      DMC_BoxID.DMC_BoxCount = DrawBox(DMC_Box.Left, DMC_Text.Top - (Height.DMC_FontType * ((1 - TextAdj) / 3) * (App == 'FW')), DMC_ColumnWidth, Height.DMC_FontType, 'HL', Line.MiniCal, 0, Black$, 1)
      if App == 'FW' then OBJECTTOBACK
      else if App == 'PGS' then SENDTOBACK OBJECTID DMC_BoxID.DMC_BoxCount WINDOW winName
    end

    DMC_Column = DMC_Column + 1
    if DMC_Column == 7 then do
      DMC_Column = 0
      DMC_Row = DMC_Row + 1
    end
  end

  call DrawBox(DMC_MiniCalLeft, Margin.Top, DMC_CalWidth, 7*Height.DMC_FontType, 'HL', Line.MiniCal, 1, Background.MiniCal, 1)
  call UpdateBusy(Req, 1)

  if App == 'FW' then do
    REDRAW
    do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT DMC_ID.DMC_i MULTIPLE; End
    do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT DMC_BoxID.DMC_i MULTIPLE; End
    GROUP
  end
  if App == 'PGS' then do
    do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT ObjectID DMC_ID.DMC_i Add WINDOW winName; End
    do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT ObjectID DMC_BoxID.DMC_i Add WINDOW winName; End
    GROUP WINDOW winName
  end
return
/**/

/***//*******  DrawMoon (DM) Subroutine  ***********/
DrawMoon:
  parse arg DM_Phase, DM_CtrX, DM_CtrY, DM_Color

  if App == 'FW' then do
    if (DM_Phase == 'N') | (DM_Phase == 'F') then do
      if DM_Phase == 'N' then DM_FillColor = DM_Color
      else DM_FillColor = White$
      OVALPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_FillColor'"'
      DRAWOVAL 1 (DM_CtrX - MoonRadius) (DM_CtrY - MoonRadius) (2 * MoonRadius) (2 * MoonRadius)
      DM_id = result
    end
    else do
      SHAPEPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_Color'"'
      if DM_Phase == 1 then DM_HalfID = DrawHalf('R')
      else DM_HalfID = DrawHalf('L')
      SHAPEPREFS FILLCOLOR '"'White$'"'
      if DM_Phase == 1 then DM_Half2ID = DrawHalf('L')
      else DM_Half2ID = DrawHalf('R')
      SELECTOBJECT DM_HalfID
      SELECTOBJECT DM_Half2ID Multiple
      GROUP
      CURRENTOBJECT; DM_id = result
    end
  end
  else if App == 'PGS' then do
    if (DM_Phase == 'N') | (DM_Phase == 'F') then do
      DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius WINDOW winName
      DM_id = result
      if DM_Phase == 'N' then call SetFill(DM_id, DM_Color, DM_Color)
      else call SetFill(DM_id, DM_Color, White$)
    end
    else do
      DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
      DM_LHalfID = result
      if DM_Phase == 1 then call SetFill(DM_LHalfID, DM_Color, White$)
      else call SetFill(DM_LHalfID, DM_Color, DM_Color)
      DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
      DM_RHalfID = result
      if DM_Phase == 1 then call SetFill(DM_RHalfID, DM_Color, DM_Color)
      else call SetFill(DM_RHalfID, DM_Color, White$)
      SELECTOBJECT OBJECTID DM_LHalfID Add WINDOW winName
      GROUP WINDOW winName; DM_id = result
    end
  end

  return DM_id
/**/

/***//*******  EditHighlight (EH) Subroutine  ***********/
EditHighlight:
  do i = 0 to 6
    val = i - StartWeek
    if val < 0 then val = 7 + val
    interpret 'Day.'D.i '=' val
    interpret 'Day.val = 'D.i'$'
  end

  EH_WeekendCyc.0     = "OK"
  EH_WeekendCyc.1     = "P"
  EH_WeekendCyc.2     = "N"
  EH_WeekendCyc.OK    = 0
  EH_WeekendCyc.P     = 1
  EH_WeekendCyc.N     = 2

  EH_WeekTypeCyc.0    = "All"
  EH_WeekTypeCyc.1    = "Odd"
  EH_WeekTypeCyc.2    = "Even"
  EH_WeekTypeCyc.All  = 0
  EH_WeekTypeCyc.Odd  = 1
  EH_WeekTypeCyc.Even = 2

  EH_HighlightTypeCyc.Fixed      = 0
  EH_HighlightTypeCyc.Float      = 1
  EH_HighlightTypeCyc.BiOrWeekly = 2
  EH_HighlightTypeCyc.0          = 'Fixed'
  EH_HighlightTypeCyc.1          = 'Float'
  EH_HighlightTypeCyc.2          = 'BiOrWeekly'

  EH_KeywordCode.00 = 'Highlight'
  EH_KeywordCode.01 = 'Image'
  EH_KeywordCode.10 = 'CalculateDate'
  EH_KeywordCode.11 = 'CalculateImage'
  EH_KeywordCode.20 = 'CalculateDate'
  EH_KeywordCode.21 = 'CalculateImage'

  EH_EntryCount   = 0
  EH_EventDay     = 0

  EH_Year = left(date('S'),4)
  interpret 'EH_StartYear = Day.'DateInfo('W', EH_Year'0101', 'S')
  EH_YearOffset = 7 - EH_StartYear
  if EH_YearOffset == 7 then EH_YearOffset = 0

  EH_SelectMonth = right(EH_SelectMonth, 2, '0')
  EH_MonthCount = MonthCount.EH_SelectMonth
  EH_Month = EH_SelectMonth - 0
  if EH_Month > 12 then EH_Month = 1
  EH_Month = right(EH_Month, 2, "0")
  EH_ShortMonth = EH_Month - 0

  interpret 'EH_StartDate = Day.'DateInfo('W', EH_Year''EH_Month'01', 'S')

  /* Read data here */
  if EH_MonthCount > 0 then do
    do EH_j = 1 to EH_MonthCount
      EH_EntryCount = EH_EntryCount + 1
      if EH_SelectMonth < 14 then HighlightData.EH_SelectMonth.EH_j = substr(HighlightData.EH_SelectMonth.EH_j, 3)
      if symbol('HighlightData.EH_SelectMonth.EH_j') == 'VAR' then do
        EH_HighlightData = strip(HighlightData.EH_SelectMonth.EH_j)
        if right(EH_HighlightData, 2) == '*/' then do
          EH_StartComment = lastpos('/*', EH_HighlightData)
          EH_Comment.EH_EntryCount = strip(substr(EH_HighlightData, EH_StartComment), 'B', ' /*')
          EH_HighlightData = strip(left(EH_HighlightData, EH_StartComment - 1))
        end
        else EH_Comment.EH_EntryCount = ''

        EH_Keyword = word(EH_HighlightData, 1)
        EH_FirstDot = pos('.', EH_Keyword)
        EH_FirstParen = pos('(', EH_Keyword)
        if EH_FirstDot == 0 then EH_EndOfKeyword = EH_FirstParen
        else if EH_FirstParen == 0 then EH_EndOfKeyword = EH_FirstDot
        else EH_EndOfKeyword = min(pos('.', EH_Keyword), pos('(', EH_Keyword))
        EH_Keyword.EH_EntryCount = left(EH_Keyword, EH_EndOfKeyword - 1)
        if (upper(EH_Keyword.EH_EntryCount) == 'HIGHLIGHT') | (upper(EH_Keyword.EH_EntryCount) == 'IMAGE') then do
          EH_HighlightType.EH_EntryCount = 'Fixed'
          EH_EventDay.EH_EntryCount = substr(EH_Keyword, lastpos('.', EH_Keyword) + 1)
          EH_Event.EH_EntryCount = substr(EH_HighlightData, pos('=', EH_HighlightData) + 1)
          if upper(EH_Keyword.EH_EntryCount) == 'IMAGE' then do
            if (pos(':', EH_Event.EH_EntryCount) == 0) & (pos('/', EH_Event.EH_EntryCount) == 0) then do
              EH_Event.EH_EntryCount = ScriptDir'Images/'strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
            end
          end
        end
        else do
          EH_HighlightData = strip(substr(EH_HighlightData, EH_EndOfKeyword + 1), 'B', ')')
          if EH_SelectMonth == 14 then do
            parse var EH_HighlightData EH_EventDay.EH_EntryCount','EH_Event.EH_EntryCount
            EH_EventDay.EH_EntryCount = strip(EH_EventDay.EH_EntryCount)
            EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount)
            EH_HighlightType.EH_EntryCount = 'Easter'
            EH_Keyword.EH_EntryCount = 'CalculateEDate'
          end
          else do
            parse var EH_HighlightData .','EH_DayOfWeek','EH_HighDate','EH_Event.EH_EntryCount
            interpret "EH_DayOfWeek = Day."strip(EH_DayOfWeek, 'B', ' "'||"'")
            EH_HighDate = strip(EH_HighDate)
            EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount)
            if pos('IMAGE', upper(EH_Keyword.EH_EntryCount)) > 0 then do
              if (pos(':', EH_Event.EH_EntryCount) == 0) & (pos('/', EH_Event.EH_EntryCount) == 0) then do
                EH_Event.EH_EntryCount = ScriptDir'Images/'strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
              end
            end
            if datatype(EH_HighDate) == 'CHAR' then do
              /* Weekly/Biweekly events */
              EH_HighlightType.EH_EntryCount = 'BiOrWeekly'
              EH_WeekType.EH_EntryCount = upper(EH_HighDate)
              EH_EventOffset = EH_DayOfWeek - EH_StartDate
              EH_EventDay.EH_EntryCount  = 1 + EH_EventOffset
              if EH_EventDay.EH_EntryCount < 1 then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount + 7
              EH_WN = trunc((right(DateInfo('J', EH_Year''EH_Month''right(EH_EventDay.EH_EntryCount, 2, '0'), 'S'), 3) - EH_YearOffset - 1)/7 + 1)
              if (EH_WeekType.EH_EntryCount == 'EVEN') & (EH_WN//2 == 1) then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount  + 7
              else if (EH_WeekType.EH_EntryCount == 'ODD') & (EH_WN//2 == 0) then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount  + 7
            end
            else do
              EH_HighlightType.EH_EntryCount = 'Float'
              interpret 'EH_First = Day.'DateInfo('W', EH_Year''EH_Month'01', 'S')
              EH_EventDay.EH_EntryCount = EH_HighDate + (EH_DayOfWeek - EH_First)
              if EH_First < EH_DayOfWeek then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount - 7
              EH_TempDay = EH_EventDay.EH_EntryCount
              EH_Weeknumber.EH_EntryCount = 0
              if EH_HighDate > 28 then EH_Weeknumber.EH_EntryCount = 4
              else do
                do until EH_TempDay < 0
                  EH_TempDay = EH_TempDay - 7
                  if EH_TempDay > 0 then EH_Weeknumber.EH_EntryCount = EH_Weeknumber.EH_EntryCount + 1
                end
              end
            end
          end
        end

        if datatype(EH_EventDay.EH_EntryCount) == 'CHAR' then do
          EH_Weekend.EH_EntryCount = upper(right(EH_EventDay.EH_EntryCount, 1))
          EH_EventDay.EH_EntryCount = left(EH_EventDay.EH_EntryCount, length(EH_EventDay.EH_EntryCount) - 1)
        end
        else EH_Weekend.EH_EntryCount = 'OK'

        if EH_EventDay.EH_EntryCount == '32' then EH_EventDay.EH_EntryCount = 'LD'

        EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
        if right(EH_Event.EH_EntryCount, 1) == '#' then do
          EH_Holiday.EH_EntryCount = 128
          EH_Event.EH_EntryCount = left(EH_Event.EH_EntryCount, length(EH_Event.EH_EntryCount) - 1)
        end
        else EH_Holiday.EH_EntryCount = 0
      end

      do EH_k = 1 to EH_EntryCount - 1
        EH_Seq = EH_Pointer.EH_k
        if EH_EventDay.EH_EntryCount < EH_EventDay.EH_Seq then do
          do EH_l = EH_EntryCount - 1 to EH_k by -1
            EH_Next = EH_l + 1
            EH_Pointer.EH_Next = EH_Pointer.EH_l
          end
        leave
        end
      end
      EH_Pointer.EH_k = EH_EntryCount
    end
  end

  EH_HighEntry = EH_EntryCount
  if EH_EntryCount > 0 then do
    EH_CurrentPointer = 1
    EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
  end
  else do
    EH_CurrentEntry = 0
    EH_CurrentPointer = 0
  end
  EH_DayShowing = 0

  GadID.  = ''
  EH_Arg. = ''
  EH_i    = 0
  EH_Day  = 0
  Req     = OpenBusy(PrepReq$'...', 45)
  do while (EH_i < 6)
    EH_j = 0
    do while (EH_j < 7)
      call UpdateBusy(Req, 1)
      EH_SerialPosition = (EH_i * 7) + EH_j
      EH_Button = EH_SerialPosition + 1
      if (EH_SerialPosition >= EH_StartDate) & (EH_SerialPosition < EH_StartDate + MonthLength.EH_ShortMonth + 1) then Do
        EH_Day = EH_Day + 1
        if EH_Day > MonthLength.EH_ShortMonth then EH_Day = LD
        interpret "GadID."EH_Button" = bguitoggle('"EH_Button"_', EH_Day)"
        GadID = GetID(EH_Button'_')
        EH_Button.EH_Button = GadID
        EH_Arg.GadID = EH_Day
        EH_ButtonID.EH_Day = EH_Button
      end
      else do
          interpret "GadID."EH_Button" = bguibutton('"EH_Button"_', '')"
          GadID = GetID(EH_Button'_')
          EH_Button.EH_Button = GadID
          EH_Arg.GadID = 'dummy'
      end
      EH_j = EH_j + 1
    end
    EH_i = EH_i + 1
    if EH_SerialPosition >= EH_StartDate + MonthLength.EH_ShortMonth then leave
  end

  DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
                bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
                bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
                bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  if EH_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  if EH_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)

  call bguilist("EH_monthlist_", January$, February$, March$, April$, May$, June$, July$, August$, September$, October$, November$, December$, All$, Easter$)
  call bguilist("EH_highlighttypelist_", Fixed$, Floating$, BiOrWeekly$)
  call bguilist("EH_weeknumberlist_", First$, Second$, Third$, Fourth$, Last$)
  call bguilist("EH_weektypelist_", All$, Odd$, Even$)
  call bguilist("EH_weekendlist_", OK2$, PreviousDay$, NextDay$)

  EH_g=bguivgroup(,
    bguihgroup(,
      bguistring("EH_event_",Event$":","",256)bguilayout(LGO_FixMinHeight,1)||,
      bguiibutton('EH_eventimage_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
      bguibutton('EH_prev_','<')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
      bguibutton("EH_next_",'>')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
    )||,
    bguihgroup(,
      bguistring('EH_comment_',Comment$":","",256)bguilayout(LGO_FixMinHeight,1),
    )||,
    bguihgroup(,
      bguivgroup(,
        bguihgroup(,
          bguivarspace(40)||,
          bguicycle('changemonth_',,"EH_monthlist_")bguilayout(LGO_FixMinHeight, 1)||,
          bguivarspace(40),
        )||,
        bguihgroup(,
          bguiinfo("EH_dummy_",,esc"c"left(Day.0,1))||,
          bguiinfo("EH_dummy_",,esc"c"left(Day.1,1))||,
          bguiinfo("EH_dummy_",,esc"c"left(Day.2,1))||,
          bguiinfo("EH_dummy_",,esc"c"left(Day.3,1))||,
          bguiinfo("EH_dummy_",,esc"c"left(Day.4,1))||,
          bguiinfo("EH_dummy_",,esc"c"left(Day.5,1))||,
          bguiinfo("EH_dummy_",,esc"c"left(Day.6,1)),
        )||,
        DateButtons,
      )||,
      bguivgroup(,
        bguivarspace(40)||,
        bguicycle('EH_highlighttype_',esc"r"Type$':','EH_highlighttypelist_')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
        bguicycle("EH_weeknumber_",esc"r"WeekNumber$':',"EH_weeknumberlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguicycle('EH_weektype_',esc"r"WeekType$":",'EH_weektypelist_')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
        bguicycle("EH_weekend_",esc"r"Weekend$":",'EH_weekendlist_')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguicheckbox("EH_holiday_",esc"r"Holiday$":",0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguihgroup(,
          bguistring("EH_easter_",Easter$':',,4)bguilayout(LGO_FixMinHeight,1)||,
          bguivarspace(40),
        )||,
        bguihgroup(,
          bguibutton("EH_new_",AddEvent$)bguilayout(LGO_FixMinHeight,1)||,
          bguibutton("EH_delete_",DeleteEvent$)bguilayout(LGO_FixMinHeight,1),
        )||,
        bguihgroup(,
          bguibutton("EH_done_",Done$)bguilayout(LGO_FixMinHeight,1),
        ),
      ),
    ),
  ,"-1","-1")

  call UpdateBusy(Req, 1)
  EH_winID=bguiwindow(EnterEventInfo$,EH_g,5,0,,PubScreen)
  call UpdateBusy(Req, 1)

  call bguiwintabcycleorder(EH_winID,obj.EH_event_||obj.EH_comment_)
  if EH_EntryCount == 0 then call EH_GhostGads
  else if EH_SelectMonth == 14 then do
    call EH_GhostGads
    call EH_SetGads
  end
  else do
    do EH_i = 1 to EH_Button
      EH_temp = EH_Button.EH_i
      if EH_Arg.EH_temp == 'dummy' then interpret "call bguiset(obj."EH_i"_,EH_winID, GA_Disabled, 1)"
    end
  end

  call bguiset(obj.changemonth_,EH_winID,CYC_Active,EH_SelectMonth - 1)

  EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
  call EH_SetRequester
  if EH_EntryCount > 0 then EH_DayShowing = EH_EventDay.EH_CurrentEntry
  if bguiwinopen(EH_winID)=0 then bguierror(12)

  if Req ~= 0 then do
    call bguiwinclose(Req)
    Req = 0
  end

  id=0
  EH_Done = 0
  do until EH_Done ~= 0
    call bguiwinwaitevent(EH_winID,"ID")
    select
      when (id == id.EH_cancel_) | (id == id.winclose) then do
        call bguiwinclose(EH_winID)
        EH_Done = 1
      end
      when id == id.EH_done_ then do
        call EH_SaveHighlightData
        EH_Done = 1
      end
      when id == id.EH_event_ then EH_Event.EH_CurrentEntry = bguiget(obj.EH_event_, STRINGA_TextVal)
      when id == id.EH_prev_ then do
        call EH_ReadSettings
        EH_CurrentPointer = EH_CurrentPointer - 1
        EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
        call EH_SetRequester
        EH_DayShowing = EH_EventDay.EH_CurrentEntry
      end
      when id == id.EH_next_ then do
        call EH_ReadSettings
        EH_CurrentPointer = EH_CurrentPointer + 1
        EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
        call EH_SetRequester
        EH_DayShowing = EH_EventDay.EH_CurrentEntry
      end
      when id == id.EH_eventimage_ then do
        EH_DataFile = bguifilereq(ScriptDir'Images/', SelectImage$, EH_winID)
        if ~exists(EH_DataFile) then do
          call bguireq(EH_DataFile' 'CantFind$'...','*'OK$,'FWCalendar 'Notice$,EH_winID)
          EH_DataFile = ''
        end
        else call bguiset(obj.EH_event_, EH_winID, STRINGA_TextVal,EH_DataFile)
      end
      when id == id.changemonth_ then do
        call EH_SaveHighlightData
        EH_SelectMonth = bguiget(obj.changemonth_,CYC_Active) + 1
        call bguiwinclose(EH_winID)
        EH_Done = 2
      end
      when id == id.EH_highlighttype_ then do
        EH_HighlightType = bguiget(obj.EH_highlighttype_,CYC_Active)
        EH_HighlightType.CurrentEntry = EH_HighlightTypeCyc.EH_HighlightType
        select
          when EH_HighlightType.CurrentEntry == 'Fixed' then call EH_SetFixed
          when EH_HighlightType.CurrentEntry == 'Float' then do
            call EH_SetFloat
            call EH_CheckWeekNumber
          end
          when EH_HighlightType.CurrentEntry == 'BiOrWeekly' then do
            call EH_SetBiOrWeekly
            call EH_CheckWeekType
          end
        end
      end
      when id == id.EH_weeknumber_ then do
        if EH_EventDay.EH_CurrentEntry > 0 then do
          EH_GadgetID = EH_ButtonID.EH_DayShowing
          interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
          EH_EventDay = EH_EventDay.EH_CurrentEntry
          EH_Weeknumber.EH_CurrentEntry = bguiget(obj.EH_weeknumber_,CYC_Active)

          do until EH_EventDay < 1
            EH_EventDay = EH_EventDay - 7
          end
          do EH_i = 0 to EH_Weeknumber.EH_CurrentEntry
            EH_EventDay = EH_EventDay + 7
          end
          if EH_EventDay > MonthLength.EH_ShortMonth then EH_EventDay = EH_EventDay - 7

          EH_GadgetID = EH_ButtonID.EH_EventDay
          interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
          EH_EventDay.EH_CurrentEntry = EH_EventDay
          EH_DayShowing = EH_EventDay
        end
      end
      when id == id.EH_weektype_ then do
        if EH_EventDay.EH_CurrentEntry > 0 then do
          EH_GadgetID = EH_ButtonID.EH_DayShowing
          interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
          EH_EventDay = EH_EventDay.EH_CurrentEntry
          EH_TempWeek = bguiget(obj.EH_weektype_,CYC_Active)
          if (EH_TempWeek ~= 0) & (EH_Week ~= EH_TempWeek) then do
            if EH_EventDay - 7 < 1 then EH_EventDay = EH_EventDay + 7
            else EH_EventDay = EH_EventDay - 7
          end
          EH_GadgetID = EH_ButtonID.EH_EventDay
          interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
          EH_EventDay.EH_CurrentEntry = EH_EventDay
          EH_DayShowing = EH_EventDay
          EH_Week = EH_TempWeek
        end
      end
      when id == id.EH_new_ then do
        call EH_ReadSettings
        if EH_DayShowing ~= 0 then do
          EH_GadgetID = EH_ButtonID.EH_DayShowing
          interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
        end
        EH_EntryCount = EH_EntryCount + 1
        EH_CurrentPointer = EH_EntryCount
        EH_HighEntry = EH_HighEntry + 1
        EH_Pointer.EH_CurrentPointer = EH_HighEntry
        EH_CurrentEntry = EH_HighEntry
        call EH_CreateEntry
        call EH_SetGads
        call EH_SetRequester
      end
      when id == id.EH_delete_ then do
        call EH_ReadSettings
        if EH_EntryCount == 1 then do
          EH_CurrentEntry   = 0
          EH_CurrentPointer = 0
          EH_EntryCount     = 0
        end
        else do
          do EH_i = EH_CurrentPointer to EH_EntryCount - 1
            EH_NextPointer = EH_i + 1
            EH_Pointer.EH_i = EH_Pointer.EH_NextPointer
          end
          EH_EntryCount = EH_EntryCount - 1
          EH_CurrentPointer = min(EH_CurrentPointer, EH_EntryCount)
          EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
        end
        call EH_SetRequester
        EH_DayShowing = EH_EventDay.EH_CurrentEntry
      end
      when (datatype(EH_Arg.id) == 'NUM') | (EH_Arg.id == 'LD') then do
        if EH_Arg.id == EH_DayShowing then do
          /* Re-set current date button */
          EH_GadgetID = EH_ButtonID.EH_DayShowing
          interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
        end
        else do
          /* Clear previous date button if necessary */
          if EH_DayShowing ~= 0 then do
            EH_GadgetID = EH_ButtonID.EH_DayShowing
            interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
          end
          /* Set current date button */
          EH_DayShowing = EH_Arg.id
          EH_GadgetID = EH_ButtonID.EH_DayShowing
          interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
          EH_EventDay.EH_CurrentEntry = EH_Arg.id

          /* Check for impacts of change */
          if EH_HighlightType.CurrentEntry == 'Float' then call EH_CheckWeekNumber
          else if EH_HighlightType.CurrentEntry == 'BiOrWeekly' then call EH_CheckWeekType
        end
      end
      otherwise nop
    end
  end
  return EH_Done

/***//*******  EH_CheckWeekNumber Subroutine  *********/
EH_CheckWeekNumber:
  EH_TempDay = EH_EventDay.EH_CurrentEntry
  EH_Weeknumber.EH_CurrentEntry = 0

  do until EH_TempDay < 0
    EH_TempDay = EH_TempDay - 7
    if EH_TempDay > 0 then EH_Weeknumber.EH_CurrentEntry = EH_Weeknumber.EH_CurrentEntry + 1
  end
  call bguiset(obj.EH_weeknumber_, EH_winID, CYC_Active, EH_Weeknumber.EH_CurrentEntry)

  return
/**/

/***//*******  EH_CheckWeekType Subroutine  *********/
EH_CheckWeekType:
  interpret 'EH_StartYear = Day.'DateInfo('W', EH_Year'0101', 'S')
  EH_YearOffset = 7 - EH_StartYear
  if EH_YearOffset == 7 then EH_YearOffset = 0
  EH_Week = 2 - (trunc((right(DateInfo('J', EH_Year''EH_Month''right(EH_EventDay.EH_CurrentEntry, 2, '0'), 'S'), 3) - EH_YearOffset - 1)/7 + 1))//2
  call bguiset(obj.EH_weektype_, EH_winID, CYC_Active, EH_Week)
  return
/**/

/***//*******  EH_CreateEntry Subroutine  *********/
EH_CreateEntry:
  EH_Event.EH_CurrentEntry    = ''
  EH_Comment.EH_CurrentEntry  = ''
  EH_EventDay.EH_CurrentEntry = 1
  EH_Holiday.EH_CurrentEntry  = 0

  if EH_SelectMonth < 14 then do
    EH_HighlightType.EH_CurrentEntry = 'Fixed'
    EH_Keyword.EH_CurrentEntry       = 'Highlight'
    EH_Weekend.EH_CurrentEntry       = 'OK'
    EH_DayShowing                    = 1
  end

  return
/**/

/***//*******  EH_GhostGads Subroutine  *********/
EH_GhostGads:
  do EH_i = 1 to EH_Button
    interpret "call bguiset(obj."EH_i"_,EH_winID, GA_Disabled, 1, GA_Selected, 0)"
  end
  call bguiset(obj.EH_event_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_event_, EH_winID, STRINGA_TextVal,'')
  call bguiset(obj.EH_comment_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_comment_, EH_winID, STRINGA_TextVal,'')
  call bguiset(obj.EH_eventimage_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_highlighttype_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_holiday_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_easter_,EH_winID, GA_Disabled, 1)
  call bguiset(obj.EH_easter_, EH_winID, STRINGA_TextVal,'')
  call bguiset(obj.EH_delete_,EH_winID, GA_Disabled, 1)
  return
/**/

/***//*******  EH_ReadSettings Subroutine  *********/
EH_ReadSettings:
  EH_Event.EH_CurrentEntry = bguiget(obj.EH_event_, STRINGA_TextVal)
  EH_Comment.EH_CurrentEntry = bguiget(obj.EH_comment_, STRINGA_TextVal)

  parse var EH_Event.EH_CurrentEntry EH_Image','EH_X','EH_Y
  if exists(EH_Image) then EH_Image = 1
  else EH_Image = 0
  if EH_SelectMonth < 14 then do
    EH_HighlightType = bguiget(obj.EH_highlighttype_,CYC_Active)
    interpret 'EH_HighlightType.EH_CurrentEntry = EH_HighlightTypeCyc.'EH_HighlightType
    interpret 'EH_Keyword.EH_CurrentEntry = EH_KeywordCode.'EH_HighlightType''EH_Image
    EH_Weeknumber.EH_CurrentEntry = bguiget(obj.EH_weeknumber_,CYC_Active)
    interpret 'EH_WeekType.EH_CurrentEntry = EH_WeekTypeCyc.'bguiget(obj.EH_weektype_,CYC_Active)
    interpret 'EH_Weekend.EH_CurrentEntry = EH_WeekendCyc.'bguiget(obj.EH_weekend_,CYC_Active)
  end
  else EH_EventDay.EH_CurrentEntry = bguiget(obj.EH_easter_, STRINGA_TextVal)

  EH_Holiday.EH_CurrentEntry = bguiget(obj.EH_holiday_, GA_Selected)
  return
/**/

/***//*******  EH_SaveHighlightData Subroutine  *********/
EH_SaveHighlightData:
  call EH_ReadSettings

  do EH_i = 1 to EH_EntryCount
    EH_CurrentPointer = EH_i
    EH_CurrentEntry   = EH_Pointer.EH_CurrentPointer

    EH_EventDay = EH_EventDay.EH_CurrentEntry
    if EH_EventDay == 'LD' then EH_EventDay = 32
    if pos('"', EH_Event.EH_CurrentEntry) == 0 then EH_QuoteChar = '"'
    else QuoteChar = "'"
    if EH_Holiday.EH_CurrentEntry == 128 then EH_Event.EH_CurrentEntry = EH_Event.EH_CurrentEntry'#'
    if EH_Weekend.EH_CurrentEntry ~= 'OK' then EH_EventDay = EH_EventDay''EH_Weekend.EH_CurrentEntry
    if (upper(EH_Keyword.EH_CurrentEntry) == 'HIGHLIGHT') | (upper(EH_Keyword.EH_CurrentEntry) == 'IMAGE') then do
      EH_DataLine = EH_SelectMonth''EH_Keyword.EH_CurrentEntry'.'EH_SelectMonth - 0'.'EH_EventDay' = '
      EH_DataLine = EH_DataLine''EH_QuoteChar''EH_Event.EH_CurrentEntry''EH_QuoteChar
    end
    else if (upper(EH_Keyword.EH_CurrentEntry) == 'CALCULATEDATE') | (upper(EH_Keyword.EH_CurrentEntry) == 'CALCULATEIMAGE') then do
      EH_DayOfWeek = DateInfo('W', EH_Year''EH_Month''right(EH_EventDay.EH_CurrentEntry, 2, '0'), 'S')

      if EH_HighlightType.EH_CurrentEntry == 'Float' then do
        interpret 'EH_DayNumber = Day.'EH_DayOfWeek
        if EH_Weeknumber.EH_CurrentEntry < 4 then do
          EH_DayNumber = EH_DayNumber + 1
          if EH_DayNumber == 7 then EH_DayNumber = 0
          interpret 'EH_DayOfWeek = D.'EH_DayNumber
          EH_EventDay = 7 * (EH_Weeknumber.EH_CurrentEntry + 1)
        end
        else do
          EH_EventDay = Monthlength.EH_ShortMonth
          EH_TempDay = Monthlength.EH_ShortMonth - 29
          EH_DayNumber = EH_DayNumber - EH_TempDay
          if EH_DayNumber < 0 then EH_DayNumber = EH_DayNumber + 7
          else if EH_DayNumber > 6 then EH_DayNumber = EH_DayNumber - 7
          interpret 'EH_DayOfWeek = D.'EH_DayNumber
        end
      end
      else EH_EventDay = "'"EH_WeekType.EH_CurrentEntry"'"

      EH_DataLine = EH_SelectMonth''EH_Keyword.EH_CurrentEntry'('EH_SelectMonth - 0',"'EH_DayOfWeek'",'EH_EventDay','
      EH_DataLine = EH_DataLine''EH_QuoteChar''EH_Event.EH_CurrentEntry''EH_QuoteChar')'
    end
    else if EH_SelectMonth == 14 then do
      EH_DataLine = 'CalculateEDate('EH_EventDay.EH_CurrentEntry','
      EH_DataLine = EH_DataLine''EH_QuoteChar''EH_Event.EH_CurrentEntry''EH_QuoteChar')'
    end
    if EH_Comment.EH_CurrentEntry ~= '' then EH_DataLine = EH_DataLine'  /* 'EH_Comment.EH_CurrentEntry' */'
    HighlightData.EH_SelectMonth.EH_i = EH_DataLine
  end
  MonthCount.EH_SelectMonth = EH_EntryCount
  call bguiwinclose(EH_winID)
  return
/**/

/***//*******  EH_SetBiOrWeekly Subroutine  *********/
EH_SetBiOrWeekly:
  EH_GadgetID = EH_ButtonID.LD
  interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Disabled, 1)"
  if EH_EventDay.EH_CurrentEntry == 'LD' then do
    interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
    EH_EventDay.EH_CurrentEntry = 1
    EH_GadgetID = EH_ButtonID.1
    interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
    EH_DayShowing = 1
  end
  call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 0)
  call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_easter_,EH_winID,GA_Disabled, 1)
  return
/**/

/***//*******  EH_SetFixed Subroutine  *********/
EH_SetFixed:
  EH_GadgetID = EH_ButtonID.LD
  interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Disabled, 0)"
  call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 0)
  call bguiset(obj.EH_easter_,EH_winID,GA_Disabled, 1)
  return
/**/

/***//*******  EH_SetFloat Subroutine  *********/
EH_SetFloat:
  EH_GadgetID = EH_ButtonID.LD
  interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Disabled, 1)"
  if EH_EventDay.EH_CurrentEntry == 'LD' then do
    interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
    EH_EventDay.EH_CurrentEntry = 1
    EH_GadgetID = EH_ButtonID.1
    interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
    EH_DayShowing = 1
  end
  call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 0)
  call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 1)
  call bguiset(obj.EH_easter_,EH_winID,GA_Disabled, 1)
  return
/**/

/***//*******  EH_SetGads Subroutine  *********/
EH_SetGads:
  if EH_SelectMonth ~= 14 then do
    do EH_i = 1 to EH_Button
      EH_temp = EH_Button.EH_i
      if EH_Arg.EH_temp ~= 'dummy' then interpret "call bguiset(obj."EH_i"_,EH_winID, GA_Disabled, 0)"
    end
    call bguiset(obj.EH_highlighttype_,EH_winID,GA_Disabled, 0)
    call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 0)
    call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 0)
    call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 0)
  end
  else call bguiset(obj.EH_easter_,EH_winID, GA_Disabled, 0)

  call bguiset(obj.EH_event_,EH_winID,GA_Disabled, 0)
  call bguiset(obj.EH_comment_,EH_winID,GA_Disabled, 0)
  call bguiset(obj.EH_eventimage_,EH_winID,GA_Disabled, 0)
  call bguiset(obj.EH_holiday_,EH_winID,GA_Disabled, 0)
  call bguiset(obj.EH_delete_,EH_winID, GA_Disabled, 0)
  return
/**/

/***//*******  EH_SetRequester Subroutine  *********/
call EH_SetRequester:
  /* Set 'Prev' & 'Next' gads */
  if EH_CurrentPointer < 2 then call bguiset(obj.EH_prev_,EH_winID,GA_Disabled, 1)
  else call bguiset(obj.EH_prev_,EH_winID,GA_Disabled, 0)
  if EH_CurrentPointer == EH_EntryCount then call bguiset(obj.EH_next_,EH_winID,GA_Disabled, 1)
  else call bguiset(obj.EH_next_,EH_winID,GA_Disabled, 0)

  if EH_EntryCount > 0 then do
    if EH_SelectMonth < 14 then do
      /* De-select existing date button */
      if EH_DayShowing ~= 0 then do
        EH_GadgetID = EH_ButtonID.EH_DayShowing
        interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
      end
      /* Select current date button */
      EH_EventDay = EH_EventDay.EH_CurrentEntry
      EH_GadgetID = EH_ButtonID.EH_EventDay
      EH_HighlightType = EH_HighlightType.EH_CurrentEntry
      interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"

      interpret 'call bguiset(obj.EH_highlighttype_,EH_winID,CYC_Active,EH_HighlightTypeCyc.'EH_HighlightType')'
      interpret 'call EH_Set'EH_HighlightType
      interpret 'call bguiset(obj.EH_weekend_,EH_winID,CYC_Active,EH_WeekendCyc.'EH_Weekend.EH_CurrentEntry')'
      call bguiset(obj.EH_holiday_,EH_winID,GA_Selected,EH_Holiday.EH_CurrentEntry)
      if EH_HighlightType == 'Float' then call EH_CheckWeekNumber
      else if EH_HighlightType == 'BiOrWeekly' then call EH_CheckWeekType
    end
    else call bguiset(obj.EH_easter_, EH_winID, STRINGA_TextVal,EH_EventDay.EH_CurrentEntry)

    /* Set event & comment */
    call bguiset(obj.EH_event_, EH_winID, STRINGA_TextVal,EH_Event.EH_CurrentEntry)
    call bguiset(obj.EH_comment_, EH_winID, STRINGA_TextVal,EH_Comment.EH_CurrentEntry)
  end
  else call EH_GhostGads

  return
/**/

/**/

/***//*******  GetFontWidth (GFW) Subroutine  *********/
GetFontWidth:
  parse arg GFW_FontType, GFW_FontStyle, GFW_Char

  GFW_ID = PrintText(.5, .5, GFW_FontType, GFW_FontStyle, Black$, Width.GFW_FontType, GFW_Char)
  if App == 'FW' then do
    REDRAW
    GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
    DELETEOBJECT GFW_ID
  end
  else if App == 'PGS' then do
    GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
    GFW_Width = GFW_Text.Right - GFW_Text.Left
    DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  end
return GFW_Width
/**/

/***//*******  GetHeight (GH) Subroutine  ***********/
GetHeight:
  parse arg GH_FontType

  if App == 'FW' then do
    TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
    DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
    GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  end
  else if App == 'PGS' then do
    DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
    SELECTTEXT AT 0 0 WINDOW winName
    BEGINCOMMANDCAPTURE
      SETLEADING RELATIVE 100
      SETTYPESIZE FSize.GH_FontType WINDOW winName
      SETFONT Font.GH_FontType WINDOW winName
    ENDCOMMANDCAPTURE
    INSERT 'A' WINDOW winName
    GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
    GH_Text.Height = GH_Text.Bottom - GH_Text.Top
    DELETEOBJECT OBJECTID GH_id WINDOW winName
  end
  return GH_Text.Height
/**/

/***//*******  GetID (GI) Subroutine  ***********/
GetID:
parse arg GI_var

return id.GI_var
/**/

/***//*******  GetLogInfo () Subroutine  ***********/
GetLogInfo:
  if ~exists(Storage'FWC'App'Temp.txt') then address command 'list >'Storage'FWC'App'Temp.txt 'AppName'#? lformat %N'
  if open('Temp', Storage'FWC'App'Temp.txt') ~= 0 then do
    do while ~eof('Temp')
      PgmName = readln('Temp')
      if pos('.', PgmName) == 0 then leave
    end
    call close('Temp')
  end

  if ~exists(Storage'FWC'App'VersionInfo.txt') then address command 'version >'Storage'FWC'App'VersionInfo.txt 'PgmName

  call open('Temp', Storage'FWC'App'VersionInfo.txt')
    address command 'copy 'Storage'FWC'App'VersionInfo.txt ram:versioninfo.txt'
    PgmVersion = readln('Temp')
  call close('Temp')

  if left(PgmVersion, 34) == 'Could not find version information' then do
    if App == 'FW' then do
      call open('Temp', CurrentDir''PgmName)
        /* Desired string at 325365 for v 5.06 */
        /* Desired string at 333771 for FW97   */
        FileOffset = 325300
        call seek('Temp', FileOffset, 'B')
        do until (EndPos ~= 0) | (PrevOffset = FileOffset)
          PrevOffset = FileOffset
          Chunk = readch('Temp', 10000)
          EndPos = pos('Created', Chunk)
          if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
        end
        if EndPos ~= 0 then do
          StartPos = lastpos('Final', Chunk, EndPos)
          EndPos = pos('00'x||'00'x, Chunk, StartPos)
          PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
        end
        else do
          FileOffset = 0
          call seek('Temp', FileOffset, 'B')
          do until (EndPos ~= 0) | (PrevOffset = FileOffset)
            PrevOffset = FileOffset
            Chunk = readch('Temp', 10000)
            EndPos = pos('FinalWriter 97', Chunk)
            if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
          end
          if EndPos ~= 0 then PgmVersion = 'FinalWriter 97'
          else PgmVersion = 'Final Writer - version unknown'
        end
      call close('Temp')
      call open('Temp', Storage'FWC'App'VersionInfo.txt', 'W')
        call writeln('Temp', PgmVersion)
      call close('Temp')
    end
    else PgmVersion = PgmName" - can't find version info"
  end

  return
/**/

/***//*******  GetMaxWidth (GMW) Subroutine  ***********/
GetMaxWidth:
  parse arg GMW_Stem, GMW_Count

  GMW_maxwidth = 0
  Do GMW_i = 0 to GMW_Count
    interpret 'GMW_ObjectID = 'GMW_Stem'.'GMW_i
    if App = 'FW' then do
      GETOBJECTCOORDS GMW_ObjectID
      Parse Var result . . . GMW_width .
    end
    else if App == 'PGS' then do
      SELECTOBJECT ObjectID GMW_ObjectID WINDOW winName
      GETTEXTOBJ POSITION GMW_Temp OBJECTID GMW_ObjectID WINDOW winName
      GMW_width = GMW_Temp.Right - GMW_Temp.Left
    end
    GMW_maxwidth = max(GMW_width, GMW_maxwidth)
  end

  return GMW_maxwidth
/**/

/***//*******  GetMiniMax (GMM) Subroutine  ***********/
GetMiniMax:
  parse arg GMM_FontType

  NormalWidth.Widest = 0
  BoldWidth.Widest = 0
  do GMM_i = 0 to 9
    NormalWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'N', Black$, Width.GMM_FontType, GMM_i)
    BoldWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'B', Black$, Width.GMM_FontType, GMM_i)
  end
  if App == 'FW' then REDRAW
  do GMM_i = 0 to 9
    NormalWidth.GMM_i = GetWidth(NormalWidthID.GMM_i)
    BoldWidth.GMM_i = GetWidth(BoldWidthID.GMM_i)
    NormalWidth.Widest = max(NormalWidth.Widest, NormalWidth.GMM_i)
    BoldWidth.Widest = max(BoldWidth.Widest, BoldWidth.GMM_i)
    if App == 'PGS' then do
      DELETEOBJECT OBJECTID NormalWidthID.GMM_i WINDOW winName
      DELETEOBJECT OBJECTID BoldWidthID.GMM_i WINDOW winName
    end
  end

  return
/**/

/***//*******  GetPhases (GP) Subroutine  ***********/
GetPhases:
  parse arg GP_Y, GP_Month

  if DateLib == 1 then do
    GP_Phase.0 = 'N'
    GP_Phase.1 = '1'
    GP_Phase.2 = 'F'
    GP_Phase.3 = '3'

    GP_JD = date_GregorianToJD(1, GP_Month, GP_Y)
    do GP_SeqDate = GP_JD - 22 to GP_JD + 39
      call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')

      do GP_Phase = 0 to 3
        GP_SeqDate = date_GregorianMoonPhase(GP_Day, GP_Month, GP_Year, GP_Phase)
        call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')
        MoonPhase.GP_Year.GP_Month.GP_Day = GP_Phase.GP_Phase
      end
    end
  end
  else do
    /* Routine to determine the dates of the new and full moons for a given year */
    /* obtained from the Sky & Telescope web site. The basic program from which  */
    /* the following was derived originally appeared in Astronomical Computing,  */
    /* Sky & Telescope, March, 1985                                              */
    GP_Progress = -2
    GP_R1 = PI(0) / 180
    GP_NextPhase = 29.530588853 / 4
    GP_U  = 0

    GP_K0 = trunc((GP_Y - 1900) * 12.3685)
    GP_T  = (GP_Y - 1899.5) / 100
    GP_T2 = GP_T*GP_T
    GP_T3 = GP_T*GP_T*GP_T
    GP_J0 = 2415020 + 29 * GP_K0
    GP_F0 = 0.0001178 * GP_T2 - 0.000000155 * GP_T3 + 0.75933 + 0.53058868 * GP_K0 - 0.000837 * GP_T - 0.000335 * GP_T2

    GP_J0  = GP_J0 + trunc(GP_F0)
    GP_F0  = GP_F0 - trunc(GP_F0)

    GP_M0 = GP_K0 * 0.08084821133
    GP_M0 = 360 * (GP_M0 - trunc(GP_M0)) + 359.2242 - 0.0000333 * GP_T2 - 0.00000347 * GP_T3
    GP_M1 = GP_K0 * 0.07171366128
    GP_M1 = 360 * (GP_M1 - trunc(GP_M1)) + 306.0253 + 0.0107306 * GP_T2 + 0.00001236 * GP_T3
    GP_B1 = GP_K0 * 0.08519585128
    GP_B1 = 360 * (GP_B1 - trunc(GP_B1)) + 21.2964 - 0.0016528 * GP_T2 - 0.00000239 * GP_T3
    do GP_K9 = 0 to 28
      if GP_K9//4 == 0 then do
        GP_Progress = -GP_Progress
        call UpdateBusy(Req, GP_Progress)
      end
      GP_J  = GP_J0 + 14 * GP_K9
      GP_F  = GP_F0 + 0.765294 * GP_K9
      GP_K  = GP_K9 / 2
      GP_M5 = (GP_M0 + GP_K * 29.10535608) * GP_R1
      GP_M6 = (GP_M1 + GP_K * 385.81691806) * GP_R1
      GP_B6 = (GP_B1 + GP_K * 390.67050646) * GP_R1
      GP_F  = GP_F - 0.4068 * SIN(GP_M6) + (0.1734 - 0.000393 * GP_T) * SIN(GP_M5) + 0.0161 * SIN(2 * GP_M6)
      GP_F  = GP_F + 0.0104 * SIN(2 * GP_B6) - 0.0074 * SIN(GP_M5 - GP_M6) - 0.0051 * SIN(GP_M5 + GP_M6)
      GP_F  = GP_F + 0.0021 * SIN(2 * GP_M5) + 0.0010 * SIN(2 * GP_B6 - GP_M6)
      GP_J  = GP_J + trunc(GP_F)
      GP_F  = GP_F - trunc(GP_F)

      GP_Converted  = ConvertJ(GP_F, GP_J)
      GP_Y          = word(GP_Converted, 1) - 0
      GP_M          = word(GP_Converted, 2) - 0
      GP_Day        = word(GP_Converted, 3) - 0
      GP_Hrs        = word(GP_Converted, 4)
      if GP_U = 0 then do
        MoonPhase.GP_Y.GP_M.GP_Day = 'N'
        GP_FQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
        GP_Y = left(GP_FQ, 4)
        GP_M = strip(substr(GP_FQ, 5, 2), 'L', '0')
        GP_Day = strip(right(GP_FQ, 2), 'L', '0')
        MoonPhase.GP_Y.GP_M.GP_Day = '1'
      end
      if GP_U = 1 then do
        MoonPhase.GP_Y.GP_M.GP_Day = 'F'
        GP_TQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
        GP_Y = left(GP_TQ, 4)
        GP_M = strip(substr(GP_TQ, 5, 2), 'L', '0')
        GP_Day = strip(right(GP_TQ, 2), 'L', '0')
        MoonPhase.GP_Y.GP_M.GP_Day = '3'
      end
      GP_U = GP_U + 1
      if GP_U = 2 then GP_U = 0
    end
    if sign(GP_Progress) == 1 then call UpdateBusy(Req, -GP_Progress)
  end
return 0
/**/

/***//*******  GetSetupInfo (GSI) Subroutine  ***********/
GetSetupInfo:
  if (exists(ScriptDir''ChangesFile)) & (word(statef(ScriptDir''ChangesFile), 2) > 1) then do
    /* Determine current prefs file */
    if open('DataFile', ScriptDir''ChangesFile) then do
      GSI_DataFile = readch('DataFile', 65535)
      call close('DataFile')
      call openv('GSI_DataFile')
        GSI_DataVersion = readvln('GSI_DataFile')
        PrefsFile = readvln('GSI_DataFile')
        PrefsFile = strip(substr(PrefsFile, pos('=', PrefsFile) + 1),," '")
        GSI_Data = readvch('GSI_DataFile', 65535)
      call closev('GSI_DataFile')
      call WriteEnv('FWCalendar', PrefsFile, 'B')
    end
    call delete(ScriptDir''ChangesFile)
  end
  else if open('EnvInfo','ENV:FWCalendar') then do
    /* Determine existing data file */
    PrefsFile = ReadLn('EnvInfo')
    call close('EnvInfo')
  end
  else do
    /* Create environment variable if it doesn't exist */
    PrefsFile = 'Default'
    call WriteEnv('FWCalendar', PrefsFile, 'B')
  end

  if PrefsFile ~= 'Default' then do
    /* Move translation strings to separate file */
    if open('DataFile', PrefsFile) then do
      call openv('GSI_TranslationFile')
      call openv('GSI_DataFile')
      do until eof('DataFile')
        GSI_Ln = ReadLn('DataFile')
        GSI_Var = upper(word(GSI_Ln, 1))
        if right(GSI_Var, 1) == '$' then call writevln('GSI_TranslationFile', compress(GSI_Ln, ':'))
        else call writevln('GSI_DataFile', GSI_Ln)
      end
      call closev('GSI_DataFile')
      call closev('GSI_TranslationFile')
      call close('DataFile')
      if GSI_TranslationFile ~= '' then do
        if open('DataFile', ScriptDir'FWCTranslations.txt', 'W') then do
          call writeln('DataFile', '/* FWC Translation file v4.x */')
          call writeln('DataFile', GSI_TranslationFile)
          call close('DataFile')
        end
        else call AddMsg('W', 'Unable to create translation file.')
      end
      if open('DataFile', PrefsFile, 'W') then do
        call writeln('DataFile', GSI_DataFile)
        call close('DataFile')
      end
      else do
        call AddMsg('E', 'Unable to re-create preference file.')
        call Cleanup
      end
    end
  end

  Year = left(date('S'),4)
  ThisMonth = left(date('U'), 2) + 0

  if (owner == 'rgoertz') & (CallHost == 'REXX') then CalMonth = ThisMonth
  else do
    CalMonth = getclip('FWC_CalMonth')
    if datatype(CalMonth) == 'CHAR' then do
      CalMonth = ThisMonth
      AddYear = 0
    end
    else do
      CalMonth = CalMonth + 1
      if CalMonth = 13 then do
        CalMonth = 1
        AddYear = 1
      end
      else AddYear = 0
    end
    CalYear = getclip('FWC_CalYear')
    if (CalYear ~= '') & (DataType(CalYear) == 'NUM') then Year = CalYear + AddYear
  end

  call InitializeVariables
  Req = OpenBusy(PrepReq$'...', 9)

  call UpdateBusy(Req, 1)
  if PrefsFile ~= 'Default' then do
    if open('DataFile', PrefsFile) then do
      GSI_Data = readch('DataFile', 65535)
      call close('DataFile')
      call OpenV('GSI_Data')
        GSI_StringVar = 0
        do until eofv('GSI_Data')
          GSI_Ln = readvln('GSI_Data')
          GSI_Var = upper(word(GSI_Ln, 1))
          if (GSI_Var == 'DOSHANGHAI') | (GSI_Var == 'STORAGE') then interpret GSI_Ln
        end
      call CloseV('GSI_Data')
    end
    else PrefsFile = 'Default'
  end

  call makedir(left(Storage, length(Storage) - 1))
  call UpdateBusy(Req, 1)
  call InitializeSettings
  EH_SelectMonth = CalMonth

  do until Reset == 0
    call CheckShanghai
    if Req == 0 then Req = OpenBusy(PrepReq$'...', 6)
    call ReadData
    call CheckShanghai
    call DoSetupReq
    call CheckShanghai
    if Reset == 1 then call bguiwinclose(winID)
  end

  if ImageClass.0 ~= '' then
    do GSI_i = 0 to ImageClass.Count - 1
      parse var ImageFile.GSI_i ImageFile.GSI_i ',' GSI_DX ',' GSI_DY
      GSI_DX = strip(GSI_DX, 'B', '" '||"'");if GSI_DX == '' then GSI_DX = 0
      GSI_DY = strip(GSI_DY, 'B', '" '||"'");if GSI_DY == '' then GSI_DY = 0
      if (pos('/', ImageFile.GSI_i) == 0) & (pos(':', ImageFile.GSI_i) == 0) then
        ImageFile.GSI_i = ScriptDir'Images/'strip(ImageFile.GSI_i, 'B', ' "'||"'")
      ImageDX.GSI_i = GSI_DX
      ImageDY.GSI_i = GSI_DY
    end

  do GSI_i = 1 to 8
    if (Do.GSI_i='BothJ') | (Do.GSI_i='BothS') then iterate
    interpret 'Do'Do.GSI_i' = 0'
  end

  do GSI_i = 0 to GroupCount
    pos = pos.GSI_i
    option = option.pos
    if Do.option == 'BothJ' then do
      DoJulian = pos.GSI_i
      DoJulianLeft = pos.GSI_i
    end
    else if Do.option == 'BothS' then do
      DoSunrise = pos.GSI_i
      DoSunset  = pos.GSI_i
    end
    else interpret 'Do'Do.option" = '"pos.GSI_i"'"
  end

  call WriteData

  TopOption = 0
  do GSI_i = 1 to 8
    if (Do.GSI_i='BothJ') | (Do.GSI_i='BothS') then iterate
    if left(value('Do'Do.GSI_i), 1) == 'T' then do
      TopOption = 1
      leave
    end
  end

  if CalType == 1 then Calendar = Month.Month' 'EnteredYear
  else Calendar = EnteredYear
  call bguiwinclose(winID)

  Mn = right(Month, 2, '0')
  if DataType(Month) == 'NUM' then call setclip('FWC_CalMonth', Month)
  if DataType(EnteredYear) == 'NUM' then call setclip('FWC_CalYear', EnteredYear)

  return
/**/

/***//*******  GetSRSS (GS) Subroutine  ***********/
GetSRSS:
  parse arg GS_IDay

  GS_EDay = translate(DateInfo('E', GS_IDay, 'I'), '-', '/')
  if AdjustDST ~= 0 then do
    if GS_IDay < StartDST | GS_IDay >= EndDST then GS_Status = WriteEnv('suncalc/dst', 0)
    else GS_Status = WriteEnv('suncalc/dst', 1)
  end
  address command Storage'suncalc > 'Storage'SRSS.txt date='GS_EDay' text="$SR $SS"'
  call open('SRSS', Storage'SRSS.txt')
    GS_SRSS = readln('SRSS')
  call close('SRSS')
return GS_SRSS
/**/

/***//*******  GetWidth (GW) Subroutine  ***********/
GetWidth:
  parse arg GW_ID
  if App = 'FW' then do
    GETOBJECTCOORDS GW_ID
    Parse Var result . . . GW_width .
  end
  else if App == 'PGS' then do
    SELECTOBJECT OBJECTID GW_ID WINDOW winName
    GETTEXTOBJ POSITION GW_Temp OBJECTID GW_ID WINDOW winName
    GW_width = GW_Temp.Right - GW_Temp.Left
  end
  return GW_width
/**/

/***//*******  HalveBox (HB) Subroutine  ***********/
HalveBox:
  parse arg HB_ID

  if App = 'FW' then do
    GETOBJECTCOORDS HB_ID
    parse var result . HB_Left HB_Top HB_Width HB_Height
    SETOBJECTCOORDS HB_ID 1 HB_Left HB_Top HB_Width HB_Height/2
  end
  else if App == 'PGS' then do
    GETBOX POSITION HB_Coords OBJECTID HB_ID WINDOW winName
    HB_Bottom = HB_Coords.Top + (HB_Coords.Bottom - HB_Coords.Top) / 2
    EDITBOX POSITION HB_Coords.Left HB_Coords.Top HB_Coords.Right HB_Bottom OBJECTID HB_ID WINDOW winName
  end

  return HB_ID
/**/

/***//*******  LibVer (LV) Subroutine  *********/
LibVer: /* Retrieve the version number of a library */
  parse arg LV_libname
  if right(LV_libname,8) ~= '.library' then LV_libname = LV_libname'.library'
  address command 'version' 'libs:'LV_Libname '>env:LibVer'
  LV_libver = ReadEnv('LibVer')

  return LV_libver
/**/

/***//*******  MemberID (MI) Subroutine  *********/
MemberID:
  parse arg MI_Member, MI_Array, MI_Count, MI_Start

  if MI_Count == '' then interpret 'MI_Count = 'MI_Array'.Count'
  if MI_Start == '' then MI_Start = 0

  if MI_Start == 0 then MI_Count = MI_Count - 1
  do MI_i = MI_Start to MI_Count
    if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  end
  return -1
/**/

/***//*******  MiniCalPreCalc (MCPC) Subroutine  *********/
MiniCalPreCalc:
  parse arg MCPC_FontType, MCPC_CalWidth

  Width.MCPC_FontType = 100 * min(1, MCPC_CalWidth / (22 * BoldWidth.Widest))
  if App == 'FW' then Width.MCPC_FontType = trunc(Width.MCPC_FontType)

  do MCPC_i = 0 to 9
    NormalWidth.MCPC_i = NormalWidth.MCPC_i * Width.MCPC_FontType / 100
    BoldWidth.MCPC_i   = BoldWidth.MCPC_i * Width.MCPC_FontType / 100
  end
  NormalWidth.Widest = NormalWidth.Widest * Width.MCPC_FontType / 100
  BoldWidth.Widest = BoldWidth.Widest * Width.MCPC_FontType / 100
return
/**/

/***//*******  Move (M) Subroutine  ***********/
Move:
  parse arg M_ID, M_dX, M_dY

  if M_ID == 0 then return
  if App = 'FW' then do
    GETOBJECTCOORDS M_ID; Parse Var result . M_Coords.Left M_Coords.Top M_Coords.Width M_Coords.Height
    SETOBJECTCOORDS M_ID 1 (M_Coords.Left + M_dX) (M_Coords.Top + M_dY) M_Coords.Width M_Coords.Height
  end
  else if App == 'PGS' then MOVE OFFSET M_dX M_dY OBJECTID M_ID WINDOW winName

  return
/**/

/***//*******  NameOnly (NO) Subroutine  ***********/
NameOnly:
  parse arg NO_fontname
  return substr(NO_fontname, max(lastpos(':', NO_fontname), lastpos('/', NO_fontname)) + 1)
/**/

/***//*******  OpenBusy (OB) Subroutine  ***********/
OpenBusy:
  parse arg OB_BusyTitle, OB_EventCount

  Progress = 0
  OB_ProgressGroup=bguivgroup(,
        bguiinfo('OB_dummy',,'1B'x||'c'OB_BusyTitle)bguilayout(LGO_FixMinHeight,1)||,
        bguiprogress('OB_prog2_',,0,OB_EventCount)||,
        bguihgroup(,
                bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
                bguibutton('OB_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
                bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
        ,,,,'W'),
  ,-2,-2)

  OB_ProgressWindow = bguiwindow(PleaseWait$'...',OB_ProgressGroup,,2,,PubScreen)
  if bguiwinopen(OB_ProgressWindow) = 0 then call Cleanup

return OB_ProgressWindow
/**/

/***//*******  ParseVariables (PV) Subroutine  ***********/
ParseVariables:
parse arg PV_Line

PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
PV_VarString = ''
PV_Var.      = '00'x
PV_LongVar   = 4
PV_LIT       = ''
PV_Count     = 0

do PV_i = 1 to words(PV_String)
  PV_Word = word(PV_String, PV_i)
  if pos(PV_Word'(', PV_Line) > 0 then iterate
  if datatype(PV_Word) == 'CHAR' then do
    if (symbol(PV_Word) == 'LIT') then PV_LIT = PV_LIT''PV_Word', '
    if (symbol(PV_Word) == 'VAR') | (pos('.', PV_Word) > 0) then do
      if symbol(PV_Word) == 'VAR' then do
        PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
        if PV_Var.PV_Word == '00'x then do
          PV_Count = PV_Count + 1
          PV_Var.PV_Count = PV_Word
          PV_Var.PV_Word  = value(PV_Word)
        end
      end
      if pos('.', PV_Word) > 0 then do
        PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
        do PV_j = 1 to words(PV_CompoundParts)
          PV_Subword = word(PV_CompoundParts, PV_j)
          PV_LongVar = max(PV_LongVar, length(PV_SubWord) + 2)
          if PV_Var.PV_SubWord == '00'x then do
            PV_Count = PV_Count + 1
            PV_Var.PV_Count = PV_SubWord
            if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
            else PV_Var.PV_SubWord  = value(PV_SubWord)
          end
        end
      end
    end
  end
end

do PV_i = 1 to PV_Count
  PV_Word = PV_Var.PV_i
  if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
end

if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
return PV_VarString
/**/

/***//*******  PathPart (PP) Subroutine  ***********/
PathPart:
  parse arg PP_FileWithPath
  return left(PP_FileWithPath, max(lastpos(':', PP_FileWithPath), lastpos('/', PP_FileWithPath)))
/**/

/***//*******  PrintHighlight (PH) Subroutine  ***********/
PrintHighlight:
  parse arg PH_Event

  /* Fit line(s) into allowable space */
  PH_Textline         = 0
  PH_Text.            = ''
  PH_Text.PH_Textline = PH_Event

  Do until PH_Text.PH_Nextline == ''
    PH_AllowedWidth = BoxWidth - 2 * DateOffset - HighlightOffset
    PH_Nextline = PH_Textline + 1
    if PH_Textline == 0 then PH_Indent.PH_Textline = 0
    else PH_Indent.PH_Textline = Width.WidthOfDate1
    PH_AllowedWidth = PH_AllowedWidth - PH_Indent.PH_Textline

    if PH_Event == '' then do
      PH_Text.PH_TextLine = ''
      iterate
    end
    if App == 'FW' & length(PH_Text.PH_Textline) > 37 then do
      PH_Wordbreak = lastpos(' ', PH_Text.PH_Textline, 37)
      PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
      PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
    end
    PH_ID = PrintText(1, 1, Highlight, 'N', Color.Highlight, Width.Highlight, PH_Text.PH_Textline)
    if App == 'FW' then redraw
    PH_TextWidth.PH_Textline = GetWidth(PH_ID)
    if App == 'FW' then DELETEOBJECT PH_ID
    else if App == 'PGS' then do
      SELECTOBJECT ObjectID PH_ID WINDOW winName
      DELETEOBJECT ObjectID PH_ID WINDOW winName
    end

    PH_NeededCompression.PH_Textline = min(1, PH_AllowedWidth/PH_TextWidth.PH_Textline)
    if (PH_NeededCompression.PH_Textline < MinWidth/100) & (Words(PH_Text.PH_Textline) > 1) then do
      /* Move last word to next line */
      PH_Wordbreak     = lastpos(' ', PH_Text.PH_Textline)
      PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
      PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
    end
    else if PH_Text.PH_Nextline ~= '' then PH_Textline = PH_Textline + 1

  end
  PH_LineCount = PH_Textline

  do PH_TextLine = 0 to PH_LineCount
    if PH_Text.PH_TextLine ~= '' then do
      TextLeft = BoxLeft + DateOffset + HighlightOffset * (DailyHLCount * Height.Highlight < Height.Date * TextBase)
      PH_TextTop = BoxTop + DailyHLCount * Height.Highlight
      PH_Width = PH_NeededCompression.PH_Textline * Width.Highlight
      if App == 'FW' then PH_Width = min(max(trunc(PH_Width), 4), 255)
      call PrintText(TextLeft + PH_Indent.PH_TextLine, PH_TextTop, Highlight, 'N', TextColor, PH_Width, PH_Text.PH_TextLine)
    end
    if PH_TextLine ~= PH_LineCount then DailyHLCount = DailyHLCount + 1
  end
  return
/**/

/***//*******  PrintOption (PO) Subroutine  ***********/
PrintOption:
  parse arg PO_Location

  PO_ID = PrintText(BoxLeft + DateOffset, BoxTop + (BHeight - Height.Extras) * (left(PO_Location, 1) ~= 'T'), Extras, 'N', DO_PrintColor, Width.Extras, DO_Text2Print)
  if right(PO_Location, 1) == 'C' then call CenterText(PO_ID, BoxLeft + BoxWidth / 2, 0, min(1, BoxWidth/GetWidth(PO_ID)))
  if right(PO_Location, 1) == 'R' then call RightText(PO_ID, BoxLeft + BoxWidth - 2 * DateOffset)

  return PO_ID
/**/

/***//*******  PrintText (PT) Subroutine  ***********/
PrintText:
  parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text

  if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  else PT_Font = Bold.PT_FontType

  if App == 'FW' then do
    if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
    PT_Top = PT_Top + TextAdj * Height.PT_FontType
    TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
    DRAWTEXTBLOCK 1 trunc(PT_Left, 4) trunc(PT_Top, 4) PT_Text; PT_id = result
  end
  else if App == 'PGS' then do
    DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
    SELECTTEXT AT PT_Left PT_Top WINDOW winName
    BEGINCOMMANDCAPTURE
      SETLEADING RELATIVE 100
      SETTYPESIZE FSize.PT_FontType WINDOW winName
      SETTYPEWIDTH PT_Width WINDOW winName
      SETFONT PT_Font WINDOW winName
      SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
    ENDCOMMANDCAPTURE
    if pos('"', PT_Text) > 0 then do
      call open('IFile', Storage'Text2Insert.txt', 'W')
        call WriteLn('IFile', PT_Text)
      call close('IFile')
      INSERTTEXT FILE Storage'Text2Insert.txt' FILTER ASCII WINDOW winName
    end
    else INSERT '"'PT_Text'"' WINDOW winName
  end
  return PT_id
/**/

/***//*******  ProcessVariableList (PVL) Subroutine  ***********/
ProcessVariableList:
  parse arg PVL_DataFile

  call openv(PVL_DataFile)
    do until eofv(PVL_DataFile)
      PVL_Ln = ReadVLn(PVL_DataFile)
      if PVL_Ln = '' then iterate /* Skip blank lines */
      PVL_VarName = strip(word(PVL_Ln, 1))
      PVL_VarStem = upper(left(PVL_VarName, pos('.', PVL_VarName)))
      VarNameMaxLn = max(VarNameMaxLn, length(PVL_VarName))
      if (pos('/* End Pass One', PVL_Ln) > 0) | (PVL_DoHighlights == 1) then do
        PVL_DoHighlights = 1
        if left(PVL_Ln, 2) == '/*' then iterate
        PVL_Month = left(PVL_Ln, 2)
        if upper(PVL_Month) == 'CA' then PVL_Month = 14
        MonthCount.PVL_Month = MonthCount.PVL_Month + 1
        PVL_MonthCount = MonthCount.PVL_Month
        HighlightData.PVL_Month.PVL_MonthCount = PVL_Ln
        iterate
      end
      if PVL_VarName == 'return' then leave
      if left(PVL_Ln, 2) == '/*' then iterate
      PVL_VarDone = 0
      if PVL_VarStem == 'IMAGECLASS.' then do
        ImageClass.ImgClassCount = substr(PVL_VarName, 12)
        PVL_ImageFile = strip(substr(PVL_Ln, pos("=", PVL_Ln) + 1), 'B', " '"||'"')
        interpret "ImageFile."ImgClassCount" = PVL_ImageFile"
        ImgClassCount = ImgClassCount + 1
      end
      else do
        if (PVL_VarStem == 'ALTCOLOR.') | (PVL_VarStem == 'BACKGROUND.') |,
           (PVL_VarStem == 'COLOR.') | (PVL_VarStem == 'LINE.') then do
          PVL_VariableType = 'Color'
          interpret PVL_Ln
          if (MemberID(value(PVL_VarName), 'ColorList') == -1) then do
            if (value(PVL_VarName) == '<'Clear$'>') & (PVL_VarStem == 'BACKGROUND.') then nop
            else do
              PVL_Ln = PVL_VarName' = "'ColorList.0'"'
              call AddMsg('W', value(PVL_VarName)" can't be found; "ColorList.0" used instead.")
            end
          end
        end
        else if (PVL_VarStem == 'FONT.') | (PVL_VarStem == 'BOLD.') then PVL_VariableType = 'Font'
        else if (PVL_VarStem == 'MARGIN.') | (upper(left(PVL_VarName, 2)) == 'DO') |,
                (upper(PVL_VarName) == 'ORIENTATION') then PVL_VariableType = 'Main'
        else PVL_VariableType = 'Misc'
        if VariableSeq.PVL_VarName == '' then do
          VariableName.VariableCount = PVL_VarName
          VariableType.VariableCount = PVL_VariableType
          VariableSeq.PVL_VarName = VariableCount
          VariableCount = VariableCount + 1
        end
        interpret PVL_Ln
      end
    end
  call closev(PVL_DataFile)

  return
/**/

/***//*******  QuoteIt () Subroutine  ***********/
QuoteIt: PROCEDURE
  parse arg String

  String = strip(String)
  if (left(String, 1) == '"') & (right(String, 1) == '"') then return String
  else if (left(String, 1) == "'") & (right(String, 1) == "'") then return String
  else if pos("'", String) == 0 then return "'"String"'"
  else return '"'String'"'

  return
/**/

/***//*******  ReadData (RD) Subroutine  ***********/
ReadData:
  call UpdateBusy(Req, 1)
  VariableCount    = 0
  MainVarCount     = 0
  MiscVarCount     = 0
  ColorVarCount    = 0
  FontVarCount     = 0
  ImgClassCount    = 0
  VariableName.    = ''
  VariableSeq.     = ''
  RD_Progress      = -1
  VarNameMaxLn     = 0
  MonthCount.      = 0
  PVL_DoHighlights = 0

  /* Read default variables */
  call open('Temp', FullCallPath)
    FileOffset = 120000
    call seek('Temp', FileOffset, 'B')
    do until (EndPos ~= 0) | (PrevOffset = FileOffset)
      PrevOffset = FileOffset
      Chunk = readch('Temp', 65535)
      EndPos = pos('VarList:'||'0a'x, Chunk)
      if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
    end
    call seek('Temp', FileOffset + EndPos + 8, 'B')
    RD_VariableFile = readch('Temp', 65535)
  call close('Temp')
  call ProcessVariableList('RD_VariableFile')

  if App == 'FW' then do
    GETSECTIONSETUP Top Bottom Inside Outside
    parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  end
  else if App == 'PGS' then do
    Margin.Top    = 0.5
    Margin.Bottom = 0.5
    Margin.Left   = 0.5
    Margin.Right  = 0.5
  end
  do RD_i = 0 to VariableCount - 1
    Default.RD_i = value(VariableName.RD_i)
  end

  /* Read user variables */
  if PrefsFile ~= 'Default' then do
    if open('DataFile', PrefsFile) then do
      RD_VariableFile = readch('DataFile', 65535)
      call close('DataFile')
      call ProcessVariableList('RD_VariableFile')
    end
  end

  do RD_i = 0 to VariableCount - 1
    select
      when VariableType.RD_i == 'Color' then do
        ColorVarName.ColorVarCount = VariableName.RD_i
        ColorVarCount = ColorVarCount + 1
      end
      when VariableType.RD_i == 'Font' then do
        FontVarName.FontVarCount = VariableName.RD_i
        FontVarCount = FontVarCount + 1
      end
      when VariableType.RD_i == 'Main' then do
        MainVarName.MainVarCount = VariableName.RD_i
        MainVarCount = MainVarCount + 1
      end
      otherwise do
        MiscVarName.MiscVarCount = VariableName.RD_i
        MiscVarCount = MiscVarCount + 1
      end
    end
  end

  if ImgClassCount > 0 then do
    do RD_i = 0 to ImgClassCount - 1
      MiscVarName.MiscVarCount = 'ImageClass.'ImageClass.RD_i
      MiscVarCount = MiscVarCount + 1
    end
  end

  MainVarName.COUNT  = MainVarCount
  MiscVarName.COUNT  = MiscVarCount
  ColorVarName.COUNT = ColorVarCount
  FontVarName.COUNT  = FontVarCount
  ImageClass.COUNT   = ImgClassCount

  CurrentColorName   = ColorVarName.0
  CurrentFontName    = FontVarName.0
  CurrentMiscName    = MiscVarName.0
  if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
    IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
    VarVal = ImageFile.IC
  end
  else VarVal = Value(CurrentMiscName)

  if upper(Orientation) == 'WIDE' then OrientChoice = 0
  else OrientChoice = 1

  call UpdateBusy(Req, 1)
  if (exists(SunCalcPath'suncalc')) & (~exists(Storage'suncalc')) then address command 'copy 'SunCalcPath'suncalc 'Storage

  call UpdateBusy(Req, 1)
  if (exists(GfxAppPath''GfxApp)) & (~exists(Storage''GfxApp)) then address command 'copy 'GfxAppPath''GfxApp' 'Storage
  if ~exists(Storage''GfxApp) then DoImages = 0

  if PhaseLib ~= 1 then DoPhases = 0

  do i = 0 to 6
    val = i - StartWeek
    if val < 0 then val = 7 + val
    interpret 'Day.'D.i '=' val
    interpret 'Day.val = 'D.i'$'
  end

  return
/**/

/***//*******  ReadEnv (RE) Subroutine  ***********/
ReadEnv: PROCEDURE
  parse arg file

  if open('Temp', 'ENV:'file) then do
    val = strip(readch('Temp', 65535), 'B', ' '||'0a'x)
    call close('Temp')
  end
  else val = ''
  return val
/**/

/***//*******  ReplaceString (RS) Subroutine  ***********/
ReplaceString: PROCEDURE
  parse arg old, new, string

  if pos(old, string) > 0 then do
    parse var string begin(old)end
    return begin || new || ReplaceString(old, new, end)
  end

  return string
/**/

/***//*******  RightText (RT) Subroutine  ***********/
RightText:
  parse arg RT_id, RT_RightEdge

  if App = 'FW' then do
    GETOBJECTCOORDS RT_id; Parse Var result . . RT_Text.Bottom RT_Text.Width RT_Text.Height
    RT_Text.Left = RT_RightEdge - RT_Text.Width
    SETOBJECTCOORDS RT_id 1 RT_Text.Left RT_Text.Bottom RT_Text.Width RT_Text.Height
  end
  else if App == 'PGS' then do
    GETTEXTOBJ POSITION RT_Text OBJECTID RT_id WINDOW winName
    RT_Text.Width = RT_Text.Right - RT_Text.Left
    RT_Text.Left = RT_RightEdge - RT_Text.Width
    EDITTEXTOBJ POSITION RT_Text.Left RT_Text.Top (RT_Text.Left + RT_Text.Width) RT_Text.Bottom OBJECTID RT_id WINDOW winName
  end
  return RT_id
/**/

/***//*******  SaveVariable (SV) Subroutine  ***********/
SaveVariable:
  parse arg SV_OutFile, SV_Variable, SV_Value

  SV_Cmd = SV_Variable' = 'SV_Value
  call WriteLn(SV_OutFile, SV_Cmd)
  interpret SV_Cmd

  return
/**/

/***//*******  SetFill (SF) Subroutine  ***********/
SetFill:
  parse arg SF_ID, SF_StrokeColor, SF_FillColor

  BEGINCOMMANDCAPTURE
    SETSTROKEWEIGHT '0.3pt' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
    SETCOLORSTYLE '"'SF_StrokeColor'"' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
    FILLED 'ON'
    SETCOLORSTYLE '"'SF_FillColor'"' FILL OBJECT OBJECTID SF_ID WINDOW winName
  ENDCOMMANDCAPTURE
  return
/**/

/***//*******  SetHighlights (SH) Subroutine  ***********/
SetHighlights:
/* The algorithm for calculating Easter is due to J.-M. Oudin (1940) and is        */
/* reprinted in the Explanatory Supplement to the Astronomical Almanac, ed. P. K.  */
/* Seidelmann (1992). See Chapter 12, "Calendars", by L. E. Doggett.               */
/*                                                                                 */
/* I obtained the algorithm from the US Naval Observatory web site                 */

  SettingHighlights = 1
  SH_Progress = -2
  if EasterKnown ~= 1 then do
    SH_century = trunc(Year / 100)
    SH_n = trunc(Year - 19 * trunc(Year / 19))
    SH_k = trunc((SH_century - 17) / 25)
    SH_i = SH_century - trunc(SH_century / 4) - trunc((SH_century - SH_k) / 3) + 19 * SH_n + 15
    SH_i = SH_i - 30 * trunc(SH_i / 30)
    SH_i = SH_i - trunc(SH_i / 28) * (1 - trunc(SH_i / 28) * trunc(29 / (SH_i + 1)) * trunc((21 - SH_n) / 11))
    SH_j = Year + trunc(Year / 4) + SH_i + 2 - SH_century + trunc(SH_century / 4)
    SH_j = SH_j - 7 * trunc(SH_j / 7)
    SH_l = SH_i - SH_j
    SH_EasterMonth  = 3 + trunc((SH_l + 40 ) / 44)
    SH_EasterDay    = SH_l + 28 - 31 * trunc(SH_EasterMonth / 4)
    EasterSerial = DateInfo('I', Year'0'SH_EasterMonth''right(SH_EasterDay, 2, '0'), 'S')
    EasterKnown  = 1
  end
  Highlight. = ''
  Image.     = ''

  if PrefsFile ~= 'Default' then do
    call open('DataFile', PrefsFile)
    do forever
      if eof('DataFile') then leave
      if pos('/* End Pass One', readln('DataFile')) > 0 then do
        do until eof('DataFile')
          SH_Ln = ReadLn('DataFile')
          SH_Ln2 = left(SH_Ln, 2)
          if upper(left(SH_Ln, 14)) == 'CALCULATEEDATE' then interpret 'call 'SH_Ln
          if (SH_Ln2 == Mn) | (SH_Ln2 == '13') then do
            SH_Progress = -SH_Progress
            call UpdateBusy(Req, SH_Progress)
            select
              when upper(substr(SH_Ln, 3, 13)) == 'CALCULATEDATE' then interpret 'call 'substr(SH_Ln, 3)
              when upper(substr(SH_Ln, 3, 9)) == 'HIGHLIGHT' then call AssignHighlight(substr(SH_Ln, 3))
              when upper(substr(SH_Ln, 3, 5)) == 'IMAGE' then call AssignImage(substr(SH_Ln, 3))
              when upper(substr(SH_Ln, 3, 14)) == 'CALCULATEIMAGE' then interpret 'call 'substr(SH_Ln, 3)
              otherwise do
                call AddMsg('W', 'Check the keyword in the following line of your FWCalendar.data file:')
                call AddMsg('W', '  'SH_Ln)
                ListHighlightData = 1
              end
            end
          end
        end
      end
    end
    call close('DataFile')
  end

  if sign(SH_Progress) == 1 then call UpdateBusy(Req, -SH_Progress)
  SettingHighlights = 0
return
/**/

/***//*******  Syntax () Subroutine  ***********/
Syntax:
  signal off syntax

  ErrorLine  = SIGL
  SourceLine = strip(SourceLine(ErrorLine))

  call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  call AddMsg('E', ParseVariables(SourceLine))

  call Cleanup
  exit
/**/

/***//*******  UpdateBusy (UB) Subroutine  ***********/
UpdateBusy:
  parse arg UB_ReqWin, UB_ProgressMade

  if UB_ReqWin == 0 then return
  Progress = Progress + UB_ProgressMade

  call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
  if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup

  return
/**/

/***//*******  VIO Routines () Subroutine  ***********/
/***//** OpenV() **/
OpenV:
  parse arg VIO_Variable

  if Open.VIO_Variable ~= 1 then do
    if symbol(VIO_Variable) == 'LIT' then interpret VIO_Variable' = ""'
    Open.VIO_Variable = 1
    Pointer.VIO_Variable = 1
    EOF.VIO_Variable = 0
    return 1
  end
  else return 0
/**/

/***//** CloseV() **/
CloseV:
  parse arg VIO_Variable

  If Open.VIO_Variable == 0 then return 0
  Open.VIO_Variable = 0
  return 1
/**/

/***//** SeekV() **/
SeekV:
  parse arg VIO_Variable, VIO_Offset, VIO_Anchor

  if Open.VIO_Variable == 1 then do
    VIO_Anchor = upper(left(VIO_Anchor, 1))

    VIO_Value = Value(VIO_Variable)
    select
      when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
      when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
      otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
    end

    if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
    if Pointer.VIO_Variable == 0 then Pointer.VIO_Variable = 1
    return Pointer.VIO_Variable
  end
  else return 0
/**/

/***//** ReadVCh() **/
ReadVCh:
  parse arg VIO_Variable, VIO_Length

  if VIO_Length == '' then VIO_Length = 1
  if Open.VIO_Variable == 1 then do
    if EOF.VIO_Variable == 0 then do
      VIO_Value = Value(VIO_Variable)
      VIO_Length = min(VIO_Length, length(VIO_Value) - Pointer.VIO_Variable)
      VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
      Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
      if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
      else EOF.VIO_Variable = 0
    end
    else VIO_Ret = ''
  end
  else VIO_Ret = ''

  return VIO_Ret
/**/

/***//** ReadVLn(RV) **/
ReadVLn:
  parse arg VIO_Variable, VIO_Count, VIO_SepChar

  if VIO_Count == '' then VIO_Count = 1
  if VIO_SepChar == '' then VIO_SepChar = '0a'x

  if Open.VIO_Variable == 1 then do
    VIO_Value = Value(VIO_Variable)
    VIO_Ret   = ''
    do VIO_i = 1 to VIO_Count
      VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
      if VIO_LF > 0 then do
        VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
        Pointer.VIO_Variable = VIO_LF + 1
        if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
        else EOF.VIO_Variable = 0
      end
      else do
        if Pointer.VIO_Variable < length(VIO_Value) then do
          VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
          Pointer.VIO_Variable = length(VIO_Value) + 1
          EOF.VIO_Variable = 1
        end
      end
      if EOF.VIO_Variable == 1 then leave
      if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
    end
  end
  else VIO_Ret = ''

  return VIO_Ret
/**/

/***//** WriteVCh() **/
WriteVCh:
  parse arg VIO_Variable, VIO_String, VIO_Option

  VIO_Value  = Value(VIO_Variable)
  VIO_Option = upper(left(VIO_Option, 1))
  VIO_Length = length(VIO_Value)
  if VIO_Option == 'C' then do
    VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
    Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  end
  else if VIO_Option == 'B' then do
    VIO_Value = VIO_String''VIO_Value
    Pointer.VIO_Variable = length(VIO_String) + 1
  end
  else do
    VIO_Value = VIO_Value''VIO_String
    Pointer.VIO_Variable = length(VIO_Value)
  end
  interpret VIO_Variable'= VIO_Value'
  if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  else VIO_Ret = 0

  return VIO_Ret
/**/

/***//** WriteVLn() **/
WriteVLn:
  parse arg VIO_Variable, VIO_String, VIO_Option

  return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
/**/

/***//** EOFV() **/
EOFV:
  parse arg VIO_Variable

  if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  else return 1
/**/
/**/

/***//*******  WriteData (WD) Subroutine  ***********/
WriteData:
  WD_FileOpen      = 0
  WD_MsgWritten    = 0
  WD_SepWritten    = 0

  /* Write non-imageclass variables */
  do WD_i = 0 to VariableCount - 1
    if value(VariableName.WD_i) ~= Default.WD_i then do
      WD_Value = Value(VariableName.WD_i)
      if (datatype(WD_Value) == 'CHAR') then do
        if pos("'", WD_Value) ~= 0 then WD_Value = '"'WD_Value'"'
        else WD_Value = "'"WD_Value"'"
      end
      call WriteDataLine(VariableName.WD_i' = 'WD_Value)
    end
  end

  /* Write imageclass variables */
  do WD_i = 0 to ImgClassCount - 1
    call WriteDataLine('ImageClass.'ImageClass.WD_i' = 'QuoteIt(ImageFile.WD_i))
  end

  /* Write highlight variables */
  do WD_i = 1 to 14
    WD_Month = right(WD_i, 2, '0')
    WD_MonthCount = MonthCount.WD_Month
    if WD_MonthCount > 0 then do
      do WD_j = 1 to WD_MonthCount
        if symbol('HighlightData.WD_Month.WD_j') == 'VAR' then do
          if WD_SepWritten == 0 then do
            call WriteDataLine('/* End Pass One - DO NOT DELETE THIS LINE!!! */')
            WD_SepWritten = 1
          end
          call WriteDataLine(HighlightData.WD_Month.WD_j)
        end
      end
    end
  end

  call close('DataFile')

  return

WriteDataLine:
  parse arg WDL_Data

  if WD_FileOpen == 0 then do
    if PrefsFile == 'Default' then do
      WDL_File = bguifilereq(ScriptDir'FWCalendar.prefs', SelectPrefs$)
      WD_FileOpen = open('DataFile', WDL_File, 'W')
      if WD_FileOpen ~= 0 then do
        PrefsFile = WDL_File
        call WriteEnv('FWCalendar', PrefsFile, 'B')
      end
    end
    else WD_FileOpen = open('DataFile', PrefsFile, 'W')
    if WD_FileOpen ~= 0 then call writeln('DataFile', '/* Dataversion 'word(sourceline(4), 3)' */')
  end
  if WD_FileOpen ~= 0 then call writeln('DataFile', WDL_Data)
  else do
    if WD_MsgWritten == 0 then do
      WD_MsgWritten = 1
      call AddMsg('W', 'Unable to write to preference file.')
    end
  end
  return
/**/

/***//*******  WriteEnv (WE) Subroutine  ***********/
WriteEnv: PROCEDURE
  parse arg file, var, which

  if open('Temp', 'ENV:'file, 'W') then do
    success = writech('Temp', var)
    call close('Temp')
  end
  if upper(which) == 'B' then do
    if open('Temp', 'ENVARC:'file, 'W') then do
      success = writech('Temp', var)
      call close('Temp')
    end
  end
  return success
/**/

/***//*******  InitializeVariables (IV) Subroutine  *********/
InitializeVariables:
  ColorVars         = 'color. line. background.'
  CountJulian       = 0
  CountJulianLeft   = 0
  CountSunRise      = 0
  CountSunSet       = 0
  CountPhases       = 0
  Error             = 0
  esc               = "1B"x
  FSize.            = 10
  FWCData           = 'FWCalendar.data'
  ChangesFile       = 'FWC.dat'
  HighlightCount    = 0
  ImageClass.Count  = 0
  ImageCount        = 0
  ImageSize.        = ''
  ImageType.        = ''
  ImageWidth.       = 0
  ImageHeight.      = 0
  LF                = '0a'x
  MoonPhase.        = ''
  NULL              = '00'x
  OB_ProgressWindow = ''
  PatVar            = '#?.(data|prefs)'
  Req               = 0
  Storage           = 'RAM:FWC/'
  Text.             = ''
  TextAdj           = 0.77
  TTextArea         = 0.15
  WTextArea         = 0.20
  UserPrefs         = ''
  Width.            = 100
  Spc               =' '
  NormalWidth.Spc  = 0
  BoldWidth.Spc    = 0

  PGSFilter.     = ''
  PGSFilter.ILBM = 'IFFILBM'
  PGSFilter.JFIF = 'JPEG'
  PGSFilter.POST = 'IllustratorEPS'

  Action.0       = 'MX_EnableButton'
  Action.1       = 'MX_DisableButton'
  GroupCount     = 4

  pos.0 = 'BL' ; grp.0 = 'obj.bottomleft_'
  pos.1 = 'BC' ; grp.1 = 'obj.bottomcenter_'
  pos.2 = 'BR' ; grp.2 = 'obj.bottomright_'
  pos.3 = 'TC' ; grp.3 = 'obj.topcenter_'
  pos.4 = 'TR' ; grp.4 = 'obj.topright_'

  Do.1 = 'Phases'     ; MXPos.Phases     = 1
  Do.2 = 'Weeknumber' ; MXPos.Weeknumber = 2
  Do.3 = 'Julian'     ; MXPos.Julian     = 3
  Do.4 = 'JulianLeft' ; MXPos.JulianLeft = 4
  Do.5 = 'BothJ'      ; MXPos.BothJ      = 5
  Do.6 = 'Sunrise'    ; MXPos.Sunrise    = 6
  Do.7 = 'Sunset'     ; MXPos.Sunset     = 7
  Do.8 = 'BothS'      ; MXPos.BothS      = 8

  if App == 'FW' then do
    DefaultFont = 'SoftSans'
    DefaultBold = 'SoftSans_Bold'
  end
  else if App == 'PGS' then do
    DefaultFont = 'PageStream-Normal'
    DefaultBold = 'PageStream-Normal'
  end

  Date      = 0
  Weekday   = 1
  Header    = 2
  MiniCal   = 3
  FYMiniCal = 4
  Highlight = 5
  Extras    = 6
  FontTypes = 6

  D.0 = 'Sunday'
  D.1 = 'Monday'
  D.2 = 'Tuesday'
  D.3 = 'Wednesday'
  D.4 = 'Thursday'
  D.5 = 'Friday'
  D.6 = 'Saturday'

  MonthLength.1  = 31
  MonthLength.2  = 28
  MonthLength.3  = 31
  MonthLength.4  = 30
  MonthLength.5  = 31
  MonthLength.6  = 30
  MonthLength.7  = 31
  MonthLength.8  = 31
  MonthLength.9  = 30
  MonthLength.10 = 31
  MonthLength.11 = 30
  MonthLength.12 = 31

  call TranslationStrings

  if open('TranslationFile', ScriptDir'FWCTranslations.txt') then do
    IV_TranslationFile = readch('TranslationFile', 65535)
    call close('TranslationFile')
    call openv('IV_TranslationFile')
    do until eofv('IV_TranslationFile')
      interpret readvln('IV_TranslationFile')
    end
    call closev('IV_TranslationFile')
  end

  Month.1  = January$
  Month.2  = February$
  Month.3  = March$
  Month.4  = April$
  Month.5  = May$
  Month.6  = June$
  Month.7  = July$
  Month.8  = August$
  Month.9  = September$
  Month.10 = October$
  Month.11 = November$
  Month.12 = December$

  return
/**/

/***//*******  InitializeSettings Subroutine  ***********/
InitializeSettings:
  call GetLogInfo

  if App == 'FW' then do
    call open('FWPrefs', CurrentDir'FWFiles/FW.Prefs')
      FWPrefs = readch('FWPrefs', 65535)
    call close('FWPrefs')
    ColorTable = pos('SWCL', FWPrefs) + 12
    EndTable = pos('STUP', FWPrefs)
    ColorCount = 0
    Do CTPos = ColorTable to EndTable by 20
      ColorRegister = c2x(substr(FWPrefs, CTPos - 3, 3))
      ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
      if ColorRegister = '000000' then Black$ = ColorList.ColorCount
      if ColorRegister = 'FFFFFF' then White$ = ColorList.ColorCount
      ColorCount = ColorCount + 1
    end
    ColorList.ColorCount = '<'Clear$'>'
    ColorCount = ColorCount + 1
    ColorList.COUNT = ColorCount
    if symbol('Black$') == 'LIT' then do
      call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
      Black$ = ColorList.0
    end
    if symbol('White$') == 'LIT' then do
      call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
      White$ = ColorList.1
    end
  end
  else if App == 'PGS' then do
    GETFONTLIST FontList
    FontList.COUNT = result

    call open('PGSColors', CurrentDir''word(PgmVersion, 1)'.colors')
      PGSColors = readch('PGSColors', 65535)
    call close('PGSColors')
    ColorCount = 0
    StartTag = pos('TG'||'00'x, PGSColors)
    do while StartTag ~= 0
      Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
      AccentMarker = pos(d2c(129), Color)
      do while AccentMarker > 0
        Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
        AccentMarker = pos(d2c(129), Color)
      end
      ColorList.ColorCount = Color
      ColorCount = ColorCount + 1
      StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
    end
    ColorList.ColorCount = '<'Clear$'>'
    ColorCount = ColorCount + 1
    ColorList.COUNT = ColorCount
    White$ = ColorList.0
    Black$ = ColorList.1
  end

  DefaultColor = Black$
  DefaultBackground = White$

  RequesterVariables = 1
  if App == 'PGS' then do
    GETDOCUMENTS dummy; DocCount = result
    if DocCount > 0 then do
      call bguireq('1b'x||"cYou "||'1b'x||"bmust"||'1b'x||"-b close all other",
                   ||'0a'x||"documents before using FWCalendar.","*"OK$,'',,PubScreen)
      call CleanUp
    end
  end

  VarLoc = VarListLoc()
  return
/**/

/***//*******  SetVariables Subroutine  ***********/
SetVariables:
  CNotice     = 'Created w/ FWCalendar © Ron Goertz'
  FSize.4pt   = 4
  Font.4pt    = DefaultFont

  DoJulian     = upper(DoJulian)
  DoJulianLeft = upper(DoJulianLeft)
  ShiftLMini   = ShiftLMini / 720
  ShiftRMini   = ShiftRMini / 720

  if (PhaseLib ~= 1) & (DoPhases ~= 0) then do
    call AddMsg('W', 'date.library or rexxmathlib.library are required to calculate the moon phases.')
    DoPhases = 0
  end

  if App == 'FW' then do
    TextBase = TextAdj
    do i = 0 to FontTypes
      if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
      if ~exists(Font.i) then do
        call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
        Font.i = DefaultFont
      end
    end
    if Bold.MiniCal == NameOnly(Bold.MiniCal) then Bold.MiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.MiniCal
    if ~exists(Bold.MiniCal) then do
      call AddMsg('W', NameOnly(Bold.MiniCal)" can't be found; "DefaultBold" used instead.")
      Bold.MiniCal = DefaultBold
    end
    if Bold.FYMiniCal == NameOnly(Bold.FYMiniCal) then Bold.FYMiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.FYMiniCal
    if ~exists(Bold.FYMiniCal) then do
      call AddMsg('W', NameOnly(Bold.FYMiniCal)" can't be found; "DefaultBold" used instead.")
      Bold.FYMiniCal = DefaultBold
    end
    PAGESETUP ORIENT Orientation
    if upper(Orientation) == 'WIDE' then TextArea = WTextArea
    else TextArea = TTextArea

    GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
    DISPLAYPREFS Measure Inches
    SECTIONSETUP TOP Margin.Top BOTTOM Margin.Bottom INSIDE Margin.Left OUTSIDE Margin.Right
    GETPAGESETUP Width Height
    parse var result FullWidth FullHeight
  end
  else if App = 'PGS' then do
    TextBase = 1
    do i = 0 to FontTypes
      do j = 0 to FontList.COUNT - 1
        if upper(Font.i) == upper(FontList.j) then leave
      end
      if j == FontList.COUNT then do
        call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
        Font.i = DefaultFont
      end
    end
    do j = 0 to FontList.COUNT - 1
      if upper(Bold.MiniCal) == upper(FontList.j) then leave
    end
    if j == FontList.COUNT then do
      call AddMsg('W', Bold.MiniCal" can't be found; "DefaultBold" used instead.")
      Bold.MiniCal = DefaultBold
    end
    do j = 0 to FontList.COUNT - 1
      if upper(Bold.FYMiniCal) == upper(FontList.j) then leave
    end
    if j == FontList.COUNT then do
      call AddMsg('W', Bold.FYMiniCal" can't be found; "DefaultBold" used instead.")
      Bold.FYMiniCal = DefaultBold
    end

    if upper(Orientation) == 'WIDE' then do
      TextArea = WTextArea
      Orientation = 'LANDSCAPE'
    end
    else do
      TextArea = TTextArea
      Orientation = 'PORTRAIT'
    end

    if CalType == 1 then DocName = '"'EnteredYear''Mn''Calendar$'"'
    else DocName = '"'EnteredYear''Calendar$'"'
    PageName = '"FWCalendar by Ron Goertz"'
    NEWDOCUMENT DocName
    NEWMASTERPAGE PageName PageWidth PageHeight SINGLE Orientation
    SETMARGINGUIDES Margin.Left Margin.Right Margin.Top Margin.Bottom MASTERPAGE PageName
    SETDIMENSIONS PageWidth PageHeight SINGLE Orientation MASTERPAGE PageName
    SETCOLUMNGUIDES 0 0 MASTERPAGE PageName
    SETDOCUMENTSTATUS unchanged DOCUMENT DocName
    OPENWINDOW '"View 1"' DOCUMENT DocName PAGE 1
    GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
    UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
    SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
    GETMARGINGUIDES temp MASTERPAGE PageName
    if rc == 0 then do
      Margin.Left   = temp.inside
      Margin.Right  = temp.outside
      Margin.Top    = temp.top
      Margin.Bottom = temp.bottom
    end
    GETDIMENSIONS temp MASTERPAGE PageName
    CmdSuccess = rc
    if Orientation = 'LANDSCAPE' then do
      if CmdSuccess == 0 then do
        FullWidth  = temp.height
        FullHeight = temp.width
      end
      else do
        FullWidth  = PageHeight
        FullHeight = PageWidth
      end
    end
    else do
      if CmdSuccess == 0 then do
        FullWidth  = temp.width
        FullHeight = temp.height
      end
      else do
        FullWidth  = PageWidth
        FullHeight = PageHeight
      end
    end
    CURRENTWINDOW; winName = '"'RESULT'"'
  end
  PrintWidth  = FullWidth - Margin.Left - Margin.Right
  PrintHeight = FullHeight - Margin.Top - Margin.Bottom


  if CalType == 1 then do
    Height.4pt = GetHeight(4pt)

    if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then do
      DoCopyright = 1
      PrintHeight = PrintHeight - Height.4pt
    end
    else DoCopyright = 0

    BoxWidth    = PrintWidth/7
    CalRight    = Margin.Left + BoxWidth * 7

    TextArea        = TextArea * PrintHeight
    CalTop          = TextArea + Margin.Top
    BoxHeight       = (PrintHeight - TextArea)/5
    MoonRadius      = BoxHeight * MoonRadius
    DateOffset      = DateOffset * BoxWidth
    MiniCalHeight   = TextArea * MiniCalHeight
    MiniCalWidth    = MiniCalHeight * MiniCalWidth

    FSize.Highlight = BoxHeight/HighlightRows * 72
    FSize.Extras    = FSize.Highlight * MagnifyExtras
    FSize.Date      = BoxHeight/HighlightRows * 72 * StretchDateH
    Width.Date      = 100 * StretchDateW / StretchDateH
    FSize.Weekday   = (TextArea - MiniCalHeight) * WeekdaySize * 72
    FSize.Header    = TextArea * HeaderSize * 72

    if App == 'FW' then do
      FSize.MiniCal  = MiniCalHeight/6 * 72
      do i = 0 to 6
        FSize.i = min(max(trunc(FSize.i), 4), 360)
        Width.i = min(max(trunc(Width.i), 4), 255)
      end
    end
    else if App == 'PGS' then FSize.MiniCal  = MiniCalHeight/7 * 72

    Height.Highlight = FSize.Highlight / 4 * Height.4pt * Leading/100
    Height.Date      = FSize.Date / 4 * Height.4pt * Leading/100
    Height.Weekday   = FSize.Weekday / 4 * Height.4pt * Leading/100
    Height.Header    = FSize.Header / 4 * Height.4pt * Leading/100
    Height.MiniCal   = FSize.MiniCal / 4 * Height.4pt * Leading/100
    Height.Extras    = FSize.Extras / 4 * Height.4pt * Leading/100

    if DoMiniCals == 1 then call GetMiniMax(MiniCal)
  end
  else do
    Height.4pt = GetHeight(4pt)

    if ((((PrintHeight - (3 * MiniCalSpacing) - Height.4pt) / 4 ) / 7) * 72) >= 4 then DoCopyright = 1
    else DoCopyright = 0

    MiniCalSpacing  = PrintWidth * MiniCalSpacing
    MiniCalWidth    = (PrintWidth - 2 * MiniCalSpacing)/3
    FSize.FYMiniCal = (((PrintHeight - (3 * MiniCalSpacing) - (Height.4pt * DoCopyright)) / 4 ) / 7) * 72
    if App == 'FW' then FSize.FYMiniCal = max(trunc(FSize.FYMiniCal), 4)
    Height.FYMiniCal = FSize.FYMiniCal / 4 * Height.4pt * Leading/100
    call GetMiniMax(FYMiniCal)
  end

  if App == 'FW' then do
    FIRSTOBJECT; ObjID = result
    SELECTOBJECT ObjID
    do forever
      NEXTOBJECT ObjID; ObjID = result
      if ObjID == 0 then leave
      SELECTOBJECT ObjID MULTIPLE
    end
    DELETEOBJECT
  end
  VariablesSet = 1
  if ErrorCount > 0 then call Cleanup
return
/**/

/***//*******  TranslationStrings () Subroutine  ***********/
TranslationStrings:
AddEvent$       = 'Add Event'
All$            = 'All'
Backgrounds$    = 'Backgrounds'
BiOrWeekly$     = '(Bi)Weekly'
Biweekly$       = 'Biweekly'
Bottom$         = 'Bottom'
BoxColor$       = 'Box'
BoxDates$       = 'Box Dates'
Boxed$          = '_Boxed'
Calendar$       = 'Calendar'
Cancel$         = '_Cancel'
CantFind$       = "can't be found"
Center$         = 'Center'
Clear$          = 'Clear'
Colors$         = 'Colors'
Comment$        = 'Comment'
Critical$       = 'Critical error'
DailyColors$    = 'Use daily colors'
DeleteEvent$    = 'Delete Event'
Done$           = 'Done'
Easter$         = 'Easter'
End$            = 'End'
EnterEvent$     = 'You must enter an event...'
EnterEventInfo$ = 'Enter event information'
EnterStartdate$ = 'You must enter a start date...'
Even$           = 'Even'
Event$          = 'Event'
Extended$       = 'Extended'
File$           = 'File'
First$          = 'First'
Fixed$          = 'Fixed'
Floating$       = 'Floating'
Font$           = 'Font'
Fonts$          = 'Fonts'
ForDetails$     = 'for details'
ForwardContent$ = 'Forward contents of output to'
ForwardLog$     = 'Forward log file to'
Fourth$         = 'Fourth'
Frequency$      = 'Frequency'
GeneratingM$    = 'Generating %s %s calendar'
GeneratingY$    = 'Generating %s calendar'
Highlights$     = 'Highlights'
Holiday$        = 'Holiday'
Images$         = 'Images'
Julian$         = 'Julian'
JulJulLeft$     = 'Jul/Jul Left'
JulLeft$        = 'Jul Left'
Last$           = 'Last'
Left$           = 'Left'
Line$           = '_Line'
Load$           = '_Load'
MatchColors$    = 'Date Color = Highlight Color'
MiniCals$       = 'MiniCals'
MiscVar$        = 'Miscellaneous Variables'
Monthly$        = '_Monthly'
MustUse$        = "You must use the gadget to"||'0a'x||"the right for this value."
NextDay$        = 'Next day'
Noncritical$    = 'Noncritical warning'
None$           = 'None'
NotClear$       = '<'Clear$'> can only be used for "Background." variables...'
Note$           = 'Notes'
NoteBox$        = 'Include note box'
Notice$         = 'notice'
Odd$            = 'Odd'
OK$             = '_OK'
OK2$            = 'OK'
Once$           = 'Once'
Options$        = 'Options'
OptLayout$      = 'Options & Layout'
OrientMarg$     = 'Orientation & Margins'
Phases$         = 'Phases'
PleaseWait$     = 'Please wait'
PrepReq$        = 'Preparing requester'
PreviousDay$    = 'Prev day'
ProcessEvents$  = 'Processing events'
Reset$          = '_Reset'
Right$          = 'Right'
RiseSet$        = 'Rise/Set'
Second$         = 'Second'
See$            = 'see'
SeeOutput$      = 'see the output above for details'
SeeShell$       = 'see the shell output for details'
SelectFile$     = 'Select data file'
SelectFont$     = 'Select font'
SelectPrefs$    = 'Select name for prefs file'
SelectApp$      = 'Select application'
Start$          = 'Start'
Sunrise$        = 'Sunrise'
Sunset$         = 'Sunset'
Tall$           = 'Tall'
TextColor$      = 'Text'
Third$          = 'Third'
Top$            = 'Top'
TopLong$        = 'Extra week at top'
Type$           = 'Type'
Unable$         = 'if you are unable to resolve the problem.'
VarGUITitle$    = 'Set desired variables'
Variables$      = 'Variables'
Weekend$        = 'Weekend'
Weekly$         = 'Weekly'
WeekNumber$     = 'Week Number'
WeekType$       = 'Week Type'
WholeYear$      = 'Whole _Year'
Wide$           = 'Wide'

January$   = 'January'
February$  = 'February'
March$     = 'March'
April$     = 'April'
May$       = 'May'
June$      = 'June'
July$      = 'July'
August$    = 'August'
September$ = 'September'
October$   = 'October'
November$  = 'November'
December$  = 'December'

Sunday$    = 'Sunday'
Monday$    = 'Monday'
Tuesday$   = 'Tuesday'
Wednesday$ = 'Wednesday'
Thursday$  = 'Thursday'
Friday$    = 'Friday'
Saturday$  = 'Saturday'
return 0
/**/

/***//*******  VarList () Subroutine  ***********/
ReturnVarListLoc:
  return SIGL + 2
VarListLoc:
  /* WTextArea      = fraction of print height used for top of calendar (Wide) */
  /* TTextArea      = fraction of print height used for top of calendar (Tall) */
  /* DateOffset     = fraction of box width to offset dates from edge of box   */
  /* MiniCalHeight  = fraction of text area height used for minicals           */
  /* MiniCalWidth   = width-to-height ratio for minicals                       */
  /* MiniCalSpacing = fraction of print width placed between FY minicals       */
  signal ReturnVarListLoc
VarList:
  AddEventRows          = 9
  AdjustDST             = 1
  AltColor.Date         = Black$
  AltColor.Extended     = Black$
  AltColor.Highlight    = Black$
  AltColor.HighlightH   = Black$
  AltColor.Julian       = Black$
  AltColor.Sunrise      = Black$
  AltColor.Sunset       = Black$
  AltColor.WeekNumber   = Black$
  Background.AddEvent   = White$
  Background.Highlight  = White$
  Background.HighlightH = White$
  Background.MiniCal    = White$
  Background.Weekend    = White$
  BelzierFactor         = .55
  Bold.MiniCal          = DefaultBold
  Bold.FYMiniCal        = DefaultBold
  CenterMiniDates       = 1
  Color.Sunday          = Black$
  Color.Monday          = Black$
  Color.Tuesday         = Black$
  Color.Wednesday       = Black$
  Color.Thursday        = Black$
  Color.Friday          = Black$
  Color.Saturday        = Black$
  Color.AddEvent        = Black$
  Color.Date            = Black$
  Color.Extended        = Black$
  Color.Header          = Black$
  Color.Highlight       = Black$
  Color.HighlightH      = Black$
  Color.Julian          = Black$
  Color.MiniCal         = Black$
  Color.Moon            = Black$
  Color.NoteBox         = Black$
  Color.Sunrise         = Black$
  Color.Sunset          = Black$
  Color.Weekday         = Black$
  Color.WeekNumber      = Black$
  DateOffset            = 0.02
  DoBackgrounds         = 0
  DoDailyColors         = 0
  DoDateBox             = 0
  DoExtended            = 1
  DoHide                = 0
  DoHighlights          = 0
  DoImages              = 0
  DoJulian              = 0
  DoJulianLeft          = 0
  DoMatchColors         = 0
  DoMiniCals            = 1
  DoNoteBox             = 0
  DoPhases              = 0
  DoShanghai            = 1
  DoSunRise             = 0
  DoSunSet              = 0
  DoTopExtraWk          = 0
  DoWeekNumber          = 0
  FinalView             = 75
  Font.Date             = DefaultFont
  Font.Extras           = DefaultFont
  Font.Header           = DefaultFont
  Font.Highlight        = DefaultFont
  Font.MiniCal          = DefaultFont
  Font.FYMiniCal        = DefaultFont
  Font.Weekday          = DefaultFont
  GenMVars              = 'Month.Month EnteredYear'
  GenYVars              = 'EnteredYear'
  GfxApp                = 'Visage'
  GfxAppPath            = ''
  GfxCmd                = '%s info'
  GfxTemplate           = '. "0a"x . ImgDT ImgWidth "x" ImgHeight "x" .'
  HeaderLoc             = 2
  HeaderSize            = .5
  HighlightRows         = 9
  LaunchM               = ''
  LaunchY               = ''
  Leading               = 100
  Line.AddEvent         = Black$
  Line.Extended         = Black$
  Line.Grid             = Black$
  Line.MiniCal          = Black$
  Line.NoteBox          = Black$
  MagnifyExtras         = 1
  Margin.Bottom         = 0
  Margin.Left           = 0
  Margin.Right          = 0
  Margin.Top            = 0
  MinWidth              = 80
  MaxImgHeight          = .75
  MaxImgWidth           = .75
  MiniCalHeight         = 0.60
  MiniCalSpacing        = 0.005
  MiniCalWidth          = 2.00
  MoonRadius            = .1
  Orientation           = 'Wide'
  PrefsName             = 'Default'
  ShiftLMini            = 0
  ShiftRMini            = 0
  StartWeek             = 0
  StretchDateH          = 1
  StretchDateW          = 1
  SunCalcPath           = ''
  Text.Julian           = ''
  Text.Sunrise          = ''
  Text.Sunset           = ''
  Text.WeekNumber       = ''
  WeekdaySize           = .5
return
/**/