DataMuseum.dk

top - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »REGN1.PAS«

└─⟦1230711ec⟧ Bits:30003277 Digital Research Draw v.1.0 + Skriv + Regn
    └─ ⟦this⟧ »REGN1.PAS« 

TextFile

(* INCLUDE FILE REGN1.PAS SYSTEMAFHÆNGIGE *)

(* DEFINITION AF TASTER *)
PROCEDURE TASTER;
begin
 write(alloff);
 write(@27'0');
 write(@27@58@59@1@0);        (* F1 *)
 write(@27@58@71@5@19@0);     (* SKRÅ PIL *)
 write(@27@58@72@5@0);        (* PIL OP *)
 write(@27@58@75@19@0);       (* VENSTRE *)
 write(@27@58@77@4@0);        (* HØJRE *)
 write(@27@58@80@24@0);       (* PIL NED *)
 write(@27@58@82@6@0);        (* TEGN IND *)
 write(@27@58@83@127@0);      (* SLET TEGN *)
 write(@27@58@84'/U'@0);      (* PRINT *)
end;

(*$I-*)

æ
16-bit version only
å
PROCEDURE SYSKALD(kaldnr:integer);
var
 regs:record
  ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
 end;
begin
 regs.cx:=kaldnr;
 if kaldnr=16 then begin
  regs.dx:=filofs;
  regs.ds:=filseg;
 end;
 swint(224,regs);
end;


PROCEDURE LUK(nr:byte; var fejl:integer);
begin
 if nr=1 then begin
  filofs:=ofs(mcfile)+12;filseg:=seg(mcfile);
  flush(mcfile);
  close(mcfile);
  fejl:=iores;
 end else begin
  filofs:=ofs(tekstfil)+12;filseg:=seg(tekstfil);
  close(tekstfil);
  fejl:=iores;
 end;
 æ
 SYSKALD(16);
 å
end;

PROCEDURE L_DETACH;
begin

æ
16-bit version only
å
 SYSKALD(159);
 

end;
(*$I+*)

PROCEDURE RESETDISK;
begin

 æ
 8-bit vesion only
 
 bdos(13);
 å 
 æ
 16-bit version only  -  Not neccesary for PICCOLINE
 
 SYSKALD(13);
 å
 
end;

PROCEDURE DISKDIR(drev:      char;      æ Drive on which to search          å
                                        æ @ = default drive                 å
                  filmaske:  str11;     æ filemask without "."              å
                  efternavn: boolean;   æ filename extension to be written? å
                  streng:    anystring);æ part of header                    å
                  
var
 regs:record
  ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
 end;
 linje:stringÆ79Å;
 fcb:arrayÆ1..36Å of byte;
 dma:stringÆ128Å;
 dma_ofs,dma_seg:integer;
 a,b,c,d:byte;

 æ 16-bit version only
 å
 PROCEDURE SYSKALD2(kaldnr,fofs,fseg:integer);
 begin
 regs.cx:=kaldnr;
 regs.dx:=fofs;
 regs.ds:=fseg;
 swint(224,regs);
 if kaldnr=52 then begin
  dma_ofs:=regs.ax;
  dma_seg:=regs.es;
 end;
 if (kaldnr=17) or (kaldnr=18) then a:=regs.ax;
 end;
 
 
begin
 æ
 8-bit version only   SETUP DMA
 
 dma:='';
 for a:=1 to 8 do dma:=dma+'                ';
 bdos(26,addr(dma)+1);
 å
 æ
 16-bit version only     GET DMA ADRESS
 å
 SYSKALD2(52,0,0);
 
 
 for a:=1 to 36 do fcbÆaÅ:=0;                   æ construction of FCB å
 c:=ord(drev);
 if c>96 then c:=c-32;
 drev:=chr(c);
 fcbÆ1Å:=c-64;
 for a:=2 to 12 do fcbÆaÅ:=ord(filmaskeÆa-1Å);
 
 æ
 8-bit version only      SEARCH FIRST
 
 a:=bdosb(17,addr(fcb));
 å
 æ
 16-bit version only     SEARCH FIRST
 å
 SYSKALD2(17,ofs(fcb),seg(fcb));
 
 
 linje:=copy(tom,1,(68-len(streng)) div 2)+streng+' PÅ DREV '+drev+':'+tom;
 write(clrhom);
 writeln(rvson,linje,rvsoff);
 if a=255 then begin
  gotoxy(23,3);
  write(rvson,' Der er ingen ark på disketten. ',rvsoff);
 end; 
 while a<>255 do begin

  æ
  8-bit version only      GET FILENAME and SEARCH NEXT
  
  write(copy(dma,a*32+2,8));
  if efternavn then begin
   write('.',copy(dma,a*32+10,3));
   write('    ');
  end else
   write('  ');
  a:=bdosb(18,addr(fcb));
  å
  æ
  16-bit version only     GET FILENAME and SEARCH NEXT
  å
  for d:=1 to 8 do
   write(chr(memÆdma_seg:dma_ofs+a*32+dÅ));
  if efternavn then begin
   write('.');
   for d:=9 to 11 do
    write(chr(memÆdma_seg:dma_ofs+a*32+dÅ));
   write('    ');
  end else
   write('  ');
  SYSKALD2(18,ofs(fcb),seg(fcb));
  
 end; 
end;

PROCEDURE AFSLUT;
begin
 write(@27'1');
 write(alloff);
end;«eof»