syst.inc

bmf汉字预览显示

  add  al,'0'
  stosb
  pop  ax
  shr  eax,4
  loop @1
  cli
  cld
end;  {hex}

procedure chgB(where:pointer; c1,c2:byte; size:dword); assembler;
asm
  mov  ecx,size
  jecxz @end
  mov  edi,where
  or   edi,edi
  jz   @end
  mov  al,c1
  mov  ah,c2
@1:
  repne scasb
  jecxz @end
  mov  es:[edi],ah
  jmp  @1
@end:
end;  {chgB}

procedure chgTo(src,dest:pointer; c1,c2:byte; size:dword); assembler; {vsechny c1 v src zapise jako c2 do dest}
asm
  mov  ecx,src
  jecxz @end
  mov  edi,ecx
  mov  ecx,size
  jecxz @end
  mov  esi,dest
  add  esi,ecx
  dec  esi
  mov  ebx,esi
  mov  al,c1
  mov  ah,c2
@1:
  repne scasb
  jne  @end
  mov  esi,ebx
  sub  esi,ecx
  mov  [esi],ah
  jecxz @end
  jmp  @1
@end:
end;  {chgTo}

PROCEDURE xchg(var a,b;bytes:dword); assembler;
asm
 mov  ecx,bytes
 jcxz @2
 mov  esi,a
 mov  edi,b
 mov  eax,esi
 and  eax,edi
 or   eax,eax
 jz   @2
@1:
 mov  al,[edi]
 xchg al,[esi]
 stosb
 lodsb
 loop @1
@2:
end;  {xchg}

procedure rotmove(var src,dest;bytes:dword); assembler; {rotuje data v ramci radku}
asm
  mov  ecx,bytes
  jecxz @end
  mov  esi,src
  mov  edi,dest
  add  esi,ecx
  add  edi,ecx
  mov  edx,4
  shr  ecx,1
  rcl  ebx,1
  shr  ecx,1
  rcl  ebx,1
  jecxz @1_
@1:
  sub  esi,edx
  mov  eax,[esi]
  sub  edi,edx
  mov  [edi],eax
  loop @1
@1_:
  shr  ebx,1
  rcl  ecx,1
  jecxz @2_
  mov  edx,0FFFFh
@2:
  not  edx
  dec  esi
  dec  esi
  mov  eax,[esi]
  and  eax,edx
  dec  edi
  dec  edi
  not  edx
  and  [edi],edx
  or   [edi],eax
  loop @2
@2_:
  or   ebx,ebx
  jns  @end
  dec  esi
  dec  edi
  xchg edi,esi
  movsb
@end:
end;  {rotmove}

procedure clearRegs; inline($66/$33/$C0/$66/$33/$DB/$66/$33/$C9/$66/$33/$E2/$66/$33/$F6/$66/$33/$FF);

procedure fillword(var where; words:dword; value:word); assembler;
asm
  mov  edi,where
  mov  ax,value
  mov  ecx,eax
  rol  eax,16
  mov  ax,cx
  mov  ecx,words
  shr  ecx,1
  rep  stosd
  adc  ecx,0
  rep  stosw
end;   {fillword}

procedure fillattr(var where; count:dword; attr:byte); assembler;
asm
  mov  edi,where
  mov  al,attr
  mov  ecx,count
  jecxz @end
@attr:
  stosb
  inc  edi
  loop @attr
@end:
end;   {fillword}

