INFUSTRN.PAS

9.6 KB 5db8668353e840f6…
{
  Infusion bbs string editor started on (09/01/98) by skaboy of COURSE!
}
Program InfusionStringEditor;
        Uses crt,dos,gentypes,configrt,subs1,gensubs,filelock,
             skashit,little,scrnInpt,scrnUnit,extense;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Const
 sTotalStrings = 260;
{$I ANSIS.SKA}
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Type
 sStringType   = array[1..sTotalStrings] of string[200];
 sDescType     = array[1..sTotalStrings] of string[80];
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Var
 sStringData   : ^sStringType;
 sDescriptData : ^sDescType;
 sStringFile   : string;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sInitMem(init : boolean);
 begin
 if (init=true) then
  begin
  new(sStringData);
  new(sDescriptData);
  fillChar(sStringData^,sizeOf(sStringData^),0);
  fillChar(sDescriptData^,sizeOf(sDescriptData^),0);
  end else
   begin
   dispose(sStringData);
   dispose(sDescriptData);
   end;
 end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sShow(S : String);
 begin
  gotoxy(3,wherey);
  skawrite('|07.,:$½%'' |07'+S);
 end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sShowScreens(scrn : byte);
 begin
 if (scrn=1) then
  begin
  setcolor(7);
  clrscr;
  move(header12,mem[$b800:0000],sizeOf(header12));
  gotoXY(8,9); skaWrite('|07infusion bbs software, offline string editor (c) skaboy101 1998|CR|CR');
  end else
 if (scrn=2) then
  begin
  clrscr;
  move(header12,mem[$b800:0000],sizeOf(header12));
  gotoXY(8,9); skaWrite('|07infusion bbs software, offline string editor (c) skaboy101 1998|CR|CR');
  sShow('error, invalid command line arguments..|CR');
  sShow('usage - '+paramstr(0)+' <langfile.lan>..|CR');
  halt(5);
  end;
 end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sLoadStrings;
var f : text;
    s : string;
    x : word;
 begin
 assign(f,sStringFile);
 reset(f);
 repeat readLn(f,s) until (s[1]='!');
 for x := 1 to sTotalStrings do
  begin
  readLn(f,sDescriptData^[x]);
  sDescriptData^[x] := copy(sDescriptData^[x],3,length(sDescriptData^[x])-2);
  readLn(f,sStringData^[x]);
  end;
 close(f);
 if (x<>sTotalStrings) then
  begin
  clrscr;
  writeLn('error, invalid number of strings in language file .. halting!');
  halt(0);
  end;
 end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sWriteColor(s : string);
  var i    : byte;
      a    : string[2];
      fore : byte;
      back : byte;

     Procedure Set_C(F,B : Byte);
      Begin
        If F > 15
          Then F := 15;
        Fore := F;
        Back := B;
        setcolor(16 * B + F);
      End;

  Begin
    I:=1;
    Fore := 7;
    Back := 0;
    setcolor(7);
    While (I<=Length(S)) and (WhereX<77)
    Do Begin
    If S[ i ] = '$' then Begin
      Case S[i+1] Of
        'a':Set_C(0,Back);
        'b':Set_C(1,Back);
        'g':Set_C(2,Back);
        'c':Set_C(3,Back);
        'r':Set_C(4,Back);
        'p':Set_C(5,Back);
        'y':Set_C(6,Back);
        'w':Set_C(7,Back);
        'A':Set_C(8,Back);
        'B':set_c(9,Back);
        'G':set_c(10,Back);
        'C':set_c(11,Back);
        'R':set_c(12,Back);
        'P':set_c(13,Back);
        'Y':set_c(14,Back);
        'W':set_c(15,Back);
        Else Write('$' + S[i + 1]);
      End;
      Inc(i);
    End Else If S[i] = '|'
    Then Begin
      A := S[i+1] + S[i+2];
      If (A[1] = 'B') And (A[2] in ['0'..'7'])
        Then Set_C(Fore,Valu(A[2])) Else
      If A = 'C1' then Set_C(cfg.DefColor1,0) Else
      If A = 'C2' then Set_C(cfg.DefColor2,0) Else
      If A = 'C3' then Set_C(cfg.DefColor3,0) Else
      If A = 'C4' then Set_C(cfg.DefColor4,0) Else
      If A = 'C5' then Set_C(cfg.DefColor5,0) Else
      If A = 'C6' then Set_C(cfg.DefColor6,0) Else
      If A = 'C6' then Set_C(cfg.DefColor7,0) Else
      If Valu(A) > 0 then Set_C(Valu(A),Back) Else
      Write('|'+A);
      Inc(i,2);
    End
      Else Write(S[i]);
    Inc(i);
   End;
   If i<=Length(S) Then Begin
     setcolor(143);
     Write('>>');
   End;
 End;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function sYesNo(unlit,lit : byte) : boolean;
