Mindörökké Túrbó Pászkál

Az egyik tag éppen egy parallel portos LCD-t próbált vezérelni, mire egy másik leoltotta, hogy TP-ben nem lehet semmi normálist, írja C-ben. Na erre persze nekem, a die-hard Pascal fannek, sem kellett több, tartottam egy kis demonstrációt úgy egy-másfél óra alatt, TP-s grafika programozásból, csak hogy helyretegyem az erőviszonyokat, amivel többen láthatólag nem voltak tisztában.

Az eredmény alant látható. (Figyelem: Szándékosan 100% Pascal, igen én is meg tudnám írni asmban, ez direkt ilyen, köszi. :)

Első rész, a grafikai motor. (letöltés)

{$G+}
unit motor;

interface

type
    page = array[0..63999] of byte;
    ppage = ^page;

procedure init;
procedure done;
procedure putpixel(x, y, c : integer);
procedure clearscreen;
procedure copy;
function getmaxx : integer;
function getmaxy : integer;
procedure setpal(i, r, g, b: byte);
function getbuf: ppage;


implementation

uses dos;

var
   vmem : page absolute $a000:0000;
   buf : ppage;

procedure init;
var regs: registers;
begin
     getmem(buf, 64000);
     regs.ax := $13;
     Intr($10, regs);
end;

procedure done;
var regs: registers;
begin
     freemem(buf, 64000);
     regs.ax := $10;
     Intr($10, regs);
end;

procedure setpal(i, r, g, b: byte);
begin
     Port[$03c8]:=i;
     Port[$03c9]:=r shr 2;
     Port[$03c9]:=g shr 2;
     Port[$03c9]:=b shr 2;
end;

procedure putpixel(x, y, c : integer);
begin
     if (x < 0) or (x > 319) then exit;
     if (y < 0) or (y > 199) then exit;
     buf^[(320 * y) + x] := c;
end;

procedure clearscreen;
begin
     fillchar(buf^, 64000, #0);
end;

procedure copy;
begin
     move(buf^, vmem, 64000);
end;

function getmaxx : integer;
begin
     getmaxx:=319;
end;

function getmaxy : integer;
begin
     getmaxy:=199;
end;

function getbuf: ppage;
begin
     getbuf:=buf;
end;

end.

Második rész, az űber-hiper-effekt. (letöltés)

{$G+,N+}
program foo;

uses crt, dos, motor;
var
   i,i2 : longint;
   a, b: integer;
   q, v: integer;
   x, y: integer;
   p: integer;
   buf: ppage;

const faszom : array[0..7] of array[0..31] of byte = (
             ( 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0 ),
             ( 1,1,1,1,1,1,0,0, 1,1,1,1,1,1,1,0, 1,1,0,0,0,1,1,0, 0,1,1,1,1,1,0,0 ),
             ( 0,1,1,0,0,1,1,0, 0,1,1,0,0,0,0,0, 1,1,1,0,1,1,1,0, 1,1,0,0,0,1,1,0 ),
             ( 0,1,1,0,0,1,1,0, 0,1,1,1,1,0,0,0, 1,1,1,1,1,1,1,0, 1,1,0,0,0,1,1,0 ),
             ( 0,1,1,0,0,1,1,0, 0,1,1,1,1,0,0,0, 1,1,0,1,0,1,1,0, 1,1,0,0,0,1,1,0 ),
             ( 0,1,1,0,0,1,1,0, 0,1,1,0,0,0,0,0, 1,1,0,0,0,1,1,0, 1,1,0,0,0,1,1,0 ),
             ( 0,1,1,1,1,1,1,0, 0,1,1,1,1,1,1,0, 1,1,0,0,0,1,1,0, 1,1,1,1,1,1,1,0 ),
             ( 1,1,1,1,1,1,0,0, 1,1,1,1,1,1,1,0, 1,1,0,0,0,1,1,0, 0,1,1,1,1,1,0,0 )
      );

function msin(x : real) : real;
begin
    msin:=sin(x/28);
end;

begin
     randomize;
     init;
     buf:=getbuf;
     i2:=0;

     for i:=0 to 63 do begin
         setpal(i, i, 0, 0);
     end;
     for i:=64 to 255 do begin
         setpal(i, i, i-64, 0);
     end;
     setpal(255,255,255,255);

     clearscreen;

     repeat

     inc(i2);

     for i:=0 to 319 do begin
         putpixel(i, round(100 + (msin(i*3+i2*2)*40) + (msin(i+i2) * 40)), random(256));
         putpixel(i, round(100 + (msin(i*2.5+i2*1.5)*20) + (msin(i+45-i2*1.3) * 50)), random(256));
     end;

     for i:=0 to 319 do begin
         putpixel(i, 199, random(256));
     end;

     for i:=(63999-321) downto 0 do begin
         {a:=i+32000;}
         a:=i;
         p:=buf^[a];
         p:=p+buf^[a+319];
         p:=p+buf^[a+320];
         p:=p+buf^[a+321];
         p:=(p shr 2)-1;
         if (p < 0) then p:=0;
         buf^[a]:=p;
     end;

     for q:=0 to 31 do begin
         for v:=0 to 7 do begin
             x:=q*2 + 128 + round(msin(i2) * 100);
             y:=round(v * msin(i2*1.13-q*1.2) * 3) + 100 + round(msin(i2+q*(msin(i2)*3.14)) * 5);
             if (faszom[v, q] = 1) then putpixel(x, y, 255)
         end;
     end;


     fillchar(buf^[63999-320],320,#0);

{     delay(1000);}
     copy;

     until keypressed;

     done;
end.

És fordul, igenigen:

Azért néha még mindíg meglepődöm, mik mennek fejből, nulla helppel (najó, a TP súgója azért megvolt:). Tíz-tizenkét éve irkáltam ilyeneket, amikor 18 voltam, a fiatal elme legfogékonyabb korszakában. Valószínűleg tűz effekt és szinusz plotter Turbo Pascalban még a halálos ágyamon is menni fog, a többi meg akkor már úgyis mindegy lesz. :)

(ps: Screenshot mindjárt lesz, ha minden jól megy.)
(ps#2: És minden jól ment... :) Csak szólok, hogy a screenshotok meg Pegasos II-n készültek, MorphOS alól DOSBoxban. A triviális megoldás, nyilván.)