ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOPAS/TP/UTL2/TURBOENV.PZS/TURBOENV.PAS

Pascal/Delphi Source File | 2000-06-30 | 13KB | 394 lines

{Would you believe another envelope typing program?  Well, this one is
special 'cause its written in Turbo Pascal (look ma, no GOTO's), can
save your return address on disk, and can be edited so that you select
control keys for cursor movements, delete, etc.}

{ >>>--->      Written by Jim Zisfein and uploaded to       <---<<<
  >>>--->       Blaise Pascal RCP/M - (718)-604-1930        <---<<<
  >>>--->     September 23, 1985 for the public domain.     <---<<< }

program TurboEnv {TURBO ENVELOPE v1.0}; {$R+}
type
  string40=string[40];
  linetype=1..15;
  positiontype=1..40;
const

{These control key assignments will seem normal only if you are also an
aficionado of Perfect Writer.  Wordstar users will prefer ^E, ^S, ^D, and ^X
for up, left, right, and down, DEL and ^G for delleft and delright, etc.
Well...what are you waiting for?  Change them!}

     {Cursor commands}

  left=^B;
  right=^F;
  up=^P;
  down=^N;
  lineleft=^A;        {go to beginning of line}
  lineright=^E;       {go to end of line}

     {Delete commands}

  delleft=^H;         {delete character to left of cursor}
  delright=#127;      {delete character under cursor (#127 is DEL key)}
  delline=^D;         {erase entire line}
  chopline=^C;        {erase line to right of cursor}

     {Miscellaneous commands}

  insert=^I;          {toggles insert function on/off}
  options=^X;         {first half of two character commands}

     {Two character commands: e.g., ^X^C = quit}

  help=^X;            {calls up expanded help menu}
  newenv=^E;          {erases entire buffer}
  readenv=^R;         {reads ENVELOPE.SAV from disk to buffer}
  printenv=^P;        {sends buffer to printer device}
  saveenv=^S;         {writes buffer to disk as ENVELOPE.SAV}
  quit=^C;            {exits to your system}

     {Strings sent to printer before and after printing buffer contents}

  startprinter='';    {you don't HAVE to send anything}
  stopprinter=^L;     {I use a formfeed to eject envelope after printing}

     {Appearance of printed envelope}

  xreturn=1;
  yreturn=1;          {return address begins at column 1, line 1}
  xmailing=40;
  ymailing=12;        {mailing address begins at column 40, line 12}
  xattn=1;
  yattn=18;           {attn: begins at column 1, line 18}

     {Other user-selectable constants}

  startline=1;        {line to start editing: 1=return address, 7=mailing}
  cr=^M^J;            {cr/lf sequence for your printer}
  inserton: boolean=true;  {insert mode on at start of editing}
  beepon: boolean=true;    {beep if illegal character is hit}

{BUFFER is the edit buffer: 15 lines of up to 40 characters each, using:
for RETURN ADDRESS: lines 1-6,
for MAILING ADDRESS: lines 7-12,
for ATTN INSTRUCTIONS: lines 13-15.}

var
  buffer: array[linetype] of string40;    {see above}
  line: linetype;            {line number currently being processed}
  printline: integer;        {line of printed output}
  position: positiontype;    {cursor position in line being edited}
  tex: text;                 {disk file for reading/writing}
  ch: char;                  {character input from keyboard}
  i: integer;                {all purpose counter}

{Functions x and y provide screen coordinates for buffer display.  If you
have other than an 80x24 screen, you will need to alter these functions.}

function x: integer; begin if line in[7..12] then x:=39 else x:=6; end;
function y: integer; begin y:=line+2; end;

function cch(ch: char): string40;  {translates control characters for display}
begin
  case ch of
    #0..#31: cch:='^'+chr(ord(ch)+64);
    #32..#126: cch:=ch;
    #127: cch:='DEL';
  end;
end;

procedure HelpMenu1;   {displays an abbreviated help menu at all times}
begin
  writeln(' Cursor:   Left=',cch(left),'    Right=',cch(right),
    '    Up=',cch(up),'    Down=',cch(down));
  writeln(' Jump:     Beginning of line=',cch(lineleft),
    '    End of line=',cch(lineright));
  writeln(' Delete:   Left=',cch(delleft),'    Right=',cch(delright),
    '    Delete line=',cch(delline),'    Delete line right=',cch(chopline));
  if inserton then writeln(' Insert:   Now ON.  To switch off=',cch(insert))
    else writeln(' Insert:   Now OFF.  To switch on=',cch(insert));
  write(' Other:    Help=',cch(options),cch(help),
    '  New=',cch(options),cch(newenv),
    '  Read=',cch(options),cch(readenv),
    '  Print=',cch(options),cch(printenv),
    '  Save=',cch(options),cch(saveenv),
    '  Quit=',cch(options),cch(quit));
end;

{HelpMenu2 is an expanded help menu called up by ^X^X, or whatever you
select.  Note that if you change a command, it will AUTOMATICALLY be
reflected in this menu as well as HelpMenu1.  Wouldn't it be nice if
all software were this friendly?}

procedure HelpMenu2;
begin
  clrscr;
  write('Turbo Envelope Help Menu (^=control character)'^M^J^J);
  HelpMenu1;
  write(^M^J^J'Control keys can be changed EASILY by editing source text.',
    ^M^J^J'<RETURN> goes to beginning of next line, same as ',cch(down),'.',
    ^M^J^J'Delete character keys ',cch(delleft),',',cch(delright),
    ' do not function when insert mode is off.',
    ^M^J^J,cch(options),cch(newenv),' erases editing buffer but does ',
    'not perform disk read/write.',
    ^M^J^J,cch(options),cch(readenv),' and ',cch(options),cch(saveenv),
    ' read and write to file ENVELOPE.SAV for retrieving/saving',
    ^M^J'return addresses, etc.',
    ^M^J^J,cch(options),cch(printenv),' sends the buffer contents to your ',
    'printer (LST:) device.  Be sure',
    ^M^J'that printer is on and print head is at upper left corner ',
    'of envelope.',
    ^M^J'Mailing address will be indented ',xmailing,' spaces.',
    ^M^J^J'Hit any key to return to editing...');
  repeat until keypressed;
end;

procedure DisplayLine;  {displays a single line of buffer}
begin
  gotoxy(x-3,y);
  write('--> ',buffer[line]);
  clreol;
end;

procedure DisplayBuffer;  {displays buffer contents}
begin
  for line:=1 to 15 do DisplayLine;
end;

procedure DisplayScreen;  {displays envelope mock-up; assumes 80x24 screen}
begin
  clrscr;
  writeln(' Turbo Envelope Typing Program v1.0');
  for i:=1 to 79 do write('-'); writeln;
  for i:=1 to 16 do writeln('|');
  for i:=1 to 79 do write('-'); writeln;
  HelpMenu1;
  DisplayBuffer;
end;

procedure MoveLeft;  {adjusts cursor position during line editing}
begin
  if position>1 then position:=position-1;
end;

procedure MoveRight;  {adjusts cursor position during line editing}
begin
  if position<40 then position:=position+1;
end;

{PrEnv is called thrice when the command is given to print the envelope:
for the return address, mailing address, and attn instructions.  Linestart
and lineend are lines in the edit buffer.  X and Y are locations (column
and row) on the printed envelope.}

procedure PrEnv(linestart,lineend,xprint,yprint: integer);
begin
  while printline<yprint do begin
    write(lst,cr);
    printline:=printline+1;
  end;
  for line:=linestart to lineend do begin
    for i:=2 to xprint do write(lst,' ');
    write(lst,buffer[line],cr);
    printline:=printline+1;
  end;
end;

{EditEnvelope is called by main program to process each character typed
at the keyboard.  The routine first insures that the character position
is within the line being edited (buffer[line]) or at the end of it.
The cursor is then placed on that character.  Read(kbd,ch) pauses for
keyboard input, and the case statement does the rest.}

procedure EditEnvelope;
begin
  if position>length(buffer[line]) then position:=length(buffer[line])+1;
  gotoxy(x+position,y);
  read(kbd,ch);
  case ch of

{Printable characters are inserted or added to the end of the line if
insert mode is on; otherwise they are substituted for existing characters.
The position counter is then incremented, and the line is redisplayed.}

    ' '..'~': begin
      if inserton or (position>length(buffer[line]))
        then insert(ch,buffer[line],position)
        else buffer[line][position]:=ch;
      MoveRight;
      DisplayLine;
    end;

{Cursor movements.  Note that trailing spaces are deleted before moving
to right end of line.}

    left: MoveLeft;
    right: MoveRight;
    lineleft: position:=1;
    lineright: if buffer[line]>'' then begin
      position:=length(buffer[line]);
      while (position>1) and (buffer[line][position]=' ') do begin
        delete(buffer[line],position,1);
        MoveLeft;
      end;
      MoveRight;
    end;

{Commands to delete characters (delleft, delright) work only in insert mode.
Entire line is redisplayed after all deletions.}

    delleft: if position>1 then begin
      MoveLeft;
      if inserton then begin
        delete(buffer[line],position,1);
        DisplayLine;
      end;
    end;
    delright: if inserton then begin
      delete(buffer[line],position,1);
      DisplayLine;
    end;

{Delline erases entire line.  Chopline erases character at the cursor and
everything to the right.}

    delline: begin
      buffer[line]:='';
      DisplayLine;
    end;
    chopline: begin
      delete(buffer[line],position,40);
      DisplayLine;
    end;

{Insert toggles between inserton=true and inserton=false.
I find the insert-off mode totally useless, but here it is anyway.}

    insert: begin
      inserton:=not inserton;
      gotoxy(1,20); HelpMenu1;
    end;

{<RETURN> starts beginning of the next line, as does user-selectable
Down key.  Up starts beginning of previous line.}

    up: begin
      if line=1 then line:=15 else line:=line-1;
      position:=1;
    end;
    down,^M: begin
      if line=15 then line:=1 else line:=line+1;
      position:=1;
    end;

{For NONE OF THE ABOVE (other than the options key), you get beeped at.
If this offends you, select beepon=false in the program heading.}

  else if ch<>options then write(^G);
  end;
end;

{SelectOption: if OPTIONS was pressed, the next character is processed here.
These "two-character" commands activate the expanded help menu, read from
disk, save to disk, exit to system, and, oh yes, print your envelope.}

procedure SelectOption;

{To allow editing to resume after SelectOption on the same line it was on,
the line number (line) is saved as EDITLINE.}

var
  editline: linetype;
  iok: boolean;       {false if output error occurs}

begin
  editline:=line;     {editing line number memorized}
  gotoxy(7,24);       {cursor removed from envelope mock-up}
  read(kbd,ch);       {pauses for key to be pressed}
  case ch of

{Help displays the expanded help menu.}

    help: begin HelpMenu2; DisplayScreen; end;

{Newenv erases the buffer.}

    newenv: begin
      for line:=1 to 15 do buffer[line]:='';
      DisplayBuffer;
    end;

{Readenv loads ENVELOPE.SAV from disk.  In most cases, the user will use
this file for his return address.  No error message occurs if file
is not found.}

    readenv: begin
      {$I-} reset(tex); {$I+}
      if ioresult=0 then begin
        for line:=1 to 15 do readln(tex,buffer[line]);
        close(tex);
        DisplayBuffer;
      end;
    end;

{Printenv dumps buffer to the printer.  Envelope of standard
business size is expected with upper left corner under print
head.  Strings STARTPRINTER and STOPPRINTER are sent before
and after buffer and should be used for any initialization
and termination sequences your printer requires.}

    printenv: begin
      write(lst,startprinter);
      printline:=1;
      PrEnv(1,6,xreturn,yreturn);     {print return address}
      PrEnv(7,12,xmailing,ymailing);  {print mailing address}
      PrEnv(13,15,xattn,yattn);       {print attn instructions}
      write(lst,stopprinter);
    end;

{Saveenv saves buffer to disk file ENVELOPE.SAV.  A message is printed if
an I/O error occurs}

    saveenv: begin
      iok:=true; {$I-}
      rewrite(tex); iok:=(ioresult=0);
      for line:=1 to 15 do begin
        writeln(tex,buffer[line]);
        iok:=iok and (ioresult=0);
      end;
      close(tex); iok:=iok and (ioresult=0); {$I+}
      if not iok then begin
        gotoxy(45,18); write(^G'File not written.  Press <RETURN>');
        repeat until keypressed;
        gotoxy(45,18); clreol;
      end;
    end;

{Editing now resumes on line it was previously on.}

  end;
  line:=editline;
end;

{The skeletal main program assigns the textfile, initializes the buffer
to empty, displays a mock-up of an envelope, and starts editing on
user-selectable line STARTLINE and on position 1.  The editing routine
EditEnvelope analyzes each keyboard character.  When the OPTIONS character
is received, control is transferred (for next character only) to
SelectOption.}

begin {main program}
  assign(tex,'ENVELOPE.SAV');
  for line:=1 to 15 do buffer[line]:='';
  DisplayScreen;
  line:=startline;
  position:=1;
  repeat
    repeat EditEnvelope until ch=options;
    SelectOption;
  until ch=quit;
  for i:=1 to 24 do writeln;
end.