{
******************************************************************************
*                                                                            *
*                       VAX/VMS Bulletin Board program                       *
*                       ******* ******** ***** *******                       *
*                                                                            *
*  This program will provide VMS users throughout a DECnet network           *
*  with a sophisticated bulletin board system which can be accessed for      *
*  reading and writing from any authorized account.                          *
*                                                                            *
*                                                                            *
*  Version:			2.3                                          *
*                                                                            *
*  Written by:			Mark Resmer                                  *
*				Vassar College                               *
*                                                                            *
*  Date written:		04-DEC-1985                                  *
*                                                                            *
*                                                                            *
*  Extensively revised by:	John T. Shirron                              *
*				Sachs/Freeman Associates, Inc.               *
*				Naval Research Laboratory                    *
*				Code 5133                                    *
*				jshirron@nrl-acoustics                       *
*                                                                            *
*                               Charles E. Brown                             *
*                               RCD, NRL, Code 2811.12, brown3@nrl3.arpa     *
*                                                                            *
*  Date revised:		16-Jun-1987                                  *
*                                                                            *
*  Revised and documented by:   Alta M. Paul                                 *
*                               Century Technologies, RCD, NRL               *
*                               Code 2800.CENTECH                            *
*                               November, 1987 - September, 1988             *
*                                                                            *
*  Language:			PASCAL version 3.0                           *
*                                                                            *
*  Operating System:		VMS version 4.6                              *
*                                                                            *
*  Copyright (C) 1985 Mark Resmer - permission is hereby  granted for the    *
*  reproduction of this software, on condition that this copyright notice    *
*  is included in the reproduction, and that such reproduction is not for    *
*  purposes of profit or material gain.                                      *
*                                                                            *
******************************************************************************
}

[inherit('sys$library:starlet','lib$spawn','smgdefs','smg$repaint_line'),
ENVIRONMENT('BB.PEN')]
program bb(bannerfile,bbfile,bbwrtfile,ifile,input,ofile,output,newuserfile,tu);

label 50,99;

const  
  system_group=8;			{maximum system group}
  node_name_length=15;			{length of node names (with ::)}
  ast_mask=(2**3)+(2**23)+(2**25);	{trap ^C, ^W and ^Y}
					{smg info}
  display_height=16;
  display_width=80;
  screen_rows=24;
  screen_cols=80;
					{parameters for data headers}
  blocksize=512*3;			{3 block records in database}
  date_length=8;
  key_length=36;			{used in the topic_uic definition}
  topic_length=16;
  username_length=48;
  subject_length=30;
  data_length=blocksize-date_length-topic_length-
              username_length-subject_length-3;
  null_date=chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0)+chr(0);
  null_topic=null_date+null_date;

	{symbolic key definitions}
  ctrl_c=chr(3);
  ctrl_w=chr(23);
  ctrl_y=chr(25);
  key_help=chr(1);
  key_do=chr(2);
  key_find=chr(3);
  key_insert=chr(4);
  key_remove=chr(5);
  key_select=chr(6);
  key_prev=chr(7);
  key_next=chr(8);
  key_up=chr(9);
  key_left=chr(10);
  key_down=chr(11);
  key_right=chr(12);
  key_cr=chr(13);
  key_lf=chr(10);
  key_exit=chr(26);


