/*
    AddEvent.rexx Macro
    Adds events to calendars created by FWCalendar.rexx
    $VER: FWCAddEvent.rexx v3.82 (21 Jun 2000)
    İRon Goertz (goertz@earthlink.net)
*/
 
OPTIONS RESULTS
signal on syntax

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

parse source . . . FullCallPath . CallHost
CallHost = strip(CallHost)
ScriptDir = PathPart(FullCallPath)

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

if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
  App     = 'FW'
  AppName = 'FINALWRITER'
  if CallHost == 'REXX' then address value substr(PortList, pos('FINALW.', PortList), 8)
  GETDOCITEMPREFS Decimal; DecimalFormat = result
  DOCITEMPREFS Decimal Period
end
else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
  App     = 'PGS'
  AppName = 'PAGESTREAM'
  address 'PAGESTREAM'
end

call SetVariables

Month = substr(TempDate,5,2)
if left(Month,1) == "0" then Month = right(Month,1)
PrevMonth = Month - 1
if PrevMonth = 0 then PrevMonth = 12
NextMonth = Month + 1
if NextMonth = 13 then NextMonth = 1
 
Year = left(TempDate,4)
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29

interpret "StartDate = Day."Date('W', TempDate, 'S')
if (DoExtended == 0) | (StartDate + MonthLength.Month > 35) then MaxDate = MonthLength.Month
else MaxDate = 35 - StartDate

FontName = Font.Highlight
FontSize = FSize.Highlight
call GetEvent
exit

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

  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'
  AL_MinVersions = '  0               '
  AL_Offsets     = '-30               '
  AL_Variables   = 'RexxTricks        '
  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 == 'unknown') 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 ErrorCount > 0 then call Cleanup
  return
/**/

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

  if AM_MsgType == 'E' then do
    ErrorCount = ErrorCount + 1
    Error.ErrorCount = AM_Msg
  end
  else do
    WarningCount = WarningCount + 1
    Warning.WarningCount = AM_Msg
  end

  return
