home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / TEXT / UTILITY / SCRIPTO.ZIP / SCRIPTO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-22  |  1.6 KB  |  93 lines
  1. program cursive;
  2. type
  3.   line=array[0..255]of char;
  4.   str255=string[255];
  5.   str80=string[80];
  6.   fontch=array[-3..2,1..11]of char;
  7.   fontrec=record
  8.     width:byte;
  9.     def:fontch;
  10.   end;
  11.  
  12. var
  13.   A:string[255];
  14.   fonts:array[0..255]of fontrec;
  15.   Inp:str80;
  16.   Buf:array[1..6]of str255;
  17.   Oup:array[-3..2]of line absolute Buf;
  18.  
  19. procedure loadfont;
  20. var
  21.   f:text;
  22.   Ltr:byte;
  23.   S:string[12];
  24.   i,j,
  25.   m:integer;
  26. begin
  27.   assign(f,'scripto.set');
  28.   reset(f);
  29.   A:='';
  30.   fillchar(fonts,sizeof(fonts),#0);
  31.   while not(eof(f)) do
  32.     begin
  33.     readln(f,S);
  34.     A:=A+S;
  35.     Ltr:=ord(S[1]);
  36.     for i:=-3 to 2 do
  37.       begin
  38.       readln(f,S);
  39.       if(i=0)then
  40.         begin
  41.         if(copy(S,length(S),1)='@')then
  42.           delete(S,length(S),1);
  43.         fonts[Ltr].width:=length(S);
  44.         end;
  45.       for j:=1 to length(S) do
  46.         begin
  47.         fonts[Ltr].def[i,j]:=S[j];
  48.         end;
  49.       end;
  50.     end;
  51.   {make blank 6 chars wide}
  52.   fonts[ord(' ')].width:=6;
  53. end; {loadfont}
  54.  
  55. procedure scripto(Inp:str80);
  56. var
  57.   ch:char;
  58.   Ltr:byte;
  59.   i,j,n,c:integer;
  60. begin
  61.   fillchar(Oup,sizeof(Oup),' ');
  62.   c:=0;
  63.   for n:=1 to length(Inp) do
  64.     begin
  65.     Ltr:=ord(Inp[n]);
  66.     for i:=-3 to 2 do
  67.       begin
  68.       for j:=1 to 11 do
  69.         begin
  70.         ch:=fonts[Ltr].def[i,j];
  71.         if(ch>' ')then
  72.           Oup[i,c+j]:=ch;
  73.         end;
  74.       end;
  75.       c:=c+fonts[Ltr].width+1;
  76.     end;
  77.   for i:=1 to 6 do
  78.     begin
  79.     Buf[i][0]:=chr(c);
  80.     writeln(Buf[i]);
  81.     end;
  82. end; {scripto}
  83.  
  84. begin
  85.   loadfont;
  86.   readln(Inp);
  87.   while not(Inp='') do
  88.     begin
  89.     scripto(Inp);
  90.     readln(Inp);
  91.     end;
  92. end.
  93.