type
  nametype = packed array [1..username_length] of char;
  nodetype = packed array [1..node_name_length] of char;
  param_type = packed array [1..12] of char;
  timetype = packed array [1..date_length] of char;

  bbrec = record
            date : timetype;			{message posted date}
            topic : packed array [1..topic_length] of char;{topic board name}
            poster : nametype;			{person who sent message}
            subject : packed array [1..subject_length] of char;{subject of the message}
            data : varying [data_length] of char;{the message}
            continuation : boolean;		{if message is long}
	    date_posted : timetype;		{the date message was posted to network}
          end;

  items = [volatile] record
            length : [word] 0..65535;
            code : [word] 0..65535;
            adr : ^integer;
            retlen : ^integer;
          end;

  integer_ptr = ^integer;
  name_ptr = ^nametype;
  node_ptr = ^nodetype;

  dir_ptr=^dirrec;

  dirrec = record
             previous : dir_ptr;
             next : dir_ptr;
             number : integer;
             date : timetype;
             topic : packed array [1..topic_length] of char;
             poster : packed array [1..username_length] of char;
             subject : packed array [1..subject_length] of char;
             class : integer;
	     message_counters : record
				  total_message : integer;
				  new_message : integer;
				  read_message : integer;
				  skipped_message : integer;
				end;
             last_date_accessed : timetype;
           end;

  data_ptr=^datarec;

  datarec = record
              previous : data_ptr;
              next : data_ptr;
              data : varying [data_length] of char;
            end;

  {userinfotype and newuserrec used for bb$newuserfile.dat}
  userinfotype = packed array [1..date_length+topic_length+20] of char;
  newuserrec = record
	 	 message_id : [key(0)] userinfotype;
    	       end;

  string = varying [data_length] of char;

  topic_uic=record
               topic:packed array [1..topic_length] of char;
               user_group:integer;
               member_group:integer;
               key:[key(0)] packed array[1..key_length] of char;
             end;

var
  access_control : string;
  actual_message_count : integer;
  adjust : boolean;  {Flag used to inhibit some screen management routines.}
  bannerfile : text;
  count_file : text;
  count_location : string;
  bbfile : file of bbrec;
  bb_manager : boolean;
  bbwrtfile : file of bbrec;
  broadcast_display : [volatile] unsigned;
  chosen_file : string; {Added 9-MAR-88 to split database into 2 files}
  cluster_usernames : packed array [1..16] of nametype;
  count : integer;
  current_record : bbrec;
  current_topic : packed array [1..topic_length] of char;
  data_curr : data_ptr;
  data_nodes : packed array [1..16] of nodetype;
  data_prev : data_ptr;
  data_root : data_ptr;
  dbug : string; {for debuging}
  destination_option : char;
  dir_curr : dir_ptr;
  dir_display : boolean;
  dir_list : dir_ptr;
  dir_prev : dir_ptr;
  dir_root : dir_ptr;
  dir_save : dir_ptr;
  dir_start : dir_ptr;
  error_display : [volatile] unsigned;
  file_location : string;
  found : boolean;
  header_display : unsigned;
  header_display1 : unsigned;	 {for topic directory header highwide}
  header_display2 : unsigned;    {for topic directory header message counter}
  help_display : unsigned;
  help_header_display : unsigned;
  i : integer;
  ifile : text;
  item_list : array [1..3] of items;
  keyboard : [volatile] unsigned;
  line : string;
  main_display : unsigned;
  menu_display : [volatile] unsigned;
  message_count : integer;
  message_display : unsigned;
  message_option : char;
  m_menu : boolean;    {marks if message menu is already displayed}
  new_message_count : integer;
  newuserfile : file of newuserrec;
  num_nodes : [volatile] integer;
  ofile : text;
  out_of_bounds : boolean;
  pasteboard : [volatile] unsigned;
  protected : boolean; {this flag is true for boards only bbmanager can alter}
  saved_display : unsigned;
  select_first_time : boolean;
  system_manager : boolean;
  topic_counter : integer; {the topic counter used in making menu}
  topic_list : dir_ptr;
  topic_prev : dir_ptr;
  topic_root : dir_ptr;
  topic_save : dir_ptr;
  topic_start : dir_ptr;
  topic_curr : dir_ptr;
  topic_option : char;
  t_menu : boolean;    {marks if topic menu is already displayed}
  tu:file of topic_uic;		{file for the topic_user protection info}
  user_group : [volatile] integer;
  member_group : [volatile] integer;	{member uic to be a bbmanager}
  user_id : nametype;
  username : nametype;
  user_node : nodetype;
  wait_time : real;	{used in lib$wait}

  data_logical : [volatile] nametype;
  help_logical : [volatile] nametype;
  new_user_logical : [volatile] nametype;
  count_logical : [volatile] nametype;

                                                                           
{**********************************************************************
***********************************************************************

Note: Most modules are stored in an object library called BBLIB.

***********************************************************************
**********************************************************************}
	
