{ David Proper posted a cross-fade routine here, some days ago. This is an update on that one. It now fades all texts. Quite a pain to figure this out, realy. Put it in the SWAG if you want, Gayle/Kerry/Jeff. >--- cut here } program xfade; { made by Bas van Gaalen, Holland, PD, fido 2:285/213.8, internet bas.van.gaalen@schotman.nl } uses crt; const vseg=$a000; fseg=$f000; fofs=$fa6e; lines=13; creds:array[0..lines-1] of string[20]=( {.........|.........|} 'This cross-fade', 'routine was made by', 'Bas van Gaalen', 'Code and idea', 'inspired by', 'David Proper', 'This routine was', 'enhanced a bit', 'in comparison with', 'David''s one...', 'cu later', 'alligator!', ''); procedure setpal(c,r,g,b:byte); assembler; asm mov dx,3c8h; mov al,[c]; out dx,al; inc dx; mov al,[r] out dx,al; mov al,[g]; out dx,al; mov al,[b]; out dx,al; end; procedure retrace; assembler; asm mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1 @vert2: in al,dx; test al,8; jnz @vert2; end; procedure cleartxt(col,new:byte); var x,y,vofs:word; begin for x:=0 to 319 do for y:=100 to 107 do begin vofs:=y*320+x; if mem[vseg:vofs]=col then mem[vseg:vofs]:=0 else if mem[vseg:vofs]<>0 then mem[vseg:vofs]:=new; end; end; procedure writetxt(col,cur:byte; txt:string); var x,y,vofs:word; i,j,k:byte; begin x:=(320-8*length(txt)) div 2; y:=100; for i:=1 to length(txt) do for j:=0 to 7 do for k:=0 to 7 do if ((mem[fseg:fofs+ord(txt[i])*8+j] shl k) and 128) <> 0 then begin vofs:=(y+j)*320+(i*8)+x+k; if mem[vseg:vofs]=cur then mem[vseg:vofs]:=col+cur else mem[vseg:vofs]:=col; end; end; var txtidx,curcol,i:byte; begin asm mov ax,13h; int 10h; end; setpal(1,0,0,0); setpal(2,0,0,0); setpal(3,63 div 2,63,63 div 2); curcol:=1; txtidx:=0; repeat cleartxt(curcol,3-curcol); writetxt(curcol,3-curcol,creds[txtidx]); for i:=0 to 63 do begin retrace; setpal(curcol,i div 2,i,i div 2); setpal(3-curcol,(63-i) div 2,63-i,(63-i) div 2); end; delay(500); curcol:=1+(curcol mod 2); txtidx:=(1+txtidx) mod lines; until keypressed; textmode(lastmode); end.