home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PCBOARD / DOME_PMT.ZIP / PROMPTS.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1994-03-06  |  7KB  |  438 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 2.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.     Integer  INTEGER008
  27.     Integer  INTEGER009
  28.     Integer  INTEGER010
  29.     Integer  INTEGER011
  30.     String   STRING001
  31.     String   STRING002
  32.     String   STRING003
  33.     String   TSTRING004(10)
  34.     String   STRING005
  35.     String   TSTRING006(50)
  36.     String   TSTRING007(50)
  37.     String   TSTRING008(50)
  38.     String   TSTRING009(50)
  39.     String   STRING010
  40.     String   STRING011
  41.     String   STRING012
  42.     String   STRING013
  43.     String   STRING014
  44.     String   STRING015
  45.     String   STRING016
  46.     String   STRING017
  47.     String   TSTRING018(10)
  48.     String   STRING019
  49.     String   STRING020
  50.  
  51. ;------------------------------------------------------------------------------
  52.  
  53.     GetUser
  54.     STRING001 = Chr(27)
  55.     STRING002 = Chr(13)
  56.     INTEGER001 = 0
  57.     STRING013 = ""
  58.     STRING014 = ""
  59.     STRING015 = ""
  60.     STRING016 = ""
  61.     STRING010 = STRING001 + "[s"
  62.     STRING011 = STRING001 + "[u"
  63.     STRING012 = STRING001 + "[B"
  64.     STRING020 = STRING001 + "[A"
  65.     INTEGER011 = 0
  66.     FOpen 1, PPEPath() + "prompts.cnf", 0, 0
  67.     If (Ferr(1)) Goto LABEL009
  68.     FGet 1, STRING005
  69.     FGet 1, INTEGER004
  70.     FGet 1, INTEGER005
  71.     FGet 1, INTEGER006
  72.     FGet 1, INTEGER007
  73.     FGet 1, INTEGER008
  74.     FClose 1
  75.     FOpen 1, PPEPath() + "prompts.dat", 0, 0
  76.     If (Ferr(1)) Goto LABEL009
  77.     :LABEL001
  78.     FGet 1, STRING013
  79.     If (STRING013 == "<EOF>") Then
  80.         FClose 1
  81.     Else
  82.         FGet 1, STRING014
  83.         If (STRING013 == "2") FGet 1, STRING015
  84.         If (STRING013 == "3") Then
  85.             FGet 1, STRING015
  86.             FGet 1, STRING016
  87.         Endif
  88.         Inc INTEGER001
  89.         TSTRING006(INTEGER001) = STRING013
  90.         TSTRING007(INTEGER001) = STRING014
  91.         TSTRING008(INTEGER001) = STRING015
  92.         TSTRING009(INTEGER001) = STRING016
  93.         TSTRING004(INTEGER001) = STRING010 + TSTRING007(INTEGER001)
  94.         If (STRING013 == "2") TSTRING004(INTEGER001) = TSTRING004(INTEGER001) + STRING011 + STRING012 + STRING010 + TSTRING008(INTEGER001)
  95.         If (STRING013 == "3") TSTRING004(INTEGER001) = TSTRING004(INTEGER001) + STRING011 + STRING012 + STRING010 + TSTRING008(INTEGER001) + STRING011 + STRING012 + TSTRING009(INTEGER001)
  96.         Goto LABEL001
  97.     Endif
  98.     :LABEL002
  99.     INTEGER003 = INTEGER001
  100.     INTEGER002 = INTEGER005
  101.     DispFile PPEPath() + "main.pcb", 1 + 4 + 2
  102.     AnsiPos INTEGER004, INTEGER002
  103.     Print "@X0FPrompt 1"
  104.     INTEGER001 = 2
  105.     INTEGER002 = INTEGER002 + 1
  106.     Print "@POFF@"
  107.     While (INTEGER001 <> INTEGER003 + 1) Do
  108.         AnsiPos INTEGER004, INTEGER002
  109.         PrintLn "@X0FPrompt " + String(INTEGER001)
  110.         Inc INTEGER001
  111.         INTEGER002 = INTEGER002 + 1
  112.     EndWhile
  113.     INTEGER003 = INTEGER003 + 2
  114.     AnsiPos INTEGER004, INTEGER002
  115.     PrintLn "@X0F Create "
  116.     AnsiPos INTEGER004, INTEGER002 + 1
  117.     PrintLn "  Quit  "
  118.     Print "@PON@"
  119.     INTEGER001 = 1
  120.     Gosub LABEL008
  121.     INTEGER002 = INTEGER005
  122.     AnsiPos INTEGER004, INTEGER002
  123.     Print STRING001 + "[s@X70Prompt " + String(INTEGER001) + STRING001 + "[u" + STRING001 + "[s"
  124.     STRING003 = ""
  125.     While (STRING003 <> STRING002) Do
  126.         STRING003 = Inkey()
  127.         If ((Lower(STRING003) == "a") || (STRING003 == "UP")) Then
  128.             If (INTEGER001 == INTEGER003) Then
  129.                 Print STRING001 + "[u" + STRING001 + "[s@X0F  Quit  "
  130.                 Goto LABEL003
  131.             Endif
  132.             If (INTEGER001 == INTEGER003 - 1) Then
  133.                 Print STRING001 + "[u" + STRING001 + "[s@X0F Create "
  134.                 Goto LABEL003
  135.             Endif
  136.             Print STRING001 + "[u" + STRING001 + "[s@X0FPrompt " + String(INTEGER001)
  137.             :LABEL003
  138.             If (INTEGER001 == 1) Then
  139.                 Print STRING001 + "[u" + STRING001 + "[" + String(INTEGER003 - 1) + "B" + STRING001 + "[s"
  140.                 INTEGER001 = INTEGER003
  141.                 INTEGER002 = GetY()
  142.                 Print "@X70  Quit  "
  143.                 Gosub LABEL008
  144.                 AnsiPos INTEGER004, INTEGER002
  145.                 Print STRING001 + "[s"
  146.                 Goto LABEL005
  147.             Endif
  148.             Print STRING001 + "[u" + STRING001 + "[A" + STRING001 + "[s"
  149.             INTEGER001 = INTEGER001 - 1
  150.             INTEGER002 = GetY()
  151.             If (INTEGER001 == INTEGER003 - 1) Then
  152.                 Print "@X70 Create "
  153.                 Goto LABEL004
  154.             Endif
  155.             Print "@X70Prompt " + String(INTEGER001)
  156.             :LABEL004
  157.             Gosub LABEL008
  158.             AnsiPos INTEGER004, INTEGER002
  159.             Print STRING001 + "[s"
  160.         Endif
  161.         :LABEL005
  162.         If ((Lower(STRING003) == "z") || (STRING003 == "DOWN")) Then
  163.             If (INTEGER001 == INTEGER003) Then
  164.                 Print STRING001 + "[u" + STRING001 + "[s@X0F  Quit  "
  165.                 Goto LABEL006
  166.             Endif
  167.             If (INTEGER001 == INTEGER003 - 1) Then
  168.                 Print STRING001 + "[u" + STRING001 + "[s@X0F Create "
  169.                 Goto LABEL006
  170.             Endif
  171.             Print STRING001 + "[u" + STRING001 + "[s@X0FPrompt " + String(INTEGER001)
  172.             :LABEL006
  173.             If (INTEGER001 == INTEGER003) Then
  174.                 Print STRING001 + "[u" + STRING001 + "[" + String(INTEGER003 - 1) + "A" + STRING001 + "[s"
  175.                 INTEGER001 = 1
  176.                 INTEGER002 = GetY()
  177.                 Print "@X70Prompt 1"
  178.                 Gosub LABEL008
  179.                 AnsiPos INTEGER004, INTEGER002
  180.                 Print STRING001 + "[s"
  181.                 Continue
  182.             Endif
  183.             Print STRING001 + "[u" + STRING001 + "[B" + STRING001 + "[s"
  184.             INTEGER001 = INTEGER001 + 1
  185.             INTEGER002 = GetY()
  186.             If (INTEGER001 == INTEGER003 - 1) Then
  187.                 Print "@X70 Create "
  188.                 Goto LABEL007
  189.             Endif
  190.             If (INTEGER001 == INTEGER003) Then
  191.                 Print "@X70  Quit  "
  192.                 Goto LABEL007
  193.             Endif
  194.             Print "@X70Prompt " + String(INTEGER001)
  195.             :LABEL007
  196.             Gosub LABEL008
  197.             AnsiPos INTEGER004, INTEGER002
  198.             Print STRING001 + "[s"
  199.         Endif
  200.     EndWhile
  201.     If (INTEGER001 == INTEGER003) Goto LABEL009
  202.     If (INTEGER001 == INTEGER003 - 1) Goto LABEL010
  203.     Delete STRING005
  204.     FCreate 1, STRING005, 1, 0
  205.     Select Case (TSTRING006(INTEGER001))
  206.         Case "1"
  207.             FPut 1, TSTRING007(INTEGER001)
  208.             FClose 1
  209.         Case "2"
  210.             FPutLn 1, TSTRING007(INTEGER001)
  211.             FPut 1, TSTRING008(INTEGER001)
  212.             FClose 1
  213.             FPutLn 1, TSTRING007(INTEGER001)
  214.             FPutLn 1, TSTRING008(INTEGER001)
  215.             FPut 1, TSTRING009(INTEGER001)
  216.             FClose 1
  217.             STRING017 = PPEPath() + Left(Strip(Strip(U_Name(), Chr(46)), Chr(32)), 8) + ".PMT"
  218.             If (Exist(STRING017)) Delete STRING017
  219.             FCreate 1, STRING017, 1, 3
  220.         Case "1"
  221.             FPut 1, TSTRING007(INTEGER001)
  222.             FClose 1
  223.         Case "2"
  224.             FPutLn 1, TSTRING007(INTEGER001)
  225.             FPut 1, TSTRING008(INTEGER001)
  226.             FClose 1
  227.         Case Else
  228.             FPutLn 1, TSTRING007(INTEGER001)
  229.             FPutLn 1, TSTRING008(INTEGER001)
  230.             FPut 1, TSTRING009(INTEGER001)
  231.             FClose 1
  232.             Goto LABEL009
  233.             :LABEL008
  234.             AnsiPos INTEGER006, INTEGER007
  235.             Print STRING001 + "[s@X0F" + Space(INTEGER008) + STRING001 + "[u" + STRING001 + "[B"
  236.             Print STRING001 + "[s" + Space(INTEGER008) + STRING001 + "[u" + STRING001 + "[B"
  237.             Print STRING001 + "[s" + Space(INTEGER008)
  238.             AnsiPos INTEGER006, INTEGER007
  239.             Select Case (INTEGER001)
  240.                 Case INTEGER003
  241.                     Print STRING001 + "[s" + "Quit - No change"
  242.                     Return
  243.                 Case INTEGER003 - 1
  244.                     Print STRING001 + "[s" + "Design your own prompt!" + STRING001 + "[u"
  245.             End Select
  246.             Print STRING001 + "[s" + TSTRING004(INTEGER001)
  247.             Return
  248.     End Select
  249.     :LABEL009
  250.     Print "@X0F"
  251.     Cls
  252.     PrintLn "@X0AImproved @X0FSelectable / Configurable @X0APrompts v.97ß"
  253.     PrintLn "Coded by @X0AC@X02o@X08rrupti@X07o@X0FN [DoME]"
  254.     End
  255.     :LABEL010
  256.     If (INTEGER011 == 0) Then
  257.         Cls
  258.         DispFile PPEPath() + "help1.pcb", 1 + 4 + 2
  259.         TSTRING018(1) = ""
  260.         TSTRING018(2) = ""
  261.         TSTRING018(3) = ""
  262.         INTEGER010 = 1
  263.         Newline
  264.     Endif
  265.     TSTRING018(INTEGER010) = ""
  266.     INTEGER011 = 0
  267.     While (INTEGER010 <> 4) Do
  268.         InputText "@X07>@X0F _", TSTRING018(INTEGER010), 0, 60
  269.         If ((INTEGER010 == 1) && (TSTRING018(INTEGER010) == "")) Then
  270.             Newline
  271.             Goto LABEL002
  272.         Endif
  273.         If (TSTRING018(INTEGER010) == "") Then
  274.             Newline
  275.             Goto LABEL011
  276.         Endif
  277.         If (Lower(TSTRING018(INTEGER010)) == "/help") Then
  278.             INTEGER002 = GetY()
  279.             Goto LABEL013
  280.         Endif
  281.         Inc INTEGER010
  282.         Newline
  283.     EndWhile
  284.     For INTEGER009 = 1 To INTEGER010
  285.         If (TSTRING018(INTEGER009) == "@HANGUP@") Then
  286.             Newline
  287.             PrintLn "Putting @HANGUP@ in your prompt is STUPID!  Don't do it again!"
  288.             Wait
  289.             Goto LABEL010
  290.         Endif
  291.     Next
  292.     :LABEL011
  293.     INTEGER010 = INTEGER010 - 1
  294.     STRING019 = "n"
  295.     Newlines 2
  296.     For INTEGER009 = 1 To INTEGER010
  297.         PrintLn TSTRING018(INTEGER009)
  298.     Next
  299.     Newline
  300.     InputStr "Save and Use this prompt", STRING019, 10, 1, "ynYN", 4 + 2
  301.     If ((Lower(STRING019) == "n") || (STRING019 == "")) Then
  302.         Newlines 2
  303.         Wait
  304.         Goto LABEL002
  305.     Else
  306.         Goto LABEL012
  307.     Endif
  308.     Goto LABEL002
  309.     :LABEL012
  310.     STRING017 = PPEPath() + Left(Strip(Strip(U_Name(), Chr(46)), Chr(32)), 8) + ".PMT"
  311.     If (Exist(STRING017)) Delete STRING017
  312.     FCreate 1, STRING017, 1, 3
  313.     Select Case (INTEGER010)
  314.         Case 1
  315.             FPut 1, TSTRING018(1)
  316.             FClose 1
  317.         Case 2
  318.             FPutLn 1, TSTRING018(1)
  319.             FPut 1, TSTRING018(2)
  320.             FClose 1
  321.         Case 3
  322.             FPutLn 1, TSTRING018(1)
  323.             FPutLn 1, TSTRING018(2)
  324.             FPut 1, TSTRING018(3)
  325.             FClose 1
  326.     End Select
  327.     Delete STRING005
  328.     FCreate 1, STRING005, 1, 0
  329.     If (INTEGER010 == 1) Then
  330.         FPut 1, TSTRING018(1)
  331.         FClose 1
  332.         Goto LABEL009
  333.     Endif
  334.     If (INTEGER010 == 2) Then
  335.         FPutLn 1, TSTRING018(1)
  336.         FPut 1, TSTRING018(2)
  337.         FClose 1
  338.         Goto LABEL009
  339.     Endif
  340.     If (INTEGER010 == 3) Then
  341.         FPutLn 1, TSTRING018(1)
  342.         FPutLn 1, TSTRING018(2)
  343.         FPut 1, TSTRING018(3)
  344.         FClose 1
  345.     Endif
  346.     Newlines 2
  347.     Wait
  348.     Goto LABEL009
  349.     :LABEL013
  350.     SaveScrn
  351.     Cls
  352.     DispFile PPEPath() + "help2.pcb", 1 + 4 + 2
  353.     Wait
  354.     Cls
  355.     RestScrn
  356.     AnsiPos 1, INTEGER002
  357.     ClrEol
  358.     INTEGER011 = 1
  359.     Goto LABEL010
  360.  
  361. ;------------------------------------------------------------------------------
  362. ;
  363. ; Usage report (before postprocessing)
  364. ;
  365. ; ■ Statements used :
  366. ;
  367. ;    1       End
  368. ;    4       Cls
  369. ;    1       ClrEol
  370. ;    4       Wait
  371. ;    76      Goto 
  372. ;    53      Let 
  373. ;    32      Print 
  374. ;    7       PrintLn 
  375. ;    45      If 
  376. ;    3       DispFile 
  377. ;    4       FCreate 
  378. ;    2       FOpen 
  379. ;    14      FClose 
  380. ;    11      FGet 
  381. ;    12      FPut 
  382. ;    12      FPutLn 
  383. ;    1       GetUser
  384. ;    4       Delete 
  385. ;    1       InputStr 
  386. ;    5       Gosub 
  387. ;    2       Return
  388. ;    3       Inc 
  389. ;    6       Newline
  390. ;    3       Newlines 
  391. ;    1       InputText 
  392. ;    12      AnsiPos 
  393. ;    1       SaveScrn
  394. ;    1       RestScrn
  395. ;
  396. ;
  397. ; ■ Functions used :
  398. ;
  399. ;    119     +
  400. ;    10      -
  401. ;    40      ==
  402. ;    3       <>
  403. ;    2       <
  404. ;    2       <=
  405. ;    4       >=
  406. ;    36      !
  407. ;    5       &&
  408. ;    5       ||
  409. ;    4       Lower()
  410. ;    2       Left()
  411. ;    3       Space()
  412. ;    2       Ferr()
  413. ;    6       Chr()
  414. ;    2       U_Name()
  415. ;    4       Strip()
  416. ;    1       Inkey()
  417. ;    8       String()
  418. ;    7       PPEPath()
  419. ;    2       Exist()
  420. ;    5       GetY()
  421. ;
  422. ;------------------------------------------------------------------------------
  423. ;
  424. ; Analysis flags : No flag
  425. ;
  426. ;------------------------------------------------------------------------------
  427. ;
  428. ; Postprocessing report
  429. ;
  430. ;    2       For/Next
  431. ;    3       While/EndWhile
  432. ;    22      If/Then or If/Then/Else
  433. ;    3       Select Case
  434. ;
  435. ;------------------------------------------------------------------------------
  436. ;                 AEGiS Corp - Break the routines, code against the machines!
  437. ;------------------------------------------------------------------------------
  438.