home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / TUT12.ZIP / TUTPRO12.PAS < prev   
Pascal/Delphi Source File  |  1994-07-22  |  8KB  |  264 lines
  1. {$X+}
  2. Uses Crt,GFX2;
  3.  
  4. Const Size : Byte = 80;      { Size =  40 = 1 across, 4 down }
  5.                              { Size =  80 = 2 across, 2 down }
  6.                              { Size = 160 = 4 across, 1 down }
  7.  
  8. Type Icon = Array [1..256] of byte;
  9.      Terrain = Array [1..21] of Icon;  {base 8 are desert, top 13 are letters }
  10.  
  11. VAR des : ^Terrain;       { Desert}
  12.  
  13.  
  14. {──────────────────────────────────────────────────────────────────────────}
  15. Procedure InitChain4; ASSEMBLER;
  16.   {  This procedure gets you into Chain 4 mode }
  17. Asm
  18.     mov    ax, 13h
  19.     int    10h         { Get into MCGA Mode }
  20.  
  21.     mov    dx, 3c4h    { Port 3c4h = Sequencer Address Register }
  22.     mov    al, 4       { Index 4 = memory mode }
  23.     out    dx, al
  24.     inc    dx          { Port 3c5h ... here we set the mem mode }
  25.     in     al, dx
  26.     and    al, not 08h
  27.     or     al, 04h
  28.     out    dx, al
  29.     mov    dx, 3ceh
  30.     mov    al, 5
  31.     out    dx, al
  32.     inc    dx
  33.     in     al, dx
  34.     and    al, not 10h
  35.     out    dx, al
  36.     dec    dx
  37.     mov    al, 6
  38.     out    dx, al
  39.     inc    dx
  40.     in     al, dx
  41.     and    al, not 02h
  42.     out    dx, al
  43.     mov    dx, 3c4h
  44.     mov    ax, (0fh shl 8) + 2
  45.     out    dx, ax
  46.     mov    ax, 0a000h
  47.     mov    es, ax
  48.     sub    di, di
  49.     mov    ax, 0000h {8080h}
  50.     mov    cx, 32768
  51.     cld
  52.     rep    stosw            { Clear garbage off the screen ... }
  53.  
  54.     mov    dx, 3d4h
  55.     mov    al, 14h
  56.     out    dx, al
  57.     inc    dx
  58.     in     al, dx
  59.     and    al, not 40h
  60.     out    dx, al
  61.     dec    dx
  62.     mov    al, 17h
  63.     out    dx, al
  64.     inc    dx
  65.     in     al, dx
  66.     or     al, 40h
  67.     out    dx, al
  68.  
  69.     mov    dx, 3d4h
  70.     mov    al, 13h
  71.     out    dx, al
  72.     inc    dx
  73.     mov    al, [Size]      { Size * 8 = Pixels across. Only 320 are visible}
  74.     out    dx, al
  75. End;
  76.  
  77.  
  78. {──────────────────────────────────────────────────────────────────────────}
  79. Procedure C4PutPixel(X,Y : Word; Col : Byte); ASSEMBLER;
  80.   { This puts a pixel on the chain 4 screen }
  81. Asm
  82.     mov    ax,[y]
  83.     xor    bx,bx
  84.     mov    bl,[size]
  85.     imul   bx
  86.     shl    ax,1
  87.     mov    bx,ax
  88.     mov    ax, [X]
  89.     mov    cx, ax
  90.     shr    ax, 2
  91.     add    bx, ax
  92.     and    cx, 00000011b
  93.     mov    ah, 1
  94.     shl    ah, cl
  95.     mov    dx, 3c4h                  { Sequencer Register    }
  96.     mov    al, 2                     { Map Mask Index        }
  97.     out    dx, ax
  98.  
  99.     mov    ax, 0a000h
  100.     mov    es, ax
  101.     mov    al, [col]
  102.     mov    es: [bx], al
  103. End;
  104.  
  105. {──────────────────────────────────────────────────────────────────────────}
  106. Procedure Plane(Which : Byte); ASSEMBLER;
  107.   { This sets the plane to write to in Chain 4}
  108. Asm
  109.    mov     al, 2h
  110.    mov     ah, 1
  111.    mov     cl, [Which]
  112.    shl     ah, cl
  113.    mov     dx, 3c4h                  { Sequencer Register    }
  114.    out     dx, ax
  115. End;
  116.  
  117.  
  118. {──────────────────────────────────────────────────────────────────────────}
  119. procedure moveto(x, y : word);
  120.   { This moves to position x*4,y on a chain 4 screen }
  121. var o : word;
  122. begin
  123.   o := y*size*2+x;
  124.   asm
  125.     mov    bx, [o]
  126.     mov    ah, bh
  127.     mov    al, 0ch
  128.  
  129.     mov    dx, 3d4h
  130.     out    dx, ax
  131.  
  132.     mov    ah, bl
  133.     mov    al, 0dh
  134.     mov    dx, 3d4h
  135.     out    dx, ax
  136.   end;
  137. end;
  138.  
  139.  
  140. {──────────────────────────────────────────────────────────────────────────}
  141. procedure LoadPal (FileName : string);
  142.   { This loads .col file and sets the pallette }
  143. type
  144.   DACType = array [0..255,1..3] of byte;
  145. var
  146.   DAC : DACType;
  147.   Fil : file of DACType;
  148.   I : integer;
  149. begin
  150.   assign (Fil, FileName);
  151.   reset (Fil);
  152.   read (Fil, DAC);
  153.   close (Fil);
  154.   for I := 0 to 255 do
  155.     pal (i,dac[i,1],dac[i,2],dac[i,3]);
  156. end;
  157.  
  158.  
  159. {──────────────────────────────────────────────────────────────────────────}
  160. Procedure Init;
  161.   { We get our memory and load the graphics here }
  162. VAR f:file;
  163. BEGIN
  164.   Getmem (des,sizeof (des^));
  165.   assign (f,'piccs.dat');
  166.   reset (f,1);
  167.   blockread (f,des^,sizeof(des^));
  168.   close (f);
  169.   loadpal ('pallette.col');
  170. END;
  171.  
  172.  
  173. {──────────────────────────────────────────────────────────────────────────}
  174. Procedure Play;
  175.   { Our main procedure }
  176. CONST sAsp : Array [0..19] of byte =
  177. (1,3,2,4,5,3,9,10,11,12,13,14,15,9,7,4,5,2,1,4);   { Data for 'ASPHYXIA' }
  178.       sVGA : Array [0..19] of byte =
  179. (4,7,1,2,4,5,8,3,16,17,9,5,6,2,5,8,6,2,5,7);       { Data for 'VGA' }
  180.       sTra : Array [0..19] of byte =
  181. (2,5,8,2,1,6,18,19,9,15,20,21,19,7,2,4,1,8,3,4);   { Data for 'TRAINER' }
  182.  
  183. Var loop1,loop2:integer;
  184.     depth,farin:integer;
  185.     what:array[0..19] of byte;
  186.     count:integer;
  187. Begin
  188.    MoveTo(0,200); { This moves the view to the left hand corner }
  189.    depth:=200;    { This is our y for our viewport }
  190.    farin:=15;     { This is how far in to the icon we have drawn }
  191.    count:=0;      { This is for when the write ASPHYXIA VGA TRAINER }
  192.    for loop1:=0 to 19 do what[loop1]:=random (8)+1;
  193.         { This sets a random row of desert icons }
  194.    Repeat
  195.      for loop1:=0 to 19 do
  196.        for loop2:=0 to 15 do BEGIN
  197.          c4putpixel (loop1*16+loop2,depth,des^[what[loop1],farin*16+loop2+1]);
  198.          c4putpixel (loop1*16+loop2,depth+201,des^[what[loop1],farin*16+loop2+1]);
  199.        END;
  200.         { This draws the two rows of pixels, above and below the viewport }
  201.      depth:=depth-1; { This moves our viewport up one pixel }
  202.      farin:=farin-1; { This moves us to the next row in our icons }
  203.      if depth=-1 then depth:=200; {We have hit the top, jump to the bottom }
  204.      if farin=-1 then BEGIN { We have finished our row of icons }
  205.        farin:=15;
  206.        for loop1:=0 to 19 do what[loop1]:=random (8)+1;
  207.          { This sets a random row of desert icons }
  208.        inc (count);
  209.        if count=24 then for loop1:=0 to 19 do what[loop1]:=sasp[loop1];
  210.        if count=22 then for loop1:=0 to 19 do what[loop1]:=svga[loop1];
  211.        if count=20 then for loop1:=0 to 19 do what[loop1]:=stra[loop1];
  212.        if count=50 then count:=0;
  213.      END;
  214.      waitretrace;
  215.      moveto(0,depth);
  216.    Until keypressed;
  217.    Readkey;
  218. End;
  219.  
  220.  
  221. BEGIN
  222.   clrscr;
  223.   Writeln ('Hello! After a long absence, here is the latest installment of the');
  224.   Writeln ('ASPHYXIA VGA Trainer! This one, by popular demand, is on full screen');
  225.   WRiteln ('scrolling in Chain-4. This isn''t very interactive, just hit any key');
  226.   Writeln ('and a random landscape will scroll by for infinity, with the letters');
  227.   Writeln ('ASPHYXIA VGA TRAINER scrolling passed at set intervals. You will notice');
  228.   Writeln ('that two of our four pages are untouched. These could be put to good');
  229.   Writeln ('use in for example a game etc.');
  230.   Writeln;
  231.   Writeln ('This code could easily be altered to produce a movie-credits type');
  232.   Writeln ('sequence, a large game-map and so on. Have fun with it and see what');
  233.   Writeln ('you can come up with! All desert art is done by Pieter Buys (Fubar), may');
  234.   Writeln ('I add on very short notice by my request. The font was, I think, ripped,');
  235.   Writeln ('I found it lying about on my hard drive.');
  236.   Writeln;
  237.   Writeln ('The code is very easy to follow and you should have it doing what you want');
  238.   Writeln ('in no time.');
  239.   writeln;
  240.   writeln;
  241.   Write ('  Hit any key to contine ...');
  242.   Readkey;
  243.   initChain4;
  244.   init;
  245.   play;
  246.   Freemem (des,sizeof (des^));
  247.   SetText;
  248.   Writeln ('All done. This concludes the twelfth sample program in the ASPHYXIA');
  249.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  250.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  251.   Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
  252.   Writeln ('    smith9@batis.bis.und.ac.za');
  253.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  254.   Writeln ('             Grant Smith');
  255.   Writeln ('             P.O. Box 270');
  256.   Writeln ('             Kloof');
  257.   Writeln ('             3640');
  258.   Writeln ('             Natal');
  259.   Writeln ('             South Africa');
  260.   Writeln ('I hope to hear from you soon!');
  261.   Writeln; Writeln;
  262.   Write   ('Hit any key to exit ...');
  263.   Readkey;
  264. END.