home *** CD-ROM | disk | FTP | other *** search
/ Carsten's PPE Collection / Carstens_PPE_Collection_2007.zip / S / STACK10.ZIP / !.PPE (.txt) next >
PCBoard Programming Language Executable  |  1995-10-25  |  5KB  |  396 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.1O (Encryption type I) - 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.     String   TSTRING001(8)
  26.     String   TSTRING002(1)
  27.     String   STRING003
  28.     String   STRING004
  29.     String   TSTRING005(1)
  30.     String   TSTRING006(1)
  31.     String   STRING007
  32.  
  33. ;------------------------------------------------------------------------------
  34.  
  35.     GetUser
  36.     SaveScrn
  37.     Cls
  38.     FOpen 1, PPEPath() + "stcktext" + LangExt(), 2, 0
  39.     FGet 1, TSTRING001(0)
  40.     For INTEGER003 = 1 To 8
  41.         FGet 1, TSTRING001(INTEGER003)
  42.     Next
  43.     FClose 1
  44.     DOpen 1, PPEPath() + "key" + String(PcbNode()), 0
  45.     Gosub LABEL003
  46.     If (Abort()) Then
  47.         ResetDisp
  48.         Gosub LABEL004
  49.         End
  50.     Endif
  51.     While (STRING004 <> Chr(27)) Do
  52.         If (Abort()) Then
  53.             ResetDisp
  54.             Gosub LABEL004
  55.             End
  56.         Endif
  57.         STRING004 = ""
  58.         While (STRING004 == "") Do
  59.             STRING004 = Upper(Inkey())
  60.             If (STRING004 == "UP") STRING004 = "U"
  61.             If (STRING004 == "DOWN") STRING004 = "D"
  62.             If (InStr("DEMU" + Chr(13) + Chr(27), STRING004) == 0) STRING004 = ""
  63.         EndWhile
  64.         AnsiPos 3, INTEGER001 + 1
  65.         Print TSTRING005(INTEGER001)
  66.         Select Case (STRING004)
  67.             Case "U"
  68.                 If (INTEGER001 == 1) Then
  69.                     INTEGER001 = INTEGER002
  70.                 Else
  71.                     Dec INTEGER001
  72.                 Endif
  73.             Case "D"
  74.                 If (INTEGER001 == INTEGER002) Then
  75.                     INTEGER001 = 1
  76.                 Else
  77.                     Inc INTEGER001
  78.                 Endif
  79.             Case "E"
  80.                 INTEGER006 = DRecCount(1) + 1 - INTEGER001
  81.                 INTEGER006 = INTEGER006
  82.                 DGo 1, INTEGER006
  83.                 DDelete 1
  84.                 Color DefColor()
  85.                 DPack 1
  86.                 Cls
  87.                 Gosub LABEL003
  88.                 If (STRING004 == Chr(13)) Then
  89.                     Gosub LABEL004
  90.                     KbdStuff TSTRING002(INTEGER001)
  91.                     End
  92.                 Endif
  93.             Case Chr(27)
  94.                 Gosub LABEL004
  95.                 KbdStuff "^M"
  96.                 End
  97.         End Select
  98.         If (STRING004 == "M") Then
  99.             AnsiPos 1, INTEGER002 + 3
  100.             PrintLn TSTRING001(6)
  101.             PrintLn TSTRING001(7)
  102.             Print TSTRING001(8)
  103.             AnsiPos 3, INTEGER001 + 1
  104.             Print TSTRING005(INTEGER001)
  105.             AnsiPos 3, INTEGER001 + 1
  106.             INTEGER004 = 1
  107.             STRING004 = ""
  108.             If (Abort()) Then
  109.                 ResetDisp
  110.                 Gosub LABEL004
  111.                 End
  112.             Endif
  113.             While (STRING004 <> Chr(13)) Do
  114.                 If (Abort()) Then
  115.                     ResetDisp
  116.                     Gosub LABEL004
  117.                     End
  118.                 Endif
  119.                 STRING004 = ""
  120.                 While (STRING004 == "") Do
  121.                     STRING004 = Inkey()
  122.                     If (STRING004 == "RIGHT") STRING004 = Chr(2)
  123.                     If (STRING004 == "LEFT") STRING004 = Chr(3)
  124.                     If (STRING004 == "END") STRING004 = Chr(16)
  125.                     If (STRING004 == "HOME") STRING004 = Chr(23)
  126.                     If (STRING004 == "CTRL LEFT") STRING004 = Chr(1)
  127.                     If (STRING004 == "CTRL RIGHT") STRING004 = Chr(6)
  128.                     If (STRING004 == "CTRL END") STRING004 = Chr(5)
  129.                     If (InStr(Chr(1) + Chr(2) + Chr(3) + Chr(5) + Chr(16) + Chr(23) + Chr(25) + Chr(6) + Chr(8) + Chr(13) + Mask_Ascii(), STRING004) == 0) STRING004 = ""
  130.                 EndWhile
  131.                 If (STRING004 == Chr(2)) Then
  132.                     If (INTEGER004 <> 75) Then
  133.                         Forward 1
  134.                         Inc INTEGER004
  135.                     Endif
  136.                     Continue
  137.                 Endif
  138.                 If (STRING004 == Chr(3)) Then
  139.                     If (INTEGER004 <> 1) Then
  140.                         Backup 1
  141.                         Dec INTEGER004
  142.                     Endif
  143.                     Continue
  144.                 Endif
  145.                 If (STRING004 == Chr(16)) Then
  146.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  147.                     INTEGER005 = Len(STRING003)
  148.                     If (INTEGER005 <> 75) Then
  149.                         INTEGER004 = INTEGER005 + 1
  150.                         Goto LABEL001
  151.                     Endif
  152.                     INTEGER004 = INTEGER005
  153.                     :LABEL001
  154.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  155.                     Continue
  156.                 Endif
  157.                 If (STRING004 == Chr(23)) Then
  158.                     INTEGER004 = 1
  159.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  160.                     Continue
  161.                 Endif
  162.                 If (STRING004 == Chr(1)) Then
  163.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  164.                     If (INTEGER004 <> 1) Then
  165.                         For INTEGER003 = INTEGER004 To 1 Step -1
  166.                             STRING007 = Mid(STRING003, INTEGER003 - 1, 1)
  167.                             If ((STRING007 == Chr(32)) && (INTEGER003 <> INTEGER004)) Break
  168.                         Next
  169.                     Endif
  170.                     INTEGER004 = INTEGER003
  171.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  172.                     Continue
  173.                 Endif
  174.                 If (STRING004 == Chr(6)) Then
  175.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  176.                     INTEGER005 = Len(STRING003)
  177.                     If (INTEGER004 < INTEGER005 + 1) Then
  178.                         For INTEGER003 = INTEGER004 To INTEGER005
  179.                             STRING007 = Mid(STRING003, INTEGER003 + 1, 1)
  180.                             If (STRING007 == Chr(32)) Break
  181.                         Next
  182.                     Endif
  183.                     INTEGER004 = INTEGER003 + 2
  184.                     If (INTEGER004 > INTEGER005) INTEGER004 = INTEGER005 + 1
  185.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  186.                     Continue
  187.                 Endif
  188.                 If (STRING004 == Chr(8)) Then
  189.                     If (INTEGER004 <> 1) Then
  190.                         Dec INTEGER004
  191.                         TSTRING005(INTEGER001) = TSTRING001(5) + Left(StripAtx(TSTRING005(INTEGER001)), INTEGER004 - 1) + Right(StripAtx(TSTRING005(INTEGER001)), 75 - INTEGER004) + " "
  192.                         TSTRING006(INTEGER001) = TSTRING001(4) + StripAtx(TSTRING005(INTEGER001))
  193.                         AnsiPos 3, INTEGER001 + 1
  194.                         Print TSTRING005(INTEGER001)
  195.                         AnsiPos INTEGER004 + 2, INTEGER001 + 1
  196.                     Endif
  197.                     Continue
  198.                 Endif
  199.                 If (STRING004 == Chr(5)) Then
  200.                     STRING003 = Trim(StripAtx(TSTRING005(INTEGER001)), " ")
  201.                     STRING003 = Left(STRING003, INTEGER004 - 1)
  202.                     TSTRING005(INTEGER001) = TSTRING001(5) + STRING003 + Space(75 - INTEGER004)
  203.                     TSTRING006(INTEGER001) = TSTRING001(4) + STRING003 + Space(75 - INTEGER004)
  204.                     AnsiPos 3, INTEGER001 + 1
  205.                     Print TSTRING005(INTEGER001)
  206.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  207.                     Continue
  208.                 Endif
  209.                 If (STRING004 == Chr(13)) Then
  210.                     Continue
  211.                 Endif
  212.                 If (STRING004 == Chr(25)) Then
  213.                     TSTRING005(INTEGER001) = TSTRING001(5) + Space(75)
  214.                     TSTRING006(INTEGER001) = TSTRING001(4) + Space(75)
  215.                     INTEGER004 = 1
  216.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  217.                     Print TSTRING005(INTEGER001)
  218.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  219.                     Continue
  220.                 Endif
  221.                 If (INTEGER004 <> 75) Then
  222.                     Inc INTEGER004
  223.                     Print Upper(STRING004)
  224.                     TSTRING005(INTEGER001) = ScrText(3, 1 + INTEGER001, 75, 1)
  225.                     TSTRING006(INTEGER001) = TSTRING001(4) + StripAtx(TSTRING005(INTEGER001))
  226.                     AnsiPos INTEGER004 + 2, INTEGER001 + 1
  227.                 Endif
  228.             EndWhile
  229.             If (Trim(StripAtx(TSTRING005(INTEGER001)), " ") == "") Then
  230.                 INTEGER006 = DRecCount(1) + 1 - INTEGER001
  231.                 DGo 1, INTEGER001
  232.                 DDelete 1
  233.                 Color DefColor()
  234.                 DPack 1
  235.                 Cls
  236.                 Gosub LABEL003
  237.                 Goto LABEL002
  238.             Endif
  239.             DNew 1
  240.             DPut 1, "KEY", StripAtx(TSTRING005(INTEGER001))
  241.             DAdd 1
  242.             Color DefColor()
  243.             Cls
  244.             Gosub LABEL003
  245.         Endif
  246.         :LABEL002
  247.         AnsiPos 3, INTEGER001 + 1
  248.         Print TSTRING006(INTEGER001)
  249.     EndWhile
  250.     End
  251.     :LABEL003
  252.     INTEGER002 = U_PageLen - 7
  253.     Redim TSTRING002, INTEGER002
  254.     DBottom 1
  255.     DGet 1, "KEY", TSTRING002(0)
  256.     If ((Trim(TSTRING002(0), " ") == "") && (DRecCount(1) <= 1)) Then
  257.         Gosub LABEL004
  258.         KbdStuff "^M"
  259.         End
  260.     Endif
  261.     PrintLn TSTRING001(1)
  262.     For INTEGER003 = 1 To INTEGER002
  263.         DGet 1, "KEY", TSTRING002(INTEGER003)
  264.         TSTRING002(INTEGER003) = Trim(TSTRING002(INTEGER003), " ")
  265.         If (Len(TSTRING002(INTEGER003)) > 75) Then
  266.             STRING003 = Left(TSTRING002(INTEGER003), 75)
  267.         Else
  268.             STRING003 = TSTRING002(INTEGER003)
  269.         Endif
  270.         If (TSTRING002(INTEGER003) <> "") Then
  271.             OpText STRING003
  272.             PrintLn TSTRING001(2)
  273.         Else
  274.             Dec INTEGER003
  275.         Endif
  276.         If (DRecNo(1) == 1) Then
  277.             INTEGER002 = INTEGER003
  278.             Break
  279.         Endif
  280.         DSkip 1, -1
  281.     Next
  282.     INTEGER001 = 1
  283.     PrintLn TSTRING001(3)
  284.     Redim TSTRING005, INTEGER002
  285.     Redim TSTRING006, INTEGER002
  286.     For INTEGER003 = 1 To INTEGER002
  287.         TSTRING005(INTEGER003) = ScrText(3, 1 + INTEGER003, 75, 1)
  288.         TSTRING006(INTEGER003) = TSTRING001(4) + StripAtx(TSTRING005(INTEGER003))
  289.     Next
  290.     AnsiPos 3, 2
  291.     Print TSTRING006(1)
  292.     Return
  293.     :LABEL004
  294.     DClose 1
  295.     Color DefColor()
  296.     Cls
  297.     RestScrn
  298.     Return
  299.  
  300. ;------------------------------------------------------------------------------
  301. ;
  302. ; Usage report (before postprocessing)
  303. ;
  304. ; ■ Statements used :
  305. ;
  306. ;    8       End
  307. ;    5       Cls
  308. ;    4       Color 
  309. ;    74      Goto 
  310. ;    64      Let 
  311. ;    9       Print 
  312. ;    5       PrintLn 
  313. ;    57      If 
  314. ;    1       FOpen 
  315. ;    1       FClose 
  316. ;    2       FGet 
  317. ;    4       ResetDisp
  318. ;    1       GetUser
  319. ;    11      Gosub 
  320. ;    2       Return
  321. ;    3       Inc 
  322. ;    4       Dec 
  323. ;    3       KbdStuff 
  324. ;    1       OpText 
  325. ;    17      AnsiPos 
  326. ;    1       Backup 
  327. ;    1       Forward 
  328. ;    1       SaveScrn
  329. ;    1       RestScrn
  330. ;    3       Redim 
  331. ;    1       DOpen 
  332. ;    1       DClose 
  333. ;    2       DPack 
  334. ;    1       DNew 
  335. ;    1       DAdd 
  336. ;    2       DGo 
  337. ;    1       DBottom 
  338. ;    1       DSkip 
  339. ;    2       DDelete 
  340. ;    2       DGet 
  341. ;    1       DPut 
  342. ;
  343. ;
  344. ; ■ Functions used :
  345. ;
  346. ;    4       -
  347. ;    67      +
  348. ;    9       -
  349. ;    36      ==
  350. ;    10      <>
  351. ;    6       <
  352. ;    6       <=
  353. ;    2       >
  354. ;    10      >=
  355. ;    43      !
  356. ;    12      &&
  357. ;    5       ||
  358. ;    3       Len(
  359. ;    2       Upper()
  360. ;    2       Mid()
  361. ;    3       Left()
  362. ;    1       Right()
  363. ;    4       Space()
  364. ;    35      Chr()
  365. ;    2       InStr()
  366. ;    4       Abort()
  367. ;    7       Trim()
  368. ;    11      StripAtx()
  369. ;    2       Inkey()
  370. ;    1       String()
  371. ;    1       Mask_Ascii()
  372. ;    2       PPEPath()
  373. ;    1       PcbNode()
  374. ;    1       LangExt()
  375. ;    4       DefColor()
  376. ;    2       ScrText()
  377. ;    3       DRecCount()
  378. ;    1       DRecNo()
  379. ;
  380. ;------------------------------------------------------------------------------
  381. ;
  382. ; Analysis flags : No flag
  383. ;
  384. ;------------------------------------------------------------------------------
  385. ;
  386. ; Postprocessing report
  387. ;
  388. ;    5       For/Next
  389. ;    4       While/EndWhile
  390. ;    30      If/Then or If/Then/Else
  391. ;    1       Select Case
  392. ;
  393. ;------------------------------------------------------------------------------
  394. ;                 AEGiS Corp - Break the routines, code against the machines!
  395. ;------------------------------------------------------------------------------
  396.