home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PCBOARD
/
USAPPL1A.ZIP
/
USATODAY.PPE
(
.txt
)
< prev
Wrap
PCBoard Programming Language Executable
|
1994-02-07
|
12KB
|
568 lines
;------------------------------------------------------------------------------
; .ss.
; `²²'
; .,sS$Ss,,s$ .,sS$$$Ss. .,sS$Ss,,s$ .ss. .sSs.
; .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
; $$$' .$$$' $$$²Sçsµ²' .$$$' .$$$'.$$$' .$$$' `$$b.
; $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$' ;$$$
; `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
; .sS²°$$$²²°"' d²°'
; .$$² .$$'
; $$$.,d$$'
; `²S$$S²'
;------------------------------------------------------------------------------
; P.P.L.X. 2.OO (C)1996 - Lone Runner / AEGiS CoRP'96
;------------------------------------------------------------------------------
; PPE 2.OO (plain) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Integer INTEGER005
String TSTRING001(19,20)
String TSTRING002(200)
String STRING003
String STRING004
String STRING005
String STRING006
String STRING007
String STRING008
String STRING009
String STRING010
String STRING011
String STRING012
String STRING013
String TSTRING014(19)
;------------------------------------------------------------------------------
FOpen 1, PPEPath() + "\HEADLINE.USA", 2, 0
If (Ferr(1)) Then
PrintLn "Error, Exiting..."
End
Endif
STRING004 = FileInf(PPEPath() + "\HEADLINE.USA", 2)
Log "User " + U_Name() + " into USATODAY PPL on node " + String(PcbNode()), 0
Cls
If (Exist(PPEPath() + "USALGO")) DispFile PPEPath() + "USALGO", 1 + 2 + 4
Newlines 3
Print " "
Wait
Print "@X0A Please wait while we build today's index@X0F"
STRING009 = Month(STRING004)
Select Case (STRING009)
Case 1
STRING009 = "January"
Case 2
STRING009 = "February"
Case 3
STRING009 = "March"
Case 4
STRING009 = "April"
Case 5
STRING009 = "May"
Case 6
STRING009 = "June"
Case 7
STRING009 = "July"
Case 8
STRING009 = "August"
Case 9
STRING009 = "September"
Case 10
STRING009 = "October"
Case 11
STRING009 = "November"
Case Else
STRING009 = "December"
End Select
STRING008 = Year(STRING004)
STRING007 = Day(STRING004)
STRING005 = Dow(STRING004)
Select Case (STRING005)
Case 1
STRING005 = "Monday"
STRING006 = "Sunday"
Case 2
STRING005 = "Tuesday"
STRING006 = "Monday"
Case 3
STRING005 = "Wednesday"
STRING006 = "Tuesday"
Case 4
STRING005 = "Thursday"
STRING006 = "Wednsday"
Case 5
STRING005 = "Friday"
STRING006 = "Thursday"
Case 6
STRING005 = "Saturday"
STRING006 = "Friday"
Case Else
STRING005 = "Sunday"
STRING006 = "Saturday"
End Select
FGet 1, TSTRING001(19, 1)
:LABEL001
If (Ferr(1)) Goto LABEL003
For INTEGER003 = 1 To 16
Print "."
Select Case (Left(TSTRING001(19, 1), 9))
Case "Advertisi"
TSTRING001(1, 1) = TSTRING001(19, 1)
INTEGER001 = 1
Case "Banking a"
TSTRING001(2, 1) = TSTRING001(19, 1)
INTEGER001 = 2
Case "Business "
TSTRING001(3, 1) = TSTRING001(19, 1)
INTEGER001 = 3
Case "Energy "
TSTRING001(4, 1) = TSTRING001(19, 1)
INTEGER001 = 4
Case "Health "
TSTRING001(5, 1) = TSTRING001(19, 1)
INTEGER001 = 5
Case "Insurance"
TSTRING001(6, 1) = TSTRING001(19, 1)
INTEGER001 = 6
Case "Internati"
TSTRING001(7, 1) = TSTRING001(19, 1)
INTEGER001 = 7
Case "News "
TSTRING001(8, 1) = TSTRING001(19, 1)
INTEGER001 = 8
Case "Personal "
TSTRING001(9, 1) = TSTRING001(19, 1)
INTEGER001 = 9
Case "Real Esta"
TSTRING001(10, 1) = TSTRING001(19, 1)
INTEGER001 = 10
Case "Sports "
TSTRING001(11, 1) = TSTRING001(19, 1)
INTEGER001 = 11
Case "Technolog"
TSTRING001(12, 1) = TSTRING001(19, 1)
INTEGER001 = 12
Case "Telecommu"
TSTRING001(13, 1) = TSTRING001(19, 1)
INTEGER001 = 13
Case "Travel "
TSTRING001(14, 1) = TSTRING001(19, 1)
INTEGER001 = 14
Case "Trends an"
TSTRING001(15, 1) = TSTRING001(19, 1)
INTEGER001 = 15
Case "Issues an"
TSTRING001(16, 1) = TSTRING001(19, 1)
INTEGER001 = 16
Case "And today"
TSTRING001(17, 1) = TSTRING001(19, 1)
STRING010 = Mid(TSTRING001(17, 1), 19, 79)
STRING010 = RTrim(STRING010, " ")
STRING010 = Upper(STRING010)
TSTRING001(17, 2) = STRING010
INTEGER001 = 17
INTEGER002 = 3
FOpen 3, PPEPath() + "\BONUS.USA", 2, 0
If (Ferr(3)) Then
PrintLn "Error, Exiting..."
End
Endif
FGet 3, TSTRING001(INTEGER001, INTEGER002)
FGet 3, TSTRING001(INTEGER001, INTEGER002)
FGet 3, TSTRING001(INTEGER001, INTEGER002)
FGet 3, TSTRING001(INTEGER001, INTEGER002)
FGet 3, TSTRING001(INTEGER001, INTEGER002)
FGet 3, TSTRING001(INTEGER001, INTEGER002)
:LABEL002
FGet 3, TSTRING001(INTEGER001, INTEGER002)
If (Left(TSTRING001(INTEGER001, INTEGER002), 9) == " ") Then
FGet 3, TSTRING001(INTEGER001, INTEGER002)
Inc TSTRING014(INTEGER001)
Inc INTEGER002
Endif
If (Left(TSTRING001(INTEGER001, INTEGER002 - 1), 9) == "Bonus edi") Then
Inc TSTRING014(INTEGER001)
FClose 3
Goto LABEL003
Endif
Goto LABEL002
End Select
For INTEGER002 = 2 To 20
FGet 1, TSTRING001(INTEGER001, INTEGER002)
Inc TSTRING014(INTEGER001)
If (Left(TSTRING001(INTEGER001, INTEGER002), 9) == " ") Then
Break
Endif
TSTRING001(INTEGER001, INTEGER002) = LTrim(TSTRING001(INTEGER001, INTEGER002), " ")
TSTRING001(INTEGER001, INTEGER002) = RTrim(TSTRING001(INTEGER001, INTEGER002), " ")
Next
FGet 1, TSTRING001(19, 1)
Goto LABEL001
Next
Goto LABEL001
:LABEL003
TSTRING014(18) = 6
TSTRING001(18, 1) = "Weather"
TSTRING001(18, 2) = "REGIONAL FORECAST:"
TSTRING001(18, 3) = "WORLD TEMPERATURES " + Upper(STRING005) + ":"
TSTRING001(18, 4) = "ACROSS THE NATION:"
TSTRING001(18, 5) = Upper(STRING006) + "'S EXTREMES"
TSTRING001(18, 6) = "24-HOUR TELEPHONE INFORMATION:"
STRING003 = RTrim(TSTRING001(16, 2), ":")
:LABEL004
Cls
If (Exist(PPEPath() + "HEADER")) DispFile PPEPath() + "HEADER", 1 + 2 + 4
If (AnsiOn()) Then
AnsiPos 44, 1
Print "@X1F" + STRING005 + ", " + STRING009 + " " + STRING007 + ", " + STRING008
AnsiPos 18, 2
Print "@X70" + STRING003
AnsiPos 18, 3
Print "@X4FBONUS - " + STRING010
AnsiPos 0, 4
If (Exist(PPEPath() + "MENU")) DispFile PPEPath() + "MENU", 1 + 2 + 4
Print "@X1F USATODAY PPL By: John Lundell UNREGISTERED Version 1.00b @X17@X07"
Endif
:LABEL005
AnsiPos 4, 14
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
Select Case (STRING011)
Case 1
INTEGER001 = 1
STRING013 = "ADVERTIS"
Goto LABEL007
Case 2
INTEGER001 = 2
STRING013 = "BANKING"
Goto LABEL007
Case 3
INTEGER001 = 3
STRING013 = "LEGAL"
Goto LABEL007
Case 4
INTEGER001 = 4
STRING013 = "ENERGY"
Goto LABEL007
Case 5
INTEGER001 = 5
STRING013 = "HEALTH"
Goto LABEL007
Case 6
INTEGER001 = 6
STRING013 = "INSURE"
Goto LABEL007
Case 7
INTEGER001 = 7
STRING013 = "INTERNTL"
Goto LABEL007
Case 8
INTEGER001 = 8
STRING013 = "NEWS"
Goto LABEL007
Case 9
INTEGER001 = 9
STRING013 = "PERSONAL"
Goto LABEL007
Case 10
INTEGER001 = 10
STRING013 = "REALTORS"
Goto LABEL007
Case 11
INTEGER001 = 11
STRING013 = "SPORTS"
Goto LABEL007
Case 12
INTEGER001 = 12
STRING013 = "TECHNOL"
Goto LABEL007
Case 13
INTEGER001 = 13
STRING013 = "TELECOM"
Goto LABEL007
Case 14
INTEGER001 = 14
STRING013 = "TRAVEL"
Goto LABEL007
Case 15
INTEGER001 = 15
STRING013 = "TRENDS"
Goto LABEL007
Case 16
INTEGER001 = 16
STRING013 = "ISSUES"
Goto LABEL007
Case 17
INTEGER001 = 17
STRING013 = "BONUS"
Goto LABEL007
Case 18
INTEGER001 = 18
STRING013 = "WEATHER"
Goto LABEL007
Case "H"
Goto LABEL006
Case "Q"
Goto LABEL013
Case ""
Goto LABEL005
End Select
:LABEL006
Cls
If (Exist(PPEPath() + "HELP")) DispFile PPEPath() + "HELP", 1 + 2 + 4
Wait
Goto LABEL004
:LABEL007
Cls
If (Exist(PPEPath() + "HEADER")) DispFile PPEPath() + "HEADER", 1 + 2 + 4
If (AnsiOn()) Then
AnsiPos 44, 1
Print "@X1F" + STRING005 + ", " + STRING009 + " " + STRING007 + ", " + STRING008
Endif
AnsiPos 5, 5
Color 15
INTEGER003 = 6
INTEGER004 = 1
For INTEGER002 = 2 To TSTRING014(INTEGER001)
Print "@X0A[@X0F"
If (INTEGER004 < 10) Then
Print " "
Endif
Print INTEGER004
Print "@X0A]@X0F "
Print RTrim(TSTRING001(INTEGER001, INTEGER002), ":")
AnsiPos 5, INTEGER003
Inc INTEGER003
Inc INTEGER004
Next
FOpen 2, PPEPath() + "\" + STRING013 + ".USA", 2, 0
If (Ferr(2)) Then
PrintLn "Error, Exiting..."
End
Endif
Newline
Print " [@X0EM@X0F]@X0Eain Menu@X0F, [@X0EQ@X0F]@X0Euit@X0F, [@X0EH@X0F]@X0Eelp@X0F, [@X0E1@X0F-@X0E"
Print TSTRING014(INTEGER001) - 1
InputStr "@X0F],@X0E Your Subject Menu Choice: _", STRING012, 15, 20, "0123456789QHM", 2 + 4 + 8
Select Case (STRING012)
Case ""
FClose 2
STRING011 = ""
Goto LABEL004
Case "Q"
FClose 2
STRING011 = ""
Goto LABEL013
Case "H"
FClose 2
STRING011 = ""
Goto LABEL006
Case "M"
FClose 2
STRING011 = ""
Goto LABEL004
End Select
If (INTEGER001 == 18) Then
Goto LABEL010
Endif
FGet 2, TSTRING002(1)
TSTRING002(1) = LTrim(TSTRING002(1), " ")
TSTRING002(1) = RTrim(TSTRING002(1), " ")
:LABEL008
If (Ferr(2)) Goto LABEL009
If (INTEGER001 == 17) Then
If (STRING012 == 1) Then
FGet 2, TSTRING002(INTEGER002)
FGet 2, TSTRING002(INTEGER002)
FGet 2, TSTRING002(INTEGER002)
FGet 2, TSTRING002(INTEGER002)
Else
If (TSTRING002(1) == TSTRING001(INTEGER001, STRING012 + 1)) Then
Endif
Endif
For INTEGER002 = 2 To 100
FGet 2, TSTRING002(INTEGER002)
Inc INTEGER005
If (Left(TSTRING002(INTEGER002), 9) == " ") Then
Goto LABEL012
Endif
TSTRING002(INTEGER002) = RTrim(TSTRING002(INTEGER002), " ")
Next
Endif
FGet 2, TSTRING002(1)
TSTRING002(1) = LTrim(TSTRING002(1), " ")
TSTRING002(1) = RTrim(TSTRING002(1), " ")
Goto LABEL008
Goto LABEL008
:LABEL009
Goto LABEL012
:LABEL010
FGet 2, TSTRING002(1)
TSTRING002(1) = LTrim(TSTRING002(1), " ")
TSTRING002(1) = RTrim(TSTRING002(1), " ")
:LABEL011
If (Ferr(2)) Goto LABEL012
If (Left(TSTRING002(1), 9) == Left(TSTRING001(INTEGER001, STRING012 + 1), 9)) Then
For INTEGER002 = 2 To 100
FGet 2, TSTRING002(INTEGER002)
Inc INTEGER005
If (Left(TSTRING002(INTEGER002), 9) == "WORLD TEM") Then
Goto LABEL012
Endif
If (Left(TSTRING002(INTEGER002), 9) == "ACROSS TH") Then
Goto LABEL012
Endif
If (Left(TSTRING002(INTEGER002), 6) == Left(Upper(STRING006), 6)) Then
Goto LABEL012
Endif
If (Left(TSTRING002(INTEGER002), 9) == "24-HOUR T") Then
Goto LABEL012
Endif
If (Left(TSTRING002(INTEGER002), 9) == "Weather E") Then
Goto LABEL012
Endif
TSTRING002(INTEGER002) = RTrim(TSTRING002(INTEGER002), " ")
Next
Endif
FGet 2, TSTRING002(1)
TSTRING002(1) = LTrim(TSTRING002(1), " ")
TSTRING002(1) = RTrim(TSTRING002(1), " ")
Goto LABEL011
Goto LABEL011
:LABEL012
Cls
If (Exist(PPEPath() + "HEADER")) DispFile PPEPath() + "HEADER", 1 + 2 + 4
If (AnsiOn()) Then
AnsiPos 44, 1
Print "@X1F" + STRING005 + ", " + STRING009 + " " + STRING007 + ", " + STRING008
Endif
INTEGER003 = 6
AnsiPos 5, INTEGER003
Color 15
If (INTEGER005 == 0) Then
PrintLn "@X0C Gannett News Media Made An Error in the HEADERS.USA File...@X0F"
PrintLn " Future versions of the USAToday PPL will correct for their "
PrintLn " mistakes. Check for this 'topic' to actually be available "
PrintLn " under a previous Main Menu choice. Sorry! "
Newlines 2
Wait
Else
StartDisp 1
For INTEGER002 = 1 To INTEGER005
AnsiPos 5, INTEGER003
If (INTEGER002 == 1) Then
Color 14
If ((INTEGER001 == 18) && (Left(TSTRING002(INTEGER002), 6) == Left(Upper(STRING006), 6))) Then
Color 15
Dec INTEGER003
Endif
Else
Color 15
Endif
PrintLn TSTRING002(INTEGER002)
If (INTEGER002 == 1) Then
Inc INTEGER003
Endif
Inc INTEGER003
If (INTEGER003 > 20) Then
Newline
Wait
For INTEGER003 = 6 To 21
AnsiPos 5, INTEGER003
PrintLn " "
Next
INTEGER003 = 6
Endif
Next
Newlines 2
Wait
Endif
FClose 2
StartDisp 2
INTEGER005 = 0
STRING012 = ""
STRING011 = ""
Goto LABEL007
:LABEL013
Cls
End
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 4 End
; 6 Cls
; 5 Wait
; 5 Color
; 205 Goto
; 151 Let
; 16 Print
; 9 PrintLn
; 101 If
; 6 DispFile
; 3 FOpen
; 6 FClose
; 21 FGet
; 2 StartDisp
; 1 Log
; 2 InputStr
; 10 Inc
; 1 Dec
; 2 Newline
; 3 Newlines
; 12 AnsiPos
;
;
; ■ Functions used :
;
; 72 +
; 2 -
; 78 ==
; 8 <
; 7 <=
; 1 >
; 14 >=
; 95 !
; 15 &&
; 7 ||
; 5 Upper()
; 1 Mid()
; 31 Left()
; 6 Ferr()
; 5 LTrim()
; 10 RTrim()
; 1 U_Name()
; 1 Year()
; 1 Month()
; 1 Day()
; 1 Dow()
; 1 String()
; 16 PPEPath()
; 1 PcbNode()
; 6 Exist()
; 3 AnsiOn()
; 1 FileInf()
;
;------------------------------------------------------------------------------
;
; Analysis flags : No flag
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 7 For/Next
; 0 While/EndWhile
; 26 If/Then or If/Then/Else
; 5 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------