Mode-X Scrolling

                    ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸
                    ³         W E L C O M E         ³
                    ³  To the VGA Trainer Program   ³ ³
                    ³              By               ³ ³
                    ³      DENTHOR of ASPHYXIA      ³ ³ ³
                    ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ; ³ ³
                      ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
                        ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

                            --==[ PART 12 ]==--

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 þ Introduction

 Hello! :-)

 Well, a lot has happened since the last trainer, which is the reason for
 the amazingly long delay. First, the elections. These were quite easy
 actually, I went and watched a move (Demolition Man) (Election day
 special, all movies R2, which is about 50 US cents), then went and voted
 after most voters had gone home, so no long lines ;-). Soon after were
 exams. These did not go too well, and I am not looking forward to the
 results. Finally, I got measles and pneumonia at the same time and was
 sent off to hospital for a few days. All in all, not events which are
 conducive to coding! This has meant that the trainer has been delayed,
 and ASPHYXIA was not able to enter into the local democompo, Dexterity
 '94, which we were hoping to do well in. Oh well, onward and upward!

 This trainer is on full screen scrolling in Chain-4, by request. This is
 actually very easy to do (and smooth), and holds a lot of potential, as
 I am sure you can immediately imagine.

 A few more things : People have been saying they have had hassles
 sending me email, and I have found that this is because they forget the
 numbers in my name. They send mail to smith@batis... which does not
 exist, or smith@beastie... which is my brothers account. He is getting a
 bit sick of forwarding my mail to me ;). The two address are :
        smith9@batis.bis.und.ac.za
        smith0@beastie.cs.und.ac.za

 I have lost about 200k worth of email, chalk it up to my beginner status
 at Unix. The test to see if your mail got through? I have answered
 _every_ email message sent to me (no easy task), so if you haven't got a
 reply, please resend the message.

 You can now also send a group message to all members of Asphyxia. Just
 send mail to asphyxia@beastie.cs.und.ac.za and we will all get a copy
 ... which could mean numerous replies to one querey ;)

 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 Denthor, EzE, Goth, Fubar or Nobody on Connectix.
             3) Write to :  Grant Smith
                            P.O.Box 270 Kloof
                            3640
                            Natal
                            South Africa
             4) 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 ;-))
             5) Write to smith9@batis.bis.und.ac.za in E-Mail.
             6) Write to asphyxia@beastie.cs.und.ac.za

 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!

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 þ  What is full screen scrolling?

 I seem to recall doing this in a previous tut, but here goes again! Full
 screen scrolling is when the entire screen moves in a particular
 direction, with the new picture scrolling on to the screen. Um. Think of
 movie credits. The screen, filled with text, is scrolled off the top of
 the screen while the new text is scrolled on from the bottom. This is
 full screen scrolling.

 Full screen scrolling is not limited to movie credits. Games like Raptor
 have you flying over a scrolling landscape while you are shooting down
 the bad guys. In this tutorial we will be doing vertical scrolling, but
 the code can very easily be altered for horizontal scrolling too.

 Remember that we will be using Chain-4 to do our scrolling, so you may
 want to brush up on tut 10 in which that was covered. I will assume a
 brief knowledge of how chain-4 works for this tutorial.

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 þ  The theory

 The theory behind full screen scrolling in Chain-4 is acually very
 simple.

 Picture if you will, a screen that is two monitors high. Chain-4
 actually has four, but for this we only need two. Now, for this screen
 that is two monitors high, we can only see one monitors worth. Here it
 is in ASCII

     +-------------+  Screen two monitors high
     |             |
     |             |
     |             |
     |             |
     |+-----------+|
     ||           ||
     ||           ||<- This is the bit we can see, one monitors worth
     ||           ||
     |+-----------+|
     +-------------+

 We can move the bit we can see up or down the enlarged screen. So, for
 example, if the screen two monitors high had a picture on it, we could
 move the bit we see up and down to try glimpse the entire picture. Think
 of it in this way : The screen is a large painting, but we can only see
 though a small magnifing glass. We can move this magnifing glass around
 the painting, but can never see the painting all at once.

 This actually works in our favour. Anything done outside the bit we are
 looking through cannot be seen, so we can do our work without changing
 our screen.

 On to scrolling. The method we will use this time is as follows :

 1) Draw the next line to be seen just above and just below the part we
    can see.

       +------------+ The enlarged screen
       |            |
       |            |
       |111111111111|  The new part of the picture
       |+----------+|
       ||          || The bit we can see
       |+----------+|
       |111111111111|  The new part of the picture
       +------------+

 2) Move the view up one pixel so that the new part of the picture is
    visible at the top of the screen.

 3) Repeat Steps 1) and 2) until the whole screen is filled. Our screen
    will look as follows :

      +---------------+
      |+-------------+|
      ||3333333333333||
      ||2222222222222|| Viewscreen
      ||1111111111111||
      |+-------------+|
      |333333333333333|
      |222222222222222|
      |111111111111111|
      +---------------+

 Check this picture with steps 1) and 2), you will see that this is
 correct.

 4) Set our viewport to the bottom of the enlarged screen.

      +---------------+
      |333333333333333|
      |222222222222222|
      |111111111111111|
      |+-------------+|
      ||3333333333333||
      ||2222222222222|| New position of viewscreen
      ||1111111111111||
      |+-------------+|
      +---------------+

 As you can see, the bit we will be looking at is exactly the same as
 before, we are now just at the bottom of the larger screen instead of
 the top!

 5) Jump back to 1). The entire sequence can begin again, and we can have
    infinate scrolling in the upward direction. Clever huh?

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 þ  Our code

 In the sample code, we have 21 different icons. What we do is decide
 what the next row of icons is going to consist of. We then draw the next
 line of pixels above and below the viewscreen according to what icons we
 are displaying. We then scroll up one pixel and begin again. When we
 have completed a row of icons, we randomly select a new row and begin
 again. Our icons are 16x16, so exactly 20 fit across a 320 pixel screen.

 When we hit the top of our enlarged screen, we flip down to the bottom
 which looks exactly the same as the screen we have left. In this manner
 we have obtained smooth, infinate full screen scrolling!

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 þ  Extra bits

 As you will see from the code, it would be the work of but a few minutes
 to extend our landscape across the two unused screens, thereby allowing
 limited horizontal movement along with our vertical movement. In fact,
 the entire routine could easily be made to be a horizontal scrolling
 routine.

 A map of sorts could be generated, with one byte equalling one terrain
 type. In this manner, the terrain scrolled over could be set, as in a
 flying game (Flying Shark, Raptor etc). The terrain could also easily be
 replaced with letters for our movie-style credits.

 Free direction scrolling, ie scrolling in all directions, is a very
 different matter, with very different methods to get it to work. Perhaps
 this will be discussed in a later trainer. But for now, work with this,
 know it, understand it, and think up many great things to do with it!
 How about a full screen text scrolly? A game? Go wild!

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

 Well, I hope you enjoyed this, the latest trainer. The sample program is
 a little short, but that is because the concept is so simple. Attached
 is a file, PICCS.DAT, which contains the terrain and letters for the
 sample program. They were .CEL's, which I loaded into the des^ variable,
 which I then dumped to disk, for easy access later. The .CEL's were
 drawn on short notice, but still produces some nice terrain.

 I have recieved a few requests for future trainers, and most of them are
 for effects, so I guess that is what will be done from now on. A
 surprising number have told me not to do a sound trainer and stick with
 graphics stuff, with only a few asking for sound stuff, so I will hold
 off on that until there is more of a demand.

 I am still open to suggestions for future trainers, and of course
 suggestions for improving the series. Leave me mail!

 Hmm. A quote? Okay, let me think ....

         [    The little devil sat atop the alpine slopes, frolicking in the
            snow.  He threw a snowball at a nearby squirrel, which
            missed. The resulting avalance buried two villages and a ski
            resort.
              The little devil was scared. Avalances were bad for
            business. The locals would form team spirit, be nice to
            each other and work together and free those trapped beneath
            the snow, which created even more goodwill. The man
            downstairs didn't like goodwill. He didn't like it at
            all.
              In the blink of an eye the devil was in his penthouse
            apartment, dressed in his usual suit. He picked up the phone.
            Dialing was for mortals.
              "Hello, Micros..."
              "This is Mister Crowley", interrupted the devil.
              There were sounds of thumping on the other side of the
            phone, then there was a new voice. "Hello, Bill here, we
            haven't heard from you in a while, Mister Crowley." The fear
            of the man on the other end was almost tangible. The devil
            smiled.
              "Hello Bill. Something has come up."
              "No!" The man on the other side almost shouted with terror.
            "Not Win..."
              "Yes, Bill. It is time."
              "Havn't I paid enough for my sins? Just that one night..."
            The man was almost sobbing.
              "You are touching me, Bill. But nevertheless, it is time."
              "No." The man sounded beaten, alone.
              "Yes. Bill, it is time for a new update."
                                                                        ]
                                                       - Grant Smith
                                                           14:23
                                                             23-7-94

 See you next time!
   - 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  º
 ºConnectix BBS             º+27-31-266-9992 ºALL  º
 ºPOP!                      º+27-12-661-1257 ºALL  º
 ºPure Surf BBS             º+27-31-561-5943 ºA/H  º
 ºSoul Asylum               º+358-0-5055041  ºALL  º
 ºWasted Image              º407-838-4525    ºALL  º
 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍͼ

 Leave me mail if you want to become an official Asphyxia BBS
 distribution site.

 Unit GFX2;

 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}

 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 }

 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,[X]
   mov     dx,[Y]
   mov     di,bx
   mov     bx, dx                  {; bx = dx}
   shl     dx, 8
   shl     bx, 6
   add     dx, bx                  {; dx = dx + bx (ie y*320)}
   add     di, dx                  {; finalise location}
   mov     al, [Col]
   stosb
 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,[X]
   mov     dx,[Y]
   mov     di,bx
   mov     bx, dx                  {; bx = dx}
   shl     dx, 8
   shl     bx, 6
   add     dx, bx                  {; dx = dx + bx (ie y*320)}
   add     di, dx                  {; finalise location}
   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;

 BEGIN
 END.{$X+}
 Uses Crt,GFX2;

 Const Size : Byte = 80;      { Size =  40 = 1 across, 4 down }
                              { Size =  80 = 2 across, 2 down }
                              { Size = 160 = 4 across, 1 down }

 Type Icon = Array [1..256] of byte;
      Terrain = Array [1..21] of Icon;  {base 8 are desert, top 13 are letters }

 VAR des : ^Terrain;       { Desert}

 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 Procedure InitChain4; ASSEMBLER;
   {  This procedure gets you into Chain 4 mode }
 Asm
     mov    ax, 13h
     int    10h         { Get into MCGA Mode }

     mov    dx, 3c4h    { Port 3c4h = Sequencer Address Register }
     mov    al, 4       { Index 4 = memory mode }
     out    dx, al
     inc    dx          { Port 3c5h ... here we set the mem mode }
     in     al, dx
     and    al, not 08h
     or     al, 04h
     out    dx, al
     mov    dx, 3ceh
     mov    al, 5
     out    dx, al
     inc    dx
     in     al, dx
     and    al, not 10h
     out    dx, al
     dec    dx
     mov    al, 6
     out    dx, al
     inc    dx
     in     al, dx
     and    al, not 02h
     out    dx, al
     mov    dx, 3c4h
     mov    ax, (0fh shl 8) + 2
     out    dx, ax
     mov    ax, 0a000h
     mov    es, ax
     sub    di, di
     mov    ax, 0000h {8080h}
     mov    cx, 32768
     cld
     rep    stosw            { Clear garbage off the screen ... }

     mov    dx, 3d4h
     mov    al, 14h
     out    dx, al
     inc    dx
     in     al, dx
     and    al, not 40h
     out    dx, al
     dec    dx
     mov    al, 17h
     out    dx, al
     inc    dx
     in     al, dx
     or     al, 40h
     out    dx, al

     mov    dx, 3d4h
     mov    al, 13h
     out    dx, al
     inc    dx
     mov    al, [Size]      { Size * 8 = Pixels across. Only 320 are visible}
     out    dx, al
 End;

 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 Procedure C4PutPixel(X,Y : Word; Col : Byte); ASSEMBLER;
   { This puts a pixel on the chain 4 screen }
 Asm
     mov    ax,[y]
     xor    bx,bx
     mov    bl,[size]
     imul   bx
     shl    ax,1
     mov    bx,ax
     mov    ax, [X]
     mov    cx, ax
     shr    ax, 2
     add    bx, ax
     and    cx, 00000011b
     mov    ah, 1
     shl    ah, cl
     mov    dx, 3c4h                  { Sequencer Register    }
     mov    al, 2                     { Map Mask Index        }
     out    dx, ax

     mov    ax, 0a000h
     mov    es, ax
     mov    al, [col]
     mov    es: [bx], al
 End;

 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 Procedure Plane(Which : Byte); ASSEMBLER;
   { This sets the plane to write to in Chain 4}
 Asm
    mov     al, 2h
    mov     ah, 1
    mov     cl, [Which]
    shl     ah, cl
    mov     dx, 3c4h                  { Sequencer Register    }
    out     dx, ax
 End;

 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 procedure moveto(x, y : word);
   { This moves to position x*4,y on a chain 4 screen }
 var o : word;
 begin
   o := y*size*2+x;
   asm
     mov    bx, [o]
     mov    ah, bh
     mov    al, 0ch

     mov    dx, 3d4h
     out    dx, ax

     mov    ah, bl
     mov    al, 0dh
     mov    dx, 3d4h
     out    dx, ax
   end;
 end;

 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 procedure LoadPal (FileName : string);
   { This loads .col file and sets the pallette }
 type
   DACType = array [0..255,1..3] of byte;
 var
   DAC : DACType;
   Fil : file of DACType;
   I : integer;
 begin
   assign (Fil, FileName);
   reset (Fil);
   read (Fil, DAC);
   close (Fil);
   for I := 0 to 255 do
     pal (i,dac[i,1],dac[i,2],dac[i,3]);
 end;

 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 Procedure Init;
   { We get our memory and load the graphics here }
 VAR f:file;
 BEGIN
   Getmem (des,sizeof (des^));
   assign (f,'piccs.dat');
   reset (f,1);
   blockread (f,des^,sizeof(des^));
   close (f);
   loadpal ('pallette.col');
 END;

 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 Procedure Play;
   { Our main procedure }
 CONST sAsp : Array [0..19] of byte =
 (1,3,2,4,5,3,9,10,11,12,13,14,15,9,7,4,5,2,1,4);   { Data for 'ASPHYXIA' }
       sVGA : Array [0..19] of byte =
 (4,7,1,2,4,5,8,3,16,17,9,5,6,2,5,8,6,2,5,7);       { Data for 'VGA' }
       sTra : Array [0..19] of byte =
 (2,5,8,2,1,6,18,19,9,15,20,21,19,7,2,4,1,8,3,4);   { Data for 'TRAINER' }

 Var loop1,loop2:integer;
     depth,farin:integer;
     what:array[0..19] of byte;
     count:integer;
 Begin
    MoveTo(0,200); { This moves the view to the left hand corner }
    depth:=200;    { This is our y for our viewport }
    farin:=15;     { This is how far in to the icon we have drawn }
    count:=0;      { This is for when the write ASPHYXIA VGA TRAINER }
    for loop1:=0 to 19 do what[loop1]:=random (8)+1;
         { This sets a random row of desert icons }
    Repeat
      for loop1:=0 to 19 do
        for loop2:=0 to 15 do BEGIN
          c4putpixel (loop1*16+loop2,depth,des^[what[loop1],farin*16+loop2+1]);
          c4putpixel (loop1*16+loop2,depth+201,des^[what[loop1],farin*16+loop2+1]);
        END;
         { This draws the two rows of pixels, above and below the viewport }
      depth:=depth-1; { This moves our viewport up one pixel }
      farin:=farin-1; { This moves us to the next row in our icons }
      if depth=-1 then depth:=200; {We have hit the top, jump to the bottom }
      if farin=-1 then BEGIN { We have finished our row of icons }
        farin:=15;
        for loop1:=0 to 19 do what[loop1]:=random (8)+1;
          { This sets a random row of desert icons }
        inc (count);
        if count=24 then for loop1:=0 to 19 do what[loop1]:=sasp[loop1];
        if count=22 then for loop1:=0 to 19 do what[loop1]:=svga[loop1];
        if count=20 then for loop1:=0 to 19 do what[loop1]:=stra[loop1];
        if count=50 then count:=0;
      END;
      waitretrace;
      moveto(0,depth);
    Until keypressed;
    Readkey;
 End;

 BEGIN
   clrscr;
   Writeln ('Hello! After a long absence, here is the latest installment of the');
   Writeln ('ASPHYXIA VGA Trainer! This one, by popular demand, is on full screen');
   WRiteln ('scrolling in Chain-4. This isn''t very interactive, just hit any key');
   Writeln ('and a random landscape will scroll by for infinity, with the letters');
   Writeln ('ASPHYXIA VGA TRAINER scrolling passed at set intervals. You will notice');
   Writeln ('that two of our four pages are untouched. These could be put to good');
   Writeln ('use in for example a game etc.');
   Writeln;
   Writeln ('This code could easily be altered to produce a movie-credits type');
   Writeln ('sequence, a large game-map and so on. Have fun with it and see what');
   Writeln ('you can come up with! All desert art is done by Pieter Buys (Fubar), may');
   Writeln ('I add on very short notice by my request. The font was, I think, ripped,');
   Writeln ('I found it lying about on my hard drive.');
   Writeln;
   Writeln ('The code is very easy to follow and you should have it doing what you want');
   Writeln ('in no time.');
   writeln;
   writeln;
   Write ('  Hit any key to contine ...');
   Readkey;
   initChain4;
   init;
   play;
   Freemem (des,sizeof (des^));
   SetText;
   Writeln ('All done. This concludes the twelfth 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 am also an avid');
   Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
   Writeln ('    smith9@batis.bis.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.

 [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!