Created
May 25, 2013 20:38
-
-
Save robey/5650702 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{$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