AmigActive 6/AACD06.ISO/AACD/Utilities/FWCalendar/FWCalendar.rexx

OS/2 REXX Batch file | 2000-01-11 | 136KB | 3,777 lines

/*
   FWCalendar.rexx Macro
   Creates calendars on FinalWriter v 4.x (SoftWood) & PageStream v 3.x
   $VER: FWCalendar.rexx v3.78 (11 Jan 2000)
   ©Ron Goertz ([e-mail])
*/

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)

if (DoHighlights == 1) | (DoImages == 1) then call SetHighLights
if DoPhases ~= 0 then call GetPhases(Year, Month)

/************************/
/* 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')

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')

/* 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
LineTop.    = CalTop
LineBottom. = CalTop + BoxHeight*5
LineLeft.   = Margin.Left
LineRight.  = CalRight
BackBox.    = 0

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

Do i = 0 to 5
  if i = 5 then do
    BoxTop = CalTop + BoxHeight*4.5
    BHeight = BoxHeight/2
  end
  else do
    BoxTop  = CalTop + BoxHeight*i
    BHeight = BoxHeight
  end

  Do j = 0 to 6
    Day = Day + 1
    JulianDay = IDay + Day
    BoxLeft = Margin.Left + BoxWidth * j

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

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

      /* Next month */
      else do
        PrintDay = Day - MonthLength.Month
        interpret 'LineBottom.'j+1' = 'CalTop + BoxHeight*4
        CalRow = i + 1
        if LineRight.CalRow == CalRight then LineRight.CalRow = Margin.Left + BoxWidth * j
      end

      if DoExtended then do
        if (j = Day.Sunday | j = 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 i = 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 (j = Day.Sunday | j = 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 j == Day.Sunday then TextColor = Color.Sunday
            when j == Day.Monday then TextColor = Color.Monday
            when j == Day.Tuesday then TextColor = Color.Tuesday
            when j == Day.Wednesday then TextColor = Color.Wednesday
            when j == Day.Thursday then TextColor = Color.Thursday
            when j == Day.Friday then TextColor = Color.Friday
            when j == 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 j == Day.Sunday then TextColor = Color.Sunday
            when j == Day.Monday then TextColor = Color.Monday
            when j == Day.Tuesday then TextColor = Color.Tuesday
            when j == Day.Wednesday then TextColor = Color.Wednesday
            when j == Day.Thursday then TextColor = Color.Thursday
            when j == Day.Friday then TextColor = Color.Friday
            when j == 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 (i = 5) & (Day = MonthLength.Month) then leave i
  end
  if Day >= MonthLength.Month then leave
end
/**/

/***//* Draw grids */
LowRow = i
if LowRow = 3 then LineBottom. = CalTop + BoxHeight*4

/* Draw vertical grid */
do i = 0 to 7
  LeftEdge = Margin.Left + BoxWidth*i
  if DoExtended then do
    if LineTop.i > CalTop then do
      call DrawLine(LeftEdge, CalTop, LeftEdge, LineTop.i, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
    if LineBottom.i < LineBottom.8 then do
      call DrawLine(LeftEdge, LineBottom.i, LeftEdge, LineBottom.8, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
  end
  call DrawLine(LeftEdge, LineTop.i, LeftEdge, LineBottom.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 LineLeft.i > Margin.Left then do
      call DrawLine(Margin.Left, TopEdge, LineLeft.i, TopEdge, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
    if LineRight.i < CalRight then do
      call DrawLine(LineRight.i, TopEdge, CalRight, TopEdge, 'HL', Line.Extended)
      call UpdateBusy(Req, 1)
    end
  end
  call DrawLine(LineLeft.i, TopEdge, LineRight.i, TopEdge, 'HL', Line.Grid)
  call UpdateBusy(Req, 1)
end
/**/

/***//* 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)

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)
  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(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

  parse var AI_Image AI_Image ',' AI_DX ',' AI_DY
  if (pos('/', AI_Image) == 0) & (pos(':', AI_Image) == 0) then AI_Image = ScriptDir'Images/'AI_Image
  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)
  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

  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
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

  if DoEaster == 1 then do
    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)
  end
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_Event

  if DoImages ~= 1 then return 0

  if CI_Month = 13 then CI_Month = Mn - 0

  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_Event)
  else return CI_Day
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 call bguiwinclose(Req)
  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 (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
    if (exists(ScriptDir''ChangesFile)) & (word(statef(ScriptDir''ChangesFile), 2) > 2) then do
      call writeln('FWCLog', '0a'x||' -- 'ScriptDir''ChangesFile' -- ')
      call open('DataFile', ScriptDir''ChangesFile)
        do until eof('DataFile')
          call writeln('FWCLog', ReadLn('DataFile'))
        end
      call close('DataFile')
    end

    if ErrorCount > 0 then ErrorType = Critical$
    else ErrorType = Noncritical$
    FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <[e-mail]>'||'0a'x||Unable$
    Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <[e-mail]>'||'0a'x||Unable$
    ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <[e-mail]>'||'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
/**/

/***//*******  CreateDataFile (CD) Subroutine  ***********/
CreateDataFile:
  CD_VarCount = 0
  CD_Progress = -1
  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

  if (~exists(ScriptDir''ChangesFile)) | (word(statef(ScriptDir''ChangesFile), 2) < 2) then do
    if open('DataFile', ScriptDir''ChangesFile, 'W') then do
      call TranslationStrings
      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')
        DefaultVariables = readch('Temp', 65535)
      call close('Temp')
      call openv('DefaultVariables')
        do forever
          CD_VarLine = strip(readvln('DefaultVariables'))
          if CD_VarLine == 'return' then leave
          if CD_VarLine == '' then iterate
          if left(CD_VarLine, 7) ~= 'Margin.' then interpret CD_VarLine
          CD_Var = word(CD_VarLine, 1)
          CD_Var.CD_VarCount = CD_Var
          if (datatype(value(CD_Var.CD_VarCount)) == 'CHAR') then CD_VarLine.CD_VarCount = CD_Var.CD_VarCount" = '"Value(CD_Var.CD_VarCount)"'"
          else CD_VarLine.CD_VarCount = CD_Var.CD_VarCount' = 'Value(CD_Var.CD_VarCount)
          CD_VarCount = CD_VarCount + 1
        end
      call closev('DefaultVariables')

      if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
        if open('UserFile', PrefsFile) then do
          UserFile = readch('UserFile', 65535)
          call close('UserFile')
          call openv('UserFile')
            do until eofv('UserFile')
              CD_Progress = -CD_Progress
              call UpdateBusy(Req, CD_Progress)
              CD_VarLine = strip(ReadvLn('UserFile'))
              CD_VarName = upper(strip(word(CD_VarLine, 1)))
              if left(CD_VarLine, 15) == '/* End Pass One' then leave
              if (right(CD_VarName, 1) == '$') |,
                 (left(CD_VarLine, 2) == '/*') |,
                 (CD_VarLine == '') then iterate
              CD_MemberID = MemberID(CD_VarName, 'CD_Var', CD_VarCount)
              if CD_MemberID >= 0 then CD_VarLine.CD_MemberID = CD_VarLine
              else do
                CD_Var.CD_VarCount = CD_VarName
                CD_VarLine.CD_VarCount = CD_VarLine
                CD_VarCount = CD_VarCount + 1
              end
            end
          call closev('UserFile')
        end
      end
      call writeln('DataFile', 'Dataversion 'word(sourceline(4), 3))
      call writeln('DataFile', "PrefsFile = '"PrefsFile"'")
      call writeln('DataFile', "Cancel$ = '"Cancel$"'")
      call writeln('DataFile', "PleaseWait$ = '"PleaseWait$"'")
      call writeln('DataFile', "PrepReq$ = '"PrepReq$"'")
      do CD_i = 0 to CD_VarCount - 1
        call writeln('DataFile', CD_VarLine.CD_i)
      end
      call close('DataFile')
      if sign(CD_Progress) == 1 then call UpdateBusy(Req, -CD_Progress)
    end
    else do
      call AddMsg('E', 'Unable to create 'ScriptDir''ChangesFile)
      call Cleanup
    end
  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_DateString = 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 (i = 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 (i = 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 (i = 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 (i = 5) & (left(DoSunSet, 1) ~= 'T') then call Move(SSID.DO_PrevDay, 0, -BoxHeight / 2)
    end
  end
  /**/

/***//* DoWeekNumber */
  if (DoWeekNumber ~= 0) & (j = 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)/7, 0) + 1
    If StartYear == 1 then DO_WN = DO_WN - 1
    DO_Text2Print = Text.WeekNumber''DO_WN
    call UpdateBusy(Req, 1)
    WNID.Day = PrintOption(DoWeekNumber)
    if (i = 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 (i = 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 (i = 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

  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'PrefsName)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('extended_',Extended$, DoExtended)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
          )||,
          bguivarspace(10)||,
          bguivgroup(,
            bguicheckbox('dateboxes_',BoxDates$, DoDateBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('backgrounds_',Backgrounds$, DoBackgrounds)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
            bguicheckbox('images_',Images$, DoImages)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_',,'FontName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
          bguistring('fontvalue_',,value(FontName),256)bguilayout(LGO_FixMinHeight,1)||,
          bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
        ,-2,'F',Fonts$)||,
        bguivgroup(,
          bguihgroup(,
            bguicycle('colorvar_',,'ColorName')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$)||,
        bguihgroup(,
          bguicycle('currentvar_',,'VarName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
          bguistring('currentvalue_',,VarVal,256)bguilayout(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)||,
      bguibutton('export_',Export$)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)

  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(ColorName),'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 bguiwinopen(winID)=0 then bguierror(12)

  if Req ~= 0 then call bguiwinclose(Req)

  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
        address command 'delete >NIL: 'ScriptDir''ChangesFile' quiet'
        PrefsFile = 'Default'
        leave
      end
      when id == id.load_ then do
        CurrentPrefs = PrefsFile
        PrefsFile = bguifilereq(ScriptDir''"FWCalendar.prefs", SelectFile$, winID,DOPATTERNS,PatVar)
        if PrefsFile ~= '' then do
          if ~exists(PrefsFile) then do
            call bguireq(PrefsFile' 'CantFind$'...','*'OK$,'FWCalendar 'Notice$,,PubScreen)
            PrefsFile = CurrentPrefs
          end
          else do
            address command 'delete >NIL: 'ScriptDir''ChangesFile' quiet'
            Reset = 1
            leave
          end
        end
      end
      when id == id.export_ then do
        ExportFile = ''
        ExportFile = bguifilereq(ScriptDir, ExportFile$, winID)
        if ExportFile ~= '' then do
          if upper(NameOnly(ExportFile)) == upper(NameOnly(PrefsFile)) then call bguireq(esc'c'CantMatch$'...','*'OK$,'FWCalendar 'Notice$,,PubScreen)
          else if open('ExportFile', ExportFile, 'W') then do
            call bguiwinbusy(winID)
            call bguiwinopen(ExportwinID)
            call ExportVariables('ExportFile')
            call bguiwinclose(ExportwinID)
            call bguiwinready(winID)
            call close('ExportFile')
          end
          else call bguireq(ExportFile' 'CantOpen$'...','*'OK$,'FWCalendar 'Notice$,,PubScreen)
        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     DoExtended = sign(bguiget(obj.extended_, 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 bguiwinbusy(winID)
        call bguireq('1b'x||"c"MustUse$,"*"OK$,'',,PubScreen)
        call bguiset(obj.fontvalue_, winID,STRINGA_TextVal, value(FontName))
        call bguiwinready(winID)
      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 FontName" = '"strip(bguiget(obj.fontvalue_, STRINGA_TextVal),'B', "'"||'"')"'"
        FontName = value('FontName.'bguiget(obj.fontvar_, CYC_Active))
        call bguiset(obj.fontvalue_,winID,STRINGA_TextVal,Value(FontName))
      end
      when id == id.colorvar_ then do
        interpret ColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
        ColorName = value('ColorName.'bguiget(obj.colorvar_, CYC_Active))
        call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(ColorName),'ColorList')))
        CurrentColor = bguiget(obj.colorlist_, CYC_Active)
      end
      when id == id.colorlist_ then do
        if (pos('BACKGROUND.', upper(ColorName)) == 0) & (bguiget(obj.colorlist_, CYC_Active) == ColorList.Count - 1) then do
          call bguiwinbusy(winID)
          call bguireq('1b'x||"c"NotClear$,"*"OK$,'',,PubScreen)
          call bguiset(obj.colorlist_, winID, CYC_Active, CurrentColor)
          call bguiwinready(winID)
        end
      end
      when id == id.currentvar_ then do
        Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
        if datatype(Value) == 'CHAR' then Value = "'"strip(Value,'B', "'"||'"')"'"
        if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
          IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
          interpret 'ImageFile.'IC' = 'Value
        end
        else interpret Varname' = 'Value
        VarName = value('VarName.'bguiget(obj.currentvar_, CYC_Active))
        if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
          IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
          call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,value('ImageFile.IC'))
        end
        else call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,Value(VarName))
      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)
        leave
      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 then leave
  end
  interpret FontName" = '"strip(bguiget(obj.fontvalue_, STRINGA_TextVal),'B', "'"||'"')"'"

  interpret ColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'

  Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
  if datatype(Value) == 'CHAR' then Value = "'"strip(Value,'B', "'"||'"')"'"
  if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
    IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
    interpret 'ImageFile.'IC' = 'Value
  end
  else interpret Varname' = 'Value
  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
/**/

/***//*******  ExportVariables (EV) Subroutine  *********/
ExportVariables:
  parse arg EV_File

  call open('Temp', FullCallPath)
    EV_FileOffset = 120000
    call seek('Temp', EV_FileOffset, 'B')
    do until (EV_EndPos ~= 0) | (EV_PrevOffset = EV_FileOffset)
      EV_PrevOffset = EV_FileOffset
      EV_Chunk = readch('Temp', 65535)
      EV_EndPos = pos('VarList:'||'0a'x, EV_Chunk)
      if EV_EndPos == 0 then EV_FileOffset = seek('Temp', -10, 'C')
    end
    call seek('Temp', EV_FileOffset + EV_EndPos + 8, 'B')
    EV_DefaultVariables = readch('Temp', 65535)
  call close('Temp')

  call openv('EV_DefaultVariables')
    do forever
      EV_VarLine = strip(readvln('EV_DefaultVariables'))
      EV_VarName = strip(word(EV_VarLine, 1))
      EV_VarVal  = strip(substr(EV_VarLine, pos('=', EV_VarLine) + 1))
      if EV_VarLine == 'return' then leave
      EV_Existing = MemberID(EV_VarName, 'RD_Var')
      if EV_Existing == -1 then iterate
      interpret 'EV_DefaultValue = 'EV_VarVal
      EV_CurrentVal = value(value('RD_Var.'EV_Existing))
      if EV_CurrentVal ~= EV_DefaultValue then do
        if datatype(EV_CurrentVal) == 'CHAR' then EV_CurrentVal = '"'EV_CurrentVal'"'
        call writeln(EV_File, right(EV_VarName, VarNameMaxLn)' = 'EV_CurrentVal)
      end
    end
  call closev('EV_DefaultVariables')
  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
/**/

/***//*******  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 PgmVersion = 'Final Writer - version unknown'
        else do
          StartPos = lastpos('Final', Chunk, EndPos)
          EndPos = pos('00'x||'00'x, Chunk, StartPos)
          PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
        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:
  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

  PrefsFile = 'Default'
  if (exists(ScriptDir''ChangesFile)) & (word(statef(ScriptDir''ChangesFile), 2) > 2) then do
    if open('DataFile', ScriptDir''ChangesFile) 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 (right(GSI_Var, 1) == '$') |,
             (GSI_Var == 'DOSHANGHAI') |,
             (GSI_Var == 'STORAGE') |,
             (GSI_Var == 'PREFSFILE') then interpret GSI_Ln
        end
      call CloseV('GSI_Data')
    end
  end

  call makedir(left(Storage, length(Storage) - 1))
  call ReadTranslations
  call InitializeSettings

  do until Reset == 0
    call CheckShanghai
    call ReadTranslations
    Req = OpenBusy(PrepReq$'...', 6)
    call CreateDataFile
    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);if GSI_DX == '' then GSI_DX = 0
      GSI_DY = strip(GSI_DY);if GSI_DY == '' then GSI_DY = 0
      if (pos('/', ImageFile.GSI_i) == 0) & (pos(':', ImageFile.GSI_i) == 0) then
        ImageFile.GSI_i = ScriptDir'Images/'ImageFile.GSI_i
      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

  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

  call WriteData

  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 call WriteEnv('suncalc/dst', 0)
    else call 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
/**/

/***//*******  ReadData (RD) Subroutine  ***********/
ReadData:
  call UpdateBusy(Req, 1)
  RD_VarCount   = 0
  RD_ColorCount = 0
  RD_FontCount  = 0
  RD_ICCount    = 0
  RD_SL         = 0
  RD_Var.       = ''
  RD_UpdateVars = 0
  RD_Progress   = -1
  PrefsFile     = ''
  PrefsName     = ''
  VarNameMaxLn  = 0

  if open('DataFile', ScriptDir''ChangesFile) then do
    DataFile = readch('DataFile', 65535)
    call close('DataFile')
    call openv('DataFile')
      RD_DataVersion = readvln('DataFile')
      if pos('Dataversion', RD_DataVersion) == 0 then do
        call seekv('DataFile', 0, 'B')
        RD_UpdateVars = 1
      end
      else if word(RD_DataVersion, 2) ~= word(sourceline(4), 3) then RD_UpdateVars = 1
      do until eofv('DataFile')
        RD_Ln = ReadVLn('DataFile')
        if RD_Ln = '' then iterate
        RD_VarName = strip(word(RD_Ln, 1))
        VarNameMaxLn = max(VarNameMaxLn, length(RD_VarName))
        if right(RD_VarName, 1) == '$' then iterate
        if RD_VarName == 'PrefsFile' then do
          interpret RD_Ln
          if PrefsFile ~= 'Default' then do
            if open('UserFile', PrefsFile) then do
              do until eof('UserFile')
                RD_VarLine = strip(ReadLn('UserFile'))
                RD_VarName = upper(strip(word(RD_VarLine, 1)))
                if left(RD_VarLine, 15) == '/* End Pass One' then leave
                if (right(RD_VarName, 1) == '$') then interpret RD_VarLine
              end
              call close('UserFile')
            end
          end
          iterate
        end
        RD_VarDone = 0
        RD_VarStem = upper(left(RD_VarName, pos('.', RD_VarName)))
        RD_Var.RD_SL = RD_VarName
        RD_SL = RD_SL + 1
        if RD_VarStem ~= 'IMAGECLASS.' then interpret RD_Ln
        if (upper(left(RD_VarName, 7)) == 'STORAGE') |,
           (upper(left(RD_VarName, 7)) == 'MARGIN.') |,
           (upper(RD_VarName) == 'PREFSFILE') then iterate
        if (upper(left(RD_VarName, 2)) == 'DO') & (upper(RD_VarName) ~= 'DOHIDE') & (upper(RD_VarName) ~= 'DOSHANGHAI') then RD_VarDone = 1
        if RD_VarStem == 'IMAGECLASS.' then do
          ImageClass.RD_ICCount = upper(substr(RD_VarName, 12))
          interpret 'ImageFile.'RD_ICCount' = 'strip(substr(RD_Ln, pos('=', RD_Ln) + 1))
          RD_ICCount = RD_ICCount + 1
          VarName.RD_VarCount = RD_VarName
          RD_VarCount = RD_VarCount + 1
          RD_VarDone = 1
        end
        if (RD_VarStem == 'ALTCOLOR.') |,
           (RD_VarStem == 'BACKGROUND.') |,
           (RD_VarStem == 'COLOR.') |,
           (RD_VarStem == 'LINE.') then do
          if (MemberID(value(RD_VarName), 'ColorList') == -1) then do
            if (value(RD_VarName) == '<'Clear$'>') & (RD_VarStem == 'BACKGROUND.') then nop
            else do
              call AddMsg('W', value(RD_VarName)" can't be found; "ColorList.0" used instead.")
              interpret RD_VarName' = "'ColorList.0'"'
            end
          end
          ColorName.RD_ColorCount = RD_VarName
          RD_ColorCount = RD_ColorCount + 1
          RD_VarDone = 1
        end
        if (RD_VarStem == 'FONT.') | (RD_VarStem == 'BOLD.') then do
          FontName.RD_FontCount = RD_VarName
          RD_FontCount = RD_FontCount + 1
          RD_VarDone = 1
        end
        if RD_VarDone == 0 then do
          VarName.RD_VarCount = RD_VarName
          RD_VarCount = RD_VarCount + 1
        end
      end
    call closev('DataFile')
  end
  else do
    call AddMsg('E', 'Unable to open 'ScriptDir''ChangesFile)
    call Cleanup
  end

  if RD_UpdateVars == 1 then do /* See if new default variables were added */
    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')
      DefaultVariables = readch('Temp', 65535)
    call close('Temp')
    call openv('DefaultVariables')
      do forever
        RD_VarDone = 0
        RD_VarLine = strip(readvln('DefaultVariables'))
        RD_VarName = strip(word(RD_VarLine, 1))
        RD_VarStem = upper(left(RD_VarName, pos('.', RD_VarName)))
        if RD_VarLine == 'return' then leave
        if (upper(left(RD_VarName, 7)) == 'STORAGE') |,
           (upper(left(RD_VarName, 7)) == 'MARGIN.') then iterate
        if upper(left(RD_VarName, 2)) == 'DO' then do
          if (upper(RD_VarName ~= 'DOHIDE')) & (upper(RD_VarName ~= 'DOSHANGHAI')) then do
            if MemberID(RD_VarName, 'RD_Var', RD_SL) == -1 then do
              interpret RD_VarLine
              RD_Var.RD_SL = RD_VarName
              RD_SL = RD_SL + 1
            end
          end
          RD_VarDone = 1
        end
        if (RD_VarStem == 'ALTCOLOR.') |,
           (RD_VarStem == 'BACKGROUND.') |,
           (RD_VarStem == 'COLOR.') |,
           (RD_VarStem == 'LINE.') then do
          if MemberID(RD_VarName, 'ColorName', RD_ColorCount) == -1 then do
            interpret RD_VarLine
            RD_Var.RD_SL = RD_VarName
            RD_SL = RD_SL + 1
            ColorName.RD_ColorCount = RD_VarName
            RD_ColorCount = RD_ColorCount + 1
          end
          RD_VarDone = 1
        end
        if (RD_VarStem == 'FONT.') | (RD_VarStem == 'BOLD.') then do
          if MemberID(RD_VarName, 'FontName', RD_FontCount) == -1 then do
            interpret RD_VarLine
            RD_Var.RD_SL = RD_VarName
            RD_SL = RD_SL + 1
            FontName.RD_FontCount = RD_VarName
            RD_FontCount = RD_FontCount + 1
          end
          RD_VarDone = 1
        end
        if RD_VarDone == 0 then do
          if MemberID(RD_VarName, 'VarName', RD_VarCount) == -1 then do
            interpret RD_VarLine
            RD_Var.RD_SL = RD_VarName
            RD_SL = RD_SL + 1
            VarName.RD_VarCount = RD_VarName
            RD_VarCount = RD_VarCount + 1
          end
        end
      end
    call closev('DefaultVariables')
  end

  if PrefsFile == '' then do
    if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
    else PrefsFile = 'Default'
  end
  if PrefsName == '' then PrefsName = PrefsFile

  RD_Var.COUNT     = RD_SL
  VarName.COUNT    = RD_VarCount
  ColorName.COUNT  = RD_ColorCount
  FontName.COUNT   = RD_FontCount
  ImageClass.COUNT = RD_ICCount

  ColorName = ColorName.0
  FontName  = FontName.0
  VarName   = VarName.0
  if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
    IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
    VarVal = ImageFile.IC
  end
  else VarVal = Value(VarName)

  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
  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
/**/

/***//*******  ReadTranslations (RTr) Subroutine  ***********/
ReadTranslations:
  if exists(PrefsFile) then do
    if open('DataFile', PrefsFile) then do
      do until eof('DataFile')
        RTr_Ln = ReadLn('DataFile')
        RTr_Var = upper(word(RTr_Ln, 1))
        if right(RTr_Var, 1) == '$' then interpret RTr_Ln
        else if pos('/* End Pass One', RTr_Ln) > 0 then leave
      end
      call close('DataFile')
    end
  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
/**/

/***//*******  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 DoEaster == 1 then call AssignHighlight(SH_EasterMonth, SH_EasterDay, Easter$'#')
  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
    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_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:
  if open('DataFile', ScriptDir''ChangesFile, 'W') then do
    call writeln('DataFile', 'Dataversion 'word(sourceline(4), 3))
    call writeln('DataFile', "PrefsFile = '"PrefsFile"'")
    do WD_i = 0 to RD_SL - 1
      WD_VarName = RD_Var.WD_i
      if upper(left(WD_VarName, pos('.', WD_VarName))) == 'IMAGECLASS.' then do
        WD_IC = MemberID(upper(substr(WD_VarName, 12)), 'ImageClass')
        WD_Value = ImageFile.WD_IC
      end
      else WD_Value = Value(WD_VarName)
      if (datatype(WD_Value) == 'CHAR') then WD_Value = "'"WD_Value"'"
      call writeln('DataFile', WD_VarName' = 'WD_Value)
    end
    call close('DataFile')
  end
  else do
    call AddMsg('E', 'Unable to create 'ScriptDir''ChangesFile)
    call Cleanup
  end

  return
/**/

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

  if open('Temp', 'ENV:'file, 'W') then call writech('Temp', var)
  return close('Temp')
/**/

/***//*******  InitializeVariables () 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
  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

  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

  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:
Backgrounds$    = 'Backgrounds'
Bottom$         = 'Bottom'
BoxColor$       = 'Box:'
BoxDates$       = 'Box Dates'
Boxed$          = '_Boxed:'
Calendar$       = 'Calendar'
Cancel$         = '_Cancel'
CantFind$       = "can't be found"
CantMatch$      = "The export file can't be the"||'0a'x||"same as the preferences file"
CantOpen$       = "can't be opened"
Center$         = 'Center'
Clear$          = 'Clear'
Colors$         = 'Colors'
Critical$       = 'Critical error'
DailyColors$    = 'Use daily colors'
Easter$         = 'Easter'
End$            = 'End:'
EnterEvent$     = 'You must enter an event...'
EnterEventInfo$ = 'Enter event information:'
EnterStartdate$ = 'You must enter a start date...'
Event$          = 'Event:'
Export$         = 'E_xport'
ExportFile$     = 'Select export file:'
Exporting$      = 'Exporting'
Extended$       = 'Extended'
File$           = 'File:'
Font$           = 'Font:'
Fonts$          = 'Fonts'
ForDetails$     = 'for details'
ForwardContent$ = 'Forward contents of output to'
ForwardLog$     = 'Forward log file to'
GeneratingM$    = 'Generating %s %s calendar'
GeneratingY$    = 'Generating %s calendar'
GenMVars        = 'Month.Month EnteredYear'
GenYVars        = 'EnteredYear'
Highlights$     = 'Highlights'
Images$         = 'Images'
Julian$         = 'Julian'
JulJulLeft$     = 'Jul/Jul Left'
JulLeft$        = 'Jul Left'
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 to select a font."
Noncritical$    = 'Noncritical warning'
None$           = 'None'
NotClear$       = '<'Clear$'> can only be used for "Background." variables...'
Notice$         = 'notice'
OK$             = '_OK'
Options$        = 'Options'
OptLayout$      = 'Options & Layout'
OrientMarg$     = 'Orientation & Margins'
Phases$         = 'Phases'
PleaseWait$     = 'Please wait'
PrepReq$        = 'Preparing requester'
ProcessEvents$  = 'Processing events'
Reset$          = '_Reset'
Right$          = 'Right'
RiseSet$        = 'Rise/Set'
See$            = 'see'
SeeOutput$      = 'see the output above for details'
SeeShell$       = 'see the shell output for details'
SelectFile$     = 'Select data file:'
SelectFont$     = 'Select font:'
Start$          = 'Start:'
Sunrise$        = 'Sunrise'
Sunset$         = 'Sunset'
Tall$           = 'Tall'
TextColor$      = 'Text:'
Top$            = 'Top'
Unable$         = 'if you are unable to resolve the problem.'
VarGUITitle$    = 'Set desired variables:'
Variables$      = 'Variables'
Weekly$         = '_Weekly:'
Weeknumber$     = 'Weeknumber'
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.Sunrise         = Black$
  Color.Sunset          = Black$
  Color.Weekday         = Black$
  Color.WeekNumber      = Black$
  DateOffset            = 0.02
  DoBackgrounds         = 0
  DoDailyColors         = 0
  DoDateBox             = 0
  DoEaster              = 1
  DoExtended            = 1
  DoHide                = 0
  DoHighlights          = 0
  DoImages              = 0
  DoJulian              = 0
  DoJulianLeft          = 0
  DoMatchColors         = 0
  DoMiniCals            = 1
  DoPhases              = 0
  DoShanghai            = 1
  DoSunRise             = 0
  DoSunSet              = 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
  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$
  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             = ''
  ShiftLMini            = 0
  ShiftRMini            = 0
  StartWeek             = 0
  StretchDateH          = 1
  StretchDateW          = 1
  SunCalcPath           = ''
  Text.Julian           = ''
  Text.Sunrise          = ''
  Text.Sunset           = ''
  Text.WeekNumber       = ''
  WeekdaySize           = .5
return
/**/