home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1997 October / PCO1097.ISO / FilesBBS / DOS / DATSCRN.EXE / OS2-VARI / DAT-OS2.LZH / DAT2.Cmd < prev    next >
Encoding:
Text File  |  1997-08-26  |  27.0 KB  |  780 lines
  1. /* REXX ================================================================ */
  2. /*                                                                       */
  3. /* Name      : DAT2.CMD                                                  */
  4. /* Datum     : 09.03.1996                                                */
  5. /*                                                                       */
  6. /* Autor     : Gert Massheimer                                           */
  7. /* eMail     : GertMassheimer@swol.de     2:2476/62@fidonet              */
  8. /*                                                                       */
  9. /* Funktion  : OS/2-Gegenstück zum DOS-Programm DatScreen von            */
  10. /*             Carsten Kruse [2:248/4002].                               */
  11. /*             Dieses Script erzeugt einen Begrüßungsbildschirm für      */
  12. /*             eine BBS. Dabei wird ein Spruch (Zitat) für den Tag,      */
  13. /*             sowie ein Kalenderblatt angezeigt.                        */
  14. /*                                                                       */
  15. /* Syntax    : OS/2-Rexx                                                 */
  16. /* Änderung  : 03.08.1997                                                */
  17. /*                                                                       */
  18. /* ===================================================================== */
  19.  
  20.  Call Init
  21.  
  22. /* Fehlerauswertung */
  23.  
  24.  Signal on Halt                            /*  Abbruch bei Fehler        */
  25.  Signal on NoValue                         /*  Leere Variable            */
  26.  Signal on Syntax                          /*  Falsche Befehls-Syntax    */
  27.  
  28. /* --------------------------------------------------------------------- */
  29. /* Hauptprogramm                                                         */
  30. /* --------------------------------------------------------------------- */
  31.  
  32.  CLS = '1B'x'[2J'; BG = '1B'x'[0;40m'
  33.  
  34.  Say ' DAT2 v0.04 "Hello!" door for mailbox systems'
  35.  Say ' Freeware (c) by Gert Massheimer'
  36.  Say ' If you like it mail me: 2:2476/62@fidonet or GertMassheimer@swol.de'
  37.  Say '';
  38.  
  39.  Parse Upper Arg Show
  40.  
  41.  If (Show = '/?') | (Show = '-?') |,
  42.     (Show = '/H') | (Show = '-H') then do
  43.    Say ' DAT2 [-h] | [-s]'
  44.    Say '       -h views this help screen'
  45.    Say '       -s types the result of building the ANSI file(s)'
  46.    Exit
  47.  End
  48.  If Show = '-S' then Show = 1
  49.  
  50.  Call Read_Config
  51.  
  52.  If Shadow = 1 then ShadowChar = SColor || '▒'
  53.  Else ShadowChar = ''
  54.  
  55.  /* Header erstellen =================================================== */
  56.  
  57.  HeaderLength = Format(HeaderLength,2 ,0)
  58.  Test = HeaderLength / 2
  59.  If Length(Test) > 2 then HeaderLength = HeaderLength + 1
  60.  HPos = Copies(' ', (76 - HeaderLength) / 2)
  61.  LeftFrame = BG || HPos || FColor || Site || ' '
  62.  RightFrame = ' '|| FColor_3D || Site || ShadowChar || BG
  63.  TopHeaderLine = CLS || BG || HPos || FColor ||,
  64.                  ULC || Copies(URow, HeaderLength + 2) || URC || BG
  65.  HeaderLine = LeftFrame || NewHeader || RightFrame
  66.  BottomHeaderLine = BG || HPos || FColor ||,
  67.                     LLC || FColor_3D ||Copies(LRow, HeaderLength + 2) ||,
  68.                     LRC || ShadowChar || BG
  69.  
  70.  /* Vorlagen.Txt lesen und auswerten =================================== */
  71.  
  72.  Tmp_File = 'Msg.$$$'
  73.  D_File = 'Vorlagen.Txt'
  74.  Call SysFileDelete Tmp_File
  75.  Call Read_Date_File
  76.  
  77.  If (Stream(Tmp_File, 'C', 'Query Exist') = '') & (AllDayMsg \= 'N')
  78.    then Call Read_AllDays_File
  79.  If (Stream(Tmp_File, 'C', 'Query Exist') = '') & (AllDayMsg = 'N')
  80.    then Exit
  81.  
  82.  /* JederTag.Txt lesen und auswerten =================================== */
  83.  
  84.  Call Read_Day_File
  85.  
  86.  /* Holy_Day.Txt lesen und auswerten =================================== */
  87.  
  88.  Tmp_File = 'Msg.$$1'
  89.  D_File = 'Holy_Day.Txt'
  90.  Call SysFileDelete Tmp_File
  91.  Call Read_Date_File
  92.  Call Read_Cal_File
  93.  
  94.  /* Message erstellen ================================================== */
  95.  
  96.  MsgLineLength = Format(MsgLineLength,2 ,0)
  97.  Test = MsgLineLength / 2
  98.  If Length(Test) > 2 then MsgLineLength = MsgLineLength + 1
  99.  MPos = Copies(' ', (76 - MsgLineLength) / 2)
  100.  TopMsgLine =  BG || MPos || FColor ||,
  101.               ULC || Copies(URow, MsgLineLength + 2) || URC || BG
  102.  BottomMsgLine = BG || MPos || FColor ||,
  103.                  LLC || FColor_3D || Copies(LRow, MsgLineLength + 2) ||,
  104.                  LRC || ShadowChar || BG
  105.  
  106.  /* Footer erstellen =================================================== */
  107.  
  108.  FooterLength = Format(FooterLength,2 ,0)
  109.  Test = FooterLength / 2
  110.  If Length(Test) > 2 then FooterLength = FooterLength + 1
  111.  FPos = Copies(' ', (80 - FooterLength) / 2)
  112.  FooterLine = BG || FPos || NewFooter
  113.  
  114.  /* Pause-Zeile erstellen ============================================== */
  115.  
  116.  Select
  117.     When Pause = 'I' then PauseLine = Copies(PauseSign, T + 2)
  118.     When Pause = 'R' then PauseLine = Copies(PauseSign, Random(1, 7))
  119.     When Pause =  0  then PauseLine = ''
  120.     When (Pause >= 1) | (Pause <= 7) then PauseLine = Copies(PauseSign, Pause)
  121.     When Pause > 7   then PauseLine = Copies(PauseSign, 7)
  122.     Otherwise PauseLine = ''
  123.  End
  124.  
  125.  /* ANSI-Datei schreiben =============================================== */
  126.  
  127.  If Shadow = 1 then ShadowChar = SColor || '▒'
  128.  Else ShadowChar = ''
  129.  
  130.  ANS_File = OutDir || '\' || OutName || '.ANS'
  131.  Call SysFileDelete ANS_File
  132.  Say ' Writing' ANS_File '...'
  133.  Call Stream  ANS_File, 'C', 'Open write'
  134.    Call LineOut ANS_File, TopHeaderLine
  135.    Call LineOut ANS_File, HeaderLine
  136.    Call LineOut ANS_File, BottomHeaderLine
  137.    If Shadow = 1 then
  138.      Call LineOut ANS_File, BG ||HPos || ' ' || SColor ||,
  139.                             Copies('▒', Headerlength + 4)
  140.    Call LineOut ANS_File, ''
  141.    Call LineOut ANS_File, TopMsgLine
  142.    If TextForm = 'C' then do
  143.      Do I = 1 to T
  144.        Call LineOut ANS_File, BG || MPos || FColor || Site || ' ' || TColor ||,
  145.                               Center(MsgLine.I, MsgLineLength) ||,
  146.                               FColor || ' ' || FColor_3D || Site || ShadowChar || BG
  147.      End
  148.    End
  149.    If TextForm = 'L' then do
  150.      Do I = 1 to T
  151.        Call LineOut ANS_File, BG || MPos || FColor || Site || ' ' || TColor ||,
  152.                               Left(Strip(MsgLine.I,, '~'), MsgLineLength) ||,
  153.                               FColor || ' ' || FColor_3D || Site || ShadowChar || BG
  154.      End
  155.    End
  156.    Call LineOut ANS_File, BottomMsgLine
  157.    If Shadow = 1 then
  158.      Call LineOut ANS_File, BG ||MPos || ' ' || SColor ||,
  159.                             Copies('▒', MsgLinelength + 4)
  160.    Call LineOut ANS_File, ''
  161.    Call LineOut ANS_File, FooterLine
  162.    Call LineOut ANS_File, PauseLine
  163.    Call LineOut ANS_File, EnterMsg
  164.  
  165.  /* Kallenderblatt schreiben =========================================== */
  166.  
  167.    If Translate(Calendar) \= 'N' then do
  168.      If CalFile \= 'N' then do
  169.        Call Stream  ANS_File, 'C', 'Close'
  170.        ANS_File = OutDir || '\' || CalFile || '.ANS'
  171.        Call SysFileDelete ANS_File
  172.        Call Stream  ANS_File, 'C', 'Open write'
  173.      End
  174.      CalColor = '1B'x'[0;47;30m'
  175.      If Date('W') = 'Sunday' then NumColor = '1B'x'[1;47;31m'
  176.      Else NumColor = '1B'x'[0;47;34m'
  177.  
  178.      If Shadow = 1 then do
  179.        CalSColor = '1B'x'[30;1;40m'
  180.        ShadowChar = CalSColor || '▒'
  181.      End
  182.      Else ShadowChar = ''
  183.  
  184.      Call FrameSet1
  185.  
  186.      ToDay     = RxDate()
  187.      Select
  188.         When (Translate(Days_2000) \= 'N') &,
  189.              (Translate(Days_2000) \= 'M') &,
  190.              (Translate(SubStr(SubWord(Days_2000, 1, 1), 1, 1)) \= 'C') then do
  191.           FinalDate = RxDate('01/01/2000') - ToDay
  192.           Select
  193.             When FinalDate = 0 then
  194.               DateLine = 'Hallo neues Jahrtausend!'
  195.             When FinalDate < 0 then do
  196.               FinalDate = ToDay - RxDate('01/01/2000')
  197.               DateLine = 'Schon' FinalDate 'Tage seit dem 1.1.2000!'
  198.              End
  199.             Otherwise NOP
  200.               DateLine = 'Noch' FinalDate 'Tage bis zum 1.1.2000!'
  201.           End
  202.          End
  203.         When (Translate(Days_2000) \= 'N') &,
  204.              (Translate(Days_2000)  = 'M') then do
  205.           FinalDate = RxDate('01/01/2001') - ToDay
  206.           Select
  207.             When FinalDate = 0 then
  208.               DateLine = 'Hallo neues Jahrtausend!'
  209.             When FinalDate < 0 then do
  210.               FinalDate = ToDay - RxDate('01/01/2001')
  211.               DateLine = 'Schon' FinalDate 'Tage seit der Jahrtausendwende!'
  212.              End
  213.             Otherwise NOP
  214.               DateLine = 'Noch' FinalDate 'Tage bis zum neuen Jahrtausend!'
  215.           End
  216.          End
  217.         When Translate(SubStr(SubWord(Days_2000, 1, 1), 1, 1)) = 'C' then do
  218.           FstWords = ''; SecWords = ''; TargetDate = ToDay
  219.           Parse Value Days_2000 with Custom','FstWords'###'SecWords'$'TargetDate
  220.           Parse Value TargetDate with TDay'.'TMonth'.'TYear
  221.           TargetDate = TMonth || '/' || TDay || '/' || TYear
  222.           FinalDate = RxDate(TargetDate) - ToDay
  223.           DateLine = Strip(FstWords) FinalDate Strip(SecWords)
  224.          End
  225.         Otherwise NOP
  226.      End
  227.  
  228.      CPos = Copies(' ', 14)
  229.      TopCalLine = BG || CPos || CalColor || ULC || Copies(URow, 48) ||,
  230.                   URC || BG
  231.      EmptyCalLine = BG || CPos || CalColor || Site || Copies(' ', 48) ||,
  232.                     Site || ShadowChar || BG
  233.      BottomCalLine = BG || CPos || CalColor || LLC || Copies(LRow, 48) ||,
  234.                      LRC || ShadowChar || BG
  235.      LeftCalFrame = BG || CPos || CalColor || Site
  236.      RightCalFrame = CalColor || Site || ShadowChar || BG
  237.      CalText = LeftCalFrame || Center(CalText, 48) || RightCalFrame
  238.  
  239.      Call Interpret_Date
  240.  
  241.      NumLine1 = LeftCalFrame || NumColor ||,
  242.                 Center(Pos11 || Pos21 || '  ' || Pos31 || Pos41 || ' ', 48) ||,
  243.                 RightCalFrame
  244.      NumLine2 = LeftCalFrame || NumColor ||,
  245.                 Center(Pos12 || Pos22 || '  ' || Pos32 || Pos42 || ' ', 48) ||,
  246.                 RightCalFrame
  247.      If NumSet = 1 then
  248.        NumLine3 = LeftCalFrame || NumColor ||,
  249.                   Center(Pos13 || Pos23 || ZP || ' ' || Pos33 || Pos43 || ZP, 48) ||,
  250.                   RightCalFrame
  251.      Else
  252.        NumLine3 = LeftCalFrame || NumColor ||,
  253.                   Center(Pos13 || Pos23 || ZP || Pos33 || Pos43 || ZP, 48) ||,
  254.                   RightCalFrame
  255.  
  256.      Call LineOut ANS_File, CLS
  257.      Call LineOut ANS_File, ''
  258.      Call LineOut ANS_File, ''
  259.      Call LineOut ANS_File, TopCalLine
  260.      Call LineOut ANS_File, EmptyCalLine
  261.      Call LineOut ANS_File, CalText
  262.      Call LineOut ANS_File, EmptyCalLine
  263.      Call LineOut ANS_File, NumLine1
  264.      Call LineOut ANS_File, NumLine2
  265.      Call LineOut ANS_File, NumLine3
  266.      Call LineOut ANS_File, EmptyCalLine
  267.      Do I = 1 to C_LNo
  268.        Call LineOut ANS_File, BG || CPos || CalColor || Site ||,
  269.                               Center(CalLine.I, 48) || Site || ShadowChar || BG
  270.      End
  271.      If Translate(Days_2000) \= 'N' then do
  272.        Call LineOut ANS_File, EmptyCalLine
  273.        Call LineOut ANS_File, BG || CPos || CalColor || Site ||,
  274.                               Center(DateLine, 48) || Site || ShadowChar || BG
  275.      End 
  276.      Call LineOut ANS_File, EmptyCalLine
  277.      Call LineOut ANS_File, BottomCalLine
  278.      If Shadow = 1 then do
  279.        Call LineOut ANS_File, BG || Copies(' ', 15) || CalSColor ||,
  280.                               Copies('▒', 50) || BG
  281.        Call LineOut ANS_File, ''
  282.      End
  283.      Call LineOut ANS_File, CalPauseLine
  284.      Call LineOut ANS_File, EnterMsg
  285.    End
  286.  
  287.  Call Stream  ANS_File, 'C', 'Close'
  288.  
  289.  If Show = 1 then do
  290.    '@Type' OutDir || '\' || OutName || '.ANS'
  291.     If CalFile \= 'N' then '@Type' OutDir || '\' || CalFile || '.ANS'
  292.  End
  293.  
  294. Exit
  295.  
  296. /* --------------------------------------------------------------------- */
  297. /* Default-Konfiguration lesen                                           */
  298. /* --------------------------------------------------------------------- */
  299.  
  300. Read_Config:
  301.  Cfg_File = 'DAT2.CFG'
  302.  Say ' Reading configuration file...'
  303.  If Stream(Cfg_File, 'C', 'Query Exist') = '' then do
  304.    Say ' Sorry, could not find ' || Cfg_File
  305.    Say ' Please check your configuration!'
  306.    Exit
  307.  End
  308.  Call Stream Cfg_File, 'C', 'Open read'
  309.    Do While Lines(Cfg_File) = 1
  310.      Line = LineIn(Cfg_File)
  311.      If (SubStr(Line, 1, 2) = '//') | (Length(Line) = 0) then Iterate
  312.      Keyword = Translate(Word(Line, 1))
  313.      Info = Word(Line, 2); LongInfo = DelWord(Line,1,1)
  314.      Select
  315.        When Keyword = '*BBSNAME:'        then BBSName   = LongInfo
  316.        When Keyword = '*SYSOPFIRSTNAME:' then FName     = LongInfo
  317.        When Keyword = '*SYSOPLASTNAME:'  then LName     = LongInfo
  318.        When Keyword = '*SHOWLASTNAME:'   then do
  319.           SLName    = Translate(Info)
  320.           If SLName = 'N' then SLName = ''
  321.           Else SLName = LName
  322.         End
  323.        When Keyword = '*OUTPUTPATH:'     then OutDir    = Info
  324.        When Keyword = '*OUTPUTNAME:'     then OutName   = Info
  325.        When Keyword = '*BGCOLOR:'        then BGColor   = Info
  326.        When Keyword = '*FRAMECOLOR:'     then
  327.          FColor     = '1B'x'[' || BGColor || ';1;' || Info || 'm'
  328.        When Keyword = '*HEADERCOLOR:'    then do
  329.           HeaderColor = Info
  330.           HColor     = '1B'x'[' || BGColor || ';1;' || Info || 'm'
  331.          End
  332.        When Keyword = '*BBSNAMECOLOR:'   then
  333.          BBSColor   = Info
  334.        When Keyword = '*TEXTCOLOR:'      then
  335.          TColor     = '1B'x'[' || BGColor || ';1;' || Info || 'm'
  336.        When Keyword = '*FRAMESET:'       then do
  337.           FrameSet = Info
  338.           Select
  339.             When Info = 1 then Call FrameSet1
  340.             When Info = 2 then Call FrameSet2
  341.             When Info = 3 then Call FrameSet3
  342.             When Info = 4 then Call FrameSet4
  343.             When Info = 5 then Call FrameSet5
  344.             When Info = 6 then Call FrameSet6
  345.             When Info = 7 then Call FrameSet7
  346.             When Info = 8 then Call FrameSet8
  347.             When (C2D(Info) >= 49) | (C2D(Info) <= 56) then
  348.               Call FrameSetX Info
  349.             Otherwise Call FrameSet1
  350.           End
  351.          End
  352.        When Keyword = '*SHADOW:'         then do
  353.           Shadow  = Translate(Info)
  354.           IF Shadow \= 'N' then Shadow = 1
  355.           Else Shadow = 0
  356.          End
  357.        When Keyword = '*SHADOWCOLOR:'    then
  358.          SColor     = '1B'x'[' || Info || ';1;40m'
  359.        When Keyword = '*3D_EFECT:'       then do
  360.           D3_Efect = Translate(Info)
  361.           If D3_Efect \= 'N' then FColor_3D = '1B'x'[0;' || BGColor || ';30m'
  362.           Else FColor_3D = FColor
  363.          End
  364.        When Keyword = '*ALLDAYMESSAGE:'  then AllDayMsg = Translate(Info)
  365.        When Keyword = '*ENTERMESSAGE:'   then do
  366.           EnterMsg  = Translate(Info)
  367.           IF EnterMsg \= 'N' then
  368.             EnterMsg = '1B'x'[0;37m'Copies(' ', 29) || 'Bitte <Enter> druecken'
  369.          End
  370.        When Keyword = '*SPACES:'         then do
  371.           Spaces    = Info
  372.           If EnterMsg = 'N' then EnterMsg = Copies(' ', Spaces) || ''
  373.          End
  374.        When Keyword = '*ALIAS:'          then do
  375.           Alias     = LongInfo
  376.           If Translate(Alias) = 'N' then Alias = FName SLName
  377.         End
  378.        When Keyword = '*PAUSE:'          then Pause     = Translate(Info)
  379.        When Keyword = '*PAUSESIGN:'      then PauseSign = LongInfo
  380.        When Keyword = '*NEWHEADER:'      then do
  381.           Newhead = LongInfo
  382.           If Translate(NewHead) = 'N'   then do
  383.             NewHeader = '1B'x'[' || BGColor || ';1;33m' ||,
  384.                         ' Willkommen in der' || '1B'x'[' ||,
  385.                         BBSColor || 'm' BBSName || ' '
  386.             HeaderLength = 20 + Length(BBSName)
  387.           End
  388.           Else do
  389.             NewHead = ' ' || NewHead || ' '
  390.             NewHeader = '1B'x'[' || BGColor || ';1;33m' || Strip(NewHead)
  391.             HeaderLength = Length(NewHead)
  392.           End
  393.          End
  394.        When Keyword = '*NEWFOOTER:'      then do
  395.           If Translate(LongInfo) = 'N' then do
  396.             NewFooter = '1B'x'[40;1;33m' ||,
  397.                         'Viel Spass wuenscht Dir Dein SysOp'||,
  398.                         '1B'x'[' || BBSColor || 'm' Strip(Alias)
  399.             FooterLength = 37 + Length(Strip(Alias))
  400.           End
  401.           Else do
  402.             LongInfo = ' ' || LongInfo || ' '
  403.             NewFooter = '1B'x'[40;1;33m' Strip(LongInfo)
  404.             FooterLength = Length(LongInfo)
  405.           End
  406.         End
  407.        When Keyword = '*CALENDAR:'      then Calendar   = Info
  408.        When Keyword = '*CALTEXT:'       then do
  409.           CalText   = LongInfo
  410.           If Translate(CalText) = 'N' then do
  411.             Select
  412.               When Date('W') = 'Monday'    then Tag = 'Montag'
  413.               When Date('W') = 'Tuesday'   then Tag = 'Dienstag'
  414.               When Date('W') = 'Wednesday' then Tag = 'Mittwoch'
  415.               When Date('W') = 'Thursday'  then Tag = 'Donnerstag'
  416.               When Date('W') = 'Freyday'   then Tag = 'Freitag'
  417.               When Date('W') = 'Saturday'  then Tag = 'Samstag'
  418.               When Date('W') = 'Sunday'    then Tag = 'Sonntag'
  419.              Otherwise NOP
  420.             End
  421.             CalText = 'Kalenderblatt fuer' Tag || ', den:'
  422.           End
  423.          End
  424.        When Keyword = '*CALNUMSET:'     then do
  425.           NumSet    = Info
  426.           Select
  427.              When NumSet = 1 then Call Read_Number_Set1
  428.              When NumSet = 2 then Call Read_Number_Set2
  429.              When NumSet = 3 then Call Read_Number_Set3
  430.             Otherwise Read_Number_Set1
  431.           End
  432.         End
  433.        When Keyword = '*CALPAUSE:'      then do
  434.           CalPause  = Info
  435.           Select
  436.             When Translate(CalPause) = 'N' then CalPauseLine = ''
  437.             When (CalPause >= 1) | (CalPause <= 3)
  438.               then CalPauseLine = Copies(PauseSign, CalPause)
  439.             When CalPause > 3 then CalPauseLine = Copies(PauseSign, 3)
  440.             Otherwise CalPauseLine = ''
  441.           End
  442.         End
  443.        When Keyword = '*CALFILE:'       then CalFile    = Info
  444.        When Keyword = '*DAYS_2000:'     then Days_2000  = LongInfo
  445.        Otherwise NOP
  446.      End
  447.    End
  448.  Call Stream Cfg_File, 'C', 'Close'
  449. Return
  450.  
  451. /* --------------------------------------------------------------------- */
  452. /* Vorlagen.Txt bzw. Holy_Day.Txt lesen                                  */
  453. /* --------------------------------------------------------------------- */
  454.  
  455. Read_Date_File:
  456.  Parse Value Date('U') with MM '/' DD '/' YY
  457.  Say ' Reading date file...'
  458.  If Stream(D_File, 'C', 'Query Exist') = '' then do
  459.    Say ' Sorry, could not find ' || D_File
  460.    Say ' Please check your configuration!'
  461.    Exit
  462.  End
  463.  Call Stream D_File, 'C', 'Open read'
  464.    Do While Lines(D_File) = 1
  465.      Line = LineIn(D_File)
  466.      If (SubStr(Line, 1, 2) = '//') then Iterate
  467.      If Word(Line, 1) = MM || '-' || DD then do
  468.        Call Stream Tmp_File, 'C', 'Open write'
  469.          Do until Word(MLine, 1) = '/***/'
  470.            MLine = LineIn(D_File)
  471.            If MLine \= '/***/' then Call LineOut Tmp_File, MLine
  472.          End
  473.        Call Stream Tmp_File, 'C', 'Close'
  474.      End
  475.    End
  476.  Call Stream D_File, 'C', 'Close'
  477. Return
  478.  
  479. /* --------------------------------------------------------------------- */
  480. /* JederTag.Txt lesen                                                    */
  481. /* --------------------------------------------------------------------- */
  482.  
  483. Read_AllDays_File:
  484.  A_File = 'JederTag.Txt'
  485.  Say ' Reading all days file...'
  486.  If Stream(A_File, 'C', 'Query Exist') = '' then do
  487.    Say ' Sorry, could not find ' || A_File
  488.    Say ' Please check your configuration!'
  489.    Exit
  490.  End
  491.  Call Stream A_File, 'C', 'Open read'
  492.    C = 0; CNo = ''; LNo = 0
  493.    Do While Lines(A_File) = 1
  494.      LNo = LNo + 1
  495.      Line = LineIn(A_File)
  496.      If (SubStr(Line, 1, 2) = '//') then Iterate
  497.      If Word(Line, 1) = '/***/' then do
  498.        C = C + 1; A.C = LNo
  499.      End
  500.    End
  501.    TextNo = Random(1, C - 1)
  502.    StartLine = A.TextNo
  503.  Call Stream A_File, 'C', 'Close'
  504.  Call Stream A_File, 'C', 'Open read'
  505.    SearchLine = 0
  506.    Do While Lines(A_File) = 1
  507.      SearchLine = SearchLine + 1
  508.      Call LineIn(A_File)
  509.      If SearchLine = StartLine then do
  510.        Call Stream Tmp_File, 'C', 'Open write'
  511.          Do until Word(MLine, 1) = '/***/'
  512.            MLine = LineIn(A_File)
  513.            If MLine \= '/***/' then Call LineOut Tmp_File, MLine
  514.          End
  515.        Call Stream Tmp_File, 'C', 'Close'
  516.      End
  517.    End
  518.  Call Stream A_File, 'C', 'Close'
  519. Return
  520.  
  521. /* --------------------------------------------------------------------- */
  522. /* Tagesspruch einlesen                                                  */
  523. /* --------------------------------------------------------------------- */
  524.  
  525. Read_Day_File:
  526.  Say ' Reading daily file...'
  527.  Call Stream Tmp_File, 'C', 'Open read'
  528.    FirstLine = LineIn(Tmp_File)
  529.  Call Stream Tmp_File, 'C', 'Close'
  530.  FirstWord = Word(FirstLine, 1)
  531.  If SubStr(FirstWord,1,1) = '~' then TextForm = 'L'
  532.  Else TextForm = 'C'
  533.  Call Stream Tmp_File, 'C', 'Open read'
  534.    T = 0
  535.    Do While Lines(Tmp_File) = 1
  536.      T = T + 1; T1 = T - 1
  537.      MsgLine.T = LineIn(Tmp_File)
  538.      L.T = Length(MsgLine.T)
  539.    End
  540.    MsgLineLength = 0
  541.    Do I = 1 to T
  542.      If L.I > MsgLineLength then MsgLineLength = L.I
  543.    End
  544.  Call Stream Tmp_File, 'C', 'Close'
  545. Return
  546.  
  547. /* --------------------------------------------------------------------- */
  548. /* Kalenderspruch einlesen                                               */
  549. /* --------------------------------------------------------------------- */
  550.  
  551. Read_Cal_File:
  552.  Say ' Reading calendar file...'
  553.  If Stream(Tmp_File, 'C', 'Query Exist') = '' then do
  554.    C_LNo = 3
  555.    CalLine.1 = 'Fuer heute ist mir kein'
  556.    CalLine.2 = 'besonderes Ereignis bekannt.'
  557.    CalLine.3 = 'Ich wuensche noch einen schoenen Tag!'
  558.    Return
  559.  End
  560.  Call Stream Tmp_File, 'C', 'Open read'
  561.    C_LNo = 0
  562.    Do While Lines(Tmp_File) = 1
  563.      C_LNo = C_LNo + 1
  564.      CalLine.C_LNo = LineIn(Tmp_File)
  565.    End
  566.  Call Stream Tmp_File, 'C', 'Close'
  567. Return
  568.  
  569. /* --------------------------------------------------------------------- */
  570. /* Die Zahlen                                                            */
  571. /* --------------------------------------------------------------------- */
  572.  
  573.  
  574. Read_Number_Set1:
  575.  ZP = '∞'
  576.  Z.0.1 = '╓──╖'; Z.0.2 = '║  ║'; Z.0.3 = '╙──╜'
  577.  Z.1.1 = '  ─╖'; Z.1.2 = '   ║'; Z.1.3 = '   ╨'
  578.  Z.2.1 = '╓──╖'; Z.2.2 = '╓──╜'; Z.2.3 = '╙──╜'
  579.  Z.3.1 = '╓──╖'; Z.3.2 = '  ─╢'; Z.3.3 = '╙──╜'
  580.  Z.4.1 = '╥  ╥'; Z.4.2 = '╙──╢'; Z.4.3 = '   ╨'
  581.  Z.5.1 = '╓──╖'; Z.5.2 = '╙──╖'; Z.5.3 = '╙──╜'
  582.  Z.6.1 = '╓──╖'; Z.6.2 = '╟──╖'; Z.6.3 = '╙──╜'
  583.  Z.7.1 = '───╖'; Z.7.2 = '  ─╢'; Z.7.3 = '   ╨'
  584.  Z.8.1 = '╓──╖'; Z.8.2 = '╟──╢'; Z.8.3 = '╙──╜'
  585.  Z.9.1 = '╓──╖'; Z.9.2 = '╙──╢'; Z.9.3 = '╙──╜'
  586. Return
  587.  
  588. Read_Number_Set2:
  589.  ZP  = ' ▀'
  590.  Z.0.1 = ' █▀█'; Z.0.2 = ' █ █'; Z.0.3 = ' ▀▀▀'
  591.  Z.1.1 = ' ▄█ '; Z.1.2 = '  █ '; Z.1.3 = ' ▀▀▀'
  592.  Z.2.1 = ' ▀▀█'; Z.2.2 = ' █▀▀'; Z.2.3 = ' ▀▀▀'
  593.  Z.3.1 = ' ▀▀█'; Z.3.2 = '  ▀█'; Z.3.3 = ' ▀▀▀'
  594.  Z.4.1 = ' █ █'; Z.4.2 = ' ▀▀█'; Z.4.3 = '   ▀'
  595.  Z.5.1 = ' █▀▀'; Z.5.2 = ' ▀▀█'; Z.5.3 = ' ▀▀▀'
  596.  Z.6.1 = ' █▀▀'; Z.6.2 = ' █▀█'; Z.6.3 = ' ▀▀▀'
  597.  Z.7.1 = ' ▀▀█'; Z.7.2 = '  █ '; Z.7.3 = '  ▀ '
  598.  Z.8.1 = ' █▀█'; Z.8.2 = ' █▀█'; Z.8.3 = ' ▀▀▀'
  599.  Z.9.1 = ' █▀█'; Z.9.2 = ' ▀▀█'; Z.9.3 = ' ▀▀▀'
  600. Return
  601.  
  602. Read_Number_Set3:
  603.  ZP  = ' .'
  604.  Z.0.1 = ' ...'; Z.0.2 = ' : :'; Z.0.3 = ' :.:'
  605.  Z.1.1 = ' .. '; Z.1.2 = '  : '; Z.1.3 = ' .:.'
  606.  Z.2.1 = ' ...'; Z.2.2 = '  .:'; Z.2.3 = ' :..'
  607.  Z.3.1 = ' ...'; Z.3.2 = '  .:'; Z.3.3 = ' ..:'
  608.  Z.4.1 = ' : :'; Z.4.2 = ' :.:'; Z.4.3 = '   :'
  609.  Z.5.1 = ' ...'; Z.5.2 = ' :..'; Z.5.3 = ' ..:'
  610.  Z.6.1 = ' ...'; Z.6.2 = ' :..'; Z.6.3 = ' :.:'
  611.  Z.7.1 = ' ...'; Z.7.2 = '  .:'; Z.7.3 = '  : '
  612.  Z.8.1 = ' ...'; Z.8.2 = ' :.:'; Z.8.3 = ' :.:'
  613.  Z.9.1 = ' ...'; Z.9.2 = ' :.:'; Z.9.3 = ' ..:'
  614. Return
  615.  
  616. Interpret_Date:
  617.  M1 = SubStr(MM, 1, 1); M2 = SubStr(MM, 2, 1)
  618.  D1 = SubStr(DD, 1, 1); D2 = SubStr(DD, 2, 1)
  619.  Do I = 0 to 9
  620.    If I = D1 then do
  621.      Pos11 = Z.I.1; Pos12 = Z.I.2; Pos13 = Z.I.3
  622.    End
  623.  End
  624.  Do I = 0 to 9
  625.    If I = D2 then do
  626.      Pos21 = Z.I.1; Pos22 = Z.I.2; Pos23 = Z.I.3
  627.    End
  628.  End
  629.  Do I = 0 to 9
  630.    If I = M1 then do
  631.      Pos31 = Z.I.1; Pos32 = Z.I.2; Pos33 = Z.I.3
  632.    End
  633.  End
  634.  Do I = 0 to 9
  635.    If I = M2 then do
  636.      Pos41 = Z.I.1; Pos42 = Z.I.2; Pos43 = Z.I.3
  637.    End
  638.  End
  639. Return
  640.  
  641. FrameSet1:
  642.  ULC  = '┌' /* 218 */
  643.  URC  = '┐' /* 191 */
  644.  LLC  = '└' /* 192 */
  645.  LRC  = '┘' /* 217 */
  646.  Site = '│' /* 179 */
  647.  URow = '─' /* 196 */
  648.  LRow = '─' /* 196 */
  649. Return
  650.  
  651. FrameSet2:
  652.  ULC  = '╔' /* 201 */
  653.  URC  = '╗' /* 187 */
  654.  LLC  = '╚' /* 200 */
  655.  LRC  = '╝' /* 188 */
  656.  Site = '║' /* 186 */
  657.  URow = '═' /* 205 */
  658.  LRow = '═' /* 205 */
  659. Return
  660.  
  661. FrameSet3:
  662.  ULC  = '╓' /* 214 */
  663.  URC  = '╖' /* 183 */
  664.  LLC  = '╙' /* 211 */
  665.  LRC  = '╜' /* 189 */
  666.  Site = '║' /* 186 */
  667.  URow = '─' /* 196 */
  668.  LRow = '─' /* 196 */
  669. Return
  670.  
  671. FrameSet4:
  672.  ULC  = '╒' /* 213 */
  673.  URC  = '╕' /* 184 */
  674.  LLC  = '╘' /* 212 */
  675.  LRC  = '╛' /* 190 */
  676.  Site = '│' /* 179 */
  677.  URow = '═' /* 205 */
  678.  LRow = '═' /* 205 */
  679. Return
  680.  
  681. FrameSet5:
  682.  ULC  = '╔' /* 201 */
  683.  URC  = '╗' /* 187 */
  684.  LLC  = '╚' /* 200 */
  685.  LRC  = '╝' /* 188 */
  686.  Site = '│' /* 179 */
  687.  URow = '─' /* 196 */
  688.  LRow = '─' /* 196 */
  689. Return
  690.  
  691. FrameSet6:
  692.  ULC  = '+' /*  43 */
  693.  URC  = '+' /*  43 */
  694.  LLC  = '+' /*  43 */
  695.  LRC  = '+' /*  43 */
  696.  Site = '|' /* 124 */
  697.  URow = '-' /*  45 */
  698.  LRow = '-' /*  45 */
  699. Return
  700.  
  701. FrameSet7:
  702.  ULC  = '+' /*  43 */
  703.  URC  = '+' /*  43 */
  704.  LLC  = '+' /*  43 */
  705.  LRC  = '+' /*  43 */
  706.  Site = '!' /*  33 */
  707.  URow = '-' /*  45 */
  708.  LRow = '-' /*  45 */
  709. Return
  710.  
  711. FrameSet8:
  712.  ULC  = '█' /* 219 */
  713.  URC  = '█' /* 219 */
  714.  LLC  = '█' /* 219 */
  715.  LRC  = '█' /* 219 */
  716.  Site = '█' /* 219 */
  717.  URow = '▀' /* 223 */
  718.  LRow = '▄' /* 220 */
  719. Return
  720.  
  721. FrameSetX:
  722.  Parse Arg Info
  723.  ULC  = Info
  724.  URC  = Info
  725.  LLC  = Info
  726.  LRC  = Info
  727.  Site = Info
  728.  URow = Info
  729.  LRow = Info
  730. Return
  731.  
  732. /* --------------------------------------------------------------------- */
  733. /* Rexx initialisierten                                                  */
  734. /* --------------------------------------------------------------------- */
  735.  
  736. Init:
  737. /* Rexx initialisieren */
  738.  
  739.  If RxFuncQuery('SysLoadFuncs') then do
  740.    Call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  741.    Call SysLoadFuncs
  742.  End
  743.  
  744.  If RxFuncQuery('RxDate') then
  745.    Call RxFuncAdd 'RxDate', 'RexxDate', 'RxDate'
  746.  
  747. Return
  748.  
  749. /* --------------------------------------------------------------------- */
  750. /* Fehlerauswertung                                                      */
  751. /* --------------------------------------------------------------------- */
  752.  
  753. Halt:
  754.   Say '1B'x'[1;31;40m'               /* Setze Farbe hell Rot auf Schwarz */
  755.   Say 'Programm angehalten in Zeile:' sigl'.'
  756.   Bad_Code = sigl
  757.   Signal Bad_Running
  758. Return
  759.  
  760. NoValue:
  761.   Say '1B'x'[1;31;40m'               /* Setze Farbe hell Rot auf Schwarz */
  762.   Say 'Fehlender Wert in Zeile:' sigl'.'
  763.   Bad_Code = sigl
  764.   Signal Bad_Running
  765. Return
  766.  
  767. Syntax:
  768.   Say '1B'x'[1;31;40m'               /* Setze Farbe hell Rot auf Schwarz */
  769.   Say 'Program Syntax Fehler in Zeile:' sigl'.'
  770.   Bad_Code = sigl
  771.   Signal Bad_Running
  772. Return
  773.  
  774. Bad_Running:
  775.   Say '1B'x'[1;31;40m'               /* Setze Farbe hell Rot auf Schwarz */
  776.   Say 'Der Fehler ist:"'Sourceline(Bad_Code)'"'
  777.   Exit
  778. Return
  779.  
  780.