home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / prokit / prokit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-02  |  7.2 KB  |  266 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * ProKit.PAS - demo program for the ProKit system (3-1-89)
  15.  *
  16.  *)
  17.  
  18. {!!!IMPORTANT!!! F5 WON'T WORK WITHOUT THE FOLLOWING LINE}
  19. {$M 6000,14000,14000}  {Stack, minheap, maxheap}
  20. {$S-,R-}
  21. {$L+,D+}
  22.  
  23.  
  24. Program ProKit_demo;
  25.  
  26. {$i prokit.inc}    {include standard 'uses' statement}
  27.  
  28.  
  29.  
  30. (* ---------------------------------------------------------------- *)
  31. procedure display_info;
  32. begin
  33.    displn(WHITE);
  34.    displn(first_name+', here is your User information:'+GREEN);
  35.    displn('   Current date   = '+system_date+' '+system_time);
  36.    displn('   Full name      = '+username);
  37.    displn('   Phone numbers  = '+user.busphone + ' / ' + user.phone);
  38.    displn('   City           = '+user.city);
  39.    displn('   Security level = '+itoa(userlevel));
  40.    displn('   Baud rate      = '+baudrate);
  41.  
  42.    displn('   Last call date = '+user.date+' '+user.time+
  43.            ', Used = '+itoa(user.lastused)+
  44.            '/'+itoa(pcbsys.prev_used));
  45.  
  46.    displn('   Conference     = '+conference_name+' ('+
  47.                   itoa(pcbsys.curconf)+'/'+itoa(user.curconf)+')');
  48.  
  49.    displn('   TimeOn (mins)  = '+itoa(pcbsys.time_on)+
  50.            ', Now = '+itoa(get_mins));
  51.  
  52.    displn('   Minutes left   = '+wtoa(minutes_left)+
  53.            ', Used = '+itoa(time_used)+
  54.            ', Credit = '+itoa(pcbsys.time_credit)+
  55.            ', Limit = '+itoa(pcbsys.time_limit)+
  56.            ', Added = '+itoa(pcbsys.time_added));
  57.  
  58.    displn('   Event schedule = '+itoa(minutes_before_event)+' minutes');
  59.  
  60.    displn('   Downloads      = '+itoa(user.downloads)+
  61.             ', Total = '+dtok(user.downtotal)+
  62.             'k, Today = '+dtok(user.downbytes)+
  63.             'k, Allowed = '+wtoa(download_k_allowed)+'k');
  64.  
  65.    displn('   Uploads        = '+itoa(user.uploads)+
  66.             ', Total = '+dtok(user.uptotal)+
  67.             'k, Earned = '+wtoa(user.earned_k)+
  68.             'k');
  69.  
  70.    disp  ('   Expert mode    = ');
  71.    if expert then displn('ON') else displn('OFF');
  72.  
  73.    disp  ('   Graphics       = ');
  74.    if graphics then displn('ON') else displn('OFF');
  75.  
  76.    force_enter;
  77. end;
  78.  
  79.  
  80.  
  81. (* ---------------------------------------------------------------- *)
  82. procedure take_chance;
  83. var
  84.    thinking_of:  anystring;
  85.  
  86. begin
  87.    {think of a number - based on the time of day}
  88.    thinking_of := itoa(random(9));
  89.  
  90.    {check for a stacked response- prompt if not}
  91.    if length(cmdline) = 0 then
  92.    begin
  93.       disp(CYAN);
  94.       displn('I''m thinking of a number from 0 to 9.   If you guess the');
  95.       displn('number, you will be given an extra 10 minutes online.  If you');
  96.       displn('get it wrong, your time will be reduced by 2 minutes.');
  97.       newline;
  98.       disp(YELLOW);
  99.       disp('What''s your guess? ');
  100.       get_cmdline;
  101.       newline;
  102.    end;
  103.  
  104.    {get the input and process it}
  105.    get_nextpar;
  106.    if par = thinking_of then
  107.    begin
  108.       disp(GREEN);
  109.       displn('That''s right!  You get a 10 minute bonus!');
  110.       adjust_time_allowed(10 * 60);
  111.    end
  112.    else
  113.  
  114.    begin
  115.       disp(BLUE);
  116.       displn('Wrong!  You lose 2 minutes!  I was thinking of '+thinking_of+'.');
  117.       adjust_time_allowed(-120);
  118.    end;
  119.  
  120. end;
  121.  
  122.  
  123.  
  124. (* ---------------------------------------------------------------- *)
  125. procedure test_pattern;
  126. var
  127.    i:     integer;
  128.    start: longint;
  129.  
  130. begin
  131.    flush_com;
  132.    start := lget_ms;
  133.    for i := 1 to 20 do
  134.       displn('(1234567890-abcdefghijklmnopqrstuvwxyz-ABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789)');
  135.    flush_com;
  136.    displn('Speed = '+ftoa(1580000.0 / int(lget_ms - start),0,1)+' char/sec');
  137. end;
  138.  
  139.  
  140. (* ---------------------------------------------------------------- *)
  141. procedure ansi_demo;
  142. var
  143.    x,y: integer;
  144.  
  145. begin
  146.    if not graphics then
  147.    begin
  148.       displn('You must be in GRAPHICS mode to run this demo.');
  149.       displn('Use the (M) command from the main board.');
  150.       exit;
  151.    end;
  152.  
  153.    disp(GREEN);
  154.    clear_screen;
  155.  
  156.    for y := 2 to 21 do
  157.    begin
  158.       position(1,y);  dispc('│');
  159.       position(79,y); dispc('│');
  160.    end;
  161.  
  162.    position(2,1);
  163.    for x := 2 to 78 do
  164.       dispc('─');
  165.  
  166.    position(2,22);
  167.    for x := 2 to 78 do
  168.       dispc('─');
  169.  
  170.    position(1,1);   dispc('┌');
  171.    position(79,1);  dispc('┐');
  172.    position(1,22);  dispc('└');
  173.    position(79,22); dispc('┘');
  174.  
  175.    disp(RED);
  176.    position(30,10);  disp(' P r o   K i t ');
  177.    disp(YELLOW);
  178.    position(12,12);  disp(' This is only a SMALL sample of what ProKit can do! ');
  179.    disp(WHITE);
  180.    position(30,18);  disp('Press (Enter): ');
  181.    get_cmdline;
  182.  
  183.    cmdline := '';
  184.    clear_screen;
  185. end;
  186.  
  187.  
  188. (* ---------------------------------------------------------------- *)
  189. procedure menu;
  190. begin
  191.  
  192.    newline;
  193.    displn(GRAY);
  194.    displn('ProKit DEMO - Based on ProKit '+version);
  195.    newline;
  196.    display_file('prokit.m');  {uses prokit.mg in graphics mode}
  197.    force_enter;
  198.    newline;
  199.  
  200.    {main command loop}
  201.    repeat
  202.  
  203.       {prompt for input only if there is not a stacked command pending}
  204.       if length(cmdline) = 0 then
  205.       begin
  206.          displn(WHITE);
  207.          displn('Main menu:');
  208.          displn(RED    +' (I)  Display system information');
  209.          displn(GREEN  +' (C)  Take a chance for more time online');
  210.          displn(MAGENTA+' (T)  Display a test pattern, calculate speed');
  211.          displn(CYAN   +' (A)  Ansi graphics demo');
  212.          displn(RED    +' (G)  Goodbye, hang up');
  213.          displn(BLUE   +' (Q)  Return to PCBoard');
  214.          newline;
  215.  
  216.          repeat
  217.             display_time_left;
  218.             disp(YELLOW+'Command? ');
  219.             get_cmdline;              {get cmdline, map to upper case}
  220.             newline;
  221.          until dump_user or (length(cmdline) > 0);
  222.       end;
  223.  
  224.       if dump_user then exit;   {leave menu if carrier lost}
  225.       get_nextpar;              {scan next parameter from cmdline into par}
  226.  
  227.       {process commands}
  228.       case par[1] of
  229.          'I':   display_info;
  230.          'C':   take_chance;
  231.          'T':   test_pattern;
  232.          'A':   ansi_demo;
  233.  
  234.          'G':   begin
  235.                    dump_user := true;
  236.                    option := o_logoff;
  237.                 end;
  238.  
  239.          'Q':   exit;
  240.          else   displn(MAGENTA+'('+par+') is not allowed!  Try again:');
  241.       end;
  242.  
  243.    until dump_user;
  244.  
  245. end;
  246.  
  247.  
  248. (* ---------------------------------------------------------------- *)
  249.  
  250. begin  {main block}
  251.    init;     {must be first - opens com port, loads setup and user data}
  252.  
  253.    load_cnames_file;       {make conference information available}
  254.  
  255.    load_color_constants('PROCOLOR');
  256.                            {use 'PROCOLOR' to redefine colors; defaults used
  257.                             if this file is missing}
  258.  
  259.    progname := 'Demo';    {program name on status line}
  260.    display_info;
  261.    menu;                  {insert your code here}
  262.  
  263.    uninit;   {must be last - closes com port and updates database}
  264. end.
  265.  
  266.