program nosnow;

{======================================================================}
{                                                                      }
{ 2 procedures to write 1 byte to the display; avoid "snow"            }
{ 1 procedure to build an entire screen, 500 bytes at a time; avoid    }
{    "snow".                                                           }
{                                                                      }
{ NOTE: These procedures are released to the public domain on the      }
{ condition that nobody tells on me. There are a lot of skiers here    }
{ in Salt Lake City who would get very mad at somebody who was trying  }
{ to eliminate snow!                                                   }
{                                                                      }
{======================================================================}

{ By Michael Quinlan   7/1/85  }

{======================================================================}
{                                                                      }
{ NoSnow1 is not as fast as NoSnow2, but it has these advantages:      }
{                                                                      }
{   1. Should work on almost any PC compatible,                        }
{   2. Should work with almost any display adaptor and monitor.        }
{   3. Absolutely no "snow".                                           }
{                                                                      }
{ It works by calling the BIOS to position the cursor, then calling    }
{ the BIOS again to write the character.                               }
{                                                                      }
{======================================================================}

procedure NoSnow1(r, c : integer; ch : char; a : byte);

{ r = row (1..25)
  c = column (1..80)
  ch = character to write
  a = attribute of character }

  begin
    Inline(
      $8a/$76/<r/      { mov dh,r[bp]   ;get row }
      $fe/$ce/         { dec dh         ;convert row to [0..24] }
      $8a/$56/<c/      { mov dl,c[bp]   ;get col }
      $fe/$ca/         { dec dl         ;convert col to [0..79] }
      $b7/$00/         { mov bh,0       ;page }
      $b4/$02/         { mov ah,2       ;set cursor position }
      $cd/$10/         { int $10        ;have BIOS do the dirty work }
      $b7/$00/         { mov bh,0       ;page }
      $b9/>1/          { mov cx,1       ;number of copies }
      $8a/$46/<ch/     { mov al,ch[bp]  ;character }
      $8a/$5e/<a/      { mov bl,a[bp]   ;attribute }
      $b4/$09/         { mov ah,9       ;write attr/char }
      $cd/$10)         { int $10        ;have BIOS do the dirty work }
  end;

