home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 3 / hamradioversion3.0examsandprograms1992.iso / control / net400-1 / netlogin.pas < prev    next >
Pascal/Delphi Source File  |  1989-07-13  |  6KB  |  244 lines
  1. procedure clear_window(on : boolean);
  2. begin
  3.   if (on) then
  4.             begin
  5.               brite_blanks;
  6.               auxcolor;
  7.             end
  8.           else
  9.             begin
  10.               norm_blanks;
  11.               normcolor;
  12.             end;
  13. end;
  14.  
  15. procedure login;
  16. var i : integer;
  17.     old_x, old_y : integer;
  18.     test_prefix : pre_str;
  19.     test_area : char;
  20.     test_suffix : post_str;
  21.     key : char;
  22.  
  23.  procedure show_call(p : integer; brite : boolean);
  24.  begin
  25.    if NOT (p in [0..13]) then exit;
  26.    if brite = FALSE
  27.    then
  28.      auxcolor
  29.    else
  30.      brite_auxcolor;
  31.    gotoxy(x[p],y[p]);
  32.    case p of
  33.      0 : write(test_suffix:6);
  34.      1..13 : with net_list[call[p]]^ do
  35.                write(Trim(prefix) + area + suffix : 6) ;
  36.      end;
  37.    gotoxy(x[p],y[p]);
  38.  end;
  39.  
  40.   procedure all_ready_logged;
  41.   begin
  42.     window(32,8,79,16);
  43.     textcolor(status_f);
  44.     textbackground(norm_b);
  45.     gotoxy(30,1);
  46.     write('ALREADY LOGGED',#7);
  47.     delay(500);
  48.     gotoxy(30,1);
  49.     ClrEol;
  50.     window(1,1,80,25);
  51.   end;
  52.  
  53.  
  54.   procedure new_call;
  55.   var test_prefix : string[3];
  56.       test_area   : string[1];
  57.   begin
  58.     if (new_pntr = max_new) then
  59.     begin
  60.       window(32,8,79,16);
  61.       textcolor(status_f);
  62.       textbackground(status_b);
  63.       gotoxy(30,1); ClrEol; write('No NEW CALL memory left',#7);
  64.       normcolor;
  65.       window(1,1,80,25);
  66.     end
  67.     else
  68.     begin
  69.       window(32,8,79,16);
  70.       normcolor;
  71.       Set_Confirm_On;
  72.       test_prefix := '  ';
  73.       sayget(30,1,'Prefix ',test_prefix,_S,2,0);
  74.       picture('@!');
  75.       test_area := ' ';
  76.       sayget(30,2,'Area   ',test_area,_S,1,0);
  77.       picture('9');
  78.       readgets;
  79.       Set_Confirm_Off;
  80.       if test_prefix = '  ' then
  81.         begin
  82.           gotoxy(30,1); ClrEol;
  83.           gotoxy(30,2); ClrEol;
  84.           window(1,1,80,25);
  85.           exit;                 { this call is rejected }
  86.         end;
  87.       gotoxy(30,1); ClrEol;
  88.       gotoxy(30,2); ClrEol;
  89.       if (new_there(test_prefix,test_area,test_suffix) = TRUE) then
  90.       begin
  91.         all_ready_logged;
  92.         exit;
  93.       end;
  94.       new_pntr := new_pntr + 1;
  95.       top_pntr := top_pntr + 1;
  96.       with checkins[top_pntr] do
  97.       begin
  98.         list_nbr := 1;
  99.         position := new_pntr;
  100.         hr_min   := copy(SystemTime,1,5);
  101.       end;
  102.       with new_list[new_pntr]^ do
  103.       begin
  104.         prefix    := test_prefix;
  105.         area      := test_area;
  106.         suffix    := test_suffix;
  107.         name      := '';
  108.         net_nbr   := ' ';
  109.         log_date  := SystemDate;
  110.         xref      := top_pntr;
  111.         with NBase do
  112.         begin
  113.           _PREFIX  := prefix;
  114.           _AREA    := area;
  115.           _SUFFIX  := suffix;
  116.           _NAME    := name;
  117.           _LOGDATE := SystemDate;
  118.         end;
  119.         APPEND;
  120.         recnbr := RecNo;
  121.       end;
  122.       gotoxy(1,1); InsLine;
  123.       write(Trim(test_prefix) + test_area + test_suffix:6);
  124.       if (max_new - new_pntr = 5) then
  125.       begin
  126.         textcolor(status_f);
  127.         textbackground(norm_b);
  128.         gotoxy(25,2); write('Only 5 more new logins');
  129.         gotoxy(25,3); write('allowed.');
  130.       end;
  131.       window(1,1,80,25);
  132.       display_checkin(top_pntr);
  133.       if top_pntr = 1 then top_of_roster;
  134.       update_flag := TRUE;
  135.       status;
  136.     end;
  137.   end;
  138.  
  139.   procedure add_call;
  140.   begin
  141.     if net_list[call[call_count]]^.xref = 0
  142.     then
  143.     begin
  144.       top_pntr := top_pntr + 1;
  145.       with checkins[top_pntr] do
  146.       begin
  147.         list_nbr := 0;
  148.         position := call[call_count];
  149.         hr_min   := copy(SystemTime,1,5);
  150.         net_list[position]^.xref := top_pntr;
  151.         window(32,8,79,16);
  152.         normcolor;
  153.         gotoxy(1,1); InsLine;
  154.         with net_list[position]^ do
  155.         begin
  156.           write((Trim(prefix) + area + suffix):6,' ',name:10);
  157.           if (net_nbr <> ' ') then
  158.             write(net_nbr:5);
  159.         end;
  160.         window(1,1,80,25);
  161.       end;
  162.       display_checkin(top_pntr);
  163.       if top_pntr = 1 then top_of_roster;
  164.       update_flag := TRUE;
  165.       status;
  166.     end
  167.     else
  168.       all_ready_logged;
  169.   end;
  170.  
  171. begin
  172.   old_x := WhereX; old_y := WhereY;
  173.   window(32,8,79,16);
  174.   normcolor;
  175.   ClrScr;
  176.   window(1,1,80,25);
  177. repeat
  178.   test_suffix := '   ';
  179.   clear_window(true);
  180.   sayget(x[0],y[0],'',test_suffix,_S,3,0);
  181.   picture('@!');
  182.   readgets;
  183.   if (test_suffix <> '   ') then
  184.   begin
  185.     gotoxy(32,2);
  186.     textcolor(status_f);
  187.     textbackground(border_b);
  188.     write('NuCall');
  189.     find_call(test_suffix);
  190.     show_call(0,FALSE);
  191.     key := #0;
  192.     if multiple > 0
  193.     then
  194.       begin
  195.         for call_count := 1 to multiple do
  196.           show_call(call_count,FALSE);
  197.         gotoxy(x[first],y[first]);
  198.         call_count := first;
  199.         show_call(first,TRUE);
  200.         repeat
  201.           key := readkey;
  202.           if key = #0 then
  203.             begin
  204.               key := readkey;
  205.               case key of
  206.                 #77 : { -> } begin
  207.                       if call_count < multiple then
  208.                       begin
  209.                         show_call(call_count, FALSE);
  210.                         call_count := call_count + 1;
  211.                         show_call(call_count,TRUE);
  212.                       end;
  213.                     end;
  214.                  #75 : { <- }
  215.                      begin
  216.                        if call_count > 0 then
  217.                        begin
  218.                          show_call(call_count,FALSE);
  219.                          call_count := call_count - 1;
  220.                          show_call(call_count,TRUE);
  221.                        end;
  222.                      end;
  223.                  end;
  224.                  key := #0;
  225.             end;
  226.       until (key in [#13,#27]);
  227.       end;
  228.   end;
  229.   if key <> #27 then
  230.     begin
  231.       if test_suffix > '   ' then
  232.         if (call_count = 0) OR (multiple = 0)
  233.           then new_call
  234.           else add_call;
  235.     end;
  236.   textcolor(border_f);
  237.   textbackground(border_b);
  238.   gotoxy(32,2);
  239.   write('SUFFIX');
  240. until (test_suffix = '   ');
  241.   clear_window(false);
  242.   gotoxy(old_x,old_y);
  243. end;
  244.