home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / 91xx / 9112dos / c64.pas < prev    next >
Pascal/Delphi Source File  |  1991-08-25  |  5KB  |  211 lines
  1. unit C64;
  2.  
  3. interface
  4.  
  5. uses crt,graph,dos;
  6.  
  7. procedure C64_farbe(name:string);
  8. procedure Bild_strecken;
  9. procedure C64_hires(zahl:integer;
  10.                 bild1,bild2,bild3,bild4:string;
  11.                 format:char);
  12. implementation
  13.  
  14.  
  15. var p1,p2,p3,p4,p5,p6,p7,p8:integer; (* für Farben umwandeln *)
  16.     a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p:integer;
  17.     a1,b1:integer;
  18.     wahl:char;
  19.     clip:boolean;
  20.     dat:file of char;
  21.  
  22.  
  23. procedure farben_anpassen;
  24.  
  25. begin
  26.         c:=0;
  27.         if (d=0) and (c=0) then begin c:=1;d:=0;end;
  28.         if (d=1) and (c=0) then begin c:=1;d:=15;end;
  29.         if (d=2) and (c=0) then begin c:=1;d:=4;end;
  30.         if (d=3) and (c=0) then begin c:=1;d:=2;end;
  31.         if (d=4) and (c=0) then begin c:=1;d:=13;end;
  32.         if (d=5) and (c=0) then begin c:=1;d:=3;end;
  33.         if (d=6) and (c=0) then begin c:=1;d:=1;end;
  34.         if (d=7) and (c=0) then begin c:=1;d:=14;end;
  35.         if (d=8) and (c=0) then begin c:=1;d:=5;end;
  36.         if (d=9) and (c=0) then begin c:=1;d:=6;end;
  37.         if (d=10) and (c=0) then begin c:=1;d:=12;end;
  38.         if (d=11) and (c=0) then begin c:=1;d:=8;end;
  39.         if (d=12) and (c=0) then begin c:=1;d:=11;end;
  40.         if (d=13) and (c=0) then begin c:=1;d:=10;end;
  41.         if (d=14) and (c=0) then begin c:=1;d:=9;end;
  42.         if (d=15) and (c=0) then begin c:=1;d:=7;end;
  43.   end;
  44.  
  45. procedure Byte_aufteilen;
  46.  
  47.  begin
  48.   p1:=0;p2:=0;p3:=0;p4:=0;p5:=0;p6:=0;p7:=0;p8:=0;
  49.   if d-128 >= 0 then begin p1:=15;d:=d-128;end;
  50.   if d-64  >= 0 then begin p2:=15;d:=d-64;end;
  51.   if d-32  >= 0 then begin p3:=15;d:=d-32;end;
  52.   if d-16  >= 0 then begin p4:=15;d:=d-16;end;
  53.   if d-8   >= 0 then begin p5:=15;d:=d-8;end;
  54.   if d-4   >= 0 then begin p6:=15;d:=d-4;end;
  55.   if d-2   >= 0 then begin p7:=15;d:=d-2;end;
  56.   if d-1   >= 0 then begin p8:=15;d:=d-1;end;
  57.  end;
  58.  
  59. procedure Schwarz_weiss_einladen(name:string);
  60.  
  61.  begin
  62.   assign(dat,name);
  63.   reset(dat);
  64.   read(dat,wahl);read(dat,wahl);
  65.   a1:=-8;
  66.   for a:=1 to 25 do begin
  67.    a1:=a1+8;
  68.    b1:=-4;
  69.    for b:=1 to 40 do begin
  70.    b1:=b1+4;
  71.     for c:=1 to 8 do begin
  72.      read(dat,wahl);
  73.      d:=ord(wahl);
  74.      byte_aufteilen;
  75.      putpixel(b1+1+320,a1+c,p2);putpixel(b1+2+320,a1+c,p4);
  76.      putpixel(b1+3+320,a1+c,p6);putpixel(b1+4+320,a1+c,p8);
  77.      putpixel(b1+1+480,a1+c,p1);putpixel(b1+2+480,a1+c,p3);
  78.      putpixel(b1+3+480,a1+c,p5);putpixel(b1+4+480,a1+c,p7);
  79.     end;
  80.    end;
  81.   end;
  82.  end;
  83.  
  84. procedure farbe_einladen;
  85.  
  86.  begin
  87.   a1:=-8;
  88.   for a:=1 to 25 do begin
  89.    a1:=a1+8;
  90.    b1:=-4;
  91.    for b:=1 to 40 do begin
  92.     b1:=b1+4;
  93.     read(dat,wahl);
  94.     d:=ord(wahl);
  95.     Byte_aufteilen;
  96.     e:=0;
  97.     if p8=15 then e:=e+1;
  98.     if p7=15 then e:=e+2;
  99.     if p6=15 then e:=e+4;
  100.     if p5=15 then e:=e+8;
  101.     d:=e;farben_anpassen;e:=d;
  102.     f:=0;
  103.     if p4=15 then f:=f+1;
  104.     if p3=15 then f:=f+2;
  105.     if p2=15 then f:=f+4;
  106.     if p1=15 then f:=f+8;
  107.     d:=f;farben_anpassen;f:=d;
  108.     for g:=1 to 4 do begin
  109.      for h:=1 to 8 do begin
  110.       i:=getpixel(b1+g+320,a1+h);
  111.       j:=getpixel(b1+g+480,a1+h);
  112.       if (j=0 ) and (i=15) then putpixel(b1+g,a1+h,f);
  113.       if (j=15) and (i=0 ) then putpixel(b1+g,a1+h,e);
  114.      end;
  115.     end;
  116.    end;
  117.   end;
  118.  end;
  119.  
  120. procedure farbe_einladen2;
  121.  
  122.  begin
  123.   a1:=-8;
  124.   for a:=1 to 25 do begin
  125.    a1:=a1+8;
  126.    b1:=-4;
  127.    for b:=1 to 40 do begin
  128.     b1:=b1+4;
  129.     read(dat,wahl);
  130.     d:=ord(wahl);
  131.     Byte_aufteilen;
  132.     e:=0;
  133.     if p8=15 then e:=e+1;
  134.     if p7=15 then e:=e+2;
  135.     if p6=15 then e:=e+4;
  136.     if p5=15 then e:=e+8;
  137.     d:=e;farben_anpassen;e:=d;
  138.     f:=0;
  139.     if p4=15 then f:=f+1;
  140.     if p3=15 then f:=f+2;
  141.     if p2=15 then f:=f+4;
  142.     if p1=15 then f:=f+8;
  143.     d:=f;farben_anpassen;f:=d;
  144.     for g:=1 to 4 do begin
  145.      for h:=1 to 8 do begin
  146.       i:=getpixel(b1+g+320,a1+h);
  147.       j:=getpixel(b1+g+480,a1+h);
  148.       if (i=15) and (j=15) then putpixel(b1+g,a1+h,e);
  149.      end;
  150.     end;
  151.    end;
  152.   end;
  153.  end;
  154.  
  155. procedure Bild_strecken;
  156.  
  157.  begin
  158.   for a:=1 to 200 do begin
  159.    for b:=160 downto 1 do begin
  160.     c:=getpixel(b,a);
  161.     putpixel(b*2,a,c);
  162.     putpixel(b*2-1,a,c);
  163.    end;
  164.   end;
  165.  end;
  166.  
  167. procedure C64_farbe(Name:string);
  168.  begin
  169.   Schwarz_weiss_einladen(Name);
  170.   farbe_einladen;
  171.   farbe_einladen2;
  172.  end;
  173.  
  174. procedure C64_hires(zahl:integer;
  175.                 bild1,bild2,bild3,bild4:string;
  176.                 format:char);
  177.  
  178. var x,y:char;
  179.  
  180.  begin
  181.   for a:=1 to Zahl do begin
  182.    if a=1 then begin a1:=-8;assign(dat,bild1);end;
  183.    if a=2 then begin a1:=-8;assign(dat,bild2);end;
  184.    if a=3 then begin a1:=192;assign(dat,bild3);end;
  185.    if a=4 then begin a1:=192;assign(dat,bild4);end;
  186.    reset(dat);
  187.    read(dat,y);read(dat,x);
  188.    if format='h' then begin x:=chr(25);y:=chr(40);end;
  189.    for b:=1 to ord(x) do begin
  190.     a1:=a1+8;
  191.     if a=1 then b1:=-8;
  192.     if a=2 then b1:=312;
  193.     if a=3 then b1:=-8;
  194.     if a=4 then b1:=312;
  195.     for c:=1 to ord(y) do begin
  196.      b1:=b1+8;
  197.      for e:=1 to 8 do begin
  198.       read(dat,wahl);
  199.       d:=ord(wahl);
  200.       Byte_aufteilen;
  201.       putpixel(b1+1,a1+e,p1);putpixel(b1+2,a1+e,p2);putpixel(b1+3,a1+e,p3);putpixel(b1+4,a1+e,p4);
  202.       putpixel(b1+5,a1+e,p5);putpixel(b1+6,a1+e,p6);putpixel(b1+7,a1+e,p7);putpixel(b1+8,a1+e,p8);
  203.      end;
  204.     end;
  205.    end;
  206.    close(dat);
  207.   end;
  208.  end;
  209. end.
  210.  
  211.