Skip to content

Instantly share code, notes, and snippets.

@robey

robey/zedit.pas

Created May 25, 2013 20:38
Show Gist options
  • Save robey/5650702 to your computer and use it in GitHub Desktop.
Save robey/5650702 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
zedit.pas
{$C-} { Ctrl-break doesn't stop us now! }
{
ZEdit - WWIV full-screen editor
Command line:
ZEDIT [options] filename
Public ("official") releases:
v1.1 - May 30, 1989
v1.1B - June 2, 1989
v1.1C - June 16, 1989
v1.1D - June 19, 1989
v1.1E - (abandoned)
v1.2 - October 7, 1989
v1.2B - December 15, 1989
v1.2C - March 6, 1990
v1.2D - August 21, 1990
v1.2E - December 26, 1990
v1.2F - February 18, 1991
Compile with maximum stack/heap segment of $7000
(important since we are allocating pages of memory)
}
{$I modemd.inc} { modem I/O - source: PD }
{ I spawn.pas} { dos shelling - source: Hit Man }
const okokokok:string[3]='\%\'; { marks where the following will be }
const registered:boolean=false; { $00/$01 - registered copy? }
const sernum:integer=0; { serial number }
const serchk:integer=0; { S/N xor $3078, and $D7F5 }
const serchker:integer=0; { S/N and $3078, xor $D7F5 }
const license:str=''; { licensed to whom (str type) }
const datafn:str='ZEDIT'; { data file name for help & kbd files }
const beta:boolean=false; { beta test? }
const basecolor:integer=0; { base color: 7 in non-WWIV }
const xxx:string[8]='';
{ beta = á = 225 }
const ver='Z-Edit v1.2F 18 Feb 1991';
vernum='v1.2F';
verdate='April 1989-February 1991';
linesperpage=20;
copyright='1990';
{ type added Aug 19, 1989 }
type line = record
text : str;
col : array[0..80] of byte; { high bits unused in WWIV mode }
stat : byte; { 0x01, 0x02 - just :: 0x04 - wrap :: 0x08 - marked }
end;
var
pagemax:integer; { max pages avail (a variable!!) }
total:integer; { max lines avail (a variable!!) }
msg:array[1..2500] of ^line; { pointer to lines of message }
filename:str; { filename given to load }
tab:array[1..80] of boolean; { tab stop? T/F }
baud:array[1..5] of boolean; { 300, 1200, 2400, 9600, 19200 }
mcr:array[1..10] of str; { macros alt-1 thru alt-0 }
macrobuf:string[255]; { buffer for macro-entered text }
xloc,yloc:integer; { x-pos and y-pos acc. to display }
yl:integer; { current y-pos in message }
ccol:integer; { current color user has chosen }
page:integer; { current page number }
xmax:integer; { maximum x-width of user screen }
comport:integer; { modem comm port for modem I/O }
width:integer; { width of user's screen }
lmar,rmar:integer; { left/right margin }
save:boolean; { T/F save the file before exiting }
done:boolean; { T/F done editing the file }
insert:boolean; { insert mode on/off }
stupid:boolean; { (outdated) they can't find ESC-? }
wwivspec:boolean; { T/F use special WWIV-only functions }
colorok:boolean; { T/F may use special WWIV colors }
okshow:boolean; { T/F may show blue ">"s for wrapping }
olt,ort:boolean; { do tabs exist under margins? (TEMP) }
yl2:integer; { current line # drawing on scrn }
cmd:array[1..203,0..5] of integer; { list of commands : 0=wot it does }
commands:integer; { total number of commands }
usrdef:array[1..10,1..15] of integer;{ user defined commands }
helpmsg:str; { "Ctrl-Z for help" usually }
statcol:integer; { color of statline }
tabcol:integer; { color of tab stop line }
wrapcol:integer; { color of wordwrap markers }
allocated:boolean; { T/F already allocated memory }
infileok:boolean; { T/F file to edit existed }
pagelimit:integer; { limit of pages WWIV decrees [yuk] }
colorform:integer; { format of colors }
usrmaca,usrmacd,usrmacf:str; { 21Aug90 user macros A,D,F }
username:str; { username for getting macros }
neowwiv:boolean; { WWIV 411 or greater? }
extrabytes:integer; { extra bytes in USER.LST (mods) }
{ determine which color routine to call }
procedure ansic(c:integer);
begin
{ if (wherey<2) or (wherey>21) or (wherex=80) or (yl2=0) then
begin ansicn(c); exit; end;
if ((msg[yl2]^.stat and $08)=$08) then ansicn(c) else ansicn(c);
}
if (colorform=0) then ansicn(c) else ansicx(c);
end;
{ mgetkey w/macro buffer }
procedure getkey(var c:char);
begin
if length(macrobuf)>0 then begin c:=macrobuf[1]; delete(macrobuf,1,1); end
else mgetkey(c);
end;
{ delete a file - used when existing file is cleared & saved }
function filedel(fspec:str) : integer;
var r:regs;
begin
fspec:=fspec+#0; r.dx:=ofs(fspec[1]); r.ds:=seg(fspec[1]);
r.ax:=$4100; msdos(r); filedel:=lo(r.ax);
if (r.flags and $01)=0 then filedel:=0;
end;
{ character out with color }
procedure zoutc(lin:integer; x:integer);
begin
if ccol<>msg[lin]^.col[x] then
begin ccol:=msg[lin]^.col[x]; ansic(ccol); end;
outc(msg[lin]^.text[x]);
end;
{ move to location on screen [user:true if this is permanent] }
procedure locate(x:integer; y:integer; user:boolean);
var s:str; i:integer;
begin
s:=#27+'['+cstr(y)+';'+cstr(x)+'H';
outms(s);
gotoxy(x,y);
if user then begin xloc:=x; yloc:=y-1; end;
end;
{ show a particular message line }
procedure zprompt(lin:integer);
var i:integer;
begin
yl2:=lin;
if ccol<>basecolor then ansicn(0); ccol:=basecolor;
for i:=1 to length(msg[lin]^.text) do zoutc(lin,i);
if ((msg[lin]^.stat and $04)=$04) and (okshow) then begin
locate(width,wherey,false); ansicn(wrapcol); prompt('>');
end;
yl2:=0; ansic(ccol);
end;
{ intro message, also allocates memory for pages 19-Aug-89! }
procedure intro(modem:boolean);
begin
if modem then begin
nl; textcolor(13);
print('Z-Edit '+vernum+' (c)'+copyright+' Zarrf!');
print('COMMODORE USERS: Ctrl-E = ESC');
if (license<>'') or (beta) or (sernum>1) then nl;
if license<>'' then print('Licensed to '+license);
if sernum>1 then print('Serial number #Z'+cstr(sernum));
if beta then print('Beta Test - DO NOT DISTRIBUTE');
end else begin
writeln; textcolor(13);
writeln('Z-Edit '+vernum+' (c)'+copyright+' Zarrf!');
writeln('COMMODORE USERS: Ctrl-E = ESC');
if (license<>'') or (beta) or (sernum>1) then writeln;
if license<>'' then writeln('Licensed to '+license);
if sernum>1 then writeln('Serial number #Z'+cstr(sernum));
if beta then writeln('Beta Test - DO NOT DISTRIBUTE');
end;
textcolor(7);
end;
{ allocate memory for pages 19-Aug-89! }
procedure malloc;
var r:real; i,t:integer; ok:boolean;
begin
t:=0; ok:=true;
if not allocated then begin { allocate pages of memory }
repeat
r:=maxavail;
if (r >= (sizeof(line)*1.0)) then begin
t:=t+1; new(msg[t]);
end else ok:=false;
until (not ok) or (t=2500) or ((pagelimit<>0) and (t=(pagelimit*20)));
pagemax:=(t div 20); total:=pagemax*20;
if t>total then for i:=total+1 to t do dispose(msg[i]);
textcolor(7); nl; allocated:=true;
if pagemax<>1 then
print('There are '+cstr(pagemax)+' pages available.')
else
print('There is 1 page available.');
end;
end;
{ no good parameters }
procedure trash;
begin
intro(false); textcolor(11);
writeln;
writeln('ZEDIT [-(options)] (filename)');
writeln(' On WWIV: %1=(filename), %2=(width), %4=(max lines)');
writeln;
writeln('Options:');
writeln(' X local (no modem) overrides P Wn user has screen width of n');
writeln(' Pn use modem port n (default 1) Mn pace modem n milliseconds');
writeln(' C restrict color access Rxx restrict xx baudrates');
writeln(' V cancel visible word wrap Sxx use setup config file xx');
writeln(' Ln maximum of n lines in msg A all WWIV options canceled');
writeln(' N user macros (WWIV 4.11+) Nn macros, n extra bytes in USER.LST');
{ writeln(' Fn specify color format'); }
writeln;
writeln('-Rxx baudrate codes: [3]00,[1]200,[2]400,[9]600, and [0]-19200 baud');
{ writeln('-Fn codes: 0-WWIV (default) 1-Genesis 2-ANSI'); }
writeln('Example command line: ZEDIT -X -Swordstar TEST.MSG');
halt;
end;
{ error in parameters }
procedure error(s:str);
var cmdline:string[128] absolute cseg:$80; t:str;
begin
intro(false); textcolor(11); nl; t:=cmdline;
while (t[1]=' ') do delete(t,1,1);
writeln('Error with command line "'+t+'"');
writeln(s); bye;
end;
{ translate command line parameters into variables - rewritten 16sep89 }
procedure getparams;
var i,pn:integer; c:char; s,t:str; inc:boolean;
begin
{ initialize all values to defaults }
remote:=true; colorok:=true; wwivspec:=true; okshow:=true; colorform:=0;
filename:=''; pn:=1; comport:=1; width:=80; inc:=true; pagelimit:=0;
neowwiv:=false; extrabytes:=0;
for i:=1 to 5 do baud[i]:=true;
if paramstr(1)='' then trash;
{ interpret the parameters now }
while (pn<=paramcount) do begin
if inc then s:=paramstr(pn);
c:=s[1]; inc:=true;
if (c='/') or (c='-') or (c='+') then begin
t:=copy(s,3,length(s)-2); i:=value(t);
case upcase(s[2]) of
'X' : remote:=not remote;
'P' : comport:=i;
'W' : width:=i;
'M' : ptim:=i;
'C' : colorok:=not colorok;
'V' : okshow:=not okshow;
'R' : for i:=1 to length(t) do case t[i] of
'3' : baud[1]:=not baud[1];
'1' : baud[2]:=not baud[2];
'2' : baud[3]:=not baud[3];
'9' : baud[4]:=not baud[4];
'0' : baud[5]:=not baud[5];
else error('Invalid "R" baudrate code: '+t[i]);
end;
'S' : datafn:=t;
'L' : begin
pagelimit:=(i div 20);
if (i mod 20)<>0 then pagelimit:=pagelimit+1;
end;
'A' : wwivspec:=not wwivspec;
'F' : { colorform:=i; } error('Invalid switch: -'+upcase(s[2]));
'N' : begin
neowwiv:=not neowwiv;
extrabytes:=i;
end;
else error('Invalid switch: -'+upcase(s[2]));
end;
if (upcase(s[2])<>'S') then begin
i:=3;
while (i<=length(s)) and ((s[i]>='0') and (s[i]<='9')) do i:=i+1;
if i<=length(s) then
begin inc:=false; s:='-'+copy(s,i,length(s)-i+1); end;
end;
end else begin
if filename<>'' then error('More than one filename!');
filename:=s;
end;
if inc then pn:=pn+1;
end;
if filename='' then error('No filename given!');
if not wwivspec then begin okshow:=false; colorok:=false; end;
xmax:=width-1;
if (colorform<>0) then basecolor:=7;
ccol:=basecolor;
end;
{ load ZEDIT.TAB - tabs & macros }
procedure loadtabs;
var i,j:integer; f:text; c:char; s:str;
begin
assign(f,'zedit.tab'); {$I-} reset(f); {$I+}
if ioresult<>0 then begin
for i:=1 to 80 do if (i mod 5)=0 then tab[i]:=true else tab[i]:=false;
tab[width]:=false; lmar:=1; rmar:=xmax; olt:=false; ort:=false;
tab[lmar]:=true; tab[rmar]:=true; for i:=1 to 10 do mcr[i]:='';
end else begin
for i:=1 to 80 do
begin read(f,c); if c='+' then tab[i]:=true else tab[i]:=false; end;
read(f,c); if c='T' then olt:=true else olt:=false;
read(f,c); if c='T' then ort:=true else ort:=false;
readln(f,s); readln(f,lmar); readln(f,rmar);
if width=40 then begin
if rmar>39 then rmar:=rmar-40;
for i:=rmar+1 to 80 do if tab[i]=true then tab[i]:=false;
end;
for i:=1 to 10 do readln(f,mcr[i]);
for i:=1 to 10 do for j:=1 to length(mcr[i]) do begin
if mcr[i][j]=#11 then mcr[i][j]:=#13;
if mcr[i][j]=#0 then mcr[i][j]:=#10;
end;
end;
close(f);
end;
{ load in keyboard definitions (ZEDIT.DAT) }
procedure loaddef;
var f:file of integer; i,j,ident:integer;
begin
assign(f,datafn+'.dat');
{$I-} reset(f); {$I+}
if ioresult<>0 then begin
textcolor(11);
writeln;
writeln(datafn+'.DAT not found!');
writeln;
writeln(datafn+'.DAT is needed for Z-Edit to know the correct key combinations used');
writeln('for the commands. A copy should have come in the same ZIP file as the rest');
writeln('of Z-Edit. If you accidentally erased it, but you still have your ZEDIT.DEF,');
writeln('type ZEC ZEDIT.DEF and ZEDIT.DAT will be recreated.');
bye;
end;
read(f,ident); if ident<200 then begin
textcolor(11);
writeln(datafn+'.DAT outdated -- please recompile soon!');
commands:=ident; textcolor(7);
for i:=1 to 100 do for j:=0 to 5 do read(f,cmd[i,j]);
for i:=1 to 10 do for j:=1 to 5 do read(f,usrdef[i,j]);
for i:=0 to 15 do begin read(f,j); helpmsg[i]:=chr(j); end;
statcol:=1; tabcol:=5; wrapcol:=7;
end else begin
read(f,commands);
for i:=1 to 200 do for j:=0 to 5 do read(f,cmd[i,j]);
for i:=1 to 10 do for j:=1 to 15 do read(f,usrdef[i,j]);
for i:=0 to 15 do begin read(f,j); helpmsg[i]:=chr(j); end;
read(f,statcol); read(f,tabcol); read(f,wrapcol);
end;
while (length(helpmsg)<15) do helpmsg:=helpmsg+' ';
close(f);
commands:=commands+1;
cmd[commands,0]:=088; cmd[commands,1]:=027; cmd[commands,2]:=028;
cmd[commands,3]:=000; cmd[commands,4]:=000; cmd[commands,5]:=000;
commands:=commands+1;
cmd[commands,0]:=089; cmd[commands,1]:=027; cmd[commands,2]:=042;
cmd[commands,3]:=000; cmd[commands,4]:=000; cmd[commands,5]:=000;
commands:=commands+1;
cmd[commands,0]:=019; cmd[commands,1]:=030; cmd[commands,2]:=000;
cmd[commands,3]:=000; cmd[commands,4]:=000; cmd[commands,5]:=000;
end;
{ clear memory (tot:true = lose position, toggles and tabs) }
procedure clearall(tot:boolean);
var i,j:integer; l:line;
begin
if tot then loadtabs;
l.text[0]:=#0; l.col[0]:=80; l.stat:=$00;
for j:=1 to 80 do begin l.text[j]:=' '; l.col[j]:=basecolor; end;
for i:=1 to total do msg[i]^:=l;
if tot then begin
yl:=1; yloc:=1; xloc:=1;
ccol:=basecolor;
ansicn(0); insert:=false; page:=1;
tab[lmar]:=true; tab[rmar]:=true;
end;
end;
{ go back to user's position! }
procedure reloc;
begin
locate(xloc,yloc+1,false);
end;
{ yes or no? default:no }
function yn : boolean;
var a:boolean; c:char;
begin
repeat
getkey(c); c:=upcase(c);
until (c='Y') or (c='N') or (c=#13);
ansicn(1);
if c='Y' then a:=true else a:=false;
if a=true then prompt('Yes') else prompt('No');
yn:=a; ansicn(0);
end;
{ erase line y }
procedure eline(y:integer);
var s:str;
begin
locate(1,y,false); outms(#27+'[0K');
clreol;
end;
{ draw a green --- line at y }
{ NO LONGER HIDDEN }
procedure drawline(y:integer);
var i:integer;
begin
locate(1,y,false); ansicn(tabcol);
for i:=1 to width do
if tab[i]=true then if (i=lmar) or (i=rmar) then
if i=lmar then prompt('L') else prompt('R')
else prompt('+') else prompt('-');
ansicn(0);
end;
{ show a certain tab stop }
procedure showtab(x:integer);
var i:integer;
begin
for i:=0 to 1 do begin
locate(x,i*21+1,false); ansicn(tabcol);
if tab[x]=true then if (x=lmar) or (x=rmar) then
if x=lmar then prompt('L') else prompt('R')
else prompt('+') else prompt('-');
end;
ansic(ccol);
end;
{ draw status line }
{ NO LONGER HIDDEN }
procedure statline;
begin
ansicn(statcol); eline(23);
prompt('Z-Edit: '); prompt(helpmsg);
if insert then begin ansicn(2); prompt(' Ins'); ansicn(statcol); end
else prompt(' ');
if not remote then begin ansicn(2); prompt(' Loc'); ansicn(statcol); end
else prompt(' ');
locate(width-7,23,false); prompt('Page '); if page<10 then prompt(' ');
prompt(cstr(page)); ansic(ccol);
end;
{ draw current page inside display }
procedure drawwksp;
var i:integer;
begin
for i:=1 to linesperpage do begin
eline(i+1); zprompt((page-1)*linesperpage+i);
end;
statline;
reloc;
end;
{ does the file exist? }
function exist(fn:str) : boolean;
var f:text;
begin
assign(f,fn);
{$I-} reset(f); {$I+}
if ioresult<>0 then exist:=false else exist:=true;
close(f);
end;
{ load in a file for editing }
procedure loadin(fn:str);
var f:text; i,j,k,c,zz:integer; ch:char; s:string[160]; fn2:str;
function moron(i:integer) : integer;
begin
case i of
1: moron:=4;
4: moron:=1;
3: moron:=6;
6: moron:=3;
else moron:=i;
end;
end;
begin
c:=basecolor; i:=0; eline(23); ansicn(statcol);
prompt('Loading file '+fn+'...'); ansicn(0);
assign(f,fn); reset(f);
while (not eof(f)) and (i<total) do begin
i:=i+1; readln(f,s); j:=1; c:=basecolor;
if (s[j]=#2) then begin { Dec 4 : autocentering mod by DD }
delete(s,1,1); msg[i]^.stat:=msg[i]^.stat or $01; {centered}
end;
while j<=length(s) do begin
msg[i]^.col[j]:=c;
if s[1]=#1 then begin
msg[i]^.stat:=msg[i]^.stat or $04; delete(s,j,1); j:=j-1;
end;
if (s[j]=#3) and (colorform=0) then begin
ch:=s[j+1]; delete(s,j,2); j:=j-1;
if registered then c:=ord(ch)-48;
end;
if (s[j]='|') and (colorform=1) then begin
ch:=s[j+1]; k:=(ord(ch)-48)*10; ch:=s[j+2]; k:=k+ord(ch)-48;
delete(s,j,3); j:=j-1;
if registered then c:=k;
end;
if (s[j]=#27) and (s[j+1]='[') and (colorform=2) then begin {ARGH! ANSI}
writeln('*: "',copy(s,j,length(s)-j+1),'"'); read(kbd,ch);
k:=0; delete(s,j,2);
while (s[j]=';') or ((s[j]>='0') and (s[j]<='9')) do begin
if (s[j]=';') then delete(s,j,1);
case s[j] of
'0' : begin k:=7; delete(s,j,1); end;
'1' : begin k:=k+8; delete(s,j,1); end;
'3' : begin k:=(k and $F8)+moron(ord(s[j+1])-48); delete(s,j,2); end;
'4' : delete(s,j,2);
else delete(s,j,1);
end;
end;
if (s[j]='m') and (registered) then begin c:=k; writeln('Ok'); read(kbd,ch); end;
delete(s,j,1); j:=j-1;
end;
j:=j+1;
end;
msg[i]^.text:=copy(s,1,80);
while (msg[i]^.text[j-1]=' ') do j:=j-1;
msg[i]^.text[0]:=chr(j-1);
if length(msg[i]^.text)>xmax then msg[i]^.text[0]:=chr(xmax);
if (msg[i]^.stat=$01) then begin
zz:=(xmax-length(msg[i]^.text)) div 2;
for j:=1 to zz do begin
for k:=80 downto 2 do msg[i]^.text[k]:=msg[i]^.text[k-1];
msg[i]^.text[1]:=' ';
for k:=80 downto 2 do msg[i]^.col[k]:=msg[i]^.col[k-1];
msg[i]^.col[1]:=ccol;
msg[i]^.text[0]:=chr(ord(msg[i]^.text[0])+1);
end;
end;
end;
if not eof(f) then i:=total+1;
close(f);
if i>total then begin
eline(23); ansicn(5); prompt('File too large. Truncate? ');
if not yn then begin eline(23); bye; end;
end;
drawwksp;
end;
{ clear out display }
procedure clrwksp;
var i:integer;
begin
for i:=1 to linesperpage do eline(i+1);
end;
{ draw display border, then drawwksp }
procedure drawscr(clean:boolean);
begin
ansicn(0); clrscr; outms(#12);
drawline(1); drawline(22);
gotoxy(width-39,25); write('(Sysop: Alt-C to chat, Alt-H to hangup)');
if not clean then drawwksp else begin statline; reloc; end;
end;
{ print string w/ imbedded help commands }
procedure hprint(s:str);
var i:integer;
begin
i:=1;
while i<=length(s) do begin
if s[i]='\' then begin
i:=i+1; case s[i] of
'0'..'7' : ansicn(ord(s[i])-48);
'T' : prompt(cstr(total));
'L' : prompt(cstr(linesperpage));
'P' : prompt(cstr(pagemax));
'V' : prompt(vernum);
'O' : begin
if s[i+1]='R' then if not remote then i:=150 else i:=i+1;
if s[i+1]='L' then if remote then i:=150 else i:=i+1;
end;
'Z' : prompt('Zarrf!');
end;
end else outc(s[i]);
i:=i+1;
end;
if i<>151 then nl;
end;
{ show a certain ZEDIT.HLP screen }
function showscrn(c:char) : str;
var s,t:str; f:text; d:char;
begin
if width=80 then d:='8' else d:='4';
assign(f,datafn+'.hlp'); reset(f);
repeat readln(f,s); until ((s[1]='`') and (s[2]=d) and (s[3]=c)) or (eof(f));
if (eof(f)) then begin
clrwksp; locate(1,2,false); print('This help page is missing.');
close(f); showscrn:=''; exit;
end;
t:=copy(s,4,length(s)-3);
clrwksp; locate(1,2,false);
repeat
readln(f,s);
if s[1]<>'`' then hprint(s);
until (s[1]='`') or (eof(f));
close(f);
showscrn:=t;
end;
procedure chat(user:boolean); forward;
{ CTRL-Z, ESC-? call this: }
procedure help;
var f:text; c,oc:char; s,t:str;
begin
assign(f,datafn+'.hlp');
{$I-} reset(f); {$I+}
if ioresult<>0 then begin
clrwksp; locate(1,3,false); close(f);
print('The help file '+datafn+'.HLP is not available.');
print('Please inform your sysop. Sorry...');
nl; print('(Press Ctrl-6 to abort the msg.)'); nl;
print('Press any key to return to editing: '); getkey(c);
end else begin
close(f);
s:=showscrn('?'); s:=s+'Q?:'; oc:='?';
repeat
eline(23); ansicn(statcol); prompt('Help page letter, ?, or Q: ');
ansicn(0);
repeat
getkey(c);
c:=upcase(c);
if (c=#27) and (not localkey) then c:='Q';
if (c=#27) then begin
getkey(c);
if (c='.') then begin
chat(false);
drawline(1); drawline(22);
gotoxy(width-39,25); write('(Sysop: Alt-C to chat, Alt-H to hangup)');
t:=showscrn(oc);
end;
if (c='#') then begin
eline(23); ansicn(statcol); prompt('So long!'); ansicn(0); nl;
hangupphone;
end;
c:=':';
end;
until pos(c,s)<>0;
if c<>':' then prompt(c);
if (c<>'Q') and (c<>':') then begin t:=showscrn(c); oc:=c; end;
until c='Q';
statline;
end;
drawwksp;
end;
{ arrow up }
procedure up;
begin
if yl>1 then begin
yl:=yl-1; yloc:=yloc-1;
if yl<(page-1)*linesperpage+1 then
begin page:=page-1; yloc:=linesperpage; drawwksp; end
else begin outms(#27+'[A'); gotoxy(wherex,wherey-1); end;
end;
end;
{ arrow down (cr:true=reset) }
procedure down(cr:boolean);
begin
if yl<total then begin
yl:=yl+1; yloc:=yloc+1;
if yl>(page-1)*linesperpage+20 then
begin page:=page+1; yloc:=1; drawwksp; end
else if cr then reloc
else begin outms(#27+'[B'); gotoxy(wherex,wherey+1); end;
end else if cr then reloc;
end;
{ esc up }
procedure pageup;
begin
if page>1 then begin
page:=page-1; yl:=yl-linesperpage; drawwksp;
end;
end;
{ esc down }
procedure pagedown;
var t:boolean;
begin
if page<pagemax then begin
page:=page+1; yl:=yl+linesperpage; drawwksp;
end;
end;
{ left arrow }
procedure left;
begin
if xloc>1 then begin
xloc:=xloc-1; outms(#27+'[D');
gotoxy(wherex-1,wherey);
end;
end;
{ arrow right }
procedure right;
begin
if xloc<xmax then begin
xloc:=xloc+1; outms(#27+'[C');
gotoxy(wherex+1,wherey);
end;
end;
{ home key }
procedure home;
begin
if xloc=1 then xloc:=lmar else xloc:=1;
reloc;
end;
{ end key }
procedure endkey;
var t:integer;
begin
t:=xloc; xloc:=length(msg[yl]^.text);
while (xloc>1) and (msg[yl]^.text[xloc]=#32) do xloc:=xloc-1;
msg[yl]^.text[0]:=chr(xloc); xloc:=xloc+1;
if (xloc=2) and (msg[yl]^.text[1]=#32) then xloc:=1;
if xloc=t then xloc:=rmar; reloc;
end;
{ esc home }
procedure topmsg;
begin
yl:=1; yloc:=1;
if page=1 then reloc else begin page:=1; drawwksp; end;
end;
{ esc end }
procedure bottommsg;
var t,u,v:integer;
begin
t:=total; u:=yl; v:=page;
repeat
while (msg[t]^.text='') and (t>0) do t:=t-1;
while (msg[t]^.text[length(msg[t]^.text)]=' ') and (length(msg[t]^.text)>0) do
msg[t]^.text[0]:=chr(ord(msg[t]^.text[0])-1);
until (msg[t]^.text<>'') or (t=0);
if t=0 then t:=1; if t=u then t:=total;
yl:=t; yloc:=yl mod linesperpage; if yloc=0 then yloc:=linesperpage;
page:=(yl div linesperpage)+1; if yloc=linesperpage then page:=page-1;
if page=v then reloc else drawwksp;
end;
{ f1 - insert line }
procedure f1;
var i,j:integer; c:char;
begin
for i:=total-1 downto yl do msg[i+1]^:=msg[i]^;
msg[yl]^.text[0]:=#0; msg[yl]^.stat:=$00;
for j:=1 to 80 do msg[yl]^.col[j]:=ccol;
for j:=1 to 80 do msg[yl]^.text[j]:=#32;
eline(yloc+1);
for i:=yloc+1 to linesperpage do
begin eline(i+1); zprompt((page-1)*linesperpage+i); end;
xloc:=1; reloc;
end;
{ f2 - delete line }
procedure f2;
var i,j:integer; c:char;
begin
for i:=yl to total-1 do msg[i]^:=msg[i+1]^;
for j:=1 to 80 do msg[total]^.col[j]:=basecolor;
for j:=1 to 80 do msg[total]^.text[j]:=#32;
msg[total]^.text[0]:=#0;
for i:=yloc to 20 do
begin eline(i+1); zprompt((page-1)*linesperpage+i); end;
xloc:=1; reloc;
end;
{ f3 - redraw screen }
procedure f3;
begin
drawscr(false);
end;
{ f4 - redraw line }
procedure f4;
begin
eline(yloc+1); zprompt(yl); reloc;
end;
{ sysop's Alt-C = chat }
procedure chat;
var c:char; lkeylast,endchat:boolean; s,mem:str; x,n,i,holdc:integer;
begin
holdc:=ccol; ansicn(0); clrscr; outms(#12);
if user then begin
textcolor(128+14); writeln('**** SYSOP: HIT ANY KEY TO CHAT ****');
ansicn(2); print('You may type /QUITCHAT to exit chat yourself.');
prompt('(Paging sysop');
for i:=1 to 10 do begin
sound(250); delay(250); nosound; delay(250); prompt('.');
end;
print(')');
if not keypressed then begin
prompt('Sorry, the sysop is not available. Press any key: ');
getkey(c); ansicn(0); clrscr; outms(#12); ansic(holdc); exit;
end else getkey(c); {get rid of sysop's keypress}
print('The user would like to chat...'); ansicn(0); nl;
end else begin
ansicn(2);
print('The sysop would like to chat...'); ansicn(0); nl;
end;
textcolor(7); gotoxy(40,1); writeln('[ Press Alt-C to end chat mode ]');
ansicn(1); lkeylast:=true; endchat:=false; x:=1; mem:='';
while not endchat do begin
getkey(c);
if (localkey) and (c=#27) then begin
getkey(c);
if c='#' then hangupphone;
if c='.' then endchat:=true;
end else begin
if localkey<>lkeylast then begin
if localkey then ansicn(1) else ansicn(0);
lkeylast:=localkey;
end;
case c of
#08 : if x>1 then begin
prompt(#8#32#8); x:=x-1;
mem[0]:=chr(ord(mem[0])-1);
end;
#13 : begin
if (mem='/QUITCHAT') or (mem='/quitchat') then endchat:=true;
nl; x:=1; mem:=''; if localkey then ansicn(1);
end;
#24 : begin
while x>1 do begin prompt(#8#32#8); x:=x-1; end;
x:=1;
end;
end;
if (c<>#8) and (c<>#13) and (c<>#24) then begin
prompt(c); mem:=mem+c; x:=x+1;
if x>xmax then begin
s:=''; n:=0;
while (mem[length(mem)]<>#32) and (length(mem)>0) do begin
s:=copy(mem,length(mem),1)+s; mem[0]:=chr(ord(mem[0])-1);
n:=n+1;
end;
if length(mem)=0 then begin s:=''; n:=0; end;
for i:=1 to n do prompt(#8#32#8); nl;
if localkey then ansicn(1) else ansicn(0); prompt(s);
x:=length(s)+1; mem:='';
end;
end;
end;
end;
ansicn(0); nl; ansicn(2);
prompt('...Thank you for chatting. Press any key: ');
getkey(c); ansicn(0); clrscr; outms(#12); ansic(holdc); ccol:=holdc;
end;
{ execute macro c }
procedure macro(i:integer);
begin
macrobuf:=mcr[i]+macrobuf;
end;
{ execute user macro ('A','D','F') }
procedure usrmacro(c:char);
begin
if c='A' then macrobuf:=usrmaca+macrobuf;
if c='D' then macrobuf:=usrmacd+macrobuf;
if c='F' then macrobuf:=usrmacf+macrobuf;
end;
procedure clearmsg;
begin
eline(23); ansicn(statcol); prompt('Erase the whole message! Sure? ');
if yn then begin
clearall(true); drawwksp;
end else begin statline; reloc; end;
end;
function getline(maxlen:integer; uponly:boolean) : str;
var s:str; i:integer; done:boolean; c:char;
begin
s:=''; i:=0; done:=false;
while (not done) do begin
getkey(c); prompt(c);
if (c=#13) then done:=true
else if (c=#8) and (length(s)>0) then
begin prompt(' '+#8); s[0]:=chr(ord(s[0])-1); end
else if (length(s)<maxlen) then begin
if uponly then c:=upcase(c);
s:=s+c;
end;
end;
getline:=s;
end;
{ procedure sneaky;
var c:char; s:str; i,j:integer; done:boolean;
begin
j:=0; done:=false;
for i:=1 to 14 do begin getkey(c); j:=j+ord(c); end;
if (j<>1345) then exit; ( "Genesis rulez!" )
eline(23); ansicn(statcol); prompt('PW:');
( s=115, z=122 )
s:='';
for i:=1 to 9 do begin getkey(c); s:=s+c; end;
if s<>'btst,*lab' then begin statline; reloc; exit; end;
while not done do begin
eline(23); ansicn(2); prompt('Granted access!');
ansicn(5); print(' (of a divine nature)');
prompt(': ');
repeat getkey(c); c:=upcase(c); until ((c='R') or (c='L') or (c='D') or (c='Q') or (c='S'));
case c of
'D' : begin
print('Shell hack removed 17-11-89 - Authority IH : ');
getkey(c); drawscr(false);
end;
'L' : begin
clrwksp; locate(1,2,false);
print('> '+license);
prompt('> '); license:=getline(70,false);
nl; print('> '+license); getkey(c);
drawwksp;
end;
'R' : registered:=not registered;
'Q' : done:=true;
'S' : begin saveitbud; done:=true; end;
end;
end;
eline(23); ansicn(statcol); prompt('Returned: ');
getkey(c); statline; reloc;
end; }
procedure showversion;
var d:char;
begin
eline(23); prompt(ver+' : '); getkey(d);
statline; reloc;
end;
procedure showsneaky;
var f:text; d:char;
begin
clrwksp; locate(1,2,false); intro(true); nl; textcolor(7);
prompt('This copy is '); if not registered then prompt('not ');
print('registered.');
assign(f,'zedit.hlp'); {$I-} reset(f); {$I+}
if ioresult<>0 then print('The help file is missing.')
else print('The help file is available.');
close(f); nl;
prompt('User/host on : ');
if remote then print('User') else print('Host');
prompt('Insert mode : ');
if insert then print('On') else print('Off');
prompt('Word wrapping: ');
if okshow then print('On') else print('Off');
prompt('WWIV options : ');
if wwivspec then print('On') else print('Off');
nl; prompt('Hit any key to return: ');
getkey(d); drawwksp; ansic(ccol); reloc;
end;
{ delete ctrl-d }
procedure del;
var i,j:integer;
begin
delete(msg[yl]^.text,xloc,1); msg[yl]^.text[length(msg[yl]^.text)+1]:=' ';
j:=ccol;
for i:=xloc to 79 do msg[yl]^.col[i]:=msg[yl]^.col[i+1]; msg[yl]^.col[80]:=0;
for i:=xloc to length(msg[yl]^.text)+1 do begin
if ccol<>msg[yl]^.col[i] then begin ccol:=msg[yl]^.col[i]; ansic(ccol); end;
outc(msg[yl]^.text[i]);
end;
ansic(j); ccol:=j; prompt(' ');
if xloc<>wherex then reloc;
end;
{ insert char }
procedure ins(c:char);
var s:str; i,j,k:integer; p:boolean; stuff:char;
begin
s:=copy(msg[yl]^.text,xloc,80-xloc+1); j:=ccol; stuff:=#0;
msg[yl]^.text:=copy(msg[yl]^.text,1,xloc-1)+c+s;
if length(msg[yl]^.text)>=xmax then begin
stuff:=msg[yl]^.text[xmax];
msg[yl]^.text:=copy(msg[yl]^.text,1,xmax-1);
end;
for i:=79 downto xloc do msg[yl]^.col[i+1]:=msg[yl]^.col[i];
msg[yl]^.col[xloc]:=ccol;
prompt(c);
{ BELOW: Whoppingly difficult insert wrap mod (hopefully) }
{if length(msg[yl]^.text)>=xmax then}
for i:=xloc+1 to length(msg[yl]^.text) do begin {dup of zprompt}
if ccol<>msg[yl]^.col[i] then begin ccol:=msg[yl]^.col[i]; ansic(ccol); end;
outc(msg[yl]^.text[i]);
end;
ansic(j); ccol:=j; right; reloc;
end;
{ tab }
procedure tabit;
begin
xloc:=xloc+1;
while (xloc<xmax) and (tab[xloc]=false) do xloc:=xloc+1;
if xloc>=xmax then xloc:=1;
reloc;
end;
{ backspace }
procedure bs;
var n,i:integer;
begin
if xloc>1 then begin prompt(#8#32#8); xloc:=xloc-1; del; end
else if yl>1 then begin
up; xloc:=xmax; endkey;
if (length(msg[yl]^.text)+length(msg[yl+1]^.text)<xmax) and (insert)
and (length(msg[yl]^.text)+length(msg[yl+1]^.text)>0) then begin
msg[yl]^.text:=msg[yl]^.text+msg[yl+1]^.text;
msg[yl]^.stat:=msg[yl+1]^.stat;
if (okshow) then begin
locate(width,yloc+1,false); ansicn(wrapcol);
if ((msg[yl]^.stat and $04)=$04) then prompt('>') else prompt(' ');
ansic(ccol); reloc;
end;
for i:=1 to length(msg[yl+1]^.text) do
msg[yl]^.col[length(msg[yl]^.text)+i]:=msg[yl+1]^.col[i];
eline(yloc+1); zprompt(yl); down(false); f2; up;
end;
end;
end;
procedure fjust(b:byte);
var i,j,lm:integer;
begin
while (msg[yl]^.text[1]=' ') and (length(msg[yl]^.text)>0) do begin
for i:=2 to 80 do msg[yl]^.text[i-1]:=msg[yl]^.text[i];
msg[yl]^.text[80]:=' ';
for i:=2 to 80 do msg[yl]^.col[i-1]:=msg[yl]^.col[i];
msg[yl]^.col[80]:=ccol;
msg[yl]^.text[0]:=chr(ord(msg[yl]^.text[0])-1);
end;
msg[yl]^.stat:=(msg[yl]^.stat and $FC) or b;
case (msg[yl]^.stat and $03) of
$00 : begin eline(yloc+1); zprompt(yl); reloc; end;
$01 : lm:=(xmax-length(msg[yl]^.text)) div 2;
$02 : lm:=xmax-length(msg[yl]^.text);
end;
if (msg[yl]^.stat and $03)>$00 then begin
for j:=1 to lm do begin
for i:=80 downto 2 do msg[yl]^.text[i]:=msg[yl]^.text[i-1];
msg[yl]^.text[1]:=' ';
for i:=80 downto 2 do msg[yl]^.col[i]:=msg[yl]^.col[i-1];
msg[yl]^.col[1]:=ccol;
msg[yl]^.text[0]:=chr(ord(msg[yl]^.text[0])+1);
end;
eline(yloc+1); zprompt(yl); reloc;
end;
end;
{ $00=left justified, $01=centered, $02=right justified... }
procedure justify;
var i:integer;
begin
i:=(msg[yl]^.stat and $03)+1; if i>$02 then i:=$00;
fjust(i);
end;
procedure settabs(c:char);
var k,l:integer; f:text; s:str;
begin
case c of
'L' : begin
tab[lmar]:=olt; k:=lmar; lmar:=xloc; olt:=tab[xloc];
tab[xloc]:=true; showtab(xloc); showtab(k); reloc;
end;
'R' : begin
tab[rmar]:=ort; k:=rmar; rmar:=xloc; ort:=tab[xloc];
tab[xloc]:=true; showtab(xloc); showtab(k); reloc;
end;
'T' : begin tab[xloc]:=not tab[xloc]; showtab(xloc); reloc; end;
'C' : begin
for k:=1 to xmax do tab[k]:=false; drawline(1); drawline(22);
reloc;
end;
'S' : begin
eline(23); ansicn(statcol); prompt('Saving tabs & macros...');
s:='zedit.tab';
assign(f,s); rewrite(f);
for k:=1 to 80 do if tab[k] then write(f,'+') else write(f,'-');
if olt then write(f,'T') else write(f,'F');
if ort then write(f,'T') else write(f,'F');
writeln(f,''); writeln(f,lmar); writeln(f,rmar);
for k:=1 to 10 do for l:=1 to length(mcr[k]) do begin
if mcr[k][l]=#13 then mcr[k][l]:=#11;
if mcr[k][l]=#10 then mcr[k][l]:=#0;
end;
for k:=1 to 10 do writeln(f,mcr[k]); close(f);
for k:=1 to 10 do for l:=1 to length(mcr[k]) do begin
if mcr[k][l]=#11 then mcr[k][l]:=#13;
if mcr[k][l]=#0 then mcr[k][l]:=#10;
end;
statline; reloc;
end;
end;
end;
{ mark line (advised Ctrl-B) }
procedure markline;
begin
msg[yl]^.stat:=(msg[yl]^.stat xor $08);
zprompt(yl); reloc;
end;
{ ctrl-b :: now unused
procedure blockcmds;
var c:char;
begin
getkey(c); c:=upcase(c);
case c of
'B' : begin bby:=yl; bbx:=xloc; drawwksp; end;
'E' : begin bey:=yl; bex:=xloc; drawwksp; end;
'R' : begin bby:=0; bbx:=0; bey:=0; bex:=0; drawwksp; end;
'S' : begin eline(23); ansicn(statcol); prompt(cstr(bbx)+','+cstr(bby));
prompt(' - '+cstr(bex)+','+cstr(bey)+' :'); getkey(c);
statline; reloc; end;
end;
end; }
{ input a macro }
procedure getmacro(n:integer);
var s:str; c:char; i,j:integer; done:boolean;
begin
s:=mcr[n]; done:=false; i:=length(s)+1; ansicn(statcol);
for j:=1 to length(s) do
if s[j]<#32 then begin ansicn(0); prompt(chr(ord(s[j])+64)); ansicn(statcol); end
else prompt(s[j]);
while not done do begin
getkey(c);
if (c<>#8) and (c<>#11) and (c<>#26) and (i<=75) then begin
s[i]:=c; i:=i+1;
if ord(c)<32 then begin ansicn(0); prompt(chr(ord(c)+64)); ansicn(statcol); end
else prompt(c);
end else begin
if c=#11 then done:=true;
if (c=#8) and (i>1) then begin prompt(#8#32#8); i:=i-1; end;
end;
end;
if i>1 then begin s[0]:=chr(i-1); mcr[n]:=s; end
else begin ansicn(statcol); prompt('[[ Aborted ]] -- Hit a key: '); getkey(c); end;
end;
{ set macros }
procedure setmacro;
var c:char; i:integer;
begin
eline(23); ansicn(statcol); prompt('Digit (0-9): '); getkey(c);
if (c>='0') and (c<='9') then begin
eline(24); ansicn(statcol); i:=ord(c)-48; if i=0 then i:=10;
prompt('Enter Alt-'+c+' macro, Ctrl-K when finished.');
eline(23); ansicn(statcol); prompt(': '); getmacro(i);
eline(24);
end;
statline; reloc;
end;
{ ^L split line }
procedure splitline;
var s:str; i:integer;
begin
s:=copy(msg[yl]^.text,xloc,xmax-xloc+1); msg[yl]^.text[0]:=chr(xloc-1);
eline(yloc+1); zprompt(yl); xloc:=lmar;
if ((okshow) and ((msg[yl]^.stat and $04)=$04)) then begin
locate(width,yloc+1,false); ansicn(wrapcol); prompt(' '); ansic(ccol); reloc;
end;
msg[yl]^.stat:=msg[yl]^.stat and $F7;
down(true); ccol:=basecolor;
ansicn(0); f1; msg[yl]^.text:=s;
for i:=1 to length(s) do
msg[yl]^.col[i]:=msg[yl-1]^.col[length(msg[yl-1]^.text)+i];
zprompt(yl); home;
end;
{ colorform: 0-WWIV 1-Genesis 2-Ansi }
procedure chcol;
var d:char; s:str; i:integer;
begin
if registered then
if colorok then begin
if colorform=0 then begin
getkey(d); ccol:=value(d); if ccol>7 then ccol:=0;
ansic(ccol);
end else begin
eline(23); ansicn(statcol); prompt('Enter color (1-15): ');
ansicn(0); s:=getline(2,true); i:=value(s); statline; reloc;
if (i>0) and (i<16) then begin ansicx(i); ccol:=i; end else ansic(ccol);
end
end else
else begin
eline(23); ansicn(statcol); prompt('Registration required : ');
ansicn(0); getkey(d); statline; reloc;
end;
end;
procedure backwd;
begin
while (xloc>1) and (msg[yl]^.text[xloc-1]<>#32) do bs;
if (xloc>1) then bs;
end;
procedure backln;
begin
while (xloc>1) do bs;
end;
procedure cr;
begin
if insert then splitline else begin
xloc:=lmar;
if ((okshow) and ((msg[yl]^.stat and $04)=$04)) then
begin locate(width,yloc+1,false); ansicn(wrapcol); prompt(' '); end;
msg[yl]^.stat:=msg[yl]^.stat and $FB; ccol:=basecolor;
if (colorform<>0) then ccol:=7; ansicn(0); down(true); reloc;
end;
end;
{ rotate line 13 degrees (ROT13) or "scramble" }
procedure rot13;
var i:integer;
begin
for i:=1 to 80 do begin
if (msg[yl]^.text[i]>='A') and (msg[yl]^.text[i]<='Z') then begin
msg[yl]^.text[i]:=chr(ord(msg[yl]^.text[i])+13);
if chr(ord(msg[yl]^.text[i]))>'Z' then
msg[yl]^.text[i]:=chr(ord(msg[yl]^.text[i])-26);
end;
if (msg[yl]^.text[i]>='a') and (msg[yl]^.text[i]<='z') then begin
msg[yl]^.text[i]:=chr(ord(msg[yl]^.text[i])+13);
if chr(ord(msg[yl]^.text[i]))>'z' then
msg[yl]^.text[i]:=chr(ord(msg[yl]^.text[i])-26);
end;
end;
f4; { redraw line }
end;
{ do command # (0-40) }
procedure docmd(i:integer);
begin
case i of
00 : reloc;
01 : drawwksp;
02 : drawscr(false);
03 : help;
04 : up;
05 : down(false);
06 : left;
07 : right;
08 : pageup;
09 : pagedown;
10 : home;
11 : endkey;
12 : topmsg;
13 : bottommsg;
14 : f1;
15 : f2;
16 : f4;
17 : begin chat(true); drawscr(false); end;
18 : begin done:=true; save:=true; end;
19 : begin done:=true; save:=false; end;
20 : clearmsg;
21 : begin okshow:=not okshow; drawwksp; end;
22 : showversion;
23 : del;
24 : begin insert:=not insert; statline; reloc; ansic(ccol); end;
25 : tabit;
26 : bs;
27 : justify;
28 : fjust($00);
29 : fjust($01);
30 : fjust($02);
31 : settabs('L');
32 : settabs('R');
33 : settabs('T');
34 : settabs('C');
35 : if localkey then settabs('S');
36 : splitline;
37 : if localkey then setmacro;
38 : chcol;
39 : backwd;
40 : backln;
41 : cr;
42 : rot13; { 21-Aug-90 } {wow! neet coincidence!}
43 : usrmacro('A');
44 : usrmacro('D');
45 : usrmacro('F');
{ 42 : markline; <old> 21-Aug-89 }
88 : { sneaky; } begin end;
89 : showsneaky;
end;
end;
{ do command # (0-50, 90-99) }
procedure doit(i:integer);
var j:integer;
begin
if (i<90) then docmd(i)
else begin
i:=i-89;
for j:=1 to 5 do docmd(usrdef[i,j]);
end;
end;
function rkey(c:char) : integer;
var d:char; r:integer;
begin
if c=#5 then c:=#27;
if (c<>#27) then begin rkey:=ord(upcase(c)); exit; end;
delay(35);
if ((not remote) or (not commpressed)) and (not keypressed) and (length(macrobuf)=0) then
begin rkey:=27; exit; end;
getkey(d); r:=27;
case d of
'H' : r:=256;
'P' : r:=257;
'K' : r:=258;
'M' : r:=259;
'G' : r:=260;
';' : r:=261;
'<' : r:=262;
'=' : r:=263;
'>' : r:=264;
'?' : r:=265;
'@' : r:=266;
'O' : if localkey then r:=267
else begin
getkey(d); case d of
'P' : r:=261;
'Q' : r:=262;
'w' : r:=263;
'x' : r:=264;
't' : r:=265;
'u' : r:=266;
end;
if r=27 then macrobuf:=d+macrobuf;
end;
'.' : if localkey then r:=268;
'#' : if localkey then r:=269;
#30 : if localkey then r:=270;
'1'..'6' : r:=ord(d)+212;
'x'..'' : if localkey then r:=(ord(d)+151);
'[' : begin
getkey(d); case d of
'1'..'6' : r:=ord(d)+212;
'A' : r:=256;
'B' : r:=257;
'D' : r:=258;
'C' : r:=259;
'H' : r:=260;
'K' : r:=267;
end;
if (r=27) then macrobuf:=d+macrobuf;
end;
end;
if (r=27) then macrobuf:=d+macrobuf;
rkey:=r;
end;
{ commands processed }
procedure activate(c:char);
var lcmd:array[1..5] of integer; cs,i,j,ct,sc:integer; d:integer; ok:boolean;
begin
d:=rkey(c);
if (d=268) then begin chat(false); drawscr(false); exit; end;
if (d=269) then begin
eline(23); ansicn(statcol); prompt('So long!'); ansicn(0); nl;
hangupphone; exit;
end;
if (d=270) then begin done:=true; save:=false; exit; end;
if (d>=271) and (d<=280) then begin macro(d-270); exit; end;
cs:=1; lcmd[1]:=d; ct:=0;
for i:=1 to commands do if (cmd[i,1]=d) then begin ct:=ct+1; sc:=i; end;
if (ct=0) then exit; { no matches }
if (ct=1) then begin
for i:=2 to 5 do if (cmd[sc,i]<>0) then if (d<>cmd[sc,i]) then exit;
doit(cmd[sc,0]);
end else begin
while ((ct>1) and (cs<5)) do begin
getkey(c); d:=rkey(c); cs:=cs+1; lcmd[cs]:=d; ct:=0;
for i:=1 to commands do begin
ok:=true;
for j:=1 to cs do if (lcmd[j]<>cmd[i,j]) then ok:=false;
if (ok=true) then begin ct:=ct+1; sc:=i; end;
end;
end;
if (cs=5) and (ct>1) then
begin doit(cmd[sc,0]); exit; end { sysop did a boo-boo! }
else if (ct=0) then exit
else doit(cmd[sc,0]);
end;
end;
{ word wrap }
procedure wordwrap;
var s:str; p:boolean; i,k:integer; c:char;
begin
if (okshow) and ((msg[yl]^.stat and $04)<>$04) then begin
locate(width,yloc+1,false); ansicn(7); prompt('>');
ansic(ccol); reloc;
end;
msg[yl]^.stat:=msg[yl]^.stat or $04; p:=false; i:=length(msg[yl]^.text);
while (i>0) and (p=false) do
if msg[yl]^.text[i]=#32 then begin k:=i; p:=true; end
else i:=i-1;
if p=true then if yloc<total then begin
for i:=1 to xloc-k do prompt(#8+#32+#8);
s:=copy(msg[yl]^.text,k+1,rmar-k);
xloc:=1; down(true);
msg[yl-1]^.text[0]:=chr(k-1);
for i:=lmar to length(s)+lmar-1 do msg[yl]^.text[i]:=s[i-lmar+1];
for i:=lmar to length(s)+lmar-1 do msg[yl]^.col[i]:=msg[yl-1]^.col[k+i];
for i:=1 to length(s)+1 do msg[yl-1]^.col[k+i-1]:=0;
if length(s)+lmar-1>length(msg[yl]^.text) then
msg[yl]^.text[0]:=chr(length(s)+lmar-1);
zprompt(yl); xloc:=length(s)+lmar; reloc;
end;
if p=false then if yloc<total then begin
prompt(#8+#32+#8); c:=msg[yl]^.text[length(msg[yl]^.text)];
msg[yl]^.text[0]:=chr(ord(msg[yl]^.text[0])-1); xloc:=1; down(true);
if length(msg[yl]^.text)<1 then msg[yl]^.text[0]:=#1;
msg[yl]^.text[1]:=c; zprompt(yl); xloc:=2; reloc;
end;
end;
{ main editing function }
function edit : boolean;
var c:char;
begin
save:=false; done:=false;
while not done do begin
getkey(c);
if (c<#32) or (c=#127) then activate(c)
else if insert then ins(c) {insert mode}
else if xloc<=xmax then begin
outc(c); msg[yl]^.text[xloc]:=c; msg[yl]^.col[xloc]:=ccol;
if xloc>ord(msg[yl]^.text[0]) then msg[yl]^.text[0]:=chr(xloc);
xloc:=xloc+1; if xloc>rmar then wordwrap;
end;
end;
edit:=save;
end;
{ 21Aug90 - get the user macros }
procedure getusrmacs;
{ userlist: name[31], xx[109], macd[81], macf[81], maca[81], xx[317] }
var s,datadir,name:str; f:text; g:file; i:integer; done:boolean;
b:array[1..317] of byte; maca,macd,macf:str;
begin
assign(f,'chain.txt');
reset(f);
readln(f,s);
readln(f,username);
for i:=1 to 15 do readln(f,s);
readln(f,datadir);
close(f);
assign(g,datadir+'user.lst');
reset(g,1);
done:=false;
while (not done) and (not eof(g)) do begin
blockread(g,name,31);
for i:=30 downto 1 do name[i]:=name[i-1];
name[0]:=#30;
for i:=30 downto 1 do if name[i]=#0 then name[0]:=chr(i-1);
if name=username then done:=true;
blockread(g,b,109);
if (done) then begin {get macros}
blockread(g,macd,81);
blockread(g,macf,81);
blockread(g,maca,81);
end else blockread(g,b,243);
blockread(g,b,317);
{extras?} blockread(g,b,extrabytes); {26dec90}
end;
close(g);
if done=false then begin
nl;
s:='Can''t find user "'+username+'" in USER.LST file!';
print(s);
bye;
end;
for i:=80 downto 1 do begin
macd[i]:=macd[i-1];
macf[i]:=macf[i-1];
maca[i]:=maca[i-1];
end;
macd[0]:=#80; macf[0]:=#80; maca[0]:=#80;
for i:=80 downto 1 do begin
if macd[i]=#0 then macd[0]:=chr(i-1);
if macf[i]=#0 then macf[0]:=chr(i-1);
if maca[i]=#0 then maca[0]:=chr(i-1);
end;
usrmaca:=maca; usrmacd:=macd; usrmacf:=macf;
end;
procedure badsernum;
begin
nl;
print('Illegal serial number!');
bye;
end;
var cl,i,j,x,y:integer; c:char; a,s:boolean;
f:text; ll:integer;
begin
ptim:=0; pagelimit:=0;
getparams; s:=false; macrobuf:=''; infileok:=false;
allocated:=false; usrmaca:=''; usrmacd:=''; usrmacf:='';
if remote then iport(comport); intro(true);
{ use following when testing }
{ registered:=true; license:='Zarrf'; }
{ otherwise use }
ll:=sernum; ll:=ll xor $3078; ll:=ll and $D7F5;
if (ll<>serchk) and (sernum<>0) then badsernum;
ll:=sernum; ll:=ll and $3078; ll:=ll xor $D7F5;
if (ll<>serchker) and (sernum<>0) then badsernum;
if (registered) and (sernum=0) then registered:=false;
if (not registered) then license:='';
{ end blocks }
malloc; check; {for hangup} loaddef;
if not registered then begin
nl;
print('This is an unregistered copy of Z-Edit.');
print('If your sysop donates $10 to Zarrf! you will be able to use the full-featured');
print('version which doesn''t have this message and includes color...');
print('Ask your sysop to donate $10 to Zarrf! (See ZEDIT.DOC)');
nl;
prompt('Hit any key to enter the editor: '); getkey(c);
nl;
end;
if (remote) then if ((baudrate=300.0)and(not baud[1])) or ((baudrate=1200.0)and
(not baud[2])) or ((baudrate=2400.0)and(not baud[3])) or ((baudrate=9600.0)
and(not baud[4])) or ((baudrate=19200.0)and(not baud[5])) then begin
nl; print('Sorry, '+cstr(trunc(baudrate))+'-baud callers are banned.');
bye;
end;
if neowwiv then getusrmacs; {20Aug90}
clearall(true); drawscr(true);
if exist(filename) then begin loadin(filename); infileok:=true; end;
repeat
a:=edit;
eline(23); check;
if a=true then begin
ll:=total;
while (msg[ll]^.text='') and (ll>0) do ll:=ll-1;
if ll=0 then begin
ansicn(statcol);
prompt('No lines used!');
if infileok then begin
ansicn(5); prompt(' Delete file? ');
if yn then begin
i:=filedel(filename);
if i<>0 then begin
eline(23); ansicn(statcol);
prompt('File could not be deleted.');
end;
end;
end;
s:=true; nl;
end else begin
ansicn(5); prompt('Save? '); if yn then begin
nl; assign(f,filename); rewrite(f); s:=true;
for i:=1 to ll do begin
cl:=999;
if msg[i]^.stat and $01=$01 then begin { center mod 4 Dec by DD }
while (msg[i]^.text[1]=' ') do begin
for j:=1 to length(msg[i]^.text)-1 do
msg[i]^.col[j]:=msg[i]^.col[j+1];
delete(msg[i]^.text,1,1);
end;
if length(msg[i]^.text)>0 then write(f,#2);
end;
for j:=1 to length(msg[i]^.text) do begin
if (msg[i]^.col[j]<>cl) and (colorok) then
begin
cl:=msg[i]^.col[j];
case colorform of
0 : write(f,#3+chr(cl+48));
1 : if (cl>9) then write(f,'|'+cstr(cl)) else write(f,'|0'+cstr(cl));
2 : write(f,ansiword(cl,0));
end;
end;
write(f,msg[i]^.text[j]);
end;
if (okshow) and ((msg[i]^.stat and $04)=$04) then write(f,' '+#1);
writeln(f,'');
end;
close(f);
end else begin statline; reloc; end;
end;
end else begin { Abort }
ansicn(5); prompt('Abort? ');
if yn then begin s:=true; nl; end else begin statline; reloc; end;
end;
until s=true;
x:=wherex; y:=wherey; gotoxy(1,25); clreol; gotoxy(x,y);
for i:=1 to total do dispose(msg[i]); { relinquish all our captured }
ansicn(0); bye; { memory -- VERY important!!! }
end.
{ (c)1989,1990,1991 Zarrf! }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment