Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {$R-}
- uses crt;
- type Palette = Array[0..256*3] of byte;
- procedure Pall(VAR p:palette); ASSEMBLER;
- ASM
- MOV DX,3C8h
- XOR AX,AX
- OUT DX,AL
- INC DX
- MOV CX,768
- PUSH DS
- LDS SI,p
- @@l:
- OUTSB
- LOOP @@l
- POP DS
- END;
- procedure SetVga;assembler;
- asm
- MOV AX,13h
- INT 10h
- end;
- procedure testo;assembler;
- ASM
- MOV AX,3
- INT 10h
- END;
- procedure punto(x,y:integer;col:byte);assembler;
- asm
- mov ax,$a000
- mov es,ax
- mov cx,y
- shl y,8
- shl cx,6
- add cx,x
- add cx,y
- mov di,cx
- mov al,col
- stosb
- end;
- procedure fireline;
- var i:integer;
- delta:integer;
- begin
- for i:=320 downto 0 do
- begin
- if random<0.1 then delta:=random(10)*190;
- mem[$a000:i+64960]:=delta;
- mem[$a000:i+64640]:=delta;
- end;
- end;
- Function getmed(x,y:integer):byte;
- var med:byte;
- begin
- med:=(mem[$a000:x+1+y*320]+mem[$a000:x-1+y*320]+mem[$a000:x+(y+1)*320]) div 3;
- if (not(med<1)) then {Faccio la media dei punti che stanno atorno a x,y}
- getmed:=med-1 {e se è minore di 1 non la decremento}
- else getmed:=med;
- end;
- procedure ret(x,y,x1,y1:integer);
- var i,j:longint;
- begin
- for j:=y1 downto y do
- for i:=x to x1 do
- punto(i,j,getmed(i,j));
- end;
- Procedure PhongPal(rosso,verde,blu,luce,riflesso,ambiente:real);{Procedura che calcola le palette secondo la formula di phong}
- var tmp,i:real;
- d:integer;
- col:palette;
- Function Pow(base:real;esponente:integer):real; {Funzione annidata che calcola la potenza di un numero}
- var i:integer;
- p:real;
- begin
- p:=base;
- for i:=1 to esponente do p:=p*base;
- pow:=p;
- end;
- begin
- for d:=0 to 255 do
- begin
- i:=cos((255-d)/512*3.14159);
- tmp:=rosso*ambiente/63+rosso*i+pow(i,round(riflesso))*luce;
- if tmp>63 then tmp:=63;
- col[d*3]:=round(tmp);
- tmp:=verde*ambiente/63+verde*i+pow(i,round(riflesso))*luce;
- if tmp>63 then tmp:=63;
- col[d*3+1]:=round(tmp);
- tmp:=blu*ambiente/63+blu*i+pow(i,round(riflesso))*luce;
- if tmp>63 then tmp:=63;
- col[d*3+2]:=round(tmp);
- end;
- pall(col);
- end;
- var i:integer;
- t:char;
- begin
- setvga;
- phongpal(128,20,0,255,5,0);
- repeat
- fireline;
- ret(0,150,320,202);
- if keypressed then t:=readkey;
- until t=#27;
- t:='#';
- testo;
- end.
- {Numa}
Add Comment
Please, Sign In to add comment