home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PCBOARD / OS178B.ZIP / ONSALE.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1994-01-29  |  5KB  |  296 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 1.OO (plain) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     Integer  INTEGER006
  25.     Integer  INTEGER007
  26.     String   STRING001
  27.     String   STRING002
  28.     String   TSTRING003(7)
  29.     String   STRING004
  30.     String   STRING005
  31.     String   STRING006
  32.     String   STRING007
  33.     String   STRING008
  34.     String   STRING009
  35.     String   STRING010
  36.     String   STRING011
  37.     String   STRING012
  38.     String   STRING013
  39.     String   STRING014
  40.     String   STRING015
  41.     String   STRING016
  42.  
  43. ;------------------------------------------------------------------------------
  44.  
  45.     INTEGER001 = 0
  46.     STRING001 = "@X00@X0BMain Street@XFF"
  47.     STRING012 = "Madison Farrell"
  48.     STRING007 = "@X00@X0BOn-Sale@XFF"
  49.     STRING008 = ""
  50.     STRING002 = PPEPath() + PPEName() + ".CLA"
  51.     STRING005 = PPEPath() + PPEName() + ".CFG"
  52.     STRING006 = PPEPath() + PPEName() + ".O_E"
  53.     STRING009 = PPEPath() + PPEName() + ".CUS"
  54.     STRING010 = PPEPath() + PPEName() + ".OSL"
  55.     STRING011 = PPEPath() + PPEName() + ".SPC"
  56.     STRING014 = PPEPath() + PPEName() + ".TMP"
  57.     STRING015 = PPEPath() + PPEName() + ".THK"
  58.     STRING016 = "178b"
  59.     INTEGER004 = 8
  60.     INTEGER005 = 1
  61.     INTEGER006 = 0
  62.     If (Exist(STRING005)) Then
  63.         Gosub LABEL013
  64.     Endif
  65.     If (INTEGER005 == 1) Gosub LABEL014
  66.     While (STRING004 <> "Q") Do
  67.         If ((STRING004 <> "") && (STRING004 <> "Q")) Then
  68.             Gosub LABEL001
  69.             Gosub LABEL002
  70.         Endif
  71.         STRING004 = Upper(Inkey())
  72.         If (STRING004 == "E") Then
  73.             Gosub LABEL005
  74.             Continue
  75.         Endif
  76.         If (STRING004 == "R") Then
  77.             Gosub LABEL006
  78.             Gosub LABEL003
  79.             Continue
  80.         Endif
  81.         If (STRING004 == "O") Then
  82.             Gosub LABEL009
  83.             Gosub LABEL003
  84.             Continue
  85.         Endif
  86.         If (STRING004 == "S") Then
  87.             Gosub LABEL010
  88.             Gosub LABEL003
  89.             Continue
  90.         Endif
  91.         If (STRING004 == "P") Then
  92.             Gosub LABEL011
  93.             Gosub LABEL003
  94.         Endif
  95.     EndWhile
  96.     Newline
  97.     PrintLn "Thank you for using " + STRING007 + "."
  98.     PrintLn "This program is currently in BETA TESTING.  If you noticed anything"
  99.     PrintLn "out of the ordinary or have any suggestions for improvement, please"
  100.     PrintLn "leave a comment to the SysOp."
  101.     PrintLn 
  102.     PrintLn "Thank you for using On-Sale on " + STRING001 + "."
  103.     PrintLn "--- SysOp, " + STRING012
  104.     Newline
  105.     End
  106.     :LABEL001
  107.     PrintLn "@CLS@@X07"
  108.     PrintLn "@X0F             @X7F┌───────────────────────────────────────────────────@X70┐"
  109.     PrintLn "@X0F             @X7F│@X70─@X71╒@X79═════╗@X71╒@X79═════╗@X70───────@X71╒@X79═════╗@X71╒@X79═════╗@X71╒@X79═╗@X70────@X71╒@X79═════╗@X70─│"
  110.     PrintLn "@X0F             @X7F│@X70─@X71│ ╓@X79─┐ ║@X71│     @X79║@X71╒@X79═════╗@X71│  @X79───╢@X71│  @X79─  ║@X71│ @X79║@X70────@X71│  @X79───╢@X70─│"
  111.     PrintLn "@X0F             @X7F│@X70─@X71│ ╚═@X79╛ ║@X71│  │  @X79║@X71└─────@X79╜@X71├───  @X79║@X71│  │  @X79║@X71│ @X79╚═══╗@X71│  @X79───╢@X70─│"
  112.     PrintLn "@X0F             @X7F│@X70─@X71└─────@X79╜@X71└──┴──@X79╜@X70───────@X71└─────@X79╜@X71└──┴──@X79╜@X71└─────@X79╜@X71└─────@X79╜@X70─│"
  113.     PrintLn "@X0F             @X7F└@X70───────── Online Shopping and Classifieds ─────" + STRING016 + "┘"
  114.     PrintLn "@X0F                   @X08Copyright (C) 1994 By Madison Farrell, III"
  115.     PrintLn "                              All Rights Reserved"
  116.     Return
  117.     :LABEL002
  118.     Newline
  119.     PrintLn "@X0F         (@X0CE@X0F)nter classified  (@X0CO@X0F)nline Shopping List  (@X0CP@X0F)lace an order"
  120.     PrintLn "         (@X0CR@X0F)ead classifieds  (@X0CS@X0F)ales/Special Events  (@X0CQ@X0F)uit ON-SALE"
  121.     Newline
  122.     Return
  123.     :LABEL003
  124.     PrintLn "Press <@X00@X0EENTER@XFF> To Continue"
  125.     While (STRING004 <> Chr(13)) Do
  126.         STRING004 = Inkey()
  127.     EndWhile
  128.     Return
  129.     :LABEL004
  130.     FOpen 1, STRING014, 1, 3
  131.     FPutLn 1, STRING013
  132.     FPutLn 1
  133.     FClose 1
  134.     Return
  135.     :LABEL005
  136.     If (Exist(STRING006)) DispFile STRING006, 7
  137.     Newline
  138.     INTEGER002 = 2
  139.     TSTRING003(1) = Date()
  140.     TSTRING003(1) = TSTRING003(1) + " ----------------------- " + U_Name()
  141.     While (INTEGER002 < INTEGER004) Do
  142.         Input "@X0F" + INTEGER002 - 1 + ":@X0B", TSTRING003(INTEGER002)
  143.         Select Case (TSTRING003(INTEGER002))
  144.             Case "/Q"
  145.                 INTEGER002 = INTEGER004 - 1
  146.             Case ""
  147.                 TSTRING003(INTEGER002) = ". . ."
  148.         End Select
  149.         PrintLn 
  150.         INTEGER002 = INTEGER002 + 1
  151.     EndWhile
  152.     FAppend 1, STRING002, 1, 3
  153.     INTEGER007 = 1
  154.     While (TSTRING003(INTEGER007) <> "") Do
  155.         FPutLn 1, TSTRING003(INTEGER007)
  156.         TSTRING003(INTEGER007) = ""
  157.         INTEGER007 = INTEGER007 + 1
  158.     EndWhile
  159.     FClose 1
  160.     Return
  161.     :LABEL006
  162.     If (Exist(STRING002)) Goto LABEL007
  163.     PrintLn "No current classifieds on-line."
  164.     Goto LABEL008
  165.     :LABEL007
  166.     Newline
  167.     INTEGER003 = 0
  168.     FOpen 1, STRING002, 0, 3
  169.     While (INTEGER003 == 0) Do
  170.         FGet 1, STRING013
  171.         If (STRING013 == "") Then
  172.             INTEGER003 = 1
  173.             Continue
  174.         Endif
  175.         If (STRING013 == "/Q") Then
  176.             STRING013 = ""
  177.             Continue
  178.         Endif
  179.         PrintLn STRING013
  180.     EndWhile
  181.     FClose 1
  182.     :LABEL008
  183.     Return
  184.     :LABEL009
  185.     If (Exist(STRING010)) Then
  186.         DispFile STRING010, 7
  187.     Else
  188.         PrintLn "There is no current on-line shopping list available."
  189.     Endif
  190.     Return
  191.     :LABEL010
  192.     If (Exist(STRING011)) Then
  193.         DispFile STRING011, 7
  194.     Else
  195.         PrintLn "There are no current sales or special events in effect."
  196.     Endif
  197.     Return
  198.     :LABEL011
  199.     If (Exist(STRING009)) DispFile STRING009, 7
  200.     Newline
  201.     Input "@X0F:@X0E", STRING008
  202.     If (STRING008 <> "") Then
  203.         STRING013 = STRING008
  204.         Gosub LABEL004
  205.         Message 0, "SYSOP", U_Name(), "On-Sale Customer Inquiry", "R", 0, 1, 0, STRING014
  206.         Delete STRING014
  207.         Newline
  208.         If (Exist(STRING015)) Then
  209.             DispFile STRING015, 7
  210.             Goto LABEL012
  211.         Endif
  212.         PrintLn "Customer order aborted."
  213.     Endif
  214.     :LABEL012
  215.     Return
  216.     :LABEL013
  217.     FOpen 1, STRING005, 0, 3
  218.     FGet 1, STRING001
  219.     FGet 1, STRING012
  220.     FGet 1, INTEGER001
  221.     FClose 1
  222.     Return
  223.     :LABEL014
  224.     Gosub LABEL001
  225.     Gosub LABEL002
  226.     If ((FileInf(STRING010, 2) >= U_LDate()) && (FileInf(STRING010, 3) >= U_LTime())) Then
  227.         Newline
  228.         PrintLn "The on-line shopping list has been updated since your last log-on."
  229.     Endif
  230.     INTEGER005 = 0
  231.     Return
  232.  
  233. ;------------------------------------------------------------------------------
  234. ;
  235. ; Usage report (before postprocessing)
  236. ;
  237. ; ■ Statements used :
  238. ;
  239. ;    1       End
  240. ;    38      Goto 
  241. ;    33      Let 
  242. ;    26      PrintLn 
  243. ;    25      If 
  244. ;    5       DispFile 
  245. ;    2       Input 
  246. ;    3       FOpen 
  247. ;    1       FAppend 
  248. ;    4       FClose 
  249. ;    4       FGet 
  250. ;    3       FPutLn 
  251. ;    1       Delete 
  252. ;    16      Gosub 
  253. ;    11      Return
  254. ;    9       Newline
  255. ;    1       Message 
  256. ;
  257. ;
  258. ; ■ Functions used :
  259. ;
  260. ;    29      +
  261. ;    2       -
  262. ;    11      ==
  263. ;    6       <>
  264. ;    1       <
  265. ;    2       >=
  266. ;    22      !
  267. ;    2       &&
  268. ;    1       Upper()
  269. ;    1       Chr()
  270. ;    1       Date()
  271. ;    2       U_Name()
  272. ;    1       U_LDate()
  273. ;    1       U_LTime()
  274. ;    2       Inkey()
  275. ;    8       PPEPath()
  276. ;    7       Exist()
  277. ;    2       FileInf()
  278. ;    8       PPEName()
  279. ;
  280. ;------------------------------------------------------------------------------
  281. ;
  282. ; Analysis flags : No flag
  283. ;
  284. ;------------------------------------------------------------------------------
  285. ;
  286. ; Postprocessing report
  287. ;
  288. ;    0       For/Next
  289. ;    5       While/EndWhile
  290. ;    14      If/Then or If/Then/Else
  291. ;    1       Select Case
  292. ;
  293. ;------------------------------------------------------------------------------
  294. ;                 AEGiS Corp - Break the routines, code against the machines!
  295. ;------------------------------------------------------------------------------
  296.