07

More Fun With Palette Cycling

As I got more comfortable, I started making variations on a theme, and made "ALL.PAS" as a single program that let the user flip through the variations. Every one of these is palette cycling; after the initial screen draw no more pixels are drawn, and all the "motion" is through manipulating the color palettes. The seven variants on a circle theme are on this entry, and the rest on the next.
the 256 DAC registers. Every pattern here animates this and nothing else.

P1

One circle per palette index, largest first. The cycle writes (x+s)*r as the red channel, and r is ±1, so on the negative half the value goes through the byte wrap and comes back as a mirrored ramp. This was likely not intended at first, but I kept it as I liked the effect.

P2

A 180-entry history buffer: every frame it shifts down one and a new color is pushed in at the top, each channel doing a ±1 walk between 0 and 63. The r, g and b all start at 0 with the same step and the same bounds, so they never diverge; this is grayscale intentionally.

P3

The same shift register, but instead of a walk the new entry is three independent random(63) values. No continuity between neighbors, so it reads as random colored rings scrolling outward.

P4

P2 with the abs() removed from the bounds: "if(r>(64-s))or(r<s)". On the way down s is -1, so the lower test becomes r < -1, which a byte can never satisfy. The value runs off 0 into 255, the upper test fires, and about 128 frames in it locks into a 0↔255 flip. From then on the shift register is carrying alternating black and full-bright entries, one register apart, a comb with a period of two indices, marching through 180 concentric rings whose spacing changes with radius. I seem to have enjoyed these hypnotic effects.

P5

The one that actually has color, and the reason is a single line: s:=34; t:=11; u:=10. The three channels run the same ±1 triangle but start 23 and 24 apart, and since they never reset they hold that offset forever. P2 and P4 are the same idea started from 0,0,0, which is the whole difference between a rainbow and a grayscale.

P6

The best-written of the seven. Step magnitudes are re-rolled to 1 or 2 every frame, and the bound test is split by direction and applied before the update, so nothing can overshoot. Note that its array e[] is a LOCAL and Turbo Pascal zeroes globals but not locals, so it starts from whatever P5 left on the stack. The random opening is an accident.

P7

Same construction as P1 but only 64 rings, and the cycle adds x to each channel so the ramp itself moves through the rings while the three offsets drift apart. A small bullseye rather than a full screen.

The date on the file is eleven months late

ALL.PAS is stamped 1996-08-08, but the demo was written in September 1995. The two files are identical except that .BAK carries a scratch P16 flicker probe with everything else commented out:

Begin P0;CircleDemos;{P10;P11;P12;P13;P14;P15;}P16;

That is a bench test, not a demo, and it means the fifteen patterns already existed on 1995-09-16 and were merely switched back on eleven months later. P16 itself is gone from the dropdown here: it drew one line, erased it and repeated with no retrace wait, to see how badly draw_line tears.

ALL.PAS

1996-08-08 05:19 · 6,490 bytes · Fifteen patterns, all enabled.

Uses Crt,jmodex;Var X:Integer;a:char;

Procedure i;begin IF SET_VGA_MODEX(7,360,480,1)=0 THEN halt(0);
CLEAR_VGA_SCREEN(0);end;

Procedure circ(x,y,r,l:integer);var b,c:integer;a:real;begin if r=0then b:=0
else b:=round(sqrt(r*r-1));a:=b;for c:=0to round(r/sqrt(2))do begin if a=0then
a:=1;a:=(a-(c/a));b:=round(a);draw_line(x+b,y+c,x-b,y+c,l);draw_line(x+b,y-c,
x-b,y-c,l);draw_line(x+c,y+b,x-c,y+b,l);draw_line(x+c,y-b,x-c,y-b,l);end;end;

