home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 6 / AACD06.ISO / AACD / Utilities / FWCalendar / FWCAddEvent.rexx < prev    next >
OS/2 REXX Batch file  |  2000-01-11  |  62KB  |  1,836 lines
  1. /*
  2.     AddEvent.rexx Macro
  3.     Adds events to calendars created by FWCalendar.rexx
  4.     $VER: FWCAddEvent.rexx v3.74 (11 Jan 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$,,AppScreen)
  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$,,AppScreen)
  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.  
  294.   GE_StartOrEnd   = 1
  295.   GE_StartDate    = ""
  296.   GE_EndDate      = ""
  297.   GE_Boxed.0      = ""
  298.   GE_Boxed.128    = "B"
  299.   GE_Weekly.0     = ""
  300.   GE_Weekly.128   = "W"
  301.   GadID.          = ''
  302.   GE_Arg.         = ''
  303.   GE_i            = 0
  304.   GE_Day          = 0
  305.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  306.   GE_NextDay      = 0
  307.  
  308.   Req = OpenBusy(PrepReq$'...', 45)
  309.   do while (GE_i < 6)
  310.     GE_j = 0
  311.     do while (GE_j < 7)
  312.       call UpdateBusy(Req, 1)
  313.       GE_SerialPosition = (GE_i * 7) + GE_j
  314.       GE_Button = GE_SerialPosition + 1
  315.       if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
  316.         GE_Day = GE_Day + 1
  317.         interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
  318.         GadID = GetID(GE_Button'_')
  319.         GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
  320.       end
  321.       else do
  322.         if GE_SerialPosition < StartDate then Do
  323.           GE_PrevDay = GE_PrevDay + 1
  324.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
  325.           GadID = GetID(GE_Button'_')
  326.           GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
  327.         end
  328.         else do
  329.           GE_NextDay = GE_NextDay + 1
  330.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
  331.           GadID = GetID(GE_Button'_')
  332.           GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
  333.         end
  334.       end
  335.       GE_j = GE_j + 1
  336.     end
  337.     GE_i = GE_i + 1
  338.     if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  339.   end
  340.  
  341.   DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
  342.                 bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
  343.                 bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
  344.                 bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  345.   if GE_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  346.   if GE_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)
  347.  
  348.   g=bguivgroup(,
  349.     bguihgroup(,
  350.       bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  351.       bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1),
  352.     )||,
  353.     bguihgroup(,
  354.       bguistring('fontvalue_',Font$,FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
  355.       bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
  356.       bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  357.       bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
  358.     )||,
  359.     bguihgroup(,
  360.       bguivgroup(,
  361.         bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
  362.         bguihgroup(,
  363.           bguiinfo("dummy_",,esc"c"left(Day.0,1))||,
  364.           bguiinfo("dummy_",,esc"c"left(Day.1,1))||,
  365.           bguiinfo("dummy_",,esc"c"left(Day.2,1))||,
  366.           bguiinfo("dummy_",,esc"c"left(Day.3,1))||,
  367.           bguiinfo("dummy_",,esc"c"left(Day.4,1))||,
  368.           bguiinfo("dummy_",,esc"c"left(Day.5,1))||,
  369.           bguiinfo("dummy_",,esc"c"left(Day.6,1)),
  370.         )||,
  371.         DateButtons,
  372.       )||,
  373.       bguivgroup(,
  374.         bguiinfo("startchoice_",esc"r"Start$,"")bguilayout(LGO_FixMinHeight, 1)||,
  375.         bguiinfo("endchoice_",esc"r"End$,"")bguilayout(LGO_FixMinHeight, 1)||,
  376.         bguicycle('textcolor_',esc"r"TextColor$,'TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  377.         bguicycle("linechoice_",esc"r"Line$,"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  378.         bguicheckbox("boxchoice_",esc"r"Boxed$,0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  379.         bguicycle('boxcolor_',esc"r"BoxColor$,'ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  380.         bguicheckbox("weeklychoice_",esc"r"Weekly$,0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  381.         bguihgroup(,
  382.           bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
  383.           bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1),
  384.         ),
  385.       ),
  386.     ),
  387.   ,"-1","-1")
  388.  
  389.   call UpdateBusy(Req, 1)
  390.   GE_winID=bguiwindow(EnterEventInfo$,g,5,0,,AppScreen)
  391.   call UpdateBusy(Req, 1)
  392.  
  393.   if App == 'PGS' then do
  394.     FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
  395.     call UpdateBusy(Req, 1)
  396.     FontwinID=bguiwindow(SelectFont$,FontGroup,20,50,,AppScreen)
  397.   end
  398.  
  399.   call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  400.   call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  401.   call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  402.   call bguiset(obj.event_,,BT_Key,EventKey)
  403.   call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)
  404.  
  405.   if bguiwinopen(GE_winID)=0 then bguierror(12)
  406.  
  407.   if Req ~= 0 then call bguiwinclose(Req)
  408.   Req = 0
  409.  
  410.   id=0
  411.   do while 1
  412.     call bguiwinwaitevent(GE_winID,"ID")
  413.     select
  414.       when (id == id.cancel_) | (id == id.winclose) then call Cleanup
  415.       when id == id.winactive then nop
  416.       when id == id.wininactive then nop
  417.       when id == id.event_ then nop
  418.       when id == id.linechoice_ then nop
  419.       when id == id.boxchoice_ then nop
  420.       when id == id.textcolor_ then nop
  421.       when id == id.boxcolor_ then nop
  422.       when id == id.weeklychoice_ then nop
  423.       when id == id.reset_ then do
  424.         FontName = Font.Highlight
  425.         FontSize = FSize.Highlight
  426.         call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
  427.         call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
  428.       end
  429.       when id == id.fontvalue_ then do
  430.         call bguiwinbusy(GE_winID)
  431.         call bguireq('1b'x||"c"MustUse$,"*"OK$,'',,AppScreen)
  432.         call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
  433.         call bguiwinready(GE_winID)
  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.         if GE_StartDate = "" then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,,AppScreen)
  461.         else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,,AppScreen)
  462.         else do
  463.           GE_WeeklyValue  = bguiget(obj.weeklychoice_, GA_Selected)
  464.           GE_EventType = bguiget(obj.eventtype_, 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$,,AppScreen)
  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,,AppScreen)
  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.  
  821.   if EventData == 0 then call CleanUp
  822.   call openv('EventData')
  823.     do until eofv('EventData')
  824.       PE_Ln = readvln('EventData')
  825.       interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
  826.     end
  827.   call closev('EventData')
  828.  
  829.   Event. = ''
  830.   if EventType == Event$ then do
  831.     Event.0   = 1
  832.     Event.1   = EventData
  833.     EventFile = ''
  834.   end
  835.   else do
  836.     EventFile = EnteredEvent
  837.     RootDay = ConvertDay(EnteredDay1)
  838.  
  839.     call open('EventFile', EventFile)
  840.       EventCount = 1
  841.       do until eof('EventFile')
  842.         Ln = ReadLn('EventFile')
  843.         if eof('EventFile') == 0 then do
  844.           if left(strip(Ln), 2) == '/*' then iterate
  845.           if Ln == '' then do
  846.             EventCount = EventCount + 1
  847.             iterate
  848.           end
  849.           Event.EventCount = Event.EventCount''Ln||'0a'x
  850.         end
  851.       end
  852.       Event.0 = EventCount
  853.     call close('EventFile')
  854.   end
  855.  
  856.   if Event.0 > 1 then Req = OpenBusy(ProcessEvents$'...', Event.0)
  857.   if App == 'PGS' then do
  858.     REFRESH OFF ALL
  859.   end
  860.   do EC = 1 to Event.0
  861.     if Req ~= 0 then call UpdateBusy(Req, 1)
  862.     Box    = 0
  863.     Weekly = 0
  864.     EnteredFont = Font.Highlight
  865.     EnteredSize = FSize.Highlight
  866.     EnteredDay1 = ''
  867.     EnteredDay2 = ''
  868.     EnteredLine = ''
  869.     EnteredEvent = ''
  870.     Options = ''
  871.     BoxColor = ''
  872.     TextColor = ''
  873.  
  874.     if Event.EC == '' then iterate
  875.     call openv('Event.EC')
  876.       do until eofv('Event.EC')
  877.         PE_Ln = readvln('Event.EC')
  878.         PE_Variable = upper(strip(word(PE_Ln, 1)))
  879.         select
  880.           when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
  881.           when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
  882.           when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
  883.           when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
  884.           when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
  885.           when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
  886.           otherwise nop
  887.         end
  888.         interpret PE_Variable'= strip(subword(PE_Ln, 3))'
  889.       end
  890.     call closev('Event.EC')
  891.     EnteredFont = strip(EnteredFont, 'B', '"'||"'")
  892.     TextColor   = strip(TextColor, 'B', '"'||"'")
  893.     BoxColor    = strip(BoxColor, 'B', '"'||"'")
  894.     Options     = compress(upper(strip(Options, 'B', ' "'||"'")))
  895.  
  896.     if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)
  897.  
  898.     FontInfo = compress(EnteredFont''EnteredSize, '. /:')
  899.     if FontKnown.FontInfo == '' then do
  900.       HighestFont = HighestFont + 1
  901.       FontKnown.FontInfo = HighestFont
  902.       Font.HighestFont = EnteredFont
  903.       FSize.HighestFont = EnteredSize
  904.       Height.HighestFont = GetHeight(HighestFont) * Leading/100
  905.     end
  906.     CurrentFont = FontKnown.FontInfo
  907.  
  908.     If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
  909.     If EnteredLine == '' then EnteredLine = 1
  910.     if BoxColor    == '' then BoxColor = Background.AddEvent
  911.     if TextColor   == '' then TextColor = Color.AddEvent
  912.  
  913.     if EventType = Event$ then do
  914.       EnteredDay1 = ConvertDay(EnteredDay1)
  915.       EnteredDay2 = ConvertDay(EnteredDay2)
  916.     end
  917.     else do
  918.       EnteredDay1 = RootDay + EnteredDay1
  919.       EnteredDay2 = RootDay + EnteredDay2
  920.     end
  921.     If EnteredDay1 > EnteredDay2 then Do
  922.       TempDate = EnteredDay1
  923.       EnteredDay1 = EnteredDay2
  924.       EnteredDay2 = TempDate
  925.     End
  926.  
  927.     if pos('B', Options) ~= 0 then Box = 1
  928.     if pos('W', Options) ~= 0 then Weekly = 1
  929.  
  930.     /* Process Event */
  931.     if App == 'PGS' then REFRESH OFF ALL
  932.     do until Weekly = 0
  933.       Event = EnteredEvent
  934.       Line  = EnteredLine
  935.       Day1  = EnteredDay1
  936.       Day2  = EnteredDay2
  937.       Text. = ''
  938.  
  939.       if Day1 > MaxDate then do
  940.         Weekly = 0
  941.         iterate
  942.       end
  943.       if Day2 > MaxDate then Day2 = MaxDate
  944.  
  945.       If Day1 ~= Day2 then Box = 1
  946.  
  947.       LineCount = 0
  948.       Do until Day1 > Day2
  949.         Day1Row = trunc((Day1 + StartDate - 1) / 7)
  950.         Day2Row = trunc((Day2 + StartDate - 1) / 7)
  951.         Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
  952.         Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
  953.  
  954.         if Day1Row == Day2Row then DaySpan = Day2Column - Day1Column + 1
  955.         else DaySpan = 7 - Day1Column
  956.         if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
  957.         else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
  958.         else CalDate = Day1
  959.         Select
  960.           when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  961.           when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  962.           otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  963.         end
  964.         HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
  965.         If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
  966.         else BoxTop = CalTop + 4.5 * BoxHeight
  967.  
  968.         LeftEdge = Margin.Left + Day1Column * BoxWidth + DateOffset + HighlightOffset
  969.         if event ~= '' then do
  970.           Textline = 0
  971.           Text.    = ''
  972.           Text.Textline = event
  973.  
  974.           /* Accomodate user line breaks */
  975.           do until LineBreak = 0
  976.             LineBreak = pos('//', Text.Textline)
  977.             if LineBreak > 0 then do
  978.               Nextline = Textline + 1
  979.               Text.Nextline = substr(Text.Textline, LineBreak + 2)
  980.               Text.Textline = left(Text.Textline, LineBreak - 1)
  981.               Textline = Nextline
  982.             end
  983.           end
  984.           Textline = 0
  985.  
  986.           /* Fit line(s) into allowable space */
  987.           do until Text.Nextline == ''
  988.             Nextline = Textline + 1
  989.             if Box == 1 | Textline == 0 then Indent.Textline = 0
  990.             else Indent.Textline = 3 * DateOffset
  991.             AllowedWidth = DaySpan * BoxWidth - 2 * DateOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
  992.             AllowedBoxWidth = AllowedWidth + 2 * DateOffset
  993.             if left(Text.Textline, length(TabSub)) == TabSub then do
  994.               Indent.Textline = TabFactor * DateOffset
  995.               Text.Textline = substr(Text.Textline, length(TabSub) + 1)
  996.             end
  997.  
  998.             if App == 'FW' & length(Text.Textline) > 37 then do
  999.               Wordbreak = lastpos(' ', Text.Textline, 37)
  1000.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1001.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1002.             end
  1003.             ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
  1004.             if App == 'FW' then redraw
  1005.             TextWidth.Textline = GetWidth(ID)
  1006.             if App == 'FW' then DELETEOBJECT ID
  1007.             else if App == 'PGS' then do
  1008.               SELECTOBJECT OBJECTID ID WINDOW winName
  1009.               DELETEOBJECT OBJECTID ID WINDOW winName
  1010.             end
  1011.  
  1012.             NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
  1013.             TextWidth.Textline = TextWidth.Textline * NeededCompression.Textline
  1014.             if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
  1015.               /* Move last word to next line */
  1016.               Wordbreak     = lastpos(' ', Text.Textline)
  1017.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1018.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1019.             end
  1020.             else if Text.Nextline ~= '' then Textline = Textline + 1
  1021.           End
  1022.           LineCount = Textline
  1023.         end
  1024.  
  1025.         if Box then call DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
  1026.         if event ~= '' then
  1027.           do i = 0 to LineCount
  1028.             Text.Top = BoxTop + (Line + i) * Height.Highlight
  1029.             if Box == 0 then Text.Left = LeftEdge + Indent.i
  1030.             else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i) / 2
  1031.             TextWidth = NeededCompression.i * Width.CurrentFont
  1032.             if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)
  1033.             call PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
  1034.           end
  1035.  
  1036.         Day1 = Day1 + DaySpan
  1037.         if Day1 > Day2 then leave
  1038.         else if trunc((Day1 + StartDate - 1) / 7) > 4 & Day2 > MonthLength.Month then Day2 = Day1
  1039.       end
  1040.  
  1041.       if Weekly == 1 then do
  1042.         EnteredDay1 = EnteredDay1 + 7
  1043.         EnteredDay2 = EnteredDay2 + 7
  1044.       end
  1045.     end
  1046.  
  1047.     if App == 'FW' then redraw
  1048.     else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  1049.   end
  1050.  
  1051.   if Req ~= 0 then call bguiwinclose(Req)
  1052.  
  1053.   if App == 'PGS' then do
  1054.     REFRESH ON ALL
  1055.     REFRESHWINDOW WINDOW winName
  1056.     WindowRefreshed = 1
  1057.   end
  1058.  
  1059. return
  1060. /**/
  1061.  
  1062. /***//*******  Syntax () Subroutine  ***********/
  1063. Syntax:
  1064.   signal off syntax
  1065.  
  1066.   ErrorLine  = SIGL
  1067.   SourceLine = strip(SourceLine(ErrorLine))
  1068.  
  1069.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  1070.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  1071.   call AddMsg('E', ParseVariables(SourceLine))
  1072.  
  1073.   call Cleanup
  1074.   exit
  1075. /**/
  1076.  
  1077. /***//*******  TranslationStrings () Subroutine  ***********/
  1078. TranslationStrings:
  1079. Backgrounds$    = 'Backgrounds'
  1080. Bottom$         = 'Bottom'
  1081. BoxColor$       = 'Box:'
  1082. BoxDates$       = 'Box Dates'
  1083. Boxed$          = '_Boxed:'
  1084. Calendar$       = 'Calendar'
  1085. Cancel$         = '_Cancel'
  1086. CantFind$       = "can't be found"
  1087. CantMatch$      = "The export file can't be the"||'0a'x||"same as the preferences file"
  1088. CantOpen$       = "can't be opened"
  1089. Center$         = 'Center'
  1090. Clear$          = 'Clear'
  1091. Colors$         = 'Colors'
  1092. Critical$       = 'Critical error'
  1093. DailyColors$    = 'Use daily colors'
  1094. Easter$         = 'Easter'
  1095. End$            = 'End:'
  1096. EnterEvent$     = 'You must enter an event...'
  1097. EnterEventInfo$ = 'Enter event information:'
  1098. EnterStartdate$ = 'You must enter a start date...'
  1099. Event$          = 'Event:'
  1100. Export$         = 'E_xport'
  1101. ExportFile$     = 'Select export file:'
  1102. Exporting$      = 'Exporting'
  1103. Extended$       = 'Extended'
  1104. File$           = 'File:'
  1105. Font$           = 'Font:'
  1106. Fonts$          = 'Fonts'
  1107. ForDetails$     = 'for details'
  1108. ForwardContent$ = 'Forward contents of output to'
  1109. ForwardLog$     = 'Forward log file to'
  1110. GeneratingM$    = 'Generating %s %s calendar'
  1111. GeneratingY$    = 'Generating %s calendar'
  1112. GenMVars        = 'Month.Month EnteredYear'
  1113. GenYVars        = 'EnteredYear'
  1114. Highlights$     = 'Highlights'
  1115. Images$         = 'Images'
  1116. Julian$         = 'Julian'
  1117. JulJulLeft$     = 'Jul/Jul Left'
  1118. JulLeft$        = 'Jul Left'
  1119. Left$           = 'Left'
  1120. Line$           = '_Line:'
  1121. Load$           = '_Load'
  1122. MatchColors$    = 'Date Color = Highlight Color'
  1123. MiniCals$       = 'MiniCals'
  1124. MiscVar$        = 'Miscellaneous Variables'
  1125. Monthly$        = '_Monthly'
  1126. MustUse$        = "You must use the gadget to"||'0a'x||"the right to select a font."
  1127. Noncritical$    = 'Noncritical warning'
  1128. None$           = 'None'
  1129. NotClear$       = '<'Clear$'> can only be used for Background. variables...'
  1130. Notice$         = 'notice'
  1131. OK$             = '_OK'
  1132. Options$        = 'Options'
  1133. OptLayout$      = 'Options & Layout'
  1134. OrientMarg$     = 'Orientation & Margins'
  1135. Phases$         = 'Phases'
  1136. PleaseWait$     = 'Please wait'
  1137. PrepReq$        = 'Preparing requester'
  1138. ProcessEvents$  = 'Processing events'
  1139. Reset$          = '_Reset'
  1140. Right$          = 'Right'
  1141. RiseSet$        = 'Rise/Set'
  1142. See$            = 'see'
  1143. SeeOutput$      = 'see the output above for details'
  1144. SeeShell$       = 'see the shell output for details'
  1145. SelectFile$     = 'Select data file:'
  1146. SelectFont$     = 'Select font:'
  1147. Start$          = 'Start:'
  1148. Sunrise$        = 'Sunrise'
  1149. Sunset$         = 'Sunset'
  1150. Tall$           = 'Tall'
  1151. TextColor$      = 'Text:'
  1152. Top$            = 'Top'
  1153. Unable$         = 'if you are unable to resolve the problem.'
  1154. VarGUITitle$    = 'Set desired variables:'
  1155. Variables$      = 'Variables'
  1156. Weekly$         = '_Weekly:'
  1157. Weeknumber$     = 'Weeknumber'
  1158. WholeYear$      = 'Whole _Year'
  1159. Wide$           = 'Wide'
  1160.  
  1161. January$   = 'January'
  1162. February$  = 'February'
  1163. March$     = 'March'
  1164. April$     = 'April'
  1165. May$       = 'May'
  1166. June$      = 'June'
  1167. July$      = 'July'
  1168. August$    = 'August'
  1169. September$ = 'September'
  1170. October$   = 'October'
  1171. November$  = 'November'
  1172. December$  = 'December'
  1173.  
  1174. Sunday$    = 'Sunday'
  1175. Monday$    = 'Monday'
  1176. Tuesday$   = 'Tuesday'
  1177. Wednesday$ = 'Wednesday'
  1178. Thursday$  = 'Thursday'
  1179. Friday$    = 'Friday'
  1180. Saturday$  = 'Saturday'
  1181. return 0
  1182. /**/
  1183.  
  1184. /***//*******  UpdateBusy (UB) Subroutine  ***********/
  1185. UpdateBusy:
  1186.   parse arg UB_ReqWin, UB_ProgressMade
  1187.  
  1188.   if Req ~= 0 then do
  1189.     Progress = Progress + UB_ProgressMade
  1190.  
  1191.     call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
  1192.     if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup
  1193.   end
  1194.  
  1195.   return
  1196. /**/
  1197.  
  1198. /***//*******  VIO Routines () Subroutine  ***********/
  1199. /***//** OpenV() **/
  1200. OpenV:
  1201.   parse arg VIO_Variable
  1202.  
  1203.   if Open.VIO_Variable ~= 1 then do
  1204.     Open.VIO_Variable = 1
  1205.     Pointer.VIO_Variable = 1
  1206.     EOF.VIO_Variable = 0
  1207.     return 1
  1208.   end
  1209.   else return 0
  1210. /**/
  1211.  
  1212. /***//** CloseV() **/
  1213. CloseV:
  1214.   parse arg VIO_Variable
  1215.  
  1216.   If Open.VIO_Variable == 0 then return 0
  1217.   Open.VIO_Variable = 0
  1218.   return 1
  1219. /**/
  1220.  
  1221. /***//** SeekV() **/
  1222. SeekV:
  1223.   parse arg VIO_Variable, VIO_Offset, VIO_Anchor
  1224.  
  1225.   if Open.VIO_Variable == 1 then do
  1226.     VIO_Anchor = upper(left(VIO_Anchor, 1))
  1227.  
  1228.     VIO_Value = Value(VIO_Variable)
  1229.     select
  1230.       when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
  1231.       when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
  1232.       otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
  1233.     end
  1234.  
  1235.     if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
  1236.     return Pointer.VIO_Variable
  1237.   end
  1238.   else return 0
  1239. /**/
  1240.  
  1241. /***//** ReadVCh() **/
  1242. ReadVCh:
  1243.   parse arg VIO_Variable, VIO_Length
  1244.  
  1245.   if VIO_Length == '' then VIO_Length = 1
  1246.  
  1247.   if Open.VIO_Variable == 1 then do
  1248.     if EOF.VIO_Variable == 0 then do
  1249.       VIO_Value = Value(VIO_Variable)
  1250.       VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
  1251.       Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
  1252.       if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
  1253.       else EOF.VIO_Variable = 0
  1254.     end
  1255.     else VIO_Ret = ''
  1256.   end
  1257.   else VIO_Ret = ''
  1258.  
  1259.   return VIO_Ret
  1260. /**/
  1261.  
  1262. /***//** ReadVLn(RV) **/
  1263. ReadVLn:
  1264.   parse arg VIO_Variable, VIO_Count, VIO_SepChar
  1265.  
  1266.   if VIO_Count == '' then VIO_Count = 1
  1267.   if VIO_SepChar == '' then VIO_SepChar = '0a'x
  1268.  
  1269.   if Open.VIO_Variable == 1 then do
  1270.     VIO_Value = Value(VIO_Variable)
  1271.     VIO_Ret   = ''
  1272.     do VIO_i = 1 to VIO_Count
  1273.       VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
  1274.       if VIO_LF > 0 then do
  1275.         VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
  1276.         Pointer.VIO_Variable = VIO_LF + 1
  1277.         if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
  1278.         else EOF.VIO_Variable = 0
  1279.       end
  1280.       else do
  1281.         if Pointer.VIO_Variable < length(VIO_Value) then do
  1282.           VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
  1283.           Pointer.VIO_Variable = length(VIO_Value) + 1
  1284.           EOF.VIO_Variable = 1
  1285.         end
  1286.       end
  1287.       if EOF.VIO_Variable == 1 then leave
  1288.       if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
  1289.     end
  1290.   end
  1291.   else VIO_Ret = ''
  1292.  
  1293.   return VIO_Ret
  1294. /**/
  1295.  
  1296. /***//** WriteVCh() **/
  1297. WriteVCh:
  1298.   parse arg VIO_Variable, VIO_String, VIO_Option
  1299.  
  1300.   VIO_Value  = Value(VIO_Variable)
  1301.   VIO_Option = upper(left(VIO_Option, 1))
  1302.   VIO_Length = length(VIO_Value)
  1303.   if VIO_Option == 'C' then do
  1304.     VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
  1305.     Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  1306.   end
  1307.   else if VIO_Option == 'B' then do
  1308.     VIO_Value = VIO_String''VIO_Value
  1309.     Pointer.VIO_Variable = length(VIO_String) + 1
  1310.   end
  1311.   else do
  1312.     VIO_Value = VIO_Value''VIO_String
  1313.     Pointer.VIO_Variable = length(VIO_Value)
  1314.   end
  1315.   interpret VIO_Variable'= VIO_Value'
  1316.   if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  1317.   else VIO_Ret = 0
  1318.  
  1319.   return VIO_Ret
  1320. /**/
  1321.  
  1322. /***//** WriteVLn() **/
  1323. WriteVLn:
  1324.   parse arg VIO_Variable, VIO_String, VIO_Option
  1325.  
  1326.   return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
  1327. /**/
  1328.  
  1329. /***//** EOFV() **/
  1330. EOFV:
  1331.   parse arg VIO_Variable
  1332.  
  1333.   if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  1334.   else return 1
  1335. /**/
  1336. /**/
  1337.  
  1338. /***//*******  SetVariables Subroutine  ***********/
  1339. SetVariables:
  1340.  
  1341. /***//* Initialize Variables */
  1342.   AddEventRows    = 9
  1343.   ChangesFile     = 'FWC.dat'
  1344.   DataFile        = ''
  1345.   Date            = 0
  1346.   DoShanghai      = 1
  1347.   esc             = "1B"x
  1348.   EventFile       = ''
  1349.   EventKey        = 'E'
  1350.   FontKnown.      = ''
  1351.   FSize.          = 10
  1352.   HighestFont     = 5
  1353.   Highlight       = 5
  1354.   Leading         = 100
  1355.   MinWidth        = 80
  1356.   PatVar          = '#?.data'
  1357.   PrefsFile       = ''
  1358.   Req             = 0
  1359.   StartWeek       = 0
  1360.   Storage         = 'RAM:FWC/'
  1361.   TabFactor       = 3
  1362.   TabSub          = '/~'
  1363.   Width.          = 100
  1364.  
  1365.   if App == 'FW' then DefaultFont = "SoftSans"
  1366.   else if App == 'PGS' then DefaultFont = 'PageStream-Normal'
  1367.  
  1368.   TextAdj         = 0.77
  1369.   WTextArea       = 0.20  /* fraction of print height used for top of calendar (Wide) */
  1370.   TTextArea       = 0.15  /* fraction of print height used for top of calendar (Tall) */
  1371.   DateOffset      = 0.02  /* fraction of box width to offset dates from edge of box   */
  1372.  
  1373.   D.0 = 'Sunday'
  1374.   D.1 = 'Monday'
  1375.   D.2 = 'Tuesday'
  1376.   D.3 = 'Wednesday'
  1377.   D.4 = 'Thursday'
  1378.   D.5 = 'Friday'
  1379.   D.6 = 'Saturday'
  1380.  
  1381.   MonthLength.1    = 31
  1382.   MonthLength.2    = 28
  1383.   MonthLength.3    = 31
  1384.   MonthLength.4    = 30
  1385.   MonthLength.5    = 31
  1386.   MonthLength.6    = 30
  1387.   MonthLength.7    = 31
  1388.   MonthLength.8    = 31
  1389.   MonthLength.9    = 30
  1390.   MonthLength.10   = 31
  1391.   MonthLength.11   = 30
  1392.   MonthLength.12   = 31
  1393.  
  1394.   call TranslationStrings
  1395. /**/
  1396.  
  1397.   ProcessNow = 'DoShanghai Storage PrefsFile'
  1398.  
  1399.   if exists(ScriptDir''ChangesFile) then do
  1400.     call open('DataFile', ScriptDir''ChangesFile)
  1401.       do until eof('DataFile')
  1402.         Ln = ReadLn('DataFile')
  1403.         if pos(upper(word(Ln, 1)), upper(ProcessNow)) ~= 0 then interpret Ln
  1404.         else if right(word(Ln, 1), 1) == '$' then interpret Ln
  1405.         else if pos('End Pass One', Ln) > 0 then leave
  1406.       end
  1407.     call close('DataFile')
  1408.   end
  1409.  
  1410.   if (PrefsFile ~= '') & (exists(PrefsFile)) then do
  1411.     if open('DataFile', PrefsFile) then do
  1412.       do until eof('DataFile')
  1413.         Ln = ReadLn('DataFile')
  1414.         Var = upper(word(Ln, 1))
  1415.         if right(Var, 1) == '$' then interpret Ln
  1416.         else if pos('/* End Pass One', Ln) > 0 then leave
  1417.       end
  1418.       call close('DataFile')
  1419.     end
  1420.     Month.1  = January$
  1421.     Month.2  = February$
  1422.     Month.3  = March$
  1423.     Month.4  = April$
  1424.     Month.5  = May$
  1425.     Month.6  = June$
  1426.     Month.7  = July$
  1427.     Month.8  = August$
  1428.     Month.9  = September$
  1429.     Month.10 = October$
  1430.     Month.11 = November$
  1431.     Month.12 = December$
  1432.   end
  1433.  
  1434.   call makedir(left(Storage, length(Storage) - 1))
  1435.   call GetLogInfo
  1436.  
  1437.   if App == 'FW' then do
  1438.     call open('FWPrefs', CurrentDir'FWFiles/FW.Prefs')
  1439.       FWPrefs = readch('FWPrefs', 65535)
  1440.     call close('FWPrefs')
  1441.     ColorTable = pos('SWCL', FWPrefs) + 12
  1442.     EndTable = pos('STUP', FWPrefs)
  1443.     ColorCount = 0
  1444.     Do CTPos = ColorTable to EndTable by 20
  1445.       ColorRegister = c2x(substr(FWPrefs, CTPos - 3, 3))
  1446.       ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
  1447.       if ColorRegister = '000000' then Black$ = ColorList.ColorCount
  1448.       if ColorRegister = 'FFFFFF' then White$ = ColorList.ColorCount
  1449.       ColorCount = ColorCount + 1
  1450.     end
  1451.     ColorList.ColorCount = '<'Clear$'>'
  1452.     ColorCount = ColorCount + 1
  1453.     ColorList.COUNT = ColorCount
  1454.     if symbol('Black$') == 'LIT' then do
  1455.       call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
  1456.       Black$ = ColorList.0
  1457.     end
  1458.     if symbol('White$') == 'LIT' then do
  1459.       call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
  1460.       White$ = ColorList.1
  1461.     end
  1462.   end
  1463.   else if App == 'PGS' then do
  1464.     GETFONTLIST FontList
  1465.     FontList.COUNT = result
  1466.  
  1467.     call open('PGSColors', CurrentDir''word(PgmVersion, 1)'.colors')
  1468.       PGSColors = readch('PGSColors', 65535)
  1469.     call close('PGSColors')
  1470.     ColorCount = 0
  1471.     StartTag = pos('TG'||'00'x, PGSColors)
  1472.     do while StartTag ~= 0
  1473.       Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
  1474.       AccentMarker = pos(d2c(129), Color)
  1475.       do while AccentMarker > 0
  1476.         Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
  1477.         AccentMarker = pos(d2c(129), Color)
  1478.       end
  1479.       ColorList.ColorCount = Color
  1480.       ColorCount = ColorCount + 1
  1481.       StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
  1482.     end
  1483.     ColorList.ColorCount = '<'Clear$'>'
  1484.     ColorCount = ColorCount + 1
  1485.     ColorList.COUNT = ColorCount
  1486.     White$ = ColorList.0
  1487.     Black$ = ColorList.1
  1488.   end
  1489.   TextColorList.Count = ColorList.COUNT - 1
  1490.   do i = 0 to TextColorList.Count - 1
  1491.     TextColorList.i = ColorList.i
  1492.   end
  1493.  
  1494.   Color.          = Black$
  1495.   Line.           = Black$
  1496.   Background.     = White$
  1497.  
  1498.   AppScreen = ''
  1499.   DefScreen = ''
  1500.   if (RexxTricks == 1) & (DoShanghai ~= 0) then do
  1501.     if (pubscreenlist('ScreenList') > 0) then do
  1502.       do i = 1 to ScreenList.0
  1503.         if pos(AppName, upper(ScreenList.i)) > 0 then do
  1504.           AppScreen = ScreenList.i
  1505.           DefScreen = setdefaultpubscreen(AppScreen)
  1506.           leave
  1507.         end
  1508.       end
  1509.     end
  1510.   end
  1511.  
  1512.   /**** Read user variables ****/
  1513.   if App == 'FW' then do
  1514.     FIRSTOBJECT; TempDateID = result
  1515.     do forever
  1516.       if TempDateID == 0 then do
  1517.         call AddMsg('E', 'Unable to find FWC date string.')
  1518.         call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1519.         call Cleanup
  1520.       end
  1521.       GETOBJECTTYPE TempDateID; ObjectType = result
  1522.       if ObjectType == 7 then do
  1523.         GETTEXTBLOCKTEXT TempDateID; TempDate = result
  1524.         if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
  1525.       end
  1526.       NEXTOBJECT TempDateID; TempDateID = result
  1527.     end
  1528.     do while right(TempDate, 1) == '|'
  1529.       StartObj = pos('|', TempDate)
  1530.       NextObj = strip(substr(TempDate, StartObj), 'B', '|')
  1531.       GETTEXTBLOCKTEXT NextObj; TempDate = left(TempDate, StartObj - 1)''result
  1532.     end
  1533.     PrefsFile = substr(TempDate, 12)
  1534.     TempDate = substr(TempDate, 4, 8)
  1535.   end
  1536.   else if App = 'PGS' then do
  1537.     CURRENTWINDOW; winName = '"'RESULT'"'
  1538.     SELECTTEXT at 0 0 WINDOW winName
  1539.     SELECTTEXT ALL WINDOW winName
  1540.     EXPORTTEXT AMIGA FILE Storage"TempDate.txt" FILTER "ASCII" STATUS FORCE
  1541.     if exists(Storage"TempDate.txt") then do
  1542.       open(TDFile, Storage"TempDate.txt")
  1543.         TempDate = ReadLn(TDFile)
  1544.       close(TDFile)
  1545.     end
  1546.     if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
  1547.       call AddMsg('E', 'Unable to find FWC date string.')
  1548.       call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1549.       call Cleanup
  1550.     end
  1551.     else do
  1552.       PrefsFile = substr(TempDate, 12)
  1553.       TempDate = substr(TempDate, 4, 8)
  1554.     end
  1555.   end
  1556.   if PrefsFile == '' then do
  1557.     if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
  1558.     else PrefsFile = 'Default'
  1559.   end
  1560.  
  1561.   call open('Temp', FullCallPath)
  1562.     FileOffset = 40000
  1563.     call seek('Temp', FileOffset, 'B')
  1564.     do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  1565.       PrevOffset = FileOffset
  1566.       Chunk = readch('Temp', 65535)
  1567.       EndPos = pos('VarList:'||'0a'x, Chunk)
  1568.       if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
  1569.     end
  1570.     call seek('Temp', FileOffset + EndPos + 8, 'B')
  1571.     DefaultVariables = readch('Temp', 65535)
  1572.   call close('Temp')
  1573.   call openv('DefaultVariables')
  1574.     do forever
  1575.       CD_VarLine = strip(readvln('DefaultVariables'))
  1576.       if CD_VarLine == 'return' then leave
  1577.       if CD_VarLine == '' then iterate
  1578.       interpret CD_VarLine
  1579.     end
  1580.   call closev('DefaultVariables')
  1581.  
  1582.   if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
  1583.     if open('UserFile', PrefsFile) then do
  1584.       UserFile = readch('UserFile', 65535)
  1585.       call close('UserFile')
  1586.       call openv('UserFile')
  1587.         do until eofv('UserFile')
  1588.           CD_VarLine = strip(ReadvLn('UserFile'))
  1589.           CD_VarName = upper(strip(word(CD_VarLine, 1)))
  1590.           if left(CD_VarLine, 15) == '/* End Pass One' then leave
  1591.           if (left(CD_VarLine, 2) == '/*') |,
  1592.              (CD_VarName == 'DOSHANGHAI') |,
  1593.              (CD_VarLine == '') |,
  1594.              (upper(left(CD_VarLine, 11)) == 'IMAGECLASS.') then iterate
  1595.           else interpret CD_VarLine
  1596.         end
  1597.       call closev('UserFile')
  1598.     end
  1599.   end
  1600.   drop Orientation
  1601.  
  1602.   Type.0    = Event$
  1603.   Type.1    = File$
  1604.   FSize.4pt = 4
  1605.  
  1606.   do i = 0 to 6
  1607.     val = i - StartWeek
  1608.     if val < 0 then val = 7 + val
  1609.     interpret 'Day.'D.i '=' val
  1610.     interpret 'Day.val = 'D.i'$'
  1611.   end
  1612.  
  1613.   Month.1  = January$
  1614.   Month.2  = February$
  1615.   Month.3  = March$
  1616.   Month.4  = April$
  1617.   Month.5  = May$
  1618.   Month.6  = June$
  1619.   Month.7  = July$
  1620.   Month.8  = August$
  1621.   Month.9  = September$
  1622.   Month.10 = October$
  1623.   Month.11 = November$
  1624.   Month.12 = December$
  1625.  
  1626.   do i = 1 to 12
  1627.     AbbrMonth.i  = left(Month.i, 3)
  1628.   end
  1629.  
  1630.   if App == 'FW' then do
  1631.     TextBase = TextAdj
  1632.     do i = 0 to 5 by 5
  1633.       if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
  1634.       if ~exists(Font.i) then do
  1635.         call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
  1636.         Font.i = DefaultFont
  1637.       end
  1638.     end
  1639.     GETPAGESETUP ORIENT; FWC_Orientation = result
  1640.     if FWC_Orientation == 'Wide' then TextArea = WTextArea
  1641.     else TextArea = TTextArea
  1642.  
  1643.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  1644.     DISPLAYPREFS Measure Inches
  1645.     GETSECTIONSETUP Top Bottom Inside Outside
  1646.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  1647.  
  1648.     GETPAGESETUP Width Height
  1649.     parse var result FullWidth FullHeight
  1650.  
  1651.     TextBlockPrefs TEXTFLOW None
  1652.   end
  1653.   else if App = 'PGS' then do
  1654.     TextBase = 1
  1655.     GETFONTLIST FontNames
  1656.     FontNames.COUNT = result
  1657.     do i = 0 to 5 by 5
  1658.       do j = 0 to FontNames.COUNT - 1
  1659.         if upper(Font.i) == upper(FontNames.j) then leave
  1660.       end
  1661.       if j == FontNames.COUNT then do
  1662.         call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
  1663.         Font.i = DefaultFont
  1664.       end
  1665.     end
  1666.     GETMASTERPAGES MPage; PageName = MPage.0
  1667.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  1668.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  1669.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  1670.     GETMARGINGUIDES temp
  1671.     Margin.Left   = temp.inside
  1672.     Margin.Right  = temp.outside
  1673.     Margin.Top    = temp.top
  1674.     Margin.Bottom = temp.bottom
  1675.  
  1676.     GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
  1677.     if layout.orientation == 'LANDSCAPE' then do
  1678.       TextArea   = WTextArea
  1679.       FullWidth  = layout.height
  1680.       FullHeight = layout.width
  1681.     end
  1682.     else do
  1683.       TextArea   = TTextArea
  1684.       FullWidth  = layout.width
  1685.       FullHeight = layout.height
  1686.     end
  1687.   end
  1688.  
  1689.   PrintWidth       = FullWidth - Margin.Left - Margin.Right
  1690.   PrintHeight      = FullHeight - Margin.Top - Margin.Bottom
  1691.  
  1692.   if App == 'FW' then do
  1693.     GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  1694.   end
  1695.   else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  1696.   if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
  1697.       PrintHeight = PrintHeight - Height.4pt
  1698.  
  1699.   BoxWidth         = PrintWidth/7
  1700.   CalRight         = Margin.Left + BoxWidth * 7
  1701.   TextArea         = TextArea * PrintHeight
  1702.   CalTop           = TextArea + Margin.Top
  1703.   BoxHeight        = (PrintHeight - TextArea)/5
  1704.   DateOffset       = DateOffset * BoxWidth
  1705.   FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  1706.   Width.Date       = Width.Date * StretchDateW / StretchDateH
  1707.   FSize.Highlight  = BoxHeight/AddEventRows * 72
  1708.   if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  1709.   if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  1710.   Height.Highlight = GetHeight(Highlight) * Leading/100
  1711.   Height.Date      = GetHeight(Date) * Leading/100
  1712.  
  1713.   FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  1714.   FontKnown.FontInfo = Highlight
  1715.  
  1716.   RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  1717.   Width.WidthOfDate1 = GetFontWidth(Date, '1')
  1718.   Width.WidthOfDate8 = GetFontWidth(Date, '8')
  1719.   VariablesSet = 1
  1720. return
  1721. /**/
  1722.  
  1723. /***//*******  VarList () Subroutine  ***********/
  1724. ReturnVarListLoc:
  1725.   return SIGL + 2
  1726. VarListLoc:
  1727.   /* WTextArea      = fraction of print height used for top of calendar (Wide) */
  1728.   /* TTextArea      = fraction of print height used for top of calendar (Tall) */
  1729.   /* DateOffset     = fraction of box width to offset dates from edge of box   */
  1730.   /* MiniCalHeight  = fraction of text area height used for minicals           */
  1731.   /* MiniCalWidth   = width-to-height ratio for minicals                       */
  1732.   /* MiniCalSpacing = fraction of print width placed between FY minicals       */
  1733.   signal ReturnVarListLoc
  1734. VarList:
  1735.   AddEventRows          = 9
  1736.   AdjustDST             = 1
  1737.   AltColor.Date         = Black$
  1738.   AltColor.Extended     = Black$
  1739.   AltColor.Highlight    = Black$
  1740.   AltColor.HighlightH   = Black$
  1741.   AltColor.Julian       = Black$
  1742.   AltColor.Sunrise      = Black$
  1743.   AltColor.Sunset       = Black$
  1744.   AltColor.WeekNumber   = Black$
  1745.   Background.AddEvent   = White$
  1746.   Background.Highlight  = White$
  1747.   Background.HighlightH = White$
  1748.   Background.MiniCal    = White$
  1749.   Background.Weekend    = White$
  1750.   BelzierFactor         = .55
  1751.   Bold.FYMiniCal        = DefaultBold
  1752.   Bold.MiniCal          = DefaultBold
  1753.   CenterMiniDates       = 1
  1754.   Clear$                = 'Clear'
  1755.   Color.AddEvent        = Black$
  1756.   Color.Date            = Black$
  1757.   Color.Extended        = Black$
  1758.   Color.Friday          = Black$
  1759.   Color.Header          = Black$
  1760.   Color.Highlight       = Black$
  1761.   Color.HighlightH      = Black$
  1762.   Color.Julian          = Black$
  1763.   Color.MiniCal         = Black$
  1764.   Color.Monday          = Black$
  1765.   Color.Moon            = Black$
  1766.   Color.Saturday        = Black$
  1767.   Color.Sunday          = Black$
  1768.   Color.Sunrise         = Black$
  1769.   Color.Sunset          = Black$
  1770.   Color.Thursday        = Black$
  1771.   Color.Tuesday         = Black$
  1772.   Color.Wednesday       = Black$
  1773.   Color.Weekday         = Black$
  1774.   Color.WeekNumber      = Black$
  1775.   DateOffset            = 0.02
  1776.   DoBackgrounds         = 0
  1777.   DoDailyColors         = 0
  1778.   DoDateBox             = 0
  1779.   DoEaster              = 1
  1780.   DoExtended            = 1
  1781.   DoHighlights          = 0
  1782.   DoImages              = 0
  1783.   DoJulian              = 0
  1784.   DoJulianLeft          = 0
  1785.   DoMatchColors         = 0
  1786.   DoMiniCals            = 1
  1787.   DoPhases              = 0
  1788.   DoSunRise             = 0
  1789.   DoSunSet              = 0
  1790.   DoWeekNumber          = 0
  1791.   FinalView             = 75
  1792.   Font.Date             = DefaultFont
  1793.   Font.Extras           = DefaultFont
  1794.   Font.FYMiniCal        = DefaultFont
  1795.   Font.Header           = DefaultFont
  1796.   Font.Highlight        = DefaultFont
  1797.   Font.MiniCal          = DefaultFont
  1798.   Font.Weekday          = DefaultFont
  1799.   GfxAppPath            = ''
  1800.   HeaderLoc             = 2
  1801.   HighlightRows         = 9
  1802.   LaunchM               = ''
  1803.   LaunchY               = ''
  1804.   Leading               = 100
  1805.   Line.AddEvent         = Black$
  1806.   Line.Extended         = Black$
  1807.   Line.Grid             = Black$
  1808.   Line.MiniCal          = Black$
  1809.   MagnifyExtras         = 1
  1810.   Margin.Bottom         = 0
  1811.   Margin.Left           = 0
  1812.   Margin.Right          = 0
  1813.   Margin.Top            = 0
  1814.   MaxImgHeight          = .75
  1815.   MaxImgWidth           = .75
  1816.   MiniCalHeight         = 0.60
  1817.   MiniCalSpacing        = 0.05
  1818.   MiniCalWidth          = 2
  1819.   MinWidth              = 80
  1820.   MoonRadius            = .075
  1821.   Orientation           = 'Wide'
  1822.   ShiftLMini            = 0
  1823.   ShiftRMini            = 0
  1824.   StartWeek             = 0
  1825.   StretchDateH          = 1
  1826.   StretchDateW          = 1
  1827.   SunCalcPath           = ''
  1828.   Text.Julian           = ''
  1829.   Text.Sunrise          = ''
  1830.   Text.Sunset           = ''
  1831.   Text.WeekNumber       = ''
  1832.   Width.Date            = 100
  1833. return
  1834. /**/
  1835.  
  1836.