Program view12;
{includes graphics draw_string for fast screen writes -------------------------------}
{uses linked list for data}
{12-21-88  Ver 1.2}

Const
 {$I Gemconst.Src}
Type
  str = string[100];
 {$I GemType.Src} 
  str120 = string[120];
  str100 = string[100];
  Link_pointer = ^link_type;
  link_type    = record
                   next,prev : link_pointer;
                   tex    : str100;
                   cnt : integer;
                 end;

VAR
 start,endd,link,start_line : link_pointer;
 delta_y,y_init,y_menuline,
 ocol0,ocol1,ocol2,ocol3,
 org_rate,orate,odela,
 res,counter,scnt,
 fdrive,cdrive :             integer;
 menutex,menustr : str100;
 F1,Out : text;
  scancode,co1,co2,co3,len,I, Numlines : integer;
 C,Pkey : char; 
 tstr : str100;
 Filen1,Sstring,path : String[80];
{ Inst_line : str;}
 Endit : Boolean;
 Addres,Ramfree,ad_link_tex : Long_integer;

(*************************************************************************)
  {$I gemsubs.src}

Function Xbios04:integer;  {Screen resolution}
       Xbios(04);

Function Setcolorx(colornum,col:integer):integer;
         Xbios(07);

Function Gemdos08:Long_integer; {conin without echo (readkey)}
       Gemdos($08);

Procedure Gemdos09(ad:long_integer); {Printline}
   Gemdos($09);

Function gemdos11:boolean; {is printer on ?}
    Gemdos($11);

Function Xbios35(dela,repea:integer):integer; {keyboard repeat rate}
   xbios(35);

FUNCTION IO_Result
	: Short_Integer ;
	EXTERNAL ;
PROCEDURE IO_Check( YesNo : Boolean ) ;
	EXTERNAL ;

Procedure setcol1; {black on white}
   Begin
    ocol0 := setcolorx(0,$777);
    ocol3 := setcolorx(3,$000);
   end;
Procedure setcol2; {white on black}
var i:integer;
   Begin
    ocol0 := setcolorx(0,$000);
    ocol3 := setcolorx(3,$777);
   end;
Procedure setcol3; {black on lt. blue}
   Begin
    ocol0 := setcolorx(0,$457);
    ocol3 := setcolorx(3,$000);
   end;
Procedure setcol4;  {blue on lt. blue}
   Begin
    ocol3 := setcolorx(3,$005);
    ocol0 := setcolorx(0,$457);
   end;
Procedure setcol5;
   Begin
    ocol0 := setcolorx(0,$337);
    ocol3 := setcolorx(3,$000);
   end;
Procedure setcol6;   {white on gray}
   Begin
    ocol0 := setcolorx(3,$777);
    ocol0 := setcolorx(0,$444);
   end;

Procedure setcol7;
   Begin
    ocol0 := setcolorx(0,$555);
    ocol3 := setcolorx(3,$000);
   end;

Procedure setcol8;
   Begin
    ocol0 := setcolorx(0,$030);
    ocol3 := setcolorx(3,$777);
   end;
Procedure setcol9;
   Begin
    ocol0 := setcolorx(0,$005);
    ocol3 := setcolorx(3,$777);
   end;

Procedure setcol10; {Amber-brown}
 Begin
    ocol0 := setcolorx(0,$440);
    ocol3 := setcolorx(3,$777);
 end;

   
Function Readkey:char;  {read character without echo}
 Var
   pkeynum : long_integer;
   pkey   : char;

 Begin
   pkeynum := Gemdos08;
   readkey := chr(pkeynum);
   scancode := pkeynum div 65536;
   if (ord(pkey) = 0) then
     Begin
      If (scancode = $3B) then setcol1; {F1}
      If (scancode = $3C) then setcol2; {F2}
      If (scancode = $3D) then setcol3; {F3}
      If (scancode = $3E) then setcol4; {F4}
      If (scancode = $3F) then setcol5; {F5}
      If (scancode = $40) then setcol6; {F6}
      If (scancode = $41) then setcol7; {F7}
      If (scancode = $42) then setcol8; {F8}
      If (scancode = $43) then setcol9; {F9}
      If (scancode = $44) then setcol10; {F10}

      If (scancode = $01) then readkey := 'Q'; {esc}
      If (scancode = $47) then readkey := 'f'; {home}
      If (scancode = $62) then readkey := 'H'; {help}
      If (scancode = $48) then readkey := 'U'; {up arrow}
      If (scancode = $50) then readkey := 'D'; {down arrow}
      If (scancode = $4D) then readkey := '>'; {right arrow}
      If (scancode = $4B) then readkey := '<'; {left arrow}
     End;
  {Writeln(pkeynum,pkey,' into function ');}
 End;

