Информационный сервер для программистов: Исходники со всего света. Паскальные исходники со всего света
  Powered by Поисковый сервер Яndex: Найдется ВСЁ!
На Главную Исходники Форум Информер Страны мира
   Demo Making    >>    burn
   
 
 Controllable Fire Demo for Mode 13h   Frank Jan Sorensen 26.06.1994

Демонстрация регулируемого пламени. Можно увеличить или уменьшить интенсивность горения, "подбросить дровишек" или "плеснуть водички". Кроме того, можно выбрать "горючесть" материала: от дерева, до газа.
EXCELLENT fire demo w/ Pascal Source. You can Increase/Decrease intensity, throw in a match or add a little water. Moreower you can change a Burnability from Wood to Gaz.



19k 
 

{> Cut here. FileName= BURN.PAS } {$A+,B-,D+,E+,F-,G+,I-,L+,N+,O-,P+,Q-,R-,S-,T-,V-,X+,Y+} {$M 16384,0,655360} { Hi guys, try this, use it in your code, but please credit Frank Jan Sorensen Alias:Frank Patxi (fjs@lab.jt.dk) for the fireroutine. } Program Burn; uses Dos,Crt; Const RootRand = 20; { Max/Min decrease of the root of the flames } Decay = 10; { How far should the flames go up on the screen? } MinY = 100; { Startingline of the flame routine. (should be adjusted along with MinY above) } Smooth = 1; { How descrete can the flames be?} MinFire = 50; { limit between the "starting to burn" and the "is burning" routines } XStart = 90; { Startingpos on the screen } XEnd = 210; { Guess! } Width = XEnd-XStart; {Well- } MaxColor = 110; { Constant for the MakePal procedure } FireIncrease : Byte = 3; {3 = Wood, 90 = Gazolin} Var Scr : Array[0..199,0..319] Of Byte Absolute $A000:$0000; Type ColorValue = record R, G, B : byte; end; VGAPaletteType = array[0..255] of ColorValue; procedure ReadPal(var Pal); var K : VGAPaletteType Absolute Pal; Regs : Registers; begin with Regs do begin AX := $1017; BX := 0; CX := 256; ES := Seg(K); DX := Ofs(K); Repeat Until Port[$03DA] And $08 = $08; {Wait for rescan} Intr($10,Regs); end; end; procedure WritePal(var Pal); Var K : VGAPaletteType Absolute Pal; Regs : Registers; begin with Regs do begin AX := $1012; BX := 0; CX := 256; ES := Seg(K); DX := Ofs(K); Repeat Until Port[$03DA] And $08 = $08; {Wait for rescan} Intr($10,Regs); end; end; Procedure Hsi2Rgb(H, S, I : Real; var C : ColorValue); {Convert (Hue, Saturation, Intensity) -> (RGB)} var T : Real; Rv, Gv, Bv : Real; begin T := H; Rv := 1 + S * Sin(T - 2 * Pi / 3); Gv := 1 + S * Sin(T); Bv := 1 + S * Sin(T + 2 * Pi / 3); T := 63.999 * I / 2; with C do begin R := trunc(Rv * T); G := trunc(Gv * T); B := trunc(Bv * T); end; end; { Hsi2Rgb } { Faster put'n get pixel routines! } procedure put(x,y : integer; c : byte); assembler; { Written by Matt Sottile } asm mov ax,y mov bx,ax shl ax,8 shl bx,6 add bx,ax add bx,x mov ax,0a000h mov es,ax mov al,c mov es:[bx],al end; Function get(x,y : integer):byte; { Put Modified by me } begin asm mov ax,y mov bx,ax shl ax,8 shl bx,6 add bx,ax add bx,x mov ax,0a000h mov es,ax mov al,es:[bx] mov @result,al end; end; Procedure MakePal; Var I : Byte; Pal : VGAPaletteType; begin FillChar(Pal,SizeOf(Pal),0); For I:=1 To MaxColor Do HSI2RGB(4.6-1.5*I/MaxColor,I/MaxColor,I/MaxColor,Pal[I]); For I:=MaxColor To 255 Do begin Pal[I]:=Pal[I-1]; With Pal[I] Do begin If R<63 Then Inc(R); If R<63 Then Inc(R); If (I Mod 2=0) And (G<53) Then Inc(G); If (I Mod 2=0) And (B<63) Then Inc(B); end; end; WritePal(Pal); end; Function Rand(R:Integer):Integer; { Return a random number between -R And R} begin Rand:=Random(R*2+1)-R; end; Procedure Help; Var Mode : Byte; R : Registers; begin R.Ax:=$0F00; Intr($10,R); Mode:=R.Al; R.Ax:=$0003; {TextMode} Intr($10,R); ClrScr; WriteLn('Burn version 1.00'); WriteLn; WriteLn('Light''n''play'); WriteLn; WriteLn('Keys : '); WriteLn('<space> : Throw in a match'); WriteLn('<W> : Water'); WriteLn('<+> : Increase intensity'); WriteLn('<-> : Decrease intensity'); WriteLn('<C> : Initialize fire'); WriteLn('<1>..<9>: Burnability (1=Wood, 9=Gaz)'); WriteLn('<?> : This help'); WriteLn; Write('Hit any key kid >'); ReadKey; R.Ax:=$0000+Mode; Intr($10,R); If Mode = $13 Then MakePal; end; Var FlameArray : Array[XStart..XEnd] Of Byte; LastMode : Byte; I,J : Integer; X,P : Integer; MoreFire, V : Integer; R : Registers; Ch : Char; begin Help; RandomIze; R.Ax:=$0F00; Intr($10,R); LastMode:=R.Al; R.Ax:=$0013; Intr($10,R); MoreFire:=1; MakePal; { (* Use this if you want to view the palette *) For I:=0 To 255 Do For J:=0 To 20 Do Put(I,J,I); ReadKey; {} { Initialize FlameArray } For I:=XStart To XEnd Do FlameArray[I]:=0; FillChar(Scr,SizeOf(Scr),0); { Clear Screen } repeat If KeyPressed Then Ch:=ReadKey Else Ch:='.'; {'.' = Nothing (Dummy)} While KeyPressed Do ReadKey; { Empty Keyboard buffer } { Put the values from FlameArray on the bottom line of the screen } For I:=XStart To XEnd Do Put(I,199,FlameArray[I]); { This loop makes the actual flames } For I:=XStart To XEnd Do For J:=MinY To 199 Do begin V:=Get(I,J); If (V=0) Or (V<Decay) Or (I<=XStart) Or (I>=XEnd) Then Put(I,Pred(J),0) else Put(I-Pred(Random(3)),Pred(J),V-Random(Decay)); end; {Match?} If (Random(150)=0) Or (Ch=' ') Then FillChar(FlameArray[XStart+Random(XEnd-XStart-5)],5,255); {In-/Decrease?} If (Ch='-') Then If MoreFire >-2 Then Dec(MoreFire); If (Ch='+') Then If MoreFire < 4 Then Inc(MoreFire); {!!} If UpCase(Ch) = 'C' Then FillChar(FlameArray,SizeOf(FlameArray),0); If UpCase(Ch) = 'W' Then for I:=1 To 10 Do FlameArray[XStart+Random(Width)]:=0; If Ch = '?' Then Help; if Ch in ['1'..'9'] Then FireIncrease:=3+Sqr(Ord(Ch)-Ord('1')); {This loop controls the "root" of the flames ie. the values in FlameArray.} For I:=XStart To XEnd Do begin X:=FlameArray[I]; If X<MinFire Then { Increase by the "burnability"} begin {Starting to burn:} If X>10 Then Inc(X,Random(FireIncrease)); end else { Otherwise randomize and increase by intensity (is burning)} Inc(X,Rand(RootRand)+MoreFire); If X>255 Then X:=255; { X Too large ?} FlameArray[I]:=X; end; { Pour a little water on both sides of the fire to make it look nice on the sides} For I:=1 To Width Div 8 Do begin X:=Trunc(Sqr(Random)*Width/8); FlameArray[XStart+X]:=0; FlameArray[XEnd-X]:=0; end; {Smoothen the values of FrameArray to avoid "descrete" flames} P:=0; For I:=XStart+Smooth To XEnd-Smooth Do begin X:=0; For J:=-Smooth To Smooth Do Inc(X,FlameArray[I+J]); FlameArray[I]:=X Div (2*Smooth+1); end; Until Ch=#27; {Restore video mode} R.Ax:=$0000+LastMode; Intr($10,R); {Good bye} end.