procedure goto99;

{This procedure is called from the other modules to exit quickly}

begin
   goto 99;
end;

{**********************************************************************
**********************************************************************}
    
procedure goto50;

{This module added 15-MAR-88 to loop back into first screen
         when exiting with QUIT or <CNTRL-Z>.  If using <CNTRL-Y>
         exit then the program terminates immediately.  AMP}

begin
  close(bbfile,error:=continue);
  close(newuserfile,error:=continue);
  smg$delete_pasteboard(pasteboard);
  goto 50;
end;

{**********************************************************************
**********************************************************************}
	
[asynchronous,unbound]procedure asynch_goto99;

{This procedure is called from the asynchronous modules to exit quickly}

begin
   goto 99;
end;  

{**********************************************************************
**********************************************************************}

	{Function for callable EDT}

[external]
function edt$edit
  (%stdescr in_file : packed array [l..u:integer] of char;
   %stdescr out_file : packed array [l1..u1:integer] of char:=%immed 0;
   %stdescr com_file : packed array [l2..u2:integer] of char:=%immed 0) :
   integer;extern;

{**********************************************************************
**********************************************************************}
	{Used to wait on processing}
[external]
function lib$wait
  (%REF wait_time : real) :
   integer;extern;

{**********************************************************************
**********************************************************************}
	 {Call the edt editor to create message to be posted to a board}
[external] procedure add_edit;
     extern;

{**********************************************************************
**********************************************************************}

	{Use a file to post messages to a board}
[external] procedure add_file;
     extern;

{**********************************************************************
**********************************************************************}

	{Call when a message is to be added to a board}
[external] procedure add_menu;
     extern;         

{**********************************************************************
**********************************************************************}

	{Used to add topics to the topics menu and bbfile}
[external] procedure add_topic;
    extern;          

{**********************************************************************
**********************************************************************}

	{Trap incoming messages}
[external,asynchronous,unbound]procedure broadcast_handler;
    extern;                              

{**********************************************************************
**********************************************************************}

	{Choose the file containing the desired category of topics}
[external]   
procedure choose_database;
     extern;

{**********************************************************************
**********************************************************************}

	{Get the message list loaded and ready in link list of messages}
[external] procedure create_message_data_list;
    extern;

{**********************************************************************
**********************************************************************}

	{Creates the message listing of a topic selected}
[external] procedure create_message_dir_list;
     extern;

{**********************************************************************
**********************************************************************}

	{Makes topic list that is used to select from}
[external] procedure create_topic_dir_list;
     extern;

{**********************************************************************
**********************************************************************}

	{Delete messages that are owned by the deleter}
[external] procedure delete_message;
     extern;

{**********************************************************************
**********************************************************************}

	{Delete topics by number or name from bbdata file}
[external] procedure delete_topic;
     extern;

{**********************************************************************
**********************************************************************}

	{Extracts message into a file}
[external] procedure extract;
     extern;

