FIRE1-11.PAS

FIRE1-11.PAS

{                旼컴컴컴컴컴컴커
                 ?  FIRE.PAS   ?
      旼컴컴컴컴컨컴컴컴컴컴컴컴좔컴컴컴컴컴?
      ?갚꾼 Version 1.11 (C) 22/6/94  昉굅 ?
      쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴?
      ?My puny attempt at a fire effect.   ?
      ?Yes, I know... it'll all end in     ?
      ?tears. Well, it was just about the  ?
      ?only thing in the PCGPE that didn't ?
      ?involve incredible amounts of trig. ?
      ?At any rate, it's something else to ?
      ?add to the 'well, I tried it' pile. ?
      쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴?
      ?V1.04 adds worded X-values          ?
      ?V1.05 gets rid of editor            ?
      ?V1.08 speeds up (1.07 didn't!)      ?
      ?V1.09 speeds up a bit more          ?
      ?V1.10b uses fewer checkpoints       ?
      ?V1.11 improves the lookup table and ?
      ?      the X,Y parameter passing     ?
      읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴?


What a useless and silly program that dosen't work! (tr)}

Uses DOS,CRT;

Const
     MemoryUsed = 32000;

Type                                           { Don't ask me about 'em! }
    VirtScreenData = Array [1..MemoryUsed] Of Byte; { 320x200 virtual screen }
    VirtPointer = ^VirtScreenData;             { Pointer to virtual screen }

Var
   VirtualScreen : VirtPointer;                { Actual virtual screen }
   VirtScrSeg  : Word;                         { Segment of virtual screen}
   Temp : Word;                                { Err... temporary thing }

Const
     HotSpots : Byte = 100;                     { Starting hotspots }
     Xres : Word = 319;                        { X-resolution, *BYTE* }
     Yres : Byte = 50;                         { Y-resolution }
     RealScrSeg : Word = $A000;                { For ease of addressing }

Procedure SetRGBpalette(Col,r,g,b : Byte);
{ Fast palette set }
Begin
     Port[$3C8]:=Col;
     Port[$3C9]:=r;
     Port[$3C9]:=g;
     Port[$3C9]:=b;
End;

Procedure SetVideoMode(Mode : Byte);
{ Set video mode via bios }
Var
   Reggie : Registers;
Begin
     Reggie.AH:=0;
     Reggie.AL:=Mode;
     Intr($10,Reggie);
End;

Procedure ClearReal;
{ Clear the real proper screen }
Begin
     FillChar(Mem[RealScrSeg:0],MemoryUsed,0);
End;

Procedure ClearVirtual;
{ Clear the virtual screen }
Begin
     FillChar(Mem[VirtScrSeg:0],MemoryUsed,0);
End;

Procedure SetUpVirtual;
{ Initialise virtual screen }
Begin
  GetMem(VirtualScreen,MemoryUsed);
  VirtScrSeg:=Seg(VirtualScreen^);
  ClearVirtual;
End;

Procedure ReleaseVirtual;
{ Zap the virtual screen }
Begin
  FreeMem(VirtualScreen,MemoryUsed);
End;

Procedure Flip;
{ Flips the virtual screen to the VGA screen }
Begin
  Move(VirtualScreen^,Mem[RealScrSeg:0],MemoryUsed);
End;

Procedure ReverseFlip;
{ Flips the VGA screen to the virtual screen }
Begin
  Move(Mem[RealScrSeg:0],VirtualScreen^,MemoryUsed);
End;

Procedure SmoothPalette;
{ Smooth black-red palette }
Var
   SetPal : Word;
Begin
     { Preferably, 0-6=yellow, 7-30=red, 31-255=white }
     For SetPal:=0 To 6 Do
         SetRGBPalette(SetPal,Trunc(SetPal*10),0,0);
     For SetPal:=7 To 20 Do
         SetRGBPalette(SetPal,63,Trunc((SetPal-7)*4.9),0);
     For SetPal:=21 To 255 Do
         SetRGBPalette(SetPal,63,63,Trunc((SetPal-21)/3.6));
End;

Procedure PutPixel(Segment : Word; Xpos : Word; Ypos,Colour : Byte);
{ Rudimentary PutPixel }
Begin
     Mem[Segment:Ypos*320+Xpos]:=Colour;
End;

Function GetPixel(Segment : Word; Xpos : Word; Ypos : Byte) : Byte;
{ Rudimentary GetPixel }
Begin
     GetPixel:=Mem[Segment:Ypos*320+Xpos];
End;

Procedure SetupSpots;
{ Define initial hotspots }
Var
   DefHotSpots,BottomLine : Byte;
   Xpos : Word;
Begin
     For DefHotSpots:=1 To HotSpots Do
     Begin
          Xpos:=Trunc(Random*Xres);
          PutPixel(VirtScrSeg,Xpos,Yres,255);
     End;
End;

Procedure ExtraSpot(Xpos : Word; Ypos : Byte);
{ Define extra hotspot }
Begin
     PutPixel(VirtScrSeg,Xpos,Ypos,255);
End;

Procedure UpdateFireAssembler(VirtScrSeg,RealScrSeg,BytesToDo : Word);
Assembler;
{ Hopefully display the fire on-screen in *gasp* - assembler! }
Asm
   cli
   push ds
   mov AX,[RealScrSeg]         { screen memory; using DS:SI for RealScr }
   mov DS,AX                   { dunno, this line just looked lonely. }
   mov SI,321                  { ofs = 2nd point on 2nd line }

   mov AX,[VirtScrSeg]         { virtual screen memory; ES:SI is VirtScr }
   mov ES,AX                   { err... another lonely line }

   xor AH,AH                   { use AL later }
   mov CX,[BytesToDo]          { Xres*Yres }
@Update_All_Rows:
   mov BX,0                    { change for longer-lasting fire }   { 2 tiks }

   mov AL,[ES:SI]              { X,Y }                              { 4 }
   add BX,AX                                                        { 2 }
   mov AL,[ES:SI]+319          { X-1,Y+1 }                          { 4 }
   add BX,AX                                                        { 2 }
   mov AL,[ES:SI]+320          { X,Y+1 }                            { 4 }
   add BX,AX                                                        { 2 }
   mov AL,[ES:SI]+321          { X+1,Y+1 }                          { 4 }
   add BX,AX                                                        { 2 }
   mov AL,[ES:SI]+640          { X,Y+2 }                            { 4 }
   add BX,AX                                                        { 2 }

   mov BL,[CS:BX+Offset @Lookup_Table]                              { 4 }
   mov [DS:SI],BL                                                   { 2 }
   inc SI                      { onto next pixel }                  { 2 }
   loop @Update_All_Rows                                            { 10? }
   jmp @Asm_End                                                     { T=50 }

@Lookup_Table:
   { okay, this is perhaps not the most efficient use of source code. }
   db 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5,5,5
   db 5,5,6,6,6,6,6,7,7,7,7,7,8,8,8,8,8,9,9,9,9,9,10,10,10,10,10,11,11
   db 11,11,11,12,12,12,12,12,13,13,13,13,13,14,14,14,14,14,15,15,15,15
   db 15,16,16,16,16,16,17,17,17,17,17,18,18,18,18,18,19,19,19,19,19,20
   db 20,20,20,20,21,21,21,21,21,22,22,22,22,22,23,23,23,23,23,24,24,24
   db 24,24,25,25,25,25,25,26,26,26,26,26,27,27,27,27,27,28,28,28,28,28
   db 29,29,29,29,29,30,30,30,30,30,31,31,31,31,31,32,32,32,32,32,33,33
   db 33,33,33,34,34,34,34,34,35,35,35,35,35,36,36,36,36,36,37,37,37,37
   db 37,38,38,38,38,38,39,39,39,39,39,40,40,40,40,40,41,41,41,41,41,42
   db 42,42,42,42,43,43,43,43,43,44,44,44,44,44,45,45,45,45,45,46,46,46
   db 46,46,47,47,47,47,47,48,48,48,48,48,49,49,49,49,49,50,50,50,50,50
   db 51,51,51,51,51,52,52,52,52,52,53,53,53,53,53,54,54,54,54,54,55,55
   db 55,55,55,56,56,56,56,56,57,57,57,57,57,58,58,58,58,58,59,59,59,59
   db 59,60,60,60,60,60,61,61,61,61,61,62,62,62,62,62,63,63,63,63,63,64
   db 64,64,64,64,65,65,65,65,65,66,66,66,66,66,67,67,67,67,67,68,68,68
   db 68,68,69,69,69,69,69,70,70,70,70,70,71,71,71,71,71,72,72,72,72,72
   db 73,73,73,73,73,74,74,74,74,74,75,75,75,75,75,76,76,76,76,76,77,77
   db 77,77,77,78,78,78,78,78,79,79,79,79,79,80,80,80,80,80,81,81,81,81
   db 81,82,82,82,82,82,83,83,83,83,83,84,84,84,84,84,85,85,85,85,85,86
   db 86,86,86,86,87,87,87,87,87,88,88,88,88,88,89,89,89,89,89,90,90,90
   db 90,90,91,91,91,91,91,92,92,92,92,92,93,93,93,93,93,94,94,94,94,94
   db 95,95,95,95,95,96,96,96,96,96,97,97,97,97,97,98,98,98,98,98,99,99
   db 99,99,99,100,100,100,100,100,101,101,101,101,101,102,102,102,102
   db 102,103,103,103,103,103,104,104,104,104,104,105,105,105,105,105,106
   db 106,106,106,106,107,107,107,107,107,108,108,108,108,108,109,109,109
   db 109,109,110,110,110,110,110,111,111,111,111,111,112,112,112,112,112
   db 113,113,113,113,113,114,114,114,114,114,115,115,115,115,115,116,116
   db 116,116,116,117,117,117,117,117,118,118,118,118,118,119,119,119,119
   db 119,120,120,120,120,120,121,121,121,121,121,122,122,122,122,122,123
   db 123,123,123,123,124,124,124,124,124,125,125,125,125,125,126,126,126
   db 126,126,127,127,127,127,127,128,128,128,128,128,129,129,129,129,129
   db 130,130,130,130,130,131,131,131,131,131,132,132,132,132,132,133,133
   db 133,133,133,134,134,134,134,134,135,135,135,135,135,136,136,136,136
   db 136,137,137,137,137,137,138,138,138,138,138,139,139,139,139,139,140
   db 140,140,140,140,141,141,141,141,141,142,142,142,142,142,143,143,143
   db 143,143,144,144,144,144,144,145,145,145,145,145,146,146,146,146,146
   db 147,147,147,147,147,148,148,148,148,148,149,149,149,149,149,150,150
   db 150,150,150,151,151,151,151,151,152,152,152,152,152,153,153,153,153
   db 153,154,154,154,154,154,155,155,155,155,155,156,156,156,156,156,157
   db 157,157,157,157,158,158,158,158,158,159,159,159,159,159,160,160,160
   db 160,160,161,161,161,161,161,162,162,162,162,162,163,163,163,163,163
   db 164,164,164,164,164,165,165,165,165,165,166,166,166,166,166,167,167
   db 167,167,167,168,168,168,168,168,169,169,169,169,169,170,170,170,170
   db 170,171,171,171,171,171,172,172,172,172,172,173,173,173,173,173,174
   db 174,174,174,174,175,175,175,175,175,176,176,176,176,176,177,177,177
   db 177,177,178,178,178,178,178,179,179,179,179,179,180,180,180,180,180
   db 181,181,181,181,181,182,182,182,182,182,183,183,183,183,183,184,184
   db 184,184,184,185,185,185,185,185,186,186,186,186,186,187,187,187,187
   db 187,188,188,188,188,188,189,189,189,189,189,190,190,190,190,190,191
   db 191,191,191,191,192,192,192,192,192,193,193,193,193,193,194,194,194
   db 194,194,195,195,195,195,195,196,196,196,196,196,197,197,197,197,197
   db 198,198,198,198,198,199,199,199,199,199,200,200,200,200,200,201,201
   db 201,201,201,202,202,202,202,202,203,203,203,203,203,204,204,204,204
   db 204,205,205,205,205,205,206,206,206,206,206,207,207,207,207,207,208
   db 208,208,208,208,209,209,209,209,209,210,210,210,210,210,211,211,211
   db 211,211,212,212,212,212,212,213,213,213,213,213,214,214,214,214,214
   db 215,215,215,215,215,216,216,216,216,216,217,217,217,217,217,218,218
   db 218,218,218,219,219,219,219,219,220,220,220,220,220,221,221,221,221
   db 221,222,222,222,222,222,223,223,223,223,223,224,224,224,224,224,225
   db 225,225,225,225,226,226,226,226,226,227,227,227,227,227,228,228,228
   db 228,228,229,229,229,229,229,230,230,230,230,230,231,231,231,231,231
   db 232,232,232,232,232,233,233,233,233,233,234,234,234,234,234,235,235
   db 235,235,235,236,236,236,236,236,237,237,237,237,237,238,238,238,238
   db 238,239,239,239,239,239,240,240,240,240,240,241,241,241,241,241,242
   db 242,242,242,242,243,243,243,243,243,244,244,244,244,244,245,245,245
   db 245,245,246,246,246,246,246,247,247,247,247,247,248,248,248,248,248
   db 249,249,249,249,249,250,250,250,250,250,251,251,251,251,251,252,252
   db 252,252,252,253,253,253,253,253,254

@Asm_End:
   pop ds
   sti
End;

Begin
     Inc(RealScrSeg,20*(201-Yres));            { shift it down screen }
     SetVideoMode($13);                        { 320x200, 256 colours}
     SetUpVirtual;                             { alternate screen }
     SmoothPalette;                            { black-red }
     ClearReal;
     TextColor(25); DirectVideo:=False;

     Repeat
           SetupSpots;                         { some more starters }
           UpdateFireAssembler(VirtScrSeg,RealScrSeg,Xres*Yres);
           ReverseFlip;                        { and save the results }
     Until Keypressed;

     ReleaseVirtual;                           { get memory back }
     SetVideoMode(3);                          { 80x25 standard text }
     WriteLn;
     WriteLn('Too hot, eh?');
End.