home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / AMOD095.ZIP / LIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-25  |  7.3 KB  |  369 lines
  1. unit list;
  2. interface
  3. uses crt,dos;
  4. {$s-}
  5. const
  6.   maxline = 250;
  7.   t_none = 0;
  8.   t_mod = 1;
  9.   t_zip = 2;
  10.   t_dir = 3;
  11.   t_drive = 4;
  12.  
  13. type
  14. t_memarray = array[0..8000] of byte;
  15. t_line = record
  16.            s : array[0..2] of string[20];
  17.            t : integer;
  18.            tagged : boolean;
  19.          end;  
  20. t_linea = array[0..maxline] of t_line;
  21. p_linea = ^t_linea;
  22. t_list = object
  23.            x1,y1,x2,y2 : integer;
  24.            c1x,c2x,c3x : integer;
  25.            size,len : integer;
  26.            curline,startline : integer;
  27.            lines : p_linea;
  28.            tilt : t_line;
  29.            numtagged : integer;
  30.            procedure insline(s,s2,s3 : string;t : integer);
  31.            procedure delline;
  32.            procedure delete;
  33.            procedure init(maxline,minx,miny,maxx,maxy : integer;pic : pointer);
  34.            procedure done;
  35.            procedure draw;
  36.            procedure drawline(cline : integer);
  37.            procedure upline;
  38.            procedure downline;
  39.            procedure uppage;
  40.            procedure downpage;
  41.            procedure goend;
  42.            procedure gohome;
  43.            procedure gotokey(key : char);
  44.            procedure tagline;
  45.            procedure strswap(s1,s2 : integer);
  46.            function compare(a : integer):integer;
  47.            procedure sort(top,bottom : integer);
  48.            procedure qsort;
  49.          end;
  50.  
  51.  
  52. implementation
  53. var
  54. piccy : ^t_memarray;
  55.  
  56. procedure hiline(x,y,xl,c : integer); assembler;
  57. asm
  58.   dec  y
  59.   push ds
  60.   mov  ds,word ptr piccy+2
  61.   mov  ax,160
  62.   mul  y
  63.   add  ax,x
  64.   add  ax,x
  65.   mov  di,ax
  66.   mov  si,ax
  67.   mov  ax,0b800h
  68.   mov  es,ax
  69.   mov  cx,xl
  70.   mov  bx,c
  71. @@1:
  72.   mov  al,[si+1]
  73.   and  al,15
  74.   or   al,16
  75.   mov  es:[di+1],al
  76.   add  di,2
  77.   add  si,2
  78.   loop @@1
  79.   pop  ds
  80. end;
  81.  
  82. procedure orgline(x,y,xl : integer);
  83. var
  84. o : word;
  85. begin
  86.   o := (y-1)*160+x*2;
  87.   move(piccy^[o],mem[$b800:o],xl*2);
  88. end;
  89.  
  90. procedure fastwrite(x,y : word;s : string);
  91. begin
  92. {l := byte(s[0]);
  93. if l = 0 then exit;
  94. for n := 1 to l do mem[$b800:(y-1)*160+(x-1)*2+n*2-2] := byte(s[n]);}
  95. asm
  96.     push ds
  97.     mov  ax,ss
  98.     mov  ds,ax
  99.     mov  ax,0b800h
  100.     mov  es,ax
  101.     lea  si,s
  102.     lodsb
  103.     cmp  al,0
  104.     jne  @@2
  105.     jmp  @@end
  106. @@2:
  107.     mov  cl,al
  108.     xor  ch,ch
  109.     mov  di,y
  110.     dec  di
  111.     dec  x
  112.     mov  ax,160
  113.     mul  di
  114.     mov  di,ax
  115.     add  di,x
  116.     add  di,x
  117. @@1:
  118.     movsb
  119.     inc  di
  120.     loop @@1
  121. @@end:
  122.     pop  ds
  123. end;
  124. end;
  125.  
  126. procedure t_list.init(maxline,minx,miny,maxx,maxy : integer;pic : pointer);
  127. begin
  128.   piccy := pic;
  129.   size := maxline;
  130.   len := 0;
  131.   curline := 0;
  132.   startline := 1;
  133.   x1 := minx;
  134.   y1 := miny;
  135.   y2 := maxy;
  136.   x2 := maxx;
  137.   c1x := 1;
  138.   c2x := 20;
  139.   c3x := 40;
  140.   numtagged := 0;
  141.   getmem(lines,sizeof(t_line)*size);
  142. end;
  143.  
  144. procedure t_list.done;
  145. begin
  146.   freemem(lines,sizeof(t_line)*size);
  147. end;
  148.  
  149. procedure t_list.delete;
  150. begin
  151.   startline := 1;
  152.   curline := 1;
  153.   len := 0;
  154. end;
  155.  
  156. procedure t_list.delline;
  157. begin
  158.   if len > 0 then dec(len);
  159.   if curline > len then curline := len;
  160.   if startline > curline then startline := curline;
  161. end;
  162.  
  163. procedure t_list.insline(s,s2,s3 : string;t : integer);
  164. begin
  165.   if len >= size then exit;
  166.   inc(len);
  167.   lines^[len].s[0] := s;
  168.   lines^[len].s[1] := s2;
  169.   lines^[len].s[2] := s3;
  170.   lines^[len].t := t;
  171.   lines^[len].tagged := false;
  172.   if curline = 0  then curline := 1;
  173. end;
  174.  
  175. procedure t_list.upline;
  176. begin
  177.   if curline > 1 then dec(curline);
  178.   if curline < startline then begin
  179.     dec(startline);
  180.     draw;
  181.   end
  182.   else begin
  183.     drawline(curline+1);
  184.     drawline(curline);
  185.   end;
  186. end;
  187.  
  188. procedure t_list.downline;
  189. begin
  190.   if curline < len then inc(curline);
  191.   if curline > startline+y2-y1 then begin
  192.     inc(startline);
  193.     draw;
  194.   end
  195.   else begin
  196.     drawline(curline-1);
  197.     drawline(curline);
  198.   end;
  199. end;
  200.  
  201. procedure t_list.uppage;
  202. begin
  203.   if curline > startline then begin
  204.     curline := startline;
  205.   end
  206.   else begin
  207.     if curline > (y2-y1) then begin
  208.       dec(curline,y2-y1);
  209.       startline := curline;
  210.     end
  211.     else begin
  212.       curline := 1;
  213.       startline := 1;
  214.     end;
  215.   end;
  216.   draw;
  217. end;
  218.  
  219. procedure t_list.downpage;
  220. begin
  221.   if curline < startline+y2-y1 then begin
  222.     curline := startline+y2-y1;
  223.     if curline > len then curline := len;
  224.   end
  225.   else begin
  226.     inc(curline,y2-y1);
  227.     if curline > len then curline := len;
  228.     startline := curline-y2+y1;
  229.   end;
  230.   draw;
  231. end;
  232.  
  233. procedure t_list.goend;
  234. begin
  235.   curline := len;
  236.   if curline > y2-y1 then startline := curline-y2+y1
  237.   else startline := 1;
  238.   draw;
  239. end;
  240.  
  241. procedure t_list.gohome;
  242. begin
  243.   curline := 1;
  244.   startline := 1;
  245.   draw;
  246. end;
  247.  
  248. procedure t_list.gotokey(key : char);
  249. var
  250. n,i : integer;
  251. sline,dline : integer;
  252. begin
  253.   dline := 1;
  254.   sline := curline;
  255.   while (dline < len) and (lines^[dline].s[0][1] < key) do inc(dline);
  256.   if dline > curline then
  257.     for i := dline-1 downto sline do downline
  258.   else if dline < curline then
  259.     for i := dline+1 to sline do upline;
  260.   draw;
  261. end;
  262.  
  263. procedure t_list.tagline;
  264. begin
  265.   if lines^[curline].tagged then begin
  266.     lines^[curline].tagged := false;
  267.     dec(numtagged);
  268.   end
  269.   else begin
  270.     lines^[curline].tagged := true;
  271.     inc(numtagged);
  272.   end;
  273.   drawline(curline);
  274. end;
  275.  
  276. procedure t_list.draw;
  277. var
  278. n,cline : integer;
  279. wmin,wmax : integer;
  280. begin
  281.   for n := 1 to y2-y1+1 do begin
  282.     cline := startline+n-1;
  283.     if cline <= len then begin
  284.       if cline=curline then begin
  285.         orgline(x1-1,n+y1-1,50);
  286.         hiline(x1-1,n+y1-1,12,16);
  287.       end
  288.       else orgline(x1-1,n+y1-1,50);
  289.       fastwrite(x1,n+y1-1,lines^[cline].s[0]);
  290.       fastwrite(c2x+x1-1,n+y1-1,lines^[cline].s[1]);
  291.       fastwrite(c3x+x1-1,n+y1-1,lines^[cline].s[2]);
  292.     end;
  293.   end;
  294. end;
  295.  
  296. procedure t_list.drawline(cline : integer);
  297. var
  298. n : integer;
  299. wmin,wmax : integer;
  300. begin
  301.   n := cline-startline+1;
  302.   if (n > 0) and (n <= y2-y1+1) then if cline <= len then begin
  303.     if cline=curline then hiline(x1-1,n+y1-1,12,16)
  304.     else orgline(x1-1,n+y1-1,50);
  305.     fastwrite(x1,n+y1-1,lines^[cline].s[0]);
  306.     fastwrite(c2x+x1-1,n+y1-1,lines^[cline].s[1]);
  307.     fastwrite(c3x+x1-1,n+y1-1,lines^[cline].s[2]);
  308.   end;
  309. end;
  310.  
  311.  
  312. procedure t_list.strswap(s1,s2 :integer);
  313. var
  314. t : t_line;
  315. begin
  316.   t := lines^[s1];
  317.   lines^[s1] := lines^[s2];
  318.   lines^[s2] := t;
  319. end;
  320.  
  321. function t_list.compare(a : integer):integer;
  322. var
  323. s : string;
  324. t1,t2 : integer;
  325. begin
  326.   t1 := lines^[a].t;
  327.   t2 := tilt.t;
  328.   {if t1 = t_zip then t1 := t_mod;
  329.   if t2 = t_zip then t2 := t_mod;}
  330.   if t1 < t2 then compare := -1
  331.   else if t1 > t2 then compare := 1
  332.   else if lines^[a].s[0] < tilt.s[0] then compare := -1
  333.   else if lines^[a].s[0] > tilt.s[0] then compare := 1
  334.   else compare := 0;
  335. end;
  336.  
  337. procedure t_list.sort(top,bottom : integer);
  338. var
  339. i,j : integer;
  340. x : string[20];
  341. begin
  342.   i := top;
  343.   j := bottom;
  344.   x := lines^[(top+bottom) div 2].s[0];
  345.   tilt.s[0] := x;
  346.   tilt.t := lines^[(top+bottom) div 2].t;
  347.   repeat
  348.     while {lines^[i].s[0] < x]} compare(i)=-1 do inc(i);
  349.     while {(x < lines^[j].s[0])} compare(j)=1 do dec(j);
  350.     if i < j then begin
  351.       strswap(i,j);
  352.     end;
  353.     if i <= j then begin
  354.       inc(i);
  355.       dec(j);
  356.     end;
  357.   until i > j;
  358.   if top < j then sort(top,j);
  359.   if i < bottom then sort(i,bottom);
  360. end;
  361.  
  362. procedure t_list.qsort;
  363. begin
  364.   sort(1,len);
  365. end;
  366.  
  367. end.
  368.  
  369.