DataMuseum.dk

top - metrics - download

    Length: 2816 (0xb00)
    Types: TextFile
    Names: »SKDUMP.PAS«

└─⟦29e35ddf2⟧ Bits:30003931/CCPM_Tegn.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
    └─⟦this⟧ »SKDUMP.PAS« 

TextFile

program skdump;

var
  n                  : integer;                                
  tegn               : char;
     
procedure InputJaNej(x,y: integer; var tegn: char);
begin
  gotoxy(x,y);
  write(@27'b4','N',@27'b3','=nej  ',@27'b4','J',@27'b3','=ja   ');
  repeat
    read(KBD,tegn);
  until (tegn in (.@13,'N','n','J','j'.)) or (tegn=@27);
  if (tegn in (.@13,'N','n'.)) then begin
    tegn:='N';
  end else begin
    if (tegn<>@27) then tegn:='J';
  end;
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)


procedure harddump;

var
  scr_xaddr          : array(.0..740.) of integer;
  scr_yaddr          : array(.0..400.) of integer;
  k1,gr_maxxx,tmax,smax,
  txt_maxx,txt_maxy,a,b,
  xmax,ymax          : integer;
  init_ch            : string(.6.);
  gr_str             : string(.4.);
  ii,jj,kk,scr_segm  : integer;    

function get_pixel_config(var xmax,ymax:integer):integer;

const
    xios_int         = $28;
    xios_get_conf    = 4;
type
    reg_type=record
               ax,bx,cx,dx,bp,si,di,ds,es,flags:integer
             end;
var
    screen_type      : ^integer;
    reg              : reg_type;

begin
    reg.ax :=xios_get_conf;
    swint(xios_int,reg);
    screen_type :=ptr(reg.es,reg.si+18);
    if screen_type^ and 2 = 2 then
      begin (* rc partner *)
        k1:=1;
        xmax:=719;
        ymax:=351;
        gr_maxxx:=704;
        get_pixel_config :=$0F000;
      end
     else
      begin (* piccoline *)
      k1:=2;
      xmax:=559;
      ymax := 255;
      gr_maxxx:=512;
      get_pixel_config := $0D000;
      end;
end;



begin
   scr_segm:=get_pixel_config(xmax,ymax);
   a:=-gr_maxxx;b:=0;
   for ii:=0 to xmax do begin
     if (ii mod 16)=0 then a:=a+gr_maxxx;
     if (ii mod 8)=0 then if b=1 then b:=0 else b:=1;
     scr_xaddr(.ii.):=a+b;
   end;
   for ii:=0 to ymax do scr_yaddr(.ymax-ii.):=(ii*2);
   txt_maxx:=69;
   txt_maxy:=24;
   smax:=(ymax+1)*k1;
   writeln(lst,chr(27)+'T16'+chr(27)+'>'+chr(27)+'E');
   str(smax:4,gr_str);
   for ii:=1 to 4 do if gr_str(.ii.)=' ' then gr_str(.ii.):='0';
   init_ch:=chr(27)+'S'+gr_str; tmax:=txt_maxx;
   for ii:=0 to txt_maxx do begin
     write(lst,init_ch);
     for jj:=ymax downto 0 do
       for kk:=1 to k1 do
       write(lst,chr(mem(.scr_segm:scr_yaddr(.jj.)+scr_xaddr(.(tmax-ii)*8.).)));
       writeln(lst);
   end;
     writeln(lst,chr(27)+'c1',@12);
end;   

begin
 repeat
  write(clrhom);
  gotoxy(10,10);
  write('Tryk på en tast, når udskrivningen kan begynde .');
  repeat until keypress;
  write(clrhom);
  gotoxy(10,10);
  write('Skift til konsol 0 - nu.');
  for n:=1 to 32000 do n:=n;
  harddump;
  inputjanej(10,10,tegn);
 until (tegn='n') or (tegn='N');  
end.
«eof»