{$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='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(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 page1 then begin xloc:=xloc-1; outms(#27+'[D'); gotoxy(wherex-1,wherey); end; end; { arrow right } procedure right; begin if xloc1) 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)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 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)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; 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 yloclength(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 ylocord(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! }