Procedure Finish_It (Param : Char); Begin Write(Chr(27),Param); End;

Procedure GotoXY (X, Y : Byte);
  Begin
    Write (Chr(27), Chr($59), Chr(Y+32), Chr(X+32));
  End;
Procedure ClrScr; Begin Finish_It ( 'E' ); End;
Procedure ClrEol; Begin Finish_It ('K'); End;
Procedure Rev_Vid_On; Begin Finish_it ('p'); End;
Procedure Rev_Vid_Off; Begin Finish_It ('q'); End;
(*************************************************************************)



Procedure repeat_rate;  {reduces keyboard repeat rate if at default}

Begin
  org_rate := xbios35(20,5); {dela in high byte,repea in low byte}
  orate := org_rate mod 256;
  odela := org_rate div 256;
end;

Procedure Start_link_list;  {link stuff}
Begin
 new(link);
 start := link;
 link^.next := nil;
 link^.prev := nil;
 link^.tex := ' ';
 link^.cnt := 0;
 endd := link;
end;

Procedure New_link;  {link stuff}
Begin
 new(link);
 link^.next := nil;
 endd^.next := link;
 link^.prev := endd;
 link^.tex := ' ';
 link^.cnt := 0;
 endd := link;
End;

(*******************************************************)
Procedure Write_lines;
VAR
 count : integer;
 C1,xpos,ypos : integer;
 tempstr : string[80];
 
Begin
 res := xbios04;
 link := start_line;
 count := 0;
 C1 := 0;
 xpos := 0;
      
    clear_screen;
    writev(menustr,menutex,start_line^.cnt:5);
    draw_mode(4);
    draw_string(0,y_menuline,menustr);
    draw_mode(1);


 while (link^.next <> nil)and(c1<24) do
  begin
   if scnt > 0 then
    begin
     if (length(link^.tex) < scnt) then
      Begin
{       Writeln;}
      End
      Else
       Begin
         tempstr := copy(link^.tex,scnt,80);
         ypos := c1 * delta_y + y_init;
         draw_string(xpos,ypos,tempstr);
       End
    End
    Else
    Begin
     ypos := c1 * delta_y + y_init;
     draw_string(xpos,ypos,link^.tex);
    End;
   link := link^.next;
   C1 := C1 +1;
  End;
  count := count + 1;
End;
(********************************************************)

Procedure Getfn;
VAR
Gotit : boolean;
testio : integer;

 Begin
  Gotit := False;
  show_Mouse;
  Repeat
    Gotit := GET_IN_FILE(Path,FILEN1);  {GEM ACCESS FOR SELECTION BOX}
    If (Gotit = False) then
     Begin
       org_rate := xbios35(odela,orate); {reset original keyboard rate}
       setcol1;
       Halt; 
     End;
  IO_Check(false);
  Reset(F1,Filen1);
  testio := io_result;
  Until (testio = 0) ;  { (gotit = true)  and}
{  io_check(true);}
 End; {Getfn}


Procedure Readf;
VAR
  I : integer;

Begin{readf}
 ramfree := memavail * 2;
 clrscr;
 writeln (' Free Memory = ',ramfree,' Before Reading File');
 Mark(link);
 Mark(Start_line);
 Mark(start);
 Start_link_list;
 link^.tex := filen1;
 I := 1;
 Set_mouse(M_Bee);

 While not (Eof(F1)) and (ramfree > 2000) do  {read into link list}
   begin
     new_link;
     Readln(F1,link^.tex);
     Link^.cnt:=I;
     I := I + 1;
     ramfree := memavail * 2;
   end;

  Numlines := I;
  ramfree := memavail * 2;
  if (ramfree <= 2000) then  {if memory gone stop reading file}
     Begin
      Writeln;
      Writeln('         **** WARNING **** ');
      Writeln(' Read Suspended Due To Lack of Memory');
     END; 
  Writeln (' Free Memory = ',ramfree,' After Reading File');
  Writeln(' Number of lines read = ',numlines);
  Writeln;
  Writeln(' View  ver 1.2  12-21-88  Terry Kabel ');
  Writeln(' Written With Personal Pascal V2.02');
  Writeln;
  Writeln(' Hit Any Key To Continue '); 
  c := readkey;
  Close(f1);
 End; 