function  trim(s:string):string;
begin
  while (length(s)>0) and (s[1] in [' ',#0]) do delete(s,1,1);
  while (length(s)>0) and (s[length(s)] in [' ',#0]) do dec(s[0]);
  result:=s;
end;  {trim}

procedure biosWriteChar(c:char);
var r:TRmRegs;
begin
  ClearRmRegs(r);
  with r do begin
    AH:=2;
    DL:=ord(c);
  end;
  RealModeInt($21,r);
end;  {biosWriteChar}

procedure biosWrite(const st:string);
var i:dword;
begin
  for i:=1 to length(st) do
    biosWriteChar(st[i]);
end;  {biosWrite}

procedure biosWriteLn(const st:string);
begin
  biosWrite(st+CRLF);
end;  {biosWriteLn}

function  fileExists(const filename:string):boolean;
var
  r:TRmRegs;
  filenameseg:word;
  dtaseg:word;
begin
  result:=false;
  if filename='' then exit;
  filenameseg:=DOSMemoryAlloc(256);
  if filenameseg=0 then exit;
  dtaseg:=DOSMemoryAlloc(64);
  if dtaseg=0 then begin
    DOSMemoryFree(filenameseg);
    exit;
  end;
  move(filename[1],pointer(dword(filenameseg) shl 4)^,length(filename));
  mem[dword(filenameseg) shl 4+length(filename)]:=0;
  ClearRmRegs(r);
  with r do begin
    AH:=$1A;
    DS:=dtaseg; {DX already 0}
    RealModeInt($21,r); {sets disk transfer address}
    AH:=$4E;
    DS:=filenameseg;
    DX:=0;
    CX:=faANYFILE and not(faVOLUMEID or faDIRECTORY);
    RealModeInt($21,r); {find first}
    result:=Flags and FLAGS_CARRY=0;
  end;
  DOSMemoryFree(dtaseg);
  DOSMemoryFree(filenameseg);
end;  {fileExists}

procedure insertFileBytes(var f:file;wherefrom,howmany:longint);
var
  pos1,pos2,origsize:longint;
  m:word;
  buffer:array[0..BUFSIZE-1] of byte;
begin
  origsize:=filesize(f);
  if (wherefrom>origsize) or (howmany<=0) {or (TFileRec(f).mode<>fmInOut)} then exit;
  pos1:=origsize; pos2:=origsize+howmany;
  repeat
    dec(pos1,BUFSIZE); dec(pos2,BUFSIZE);
    if pos1<wherefrom then break;
    seek(f,pos1); blockread(f,buffer,BUFSIZE);
    seek(f,pos2); blockwrite(f,buffer,BUFSIZE);
  until FALSE;
  m:=(filesize(f)-wherefrom-howmany) mod BUFSIZE;
  if m<>0 then begin
    seek(f,wherefrom);         blockread(f,buffer,m);
    seek(f,wherefrom+howmany); blockwrite(f,buffer,m);
  end;
end;  {insertFileBytes}

procedure deleteFileBytes(var f:file;wherefrom,howmany:longint);
var
  j:longint;
  m:word;
  buffer:array[0..BUFSIZE-1] of byte;
begin
  if (wherefrom>=filesize(f)) or (howmany<=0) {or (FileRec(f).mode<>fmInOut)} then exit;
  if wherefrom+howmany>filesize(f) then howmany:=filesize(f)-wherefrom;
  j:=-1;
  for j:=0 to (filesize(f)-wherefrom-howmany) div BUFSIZE-1 do begin
    seek(f,wherefrom+j*BUFSIZE+howmany); blockread(f,buffer,BUFSIZE);
    seek(f,wherefrom+j*BUFSIZE); blockwrite(f,buffer,BUFSIZE);
  end;
  inc(j);
  m:=(filesize(f)-wherefrom-howmany) mod BUFSIZE;
  if m<>0 then begin
    seek(f,wherefrom+j*BUFSIZE+howmany); blockread(f,buffer,m);
    seek(f,wherefrom+j*BUFSIZE); blockwrite(f,buffer,m);
  end;
  seek(f,filesize(f)-howmany); truncate(f);
end;  {deleteFileBytes}

FUNCTION  timestr:string8;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  r.ah:=$2C;
  RealModeInt($21,r);
  with r do result:=chr(48+ch div 10)+chr(48+ch mod 10)+chr(32+26*byte(dl>49))+chr(48+cl div 10)+chr(48+cl mod 10);
end;  {timestr}

FUNCTION  datestr:string8;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  r.ah:=$2A;
  RealModeInt($21,r);
  with r do result:=chr(48+dl div 10 mod 10)+chr(48+dl mod 10)+'.'+chr(48+dh div 10 mod 10)+chr(48+dh mod 10)+'.'+chr(48+cx div 10 mod 10)+chr(48+cx mod 10);
end;  {datestr}

function  cutword(var s:string):string; {odrizne ze stringu slovo a vrati jej}
var i,p:longint;
begin
  s:=trim(s);
  p:=-1;
  for i:=1 to length(s) do begin
    if s[i] in WORDBREAKERS then begin
      p:=i;
      break;
    end;
    if p<>-1 then break;
  end;
  if p=-1 then begin
    result:=s;
    s:='';
  end else begin
    result:=copy(s,1,p-1);
    s:=copy(s,p+byte(p<>$FF),$FF);
  end;
end;  {cutword}

function  cutstr(var s:string;delimiter:char):string;
var p:byte;
begin
  p:=pos(delimiter,s);
  if p=0 then begin
    result:=s;
    s:='';
  end else begin
    result:=copy(s,1,p-1);
    delete(s,1,p);
  end;
end;  {cutstr}

PROCEDURE WaitTicks(n:longint);
begin
  inc(n,memd[ROM_TICKS]);
  repeat
  until (memd[ROM_TICKS]>=n) or (port[$60]=1);
end;  {WaitTicks}

procedure die(haltcode:byte);
var r:TRmRegs;
begin
  bioswriteln(CRLF+'Halting..');
  {$IFDEF useGFX}CloseGFX;{$ENDIF}
  {$IFDEF useUSS}CloseUSS;{$ENDIF}
  {$IFDEF usePCK}ClosePCK;{$ENDIF}
  {$IFDEF usershutdown}UserShutdown;{$ENDIF}
  case haltcode of
  errOk:                  bioswriteln('Good-bye!');
  {$IFDEF useGFX}
  errVGANotSupported:     bioswriteln('VGA error: VGA not supported!');
  errVGAModeSet:          bioswriteln('VGA error: Can''t set desired VGA mode!');
  errVBENotDetected:      bioswriteln('VBE error: VESA BIOS EXTENTION not detected!');
  errVBE20Needed:         bioswriteln('VBE error: I need VESA 2.0+ to use Linear Frame Buffer (LFB)...'+CRLF+'Run UniVBE by SciTech Soft or something similar.');
  errVBECardMemory:       bioswriteln('VBE error: Not enough memory on graphics card :(');
  errVBEModeNotSupported: bioswriteln('VBE error: Desired VBE mode not supported...');
  errVBEModeSet:          bioswriteln('VBE error: Can''t set desired VESA mode!');
  {$ENDIF}
  {$IFDEF useUSS}
  errUSSLoad:             bioswriteln('USS error: Error loading music module!');
  errUSSInit:             bioswriteln('USS error: Error initializing the soundsystem!');
  {$ENDIF}
  errGIFBadFile:          bioswriteln('GIF error: Bad file');
  errGIFBadGIFCode:       bioswriteln('GIF error: Bad GIF code');
  errGIFNotAGIFFile:      bioswriteln('GIF error: Not a GIF file');
  errGIFInvalidBlockSize: bioswriteln('GIF error: Invalid Block Size');
  errGIFBadSymbolSize:    bioswriteln('GIF error: Bad Symbol Size');
  errGIFBadFirstGIFCode:  bioswriteln('GIF error: Bad first GIF code');
  errGIFBadSeek:          bioswriteln('GIF error: Bad file seek');
  errGIFBufferError:      bioswriteln('GIF error: Buffer error');
  errGIFImageTooBig:      bioswriteln('GIF error: Image too big');
  errGIFUnknownError:     bioswriteln('GIF error: Unknown error');
  {$IFDEF usePCK}
  errPCKOpen:             bioswriteln('PCK error: Error opening data file');
  errPCKLoad:             bioswriteln('PCK error: Error loading a subfile');
  errPCKSeek:             bioswriteln('PCK error: File seek error');
  {$ENDIF}
  errDPMI800:             bioswriteln('DPMI error: Can''t map physical memory to linear'+CRLF+'(error execute function 800h DPMI)'+CRLF+'Try to run with QEMM or HIMEM in raw DOS.');
  errGetmem:              bioswriteln('internal error: GetMem');
  errBMFLoad:             bioswriteln('internal error: BMFont.Load');
  errCycleH:              bioswriteln('internal error: TBuf2d.CycleH');
  errModeByRes:           bioswriteln('internal error: modeByRes.CreateDataDescriptor');
  errParamsNeeded:        bioswriteln('general error: Parameters needed');
  errFileNotExists:       bioswriteln('general error: File not exists');
  errUnknownFormat:       bioswriteln('general error: Unknown format');
  errUnexpectedEOF:       bioswriteln('general error: Unexpected end of file');
  errUserBreak:           bioswriteln('User break');
  else                    bioswriteln('Unknown error ('+hex(haltcode)+'h)');
  end;
  haltcode:=word(haltcode<>0);
  halt(haltcode);
end;  {die}

{$ENDIF}