/**/

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

  if VariablesSet == 1 then do
    interpret UserPrefs
    if Req ~= 0 then call bguiwinclose(Req)
    if App == 'FW' then do
      SELECTOBJECT
      REDRAW
      if upper(DecimalFormat) == 'COMMA' then DocItemPrefs Decimal Comma
    end
    else if App == 'PGS' then do
      SELECTOBJECT None WINDOW winName
      if WindowRefreshed ~= 1 then do
        REFRESH ON
        REFRESHWINDOW WINDOW winName
      end
    end
  end

  LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  if LogOpen == 1 then OutType = 'File'
  if (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: 'Month.Month' 'Year||'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) then do
      call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
      call open('DataFile', PrefsFile)
        do until eof('DataFile')
          Ln = ReadLn('DataFile')
          if pos('End Pass One', Ln) > 0 then leave
          call writeln('FWCLog', Ln)
        end
      call close('DataFile')
    end

    if EventFile ~= '' then do
      call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
      call open('DataFile', EventFile)
        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 <goertz@earthlink.net>'||'0a'x||Unable$
    Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
    ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
    if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
    if (OutType == 'File') & (bguiopen == 0) then do
      call open('CON', 'CON:10/10/500/300/FWCAddEvent 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
    address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
    if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  end

  address command 'delete >NIL: 'Storage'FWCTemp quiet'
  call close('FWCLog')
  if bguiopen = 1 then call bguiclose()
  if DefScreen ~= '' then call setdefaultpubscreen(DefScreen)
  exit
/**/

/***//*******  ConvertDay (CD) Subroutine ***********/
ConvertDay:
  parse arg CD_Day
  If upper(left(CD_Day,1)) == "P" then CD_Day = substr(CD_Day,2) - MonthLength.PrevMonth
  If upper(left(CD_Day,1)) == "N" then CD_Day = substr(CD_Day,2) + MonthLength.Month
  return CD_Day
/**/

/***//*******  DrawBox (DB) Subroutine  ***********/
DrawBox:
  parse arg DB_x1, DB_y1, DB_Width, DB_Height, DB_Weight, DB_Color, DB_FillBool, DB_FillColor, DB_Tint

  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_Color = DB_FillColor
    end

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

    BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_Color'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
    DRAWBOX 1 DB_x1 DB_y1 DB_Width DB_Height; DB_id = result
  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 OBJECTID DB_id WINDOW winName
    SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECTID DB_id WINDOW winName
    SETCOLORSTYLE '"'DB_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECTID DB_id WINDOW winName
    FILLED DB_FillBool OBJECTID DB_id WINDOW winName
    SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECTID DB_id WINDOW winName
    SETCOLORTINT DB_Tint FILL OBJECTID DB_id WINDOW winName
  end
  return DB_id
/**/

/***//*******  GetEvent (GE) Subroutine  ***********/
GetEvent:
  do GE_i = 0 to 15
    linelist_.GE_i = GE_i
  end
  linelist_.COUNT = min(RowsThatFit, 16)

  call bguilist("eventlist_",Event$,File$)
  call bguilist("FrequencyList", Once$, Weekly$, Biweekly$)

  GE_StartOrEnd   = 1
  GE_StartDate    = ""
  GE_EndDate      = ""
  GE_Boxed.0      = ""
  GE_Boxed.128    = "B"
  GE_Weekly.0     = ""
  GE_Weekly.1     = "W"
  GE_Weekly.2     = "2"
  GadID.          = ''
  GE_Arg.         = ''
  GE_i            = 0
  GE_Day          = 0
  GE_PrevDay      = MonthLength.PrevMonth - StartDate
  GE_NextDay      = 0

  Req = OpenBusy(PrepReq$'...', 45)
  do while (GE_i < 6)
    GE_j = 0
    do while (GE_j < 7)
      call UpdateBusy(Req, 1)
      GE_SerialPosition = (GE_i * 7) + GE_j
      GE_Button = GE_SerialPosition + 1
      if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
        GE_Day = GE_Day + 1
        interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
        GadID = GetID(GE_Button'_')
        GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
      end
      else do
        if GE_SerialPosition < StartDate then Do
          GE_PrevDay = GE_PrevDay + 1
          interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
          GadID = GetID(GE_Button'_')
          GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
        end
        else do
          GE_NextDay = GE_NextDay + 1
          interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
          GadID = GetID(GE_Button'_')
          GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
        end
      end
      GE_j = GE_j + 1
    end
    GE_i = GE_i + 1
    if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  end

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

  g=bguivgroup(,
    bguihgroup(,
      bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
      bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1),
    )||,
    bguihgroup(,
      bguistring('fontvalue_',Font$':',FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
      bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
      bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
      bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
    )||,
    bguihgroup(,
      bguivgroup(,
        bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
        bguihgroup(,
          bguiinfo("dummy_",,esc"c"left(Day.0,1))||,
          bguiinfo("dummy_",,esc"c"left(Day.1,1))||,
          bguiinfo("dummy_",,esc"c"left(Day.2,1))||,
          bguiinfo("dummy_",,esc"c"left(Day.3,1))||,
          bguiinfo("dummy_",,esc"c"left(Day.4,1))||,
          bguiinfo("dummy_",,esc"c"left(Day.5,1))||,
          bguiinfo("dummy_",,esc"c"left(Day.6,1)),
        )||,
        DateButtons,
      )||,
      bguivgroup(,
        bguiinfo("startchoice_",esc"r"Start$':',"")bguilayout(LGO_FixMinHeight, 1)||,
        bguiinfo("endchoice_",esc"r"End$':',"")bguilayout(LGO_FixMinHeight, 1)||,
        bguicycle('textcolor_',esc"r"TextColor$':','TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
        bguicycle("linechoice_",esc"r"Line$':',"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguicheckbox("boxchoice_",esc"r"Boxed$':',0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguicycle('boxcolor_',esc"r"BoxColor$':','ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
        bguicycle("weeklychoice_",esc"r"Frequency$':','FrequencyList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguihgroup(,
          bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
          bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1),
        ),
      ),
    ),
  ,"-1","-1")

  call UpdateBusy(Req, 1)
  GE_winID=bguiwindow(EnterEventInfo$':',g,5,0,,PubScreen)
  call UpdateBusy(Req, 1)

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

  call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  call bguiset(obj.event_,,BT_Key,EventKey)
  call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)

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

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

  id=0
  do while 1
    call bguiwinwaitevent(GE_winID,"ID")
    select
      when (id == id.cancel_) | (id == id.winclose) then call Cleanup
      when id == id.winactive then nop
      when id == id.wininactive then nop
      when id == id.event_ then nop
      when id == id.linechoice_ then nop
      when id == id.boxchoice_ then nop
      when id == id.textcolor_ then nop
      when id == id.boxcolor_ then nop
      when id == id.weeklychoice_ then nop
      when id == id.reset_ then do
        FontName = Font.Highlight
        FontSize = FSize.Highlight
        call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
        call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
      end
      when id == id.fontvalue_ then do
        call bguireq('1b'x||"c"MustUse$,"*"OK$,'',GE_winID)
        call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
      end
      when id == id.fontsize_ then nop
      when id == id.addfont_ then do
        call bguiwinbusy(GE_winID)
        if App == 'FW' then do
          FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$':', GE_winID,,'#?')
          if FontFile ~= '' then call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontFile)
        end
        else if App == 'PGS' then do
          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_, GE_winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
              leave
            end
          end
          call bguiwinclose(FontwinID)
        end
        call bguiwinready(GE_winID)
        FontName = bguiget(obj.fontvalue_, STRINGA_TextVal)
      end
      when id == id.ok_ then do
        GE_EventValue = bguiget(obj.event_, STRINGA_TextVal)
        GE_BoxValue   = bguiget(obj.boxchoice_, GA_Selected)
        GE_EventType  = bguiget(obj.eventtype_, CYC_Active)
        if (GE_StartDate == "") & (GE_EventType == Event$) then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
        else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
        else do
          GE_WeeklyValue  = bguiget(obj.weeklychoice_, CYC_Active)

          EventData = "   EventType = "Type.GE_EventType||'0a'x||,
                      " EnteredFont = "strip(FontName)||'0a'x||,
                      " EnteredSize = "strip(bguiget(obj.fontsize_, STRINGA_TextVal))||'0a'x||,
                      " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
                      " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
                      " EnteredLine = "bguiget(obj.linechoice_, CYC_Active)||'0a'x||,
                      "     Options = "GE_Boxed.GE_BoxValue""GE_Weekly.GE_WeeklyValue||'0a'x||,
                      "   TextColor = "value('ColorList.'bguiget(obj.textcolor_, CYC_Active))||'0a'x||,
                      "    BoxColor = "value('ColorList.'bguiget(obj.boxcolor_, CYC_Active))||'0a'x||,
                      "EnteredEvent = "GE_EventValue

          call bguiwinclose(GE_winID)
          call ProcessEvent
          call bguiwinopen(GE_winID)

          GE_StartOrEnd = 1
          GE_StartDate  = ""
          GE_EndDate    = ""
          call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,'')
          call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,'')
        end
      end
      when id == id.eventtype_ then do
        GE_EventType = bguiget(obj.eventtype_, CYC_Active)
        if Type.GE_EventType == Event$ then do
          call bguiset(obj.event_,GE_winID,STRINGA_TextVal,"")
          call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
          call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
        end
        else do
          GE_DataFile = bguifilereq(ScriptDir''"FWCAddEvent.data", SelectFile$, GE_winID,DOPATTERNS,PatVar)
          if ~exists(GE_DataFile) then do
            call bguireq(GE_DataFile' 'CantFind$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
            GE_DataFile = ''
          end
          if GE_DataFile == '' then do
            call bguiset(obj.eventtype_, GE_winID, CYC_Active, 0)
            call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
            call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
          end
          else do
            call bguiset(obj.event_, GE_winID, STRINGA_TextVal,GE_DataFile)
            call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.reset_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.addfont_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 1)
            call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 1)
          end
        end
      end
      otherwise do
        GE_StartOrEnd = 1 - GE_StartOrEnd
        GE_ReturnDate = strip(substr(GE_Arg.id, 1, 1)""right(GE_Arg.id, 2), "B", "C")
        GE_Date = substr(GE_Arg.id, 3)
        if GE_StartOrEnd == 0 then do
          call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
          GE_StartDate = GE_ReturnDate
        end
        else do
          call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
          GE_EndDate = GE_ReturnDate
        end
      end
    end
  end
  exit
