/*
    AddEvent.rexx Macro
    Adds events to calendars created by FWCalendar.rexx
    $VER: FWCAddEvent.rexx v3.87 (16 Aug 2000)
    ©Ron Goertz (goertz@earthlink.net)
*/
 
OPTIONS RESULTS
signal on syntax
Numeric Digits 14

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

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

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

address value DetermineHost()
call SetVariables

Month = substr(TempDate,5,2) - 0
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
if ClassAct == 1 then call GetEvent_CA
else call GetEvent_BGUI
exit

/*********************************************/
/*              Subroutines                  */
/*********************************************/
/***//*** AddLibraries (AL) ***/
AddLibraries:
  PortList     = show('P')
  ErrorCount   = 0
  WarningCount = 0
  Req          = 0
  bguiopen     = 0
  AL_LibCount  = 0
  Storage      = 'RAM:FWC/'

  call TranslationStrings
  interpret ReadFile(ScriptDir'FWCTranslations.txt')

  i = 0; AL_RexxSupport = i; AL_Lib.i = 'rexxsupport.library'; AL_MinVersion.i = 34.9;  AL_Offset.i = -30;  AL_Variable.i = 'RexxSupport'; AL_Status.i = "E"
  i = 1; AL_RexxTricks = i;  AL_Lib.i = 'rexxtricks.library';  AL_MinVersion.i = 0;     AL_Offset.i = -30;  AL_Variable.i = 'RexxTricks';  AL_Status.i = "W"
  i = 2; AL_DateLib = i;     AL_Lib.i = 'date.library';        AL_MinVersion.i = 33.31; AL_Offset.i = -492; AL_Variable.i = 'DateLib';     AL_Status.i = "W"
  i = 3; AL_RexxMathLib = i; AL_Lib.i = 'rexxmathlib.library'; AL_MinVersion.i = 38.1;  AL_Offset.i = -30;  AL_Variable.i = 'RexxMathLib'; AL_Status.i = "W"
  i = 4; AL_RexxBGUILib = i; AL_Lib.i = 'rexxbgui.library';    AL_MinVersion.i = 4;     AL_Offset.i = -30;  AL_Variable.i = 'RexxBGUILib'; AL_Status.i = "W"
  i = 5; AL_BGUILib = i;     AL_Lib.i = 'bgui.library';        AL_MinVersion.i = 41.1;  AL_Offset.i = -30;  AL_Variable.i = 'BGUILib';     AL_Status.i = "W"
  AL_Lib.Count = 6

  do i = 0 to AL_Lib.Count - 1
    if exists('LIBS:'AL_lib.i) then do
      AL_InstalledVersion = libver(AL_lib.i)
      AL_LibCount = AL_LibCount + 1
      Library.Name.AL_LibCount = AL_Lib.i
      Library.Version.AL_LibCount = AL_InstalledVersion
if (i == AL_RexxMathLib) & (AL_InstalledVersion == '38.02') then AL_InstalledVersion = 38.2
      if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
        call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
        interpret Al_Variable.i' = 0'
      end
      else do
        if i ~= AL_BGUILib then call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
        interpret Al_Variable.i' = 1'
        if i == AL_RexxSupport then do
          if (pos('AWNPIPE', showlist('H',,'|')) > 0) & (exists('LIBS:gadgets/layout.gadget')) then ClassAct = 1
          else do
            ClassAct = 0
            AL_Status.AL_RexxBGUILib = 'E'
            AL_Status.AL_BGUILib = 'E'
          end
        end
      end
    end
    else do
      interpret Al_Variable.i' = 0'
      if AL_Status.i == 'E' then call AddMsg('E', AL_lib' is required but could not be found.')
    end
  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
    ErrorCount = ErrorCount + 1
    Error.ErrorCount = AM_Msg
  end
  else do
    WarningCount = WarningCount + 1
    Warning.WarningCount = AM_Msg
  end

  return
/**/

/***//*** AssignID (AID) ***/
AssignID:
  parse arg AID_Var, AID_ID

  interpret AID_Var' = 'AID_ID
  GE_Gad.AID_ID = AID_Var

  return
/**/

