home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / PASCAL / VGAFONT / VGAFONT.PAS < prev   
Pascal/Delphi Source File  |  1993-12-01  |  11KB  |  318 lines
  1. Program VGAfont;
  2. Uses Crt,V_font_U,Dos;
  3.  
  4. {   See V_font_U.PAS for information about itself and the author.  This   }
  5. { program demonstrates the use of V_FONT_U.  Has been tested on a 256K    }
  6. { VGA system.  Should work on an EGA, although the EGA_VGA flag should be }
  7. { configured for EGA mode.  Compile using Turbo Pascal, version 5.0.      }
  8. { May also work with other versions of Turbo Pascal.                      }
  9.  
  10. { VGAfont demonstrates the use of using graphics on standard text-mode    }
  11. { displays.                                                               }
  12.  
  13. {$R-} {$S-} {$I-}
  14.  
  15. Var
  16.      Buffer:  array[1..FontSize] of byte; { 384 8x16 chars    }
  17.      Buffer2:  array[1..4096] of byte;    { 80x25 screen save }
  18.      TotalX,TotalY:  integer;             { MaxX+1,MaxY+1     }
  19.  
  20. Procedure Swap(Var n1,n2:  integer);
  21. Var
  22.      Temp:  integer;
  23.  
  24. Begin
  25.      Temp:=n1;
  26.      n1:=n2;
  27.      n2:=Temp
  28. End;
  29.  
  30. Procedure PsetDemo;
  31. { Displays random dots.  The display is reset (ClearChars) whenever all }
  32. { 384 characters have been used up.                                     }
  33. Var
  34.      ch:  char;
  35.  
  36. Begin
  37.      ClearChars(@Buffer2);            { Clear the character set }
  38.      While not keypressed do
  39.      Begin
  40.           Pset(random(TotalX),random(TotalY),random(15)+1);
  41.           GotoXY(1,25); TextColor(5); Write('Characters used:  ',TotalUsed);
  42.           if TotalUsed>=384 then ClearChars(@Buffer2)
  43.      End;
  44.      ch:=readkey
  45. End;
  46.  
  47. Procedure RandomDemo;
  48. { Demonstrates Line,Box,Hlin,Vlin, and Ellipse procedures.           }
  49. { The display is reset whenever all characters have been allocated.  }
  50. Var
  51.      ch:  char;
  52.      x1,y1,x2,y2,r1,r2:  integer;
  53.  
  54. Begin
  55.      ClearChars(@Buffer2);
  56.      While not keypressed do
  57.      Begin
  58.           Case random(5) of
  59.                 0:  Line(random(TotalX),random(TotalY),random(TotalX),
  60.                          random(TotalY),random(15)+1);
  61.                 1:  Begin
  62.                          Repeat
  63.                               x1:=random(TotalX);
  64.                               y1:=random(TotalY);
  65.                               x2:=random(TotalX);
  66.                               y2:=random(TotalY)
  67.                          Until (abs(x1-x2)<100) and (abs(y1-y2)<100);
  68.                          Box(x1,y1,x2,y2,random(15)+1)
  69.                     End;
  70.                 2:  Hlin(random(TotalX),random(TotalY),random(TotalX),random(15)+1);
  71.                 3:  Vlin(random(TotalX),random(TotalY),random(TotalY),random(15)+1);
  72.                 4:  Begin
  73.                          Repeat
  74.                               r1:=random(45)+2;
  75.                               r2:=random(45)+2;
  76.                               x1:=random(TotalX);
  77.                               y1:=random(TotalX)
  78.                          Until (x1-r1>=0) and (x1+r1<=MaxX) and (y1-r2>=0) and (y1+r2<=MaxY);
  79.                          Ellipse(x1,y1,r1,r2,(random(2) shl 7) or random(16))
  80.                     End
  81.           End;
  82.           GotoXY(1,25); TextColor(4); Write('Chars Used:  ',TotalUsed);
  83.           if TotalUsed>=384 then
  84.                ClearChars(@Buffer2)
  85.      End;
  86.      ch:=readkey
  87. End;
  88.  
  89. Procedure LineDemo;
  90. { Demonstrates the Line procedure.  Freeze & Unfreeze are used to minimize }
  91. { flickering.  Unfortunately, the BIOS resets the current video page to 0  }
  92. { whenever the font is updated, resulting in a FORCED UnFreeze whenever the}
  93. { ClearChars procedure is called.  Therefore, flicker is not totally       }
  94. { minimized.                                                               }
  95. Var
  96.      Color,X1inc,X2inc,Y1inc,Y2inc:  integer;
  97.      ch:  char;
  98.      x1,y1,x2,y2:  integer;
  99.  
  100. Begin
  101.      x1:=0; y1:=0; x2:=MaxX; y2:=MaxY;
  102.      X1inc:=5; X2inc:=-5; Y1inc:=0; Y2Inc:=0;
  103.      Color:=1;
  104.      While not keypressed do
  105.      Begin
  106.           Freeze;
  107.           ClearChars(@Buffer2);
  108.           Freeze;
  109.           Line(x1,y1,x2,y2,Color);
  110.           Unfreeze;
  111.           Inc(x1,X1inc); Inc(x2,X2inc); Inc(Y1,Y1Inc); Inc(Y2,Y2inc);
  112.           if x1>=MaxX then
  113.           Begin
  114.                Dec(x1,X1inc); Dec(x2,X2inc); Dec(y1,Y1inc); Dec(y2,Y2inc);
  115.                X1inc:=0; Y1inc:=5; X2inc:=0; Y2inc:=-5
  116.           End;
  117.           if y1>=MaxY then
  118.           Begin
  119.                Dec(x1,X1inc); Dec(x2,X2inc); Dec(y1,Y1inc); Dec(y2,Y2inc);
  120.                X1inc:=5; X2inc:=-5; Y1inc:=0; Y2Inc:=0;
  121.                Swap(x1,x2); Swap(y1,y2)
  122.           End;
  123.           Inc(Color); If Color=16 then Color:=1
  124.      End;
  125.      ch:=readkey
  126. End;
  127.  
  128. Procedure CursDemo;
  129. { Allows the user to move around a rectangle with the mouse.   Because }
  130. { this is graphics, this may be the first time cursor control has ever }
  131. { been so smooth in text-mode before.  Only one pixel has to be moved  }
  132. { each time the cursor is moved, whereas before the cursor must remain }
  133. { on a character boundary.                                             }
  134. Const
  135.      SizeX=30;
  136.      SizeY=25;
  137.      HalfX=SizeX div 2;
  138.      HalfY=SizeY div 2;
  139.  
  140. Var
  141.      reg:  registers;
  142.      x,y,xt,yt,i:  integer;
  143.      ReadingMouse,Start:  boolean;
  144.      ch:  char;
  145.  
  146. Begin
  147.      ClearChars(@Buffer2);
  148.      GotoXY(1,25); TextColor(2); Write('Do you have a Microsoft-compatible mouse?  ');
  149.      Repeat
  150.           ch:=upcase(readkey)
  151.      Until ch in ['Y','N'];
  152.      if ch='N' then
  153.      Begin
  154.           TextMode(co80);
  155.           WriteLn('Sorry, you can''t do the next demo! -- press a key');
  156.           ch:=readkey;
  157.           Halt
  158.      End;
  159.      DelLine; GotoXY(19,24);
  160.      Write('Move the box around the screen with the mouse.');
  161.      GetScrn(@Buffer2);
  162.      reg.ax:=0;
  163.      Intr($33,reg);
  164.  
  165.      x:=TotalX shr 1; y:=TotalY shr 1; Start:=TRUE;
  166.  
  167.      While not keypressed do
  168.      Begin
  169.           ReadingMouse:=TRUE;
  170.           While (ReadingMouse) and (not Keypressed) and (not Start) Do
  171.           Begin
  172.                reg.ax:=11;
  173.                Intr($33,reg);
  174.                xt:=x+integer(reg.cx); yt:=y+integer(reg.dx);
  175.                if (xt<>x) or (yt<>y) then
  176.                Begin
  177.                     x:=xt;
  178.                     y:=yt;
  179.                     ReadingMouse:=FALSE
  180.                End
  181.           End;
  182.           if x<(HalfX) then x:=HalfX;
  183.           if y<(HalfY) then y:=HalfY;
  184.           if x>MaxX-(HalfX) then x:=MaxX-(HalfX);
  185.           if y>MaxY-(HalfY) then y:=MaxY-(HalfY);
  186.           ClearChars(@Buffer2);
  187.           For i:=0 to 2 do
  188.               OpenBox((x-HalfX)+i,(y-HalfY)+i,(x+HalfX)-i,(y+HalfY)-i,14);
  189.           Start:=FALSE
  190.      End;
  191.      ch:=readkey
  192. End;
  193.  
  194. Procedure BounceBallDemo;
  195. { Demonstrates a bouncing ball.  Animation is very tricky when dealing with  }
  196. { graphics in text-mode (see the LineDemo procedure).  The Freeze & UnFreeze }
  197. { procedures must be used to minimize flickering.  Unfortunatly, all graphics}
  198. { primitives use BIOS to update the character font, which results in the     }
  199. { video page being reset to page 0;  the equivalent of the UnFreeze procedure.}
  200. { Because of this, flickering is not fully eliminated.  I also noticed another}
  201. { bothersome thing:  when the pause key is pressed and then de-pressed during }
  202. { this demonstration, the graphics seem to get permanently garbled (until the }
  203. { program exits).                                                             }
  204. Var
  205.      dx,x,y,a,v,i:  integer;
  206.      ch:  char;
  207.      Ycoord:  integer;
  208.      Shift:  byte;
  209.  
  210. Begin
  211.      TextMode(co80);
  212.      if MaxY=199 then
  213.      Begin
  214.           Ycoord:=144;
  215.           Shift:=0
  216.      End
  217.      else
  218.      Begin
  219.           Ycoord:=275;
  220.           Shift:=1
  221.      End;
  222.      Vlin(0,0,Ycoord,DarkGray);
  223.      Vlin(639,0,Ycoord,DarkGray);
  224.      Hlin(0,Ycoord,639,DarkGray);
  225.      GotoXY(30,21); TextColor(Red); Write('This is TEXT mode, mode 3');
  226.      GetScrn(@Buffer2);
  227.      dx:=4; x:=8; y:=0; a:=2; v:=0;
  228.      Repeat
  229.           UnFreeze;
  230.           Freeze;
  231.           Ellipse(x+5,(y shl Shift)+5,7,5,$8f);
  232.           Freeze;
  233.           if y=132 then
  234.           Begin
  235.                v:=-v;
  236.                if v=0 then v:=-20
  237.           End;
  238.           if x>618 then dx:=-dx;
  239.           if x<6 then dx:=-dx;
  240.           v:=v+a;
  241.           Box(x-2,(y shl Shift),x+12,(y shl Shift)+10,0);
  242.           inc(y,v); inc(x,dx)
  243.      Until keypressed;
  244.      UnFreeze;
  245.      TextMode(co80);
  246.      ch:=readkey
  247. End;
  248.  
  249. Procedure EllipseDemo;
  250. { This procedure continuosly updates an ellipse.  The procedure MaskColors }
  251. { is also demonstrated.  MaskColors forces a maximum of 8 colors to be     }
  252. { displayed at once (bit 3 is masked).  Failure to use MaskColors in this  }
  253. { deomonstration results in the Ellipse being displayed in a blend of two  }
  254. { colors, instead of one.  This is because characters from the lower-order }
  255. { character set are needed to make-up part of the picture.  Since these    }
  256. { characters are always displayed with low-intesity (as opposed to the     }
  257. { upper 256 characters which are high-intensity), more than two colors     }
  258. { get used.                                                                }
  259. { Pay attention to the # of characters used that is recorded at the bottom }
  260. { right of the screen.  Note that when the ellipse is colored black, the   }
  261. { number gets lower because of the de-allocated characters.  Also note     }
  262. { the slow speed of the ellipse (it's hard to ignore!).  Finally, note that}
  263. { the numbers of characters used vary depending on the # of lines on the   }
  264. { screen.  This is because the # of lines per character (points) also      }
  265. { changes.  Therefore, the less pixels/character to choose from, the more  }
  266. { charcters end up getting used.                                           }
  267. Var
  268.      ch:  char;
  269.      i:  integer;
  270.      Cx,Cy,r1,r2:  integer;
  271.      Aspect:  real;
  272.  
  273. Begin
  274.      Cx:=MaxX div 2;
  275.      Cy:=MaxY div 2;
  276.      Aspect:=MaxY/MaxX;
  277.      r1:=105;
  278.      r2:=trunc(r1*Aspect);
  279.      MaskColors;
  280.      ClearChars(@Buffer2);
  281.      GotoXY(33,25); TextColor(3); Write('Ellipse demo');
  282.      GotoXY(32,12); Write('One second ...');
  283.      For i:=0 to 5 do
  284.            OpenBox((Cx-r1)+i-20,(Cy-r2)+i-20,(r1+Cx)-i+20,(r2+Cy)-i+20,7);
  285.      Repeat
  286.            Ellipse(Cx,Cy,r1,r2,(random(7) or $80));
  287.            GotoXY(1,25); Write(TotalUsed,' characters used.  ')
  288.      Until keypressed;
  289.      ch:=readkey;
  290.      ClearChars(@Buffer2);
  291.      TextMode(co80);
  292. End;
  293.  
  294. Begin
  295.      Make8bitChars(350);                        { Set 8-bits/char, 350 lines }
  296.      TextMode(co80);                            { Erase screen               }
  297.      TotalX:=Succ(MaxX); TotalY:=succ(MaxY);    { Important values           }
  298.      Randomize;                                 { Randomize                  }
  299.      TextColor(2);                              { Green                      }
  300.      WriteLn('This is text mode!!!!');
  301.      TextColor($87);                            { Blinking white             }
  302.      WriteLn; WriteLn;
  303.      Write('See!  '); TextColor(7);             { Non-blinking white         }
  304.      WriteLn('The blink attribute!');
  305.  
  306.      FontInit(@Buffer,@Buffer2);                { Initialize the unit        }
  307.  
  308. { Do demos:  }
  309.      EllipseDemo;
  310.      PsetDemo;
  311.      RandomDemo;
  312.      LineDemo;
  313.      BounceBallDemo;
  314.      CursDemo;
  315.  
  316. { Restore default text-mode values and quit: }
  317.      TextMode(co80)
  318. End.