Pixel Morphs

                    嬪様様様様様様様様様様様様様様様
                             W E L C O M E         
                      To the VGA Trainer Program    
                                  By                
                          DENTHOR of ASPHYXIA        
                    塒様様様様様様様様様様様様様様様  
                      陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳 
                        陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳

                            --==[ PART 17 ]==--

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Introduction

 Hi there everybody. It's a new year, but the parties are over and it's time
 to get coding again!

 My mailserver died. Various sysadmins decided it was time to upgrade the
 OS, and wound up nuking the hard drive :-( ... this means that request-list
 is not working at the moment, and I have probably lost lots of mail.

 denthor@beastie.cs.und.ac.za is still the account to write to, and
 hopefully the mailserver will be back up in the near future.

 There are various C/C++ conversions of my trainer, best of which seem to be
 those by Snowman ... he runs through the text files with C++ updates (and
 seems to point out my previous mistakes with glee ;-), as well is giving a
 fully documented C++ conversion of the source ... very nice stuff.

 Also, my trainers are being put on a World Wide Web site ... it is still
 under construction, but go to http://www.cit.gu.edu.au/~rwong
 my site is at http://goth.vironix.co.za/~denthor ... it is currently pretty
 awful, anyone want to write a nice one for me? ;)

 I have just about finished Asphyxia's new game, I will let you all know
 when it is completed.

 Tut 16 dies with large bitmaps ... the way to sort this out is to decrease
 the accuracy of the fixed point from 256 to 128 ... then you can have
 bitmaps up to 512 pixels wide. I will be putting an updated scale routine
 in the gfx4.pas unit.

 This tutor is on a few demo effects (pixel morphs and static) ... after
 this one, I will go on to more theory ... perhaps some more 3d stuff, such
 as gourad shading etc. Comments?

 If you would like to contact me, or the team, there are many ways you
 can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail
                   on the ASPHYXIA BBS.
             2) Write to :  Grant Smith
                            P.O.Box 270 Kloof
                            3640
                            Natal
                            South Africa
             3) Call me (Grant Smith) at (031) 73 2129 (leave a message if you
                   call during varsity). Call +27-31-73-2129 if you call
                   from outside South Africa. (It's YOUR phone bill ;-))
             4) Write to denthor@beastie.cs.und.ac.za in E-Mail.
             5) Write to asphyxia@beastie.cs.und.ac.za to get to all of
                us at once.

 NB : If you are a representative of a company or BBS, and want ASPHYXIA
        to do you a demo, leave mail to me; we can discuss it.
 NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling
         quite lonely and want to meet/help out/exchange code with other demo
         groups. What do you have to lose? Leave a message here and we can work
         out how to transfer it. We really want to hear from you!

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   Pixel Morphing

 Have you ever lain down on your back in the grass and looked up at the
 cloudy sky? If you have, you have probably seen the clouds move together
 and create wonderful shapes ... that cloud plus that cloud together make a
 whale ... a ship ... a face etc.

 We can't quite outdo mother nature, but we can sure give it a shot. The
 effect I am going to show you is where various pixels at different starting
 points move together and create an overall picture.

 The theory behind it is simple : Each pixel has bits of data associated
 with it, most important of which is as follows :

 This is my color
 This is where I am
 This is where I want to be.

 The pixel, keeping it's color, goes from where it is to where it wants to
 be. Our main problem is _how_ it moves from where it is to where it wants
 to be. A obvious approach would be to say "If it's destination is above it,
 decrement it's y value, if the destination is to the left, decrement it's x
 value and so on."

 This would be bad. The pixel would only ever move at set angles, as you can
 see below :

                 Dest   O-----------------\
                                            \  <--- Path
                                              \
                                                \
                                                 O Source

 Doesn't look very nice, does it? The pixels would also take different times
 to get to their destination, whereas we want them to reach their points at
 the same time, ie :

      Dest 1   O-------------------------------O Source 1
      Dest 2   O-----------------O Source 2

 Pixels 1 and 2 must get to their destinations at the same time for the best
 effect. The way this is done by defining the number of frames or "hops"
 needed to get from source to destination. For example, we could tell pixel
 one it is allowed 64 hops to get to it's destination, and the same for
 point 2, and they would both arrive at the same time, even though pixel 2
 is closer.

 The next question, it how do we move the pixels in a straight line? This is
 easier then you think...

 Let us assume that for each pixel, x1,y1 is where it is, and x2,y2 is where
 it wants to be.

    (x2-x1) = The distance on the X axis between the two points
    (y2-y1) = The distance on the Y axis between the two points

 If we do the following :

   dx := (x2-x1)/64;

 we come out with a value in dx wich is very useful. If we added dx to x1 64
 times, the result would be x2! Let us check...

   dx = (x2-x1)/64
   dx*64 = x2-x1         { Multiply both sides by 64 }
   dx*64+x1 = x2         { Add x1 to both sides }

 This is high school math stuff, and is pretty self explanitory. So what we
 have is the x movement for every frame that the pixel has to undergo. We
 find the y movement in the same manner.

   dy := (y2-y1)/64;

 So our program is as follows :

   Set x1,y1 and x2,y2 values
   dx:= (x2-x1)/64;
   dy:= (y2-y1)/64;

   for loop1:=1 to 64 do BEGIN
     putpixel (x1,y1)
     wait;
     clear pixel (x1,y1);
     x1:=x1+dx;
     y1:=y1+dy;
   END;

 If there was a compiler that could use the above pseudocode, it would move
 the pixel from x1,y1 to x2,y2 in 64 steps.

 So, what we do is set up an array of many pixels with this information, and
 move them all at once ... viola, we have pixel morphing! It is usually best
 to use a bitmap which defines the color and destination of the pixels, then
 randomly scatter them around the screen.

 Why not use pixel morphing on a base object in 3d? It would be the work of
 a moment to add in a Z axis to the above.

 The sample program uses fixed point math in order to achieve high speeds,
 but it is basically the above algorithm.

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   Static

 A static screen was one of the first effects Asphyxia ever did. We never
 actually released it because we couldn't find anywhere it would fit. Maybe
 you can.

 The easiest way to get a sreen of static is to tune your TV into an unused
 station ... you even get the cool noise effect too. Those people who build
 TV's really know how to code ;-)

 For us on a PC however, it is not as easy to generate a screen full of
 static (unless you desperately need a new monitor)

 What we do is this :

 Set colors 1-16 to various shades of grey.
 Fill the screen up with random pixels between colors 1 and 16
 Rotate the pallette of colors 1 to 16.

 That's it! You have a screenfull of static! To get two images in one static
 screen, all you need to do is fade up/down the specific colors you are
 using for static in one of the images.

 A nice thing about a static screen is that it is just pallette rotations
 ... you can do lots of things in the foreground at the same time (such as a
 scroller).

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   In closing

 Well, that is about it ... as I say, I will be doing more theory stuff in
 future, as individual demo effects can be thought up if you know the base
 stuff.

 Note the putpixel in this GFX3.PAS unit ... it is _very_ fast .. but
 remember, just calling a procedure eats clock ticks... so imbed putpixels
 in your code if you need them. Most of the time a putpixel is not needed
 though.

 PCGPE ][ will be out on the 10th of Feburary. All the new tutors will be on
 it (if you aren't reading this from it right now! ;-) ... grab a copy of
 it, it is a very useful ting to have handy.

 I have found out that these tutors have been distributed inside paper
 magazines ... please remember that Denthor and Asphyxia retain full
 copyright to the series (as mentioned earlier in the series), and if you
 want to use a version in a magazine, CONTACT ME FIRST ... I will probably
 also modify it/cut out various unneccesary things ... other then that, you
 must not alter the files without my permission, or at least leave a copy of
 the origional with the update. Maybe I could even start up a nice column
 for some magazine or other :)

 Sorry 'bout that, but it had to be said ...

 I am writing a column for the Demuan list, a Florida-based electronic
 magazine ... pick it up off ftp.eng.ufl.edu ... I have written various
 articles, all bordering on quote-like design.

 There are more BBS's to be added to the list at the end, but I don't have
 them here... this tut has taken long enough ;-)

 Byeeeee....
   - Denthor

 The following are official ASPHYXIA distribution sites :

 浜様様様様様様様様様様様様曜様様様様様様様様僕様様
 BBS Name                  Telephone No.   Open 
 麺様様様様様様様様様様様様洋様様様様様様様様陵様様
 ASPHYXIA BBS #1           +27-31-765-5312 ALL  
 ASPHYXIA BBS #2           +27-31-765-6293 ALL  
 C-Spam BBS                410-531-5886    ALL  
 POP!                      +27-12-661-1257 ALL  
 Soul Asylum               +358-0-5055041  ALL  
 Wasted Image              407-838-4525    ALL  
 Reckless Life             351-01-716 67 58ALL  
 Mach 5 BBS                +1 319-355-7336 ALL  
 藩様様様様様様様様様様様様擁様様様様様様様様瞥様様

 Leave me mail if you want to become an official Asphyxia BBS
 distribution site.
 {$X+}
 USES crt,gfx3;

 Const jump = 64;       { Number of pixels active at once }
       sjump = 6;       { 1 shl 6 = 64 }

 TYPE
         FontDat = Array [' '..'Z',1..16,1..16] of byte; {Our main font }
         target = record
                  herex,herey : integer;
                  targx,targy : integer;
                  dy,dx : integer;
                  active : boolean;
                  col : byte;
                  num:integer;
              END;
         PixelDat = Array [1..4095] of target; { This is the maximum number
                                                 of points we canb fit in a
                                                 segment... }

 VAR Font : ^FontDat;                          { Our nice font }
     nextrow : ^PixelDat;
     scr : array [' '..'Z',1..8,1..8] of byte; { The basic bios font }
     Vir2 : VirtPtr;
     Vaddr2 : Word;                            { Spare virtual screen }
     counter:integer;
     PosLoop:integer;
     dir : boolean;
     pathx,pathy:array [1..314] of integer;    { Path of origination }
     arbpal : array [1..8,1..3] of byte;       { Used to remember certain
                                                 colors }

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Bigmsg (x,y:integer;msg:string);
   { This draws string msg to screen in the bios font, but bigger }
 VAR loop1,loop2,loop3,loop4,loop5:integer;
 BEGIN
   for loop1:=1 to length (msg) do
     for loop2:=1 to 8 do
       for loop3:=1 to 8 do
         if (scr[msg[loop1],loop3,loop2]<>0) then BEGIN
           for loop4:=1 to 4 do
             for loop5:=1 to 8 do
               putpixel (x+(loop1*32)+(loop2*4)+loop4,y+(loop3*8)+loop5,
                 getpixel (x+(loop1*32)+(loop2*4)+loop4,y+(loop3*8)+loop5,vaddr2)+51,vaddr);
         END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Static;
   { This moves the static and tunes in to our background logo }
 VAR loop1,loop2,count,count2,count3:integer;
 BEGIN
   flip (vaddr2,vaddr);
   Bigmsg (0,60,'ASPHYXIA');
   flip (vaddr,vga);
   count:=0;
   count2:=0;
   for loop2:=1 to 100 do BEGIN
     waitretrace;
     for loop1:=99 to 150 do BEGIN
       count:=random (64);
       pal (loop1,count,count,count);
     END;
     for loop1:=150 to 201 do BEGIN
       count:=random (64);
       pal (loop1,count,count,count);
     END;
   END;   { Do the static for a while }

   repeat
     inc (count);
     if count>10 then BEGIN
       count:=0;
       inc (count2);
     END;
     waitretrace;
     for loop1:=99 to 150 do BEGIN
       count3:=random (64-count2);
       if count3<0 then count3:=0;
       pal (loop1,count3,count3,count3);
     END;
     for loop1:=150 to 201 do BEGIN
       count3:=random (64);
       count3:=count3+count2;
       if count3>63 then count3:=63;
       pal (loop1,count3,count3,count3);
     END;
   until count2>63; { Static fade in Asphyxia logo }

   delay (500);
   for loop1:=30 to 62 do BEGIN
     line (0,loop1*2,319,loop1*2,0,vga);
     delay (5);
   END;
   for loop1:=62 downto 30 do BEGIN
     line (0,loop1*2+1,319,loop1*2+1,0,vga);
     delay (5);
   END;  { Erase logo with lines }
   delay (1000);
   while keypressed do readkey;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Fadeup;
   { This fades up the pallette to white }
 VAR loop1,loop2:integer;
     Tmp : Array [1..3] of byte;
 BEGIN
   For loop1:=1 to 64 do BEGIN
     WaitRetrace;
     For loop2:=0 to 255 do BEGIN
       Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
       If Tmp[1]<63 then inc (Tmp[1]);
       If Tmp[2]<63 then inc (Tmp[2]);
       If Tmp[3]<63 then inc (Tmp[3]);
       Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
     END;
   END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure FadeTo (name:string);
   { This procedure fades the screen to name ... if you use this for yourself,
     you will need to cut out the extra stuff I do in here specific to this
     program }
 VAR loop1,loop2:integer;
     tmp,pall2:array[0..255,1..3] of byte;
     f:file;
 BEGIN
   assign (f,name);
   reset (f,1);
   blockread (f,pall2,768);
   close (f);
   for loop1:=100 to 150 do BEGIN
     pall2[loop1,1]:=loop1-100;
     pall2[loop1,2]:=loop1-100;
     pall2[loop1,3]:=loop1-100;
   END;  { Set the background colors }
   waitretrace;
   for loop1:=0 to 255 do
     getpal (loop1,tmp[loop1,1],tmp[loop1,2],tmp[loop1,3]);

   For loop1:=1 to 64 do BEGIN
     For loop2:=0 to 255 do BEGIN
       If Tmp[loop2,1]Pall2[loop2,1] then dec (Tmp[loop2,1]);
       If Tmp[loop2,2]>Pall2[loop2,2] then dec (Tmp[loop2,2]);
       If Tmp[loop2,3]>Pall2[loop2,3] then dec (Tmp[loop2,3]);
     END;
     WaitRetrace;
     for loop2:=0 to 255 do
       pal (loop2,tmp[loop2,1],tmp[loop2,2],tmp[loop2,3]);
   END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Show (x,y:integer;ch:string);
   { This dumps string ch to screen at x,y in our main font }
 VAR loop1,loop2,loop3:integer;
 BEGIN
   for loop3:=1 to length (ch) do
     For loop1:=1 to 16 do
       for loop2:=1 to 16 do
         if Font^[ch[loop3],loop2,loop1]<>0 then
           putpixel (x+loop1+(loop3*17),y+loop2,getpixel (x+loop1+(loop3*17),y+loop2,vaddr2)+51,VGA);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Eye_Popper;
   { This fades up the colors used in our main font }
 VAR Loop1,loop2:integer;
     tmp : array [1..3] of byte;
 BEGIN
   if keypressed then exit;
   for loop1:=1 to 63 do
     for loop2:=1 to 8 do BEGIN
       Waitretrace;
       Getpal (loop2,tmp[1],tmp[2],tmp[3]);
       if tmp[1]<63 then inc (tmp[1]);
       if tmp[2]<63 then inc (tmp[2]);
       if tmp[3]<63 then inc (tmp[3]);
       pal (loop2,tmp[1],tmp[2],tmp[3]);
     END;
   for loop1:=151 to 200 do
     pal (loop1,63,63,63);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure FadeOutText;
   { This fades out the colors of our main font to the colors of the background
     static }
 VAR Loop1,loop2:integer;
     tmp : array [1..3] of byte;
 BEGIN
   if keypressed then exit;
   for loop1:=1 to 63 do BEGIN
     Waitretrace;
     for loop2:=151 to 200 do BEGIN
       Getpal (loop2,tmp[1],tmp[2],tmp[3]);
       if tmp[1]>loop2-151 then dec (tmp[1]);
       if tmp[2]>loop2-151 then dec (tmp[2]);
       if tmp[3]>loop2-151 then dec (tmp[3]);
       pal (loop2,tmp[1],tmp[2],tmp[3]);
     END;
   END;
   delay (100);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Move_Em_Out (num:integer;del:byte);
   { This procedure runs through each pixel that is active and moves it closer
     to its destination }
 VAR loop2:integer;
 BEGIN
   if del<>0 then delay (del);
   for loop2:=1 to num do
     if nextrow^[loop2].active then with nextrow^[loop2] do BEGIN
       putpixel (herex shr sjump,herey shr sjump,
                 getpixel (herex shr sjump,herey shr sjump,vaddr),vga);
         { Restore old bacground }
       herex:=herex-dx;
       herey:=herey-dy;  { Move pixel one step closer }
       putpixel (herex shr sjump,herey shr sjump,col,vga); { Put down pixel }
       dec (num);
       if num=0 then BEGIN
         active:=false;
         putpixel (herex shr sjump,herey shr sjump,col,vaddr);
       END;  { If destination reached, deactivate }
     END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Doletter (msg : char; dx,dy : integer);
   { This procedure activates the pixels necessary to draw a letter }
 VAR loop1,loop2:integer;
     x,y : Integer;
 BEGIN
   if keypressed then exit;
   for loop2:=1 to 16 do BEGIN
     for loop1:=1 to 16 do     { Our font is 16x16 }
       if Font^[msg,loop1,loop2]<>0 then BEGIN { Don't do black pixels }
         if dir then PosLoop:=PosLoop+1
           else PosLoop:=PosLoop-1;
         if PosLoop=315 then PosLoop:=1;
         if PosLoop=0 then PosLoop:=314;
         X:=pathx[PosLoop]+160;
         y:=pathy[PosLoop]+100;     { Find point of origination }

         nextrow^ [counter].herex:=x shl sjump;
         nextrow^ [counter].herey:=y shl sjump;
           { This is where I am }
         nextrow^ [counter].targx:=(dx+loop2) shl sjump;
         nextrow^ [counter].targy:=(dy+loop1) shl sjump;
           { This is where I want to be }
         nextrow^ [counter].dx:=(nextrow^[counter].herex-nextrow^[counter].targx) div jump;
         nextrow^ [counter].dy:=(nextrow^[counter].herey-nextrow^[counter].targy) div jump;
           { This is how I get there }
         nextrow^ [counter].col:=Font^[msg,loop1,loop2];
         nextrow^ [counter].active:=TRUE;
         nextrow^ [counter].num:=jump;
         move_em_out(jump,6);

         inc (counter);
         if counter=jump+1 then counter:=1;
       END;
   END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure DoPic;
   { This procedure morphs in the tank }
 VAR f:file;
     ch:byte;
     count,loop1,loop2:integer;
     ourpal : array [0..255,1..3] of byte;
 BEGIN
   cls (vaddr,0);
   getmem (nextrow,sizeof(nextrow^));
   GetMem(Vir2,64000);
   Vaddr2 := Seg(Vir2^);
   for loop2:=1 to 4095 do
     nextrow^[loop2].active:=false;

   assign (f,'tut17.cel');
   reset (f,1);
   seek (f,32);
   blockread (f,ourpal,768);
   for loop1:=0 to 255 do
     pal (loop1,ourpal[loop1,1],ourpal[loop1,2],ourpal[loop1,3]);
   count:=1;
   for loop2:=1 to 60 do
     for loop1:=1 to 160 do BEGIN
       blockread (f,ch,1);     { Go through the pic, and activate non-black
                                 pixels }
       if ch<>0 then BEGIN
         nextrow^ [count].herex:=random (320) shl sjump;
         nextrow^ [count].herey:=random (200) shl sjump;
           { This is where I am }
         nextrow^ [count].targx:=(loop1+80) shl sjump;
         nextrow^ [count].targy:=(loop2+70) shl sjump;
           { This is where I want to be }
         nextrow^ [count].dx:=(nextrow^[count].herex-nextrow^[count].targx) div jump;
         nextrow^ [count].dy:=(nextrow^[count].herey-nextrow^[count].targy) div jump;
           { This is how I get there }
         nextrow^ [count].col:=ch;
         nextrow^ [count].active:=TRUE;
         nextrow^ [count].num:=jump;
         inc (count);
       END;
   END;
   close (f);
   for loop1:=0 to 64 do
     move_em_out (count,0);  { Move pixels to targets }
   delay (2000);
   fadeup;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Init;
 VAR f:file;
     loop1,loop2:integer;
     loopie:real;
 BEGIN
   getmem (Font,sizeof(Font^));

   for loop2:=1 to jump do
     nextrow^[loop2].active:=false;

   Assign(f,'gods.Fnt');
   Reset(f,1);
   Blockread(F,Font^,SizeOf(Font^));
   Close(f);

   assign (f,'biostext.dat');
   reset (f,1);
   Blockread (f,scr,sizeof (scr));
   close (f);

   counter:=1;
   PosLoop:=1;
   dir:=true;
   loopie:=0;
   for loop1:=1 to 314 do BEGIN
     loopie:=loopie+0.02;
     pathX[loop1]:=round(150*cos (loopie));
     pathy[loop1]:=round(90*sin (loopie));
   END;    { Generate our path of origination }
   cls (vga,0);
   cls (vaddr,0);
   cls (vaddr2,0);
   for loop1:=0 to 319 do
     for loop2:=0 to 199 do
       putpixel (loop1,loop2,random (50)+100,vaddr2); { Fill the screen with static }
   flip (vaddr2,vaddr);
   flip (vaddr,vga);
   fadeto ('game01.col');
   for loop1:=1 to 8 do
     getpal (loop1,arbpal[loop1,1],arbpal[loop1,2],arbpal[loop1,3]);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Play;
 VAR loop1,loop2:integer;
     message : Array [1..10] of string;
 BEGIN
   DoPic;
   init;
   while keypressed do readkey;
              {[                 ]}
   message[1]:='';
   message[2]:='';
   message[3]:='   PIXEL TEXT   ';
   message[4]:='';
   message[5]:='   A  ROUTINE';
   message[6]:='';
   message[7]:='      BY...';
   message[9]:='';
  message[10]:='';
   for loop2:=1 to 7 do BEGIN
     For loop1:=1 to length (message[loop2]) do BEGIN
       doletter (message[loop2][loop1],loop1*17,loop2*17);
       dir:=not(dir);
     END;
     for loop1:=1 to jump do move_em_out(jump,6);
   END;

   eye_popper;
   For loop1:=1 to 7 do
     show (0,loop1*17,message[loop1]);
   fadeouttext;
   flip (vaddr2,vaddr);
   flip (vaddr,vga);

   for loop1:=1 to 8 do
     pal (loop1,arbpal[loop1,1],arbpal[loop1,2],arbpal[loop1,3]);
   message[1]:='   TUNING...';
   For loop1:=1 to length (message[1]) do BEGIN
     if message[1][loop1]='.' then for loop2:=1 to 20 do
       move_em_out(jump,6);
     doletter (message[1][loop1],loop1*17,100);
     dir:=not(dir);
   END;
   for loop1:=1 to jump do move_em_out(jump,6);

   eye_popper;
   show (0,100,message[1]);
   fadeouttext;

   static;

   freemem (vir2,sizeof (vir2^));
 END;

 BEGIN
   clrscr;
   writeln ('Hi there ... welcome to the seventeenth Asphyxia VGA Trainer ... and');
   writeln ('the last one on demo effects for a while ... I am going to be doing');
   writeln ('more work on the theory aspect in future trainers.');
   writeln;
   writeln ('This is an effect I first saw in an Extreme demo, and features ''Pixel');
   writeln ('Text'', with various dots forming letters. Also included are some crossfades');
   writeln ('and a static routine.');
   writeln;
   writeln ('Check out the GFX3 unit for a faster putpixel...');
   writeln;
   writeln ('The tank was drawn by Fubar a while ago when he was starting to learn');
   writeln ('3D Studio. The font I found somewhere on my hard drive.');
   writeln;
   writeln;
   writeln ('Hit any key to continue ...');
   readkey;
   setmcga;
   setupvirtual;
   play;
   settext;
   shutdown;
   Writeln ('All done. This concludes the seventeenth sample program in the ASPHYXIA');
   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally read');
   Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
   Writeln ('    denthor@beastie.cs.und.ac.za');
   Writeln ('The numbers are available in the main text. You may also write to me at:');
   Writeln ('             Grant Smith');
   Writeln ('             P.O. Box 270');
   Writeln ('             Kloof');
   Writeln ('             3640');
   Writeln ('             Natal');
   Writeln ('             South Africa');
   Writeln ('I hope to hear from you soon!');
   Writeln; Writeln;
   Write   ('Hit any key to exit ...');
   readkey;
 END.Unit GFX3;

 INTERFACE

 USES crt;
 CONST VGA = $A000;

 TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }

 VAR Virscr : VirtPtr;                     { Our first Virtual screen }
     Vaddr  : word;                        { The segment of our virtual screen}
     Scr_Ofs : Array[0..199] of Word;

 Procedure SetMCGA;
    { This procedure gets you into 320x200x256 mode. }
 Procedure SetText;
    { This procedure returns you to text mode.  }
 Procedure Cls (Where:word;Col : Byte);
    { This clears the screen to the specified color }
 Procedure SetUpVirtual;
    { This sets up the memory needed for the virtual screen }
 Procedure ShutDown;
    { This frees the memory used by the virtual screen }
 procedure flip(source,dest:Word);
    { This copies the entire screen at "source" to destination }
 Procedure Pal(Col,R,G,B : Byte);
    { This sets the Red, Green and Blue values of a certain color }
 Procedure GetPal(Col : Byte; Var R,G,B : Byte);
   { This gets the Red, Green and Blue values of a certain color }
 procedure WaitRetrace;
    {  This waits for a vertical retrace to reduce snow on the screen }
 Procedure Hline (x1,x2,y:word;col:byte;where:word);
    { This draws a horizontal line from x1 to x2 on line y in color col }
 Procedure Line(a,b,c,d:integer;col:byte;where:word);
   { This draws a solid line from a,b to c,d in colour col }
 Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
    { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
      in color col }
 Function rad (theta : real) : real;
    {  This calculates the degrees of an angle }
 Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
    { This puts a pixel on the screen by writing directly to memory. }
 Function Getpixel (X,Y : Integer; where:word) :Byte;
    { This gets the pixel on the screen by reading directly to memory. }
 Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
   { This loads the cel 'filename' into the pointer scrptr }
 Procedure LoadPal (FileName : string);
   { This loads in an Autodesk Animator V1 pallette file }

 IMPLEMENTATION

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
 BEGIN
   asm
      mov        ax,0013h
      int        10h
   end;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetText;  { This procedure returns you to text mode.  }
 BEGIN
   asm
      mov        ax,0003h
      int        10h
   end;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Cls (Where:word;Col : Byte); assembler;
    { This clears the screen to the specified color }
 asm
    push    es
    mov     cx, 32000;
    mov     es,[where]
    xor     di,di
    mov     al,[col]
    mov     ah,al
    rep     stosw
    pop     es
 End;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetUpVirtual;
    { This sets up the memory needed for the virtual screen }
 BEGIN
   GetMem (VirScr,64000);
   vaddr := seg (virscr^);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure ShutDown;
    { This frees the memory used by the virtual screen }
 BEGIN
   FreeMem (VirScr,64000);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 procedure flip(source,dest:Word); assembler;
   { This copies the entire screen at "source" to destination }
 asm
   push    ds
   mov     ax, [Dest]
   mov     es, ax
   mov     ax, [Source]
   mov     ds, ax
   xor     si, si
   xor     di, di
   mov     cx, 32000
   rep     movsw
   pop     ds
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Pal(Col,R,G,B : Byte); assembler;
   { This sets the Red, Green and Blue values of a certain color }
 asm
    mov    dx,3c8h
    mov    al,[col]
    out    dx,al
    inc    dx
    mov    al,[r]
    out    dx,al
    mov    al,[g]
    out    dx,al
    mov    al,[b]
    out    dx,al
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure GetPal(Col : Byte; Var R,G,B : Byte);
   { This gets the Red, Green and Blue values of a certain color }
 Var
    rr,gg,bb : Byte;
 Begin
    asm
       mov    dx,3c7h
       mov    al,col
       out    dx,al

       add    dx,2

       in     al,dx
       mov    [rr],al
       in     al,dx
       mov    [gg],al
       in     al,dx
       mov    [bb],al
    end;
    r := rr;
    g := gg;
    b := bb;
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 procedure WaitRetrace; assembler;
   {  This waits for a vertical retrace to reduce snow on the screen }
 label
   l1, l2;
 asm
     mov dx,3DAh
 l1:
     in al,dx
     and al,08h
     jnz l1
 l2:
     in al,dx
     and al,08h
     jz  l2
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
   { This draws a horizontal line from x1 to x2 on line y in color col }
 asm
   mov   ax,where
   mov   es,ax
   mov   ax,y
   mov   di,ax
   shl   ax,8
   shl   di,6
   add   di,ax
   add   di,x1

   mov   al,col
   mov   ah,al
   mov   cx,x2
   sub   cx,x1
   shr   cx,1
   jnc   @start
   stosb
 @Start :
   rep   stosw
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Line(a,b,c,d:integer;col:byte;where:word);
   { This draws a solid line from a,b to c,d in colour col }
   function sgn(a:real):integer;
   begin
        if a>0 then sgn:=+1;
        if a<0 then sgn:=-1;
        if a=0 then sgn:=0;
   end;
 var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
 begin
      u:= c - a;
      v:= d - b;
      d1x:= SGN(u);
      d1y:= SGN(v);
      d2x:= SGN(u);
      d2y:= 0;
      m:= ABS(u);
      n := ABS(v);
      IF NOT (M>N) then
      BEGIN
           d2x := 0 ;
           d2y := SGN(v);
           m := ABS(v);
           n := ABS(u);
      END;
      s := m shr 1;
      FOR i := 0 TO m DO
      BEGIN
           putpixel(a,b,col,where);
           s := s + n;
           IF not (smxy then mxy:=y2;
   if y3mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
   if y4mxy then mxy:=y4;

   if mny<0 then mny:=0;
   if mxy>199 then mxy:=199;
   if mny>199 then exit;
   if mxy<0 then exit;        { Verticle range checking }

   mul1:=x1-x4; div1:=y1-y4;
   mul2:=x2-x1; div2:=y2-y1;
   mul3:=x3-x2; div3:=y3-y2;
   mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }

   for yc:=mny to mxy do
     begin
       mnx:=320;
       mxx:=-1;
       if (y4>=yc) or (y1>=yc) then
         if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
           if not(y4=y1) then
             begin
               x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if (y1>=yc) or (y2>=yc) then
         if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
           if not(y1=y2) then
             begin
               x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if (y2>=yc) or (y3>=yc) then
         if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
           if not(y2=y3) then
             begin
               x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if (y3>=yc) or (y4>=yc) then
         if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
           if not(y3=y4) then
             begin
               x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if mnx<0 then
         mnx:=0;
       if mxx>319 then
         mxx:=319;          { Range checking on horizontal line }
       if mnx<=mxx then
         hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
     end;
   end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Function rad (theta : real) : real;
   {  This calculates the degrees of an angle }
 BEGIN
   rad := theta * pi / 180
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
   { This puts a pixel on the screen by writing directly to memory. }
 asm
    mov  ax,where
    mov  es,ax
    mov  bx,[y]
    shl  bx,1
    mov  di,word ptr [Scr_Ofs + bx]
    add  di,[x]
    mov  al,[col]
    mov  es:[di],al
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Function Getpixel (X,Y : Integer; where:word):byte; assembler;
   { This puts a pixel on the screen by writing directly to memory. }
 asm
    mov  ax,where
    mov  es,ax
    mov  bx,[y]
    shl  bx,1
    mov  di,word ptr [Scr_Ofs + bx]
    add  di,[x]
    mov  al,es:[di]
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
   { This loads the cel 'filename' into the pointer scrptr }
 var
   Fil : file;
   Buf : array [1..1024] of byte;
   BlocksRead, Count : word;
 begin
   assign (Fil, FileName);
   reset (Fil, 1);
   BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
   Count := 0;
   BlocksRead := $FFFF;
   while (not eof (Fil)) and (BlocksRead <> 0) do begin
     BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
     Count := Count + 1024;
   end;
   close (Fil);
 end;

 procedure LoadPal (FileName : string);
 var
   F:file;
   loop1:integer;
   pall:array[0..255,1..3] of byte;
 begin
   assign (F, FileName);
   reset (F,1);
   blockread (F, pall,768);
   close (F);
   for loop1 := 0 to 255 do
     Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
 end;

 VAR Loop1:integer;

 BEGIN
   For Loop1 := 0 to 199 do
     Scr_Ofs[Loop1] := Loop1 * 320;
 END.

 [BACK] Back

Discuss this article in the forums


Date this article was posted to GameDev.net: 7/16/1999
(Note that this date does not necessarily correspond to the date the article was written)

See Also:
Denthor's Asphyxia Tutorials

© 1999-2011 Gamedev.net. All rights reserved. Terms of Use Privacy Policy
Comments? Questions? Feedback? Click here!