PROGRAM PLASMA

PROGRAM PLASMA

Programul plasma exemplifica trecerea sangelui prin vene,Functia de transport a fluidelor in organism se realizeaza prin intermediul vaselor de sange (acestea sunt arterele - cele care duc sangele de la inima spre tesuturi si organe si venele - cele care transporta sangele catre inima).Circulatia sangelui se realizeaza prin intermediul actiunii de pompa a inimii.

Programul plasma foloseste variabile crt, functii si proceduri dos.

Seg: returneaza segmentul unei variabile specificate;

V,pic - indica parametrii formatati pentru datele ce contin obiectul sau imaginea;

Key: variabile de tip ordinal pentru a inregistra caracterele ASCII.

Procedura "newint9h" se foloseste pentru sincronizarea rutinei, asteptarea functiei vblank. Sintaxa "Accesses the built-in assembler" selecteaza multitudinea de assimilatori pe semicolone; o semicolona poate reprezenta o linie printr-un registru

de tip BP, SP, SS, si DS;

Functia "vinkel" reprezinta introducerea unui mod automat in momentul negarii parcurgerii automate.Functia "max" gaseste valoarea cea mai mare din linia integrata, iar functia "min" gaseste valoarea cea mai mica din linia integrata.

"Inline":inserarea unui cod de instructiuni direct in program sau unit.

Procedura "plasma" creaza un format de 32-bit si este cuprins in intervalul - 2147483648 . .

"Random" - alegerea unei valori aleatorii;

Procedura "putpixel" - are sarcina de a stabili fiecarui pixel cate o culoare;

Procedura "getpixel" - gaseste pixelul cu, culoarea per axa X, Y;

Procedura "retrace" - are rolul de a relua instructiunile cod generate la nivelul functiilor si procedurilor.

Procedura "setp" - seteaza paleta de culori in functie de efectul de rotire al cilindrului, pixelul se modifica la fiecare secunda.

Functia "test8086" - identifica modelul de procesare 80x86 al sistemului continut, foloseste un cod ce contine o detectare logica si automata a CPU-lui.

"Halt" - opreste programul si returneaza sistemul operant; se poate folosi un cod de iesire de tip unit DOS sau batch DOS.

"Upcase" - converteste caracterul citit in variabila declarata;

"Getmem" - creaza o variabila dinamica a marimii specificate;

"Getmem(pic) - creaza o variabila dinamica pentru fiecare pixel de culoare folosi.

"Plasma" - are rolul de a memora fiecare ciclu in momentul efectului de cilindru.

"Getintvec" - returneaza adresa retinuta a vectorului, iar "setintvec" - seteaza intrarea vectorului catre o adresa.

"Repeat" - efectul de repetare a efectului de cilindru in momentul iesirii din program.

"Inc" - incrementarea unei variabile;

program plasma_tunnel;

uses crt,dos;

const segA000 : word = $A000;

biosseg : word = $0040;

var v,pic : pointer;

addr,x,y : word;

i,r,d : byte;

ds,rs : shortint;

len : real;

warp,interactive : boolean;

keys : array[0..127] of boolean;

oldint9h : procedure;

key : char;

stab : array[0..255] of byte;

procedure newint9h;interrupt;assembler; 

asm

xor bh,bh

in al,60h

mov bl,al

and bl,01111111b

xor al,10000000b

shr al,7

mov byte ptr keys[bx],al

pushf

call oldint9h

cli

mov es,biosseg

mov ax,es:[1Ah]

mov es:[1Ch],ax

sti

end

function vinkel(x,y : real) : byte;

var v : integer;

begin

if (x = 0) and (y > 0) then vinkel := 64 else

if (x = 0) and (y <= 0) then vinkel := 192 else

begin

v := round(arctan(y/x)/pi*128);

if (x < 0) and (y < 0) then vinkel := v+128 else

if (x < 0) and (y >= 0) then vinkel := 128+v else

vinkel := v;

end;

end

function max(a,b : integer) : integer; 

inline($58/$5B/$3B/$C3/$7F/$01/$93); 

function min(a,b : integer) : integer;

inline($58/$5B/$3B/$C3/$7C/$01/$93);

procedure plasma(x1,y1,x2,y2 : longint);

var nx,ny : word;

c : integer;

function cc(c,n : integer) : byte;

var d : integer;

begin

d := ((x2-x1+y2-y1)*5) div 3;

cc := min(max((c+d-random(d+d)) div n,1),255);

end

procedure putpixel(x,y : byte;c : byte);assembler;

asm

mov es,word ptr [pic+2]

mov bl,x

mov bh,y

mov al,c

mov es:[bx],al

end

function getpixel(x,y : byte) : byte;assembler; 

asm

mov es,word ptr [pic+2]

mov bl,x

mov bh,y

mov al,es:[bx]

end

begin

if ((x2-x1) < 2) and ((y2-y1) < 2) then exit;

nx := x1+(x2-x1) shr 1;

ny := y1+(y2-y1) shr 1;

if getpixel(nx,y1) = 0 then

putpixel(nx,y1,cc(getpixel(x1,y1)+getpixel(x2,y1),2));

if getpixel(nx,y2) = 0 then

putpixel(nx,y2,cc(getpixel(x1,y2)+getpixel(x2,y2),2));

if getpixel(x1,ny) = 0 then

