program sample;
const
  onn = '000';     { Make a field visible. }
  off = '100';     { Make a field invisible. }
  lst_sz = 25;     { size of parts list }
  { Assign display numbers. These can be changed as needed. }
  phone_order = 1;     { main display }
  helpf = 2;	{ main part number reference }

  { Set error output messages for fatal Display Manager errors. }
  initdm_str = 'ERROR: Initialization failure';
  opndis_str = 'ERROR: Display file not found';
  dispd_str = 'ERROR: Display not found';
  posf_str = 'ERROR: Field missing';
  nxtf_str = 'ERROR: Next field missing';
  putf_str = 'ERROR: Write to field failure';
  cur_str = 'ERROR: Cursor On/Off failure';
  CLSDIS_str = 'ERROR: Can''t close display file';

    {     12345678901234  }
  tabs = '              '; {tabs for output }

type
     com_str = string[40];
     ptr = ^integer;	
var
     order_no,
     page,
     part_fb15,
     cnt,
     CLRSCR_ret,
     ret,
     ret_err 	: integer;

     retchr     : char;

     qty_dec,     			{ quantity of each item }
     price_dec: real;		{ normal price given, but may be sale }

     total_dec  : array[0..4] of real;	{ QTY times PRICE_EA }
         	

     sale_dec   : real;

     term250_str: string[250];
 
     retf60_str,
     customer,   			{ customer name }
     address,
     city,
     state,
     zip, 				{ validated for numerical value }
     phone,        			{ numerical }
     sale	: com_str;
     qty,     				{ quantity of each item }
     price_ea,				{ normal price shown, but may be sale }
     total,	         		{ QTY times PRICE_EA }
     description,	    		{ brief written description }
     part_no_chr60: array[0..4] of com_str;
     part_lst	: array[0..lst_sz,0..1] of com_str;
     price	: array[0..lst_sz] of com_str;
     payment    : array[0..1] of com_str;{ method of payment and account no. }
     buff_rd	: string[60];
     temp 	: string;

     prm_off,
     prm_on,
     retf16_str,     
     avail_attr	: string[16];

     curstat	: string[1];

     file_1,
     file_2	: text;



  { Include the Display Manager runtime library definitions. }
{$I dmextr.pas}
external procedure @hlt;
{***************************************************************************}
{ The following corresponds to lines  65-122 in the CB-80 sample program.   }
{***************************************************************************}

procedure halt;
begin
   @hlt;				{ stop the program }
end;


  { Most DM functions return -1 if there is an error. }
  { They are fatal, so abort. }
