U_MIO.PAS

{$O+}
unit u_mio;

interface

uses crt2,u_fonts,u_adv,u_help;

const barcolor:byte=4;   
      blankspace='                                '; 

procedure macroeditmenu;
	  
procedure execeditmenu;	  
	  
function macrolistheader(var f:text):boolean;

function macroreadlin(xat,yat:integer;maxchars,typeofchars:byte;strdefault:string):string;


implementation

procedure macroeditmenu;
begin
  say(4,14,4,' MACRO EDITOR ');
  say(5,27,1,'PRESS [F1] FOR HELP');
  say(5,37,5,' M Û0: EDIT MACRO');
  say(5,47,5,' E Û0: EDIT EXEC TABLE');
  say(5,67,5,' X Û0: EXPORT MACROS.TXT');
  {say(5,77,5,' D Û0: DEFRAG/REPAIR MACRO FILE');}
  say(5,97,5,'F10Û0: QUIT');
end;

procedure execeditmenu;	
begin
       say(1,1,6,' EXEC FILE EDITOR ');

      say(3,20,1,'FILE INFO');
      say(4,30,5,' F Û0: FILENAME:');  {33}
      say(4,40,5,' P Û0: PARAMETER:');  {35}
      say(3,55,1,'GRAPHICS SETUP');
      say(4,65,5,' I Û0: IN:');    {22}
      say(4,75,5,' O Û0: OUT:');    {24}
      say(3,90,1,'PROGRAM INFO');
     say(4,100,5,' S Û0: SWAP MEMORY:'); {39}
   {  if exc.c1=0 then say(4,110,5,' R Û0: RUN FROM ROOT:') else say(4,110,0,'                          '); }
     say(4,125,5,' C Û0OMMENT:'); {33}
      say(3,140,5,'ESCÛ0 TO EXIT');
end;



function macrolistheader;

begin
  assign(f,'MACROS.TXT');
 {$I-} rewrite(f); {$I+}
 if IOresult=0 then begin
 
   writeln(f,'This file is an export of the contents of all macros and exec table entries.');
   writeln(f,'DO NOT EDIT THIS FILE, it is just for reference.');


   writeln(f,' ');
   writeln(f,'Macro list:');
   writeln(f,' ');
 
 end else macrolistheader:=false;
end; 


function macroreadlin;


type setos=set of char;
     setosa=array[0..2] of setos;
{0: any chars, 1: number only, 2: filename chars}

const allowedchars:setosa=( [#32..#126] , ['1'..'9','0'] ,
   ['A'..'Z','-','!','&','1'..'9','0','_'] );

var cp:byte;
    inkey:char;
    s:string;
    showstr:string;
    blankstr:string;
    insmode,done:boolean;
    c:byte;
    lengths:byte;

begin
hidemouse;
pausemouse:=true;
blankstr:='';
for cp:=1 to maxchars do blankstr:=concat(blankstr,' ');
if length(strdefault)>(maxchars-1) then strdefault:=copy(strdefault,1,(maxchars-1));
s:=strdefault+' ';
cp:=length(s);
insmode:=true;
done:=false;
repeat
if ord(s[0])>maxchars then s[0]:=chr(maxchars);

showstr:=blankstr;
move(s[1],showstr[1],length(s));
say(xat,yat,barcolor,showstr+'Û0 ');

say(xat+( (cp-1)*2 ),yat,6,' ');

inkey:=upcase(readkey);
case inkey of
 #32..#126:if (inkey in allowedchars[typeofchars]) then
          if length(s)<=maxchars then
            begin {string can grow}
              if cp<=maxchars then
              begin
                if insmode then s:=concat(s,s[length(s)]);
                if insmode then move(s[cp],s[cp+1],length(s)-cp);
                s[cp]:=inkey;inc(cp);
               end;
            end
           else
           begin {string can NOT grow}
             if cp<length(s) then
              begin
                if insmode then move(s[cp],s[cp+1],length(s)-cp+1);
                s[cp]:=inkey;inc(cp);
              end;

            end;
    #8:if cp>1 then begin;dec(cp);
       move(s[cp+1],s[cp],length(s)-cp);dec(s[0]);end;
	#127:begin;cp:=1;s:='';end;   
    #0:case readkey of
        #59:help;
        #75:if cp>1 then dec(cp);
        #77:if cp<length(s) then inc(cp) else
          if length(s)<maxchars then begin;inc(cp);s:=concat(s,' ');end;
        {#82:if insmode=true then insmode:=false else insmode:=true;}
        #83:if cp<=length(s) then
        begin;move(s[cp+1],s[cp],length(s)-cp);dec(s[0]);end;
       end; {0case}
     #13:done:=true;
     #27:begin;s:=strdefault;done:=true;end;
     end; {case}
until done;
macroreadlin:=s;
pausemouse:=false;
showmouse;
end;



begin
end.