putpixel(x1,ny,cc(getpixel(x1,y1)+getpixel(x1,y2),2));

if getpixel(x2,ny) = 0 then

putpixel(x2,ny,cc(getpixel(x2,y1)+getpixel(x2,y2),2));

if getpixel(nx,ny) = 0 then

putpixel(nx,ny,cc(getpixel(x1,y1)+getpixel(x2,y2)+getpixel(x1,y2)+getpixel(x2,y1),4));

plasma(x1,y1,nx,ny);

plasma(nx,y1,x2,ny);

plasma(x1,ny,nx,y2);

plasma(nx,ny,x2,y2);

end

procedure retrace;assembler;

asm

mov dx,3DAh

@loop:

in al,dx

test al,8

jnz @loop

@loop2:

in al,dx

test al,8

jz @loop2

end

procedure setp(c,r,g,b : byte);assembler;

asm

mov dx,3C8h

mov al,c

out dx,al

inc dx

mov al,r

out dx,al

mov al,g

out dx,al

mov al,b

out dx,al

end

function test8086 : byte;assembler;

asm

xor dl,dl

push sp

pop ax

cmp sp,ax

jne @out

inc dl

pushf

pop ax

or ax,4000h

push ax

popf

pushf

pop ax

test ax,4000h

je @out

inc dl

@out:

mov al,dl

end

begin

randomize;

if test8086 < 2 then begin

writeln('Iti trebuie un mod de vizualizare 386 sau mai mare.',#7);

halt;

end;

interactive := false;

write('Doresti o controlare directionala a tunelului ? ');

repeat

key := readkey;

until (upcase(key) in ['D','N']);

writeln(key);

if upcase(key) = 'D' then interactive := true;

write('Asteapta calcularea datelor tunelului');

for i := 0 to 127 do keys[i] := false;

for i := 0 to 255 do stab[i] := round(sin(i*pi/128)*127.5+127.5);

getmem(v,64000);

addr := 0;

for y := 0 to 99 do

for x := 0 to 319 do begin

len := sqrt((x-159.5)*(x-159.5)+(y-99.5)*(y-99.5))+1;

memw[seg(v^):addr] := vinkel(x-159.5,y-99.5)+(round(4000/len) and

255) shl 8;

inc(addr,2);

end;

getmem(pic,$FFFF);

asm

mov es,word ptr [pic+2]

xor di,di

mov cx,0FFFFh/4+1

db 66h;xor ax,ax

db 66h;rep stosw

end;

plasma(0,0,256,256);

addr := 0;

for y := 0 to 255 do

for x := 0 to 255 do begin

mem[seg(pic^):addr] :=

(mem[seg(pic^):addr+256]+mem[seg(pic^):addr+256]+

mem[seg(pic^):addr-256]+mem[seg(pic^):addr+1]+

mem[seg(pic^):addr-1]) div 5;

inc(addr);

end;

asm

mov ax,13h

int 10h

end;

for i := 1 to 63 do setp(i,i,32,32+i div 2);

for i := 0 to 63 do setp(i+64,63-i,32+i div 2,63);

for i := 0 to 63 do setp(i+128,i div 2,63-i,63-i);

for i := 0 to 63 do setp(i+192,32+i div 2,0,i);

getintvec($09,@oldint9h);

setintvec($09,@newint9h);

asm

mov ax,word ptr [v+2]

db 8Eh;db 0E0h

mov ax,word ptr [pic+2]

db 8Eh;db 0E8h

mov es,segA000

end;

rs := 0;

if not interactive then ds := 8;

repeat

if interactive and not warp then begin

if keys[$48] then begin

if ds < 10 then inc(ds);

end else if ds > 0 then dec(ds);

if keys[$50] then begin

if ds > -10 then dec(ds);

end else if ds < 0 then inc(ds);

if keys[$4D] then begin

if rs < 10 then inc(rs);

end else if rs > 0 then dec(rs);

if keys[$4B] then begin

if rs > -10 then dec(rs);

end else if rs < 0 then inc(rs);

end else begin

if not warp then r := stab[i];

inc(i);

end;

inc(d,ds shr 1);

inc(r,rs shr 1);

if keys[1] then warp := true;

if warp then begin

inc(ds,2);

inc(rs,1);

end;

retrace;

asm

push bp

xor di,di

xor bx,bx

mov cl,r

mov ch,d

mov bp,8000

@dloop:

db 64h;mov dx,[bx]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov al,[si]

db 64h;mov dx,[bx+2]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov ah,[si]

db 66h;shl ax,16

db 64h;mov dx,[bx+4]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov al,[si]

db 64h;mov dx,[bx+6]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov ah,[si]

db 66h;rol ax,16

db 66h;stosw

add bx,8

dec bp

jnz @dloop

mov bp,8000

sub bx,2

add cl,128

@dloop2:

db 64h;mov dx,[bx]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov al,[si]

db 64h;mov dx,[bx-2]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov ah,[si]

db 66h;shl ax,16

db 64h;mov dx,[bx-4]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov al,[si]

db 64h;mov dx,[bx-6]

add dl,cl

add dh,ch

mov si,dx

db 65h;mov ah,[si]

db 66h;rol ax,16

db 66h;stosw

sub bx,8

dec bp

jnz @dloop2

pop bp

end;

until ds >= 120;

asm

mov ax,3h

int 10h

end;

setintvec($09,@oldint9h);

end