home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DEMOS / BLA2SRC.ZIP / GETFONT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-11  |  2.4 KB  |  114 lines
  1.  
  2.  
  3. TYPE
  4.    TScr = ARRAY [0..199,0..319] OF BYTE;
  5.  
  6. VAR
  7.    s : ^TScr;
  8.    fi : FILE OF TScr;
  9.  
  10.    Let : ARRAY [0..23,0..23] OF BYTE;
  11.    ncol, nLet, llen : INTEGER;
  12.    adr : INTEGER;
  13.    i : INTEGER;
  14.  
  15.    starts : ARRAY [0..100] OF WORD;
  16.    lens   : ARRAY [0..100] OF WORD;
  17.  
  18.  
  19. FUNCTION IsColEmpty: BOOLEAN;
  20.    VAR
  21.       j : INTEGER;
  22.    BEGIN
  23.       j := 0;
  24.       WHILE (s^[1+i*24+j, ncol] = 0) AND (j < 23) DO
  25.          INC(j);
  26.       IsColEmpty := (j >= 23)
  27.    END;
  28.  
  29.    CONST
  30.       LastCol : BYTE = 0;
  31.       LCount  : INTEGER = 0;
  32. PROCEDURE DumpCol;
  33.    CONST
  34.       LastCol : BYTE = 0;
  35.       LCount  : INTEGER = 0;
  36.  
  37.    VAR
  38.       j : INTEGER;
  39.    BEGIN
  40. {
  41.       Write(' DB ');    (* Un pixel por byte. *)
  42.       FOR j := 1 TO 23 DO BEGIN
  43.          Write (s^[i*24+j, ncol]);
  44.          IF j < 23 THEN
  45.             Write(',')
  46.       END;
  47.       INC(adr, 23);
  48.       WriteLn
  49. }
  50.  
  51.       Write(' DB ');    (* Dos pixels por byte. *)
  52.       FOR j := 0 TO 11 DO BEGIN
  53.          Write (s^[i*24+2*j, ncol]*16 + s^[i*24+2*j+1, ncol]);
  54.          IF j < 11 THEN
  55.             Write(',')
  56.       END;
  57.       INC(adr, 12);
  58.       WriteLn
  59.  
  60. {      FOR j := 1 TO 23 DO BEGIN   (* Comprimiendo ristras. *)
  61.          IF s^[i*24+j, ncol] = (LastCol AND 7) THEN
  62.             INC(LastCol,8)
  63.          ELSE BEGIN
  64.             Write (LastCol);
  65.             LastCol := s^[i*24+j, ncol];
  66.             IF LCount < 23 THEN BEGIN
  67.                INC(LCount);
  68.                Write(',')
  69.             END ELSE BEGIN
  70.                LCount := 0;
  71.                WriteLn;
  72.                Write('DB ')
  73.             END
  74.          END
  75.       END;
  76.       INC(adr, 23);
  77. }
  78.    END;
  79.  
  80.  
  81. BEGIN
  82.    NEW(s);
  83.    Assign(fi, 'Fuente1.Pix');
  84.    Reset(fi);
  85.    Read(fi, s^);
  86.    Close(fi);
  87.  
  88.  
  89.    WriteLn('FontData LABEL BYTE');
  90.    adr  := 0;
  91.    nLet := 0;
  92.    FOR i := 0 TO 3 DO BEGIN
  93.       ncol := 0;
  94.       WHILE ncol < 320 DO BEGIN
  95.          IF IsColEmpty THEN
  96.             INC(ncol)
  97.          ELSE BEGIN
  98.             starts[nLet] := adr;
  99.             llen := 0;
  100.             REPEAT
  101.                DumpCol;
  102.                INC(llen);
  103.                INC(ncol)
  104.             UNTIL (llen >= 24) OR (ncol >= 320) OR IsColEmpty;
  105.             lens[nLet] := llen;
  106.             INC(nLet)
  107.          END
  108.       END
  109.    END;
  110.    WriteLn;
  111.    WriteLn('FontTable LABEL BYTE');
  112.    FOR i := 0 TO nLet-1 DO
  113.       WriteLn(' DB ', lens[i]:2{, ', OFFSET FontData+', starts[i]:5})
  114. END.