DP Tool Club 8/CDASC08.ISO/NEWS/554/JUILLET/FADINOUT.PAS

Pascal/Delphi Source File | 1993-10-07 | 3KB | 139 lines

{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg  : 359 of 375
From : Jacob Riff                          2:231/411.0          29 Jun 93  07:40
To   : Ronen Magid                         2:403/138.0
Subj : Fade in/Fade out
────────────────────────────────────────────────────────────────────────────────
Well, well, well isn't that Ronen!

Sunday June 27 1993 03:14, Ronen Magid wrote to All:

 RM> I'm looking for a small procedure to perform a 'pallete fade out' and then
 RM> (after i re-write the screen text) a fade in.}

uses
  crt;
type
  RGBcolors= array[0..47] of byte;
var
  RGBoriginal,RGBnuller: RGBcolors;
  n: integer;

procedure GetDAC(var RGBvalues);assembler;
asm
  mov bl,0
  les di,RGBvalues
 @Loop:
  push bx
  mov ax,1007h
  int 10h
  mov bl,bh
  mov bh,0
  mov ax,1015h
  int 10h
  mov es:[di],dh
  mov es:[di+1],ch
  mov es:[di+2],cl
  add di,3
  pop bx
  inc bl
  cmp bl,10h
  jnz @Loop
end;

procedure Fade(RGBvalues:RGBcolors; Speed: shortint);
var
  PaletteRegs: array[0..16] of byte;
  Original,TotalChange,NextValues: RGBcolors;
begin
asm
  mov bl,0
  mov di,0
  mov si,0
 @LoopInit:
  push bx
  mov ax,1007h
  int 10h
  mov byte ptr PaletteRegs[si],bh
  inc si
  mov bl,bh
  mov bh,0
  mov ax,1015h
  int 10h
  mov byte ptr Original[di],dh
  mov al,byte ptr RGBvalues[di]
  sub al,dh
  mov byte ptr TotalChange[di],al
  mov byte ptr Original[di+1],ch
  mov al,byte ptr RGBvalues[di+1]
  sub al,ch
  mov byte ptr TotalChange[di+1],al
  mov byte ptr Original[di+2],cl
  mov al,byte ptr RGBvalues[di+2]
  sub al,cl
  mov byte ptr TotalChange[di+2],al
  add di,3
  pop bx
  inc bl
  cmp bl,10h
  jnz @LoopInit
  mov bl,Speed
  mov bh,0
 @LoopSpeed:
  inc bh
  mov di,0
  mov cx,48
 @LoopUdregn:
  mov al,bh
  imul byte ptr TotalChange[di]
  idiv bl
  add al,byte ptr Original[di]
  mov byte ptr NextValues[di],al
  inc di
  loop @LoopUdregn
  mov  dx,3dah
 @LoopWait1:
  in al,dx
  test al,8
  jnz @LoopWait1
 @LoopWait2:
  in al,dx
  test al,8
  jz @LoopWait2
  mov cx,16
  mov di,0
  mov si,0
@LoopOutput:
  mov al,byte ptr PaletteRegs[di]
  inc di
  mov dx,3c8h
  out dx,al
  inc dx
  mov al,byte ptr NextValues[si]
  out dx,al
  mov al,byte ptr NextValues[si+1]
  out dx,al
  mov al,byte ptr NextValues[si+2]
  out dx,al
  add si,3
  loop @LoopOutput
  cmp bh,bl
  jnz @LoopSpeed
end;
end;

begin
  GetDAC(RGBoriginal);
  for n:=0 to 47 do RGBnuller[n]:=0;

  repeat
    Fade( RGBnuller, 127 );
    for n:=0 to 1999 do begin
      mem[$b800:n+n]:=random(256);
      mem[$b800:n+n+1]:=random(16);
    end;
    Fade( RGBoriginal , 127 );

  until KeyPressed;
  ClrScr;
end.