Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MCGA.ZIP/RAINBOW.PAS

Pascal/Delphi Source File | 1987-10-02 | 5.6 KB | 178 lines

procedure RainbowMode;
  var
    regs : record
             AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
           end;
  begin
    regs.ax := $0013;
    intr($10,regs);
  end {RainbowMode};

procedure NormalMode;
  var
    regs : record
             AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
           end;
  begin
    regs.ax := $0003;
    intr($10,regs);
  end {NormalMode};

function Color(hue,chroma, intensity : integer) : integer;
  begin
    Color := (intensity * 3 + chroma) * 24 + hue + 32;
  end {Color};

procedure plot(x,y,color : integer);
  begin
    mem[$A000:y*320+x] := color;
  end {plot};

procedure FillArea(x,y,w,h,c : integer);
  var
    a,r : integer;
  begin
    a := 320 * y + x;
    for r := 1 to h do begin
      FillChar(mem[$A000:a],w,lo(c));
      a := a + 320;
    end;
  end {FillArea};

procedure FillTop(x,y,w,h,c : integer);
  var
    a,r : integer;
  begin
    a := 320 * y + x;
    for r := 1 to h do begin
      FillChar(mem[$A000:a],w,lo(c));
      a := a + 319;
    end;
  end {FillArea};

procedure FillSide(x,y,w,h,c : integer);
  var
    a,r : integer;
  begin
    a := 320 * succ(y-h) + x;
    for r := 1 to h div 2 do begin
      FillChar(mem[$A000:a],r,lo(c));
      a := a + 319;
    end;
    a := a - 319;
    for r := w downto 1 do begin
      FillChar(mem[$A000:a],w,lo(c));
      a := a + 320;
    end;
    a := a - 320;
    for r := h - h div 2 downto 1 do begin
      FillChar(mem[$A000:a],r,lo(c));
      a := a + 320;
    end;
  end {FillArea};

procedure DrawCube(x,y,h:integer);
  begin
    FillTop(x-16,y-16,32,16,Color(h,0,0));
    FillArea(x-32,y,32,32,Color(h,0,1));
    FillSide(x+15,y+16,16,32,Color(h,0,2));
  end {DrawCube};

procedure Wait;
  var
    c : char;
  begin
    repeat
    until KeyPressed;
    read(kbd,c);
    while KeyPressed do
      read(kbd,c);
  end {Wait};

var
  h,c,i,x,y : integer;

const
  Cube : array[1..6] of record x,y,color:integer end =
     ((x:128;y:106;color:12), (x:180;y:106;color:20), (x:232;y:106;color: 8),
      (x:154;y: 74;color: 4), (x:206;y: 74;color: 0), (x:180;y: 42;color:16));

begin
  ClrScr;
  GotoXY((80-51) div 2,1);
  writeln('Welcome to the Wonderful World of Mode 19 Graphics!');
  GotoXY(1,3);
  writeln('    Mode 19 is the 320x200 pixel graphics mode availble on all of the new IBM ');
  writeln('PS/2 computers, whether equiped with the MCGA (models 25 and 30) or the VGA   ');
  writeln('(models 50, 60, and 80).  This program will show the default palette settings ');
  writeln('for the new mode.                                                             ');
  writeln('    The first screen will show all 256 values.  The values are displayed in   ');
  writeln('order from left to right, moving down the screen.  They are grouped according ');
  writeln('to how they would be used by a program.                                       ');
  writeln('    Rows 1 and 2 show 16 values each.  The first are the old CGA colors, the  ');
  writeln('second are shades of grey.  The next 9 rows show 24 values each.  Each row    ');
  writeln('displays a full spectrum of hues, with each row differing in the chroma and   ');
  writeln('the intensity of the color.  The last row contains the 12 "dead" colors.  They');
  writeln('are all defined in the palette table as black.                                ');
  writeln('    The second screen shows the center 144 values from the previous screen,   ');
  writeln('arranged in a different format.  Each of the 24 large squares has a single hue');
  writeln('displayed, sub-divided into 9 small squares showing variation of chroma and   ');
  writeln('intensity values.                                                             ');
  writeln('    The background color on both screens is a dim, pastel yellow, specifically');
  writeln('the rightmost of the two colors at the center of the 24x9 array on the first  ');
  writeln('screen.  The color may be found on the second screen at the center of the big ');
  writeln('square in the first column, third row.                                        ');
  writeln('    The third screen is just for fun.                                         ');
  GotoXY(51,25);
  Write('Press any key to continue...');
  Wait;
  RainbowMode;
  FillArea(0,0,320,200,Color(12,1,1));
  { 0 to 15 are "standard" colors }
  { 16 to 31 are shades of grey }
  for h := 0 to 31 do begin
    x := (h mod 16 + 4) * 12 + 16;
    y := (h div 16) * 24 + 12;
    FillArea(x,y,12,12,h);
  end;
  { 32 to 247 is a spectrum }
  { 24 hues x 3 chroma levels x 3 intensities }
  for h := 0 to 215 do begin
    x := (h mod 24) * 12 + 16;
    y := (h div 24 + 4) * 12 + 12;
    FillArea(x,y,12,12,h+32);
  end;
  { 248 to 255 are all black }
  for h := 0 to 7 do begin
    x := (h mod 16 + 4) * 12 + 64;
    y := (h div 16 + 15) * 12;
    FillArea(x,y,12,12,h+248);
  end;
  Wait;
  FillArea(0,0,320,200,Color(12,1,1));
  for h := 0 to 23 do begin
    for c := 0 to 2 do
      for i := 0 to 2 do
        FillArea((h mod 6)*50+11 + c*16,(h div 6)*50+1 + i*16,
                 16,16,Color(h,c,i));
  end;
  Wait;
  { draw room }
  FillArea(0,0,320,135,Color(2,1,1));
  FillArea(0,135,320,65,Color(7,1,1));
  delay(500);
  { draw table }
  FillArea(102,102,6,80,Color(11,1,2));
  FillArea(293,102,6,80,Color(11,1,2));
  FillArea(52,148,6,52,Color(11,1,2));
  FillArea(243,148,6,52,Color(11,1,2));
  FillTop(100,100,200,50,Color(11,1,1));
  { draw boxes }
  for i := 1 to 6 do begin
    delay(500);
    DrawCube(Cube[i].x,Cube[i].y,Cube[i].color);
  end;
  delay(500);
  Wait;
  NormalMode;
end.