/**/

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

  GFW_ID = PrintText(1, 1, GFW_FontType, 'N', White$, 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
    DELETEOBJECT GH_id
  end
  else if App == 'PGS' then do
    DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
    SELECTTEXT AT 0 0 WINDOW winName
    BEGINCOMMANDCAPTURE
      SETLEADING RELATIVE 100
      SETTYPESIZE FSize.GH_FontType WINDOW winName
      SETFONT Font.GH_FontType WINDOW winName
    ENDCOMMANDCAPTURE
    INSERT 'A' WINDOW winName
    GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
    GH_Text.Height = GH_Text.Bottom - GH_Text.Top
    DELETEOBJECT OBJECTID GH_id WINDOW winName
  end
  return GH_Text.Height
/**/

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

return id.GI_var
/**/

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

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

  call open('Temp', Storage'FWC'App'VersionInfo.txt')
    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
/**/

/***//*******  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
    GETOBJECT BOUNDINGBOX GW_Temp WINDOW winName
    GW_width = GW_Temp.Right - GW_Temp.Left
  end

  return GW_width
/**/

/***//*******  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'
  if open('Temp', 'env:LibVer') then do
    LV_libver = word(readln('Temp'), 2)
    call close('Temp')
  end
  else LV_libver = 'unknown'
  return LV_libver
/**/

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

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

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

  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

  Progress = 0

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

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

/***//*******  ProcessEvent (PE) Subroutine  ***********/
ProcessEvent:
  Day1 = ''
  Day2 = ''
  EnteredLine = 1
  Options = ''
  EnteredEvent = ''
  Box = 0
  Weekly = 0
  WindowRefreshed = 0
  Keywords = '|FONT|SIZE|START|END|LINE|EVENT|OPTIONS|TEXTCOLOR|BOXCOLOR|ENTEREDFONT|ENTEREDSIZE|ENTEREDDAY1|ENTEREDDAY2|ENTEREDLINE|ENTEREDEVENT|'

  if EventData == 0 then call CleanUp
  call openv('EventData')
    do until eofv('EventData')
      PE_Ln = readvln('EventData')
      interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
    end
  call closev('EventData')

  Event. = ''
  if EventType == Event$ then do
    Event.0   = 1
    Event.1   = EventData
    EventFile = ''
  end
  else do
    EventFile = EnteredEvent
    if EnteredDay1 == '' then EnteredDay1 = 1
    RootDay = ConvertDay(EnteredDay1)

    call open('EventFile', EventFile)
      EventCount = 1
      do until eof('EventFile')
        Ln = ReadLn('EventFile')
        if eof('EventFile') == 0 then do
          if (pos('|'upper(word(Ln, 1))'|', Keywords) == 0) & (Ln ~= '') then do
            interpret Ln
            iterate
          end
          if Ln == '' then do
            if Event.1 ~= '' then EventCount = EventCount + 1
            iterate
          end
          Event.EventCount = Event.EventCount''Ln||'0a'x
        end
      end
      Event.0 = EventCount
    call close('EventFile')
  end

  if Event.0 > 1 then Req = OpenBusy(ProcessEvents$'...', Event.0)
  if App == 'PGS' then do
    REFRESH OFF ALL
  end
  do EC = 1 to Event.0
    if Req ~= 0 then call UpdateBusy(Req, 1)
    Box    = 0
    Weekly = 0
    EnteredFont = Font.Highlight
    EnteredSize = FSize.Highlight
    EnteredDay1 = ''
    EnteredDay2 = ''
    EnteredLine = ''
    EnteredEvent = ''
    Options = ''
    BoxColor = ''
    TextColor = ''

    if Event.EC == '' then iterate
    call openv('Event.EC')
      do until eofv('Event.EC')
        PE_Ln = readvln('Event.EC')
        PE_Variable = upper(strip(word(PE_Ln, 1)))
        select
          when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
          when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
          when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
          when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
          when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
          when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
          when PE_Variable == 'OPTIONS' then nop
          when PE_Variable == 'TEXTCOLOR' then nop
          when PE_Variable == 'BOXCOLOR' then nop
          when PE_Variable == 'ENTEREDFONT' then nop
          when PE_Variable == 'ENTEREDSIZE' then nop
          when PE_Variable == 'ENTEREDDAY1' then nop
          when PE_Variable == 'ENTEREDDAY2' then nop
          when PE_Variable == 'ENTEREDLINE' then nop
          when PE_Variable == 'ENTEREDEVENT' then nop
          otherwise PE_Variable = 'Error'
        end
        if PE_Variable ~= 'Error' then interpret PE_Variable'= strip(subword(PE_Ln, 3))'
      end
    call closev('Event.EC')
    if PE_Variable == 'Error' then do
      call AddMsg('W', 'Line "'PE_Ln'" does not start with a keyword; this event set was skipped.')
      iterate EC
    end

    EnteredFont = strip(EnteredFont, 'B', '"'||"'")
    TextColor   = strip(TextColor, 'B', '"'||"'")
    BoxColor    = strip(BoxColor, 'B', '"'||"'")
    Options     = compress(upper(strip(Options, 'B', ' "'||"'")))

    if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)

    FontInfo = compress(EnteredFont''EnteredSize, '. /:')
    if FontKnown.FontInfo == '' then do
      HighestFont = HighestFont + 1
      FontKnown.FontInfo = HighestFont
      Font.HighestFont = EnteredFont
      FSize.HighestFont = EnteredSize
      Height.HighestFont = GetHeight(HighestFont) * Leading/100
    end
    CurrentFont = FontKnown.FontInfo

    If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
    If EnteredLine == '' then EnteredLine = 1
    if BoxColor    == '' then BoxColor = Background.AddEvent
    if TextColor   == '' then TextColor = Color.AddEvent

    if EventType = Event$ then do
      EnteredDay1 = ConvertDay(EnteredDay1)
      EnteredDay2 = ConvertDay(EnteredDay2)
    end
    else do
      EnteredDay1 = RootDay + EnteredDay1
      EnteredDay2 = RootDay + EnteredDay2
    end
    If EnteredDay1 > EnteredDay2 then Do
      TempDate = EnteredDay1
      EnteredDay1 = EnteredDay2
      EnteredDay2 = TempDate
    End

    if pos('B', Options) ~= 0 then Box = 1
    if pos('W', Options) ~= 0 then Weekly = 1
    if pos('2', Options) ~= 0 then Weekly = 2

    /* Process Event */
    if App == 'PGS' then REFRESH OFF ALL
    do until Weekly = 0
      Event = EnteredEvent
      Line  = EnteredLine
      Day1  = EnteredDay1
      Day2  = EnteredDay2
      Text. = ''

      if Day1 > MaxDate then do
        Weekly = 0
        iterate
      end
      if Day2 > MaxDate then Day2 = MaxDate

      If Day1 ~= Day2 then Box = 1
      LineCount = 0
      Do until Day1 > Day2
        Day1Row = trunc((Day1 + StartDate - 1) / 7)
        Day2Row = trunc((Day2 + StartDate - 1) / 7)
        Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
        Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
        if (Day1Row == 5) & (DoTopExtraWk == 1) then Day1Row = 0
        if (Day2Row == 5) & (DoTopExtraWk == 1) then Day2Row = 0

        if Day1Row == Day2Row then DaySpan = Day2Column - Day1Column + 1
        else DaySpan = 7 - Day1Column
        if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
        else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
        else CalDate = Day1
        Select
          when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
          when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
          otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
        end
        HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
        If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
        else do
          if DoTopExtraWk ~= 1 then BoxTop = CalTop + 4.5 * BoxHeight
          else BoxTop = CalTop
        end

        LeftEdge = Margin.Left + Day1Column * BoxWidth + DateOffset + HighlightOffset
        if event ~= '' then do
          Textline = 0
          Text.    = ''
          Text.Textline = event

          /* Accomodate user line breaks */
          do until LineBreak = 0
            LineBreak = pos('//', Text.Textline)
            if LineBreak > 0 then do
              Nextline = Textline + 1
              Text.Nextline = substr(Text.Textline, LineBreak + 2)
              Text.Textline = left(Text.Textline, LineBreak - 1)
              Textline = Nextline
            end
          end
          Textline = 0

          /* Fit line(s) into allowable space */
          do until Text.Nextline == ''
            Nextline = Textline + 1
            if Box == 1 | Textline == 0 then Indent.Textline = 0
            else Indent.Textline = 3 * DateOffset
            AllowedWidth = DaySpan * BoxWidth - 2 * DateOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
            AllowedBoxWidth = AllowedWidth + 2 * DateOffset
            if left(Text.Textline, length(TabSub)) == TabSub then do
              Indent.Textline = TabFactor * DateOffset
              Text.Textline = substr(Text.Textline, length(TabSub) + 1)
            end

            if App == 'FW' & length(Text.Textline) > 37 then do
              Wordbreak = lastpos(' ', Text.Textline, 37)
              Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
              Text.Textline = strip(left(Text.Textline, Wordbreak))
            end
            ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
            if App == 'FW' then redraw
            TextWidth.Textline = GetWidth(ID)
            if App == 'FW' then DELETEOBJECT ID
            else if App == 'PGS' then do
              SELECTOBJECT OBJECTID ID WINDOW winName
              DELETEOBJECT OBJECTID ID WINDOW winName
            end

            NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
            TextWidth.Textline = TextWidth.Textline * NeededCompression.Textline
            if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
              /* Move last word to next line */
              Wordbreak     = lastpos(' ', Text.Textline)
              Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
              Text.Textline = strip(left(Text.Textline, Wordbreak))
            end
            else if Text.Nextline ~= '' then Textline = Textline + 1
          End
          LineCount = Textline
        end

        if Box then call DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
        if event ~= '' then
          do i = 0 to LineCount
            Text.Top = BoxTop + (Line + i) * Height.Highlight
            if Box == 0 then Text.Left = LeftEdge + Indent.i
            else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i) / 2
            TextWidth = NeededCompression.i * Width.CurrentFont
            if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)
            call PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
          end

        Day1 = Day1 + DaySpan
        if Day1 > Day2 then leave
        else if trunc((Day1 + StartDate - 1) / 7) > 4 & Day2 > MonthLength.Month then Day2 = Day1
      end

      if Weekly == 1 then do
        EnteredDay1 = EnteredDay1 + 7
        EnteredDay2 = EnteredDay2 + 7
      end
      else if Weekly == 2 then do
        EnteredDay1 = EnteredDay1 + 14
        EnteredDay2 = EnteredDay2 + 14
      end
    end

    if App == 'FW' then redraw
    else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  end

  if Req ~= 0 then call bguiwinclose(Req)

  if App == 'PGS' then do
    REFRESH ON ALL
    REFRESHWINDOW WINDOW winName
    WindowRefreshed = 1
  end

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

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

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

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

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

  if Req ~= 0 then do
    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
  end

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

