home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / ifp1s157 / ifphelp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-25  |  10.4 KB  |  433 lines
  1. unit ifphelp;
  2. {$V-}
  3. interface
  4.  
  5. Uses
  6.     Crt, Dos, ifpglobl, ifpcomon;
  7.  
  8. procedure helpscreen(pg: byte; helpver: longint);
  9.  
  10. implementation
  11.  
  12. type
  13.   tabletype = array[0..63] of longint;
  14.   helpptrtype = ^helptextrec;
  15.   helptextrec = record
  16.                   before, after: helpptrtype;
  17.                   lineno: word;
  18.                   helptext: string[79];
  19.                 end;
  20.  
  21. var
  22.   scrbuf: array[0..9599] of byte;
  23.   monoscrn: array[0..3999] of byte absolute $B000:0;
  24.   colorscrn: array[0..9599] of byte absolute $B800:0;
  25.   vidmode, vidlen, vidpg, oldattr, oldx, oldy: byte;
  26.   vidsize, vidwid, oldwindmin, oldwindmax: word;
  27.   thetable: tabletype;
  28.   filefound: boolean;
  29.   helphead: helpptrtype;
  30.   c: char;
  31.  
  32. procedure textseek(var thefile: text; position: longint);
  33.   var
  34.     segment, offset: word;
  35.     regs: registers;
  36.  
  37.   begin
  38.   segment:=Seg(thefile);
  39.   offset:=Ofs(thefile);
  40.   MemW[segment:offset + 8]:=0;
  41.   MemW[segment:offset + 10]:=0;
  42.   with regs do
  43.     begin
  44.     BX:=MemW[segment:offset];
  45.     CX:=position shr 16;
  46.     DX:=position and $0000FFFF;
  47.     AH:=$42;
  48.     AL:=0;
  49.     MsDos(regs);
  50.     end;
  51.   end;
  52.  
  53. procedure setup;
  54.   var
  55.     x, y: byte;
  56.     regs: registers;
  57.     position: word;
  58.  
  59.   begin
  60.   oldattr:=TextAttr;
  61.   oldwindmin:=WindMin;
  62.   oldwindmax:=WindMax;
  63.   oldx:=WhereX;
  64.   oldy:=WhereY;
  65.   filefound:=false;
  66.   position:=0;
  67.   modeinfo(vidmode, vidlen, vidpg, vidwid);
  68.   vidsize:=(vidwid * vidlen) * 2;
  69.   if DirectVideo then
  70.     if vidmode = 7 then
  71.       Move(monoscrn, scrbuf, vidsize)
  72.     else
  73.       Move(colorscrn, scrbuf, vidsize)
  74.   else
  75.     for y:=0 to vidlen - 1 do
  76.       for x:=0 to vidwid -1 do
  77.         with regs do
  78.           begin
  79.           AH:=2;
  80.           BH:=vidpg;
  81.           DH:=y;
  82.           DL:=x;
  83.           Intr($10, regs);
  84.           AH:=8;
  85.           BH:=vidpg;
  86.           Intr($10, regs);
  87.           scrbuf[position]:=AL;
  88.           scrbuf[position + 1]:=AH;
  89.           Inc(position, 2);
  90.           end;
  91.   end;
  92.  
  93. procedure cleanup;
  94.   var
  95.     x, y: byte;
  96.     regs: registers;
  97.     position: word;
  98.  
  99.   begin
  100.   position:=0;
  101.   if DirectVideo then
  102.     if vidmode = 7 then
  103.       Move(scrbuf, monoscrn, vidsize)
  104.     else
  105.       Move(scrbuf, colorscrn, vidsize)
  106.   else
  107.     for y:=0 to vidlen - 1 do
  108.       for x:=0 to vidwid -1 do
  109.         with regs do
  110.           begin
  111.           AH:=2;
  112.           BH:=vidpg;
  113.           DH:=y;
  114.           DL:=x;
  115.           Intr($10, regs);
  116.           AH:=9;
  117.           AL:=scrbuf[position];
  118.           BH:=vidpg;
  119.           BL:=scrbuf[position + 1];
  120.           CX:=1;
  121.           Intr($10, regs);
  122.           Inc(position, 2);
  123.           end;
  124.   TextAttr:=oldattr;
  125.   WindMin:=oldwindmin;
  126.   WindMax:=oldwindmax;
  127.   GotoXY(oldx, oldy);
  128.   end;
  129.  
  130. procedure anykey;
  131.   var
  132.     c: char;
  133.  
  134.   begin
  135.   center('Press <any key> to continue');
  136.   repeat until KeyPressed;
  137.   c:=ReadKey;
  138.   if c = #0 then
  139.     c:=ReadKey;
  140.   end;
  141.  
  142. procedure clearheap;
  143.   var
  144.     nowptr, nextptr: helpptrtype;
  145.  
  146.   begin
  147.   nowptr:=helphead;
  148.   repeat
  149.     nextptr:=nowptr^.after;
  150.     Dispose(nowptr);
  151.     nowptr:=nextptr
  152.   until nowptr = nil
  153.   end;
  154.  
  155. procedure readfile(pg: byte; helpver: longint);
  156.   var
  157.     filename: string[127];
  158.     c:char;
  159.     tablefile: file of tabletype;
  160.     infile: text;
  161.     dir, s: string;
  162.     extension: string[3];
  163.     linecount: word;
  164.     previousptr, nowptr: helpptrtype;
  165.     endread: boolean;
  166.  
  167.   begin
  168.   if GetEnv('INFOPLUS') <> '' then
  169.     begin
  170.     filename:=GetEnv('INFOPLUS');
  171.     if Pos('.', filename) = 0 then
  172.       begin
  173.       c:=filename[Length(filename)];
  174.       if (filename <> '') and (c <> ':') and (c <> '\') and (c <> '/') then
  175.         filename:=filename + '\';
  176.       filename:=filename + 'INFOPLUS.HLP';
  177.       end;
  178.     Assign(tablefile, filename);
  179.     {$I-} Reset(tablefile); {$I+}
  180.     if IOResult <> 0 then
  181.       begin
  182.       TextColor(White);
  183.       TextBackground(Red);
  184.       s:='INFOPLUS environment variable does not point';
  185.       Window((vidwid div 2) - (Length(s) div 2) - 2, (vidlen div 2) - 3,
  186.              (vidwid div 2) + (Length(s) div 2) + 2, (vidlen div 2) + 3);
  187.       box;
  188.       ClrScr;
  189.       center(s);
  190.       Writeln;
  191.       center('to a valid help file directory.');
  192.       Writeln;
  193.       center('INFOPLUS=' + GetEnv('INFOPLUS'));
  194.       Writeln;
  195.       Writeln;
  196.       anykey;
  197.       cleanup;
  198.       Exit;
  199.       end
  200.     else
  201.       filefound:=true;
  202.     end;
  203.   if not filefound then
  204.     begin
  205.     FSplit(FExpand(ParamStr(0)), dir, filename, extension);
  206.     filename:=FSearch('INFOPLUS.HLP', '.;' + dir + ';' + GetEnv('PATH'));
  207.     if filename = '' then
  208.       begin
  209.       TextColor(White);
  210.       TextBackground(Red);
  211.       s:='Unable to find INFOPLUS.HLP!';
  212.       Window((vidwid div 2) - (Length(s) div 2) - 2, (vidlen div 2) - 2,
  213.              (vidwid div 2) + (Length(s) div 2) + 2, (vidlen div 2) + 2);
  214.       box;
  215.       ClrScr;
  216.       center(s);
  217.       Writeln;
  218.       Writeln;
  219.       anykey;
  220.       cleanup;
  221.       Exit;
  222.       end
  223.     else
  224.       begin
  225.       Assign(tablefile, filename);
  226.       {$I-} Reset(tablefile); {$I+}
  227.       if IOResult <> 0 then
  228.         begin
  229.         TextColor(White);
  230.         TextBackground(Red);
  231.         s:='Unable to open ' + filename;
  232.         Window((vidwid div 2) - (Length(s) div 2) - 2, (vidlen div 2) - 2,
  233.                (vidwid div 2) + (Length(s) div 2) + 2, (vidlen div 2) + 2);
  234.         box;
  235.         ClrScr;
  236.         center(s);
  237.         Writeln;
  238.         Writeln;
  239.         anykey;
  240.         cleanup;
  241.         Exit;
  242.         end
  243.       else
  244.         filefound:=true;
  245.       end;
  246.     end;
  247.   Read(tablefile, thetable);
  248.   Close(tablefile);
  249.   if thetable[63] <> helpver then
  250.     begin
  251.     TextColor(White);
  252.     TextBackground(Red);
  253.     s:='Incorrect version of INFOPLUS.HLP!';
  254.     Window((vidwid div 2) - (Length(s) div 2) - 2, (vidlen div 2) - 2,
  255.            (vidwid div 2) + (Length(s) div 2) + 2, (vidlen div 2) + 2);
  256.     box;
  257.     ClrScr;
  258.     center(s);
  259.     Writeln;
  260.     Writeln('Found version: ', (thetable[63] / 100.0):0:2);
  261.     anykey;
  262.     cleanup;
  263.     filefound:=false;
  264.     Exit;
  265.     end;
  266.   Assign(infile, filename);
  267.   Reset(infile);
  268.   textseek(infile, thetable[pg]);
  269.   helphead:=nil;
  270.   previousptr:=nil;
  271.   nowptr:=nil;
  272.   endread:=false;
  273.   linecount:=0;
  274.   repeat
  275.     Readln(infile, s);
  276.     if s = '$END' then
  277.       endread:=true
  278.     else
  279.       if MaxAvail < SizeOf(helptextrec) then
  280.         begin
  281.         TextColor(White);
  282.         TextBackground(Red);
  283.         s:='Insufficient memory to read the ';
  284.         Window((vidwid div 2) - (Length(s) div 2) - 2, (vidlen div 2) - 3,
  285.                (vidwid div 2) + (Length(s) div 2) + 2, (vidlen div 2) + 3);
  286.         box;
  287.         ClrScr;
  288.         center(s);
  289.         Writeln;
  290.         center('full help page');
  291.         Writeln;
  292.         Writeln;
  293.         anykey;
  294.         endread:=true;
  295.         end
  296.       else
  297.         begin
  298.         New(nowptr);
  299.         if helphead = nil then
  300.           helphead:=nowptr
  301.         else
  302.           previousptr^.after:=nowptr;
  303.         nowptr^.before:=previousptr;
  304.         nowptr^.helptext:=s;
  305.         Inc(linecount);
  306.         nowptr^.lineno:=linecount;
  307.         nowptr^.after:=nil;
  308.         previousptr:=nowptr;
  309.         end;
  310.   until endread;
  311.   Close(infile);
  312.   end;
  313.  
  314. procedure showhelp;
  315.   var
  316.     c2: char2;
  317.     nowptr: helpptrtype;
  318.     height, helplength, topline, btmline: word;
  319.     endhelp: boolean;
  320.  
  321.   procedure showscreen(first, last: word);
  322.     var
  323.       nowptr: helpptrtype;
  324.  
  325.     begin
  326.     nowptr:=helphead;
  327.     GotoXY(1, 1);
  328.     while nowptr^.lineno <> first do
  329.       nowptr:=nowptr^.after;
  330.     while (nowptr^.lineno <= last) and (nowptr <> nil) do
  331.       begin
  332.       ClrEol;
  333.       if WhereY = height then
  334.         Write(nowptr^.helptext)
  335.       else
  336.         Writeln(nowptr^.helptext);
  337.       nowptr:=nowptr^.after
  338.       end;
  339.     end;
  340.  
  341.   begin
  342.   TextColor(White);
  343.   TextBackground(Blue);
  344.   Window(x2, tlength, twidth, tlength);
  345.   ClrScr;
  346.   Write('   PgUp PgDn Home End ESC');
  347.   Window(1, 3, twidth, tlength - 2);
  348.   ClrScr;
  349.   height:=Hi(WindMax) - Hi(WindMin) + 1;
  350.   nowptr:=helphead;
  351.   helplength:=0;
  352.   while nowptr <> nil do
  353.     begin
  354.     helplength:=nowptr^.lineno;
  355.     nowptr:=nowptr^.after
  356.     end;
  357.   nowptr:=helphead;
  358.   topline:=1;
  359.   if height >= helplength then
  360.     btmline:=helplength
  361.   else
  362.     btmline:=height;
  363.   showscreen(topline, btmline);
  364.   endhelp:=false;
  365.   repeat
  366.     c2:=getkey2;
  367.     case c2[1] of
  368.       #27: endhelp:=true;
  369.       #0: case c2[2] of
  370.             #$50: if btmline < helplength then {dn arrow}
  371.                     begin
  372.                     Inc(btmline);
  373.                     Inc(topline);
  374.                     showscreen(topline, btmline);
  375.                     end;
  376.             #$48: if topline > 1 then {up arrow}
  377.                     begin
  378.                     Dec(topline);
  379.                     Dec(btmline);
  380.                     showscreen(topline, btmline);
  381.                     end;
  382.             #$51: if btmline < helplength then {PgDn}
  383.                     begin
  384.                     Inc(btmline, height);
  385.                     Inc(topline, height);
  386.                     if btmline > helplength then
  387.                       begin
  388.                       btmline:=helplength;
  389.                       topline:=btmline - height + 1;
  390.                       end;
  391.                     showscreen(topline, btmline);
  392.                     end;
  393.             #$49: if topline > 1 then {PgUp}
  394.                     begin
  395.                     if topline <= height then
  396.                       begin
  397.                       topline:=1;
  398.                       btmline:=height;
  399.                       end
  400.                     else
  401.                       begin
  402.                       Dec(topline, height);
  403.                       Dec(btmline, height)
  404.                       end;
  405.                     showscreen(topline, btmline);
  406.                     end;
  407.             #$47: begin {Home}
  408.                   topline:=1;
  409.                   btmline:=height;
  410.                   showscreen(topline, btmline);
  411.                   end;
  412.             #$4F: begin {End}
  413.                   btmline:=helplength;
  414.                   topline:=btmline - height + 1;
  415.                   showscreen(topline, btmline)
  416.                   end;
  417.           end; {case c2[2]}
  418.     end; {case c2[1]}
  419.   until endhelp;
  420.   end;
  421.  
  422. procedure helpscreen(pg: byte; helpver: longint);
  423.   begin
  424.   setup;
  425.   readfile(pg, helpver);
  426.   if not filefound then
  427.     Exit;
  428.   showhelp;
  429.   clearheap;
  430.   cleanup;
  431.   end;
  432. end.
  433.