/***//*** BusyReq (BR) ***/
/*** OpenBusy ***/
OpenBusy:
  parse arg BR_BusyTitle, BR_EventCount
  BR_Progress = 0
  if ClassAct == 1 then do
    call open('ProgReq', "awnpipe:ProgressReq/xc")
    call ToPIPE('ProgReq', 'm v db dg cs si so a ps="'PubScreen'"')
    call ToPIPE('ProgReq', 'label gt="'BR_BusyTitle', 'PleaseWait$'..."')
    BR_ProgressGad = ToPIPE('ProgReq', 'fuelgauge defn=0 maxn='BR_EventCount' t=0 per')
    call ToPIPE('ProgReq', 'layout b=0 si so cj')
      call ToPIPE('ProgReq', 'space')
      BR_CancelGad = ToPIPE('ProgReq', 'button pb gt="'Cancel$'"')
      call ToPIPE('ProgReq', 'space')
    call ToPIPE('ProgReq', 'le')
    if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
    if ToPIPE('ProgReq', 'open') == 'window' then BR_ProgressWindow = 1
    if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
    else BR_ProgressWindow = 0
  end
  else do
    BR_ProgressGroup=bguivgroup(,
          bguiinfo('BR_dummy',,'1B'x||'c'BR_BusyTitle', 'PleaseWait$'...')bguilayout(LGO_FixMinHeight,1)||,
          bguiprogress('BR_prog2_',,0,BR_EventCount)||,
          bguihgroup(,
                  bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
                  bguibutton('BR_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
                  bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
          ,,,,'W'),
    ,-2,-2)
    if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
    BR_ProgressWindow = bguiwindow('',BR_ProgressGroup,,2,,PubScreen)
    if bguiwinopen(BR_ProgressWindow) = 0 then call Cleanup
    if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
  end

  return BR_ProgressWindow

/*** UpdateBusy ***/
UpdateBusy:
  parse arg BR_ReqWin, BR_ProgressMade

  if BR_ReqWin == 0 then return 0
  BR_Progress = BR_Progress + BR_ProgressMade
/* say '>'BR_Progress SIGL */
  if ClassAct == 1 then do
    if show('F', 'ProgReq') == 1 then do
      call writeln('ProgReq', 'id 'BR_CancelGad' read')
      BR_CancelStatus = readln('ProgReq')
      if BR_CancelStatus == 1 then do
        call close('ProgReq')
        return -1
      end
    end
    else return 0
    if show('F', 'ProgReq') == 1 then do
      call ToPIPE('ProgReq', 'id 0 s=2')
      call writeln('ProgReq', 'id 'BR_ProgressGad' defn='BR_Progress' ref')
      call readln('ProgReq')
    end
    else return 0
  end
  else do
    call bguiset(obj.BR_prog2_,BR_ReqWin,PROGRESS_Done,BR_Progress)
    if bguiwinevent(BR_ReqWin,'ID') == id.BR_cancel_ then return -1
  end

  return BR_Progress

/*** CloseBusy ***/
CloseBusy:
  parse arg BR_ReqWin

  if BR_ReqWin == 0 then return 0

  if ClassAct == 1 then call close('ProgReq')
  else call bguiwinclose(BR_ReqWin)
  Req = 0

  return 0
/**/

/***//*** CAGetFile (GF) ***/
CAGetFile:
  parse arg GF_FileHandle, GF_GadID, GF_Title, GF_InitDir

  if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
  call writeln(GF_FileHandle,'id 'GF_GadID' gt="'GF_Title':" fn="'GF_InitDir'" s=1')
  if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
  GF_GetFileResult = readln(GF_FileHandle)
  parse var GF_GetFileResult GF_OK GF_Choice GF_File
  if GF_Choice ~= 0 then GF_File = strip(GF_File, 'B', '" ')
  else GF_File = ''

  return GF_File
/**/

/***//*** CASimpleReq (CAS) ***/
CASimpleReq:
  parse arg CAS_Title, CAS_Msg

  CAS_Msg = translate(CAS_Msg, "'", '"')
  do while pos('0a'x, CAS_Msg) > 0
    CAS_Msg = left(CAS_Msg, pos('0a'x, CAS_Msg) - 1)'*n'substr(CAS_Msg, pos('0a'x, CAS_Msg) + 1)
  end

  call open('Req', "awnpipe:SimpleReq/xc")
  call ToPIPE('Req', '"'CAS_Title'" v db dg si so a ps="'PubScreen'"')
  call ToPIPE('Req', 'label gt="'CAS_Msg'"')
  call ToPIPE('Req', 'layout b=0 si so cj')
    call ToPIPE('Req', 'space')
    call ToPIPE('Req', 'button c gt="'OK$'"')
    call ToPIPE('Req', 'space')
  call ToPIPE('Req', 'le')
  if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
  call ToPIPE('Req', 'open')
  if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)

  do while ~eof('Req')
    call readln('Req')
  end
  call close('Req')

  return