/***//*******  SetVariables Subroutine  ***********/
SetVariables:

/***//* Initialize Variables */
  AddEventRows    = 9
  ChangesFile     = 'FWC.dat'
  DataFile        = ''
  Date            = 0
  DoShanghai      = 1
  esc             = "1B"x
  EventFile       = ''
  EventKey        = 'E'
  FontKnown.      = ''
  FSize.          = 10
  HighestFont     = 5
  Highlight       = 5
  Leading         = 100
  MinWidth        = 80
  PatVar          = '#?.data'
  PrefsFile       = ''
  Req             = 0
  StartWeek       = 0
  Storage         = 'RAM:FWC/'
  TabFactor       = 3
  TabSub          = '/~'
  Width.          = 100

  if App == 'FW' then DefaultFont = "SoftSans"
  else if App == 'PGS' then DefaultFont = 'PageStream-Normal'

  TextAdj         = 0.77
  WTextArea       = 0.20  /* fraction of print height used for top of calendar (Wide) */
  TTextArea       = 0.15  /* fraction of print height used for top of calendar (Tall) */
  DateOffset      = 0.02  /* fraction of box width to offset dates from edge of box   */

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

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

  call TranslationStrings

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

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

  ProcessNow = 'DoShanghai Storage PrefsFile'

  if exists(ScriptDir''ChangesFile) then do
    call open('DataFile', ScriptDir''ChangesFile)
      do until eof('DataFile')
        Ln = ReadLn('DataFile')
        if pos(upper(word(Ln, 1)), upper(ProcessNow)) ~= 0 then interpret Ln
        else if right(word(Ln, 1), 1) == '$' then interpret Ln
        else if pos('End Pass One', Ln) > 0 then leave
      end
    call close('DataFile')
  end

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

  call makedir(left(Storage, length(Storage) - 1))
  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
  TextColorList.Count = ColorList.COUNT - 1
  do i = 0 to TextColorList.Count - 1
    TextColorList.i = ColorList.i
  end

  Color.          = Black$
  Line.           = Black$
  Background.     = White$

  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


  /**** Read user variables ****/
  if App == 'FW' then do
    FIRSTOBJECT; TempDateID = result
    do forever
      if TempDateID == 0 then do
        call AddMsg('E', 'Unable to find FWC date string.')
        call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
        call Cleanup
      end
      GETOBJECTTYPE TempDateID; ObjectType = result
      if ObjectType == 7 then do
        GETTEXTBLOCKTEXT TempDateID; TempDate = result
        if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
      end
      NEXTOBJECT TempDateID; TempDateID = result
    end
    do while right(TempDate, 1) == '|'
      StartObj = pos('|', TempDate)
      NextObj = strip(substr(TempDate, StartObj), 'B', '|')
      GETTEXTBLOCKTEXT NextObj; TempDate = left(TempDate, StartObj - 1)''result
    end
    PrefsFile = substr(TempDate, 12)
    TempDate = substr(TempDate, 4, 8)
  end
  else if App = 'PGS' then do
    CURRENTWINDOW; winName = '"'RESULT'"'
    SELECTTEXT at 0 0 WINDOW winName
    SELECTTEXT ALL WINDOW winName
    EXPORTTEXT AMIGA FILE Storage"TempDate.txt" FILTER "ASCII" STATUS FORCE
    if exists(Storage"TempDate.txt") then do
      open(TDFile, Storage"TempDate.txt")
        TempDate = ReadLn(TDFile)
      close(TDFile)
    end
    if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
      call AddMsg('E', 'Unable to find FWC date string.')
      call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
      call Cleanup
    end
    else do
      PrefsFile = substr(TempDate, 12)
      TempDate = substr(TempDate, 4, 8)
    end
  end
  if PrefsFile == '' then do
    if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
    else PrefsFile = 'Default'
  end

  call open('Temp', FullCallPath)
    FileOffset = 40000
    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
      interpret CD_VarLine
    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_VarLine = strip(ReadvLn('UserFile'))
          CD_VarName = upper(strip(word(CD_VarLine, 1)))
          if left(CD_VarLine, 15) == '/* End Pass One' then leave
          if (left(CD_VarLine, 2) == '/*') |,
             (CD_VarName == 'DOSHANGHAI') |,
             (CD_VarLine == '') |,
             (upper(left(CD_VarLine, 11)) == 'IMAGECLASS.') then iterate
          else interpret CD_VarLine
        end
      call closev('UserFile')
    end
  end
  drop Orientation

  if RexxTricks == 1 then do
    if DoShanghai ~= 0 then PubScreen = AppScreen
    else PubScreen = DefPubScreen
  end

  Type.0    = Event$
  Type.1    = File$
  FSize.4pt = 4

  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

  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$

  do i = 1 to 12
    AbbrMonth.i  = left(Month.i, 3)
  end

  if App == 'FW' then do
    TextBase = TextAdj
    do i = 0 to 5 by 5
      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
    GETPAGESETUP ORIENT; FWC_Orientation = result
    if FWC_Orientation == 'Wide' then TextArea = WTextArea
    else TextArea = TTextArea

    GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
    DISPLAYPREFS Measure Inches
    GETSECTIONSETUP Top Bottom Inside Outside
    parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right

    GETPAGESETUP Width Height
    parse var result FullWidth FullHeight

    TextBlockPrefs TEXTFLOW None
  end
  else if App = 'PGS' then do
    TextBase = 1
    GETFONTLIST FontNames
    FontNames.COUNT = result
    do i = 0 to 5 by 5
      do j = 0 to FontNames.COUNT - 1
        if upper(Font.i) == upper(FontNames.j) then leave
      end
      if j == FontNames.COUNT then do
        call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
        Font.i = DefaultFont
      end
    end
    GETMASTERPAGES MPage; PageName = MPage.0
    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
    Margin.Left   = temp.inside
    Margin.Right  = temp.outside
    Margin.Top    = temp.top
    Margin.Bottom = temp.bottom

    GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
    if layout.orientation == 'LANDSCAPE' then do
      TextArea   = WTextArea
      FullWidth  = layout.height
      FullHeight = layout.width
    end
    else do
      TextArea   = TTextArea
      FullWidth  = layout.width
      FullHeight = layout.height
    end
  end

  PrintWidth       = FullWidth - Margin.Left - Margin.Right
  PrintHeight      = FullHeight - Margin.Top - Margin.Bottom

  if App == 'FW' then do
    GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  end
  else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
      PrintHeight = PrintHeight - Height.4pt

  BoxWidth         = PrintWidth/7
  CalRight         = Margin.Left + BoxWidth * 7
  TextArea         = TextArea * PrintHeight
  CalTop           = TextArea + Margin.Top
  BoxHeight        = (PrintHeight - TextArea)/5
  DateOffset       = DateOffset * BoxWidth
  FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  Width.Date       = Width.Date * StretchDateW / StretchDateH
  FSize.Highlight  = BoxHeight/AddEventRows * 72
  if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  Height.Highlight = GetHeight(Highlight) * Leading/100
  Height.Date      = GetHeight(Date) * Leading/100

  FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  FontKnown.FontInfo = Highlight

  RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  Width.WidthOfDate1 = GetFontWidth(Date, '1')
  Width.WidthOfDate8 = GetFontWidth(Date, '8')
  VariablesSet = 1