Procedure P0;Var s:string;Begin i;s:=
'Circle Demos: Press any key for next pattern';set_dac_register(255,50,50,50);
TPrint_Str(s,45,-5,460,255);s:='Please wait... Initializing';TPrint_Str(s,28,
70,0,255);End;
Procedure P1;var r,s,t:integer;begin for x:=1to 254do set_dac_register(x,0,
0,0);for x:=1to 180do circ(180,240,180-x,x-1);fill_block(70,0,292,7,0);
s:=0;t:=0;r:=1;repeat repeat
until(port[$3da]and 8)=0;repeat until(port[$3da]and 8)<>0;for x:=1to 180do
set_dac_register(x,(x+s)*r,x+t,x+t);s:=s+r;inc(t);if(s=63)or(s=0)then r:=-r;
until keypressed;a:=readkey;end;
Procedure P2;var s,t,u:integer;d:array[1..180]of record r,g,b:byte;end;begin
for x:=1to 180do begin d[x].r:=0;d[x].g:=0;d[x].b:=0;end;s:=1;t:=1;u:=1;repeat
repeat until(port[$3da]and 8)=0;repeat until(port[$3da]and 8)<>0;for x:=1to
180do set_dac_register(x,d[x].r,d[x].g,d[x].b);for x:=1to 179do d[x]:=d[x+1];
with d[180]do begin r:=d[179].r+s;g:=d[179].g+t;b:=d[179].b+u;if(r>(63-abs(s))
)or(r<abs(s))then s:=-s;if(g>(63-abs(t)))or(g<abs(t))then t:=-t;if(b>(63-abs
(u)))or(b<abs(u))then u:=-u;end;until keypressed;a:=readkey;end;
Procedure P3;var s,t,u:integer;d:array[0..179]of record r,g,b:byte;end;begin
for x:=0to 179do begin d[x].r:=0;d[x].g:=0;d[x].b:=0;
end;repeat repeat until(port[$3da]and 8)=0;repeat until(port[$3da]and 8)<>0;
for x:=0to 179do set_dac_register(x+1,d[x].r,d[x].g,d[x].b);for x:=0to 178do
d[x]:=d[x+1];d[179].r:=random(63);d[179].g:=random(63);d[179].b:=random(63);
until keypressed;a:=readkey;end;
Procedure P4;var s,t,u:integer;d:array[1..180]of record r,g,b:byte;end;
begin for x:=1to 180do begin d[x].r:=0;d[x].g:=0;
d[x].b:=0;end;s:=1;t:=1;u:=1;repeat repeat until(port[$3da]and 8)=0;repeat
until(port[$3da]and 8)<>0;for x:=1to 180do set_dac_register(x,d[x].r,d[x].g,
d[x].b);for x:=1to 179do d[x]:=d[x+1];with d[180]do begin r:=d[179].r+s;g:=
d[179].g+t;b:=d[179].b+u;if(r>(64-s))or(r<s)then s:=-s;if(g>(64-t))or(g<t)then
t:=-t;if(b>(64-u))or(b<u)then u:=-u;end;until keypressed;a:=readkey;end;
Procedure P5;var q,r,g,b,s,t,u:integer;begin s:=34;t:=11;u:=10;r:=1;g:=1;b:=1;
repeat repeat until(port[$3da]and 8)=0;repeat until(port[$3da]and 8)<>0;for
q:=1to 180do begin set_dac_register(q,s,t,u);s:=s+r;t:=t+g;u:=u+b;if(s=63)or(s
=0)then r:=-r;if(t=63)or(t=0)then g:=-g;if(u=63)or(u=0)then b:=-b;end;until
keypressed;a:=readkey;end;
Procedure P6;var q:byte;e:array[1..180]of record r,g,b:byte;end;s,t,u:record
m,d:shortint;end;begin s.m:=1;t.m:=1;u.m:=1;s.d:=1;t.d:=1;u.d:=1;repeat repeat
until(port[$3da]and 8)=0;repeat until(port[$3da]and 8)<>0;for q:=1to 180do
set_dac_register(q,e[q].r,e[q].g,e[q].b);for q:=1to 179do e[q]:=e[q+1];with
e[180]do begin if((s.d>0)and(r>=(63-s.m)))or((s.d<0)and(r<=s.m))then s.d:=-s.d
;if((t.d>0)and(g>=(63-t.m)))or((t.d<0)and(g<=t.m))then t.d:=-t.d;if((u.d>0)and
(b>=(63-u.m)))or((u.d<0)and(b<=u.m))then u.d:=-u.d;r:=e[179].r+(s.m*s.d);g:=
e[179].g+(t.m*t.d);b:=e[179].b+(u.m*u.d);s.m:=random(2)+1;t.m:=random(2)+1;
u.m:=random(2)+1;end;until keypressed;a:=readkey;end;
Procedure P7;var r,g,b,s,t,u:integer;begin for x:=1to 254do set_dac_register
(x,0,0,0);for x:=0to 63do circ(180,240,63-x,x);s:=34;t:=11;u:=0;r:=1;g:=1;
b:=1;repeat repeat until(port[$3da]and 8)=0;repeat until(port[$3da]and 8)<>0;
for x:=1to 64do set_dac_register(x,x+s,x+t,x+u);s:=s+r;t:=t+g;u:=u+b;if(s=63)
or(s=0)then r:=-r;if(t=63)or(t=0)then g:=-g;if(u=63)or(u=0)then b:=-b;until
keypressed;a:=readkey;end;