/**/

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

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

  if VariablesSet == 1 then do
    interpret UserPrefs
    call CloseBusy(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 (PrefsFile ~= '') & (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 ~= '') & (symbol('EventFile') == 'VAR') then do
      call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
      call open('DataFile', EventFile)
        do while ~eof('DataFile')
          if ~eof('DataFile') then 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') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, FileMsg)
    if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
    if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
    if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
    if (OutType == 'File') & (bguiopen == 0) & (ClassAct == 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') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, Conbgui)
    if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
    if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
    if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
    if (OutType == 'CON') & (bguiopen == 0) & (ClassAct == 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 (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(DefPubScreen)
  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
/**/

/***//*** DetermineHost () Subroutine ***/
DetermineHost:
  owner = ReadFile('ENV: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
    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 AddMsg('E', 'Make sure FWCAddEvent is called from Final Writer or PageStream')
    call Cleanup
  end

  PgmVersion = getclip('FWC'App'VersionInfo.txt')
  if PgmVersion == '' then do
    address command 'list >PIPE:FWC 'AppName'#? lformat %N'
    ListOutput = ReadFile('PIPE:FWC')
    call openv('ListOutput')
      do while ~eofv('ListOutput')
        PgmName = readvln('ListOutput')
        if pos('.', PgmName) == 0 then leave
      end
    call closev('ListOutput')
    address command 'version >PIPE:FWC 'PgmName
    PgmVersion = ReadFile('PIPE:FWC')

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

  AppScreen = ''
  DefPubScreen = ''
  if RexxTricks == 1 then do
    DefPubScreen = GetDefaultPubScreen()
    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
/**/

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

/***//*** dTox (PROCEDURE) Subroutine ***/
dTox:PROCEDURE
parse arg DecVal

BinVal = ''
HexVal = ''
do i = 32 to 0 by -1
  if DecVal >= 2**i then do
    BinVal = BinVal'1'
    DecVal = DecVal - 2**i
  end
  else BinVal = BinVal'0'
end

do until BinVal == ''
  HexVal = c2x(b2c(right(BinVal, 8, '0')))''HexVal
  if length(BinVal) >= 8 then CutLength = 8
  else CutLength = length(BinVal)
  BinVal = left(BinVal, length(BinVal) - CutLength)
end

return HexVal
/**/

/***//*** GetEvent_BGUI (GE) Subroutine ***/
GetEvent_BGUI:
  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)
  if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
  GE_winID=bguiwindow(EnterEventInfo$':',g,5,0,,PubScreen)
  if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
  call UpdateBusy(Req, 1)

  if App == 'PGS' then do
    FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
    call UpdateBusy(Req, 1)
    if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
    FontwinID=bguiwindow(SelectFont$':',FontGroup,20,50,,PubScreen)
    if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
  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)

  call CloseBusy(Req)

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

/***//*** GetEvent_CA (GE) Subroutine ***/
GetEvent_CA:
  /***//*** Initialize Variables ***/
  Req = OpenBusy(PrepReq$, 4 + (ColorList.Count - 1))

  GE_BoxValue     = ''
  GE_EnteredLine  = 1
  GE_EventType    = Event$
  GE_EventValue   = ''
  GE_StartOrEnd   = 1
  GE_StartDate    = ""
  GE_EndDate      = ""
  GE_WeeklyValue  = ''
  GE_Day          = 0
  GE_PrevDay      = MonthLength.PrevMonth - StartDate
  GE_NextDay      = 0
  LineList        = ''
  ColorList       = ''
  FontReq         = 0
  ColorReq        = 0
  NCColorReq      = 0
  interpret 'GE_TextColor = ColorList.'max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0))
  interpret 'GE_BoxColor = ColorList.'max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0))

  GadID.          = ''
  GadArg.         = ''
  GE_Boxed.0      = ""
  GE_Boxed.1      = "B"
  GE_Type.0       = Event$
  GE_Type.1       = File$
  GE_Weekly.0     = ""
  GE_Weekly.1     = "W"
  GE_Weekly.2     = "2"

  do GE_i = 0 to 15
    LineList = LineList''GE_i'|'
  end
  LineList.Count = min(RowsThatFit, 16)

  do GE_i = 0 to ColorList.Count - 1
    ColorList = ColorList''ColorList.GE_i'|'
  end
  ColorList = '"'strip(ColorList, 'B', '|')'"'

  EventList = '"'Event$'|'File$'"'
  FrequencyList = '"'Once$'|'Weekly$'|'Biweekly$'"'

  if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/

  /***//*** GUI Description ***/
  call open('GE',"awnpipe:AddEvent/xc")
  call ToPIPE('GE', '"'EnterEventInfo$'" m cg dg v db a so si cs ps="'PubScreen'"')

  call ToPIPE('GE', 'layout v so si b=0')
    call ToPIPE('GE', 'layout b=0')
      GE_EventTypeGad = ToPIPE('GE', 'chooser weiw=0 pu cl='EventList)
      GE_EventGad = ToPIPE('GE', 'string tc lj')
    call ToPIPE('GE', 'le')

    call ToPIPE('GE', 'layout b=0')
      call ToPIPE('GE', 'label gt="'Font$':" ua')
      GE_FontNameGad = ToPIPE('GE', 'string lj tc chl weiw=80 gt="'FontName'"')
      GE_FontSizeGad = ToPIPE('GE', 'string lj tc weiw=5 gt="'FontSize'"')
      GE_ChooseFontGad = ToPIPE('GE', 'button ab=2 weiw=0 weih=0')
      GE_ResetGad = ToPIPE('GE', 'button weih=0 weiw=0 gt="'Reset$'"')
    call ToPIPE('GE', 'le')
  call ToPIPE('GE', 'le')

  call ToPIPE('GE', 'layout weiw=0 b=0')
    call ToPIPE('GE', 'layout weiw=0 so v')
      call ToPIPE('GE', 'layout so b=0')
        call ToPIPE('GE', 'space')
        GE_MonthGad = ToPIPE('GE', 'button ro b=0 gt="'Month.Month'"')
        call ToPIPE('GE', 'space')
      call ToPIPE('GE', 'le')

      call ToPIPE('GE', 'layout e b=0')
        call ToPIPE('GE', 'button ro b=0 gt="'left(Day.0, 1)'"')
        call ToPIPE('GE', 'button ro b=0 gt="'left(Day.1, 1)'"')
        call ToPIPE('GE', 'button ro b=0 gt="'left(Day.2, 1)'"')
        call ToPIPE('GE', 'button ro b=0 gt="'left(Day.3, 1)'"')
        call ToPIPE('GE', 'button ro b=0 gt="'left(Day.4, 1)'"')
        call ToPIPE('GE', 'button ro b=0 gt="'left(Day.5, 1)'"')
        call ToPIPE('GE', 'button ro b=0 gt="'left(Day.6, 1)'"')
      call ToPIPE('GE', 'le')

      if UpdateBusy(Req, 1) == -1 then call Cleanup

      do GE_Week = 0 to 5
        call ToPIPE('GE', 'layout e b=0')
        do GE_WeekDay = 0 to 6
          GE_Posn = (GE_Week * 7) + GE_WeekDay
          if (GE_Posn >= StartDate) & (GE_Posn < StartDate + MonthLength.Month) then do
            GE_Day = GE_Day + 1
            call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_Day'"'))
            interpret "GadArg."GadID.GE_Posn" = 'C'left(Month.Month, 3)' 'GE_Day"
          end
          else do
            if GE_Posn < StartDate then do
              GE_PrevDay = GE_PrevDay + 1
              call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_PrevDay'"'))
              interpret "GadArg."GadID.GE_Posn" = 'P'left(Month.PrevMonth, 3)' 'GE_PrevDay"
            end
            else do
              GE_NextDay = GE_NextDay + 1
              call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_NextDay'"'))
              interpret "GadArg."GadID.GE_Posn" = 'N'left(Month.NextMonth, 3)' 'GE_NextDay"
            end
          end
        end
        call ToPIPE('GE', 'le')
        if GE_Posn >= StartDate + MonthLength.Month - 1 then leave
      end
    call ToPIPE('GE', 'le')

    if UpdateBusy(Req, 1) == -1 then call Cleanup
    call ToPIPE('GE', 'layout weiw=0 si so v')
      call ToPIPE('GE', 'layout weiw=0 si so b=0 v')
        call ToPIPE('GE', 'label weiw=0 ua gt="'Start$':"')
        GE_StartGad = ToPIPE('GE', 'button lj chl ro b=0')
        call ToPIPE('GE', 'label weiw=0 ua gt="'End$':"')
        GE_EndGad = ToPIPE('GE', 'button lj chl ro b=0')
        call ToPIPE('GE', 'label weiw=0 gt="'TextColor$':" ua')
        GE_TextColorGad = ToPIPE('GE', 'Button chl gt="'Color.AddEvent'"')
        call ToPIPE('GE', 'label weiw=0 gt="'Line$':" ua')
        GE_LineGad = ToPIPE('GE', 'chooser chl pu weiw=0 s=1 maxn='LineList.Count' cl='LineList)
        call ToPIPE('GE', 'label weiw=0 gt="'Boxed$':" ua')
        GE_BoxedGad = ToPIPE('GE', 'checkbox weiw=0 chl')
        call ToPIPE('GE', 'label weiw=0 gt="'BoxColor$':" ua')
        GE_BoxColorGad = ToPIPE('GE', 'Button chl gt="'Background.AddEvent'"')
        call ToPIPE('GE', 'label weiw=0 gt="'Frequency$':" ua')
        GE_FrequencyGad = ToPIPE('GE', 'chooser chl pu weiw=0 maxn=3 cl='FrequencyList)
      call ToPIPE('GE', 'le')
      call ToPIPE('GE', 'layout v si e cj b=0')
        call ToPIPE('GE', 'layout si e weiw=0 b=0')
          GE_OKGad = ToPIPE('GE', 'button weiw=0 weih=0 gt="'OK$'"')
          GE_CancelGad = ToPIPE('GE', 'button weiw=0 weih=0 c gt="'Cancel$'"')
        call ToPIPE('GE', 'le')
      call ToPIPE('GE', 'le')
    call ToPIPE('GE', 'le')
  call ToPIPE('GE', 'le')

  GetFileAllGad = ToPIPE('GE', 'getfile ua pat="#?"')
  GetFileDataGad = ToPIPE('GE', 'getfile ua pat="'PatVar'"')

  if App == 'PGS' then do
    call open('FontReq', "awnpipe:FontReq/xc")
    call ToPIPE('FontReq', '"'SelectFont$'" m db dg v a ps="'PubScreen'"')
    call ToPIPE('FontReq', 'listbrowser minw=200 minh=300')
    do GE_FontNumber = 0 to FontList.COUNT - 1
      GadID = ToPIPE('FontReq', 'browsernode gt="'FontList.GE_FontNumber'"')
      interpret 'FontGad.'GadID' = 'GE_FontNumber
    end
  end

  call open('ColorReq','awnpipe:ColorReq/xc')
  call ToPIPE('ColorReq','"Select color:" m db dg v a ps="'PubScreen'"')
  call ToPIPE('ColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample"')

  call open('NCColorReq','awnpipe:NCColorReq/xc')
  call ToPIPE('NCColorReq','"Select color:" m db dg v a ps="'PubScreen'"')
  call ToPIPE('NCColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample"')

  if App == 'FW' then do
    do GE_ColorNumber = 0 to ColorList.Count - 2
      if UpdateBusy(Req, 1) == -1 then call Cleanup
      RPen = dTox(x2d(left(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
      GPen = dTox(x2d(substr(ColorRegister.GE_ColorNumber, 3, 2)) / 255 * 4294967295)
      BPen = dTox(x2d(right(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)

      call ToPIPE('ColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
      GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶"')
      interpret 'ColorGad.'GadID' = 'GE_ColorNumber

      call ToPIPE('NCColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
      GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶"')
      interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
    end
    GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|¶"')
    interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  end
  else if App == 'PGS' then do
    do GE_ColorNumber = 0 to ColorList.Count - 2
      if UpdateBusy(Req, 1) == -1 then call Cleanup
      GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|"')
      interpret 'ColorGad.'GadID' = 'GE_ColorNumber
      GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|"')
      interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
    end
    GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|"')
    interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  end

/**/

  /***//*** GUI Action Loop ***/
  if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
  call ToPIPE('GE', 'open')
  if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
  call UpdateBusy(Req, 1)

  call CloseBusy('ProgReq')

  do until eof('GE')
    call ToPIPE('GE', 'continue')
    GE_EventInfo = readln('GE')
    parse var GE_EventInfo GE_Event' 'GE_GadID' 'GE_GadInfo1
    select
    /***//*** close ***/
      when GE_Event == 'close' then call Cleanup
    /**/

    /***//*** GE_EventTypeGad ***/
      when GE_GadID == GE_EventTypeGad then do
        GE_EventType = GE_Type.GE_GadInfo1
        if GE_EventType == Event$ then do
          GE_StartOrEnd = 1
          call ToPIPE('GE', 'id 'GE_EventGad' gt="" ref')
          call ToPIPE('GE', 'id 'GE_FontNameGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_ResetGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_TextColorGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_LineGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_BoxedGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=0 ref')
          call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=0 ref')
        end
        else do
          GE_DataFile = CAGetFile('GE', GetFileDataGad, SelectFile$, ScriptDir'FWCAddEvent.data')
          if GE_DataFile ~= '' then do
            if ~exists(GE_DataFile) then do
              call ToPIPE('GE', 'id 0 s=256')
              call CASimpleReq('FWCAddEvent 'Notice$, GE_DataFile' 'CantFind$'...')
              call ToPIPE('GE', 'id 0 s=512')
              GE_DataFile = ''
            end
            else do
              GE_EndDate = ''
              GE_EventValue = GE_DataFile
              call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
              call ToPIPE('GE', 'id 'GE_EventGad' gt="'GE_DataFile'" ref')
              call ToPIPE('GE', 'id 'GE_FontNameGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_ResetGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_TextColorGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_LineGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_BoxedGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=1 ref')
              call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=1 ref')
            end
          end
          if GE_DataFile == '' then do
            GE_StartOrEnd = 1
            GE_EventType = Event$
            call ToPIPE('GE', 'id 'GE_EventTypeGad' s=0 ref')
            call ToPIPE('GE', 'id 'GE_EventGad' gt="" ref')
            call ToPIPE('GE', 'id 'GE_FontNameGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_ResetGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_TextColorGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_LineGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_BoxedGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=0 ref')
            call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=0 ref')
          end
        end
      end
    /**/

    /***//*** GE_EventGad ***/
      when GE_GadID == GE_EventGad then GE_EventValue = GE_GadInfo1
    /**/

    /***//*** GE_FontNameGad ***/
      when GE_GadID == GE_FontNameGad then do
        call ToPIPE('GE', 'id 0 s=256')
        call CASimpleReq('FWCalendar 'Notice$, MustUse$)
        call ToPIPE('GE', 'id 0 s=512')
        call ToPIPE('GE', 'id 'FontNameGad' gt="'FontName'" ref')
      end
    /**/

    /***//*** GE_FontSizeGad ***/
      when GE_GadID == GE_FontSizeGad then FontSize = GE_GadInfo1
    /**/

    /***//*** GE_ChooseFontGad ***/
      when GE_GadID == GE_ChooseFontGad then do
        if App == 'FW' then do
          GE_File = CAGetFile('GE', GetFileAllGad, SelectFont$, CurrentDir'FWFonts/SWOLFonts/')
          if GE_File ~= '' then do
            FontName = GE_File
            call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
          end
        end
        else if App == 'PGS' then do
          call ToPIPE('GE', 'id 0 s=256')
            FontName = ReadBrowserList('FontReq', 'FontGad', 'FontList')
            call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
          call ToPIPE('GE', 'id 0 s=512')
        end
      end
    /**/

    /***//*** GE_ResetGad ***/
      when GE_GadID == GE_ResetGad then do
        FontName = Font.Highlight
        FontSize = FSize.Highlight
        call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'"')
        call ToPIPE('GE', 'id 'GE_FontSizeGad' gt="'FontSize'"')
      end
    /**/

    /***//*** Date Gadgets ***/
      when GadArg.GE_GadID ~= '' then do
        if GE_EventType == File$ then GE_StartOrEnd = 0
        else GE_StartOrEnd = 1 - GE_StartOrEnd
        GE_ReturnDate = strip(left(GadArg.GE_GadID, 1)''right(GadArg.GE_GadID, 2), "B", "C")
        GE_Date = substr(GadArg.GE_GadID, 2)
        if GE_StartOrEnd == 0 then do
          call ToPIPE('GE', 'id 'GE_StartGad' gt="'GE_Date'" ref')
          GE_StartDate = GE_ReturnDate
        end
        else do
          call ToPIPE('GE', 'id 'GE_EndGad' gt="'GE_Date'" ref')
          GE_EndDate = GE_ReturnDate
        end
      end
    /**/

    /***//*** GE_TextColorGad ***/
      when GE_GadID == GE_TextColorGad then do
        call ToPIPE('GE', 'id 0 s=256')
        GE_TextColor = ReadBrowserList('NCColorReq', 'NCColorGad', 'ColorList')
        call ToPIPE('GE', 'id 'GE_TextColorGad' gt="'GE_TextColor'"')
        call ToPIPE('GE', 'id 0 s=512')
      end
    /**/

    /***//*** GE_LineGad ***/
      when GE_GadID == GE_LineGad then GE_EnteredLine = GE_GadInfo1
    /**/

    /***//*** GE_BoxedGad ***/
      when GE_GadID == GE_BoxedGad then GE_BoxValue = GE_Boxed.GE_GadInfo1
    /**/

    /***//*** GE_BoxColorGad ***/
      when GE_GadID == GE_BoxColorGad then do
        call ToPIPE('GE', 'id 0 s=256')
        GE_BoxColor = ReadBrowserList('ColorReq', 'ColorGad', 'ColorList')
        call ToPIPE('GE', 'id 'GE_BoxColorGad' gt="'GE_BoxColor'"')
        call ToPIPE('GE', 'id 0 s=512')
      end
    /**/

    /***//*** GE_FrequencyGad ***/
      when GE_GadID == GE_FrequencyGad then GE_WeeklyValue = GE_Weekly.GE_GadInfo1
    /**/

    /***//*** GE_OKGad ***/
      when GE_GadID == GE_OKGad then do
        if (GE_StartDate == "") & (GE_EventType == Event$) then do
          call ToPIPE('GE', 'id 0 s=256')
          call CASimpleReq('FWCAddEvent 'Notice$, EnterStartDate$'...')
          call ToPIPE('GE', 'id 0 s=512')
        end
        else if (GE_EventValue == "") & (GE_BoxValue == "") then do
          call ToPIPE('GE', 'id 0 s=256')
          call CASimpleReq('FWCAddEvent 'Notice$, EnterEvent$'...')
          call ToPIPE('GE', 'id 0 s=512')
        end
        else do
          EventData = "   EventType = "GE_EventType||'0a'x||,
                      " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
                      " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
                      "   TextColor = "GE_TextColor||'0a'x||,
                      " EnteredLine = "GE_EnteredLine||'0a'x||,
                      "    BoxColor = "GE_BoxColor||'0a'x||,
                      "     Options = "GE_BoxValue""GE_WeeklyValue||'0a'x||,
                      " EnteredFont = "strip(FontName)||'0a'x||,
                      " EnteredSize = "strip(FontSize)||'0a'x||,
                      "EnteredEvent = "GE_EventValue
          call ToPIPE('GE', 'id 0 s=128')
          call ProcessEvent
          call ToPIPE('GE', 'id 0 s=64')

          GE_StartOrEnd = 1
          GE_StartDate  = ""
          GE_EndDate    = ""
          call ToPIPE('GE', 'id 'GE_StartGad' gt="" ref')
          call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
        end
      end
    /**/

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

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

  address command 'version libs:'LV_Libname '>PIPE:FWC'

  return word(ReadFile('PIPE:FWC'), 2)
/**/

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

/***//*** 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 WriteFile('PIPE:Text2Insert.txt', PT_Text)
      INSERTTEXT FILE 'PIPE: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 = 0
    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
        if DoDateBox == 1 then HighlightOffset = CurveOffset + 1.25 * DateOffset + 2 * Width.WidthOfDate8
        else do
          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
        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 + CurveOffset + 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 * CurveOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
            AllowedBoxWidth = AllowedWidth + 2 * CurveOffset

            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

  call CloseBusy(Req)

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

return
/**/

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

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

  return
/**/

/***//*** ReadBrowserList (RBL) ***/
ReadBrowserList:
  parse arg RBL_FileHandle, RBL_GadIDList, RBL_ItemList

  interpret 'RBL_AlreadyOpen = 'RBL_FileHandle
  if RBL_AlreadyOpen == 0 then do
    if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
    call ToPIPE(RBL_FileHandle, 'open')
    if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
    interpret RBL_FileHandle '= 1'
  end
  else do
    if (RexxTricks == 1) & (ShanghaiScreen == 1) then call SetDefaultPubScreen(PubScreen)
    call ToPIPE(RBL_FileHandle, 'id 0 s=64')
    if (RexxTricks == 1) & (ChangePubScreen == 0) then call SetDefaultPubScreen(DefPubScreen)
  end
  do while ~eof(RBL_FileHandle)
    call ToPIPE(RBL_FileHandle, 'continue')
    RBL_Result = readln(RBL_FileHandle)
    parse var RBL_Result . . . . RBL_NodeID
    RBL_NodeID = strip(RBL_NodeID)
    interpret 'RBL_ListID = 'RBL_GadIDList'.RBL_NodeID'
    if pos('gadget', RBL_Result) > 0 then leave
  end
  call ToPIPE(RBL_FileHandle, 'id 0 s=128')
  interpret 'RBL_Entry = 'RBL_ItemList'.'RBL_ListID

  return RBL_Entry
/**/

/***//*** ReadFile (PROCEDURE) Subroutine ***/
ReadFile: PROCEDURE
  parse arg file

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

/***//*** ReadToEOL (PROCEDURE) Subroutine ***/
ReadToEOL: PROCEDURE
  parse arg Start, Var

  if Start == 0 then return ''

  EOL = pos('0a'x, Var, Start)
  if EOL == 0 then EOL = length(Var)

  return substr(Var, Start, EOL - Start)
/**/

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

/***//*** ToPIPE (TP) ***/
ToPIPE:
  parse arg PipeName, TP_CMD

  call writeln(PipeName,' 'TP_CMD)
  TP_Response=readln(PipeName)

  parse var TP_Response TP_Response1 TP_Response2 .

  if TP_Response1 == 'ok' then return(TP_Response2)
  if TP_Response == '' then TP_Response = 'Blank line'
  call AddMsg('E', 'Line : 'SIGL)
  call AddMsg('E', PipeName' error: 'TP_Response)
  call AddMsg('E', 'Returned from: 'TP_CMD)
  call Cleanup
/**/

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

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

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

  if open('Temp', file, 'W') then do
    success = writech('Temp', var)
    call close('Temp')
  end
  if (upper(which) == 'B') & (upper(left(file, 4)) == 'ENV:') then call WriteFile('ENVARC:'substr(file, 5), var)

  return success
/**/

/***//*** SetVariables Subroutine ***/
SetVariables:
/***//**** Initialize Variables ****/
  Date            = 0
  esc             = "1B"x
  EventFile       = ''
  FontKnown.      = ''
  FSize.          = 10
  HighestFont     = 5
  Highlight       = 5
  PatVar          = '#?.data'
  PrefsFile       = ''
  Req             = 0
  Storage         = 'RAM:FWC/'
  Width.          = 100
  ColorW          = 80
  ColorH          = 10

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

  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

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

/***//**** Read default variables ****/
  call open('Temp', FullCallPath)
    call seek('Temp', -5000, 'E')
    Chunk = readch('Temp', 65535)
    EndPos = pos('VarList:'||'0a'x, Chunk)
    if EndPos == 0 then do
      call AddMsg('E', 'Unable to locate default variables.')
      call CleanUp
    end
    RD_VariableFile = substr(Chunk, EndPos + 9)
  call close('Temp')
  interpret left(RD_VariableFile, pos('return', RD_VariableFile) - 1)
/**/

/***//**** Determine prefs file from calendar ****/
  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; NextPart = result
      TempDate = left(TempDate, StartObj - 1)''NextPart
    end
  end
  else if App = 'PGS' then do
    CURRENTWINDOW; winName = '"'RESULT'"'
    SELECTTEXT at 0 0 WINDOW winName
    SELECTTEXT ALL WINDOW winName
    EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
    TempDate = ReadFile("PIPE:FWC")
    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
      do while right(TempDate, 1) == '|'
        StartObj = pos('|', TempDate)
        NextObj = strip(substr(TempDate, StartObj), 'B', '|')
        BRINGTOFRONT OBJECTID NextObj WINDOW winName
        SELECTTEXT at 0 0 WINDOW winName
        SELECTTEXT ALL WINDOW winName
        EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
        TempDate = left(TempDate, StartObj - 1)''var
        SENDTOBACK OBJECTID NextObj WINDOW winName
      end
    end
  end
  PrefsFile = substr(TempDate, 12)
  TempDate = substr(TempDate, 4, 8)
/**/

/***//**** Get application colors ****/
  if App == 'FW' then do
    FWPrefs = ReadFile(CurrentDir'FWFiles/FW.Prefs')
    ColorTable = pos('SWCL', FWPrefs) + 12
    EndTable = pos('STUP', FWPrefs)
    ColorCount = 0
    Do CTPos = ColorTable to EndTable by 20
      ColorRegister.ColorCount = c2x(substr(FWPrefs, CTPos - 3, 3))
      ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
      if ColorRegister.ColorCount = '000000' then Black$ = ColorList.ColorCount
      if ColorRegister.ColorCount = '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

    PGSColors = ReadFile(CurrentDir''word(PgmVersion, 1)'.colors')
    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$
/**/

  GSI_Data = ReadFile(PrefsFile)
  if GSI_Data ~= '' then do
    GSI_UpperData = upper(GSI_Data)
    interpret ReadToEOL(pos('DOSHANGHAI', GSI_UpperData), GSI_UpperData)
    interpret ReadToEOL(pos('CHANGEPUBSCREEN', GSI_UpperData), GSI_UpperData)
    interpret ReadToEOL(pos('STORAGE', GSI_UpperData), GSI_UpperData)
  end
  call CheckShanghai
  call makedir(left(Storage, length(Storage) - 1))

  if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
    UserFile = ReadFile(PrefsFile)
    if UserFile ~= '' then do
      call openv('UserFile')
        do until eofv('UserFile')
          CD_VarLine = strip(ReadvLn('UserFile'))
          if left(CD_VarLine, 15) == '/* End Pass One' then leave
          if upper(left(CD_VarLine, 11)) == 'IMAGECLASS.' then iterate
          interpret CD_VarLine
        end
      call closev('UserFile')
    end
  end
  drop Orientation

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

  CalendarBorder = CalendarBorder / 100
  CalendarShadow = CalendarShadow / 100
  CornerRadius   = CornerRadius / 100
  DateOffset     = DateOffset / 100
  StretchDateH   = StretchDateH / 100
  StretchDateW   = StretchDateW / 100
  TextAdj        = TextAdj / 100
  TTextArea      = TTextArea / 100
  WTextArea      = WTextArea / 100

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

  CalendarBorder   = CalendarBorder * PrintWidth
  CalendarShadow   = CalendarShadow * PrintWidth
  PrintWidth       = PrintWidth - 2 * CalendarBorder - CalendarShadow
  PrintHeight      = PrintHeight - 2 * CalendarBorder - CalendarShadow
  Margin.Left      = Margin.Left + CalendarBorder

  BoxWidth         = PrintWidth/7
  CalRight         = Margin.Left + BoxWidth * 7
  TextArea         = TextArea * PrintHeight
  CalTop           = TextArea + Margin.Top + CalendarBorder
  BoxHeight        = (PrintHeight - TextArea)/5
  CRadius          = CornerRadius * min(BoxHeight, BoxWidth)
  CurveOffset      = DateOffset * BoxWidth + CRadius * .25
  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 ***/
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.CalShadow     = Black$
  Background.Highlight     = '<'Clear$'>'
  Background.HighlightH    = '<'Clear$'>'
  Background.MiniCal       = White$
  Background.MiniCalShadow = Black$
  Background.NoteBox       = '<'Clear$'>'
  Background.Weekend       = '<'Clear$'>'
  BelzierFactor            = .55
  Bold.MiniCal             = DefaultBold
  Bold.FYMiniCal           = DefaultBold
  CalendarBorder           = 0
  CalendarShadow           = 0
  CenterMiniDates          = 1
  ChangePubScreen          = 0
  Color.Sunday             = Black$
  Color.Monday             = Black$
  Color.Tuesday            = Black$
  Color.Wednesday          = Black$
  Color.Thursday           = Black$
  Color.Friday             = Black$
  Color.Saturday           = Black$
  Color.AddEvent           = Black$
  Color.Date               = Black$
  Color.Extended           = Black$
  Color.Header             = Black$
  Color.Highlight          = Black$
  Color.HighlightH         = Black$
  Color.Julian             = Black$
  Color.MiniCal            = Black$
  Color.Moon               = Black$
  Color.NoteBox            = Black$
  Color.SubHeader          = Black$
  Color.Sunrise            = Black$
  Color.Sunset             = Black$
  Color.Weekday            = Black$
  Color.WeekNumber         = Black$
  CornerRadius             = 0
  DateOffset               = 2
  DoDailyColors            = 0
  DoDateBox                = 0
  DoExtended               = 1
  DoHide                   = 0
  DoHighlights             = 0
  DoImages                 = 0
  DoJulian                 = ''
  DoJulianLeft             = ''
  DoMatchColors            = 0
  DoMiniCals               = 1
  DoNoteBox                = 0
  DoPhases                 = ''
  DoShanghai               = 1
  DoSunRise                = ''
  DoSunSet                 = ''
  DoTopExtraWk             = 0
  DoWeekNumber             = ''
  FinalView                = 75
  Font.Date                = DefaultFont
  Font.Extras              = DefaultFont
  Font.Header              = DefaultFont
  Font.Highlight           = DefaultFont
  Font.MiniCal             = DefaultFont
  Font.FYMiniCal           = DefaultFont
  Font.Weekday             = DefaultFont
  Font.SubHeader           = DefaultFont
  GenMVars                 = 'Month.Month EnteredYear'
  GenYVars                 = 'EnteredYear'
  GfxApp                   = 'Visage'
  GfxAppPath               = ''
  GfxCmd                   = '%s info'
  GfxTemplate              = '. "0a"x . ImgDT ImgWidth "x" ImgHeight "x" .'
  HeaderLoc                = 9
  HeaderSize               = 50
  Header$                  = '%s %s'
  HeaderVars               = 'Month.Month Year'
  HighlightRows            = 9
  LaunchM                  = ''
  LaunchY                  = ''
  Leading                  = 100
  Line.AddEvent            = Black$
  Line.CalBorder           = Black$
  Line.Extended            = Black$
  Line.Grid                = Black$
  Line.MiniCal             = Black$
  Line.NoteBox             = Black$
  MagnifyExtras            = 100
  Margin.Bottom            = 0
  Margin.Left              = 0
  Margin.Right             = 0
  Margin.Top               = 0
  MinWidth                 = 80
  MaxImgHeight             = 75
  MaxImgWidth              = 75
  MiniCalHeight            = 60
  MiniCalSpacing           = 0.5
  MiniCalWidth             = 200
  MoonRadius               = 10
  Orientation              = 'Wide'
  PrefsName                = 'Default'
  ShiftLMini               = 0
  ShiftRMini               = 0
  StartWeek                = 0
  StretchDateH             = 100
  StretchDateW             = 100
  SubHeaderLoc             = 0
  SubHeaderSize            = 0
  SubHeader$               = ''
  SubHeaderVars            = ''
  SunCalcPath              = ''
  Text.Julian              = ''
  Text.Sunrise             = ''
  Text.Sunset              = ''
  Text.WeekNumber          = ''
  TextAdj                  = 77
  TTextArea                = 15
  WeekdaySize              = 50
  WTextArea                = 20
return
/**/