procedure dm_err(f_ret : integer;err_type : com_str);
begin
    if f_ret < 0
      then begin
        writeln; writeln;
        writeln(err_type);
        halt;				{ It's fatal, so abort. }
      end;
end; { dm_err }

  { If the part number exists, return it. }
function search(part_no_chr60 : com_str) : integer;
var cnt : integer;
begin
  for cnt := 0 to lst_sz-1 do		{ returns the array index }
    begin
      if part_lst[cnt,0] = part_no_chr60 
        then begin
	  search :=  cnt;
	  exit;
	end;
      if part_lst[cnt,0] = ''
	then begin
	  search :=  -1;				{ -1 unless found }
	  exit;
	end;
    end;
  search :=  -1;				{ -1 unless found }
end; { search }
 
  { Move relative to the next input field, turn on the prompt, & get input. }
procedure get_entry(var retval : com_str);
var inp60_local : com_str;
begin
  ret_err :=  nxtf(2);			{ next input field }
  dm_err(ret_err,nxtf_str);
  retchr := setf(prm_on,avail_attr);	{ Turn on the prompt. }
  retchr := getf(inp60_local);		{ Input from the field. }
  while true do begin
    if endf = 27
      then begin			{ escape key to exit }
        CLRSCR_ret := clrscr;		{added11-8} 
        ret_err := clsdis;
        dm_err(ret_err,CLSDIS_str);
        halt;
      end;
    if (endf <> 0) and (endf <> 26)
      then begin			{ control character, not ctrl-Z }
	retchr := resf(-1,retf60_str);	{ Save the position. }
	retchr := resf(1,inp60_local);	{ Resume input. }
      end else begin
	retchr := setf(prm_off,avail_attr);      { Turn off the prompt. }
    	retval := inp60_local;
 	exit;
      end;
  end;
end; { get_entry }

procedure err_msg(pos : integer;onoff : string);
begin
  ret := posf(0);			{ Store the current position. }
  ret_err := posf(pos);
  dm_err(ret_err,posf_str);
  retchr := setf(onoff,avail_attr);	{ Turn the message on/off. }
  ret_err := posf(ret);			{ Return to the original position. }
  dm_err(ret_err,posf_str);
end; { err_msg }

{***************************************************************************}
{ The following corresponds to lines 233-249 in the CB-80 sample program.   }
{***************************************************************************}

procedure writef(out : com_str);
begin
  ret_err := nxtf(2);			{ Go to input field. }
  dm_err(ret_err,nxtf_str);
  retchr := setf(onn,avail_attr);	{ Turn on the field. }
  ret_err := putf(out);			{ Put in the old data. }
  dm_err(ret_err,putf_str);
  retchr := retf(retf16_str);		{ Check if it's a payment. }
  if posf(0) = 8
    then begin				{ Output rest in adjoining field. }
      ret_err := nxtf(3);
      dm_err(ret_err,nxtf_str);
      ret_err := putf(copy(out,2,length(out)-1));
      dm_err(ret_err,putf_str);
    end;
end; { writef }


{***************************************************************************}
{ The following corresponds to lines 250-310 in the CB-80 sample program.   }
{***************************************************************************}

procedure help;
var cnt : integer;
begin
  while endf = 26 do begin
    retchr := resf(-1,retf60_str);	{ Show the part number list. }
    retchr := curs(off,curstat);
    ret_err := dispd(helpf);
    dm_err(ret_err,dispd_str);
    retf60_str := chr(0);
    cnt := 0;
    page := 22;				{ Write out the list. }
    repeat
      ret_err := posf(cnt+1);
      dm_err(ret_err,posf_str);
      if part_lst[cnt,0] <> ''
        then begin			{ Output to the end of the list. }
          temp := concat(part_lst[cnt,0],tabs,part_lst[cnt,1]);
          ret_err := putf(temp);
          dm_err(ret_err,putf_str);
          retchr := setf(onn,avail_attr);
        end else cnt := -2;
      cnt := cnt+1;
      if (cnt = -1) or (cnt >= 22)
	then begin
	  ret_err := posf(100);		{ next page, or exit }
	  dm_err(ret_err,posf_str);
	  retchr := getf(retf60_str);
	  if retf60_str <> chr(27)
	    then begin
	      if retf60_str = chr(26)
	        then if cnt <> -1
	          then begin		{ control-Z, next with wrap }
		    page := page+21;	{ next page }
		    cnt := 0;
	          end else begin
		    cnt := 0;
		    page := 22;
	    end;
	  end;
      end;
    until retf60_str = chr(27);
    ret_err := dispd(phone_order);
    dm_err(ret_err,dispd_str);
    ret_err := nxtf(-10);			{ 1st field, then 1st }
    dm_err(ret_err,nxtf_str);		{ in field to write   }
    writef(customer);			{ old data to         }
    writef(address);
    writef(city);
    writef(state);
    writef(zip);
    writef(phone);
    case payment[0,1] of 
      'A' : begin
	writef('ACCOUNT');		{ special handling }
	writef(payment[1]);		{ done in writef   }
	end;
      'B' : begin
	writef('BANK CARD');
	writef(payment[1]);
	end;
      'C' : begin
	writef('C.O.D.');
	ret_err := nxtf(2);		{ pass acount number }
	dm_err(ret_err,nxtf_str);
	end;
    end;
    err_msg(75,onn);			{ QTY exit message }
    for cnt := 0 to order_no-1 do		{ Write any        }
      begin
        writef(qty[cnt]);    		{ previous items. }
        writef(description[cnt]);
        writef(part_no_chr60[cnt]);
        writef(price_ea[cnt]);
        ret_err := nxtf(3);		{ total is output -- }
        dm_err(ret_err,nxtf_str);	{ field, not input   }
        ret_err := putf(total[cnt]);
      end;
    writef(qty[order_no]);         { line in progress }
    writef(description[order_no]);
    writef(part_no_chr60[order_no]);
    retchr := setf(prm_on,avail_attr);
    retchr := curs(onn,curstat);
    retchr := resf(1,part_no_chr60[order_no]);
    retchr := setf(prm_off,avail_attr);
  end; { while }
end; { help }

{***************************************************************************}
{ The following corresponds to lines  34- 64 in the CB-80 sample program.   }
{***************************************************************************}

{ The errors below correspond to lines 311-319 in the CB-80 sample program. }

procedure init_data;
begin
  { Get the screen-handling control code from the installation file. }
  open(file_1,'current.trm',ret_err);
  if ret_err <> 255
    then begin
      readln(file_1,term250_str);
      if ioresult <> 0
        then ret_err := 255;
    end;
  if ret_err = 255
    then begin
      writeln('ERROR: No current terminal file');
      writeln('(put control code in "CURRENT.TRM")');
      halt;				 { stop }
    end;
  { Set up the list of part numbers. }
  open(file_2,'parts.lst',ret_err);
  if ret_err <> 255
    then begin
      cnt :=  0;
      while (not eof(file_2)) and (cnt < lst_sz) do
	begin
 	  readln(file_2,buff_rd);
	  part_lst[cnt,0] := copy(buff_rd,1,5);
	  buff_rd[6] := ' ';
	  page := pos(',',buff_rd);
	  part_lst[cnt,1] := copy(buff_rd,8,page-9);
	  price[cnt] := copy(buff_rd,page+1,length(buff_rd)-page);
	  cnt :=  cnt+1;
        end;
    end else begin
      writeln('ERROR: No part no. reference file');
      halt;				 { stop }
    end;
  part_lst[cnt+1,0] :=  '';    { indicates end of list }
  close(file_2,ret_err);
  close(file_1,ret_err);
end; { init_data }

procedure head;
begin
    { All prompts are inverse video if possible, or underlined otherwise. }
    get_entry(customer);		{ Use relative movement }
    get_entry(address);			{ and GETF }
    get_entry(city);
    get_entry(state);			{ alphabetic only }
    get_entry(zip);			{ numerical validation by DM }
    get_entry(phone);
    get_entry(payment[0]);		{ A, B, or C only }
  					{ null string not a valid entry. }
    while (pos(payment[0],'ABC') = 0) or (payment[0] = '') do
      begin
        err_msg(100,onn);
        ret_err := nxtf(-2);
        dm_err(ret_err,nxtf_str);	{ Output an error message }
        get_entry(payment[0]);		{ retry }
      end;
    ret_err := nxtf(3);
    dm_err(ret_err,nxtf_str);		{ Go to next column. }
    case payment[0,1] of
      'A' : begin			{ It's a personal credit account. }
	ret_err := putf('CCOUNT');	{ Show the rest of the word. }
	get_entry(payment[1]);		{ Get the account number. }
        end;
      'B' : begin			{ bank credit card }
        ret_err := putf('ANK CARD');
        dm_err(ret_err,putf_str);
        get_entry(payment[1]);
	end;
      'C' : begin			{ cash on delivery }
        ret_err := putf('.O.D.');
        dm_err(ret_err,putf_str);
        end;
    end;
    err_msg(100,off);			{ Turn it off. }
end; { head }


begin { program }


{***************************************************************************}
{     S T A R T           P R O G R A M            H E R E                  }
{***************************************************************************}


{***************************************************************************}
{ The following corresponds to lines 123-232 in the CB-80 sample program.   }
{***************************************************************************}


  init_data;
  ret_err := initdm(term250_str);	{ Initialize the library. }
  dm_err(ret_err,initdm_str);
  retchr := retdm(avail_attr);		{ Which CRT attributes are available? }
  if avail_attr[3] <> '0'
    then begin				{ If inverse video is supported }
      prm_on := '031';
      prm_off := '330';			{ then use it for prompts }
    end else begin
      prm_on := '0';
      prm_off := '3';			{ just initials }
    end;


  { Open the display file, show it, and move to the first field. }
  ret_err := opndis('ORDERS.DIS');      { Open the file. }
  dm_err(ret_err,opndis_str);
  repeat
    ret_err := dispd(phone_order);	{ Show the display. }
    dm_err(ret_err,dispd_str);
    ret_err := nxtf(-10);		{ 1st field }
    dm_err(ret_err,nxtf_str);
    head;

    { Take the order now. }
    ret_err := posf(75);		{ Turn on the message }
    dm_err(ret_err,posf_str);		{ about the ending entry. }
    retchr := setf(onn,avail_attr);
    order_no := 0;			{ up to 5 }
    repeat
      get_entry(qty[order_no]);		{ quantity of items }
      qty_dec := BCDVAL(qty[order_no]);
      if qty_dec <> 0
	then begin			{ Stop entry. }
	  get_entry(description[order_no]);
	  err_msg(76,onn);		{ control-Z reference message }
	  repeat
	    get_entry(part_no_chr60[order_no]);
	    help;			{ ^Z gives part # display }
	    part_fb15 := search(part_no_chr60[order_no]);
	    if part_fb15  = -1
	      then begin		{ not a valid part number }
		err_msg(101,onn);
		ret_err := nxtf(-2);
		dm_err(ret_err,nxtf_str);
	      end;
      	  until part_fb15 <> -1; 	{ retry }
	  err_msg(101,off);		{ Turn off the error message. }
	  err_msg(76,off);		{ Turn off the control-z message. }
	  ret_err := nxtf(2);		{ Write the normal price. }
	  dm_err(ret_err,nxtf_str);
	  ret_err := putf(price[part_fb15]);
	  dm_err(ret_err,putf_str);
	  retchr := setf(prm_on,avail_attr);
	  retchr := updf(price_ea[order_no]);{ If CR, get the initial value. }
	  retchr := setf(prm_off,avail_attr);
	  ret_err := nxtf(3);		{ the field for the total }
	  dm_err(ret_err,nxtf_str);
	  price_dec := BCDVAL(price_ea[order_no]);
	  total_dec[order_no] := qty_dec * price_dec;
	  retchr := BCDSTR(total_dec[order_no],total[order_no]);
	  ret_err := putf(total[order_no]);
	  dm_err(ret_err,putf_str);
	  order_no := order_no+1;	{ Only 5 are allowed. }
	end;
    until (qty_dec = 0) or (order_no >= 5);
    order_no := 4;			{ Only 0 to 4 are allowed. }
    sale_dec := 0;
    for cnt := 0 to order_no do	{ Calculate the total bill. }
      sale_dec := sale_dec + total_dec[cnt];
    retchr := BCDSTR(sale_dec,sale);
    ret_err := posf(26);
    dm_err(ret_err,posf_str);
    ret_err := putf(sale);		{ Write the total sale. }
    for cnt := 0 to order_no do
      total_dec[cnt] := 0;		{ zero out intermediate totals }
    dm_err(ret_err,putf_str);
    ret_err := nxtf(20);		{ wait until ready }
    dm_err(ret_err,nxtf_str);
    retchr := setf(onn,avail_attr);	{ Turn on the prompt. }
    retchr := getf(retf60_str);	{ Wait for a carriage return. }
  until endf = 27;
  { output data to file }
  clrscr_ret := clrscr;
  ret_err := clsdis;			{ close display file }
  dm_err(ret_err,clsdis_str);
  exit;
end.