Procedure P10;var c,dc:integer;s,p:byte;Begin i;c:=0;dc:=1;FOR X:=0TO 60DO
SET_DAC_REGISTER(50+X,x,0,60-X);for x:=0to 360do begin DRAW_LINE(x,1,360-x,
479,c+50);draw_line(1,x+60,360,420-x,c+50);c:=c+DC;IF(c=0)OR(c=60)THEN DC:=
-DC;end;p:=3;s:=0;repeat Set_Dac_Register(50+P,3+P,0,60-P);Set_Dac_Register
(50+S,S,10,63-S);p:=p+1;s:=s+2;until keypressed;a:=readkey;END;

Procedure P11;Var S:Byte;Begin i;FOR x:=1TO 255DO Begin SET_DAC_REGISTER
(x,0,0,x div 4);end;for x:=0to 359do draw_line(x,0,x,480,x);repeat repeat
until(port[$3da]and 8)=0;repeat until(port[$3da]and 8)<>0;for x:=1to 359do
Set_Dac_Register(x,0,0,(s+x)div 4);s:=s+3;until keypressed;a:=readkey;END;

Procedure P12;Var c,dc,s:Integer;Begin i;c:=0;dc:=1;for x:=0to 60do
set_dac_register(50+x,x,0,60-x);for x:=0to 360do begin draw_line(x,0,360-x,
480,c+50);c:=c+dc;if(c=0)or(c=60)then dc:=-dc;end;for x:=0to 480do begin
draw_line(0,x,360,480-x,c+50);c:=c+dc;if(c=0)or(c=60)then dc:=-dc;end;s:=0;
repeat for x:=0to 60do Set_Dac_Register(50+x,s,0,s);s:=s+3;until keypressed;
a:=readkey;end;

Procedure P13;Var c,s:Integer;Begin i;for x:=1to 255do Begin set_dac_register
(X,x div 4,0,x div 4);end;for x:=0to 180do for c:=0to 240do begin s:=random
(abs(180-x)+abs(240-c)+5);set_point(x,c,s);set_point(360-x,c,s);set_point(x,
480-c,s);set_point(360-x,480-c,s);end;repeat for x:=1to 255do Set_Dac_Register
(x,s+x,0,s+x);s:=s+3;delay(10);until keypressed;a:=readkey;end;

Procedure P14;Var c,dc:Integer;s,p:Byte;Begin i;c:=0;dc:=1;for x:=0to 60do
Begin set_dac_register(50+x,0,0,0);set_dac_register(150+x,0,0,0);end;for x:=0
to 180do begin draw_line(180,1,x,479,c+50);draw_line(180,1,359-x,479,c+50);c:=
c+dc;if(c=0)or(c=60)then dc:=-dc;end;p:=3;s:=0;repeat Set_Dac_Register(50+p,
3+p,0,60-p);Set_Dac_Register(50+s,s,10,63-s);Set_Dac_Register(150+p,3+p,0,
60-p);Set_Dac_Register(150+s,63,63,s);inc(p);inc(s,2);until keypressed;
a:=readkey;end;

Procedure P15;Var c,dc:Integer;s,p:Byte;Begin i;c:=0;dc:=1;for x:=0to 60do
Begin set_dac_register(50+x,x,0,60-x);set_dac_register(150+x,x,0,60-x);end;for
x:=0to 360do begin draw_line(x,1,360-x,479,c+50);draw_line(1,x+60,360,420-x,
c+50);c:=c+dc;if(c=0)or(c=60)then dc:=-dc;end;p:=3;s:=0;repeat
Set_Dac_Register(50+p,3+p,0,60-p);Set_Dac_Register(50+s,s,10,63-s);
Set_Dac_Register(150+p,3+p,0,60-p);Set_Dac_Register(150+s,63,63,s);inc(p);inc
(s,2);until keypressed;a:=readkey;end;


Procedure CircleDemos;Begin P1;P2;P3;P4;P5;P6;P7;end;

Begin P0;CircleDemos;P10;P11;P12;P13;P14;P15;

asm mov ah,0;mov al,3;int 16;end;END.