home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / T / TRX-ADDB.ZIP / BBS!.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1997-06-08  |  7KB  |  388 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 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Boolean  BOOLEAN001
  20.     Integer  INTEGER001
  21.     Integer  INTEGER002
  22.     Integer  INTEGER003
  23.     Integer  INTEGER004
  24.     Integer  INTEGER005
  25.     String   TSTRING001(3)
  26.     String   TSTRING002(10)
  27.     String   TSTRING003(3)
  28.     String   TSTRING004(2)
  29.     String   STRING005
  30.     String   TSTRING006(7)
  31.  
  32. ;------------------------------------------------------------------------------
  33.  
  34.     BOOLEAN001 = 0
  35.     TSTRING001(0) = "70"
  36.     TSTRING001(1) = "7F"
  37.     TSTRING001(2) = "78"
  38.     TSTRING001(3) = "77"
  39.     TSTRING006(0) = "=)"
  40.     TSTRING006(1) = "=I"
  41.     TSTRING006(2) = "=("
  42.     TSTRING006(3) = "="
  43.     TSTRING006(4) = ":"
  44.     TSTRING006(5) = "|"
  45.     TSTRING006(6) = ":"
  46.     TSTRING006(7) = "="
  47.     TSTRING002(0) = "@X07                 @X70                                              @X08"
  48.     TSTRING002(1) = "@X07                 @X70 @X7F              @X78%%%@X70 bBS^aDDER @X78%%%             @X70 @X08"
  49.     TSTRING002(2) = TSTRING002(0)
  50.     TSTRING002(7) = TSTRING002(0)
  51.     TSTRING002(8) = TSTRING002(0)
  52.     TSTRING002(10) = TSTRING002(0)
  53.     TSTRING002(3) = "@X07                 @X70   bOARd^nAME @X78[....................]    oO    @X08"
  54.     TSTRING002(4) = "@X07                 @X70   bOARd^fONE @X78[...............]        \/     @X08"
  55.     TSTRING002(5) = "@X07                 @X70   wORk^hOURS @X78[...........]                   @X08"
  56.     TSTRING002(6) = "@X07                 @X70   bOARd^sOFt @X78[...........]@X70   eNtER^yOUR^nFO  @X08"
  57.     TSTRING002(9) = "@X07                 @X70    @X7FaRROWS@X70^mOVE  @X7FESC@X70^oPtIONS   pAINLESs^tOX   @X08"
  58.     Cls
  59.     GetUser
  60.     If (U_Sec >= ReadLine(PPEPath() + "bbs!.-", 2)) Goto LABEL002
  61.     Gosub LABEL024
  62.     TSTRING002(5) = "@X07                 @X70  @X7FsORRY^mAN, yOU^hAVE^vERY^@X70lOW^aXX@X7F^tO^uSE^iT  @X08"
  63.     :LABEL001
  64.     Gosub LABEL023
  65.     AnsiPos 0, 20
  66.     Wait
  67.     End
  68.     :LABEL002
  69.     INTEGER001 = 3
  70.     :LABEL003
  71.     STRING005 = ReadLine(PPEPath() + "bbs!.-", INTEGER001)
  72.     If (STRING005 == "") Goto LABEL005
  73.     If (Upper(U_Name()) == Upper(STRING005)) Goto LABEL004
  74.     Inc INTEGER001
  75.     Goto LABEL003
  76.     :LABEL004
  77.     Cls
  78.     Gosub LABEL024
  79.     TSTRING002(5) = "@X07                 @X70      @X7FsORRY^mAN, yOUR^nAME^iS^@X70bLACKlISTEd     @X08"
  80.     Goto LABEL001
  81.     :LABEL005
  82.     TSTRING004(0) = " save^this "
  83.     TSTRING004(1) = " oops!back "
  84.     TSTRING004(2) = " abort^dis "
  85.     Gosub LABEL023
  86.     :LABEL006
  87.     AnsiPos 33 + Len(TSTRING003(INTEGER002)), 8 + INTEGER002
  88.     Select Case (INTEGER002)
  89.         Case 0
  90.             INTEGER003 = 20
  91.         Case 1
  92.             INTEGER003 = 15
  93.         Case Else
  94.             INTEGER003 = 11
  95.     End Select
  96.     INTEGER001 = 0
  97.     :LABEL007
  98.     STRING005 = Inkey()
  99.     If (STRING005 == "") Then
  100.         INTEGER001 = INTEGER001 + 1
  101.         If (INTEGER001 < Random(1) * 5000 + 2000) Goto LABEL010
  102.         If (BOOLEAN001 == 0) Then
  103.             STRING005 = "O"
  104.             Goto LABEL008
  105.         Endif
  106.         STRING005 = "R"
  107.         :LABEL008
  108.         INTEGER004 = GetX()
  109.         INTEGER005 = GetY()
  110.         For INTEGER001 = 0 To 3
  111.             AnsiPos 59, 14
  112.             Print "@X" + TSTRING001(INTEGER001) + STRING005
  113.             AnsiPos INTEGER004, INTEGER005
  114.             Delay 4
  115.         Next
  116.         If (BOOLEAN001 == 0) Then
  117.             STRING005 = "R"
  118.             Goto LABEL009
  119.         Endif
  120.         STRING005 = "O"
  121.         :LABEL009
  122.         INTEGER001 = 3
  123.         While (INTEGER001 >= 0) Do
  124.             AnsiPos 59, 14
  125.             Print "@X" + TSTRING001(INTEGER001) + STRING005
  126.             AnsiPos INTEGER004, INTEGER005
  127.             Delay 4
  128.             Dec INTEGER001
  129.         EndWhile
  130.         BOOLEAN001 = !BOOLEAN001
  131.         AnsiPos INTEGER004, INTEGER005
  132.         Goto LABEL007
  133.         :LABEL010
  134.         If (STRING005 == "") Goto LABEL007
  135.     Endif
  136.     If (STRING005 == "UP") Then
  137.         Dec INTEGER002
  138.         If (INTEGER002 < 0) INTEGER002 = 3
  139.         Goto LABEL006
  140.     Endif
  141.     If (STRING005 == Chr(13)) Then
  142.         If (INTEGER002 == 3) Then
  143.             Goto LABEL013
  144.             Goto LABEL011
  145.         Endif
  146.         STRING005 = "DOWN"
  147.     Endif
  148.     :LABEL011
  149.     If (STRING005 == "DOWN") Then
  150.         Inc INTEGER002
  151.         If (INTEGER002 > 3) INTEGER002 = 0
  152.         Goto LABEL006
  153.     Endif
  154.     If (STRING005 == Chr(27)) Goto LABEL013
  155.     If (STRING005 == Chr(8)) Then
  156.         If (Len(TSTRING003(INTEGER002)) == 0) Then
  157.             Goto LABEL007
  158.             Goto LABEL012
  159.         Endif
  160.         TSTRING003(INTEGER002) = Left(TSTRING003(INTEGER002), Len(TSTRING003(INTEGER002)) - 1)
  161.         Print Chr(8), "@X78.", Chr(8)
  162.         Goto LABEL007
  163.     Endif
  164.     :LABEL012
  165.     If (Len(STRING005) > 1) Goto LABEL007
  166.     If (STRING005 < " ") Goto LABEL007
  167.     If (Len(TSTRING003(INTEGER002)) == INTEGER003) Goto LABEL007
  168.     TSTRING003(INTEGER002) = TSTRING003(INTEGER002) + STRING005
  169.     If (STRING005 == " ") STRING005 = "@X78."
  170.     Print "@X79", STRING005
  171.     Goto LABEL007
  172.     :LABEL013
  173.     AnsiPos 22, 18
  174.     Print "@X08["
  175.     AnsiPos 60, 18
  176.     Print "]"
  177.     Color 0
  178.     Print "▄"
  179.     Color 8
  180.     STRING005 = TSTRING004(0) + TSTRING004(1) + TSTRING004(2)
  181.     INTEGER003 = Len(STRING005) / 2
  182.     For INTEGER001 = 0 To INTEGER003 + 1
  183.         AnsiPos 40 - INTEGER001, 18
  184.         Print Mid(STRING005, INTEGER003 - INTEGER001, INTEGER001 * 2)
  185.     Next
  186.     For INTEGER001 = 1 To 11
  187.         AnsiPos 24 + INTEGER001, 18
  188.         Print "@X7F" + Upper(Mid(TSTRING004(0), INTEGER001, 1))
  189.     Next
  190.     INTEGER002 = 0
  191.     :LABEL014
  192.     AnsiPos 62, 18
  193.     Print "@X0F" + TSTRING006(INTEGER002)
  194.     AnsiPos 18, 18
  195.     Print "@X0F" + TSTRING006(INTEGER002)
  196.     Color 8
  197.     AnsiPos 61, 18
  198.     :LABEL015
  199.     STRING005 = Inkey()
  200.     If (STRING005 == "") Goto LABEL015
  201.     If (STRING005 == "LEFT") Then
  202.         If (INTEGER002 > 0) Goto LABEL017
  203.     Endif
  204.     If (STRING005 == "RIGHT") Then
  205.         If (INTEGER002 < 2) Goto LABEL016
  206.     Endif
  207.     If (STRING005 == Chr(13)) Goto LABEL018
  208.     Goto LABEL014
  209.     :LABEL016
  210.     For INTEGER001 = 1 To 11
  211.         AnsiPos 25 + 11 * INTEGER002, 18
  212.         Color 8
  213.         Print Lower(Left(TSTRING004(INTEGER002), INTEGER001))
  214.         AnsiPos 36 + 11 * INTEGER002, 18
  215.         Print "@X7F" + Upper(Left(TSTRING004(INTEGER002 + 1), INTEGER001))
  216.     Next
  217.     Inc INTEGER002
  218.     Goto LABEL014
  219.     :LABEL017
  220.     For INTEGER001 = 1 To 11
  221.         AnsiPos 36 + 11 * INTEGER002 - INTEGER001, 18
  222.         Color 8
  223.         Print Lower(Right(TSTRING004(INTEGER002), INTEGER001))
  224.         AnsiPos 25 + 11 * INTEGER002 - INTEGER001, 18
  225.         Print "@X7F" + Upper(Right(TSTRING004(INTEGER002 - 1), INTEGER001))
  226.     Next
  227.     Dec INTEGER002
  228.     Goto LABEL014
  229.     :LABEL018
  230.     For INTEGER001 = 3 To 7
  231.         AnsiPos 62, 18
  232.         Print "@X0F" + TSTRING006(INTEGER001)
  233.         AnsiPos 18, 18
  234.         Print "@X0F" + TSTRING006(INTEGER001)
  235.         AnsiPos 61, 18
  236.         Delay 2
  237.     Next
  238.     Color 8
  239.     Gosub LABEL021
  240.     Select Case (INTEGER002)
  241.         Case 0
  242.             If (TSTRING003(0) + TSTRING003(1) + TSTRING003(2) + TSTRING003(3) == "") Goto LABEL019
  243.             For INTEGER001 = 0 To 3
  244.                 If (TSTRING003(INTEGER001) == "") Then
  245.                     INTEGER002 = INTEGER001
  246.                     Goto LABEL006
  247.                 Endif
  248.             Next
  249.             STRING005 = "  @X0Bs@X03AV@X08ING^@X0Bb@X03OA@X08RD^@X0Bn@X03FO @X08[@X03...........................@X08]"
  250.             Gosub LABEL022
  251.             For INTEGER001 = 1 To 27
  252.                 AnsiPos 35 + INTEGER001, 18
  253.                 Color 15
  254.                 Print "■"
  255.                 Delay 1
  256.             Next
  257.             FAppend 1, ReadLine(PPEPath() + "bbs!.-", 1), 2, 3
  258.             FPutLn 1, "@X03@POS:8@" + TSTRING003(0) + "@X08@POS:30@@X08" + TSTRING003(1) + "@POS:48@" + TSTRING003(2) + "@POS:62@" + TSTRING003(3)
  259.             FClose 1
  260.             Gosub LABEL021
  261.             STRING005 = "@X0Ab@X02BS@X08^@X0Ae@X02NT@X08Ry^@X0Aa@X02DD@X08ed^@X0A!@X02!!"
  262.             Gosub LABEL022
  263.             Goto LABEL020
  264.         Case 1
  265.             INTEGER002 = 0
  266.             Goto LABEL006
  267.         Case Else
  268.             :LABEL019
  269.             STRING005 = "@X0Cb@X04BS@X08^@X0Ce@X04NT@X08Ry^@X0Ca@X04BO@X08RTed^@X0C!@X04!!"
  270.             Gosub LABEL022
  271.             :LABEL020
  272.             AnsiPos 0, 20
  273.             Wait
  274.             End
  275.     End Select
  276.     :LABEL021
  277.     For INTEGER001 = 0 To 23
  278.         AnsiPos 40 + INTEGER001, 18
  279.         Print " "
  280.         AnsiPos 40 - INTEGER001, 18
  281.         Print " "
  282.     Next
  283.     Return
  284.     :LABEL022
  285.     For INTEGER001 = 0 To 2
  286.         AnsiPos 40 - Len(StripAtx(STRING005)) / 2, 18
  287.         Color (INTEGER001 == 0) * 8 + (INTEGER001 == 1) * 7 + (INTEGER001 == 2) * 15
  288.         Print StripAtx(STRING005)
  289.         Delay 1
  290.     Next
  291.     AnsiPos 40 - Len(StripAtx(STRING005)) / 2, 18
  292.     Print STRING005
  293.     Return
  294.     :LABEL023
  295.     AnsiPos 0, 10
  296.     Print TSTRING002(5)
  297.     For INTEGER001 = 1 To 5
  298.         Delay 1
  299.         AnsiPos 0, 10 - INTEGER001
  300.         Print TSTRING002(5 - INTEGER001)
  301.         AnsiPos 0, 10 + INTEGER001
  302.         Print TSTRING002(5 + INTEGER001)
  303.     Next
  304.     Return
  305.     :LABEL024
  306.     TSTRING002(2) = TSTRING002(0)
  307.     TSTRING002(3) = TSTRING002(0)
  308.     TSTRING002(4) = TSTRING002(0)
  309.     TSTRING002(6) = TSTRING002(0)
  310.     TSTRING002(7) = TSTRING002(0)
  311.     TSTRING002(8) = TSTRING002(0)
  312.     TSTRING002(9) = "@X07                 @X70                       dONE^bY pAINLESs^tOX   @X08"
  313.     TSTRING002(10) = TSTRING002(0)
  314.     Return
  315.  
  316. ;------------------------------------------------------------------------------
  317. ;
  318. ; Usage report (before postprocessing)
  319. ;
  320. ; ■ Statements used :
  321. ;
  322. ;    2       End
  323. ;    2       Cls
  324. ;    2       Wait
  325. ;    8       Color 
  326. ;    77      Goto 
  327. ;    90      Let 
  328. ;    25      Print 
  329. ;    45      If 
  330. ;    1       FAppend 
  331. ;    1       FClose 
  332. ;    1       FPutLn 
  333. ;    1       GetUser
  334. ;    9       Gosub 
  335. ;    4       Return
  336. ;    6       Delay 
  337. ;    3       Inc 
  338. ;    3       Dec 
  339. ;    30      AnsiPos 
  340. ;
  341. ;
  342. ; ■ Functions used :
  343. ;
  344. ;    9       *
  345. ;    3       /
  346. ;    56      +
  347. ;    11      -
  348. ;    28      ==
  349. ;    15      <
  350. ;    11      <=
  351. ;    3       >
  352. ;    24      >=
  353. ;    29      !
  354. ;    22      &&
  355. ;    11      ||
  356. ;    8       Len(
  357. ;    2       Lower()
  358. ;    5       Upper()
  359. ;    2       Mid()
  360. ;    3       Left()
  361. ;    2       Right()
  362. ;    6       Chr()
  363. ;    1       Random()
  364. ;    1       U_Name()
  365. ;    3       StripAtx()
  366. ;    2       Inkey()
  367. ;    3       PPEPath()
  368. ;    3       ReadLine()
  369. ;    1       GetX()
  370. ;    1       GetY()
  371. ;
  372. ;------------------------------------------------------------------------------
  373. ;
  374. ; Analysis flags : No flag
  375. ;
  376. ;------------------------------------------------------------------------------
  377. ;
  378. ; Postprocessing report
  379. ;
  380. ;    11      For/Next
  381. ;    1       While/EndWhile
  382. ;    12      If/Then or If/Then/Else
  383. ;    2       Select Case
  384. ;
  385. ;------------------------------------------------------------------------------
  386. ;                 AEGiS Corp - Break the routines, code against the machines!
  387. ;------------------------------------------------------------------------------
  388.