home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TSCRIPT4.ZIP / TSCRIPT2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  11.5 KB  |  452 lines
  1. {********************************************
  2.  *    Part 2 of Turbo Script version 4.0    *
  3.  ********************************************}
  4.  
  5. procedure Fill_Buffer(Where : char;x,y,x1,y1 : integer);
  6. var j,k,l,Temprow,TempCol : integer;
  7.  
  8. begin
  9.    TempRow := Row;
  10.    TempCol := Column;
  11.    k := 0;
  12.    l := 0;
  13.    for i:=y-1 to y1-1 do begin
  14.       for j:= x-1 to x1-1 do begin
  15.          l := i*160+(j*2);
  16.          if Where = 'I' then Buffer[k] := Mem[$B800:l] else
  17.                Mem[$B800:l] := Buffer[k];
  18.          k := k + 1;
  19.       end;
  20.    end;
  21.    Row := TempRow;
  22.    Column := TempCol;
  23.    if Where = 'O' then Window(1,2,80,23);
  24. end;
  25.  
  26. function Replicate ( Count, Ascii : Integer ) : TempString;
  27. var Temp : TempString;
  28.       I  : Byte;
  29.  
  30. Begin
  31.   Temp := '';
  32.   For I := 1 to Count do
  33.     Temp := Temp + chr(Ascii);
  34.   Replicate := Temp;
  35. end;
  36.  
  37. procedure FuncEnd;
  38. begin
  39.    Temp3 := Length(Words[i]);
  40.    TempWord := Words[i];
  41.    repeat
  42.       ch := TempWord[Temp3];
  43.       Temp3 := Temp3 - 1;
  44.    until (ch<>chr(32)) or (Temp3 < 0);
  45.    Column := Temp3 + 2;
  46.    if Column < 1 then Column := 1;
  47. end;
  48.  
  49. procedure PrintWords(Start : integer);
  50. var j,l : integer;
  51.  
  52. begin
  53.    l := 0;
  54.    for i:=1 to 22 do begin
  55.       for j:= 1 to EndColumn do begin
  56.          l := i*160+((j-1)*2);
  57.          Move(Words[Start+i-1][j],Mem[$B800:l],1);
  58.       end;
  59.    end;
  60. end;
  61.  
  62. procedure Data_In(Line : integer;Var FileName : TempString);
  63. var
  64.    count, Maxcount : integer;
  65.    Letter : char;
  66.    NoGood, NameSet, ValidLetters, LowerCase : set of char;
  67.  
  68. begin
  69.    FileName := '--------.---';
  70.    count := 1;
  71.    GotoXY(1,Line-2);
  72.    Write('Default = .FIL');
  73.    GotoXY(1,10);
  74.    Write('Press Esc to Exit');
  75.    Exit := false;
  76.    ValidLetters := ['!'..'~'];
  77.    LowerCase := ['a'..'z'];
  78.    NoGood := ['*','<'..'>','[',']',' ','.'];
  79.    NameSet := ValidLetters - NoGood;
  80.    GotoXY(1,Line);
  81.    write(FileName);
  82.    GotoXY(1,Line);
  83.    Maxcount := Length(FileName);
  84.    repeat
  85.      GotoXY(count,Line);
  86.      read(Kbd, Letter);
  87.      if Letter in Lowercase then Letter := UpCase(Letter);
  88.      if (Letter = ' ') or (Letter = '.') then count := maxcount - 3;
  89.      if Letter <> '?' then begin
  90.         if Letter in NameSet then begin
  91.            FileName[count] := Letter;
  92.            GotoXY(1,Line);
  93.            Write(FileName);
  94.            count := count + 1;
  95.         end
  96.         else
  97.           if Letter = chr(8) then begin
  98.              if count = Pos('.',FileName) + 1 then count := count - 2
  99.                 else count := count - 1;
  100.              if count < 1 then count := 1;
  101.              FileName[count] := '-';
  102.              GotoXY(1,Line);
  103.              write(FileName);
  104.            end
  105.         else if not(ord(Letter) in [13,27,32,46]) then write(chr(7));
  106.         if count = Pos('.',FileName) then count := count + 1;
  107.      end else Dir := True;
  108.   until (count = Maxcount + 1) or (ord(Letter) in [13,27,63]);
  109.   if (ord(Letter) in [27,63]) or (count=1) then Exit := true else begin
  110.      if Copy(Filename, Maxcount-2,1) = '-' then begin
  111.         Filename := Copy(Filename, 1, Length(Filename)-4);
  112.         Filename := Filename + '.FIL';
  113.      end;
  114.      repeat
  115.         Delete(Filename,Pos('-',Filename),1);
  116.      until Pos('-',Filename)=0;
  117.      GotoXY(1,Line);
  118.      Write('                ');
  119.      GotoXY(1,Line);
  120.      Write(Filename);
  121.   end;
  122. end;
  123.  
  124. procedure Printrow;
  125. begin
  126.    Port[980]:=10;  Port[981]:=8;
  127.    Window(1,1,80,25);
  128.    GotoXY(60,1);
  129.    write(Row : 3);
  130.    GotoXY(75,1);
  131.    write(Column : 2);
  132.    Window(1,2,80,23);
  133.    GotoXY(Column, ScreenRow);
  134. end;
  135.  
  136. procedure CapsCheck;
  137. var Caps : integer;
  138.  
  139. begin
  140.    Caps := Mem[$40:$18];
  141.    if Caps = 64 then begin
  142.       CapsMode := not CapsMode;
  143.       Window(1,1,80,25);
  144.       GotoXY(18,1);
  145.       if CapsMode then write('Caps Lock') else write(Replicate(10,205));
  146.       Repeat Caps := Mem[$40:$18] until Caps = 0;
  147.       Window(1,2,80,23);
  148.       GotoXY(Column, ScreenRow);
  149.    end;
  150.    dosrec.ax := $2C00;  {Check time}
  151.    MsDos(dosrec);
  152.    Window(1,1,80,25);
  153.    if Hi(dosrec.cx) <> Hour then begin
  154.       GotoXY(3,1);
  155.       Hour := Hi(dosrec.cx);
  156.       if Hour > 12 then begin
  157.          pm := true;
  158.          if Hour-12 < 10 then Write('0',Hour-12:1,':') else Write(Hour-12:2,':');
  159.       end else begin
  160.          pm := false;
  161.          if Hour < 10 then Write('0',Hour:1,':') else Write(Hour:2,':');
  162.       end;
  163.       GotoXY(11,1);
  164.       if pm then Write(' p') else Write(' a');
  165.    end;
  166.    if Lo(dosrec.cx) <> Min then begin
  167.       Min := Lo(dosrec.cx);
  168.       GotoXY(6,1);
  169.       if Min < 10 then Write('0',Min:1,':') else Write(Min:2,':');
  170.    end;
  171.    if Hi(dosrec.dx) <> Sec then begin
  172.       Sec := Hi(dosrec.dx);
  173.       GotoXY(9,1);
  174.       If Sec < 10 then Write('0',Sec:1) else Write(Sec:2);
  175.    end;
  176.    Window(1,2,80,23);
  177.    Temp1 := 1;
  178. end;
  179.  
  180. procedure Menu(Title, Choice1, Choice2, Choice3, Choice4, Choice5 : TempString);
  181. begin
  182.    Exit := false;
  183.    While KeyPressed do Read(Kbd,ch);
  184.    ClrScr;
  185.    writeln(Title);
  186.    writeln;
  187.    writeln('1. ',Choice1);
  188.    writeln('2. ',Choice2);
  189.    writeln('3. ',Choice3);
  190.    writeln('4. ',Choice4);
  191.    if Choice5 <> ' ' then writeln('5. ',Choice5);
  192.    writeln;
  193.    write('? ');
  194.    GotoXY(1,10);
  195.    write('Press Esc to exit');
  196.    GotoXY(3,9);
  197.    read(Kbd, Choice);
  198.    If ord(Choice) = 27 then Exit := true else Val(Choice, Num, code);
  199.    if (code>0) or (Num>5) or (Num<1) then Num := 0;
  200. end;
  201.  
  202. procedure CommandWindow(Strg : TempString; x,y,x1,y1 : integer);
  203. begin
  204.    if Dir = false then Fill_Buffer('I',x,y,x1,y1);
  205.    Window(x,y,x1,y1);
  206.    ClrScr;
  207.    Window(1,2,80,23);
  208.    GotoXY(x,y-1);  Write(chr(213));
  209.    Write(Replicate((x1-1)-x,205));
  210.    Write(chr(184));
  211.    for i:=y to y1-2 do
  212.    begin
  213.       GotoXY(x, i);  Write(chr(179));
  214.       GotoXY(x1, i);  Write(chr(179));
  215.    end;
  216.    GotoXY(x, y1-1);
  217.    Write(chr(212));
  218.    Write(Replicate((x1-1)-x,205));
  219.    Write(chr(190));
  220.    Window(x+2,y+1,x1-2,y1-1);
  221.    GotoXY(1,1);
  222.    if Strg <> ' ' then begin
  223.       write(Replicate(x1-x-4,223));
  224.       GotoXY(1,2);
  225.       write(Strg);
  226.       GotoXY(1,3);
  227.       write(Replicate(x1-x-4,220));
  228.    end;
  229. end;
  230.  
  231. procedure ClearScreen;
  232. begin
  233.    CommandWindow(' ',28,6,52,18);
  234.    ClrScr;
  235.    GotoXY(1,3);
  236.    write('Clear Memory, Erase  Text?',chr(13),chr(10),chr(10));
  237.    write('ARE YOU SURE? (Y/N) ');
  238.    read(Kbd,Inkey);
  239.    write(Inkey);
  240.    if (Inkey = 'y') or (Inkey = 'Y') then begin
  241.         TempWord := Replicate(79,32);
  242.         for i := 1 to 500 do Words[i] := TempWord;
  243.         Row := 1;
  244.         ScreenRow := 1;
  245.         Column := 1;
  246.         MaxRow := 1;
  247.      end
  248.    else Exit := true;
  249. end;
  250.  
  251. function GetKey(var secnum : boolean; var Inkey : char) : boolean;
  252. begin
  253.    if KeyPressed then begin
  254.       GetKey := true;
  255.       dosrec.ax := $0800;
  256.       msdos(dosrec);
  257.       Inkey := chr(lo(dosrec.ax));
  258.       KeyNum := ord(Inkey);
  259.       Secnum := ord(Inkey) = 0;
  260.       if Secnum then begin
  261.          dosrec.ax := $0800;
  262.          msdos(dosrec);
  263.          Keynum := ord(chr(lo(dosrec.ax)));
  264.       end
  265.       else if ord(Inkey) <= 27 then Secnum := true else Secnum := false;
  266.    end
  267.    else begin
  268.       Getkey := false;
  269.       secnum := false;
  270.    end;
  271. end;
  272.  
  273. procedure InsertLine;
  274. begin
  275.    if Temp1 <> 3333 then InsLine;
  276.    for i := MaxRow + 1 downto Row do Words[i+1] := Words[i];
  277.    Words[Row] := Replicate(79,32);
  278.    MaxRow := MaxRow + 1;
  279. end;
  280.  
  281. procedure ScrollUp;
  282. begin
  283.    ScreenRow := 22;
  284.    GotoXY(1,1);
  285.    DelLine;
  286.    GotoXY(1, ScreenRow);
  287.    write(Words[Row]);
  288. end;
  289.  
  290. procedure Enter;
  291. begin
  292.   Row := Row + 1;
  293.   Oops := Words[Row];
  294.   ScreenRow := Screenrow + 1;
  295.   if ScreenRow > 22 then ScrollUp;
  296.   if InsertMode then begin
  297.      GotoXY(Column, ScreenRow-1);
  298.      ClrEol;
  299.      Sound(450);
  300.      Delay(20);
  301.      NoSound;
  302.      if Temp1 = 5555 then Column := Column + 1;
  303.      GotoXY(1,ScreenRow);
  304.      InsertLine;
  305.      Words[Row] := Copy(Words[Row-1],Column,EndColumn-Column) +
  306.                    Replicate(EndColumn-(EndColumn-Column),32);
  307.      Words[Row-1] := Copy(Words[Row-1],1,Column-1)+Replicate(EndColumn-Column,32);
  308.      FuncEnd;
  309.      if Temp1 = 5555 then Words[Row][Column] := Inkey;
  310.      GotoXY(1,ScreenRow);
  311.      TempWord := Replicate(79,32);
  312.      if Words[Row] <> Tempword then Write(Words[Row]);
  313.   end else Column := 1;
  314.   if row > MaxRow then MaxRow := Row;
  315.   GotoXY(Column, Screenrow);
  316. end;
  317.  
  318. procedure WordWrap;
  319. var Mode : boolean;
  320.  
  321. begin
  322.    Column := EndColumn;
  323.    Temp1 := 5555;
  324.    TempWord := Words[Row];
  325.    Mode := InsertMode;
  326.    repeat
  327.       Column := Column - 1;
  328.    until TempWord[Column] = chr(32);
  329.    if Column < 2 then Column := 2;
  330.    InsertMode := true;
  331.    Enter;
  332.    InsertMode := Mode;
  333.    Temp1 := 1;
  334.    Column := Column + 1;
  335. end;
  336.  
  337. procedure Character;
  338. begin
  339.    if Column = EndColumn then WordWrap else
  340.    begin
  341.       GotoXY(Column,ScreenRow);
  342.       write(Inkey);
  343.       Insert(Inkey, Words[Row], Column);
  344.       if not Insertmode then Delete(Words[Row],Column + 1,1);
  345.       Column := Column + 1;
  346.       if Column = EndColumn-8 then begin
  347.          Sound(1010);
  348.          Delay(10);
  349.          NoSound;
  350.       end;
  351.    end;
  352. end;
  353.  
  354. procedure DeleteLine;
  355. begin
  356.    DelLine;
  357.    GotoXY(1, 22);
  358.    write(Words[Row+(23-ScreenRow)]);
  359.    for i := Row to MaxRow + 1 do Words[i] := Words[i+1];
  360.    MaxRow := MaxRow - 1;
  361.    if Row > MaxRow then MaxRow := Row;
  362. end;
  363.  
  364. procedure Del;
  365. begin
  366.    if Column >= EndColumn then Column := EndColumn-1;
  367.    ch := Copy(Words[Row], Column, 1);
  368.    Delete(Words[Row], Column, 1);
  369.    Words[Row] := Words[Row] + ' ';
  370.    Port[980]:=10;  Port[981] := 8;
  371.    GotoXY(Column, ScreenRow);
  372.    TempWord := Copy(Words[Row],Column,EndColumn-Column);
  373.    Write(TempWord);
  374. end;
  375.  
  376. procedure Backspace;
  377.   begin
  378.     if Column > 1 then begin
  379.        Column := Column - 1;
  380.        if Column < EndColumn then Del;
  381.     end else if Row > 1 then begin
  382.        i := Row;
  383.        FuncEnd;
  384.        Temp1 := Column-1;
  385.        i := Row-1;
  386.        FuncEnd;
  387.        Temp2 := Column-1;
  388.        if Temp1 + Temp2 <= EndColumn then begin
  389.           Sound(200);
  390.           Delay(20);
  391.           NoSound;
  392.           Words[Row-1] := Copy(Words[Row-1],1,Temp2) + Copy(Words[Row],1,Temp1) +
  393.                           Replicate(EndColumn-(Temp1+Temp2),32);
  394.           Words[Row] := Replicate(79,32);
  395.           GotoXY(1,ScreenRow-1);
  396.           Writeln(Words[Row-1]);
  397.           GotoXY(1,ScreenRow);
  398.           ClrEol;
  399.           DeleteLine;
  400.           Row := Row - 1;
  401.           Oops := Words[Row];
  402.           ScreenRow := ScreenRow - 1;
  403.           Column := Temp2 + 1;
  404.        end;
  405.     end;
  406.  end;
  407.  
  408. procedure CursorLeft;
  409. begin
  410.   column := column - 1;
  411.   if column < 1 then begin
  412.      column := EndColumn;
  413.      if Row = 1 then Row := 1 else Row := Row - 1;
  414.      Oops := Words[Row];
  415.      if ScreenRow > 1 then ScreenRow := ScreenRow - 1;
  416.   end
  417. end;
  418.  
  419. procedure CursorRight;
  420. begin
  421.    column := column + 1;
  422.    If Column > EndColumn then begin
  423.       Column := 1;
  424.       Row := Row + 1;
  425.       Oops := Words[Row];
  426.       if Row > MaxRow then MaxRow := Row;
  427.       If ScreenRow < 22 then ScreenRow := ScreenRow + 1 else ScrollUp;
  428.    end;
  429. end;
  430.  
  431. procedure CursorUp;
  432. begin
  433.    row := row - 1;
  434.    Oops := Words[Row];
  435.    if row < 1 then row := 1;
  436.    if (ScreenRow = 1) and (Row > 1) then begin
  437.        GotoXY(1,1);
  438.        InsLine;
  439.        GotoXY(1,1);
  440.        write(Words[Row]);
  441.    end;
  442.    if ScreenRow > 1 then ScreenRow := ScreenRow - 1;
  443. end;
  444.  
  445. procedure CursorDown;
  446. begin
  447.   row := row + 1;
  448.   Oops := Words[Row];
  449.   if row > MaxRow then MaxRow := Row;
  450.   ScreenRow := ScreenRow + 1;
  451.   if ScreenRow > 22 then ScrollUp;
  452. end;