OpenCores
URL https://opencores.org/ocsvn/usb_fpga_1_2/usb_fpga_1_2/trunk

Subversion Repositories usb_fpga_1_2

[/] [usb_fpga_1_2/] [trunk/] [bmp/] [src/] [textbuf.pas] - Diff between revs 4 and 8

Show entire file | Details | Blame | View Log

Rev 4 Rev 8
Line 1... Line 1...
{*!
{*!
   bmp -- babel macro processor
   bmp -- babel macro processor
   Copyright (C) 2009-2010 ZTEX e.K.
   Copyright (C) 2009-2011 ZTEX GmbH.
   http://www.ztex.de
   http://www.ztex.de
 
 
   This program is free software; you can redistribute it and/or modify
   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License version 3 as
   it under the terms of the GNU General Public License version 3 as
   published by the Free Software Foundation.
   published by the Free Software Foundation.
Line 248... Line 248...
 
 
{ ********************************************************************* }
{ ********************************************************************* }
{ ****** FileCache **************************************************** }
{ ****** FileCache **************************************************** }
{ ********************************************************************* }
{ ********************************************************************* }
const fileCount   : longint = 0;
const fileCount   : longint = 0;
var fileCache : array[0..4095] of ansistring;
var fileCache : array[0..2047] of ansistring;
 
 
{ ****** getFileNum *************************************************** }
{ ****** getFileNum *************************************************** }
function getFileNum(const fn:ansistring):longint;
function getFileNum(const fn:ansistring):longint;
var i  : longint;
var i  : longint;
begin
begin
i:=0;
i:=0;
while (i<fileCount) and (i<4096) and (fn<>fileCache[i]) do
while (i<fileCount) and (i<2047) and (fn<>fileCache[i]) do
  i+=1;
  i+=1;
if fn<>fileCache[i] then
if fn<>fileCache[i] then
  begin
  begin
  i:=fileCount and 4095;
  i:=fileCount and 2047;
  fileCache[i]:=fn;
  fileCache[i]:=fn;
  fileCount+=1;
  fileCount+=1;
  end;
  end;
result:=i;
result:=i;
end;
end;
 
 
{ ****** lineInfoStr ************************************************* }
{ ****** lineInfoStr ************************************************* }
function lineInfoStr(li:dword):ansistring;
function lineInfoStr(li:dword):ansistring;
begin
begin
result:=fileCache[li and 4095]+'('+int2str((li shr 12)+1)+')';
result:=fileCache[li and 2047]+'('+int2str((li shr 12)+1)+')';
end;
end;
 
 
procedure lineInfoStr(var fo:text; li:dword);
procedure lineInfoStr(var fo:text; li:dword);
var s   : ansistring;
var s   : ansistring;
    i,j : longint;
    i,j : longint;
begin
begin
 
if li and 2048 <> 0 then exit;
pointer(s):=nil;
pointer(s):=nil;
i:=1;
i:=1;
while i<=length(lineInfoPattern) do
while i<=length(lineInfoPattern) do
  begin
  begin
  if (lineInfoPattern[i]='%') and (i<length(lineInfoPattern))
  if (lineInfoPattern[i]='%') and (i<length(lineInfoPattern))
    then case lineInfoPattern[i+1] of
    then case lineInfoPattern[i+1] of
           '1' : begin
           '1' : begin
                 for j:=1 to length(fileCache[li and 4095]) do
                 for j:=1 to length(fileCache[li and 2047]) do
                   if fileCache[li and 4095][j]='\'
                   if fileCache[li and 2047][j]='\'
                     then s+='\\'
                     then s+='\\'
                     else s+=fileCache[li and 4095][j];
                     else s+=fileCache[li and 2047][j];
                 i+=1;
                 i+=1;
                 end;
                 end;
           '2' : begin
           '2' : begin
                 s+=int2str(li shr 12);
                 s+=int2str(li shr 12);
                 i+=1;
                 i+=1;
Line 305... Line 306...
  i+=1;
  i+=1;
  end;
  end;
writeln(fo,s);
writeln(fo,s);
end;
end;
 
 
 
procedure initFileCache;
 
var i : longint;
 
begin
 
fileCache[0]:='?';
 
for i:=1 to 2047 do
 
  fileCache[i]:=fileCache[0];
 
end;
 
 
 
begin
 
initFileCache;
end.
end.
 
 
 No newline at end of file
 No newline at end of file

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.