Category : Files from Magazines
Archive   : PCTV1N2.ZIP
Filename : VGAMIXER.PAS

 
Output of file : VGAMIXER.PAS contained in archive : PCTV1N2.ZIP
PROGRAM VgaColorMixer;
{ Michael A. Covington 1990 }

USES Crt,Dos;

CONST Quality: ARRAY[1..5] OF String[12] =
('Redness','Greenness','Blueness','Saturation','Intensity');

CONST
C: INTEGER = 1; { Color being edited }
Q: INTEGER = 1; { Quality being edited }

R: ARRAY[1..3] OF REAL = (63.05, 0, 0); { Red component }
G: ARRAY[1..3] OF REAL = ( 0, 63.05, 0); { Green component }
B: ARRAY[1..3] OF REAL = ( 0, 0, 63.05); { Blue component }


PROCEDURE SetRgbPalette(ColorNum,Red,Green,Blue:INTEGER);
{ Like the SetRgbPalette procedure provided
in GRAPH.TPU, but does not require .BGI files.
Copy and use in your own programs. }
VAR
R: Registers;
BEGIN
R.ax := $1010;
R.bx := ColorNum;
R.dh := Red;
R.ch := Green;
R.cl := Blue;
Intr($10,R)
END;

PROCEDURE HideCursor;
{ For VGA and most others. Undone by textmode(co80). }
VAR
R: Registers;
BEGIN
R.cx := $2000; { Start cursor on scan line $20, end on $00 }
R.ah := 1; { i.e., end it before it starts }
Intr($10,R)
END;