{**********************************************************************
**********************************************************************}

	{Get a message from the database or tell that it can't be found}
[external] procedure find_message(base:integer:=1);
     extern;

{**********************************************************************
**********************************************************************}

	{Get cluster info}
[external] procedure get_cluster_data;
     extern;

{**********************************************************************
**********************************************************************}

	{Get the message record information}
[external] procedure get_message_info;
     extern;

{**********************************************************************
**********************************************************************}

	{Get info on system nodes}
[external] procedure get_node_data;
     extern;

{**********************************************************************
**********************************************************************}

	{Get group number from system service routines}
[external] procedure get_uic;
     extern;

{**********************************************************************
**********************************************************************}

	{Get username from system service routines}
[external] procedure get_username;
     extern;

{**********************************************************************
**********************************************************************}

	{Read 1 character from keyboard}
[external,asynchronous] 
function getchar:char;
     extern;

{**********************************************************************
**********************************************************************}

	{Invert date to make index for file access}
[external]
function invert(time:timetype):timetype;
     extern;

{**********************************************************************
**********************************************************************}

	{Mark message as read}
[external] procedure log_message;
     extern;

{**********************************************************************
**********************************************************************}

	{The message menu actions are controlled from here}
[external] procedure message_menu;
     extern;

{**********************************************************************
**********************************************************************}

	{Create counts of total and new messages for each board}
[external]
procedure message_state;
   extern;

{**********************************************************************
**********************************************************************}

   {Control the actions taken on the messages}
[external] procedure messages;
    extern;                

{**********************************************************************
**********************************************************************}

	{The message following the current one is loaded for reading}
[external] procedure next_message;
     extern;

{**********************************************************************
**********************************************************************}

	{open BB files}
[external] procedure open_files;
     extern;

{**********************************************************************
**********************************************************************}

	{Trap ^c, ^w, ^y}
[external,asynchronous,unbound]procedure out_of_band_handler(param:param_type);
     extern;                                                                   

{**********************************************************************
**********************************************************************}

	{Previous message is loaded to be read}
[external] procedure previous_message;
     extern;       

{**********************************************************************
**********************************************************************}

	{Displays the message page before the current one if there is one}
[external] procedure previous_message_directory_page;
     extern;

{**********************************************************************
**********************************************************************}

	{The previous page of a message is displayed or previous message}
[external] procedure previous_message_page;
     extern;

{**********************************************************************
**********************************************************************}

	{Check to see if the person using the BB can alter particular boards}
[external] procedure protected_topic_board;
     extern;                                

{**********************************************************************
**********************************************************************}

	{Write the help file info for bb}
[external] procedure put_help(header,filename:string;pause:boolean:=true);
     extern;

{**********************************************************************
**********************************************************************}

	{Send mail to the board on the DDN network, not CCF local}
[external] procedure put_internet(mail_file:string);
     extern;

{**********************************************************************
**********************************************************************}

	{Puts the message only to the local, CCF BB data base}
[external] procedure put_local;
     extern;

{**********************************************************************
**********************************************************************}

	{Read string from keyboard}
[external] procedure readstr(var str:string);
     extern;

{**********************************************************************
**********************************************************************}

	{Send mail to internet boards local area boards or poster of 
	the message}
[external] procedure reply_menu;
     extern;

{**********************************************************************
**********************************************************************}

	{Select the topic by number or full name}
[external] procedure select_topic;
     extern;           

{**********************************************************************
**********************************************************************}

	{Set up of screen windows to be used in smg}
[external] procedure setup;
     extern;

{**********************************************************************
**********************************************************************}

	{The topic menu actions are controlled from here}
[external] procedure topic_menu;
     extern;

{**********************************************************************
**********************************************************************}

	{Update last date for topic just read}
[external]
procedure update_last_access(updater : bbrec);
   extern;

{**********************************************************************
**********************************************************************}

   {To update dates of last access and counter for the current topic}
[external] procedure update_topic_info;
    extern;

{**********************************************************************
**********************************************************************}

	{Write error message}
[external,asynchronous,unbound]
procedure write_error(error_line:string;error_condition:boolean:=true);
    extern;

{**********************************************************************
**********************************************************************}

	{Write bottom line of screen}
[external,asynchronous,unbound]
procedure write_menu(title,options:string);
    extern;

{**********************************************************************
**********************************************************************}

	{Write the message that is being read}
[external] procedure write_message_data;
     extern;

{**********************************************************************
**********************************************************************}

	{Displays the directory of message for a topic selected}
[external] procedure write_message_directory;
     extern;       

{**********************************************************************
**********************************************************************}

	{Displays number, topic, description for each topic board} 
[external] procedure write_topic_directory;
     extern;

{**********************************************************************
**********************************************************************}

begin	{main program}
50: setup;
    choose_database;   
    get_username;
    get_node_data;
    get_cluster_data;
    open_files;
    get_uic;
    create_topic_dir_list;
    message_state;
    topic_menu;
99: open(ifile,'bb.tmp',history:=old,error:=continue);
    close(ifile,disposition:=delete,error:=continue); {added to get rid of
             any leftover files from sending replies or adding messages
             2-MAR-1988}
    close(bbfile,error:=continue);
    close(newuserfile,error:=continue);
    smg$delete_pasteboard(pasteboard);
end.