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

 ( Chain-Q | 2009. július 8., szerda - 1:05 )

Múlt pénteken az Amiga Klub nyári szünete miatt az egyik klubtagnál verődött össze egy kisebb csapat, a kockulási igényünket kielégítendő. 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.)

Hozzászólás megjelenítési lehetőségek

A választott hozzászólás megjelenítési mód a „Beállítás” gombbal rögzíthető.

"A triviális megoldás, nyilván."

Gondolom nekem, egyszerű mezei PC-s léleknek túl egyszerű volt előkotorni a TP-t a lemez elfeledett régióiból és szimplán nyomni egy CTRL+F9-t, mindezt ráadásul ilyen DOS gyilkos rendszereken, mint WXP? :)

De furcsa volt 24"-n látni a 80x25-s TP fordítót :D

Egyébként grat.

----------------
Lvl86 Troll

A trivialist (reszben ön)ironikusnak szantam. :) Akarcsak az egesz irast. Amugy itt nincs keznel WXP, se x86 gep "sajnos". :) A helyszinen egy 1.1-es Cerkan keszult a mutatvany, PCI S3 Trio-val. Polcrol lekapott hulladek, asztalra kiteritve. Szelesvasznu LCD-vel, ahogy kell. :)

-=- Mire a programozó: "Na és szerintetek ki csinálta a káoszt?" -=-

:)

Tudom, hogy x86 mentes övezet van nálad. Csak ilyenkor azért annyira nem rossz az ilyen "magát indításkor 8086-nak hivő processzoros" gép ;)

----------------
Lvl86 Troll

Van egyebkent egy AMD K6-2/500 + 128MB + GUS MAX + DOS gep is, direkt regi DOS-os demokhoz, de az most el van asva a beepitett szekrenybe, es ennek a kedveert nem astam elo... :) Meg asszem megint megnyekkent benne az alaplap, ha AGP-s kartyakat dugdosol benne bedugott (nem bekapcsolt) allapotban, rendszeresen elfelejti a BIOS-t (Acorp 5ALI61). Majd egyszer meghegesztem, de hajnali 1-kor nem alltam neki... :)

-=- Mire a programozó: "Na és szerintetek ki csinálta a káoszt?" -=-

Arra gondoltam, hogy de jó lenne leforgatni Free Pascalban, de aztán kiderült, hogy a direkt memóriacímzést (?) nem preferálja. Konkrétan ezt a hibaüzenetet dobja: "motor.pas(26,30) Fatal: Syntax error, ";" expected but ":" found". Hogyha pedig ezt a sort eltávolítom, akkor még a Port tömbre is panaszkodik, mert ezt sem ismeri, úgy látszik. Gyanítom, hogy a Free Pascal DOS portja sem birkózna meg a kóddal. Ha nagyon ráérek majd, lehet, hogy keresek a neten egy turbo pascalt. :)

Hat, a "motor" kod elmeletileg nagyon realmode only, de mar nem nagyon emlekszem pontosan, hogy az FPC 32 bites DOS extendere miket engedett es miket nem. A Ports tombot tamogatja az FPC (de csak DOS targethez termeszetesen), legalabbis regen tamogatta, csak kellett egy ilyen az uses sorba: "Ports".

-=- Mire a programozó: "Na és szerintetek ki csinálta a káoszt?" -=-

ehhehe, nekem a constans név választás tűnt fel! :-) gondolom több ilyen található a fejlesztésekben :-)

http://www.google.com/codesearch?q=faszom&hl=en&btnG=Search+Code

--
"ne támogasd az erdők kiírtását mozijeggyel, töltsd le a netről!" - killllll, asva.info

mplayerben is... arpi dolgozott...
--

()=() Ki oda vagyik,
('Y') hol szall a galamb
C . C elszalasztja a
()_() kincset itt alant.

Milyen LCD?

Amugy régebben csináltunk futófényt pascalban, ugy hogy a lpt-port bitjeire voltak téve ledek. Valami nagyon egyszerü volt a program. Van külön portbizgerélő parancs, ha jólemlékszek.

királyság :)