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 58ºALL º º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
See Also: © 1999-2011 Gamedev.net. All rights reserved. Terms of Use Privacy Policy
|