home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EGAMOV.ZIP / EGADISPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-03  |  4.3 KB  |  125 lines
  1. {$title:'EGADISPL.PAS Version 2.00' $pagesize:55 $linesize:96}
  2. {$symtab- $debug-}
  3. program egadisp1(input,output);
  4. const g320x200=16#0d;
  5.       g640x200=16#0e;
  6.       g640x350=16#10;
  7. type pic_arr=array [0..269,0..199] of byte;
  8.      pic_rec=record
  9.             max_count:word;
  10.             xcenter,ycenter,xdistance,ydistance:real8;
  11.             pic:pic_arr;
  12.          end;
  13.       chunk=record
  14.             val1,val2,val3,val4:lstring(23);
  15.             littlechunk : array[0..319,0..199] of byte;
  16.           end;
  17. function allmqq(wants:word):adsmem;extern;
  18. function egamove(mode:integer;bf1,bf2:adsmem):integer;extern;
  19.  
  20. var bfa1,bfa2:ads of byte;
  21.     i,result:integer;
  22.     w,r1,r2:word;
  23.     color:array [0..15] of byte;
  24. begin
  25.    bfa1:=allmqq(32000);r1:=bfa1.r;
  26.    if r1<=1 then
  27.       writeln('Memory cannot be allocated.')
  28.    else
  29.       begin
  30.          writeln('Making a 16 color buffer for 320x200 display.');
  31.          for i:=0 to 15 do color[i]:=wrd(i);
  32.          w:=0;
  33.          while w<32000 do
  34.             begin
  35.                i:=ord((w div 1600) mod 16);
  36.                if i=0 then i:=ord(w mod 16);
  37.                bfa1^:=color[i]+16*color[i];
  38.                w:=w+1;bfa1.r:=bfa1.r+1;
  39.             end;
  40.          bfa1.r:=r1;
  41.          writeln('Invoking function egamove.  ESC cancels display.');
  42.          w:=0;while w<maxword do w:=w+1;
  43.          result:=egamove(g320x200,bfa1,bfa1);
  44.          case result of
  45.             0:writeln('Display generated successfully.');
  46.             1:writeln('EGA not attached.');
  47.             2:writeln('Illegal mode invoked.');
  48.             otherwise writeln('Unknown error',result,' occured.')
  49.          end;
  50.       end;
  51.    bfa1:=allmqq(64000);r1:=bfa1.r;
  52.    if r1<=1 then
  53.       writeln('Memory cannot be allocated.')
  54.    else
  55.       begin
  56.          writeln('Making a 16 color buffer for 640x200 display.');
  57.          for i:=0 to 15 do color[i]:=wrd(i);
  58.          w:=0;
  59.          while w<64000 do
  60.             begin
  61.                i:=ord((w div 3200) mod 16);
  62.                if i=0 then i:=ord(w mod 16);
  63.                bfa1^:=color[i]+16*color[i];
  64.                w:=w+1;bfa1.r:=bfa1.r+1;
  65.             end;
  66.          bfa1.r:=r1;
  67.          writeln('Invoking function egamove.  ESC cancels display.');
  68.          w:=0;while w<maxword do w:=w+1;
  69.          result:=egamove(g640x200,bfa1,bfa1);
  70.          case result of
  71.             0:writeln('Display generated successfully.');
  72.             1:writeln('EGA not attached.');
  73.             2:writeln('Illegal mode invoked.');
  74.             otherwise writeln('Unknown error',result,' occured.')
  75.          end;
  76.       end;
  77.    bfa1:=allmqq(56000);r1:=bfa1.r;
  78.    bfa2:=allmqq(56000);r2:=bfa2.r;
  79.    if (r1<=1) or (r2<=1) then
  80.       writeln('Memory cannot be allocated.')
  81.    else
  82.       begin
  83.          writeln('Making two 8 color buffers for 640x350 display.');
  84.          for i:=0 to 15 do color[i]:=wrd(i);
  85.          w:=0;
  86.          while w<56000 do
  87.             begin
  88.                i:=ord((w div 6400) mod 8);
  89.                if i=0 then i:=ord(w mod 16);
  90.                bfa1^:=color[i]+16*color[i];
  91.                w:=w+1;bfa1.r:=bfa1.r+1;
  92.             end;
  93.          bfa1.r:=r1;
  94.          w:=0;
  95.          while w<56000 do
  96.             begin
  97.                i:=ord((w div 6400+8) mod 16);
  98.                if i=0 then i:=ord(w mod 16);
  99.                bfa2^:=color[i]+16*color[i];
  100.                w:=w+1;bfa2.r:=bfa2.r+1;
  101.             end;
  102.          bfa2.r:=r2;
  103.          writeln('Invoking function egamove.  ESC cancels display.');
  104.          w:=0;while w<maxword do w:=w+1;
  105.          result:=egamove(g640x350,bfa1,bfa2);
  106.          case result of
  107.             0:writeln('Display generated successfully.');
  108.             1:writeln('EGA not attached.');
  109.             2:writeln('Illegal mode invoked.');
  110.             otherwise writeln('Unknown error',result,' occured.')
  111.          end;
  112.       end;
  113.    bfa1.s:=#1000;bfa1.r:=0;bfa2.s:=#f000;bfa2.r:=0;
  114.    writeln('Using segments 1 and f for display.');
  115.    writeln('Invoking function egamove.  ESC cancels display.');
  116.    w:=0;while w<maxword do w:=w+1;
  117.    result:=egamove(g640x350,bfa1,bfa2);
  118.    case result of
  119.       0:writeln('Display generated successfully.');
  120.       1:writeln('EGA not attached.');
  121.       2:writeln('Illegal mode invoked.');
  122.       otherwise writeln('Unknown error',result,' occured.')
  123.    end
  124. end.{egadisp1}
  125.