home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / AXREAD12.ZIP / BOOK.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1996-08-03  |  6KB  |  429 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.     Integer  TINTEGER001(26)
  20.     String   STRING001
  21.     String   TSTRING002(26)
  22.     String   STRING003
  23.     String   TSTRING004(26)
  24.     String   STRING005
  25.     String   STRING006
  26.     String   STRING007
  27.     String   STRING008
  28.     String   STRING009
  29.     String   STRING010
  30.     String   STRING011
  31.     String   STRING012
  32.     String   STRING013
  33.     String   STRING014
  34.     String   STRING015
  35.     String   STRING016
  36.     String   STRING017
  37.     String   STRING018
  38.     Int      INT001
  39.     Int      INT002
  40.     Int      INT003
  41.     Int      INT004
  42.     Int      INT005
  43.     Int      INT006
  44.     Int      INT007
  45.     Int      INT008
  46.     Int      INT009
  47.     Int      INT010
  48.     Declare  Procedure PROC001(Var String STRING019, Int INT011)
  49.  
  50. ;------------------------------------------------------------------------------
  51.  
  52.     STRING001 = PPEPath() + "BOOKTEXT" + LangExt()
  53.     If (!Exist(STRING001)) STRING001 = PPEPath() + "BOOKTEXT"
  54.     FOpen 1, STRING001, 0, 0
  55.     FGet 1, STRING008
  56.     FGet 1, STRING009
  57.     FGet 1, STRING010
  58.     FGet 1, STRING011
  59.     FGet 1, STRING003
  60.     Tokenize STRING003
  61.     INT006 = GetToken()
  62.     INT007 = GetToken()
  63.     FGet 1, STRING012
  64.     FGet 1, STRING013
  65.     FGet 1, STRING014
  66.     FGet 1, STRING015
  67.     FGet 1, STRING016
  68.     FGet 1, STRING017
  69.     FGet 1, STRING018
  70.     FClose 1
  71.     StartDisp 1
  72.     DispFile PPEPath() + "BOOK", 4
  73.     STRING001 = PPEPath() + "DATA\" + Strip(Left(U_Name(), 4) + Right(U_Name(), 4), " ")
  74.     STRING006 = STRING008 + "[" + STRING010 + "a" + STRING008 + "]"
  75.     INT003 = 1
  76.     If (Exist(STRING001)) Then
  77.         INT001 = 1
  78.         FOpen 1, STRING001, 0, 0
  79.         :LABEL001
  80.         If (Ferr(1)) Goto LABEL002
  81.         FGet 1, TSTRING002(INT001)
  82.         Inc INT001
  83.         Goto LABEL001
  84.         :LABEL002
  85.         FClose 1
  86.         For INT001 = 1 To 26
  87.             STRING003 = Trim(TSTRING002(INT001), " ")
  88.             If (STRING003 == "") Then
  89.                 INT002 = INT001 - 1
  90.                 INT003 = 1
  91.                 AnsiPos 10, 6
  92.                 Gosub LABEL016
  93.                 Goto LABEL003
  94.             Endif
  95.             If (INT001 < 14) Then
  96.                 AnsiPos 12, INT001 + 5
  97.             Else
  98.                 AnsiPos 46, INT001 - 8
  99.             Endif
  100.             Print STRING003
  101.         Next
  102.     Else
  103.         AnsiPos 10, 6
  104.         Gosub LABEL016
  105.     Endif
  106.     :LABEL003
  107.     While (STRING007 <> Chr(27)) Do
  108.         STRING007 = TInkey(0)
  109.         Select Case (STRING007)
  110.             Case "2"
  111.                 STRING007 = "DOWN"
  112.             Case "8"
  113.                 STRING007 = "UP"
  114.             Case "6"
  115.                 STRING007 = "RIGHT"
  116.             Case "4"
  117.                 STRING007 = "LEFT"
  118.         End Select
  119.         If (STRING007 == "UP") Then
  120.             If (INT003 == 1) Then
  121.                 INT003 = 26
  122.                 Goto LABEL004
  123.             Endif
  124.             Dec INT003
  125.             :LABEL004
  126.             Gosub LABEL016
  127.         Endif
  128.         If (STRING007 == "DOWN") Then
  129.             If (INT003 == 26) Then
  130.                 INT003 = 1
  131.                 Goto LABEL005
  132.             Endif
  133.             Inc INT003
  134.             :LABEL005
  135.             Gosub LABEL016
  136.         Endif
  137.         If ((STRING007 == "LEFT") || (STRING007 == "RIGHT")) Then
  138.             If (INT003 < 14) Then
  139.                 INT003 = INT003 + 13
  140.                 Goto LABEL006
  141.             Endif
  142.             INT003 = INT003 - 13
  143.             :LABEL006
  144.             Gosub LABEL016
  145.         Endif
  146.         If (((Len(STRING007) == 1) && (Asc(Upper(STRING007)) > 64)) && (Asc(Upper(STRING007)) < 91)) Then
  147.             INT003 = Asc(Upper(STRING007)) - 64
  148.             Gosub LABEL016
  149.             STRING007 = Chr(13)
  150.         Endif
  151.         If (STRING007 == Chr(13)) Then
  152.             INT004 = GetX()
  153.             INT005 = GetY()
  154.             If (INT003 < 14) Then
  155.                 AnsiPos 12, INT003 + 5
  156.                 Goto LABEL007
  157.             Endif
  158.             AnsiPos 46, INT003 - 8
  159.             :LABEL007
  160.             Color 7
  161.             PROC001(TSTRING002(INT003), 26)
  162.             If (Trim(TSTRING002(INT003), " ") == "") Then
  163.                 TSTRING002(INT003) = ""
  164.             Endif
  165.             Gosub LABEL014
  166.             STRING007 = ""
  167.             AnsiPos INT004, INT005
  168.         Endif
  169.     EndWhile
  170.     Backup 3
  171.     Print STRING006
  172.     Backup 3
  173.     INT004 = GetX()
  174.     INT005 = GetY()
  175.     AnsiPos INT006, INT007
  176.     INT001 = 0
  177.     Print STRING012
  178.     INT009 = GetX()
  179.     INT010 = GetY()
  180.     Print STRING014 + STRING015 + STRING017
  181.     :LABEL008
  182.     STRING003 = TInkey(0)
  183.     Select Case (STRING003)
  184.         Case "6"
  185.             STRING003 = "RIGHT"
  186.         Case "4"
  187.             STRING003 = "LEFT"
  188.     End Select
  189.     If (STRING003 == "LEFT") Then
  190.         If (INT001 == 0) Then
  191.             INT001 = 2
  192.             Goto LABEL009
  193.         Endif
  194.         Dec INT001
  195.         :LABEL009
  196.         Gosub LABEL012
  197.     Endif
  198.     If (STRING003 == "RIGHT") Then
  199.         If (INT001 == 2) Then
  200.             INT001 = 0
  201.             Goto LABEL010
  202.         Endif
  203.         Inc INT001
  204.         :LABEL010
  205.         Gosub LABEL012
  206.     Endif
  207.     If (STRING003 == Chr(13)) Then
  208.         If (INT001 == 0) Then
  209.             Goto LABEL015
  210.             Goto LABEL011
  211.         Endif
  212.         If (INT001 == 1) Then
  213.             AnsiPos INT006, INT007
  214.             Print Space(Len(StripAtx(STRING012 + STRING013 + STRING016 + STRING017)))
  215.             STRING003 = ""
  216.             STRING007 = ""
  217.             AnsiPos INT004, INT005
  218.             Print STRING005
  219.             Goto LABEL003
  220.             Goto LABEL011
  221.         Endif
  222.         If (INT001 == 2) Then
  223.             Gosub LABEL013
  224.             STRING003 = ""
  225.         Endif
  226.     Endif
  227.     :LABEL011
  228.     Goto LABEL008
  229.     :LABEL012
  230.     AnsiPos INT009, INT010
  231.     Select Case (INT001)
  232.         Case 0
  233.             Print STRING014 + STRING015 + STRING017
  234.         Case 1
  235.             Print STRING013 + STRING016 + STRING017
  236.         Case 2
  237.             Print STRING013 + STRING015 + STRING018
  238.     End Select
  239.     Return
  240.     :LABEL013
  241.     Sort TSTRING002, TINTEGER001
  242.     For INT008 = 0 To 26
  243.         TSTRING004(INT008 + 1) = TSTRING002(TINTEGER001(INT008))
  244.     Next
  245.     For INT008 = 1 To 26
  246.         TSTRING002(INT008) = TSTRING004(INT008)
  247.     Next
  248.     Gosub LABEL014
  249.     INT001 = 2
  250.     Gosub LABEL012
  251.     Return
  252.     :LABEL014
  253.     For INT001 = 1 To 26
  254.         TSTRING004(INT001) = TSTRING002(INT001)
  255.         TSTRING002(INT001) = ""
  256.     Next
  257.     INT002 = 1
  258.     For INT001 = 1 To 26
  259.         If (Trim(TSTRING004(INT001), " ") <> "") Then
  260.             TSTRING002(INT002) = TSTRING004(INT001)
  261.             INT002 = INT002 + 1
  262.         Endif
  263.     Next
  264.     INT002 = INT002 - 1
  265.     For INT001 = 1 To 26
  266.         If (INT001 < 14) Then
  267.             AnsiPos 12, INT001 + 5
  268.         Else
  269.             AnsiPos 46, INT001 - 8
  270.         Endif
  271.         Print "@X08··························"
  272.         If (INT001 < 14) Then
  273.             AnsiPos 12, INT001 + 5
  274.         Else
  275.             AnsiPos 46, INT001 - 8
  276.         Endif
  277.         Color 7
  278.         Print TSTRING002(INT001)
  279.     Next
  280.     Return
  281.     :LABEL015
  282.     If (INT002 > 0) Then
  283.         Delete STRING001
  284.         FOpen 1, STRING001, 1, 3
  285.         For INT001 = 1 To INT002
  286.             FPutLn 1, TSTRING002(INT001)
  287.         Next
  288.         FClose 1
  289.     ElseIf (Exist(STRING001)) Then
  290.         Delete STRING001
  291.     Endif
  292.     AnsiPos 1, 23
  293.     End
  294.     :LABEL016
  295.     STRING005 = STRING009 + "[" + STRING011 + Chr(INT003 + 64) + STRING009 + "]@X0F"
  296.     Backup 3
  297.     Print STRING006
  298.     If (INT003 < 14) Then
  299.         AnsiPos 7, INT003 + 5
  300.     Else
  301.         AnsiPos 41, INT003 - 8
  302.     Endif
  303.     Print STRING005
  304.     STRING006 = STRING008 + "[" + STRING010 + Chr(INT003 + 96) + STRING008 + "]"
  305.     Return
  306.     End
  307.  
  308. ;------------------------------------------------------------------------------
  309.  
  310.     Procedure PROC001(Var String STRING019, Int INT011)
  311.  
  312.     String   STRING020
  313.     Int      INT012
  314.  
  315.     Color 15
  316.     INT012 = Len(STRING019)
  317.     Print STRING019
  318.     :LABEL017
  319.     STRING020 = Upper(TInkey(0))
  320.     If (STRING020 == Chr(13)) Goto LABEL018
  321.     If (STRING020 == Chr(29)) Goto LABEL017
  322.     If (STRING020 == Chr(8)) Then
  323.         If (INT012 == 0) Goto LABEL017
  324.         INT012 = INT012 - 1
  325.         Backup 1
  326.         Print "@X08·"
  327.         Backup 1
  328.         STRING019 = Left(STRING019, INT012)
  329.         Goto LABEL017
  330.     Endif
  331.     If (!(Len(STRING020) == 1)) Goto LABEL017
  332.     If (Asc(STRING020) < 31) Goto LABEL017
  333.     If (INT012 == INT011) Goto LABEL017
  334.     STRING019 = STRING019 + STRING020
  335.     INT012 = INT012 + 1
  336.     Print "@X08", STRING020
  337.     Backup 1
  338.     Delay 1
  339.     Print "@X07", STRING020
  340.     Backup 1
  341.     Delay 1
  342.     Print "@X0F", STRING020
  343.     Goto LABEL017
  344.     :LABEL018
  345.  
  346.     EndProc
  347.  
  348.  
  349. ;------------------------------------------------------------------------------
  350. ;
  351. ; Usage report (before postprocessing)
  352. ;
  353. ; ■ Statements used :
  354. ;
  355. ;    2       End
  356. ;    3       Color 
  357. ;    87      Goto 
  358. ;    70      Let 
  359. ;    18      Print 
  360. ;    53      If 
  361. ;    1       DispFile 
  362. ;    3       FOpen 
  363. ;    3       FClose 
  364. ;    13      FGet 
  365. ;    1       FPutLn 
  366. ;    1       StartDisp 
  367. ;    2       Delete 
  368. ;    12      Gosub 
  369. ;    4       Return
  370. ;    2       Delay 
  371. ;    3       Inc 
  372. ;    2       Dec 
  373. ;    1       Tokenize 
  374. ;    18      AnsiPos 
  375. ;    7       Backup 
  376. ;    1       Sort 
  377. ;    1       EndProc
  378. ;
  379. ;
  380. ; ■ Functions used :
  381. ;
  382. ;    52      +
  383. ;    10      -
  384. ;    33      ==
  385. ;    2       <>
  386. ;    15      <
  387. ;    7       <=
  388. ;    2       >
  389. ;    14      >=
  390. ;    48      !
  391. ;    16      &&
  392. ;    8       ||
  393. ;    4       Len(
  394. ;    4       Upper()
  395. ;    2       Left()
  396. ;    1       Right()
  397. ;    1       Space()
  398. ;    1       Ferr()
  399. ;    9       Chr()
  400. ;    4       Asc()
  401. ;    3       Trim()
  402. ;    2       U_Name()
  403. ;    1       StripAtx()
  404. ;    1       Strip()
  405. ;    4       PPEPath()
  406. ;    2       GetToken()
  407. ;    3       Exist()
  408. ;    1       LangExt()
  409. ;    3       GetX()
  410. ;    3       GetY()
  411. ;    3       TInkey()
  412. ;
  413. ;------------------------------------------------------------------------------
  414. ;
  415. ; Analysis flags : No flag
  416. ;
  417. ;------------------------------------------------------------------------------
  418. ;
  419. ; Postprocessing report
  420. ;
  421. ;    7       For/Next
  422. ;    1       While/EndWhile
  423. ;    28      If/Then or If/Then/Else
  424. ;    3       Select Case
  425. ;
  426. ;------------------------------------------------------------------------------
  427. ;                 AEGiS Corp - Break the routines, code against the machines!
  428. ;------------------------------------------------------------------------------
  429.