home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / TUT10.ZIP / TUTPRO10.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-05  |  8.3 KB  |  248 lines
  1. Uses Crt,GFX;
  2.  
  3. Const Size : Byte = 80;      { Size =  40 = 1 across, 4 down }
  4.                              { Size =  80 = 2 across, 2 down }
  5.                              { Size = 160 = 4 across, 1 down }
  6.  
  7.       bit : Array [1..897] of byte = (
  8. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,33,2,151,5,149,6,148,7,147,8,49,2,95,8,49,
  9. 4,93,9,49,3,93,4,2,3,49,4,92,4,3,3,48,4,92,4,3,4,48,4,91,4,4,3,48,4,92,4,3,4,
  10. 48,3,58,2,32,4,4,4,47,4,57,3,31,4,5,3,48,3,57,4,30,4,5,4,47,3,57,5,29,4,6,4,46,
  11. 4,57,4,29,4,7,3,47,3,58,2,30,4,7,4,46,4,90,4,7,4,46,3,90,4,8,4,27,2,16,3,90,4,
  12. 8,9,22,3,16,3,89,4,5,13,8,6,8,3,15,3,90,4,2,15,6,10,6,3,16,3,6,1,21,1,9,2,7,1,
  13. 21,6,14,18,9,5,2,4,5,4,1,4,10,3,4,5,10,2,7,3,8,2,5,3,9,3,7,8,13,13,1,4,9,4,5,3,
  14. 5,3,1,6,9,3,3,6,9,4,5,4,8,3,3,4,9,3,6,9,11,10,6,4,8,4,6,3,4,11,8,3,2,7,9,5,4,4,
  15. 9,3,2,4,9,3,6,4,4,2,8,10,9,4,7,4,6,3,5,5,3,3,8,3,1,8,8,5,4,5,8,3,3,3,9,4,5,4,5,
  16. 2,5,10,12,4,7,3,5,5,4,5,4,3,7,3,1,4,1,3,9,4,5,4,9,3,2,3,10,3,6,3,5,3,4,10,13,3,
  17. 8,3,2,7,5,4,5,3,7,7,1,3,9,4,5,5,9,3,1,3,10,3,6,3,5,4,4,5,1,4,12,4,8,3,2,5,6,4,
  18. 5,4,6,6,2,4,8,4,5,5,10,6,10,4,5,4,5,3,5,2,3,4,13,4,8,3,3,1,9,3,6,3,7,5,3,3,5,1,
  19. 3,3,5,5,4,2,5,5,11,3,6,3,5,4,10,3,14,4,8,3,12,3,6,4,6,5,3,3,5,2,2,4,4,6,4,2,5,
  20. 5,6,1,3,4,5,3,6,3,10,4,14,4,5,1,2,4,11,3,6,3,7,5,3,3,4,3,1,4,4,6,4,3,5,4,6,2,3,
  21. 3,6,3,5,4,9,4,15,3,5,2,3,4,9,3,6,4,7,4,3,3,5,2,2,3,4,7,3,3,6,3,6,3,2,4,5,4,5,3,
  22. 10,3,15,4,4,3,4,3,9,3,6,3,7,4,4,3,4,3,1,4,3,3,1,3,3,3,6,4,6,2,3,3,6,3,5,4,9,4,
  23. 15,4,4,3,4,4,7,3,6,4,7,4,3,3,4,3,2,3,3,3,2,3,2,4,5,5,5,3,2,4,6,3,5,4,8,4,16,4,
  24. 4,2,6,3,7,3,5,4,7,4,4,3,3,3,3,8,2,3,2,4,5,6,4,3,3,3,7,3,4,5,8,4,16,4,4,2,6,3,6,
  25. 3,5,4,8,3,5,8,3,9,2,3,1,4,6,6,3,3,4,3,7,3,3,6,7,4,17,4,4,3,5,3,6,3,4,4,9,3,5,8,
  26. 3,7,3,8,6,3,1,4,1,4,3,4,7,3,2,3,1,3,7,4,17,4,4,3,5,3,5,11,9,3,6,7,4,6,4,7,6,3,
  27. 2,8,4,3,8,7,2,3,6,4,18,3,5,4,3,4,5,10,10,3,6,6,6,4,4,6,7,3,4,6,5,3,8,7,2,4,4,4,
  28. 19,3,5,10,5,3,1,6,11,3,7,3,16,5,7,4,4,5,6,3,8,6,3,5,3,4,19,3,6,9,5,3,18,2,25,5,
  29. 9,3,6,3,7,2,10,3,6,4,3,3,20,3,8,5,6,3,44,6,10,2,39,3,3,2,22,2,19,3,43,7,101,3,
  30. 42,8,102,3,41,4,1,4,101,4,39,5,2,3,102,3,39,4,4,3,102,3,38,4,4,4,101,3,38,4,5,
  31. 3,102,3,37,4,5,4,101,4,36,4,6,3,102,3,37,3,6,4,102,3,36,4,6,3,102,3,37,3,6,3,
  32. 103,3,37,3,5,4,102,4,37,3,4,4,103,3,38,10,104,3,38,9,105,2,40,7,106,2,41,4,0);
  33.  
  34.  
  35. {──────────────────────────────────────────────────────────────────────────}
  36. Procedure InitChain4; ASSEMBLER;
  37.   {  This procedure gets you into Chain 4 mode }
  38. Asm
  39.     mov    ax, 13h
  40.     int    10h         { Get into MCGA Mode }
  41.  
  42.     mov    dx, 3c4h    { Port 3c4h = Sequencer Address Register }
  43.     mov    al, 4       { Index 4 = memory mode }
  44.     out    dx, al
  45.     inc    dx          { Port 3c5h ... here we set the mem mode }
  46.     in     al, dx
  47.     and    al, not 08h
  48.     or     al, 04h
  49.     out    dx, al
  50.     mov    dx, 3ceh
  51.     mov    al, 5
  52.     out    dx, al
  53.     inc    dx
  54.     in     al, dx
  55.     and    al, not 10h
  56.     out    dx, al
  57.     dec    dx
  58.     mov    al, 6
  59.     out    dx, al
  60.     inc    dx
  61.     in     al, dx
  62.     and    al, not 02h
  63.     out    dx, al
  64.     mov    dx, 3c4h
  65.     mov    ax, (0fh shl 8) + 2
  66.     out    dx, ax
  67.     mov    ax, 0a000h
  68.     mov    es, ax
  69.     sub    di, di
  70.     mov    ax, 0000h {8080h}
  71.     mov    cx, 32768
  72.     cld
  73.     rep    stosw            { Clear garbage off the screen ... }
  74.  
  75.     mov    dx, 3d4h
  76.     mov    al, 14h
  77.     out    dx, al
  78.     inc    dx
  79.     in     al, dx
  80.     and    al, not 40h
  81.     out    dx, al
  82.     dec    dx
  83.     mov    al, 17h
  84.     out    dx, al
  85.     inc    dx
  86.     in     al, dx
  87.     or     al, 40h
  88.     out    dx, al
  89.  
  90.     mov    dx, 3d4h
  91.     mov    al, 13h
  92.     out    dx, al
  93.     inc    dx
  94.     mov    al, [Size]      { Size * 8 = Pixels across. Only 320 are visible}
  95.     out    dx, al
  96. End;
  97.  
  98.  
  99. {──────────────────────────────────────────────────────────────────────────}
  100. Procedure C4PutPixel(X,Y : Word; Col : Byte); ASSEMBLER;
  101.   { This puts a pixel on the chain 4 screen }
  102. Asm
  103.     mov    ax,[y]
  104.     xor    bx,bx
  105.     mov    bl,[size]
  106.     imul   bx
  107.     shl    ax,1
  108.     mov    bx,ax
  109.     mov    ax, [X]
  110.     mov    cx, ax
  111.     shr    ax, 2
  112.     add    bx, ax
  113.     and    cx, 00000011b
  114.     mov    ah, 1
  115.     shl    ah, cl
  116.     mov    dx, 3c4h                  { Sequencer Register    }
  117.     mov    al, 2                     { Map Mask Index        }
  118.     out    dx, ax
  119.  
  120.     mov    ax, 0a000h
  121.     mov    es, ax
  122.     mov    al, [col]
  123.     mov    es: [bx], al
  124. End;
  125.  
  126. {──────────────────────────────────────────────────────────────────────────}
  127. Procedure Plane(Which : Byte); ASSEMBLER;
  128.   { This sets the plane to write to in Chain 4}
  129. Asm
  130.    mov     al, 2h
  131.    mov     ah, 1
  132.    mov     cl, [Which]
  133.    shl     ah, cl
  134.    mov     dx, 3c4h                  { Sequencer Register    }
  135.    out     dx, ax
  136. End;
  137.  
  138.  
  139. {──────────────────────────────────────────────────────────────────────────}
  140. procedure moveto(x, y : word);
  141.   { This moves to position x*4,y on a chain 4 screen }
  142. var o : word;
  143. begin
  144.   o := y*size*2+x;
  145.   asm
  146.     mov    bx, [o]
  147.     mov    ah, bh
  148.     mov    al, 0ch
  149.  
  150.     mov    dx, 3d4h
  151.     out    dx, ax
  152.  
  153.     mov    ah, bl
  154.     mov    al, 0dh
  155.     mov    dx, 3d4h
  156.     out    dx, ax
  157.   end;
  158. end;
  159.  
  160.  
  161.  
  162. {──────────────────────────────────────────────────────────────────────────}
  163. Procedure Putpic (x,y:integer);
  164.   { This put's the picture at coordinates x,y on the chain-4 screen }
  165. Var loop1,loop2:integer;
  166.     depth,cur:integer;
  167. BEGIN
  168.    depth:=1;
  169.    cur:=0;
  170.    For loop1:=1 to 897 do BEGIN
  171.      for loop2:=1 to bit [loop1] do BEGIN
  172.        if cur<>0 then c4putpixel ((depth mod 155)+x,(depth div 155)+y,depth div 155);
  173.        inc (depth);
  174.      END;
  175.      cur:=(cur+1) mod 2;
  176.    END;
  177. END;
  178.  
  179.  
  180. Procedure Play;
  181. Var loop1,loop2:integer;
  182.     xpos,ypos,xdir,ydir:integer;
  183.     ch:char;
  184. Begin
  185.    for loop1:=1 to 62 do
  186.      pal (loop1,loop1,0,62-loop1); { This sets up the pallette for the pic }
  187.  
  188.    MoveTo(0,0); { This moves the view to the top left hand corner }
  189.  
  190.    for loop1:=0 to 3 do
  191.      for loop2:=0 to 5 do
  192.        putpic (loop1*160,loop2*66); { This places the picture all over the
  193.                                       chain-4 screen }
  194.    readkey;
  195.    ch:=#0;
  196.    xpos:=random (78)+1;
  197.    ypos:=random (198)+1; { Random start positions for the view }
  198.    xdir:=1;
  199.    ydir:=1;
  200.    repeat
  201.      moveto (xpos,ypos);
  202.      waitretrace;          { Take this out and watch the screen go crazy! }
  203.      xpos:=xpos+xdir;
  204.      ypos:=ypos+ydir;
  205.      if (xpos>79) or (xpos<1) then xdir:=-xdir;
  206.      if (ypos>199) or (ypos<1) then ydir:=-ydir;  { Hit a boundry, change
  207.                                                     direction! }
  208.      if keypressed then ch:=readkey;
  209.    until ch=#27;  { Quit when escape is pressed }
  210. End;
  211.  
  212.  
  213. BEGIN
  214.   clrscr;
  215.   writeln ('Hello there! Here is the tenth tutorial, on Chain-4! You will notice');
  216.   writeln ('that there are two pascal files here : one is a unit containing all');
  217.   writeln ('our base graphics routines, and one is the demo program.');
  218.   writeln;
  219.   writeln ('In the demo program, we will do the necessary port stuff to get into');
  220.   writeln ('Chain-4. Once in Chain-4 mode, I will put down text saying ASPHYXIA');
  221.   writeln ('over the entire screen. After a key is pressed, the viewport will');
  222.   writeln ('bounce around, displaying the entire Chain-4 screen. The program will');
  223.   writeln ('end when [ESC] is pressed. The code here is really basic (except for');
  224.   writeln ('those port values), and should be very easy to understand.');
  225.   writeln;
  226.   writeln;
  227.   Write ('  Hit any key to contine ...');
  228.   Readkey;
  229.   initChain4;
  230.   play;
  231.   SetText;
  232.   Writeln ('All done. This concludes the tenth sample program in the ASPHYXIA');
  233.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  234.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  235.   Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
  236.   Writeln ('    smith9@batis.bis.und.ac.za');
  237.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  238.   Writeln ('             Grant Smith');
  239.   Writeln ('             P.O. Box 270');
  240.   Writeln ('             Kloof');
  241.   Writeln ('             3640');
  242.   Writeln ('             Natal');
  243.   Writeln ('             South Africa');
  244.   Writeln ('I hope to hear from you soon!');
  245.   Writeln; Writeln;
  246.   Write   ('Hit any key to exit ...');
  247.   Readkey;
  248. END.