home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 113 / EnigmaAmiga113CD.iso / software / varie / fwcalendar / fwcaddevent.rexx next >
OS/2 REXX Batch file  |  2000-06-21  |  65KB  |  1,916 lines
  1. /*
  2.     AddEvent.rexx Macro
  3.     Adds events to calendars created by FWCalendar.rexx
  4.     $VER: FWCAddEvent.rexx v3.82 (21 Jun 2000)
  5.     ©Ron Goertz (goertz@earthlink.net)
  6. */
  7.  
  8. OPTIONS RESULTS
  9. signal on syntax
  10.  
  11. call AddLibraries
  12. bguiopen = bguiopen()
  13. if ErrorCount > 0 then call Cleanup
  14.  
  15. parse source . . . FullCallPath . CallHost
  16. CallHost = strip(CallHost)
  17. ScriptDir = PathPart(FullCallPath)
  18.  
  19. CurrentDir = upper(Pragma('D'))
  20. if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
  21.  
  22. if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
  23.   App     = 'FW'
  24.   AppName = 'FINALWRITER'
  25.   if CallHost == 'REXX' then address value substr(PortList, pos('FINALW.', PortList), 8)
  26.   GETDOCITEMPREFS Decimal; DecimalFormat = result
  27.   DOCITEMPREFS Decimal Period
  28. end
  29. else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
  30.   App     = 'PGS'
  31.   AppName = 'PAGESTREAM'
  32.   address 'PAGESTREAM'
  33. end
  34.  
  35. call SetVariables
  36.  
  37. Month = substr(TempDate,5,2)
  38. if left(Month,1) == "0" then Month = right(Month,1)
  39. PrevMonth = Month - 1
  40. if PrevMonth = 0 then PrevMonth = 12
  41. NextMonth = Month + 1
  42. if NextMonth = 13 then NextMonth = 1
  43.  
  44. Year = left(TempDate,4)
  45. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29
  46.  
  47. interpret "StartDate = Day."Date('W', TempDate, 'S')
  48. if (DoExtended == 0) | (StartDate + MonthLength.Month > 35) then MaxDate = MonthLength.Month
  49. else MaxDate = 35 - StartDate
  50.  
  51. FontName = Font.Highlight
  52. FontSize = FSize.Highlight
  53. call GetEvent
  54. exit
  55.  
  56. /*********************************************/
  57. /*              Subroutines                  */
  58. /*********************************************/
  59. /***//*******  AddLibraries (AL) Subroutine  ***********/
  60. AddLibraries:
  61.   PortList     = show('P')
  62.   ErrorCount   = 0
  63.   WarningCount = 0
  64.   Req          = 0
  65.   bguiopen     = 0
  66.   EventFile    = ''
  67.   DefScreen    = ''
  68.  
  69.   Storage         = 'RAM:FWC/'
  70.   Notice$         = 'notice'
  71.   Critical$       = 'Critical error'
  72.   See$            = 'see'
  73.   SeeOutput$      = 'see the output above for details'
  74.   ForDetails$     = 'for details'
  75.   ForwardLog$     = 'Forward log file to'
  76.   Unable$         = 'if you are unable to resolve the problem.'
  77.   ForwardContent$ = 'Forward contents of output to'
  78.   SeeShell$       = 'see the shell output for details'
  79.   OK$             = '_OK'
  80.  
  81.   AL_Libs        = 'rexxsupport.library rexxbgui.library bgui.library'
  82.   AL_MinVersions = ' 34.9                4.0             41.10       '
  83.   AL_Offsets     = '-30                -30              -30          '
  84.   do AL_i = 1 to words(AL_Libs)
  85.     AL_Lib        = word(AL_Libs, AL_i)
  86.     AL_MinVersion = word(AL_MinVersions, AL_i)
  87.     AL_Offset     = word(AL_Offsets, AL_i)
  88.     if exists('LIBS:'AL_Lib) then do
  89.       AL_InstalledVersion = libver(AL_Lib)
  90.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
  91.         call AddMsg('E', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  92.       end
  93.       else if pos('rexx', AL_Lib) > 0 then call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  94.     end
  95.     else call AddMsg('E', AL_lib' is required but could not be found.')
  96.   end
  97.  
  98.   AL_Libs        = 'rexxtricks.library'
  99.   AL_MinVersions = '  0               '
  100.   AL_Offsets     = '-30               '
  101.   AL_Variables   = 'RexxTricks        '
  102.   do AL_i = 1 to words(AL_Libs)
  103.     AL_Lib        = word(AL_Libs, AL_i)
  104.     AL_MinVersion = word(AL_MinVersions, AL_i)
  105.     AL_Offset     = word(AL_Offsets, AL_i)
  106.     AL_Variable   = word(AL_Variables, AL_i)
  107.     if exists('LIBS:'AL_lib) then do
  108.       AL_InstalledVersion = libver(AL_lib)
  109.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
  110.         call AddMsg('W', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  111.         interpret Al_Variable' = 0'
  112.       end
  113.       else do
  114.         call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  115.         interpret Al_Variable' = 1'
  116.       end
  117.     end
  118.     else interpret Al_Variable' = 0'
  119.   end
  120.  
  121.   if ErrorCount > 0 then call Cleanup
  122.   return
  123. /**/
  124.  
  125. /***//*******  AddMsg (AM) Subroutine  ***********/
  126. AddMsg:
  127.   parse arg AM_MsgType, AM_Msg
  128.  
  129.   if AM_MsgType == 'E' then do
  130.     ErrorCount = ErrorCount + 1
  131.     Error.ErrorCount = AM_Msg
  132.   end
  133.   else do
  134.     WarningCount = WarningCount + 1
  135.     Warning.WarningCount = AM_Msg
  136.   end
  137.  
  138.   return
  139. /**/
  140.  
  141. /***//*******  Cleanup () Subroutine  ***********/
  142. Cleanup:
  143.   signal off syntax
  144.  
  145.   if VariablesSet == 1 then do
  146.     interpret UserPrefs
  147.     if Req ~= 0 then call bguiwinclose(Req)
  148.     if App == 'FW' then do
  149.       SELECTOBJECT
  150.       REDRAW
  151.       if upper(DecimalFormat) == 'COMMA' then DocItemPrefs Decimal Comma
  152.     end
  153.     else if App == 'PGS' then do
  154.       SELECTOBJECT None WINDOW winName
  155.       if WindowRefreshed ~= 1 then do
  156.         REFRESH ON
  157.         REFRESHWINDOW WINDOW winName
  158.       end
  159.     end
  160.   end
  161.  
  162.   LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  163.   if LogOpen == 1 then OutType = 'File'
  164.   if (ErrorCount > 0) & (LogOpen == 0) then do
  165.     LogOpen = 1
  166.     call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
  167.     OutType = 'CON'
  168.   end
  169.  
  170.   if LogOpen == 1 then do
  171.     call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
  172.     call writeln('FWCLog', 'Application: 'PgmVersion)
  173.     call writeln('FWCLog', 'Current Dir: 'CurrentDir)
  174.     call writeln('FWCLog', ' Script Dir: 'ScriptDir)
  175.     call writeln('FWCLog', '       Host: 'CallHost)
  176.     call writeln('FWCLog', '   Calendar: 'Month.Month' 'Year||'0a'x)
  177.   end
  178.  
  179.   if (ErrorCount > 0) | (WarningCount > 0) then do
  180.     do i = 1 to ErrorCount
  181.       call writeln('FWCLog', Error.i)
  182.     end
  183.  
  184.     do i = 1 to WarningCount
  185.       call writeln('FWCLog', Warning.i)
  186.     end
  187.  
  188.     if exists(PrefsFile) then do
  189.       call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
  190.       call open('DataFile', PrefsFile)
  191.         do until eof('DataFile')
  192.           Ln = ReadLn('DataFile')
  193.           if pos('End Pass One', Ln) > 0 then leave
  194.           call writeln('FWCLog', Ln)
  195.         end
  196.       call close('DataFile')
  197.     end
  198.  
  199.     if EventFile ~= '' then do
  200.       call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
  201.       call open('DataFile', EventFile)
  202.         do until eof('DataFile')
  203.           call writeln('FWCLog', ReadLn('DataFile'))
  204.         end
  205.       call close('DataFile')
  206.     end
  207.  
  208.     if ErrorCount > 0 then ErrorType = Critical$
  209.     else ErrorType = Noncritical$
  210.     FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  211.     Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  212.     ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  213.     if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  214.     if (OutType == 'File') & (bguiopen == 0) then do
  215.       call open('CON', 'CON:10/10/500/300/FWCAddEvent notice/WAIT/CLOSE')
  216.         call writeln('CON', FileMsg)
  217.       call close('CON')
  218.     end
  219.     if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  220.     if (OutType == 'CON') & (bguiopen == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  221.   end
  222.   else do
  223.     address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  224.     if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  225.   end
  226.  
  227.   address command 'delete >NIL: 'Storage'FWCTemp quiet'
  228.   call close('FWCLog')
  229.   if bguiopen = 1 then call bguiclose()
  230.   if DefScreen ~= '' then call setdefaultpubscreen(DefScreen)
  231.   exit
  232. /**/
  233.  
  234. /***//*******  ConvertDay (CD) Subroutine ***********/
  235. ConvertDay:
  236.   parse arg CD_Day
  237.   If upper(left(CD_Day,1)) == "P" then CD_Day = substr(CD_Day,2) - MonthLength.PrevMonth
  238.   If upper(left(CD_Day,1)) == "N" then CD_Day = substr(CD_Day,2) + MonthLength.Month
  239.   return CD_Day
  240. /**/
  241.  
  242. /***//*******  DrawBox (DB) Subroutine  ***********/
  243. DrawBox:
  244.   parse arg DB_x1, DB_y1, DB_Width, DB_Height, DB_Weight, DB_Color, DB_FillBool, DB_FillColor, DB_Tint
  245.  
  246.   if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
  247.  
  248.   if App == 'FW' then do
  249.     if DB_Weight == 'HL' then DB_Weight = 'Hairline'
  250.     else if DB_Weight == 0 then do
  251.       DB_Weight = 'None'
  252.       if DB_FillColor ~= '<'Clear$'>' then DB_Color = DB_FillColor
  253.     end
  254.  
  255.     if DB_FillBool == 1 then DB_FillBool = 'Solid'
  256.     else do
  257.       DB_FillBool = 'Transparent'
  258.       DB_FillColor = DB_Color
  259.     end
  260.  
  261.     BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_Color'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
  262.     DRAWBOX 1 DB_x1 DB_y1 DB_Width DB_Height; DB_id = result
  263.   end
  264.   else if App == 'PGS' then do
  265.     if DB_Weight == 'HL' then DB_Weight = 0.3pt
  266.     else DB_Weight = DB_Weight'pt'
  267.  
  268.     if DB_FillBool == 1 then DB_FillBool = 'ON'
  269.     else DB_FillBool = 'OFF'
  270.  
  271.     If DB_Weight == 0 then DB_LineBool = 'OFF'
  272.     else DB_LineBool = 'ON'
  273.  
  274.     DRAWBOX DB_x1 DB_y1 DB_x1 + DB_Width DB_y1 + DB_Height WINDOW winName; DB_id = result
  275.     STROKED DB_LineBool OBJECTID DB_id WINDOW winName
  276.     SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  277.     SETCOLORSTYLE '"'DB_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  278.     FILLED DB_FillBool OBJECTID DB_id WINDOW winName
  279.     SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECTID DB_id WINDOW winName
  280.     SETCOLORTINT DB_Tint FILL OBJECTID DB_id WINDOW winName
  281.   end
  282.   return DB_id
  283. /**/
  284.  
  285. /***//*******  GetEvent (GE) Subroutine  ***********/
  286. GetEvent:
  287.   do GE_i = 0 to 15
  288.     linelist_.GE_i = GE_i
  289.   end
  290.   linelist_.COUNT = min(RowsThatFit, 16)
  291.  
  292.   call bguilist("eventlist_",Event$,File$)
  293.   call bguilist("FrequencyList", Once$, Weekly$, Biweekly$)
  294.  
  295.   GE_StartOrEnd   = 1
  296.   GE_StartDate    = ""
  297.   GE_EndDate      = ""
  298.   GE_Boxed.0      = ""
  299.   GE_Boxed.128    = "B"
  300.   GE_Weekly.0     = ""
  301.   GE_Weekly.1     = "W"
  302.   GE_Weekly.2     = "2"
  303.   GadID.          = ''
  304.   GE_Arg.         = ''
  305.   GE_i            = 0
  306.   GE_Day          = 0
  307.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  308.   GE_NextDay      = 0
  309.  
  310.   Req = OpenBusy(PrepReq$'...', 45)
  311.   do while (GE_i < 6)
  312.     GE_j = 0
  313.     do while (GE_j < 7)
  314.       call UpdateBusy(Req, 1)
  315.       GE_SerialPosition = (GE_i * 7) + GE_j
  316.       GE_Button = GE_SerialPosition + 1
  317.       if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
  318.         GE_Day = GE_Day + 1
  319.         interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
  320.         GadID = GetID(GE_Button'_')
  321.         GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
  322.       end
  323.       else do
  324.         if GE_SerialPosition < StartDate then Do
  325.           GE_PrevDay = GE_PrevDay + 1
  326.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
  327.           GadID = GetID(GE_Button'_')
  328.           GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
  329.         end
  330.         else do
  331.           GE_NextDay = GE_NextDay + 1
  332.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
  333.           GadID = GetID(GE_Button'_')
  334.           GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
  335.         end
  336.       end
  337.       GE_j = GE_j + 1
  338.     end
  339.     GE_i = GE_i + 1
  340.     if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  341.   end
  342.  
  343.   DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
  344.                 bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
  345.                 bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
  346.                 bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  347.   if GE_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  348.   if GE_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)
  349.  
  350.   g=bguivgroup(,
  351.     bguihgroup(,
  352.       bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  353.       bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1),
  354.     )||,
  355.     bguihgroup(,
  356.       bguistring('fontvalue_',Font$':',FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
  357.       bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
  358.       bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  359.       bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
  360.     )||,
  361.     bguihgroup(,
  362.       bguivgroup(,
  363.         bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
  364.         bguihgroup(,
  365.           bguiinfo("dummy_",,esc"c"left(Day.0,1))||,
  366.           bguiinfo("dummy_",,esc"c"left(Day.1,1))||,
  367.           bguiinfo("dummy_",,esc"c"left(Day.2,1))||,
  368.           bguiinfo("dummy_",,esc"c"left(Day.3,1))||,
  369.           bguiinfo("dummy_",,esc"c"left(Day.4,1))||,
  370.           bguiinfo("dummy_",,esc"c"left(Day.5,1))||,
  371.           bguiinfo("dummy_",,esc"c"left(Day.6,1)),
  372.         )||,
  373.         DateButtons,
  374.       )||,
  375.       bguivgroup(,
  376.         bguiinfo("startchoice_",esc"r"Start$':',"")bguilayout(LGO_FixMinHeight, 1)||,
  377.         bguiinfo("endchoice_",esc"r"End$':',"")bguilayout(LGO_FixMinHeight, 1)||,
  378.         bguicycle('textcolor_',esc"r"TextColor$':','TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  379.         bguicycle("linechoice_",esc"r"Line$':',"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  380.         bguicheckbox("boxchoice_",esc"r"Boxed$':',0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  381.         bguicycle('boxcolor_',esc"r"BoxColor$':','ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  382.         bguicycle("weeklychoice_",esc"r"Frequency$':','FrequencyList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  383.         bguihgroup(,
  384.           bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
  385.           bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1),
  386.         ),
  387.       ),
  388.     ),
  389.   ,"-1","-1")
  390.  
  391.   call UpdateBusy(Req, 1)
  392.   GE_winID=bguiwindow(EnterEventInfo$':',g,5,0,,PubScreen)
  393.   call UpdateBusy(Req, 1)
  394.  
  395.   if App == 'PGS' then do
  396.     FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
  397.     call UpdateBusy(Req, 1)
  398.     FontwinID=bguiwindow(SelectFont$':',FontGroup,20,50,,PubScreen)
  399.   end
  400.  
  401.   call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  402.   call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  403.   call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  404.   call bguiset(obj.event_,,BT_Key,EventKey)
  405.   call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)
  406.  
  407.   if bguiwinopen(GE_winID)=0 then bguierror(12)
  408.  
  409.   if Req ~= 0 then call bguiwinclose(Req)
  410.   Req = 0
  411.  
  412.   id=0
  413.   do while 1
  414.     call bguiwinwaitevent(GE_winID,"ID")
  415.     select
  416.       when (id == id.cancel_) | (id == id.winclose) then call Cleanup
  417.       when id == id.winactive then nop
  418.       when id == id.wininactive then nop
  419.       when id == id.event_ then nop
  420.       when id == id.linechoice_ then nop
  421.       when id == id.boxchoice_ then nop
  422.       when id == id.textcolor_ then nop
  423.       when id == id.boxcolor_ then nop
  424.       when id == id.weeklychoice_ then nop
  425.       when id == id.reset_ then do
  426.         FontName = Font.Highlight
  427.         FontSize = FSize.Highlight
  428.         call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
  429.         call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
  430.       end
  431.       when id == id.fontvalue_ then do
  432.         call bguireq('1b'x||"c"MustUse$,"*"OK$,'',GE_winID)
  433.         call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
  434.       end
  435.       when id == id.fontsize_ then nop
  436.       when id == id.addfont_ then do
  437.         call bguiwinbusy(GE_winID)
  438.         if App == 'FW' then do
  439.           FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$':', GE_winID,,'#?')
  440.           if FontFile ~= '' then call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontFile)
  441.         end
  442.         else if App == 'PGS' then do
  443.           call bguiwinopen(FontwinID)
  444.           do while 1
  445.             call bguiwinwaitevent(FontwinID,'ID')
  446.             if id == id.winclose then leave
  447.             if id == id.fontlistview_ then do
  448.               call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
  449.               leave
  450.             end
  451.           end
  452.           call bguiwinclose(FontwinID)
  453.         end
  454.         call bguiwinready(GE_winID)
  455.         FontName = bguiget(obj.fontvalue_, STRINGA_TextVal)
  456.       end
  457.       when id == id.ok_ then do
  458.         GE_EventValue = bguiget(obj.event_, STRINGA_TextVal)
  459.         GE_BoxValue   = bguiget(obj.boxchoice_, GA_Selected)
  460.         GE_EventType  = bguiget(obj.eventtype_, CYC_Active)
  461.         if (GE_StartDate == "") & (GE_EventType == Event$) then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  462.         else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  463.         else do
  464.           GE_WeeklyValue  = bguiget(obj.weeklychoice_, CYC_Active)
  465.  
  466.           EventData = "   EventType = "Type.GE_EventType||'0a'x||,
  467.                       " EnteredFont = "strip(FontName)||'0a'x||,
  468.                       " EnteredSize = "strip(bguiget(obj.fontsize_, STRINGA_TextVal))||'0a'x||,
  469.                       " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
  470.                       " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
  471.                       " EnteredLine = "bguiget(obj.linechoice_, CYC_Active)||'0a'x||,
  472.                       "     Options = "GE_Boxed.GE_BoxValue""GE_Weekly.GE_WeeklyValue||'0a'x||,
  473.                       "   TextColor = "value('ColorList.'bguiget(obj.textcolor_, CYC_Active))||'0a'x||,
  474.                       "    BoxColor = "value('ColorList.'bguiget(obj.boxcolor_, CYC_Active))||'0a'x||,
  475.                       "EnteredEvent = "GE_EventValue
  476.  
  477.           call bguiwinclose(GE_winID)
  478.           call ProcessEvent
  479.           call bguiwinopen(GE_winID)
  480.  
  481.           GE_StartOrEnd = 1
  482.           GE_StartDate  = ""
  483.           GE_EndDate    = ""
  484.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,'')
  485.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,'')
  486.         end
  487.       end
  488.       when id == id.eventtype_ then do
  489.         GE_EventType = bguiget(obj.eventtype_, CYC_Active)
  490.         if Type.GE_EventType == Event$ then do
  491.           call bguiset(obj.event_,GE_winID,STRINGA_TextVal,"")
  492.           call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  493.           call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  494.           call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  495.           call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  496.           call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  497.           call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  498.           call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  499.           call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  500.           call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  501.         end
  502.         else do
  503.           GE_DataFile = bguifilereq(ScriptDir''"FWCAddEvent.data", SelectFile$, GE_winID,DOPATTERNS,PatVar)
  504.           if ~exists(GE_DataFile) then do
  505.             call bguireq(GE_DataFile' 'CantFind$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  506.             GE_DataFile = ''
  507.           end
  508.           if GE_DataFile == '' then do
  509.             call bguiset(obj.eventtype_, GE_winID, CYC_Active, 0)
  510.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  511.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  512.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  513.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  514.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  515.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  516.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  517.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  518.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  519.           end
  520.           else do
  521.             call bguiset(obj.event_, GE_winID, STRINGA_TextVal,GE_DataFile)
  522.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 1)
  523.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 1)
  524.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 1)
  525.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 1)
  526.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 1)
  527.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 1)
  528.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 1)
  529.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 1)
  530.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 1)
  531.           end
  532.         end
  533.       end
  534.       otherwise do
  535.         GE_StartOrEnd = 1 - GE_StartOrEnd
  536.         GE_ReturnDate = strip(substr(GE_Arg.id, 1, 1)""right(GE_Arg.id, 2), "B", "C")
  537.         GE_Date = substr(GE_Arg.id, 3)
  538.         if GE_StartOrEnd == 0 then do
  539.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  540.           GE_StartDate = GE_ReturnDate
  541.         end
  542.         else do
  543.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  544.           GE_EndDate = GE_ReturnDate
  545.         end
  546.       end
  547.     end
  548.   end
  549.   exit
  550. /**/
  551.  
  552. /***//*******  GetFontWidth (GFW) Subroutine  *********/
  553. GetFontWidth:
  554.   parse arg GFW_FontType, GFW_Char
  555.  
  556.   GFW_ID = PrintText(1, 1, GFW_FontType, 'N', White$, Width.GFW_FontType, GFW_Char)
  557.   if App == 'FW' then do
  558.     REDRAW
  559.     GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
  560.     DELETEOBJECT GFW_ID
  561.   end
  562.   else if App == 'PGS' then do
  563.     GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
  564.     GFW_Width = GFW_Text.Right - GFW_Text.Left
  565.     DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  566.   end
  567. return GFW_Width
  568. /**/
  569.  
  570. /***//*******  GetHeight (GH) Subroutine  ***********/
  571. GetHeight:
  572.   parse arg GH_FontType
  573.  
  574.   if App == 'FW' then do
  575.     TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
  576.     DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
  577.     GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  578.     DELETEOBJECT GH_id
  579.   end
  580.   else if App == 'PGS' then do
  581.     DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
  582.     SELECTTEXT AT 0 0 WINDOW winName
  583.     BEGINCOMMANDCAPTURE
  584.       SETLEADING RELATIVE 100
  585.       SETTYPESIZE FSize.GH_FontType WINDOW winName
  586.       SETFONT Font.GH_FontType WINDOW winName
  587.     ENDCOMMANDCAPTURE
  588.     INSERT 'A' WINDOW winName
  589.     GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
  590.     GH_Text.Height = GH_Text.Bottom - GH_Text.Top
  591.     DELETEOBJECT OBJECTID GH_id WINDOW winName
  592.   end
  593.   return GH_Text.Height
  594. /**/
  595.  
  596. /***//*******  GetID (GI) Subroutine  ***********/
  597. GetID:
  598. parse arg GI_var
  599.  
  600. return id.GI_var
  601. /**/
  602.  
  603. /***//*******  GetLogInfo () Subroutine  ***********/
  604. GetLogInfo:
  605.   if ~exists(Storage'FWC'App'Temp.txt') then address command 'list >'Storage'FWC'App'Temp.txt 'AppName'#? lformat %N'
  606.   if open('Temp', Storage'FWC'App'Temp.txt') ~= 0 then do
  607.     do while ~eof('Temp')
  608.       PgmName = readln('Temp')
  609.       if pos('.', PgmName) == 0 then leave
  610.     end
  611.     call close('Temp')
  612.   end
  613.  
  614.   if ~exists(Storage'FWC'App'VersionInfo.txt') then address command 'version >'Storage'FWC'App'VersionInfo.txt 'PgmName
  615.  
  616.   call open('Temp', Storage'FWC'App'VersionInfo.txt')
  617.     PgmVersion = readln('Temp')
  618.   call close('Temp')
  619.  
  620.   if left(PgmVersion, 34) == 'Could not find version information' then do
  621.     if App == 'FW' then do
  622.       call open('Temp', CurrentDir''PgmName)
  623.         /* Desired string at 325365 for v 5.06 */
  624.         /* Desired string at 333771 for FW97   */
  625.         FileOffset = 325300
  626.         call seek('Temp', FileOffset, 'B')
  627.         do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  628.           PrevOffset = FileOffset
  629.           Chunk = readch('Temp', 10000)
  630.           EndPos = pos('Created', Chunk)
  631.           if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  632.         end
  633.         if EndPos == 0 then PgmVersion = 'Final Writer - version unknown'
  634.         else do
  635.           StartPos = lastpos('Final', Chunk, EndPos)
  636.           EndPos = pos('00'x||'00'x, Chunk, StartPos)
  637.           PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
  638.         end
  639.       call close('Temp')
  640.       call open('Temp', Storage'FWC'App'VersionInfo.txt', 'W')
  641.         call writeln('Temp', PgmVersion)
  642.       call close('Temp')
  643.     end
  644.     else PgmVersion = PgmName" - can't find version info"
  645.   end
  646.  
  647.   return
  648. /**/
  649.  
  650. /***//*******  GetWidth (GW) Subroutine  ***********/
  651. GetWidth:
  652.   parse arg GW_ID
  653.  
  654.   if App = 'FW' then do
  655.     GETOBJECTCOORDS GW_ID
  656.     Parse Var result . . . GW_width .
  657.   end
  658.   else if App == 'PGS' then do
  659.     SELECTOBJECT OBJECTID GW_ID  WINDOW winName
  660.     GETOBJECT BOUNDINGBOX GW_Temp WINDOW winName
  661.     GW_width = GW_Temp.Right - GW_Temp.Left
  662.   end
  663.  
  664.   return GW_width
  665. /**/
  666.  
  667. /***//*******  LibVer (LV) Subroutine  *********/
  668. LibVer: /* Retrieve the version number of a library */
  669.   parse arg LV_libname
  670.   if right(LV_libname,8) ~= '.library' then LV_libname = LV_libname'.library'
  671.   address command 'version' 'libs:'LV_Libname '>env:LibVer'
  672.   if open('Temp', 'env:LibVer') then do
  673.     LV_libver = word(readln('Temp'), 2)
  674.     call close('Temp')
  675.   end
  676.   else LV_libver = 'unknown'
  677.   return LV_libver
  678. /**/
  679.  
  680. /***//*******  MemberID (MI) Subroutine  *********/
  681. MemberID:
  682.   parse arg MI_Member, MI_Array, MI_Count, MI_Start
  683.  
  684.   if MI_Start == 0 then MI_Count = MI_Count - 1
  685.   do MI_i = MI_Start to MI_Count
  686.     if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  687.   end
  688.   return -1
  689. /**/
  690.  
  691. /***//*******  NameOnly (NO) Subroutine  ***********/
  692. NameOnly:
  693.   parse arg NO_fontname
  694.   return substr(NO_fontname, max(lastpos(':', NO_fontname), lastpos('/', NO_fontname)) + 1)
  695. /**/
  696.  
  697. /***//*******  OpenBusy (OB) Subroutine  ***********/
  698. OpenBusy:
  699.   parse arg OB_BusyTitle, OB_EventCount
  700.  
  701.   OB_ProgressGroup=bguivgroup(,
  702.         bguiinfo('OB_dummy',,'1B'x||'c'OB_BusyTitle)bguilayout(LGO_FixMinHeight,1)||,
  703.         bguiprogress('OB_prog2_',,0,OB_EventCount)||,
  704.         bguihgroup(,
  705.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
  706.                 bguibutton('OB_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
  707.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
  708.         ,,,,'W'),
  709.   ,-2,-2)
  710.  
  711.   OB_ProgressWindow = bguiwindow(PleaseWait$'...',OB_ProgressGroup,,2,,PubScreen)
  712.   if bguiwinopen(OB_ProgressWindow) = 0 then call Cleanup
  713.  
  714.   Progress = 0
  715.  
  716. return OB_ProgressWindow
  717. /**/
  718.  
  719. /***//*******  ParseVariables (PV) Subroutine  ***********/
  720. ParseVariables:
  721.   parse arg PV_Line
  722.  
  723.   PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  724.   PV_VarString = ''
  725.   PV_Var.      = '00'x
  726.   PV_LongVar   = 4
  727.   PV_LIT       = ''
  728.   PV_Count     = 0
  729.  
  730.   do PV_i = 1 to words(PV_String)
  731.     PV_Word = word(PV_String, PV_i)
  732.     if pos(PV_Word'(', PV_Line) > 0 then iterate
  733.     if datatype(PV_Word) == 'CHAR' then do
  734.       if symbol(PV_Word) == 'LIT' then PV_LIT = PV_LIT''PV_Word', '
  735.       if symbol(PV_Word) == 'VAR' then do
  736.         PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
  737.         if PV_Var.PV_Word == '00'x then do
  738.           PV_Count = PV_Count + 1
  739.           PV_Var.PV_Count = PV_Word
  740.           PV_Var.PV_Word  = value(PV_Word)
  741.         end
  742.         if pos('.', PV_Word) > 0 then do
  743.           PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
  744.           do PV_j = 1 to words(PV_CompoundParts)
  745.             PV_Subword = word(PV_CompoundParts, PV_j)
  746.             if PV_Var.PV_SubWord == '00'x then do
  747.               PV_Count = PV_Count + 1
  748.               PV_Var.PV_Count = PV_SubWord
  749.               if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
  750.               else PV_Var.PV_SubWord  = value(PV_SubWord)
  751.             end
  752.           end
  753.         end
  754.       end
  755.     end
  756.   end
  757.  
  758.   do PV_i = 1 to PV_Count
  759.     PV_Word = PV_Var.PV_i
  760.     if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  761.     PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  762.     PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  763.   end
  764.  
  765.   if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
  766.  
  767.   return PV_VarString
  768. /**/
  769.  
  770. /***//*******  PathPart (PP) Subroutine ***********/
  771. PathPart:
  772.   parse arg PP_FileWithPath
  773.   return left(PP_FileWithPath, max(lastpos(':', PP_FileWithPath), lastpos('/', PP_FileWithPath)))
  774. /**/
  775.  
  776. /***//*******  PrintText (PT) Subroutine  ***********/
  777. PrintText:
  778.   parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
  779.  
  780.   if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  781.   else PT_Font = Bold.PT_FontType
  782.  
  783.   if App == 'FW' then do
  784.     if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
  785.     PT_Top = PT_Top + TextAdj * Height.PT_FontType
  786.     TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
  787.     DRAWTEXTBLOCK 1 PT_Left PT_Top PT_Text; PT_id = result
  788.   end
  789.   else if App == 'PGS' then do
  790.     DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
  791.     SELECTTEXT AT PT_Left PT_Top WINDOW winName
  792.     BEGINCOMMANDCAPTURE
  793.       SETLEADING RELATIVE 100
  794.       SETTYPESIZE FSize.PT_FontType WINDOW winName
  795.       SETTYPEWIDTH PT_Width WINDOW winName
  796.       SETFONT PT_Font WINDOW winName
  797.       SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
  798.     ENDCOMMANDCAPTURE
  799.     if pos('"', PT_Text) > 0 then do
  800.       call open('IFile', Storage'Text2Insert.txt', 'W')
  801.         call WriteLn('IFile', PT_Text)
  802.       call close('IFile')
  803.       INSERTTEXT FILE Storage'Text2Insert.txt' FILTER ASCII WINDOW winName
  804.     end
  805.     else INSERT '"'PT_Text'"' WINDOW winName
  806.   end
  807.   return PT_id
  808. /**/
  809.  
  810. /***//*******  ProcessEvent (PE) Subroutine  ***********/
  811. ProcessEvent:
  812.   Day1 = ''
  813.   Day2 = ''
  814.   EnteredLine = 1
  815.   Options = ''
  816.   EnteredEvent = ''
  817.   Box = 0
  818.   Weekly = 0
  819.   WindowRefreshed = 0
  820.   Keywords = '|FONT|SIZE|START|END|LINE|EVENT|OPTIONS|TEXTCOLOR|BOXCOLOR|ENTEREDFONT|ENTEREDSIZE|ENTEREDDAY1|ENTEREDDAY2|ENTEREDLINE|ENTEREDEVENT|'
  821.  
  822.   if EventData == 0 then call CleanUp
  823.   call openv('EventData')
  824.     do until eofv('EventData')
  825.       PE_Ln = readvln('EventData')
  826.       interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
  827.     end
  828.   call closev('EventData')
  829.  
  830.   Event. = ''
  831.   if EventType == Event$ then do
  832.     Event.0   = 1
  833.     Event.1   = EventData
  834.     EventFile = ''
  835.   end
  836.   else do
  837.     EventFile = EnteredEvent
  838.     if EnteredDay1 == '' then EnteredDay1 = 1
  839.     RootDay = ConvertDay(EnteredDay1)
  840.  
  841.     call open('EventFile', EventFile)
  842.       EventCount = 1
  843.       do until eof('EventFile')
  844.         Ln = ReadLn('EventFile')
  845.         if eof('EventFile') == 0 then do
  846.           if (pos('|'upper(word(Ln, 1))'|', Keywords) == 0) & (Ln ~= '') then do
  847.             interpret Ln
  848.             iterate
  849.           end
  850.           if Ln == '' then do
  851.             if Event.1 ~= '' then EventCount = EventCount + 1
  852.             iterate
  853.           end
  854.           Event.EventCount = Event.EventCount''Ln||'0a'x
  855.         end
  856.       end
  857.       Event.0 = EventCount
  858.     call close('EventFile')
  859.   end
  860.  
  861.   if Event.0 > 1 then Req = OpenBusy(ProcessEvents$'...', Event.0)
  862.   if App == 'PGS' then do
  863.     REFRESH OFF ALL
  864.   end
  865.   do EC = 1 to Event.0
  866.     if Req ~= 0 then call UpdateBusy(Req, 1)
  867.     Box    = 0
  868.     Weekly = 0
  869.     EnteredFont = Font.Highlight
  870.     EnteredSize = FSize.Highlight
  871.     EnteredDay1 = ''
  872.     EnteredDay2 = ''
  873.     EnteredLine = ''
  874.     EnteredEvent = ''
  875.     Options = ''
  876.     BoxColor = ''
  877.     TextColor = ''
  878.  
  879.     if Event.EC == '' then iterate
  880.     call openv('Event.EC')
  881.       do until eofv('Event.EC')
  882.         PE_Ln = readvln('Event.EC')
  883.         PE_Variable = upper(strip(word(PE_Ln, 1)))
  884.         select
  885.           when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
  886.           when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
  887.           when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
  888.           when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
  889.           when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
  890.           when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
  891.           when PE_Variable == 'OPTIONS' then nop
  892.           when PE_Variable == 'TEXTCOLOR' then nop
  893.           when PE_Variable == 'BOXCOLOR' then nop
  894.           when PE_Variable == 'ENTEREDFONT' then nop
  895.           when PE_Variable == 'ENTEREDSIZE' then nop
  896.           when PE_Variable == 'ENTEREDDAY1' then nop
  897.           when PE_Variable == 'ENTEREDDAY2' then nop
  898.           when PE_Variable == 'ENTEREDLINE' then nop
  899.           when PE_Variable == 'ENTEREDEVENT' then nop
  900.           otherwise PE_Variable = 'Error'
  901.         end
  902.         if PE_Variable ~= 'Error' then interpret PE_Variable'= strip(subword(PE_Ln, 3))'
  903.       end
  904.     call closev('Event.EC')
  905.     if PE_Variable == 'Error' then do
  906.       call AddMsg('W', 'Line "'PE_Ln'" does not start with a keyword; this event set was skipped.')
  907.       iterate EC
  908.     end
  909.  
  910.     EnteredFont = strip(EnteredFont, 'B', '"'||"'")
  911.     TextColor   = strip(TextColor, 'B', '"'||"'")
  912.     BoxColor    = strip(BoxColor, 'B', '"'||"'")
  913.     Options     = compress(upper(strip(Options, 'B', ' "'||"'")))
  914.  
  915.     if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)
  916.  
  917.     FontInfo = compress(EnteredFont''EnteredSize, '. /:')
  918.     if FontKnown.FontInfo == '' then do
  919.       HighestFont = HighestFont + 1
  920.       FontKnown.FontInfo = HighestFont
  921.       Font.HighestFont = EnteredFont
  922.       FSize.HighestFont = EnteredSize
  923.       Height.HighestFont = GetHeight(HighestFont) * Leading/100
  924.     end
  925.     CurrentFont = FontKnown.FontInfo
  926.  
  927.     If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
  928.     If EnteredLine == '' then EnteredLine = 1
  929.     if BoxColor    == '' then BoxColor = Background.AddEvent
  930.     if TextColor   == '' then TextColor = Color.AddEvent
  931.  
  932.     if EventType = Event$ then do
  933.       EnteredDay1 = ConvertDay(EnteredDay1)
  934.       EnteredDay2 = ConvertDay(EnteredDay2)
  935.     end
  936.     else do
  937.       EnteredDay1 = RootDay + EnteredDay1
  938.       EnteredDay2 = RootDay + EnteredDay2
  939.     end
  940.     If EnteredDay1 > EnteredDay2 then Do
  941.       TempDate = EnteredDay1
  942.       EnteredDay1 = EnteredDay2
  943.       EnteredDay2 = TempDate
  944.     End
  945.  
  946.     if pos('B', Options) ~= 0 then Box = 1
  947.     if pos('W', Options) ~= 0 then Weekly = 1
  948.     if pos('2', Options) ~= 0 then Weekly = 2
  949.  
  950.     /* Process Event */
  951.     if App == 'PGS' then REFRESH OFF ALL
  952.     do until Weekly = 0
  953.       Event = EnteredEvent
  954.       Line  = EnteredLine
  955.       Day1  = EnteredDay1
  956.       Day2  = EnteredDay2
  957.       Text. = ''
  958.  
  959.       if Day1 > MaxDate then do
  960.         Weekly = 0
  961.         iterate
  962.       end
  963.       if Day2 > MaxDate then Day2 = MaxDate
  964.  
  965.       If Day1 ~= Day2 then Box = 1
  966.       LineCount = 0
  967.       Do until Day1 > Day2
  968.         Day1Row = trunc((Day1 + StartDate - 1) / 7)
  969.         Day2Row = trunc((Day2 + StartDate - 1) / 7)
  970.         Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
  971.         Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
  972.         if (Day1Row == 5) & (DoTopExtraWk == 1) then Day1Row = 0
  973.         if (Day2Row == 5) & (DoTopExtraWk == 1) then Day2Row = 0
  974.  
  975.         if Day1Row == Day2Row then DaySpan = Day2Column - Day1Column + 1
  976.         else DaySpan = 7 - Day1Column
  977.         if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
  978.         else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
  979.         else CalDate = Day1
  980.         Select
  981.           when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  982.           when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  983.           otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  984.         end
  985.         HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
  986.         If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
  987.         else do
  988.           if DoTopExtraWk ~= 1 then BoxTop = CalTop + 4.5 * BoxHeight
  989.           else BoxTop = CalTop
  990.         end
  991.  
  992.         LeftEdge = Margin.Left + Day1Column * BoxWidth + DateOffset + HighlightOffset
  993.         if event ~= '' then do
  994.           Textline = 0
  995.           Text.    = ''
  996.           Text.Textline = event
  997.  
  998.           /* Accomodate user line breaks */
  999.           do until LineBreak = 0
  1000.             LineBreak = pos('//', Text.Textline)
  1001.             if LineBreak > 0 then do
  1002.               Nextline = Textline + 1
  1003.               Text.Nextline = substr(Text.Textline, LineBreak + 2)
  1004.               Text.Textline = left(Text.Textline, LineBreak - 1)
  1005.               Textline = Nextline
  1006.             end
  1007.           end
  1008.           Textline = 0
  1009.  
  1010.           /* Fit line(s) into allowable space */
  1011.           do until Text.Nextline == ''
  1012.             Nextline = Textline + 1
  1013.             if Box == 1 | Textline == 0 then Indent.Textline = 0
  1014.             else Indent.Textline = 3 * DateOffset
  1015.             AllowedWidth = DaySpan * BoxWidth - 2 * DateOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
  1016.             AllowedBoxWidth = AllowedWidth + 2 * DateOffset
  1017.             if left(Text.Textline, length(TabSub)) == TabSub then do
  1018.               Indent.Textline = TabFactor * DateOffset
  1019.               Text.Textline = substr(Text.Textline, length(TabSub) + 1)
  1020.             end
  1021.  
  1022.             if App == 'FW' & length(Text.Textline) > 37 then do
  1023.               Wordbreak = lastpos(' ', Text.Textline, 37)
  1024.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1025.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1026.             end
  1027.             ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
  1028.             if App == 'FW' then redraw
  1029.             TextWidth.Textline = GetWidth(ID)
  1030.             if App == 'FW' then DELETEOBJECT ID
  1031.             else if App == 'PGS' then do
  1032.               SELECTOBJECT OBJECTID ID WINDOW winName
  1033.               DELETEOBJECT OBJECTID ID WINDOW winName
  1034.             end
  1035.  
  1036.             NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
  1037.             TextWidth.Textline = TextWidth.Textline * NeededCompression.Textline
  1038.             if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
  1039.               /* Move last word to next line */
  1040.               Wordbreak     = lastpos(' ', Text.Textline)
  1041.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1042.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1043.             end
  1044.             else if Text.Nextline ~= '' then Textline = Textline + 1
  1045.           End
  1046.           LineCount = Textline
  1047.         end
  1048.  
  1049.         if Box then call DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
  1050.         if event ~= '' then
  1051.           do i = 0 to LineCount
  1052.             Text.Top = BoxTop + (Line + i) * Height.Highlight
  1053.             if Box == 0 then Text.Left = LeftEdge + Indent.i
  1054.             else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i) / 2
  1055.             TextWidth = NeededCompression.i * Width.CurrentFont
  1056.             if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)
  1057.             call PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
  1058.           end
  1059.  
  1060.         Day1 = Day1 + DaySpan
  1061.         if Day1 > Day2 then leave
  1062.         else if trunc((Day1 + StartDate - 1) / 7) > 4 & Day2 > MonthLength.Month then Day2 = Day1
  1063.       end
  1064.  
  1065.       if Weekly == 1 then do
  1066.         EnteredDay1 = EnteredDay1 + 7
  1067.         EnteredDay2 = EnteredDay2 + 7
  1068.       end
  1069.       else if Weekly == 2 then do
  1070.         EnteredDay1 = EnteredDay1 + 14
  1071.         EnteredDay2 = EnteredDay2 + 14
  1072.       end
  1073.     end
  1074.  
  1075.     if App == 'FW' then redraw
  1076.     else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  1077.   end
  1078.  
  1079.   if Req ~= 0 then call bguiwinclose(Req)
  1080.  
  1081.   if App == 'PGS' then do
  1082.     REFRESH ON ALL
  1083.     REFRESHWINDOW WINDOW winName
  1084.     WindowRefreshed = 1
  1085.   end
  1086.  
  1087. return
  1088. /**/
  1089.  
  1090. /***//*******  Syntax () Subroutine  ***********/
  1091. Syntax:
  1092.   signal off syntax
  1093.  
  1094.   ErrorLine  = SIGL
  1095.   SourceLine = strip(SourceLine(ErrorLine))
  1096.  
  1097.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  1098.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  1099.   call AddMsg('E', ParseVariables(SourceLine))
  1100.  
  1101.   call Cleanup
  1102.   exit
  1103. /**/
  1104.  
  1105. /***//*******  TranslationStrings () Subroutine  ***********/
  1106. TranslationStrings:
  1107. AddEvent$       = 'Add Event'
  1108. All$            = 'All'
  1109. Backgrounds$    = 'Backgrounds'
  1110. BiOrWeekly$     = '(Bi)Weekly'
  1111. Biweekly$       = 'Biweekly'
  1112. Bottom$         = 'Bottom'
  1113. BoxColor$       = 'Box'
  1114. BoxDates$       = 'Box Dates'
  1115. Boxed$          = '_Boxed'
  1116. Calendar$       = 'Calendar'
  1117. Cancel$         = '_Cancel'
  1118. CantFind$       = "can't be found"
  1119. Center$         = 'Center'
  1120. Clear$          = 'Clear'
  1121. Colors$         = 'Colors'
  1122. Comment$        = 'Comment'
  1123. Critical$       = 'Critical error'
  1124. DailyColors$    = 'Use daily colors'
  1125. DeleteEvent$    = 'Delete Event'
  1126. Done$           = 'Done'
  1127. Easter$         = 'Easter'
  1128. End$            = 'End'
  1129. EnterEvent$     = 'You must enter an event...'
  1130. EnterEventInfo$ = 'Enter event information'
  1131. EnterStartdate$ = 'You must enter a start date...'
  1132. Even$           = 'Even'
  1133. Event$          = 'Event'
  1134. Extended$       = 'Extended'
  1135. File$           = 'File'
  1136. First$          = 'First'
  1137. Fixed$          = 'Fixed'
  1138. Floating$       = 'Floating'
  1139. Font$           = 'Font'
  1140. Fonts$          = 'Fonts'
  1141. ForDetails$     = 'for details'
  1142. ForwardContent$ = 'Forward contents of output to'
  1143. ForwardLog$     = 'Forward log file to'
  1144. Fourth$         = 'Fourth'
  1145. Frequency$      = 'Frequency'
  1146. GeneratingM$    = 'Generating %s %s calendar'
  1147. GeneratingY$    = 'Generating %s calendar'
  1148. GenMVars        = 'Month.Month EnteredYear'
  1149. GenYVars        = 'EnteredYear'
  1150. Highlights$     = 'Highlights'
  1151. Holiday$        = 'Holiday'
  1152. Images$         = 'Images'
  1153. Julian$         = 'Julian'
  1154. JulJulLeft$     = 'Jul/Jul Left'
  1155. JulLeft$        = 'Jul Left'
  1156. Last$           = 'Last'
  1157. Left$           = 'Left'
  1158. Line$           = '_Line'
  1159. Load$           = '_Load'
  1160. MatchColors$    = 'Date Color = Highlight Color'
  1161. MiniCals$       = 'MiniCals'
  1162. MiscVar$        = 'Miscellaneous Variables'
  1163. Monthly$        = '_Monthly'
  1164. MustUse$        = "You must use the gadget to"||'0a'x||"the right to select a font."
  1165. NextDay$        = 'Next day'
  1166. Noncritical$    = 'Noncritical warning'
  1167. None$           = 'None'
  1168. NotClear$       = '<'Clear$'> can only be used for "Background." variables...'
  1169. Note$           = 'Notes'
  1170. NoteBox$        = 'Include note box'
  1171. Notice$         = 'notice'
  1172. Odd$            = 'Odd'
  1173. OK$             = '_OK'
  1174. OK2$            = 'OK'
  1175. Once$           = 'Once'
  1176. Options$        = 'Options'
  1177. OptLayout$      = 'Options & Layout'
  1178. OrientMarg$     = 'Orientation & Margins'
  1179. Phases$         = 'Phases'
  1180. PleaseWait$     = 'Please wait'
  1181. PrepReq$        = 'Preparing requester'
  1182. PreviousDay$    = 'Prev day'
  1183. ProcessEvents$  = 'Processing events'
  1184. Reset$          = '_Reset'
  1185. Right$          = 'Right'
  1186. RiseSet$        = 'Rise/Set'
  1187. Second$         = 'Second'
  1188. See$            = 'see'
  1189. SeeOutput$      = 'see the output above for details'
  1190. SeeShell$       = 'see the shell output for details'
  1191. SelectFile$     = 'Select data file'
  1192. SelectFont$     = 'Select font'
  1193. Start$          = 'Start'
  1194. Sunrise$        = 'Sunrise'
  1195. Sunset$         = 'Sunset'
  1196. Tall$           = 'Tall'
  1197. TextColor$      = 'Text'
  1198. Third$          = 'Third'
  1199. Top$            = 'Top'
  1200. TopLong$        = 'Extra week at top'
  1201. Type$           = 'Type'
  1202. Unable$         = 'if you are unable to resolve the problem.'
  1203. VarGUITitle$    = 'Set desired variables'
  1204. Variables$      = 'Variables'
  1205. Weekend$        = 'Weekend'
  1206. Weekly$         = 'Weekly'
  1207. WeekNumber$     = 'Week Number'
  1208. WeekType$       = 'Week Type'
  1209. WholeYear$      = 'Whole _Year'
  1210. Wide$           = 'Wide'
  1211.  
  1212. January$   = 'January'
  1213. February$  = 'February'
  1214. March$     = 'March'
  1215. April$     = 'April'
  1216. May$       = 'May'
  1217. June$      = 'June'
  1218. July$      = 'July'
  1219. August$    = 'August'
  1220. September$ = 'September'
  1221. October$   = 'October'
  1222. November$  = 'November'
  1223. December$  = 'December'
  1224.  
  1225. Sunday$    = 'Sunday'
  1226. Monday$    = 'Monday'
  1227. Tuesday$   = 'Tuesday'
  1228. Wednesday$ = 'Wednesday'
  1229. Thursday$  = 'Thursday'
  1230. Friday$    = 'Friday'
  1231. Saturday$  = 'Saturday'
  1232. return 0
  1233. /**/
  1234.  
  1235. /***//*******  UpdateBusy (UB) Subroutine  ***********/
  1236. UpdateBusy:
  1237.   parse arg UB_ReqWin, UB_ProgressMade
  1238.  
  1239.   if Req ~= 0 then do
  1240.     Progress = Progress + UB_ProgressMade
  1241.  
  1242.     call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
  1243.     if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup
  1244.   end
  1245.  
  1246.   return
  1247. /**/
  1248.  
  1249. /***//*******  VIO Routines () Subroutine  ***********/
  1250. /***//** OpenV() **/
  1251. OpenV:
  1252.   parse arg VIO_Variable
  1253.  
  1254.   if Open.VIO_Variable ~= 1 then do
  1255.     Open.VIO_Variable = 1
  1256.     Pointer.VIO_Variable = 1
  1257.     EOF.VIO_Variable = 0
  1258.     return 1
  1259.   end
  1260.   else return 0
  1261. /**/
  1262.  
  1263. /***//** CloseV() **/
  1264. CloseV:
  1265.   parse arg VIO_Variable
  1266.  
  1267.   If Open.VIO_Variable == 0 then return 0
  1268.   Open.VIO_Variable = 0
  1269.   return 1
  1270. /**/
  1271.  
  1272. /***//** SeekV() **/
  1273. SeekV:
  1274.   parse arg VIO_Variable, VIO_Offset, VIO_Anchor
  1275.  
  1276.   if Open.VIO_Variable == 1 then do
  1277.     VIO_Anchor = upper(left(VIO_Anchor, 1))
  1278.  
  1279.     VIO_Value = Value(VIO_Variable)
  1280.     select
  1281.       when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
  1282.       when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
  1283.       otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
  1284.     end
  1285.  
  1286.     if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
  1287.     return Pointer.VIO_Variable
  1288.   end
  1289.   else return 0
  1290. /**/
  1291.  
  1292. /***//** ReadVCh() **/
  1293. ReadVCh:
  1294.   parse arg VIO_Variable, VIO_Length
  1295.  
  1296.   if VIO_Length == '' then VIO_Length = 1
  1297.  
  1298.   if Open.VIO_Variable == 1 then do
  1299.     if EOF.VIO_Variable == 0 then do
  1300.       VIO_Value = Value(VIO_Variable)
  1301.       VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
  1302.       Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
  1303.       if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
  1304.       else EOF.VIO_Variable = 0
  1305.     end
  1306.     else VIO_Ret = ''
  1307.   end
  1308.   else VIO_Ret = ''
  1309.  
  1310.   return VIO_Ret
  1311. /**/
  1312.  
  1313. /***//** ReadVLn(RV) **/
  1314. ReadVLn:
  1315.   parse arg VIO_Variable, VIO_Count, VIO_SepChar
  1316.  
  1317.   if VIO_Count == '' then VIO_Count = 1
  1318.   if VIO_SepChar == '' then VIO_SepChar = '0a'x
  1319.  
  1320.   if Open.VIO_Variable == 1 then do
  1321.     VIO_Value = Value(VIO_Variable)
  1322.     VIO_Ret   = ''
  1323.     do VIO_i = 1 to VIO_Count
  1324.       VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
  1325.       if VIO_LF > 0 then do
  1326.         VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
  1327.         Pointer.VIO_Variable = VIO_LF + 1
  1328.         if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
  1329.         else EOF.VIO_Variable = 0
  1330.       end
  1331.       else do
  1332.         if Pointer.VIO_Variable < length(VIO_Value) then do
  1333.           VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
  1334.           Pointer.VIO_Variable = length(VIO_Value) + 1
  1335.           EOF.VIO_Variable = 1
  1336.         end
  1337.       end
  1338.       if EOF.VIO_Variable == 1 then leave
  1339.       if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
  1340.     end
  1341.   end
  1342.   else VIO_Ret = ''
  1343.  
  1344.   return VIO_Ret
  1345. /**/
  1346.  
  1347. /***//** WriteVCh() **/
  1348. WriteVCh:
  1349.   parse arg VIO_Variable, VIO_String, VIO_Option
  1350.  
  1351.   VIO_Value  = Value(VIO_Variable)
  1352.   VIO_Option = upper(left(VIO_Option, 1))
  1353.   VIO_Length = length(VIO_Value)
  1354.   if VIO_Option == 'C' then do
  1355.     VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
  1356.     Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  1357.   end
  1358.   else if VIO_Option == 'B' then do
  1359.     VIO_Value = VIO_String''VIO_Value
  1360.     Pointer.VIO_Variable = length(VIO_String) + 1
  1361.   end
  1362.   else do
  1363.     VIO_Value = VIO_Value''VIO_String
  1364.     Pointer.VIO_Variable = length(VIO_Value)
  1365.   end
  1366.   interpret VIO_Variable'= VIO_Value'
  1367.   if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  1368.   else VIO_Ret = 0
  1369.  
  1370.   return VIO_Ret
  1371. /**/
  1372.  
  1373. /***//** WriteVLn() **/
  1374. WriteVLn:
  1375.   parse arg VIO_Variable, VIO_String, VIO_Option
  1376.  
  1377.   return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
  1378. /**/
  1379.  
  1380. /***//** EOFV() **/
  1381. EOFV:
  1382.   parse arg VIO_Variable
  1383.  
  1384.   if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  1385.   else return 1
  1386. /**/
  1387. /**/
  1388.  
  1389. /***//*******  SetVariables Subroutine  ***********/
  1390. SetVariables:
  1391.  
  1392. /***//* Initialize Variables */
  1393.   AddEventRows    = 9
  1394.   ChangesFile     = 'FWC.dat'
  1395.   DataFile        = ''
  1396.   Date            = 0
  1397.   DoShanghai      = 1
  1398.   esc             = "1B"x
  1399.   EventFile       = ''
  1400.   EventKey        = 'E'
  1401.   FontKnown.      = ''
  1402.   FSize.          = 10
  1403.   HighestFont     = 5
  1404.   Highlight       = 5
  1405.   Leading         = 100
  1406.   MinWidth        = 80
  1407.   PatVar          = '#?.data'
  1408.   PrefsFile       = ''
  1409.   Req             = 0
  1410.   StartWeek       = 0
  1411.   Storage         = 'RAM:FWC/'
  1412.   TabFactor       = 3
  1413.   TabSub          = '/~'
  1414.   Width.          = 100
  1415.  
  1416.   if App == 'FW' then DefaultFont = "SoftSans"
  1417.   else if App == 'PGS' then DefaultFont = 'PageStream-Normal'
  1418.  
  1419.   TextAdj         = 0.77
  1420.   WTextArea       = 0.20  /* fraction of print height used for top of calendar (Wide) */
  1421.   TTextArea       = 0.15  /* fraction of print height used for top of calendar (Tall) */
  1422.   DateOffset      = 0.02  /* fraction of box width to offset dates from edge of box   */
  1423.  
  1424.   D.0 = 'Sunday'
  1425.   D.1 = 'Monday'
  1426.   D.2 = 'Tuesday'
  1427.   D.3 = 'Wednesday'
  1428.   D.4 = 'Thursday'
  1429.   D.5 = 'Friday'
  1430.   D.6 = 'Saturday'
  1431.  
  1432.   MonthLength.1    = 31
  1433.   MonthLength.2    = 28
  1434.   MonthLength.3    = 31
  1435.   MonthLength.4    = 30
  1436.   MonthLength.5    = 31
  1437.   MonthLength.6    = 30
  1438.   MonthLength.7    = 31
  1439.   MonthLength.8    = 31
  1440.   MonthLength.9    = 30
  1441.   MonthLength.10   = 31
  1442.   MonthLength.11   = 30
  1443.   MonthLength.12   = 31
  1444.  
  1445.   call TranslationStrings
  1446.  
  1447.   if open('TranslationFile', ScriptDir'FWCTranslations.txt') then do
  1448.     SV_TranslationFile = readch('TranslationFile', 65535)
  1449.     call close('TranslationFile')
  1450.     call openv('SV_TranslationFile')
  1451.     do until eofv('SV_TranslationFile')
  1452.       interpret readvln('SV_TranslationFile')
  1453.     end
  1454.     call closev('SV_TranslationFile')
  1455.   end
  1456.  
  1457.   Month.1  = January$
  1458.   Month.2  = February$
  1459.   Month.3  = March$
  1460.   Month.4  = April$
  1461.   Month.5  = May$
  1462.   Month.6  = June$
  1463.   Month.7  = July$
  1464.   Month.8  = August$
  1465.   Month.9  = September$
  1466.   Month.10 = October$
  1467.   Month.11 = November$
  1468.   Month.12 = December$
  1469. /**/
  1470.  
  1471.   ProcessNow = 'DoShanghai Storage PrefsFile'
  1472.  
  1473.   if exists(ScriptDir''ChangesFile) then do
  1474.     call open('DataFile', ScriptDir''ChangesFile)
  1475.       do until eof('DataFile')
  1476.         Ln = ReadLn('DataFile')
  1477.         if pos(upper(word(Ln, 1)), upper(ProcessNow)) ~= 0 then interpret Ln
  1478.         else if right(word(Ln, 1), 1) == '$' then interpret Ln
  1479.         else if pos('End Pass One', Ln) > 0 then leave
  1480.       end
  1481.     call close('DataFile')
  1482.   end
  1483.  
  1484.   if (PrefsFile ~= '') & (exists(PrefsFile)) then do
  1485.     if open('DataFile', PrefsFile) then do
  1486.       do until eof('DataFile')
  1487.         Ln = ReadLn('DataFile')
  1488.         Var = upper(word(Ln, 1))
  1489.         if right(Var, 1) == '$' then interpret Ln
  1490.         else if pos('/* End Pass One', Ln) > 0 then leave
  1491.       end
  1492.       call close('DataFile')
  1493.     end
  1494.     Month.1  = January$
  1495.     Month.2  = February$
  1496.     Month.3  = March$
  1497.     Month.4  = April$
  1498.     Month.5  = May$
  1499.     Month.6  = June$
  1500.     Month.7  = July$
  1501.     Month.8  = August$
  1502.     Month.9  = September$
  1503.     Month.10 = October$
  1504.     Month.11 = November$
  1505.     Month.12 = December$
  1506.   end
  1507.  
  1508.   call makedir(left(Storage, length(Storage) - 1))
  1509.   call GetLogInfo
  1510.  
  1511.   if App == 'FW' then do
  1512.     call open('FWPrefs', CurrentDir'FWFiles/FW.Prefs')
  1513.       FWPrefs = readch('FWPrefs', 65535)
  1514.     call close('FWPrefs')
  1515.     ColorTable = pos('SWCL', FWPrefs) + 12
  1516.     EndTable = pos('STUP', FWPrefs)
  1517.     ColorCount = 0
  1518.     Do CTPos = ColorTable to EndTable by 20
  1519.       ColorRegister = c2x(substr(FWPrefs, CTPos - 3, 3))
  1520.       ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
  1521.       if ColorRegister = '000000' then Black$ = ColorList.ColorCount
  1522.       if ColorRegister = 'FFFFFF' then White$ = ColorList.ColorCount
  1523.       ColorCount = ColorCount + 1
  1524.     end
  1525.     ColorList.ColorCount = '<'Clear$'>'
  1526.     ColorCount = ColorCount + 1
  1527.     ColorList.COUNT = ColorCount
  1528.     if symbol('Black$') == 'LIT' then do
  1529.       call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
  1530.       Black$ = ColorList.0
  1531.     end
  1532.     if symbol('White$') == 'LIT' then do
  1533.       call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
  1534.       White$ = ColorList.1
  1535.     end
  1536.   end
  1537.   else if App == 'PGS' then do
  1538.     GETFONTLIST FontList
  1539.     FontList.COUNT = result
  1540.  
  1541.     call open('PGSColors', CurrentDir''word(PgmVersion, 1)'.colors')
  1542.       PGSColors = readch('PGSColors', 65535)
  1543.     call close('PGSColors')
  1544.     ColorCount = 0
  1545.     StartTag = pos('TG'||'00'x, PGSColors)
  1546.     do while StartTag ~= 0
  1547.       Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
  1548.       AccentMarker = pos(d2c(129), Color)
  1549.       do while AccentMarker > 0
  1550.         Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
  1551.         AccentMarker = pos(d2c(129), Color)
  1552.       end
  1553.       ColorList.ColorCount = Color
  1554.       ColorCount = ColorCount + 1
  1555.       StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
  1556.     end
  1557.     ColorList.ColorCount = '<'Clear$'>'
  1558.     ColorCount = ColorCount + 1
  1559.     ColorList.COUNT = ColorCount
  1560.     White$ = ColorList.0
  1561.     Black$ = ColorList.1
  1562.   end
  1563.   TextColorList.Count = ColorList.COUNT - 1
  1564.   do i = 0 to TextColorList.Count - 1
  1565.     TextColorList.i = ColorList.i
  1566.   end
  1567.  
  1568.   Color.          = Black$
  1569.   Line.           = Black$
  1570.   Background.     = White$
  1571.  
  1572.   AppScreen = ''
  1573.   DefPubScreen = ''
  1574.   if RexxTricks == 1 then do
  1575.     if (pubscreenlist('ScreenList') > 0) then do
  1576.       do i = 1 to ScreenList.0
  1577.         if pos(AppName, upper(ScreenList.i)) > 0 then do
  1578.           AppScreen = ScreenList.i
  1579.           leave
  1580.         end
  1581.       end
  1582.     end
  1583.   end
  1584.  
  1585.  
  1586.   /**** Read user variables ****/
  1587.   if App == 'FW' then do
  1588.     FIRSTOBJECT; TempDateID = result
  1589.     do forever
  1590.       if TempDateID == 0 then do
  1591.         call AddMsg('E', 'Unable to find FWC date string.')
  1592.         call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1593.         call Cleanup
  1594.       end
  1595.       GETOBJECTTYPE TempDateID; ObjectType = result
  1596.       if ObjectType == 7 then do
  1597.         GETTEXTBLOCKTEXT TempDateID; TempDate = result
  1598.         if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
  1599.       end
  1600.       NEXTOBJECT TempDateID; TempDateID = result
  1601.     end
  1602.     do while right(TempDate, 1) == '|'
  1603.       StartObj = pos('|', TempDate)
  1604.       NextObj = strip(substr(TempDate, StartObj), 'B', '|')
  1605.       GETTEXTBLOCKTEXT NextObj; TempDate = left(TempDate, StartObj - 1)''result
  1606.     end
  1607.     PrefsFile = substr(TempDate, 12)
  1608.     TempDate = substr(TempDate, 4, 8)
  1609.   end
  1610.   else if App = 'PGS' then do
  1611.     CURRENTWINDOW; winName = '"'RESULT'"'
  1612.     SELECTTEXT at 0 0 WINDOW winName
  1613.     SELECTTEXT ALL WINDOW winName
  1614.     EXPORTTEXT AMIGA FILE Storage"TempDate.txt" FILTER "ASCII" STATUS FORCE
  1615.     if exists(Storage"TempDate.txt") then do
  1616.       open(TDFile, Storage"TempDate.txt")
  1617.         TempDate = ReadLn(TDFile)
  1618.       close(TDFile)
  1619.     end
  1620.     if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
  1621.       call AddMsg('E', 'Unable to find FWC date string.')
  1622.       call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1623.       call Cleanup
  1624.     end
  1625.     else do
  1626.       PrefsFile = substr(TempDate, 12)
  1627.       TempDate = substr(TempDate, 4, 8)
  1628.     end
  1629.   end
  1630.   if PrefsFile == '' then do
  1631.     if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
  1632.     else PrefsFile = 'Default'
  1633.   end
  1634.  
  1635.   call open('Temp', FullCallPath)
  1636.     FileOffset = 40000
  1637.     call seek('Temp', FileOffset, 'B')
  1638.     do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  1639.       PrevOffset = FileOffset
  1640.       Chunk = readch('Temp', 65535)
  1641.       EndPos = pos('VarList:'||'0a'x, Chunk)
  1642.       if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
  1643.     end
  1644.     call seek('Temp', FileOffset + EndPos + 8, 'B')
  1645.     DefaultVariables = readch('Temp', 65535)
  1646.   call close('Temp')
  1647.   call openv('DefaultVariables')
  1648.     do forever
  1649.       CD_VarLine = strip(readvln('DefaultVariables'))
  1650.       if CD_VarLine == 'return' then leave
  1651.       if CD_VarLine == '' then iterate
  1652.       interpret CD_VarLine
  1653.     end
  1654.   call closev('DefaultVariables')
  1655.  
  1656.   if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
  1657.     if open('UserFile', PrefsFile) then do
  1658.       UserFile = readch('UserFile', 65535)
  1659.       call close('UserFile')
  1660.       call openv('UserFile')
  1661.         do until eofv('UserFile')
  1662.           CD_VarLine = strip(ReadvLn('UserFile'))
  1663.           CD_VarName = upper(strip(word(CD_VarLine, 1)))
  1664.           if left(CD_VarLine, 15) == '/* End Pass One' then leave
  1665.           if (left(CD_VarLine, 2) == '/*') |,
  1666.              (CD_VarName == 'DOSHANGHAI') |,
  1667.              (CD_VarLine == '') |,
  1668.              (upper(left(CD_VarLine, 11)) == 'IMAGECLASS.') then iterate
  1669.           else interpret CD_VarLine
  1670.         end
  1671.       call closev('UserFile')
  1672.     end
  1673.   end
  1674.   drop Orientation
  1675.  
  1676.   if RexxTricks == 1 then do
  1677.     if DoShanghai ~= 0 then PubScreen = AppScreen
  1678.     else PubScreen = DefPubScreen
  1679.   end
  1680.  
  1681.   Type.0    = Event$
  1682.   Type.1    = File$
  1683.   FSize.4pt = 4
  1684.  
  1685.   do i = 0 to 6
  1686.     val = i - StartWeek
  1687.     if val < 0 then val = 7 + val
  1688.     interpret 'Day.'D.i '=' val
  1689.     interpret 'Day.val = 'D.i'$'
  1690.   end
  1691.  
  1692.   Month.1  = January$
  1693.   Month.2  = February$
  1694.   Month.3  = March$
  1695.   Month.4  = April$
  1696.   Month.5  = May$
  1697.   Month.6  = June$
  1698.   Month.7  = July$
  1699.   Month.8  = August$
  1700.   Month.9  = September$
  1701.   Month.10 = October$
  1702.   Month.11 = November$
  1703.   Month.12 = December$
  1704.  
  1705.   do i = 1 to 12
  1706.     AbbrMonth.i  = left(Month.i, 3)
  1707.   end
  1708.  
  1709.   if App == 'FW' then do
  1710.     TextBase = TextAdj
  1711.     do i = 0 to 5 by 5
  1712.       if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
  1713.       if ~exists(Font.i) then do
  1714.         call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
  1715.         Font.i = DefaultFont
  1716.       end
  1717.     end
  1718.     GETPAGESETUP ORIENT; FWC_Orientation = result
  1719.     if FWC_Orientation == 'Wide' then TextArea = WTextArea
  1720.     else TextArea = TTextArea
  1721.  
  1722.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  1723.     DISPLAYPREFS Measure Inches
  1724.     GETSECTIONSETUP Top Bottom Inside Outside
  1725.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  1726.  
  1727.     GETPAGESETUP Width Height
  1728.     parse var result FullWidth FullHeight
  1729.  
  1730.     TextBlockPrefs TEXTFLOW None
  1731.   end
  1732.   else if App = 'PGS' then do
  1733.     TextBase = 1
  1734.     GETFONTLIST FontNames
  1735.     FontNames.COUNT = result
  1736.     do i = 0 to 5 by 5
  1737.       do j = 0 to FontNames.COUNT - 1
  1738.         if upper(Font.i) == upper(FontNames.j) then leave
  1739.       end
  1740.       if j == FontNames.COUNT then do
  1741.         call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
  1742.         Font.i = DefaultFont
  1743.       end
  1744.     end
  1745.     GETMASTERPAGES MPage; PageName = MPage.0
  1746.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  1747.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  1748.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  1749.     GETMARGINGUIDES temp
  1750.     Margin.Left   = temp.inside
  1751.     Margin.Right  = temp.outside
  1752.     Margin.Top    = temp.top
  1753.     Margin.Bottom = temp.bottom
  1754.  
  1755.     GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
  1756.     if layout.orientation == 'LANDSCAPE' then do
  1757.       TextArea   = WTextArea
  1758.       FullWidth  = layout.height
  1759.       FullHeight = layout.width
  1760.     end
  1761.     else do
  1762.       TextArea   = TTextArea
  1763.       FullWidth  = layout.width
  1764.       FullHeight = layout.height
  1765.     end
  1766.   end
  1767.  
  1768.   PrintWidth       = FullWidth - Margin.Left - Margin.Right
  1769.   PrintHeight      = FullHeight - Margin.Top - Margin.Bottom
  1770.  
  1771.   if App == 'FW' then do
  1772.     GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  1773.   end
  1774.   else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  1775.   if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
  1776.       PrintHeight = PrintHeight - Height.4pt
  1777.  
  1778.   BoxWidth         = PrintWidth/7
  1779.   CalRight         = Margin.Left + BoxWidth * 7
  1780.   TextArea         = TextArea * PrintHeight
  1781.   CalTop           = TextArea + Margin.Top
  1782.   BoxHeight        = (PrintHeight - TextArea)/5
  1783.   DateOffset       = DateOffset * BoxWidth
  1784.   FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  1785.   Width.Date       = Width.Date * StretchDateW / StretchDateH
  1786.   FSize.Highlight  = BoxHeight/AddEventRows * 72
  1787.   if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  1788.   if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  1789.   Height.Highlight = GetHeight(Highlight) * Leading/100
  1790.   Height.Date      = GetHeight(Date) * Leading/100
  1791.  
  1792.   FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  1793.   FontKnown.FontInfo = Highlight
  1794.  
  1795.   RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  1796.   Width.WidthOfDate1 = GetFontWidth(Date, '1')
  1797.   Width.WidthOfDate8 = GetFontWidth(Date, '8')
  1798.   VariablesSet = 1
  1799. return
  1800. /**/
  1801.  
  1802. /***//*******  VarList () Subroutine  ***********/
  1803. ReturnVarListLoc:
  1804.   return SIGL + 2
  1805. VarListLoc:
  1806.   /* WTextArea      = fraction of print height used for top of calendar (Wide) */
  1807.   /* TTextArea      = fraction of print height used for top of calendar (Tall) */
  1808.   /* DateOffset     = fraction of box width to offset dates from edge of box   */
  1809.   /* MiniCalHeight  = fraction of text area height used for minicals           */
  1810.   /* MiniCalWidth   = width-to-height ratio for minicals                       */
  1811.   /* MiniCalSpacing = fraction of print width placed between FY minicals       */
  1812.   signal ReturnVarListLoc
  1813. VarList:
  1814.   AddEventRows          = 9
  1815.   AdjustDST             = 1
  1816.   AltColor.Date         = Black$
  1817.   AltColor.Extended     = Black$
  1818.   AltColor.Highlight    = Black$
  1819.   AltColor.HighlightH   = Black$
  1820.   AltColor.Julian       = Black$
  1821.   AltColor.Sunrise      = Black$
  1822.   AltColor.Sunset       = Black$
  1823.   AltColor.WeekNumber   = Black$
  1824.   Background.AddEvent   = White$
  1825.   Background.Highlight  = White$
  1826.   Background.HighlightH = White$
  1827.   Background.MiniCal    = White$
  1828.   Background.Weekend    = White$
  1829.   BelzierFactor         = .55
  1830.   Bold.FYMiniCal        = DefaultBold
  1831.   Bold.MiniCal          = DefaultBold
  1832.   CenterMiniDates       = 1
  1833.   Clear$                = 'Clear'
  1834.   Color.AddEvent        = Black$
  1835.   Color.Date            = Black$
  1836.   Color.Extended        = Black$
  1837.   Color.Friday          = Black$
  1838.   Color.Header          = Black$
  1839.   Color.Highlight       = Black$
  1840.   Color.HighlightH      = Black$
  1841.   Color.Julian          = Black$
  1842.   Color.MiniCal         = Black$
  1843.   Color.Monday          = Black$
  1844.   Color.Moon            = Black$
  1845.   Color.Saturday        = Black$
  1846.   Color.Sunday          = Black$
  1847.   Color.Sunrise         = Black$
  1848.   Color.Sunset          = Black$
  1849.   Color.Thursday        = Black$
  1850.   Color.Tuesday         = Black$
  1851.   Color.Wednesday       = Black$
  1852.   Color.Weekday         = Black$
  1853.   Color.WeekNumber      = Black$
  1854.   DateOffset            = 0.02
  1855.   DoBackgrounds         = 0
  1856.   DoDailyColors         = 0
  1857.   DoDateBox             = 0
  1858.   DoEaster              = 1
  1859.   DoExtended            = 1
  1860.   DoHighlights          = 0
  1861.   DoImages              = 0
  1862.   DoJulian              = 0
  1863.   DoJulianLeft          = 0
  1864.   DoMatchColors         = 0
  1865.   DoMiniCals            = 1
  1866.   DoPhases              = 0
  1867.   DoSunRise             = 0
  1868.   DoSunSet              = 0
  1869.   DoTopExtraWk          = 0
  1870.   DoWeekNumber          = 0
  1871.   FinalView             = 75
  1872.   Font.Date             = DefaultFont
  1873.   Font.Extras           = DefaultFont
  1874.   Font.FYMiniCal        = DefaultFont
  1875.   Font.Header           = DefaultFont
  1876.   Font.Highlight        = DefaultFont
  1877.   Font.MiniCal          = DefaultFont
  1878.   Font.Weekday          = DefaultFont
  1879.   GfxAppPath            = ''
  1880.   HeaderLoc             = 2
  1881.   HighlightRows         = 9
  1882.   LaunchM               = ''
  1883.   LaunchY               = ''
  1884.   Leading               = 100
  1885.   Line.AddEvent         = Black$
  1886.   Line.Extended         = Black$
  1887.   Line.Grid             = Black$
  1888.   Line.MiniCal          = Black$
  1889.   MagnifyExtras         = 1
  1890.   Margin.Bottom         = 0
  1891.   Margin.Left           = 0
  1892.   Margin.Right          = 0
  1893.   Margin.Top            = 0
  1894.   MaxImgHeight          = .75
  1895.   MaxImgWidth           = .75
  1896.   MiniCalHeight         = 0.60
  1897.   MiniCalSpacing        = 0.05
  1898.   MiniCalWidth          = 2
  1899.   MinWidth              = 80
  1900.   MoonRadius            = .075
  1901.   Orientation           = 'Wide'
  1902.   ShiftLMini            = 0
  1903.   ShiftRMini            = 0
  1904.   StartWeek             = 0
  1905.   StretchDateH          = 1
  1906.   StretchDateW          = 1
  1907.   SunCalcPath           = ''
  1908.   Text.Julian           = ''
  1909.   Text.Sunrise          = ''
  1910.   Text.Sunset           = ''
  1911.   Text.WeekNumber       = ''
  1912.   Width.Date            = 100
  1913. return
  1914. /**/
  1915.  
  1916.