home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / lowres / lowres.pas
Encoding:
Pascal/Delphi Source File  |  1986-02-25  |  3.3 KB  |  153 lines
  1. program Lo_Res_Graphics;
  2.  
  3. type
  4.     scr            =    array[1..16000] of byte;
  5.     color          =    array[0..7] of byte;
  6.  
  7. const
  8.     blue    :color =    (1,16,9,24,18,51,26,110);
  9.     green   :color =   (2,37,31,10,39,102,85,115);
  10.     cyan    :color =   (17,32,25,52,94,86,116,125);
  11.     red     :color =   (4,58,62,12,66,126,131,132);
  12.     magneta :color =   (5,19,73,59,71,27,78,130);
  13.     brown   :color =   (6,81,83,41,87,68,128,133);
  14.     gray    :color =   (0,8,100,7,92,107,90,135);
  15.  
  16. var
  17.     i,j,k,l        :    byte;
  18.     stop           :    char;
  19.     screen         :    scr absolute $B800:$0000;
  20.     color_table    :    array[0..135,0..1] of byte;
  21.  
  22. Procedure Set_Lo_Res;
  23. type
  24.     reg            =    array[0..11] of byte;
  25. const
  26.     modereg        =    $03D8;
  27.     colorreg       =    $03D9;
  28.     crtreg         =    $03D4;
  29.     crtdata        =    $03D5;
  30.     regdata:  reg  =    (113,80,90,10,127,6,100,112,2,1,32,0);
  31. var
  32.     i              :    byte;
  33.     j              :    integer;
  34.     modesave       :    byte absolute $0000:$0465;
  35.     colorsave      :    byte absolute $0000:$0466;
  36. begin
  37.     modesave:=0;
  38.     port[modereg]:=0;
  39.     colorsave:=0;
  40.     port[colorreg]:=0;
  41.     for i:=0 to 11 do
  42.     begin
  43.      port[crtreg]:=i;
  44.      port[crtdata]:=regdata[i];
  45.     end;
  46.     for j:=1 to 16000 do
  47.     begin
  48.      screen[j]:=177;
  49.      j:=j+1;
  50.      screen[j]:=0;
  51.     end;
  52.     modesave:=9;
  53.     port[modereg]:=9;
  54.     end;
  55.  
  56. procedure Set_Text_Mode;
  57. type
  58.     reg            =    array[0..11] of byte;
  59. const
  60.     crtreg         =    $03D4;
  61.     crtdata        =    $03D5;
  62.     regdata:  reg  =    (113,80,90,10,31,6,25,28,2,7,6,7);
  63. var
  64.     i              :    byte;
  65. begin
  66.     for i:=0 to 11 do
  67.     begin
  68.      port[crtreg]:=1;
  69.      port[crtdata]:=regdata[i];
  70.     end;
  71.     textmode(3);
  72.     clrscr;
  73. end;
  74.  
  75. procedure Clear_Screen;
  76. var
  77.     i              :    integer;
  78. begin
  79.     for i:=1 to 16000 do
  80.     begin
  81.      i:=i+1;
  82.      screen[i]:=0;
  83.     end;
  84. end;
  85.  
  86. Procedure Set_Colors;
  87. var
  88.     i,c,fg,bg      :    byte;
  89. begin
  90.     c:=0;
  91.     for i:=0 to 255 do
  92.     begin
  93.      bg:=i div 16;
  94.      fg:=i mod 16;
  95.      if bg<=fg then
  96.      begin
  97.       color_table[c,0]:=bg;
  98.       color_table[c,1]:=fg;
  99.       c:=c+1;
  100.      end;
  101.     end;
  102. end;
  103.  
  104. procedure Point(x,y,c:integer);
  105. var
  106.     bg,fg          :    integer;
  107. begin
  108.     bg:=color_table[c,0];
  109.     fg:=color_table[c,1];
  110.     screen[2*(x+1)+160*y]:=fg+bg*16;
  111. end;
  112.  
  113. procedure Display_All_Colors;
  114. var
  115.     i,j,k,l        :    integer;
  116. begin
  117.     for i:=0 to 16 do
  118.      for j:=0 to 7 do
  119.       for k:=0 to 3 do
  120.        for l:=0 to 11 do
  121.         point(i*4+k,j*12+l,8*i+j);
  122. end;
  123.  
  124. procedure Display_Palette;
  125. var
  126.     i,j,k          :    integer;
  127. begin
  128.     for i:=0 to 7 do
  129.      for j:=0 to 3 do
  130.       for k:=0 to 11 do
  131.       begin
  132.        point(4*i+j,k,blue[i]);
  133.        point(4*i+j,k+12,green[i]);
  134.        point(4*i+j,k+24,cyan[i]);
  135.        point(4*i+j,k+36,red[i]);
  136.        point(4*i+j,k+48,magneta[i]);
  137.        point(4*i+j,k+60,brown[i]);
  138.        point(4*i+j,k+72,gray[i]);
  139.       end;
  140. end;
  141.  
  142. begin
  143.     Set_Lo_Res;
  144.     Set_Colors;
  145.     Display_All_Colors;
  146.     read(Kbd,stop);
  147.     Clear_Screen;
  148.     Display_Palette;
  149.     read(kbd,stop);
  150.     clear_screen;
  151.     Set_Text_Mode;
  152. end.
  153.