home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / XLIB_TP5.ZIP / UTIL / FEX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-19  |  29KB  |  838 lines
  1. (* All these Compiler-directives make the EXE smaler , but the error would
  2.    be more invisible . *)
  3. {$D-,Y-,R-,S-,O-}
  4.  
  5. (* FEX  -  Font Editor for mode X     by  Christian Harms
  6.  
  7.  
  8.    1) is a terrible hack !
  9.  
  10.    2) read/save normal font from XLib_C  with a width to 8 Rows
  11.       read/save new Bigfont from XLib_TP  with a width to 16 Rows
  12.       save fonts as const-array for including
  13.  
  14.    3) canging with mouse or keyboard
  15.  
  16.    4) is a dirty example of using XLib_TP to programm in Mode X
  17.  
  18.    5) I dont want to make a better version (Do you want ? ;-)
  19.  
  20.    6) it's free for all modifications (send a better copy to my email)
  21.  
  22.    email : harms@minnie.informatik.uni-stuttgart.de
  23.  
  24. *)
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31. {$B-}  (* Compiler generated code for short-circuit boolean-expression eval.*)
  32.  
  33. uses crt,dos,
  34.      X_Const,  (* values like GetMaxX or GetMaxY                            *)
  35.      X_Main,   (* x_set_mode and Line, PutPixel                             *)
  36.      X_Text,   (* the great text-unit                                       *)
  37.      X_Rect,   (* box - very fast                                           *)
  38.      X_Mouse,  (* mouse-unit                                                *)
  39.      X_Button, (* button-manager , simply make some button                  *)
  40.      X_Pal,    (* set, get palette                                          *)
  41.      X_Keys,   (* emulate mouseclicks as pressed keys                       *)
  42.      X_FileIO; (* standart file operations, used by all XLib-functions      *)
  43.  
  44. const Box_X  = 3;      (* Start of Zoom-character  *)
  45.       Box_Y  = 3;
  46.       Max_C  = 133;    (* last character           *)
  47.       Char_X = 2;      (* start of character - box *)
  48.  
  49.       Big_Point : Array[0..4,0..1] of Integer = ( (-1,0),(1,0),(0,-1),(0,1),(0,0) );
  50.  
  51.       Max_Lines = 8;
  52.       Help_Lines:Array[1..Max_Lines] of String =(
  53.         'F2/F3 or /     dec/increment Font_Height',
  54.         'Shift+Tab/Tab or /'#26'  dec/increment character width',
  55.         'PgUp,PgDown  inc/Decrement character number',
  56.         'Cursorkeys      move pixelcursor in Zoombox',
  57.         'Space/Enter     invert actual/bigger point',
  58.         '[L]oad/[S]ave   load/save the font',
  59.         '[D]ir               Show the selected directory',
  60.         '[F]ont'#26'Inc     convert Fontfile in Include-Pascalfile   [ENTER]');
  61.  
  62. type Big_Char = record
  63.         MaxX : Byte;
  64.         D    : Array[0..15] of Word;
  65.      end;
  66.  
  67. var Font       : Array[0..Max_C] of Big_Char;
  68.     XC,YC      : Byte;
  69.     Font_Heigth: Byte;
  70.     Zoom       : Word;        (* dynamic zoom of character in diff. resolution *)
  71.     Char_Y     : Word;
  72.     Char_Rows  : Byte;
  73.     Char_Line  : Byte;
  74.     But_X      : Word;
  75.     Ende       : Boolean;
  76.     actuell    : Byte;        (* index of actuell zoomed character *)
  77.     My_Pal     : Palette;
  78.     FileName   : String;
  79.     FontType   : Byte;       (* 0 -> 8xn Font         1 ->  16xn *)
  80.     Mult_X     : Word;
  81.  
  82.  
  83.  
  84. procedure Init_MEM;
  85. var i:Byte;
  86. begin;
  87.   for i:=0 to Max_C do Font[i].MaxX:=12;
  88.   for i:=0 to Max_C do fillchar(Font[i].D,sizeof(Font[i].D),0);
  89.   XC:=0;
  90.   YC:=0;
  91.   Font_Heigth:=15;
  92.   Ende:=False;
  93.   actuell:=65;
  94.   Mult_X:=16;
  95.   FontType:=1;
  96. end;
  97.  
  98. function byte2hex(a:Byte):String;
  99. const F:Array[0..15] of Char = ('0','1','2','3','4','5','6','7','8','9',
  100.                                 'A','B','C','D','E','F');
  101. begin;
  102.   Byte2hex:=F[a div 16]+f[a mod 16];
  103. end;
  104.  
  105.  
  106. procedure Show_Big_Char(C:Char);
  107. var i,j,col:Byte;
  108.     W,temp_Y:Word;
  109. begin;
  110.  
  111.   Shadow_Box(Box_X-3,Box_Y-3,Box_X+Mult_X*Zoom+2,Box_Y+16*Zoom+1,Gray3,Gray2,Gray1);
  112.  
  113.   if Font[Byte(c)].MaxX>0 then
  114.     if FontType=1 then
  115.       for i:=0 to Font[Byte(c)].MaxX-1 do
  116.       begin;
  117.         Temp_Y:=Box_Y;
  118.         W:=Font[Byte(c)].D[i];
  119.         for j:=0 to Font_Heigth do
  120.         begin;
  121.           if (w and 1)=0 then Col:=Gray0 else Col:=Gray4;
  122.           Box(Box_X+i*Zoom,Temp_Y,Box_X+i*Zoom+Zoom-1,Temp_Y+Zoom-1,Col);
  123.           Inc(Temp_Y,Zoom);
  124.           w:=w shr 1;
  125.         end;
  126.       end
  127.                else
  128.       for i:=0 to Font_Heigth do
  129.       begin;
  130.         w:=Font[Byte(c)].D[i];
  131.         for j:=0 to Font[Byte(c)].MaxX-1 do
  132.         begin;
  133.           if (w and 1)=0 then Col:=Gray0 else Col:=Gray4;
  134.           Box(Box_X+j*Zoom,Box_Y+i*Zoom,Box_X+j*Zoom+Zoom-1,
  135.               Box_Y+i*Zoom+Zoom-1,Col);
  136.           w:=W shr 1;
  137.  
  138.         end;
  139.       end;
  140.  
  141. end;
  142.  
  143. procedure Set_Cursor(x,y,col:Byte);
  144. begin;
  145.   Line(Box_X+x*Zoom-1,Box_Y+y*Zoom+Zoom-1,Box_X+x*Zoom+Zoom-1,Box_Y+y*Zoom+Zoom-1,col);
  146.   Line(Box_x+x*Zoom+Zoom-1,Box_Y+y*Zoom-1,Box_x+x*Zoom+Zoom-1,Box_Y+y*Zoom+Zoom-1,col);
  147. end;
  148.  
  149. procedure Get_Cursor;
  150. var x,y:Byte;
  151. begin;
  152.   x:=XC;y:=YC;
  153.   XC:=(MouseX-Box_X)div Zoom;
  154.   YC:=(MouseY-Box_Y)div Zoom;
  155.   if (x<>XC)or(y<>YC) then begin;Set_Cursor(x,y,Gray2);Set_Cursor(XC,YC,Gray5);end;
  156. end;
  157.  
  158. procedure Show_Button;
  159. var i,j:Word;
  160.     dummy:Boolean;
  161. begin;
  162.  
  163.   i:=Box_Y+14;
  164.   dummy:=Add_Button_Gray(1,But_X,i,All,'Load');   Inc(i,x_font_Height+4);
  165.   dummy:=Add_Button_Gray(2,But_X,i,All,'Save');   Inc(i,x_font_height+4);
  166.   dummy:=Add_Button_Gray(3,But_X,i,All,'Dir');    Inc(i,x_font_height+4);
  167.   dummy:=Add_Button_Gray(4,But_X,i,All,'Font'#26'Inc'); Inc(i,x_font_height+4);
  168.  
  169.   i:=But_X-6-x_length('  ');
  170.   j:=1;
  171.   dummy:=Add_Button_Gray(14,i,j,All,'F1');              Inc(j,x_font_height+4);
  172.   dummy:=Add_Button_Gray(10,i,j,both+click,'  ');      Inc(j,x_font_height+4);
  173.   dummy:=Add_Button_Gray(11,i,j,both+click,' '#26' ');  Inc(j,x_font_height+4);
  174.   dummy:=Add_Button_Gray(12,i,j,all,'  ');             Inc(j,x_font_height+4);
  175.   dummy:=Add_Button_Gray(13,i,j,All,'  ');             Inc(j,x_font_height+4);
  176.  
  177. end;
  178.  
  179. procedure Show_Bios_Char(a:Char);
  180. var s:String;
  181. const German_Char : Array[#0..#6] of Char = ('ä','Ä','ö','Ö','ü','Ü','ß');
  182. begin;
  183.   x_set_font(1);
  184.   if FontType=1 then Inc(a);
  185.   if a>#127 then a:=German_Char[Chr(Byte(a)-128)];
  186.  
  187.   s:='['+a+'-'+Byte2Hex(Byte(a))+']';
  188.   box(But_X,0,GetMaxX,14,0);
  189.   x_Write(But_X,0,255,s);
  190.   x_set_font(2);
  191. end;
  192.  
  193. procedure Show_Char(x,y,Index:Word;Col:Byte);
  194. var i,j:Byte;
  195.     w:Word;
  196. begin;
  197.   Show_Bios_Char(char(Index));
  198.  
  199.   if Font[Index].MaxX=0 then
  200.   begin;
  201.     Box(      x,y,x+Mult_X,y+Font_Heigth+1,gray2);
  202.     rectangle(x,y,x+Mult_X-1,y+Font_Heigth,Col);
  203.   end
  204.                         else
  205.   begin;
  206.     Box(x,y,x+Mult_X,y+Font_Heigth+1,Gray2);
  207.     if FontType=1 then
  208.     begin;
  209.       for i:=0 to Font[Index].MaxX-1 do
  210.       begin;
  211.         w:=Font[Index].d[i];
  212.         for j:=0 to Font_Heigth do
  213.         begin;
  214.           if (W and 1)<>0 then PutPixel(x,y+j,Col)
  215.                           else PutPixel(x,y+j,0);
  216.           w:=w shr 1;
  217.         end;
  218.         Inc(X);
  219.       end;
  220.     end else
  221.     begin;
  222.       for i:=0 to Font_Heigth do
  223.       begin;
  224.         w:=Font[Index].D[i];
  225.         for j:=0 to Font[Index].MaxX-1 do
  226.         begin;
  227.           if (w and 1)=0 then Col:=Gray0 else Col:=Gray4;
  228.           PutPixel(x+j,y+i,Col);
  229.           w:=W shr 1;
  230.         end;
  231.       end;
  232.     end;
  233.   end;
  234. end;
  235.  
  236. procedure Show_All_Char;
  237. var i,j,l:Word;
  238. begin;
  239.  
  240.   Shadow_Box(Char_X-2,Char_Y-2,GetMaxX-1,GetMaxY-1,Gray3,Gray2,Gray1);
  241.  
  242.   for i:=0 to Char_Rows-1 do
  243.     for j:=0 to Char_Line-1 do
  244.     begin;
  245.       l:=i+j*(Char_Rows);
  246.       if l<=Max_C then
  247.         if Font[l].MaxX=0 then rectangle(Char_X+i*(Mult_X+1),Char_Y+j*17,
  248.                                          Char_X+Mult_X-1+i*(Mult_X+1),Char_Y+Font_Heigth+j*17,Gray4)
  249.                           else Show_Char(Char_X+i*(Mult_X+1),Char_Y+j*17,l,Gray4);
  250.     end;
  251.   Show_Bios_Char(char(actuell));
  252. end;
  253.  
  254. procedure Select_Char;
  255. var l:Word;
  256. begin;
  257.   l:=(MouseX-Char_X)div (Mult_X+1) +
  258.      ((MouseY-Char_Y) div 17)*(Char_Rows);
  259.   if (l<>actuell)and(l<=Max_C) then
  260.   begin;
  261.     actuell:=l;
  262.     Show_Big_Char(chr(actuell));
  263.     Show_Bios_Char(char(actuell));
  264.     if XC>Font[actuell].MaxX then XC:=Font[actuell].MaxX;
  265.   end;
  266. end;
  267.  
  268. procedure Set_Point(x,y:Byte);
  269. var W   : Word;
  270.     col : Byte;
  271. begin;
  272.   if Font[actuell].MaxX>0 then
  273.     if FontType=1 then
  274.     begin;
  275.       w:=Font[actuell].D[x];
  276.  
  277.       if (w and (1 shl y))=0 then begin;Font[actuell].D[x]:=w or (1 shl y);Col:=Gray4;end
  278.                              else begin;Font[actuell].D[x]:=w and not (1 shl y);Col:=Gray0;end;
  279.  
  280.       Box(Box_X+x*Zoom,Box_Y+y*Zoom,Box_X+x*Zoom+Zoom-1,Box_Y+y*Zoom+Zoom-1,Col);
  281.       PutPixel(Char_X+(actuell mod (Char_Rows))*(Mult_X+1)+x,
  282.                Char_Y+(actuell div (Char_Rows))*17+y,Col);
  283.     end        else
  284.     begin;
  285.       w:=Font[actuell].D[y];
  286.  
  287.       if (W and (1 shl x))=0 then begin;Font[actuell].D[y]:=w or (1 shl x);Col:=Gray4;end
  288.                              else begin;Font[actuell].D[y]:=w and not (1 shl x);Col:=Gray0;end;
  289.  
  290.       Box(Box_X+x*Zoom,Box_Y+y*Zoom,Box_X+x*Zoom+Zoom-1,Box_Y+y*Zoom+Zoom-1,Col);
  291.       PutPixel(Char_X+(actuell mod (Char_Rows))*(Mult_X+1)+x,
  292.                Char_Y+(actuell div (Char_Rows))*17+y,Col);
  293.  
  294.     end;
  295. end;
  296.  
  297. procedure Init_Screen;
  298. var i:Byte;
  299. begin;
  300.   Char_Rows:=(GetMaxX-4) div (Mult_X+1);
  301.   Char_Line:=Max_C div Char_Rows+1;
  302.   Char_Y:=GetMaxY-4-Char_Line*17;
  303.  
  304.   i      := ((Char_Y-Box_Y) div 16)-1;
  305.   Zoom   := i;
  306.  
  307.   while (Box_X+(Mult_X+1)*Zoom+5>GetMaxX-50) do Dec(Zoom);
  308.  
  309.   But_X  := GetMaxX-x_length('Font'#26'Inc')-6;
  310.  
  311.  
  312.   for i:=250 to 255 do fillchar(My_Pal[i],3,(i-250)*12);
  313.   x_put_pal_raw(My_Pal,256,0,false);
  314.   Gray0:=250;Gray1:=251;Gray2:=252;Gray3:=253;Gray4:=254;Gray5:=255;
  315.   X_ClearAll;
  316.   Show_Big_Char(chr(actuell));
  317.   Show_All_Char;
  318.   Show_Button;
  319.  
  320. end;
  321.  
  322. procedure Load_Old_Font(Name:String);
  323. var F:File;
  324.     i:Word;
  325.     Buffer:Array[0..16]Of Byte;
  326. begin;
  327.   if F_Open_Read(f,Name) then
  328.   begin;
  329.     for i:=0 to Max_C do BlockRead(f,Font[i].d,32);
  330.     F_Close(F);
  331.   end;
  332. end;
  333.  
  334. procedure Save_Font(Name:String);
  335. var a:Byte;
  336.     i,j,h:Word;
  337.     F:File;
  338.     Buffer:Array[0..Max_C] of Word;
  339.     FontType:Byte;
  340.     B:Array[0..32] of Byte;
  341.     ww:Byte;
  342. begin;
  343.   a:=0;FontType:=0;Mult_X:=8;
  344.   while (a<=Max_C)and(Font[a].MaxX=0) do Inc(a);
  345.  
  346.   for j:=a to Max_C do if Font[j].MaxX>8 then begin;FontType:=1;Mult_X:=16;end;
  347.  
  348.   if a>Max_C then Exit;
  349.  
  350.   F_Open_Write(F,Name);
  351.   if FontType=1 then
  352.   begin;  (* 16xn Font *)
  353.     BlockWrite(F,a,1);                 (* FirstChar              *)
  354.     BlockWrite(F,FontType,1);             (* FontType                  *)
  355.     BlockWrite(f,Font_Heigth,1);       (* Font_Heigth            *)
  356.     i:=0;BlockWrite(f,i,1);            (* Font_Weidth var.       *)
  357.     i:=(Max_C-a)*2+2;
  358.     for j:=a to Max_C do
  359.     begin;
  360.       h:=(Word(Font[j].MaxX) shl 12);
  361.       h:=h+i;
  362.       if Font[j].MaxX=0 then h:=0;
  363.       Buffer[j]:=h;
  364.       Inc(i,Font[j].MaxX*2);
  365.     end;
  366.     BlockWrite(F,Buffer[a],(Max_C-a)*2+2);
  367.     for j:=a to Max_C do BlockWrite(F,Font[j].D[0],Font[j].MaxX*2);
  368.   end        else
  369.   begin;          (* save normal Font 8xn *)
  370.     ww:=Font[a].MaxX;           (* ww=0, if diff. widht *)
  371.     for j:=a+1 to 127 do if (ww<>0)and(Font[j].MaxX<>ww) then ww:=0;
  372.  
  373.     Inc(Font_Heigth);  (* fixed from load_font *)
  374.     BlockWrite(F,a,1);                 (* FirstChar              *)
  375.     BlockWrite(F,FontType,1);             (* FontType                  *)
  376.     BlockWrite(f,Font_Heigth,1);       (* Font_Heigth            *)
  377.     BlockWrite(f,ww,1);                (* Font_Widht var.       *)
  378.     j:=a;
  379.     for j:=a to Max_C do
  380.     begin;
  381.       for i:=0 to Font_Heigth+1 do B[i]:=Font[j].D[i];
  382.       BlockWrite(F,B[0],Font_Heigth);
  383.       if ww=0 then BlockWrite(F,Font[j].MaxX,1);
  384.     end;
  385.     Dec(Font_Heigth);
  386.   end;
  387.  
  388.   F_Close(f);
  389. end;
  390.  
  391. procedure Load_Font(Name:String);
  392. var a,h,WW:Byte;
  393.     F:File;
  394.     i,j,l:Word;
  395.     dummy:Boolean;
  396.     B:Array[0..32] of Byte;
  397. begin;
  398.   for i:=0 to Max_C do Font[i].MaxX:=0;
  399.   for i:=0 to Max_C do fillchar(Font[i].D[0],32,0);
  400.   dummy:=F_Open_Read(F,Name);
  401.   a:=Read_Byte(F);                   (* FirstChar            *)
  402.   FontType:=Read_Byte(F);               (* FontType , Fontselector *)
  403.   if FontType=1 then Mult_X:=16 else Mult_X:=8;
  404.   Font_Heigth:=Read_Byte(F);
  405.   WW:=Read_Byte(F);
  406.   if FontType=1 then
  407.   begin;          (* Read BigFont 16x16 *)
  408.     for j:=a to Max_C do
  409.     begin;
  410.       i:=Read_Word(F);
  411.       Font[j].MaxX:=i shr 12;
  412.     end;
  413.     for j:=a to Max_C do BlockRead(F,Font[j].D[0],Font[j].MaxX*2);
  414.   end
  415.   else
  416.   begin;          (* Read normal Font 8xn *)
  417.     j:=a;
  418.     while not eof(F) do
  419.     begin;
  420.  
  421.       if ww=0 then BlockRead(F,B[1],Font_Heigth+1)
  422.               else BlockRead(F,B[1],Font_Heigth);
  423.  
  424.       if ww=0 then Font[j].MAxX:=B[Font_Heigth+1]
  425.               else Font[j].MAxX:=WW;
  426.  
  427.       for i:=0 to Font_Heigth do Font[j].D[i]:=B[i+1];
  428.  
  429.       inc(j);
  430.     end;
  431.     Dec(Font_Heigth);
  432.   end;
  433.   F_Close(F);
  434. end;
  435.  
  436. procedure Show_Dir(F:String);
  437. var S:SearchRec;
  438.     x,y:Word;
  439. begin;
  440.   y:=Box_Y+x_font_height+2;
  441.   x:=5;
  442.   FindFirst(F, anyfile, S);
  443.   while (DosError = 0)and((y+x_font_Height<Char_Y)or(x+x_Length(S.Name)+16<But_X-x_length('  '))) do
  444.   begin
  445.     if x+x_Length(S.Name)+2>But_X then begin;x:=5;Inc(y,x_font_height);end;
  446.  
  447.     E_Write(x,y,Gray4,Gray2,S.Name);
  448.     inc(x,x_Length(S.Name)+10);
  449.     FindNext(S);
  450.   end;
  451. end;
  452.  
  453. procedure Fnt2Inc(S:String);
  454. type BIG = array[1..5000] of Byte;
  455. var i,size:Word;
  456.     f1,f2:File;
  457.     b:Byte;
  458.     Buffer:^Big;
  459. begin;
  460.   New(Buffer);
  461.   size:=F_Size(S);
  462.   if F_Open_Read(F1,S) then
  463.   begin;
  464.     s:=Only_one_Ext(S,'INC');
  465.     F_Open_Write(F2,s);
  466.     Write_Text(F2,'const Font_'+copy(s,1,pos('.INC',s)-1)+' : Array[1..'+str(size)+'] of Byte = ('#10#13'  ');
  467.     Seek(F1,0);
  468.     BlockRead(F1,Buffer^,size-1);
  469.     for i:=1 to size-1 do
  470.     begin;
  471.       b:=Buffer^[i];
  472.       Write_Text(F2,'$'+Byte2hex(b)+',');
  473.       if i mod 18=0 then Write_Text(F2,#10#13'  ');
  474.     end;
  475.     b:=Buffer^[size-1];
  476.     Write_Text(F2,'$'+Byte2hex(b)+');');
  477.     system.Close(f1);
  478.     F_Close(f2);
  479.   end;
  480.   Dispose(Buffer);
  481. end;
  482.  
  483. procedure help;
  484. var i:Byte;x,y:Word;
  485. begin;
  486.   WriteLn('fex ?                this help');
  487.   WriteLn('fex [nr] [name]      start in mode <nr> and load Fontfile <name>');
  488.   WriteLn;
  489.   WriteLn('modes without sizeproblems ');
  490.   for i:=0 to x_Max_Modi do
  491.   begin;
  492.     x_mode_info(i,x,y);
  493.     if y>200 then WriteLn('[',I:2,']   with  ',x,'x',y,' Pixel.');
  494.   end;
  495.   Halt(0);
  496. end;
  497.  
  498. (* Created by FEX with  [Font->Inc] !   (see procedure Fnt2Inc)             *)
  499. const Font_TIMPANI : Array[1..1600] of Byte = (
  500.   $01,$00,$0B,$00,$3E,$41,$55,$41,$41,$5D,$49,$41,$3E,$00,$00,
  501.   $07,$3E,$7F,$6B,$7F,$7F,$63,$77,$7F,$3E,$00,$00,$07,$00,$00,
  502.   $00,$0A,$1F,$1F,$0E,$04,$00,$00,$00,$05,$00,$00,$00,$04,$0E,
  503.   $1F,$0E,$04,$00,$00,$00,$05,$00,$04,$0E,$04,$1B,$1B,$04,$04,
  504.   $0E,$00,$00,$05,$00,$04,$0E,$1F,$1F,$0E,$04,$04,$0E,$00,$00,
  505.   $05,$00,$00,$00,$04,$0E,$04,$00,$00,$00,$00,$00,$04,$0F,$0F,
  506.   $0F,$0B,$01,$0B,$0F,$0F,$0F,$0F,$0F,$04,$00,$00,$1C,$22,$22,
  507.   $22,$1C,$00,$00,$00,$00,$06,$3F,$3F,$23,$1D,$1D,$1D,$23,$3F,
  508.   $3F,$3F,$3F,$06,$00,$00,$38,$30,$28,$04,$0C,$12,$12,$0C,$00,
  509.   $06,$00,$00,$0E,$11,$11,$0E,$04,$04,$0E,$04,$00,$05,$00,$1C,
  510.   $14,$1C,$04,$04,$04,$07,$03,$00,$00,$05,$00,$7C,$54,$74,$14,
  511.   $14,$14,$1F,$0B,$00,$00,$07,$00,$04,$04,$0E,$0E,$0E,$04,$04,
  512.   $04,$00,$00,$04,$00,$02,$06,$0E,$1E,$0E,$06,$02,$00,$00,$00,
  513.   $05,$00,$10,$18,$1C,$1E,$1C,$18,$10,$00,$00,$00,$05,$00,$04,
  514.   $0E,$04,$04,$04,$04,$0E,$04,$00,$00,$04,$00,$0A,$0A,$0A,$0A,
  515.   $0A,$0A,$00,$0A,$00,$00,$04,$00,$1E,$15,$15,$16,$14,$14,$14,
  516.   $14,$00,$00,$05,$0E,$01,$06,$0C,$0A,$0A,$06,$0C,$10,$0E,$00,
  517.   $05,$00,$00,$00,$00,$00,$00,$00,$00,$1F,$1F,$00,$05,$00,$04,
  518.   $0E,$04,$04,$04,$04,$04,$0E,$04,$0E,$04,$00,$04,$0E,$1F,$04,
  519.   $04,$04,$04,$04,$00,$00,$05,$00,$04,$04,$04,$04,$04,$1F,$0E,
  520.   $04,$00,$00,$05,$00,$00,$00,$04,$0C,$1F,$0C,$04,$00,$00,$00,
  521.   $05,$00,$00,$00,$04,$06,$1F,$06,$04,$00,$00,$00,$05,$00,$00,
  522.   $00,$00,$02,$0E,$00,$00,$00,$00,$00,$04,$00,$00,$00,$12,$3F,
  523.   $12,$00,$00,$00,$00,$00,$06,$00,$00,$04,$04,$0E,$0E,$1F,$1F,
  524.   $00,$00,$00,$05,$00,$00,$1F,$1F,$0E,$0E,$04,$04,$00,$00,$00,
  525.   $05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$04,$02,$02,
  526.   $02,$02,$02,$00,$02,$02,$00,$00,$00,$02,$0A,$0A,$0A,$00,$00,
  527.   $00,$00,$00,$00,$00,$00,$04,$12,$12,$3F,$12,$12,$12,$3F,$12,
  528.   $12,$00,$00,$06,$08,$1C,$2A,$0A,$0C,$18,$28,$2A,$1C,$08,$00,
  529.   $06,$06,$49,$26,$10,$08,$04,$32,$49,$30,$00,$00,$07,$04,$0A,
  530.   $0A,$04,$04,$2A,$12,$12,$2C,$00,$00,$06,$04,$04,$04,$00,$00,
  531.   $00,$00,$00,$00,$00,$00,$03,$08,$0C,$04,$02,$02,$02,$02,$04,
  532.   $0C,$08,$00,$04,$02,$06,$04,$08,$08,$08,$08,$04,$06,$02,$00,
  533.   $04,$00,$00,$00,$22,$1C,$3E,$1C,$22,$00,$00,$00,$07,$00,$00,
  534.   $08,$08,$3E,$08,$08,$00,$00,$00,$00,$06,$00,$00,$00,$00,$00,
  535.   $00,$00,$00,$04,$02,$00,$03,$00,$00,$00,$00,$0E,$00,$00,$00,
  536.   $00,$00,$00,$04,$00,$00,$00,$00,$00,$00,$00,$00,$02,$00,$00,
  537.   $02,$08,$08,$04,$04,$04,$04,$04,$02,$02,$00,$00,$04,$1C,$22,
  538.   $22,$22,$22,$22,$22,$22,$1C,$00,$00,$06,$20,$38,$20,$20,$20,
  539.   $20,$20,$20,$20,$00,$00,$06,$1C,$22,$20,$20,$10,$08,$04,$02,
  540.   $3E,$00,$00,$06,$1C,$22,$20,$20,$18,$20,$20,$22,$1C,$00,$00,
  541.   $06,$10,$18,$18,$14,$14,$12,$3E,$10,$10,$00,$00,$06,$3E,$02,
  542.   $02,$1E,$22,$20,$20,$22,$1C,$00,$00,$06,$1C,$22,$02,$02,$1E,
  543.   $22,$22,$22,$1C,$00,$00,$06,$3E,$20,$10,$10,$08,$08,$04,$04,
  544.   $04,$00,$00,$06,$1C,$22,$22,$22,$1C,$22,$22,$22,$1C,$00,$00,
  545.   $06,$1C,$22,$22,$22,$3C,$20,$20,$22,$1C,$00,$00,$06,$00,$02,
  546.   $02,$00,$00,$00,$00,$02,$02,$00,$00,$02,$00,$04,$04,$00,$00,
  547.   $00,$00,$04,$04,$02,$00,$03,$00,$10,$08,$04,$02,$04,$08,$10,
  548.   $00,$00,$00,$05,$00,$00,$00,$3E,$00,$3E,$00,$00,$00,$00,$00,
  549.   $06,$00,$02,$04,$08,$10,$08,$04,$02,$00,$00,$00,$05,$1C,$22,
  550.   $20,$20,$10,$08,$08,$00,$08,$00,$00,$06,$38,$44,$B2,$AA,$AA,
  551.   $AA,$52,$04,$38,$00,$00,$08,$10,$10,$28,$28,$44,$44,$7C,$82,
  552.   $82,$00,$00,$08,$3C,$44,$44,$44,$3C,$44,$44,$44,$3C,$00,$00,
  553.   $07,$3C,$42,$02,$02,$02,$02,$02,$42,$3C,$00,$00,$07,$1E,$22,
  554.   $42,$42,$42,$42,$42,$22,$1E,$00,$00,$07,$3E,$02,$02,$02,$1E,
  555.   $02,$02,$02,$3E,$00,$00,$06,$3E,$02,$02,$02,$1E,$02,$02,$02,
  556.   $02,$00,$00,$06,$3C,$42,$02,$02,$72,$42,$42,$62,$5C,$00,$00,
  557.   $07,$42,$42,$42,$42,$7E,$42,$42,$42,$42,$00,$00,$07,$02,$02,
  558.   $02,$02,$02,$02,$02,$02,$02,$00,$00,$02,$10,$10,$10,$10,$10,
  559.   $10,$12,$12,$0C,$00,$00,$05,$44,$24,$14,$0C,$0C,$14,$24,$44,
  560.   $84,$00,$00,$08,$02,$02,$02,$02,$02,$02,$02,$02,$3E,$00,$00,
  561.   $06,$82,$82,$C6,$C6,$AA,$AA,$92,$92,$82,$00,$00,$08,$42,$46,
  562.   $46,$4A,$4A,$52,$62,$62,$42,$00,$00,$07,$3C,$42,$42,$42,$42,
  563.   $42,$42,$42,$3C,$00,$00,$07,$3E,$42,$42,$42,$3E,$02,$02,$02,
  564.   $02,$00,$00,$07,$3C,$42,$42,$42,$42,$42,$52,$62,$3C,$40,$00,
  565.   $07,$3E,$42,$42,$42,$3E,$42,$42,$42,$42,$00,$00,$07,$1C,$22,
  566.   $02,$02,$1C,$20,$20,$22,$1C,$00,$00,$06,$3E,$08,$08,$08,$08,
  567.   $08,$08,$08,$08,$00,$00,$06,$42,$42,$42,$42,$42,$42,$42,$42,
  568.   $3C,$00,$00,$07,$82,$82,$44,$44,$44,$28,$28,$10,$10,$00,$00,
  569.   $08,$82,$82,$82,$82,$82,$92,$92,$AA,$44,$00,$00,$08,$82,$82,
  570.   $44,$28,$10,$28,$44,$82,$82,$00,$00,$08,$82,$82,$44,$28,$10,
  571.   $10,$10,$10,$10,$00,$00,$08,$FE,$80,$40,$20,$10,$08,$04,$02,
  572.   $FE,$00,$00,$08,$06,$02,$02,$02,$02,$02,$02,$02,$02,$06,$00,
  573.   $03,$02,$02,$04,$04,$04,$04,$08,$08,$00,$00,$00,$04,$06,$04,
  574.   $04,$04,$04,$04,$04,$04,$04,$06,$00,$03,$08,$14,$22,$00,$00,
  575.   $00,$00,$00,$00,$00,$00,$06,$00,$00,$00,$00,$00,$00,$00,$00,
  576.   $3E,$00,$00,$06,$06,$0C,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  577.   $04,$00,$00,$00,$1C,$20,$3C,$22,$22,$3C,$00,$00,$06,$02,$02,
  578.   $02,$1E,$22,$22,$22,$22,$1E,$00,$00,$06,$00,$00,$00,$1C,$22,
  579.   $02,$02,$22,$1C,$00,$00,$06,$20,$20,$20,$3C,$22,$22,$22,$22,
  580.   $3C,$00,$00,$06,$00,$00,$00,$1C,$22,$3E,$02,$22,$1C,$00,$00,
  581.   $06,$04,$02,$02,$06,$02,$02,$02,$02,$02,$00,$00,$03,$00,$00,
  582.   $00,$3C,$22,$22,$22,$22,$3C,$20,$1E,$06,$02,$02,$02,$1A,$26,
  583.   $22,$22,$22,$22,$00,$00,$06,$02,$00,$00,$02,$02,$02,$02,$02,
  584.   $02,$00,$00,$02,$02,$00,$00,$02,$02,$02,$02,$02,$02,$02,$02,
  585.   $02,$02,$02,$02,$12,$0A,$06,$0A,$12,$22,$00,$00,$06,$02,$02,
  586.   $02,$02,$02,$02,$02,$02,$02,$00,$00,$02,$00,$00,$00,$6E,$92,
  587.   $92,$92,$92,$92,$00,$00,$08,$00,$00,$00,$1A,$26,$22,$22,$22,
  588.   $22,$00,$00,$06,$00,$00,$00,$1C,$22,$22,$22,$22,$1C,$00,$00,
  589.   $06,$00,$00,$00,$1E,$22,$22,$22,$22,$1E,$02,$02,$06,$00,$00,
  590.   $00,$3C,$22,$22,$22,$22,$3C,$20,$20,$06,$00,$00,$00,$06,$02,
  591.   $02,$02,$02,$02,$00,$00,$03,$00,$00,$00,$0C,$12,$04,$08,$12,
  592.   $0C,$00,$00,$05,$00,$02,$02,$06,$02,$02,$02,$02,$04,$00,$00,
  593.   $03,$00,$00,$00,$22,$22,$22,$22,$32,$2C,$00,$00,$06,$00,$00,
  594.   $00,$22,$22,$14,$14,$08,$08,$00,$00,$06,$00,$00,$00,$92,$92,
  595.   $AA,$AA,$44,$44,$00,$00,$08,$00,$00,$00,$12,$12,$0C,$0C,$12,
  596.   $12,$00,$00,$05,$00,$00,$00,$12,$12,$12,$12,$0C,$04,$04,$03,
  597.   $05,$00,$00,$00,$1E,$10,$08,$04,$02,$1E,$00,$00,$05,$0C,$04,
  598.   $04,$04,$04,$02,$04,$04,$04,$0C,$00,$04,$02,$02,$02,$02,$02,
  599.   $02,$02,$02,$02,$02,$00,$02,$06,$04,$04,$04,$04,$08,$04,$04,
  600.   $04,$06,$00,$04,$0A,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  601.   $04,$0E,$11,$15,$11,$0E,$00,$00,$00,$00,$00,$00,$05,$00,$14,
  602.   $00,$1C,$20,$3C,$22,$22,$3C,$00,$00,$06,$54,$10,$28,$28,$44,
  603.   $44,$7C,$82,$82,$00,$00,$08,$00,$14,$00,$1C,$22,$22,$22,$22,
  604.   $1C,$00,$00,$06,$24,$00,$3C,$42,$42,$42,$42,$42,$3C,$00,$00,
  605.   $07,$00,$14,$00,$22,$22,$22,$22,$32,$2C,$00,$00,$06,$24,$00,
  606.   $42,$42,$42,$42,$42,$42,$3C,$00,$00,$00);
  607.  
  608.  
  609. Var A:Char;
  610.     i,j,c:Integer;
  611.     s:String;
  612.     d:Boolean;
  613.     P:Pointer;F:File;
  614.  
  615. begin;
  616.   WriteLn('FEX  Font Editor for mode X    by Christian Harms');
  617.   WriteLn;
  618.   j:=3;s:='';
  619.   if paramcount>0 then
  620.   begin;
  621.     for i:=1 to paramcount do if pos('?',paramstr(i))>0 then help;
  622.     i:=1;
  623.     val(paramstr(i),j,c);
  624.     if c=0 then Inc(i) else j:=3;
  625.     if paramcount<=i then set_key_makro('L'+paramstr(i)+Enter);
  626.   end;
  627.  
  628.   X_Set_Mode(j,400);
  629.   x_text_init;
  630.   X_register_userfont(Font_Timpani);
  631.   x_set_font(2);
  632.   E_Read_Mode:=Only_Filename;   (* E_Input gets only digits for Filename. *)
  633.  
  634.  
  635.   MyMouseInit;
  636.   DefineMouseCursor(MyMouseForm,Gray5);
  637.  
  638.   Init_Mem;
  639.   actuell:=76;
  640.   Init_Screen;
  641.   Set_Cursor(XC,YC,Gray5);
  642.  
  643.   repeat
  644.     ShowMouse;
  645.     MouseAction := False;
  646.  
  647.     repeat
  648.             (* This is the idea of X_Button and X_Keys !!!
  649.                So you can use Buttons by press the key or click with mouse .
  650.                Works without a mousedriver, too !                           *)
  651.       if ButtonStatus<>0 then
  652.         case Get_pressed_Button of
  653.             0:;
  654.             1:set_key_Makro('L');
  655.             2:set_key_Makro('S');
  656.             3:set_key_Makro('D');
  657.             4:set_key_Makro('F');
  658.            10:set_key_Makro(#0+Shift_Tab);
  659.            11:set_key_Makro(TAB);
  660.            12:set_key_Makro(#0+F2);
  661.            13:set_key_Makro(#0+F3);
  662.            14:set_key_Makro(#0+F1);
  663.         end;
  664.  
  665.       if MouseAction then           (* If mouse moved ... *)
  666.       begin;
  667.         if (MouseY>Box_Y) and (MouseX>Box_X) and
  668.            InBox(Box_X,Box_Y,Box_X+Mult_X*Zoom-2,Box_Y+16*Zoom-2) and
  669.  
  670.            (((MouseX-Box_X)div Zoom)<Font[actuell].MaxX)     and
  671.            (((MouseY-Box_Y)div Zoom)<=Font_Heigth)                then
  672.         begin;
  673.           HideMouse;
  674.           Get_Cursor;
  675.           if FontType=1 then i:=(Font[actuell].D[XC] and (1 shl YC))
  676.                      else i:=(Font[actuell].D[YC] and (1 shl XC));
  677.           case ButtonStatus of
  678.             0:begin;end;
  679.             1:if (i=0 ) then begin;Set_Point(XC,YC);delay(100);end;
  680.             2:if (i<>0) then begin;Set_Point(XC,YC);delay(100);end;
  681.             3:begin;Set_Point(XC,YC);delay(100);end;
  682.           end;
  683.         end;
  684.         if InBox(Char_X,Char_Y,GetMaxX,GetMaxY)and (ButtonStatus<>0) then
  685.         begin;
  686.           HideMouse;
  687.           Select_Char;
  688.         end;
  689.  
  690.         MouseAction:=False;
  691.         ShowMouse;
  692.       end;
  693.  
  694.     until keyspressed;
  695.  
  696.     HideMouse;      (* ! imported ! *)
  697.     a:=UpCase(ReadKeys);
  698.     case a of
  699.        #0: begin;
  700.              a:=ReadKeys;
  701.              Set_Cursor(XC,YC,Gray2);
  702.              case a of
  703.                Left  : if XC>0 then Dec(XC) else XC:=Font[actuell].MaxX;
  704.                Right : if XC<Font[actuell].MaxX then Inc(XC) else XC:=0;
  705.                Up    : if YC>0 then Dec(YC) else YC:=Font_Heigth       ;
  706.                Down  : if YC<Font_Heigth        then Inc(YC);
  707.                Shift_TAB :if Font[actuell].MaxX>0 then
  708.                        begin;
  709.                          Dec(Font[actuell].MaxX);
  710.                          if XC>Font[actuell].MaxX then XC:=Font[actuell].MaxX;
  711.                          Show_Big_Char(chr(actuell));
  712.                          Show_Char(Char_X+(actuell mod (Char_Rows))*(Mult_X+1),
  713.                                    Char_Y+(actuell div (Char_Rows))*17,
  714.                                    actuell,Gray4);
  715.                        end;
  716.                PGDown: if actuell<Max_C then
  717.                        begin;
  718.                          Inc(actuell);
  719.                          Show_Big_Char(chr(actuell));
  720.                          Show_Bios_Char(char(actuell));
  721.                        end;
  722.                PGUp: if actuell>0 then
  723.                        begin;
  724.                          Dec(actuell);
  725.                          Show_Big_Char(chr(actuell));
  726.                          Show_Bios_Char(char(actuell));
  727.                        end;
  728.                F1:begin;
  729.                     Box(0,0,But_X-6-x_length('  '),Char_Y-3,0);
  730.                     i:=10;
  731.                     for j:=1 to Max_Lines do
  732.                     begin;X_write(5,i,255,Help_Lines[j]);Inc(i,x_font_height);end;
  733.                     wait_key(Return);
  734.                     Box(0,0,But_X-6-x_length('  '),Char_Y-3,0);
  735.                     Show_Big_Char(chr(actuell));
  736.                   end;
  737.                F2:if Font_Heigth>1 then
  738.                   begin;
  739.                     Dec(Font_Heigth);
  740.                     Init_Screen;
  741.                   end;
  742.                F3:if Font_Heigth<15 then
  743.                   begin;
  744.                     Inc(Font_Heigth);
  745.                     Init_Screen;
  746.                   end;
  747.              end;
  748.              Set_Cursor(XC,YC,Gray5);
  749.            end;
  750.     Space:Set_Point(XC,YC);
  751.     Enter:for i:=0 to 4 do
  752.             if (Big_Point[i,0]+XC>=0)and(Big_Point[i,0]+XC<=Font[actuell].MaxX)and
  753.                (Big_Point[i,1]+YC>=0)and(Big_Point[i,1]+YC<=Font_Heigth) then
  754.                   Set_Point(Big_Point[i,0]+XC,Big_Point[i,1]+YC);
  755.       TAB:if (FontType=1)and(Font[actuell].MaxX<15)or
  756.              (FontType=0)and(Font[actuell].MaxX<8)  then
  757.           begin;
  758.             Inc(Font[actuell].MaxX);
  759.             Show_Big_Char(chr(actuell));
  760.             Show_Char(Char_X+(actuell mod (Char_Rows))*(Mult_X+1),
  761.                       Char_Y+(actuell div (Char_Rows))*17,actuell,Gray4);
  762.           end;
  763.     'S':begin;
  764.           s:=FileName;
  765.           if FontType=0 then begin;
  766.                              Shadow_Box(8,8,But_X-20,x_font_height+11,Gray5,Gray4,Gray3);
  767.                              E_Input(10,10,But_X-24,Gray0,Gray2,Gray4,Gray0,'Save (8xn): ',s);
  768.                           end
  769.                      else begin;
  770.                              Shadow_Box(8,8,But_X-20,x_font_height*2+11,Gray5,Gray4,Gray3);
  771.                              x_write(10,12+x_font_height,Gray0,'XLib_C dont support this in version 6 !');
  772.                              E_Input(10,10,But_X-24,Gray0,Gray2,Gray4,Gray0,'Save (16xn): ',s);
  773.                           end;
  774.  
  775.           if s<>'' then begin;FileName:=Only_One_Ext(S,'FNT');Save_Font(Filename);end;
  776.           Box(8,8,But_X-20,x_font_height*2+12,Gray0);
  777.           Show_Big_Char(chr(actuell));
  778.         end;
  779.     'L':begin;
  780.           s:=FileName;
  781.           Shadow_Box(8,8,But_X-20,x_font_height+11,Gray5,Gray4,Gray3);
  782.           E_Input(10,10,But_X-24,Gray0,Gray2,Gray4,Gray0,'Load Font: ',s);
  783.           if F_Size(Only_One_Ext(S,'FNT'))=0 then s:='';
  784.           if s<>'' then begin;FileName:=Only_One_Ext(S,'FNT');Load_Font(Filename);end;
  785.           XC:=0;YC:=0;
  786.           Init_Screen;
  787.         end;
  788.     'D':begin;
  789.           s:='*.fnt';
  790.           Shadow_Box(8,8,But_X-20,x_font_height+11,Gray5,Gray4,Gray3);
  791.           E_Input(10,10,But_X-24,Gray0,Gray2,Gray4,Gray0,'Wildcard : ',s);
  792.           Box(Box_X,Box_Y,But_X-20,Char_Y-10,Gray0);
  793.           if s<>'' then begin;Show_Dir(s);wait_key(#13);end;
  794.           Box(Box_X,Box_Y,But_X-20,Char_Y-10,Gray0);
  795.           Show_Big_Char(chr(actuell));
  796.         end;
  797.     'F':begin;
  798.           s:=FileName;
  799.           Shadow_Box(8,8,But_X-20,x_font_height+11,Gray5,Gray4,Gray3);
  800.           E_Input(10,10,But_X-24,Gray0,Gray2,Gray4,Gray0,'Fontfilename: ',s);
  801.           if F_Size(Only_One_Ext(S,'FNT'))=0 then s:='';
  802.           if s<>'' then begin;FileName:=Only_One_Ext(S,'FNT');Fnt2Inc(Filename);end;
  803.           Box(8,8,But_X-20,x_font_height+12,Gray0);
  804.           Show_Big_Char(chr(actuell));
  805.         end;
  806.  
  807.       ESC:Ende:=True;
  808.     end;
  809.  
  810.  
  811.  
  812.   until Ende;
  813.  
  814.  
  815.   for i:=1 to 3 do D:=Kill_Button(i); (* to make free the heap *)
  816.  
  817.   MyMouseDestroy;
  818.   X_Text_Mode;
  819.  
  820.   WriteLn('This is the end of FEX, the Font Editor in mode X  by Christian Harms.');
  821.   WriteLn;
  822.   WriteLn('FEX is a demo/utility of XLib_TP, the mode x-programmer lib for TP.');
  823. end.
  824.  
  825.  
  826.  
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837.  
  838.