_ _ _ ____ _ _
/ \ _ __ ___ | |_| |__ ___ _ __ | _ \ _ __ ___ (_) __| |
/ _ \ | '_ \ / _ \| __| '_ \ / _ \ '__| | | | | '__/ _ \| |/ _\` |
/ ___ \| | | | (_) | |_| | | | __/ | | |_| | | | (_) | | (_| |
/_/ \_\_| |_|\___/ \__|_| |_|\___|_| |____/|_| \___/|_|\__,_|
bbs
XQTRs lair...
below is a complete oneliner editor for mystic bbs, default oneliner.
you are able to edit, delete, add oneliners as you wish, but this script
is here, more to learn some stuff about MPL. so lets take the script
line by line and so some explaining. at the end you can copy/paste the
entire script.
this command gives us access to some very useful variables. in our case
the cfgdatapath, which contains the path to the mystic data directory.
Uses cfg;
this is the format/record/structure of each liner inside the oneliners.dat
file. we need this to be able to read/write oneliners.
Type OneLineRec = Record
Text : String[79];
From : String[30];
End;
this is procedure to turn a mystic box code into something we can use
more easy.
Procedure XWindow(H1:String;T,X1,Y1,X2,Y2:Integer);
Var T1,A1,A2,B1,B2 : String;
Begin
A1 := Int2Str(X1);
A2:=Int2Str(X2);
B1:=Int2Str(Y1);
B2:=Int2Str(Y2);
T1:=Int2Str(T);
Write('|#X#'+T1+'#'+H1+'#'+A1+'#'+B1+'#'+A2+'#'+B2+'#');
End;
with this procedure we create a yes/no box, that also restores the screen,
when it's closed. we use it to take yes/no replies from the user. it
uses the class system of mystic bbs to display the box. we could also use
the above procedure to just display a box.
function yesnobox(title:string):boolean;
var
bb:longint;
begin
ClassCreate (bb, 'box');
BoxOptions (bb, 1, true, 8, 8, 7, 15, false, 112);
BoxOpen (bb, 27, 8, 47, 12);
writexypipe(29,8,7,MCILength(title),title);
gotoxy(33,10);
yesnobox:= inputyn('')
BoxClose (bb);
ClassFree (bb);
end;
this is how we save all the oneliner records, stored in an array of 10
records (lines[]). the function, makes a backup copy of the original file,
rewrites a new one and saves all records, until it finds an empty one. if
we found an empty, we stop saving the rest records, so we don't save
any blank/empty records.
procedure savelines;
var
k:byte;
f:file;
begin
filecopy(oneliner,oneliner+'.1lb'); // copy backup file
fassign(f,oneliner,66); // assign file to a variable
frewrite(f); // rewrite it
k:=1;
while k<11 and lines[k].from<>'' do begin // while we have records, save
fwrite(f,lines[k],sizeof(ll));
k:=k+1;
end;
fclose(f); // close the file
changed:=false;
end;
here we just reading the file, into an array of 10 records. first we fill
the array with empty strings to initialize it, then we open the file and
read it until the end of it. this way, if a oneliner.dat file has less
than 10 records, we are sure, that the rest of the array, is initialized
with empty spaces (#0) and if the user will save the file, it will stop
saving in the first empty record.
procedure loadoneliner;
var
f : file;
ol:onelinerec;
i:byte;
begin
for i:=1 to 10 do
fillchar(lines[i],sizeof(ol),#0); // fill the array with #0 chars
fassign(f,oneliner,66); // assign file to variable
freset(f); // open for reading
i:=0;
while not feof(f) do begin // while we are not in the end of file
// read records.
i:=i+1;
fillchar(ol,sizeof(ol),#0);
fread(f,ol,sizeof(ol))
lines[i]:=ol;
end;
fclose(f); // close the file... always!
end;
below is our main function, that displays the info and waits for the user
to press a key. this is the same logic, for a lightbar menu. it's the
same thing here. the logic is... display all 10 records, with the
"unselected" color and after draw the record, that is selected, with a
more intense ("selected") color. to know which record is selected, we
store it's index number in a variable (sel)
procedure select;
var
sel : byte = 1;
done : boolean = false;
c : char;
procedure listlines; // display all records!
var
i:byte;
cl:byte;
begin
for i := 0 to 9 do begin
writexypipe(1,3+(i*2),7,79,lines[i+1].from)
writexypipe(1,3+(i*2)+1,7,79,lines[i+1].text)
end;
end;
procedure showsel; // display the selected one
begin
textcolor(14+16);
gotoxy(1,3+((sel-1)*2));
writeraw(padrt(lines[sel].from,79,' '));
gotoxy(1,3+((sel-1)*2)+1)
writeraw(padrt(lines[sel].text,79,' '));
end;
to delete a record, i chose this method... move all records below the
selected one, one place up and fill the last one with empty chars. this
way, the selected record is delete (actually filled, with info from the
record below) and the empty record, that will appear at the end, we fill
it with space.
procedure deleterec;
var
j:byte;
begin
// if the user said NO, we exit the procedure
if yesnobox(' |14Delete record? ') = false then exit;
for j:=sel to 9 do begin
lines[j]:=lines[j+1] // move next record to the previous one
end;
fillchar(lines[10],sizeof(ll),#0); // fill record with empty chars.
changed:=true;
end;
to clear all lines, we just fill all records with #0.
procedure clearall;
var
k:byte;
begin
for k:=1 to 10 do fillchar(lines[k],sizeof(ll),#0);
changed:=true;
end;
for the user to edit a record, we just use a box and two getstr functions.
nothing complicated. just show stuff and wait for the user to enter the
new strings. if the user accepts the new values, we pass them into our
array that we keep all records, else we ignore everything.
procedure editrec;
var
j:byte;
ok:boolean=false;
from,txt:string;
begin
xwindow('',1,5,10,75,16);
writexy(7,10,14,' Edit record #'+int2str(sel)+' ');
writexy(7,12,7,padrt(lines[sel].from,30,' '));
writexy(7,13,7,padrt(copy(lines[sel].text,1,68),68,' '));
gotoxy(7,12);
from:=input(30,30,11,lines[sel].from);
writexy(7,12,7,padrt(from,30,' '));
gotoxy(7,13);
txt:=input(67,79,11,lines[sel].text);
writexy(7,13,7,padrt(copy(txt,1,68),68,' '));
gotoxy(25,15);
textcolor(3);
ok:=inputyn('Apply changes?: ');
if ok then begin
lines[sel].from:=from;
lines[sel].text:=txt;
changed:=true;
end;
end;
now we just have make a loop, to accept user commands. to do that, we
use a repeat/until loop. inside we do these things:
1. draw stuff
2. wait for keypress/command
3. execute the command
4. go back to 1...
begin
writexypipe(1,24,7,79,'|11E|03:Edit | |11D|03:Delete | |11S|03:Save | '+
'|11C|03:Clear All | |11R|03:Revert | |11ESC|03:Exit | |11H|03:Help');
repeat
listlines; // draw stuff...
showsel;
c:=readkey; // wait for user to press a key
if isarrow then begin // is the key an arrow key?
case c of // if yes, c holds the key code
#72 : begin // move selection up
sel:=sel -1;
if sel < 1 then sel:=1;
end;
#80 : begin // move selection down
sel:=sel+1;
if sel>10 then sel:=10;
end;
#71 : sel:=1; // move selection to top
#79 : sel:=10; // and bottom...
end;
end else begin
case c of // the key is a simple one
#13 : begin // enter? do nothing, not care
end;
#27 : begin // pressed esc? ask to save if changes are made.
if changed then save;
Done := True; // if we change this to true we will exit
// the loop.
end;
'c','C': clearall; // a key responding to a command pressed.
'd','D': deleterec // execute the command
'e','E': editrec;
's','S': save;
'h','H': help;
'r','R': begin
loadoneliner;
changed:=false;
end;
end;
end;
until Done; // repeat the loop, until the user presses esc.
end;
this is our main block of code. we get the data path, in a weird way :)
just to show you, that there are more ways to do the same thing, even
if it's stupid :) then load the records in memory and display the
menu selection to the user.
begin
dir := cfgsyspath;
oneliner := dir +'data'+pathchar+'oneliner.dat';
textcolor(15);
clrscr;
writexy(1,1,15,cprt);
loadoneliner;
select;
textcolor(7);
clrscr;
end;
;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:
actuall script
;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:
Uses cfg;
Const
cprt = 'OneLiner Editor by XQTR//2019';
Type OneLineRec = Record
Text : String[79];
From : String[30];
End;
var
dir : string;
ll : OneLineRec;
oneliner : string;
lines : array[1..10] of OneLineRec;
changed:boolean = false;
Procedure XWindow(H1:String;T,X1,Y1,X2,Y2:Integer);
Var T1,A1,A2,B1,B2 : String;
Begin
A1 := Int2Str(X1);
A2:=Int2Str(X2);
B1:=Int2Str(Y1);
B2:=Int2Str(Y2);
T1:=Int2Str(T);
Write('|#X#'+T1+'#'+H1+'#'+A1+'#'+B1+'#'+A2+'#'+B2+'#');
End;
function yesnobox(title:string):boolean;
var
bb:longint;
begin
ClassCreate (bb, 'box');
BoxOptions (bb, 1, true, 8, 8, 7, 15, false, 112);
BoxOpen (bb, 27, 8, 47, 12);
writexypipe(29,8,7,MCILength(title),title);
gotoxy(33,10);
yesnobox:= inputyn('')
BoxClose (bb);
ClassFree (bb);
end;
procedure savelines;
var
k:byte;
f:file;
begin
filecopy(oneliner,oneliner+'.1lb');
fassign(f,oneliner,66);
frewrite(f);
k:=1;
while k<11 and lines[k].from<>'' do begin
fwrite(f,lines[k],sizeof(ll));
k:=k+1;
end;
fclose(f);
changed:=false;
end;
procedure loadoneliner;
var
f : file;
ol:onelinerec;
i:byte;
begin
for i:=1 to 10 do
fillchar(lines[i],sizeof(ol),#0);
fassign(f,oneliner,66);
freset(f);
i:=0;
while not feof(f) do begin
i:=i+1;
fillchar(ol,sizeof(ol),#0);
fread(f,ol,sizeof(ol))
lines[i]:=ol;
end;
fclose(f);
end;
procedure select;
var
sel : byte = 1;
done : boolean = false;
c : char;
procedure listlines;
var
i:byte;
cl:byte;
begin
for i := 0 to 9 do begin
//cl:=i%2;
//if cl=1 then textcolor(3) else textcolor(11);
//gotoxy(1,3+(i*2));
//writeraw(padrt(lines[i+1].from,79,' '));
writexypipe(1,3+(i*2),7,79,lines[i+1].from)
//gotoxy(1,3+(i*2)+1)
//writeraw(padrt(lines[i+1].text,79,' '));
writexypipe(1,3+(i*2)+1,7,79,lines[i+1].text)
end;
end;
procedure showsel;
begin
textcolor(14+16);
gotoxy(1,3+((sel-1)*2));
writeraw(padrt(lines[sel].from,79,' '));
gotoxy(1,3+((sel-1)*2)+1)
writeraw(padrt(lines[sel].text,79,' '));
end;
procedure deleterec;
var
j:byte;
begin
if yesnobox(' |14Delete record? ') = false then exit;
for j:=sel to 9 do begin
lines[j]:=lines[j+1]
end;
fillchar(lines[10],sizeof(ll),#0);
changed:=true;
end;
procedure clearall;
var
k:byte;
begin
for k:=1 to 10 do fillchar(lines[k],sizeof(ll),#0);
changed:=true;
end;
procedure help
begin
xwindow('',1,2,7,78,20);
writexy(4,7,14,' Help ');
writexy(4,9 ,7,'Edit the OneLine records of the oneliners.dat file.'+
' The commands');
writexy(4,10,7,'are self explanatory. You only need to know these:');
writexy(4,12,7,'() No changes are saved in the file, unless you press '+
'the (S)ave command');
writexy(4,13,7,'() You can revert to the current file by pressing'+
' (R)evert');
writexy(4,14,7,'() When you save changes a backup file of the original'+
' one, is saved as');
writexy(4,15,7,' oneliners.dat.1lb. If you mess things up, '+
'restore this file.');
readkey;
end;
procedure editrec;
var
j:byte;
ok:boolean=false;
from,txt:string;
begin
xwindow('',1,5,10,75,16);
writexy(7,10,14,' Edit record #'+int2str(sel)+' ');
writexy(7,12,7,padrt(lines[sel].from,30,' '));
writexy(7,13,7,padrt(copy(lines[sel].text,1,68),68,' '));
gotoxy(7,12);
from:=input(30,30,11,lines[sel].from);
writexy(7,12,7,padrt(from,30,' '));
gotoxy(7,13);
txt:=input(67,79,11,lines[sel].text);
writexy(7,13,7,padrt(copy(txt,1,68),68,' '));
gotoxy(25,15);
textcolor(3);
ok:=inputyn('Apply changes?: ');
if ok then begin
lines[sel].from:=from;
lines[sel].text:=txt;
changed:=true;
end;
end;
procedure save;
begin
if yesnobox(' Save changes? ') then savelines;
end;
begin
writexypipe(1,24,7,79,'|11E|03:Edit | |11D|03:Delete | |11S|03:Save | '+
'|11C|03:Clear All | |11R|03:Revert | |11ESC|03:Exit | |11H|03:Help');
repeat
listlines;
showsel;
c:=readkey;
if isarrow then begin
case c of
#72 : begin
sel:=sel -1;
if sel < 1 then sel:=1;
end;
#80 : begin
sel:=sel+1;
if sel>10 then sel:=10;
end;
#71 : sel:=1;
#79 : sel:=10;
end;
end else begin
case c of
#13 : begin
end;
#27 : begin
if changed then save;
Done := True;
end;
'c','C': clearall;
'd','D': deleterec
'e','E': editrec;
's','S': save;
'h','H': help;
'r','R': begin
loadoneliner;
changed:=false;
end;
end;
end;
until Done;
end;
begin
dir := cfgsyspath;
oneliner := dir +'data'+pathchar+'oneliner.dat';
textcolor(15);
clrscr;
writexy(1,1,15,cprt);
loadoneliner;
select;
textcolor(7);
clrscr;
end;