home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / dc / fontedit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-21  |  6.0 KB  |  201 lines
  1. {
  2.   Copyright 1992 by Digital Crime.
  3.  
  4.   All rights reserved.
  5.  
  6.   Permission to use, copy, modify, and distribute this software and its
  7.   documentation for any purpose and without fee is hereby granted,
  8.   provided that the above copyright notice appear in all copies and that
  9.   both that copyright notice and this permission notice appear in
  10.   supporting documentation, and that the name of the Digital Crime
  11.   not be used in advertising or publicity pertaining to distribution
  12.   of the software without specific, written  prior permission.
  13.  
  14.   DIGITAL CRIME DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
  15.   SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
  16.   AND FITNESS, IN NO EVENT SHALL DIGITAL CRIME BE LIABLE FOR ANY SPECIAL,
  17.   INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  18.   FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
  19.   NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
  20.   WITH THE USE OR PERFORMANCE OF THIS  SOFTWARE.
  21.  
  22.   s924683@minyos.xx.rmit.OZ.AU   Chandi.
  23.   s924698@minyos.xx.rmit.OZ.AU   Ed.
  24.  
  25. }
  26.  
  27.  
  28. {$R-}
  29. program Font_Editor;
  30.  
  31. { This allows you to make your own SVGA fonts however you have   }
  32. { to run the program from TP if you start changing the Width and }
  33. { Height of characters. Click on character you wish to edit.     }
  34. { Use left mouse button to add a pixel, right mouse button to    }
  35. { delete a pixel.  's' to save, 'l' to load CharSetName and      }
  36. { 'q' to quit.                                                   }
  37.  
  38. uses SVGA, Crt;
  39.  
  40. const MaxNumChars = 95;  { Maximum number of Characters }
  41.       Width = 7;
  42.       Height = 9;
  43.       CharSetName = 'standard.chr'; { Name of Character Set file }
  44.   { MAKE SURE THAT WIDTH AND HEIGHT ARE SET FOR THE APPROPRIATE FONT }
  45.   { 'future.chr'    Width = 15  Height = 12  not finished }
  46.   { 'standard.chr'  Width = 7   Height = 9                }
  47.  
  48. type CharType = array[ 0..Width, 0..Height ] of boolean;
  49.      CharSetType = array[ 0..MaxNumChars ] of CharType;
  50.  
  51. var GM : GraphicMouse;
  52.     CharSet : ^CharSetType;
  53.     xx, yy, Btn, Rx, Ry, CutX, CutY : integer;
  54.     PresentChar : byte;
  55.     ReadCh : Char;
  56.     Done : boolean;
  57.  
  58. procedure DrawChar( Ch : integer );
  59.  
  60.   var i, j : integer;
  61.  
  62.   begin
  63.     GM.Show( False );
  64.     Rx := (Ch mod 16)*39+6;
  65.     Ry := (Ch div 16)*39+246;
  66.     Rectangle( Rx, Ry, Rx+27, Ry+27, 252 );
  67.     for i := 0 to Width do
  68.       for j := 0 to Height do
  69.         if CharSet^[Ch][i,j] then
  70.             RectFill( i*9+1, j*9+1, i*9+8, j*9+8, 253 )
  71.         else
  72.             RectFill( i*9+1, j*9+1, i*9+8, j*9+8, 0 );
  73.     GM.Show( True );
  74.   end;
  75.  
  76.  
  77. procedure SetUp;
  78.  
  79.   var i, j, k : integer;
  80.  
  81.   begin
  82.     SetMode( SVGAMED );
  83.     LoadPalette( 'pal256.002' );
  84.     for i := 0 to 15 do
  85.       for j := 0 to 5 do
  86.         begin
  87.           Rx := i*39;
  88.           Ry := j*39;
  89.           Rectangle(  Rx , Ry+240, Rx+39, Ry+279, 35 );
  90.           Rectangle( Rx+1, Ry+241, Rx+38, Ry+278, 27 );
  91.           Rectangle( Rx+2, Ry+242, Rx+37, Ry+277, 21 );
  92.           Rectangle( Rx+3, Ry+243, Rx+36, Ry+276, 16 );
  93.           Rectangle( Rx+4, Ry+244, Rx+35, Ry+275, 10 );
  94.         end;
  95.     GetMem( CharSet, (Width+1)*(Height+1)*(MaxNumChars+1));
  96.     for k := 0 to MaxNumChars do
  97.       for i := 0 to Width do
  98.         for j := 0 to Height do
  99.           Charset^[k][i,j] := False;
  100.     PresentChar := 0;
  101.     GM.Initialize;
  102.     DrawChar( PresentChar );
  103.     for i := 0 to Width do
  104.       for j := 0 to Height do
  105.         Rectangle( i*9, j*9, i*9+9, j*9+9, 254);
  106.     Done := False;
  107.     CutX := (Width+1)*9;
  108.     CutY := (Height+1)*9;
  109.   end;
  110.  
  111. procedure FillSquare( A, B : integer; State : boolean );
  112.  
  113.   var s, t, XShift, YShift, Color : integer;
  114.  
  115.   begin
  116.     if State = True then Color := 253
  117.       else Color := 0;
  118.     s := trunc( xx / 9 );
  119.     t := trunc( yy / 9 );
  120.     GM. Show( False );
  121.     RectFill( s*9+1, t*9+1, s*9+8, t*9+8, Color );
  122.     XShift := (PresentChar mod 16)*39+12;
  123.     YShift := (PresentChar div 16)*39+252;
  124.     Plot( XShift+s, YShift+t, Color );
  125.     GM.Show( True );
  126.     CharSet^[PresentChar][s,t] := State;
  127.   end;
  128.  
  129. procedure SaveCharSet;
  130.  
  131.   var i, j, k : integer;
  132.       fil : file of CharSetType;
  133.  
  134.   begin
  135.     GM.Show( False );
  136.     assign( fil, CharSetName );
  137.     rewrite( fil );
  138.     write( fil, Charset^ );
  139.     Close( fil );
  140.     GM.Show( True );
  141.   end;
  142.  
  143. procedure LoadCharSet;
  144.  
  145.   var i, j, k, XShift, YShift : integer;
  146.       fil : file of CharSetType;
  147.       Color : byte;
  148.  
  149.   begin
  150.     GM.Show( False );
  151.     Rx := (PresentChar mod 16)*39+6;
  152.     Ry := (PresentChar div 16)*39+246;
  153.     Rectangle( Rx, Ry, Rx+27, Ry+27, 0 );
  154.     assign( fil,CharSetName );
  155.     reset( fil );
  156.     Read( fil, Charset^ );
  157.     Close( fil );
  158.     for k := 0 to MaxNumChars do
  159.       for i := 0 to Width do
  160.         for j := 0 to Height do
  161.           begin
  162.             XShift := (k mod 16)*39+12;
  163.             YShift := (k div 16)*39+252;
  164.             if CharSet^[k][i,j] then Color := 253
  165.               else Color := 0 ;
  166.             Plot( XShift+i, YShift+j, Color );
  167.           end;
  168.     PresentChar := 0;
  169.     GM.Show( True );
  170.     DrawChar( PresentChar );
  171.   end;
  172.  
  173. begin
  174.   SetUp;
  175.   repeat
  176.     GM.CheckMouse;
  177.     GM.GetPosition( Btn, xx, yy );
  178.     if ( Btn AND $01 = $01 ) AND ( xx < CutX ) AND ( yy < CutY ) then
  179.       FillSquare( xx, yy, True );
  180.     if ( Btn AND $02 = $02 ) AND ( xx < CutX ) AND ( yy < CutY ) then
  181.       FillSquare( xx, yy, False );
  182.     if ( Btn AND $01 = $01 ) AND ( yy > 240 ) then
  183.       begin
  184.         Rx := (PresentChar mod 16)*39+6;
  185.         Ry := (PresentChar div 16)*39+246;
  186.         Rectangle( Rx, Ry, Rx+27, Ry+27, 0 );
  187.         PresentChar := (xx div 39) + ((yy-240) div 39)*16;
  188.         DrawChar( PresentChar );
  189.       end;
  190.     if keypressed = True then
  191.       begin
  192.         ReadCh := ReadKey;
  193.         case ReadCh of
  194.           's','S' : SaveCharSet;
  195.           'l','L' : LoadCharSet;
  196.           'q','Q' : Done := True;
  197.           end;
  198.       end;
  199.   until Done;
  200.   ExitGraphics;
  201. end.