Text 78, 676 rader
Skriven 2007-01-05 23:53:10 av Donald Tidmore (1:261/38)
     Kommentar till text 73 av Scott Adams (1:112/91.0)
Ärende: Re: Need help with LordMenu utility
===========================================
> Would've helped to see the code here.  I'll forget to go to the
> URL :).  But doing Ansi isn't that hard.  Have you checked
> out Swag it has a whole section just on Ansi source codes.
> ... "I'm paying off karma at a vastly accelerated rate" - Ivanova.

The program itself is fairly short, so I'll copy it here from the Wordpad
program for you.  http://www.fidotel.com/public/camelot/IGM-Code/lpe-code.zip
archive online has the Chasattr.pas and Chasware.pas files that I used with the
program, and LordLock is the basic unit from DDIGM and DDPLUS.  The basic
problem is that I don't really understand the code -- created by Robert Fogt
over a dozen years ago, -- especially in regards to how it creates the
3rdalt.txt file.  The end-result however will not work in LORD due to the
individual lines going up to 1,000 spaces each. 

Bjorn Felten thinks he can solve the problem by having the program write the
ansi strings to an *.ANS file, and then changing its filename to 3rdalt.txt. I
just don't do ANSI coding very much, so its been difficult to fix the program
myself.  And others who have tried are busy with other projects, or they don't
have a working solution yet.  SO I really appreciate your help guys with the
situation.  Lloyd Hannesson was handling the program but he got tired of BBS's
and LORD stuff, and retired completely from doing both in Fall 2005.  Donald.
===============================================================

PROGRAM lordmenu;           {December 2005 Beta}

USES dos, crt, LordLock, ChasWare;

CONST version = '`%Version `$1.32 Beta';

      Compile_Date: STRING = 'December 04, 2005.';

var flag,miscint, x, y : integer;
         newok : boolean;
         { s: string; }  {disabled 12/04/05}
         datafile : text;
         backup : text;
         menu : text;
         igms : text;
         test : text;
         lordpath : string;
         mych : char;
         saveexit:pointer;
         RIP : boolean;
         igmcount : integer;

         Data_String: STRING[255];  {12/04/05}
         Program_Path: STRING;     {12/04/05: Path info for lordmenu.dat config
 file}
         Party_Path_FN: STRING;        {12/04/05: Path info for 3rdparty.dat}
         Text_File_FN: STRING;     {12/04/05: Path info for ANSI or RIP text fi
le}
         { ====================================================================
=======
===== }


PROCEDURE LWRITE(s: STRING);          {Added 12/04/05 from lordstat.pas}
  VAR f,g,h: STRING;
      Done: BOOLEAN;
      q: BYTE;
BEGIN
  Done:= FALSE;

  IF NOT POS('`',S) > 0 THEN
         BEGIN
      WRITELN(s);
      EXIT;
    END;

  REPEAT
    IF s[POS('`',S)+1] IN ['0','1','2','3','4','5','6','7','8','9','!','@','#',
'$','%'] THEN
      BEGIN
        g:= '';

        FOR Q:= 1 TO POS('`',S)-1 DO
          g:= g + s[q];

        WRITE(G);

        CASE s[POS('`',S)+1] OF
          '1': TextColor(1);       {Color: 1 - Dark Blue}
          '2': TextColor(2);       {Color: 2 - Dark Green}
          '3': TextColor(3);       {Color: 3 - Dark Cyan}
          '4': TextColor(4);       {Color: 4 - Dark Red/Magenta}
          '5': TextColor(5);       {Color: 5 - Dark Violet}
          '6': TextColor(6);       {Color: 6 - Brown}
          '7': TextColor(7);       {Color: 7 - Light Gray}
          '8': TextColor(8);       {Color: 8 - Dark Gray}
          '9': TextColor(9);       {Color: 9 - Light Blue}
          '0': TextColor(10);      {Color: 10 - Light Green}
          '!': TextColor(11);      {color: 11 - Light Cyan}
          '@': TextColor(12);      {Color: 12 - Bright Red}
          '#': TextColor(13);      {Color: 13 - Light Violet}
          '$': TextColor(14);      {color: 14 - Yellow}
          '%': TextColor(15);      {color: 15 - White}
        END;  {CASE}

        f:= '';

        FOR Q:= (POS('`',S)+2) to Length(s) DO
          f:= f + s[q];

        s:= f;
      END;  {IF S[....] - Ending}

  UNTIL POS('`',S) = 0;

  WRITE(s);
END;   { LWrite ====================================== }

  { 11/22/05: Fixed indentation to here. 05:19 pm }