var X,Y : Byte;
    CH : Char;
    Yes : Boolean;
 Begin
 X := WhereX;
 Y := WhereY;
 asm mov ah,1; mov cx,2000h;Int 10h end; {No Cursor}
 GotoXy(X,Y);
 setColor(lit);Write(' Yes ');
 setColor(unlit);Write(' No ');
 GotoXy(X,Y);
 Yes := True;
 While not (CH in['Y','N',#13,#27]) do
 Begin
  CH := Readkey;If CH = #0 then CH := Readkey;CH := Upcase(CH);
  If CH in[#75,'Y'] then Yes := True;
  If CH in[#77,'N',#27] then Yes := False;
  GotoXy(X,Y);
  If Yes then Begin
               setColor(lit);   Write(' Yes ');
               setColor(unLit); Write(' No ');
              End
         else Begin
               setColor(unlit); Write(' Yes ');
               setColor(lit);   Write(' No ');
              End;
 End;
 setColor(7);
 sYesno := Yes;
 End;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sCheckSave;
var sInKey : char;
    sFile  : text;
    sCount : word;
 begin
 textAttr := 7;
 crt.window(1,11,80,25); setColor(7); crt.clrscr;
 gotoXY(1,11); sShow('would you like to save your changes ');
  if (sYesNo(7,31)=true) then
  begin
  tAssign(sFile,sStringFile);
  tRewrite(sFile);
  writeLn(sFile,'#');
  writeLn(sFile,'# Infusion Bulletin Board System, (c) Grant Passmore (skaboy101) 1998');
  writeLn(sFile,'# Language file generated on '+dateStr(now));
  writeLn(sFile,'#');
  writeLn(sFile,'# Do NOT Remove the following line');
  writeLn(sFile,'!_BEGIN_INFUSION_LANGUAGE_BLOCK_!');
  for sCount := 1 to sTotalStrings do
   begin
   writeLn(sFile,'# '+sDescriptData^[sCount]);
   writeLn(sFile,sStringData^[sCount]);
   end;
  tClose(sFile);
  writeLn;
  sShow('language file updated, must be compiled with INFULANG for usage!|CR|CR');
  end else
   begin
   writeLn;
   sShow('all changes aborted|CR|CR');
   end;
 end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sSelectionProc;
var sTopString : word;
    sBotString : word;
    sInKey     : char;
    sCurrent   : word;
    sLast      : word;
    sDone      : boolean;
    sReprint   : boolean;

    Procedure sShowBars;
    var count : word;
     begin
     if (sReprint=true) then
      begin
      crt.window(1,11,80,25); setColor(7); crt.clrscr;
      for count := sTopString to sBotString do
       begin
       gotoXY(1,13+(count-sTopString)+((count-sTopString-1)*2));
       if (count=(sCurrent*sTopString)) then setcolor(31) else
           setcolor(15);
       writeLn(tab(sDescriptData^[count],78));
       setcolor(7);
       sWriteColor(sStringData^[count]);
       end;
      sReprint := false;
      end else
       begin
       gotoXY(1,10+sLast+((sLast-1)*2));
       setcolor(15); write(tab(sDescriptData^[sLast+sTopString-1],78));
       gotoXY(1,10+sCurrent+((sCurrent-1)*2));
       setcolor(31); write(tab(sDescriptData^[sCurrent+sTopString-1],78));
       end;
      setcolor(7); gotoXY(1,1); write('(',sCurrent+sTopString-1,'/',sTotalStrings,')   ');
      gotoXY(1,2); write('(',(sTopString+4) div 5,'/',sTotalStrings div 5,')   ');
     end;

 begin
 sTopString := 1;
 sBotString := 5;
 sCurrent   := 1;
 sDone      := false;
 sLast      := 1;
 sReprint   := true;
 sShowBars;
  repeat
  repeat sInKey := readKey until (sInKey in [#72,#80,#13,#81,#73,#27]);
   case sInKey of
    #27 : sDone := true;
    #80 : begin
          sLast := sCurrent;
          if (sCurrent<5) then inc(sCurrent) else sCurrent := 1;
          sShowBars;
          end;
    #72 : begin
          sLast := sCurrent;
          if (sCurrent>1) then dec(sCurrent) else sCurrent := 5;
          sShowBars;
          end;
    #81 : begin
          if (sTopString<sTotalStrings-5) then
           begin
           inc(sTopString,5);
           inc(sBotString,5);
           sCurrent := 1;
           sLast := 1;
           sReprint := true;
           sShowBars;
           end;
          end;
    #73 : begin
          if (sTopString<>1) then
           begin
           dec(sTopString,5);
           dec(sBotString,5);
           sCurrent := 1;
           sLast := 1;
           sReprint := true;
           sShowBars;
           end;
          end;
    #13 : begin
          bufLen := 200;
          cursor_on;
          setInputRegion(1,80,10+sCurrent+((sCurrent-1)*2)+1);
          setDefaultInput(sStringData^[sTopString+sCurrent-1]);
          setInputColor(7);
          readLn(sStringData^[sTopString+sCurrent-1]);
          cursor_off;
          gotoXY(1,10+sCurrent+((sCurrent-1)*2)+1); setColor(7); clreol;
          gotoXY(1,10+sCurrent+((sCurrent-1)*2)+1);
          sWriteColor(sStringData^[sTopString+sCurrent-1]);
          end;
   end;
  until (sDone=true);
 sCheckSave;
 end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure sInitProc;
 begin
 sInitMem(true);
 sLoadStrings;
 sShowScreens(1);
 cursor_off;
 sSelectionProc;
 sInitMem(false);
 cursor_on;
 end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
begin
sStringFile := paramStr(1);
if (paramCount<>1) or (exist(sStringFile)=false) then sShowScreens(2);
sInitProc;
end.