return
/**/

/***//*******  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.FYMiniCal        = DefaultBold
  Bold.MiniCal          = DefaultBold
  CenterMiniDates       = 1
  Clear$                = 'Clear'
  Color.AddEvent        = Black$
  Color.Date            = Black$
  Color.Extended        = Black$
  Color.Friday          = Black$
  Color.Header          = Black$
  Color.Highlight       = Black$
  Color.HighlightH      = Black$
  Color.Julian          = Black$
  Color.MiniCal         = Black$
  Color.Monday          = Black$
  Color.Moon            = Black$
  Color.Saturday        = Black$
  Color.Sunday          = Black$
  Color.Sunrise         = Black$
  Color.Sunset          = Black$
  Color.Thursday        = Black$
  Color.Tuesday         = Black$
  Color.Wednesday       = Black$
  Color.Weekday         = Black$
  Color.WeekNumber      = Black$
  DateOffset            = 0.02
  DoBackgrounds         = 0
  DoDailyColors         = 0
  DoDateBox             = 0
  DoEaster              = 1
  DoExtended            = 1
  DoHighlights          = 0
  DoImages              = 0
  DoJulian              = 0
  DoJulianLeft          = 0
  DoMatchColors         = 0
  DoMiniCals            = 1
  DoPhases              = 0
  DoSunRise             = 0
  DoSunSet              = 0
  DoTopExtraWk          = 0
  DoWeekNumber          = 0
  FinalView             = 75
  Font.Date             = DefaultFont
  Font.Extras           = DefaultFont
  Font.FYMiniCal        = DefaultFont
  Font.Header           = DefaultFont
  Font.Highlight        = DefaultFont
  Font.MiniCal          = DefaultFont
  Font.Weekday          = DefaultFont
  GfxAppPath            = ''
  HeaderLoc             = 2
  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
  MaxImgHeight          = .75
  MaxImgWidth           = .75
  MiniCalHeight         = 0.60
  MiniCalSpacing        = 0.05
  MiniCalWidth          = 2
  MinWidth              = 80
  MoonRadius            = .075
  Orientation           = 'Wide'
  ShiftLMini            = 0
  ShiftRMini            = 0
  StartWeek             = 0
  StretchDateH          = 1
  StretchDateW          = 1
  SunCalcPath           = ''
  Text.Julian           = ''
  Text.Sunrise          = ''
  Text.Sunset           = ''
  Text.WeekNumber       = ''
  Width.Date            = 100
return
/**/