PROCEDURE LWriteLn(s: STRING);    {Added 12/04/05 from lordstat.pas}
  VAR f,g,h: STRING;
                Done: BOOLEAN;
                q: BYTE;
BEGIN
  Done:= FALSE;

  IF NOT POS('`',S) > 0 THEN
         BEGIN
                WRITELN(s);
                EXIT;
         END;

  REPEAT
         IF s[POS('`',S)+1] IN ['0','1','2','3','4','5','6','7','8','9','!','@'
,'#','$
','%'] THEN
                BEGIN
        g:= '';

        FOR Q:= 1 TO POS('`',S)-1 DO
          g:= g + s[q];

        WRITE(G);

        CASE s[POS('`',S)+1] OF
          '1': TextColor(1);
                         '2': TextColor(2);
          '3': TextColor(3);
          '4': TextColor(4);
          '5': TextColor(5);
          '6': TextColor(6);
          '7': TextColor(7);
          '8': TextColor(8);
          '9': TextColor(9);
          '0': TextColor(10);
          '!': TextColor(11);
          '@': TextColor(12);
          '#': TextColor(13);
          '$': TextColor(14);
          '%': TextColor(15);
        END; {CASE}

        f:= '';

        FOR Q:= (POS('`',S)+2) to Length(s) DO
          f:= f + s[q];

        s:= f;
      END;
   UNTIL POS('`',S) = 0;

   WRITELN(s);
END;   {LWriteLn ====================================== }


procedure myexit;
begin
  ExitProc:=Saveexit;

clrscr;

halt(0);
end; {myexit}


function UCase(s:string) : string;
var plz : integer;
         zlp : string;
begin
for plz := 1 to length(s) do zlp[plz]:= upcase(s[plz]); UCase := zlp;
end; {UpCase}


function sgoto_xy(x,y:integer) : string; var
 s,s2: string;
begin
 s:=#27+'[';
 str(y,s2);
 s:=s+s2;
 str(x,s2);
 s:=s+';'+s2+'f';
 sgoto_xy := s;
end; {sgoto_xy}


function lord2ansi(s: string): string; var az : integer;
         bz : char;
         cz : string[255];  {12/04/05: Changed from STRING;  to STRING[255]; DG
T}
begin
 cz:='';
 for az := 1 to length(s) do begin
 if s[az]='`' then begin
 bz:=s[az+1];
  case bz of
  '1' : cz:=cz+'[0;40;34m';
  '2' : cz:=cz+'[0;40;32m';
  '3' : cz:=cz+'[0;40;36m';
  '4' : cz:=cz+'[0;40;31m';
  '5' : cz:=cz+'[0;40;35m';
  '6' : cz:=cz+'[0;40;33m';
  '7' : cz:=cz+'[0;40;37m';
  '8' : cz:=cz+'[1;40;30m';
  '9' : cz:=cz+'[1;40;34m';
  '0' : cz:=cz+'[1;40;32m';
  '!' : cz:=cz+'[1;40;36m';
  '@' : cz:=cz+'[1;40;31m';
  '#' : cz:=cz+'[1;40;35m';
  '$' : cz:=cz+'[1;40;33m';
  '%' : cz:=cz+'[1;40;37m';
end; {case bz}
end; {color}
if (s[az-1]<>'`') and (s[az]<>'`') then cz:=cz+s[az];
 end; {length s}

lord2ansi:=cz;
end; {lord2ansi}


function stripped(t : string) : string; begin
for miscint := 1 to length(t) do if t[miscint] ='`' then delete(t,miscint,2);
stripped := t;
end; {stripped}


Procedure GetNewColor(ch1,ch2 : char;flag:byte;var f,b:byte;var newok:boolean);
var
 sb,c:byte;
begin
  newok:=true;
  case ch2 of
         '1'..'9' : c:=byte(ch2)-48;
         '0': c:=10;
         '!': c:=11;
         '@': c:=12;
         '#': c:=13;
         '$': c:=14;
         '%': c:=15;
         '^': if flag=1 then c:=0;
  else
         NewOk:=false;
  end;

  case ch1 of
         '`' :  if c<>b then f:=c;
         '~' :  begin
                                 sb:=c mod 8;
                                 if sb<>f then
                                        b:=sb;
                          end;
  end;
end;


(*   {replaced by LWrite and LWriteln. 12/04/05}
Procedure SWriteColors;
var
 j,f,b:byte;
 ch1,ch2,c3:char;
 newyes:boolean;
begin
  f:=7;b:=0;
  c3:='~'; if flag=0 then c3:='`';
  if x > 0 then  GotoXy(x,y);
  textcolor(f);textbackground(b);
  for j:=1 to length(Data_String) do
    begin
                ch1:=Data_String[j];
                If (ch1 in ['`',c3]) and (j<length(Data_String)) then
        begin
                         ch2:=Data_String[j+1];
                         GetNewColor(ch1,ch2,flag,f,b,newyes);
                         If newyes then
                          begin
                                 textcolor(f);textbackground(b);
                                 inc(j);
                          end;
                  end
                else
                        write(ch1);
         if wherex >79 then exit;
        end;
  if x=0 then BLANK(1);
end;  { SWriteColors ========================================== }   *)


(*  function fileExists(var s : string) : boolean;   {Replaced by EXIST
function 12/04/05}
begin
  fileExists := fSearch(s, '') <> '';
end;                                          *)


procedure make_menu;
  var xyz, t: string;
begin
  clrscr;
  Party_Path_FN:=lordpath+'3RDPARTY.DAT';

  IF NOT EXIST(Party_Path_FN) then
         begin
                LWriteLn('   `!You need to set the correct path to `@LORD `!bef
ore making the
menu.');
                LWriteLn('   `%-=<`9press a key`%>=-');

                mych:=readkey;
                mych:=#0;

                EXIT;
         end;       {not file exists 3rdparty.dat}

LWriteLn('   `!Writing file now ....');

ASSIGN(test,'LMTEST.TXT');
REWRITE(test);
Party_Path_FN:=lordpath+'3RDPARTY.DAT';

ASSIGN(igms,Party_Path_FN);
reset(igms);

WHILE not eof(igms) do
  begin
         readln(igms,Data_String);
         if (pos(';',Data_String) <> 1) and (Data_String <> '') then
writeln(test,Data_String);
  end;  {not eof(igms)}

CLOSE(igms);
CLOSE(test);


Text_File_FN:= lordpath+'3RDALT.TXT';

IF EXIST(Text_File_FN) then begin
        ASSIGN(backup,lordpath+'3RDALT.BAK');
        REWRITE(backup);
        ASSIGN(menu,Text_File_FN);
        reset(menu);

          WHILE not eof(menu) do begin
                 readln(menu,Data_String);
                 writeln(backup,Data_String);
          end;  {eof(menu)}

        CLOSE(menu);CLOSE(backup);

        BLANK(1);

        LWriteLn('   `!Old menu saved as 3RDALT.BAK');

        BLANK(1);
end; {3rdalt.txt exists}

ASSIGN(menu,Text_File_FN);
REWRITE(menu);

 if RIP then begin
 writeln(menu,'[0;30;40m[2J');
 writeln(menu,'');
 write(menu,'!|1K|*|w0000270L02|1B0Z0E020QOY0209000F080700000F0700000Z|Y0000010
0');
 write(menu,'|1U2T8W00000000<>0<>0|1U3X8W00000000<>1<>1|1U518W00000000<>2<>2');
 write(menu,'|1U658W00000000<>3<>3|1U798W00000000<>4<>4|1U8D8W00000000<>5<>5');
 write(menu,'|1U9H8W00000000<>6<>6|1UAL8W00000000<>7<>7|1UBP8W00000000<>8<>8');
 write(menu,'|1UCT8W00000000<>9<>9|1UDX8W00000000<>0<>0');
 write(menu,'|1B1Y0E020QOY020A000F080700000F0700001Y|1U0Q8W00000000<><enter><>^
M');
 writeln(menu,'|1UF18W00000000<><enter><>^M|#|#|#');
 end; {rip}

write(menu,'[?7h[40m[2J[0;34m°°°°°°°°°°°°°°°°°°°°°°°°°°
[1;46m±[5C±[40mß[46m±[3C±[40mß[46m±[3C±[40mßÜ   [s');
write(menu,'[u[0;34m°°°°°°°°°°°°°°°°°°°°°°°°°°°°°[2;1H±±±±±±±±±±±±±±±±±±±±±±
±±±± [1;46m²[40mÜÜ Ü [46m²[40mÜ[s');
write(menu,'[u[46m²[1C[40mÜ [46m²[40mßÜ Ü [46m²[40mÜß Ü
[0;34m±±±±±±±±±±±±±±±±±±±±±±±±±±±±±[3;1H²²²²²²²²²²²²[s');
write(menu,'[u²²²²²²²²²²²²²² [1;37mChoose your path wisely
[0;34m²²²²²²²²²²²²²²²²²²²²²²²²²²²²²');


x:=3;
y:=4;
igmcount:=0;

ASSIGN(igms,'LMTEST.TXT');
reset(igms);

WHILE not eof(igms) do begin
inc(igmcount);
        if (((igmcount-1) mod 40) = 0) and (igmcount<>1) then begin
        if rip then write(menu,sgoto_xy(1,5)) else write(menu,sgoto_xy(1,2));
        for miscint:=1 to 23 do writeln(menu,'');
        write(menu,'[?7h[40m[2J[0;34m°°°°°°°°°°°°°°°°°°°°°°°°°°
[1;46m±[5C±[40mß[46m±[3C±[40mß[46m±[3C±[40mßÜ   [s');
        write(menu,'[u[0;34m°°°°°°°°°°°°°°°°°°°°°°°°°°°°°[2;1H±±±±±±±±±±±±±±±±±
±±±±
±±±±± [1;46m²[40mÜÜ Ü [46m²[40mÜ[s');
        write(menu,'[u[46m²[1C[40mÜ [46m²[40mßÜ Ü [46m²[40mÜß Ü
[0;34m±±±±±±±±±±±±±±±±±±±±±±±±±±±±±[3;1H²²²²²²²²²²²²[s');
        write(menu,'[u²²²²²²²²²²²²²² [1;37mChoose your path wisely
[0;34m²²²²²²²²²²²²²²²²²²²²²²²²²²²²²');
        x:=3;
        y:=4;
        end;

readln(igms,Data_String);
readln(igms,Data_String);

if ((igmcount mod 2)=0) then x:=42
else
  begin x:=3;  BLANK(1);
  end;

str(igmcount,xyz);
        if (pos('$$$ LORDOPOLY $$$',ucase(stripped(Data_String)))>0)
          then LWriteLn('   `0$$$ `9LORD`%opoly `0$$$')

        else if (pos('LORD COUNTY FAIR:',ucase(stripped(Data_String)))>0)
          then LWriteLn('   `!LORD COUNTY FAIR:')

        else if (pos('SEARCH THE FOREST FOR VIOLET',ucase(stripped(Data_String)
))>0)
          then LWriteLn('   `%Search for `#Violet`2''s `0Cottage');

write(menu,sgoto_xy(x,y)+'[1;40;37m[[1;40;36m'+xyz+'[1;40;37m][40;37m
'+lord2ansi(Data_String));
end;  {eof(igms)}
CLOSE(igms);

writeln(menu,'[0;40;37m');

CLOSE(menu);

ASSIGN(test,'LMTEST.TXT');
{$I-}
erase(test);
{$I+}
x:=0;

BLANK(1);

LWriteLn('   `!Completed `%... `!The `$Other Places `!in `@LORD `!now uses
the');
LWriteLn('   `!menu I created `%...  `!Go play `@LORD `!and check it out.');

BLANK(1);

LWriteLn('   `%-=<`9press a key`%>=-');

mych:=readkey;
mych:=#0;
end; {make_menu}


begin {main program}

  LWriteLn('     `!Loading  `%.....');

  SaveExit:=Exitproc;
  ExitProc:=@myexit;

  Party_Path_FN:='3RDPARTY.DAT';

  IF NOT EXIST(Party_Path_FN) then
         begin
                Program_Path:='LORDMENU.DAT';

                IF NOT EXIST(Program_Path) then
                  begin
                         ASSIGN(datafile, 'LORDMENU.DAT');
                         REWRITE(datafile);
                         CLOSE(datafile);
                  end; {no lordmenu.dat}

ASSIGN(datafile,'LORDMENU.DAT');
reset(datafile);
read(datafile,lordpath);
CLOSE(datafile);

end {no 3rdparty.dat}
else begin
Lordpath := paramstr(0);
delete(lordpath,pos('LORDMENU.EXE',lordpath),12);
end;{3rdparty.dat found}

Party_Path_FN:=lordpath+'3RDPARTY.DAT';
IF NOT EXIST(Party_Path_FN) then lordpath := '`$UNKNOWN!!  `%set this first.';

repeat

clrscr;

LWriteLn('   `!Lord Menu '+version+' `%by `$Donald Tidmore.');
BLANK(1);  {12/04/05}

                         (*  x:=(length(stripped(Data_String)) div 2);
                         y:=2;          {12/04/05: changed 3 to 2.  Y is Line N
umber.}
                         SwriteColors;           *)
                         x:=5;
                         y:=4;          {12/04/05: Changed Y from 5 to 4.}

LWriteLn('   `0Lord Menu `!creates an alternate menu that is displayed by ');
LWriteLn('   `@LORD `!when a player enters `!Other Places `0from the main
menu.');

BLANK(1);
LWriteLn('   `!You must have the game of `@LORD `!version 3.50 or higher ');
LWriteLn('   `!installed on your system.');

BLANK(1);
LWriteLn('   `!You must run this program every time you add or remove an
IGM.');
LWriteLn('   `!Or when you change IGM entry lines inside the 3rdparty.dat
file.');

BLANK(1);
LWriteLn('     `@[`$1`@] `0LORD Path:  `$'+LordPath);
LWriteLn('     `#Note:  `%Change the LORD Path if it is not correct.');

LWriteLn('     `@[`$2`@] `0Create Menu `!with RIP support');
LWriteLn('     `@[`$3`@] `0Create Menu `!without RIP support');
LWriteLn('     `@[`$4`@] `0Uninstall LORD Menu.');
LWriteLn('     `@[`$5`@] `0Quit');

BLANK(1);
LWriteLn('  `!Option 2 is the preferred menu. `0Only use option 3 if you hate
RIP');

BLANK(1);
LWriteLn('  `!Enter 1,2,3,4,5 or Q `%(for Quit) `0-=> `$ ');

mych:=readkey;
mych:=upcase(mych);

IF Mych = 'Q' THEN Mych:= '5';  {12/04/05}

          case mych of
                        '1'   :   begin
                                                 clrscr;x:=0;

                                                 gotoxy(1,5);
                                                 LWriteLn('   `!Enter the path 
to your `!LORD directory');

                                                 readln(lordpath);
                                                 if not (lordpath[length(lordpa
th)]='\') then lordpath:=lordpath+'\';

                                                 Party_Path_FN:= lordpath+'3RDP
ARTY.DAT';

                                                 IF NOT EXIST(Party_Path_FN) th
en begin
                                                 BLANK(1);
                                                 LWriteLn('   `!ERROR!!  Could 
not find 3rdparty.dat, incorrect path');

                                                 BLANK(1);

                                                 LWriteLn('   `%-=<`9press a ke
y`%>=-');

                                                 mych:=readkey;
                                                 mych:=#0;
                                                 lordpath := '`$UNKNOWN!!  `%se
t this first.';
                                                 end;{not fileexists}
                                                 end; {1}

                         '2'  :   begin
                                                 RIP:=TRUE;
                                                 make_menu;
                                                 end; {2}

                         '3'  :   begin
                                                 RIP:=FALSE;
                                                 make_menu;
                                                 end; {3}

                         '4'  :   begin
                                                 x:=0;
                                                 clrscr;

                                                 BLANK(1);
                                                 Text_File_FN:=lordpath+'3RDALT
.TXT';

                                                         IF EXIST(Text_File_FN)
 then begin
                                                         ASSIGN(menu,Text_File_
FN);
                                                         {$I-}
                                                         erase(menu);
                                                         {$I+}
                                                                if ioresult <> 
0 then begin
                                                                LWriteLn('   `!
ERROR Could not delete 3rdalt.txt, you must delete the file from DOS.');

                                                                end {ioresult <
>0}
                                                                else begin LWri
teLn('   `!Successful...3rdalt.txt deleted... LORD is
back to normal.');

                                                                end;

                                                         BLANK(1);
                                                         LWriteLn('   `%-=<`9pr
ess a key`%>=-');

                                                         mych:=readkey;
                                                         mych:=#0;
                                                         end {file 3rdalt.txt e
xists}
                                                         else begin

                                                         LWriteLn('   `!Could n
ot find 3rdalt.txt!!!!');

                                                         BLANK(1);

                                                         LWriteLn('   `!Either 
LORD menu has not been installed, or the Path is incorrect.');

                                                         BLANK(1);
                                                         LWriteLn('   `%-=<`9pr
ess a key`%>=-');


                                                         mych:=readkey;
                                                         mych:=#0;
                                                         end; {3rdalt.txt does 
not exist}
                                                 end; {4}

                         '5'  :   begin
                                                 Party_Path_FN:= '3RDPARTY.DAT'
;

                                                 IF NOT EXIST(Party_Path_FN) th
en begin
                                                 ASSIGN(datafile, 'LORDMENU.DAT
');
                                                 REWRITE(datafile);
                                                 write(datafile,lordpath);
                                                 CLOSE(datafile);
                                                 halt(0);
                                                 end; {no 3rdparty.dat}
                                                 halt(0);
                                                 end; {5}
          end; {case}
until ((mych='Q') and (mych='R'));

end.  {main program}


--- BBBS/LiI v4.01 Flag-5
 * Origin: Prism bbs (1:261/38)