home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PCBOARD / USAPPL1A.ZIP / USATODAY.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1994-02-07  |  12KB  |  568 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 2.OO (plain) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     String   TSTRING001(19,20)
  25.     String   TSTRING002(200)
  26.     String   STRING003
  27.     String   STRING004
  28.     String   STRING005
  29.     String   STRING006
  30.     String   STRING007
  31.     String   STRING008
  32.     String   STRING009
  33.     String   STRING010
  34.     String   STRING011
  35.     String   STRING012
  36.     String   STRING013
  37.     String   TSTRING014(19)
  38.  
  39. ;------------------------------------------------------------------------------
  40.  
  41.     FOpen 1, PPEPath() + "\HEADLINE.USA", 2, 0
  42.     If (Ferr(1)) Then
  43.         PrintLn "Error, Exiting..."
  44.         End
  45.     Endif
  46.     STRING004 = FileInf(PPEPath() + "\HEADLINE.USA", 2)
  47.     Log "User " + U_Name() + " into USATODAY PPL on node " + String(PcbNode()), 0
  48.     Cls
  49.     If (Exist(PPEPath() + "USALGO")) DispFile PPEPath() + "USALGO", 1 + 2 + 4
  50.     Newlines 3
  51.     Print "                        "
  52.     Wait
  53.     Print "@X0A          Please wait while we build today's index@X0F"
  54.     STRING009 = Month(STRING004)
  55.     Select Case (STRING009)
  56.         Case 1
  57.             STRING009 = "January"
  58.         Case 2
  59.             STRING009 = "February"
  60.         Case 3
  61.             STRING009 = "March"
  62.         Case 4
  63.             STRING009 = "April"
  64.         Case 5
  65.             STRING009 = "May"
  66.         Case 6
  67.             STRING009 = "June"
  68.         Case 7
  69.             STRING009 = "July"
  70.         Case 8
  71.             STRING009 = "August"
  72.         Case 9
  73.             STRING009 = "September"
  74.         Case 10
  75.             STRING009 = "October"
  76.         Case 11
  77.             STRING009 = "November"
  78.         Case Else
  79.             STRING009 = "December"
  80.     End Select
  81.     STRING008 = Year(STRING004)
  82.     STRING007 = Day(STRING004)
  83.     STRING005 = Dow(STRING004)
  84.     Select Case (STRING005)
  85.         Case 1
  86.             STRING005 = "Monday"
  87.             STRING006 = "Sunday"
  88.         Case 2
  89.             STRING005 = "Tuesday"
  90.             STRING006 = "Monday"
  91.         Case 3
  92.             STRING005 = "Wednesday"
  93.             STRING006 = "Tuesday"
  94.         Case 4
  95.             STRING005 = "Thursday"
  96.             STRING006 = "Wednsday"
  97.         Case 5
  98.             STRING005 = "Friday"
  99.             STRING006 = "Thursday"
  100.         Case 6
  101.             STRING005 = "Saturday"
  102.             STRING006 = "Friday"
  103.         Case Else
  104.             STRING005 = "Sunday"
  105.             STRING006 = "Saturday"
  106.     End Select
  107.     FGet 1, TSTRING001(19, 1)
  108.     :LABEL001
  109.     If (Ferr(1)) Goto LABEL003
  110.     For INTEGER003 = 1 To 16
  111.         Print "."
  112.         Select Case (Left(TSTRING001(19, 1), 9))
  113.             Case "Advertisi"
  114.                 TSTRING001(1, 1) = TSTRING001(19, 1)
  115.                 INTEGER001 = 1
  116.             Case "Banking a"
  117.                 TSTRING001(2, 1) = TSTRING001(19, 1)
  118.                 INTEGER001 = 2
  119.             Case "Business "
  120.                 TSTRING001(3, 1) = TSTRING001(19, 1)
  121.                 INTEGER001 = 3
  122.             Case "Energy   "
  123.                 TSTRING001(4, 1) = TSTRING001(19, 1)
  124.                 INTEGER001 = 4
  125.             Case "Health   "
  126.                 TSTRING001(5, 1) = TSTRING001(19, 1)
  127.                 INTEGER001 = 5
  128.             Case "Insurance"
  129.                 TSTRING001(6, 1) = TSTRING001(19, 1)
  130.                 INTEGER001 = 6
  131.             Case "Internati"
  132.                 TSTRING001(7, 1) = TSTRING001(19, 1)
  133.                 INTEGER001 = 7
  134.             Case "News     "
  135.                 TSTRING001(8, 1) = TSTRING001(19, 1)
  136.                 INTEGER001 = 8
  137.             Case "Personal "
  138.                 TSTRING001(9, 1) = TSTRING001(19, 1)
  139.                 INTEGER001 = 9
  140.             Case "Real Esta"
  141.                 TSTRING001(10, 1) = TSTRING001(19, 1)
  142.                 INTEGER001 = 10
  143.             Case "Sports   "
  144.                 TSTRING001(11, 1) = TSTRING001(19, 1)
  145.                 INTEGER001 = 11
  146.             Case "Technolog"
  147.                 TSTRING001(12, 1) = TSTRING001(19, 1)
  148.                 INTEGER001 = 12
  149.             Case "Telecommu"
  150.                 TSTRING001(13, 1) = TSTRING001(19, 1)
  151.                 INTEGER001 = 13
  152.             Case "Travel   "
  153.                 TSTRING001(14, 1) = TSTRING001(19, 1)
  154.                 INTEGER001 = 14
  155.             Case "Trends an"
  156.                 TSTRING001(15, 1) = TSTRING001(19, 1)
  157.                 INTEGER001 = 15
  158.             Case "Issues an"
  159.                 TSTRING001(16, 1) = TSTRING001(19, 1)
  160.                 INTEGER001 = 16
  161.             Case "And today"
  162.                 TSTRING001(17, 1) = TSTRING001(19, 1)
  163.                 STRING010 = Mid(TSTRING001(17, 1), 19, 79)
  164.                 STRING010 = RTrim(STRING010, " ")
  165.                 STRING010 = Upper(STRING010)
  166.                 TSTRING001(17, 2) = STRING010
  167.                 INTEGER001 = 17
  168.                 INTEGER002 = 3
  169.                 FOpen 3, PPEPath() + "\BONUS.USA", 2, 0
  170.                 If (Ferr(3)) Then
  171.                     PrintLn "Error, Exiting..."
  172.                     End
  173.                 Endif
  174.                 FGet 3, TSTRING001(INTEGER001, INTEGER002)
  175.                 FGet 3, TSTRING001(INTEGER001, INTEGER002)
  176.                 FGet 3, TSTRING001(INTEGER001, INTEGER002)
  177.                 FGet 3, TSTRING001(INTEGER001, INTEGER002)
  178.                 FGet 3, TSTRING001(INTEGER001, INTEGER002)
  179.                 FGet 3, TSTRING001(INTEGER001, INTEGER002)
  180.                 :LABEL002
  181.                 FGet 3, TSTRING001(INTEGER001, INTEGER002)
  182.                 If (Left(TSTRING001(INTEGER001, INTEGER002), 9) == "         ") Then
  183.                     FGet 3, TSTRING001(INTEGER001, INTEGER002)
  184.                     Inc TSTRING014(INTEGER001)
  185.                     Inc INTEGER002
  186.                 Endif
  187.                 If (Left(TSTRING001(INTEGER001, INTEGER002 - 1), 9) == "Bonus edi") Then
  188.                     Inc TSTRING014(INTEGER001)
  189.                     FClose 3
  190.                     Goto LABEL003
  191.                 Endif
  192.                 Goto LABEL002
  193.         End Select
  194.         For INTEGER002 = 2 To 20
  195.             FGet 1, TSTRING001(INTEGER001, INTEGER002)
  196.             Inc TSTRING014(INTEGER001)
  197.             If (Left(TSTRING001(INTEGER001, INTEGER002), 9) == "         ") Then
  198.                 Break
  199.             Endif
  200.             TSTRING001(INTEGER001, INTEGER002) = LTrim(TSTRING001(INTEGER001, INTEGER002), " ")
  201.             TSTRING001(INTEGER001, INTEGER002) = RTrim(TSTRING001(INTEGER001, INTEGER002), " ")
  202.         Next
  203.         FGet 1, TSTRING001(19, 1)
  204.         Goto LABEL001
  205.     Next
  206.     Goto LABEL001
  207.     :LABEL003
  208.     TSTRING014(18) = 6
  209.     TSTRING001(18, 1) = "Weather"
  210.     TSTRING001(18, 2) = "REGIONAL FORECAST:"
  211.     TSTRING001(18, 3) = "WORLD TEMPERATURES " + Upper(STRING005) + ":"
  212.     TSTRING001(18, 4) = "ACROSS THE NATION:"
  213.     TSTRING001(18, 5) = Upper(STRING006) + "'S EXTREMES"
  214.     TSTRING001(18, 6) = "24-HOUR TELEPHONE INFORMATION:"
  215.     STRING003 = RTrim(TSTRING001(16, 2), ":")
  216.     :LABEL004
  217.     Cls
  218.     If (Exist(PPEPath() + "HEADER")) DispFile PPEPath() + "HEADER", 1 + 2 + 4
  219.     If (AnsiOn()) Then
  220.         AnsiPos 44, 1
  221.         Print "@X1F" + STRING005 + ", " + STRING009 + " " + STRING007 + ", " + STRING008
  222.         AnsiPos 18, 2
  223.         Print "@X70" + STRING003
  224.         AnsiPos 18, 3
  225.         Print "@X4FBONUS - " + STRING010
  226.         AnsiPos 0, 4
  227.         If (Exist(PPEPath() + "MENU")) DispFile PPEPath() + "MENU", 1 + 2 + 4
  228.         Print "@X1F  USATODAY PPL By: John Lundell                    UNREGISTERED Version 1.00b  @X17@X07"
  229.     Endif
  230.     :LABEL005
  231.     AnsiPos 4, 14
  232.     InputStr "@X0A[@X0FQ@X0A]uit, [@X0FH@X0A]elp, [@X0F1@X0A-@X0F18@X0A], @X0AYour @X0FU@X0BS@X09@X0CA@X0FToday@X0A Decisionline Main Menu Choice: _", STRING011, 15, 20, "0123456789QH", 2 + 4 + 8
  233.     Select Case (STRING011)
  234.         Case 1
  235.             INTEGER001 = 1
  236.             STRING013 = "ADVERTIS"
  237.             Goto LABEL007
  238.         Case 2
  239.             INTEGER001 = 2
  240.             STRING013 = "BANKING"
  241.             Goto LABEL007
  242.         Case 3
  243.             INTEGER001 = 3
  244.             STRING013 = "LEGAL"
  245.             Goto LABEL007
  246.         Case 4
  247.             INTEGER001 = 4
  248.             STRING013 = "ENERGY"
  249.             Goto LABEL007
  250.         Case 5
  251.             INTEGER001 = 5
  252.             STRING013 = "HEALTH"
  253.             Goto LABEL007
  254.         Case 6
  255.             INTEGER001 = 6
  256.             STRING013 = "INSURE"
  257.             Goto LABEL007
  258.         Case 7
  259.             INTEGER001 = 7
  260.             STRING013 = "INTERNTL"
  261.             Goto LABEL007
  262.         Case 8
  263.             INTEGER001 = 8
  264.             STRING013 = "NEWS"
  265.             Goto LABEL007
  266.         Case 9
  267.             INTEGER001 = 9
  268.             STRING013 = "PERSONAL"
  269.             Goto LABEL007
  270.         Case 10
  271.             INTEGER001 = 10
  272.             STRING013 = "REALTORS"
  273.             Goto LABEL007
  274.         Case 11
  275.             INTEGER001 = 11
  276.             STRING013 = "SPORTS"
  277.             Goto LABEL007
  278.         Case 12
  279.             INTEGER001 = 12
  280.             STRING013 = "TECHNOL"
  281.             Goto LABEL007
  282.         Case 13
  283.             INTEGER001 = 13
  284.             STRING013 = "TELECOM"
  285.             Goto LABEL007
  286.         Case 14
  287.             INTEGER001 = 14
  288.             STRING013 = "TRAVEL"
  289.             Goto LABEL007
  290.         Case 15
  291.             INTEGER001 = 15
  292.             STRING013 = "TRENDS"
  293.             Goto LABEL007
  294.         Case 16
  295.             INTEGER001 = 16
  296.             STRING013 = "ISSUES"
  297.             Goto LABEL007
  298.         Case 17
  299.             INTEGER001 = 17
  300.             STRING013 = "BONUS"
  301.             Goto LABEL007
  302.         Case 18
  303.             INTEGER001 = 18
  304.             STRING013 = "WEATHER"
  305.             Goto LABEL007
  306.         Case "H"
  307.             Goto LABEL006
  308.         Case "Q"
  309.             Goto LABEL013
  310.         Case ""
  311.             Goto LABEL005
  312.     End Select
  313.     :LABEL006
  314.     Cls
  315.     If (Exist(PPEPath() + "HELP")) DispFile PPEPath() + "HELP", 1 + 2 + 4
  316.     Wait
  317.     Goto LABEL004
  318.     :LABEL007
  319.     Cls
  320.     If (Exist(PPEPath() + "HEADER")) DispFile PPEPath() + "HEADER", 1 + 2 + 4
  321.     If (AnsiOn()) Then
  322.         AnsiPos 44, 1
  323.         Print "@X1F" + STRING005 + ", " + STRING009 + " " + STRING007 + ", " + STRING008
  324.     Endif
  325.     AnsiPos 5, 5
  326.     Color 15
  327.     INTEGER003 = 6
  328.     INTEGER004 = 1
  329.     For INTEGER002 = 2 To TSTRING014(INTEGER001)
  330.         Print "@X0A[@X0F"
  331.         If (INTEGER004 < 10) Then
  332.             Print " "
  333.         Endif
  334.         Print INTEGER004
  335.         Print "@X0A]@X0F  "
  336.         Print RTrim(TSTRING001(INTEGER001, INTEGER002), ":")
  337.         AnsiPos 5, INTEGER003
  338.         Inc INTEGER003
  339.         Inc INTEGER004
  340.     Next
  341.     FOpen 2, PPEPath() + "\" + STRING013 + ".USA", 2, 0
  342.     If (Ferr(2)) Then
  343.         PrintLn "Error, Exiting..."
  344.         End
  345.     Endif
  346.     Newline
  347.     Print "  [@X0EM@X0F]@X0Eain Menu@X0F, [@X0EQ@X0F]@X0Euit@X0F, [@X0EH@X0F]@X0Eelp@X0F, [@X0E1@X0F-@X0E"
  348.     Print TSTRING014(INTEGER001) - 1
  349.     InputStr "@X0F],@X0E Your Subject Menu Choice: _", STRING012, 15, 20, "0123456789QHM", 2 + 4 + 8
  350.     Select Case (STRING012)
  351.         Case ""
  352.             FClose 2
  353.             STRING011 = ""
  354.             Goto LABEL004
  355.         Case "Q"
  356.             FClose 2
  357.             STRING011 = ""
  358.             Goto LABEL013
  359.         Case "H"
  360.             FClose 2
  361.             STRING011 = ""
  362.             Goto LABEL006
  363.         Case "M"
  364.             FClose 2
  365.             STRING011 = ""
  366.             Goto LABEL004
  367.     End Select
  368.     If (INTEGER001 == 18) Then
  369.         Goto LABEL010
  370.     Endif
  371.     FGet 2, TSTRING002(1)
  372.     TSTRING002(1) = LTrim(TSTRING002(1), " ")
  373.     TSTRING002(1) = RTrim(TSTRING002(1), " ")
  374.     :LABEL008
  375.     If (Ferr(2)) Goto LABEL009
  376.     If (INTEGER001 == 17) Then
  377.         If (STRING012 == 1) Then
  378.             FGet 2, TSTRING002(INTEGER002)
  379.             FGet 2, TSTRING002(INTEGER002)
  380.             FGet 2, TSTRING002(INTEGER002)
  381.             FGet 2, TSTRING002(INTEGER002)
  382.         Else
  383.             If (TSTRING002(1) == TSTRING001(INTEGER001, STRING012 + 1)) Then
  384.             Endif
  385.         Endif
  386.         For INTEGER002 = 2 To 100
  387.             FGet 2, TSTRING002(INTEGER002)
  388.             Inc INTEGER005
  389.             If (Left(TSTRING002(INTEGER002), 9) == "         ") Then
  390.                 Goto LABEL012
  391.             Endif
  392.             TSTRING002(INTEGER002) = RTrim(TSTRING002(INTEGER002), " ")
  393.         Next
  394.     Endif
  395.     FGet 2, TSTRING002(1)
  396.     TSTRING002(1) = LTrim(TSTRING002(1), " ")
  397.     TSTRING002(1) = RTrim(TSTRING002(1), " ")
  398.     Goto LABEL008
  399.     Goto LABEL008
  400.     :LABEL009
  401.     Goto LABEL012
  402.     :LABEL010
  403.     FGet 2, TSTRING002(1)
  404.     TSTRING002(1) = LTrim(TSTRING002(1), " ")
  405.     TSTRING002(1) = RTrim(TSTRING002(1), " ")
  406.     :LABEL011
  407.     If (Ferr(2)) Goto LABEL012
  408.     If (Left(TSTRING002(1), 9) == Left(TSTRING001(INTEGER001, STRING012 + 1), 9)) Then
  409.         For INTEGER002 = 2 To 100
  410.             FGet 2, TSTRING002(INTEGER002)
  411.             Inc INTEGER005
  412.             If (Left(TSTRING002(INTEGER002), 9) == "WORLD TEM") Then
  413.                 Goto LABEL012
  414.             Endif
  415.             If (Left(TSTRING002(INTEGER002), 9) == "ACROSS TH") Then
  416.                 Goto LABEL012
  417.             Endif
  418.             If (Left(TSTRING002(INTEGER002), 6) == Left(Upper(STRING006), 6)) Then
  419.                 Goto LABEL012
  420.             Endif
  421.             If (Left(TSTRING002(INTEGER002), 9) == "24-HOUR T") Then
  422.                 Goto LABEL012
  423.             Endif
  424.             If (Left(TSTRING002(INTEGER002), 9) == "Weather E") Then
  425.                 Goto LABEL012
  426.             Endif
  427.             TSTRING002(INTEGER002) = RTrim(TSTRING002(INTEGER002), " ")
  428.         Next
  429.     Endif
  430.     FGet 2, TSTRING002(1)
  431.     TSTRING002(1) = LTrim(TSTRING002(1), " ")
  432.     TSTRING002(1) = RTrim(TSTRING002(1), " ")
  433.     Goto LABEL011
  434.     Goto LABEL011
  435.     :LABEL012
  436.     Cls
  437.     If (Exist(PPEPath() + "HEADER")) DispFile PPEPath() + "HEADER", 1 + 2 + 4
  438.     If (AnsiOn()) Then
  439.         AnsiPos 44, 1
  440.         Print "@X1F" + STRING005 + ", " + STRING009 + " " + STRING007 + ", " + STRING008
  441.     Endif
  442.     INTEGER003 = 6
  443.     AnsiPos 5, INTEGER003
  444.     Color 15
  445.     If (INTEGER005 == 0) Then
  446.         PrintLn "@X0C Gannett News Media Made An Error in the HEADERS.USA File...@X0F"
  447.         PrintLn "     Future versions of the USAToday PPL will correct for their "
  448.         PrintLn "     mistakes.  Check for this 'topic' to actually be available "
  449.         PrintLn "     under a previous Main Menu choice.  Sorry!                 "
  450.         Newlines 2
  451.         Wait
  452.     Else
  453.         StartDisp 1
  454.         For INTEGER002 = 1 To INTEGER005
  455.             AnsiPos 5, INTEGER003
  456.             If (INTEGER002 == 1) Then
  457.                 Color 14
  458.                 If ((INTEGER001 == 18) && (Left(TSTRING002(INTEGER002), 6) == Left(Upper(STRING006), 6))) Then
  459.                     Color 15
  460.                     Dec INTEGER003
  461.                 Endif
  462.             Else
  463.                 Color 15
  464.             Endif
  465.             PrintLn TSTRING002(INTEGER002)
  466.             If (INTEGER002 == 1) Then
  467.                 Inc INTEGER003
  468.             Endif
  469.             Inc INTEGER003
  470.             If (INTEGER003 > 20) Then
  471.                 Newline
  472.                 Wait
  473.                 For INTEGER003 = 6 To 21
  474.                     AnsiPos 5, INTEGER003
  475.                     PrintLn "                                                                                              "
  476.                 Next
  477.                 INTEGER003 = 6
  478.             Endif
  479.         Next
  480.         Newlines 2
  481.         Wait
  482.     Endif
  483.     FClose 2
  484.     StartDisp 2
  485.     INTEGER005 = 0
  486.     STRING012 = ""
  487.     STRING011 = ""
  488.     Goto LABEL007
  489.     :LABEL013
  490.     Cls
  491.     End
  492.  
  493. ;------------------------------------------------------------------------------
  494. ;
  495. ; Usage report (before postprocessing)
  496. ;
  497. ; ■ Statements used :
  498. ;
  499. ;    4       End
  500. ;    6       Cls
  501. ;    5       Wait
  502. ;    5       Color 
  503. ;    205     Goto 
  504. ;    151     Let 
  505. ;    16      Print 
  506. ;    9       PrintLn 
  507. ;    101     If 
  508. ;    6       DispFile 
  509. ;    3       FOpen 
  510. ;    6       FClose 
  511. ;    21      FGet 
  512. ;    2       StartDisp 
  513. ;    1       Log 
  514. ;    2       InputStr 
  515. ;    10      Inc 
  516. ;    1       Dec 
  517. ;    2       Newline
  518. ;    3       Newlines 
  519. ;    12      AnsiPos 
  520. ;
  521. ;
  522. ; ■ Functions used :
  523. ;
  524. ;    72      +
  525. ;    2       -
  526. ;    78      ==
  527. ;    8       <
  528. ;    7       <=
  529. ;    1       >
  530. ;    14      >=
  531. ;    95      !
  532. ;    15      &&
  533. ;    7       ||
  534. ;    5       Upper()
  535. ;    1       Mid()
  536. ;    31      Left()
  537. ;    6       Ferr()
  538. ;    5       LTrim()
  539. ;    10      RTrim()
  540. ;    1       U_Name()
  541. ;    1       Year()
  542. ;    1       Month()
  543. ;    1       Day()
  544. ;    1       Dow()
  545. ;    1       String()
  546. ;    16      PPEPath()
  547. ;    1       PcbNode()
  548. ;    6       Exist()
  549. ;    3       AnsiOn()
  550. ;    1       FileInf()
  551. ;
  552. ;------------------------------------------------------------------------------
  553. ;
  554. ; Analysis flags : No flag
  555. ;
  556. ;------------------------------------------------------------------------------
  557. ;
  558. ; Postprocessing report
  559. ;
  560. ;    7       For/Next
  561. ;    0       While/EndWhile
  562. ;    26      If/Then or If/Then/Else
  563. ;    5       Select Case
  564. ;
  565. ;------------------------------------------------------------------------------
  566. ;                 AEGiS Corp - Break the routines, code against the machines!
  567. ;------------------------------------------------------------------------------
  568.