PROCEDURE Block(Left,Upper,Right,Lower,Color: INTEGER);
VAR
Row, Col: INTEGER;
BEGIN
TextColor(Color);
FOR Row := Upper TO Lower DO
FOR Col := Left TO Right DO
BEGIN
GoToXY(Col,Row); write(#219)
END;
TextColor(White);
END;

PROCEDURE Box(Left,Upper,Right,Lower,Color: INTEGER);
BEGIN
Block(Left,Upper,Left,Lower,Color);
Block(Right,Upper,Right,Lower,Color);
Block(Left,Upper,Right,Upper,Color);
Block(Left,Lower,Right,Lower,Color)
END;

PROCEDURE WriteCentered(Msg:String;Row,Color:INTEGER);
BEGIN
GoToXY(40-(length(Msg) div 2),Row);
write(Msg)
END;

PROCEDURE WriteInverse(Msg:String);
BEGIN
TextBackground(White);
TextColor(Black);
write(Msg);
TextColor(White);
TextBackground(Black)
END;

PROCEDURE UpdateColors;
{ Updates just those parts of the screen that change }
{ when the user alters a color quality }
VAR
j, red, green, blue: INTEGER;

BEGIN

SetRgbPalette(4,round(R[C]),round(G[C]),round(B[C]));
{ Color 4 will always be the color currently being edited }

FOR j:=1 TO 3 DO
BEGIN
SetRgbPalette(j,round(R[j]),round(G[j]),round(B[j]));

{ Label the colors }

TextColor(White);
GoToXY(20*j-3,9);
IF j=C THEN
WriteInverse('Color '+chr(ord('0')+j))
ELSE
write('Color '+chr(ord('0')+j));

GoToXY(20*j-7,7);
IF j=C THEN
TextColor(White)
ELSE
TextColor(LightGray);
Write( 'R=',round(R[j]):2,
' G=',round(G[j]):2,
' B=',round(B[j]):2);

END;

{ Update the menu of qualities }

TextBackground(Black); TextColor(White);
GoToXY(11,19);
FOR j:=1 TO 5 DO
BEGIN
IF j=Q THEN
WriteInverse(Quality[j])
ELSE
Write(Quality[j]);
Write(' ')
END


END;


PROCEDURE UpdateScreen;
VAR
j,k: INTEGER;
BEGIN
TextMode(Co80); { Clears screen and resets colors }
HideCursor;
UpdateColors;

Box(1,1,80,21,DarkGray);
WriteCentered('V G A C o l o r M i x e r',3,White);
WriteCentered('TAB chooses color to edit',22,White);
WriteCentered(
#$1B + ' ' + #$1A + ' choose a quality to alter',
23,White);
WriteCentered(
#$18 + ' increases and ' + #$19 + ' decreases that quality',
24,White);
WriteCentered('Alt-X ends program',25,White);

{ Color swatches }

Block(11,5,29,6,1);
Block(31,5,49,6,2);
Block(51,5,69,6,3);

{ Large patch of the color currently being edited }
Block(11,11,69,15,4);

{ Text samples }

GoToXY(10,17);
FOR j:=1 to 3 DO
FOR k:=1 TO 3 DO
IF j<>k THEN
BEGIN
TextBackground(Black); Write(' ');
TextBackground(j);
TextColor(k);
Write(' ',k,' on ',j,' ')
END;
TextBackground(Black);

END;


FUNCTION Min(X,Y,Z:REAL):REAL;
BEGIN
IF X { Minimum is not Y }
IF X ELSE
{ Minimum is not X }
IF Y END;

FUNCTION Max(X,Y,Z:REAL):REAL;
BEGIN
IF X>Y THEN
{ Maximum is not Y }
IF X>Z THEN Max:=X ELSE Max:=Z
ELSE
{ Maximum is not X }
IF Y>Z THEN Max:=Y ELSE Max:=Z
END;


{ Main }

VAR
Keys: string;
Top, Factor: real;

BEGIN
UpdateScreen;
Keys := '';
WHILE TRUE DO
BEGIN
IF Keys = '' then Keys := ReadKey;
CASE Keys[1] OF
#09 : { Tab }
BEGIN
C := C MOD 3 + 1;
UpdateColors
END;
#27 : { First byte of any non-ASCII key }
{ do nothing };
#72 : { Up arrow }
BEGIN
CASE Q OF
1: IF R[C]<62.5 THEN R[C] := R[C]+1;
2: IF G[C]<62.5 THEN G[C] := G[C]+1;
3: IF B[C]<62.5 THEN B[C] := B[C]+1;
4: { Up saturation }
BEGIN
Top := Max(R[C],G[C],B[C]);
IF Min(R[C],G[C],B[C]) > 0.5 THEN
BEGIN
Factor := (Top-Min(R[C],G[C],B[C]));
IF Factor > 0 THEN
BEGIN
Factor := 1/Factor;
R[C] := R[C] + Factor*(R[C] - Top);
G[C] := G[C] + Factor*(G[C] - Top);
B[C] := B[C] + Factor*(B[C] - Top)
END
END
END;
5: { Up intensity }
IF Max(R[C],G[C],B[C])<62.5 THEN
BEGIN
R[C] := R[C]*1.01;
G[C] := G[C]*1.01;
B[C] := B[C]*1.01
END
END;
UpdateColors
END;
#73 : { PgUp = five Up Arrows }
Keys := Keys[1]+#72+#72+#72+#72+#72+copy(Keys,2,255);
#80 : { Down arrow }
BEGIN
CASE Q OF
1: IF R[C]>=0.5 THEN R[C] := R[C]-1;
2: IF G[C]>=0.5 THEN G[C] := G[C]-1;
3: IF B[C]>=0.5 THEN B[C] := B[C]-1;
4: { Down saturation }
BEGIN
Top := Max(R[C],G[C],B[C]);
IF (Top-Min(R[C],G[C],B[C])) > 0.5 THEN
BEGIN
Factor := 1/Abs(Top-Min(R[C],G[C],B[C]));
R[C] := R[C] - Factor*(R[C] - Top);
G[C] := G[C] - Factor*(G[C] - Top);
B[C] := B[C] - Factor*(B[C] - Top)
END
END;
5: { Down intensity }
BEGIN
R[C]:=R[C]*0.99;
G[C]:=G[C]*0.99;
B[C]:=B[C]*0.99
END
END;
UpdateColors
END;
#81 : { PgDn = five Down Arrows }
Keys := Keys[1]+#80+#80+#80+#80+#80+copy(Keys,2,255);
#75 : { Left arrow }
BEGIN
IF Q > 1 THEN Dec(Q);
UpdateColors
END;
#77 : { Right arrow }
BEGIN
IF Q < 5 THEN Inc(Q);
UpdateColors
END;
#45 : { Alt-X }
BEGIN
TextMode(Co80); { Reset colors }
Halt
END
END {Case};
Delete(Keys,1,1); { Eat the keystroke that was just acted on }
END
END.

  3 Responses to “Category : Files from Magazines
Archive   : PCTV1N2.ZIP
Filename : VGAMIXER.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/