Procedure View;
Label 09;
VAR
 Pointer,Lpointer,Putlines, I,II, J : integer;
 Ad_inst_line : long_integer;
 Lines,num : Integer;
 
Begin
  Hide_Mouse;
  scnt := 0;
  start_line := start;

  Repeat
    Write_lines; 
     I := Pointer;
     II := 0;
  09:
    Pkey := Readkey;
  If pkey in ['Q','q','N','n','B','b','F','f','L','l','P',
     'H','U','u','D','d','F','R','r','<','>','0'..'9'] then
   Begin
    If (Pkey in ['0'..'9']) then
      begin
        num := (ord(pkey)-48);
        lines := num * numlines div 10;
        start_line := start; 
          For I := 1 to lines do
           Begin
            start_line := start_line^.next; 
           end;
      end;

    If (Pkey = 'N') or (Pkey = 'n')  then
      Begin
       If start_line = endd then {we are already at the end of file}
        begin
         Write(chr(07));   {sound bell}
         goto 09;      {don't rewrite the page}
        end
        else
        Begin
         for i:=1 to 24 do
          Begin 
           if start_line^.next <> nil then
            Begin
             start_line := start_line^.next; 
            end
          end;
        End;
      End;

    If (Pkey = 'D') or (Pkey = 'd') then
      Begin
       if start_line^.next <> nil then
        Begin
         start_line := start_line^.next; 
        End;
      End;

    If (Pkey = 'U') or (pkey = 'u') then
      Begin
       if start_line^.prev <> nil then
        Begin
         start_line := start_line^.prev;
        End;
      End;

    If (Pkey = '>')  then
      Begin
       if (scnt = 20) or (scnt = 60) then
        begin
         Write(chr(07));
         goto 09;
        end;
       if scnt = 10 then
        Begin
          scnt := 20;
        End; 
       if scnt = 30 then
        Begin
          scnt := 60;
        End; 
       if scnt = 0 then
        Begin
         if res = 0 then
          Begin
           scnt := 30;
          end
          else
          Begin
           scnt := 10;
          End;
        End;
      End;

    If (Pkey = '<')  then
      Begin
       if scnt = 0 then
        begin
         Write(chr(07));
         goto 09;
        end;
       if scnt = 10 then
        Begin
          scnt := 0;
        End; 
       if scnt = 30 then
        Begin
          scnt := 0;
        End; 
       if scnt = 60 then
        Begin
          scnt := 30;
        End; 
       if scnt = 20 then
        Begin
         scnt := 10;
        End;
      End;

    If (Pkey = 'B') or (Pkey = 'b') then
      Begin
       If start_line = start then
        begin
         Write(chr(07));
         goto 09;
        end
        else
        Begin
        for i:=1 to 24 do
         Begin 
          if start_line^.prev <> nil then
           Begin
            start_line := start_line^.prev; 
           end;
         end;
        End;
      End;

    If (Pkey = 'f')   then   {first of file}
      Begin
       if start_line = start then
        Begin
         goto 09;
        end
        else 
        begin
         Start_line := start; 
        end;
      End; 
    If (Pkey = 'L') or (Pkey = 'l')  then  {last of file}
     Begin
       Start_line := Endd;
       for i:=1 to 23 do
         Begin 
          if start_line^.prev <> nil then
           Begin
            start_line := start_line^.prev; 
           end;
         end;
     End;      

    If (Pkey = 'P')  then   { (pkey = 'p') then }{ print page}
        Begin
          Rewrite(out,'LST:');
          link := start_line;
          if (gemdos11) then 
           Begin
            for I := 1 to 24 do
              Begin
               if (link^.next <> nil) then
                Begin
                 writeln(Out,link^.tex);
                 link := link^.next;
                End;
              End;
           end
           else
           Begin
            gotoxy(0,0);
            Clreol;
            Rev_vid_on;
            Write(' Printer is Off ');
            Rev_vid_off;
            pkey := readkey;
           end;
        End;

     If (Pkey = 'H') then {Help}
      Begin
       clrscr;
       Writeln(' HELP SCREEN');
       Writeln(' ');  
       Writeln(' F1-F10    Set Screen Colors');
       Writeln(' Q,q,esc   Go Back Go Fileselect');
       Writeln('               Select "CANCEL" to exit program');
       Writeln(' P         Print Screen Page'); 
       Writeln(' n,N       Next Page');
       Writeln(' b,B       Back a Page');
       Writeln(' F         Find a string (non case sensitive)');
       Writeln(' r,R       Repeat Find of Previously Entered String');
       Writeln(' 0-9       Go To X0 % Thru File ( 5 goes 50% thru file)');      
       Writeln(' l,L       Go To last page of file');
       Writeln(' ');
       Writeln(' Any KEY to Continue'); 
       pkey := readkey;
      End;
      
    If (Pkey = 'F') Then    {Find}
     Begin
      gotoxy(0,0);
      Clreol;
      Rev_vid_on;
      Write('Enter Search String = ');
      Rev_vid_off;
      Readln(sstring);
       len := length(sstring);
        for j:= 1 to len do
         Begin 
          if (sstring[j] in ['A'..'Z']) then
           Begin
            sstring[j] := chr((ord(sstring[j])+32));
           End;
         End; 
     clrscr;
     Repeat
       if (start_line^.next <> nil) then
         Begin
           Start_line := start_line^.next; 
           tstr:=start_line^.tex;
           len := length(tstr);
           for j := 1 to len do
            Begin
             if (tstr[j] in ['A'..'Z']) then
               Begin
                 tstr[j] := chr(ord(tstr[j])+32);
               End;
            End;
         End;
     Until (Pos(sstring,tstr) <> 0) or (start_line^.next = nil);
     End;

     If (Pkey = 'R')or(Pkey = 'r') Then          {repeat find}
     Begin
      Repeat
       if (start_line^.next <> nil) then
        Begin       
         start_line := start_line^.next;
         tstr := start_line^.tex;
         len := length(tstr);
         for j := 1 to len do
           Begin
            if (tstr[j] in ['A'..'Z']) then
              Begin
                tstr[j] := chr(ord(tstr[j])+32);
              End;
           End;
        End;
      Until (Pos(sstring,tstr) <> 0) or (start_line^.next = nil);   
     End;
    
    If (Pkey = 'q') or (Pkey = 'Q')  then  {Quit}
      Begin        {free up memory}{more link stuff}
       release(link);
       release(start_line);
       release(start);
       ramfree := memavail * 2;
       clrscr;
       writeln (' Free Memory = ',ramfree,'       ***');
      End; 
    
   End
   Else
    Begin
      goto 09;
    End;

      
  Until (Pkey = 'q') or (pkey = 'Q');
 Show_Mouse;
End;

Procedure Initial;
VAR
 count : integer;
 
Begin
 Endit := False;
 Path := '\*.*';
 res := xbios04;
 menutex:='"q"uit|"n"ext|"b"ack|"F"ind|"r"ep|"P"rint|HELP|0..9|F1-F10|ARROWS|Line #=';

  Case Res of
   2:
    Begin
     delta_y := 16;
     y_init := 12;
     y_menuline := 397;
     set_clip(0,0,640,400);
    end;
   1:
    Begin
     delta_y := 8;
     y_init := 6;
     y_menuline := 198;
     set_clip(0,0,640,200);
     setcol1;
    End;
   0:
      Begin  {if res is 0  ( low resolution ) }
       delta_y := 8;
       y_init := 6;
       y_menuline := 198;
       set_clip(0,0,320,200);
       text_height(4);
       setcol1;
      end;
  end;
End;




   

Begin { Main }
  Repeat_rate;
  IF Init_Gem >= 0 THEN
   Begin 
    Initial;
    Repeat 
     Getfn;
     Readf;
     View;
    Until (endit = True);
   End;
End. { Main }