home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TSCRIPT4.ZIP / TSCRIPT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  34.6 KB  |  1,182 lines
  1. Program TurboScript;
  2. {
  3. *****************************************************************************
  4. *                                                                           *
  5. *                  Turbo Script   ---  Version 4.0                          *
  6. *                                                                           *
  7. *                         By Kevin Menningen                                *
  8. *                                                                           *
  9. *        Copyright (c) 1985 by Kevin Menningen.   All Rights Reserved.      *
  10. *                                                                           *
  11. *             Special thanks to Tim Conner for his contributions.           *
  12. *                                                                           *
  13. *  If you like this program, or even if you don't, please send me either    *
  14. *  regular or electronic mail so I know you're out there. If you REALLY     *
  15. *  like it, then a contribution as big as $1 will be GREATLY appreciated.   *
  16. *  With the high cost of software these days, it would be a good idea to    *
  17. *  support ALL public domain programmers to keep them off the streets! Send *
  18. *  mail to:                                                                 *
  19. *                                                                           *
  20. *                            Kevin Menningen                                *
  21. *                            2051 S. 95th Street                            *
  22. *                            West Allis, WI  53227                          *
  23. *                                                                           *
  24. *                       BBS: Exec-PC BBS (414) 964-5160                     *
  25. *****************************************************************************
  26. }
  27.  
  28. {$C-,V-,K-}
  29. type
  30.     TempString = string[80];
  31. var
  32.     Words : array[1..500] of TempString;
  33.     Buffer : array[0..1325] of integer;
  34.     Row, Column, i, MaxRow, ScreenRow, Temp1, Temp2, Temp3, Keynum, Num, code,
  35.     EndColumn, Index, NumEnd, Inum, Hour, Min, Sec : integer;
  36.     Inkey, SecInkey, Choice, ch, Drive : char;
  37.     Tabset : array[1..80] of boolean;
  38.     TextFile : Text;
  39.     TempWord, Glossary, DirString, Path, FileName, Oops : TempString;
  40.     Secnum, Insertmode, Exit, Dir, Capsmode, pm : boolean;
  41.     dosrec : record
  42.                ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  43.              end;
  44.  
  45. {$I TSCRIPT2.PAS}
  46.  
  47. procedure DirGet  (Func, Asciiz : TempString; var FileName : TempString;
  48.                    var Error : Integer; Option : Integer);
  49. var
  50.    OurDTA : array [ 1..43 ] of byte;    { Data Transfer Area buffer }
  51.    CurDTAseg,                           { DTA segment before execution }
  52.    CurDTAofs,                           { DTA offset    "        "     }
  53.    OurDTAseg,                           { DTA segment and offset set after }
  54.    OurDTAofs          : integer;        { start of program }
  55.  
  56. begin
  57.     error := 0;
  58.     If Func = 'FIRST' then begin
  59.        Error := 0; {---------- Initialization processes ------------}
  60.        For I := 1 to 43 do OurDTA[I]:=0;        {Initialize our DTA Buffer}
  61.        dosrec.ax := $2F00;                      { Save Current DTA pointer}
  62.        Intr($21,dosrec);                        { to be restored later    }
  63.        CurDTASeg := dosrec.es;
  64.        CurDTAOfs := dosrec.bx;
  65.        error := dosrec.ax and $FF;
  66.        if error = 0 then begin
  67.           OurDTAseg := seg(OurDTA);           {Point DOS to our        }
  68.           OurDTAofs := ofs(OurDTA);           {DTA Buffer              }
  69.           dosrec.ax := $1A00;
  70.           dosrec.ds := OurDTASeg;
  71.           dosrec.dx := OurDTAOfs;
  72.           Intr($21,dosrec);
  73.           error := dosrec.ax and $FF;
  74.        end;
  75.        asciiz[length(asciiz)+1]:=chr(0); { Terminate name with hex00 }
  76.        dosrec.ax := $4E00;          { Get first directory entry }
  77.        dosrec.ds := seg(Asciiz);    { Point to the file mask }
  78.        dosrec.dx := ofs(Asciiz);
  79.        dosrec.dx := dosrec.dx + 1;    { Point past string's length byte }
  80.        dosrec.cx := Option;
  81.        end
  82.     else
  83.        dosrec.ax := $4F00;          {Get next directory entry}
  84.     Intr($21,dosrec);               { Execute MSDos call }
  85.     error := dosrec.ax and $FF;     { Get error return }
  86.     I := 1;
  87.     If error = 0 then
  88.     Repeat                        { Get name from the DTA area }
  89.         FileName[I]:=chr(mem[OurDTASeg:OurDTAOfs + 29 + I]);
  90.         I := I + 1;
  91.     Until (not (FileName[I - 1] in [' '..'~']));
  92.     FileName[0]:=chr(I-1)         { set string length because assigning }
  93.                                   { by element does not set length }
  94. end;
  95.  
  96. procedure PrintDir;
  97. var err,place : integer;
  98.     firstname, nextnames, SearchString : TempString;
  99.  
  100. Begin
  101.    ClrScr;
  102.    DirGet('FIRST','????????.???'+chr(0),FIRSTNAME,err,8);
  103.    SearchString := Drive + ':' + Path + DirString + chr(0);
  104.    Writeln('Directory of ',SearchString,' Volume name is ',FIRSTNAME);
  105.    Writeln;
  106.    DirGet('FIRST',SearchString,Firstname,err,3);
  107.    write(Firstname);
  108.    place := 17;
  109.    repeat
  110.        if Place > 45 then begin
  111.           Writeln;
  112.           Place := 1;
  113.        end;
  114.        GotoXY(Place, WhereY);
  115.        DirGet('NEXT',SearchString,Nextnames,err,3);
  116.        Write(Nextnames);
  117.        Place := Place + 16;
  118.    until err<>0;
  119.    dosrec.ax := $3600;
  120.    dosrec.dx := 0;
  121.    Intr($21, dosrec);
  122.    Writeln;
  123.    writeln('>>>  ',dosrec.bx,'k bytes free',chr(13),chr(10));
  124.    if Inum = 3333 then begin
  125.       writeln('Press any key to continue...');
  126.       read(Kbd, Choice);
  127.    end;
  128. end;
  129.  
  130. function Exist(Name : TempString) : boolean;
  131. begin
  132.    Assign(TextFile, Name);
  133.    {$I-}
  134.    Reset(TextFile);
  135.    {$I+}
  136.    Exist := (IOresult = 0);
  137. end;
  138.  
  139. procedure Warning;
  140. begin
  141.    ClrScr;
  142.    Writeln(chr(7),'<<<<<<<<<<>>>>>>>>>>  ');
  143.    writeln('That file already');
  144.    writeln('    exists.');
  145.    writeln;
  146.    writeln('Replace it (Y/N)?');
  147.    writeln;
  148.    writeln('<<<<<<<<<<>>>>>>>>>>');
  149.    GotoXY(19,6);
  150.    Read(Kbd, Choice);
  151.    GotoXY(19,6);
  152.    write(Choice);
  153.    if (Choice = 'n') or (Choice = 'N') then Exit := true;
  154. end;
  155.  
  156. overlay procedure Savefile;
  157. begin
  158.    Temp1 := Column;
  159.    Dir := false;
  160.    CommandWindow('     Save File',28,6,52,18);
  161.    GotoXY(1,5);
  162.    writeln('Enter File Name:');
  163.    Data_In(8, Filename);
  164.    if Dir = True then begin
  165.       Exit := false;
  166.       Fill_Buffer('O',28,6,52,18);
  167.       Fill_Buffer('I',2,3,78,19);
  168.       CommandWindow(' ',2,3,52,19);
  169.       PrintDir;
  170.       CommandWindow('     Save File',54,6,78,18);
  171.       GotoXY(1,5);
  172.       Writeln('Enter File Name:');
  173.       Data_In(8, Filename);
  174.    end;
  175.    if Exit = false then begin
  176.       if Exist(FileName) = true then Warning;
  177.       if Exit = false then begin
  178.          Rewrite(TextFile);
  179.          for i := 1 to MaxRow do begin
  180.             FuncEnd;
  181.             Writeln(TextFile, Copy(Words[i],1,Column));
  182.          end;
  183.          Close(TextFile);
  184.       end;
  185.    end;
  186.    if Dir=false then Fill_Buffer('O',28,6,52,18) else Fill_Buffer('O',2,3,78,19);
  187.    Column := Temp1;
  188. end;
  189.  
  190. overlay procedure Loadfile(Title : TempString; Start : integer);
  191. begin
  192.    Dir := false;
  193.    Temp1 := 3333;
  194.    Temp2 := Row;
  195.    CommandWindow('     '+Title+' File',28,6,52,18);
  196.    GotoXY(1,5);
  197.    Writeln('Enter File Name:');
  198.    Data_In(8, Filename);
  199.    if Dir = True then begin
  200.       Exit := false;
  201.       Fill_Buffer('O',28,6,52,18);
  202.       Fill_Buffer('I',2,3,78,19);
  203.       CommandWindow(' ',2,3,52,19);
  204.       PrintDir;
  205.       CommandWindow('     '+Title+' File',54,6,78,18);
  206.       GotoXY(1,5);
  207.       Writeln('Enter File Name:');
  208.       Data_In(8, Filename);
  209.    end;
  210.    if Exit = false then if Exist(FileName)=true then begin
  211.       if Title='Load' then ClearScreen;
  212.       if Exit = false then begin
  213.          Row := Start;
  214.          While EOF(Textfile) = false do begin
  215.             if Title = 'Merge' then InsertLine;
  216.             Readln(TextFile, Words[Row]);
  217.             if Length(Words[Row]) < 79 then Words[Row] := Words[Row] +
  218.                Replicate(79-Length(Words[Row]),32);
  219.             if Length(Words[Row]) >= 80 then Words[Row] := Copy(Words[Row], 1, 79);
  220.             if Title = 'Load' then MaxRow := MaxRow + 1;
  221.             Row := Row + 1;
  222.          end;
  223.          Temp1 := 1;
  224.          Close(TextFile);
  225.          Window(1,2,80,23);
  226.          ClrScr;
  227.          GotoXY(1,1);
  228.          if Title = 'Load' then begin
  229.             PrintWords(1);
  230.             Row := 1;
  231.          end else begin
  232.             Row := Temp2;
  233.             PrintWords(Row-ScreenRow+1);
  234.          end;
  235.          Oops := Words[Row];
  236.       end;
  237.    end
  238.    else if Exit = False then begin
  239.       ClrScr;
  240.       writeln(chr(7));
  241.       writeln('File does not exist');
  242.       Delay(1000);
  243.       Exit := true;
  244.       Row := Temp2;
  245.    end;
  246.    if Exit = true then begin
  247.       if Dir=false then Fill_Buffer('O',28,6,52,18) else Fill_Buffer('O',2,3,78,19);
  248.    end;
  249. end;
  250.  
  251. overlay procedure PrintFile;
  252. var Linespaces,RowNum,j,LineNum,Page : integer;
  253.     UnderMode, ItalicMode, BoldMode, PageNums : boolean;
  254.     Typeset : TempString;
  255.  
  256. procedure SetMargins;
  257. var  LeftMarg, RightMarg : integer;
  258.  
  259. begin
  260.    Menu('Select Top Margin:',' 1"',' 1 1/2"',' 2"',' 2 1/2"',' None');
  261.    if Num in [1..4] then begin
  262.       Temp1 := (Num + 1)*3;
  263.       ClrScr;
  264.       writeln('Set Horizontal       Margins (Y/N)');
  265.       read(Kbd, Choice);
  266.       if (Choice = 'Y') or (Choice = 'y') then begin
  267.           writeln;
  268.           writeln('Enter Left margin:');
  269.           Read(LeftMarg);
  270.           writeln;
  271.           writeln('Enter Right margin:');
  272.           Read(RightMarg);
  273.           Typeset := Typeset + chr(27) + chr(77) + chr(LeftMarg) +
  274.                                chr(27) + chr(81) + chr(RightMarg);
  275.       end;
  276.    end else Temp1 := 1;
  277. end;
  278.  
  279. procedure PrintTitle;
  280. var Titlename : TempString;
  281.     Spacing : integer;
  282.  
  283. begin
  284.   Dir := true;
  285.   CommandWindow('        Title',28,6,52,18);
  286.   Dir := false;
  287.   GotoXY(1,5);
  288.   writeln('Enter title:');
  289.   read(Titlename);
  290.   Write(Lst, chr(27), chr(71), chr(27), chr(69), chr(27), chr(14));
  291.   Spacing := 20 - Length(Titlename) div 2;
  292.   Spacing := Spacing + Length(Titlename);
  293.   writeln(Lst, Titlename : Spacing);
  294.   writeln(Lst, chr(27), chr(64), Typeset);
  295.   ClrScr;
  296.   GotoXY(1,3);
  297.   TextColor(White + Blink);
  298.   writeln('Printing...');
  299.   TextColor(White);
  300.   writeln;
  301.   writeln('<< Press any key >>');
  302.   writeln('<< to abort.     >>');
  303. end;
  304.  
  305. procedure Script(Style : integer);
  306. begin
  307.    Write(Lst, chr(27), chr(83), chr(Style));
  308.    Index := Index + 1;
  309.    repeat
  310.       Write(Lst, TempWord[Index]);
  311.       Index := Index + 1;
  312.    until not(TempWord[Index] in ['0'..'9','-']) = true;
  313.    write(Lst, chr(27), chr(84), TempWord[Index]);
  314. end;
  315.  
  316. procedure Fonts(var Mode : boolean; Num : integer);
  317. begin
  318.    Mode := Not Mode;
  319.    if Num = 45 then begin
  320.       if Mode = true then Write(Lst, chr(27),chr(Num),chr(1)) else
  321.         Write(Lst, chr(27), chr(Num), chr(0));
  322.    end else if Mode = true then Write(Lst, chr(27), chr(Num)) else
  323.         Write(Lst, chr(27), chr(Num+1));
  324. end;
  325.  
  326.  
  327. begin  { Print File }
  328.    UnderMode := false;
  329.    Italicmode := false;
  330.    Boldmode := false;
  331.    PageNums := false;
  332.    Temp2 := Column;
  333.    CommandWindow('     Print file',28,6,52,18);
  334.    Typeset := chr(27)+chr(64);
  335.    GotoXY(1,7);
  336.    writeln('Press any key...');
  337.    repeat until KeyPressed;
  338.    repeat
  339.       Menu('Choose print style:', ' Elite', ' Boldface', ' Italic', ' Compressed', ' Continue');
  340.       Case Num of
  341.           1 : Typeset := Concat(Typeset,chr(27),chr(66),chr(2),
  342.                                 chr(27),chr(77),chr(11));
  343.           2 : Typeset := Concat(Typeset,chr(27),chr(71));
  344.           3 : Typeset := Concat(Typeset,chr(27),chr(52));
  345.           4 : Typeset := Concat(Typeset,chr(15),chr(27),chr(77),chr(32));
  346.           5 :;
  347.         else
  348.           if Exit = false then write(chr(7));
  349.         end;
  350.       if Num in [1..4] then begin
  351.          Sound(300);
  352.          Delay(50);
  353.          NoSound;
  354.          write(' Done.');
  355.          Delay(300);
  356.       end;
  357.    until (Num = 5) or (Exit = true);
  358.    if Exit = false then begin
  359.       SetMargins;
  360.       ClrScr;
  361.       writeln('Set line spacing:');
  362.       writeln;
  363.       writeln('1.  Single');
  364.       writeln('2.  Double');
  365.       writeln('3.  Triple');
  366.       writeln;
  367.       read(Kbd, Choice);
  368.       Val(Choice, Num, code);
  369.       if (Num in [1..3]) and (code = 0) then Linespaces := Num;
  370.       writeln;
  371.       Write('Do you want Page     Numbers? (Y/N): ');
  372.       read(Kbd, Choice);
  373.       if (Choice = 'Y') or (Choice = 'y') then PageNums := true;
  374.       While KeyPressed do Read(Kbd,Choice);
  375.       ClrScr;
  376.       Writeln('Scroll paper to perf');
  377.       Writeln('and press any key to');
  378.       writeln('print, or Esc to');
  379.       writeln('exit');
  380.       read(Kbd, Choice);
  381.       if ord(Choice) <> 27 then begin
  382.          ClrScr;
  383.          GotoXY(1,3);
  384.          TextColor(White + Blink);
  385.          writeln('Printing...');
  386.          TextColor(White);
  387.          writeln;
  388.          writeln('<< Press any key >>');
  389.          writeln('<< to abort.     >>');
  390.          writeln(Lst, Typeset);
  391.          RowNum:= 0;
  392.          LineNum := 0;
  393.          Page := 1;
  394.          for j := 1 to Temp1 do write(Lst,chr(10));
  395.          While (not KeyPressed) and (RowNum < MaxRow + 1) do begin
  396.             TempWord := Replicate(EndColumn,32);
  397.             RowNum := RowNum + 1;
  398.             LineNum := LineNum + LineSpaces;
  399.             if Copy(Words[RowNum],1,5) = 'Title' then PrintTitle
  400.             else begin
  401.                if Words[RowNum] <> TempWord then begin
  402.                   i := RowNum;
  403.                   FuncEnd;
  404.                   TempWord := Copy(Words[RowNum],1,Column);
  405.                   Index := 0;
  406.                   repeat
  407.                      Index := Index + 1;
  408.                      case TempWord[Index] of
  409.                         '\' : Fonts(UnderMode,45);
  410.                         '~' : Script(0);
  411.                         '|' : Script(1);
  412.                         '√' : Fonts(ItalicMode,52);
  413.                         '■' : Fonts(BoldMode,71);
  414.                      else Write(Lst, TempWord[Index]);
  415.                      end;
  416.                   until Index >= Length(TempWord);
  417.                   Write(Lst, chr(13));
  418.                end;
  419.                for j := 1 to Linespaces do write(Lst, chr(10));
  420.             end;
  421.             if (LineNum = (66-Temp1*2)) and (Temp1 > 2) then begin
  422.                LineNum := 0;
  423.                Page := Page + 1;
  424.                for j := 1 to Temp1 do write(Lst, chr(10));
  425.                if PageNums then begin
  426.                   write(Lst, chr(10),chr(10),Replicate(73,32),'Page ',Page);
  427.                   for j := 1 to Temp1-2 do write(Lst, chr(10));
  428.                end else for j := 1 to Temp1 do write(Lst, chr(10));
  429.             end;
  430.          end;
  431.          if KeyPressed then Read(Kbd, Choice);
  432.       end;
  433.    end;
  434.    Column := Temp2;
  435.    GotoXY(1,3);
  436.    Writeln('            ');
  437.    Fill_Buffer('O',28,6,52,18);
  438. end;
  439.  
  440. overlay procedure Menu_S_R;
  441.  
  442. procedure Search;
  443. var SearchString, Temp : TempString;
  444.     Pointer, Position, Line, Len : integer;
  445.  
  446. begin
  447.    Line := 2;
  448.    SearchString := '';
  449.    CommandWindow('       Search',28,6,52,18);
  450.    GotoXY(1, 5);
  451.    writeln('Enter String: ');
  452.    writeln;
  453.    write('? ');
  454.    read(SearchString);
  455.    Len := Length(SearchString);
  456.    Window(1,2,80,23);
  457.    ClrScr;
  458.    for i := 1 to MaxRow do begin
  459.       Pointer := Pos(SearchString, Words[i]);
  460.       if (Exit = false) and (Pointer > 0) then begin
  461.          Temp := Words[i];
  462.          Position := Pointer;
  463.          GotoXY(1, Line);
  464.          LowVideo;
  465.          write(Temp);
  466.          NormVideo;
  467.          While Pointer > 0 do begin
  468.             GotoXY(Position, Line);
  469.             write(Copy(Temp, Pointer, Len));
  470.             Temp := Copy(Temp, Pointer + Len + 1,
  471.                          80 - Pointer + Len + 1);
  472.             Pointer := Pos(SearchString, Temp);
  473.             Position := Position + Pointer + Len;
  474.          end;
  475.          writeln;
  476.          Line := Line + 1;
  477.          if Line = 20 then begin
  478.             GotoXY(1, 22);
  479.             write('Press any key to continue or Esc to exit ...');
  480.             read(Kbd, Choice);
  481.             if ord(Choice) = 27 then Exit := true else begin
  482.                ClrScr;
  483.                line := 2;
  484.             end;
  485.          end;
  486.          if line > 2 then begin
  487.             read(Kbd, Choice);
  488.             if ord(Choice) = 27 then Exit := true;
  489.          end;
  490.       end;
  491.    end;
  492.    writeln(chr(13),chr(10),chr(10));
  493.    writeln('End of search');
  494.    Read(Kbd, Choice);
  495. end;
  496.  
  497. procedure Replace;
  498. var SearchString, Replacement : TempString;
  499.     Pointer, Line, Len, Position : integer;
  500.  
  501. begin
  502.    Line := 2;
  503.    SearchString := '';
  504.    Replacement := '';
  505.    CommandWindow('      Replace',28,6,52,18);
  506.    GotoXY(1, 5);
  507.    writeln('Enter String: ');
  508.    writeln;
  509.    write('? ');
  510.    read( SearchString);
  511.    writeln;
  512.    writeln('Enter Replacement:');
  513.    writeln;
  514.    write('? ');
  515.    read( Replacement);
  516.    Len := Length(Replacement);
  517.    Window(1,2,80,23);
  518.    ClrScr;
  519.    for i := 1 to MaxRow do begin
  520.       Pointer := Pos(SearchString, Words[i]);
  521.       Position := Pointer;
  522.       if (Pointer > 0) and (Exit = false) then begin
  523.          TempWord := Words[i];
  524.          repeat
  525.             GotoXY(1, Line);
  526.             LowVideo;
  527.             write(Words[i]);
  528.             NormVideo;
  529.             GotoXY(Position, Line);
  530.             write(Copy(Words[i], Position, Length(SearchString)));
  531.             GotoXY(1,22);
  532.             write('Replace Y/N');
  533.             read(Kbd, Choice);
  534.             if ord(Choice) = 27 then Exit := true else if (Choice = 'Y') or
  535.             (Choice = 'y') then begin
  536.                Words[i] := Copy(Words[i],1,Position-1) + Replacement +
  537.                            Copy(Words[i], Position + Length(SearchString), 79-Len+1);
  538.                GotoXY(Position, Line);
  539.                Write(Copy(Words[i], Position, Len));
  540.             end
  541.             else begin
  542.                GotoXY(80, Line);
  543.                write('N');
  544.             end;
  545.             TempWord := Copy(Words[i], Position+Len+1, 79-Position+Len+1);
  546.             Pointer := Pos(SearchString, TempWord);
  547.             Position := Position + Pointer + Len;
  548.          until Pointer = 0;
  549.          Line := Line + 1;
  550.          if Line = 20 then begin
  551.             writeln('Press any key to continue or Esc to exit ...');
  552.             read(Kbd, Choice);
  553.             if ord(Choice) = 27 then Exit := true else begin
  554.                ClrScr;
  555.                line := 2;
  556.             end;
  557.          end;
  558.       end;
  559.    end;
  560.    writeln;
  561.    write('End of replace');
  562.    Read(Kbd, Choice);
  563. end;
  564.  
  565. begin  {Menu_S_R}
  566.    CommandWindow('  Search / Replace',28,6,52,18);
  567.    Exit := false;
  568.    GotoXY(1,5);
  569.    Writeln('Enter Choice: ');
  570.    writeln;
  571.    writeln('1.  Search');
  572.    writeln('2.  Replace');
  573.    writeln;
  574.    write('? ');
  575.    GotoXY(1,10);
  576.    write('Press Esc to exit');
  577.    read(Kbd, Choice);
  578.    if ord(Choice) = 27 then Exit := true else Val(Choice, Num, code);
  579.    if (Exit = false) and (Num in [1,2]) then
  580.       case Num of
  581.          1 : Search;
  582.          2 : Replace;
  583.         end
  584.       else begin
  585.          if Exit = false then write(chr(7));
  586.          Fill_Buffer('O',28,6,52,18);
  587.          Exit := true;
  588.       end;
  589.    ClrScr;
  590.    GotoXY(1,1);
  591.    PrintWords(Row-ScreenRow+1);
  592. end;
  593.  
  594. overlay procedure DosMenu;
  595. var CNum : integer;
  596.  
  597. procedure DelFile;
  598. begin
  599.   ClrScr;
  600.   Dir := false;
  601.   writeln('Enter file to Delete:');
  602.   Data_In(4, FileName);
  603.   if Dir = True then begin
  604.       Exit := false;
  605.       Fill_Buffer('O',28,6,52,18);
  606.       Fill_Buffer('I',2,3,78,19);
  607.       CommandWindow(' ',2,3,52,19);
  608.       PrintDir;
  609.       CommandWindow(' ',54,6,78,18);
  610.       Writeln('Enter File Name:');
  611.       Data_In(4, Filename);
  612.   end;
  613.   if (Exist(FileName) = true) and (Exit=false) then begin
  614.      Erase(Textfile);
  615.      GotoXY(1,6);
  616.      writeln('File deleted');
  617.      Delay(1000);
  618.   end
  619.    else begin
  620.       GotoXY(1,6);
  621.       if Exit=false then writeln(chr(7),'File does not exist');
  622.       Delay(1000);
  623.    end;
  624. end;
  625.  
  626. procedure RenFile;
  627. var OldName, NewName : TempString;
  628.  
  629. begin
  630.    ClrScr;
  631.    Writeln('Enter old file name:');
  632.    Data_In(4, OldName);
  633.    if Dir = True then begin
  634.       Exit := false;
  635.       Fill_Buffer('O',28,6,52,18);
  636.       Fill_Buffer('I',2,3,78,19);
  637.       CommandWindow(' ',2,3,52,19);
  638.       PrintDir;
  639.       CommandWindow(' ',54,6,78,18);
  640.       Writeln('Enter old File Name:');
  641.       Data_In(4, OldName);
  642.    end;
  643.    if (Exist(OldName) = true) and (Exit=false) then begin
  644.       Close(Textfile);
  645.       ClrScr;
  646.       writeln('Enter new name:');
  647.       Data_In(4, NewName);
  648.       if (Exist(NewName) = false) and (Exit=false) then begin
  649.          Close(Textfile);
  650.          Assign(Textfile, OldName);
  651.          Rename(Textfile, NewName);
  652.          Close(Textfile);
  653.       end
  654.       else begin
  655.          GotoXY(1,8);
  656.          if Exit=false then write(chr(7),'New file already exists');
  657.          Delay(1000);
  658.       end;
  659.    end
  660.    else begin
  661.       GotoXY(1,8);
  662.       if Exit=false then write(chr(7),'File does not exist');
  663.       Delay(1000);
  664.    end;
  665. end;
  666.  
  667. procedure Stuff;
  668. begin
  669.    ClrScr;
  670.    Menu('  Disk Parameters',' Logged Drive',' Search Spec',' Change Dir',
  671.         ' Exit',' ');
  672.    if Exit=false then begin
  673.       case Num of
  674.          1 : begin
  675.                 ClrScr;
  676.                 GotoXY(1,5);
  677.                 Writeln('Enter new Drive');
  678.                 Write('    [A-F]?');
  679.                 Read(Kbd,Choice);
  680.                 Drive := UpCase(Choice);
  681.                 if not(Drive in ['A'..'F']) then Drive := 'A';
  682.              end;
  683.          2 : begin
  684.                 ClrScr;
  685.                 GotoXY(1,2);
  686.                 Writeln('Enter the Directory');
  687.                 Writeln('search string.');
  688.                 Writeln('Wildcards are');
  689.                 Writeln('allowed. Default');
  690.                 Writeln('is ''*.FIL''');
  691.                 Write(': ');
  692.                 Readln(DirString);
  693.              end;
  694.          3 : begin
  695.                 ClrScr;
  696.                 GotoXY(1,5);
  697.                 Writeln('Enter new Path');
  698.                 Writeln('Default = ''\''');
  699.                 Write(': ');
  700.                 Readln(Path);
  701.                 Path := Path + chr(0);
  702.                 dosrec.ds := Seg(Path);
  703.                 dosrec.dx := Ofs(Path);
  704.                 dosrec.ax := $3B00;
  705.                 MsDos(dosrec);
  706.                 if dosrec.ax <> 0 then Writeln(chr(7),'Bad Path');
  707.              end;
  708.          4 : ;
  709.          else write(chr(7));
  710.       end;
  711.    end;
  712. end;
  713.  
  714. begin  {DosMenu}
  715.    Inum := 0;
  716.    Dir := false;
  717.    CommandWindow(' ',28,6,52,18);
  718.    repeat
  719.       ClrScr;
  720.       Menu('      DOS Menu',' Directory',' Delete',' Rename',' Dir Stuff',
  721.                             ' Exit to DOS');
  722.       if Exit = false then begin
  723.          CNum := Num;
  724.          case CNum of
  725.             1 : begin
  726.                   Fill_Buffer('O',28,6,52,18);
  727.                   CommandWindow(' ',2,3,52,19);
  728.                   Inum := 3333;
  729.                   PrintDir;
  730.                   Fill_Buffer('O',2,3,52,19);
  731.                 end;
  732.             2 : DelFile;
  733.             3 : RenFile;
  734.             4 : Stuff;
  735.             5 : begin
  736.                    ClrScr;
  737.                    GotoXY(1,4);
  738.                    Writeln('Exit Turbo Script,');
  739.                    Writeln;
  740.                    Write('Erase memory (Y/N)? ');
  741.                    Read(Kbd, Choice);
  742.                    if (Choice = 'Y') or (Choice = 'y') then NumEnd := 9999
  743.                         else NumEnd := 0;
  744.                 end;
  745.          else write(chr(7));
  746.          end; { case }
  747.       end;
  748.    until CNum <> 4;
  749.    if (CNum <> 1) and ((CNum <> 5) or (NumEnd=0)) then begin
  750.       if Dir = false then Fill_Buffer('O',28,6,52,18) else
  751.          Fill_Buffer('O',2,3,78,19);
  752.    end;
  753. end;
  754.  
  755. overlay procedure Help;
  756. begin
  757.    Assign(TextFile, 'HELP.HLP');
  758.    Reset(TextFile);
  759.    While (EOF(Textfile) = false) and (Choice <> chr(27)) do begin
  760.       ClrScr;
  761.       GotoXY(1,1);
  762.       Index := 0;
  763.       NormVideo;
  764.       repeat
  765.          Readln(TextFile, TempWord);
  766.          Index := Index + 1;
  767.          writeln(TempWord);
  768.       until (Index = 20) or (EOF(TextFile)=true);
  769.       LowVideo;
  770.       GotoXY(1,22);
  771.       Write('      < Press');
  772.       NormVideo;
  773.       Write(' ENTER ');
  774.       LowVideo;
  775.       Write('to continue >');
  776.       read(Kbd, Choice);
  777.    end;
  778.    Close(TextFile);
  779.    NormVideo;
  780.    ClrScr;
  781.    GotoXY(1,1);
  782.    PrintWords(Row-ScreenRow+1);
  783. end;
  784.  
  785. overlay procedure Initialize;
  786. const
  787.     Digits: array[1..10] of char = ('1','2','3','4','5','6','7','8','9','0');
  788.     Positions: array[1..10] of integer = (1,8,18,25,33,39,49,59,67,74);
  789.  
  790. begin
  791.     CrtInit;
  792.     Row := 1;
  793.     Column := 1;
  794.     ScreenRow := 1;
  795.     MaxRow := 1;
  796.     EndColumn := 79;
  797.     Window(1,1,80,25);
  798.     ClrScr;
  799.     GotoXY(1,1);
  800.     Write(Replicate(80,205));
  801.     GotoXY(1,24);
  802.     Write(Replicate(80,196));
  803.     GotoXY(34,1);
  804.     Write('Turbo Script');
  805.     GotoXY(54,1);
  806.     writeln('Row = ',Row : 3,'  Column = ',Column : 2);
  807.     GotoXY(1,25);
  808.     LowVideo;
  809.     write('Help ':6,'Ser/Rep ':10,'Tabs ':7,'Clock ':8,'DOS ':6);
  810.     write('InsLine ':10,'DelLine ':10,'Print ':8,'Load ':7,'Save ':7);
  811.     NormVideo;
  812.     for i := 1 to 10 do begin
  813.        GotoXY(Positions[i], 25);
  814.        write(Digits[i]);
  815.      end;
  816.     Window(1,2,80,23);
  817.     TempWord := Replicate(79,32);
  818.     for i:=1 to 500 do Words[i] := TempWord;
  819.     TempWord := '';
  820.     Insertmode := false;
  821.     Dir := false;
  822.     pm := false;
  823.     dosrec.ax := $1900;
  824.     MsDos(dosrec);
  825.     Drive := chr(65 + lo(dosrec.ax));
  826.     DirString := '*.FIL';
  827.     Path := '\';
  828.     Hour := 25;
  829.     Min := 70;
  830.     Sec := 70;
  831.     CapsMode := false;
  832.     Mem[$40:$17] := 0;
  833.     Exit := false;
  834.     NumEnd := 1;
  835.     for i := 1 to 80 do Tabset[i] := false;
  836.     Tabset[6] := true;
  837.     Tabset[40] := true;
  838. end;
  839.  
  840. procedure TabMenu;
  841. begin
  842.    Window(1,1,80,25);
  843.    GotoXY(1,1);
  844.    write('Tabs '); LowVideo; Write ('- ['); NormVideo; write('S');
  845.    LowVideo; Write(']et, ['); NormVideo; write('C'); LowVideo; write(']lear, [');
  846.    NormVideo; Write('P'); LowVideo; Write(']urge: '); NormVideo;
  847.    read(Kbd, Choice);
  848.       if Choice in ['s','S'] then Tabset[Column] := true;
  849.       if Choice in ['c','C'] then Tabset[Column] := false;
  850.       if Choice in ['p','P'] then for i := 1 to 79 do Tabset[i] := false;
  851.    if not(Choice in ['s','c','p','S','C','P']) then write(chr(7));
  852.    GotoXY(1,1);
  853.    write(Replicate(33,205));
  854.    Window(1,2,80,25);
  855.    CapsMode := Not CapsMode;
  856.    Hour := 30; Min := 70; Sec := 70;
  857.    CapsCheck;
  858. end;
  859.  
  860. procedure PrevWord;
  861. begin
  862.    TempWord := Words[Row];
  863.    Index := Column;
  864.    repeat
  865.       Index := Index - 1;
  866.       ch := TempWord[Index];
  867.    until ch <> ' ';
  868.    repeat
  869.       Index := Index - 1;
  870.       ch := TempWord[Index];
  871.    until (ch = ' ') or (Index < 1);
  872.    Column := Index + 1;
  873.    if Column < 1 then Column := 1;
  874. end;
  875.  
  876. procedure NextWord;
  877. begin
  878.    TempWord := Words[Row];
  879.    Index := Column;
  880.    repeat
  881.       Index := Index + 1;
  882.       ch := TempWord[Index];
  883.    until (ch = ' ') or (Index > EndColumn);
  884.    repeat
  885.       Index := Index + 1;
  886.       ch := TempWord[Index];
  887.    until ch <> ' ';
  888.    Column := Index;
  889.    if Column > EndColumn then Column := EndColumn;
  890. end;
  891.  
  892. procedure Ascii;
  893. var Ascnum, Repeats, r : integer;
  894.  
  895. begin
  896.    Window(1,1,80,25);
  897.    GotoXY(1,1);
  898.    Write('Enter ASCII code number: --- ');
  899.    GotoXY(26,1);
  900.    Readln(Ascnum);
  901.    GotoXY(1,1);
  902.    Write('Enter number of repeats: --  ');
  903.    GotoXY(26,1);
  904.    Readln(Repeats);
  905.    if not(Repeats in [1..EndColumn-1]) then Repeats := 1;
  906.    GotoXY(1,1);
  907.    Write(Replicate(30,205));
  908.    If Ascnum < 255 then begin
  909.       Window(1,2,80,23);
  910.       GotoXY(Column,ScreenRow);
  911.       for r := 1 to Repeats do begin
  912.          Inkey := chr(Ascnum);
  913.          Character;
  914.       end;
  915.    end
  916.     else write(chr(7));
  917.    CapsMode := not CapsMode;
  918.    Hour := 30; Min := 70; Sec := 70;
  919.    CapsCheck;
  920.    Window(1,2,80,23);
  921. end;
  922.  
  923. procedure MemoryFilled;
  924. begin
  925.    CommandWindow(' ',28,6,52,18);
  926.    GotoXY(1,2);
  927.    Writeln(chr(7),'You have used up all');
  928.    Writeln('Available memory in');
  929.    Writeln('Turbo Script. Please');
  930.    Writeln('save your file now');
  931.    Writeln('and continue.');
  932.    Delay(3000);
  933.    SaveFile;
  934.    TempWord := Replicate(79,32);
  935.    for i:=1 to 500 do Words[i]:=TempWord;
  936.    ClrScr;
  937.    Row := 1;  ScreenRow := 1;
  938.    Column := 1;
  939. end;
  940.  
  941. procedure EndFile;
  942. begin
  943.    Row := MaxRow + 1;
  944.    Oops := Words[Row];
  945.    ScreenRow := 12;
  946.    Column := 1;
  947.    Temp1 := Row-11;
  948.    GotoXY(1,1);
  949.    TempWord := Replicate(79,32);
  950.    PrintWords(Temp1);
  951. end;
  952.  
  953. procedure SetTime;
  954. var TimeString : TempString;
  955.     Colon,code,k : integer;
  956.  
  957. begin
  958.    CommandWindow('     Set Time',28,6,52,18);
  959.    k:=0;
  960.    GotoXY(1,5);
  961.    Writeln('Enter time and a=am');
  962.    Writeln('p=pm   Ex: 9:56:10 p');
  963.    Writeln;
  964.    Write('>');
  965.    Readln(TimeString);
  966.    Writeln;
  967.    Colon := Pos(':',TimeString)-1;
  968.    Val(Copy(TimeString,1,Colon),Hour,code);
  969.    k:=k+code;
  970.    Val(Copy(TimeString,Colon+2,2),Min,code);
  971.    k:=k+code;
  972.    Val(Copy(TimeString,Colon+5,2),Sec,code);
  973.    k:=k+code;
  974.    if Copy(TimeString,Colon+8,1) = 'p' then begin
  975.       Hour := Hour + 12;
  976.       pm := true;
  977.    end;
  978.    if k <> 0 then Write(chr(7),'Invalid time') else begin
  979.       dosrec.ax := $2D00;
  980.       dosrec.cx := Hour shl 8 + Min;
  981.       dosrec.dx := Sec shl 8;
  982.       MsDos(dosrec);
  983.    end;
  984.    Fill_Buffer('O',28,6,52,18);
  985.    Hour := 25;
  986.    Min := 70;
  987.    Sec := 70;
  988.    CapsCheck;
  989. end;
  990.  
  991. procedure HandleFunc;
  992. begin
  993.    case Keynum of
  994.      7 : begin
  995.             CommandWindow(' ',27,10,54,14);
  996.             Writeln('Enter Glossary string:');
  997.             Write('>');
  998.             Readln(Glossary);
  999.             Fill_Buffer('O',27,10,54,14);
  1000.          end;
  1001.      8 : Backspace;
  1002.      9 : begin
  1003.             if Column < EndColumn then begin
  1004.                Inkey := chr(32);
  1005.                repeat
  1006.                   Column := Column + 1;
  1007.                   if InsertMode then begin
  1008.                      Column := Column - 1;
  1009.                      Character;
  1010.                   end;
  1011.                until (Tabset[Column] = true) or (Column = EndColumn);
  1012.                if InsertMode then begin
  1013.                   GotoXY(1,ScreenRow);
  1014.                   Write(Words[Row]);
  1015.                end;
  1016.             end;
  1017.          end;
  1018.     13 : Enter;
  1019.     15 : begin
  1020.             if Column > 1 then begin
  1021.                repeat
  1022.                   Column := Column - 1;
  1023.                until Tabset[Column] = true;
  1024.             end;
  1025.          end;
  1026.     24 : begin
  1027.             Words[Row] := Oops;
  1028.             GotoXY(1, ScreenRow);
  1029.             write(Words[Row]);
  1030.          end;
  1031.     23 : begin
  1032.             Inkey := chr(251);
  1033.             Character;
  1034.          end;
  1035.     27 : begin
  1036.             Column := 1;
  1037.             GotoXY(1, WhereY);
  1038.             ClrEol;
  1039.             Words[Row] := Replicate(79,32);
  1040.          end;
  1041.     30 : Ascii;
  1042.     31 : begin
  1043.             Window(1,1,80,25);
  1044.             GotoXY(1,1);
  1045.             Write('Enter Right Column: --');
  1046.             GotoXY(21,1);
  1047.             Readln(EndColumn);
  1048.             if not(EndColumn in [2..79]) then EndColumn := 79;
  1049.             GotoXY(1,1);
  1050.             Write(Replicate(30,205));
  1051.             CapsMode := not CapsMode;
  1052.             Hour := 30; Min := 70; Sec := 70;
  1053.             CapsCheck;
  1054.             Window(1,2,80,23);
  1055.          end;
  1056.     34 : begin
  1057.             for i:=1 to Length(Glossary) do begin
  1058.                Inkey := Glossary[i];
  1059.                Character;
  1060.             end;
  1061.          end;
  1062.     46 : begin
  1063.             if Words[Row][1]=' ' then begin
  1064.                Column := 0;
  1065.                NextWord;
  1066.             end else Column:=1;
  1067.             Temp1 := Column;
  1068.             i := Row;
  1069.             FuncEnd;
  1070.             Column := Column - Temp1;
  1071.             Words[Row] := Replicate(Round((EndColumn-Column)/2),32) +
  1072.                Copy(Words[Row],Temp1,Column);
  1073.             FuncEnd;
  1074.             Words[Row] := Words[Row] + Replicate(EndColumn-Column,32);
  1075.             GotoXY(1, WhereY);
  1076.             Write(Words[Row]);
  1077.          end;
  1078.     48 : begin
  1079.             Inkey := chr(254);
  1080.             Character;
  1081.          end;
  1082.     50 : LoadFile('Merge',Row);
  1083.     59 : Help;
  1084.     60 : Menu_S_R;
  1085.     61 : TabMenu;
  1086.     62 : SetTime;
  1087.     63 : DosMenu;
  1088.     64 : Insertline;
  1089.     65 : Deleteline;
  1090.     66 : PrintFile;
  1091.     67 : Loadfile('Load',1);
  1092.     68 : Savefile;
  1093.     71 : Column := 1;
  1094.     72 : CursorUp;
  1095.     73 : begin
  1096.             Row := Row - 21;
  1097.             if Row < 1 then Row := 1;
  1098.             if Row-ScreenRow < 1 then ScreenRow := Row;
  1099.             PrintWords(Row-ScreenRow+1);
  1100.             Oops := Words[Row];
  1101.          end;
  1102.     75 : CursorLeft;
  1103.     77 : CursorRight;
  1104.     79 : begin
  1105.             i := Row;
  1106.             FuncEnd;
  1107.          end;
  1108.     80 : CursorDown;
  1109.     81 : begin
  1110.             if Row + 21 < 500 then begin
  1111.                Row := Row + 21;
  1112.                Oops := Words[Row];
  1113.                PrintWords(Row-ScreenRow+1);
  1114.             end;
  1115.          end;
  1116.     82 : if Insertmode then Insertmode := false
  1117.               else Insertmode := true;
  1118.     83 : Del;
  1119.    115 : PrevWord;
  1120.    116 : NextWord;
  1121.    117 : begin
  1122.             ClrEol;
  1123.             Words[Row] := Copy(Words[Row], 1, Column-1) + Replicate(EndColumn-Column+1, 32);
  1124.          end;
  1125.    118 : EndFile;
  1126.    119 : begin
  1127.             ClearScreen;
  1128.             Fill_Buffer('O',28,6,52,18);
  1129.             if Exit = false then begin
  1130.                ClrScr;
  1131.                ScreenRow := 1;
  1132.             end;
  1133.          end;
  1134.    132 : begin
  1135.            GotoXY(1,1);
  1136.            if Row > ScreenRow then PrintWords(1);
  1137.            Row := 1;
  1138.            Column := 1;
  1139.            ScreenRow := 1;
  1140.          end;
  1141.    else
  1142.      Sound(200);
  1143.      Delay(300);
  1144.      NoSound;
  1145.    end;
  1146. end;
  1147.  
  1148. begin
  1149.   Initialize;
  1150.   PrintRow;
  1151.   Port[980]:=11;  Port[981]:=7;
  1152.   repeat
  1153.     Secnum := false;
  1154.     if Getkey(Secnum, Inkey) then begin
  1155.        if Secnum then HandleFunc else Character;
  1156.        PrintRow;
  1157.        Exit := false;
  1158.        if Insertmode then begin
  1159.          Port[980]:=10;  Port[981]:=8;
  1160.          if Words[Row][EndColumn-1]<>' ' then begin
  1161.             Temp1 := Column; Temp2 := Row; Inum := ScreenRow;
  1162.             Column := 80;
  1163.             PrevWord;
  1164.             Enter;
  1165.             Column := Temp1; Row := Temp2; ScreenRow := Inum;
  1166.          end;
  1167.          GotoXY(Column, ScreenRow);
  1168.          TempWord := Copy(Words[Row],Column,EndColumn-Column);
  1169.          Write(TempWord);
  1170.        end;
  1171.        GotoXY(Column , ScreenRow);
  1172.     end;
  1173.     if Row > 500 then MemoryFilled;
  1174.     CapsCheck;
  1175.     Port[980]:=10;
  1176.     if InsertMode then Port[981]:=4 else Port[981]:=7;
  1177.     GotoXY(Column, ScreenRow);
  1178.   until NumEnd = 9999;
  1179.   Window(1,1,80,25);
  1180.   ClrScr;
  1181. end.
  1182.