{======================================================================}
{                                                                      }
{ NoSnow2 writes a single character as fast as possible to the         }
{ display buffer. It seems that there is still some "snow" on the      }
{ left edge of the screen (it usually isn't very noticable). The code  }
{ only works with the color graphics adaptor in 25x80 text mode. It    }
{ would be simple (but useless) to change the code to work with other  }
{ adaptors.                                                            }
{                                                                      }
{ NoSnow2 only works on an IBM PC or highly compatible.                }
{                                                                      }
{======================================================================}

procedure NoSnow2(r, c : integer; ch : char; a : byte);

{ r = row (1..25)
  c = column (1..80)
  ch = character to write
  a = attribute of character }

  begin
    Inline(
     $8a/$46/<r/       { mov al,r[bp]   ;get row }
     $fe/$c8/          { dec al         ;convert to [0..24] }
     $bb/>80/          { mov bx,80      ;# columns per row }
     $f7/$e3/          { mul bx         ;calc offset into display buffer }
     $03/$46/<c/       { add ax,c[bp]   ;add in column }
     $48/              { dec ax         ;adjust for column in [0..79] }
     $03/$c0/          { add ax,ax      ;mult by to to get buffer offset }
     $8b/$f8/          { mov di,ax      ;save offset for later }
     $b8/$b800/        { mov ax,$b800   ;color display base }
     $1e/              { push ds        ;save seg reg }
     $8e/$d8/          { mov ds,ax }
     $8a/$5e/<ch/      { mov bl,ch[bp]  ;character }
     $8a/$7e/<a/       { mov bh,a[bp]   ;attribute }
     $ba/$03da/        { mov dx,$3da    ;color status port }
     $fa/              { cli            ;don't allow interrupts }
{L1:}
     $ec/              { in al,dx       ;wait for partial horiz. retrace }
     $a8/$01/          { test al,1 }
     $75/$fb/          { jnz L1 }
{L2:}
     $ec/              { in al,dx       ;wait for horiz retrace }
     $a8/$01/          { test al,1 }
     $74/$fb/          { jz L2 }
{ horizontal retrace in progress. we must move very quickly here... }
     $89/$1d/          { mov [di],bx    ;put char, attr in AX }
     $fb/              { sti            ;now allow interrupts }
     $1f);             { pop ds         ;restore seg reg }
 end;

{======================================================================}
{                                                                      }
{ Procedure ColorFlash writes an entire screen to the display buffer.  }
{ It waits for the vertical retrace, then moves 500 bytes (250         }
{ characters and attributes) at a time. It is amazingly fast and is    }
{ completely free of flicker and snow.                                 }
{                                                                      }
{ ColorFlash only works on an IBM PC or highly compatible, with the    }
{ color graphics adaptor. As with NoSnow2, it would be easy to change  }
{ the code to work with other adaptors (but why? other adaptors don't  }
{ have the hardware bug that causes "snow" in the first place...).     }
{                                                                      }
{ This code may leave interrupts disabled for too long. Some high      }
{ speed communications applications, for example, may lose characters  }
{ while we are waiting for the vertical retrace.                       }
{                                                                      }
{======================================================================}

type FlashBufferType = array [1..25] of
                         array [1..80] of
                           record
                             c : char;
                             a : byte
                           end;

procedure ColorFlash(var d : FlashBufferType);
  begin
    inline(
      $1E/                        { PUSH DS         ;save reg used }
      $B8/$B800/                  { MOV AX,0B800h   ;dest. segment }
      $8E/$C0/                    { MOV ES,AX }
      $BF/$00/$00/                { MOV DI,0        ;dest. offset }
      $8B/$76/$04/                { MOV SI,4[BP]    ;source offset }
      $8E/$5e/$06/                { MOV DS,6[BP]    ;source segment }
      $BA/$03DA/                  { MOV DX,03DAh    ;status register }
      $FC/                        { CLD             ;go forwards }
      $BB/$08/$00/                { MOV BX,8        ;8*250 = 2000 words }
{LOOP:}
      $B9/$FA/$00/                { MOV CX,250      ;250 words/500 bytes }
      $FA/                        { CLI             ;don't allow interrupts }
{WAIT1:  ;wait for any partially complete vertical retrace to finish }
      $EC/                        { IN AL,DX }
      $A8/$08/                    { TEST AL,08h }
      $75/$FB/                    { JNZ WAIT1 }
{WAIT2:  ;wait for the next vertical retrace to begin }
      $EC/                        { IN AL,DX }
      $A8/$08/                    { TEST AL,08h }
      $74/$FB/                    { JZ WAIT2 }
{ vertical retrace in progress; copy part of the buffer }
      $F3/$A5/                    { REP MOVSW       ;move 250 word chunk }
      $FB/                        { STI             ;allow interrupts }
      $4B/                        { DEC BX          ;more left to move? }
      $75/$EC/                    { JNZ LOOP        ;yes -- loop back }
      $1F)                        { POP DS          ;no -- done }
  end;

{======================================================================}
{                                                                      }
{ simple code to show off the above routines.                          }
{                                                                      }
{======================================================================}

var i, j : integer;
    b    : FlashBufferType;

begin

{ prepare for "ColorFlash" routine }
  for i := 1 to 25 do
    for j := 1 to 80 do
      with b[i, j] do begin
        a := $1e;
        c := '?'
      end;

  ClrScr;
  GotoXY(1,25);
  write('Ready to Begin, Press Enter...');
  ReadLn;

  ClrScr;
  for i := 1 to 25 do
    for j := 1 to 79 do begin
      GotoXY(j, i);
      write('z')
    end;
  GotoXY(1,25);
  Write('Turbo Pascal Write Done, Press Enter...');
  ReadLn;

  ClrScr;
  for i := 1 to 25 do
    for j := 1 to 80 do
      NoSnow1(i, j, 'x', $1e);
  GotoXY(1,25);
  write('NoSnow1 Done, Press Enter...');
  ReadLn;

  ClrScr;
  for i := 1 to 25 do
    for j := 1 to 80 do
      NoSnow2(i, j, 'a', $1e);
  GotoXY(1,25);
  write('NoSnow2 Done, Press Enter...');
  ReadLn;

  ClrScr;
  ColorFlash(b);
  GoToXY(1,25);
  write('ColorFlash Done, Press Enter...');
  ReadLn
end.