[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {
    Here a sample program which shows a smoothly (graphics mode like)
    animation of a thermobar display. It works (I think) only on VGA cards

    The trick is done by animating one character by changing it's
    bitpattern. }

    {---------------------------------------------------------}
    {  Project : Textmode thermometer bar                     }
    {  Unit    : Main Program                                 }
    {  By      : Wim van der Vegt                             }
    {---------------------------------------------------------}
    {  This program shows a thermometer bar display similar   }
    {  to the ones in many installation programs. This one    }
    {  however is in textmode, but smoothly animated as if in }
    {  graphics mode. It is only tested on one (S)VGA card.   }
    {---------------------------------------------------------}
    {  Date  .Time  Revision                                  }
    {  940620.1450  Creation.                                 }
    {---------------------------------------------------------}

    Uses
      Dos,
      Crt;

    Const
      c : Array[1..16] Of Byte = (255,255,255,255,
                                  255,255,255,255,
                                  255,255,255,255,
                                  255,255,255,255);

    {---------------------------------------------------------}
    {---Procedure to turn cursor on/off.                      }
    {---------------------------------------------------------}

    Procedure Cursor(on : Boolean);

    VAR
      r : registers;

    BEGIN
      r.ah:=$03;
      r.bh:=$00;
      Intr($10,r);

      IF ((r.cx< $2020) AND NOT(on)) OR
         ((r.cx>=$2020) AND on)
        THEN
          BEGIN
            r.ah:=$01;
            r.cx:=r.cx XOR $2020;
            Intr($10,r);
          END;
    END; {of Cursor}

    {---------------------------------------------------------}
    {---Procedure to wait for the vertical retrace of the VGA }
    {   display. This minimizes screen flickering when the    }
    {   CRTC gets reprogrammed.                               }
    {---------------------------------------------------------}

    PROCEDURE Wait4Retrace;

    begin
      while ((Port[$3DA] AND 8) > 0) do;
      while ((Port[$3DA] AND 8) = 0) do;
    end; {of Wait4Retrace;}

    {---------------------------------------------------------}
    {---Procedure to generate an animation scene for character}
    {   #1. The cursor is turned off every time the procedure }
    {   is called because the cursor keeps showing up when the}
    {   CRTC is reprogrammed. And a cursor behind a smoothly  }
    {   animated thermobar just doesn't feel right.           }
    {---------------------------------------------------------}

    Procedure Reprogram(i,bperc : Byte);

    VAR
      j : integer;
      r : registers;
      w : Word;

    Begin
    {----calculate bittpattern. It goes like
         0
         128
         128+64
         128+64+32
         128+64+32+16
         128+64+32+16+8
         128+64+32+16+8+4
         128+64+32+16+8+4+2
         128+64+32+16+8+4+2+1 (This is equivalent to character 219 'Û')
         }

       w:=0;
       FOR j:=1 TO i DO w:=w+BYTE(256 SHR j);
       For j:=1 To bperc Do c[j]:=w;

     {----reprogram character #1,
          but wait for retrace so there's no flickering}
       r.ah:=$11;
       r.al:=$10;
       r.bh:=bperc;
       r.bl:=$00;
       r.cx:=$01;
       r.dx:=$01;
       r.bp:=Ofs(c);
       r.es:=Seg(c);
       Wait4Retrace;
       Intr($10,r);
      Cursor(false);
    End; {of Reprogram}

    {---------------------------------------------------------}
    {---Main program, btw the character #1 isn't restored     }
    {   because it's seldomly used by application.            }
    {   a TEXTMODE(LASTMODE) statement will clear the screen  }
    {   and restore character #1. So put that at the end of   }
    {   program                                               }
    {---------------------------------------------------------}

    Var
      r     : registers;
      i,k   : Byte;
      bperc : Byte;

    Begin
      Clrscr;

      GotoXY(20,5);
      Write('0%                50%               100%');
      GotoXY(20,4);

    {----get bytes per character of current font,
         by requesting font data on font #0 (INT 1F)}
      r.ah:=$11;
      r.al:=$30;
      r.bh:=$00;
      Intr($10,r);
      bperc:=r.cx;

      textcolor(yellow);

    {----Do a 30 character bar}
      For k:=1 To 40 Do
        Begin
        {----Use chr(1) to animate, however wipe it before writing it}
          Reprogram(0,bperc);
          Write(#01);

        {----Animate character #1}
          For i:=0 To 7 Do
            Begin
            {----calc bit new patterns,
                 bit patterns are reversed in character generator,
                 bit 7 is on the left side of a character}
              Reprogram(i,bperc);
              Delay(25);
            End;

       {----Replace fully animated characters by a full block from
            the line drawing set because animation of character #1
            will be started all over}
         GotoXY(WhereX-1,WhereY);
         Write('Û');
        End;
      GotoXY(1,6);
      Cursor(true);

     {textmode(lastmode);}
    End. {of Main program}

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]