home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / TPPCX256.ZIP / PALPLAY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-21  |  4KB  |  212 lines
  1. { Sample program for TPPCX-VGA256 }
  2. { Copyright 1992, Mark D. Rafn, MDRUtils (tm) }
  3.  
  4. program PALPLAY;
  5. uses uVesa, graph, crt, uVGA, uPal256, uPcxVGA;
  6.  
  7. var
  8.   Status: word;
  9.   Rows: integer;
  10.   Color: integer;
  11.   x, y: integer;
  12.   r,g,b: integer;
  13.   BarW, BarH, TxtX, TxtY: integer;
  14.   VGAStatus: integer;
  15.   Dac16: aDac_16;
  16.   Rown, Rownx: string;
  17.   V: PVesa;              { VESA object }
  18.   VgaAdapter: PVga;      { VGA object  }
  19.   Adapter: PVga;         { VGA object }
  20.  
  21. procedure Pause;
  22. begin
  23.   repeat until keypressed;
  24.   MemW[ $0000:$041C ] := MemW[ $0000:$041A ];
  25. end;
  26.  
  27. procedure EraseText;
  28. var
  29.   WinWidth: integer;
  30.   bx1,bx2,by1,by2: integer;
  31. begin
  32.   SetFillStyle(SolidFill,Black);
  33.   WinWidth := (V^.StateInfo.NoCharCols * 8) - 1;
  34.   bx1 := 0;
  35.   by1 := TxtY;
  36.   bx2 := WinWidth;
  37.     by2 := TxtY + TextHeight('Mg');
  38.   Bar(bx1,by1,bx2,by2);
  39. end;
  40.  
  41. procedure WriteOut(S : string);
  42. begin
  43.   EraseText;
  44.   V^.SetColor(255,63,63,63);
  45.   Color := 255;
  46.   SetColor(Color);
  47.   SetTextStyle(DefaultFont, HorizDir, 1);
  48.   SetTextJustify(LeftText,TopText);
  49.   OutTextXY(Txtx, Txty, S);
  50. end; { WriteOut }
  51.  
  52. procedure DoBars;
  53. var
  54.   i,j: integer;
  55. begin
  56.   SetColor(DarkGray);
  57.   x := 0;
  58.   y := 0;
  59.   for i := 0 to 15 do
  60.   begin
  61.     x := 0;
  62.     for j := 0 to 15 do
  63.     begin
  64.       SetFillStyle(SolidFill, (i * 16)+j);
  65.       Bar(x, y, x + BarW, y + BarH);
  66.       Rectangle(x, y, x + BarW, y + BarH);
  67.       x := x + BarW + 5;
  68.     end;
  69.     y := y + BarH + 5;
  70.   end;
  71.   x := 0;
  72.   WriteOut('Default VGA palette (color #255 will be reset for text.)');
  73.   Pause;
  74. end;
  75.  
  76. {
  77. procedure PCXPalette;
  78. var  Pcx: PPcx;
  79. begin
  80.   WriteOut('Reading PCX file...please wait');
  81.   Pcx := nil;
  82.   Pcx := New(PPcxVESA, Init('COLOR256.PCX'));
  83.   if not (Pcx = nil) then
  84.     Pcx^.Decode(ToRam);
  85.   if PcxError = 0 then
  86.       Pcx^.Set_Palette;
  87.   Dispose(Pcx, Done);
  88.     WriteOut('Switched to PCX palette.');
  89.   Pause;
  90. end;
  91. }
  92.  
  93. procedure CycleBGI;
  94. begin
  95.   for Rows := 0 to 15 do
  96.   begin
  97.     Str(Rows * 16, Rown);
  98.     Str((Rows * 16 + 15), Rownx);
  99.     WriteOut('Cycling BGI 16 color palette by rows, color '+ Rown +' to color '+ Rownx);
  100.     V^.ReadColorBlock(Rows * 16, 16, @Dac16);
  101.     V^.SetColorBlock(Rows * 16, 16, @Dac16_BGI);
  102.     Pause;
  103.     V^.SetColorBlock(Rows * 16, 16, @Dac16);
  104.   end;
  105. end;
  106.  
  107. procedure GrayScale;
  108. begin
  109.   WriteOut('Summing colors to gray scale');
  110.   V^.SumToGray(0, 256);
  111.   pause;
  112. end;
  113.  
  114. procedure Rows_Default;
  115. begin
  116.   WriteOut('Resetting each row to default setting');
  117.   for Rows := 0 to 15 do
  118.   begin
  119.     V^.ResetPalette(Rows * 16, 16);
  120.     pause;
  121.   end;
  122. end;
  123.  
  124. procedure UserBlocks;
  125. begin
  126.   WriteOut('Setting user described blocks x 16 - Red Yellow scale');
  127.   V^.SetColorBlock(1*16, 16, @Dac16_Red);
  128.   pause;
  129.   WriteOut('Setting user described blocks x 16 - Green Cyan scale');
  130.   V^.SetColorBlock(2*16, 16, @Dac16_Green);
  131.   pause;
  132.   WriteOut('Setting user described blocks x 16 - Blue Magenta scale');
  133.   V^.SetColorBlock(3*16, 16, @Dac16_Blue);
  134.   pause;
  135. end;
  136.  
  137. procedure ResetAll;
  138. begin
  139.   WriteOut('Resetting complete palette to default');
  140.   V^.ResetPalette(0, 256);
  141.   pause;
  142. end;
  143.  
  144. procedure Set4Color;
  145. var
  146.   Number: integer;
  147.   i: integer;
  148. begin
  149.   Number := 0;
  150.   for i := 0 to 63 do
  151.   begin
  152.     V^.SetColor(Number,i,i,i);
  153.     Inc(Number);
  154.   end;
  155.   for i := 0 to 63 do
  156.   begin
  157.     V^.SetColor(Number,i,0,0);
  158.     Inc(Number);
  159.   end;
  160.   for i := 0 to 63 do
  161.   begin
  162.     V^.SetColor(Number,0,i,0);
  163.     Inc(Number);
  164.   end;
  165.   for i := 0 to 63 do
  166.   begin
  167.     V^.SetColor(Number,0,0,i);
  168.     Inc(Number);
  169.   end;
  170.   WriteOut('Setting individual colors to primary gradients.');
  171.   Pause;
  172. end;
  173.  
  174. begin
  175.   if not Vga_Detect then Halt;
  176.   Adapter := New(PVesa, Init);
  177.   { is VESA present? }
  178.   if Adapter <> nil then
  179.   begin
  180.     { VESA is present }
  181.     V := PVesa(Adapter);
  182.     InitBGI_Vesa(V);
  183.       BGI_SetVESAMode(V, VESA_max)
  184.   end
  185.   else
  186.   begin
  187.     Adapter := New(PVga, Init);
  188.     {Initialize graphics}
  189.     InitBGI_Vga(Adapter, Vga_256);
  190.     V := PVesa(Adapter);
  191.     { standard BGI mode calls plus additional mode 13h }
  192.     { VGAlo, VGAmed, VGAhi, VGA_256 (13h) }
  193.   end;
  194.  
  195.   BarH := ((V^.StateInfo.NoCharRows *
  196.       V^.StateInfo.BytesperChar) div 17) - 5;
  197.   BarW := BarH;
  198.   TxtY := ((BarH + 5) * 16);
  199.   TxtX := 0;
  200.  
  201.   Dobars;
  202. { PcxPalette;}
  203.   CycleBGI;
  204.   GrayScale;
  205.   Rows_Default;
  206.   GrayScale;
  207.   UserBlocks;
  208.   Set4Color;
  209.   ResetAll;
  210.  
  211. end.
  212.