home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SDEMO.ZIP / SDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-28  |  11.2 KB  |  379 lines
  1. {16.III.1995}
  2. {A very very small demo by Andrzej Dzirba}
  3. {A critics and other comments please send to
  4.  DZIRBA@.VETTER.ZSE.LUBLIN.PL }
  5.  
  6. PROGRAM sdemo;
  7. TYPE tbl = ARRAY [1..316] OF
  8.   INTEGER;
  9. CONST vga = $A000;
  10. TYPE
  11.   ball = ARRAY [1..20 * 20] OF
  12.   BYTE;
  13. VAR
  14.   i : WORD;
  15.   x1, y1, t, omega, fi : REAL;
  16.   tblx : ^tbl;
  17.   tbly : ^tbl;
  18.   tblx2, tbly2 : ^tbl;
  19.   tblx3, tbly3 : ^tbl;
  20.   
  21. TYPE Virtual = ARRAY [1..64000] OF
  22.   BYTE;
  23.   VirtPtr = ^Virtual;
  24.   
  25. VAR Virscr : VirtPtr;
  26.   Vaddr  : WORD;
  27.   virscr2 : VirtPtr;
  28.   vaddr2 : WORD;
  29. CONST
  30.   k : ARRAY [1..3] OF
  31.   ball =
  32.   ( (
  33.   0, 0, 0, 0, 0, 75, 77, 77, 77, 77, 76, 75, 71, 0, 0, 0, 0, 0, 0, 0, 0,
  34.   0, 0, 77, 88, 86, 88, 88, 88, 88, 86, 83, 79, 75, 69, 0, 0, 0, 0, 0,
  35.   0, 0, 82, 89, 93, 93, 93, 93, 93, 92, 90, 88, 83, 80, 76, 71, 0, 0, 0,
  36.   0, 0, 79, 91, 96, 98, 98, 98, 98, 98, 96, 93, 92, 88, 83, 80, 76, 69, 0,
  37.   0, 0, 0, 93, 98, 101, 102, 102, 103, 103, 103, 101, 98, 93, 92, 88, 83, 79, 74,
  38.   0, 0, 0, 81, 98, 103, 104, 106, 108, 108, 108, 106, 103, 103, 98, 93, 90, 86, 81,
  39.   76, 69, 0, 0, 86, 101, 103, 108, 111, 112, 112, 112, 111, 108, 103, 101, 96, 92, 88,
  40.   83, 78, 73, 0, 0, 98, 103, 106, 111, 114, 117, 117, 117, 114, 111, 106, 102, 98, 93,
  41.   88, 83, 78, 71, 0, 0, 83, 103, 107, 112, 117, 120, 122, 120, 117, 112, 108, 102, 98,
  42.   93, 88, 83, 77, 69, 0, 0, 0, 103, 108, 112, 117, 122, 122, 120, 117, 113, 108, 102,
  43.   98, 93, 88, 83, 76, 0, 0, 0, 0, 86, 103, 112, 117, 120, 122, 120, 117, 113, 108,
  44.   103, 98, 93, 88, 83, 72, 0, 0, 0, 0, 0, 92, 106, 114, 117, 117, 117, 114, 111,
  45.   106, 103, 98, 93, 85, 77, 0, 0, 0, 0, 0, 0, 0, 89, 101, 107, 112, 112, 111,
  46.   108, 104, 101, 93, 86, 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 88, 94, 94,
  47.   92, 91, 88, 87, 81, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  48.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  49.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  50.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  51.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  52.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  53.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
  54.   (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  55.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  56.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  57.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  58.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  59.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  60.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 241, 238, 238, 239, 240, 242,
  61.   244, 248, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 238, 233, 230, 227, 227, 229, 232,
  62.   234, 238, 241, 245, 250, 0, 0, 0, 0, 0, 0, 0, 233, 223, 223, 223, 223, 223, 226,
  63.   40, 232, 234, 238, 241, 246, 249, 0, 0, 0, 0, 0, 234, 222, 219, 219, 219, 219, 220,
  64.   223, 225, 40, 232, 234, 239, 242, 247, 251, 0, 0, 0, 0, 223, 215, 214, 215, 214, 214,
  65.   216, 218, 223, 225, 40, 232, 235, 239, 244, 248, 0, 0, 0, 232, 214, 211, 209, 209, 209,
  66.   211, 214, 214, 218, 223, 226, 229, 234, 238, 242, 247, 251, 0, 0, 226, 209, 207, 205, 205,
  67.   205, 207, 209, 43, 216, 220, 224, 228, 232, 237, 241, 245, 250, 0, 0, 224, 207, 203, 201,
  68.   201, 45, 203, 207, 211, 215, 219, 223, 227, 232, 237, 241, 245, 250, 0, 0, 40, 205, 201,
  69.   198, 46, 198, 45, 205, 209, 214, 219, 223, 227, 232, 237, 241, 247, 251, 0, 0, 0, 205,
  70.   201, 46, 196, 46, 201, 205, 209, 214, 219, 223, 227, 232, 237, 241, 247, 0, 0, 0, 0,
  71.   226, 201, 198, 196, 198, 201, 205, 209, 214, 219, 223, 227, 232, 236, 242, 247, 0, 0, 0,
  72.   0, 0, 219, 201, 201, 201, 203, 207, 211, 215, 219, 223, 227, 232, 238, 244, 0, 0, 0,
  73.   0, 0, 0, 0, 226, 205, 205, 207, 210, 43, 216, 220, 224, 230, 236, 244, 0, 0, 0,
  74.   0, 0, 0, 0, 0, 0, 0, 40, 224, 226, 40, 230, 233, 234, 239, 0, 0, 0, 0, 0),
  75.   (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  76.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  77.   0, 0, 0, 0, 0, 0, 0, 140, 147, 141, 138, 0, 0, 0, 0, 0, 0, 0, 0,
  78.   0, 0, 0, 0, 0, 0, 143, 153, 151, 153, 151, 147, 141, 136, 0, 0, 0, 0, 0,
  79.   0, 0, 0, 0, 0, 0, 32, 156, 159, 159, 159, 156, 153, 147, 142, 137, 0, 0, 0,
  80.   0, 0, 0, 0, 0, 0, 151, 34, 166, 166, 166, 164, 159, 156, 153, 148, 142, 136, 0,
  81.   0, 0, 0, 0, 0, 0, 32, 163, 170, 172, 172, 172, 170, 166, 159, 156, 151, 145, 139,
  82.   132, 0, 0, 0, 0, 0, 0, 153, 170, 175, 178, 37, 178, 175, 170, 164, 159, 153, 147,
  83.   140, 133, 0, 0, 0, 0, 0, 0, 33, 172, 178, 182, 183, 182, 178, 172, 166, 160, 153,
  84.   147, 140, 133, 0, 0, 0, 0, 0, 0, 32, 172, 37, 183, 185, 183, 37, 172, 166, 160,
  85.   153, 147, 140, 132, 0, 0, 0, 0, 0, 0, 0, 158, 172, 182, 185, 182, 178, 172, 165,
  86.   159, 153, 145, 137, 0, 0, 0, 0, 0, 0, 0, 0, 0, 34, 172, 37, 178, 175, 170,
  87.   164, 159, 151, 141, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 33, 172, 172, 170,
  88.   166, 158, 151, 141, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 150,
  89.   153, 151, 145, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  90.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  91.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  92.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  93.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  94.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  95.   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) );
  96.   
  97.   
  98. PROCEDURE setvga;
  99.   assembler;
  100.   asm
  101.   mov ax, 0013h
  102.   INT 10h
  103. END;
  104.  
  105. PROCEDURE settext;
  106.   assembler;
  107.   asm
  108.   mov ax, 0003h
  109.   INT 10h
  110. END;
  111.  
  112. FUNCTION KEYPRESSED : BOOLEAN;
  113. assembler;
  114. asm
  115. IN     al, 60h
  116. cmp    al, 1
  117. je     @EXIT
  118. XOR    al, al
  119. @EXIT :
  120. END;
  121.  
  122. PROCEDURE Pal (Col, R, G, B : BYTE);
  123.   assembler;
  124.   asm
  125.   mov    dx, 3c8h
  126.   mov    al, [Col]
  127.   out    dx, al
  128.   INC    dx
  129.   mov    al, [R]
  130.   out    dx, al
  131.   mov    al, [G]
  132.   out    dx, al
  133.   mov    al, [B]
  134.   out    dx, al
  135. END;
  136.  
  137. PROCEDURE LoadPal (FileName : STRING);
  138. TYPE DACType = ARRAY [0..255] OF
  139.   RECORD
  140.     R, G, B : BYTE;
  141.   END;
  142. VAR DAC : DACType;
  143.   Fil : FILE OF
  144.   DACType;
  145.   i : INTEGER;
  146. BEGIN
  147.   ASSIGN (Fil, FileName);
  148.   RESET (Fil);
  149.   READ (Fil, DAC);
  150.   CLOSE (Fil);
  151.   FOR i := 0 TO 255 DO
  152.       Pal (i, DAC [i] .R, DAC [i] .G, DAC [i] .B);
  153. END;
  154.  
  155. PROCEDURE Cls (Col : BYTE;
  156.   Where : WORD);
  157.   assembler;
  158.   asm
  159.   push    es
  160.   mov     cx, 32000;
  161.   mov     es, [Where]
  162.   XOR     di, di
  163.   mov     al, [Col]
  164.   mov     ah, al
  165.   rep     stosw
  166.   pop     es
  167. END;
  168.  
  169. PROCEDURE WaitRetrace;
  170.   assembler;
  171. LABEL
  172.   l1, l2;
  173.   asm
  174.   mov dx, 3DAh
  175.   l1 :
  176.   IN al, dx
  177.   AND al, 08h
  178.   jnz l1
  179.   l2 :
  180.   IN al, dx
  181.   AND al, 08h
  182.   jz  l2
  183. END;
  184.  
  185. PROCEDURE putball (X, Y : WORD;
  186. VAR sprt : ball;
  187.   Where : WORD);
  188.   assembler;
  189. LABEL
  190.   _Redraw, _DrawLoop, _Exit, _LineLoop, _NextLine, _Store, _NoPaint;
  191.   
  192.   asm
  193.   push  ds
  194.   push  es
  195.   lds   si, sprt
  196.   mov   ax, X     { ax = x }
  197.   mov   bx, Y     { bx = y }
  198.   _Redraw :
  199.   push    ax
  200.   mov     ax, [Where]
  201.   mov     es, ax
  202.   mov     ax, bx                  {; ax = bx  x = y}
  203.   mov     bh, bl                  {; y = y * 256  bx = bx * 256}
  204.   XOR     bl, bl
  205.   SHL     ax, 6                   {; y = y * 64   ax = ax * 64}
  206.   add     bx, ax                  {; y = (y*256) + (Y*64)  bx = bx + ax (ie y*320)}
  207.   pop     ax                      {; get back our x}
  208.   add     ax, bx                  {; finalise location}
  209.   mov     di, ax
  210.   mov   dl, 20    { dl = height of sprite }
  211.   XOR   ch, ch
  212.   mov   cl, 20     { cx = width of sprite }
  213.   cld
  214.   push  ax
  215.   mov   ax, cx
  216.   _DrawLoop :
  217.   push  di            { store y adr. for later }
  218.   mov   cx, ax          { store width }
  219.   _LineLoop :
  220.   mov   bl, BYTE PTR [si]
  221.   OR    bl, bl
  222.   jnz   _Store
  223.   _NoPaint :
  224.   INC    si
  225.   INC    di
  226.   loop   _LineLoop
  227.   jmp    _NextLine
  228.   _Store :
  229.   movsb
  230.   loop  _LineLoop
  231.   _NextLine :
  232.   pop   di
  233.   DEC   dl
  234.   jz    _Exit
  235.   add   di, 320        { di = next line of sprite }
  236.   jmp   _DrawLoop
  237.   _Exit :
  238.   pop   ax
  239.   pop   es
  240.   pop   ds
  241. END;
  242.  
  243. PROCEDURE copyblock (X, Y : WORD;
  244.   height : WORD;
  245.   source, dest : WORD);
  246.   assembler;
  247.   asm
  248.   push    ds
  249.   mov     ax, dest
  250.   mov     es, ax
  251.   mov     ax, source
  252.   mov     ds, ax
  253.   mov     bx, [X]
  254.   mov     dx, [Y]
  255.   push    bx                      {; and this again for later}
  256.   mov     bx, dx                  {; bx = dx}
  257.   mov     dh, dl                  {; dx = dx * 256}
  258.   XOR     dl, dl
  259.   SHL     bx, 6                   {; bx = bx * 64}
  260.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  261.   pop     bx                      {; get back our x}
  262.   add     bx, dx                  {; finalise location}
  263.   mov     di, bx                  {; es:di = where to go}
  264.   mov     si, di
  265.   mov     al, 60
  266.   mov     bx, height         { Hight of block to copy }
  267.   @@1 :
  268.   mov     cx, 24         { Width of block to copy divided by 2 }
  269.   rep     movsw
  270.   add     di, 110h        { 320 - 48 = 272 .. or 110 in hex }
  271.   add     si, 110h
  272.   DEC     bx
  273.   jnz     @@1
  274.   pop     ds
  275. END;
  276.  
  277. PROCEDURE SetUpVirtual;
  278. BEGIN
  279.   GETMEM (Virscr, 64000);
  280.   Vaddr := SEG (Virscr^);
  281.   GETMEM (virscr2, 64000);
  282.   vaddr2 := SEG (virscr2^);
  283. END;
  284.  
  285. PROCEDURE ShutDown;
  286. BEGIN
  287.   FREEMEM (Virscr, 64000);
  288.   FREEMEM (virscr2, 64000);
  289. END;
  290.  
  291. PROCEDURE init;
  292. BEGIN
  293.   t := 11;
  294.   omega := 10 / 20;
  295.   fi := PI / 20;
  296.   GETMEM (tblx, SIZEOF (tblx^) );
  297.   GETMEM (tbly, SIZEOF (tbly^) );
  298.   GETMEM (tblx2, SIZEOF (tblx2^) );
  299.   GETMEM (tbly2, SIZEOF (tbly2^) );
  300.   GETMEM (tblx3, SIZEOF (tblx3^) );
  301.   GETMEM (tbly3, SIZEOF (tbly3^) );
  302.   
  303.   FOR i := 1 TO 316 DO
  304.       BEGIN
  305.       x1 := SIN (t);
  306.       y1 := SIN (omega * t + fi);
  307.       t := t + 0.04;
  308.       tblx^ [i] := ROUND (160 + x1 * (440 DIV 4) );
  309.       tbly^ [i] := ROUND (95 + y1 * (300 DIV 4) );
  310.       END;
  311.   
  312.   t := 10.5;
  313.   FOR i := 1 TO 316 DO
  314.       BEGIN
  315.       x1 := SIN (t);
  316.       y1 := SIN (omega * t + fi);
  317.       t := t + 0.04;
  318.       tblx2^ [i] := ROUND (160 + x1 * (440 DIV 4) );
  319.       tbly2^ [i] := ROUND (95 + y1 * (300 DIV 4) );
  320.       END;
  321.   
  322.   t := 10;
  323.   FOR i := 1 TO 316 DO
  324.       BEGIN
  325.       x1 := SIN (t);
  326.       y1 := SIN (omega * t + fi);
  327.       t := t + 0.04;
  328.       tblx3^ [i] := ROUND (160 + x1 * (440 DIV 4) );
  329.       tbly3^ [i] := ROUND (95 + y1 * (300 DIV 4) );
  330.       END;
  331. END;
  332.  
  333. PROCEDURE liczenie;
  334. BEGIN
  335.   
  336.   i := 1;
  337.   REPEAT
  338.     
  339.     copyblock (tblx^ [i] - 5, tbly^ [i] - 2, 25, vaddr2, Vaddr);
  340.     copyblock (tblx2^ [i] - 5, tbly2^ [i] - 2, 25, vaddr2, Vaddr);
  341.     copyblock (tblx3^ [i] - 5, tbly3^ [i] - 2, 25, vaddr2, Vaddr);
  342.     
  343.     putball (tblx^ [i] + 5, tbly^ [i], k [1], Vaddr);
  344.     putball (tblx2^ [i] + 5, tbly2^ [i], k [2], Vaddr);
  345.     putball (tblx3^ [i] + 5, tbly3^ [i], k [3], Vaddr);
  346.     WaitRetrace;
  347.     
  348.     copyblock (tblx^ [i] - 5, tbly^ [i] - 2, 25, Vaddr, vga);
  349.     copyblock (tblx2^ [i] - 5, tbly2^ [i] - 2, 25, Vaddr, vga);
  350.     copyblock (tblx3^ [i] - 5, tbly3^ [i] - 2, 25, Vaddr, vga);
  351.     
  352.     INC (i);
  353.     IF i = 316 THEN
  354.        i := 1;
  355.   UNTIL KEYPRESSED;
  356.   FREEMEM (tblx, SIZEOF (tblx^) );
  357.   FREEMEM (tbly, SIZEOF (tbly^) );
  358.   FREEMEM (tblx2, SIZEOF (tblx2^) );
  359.   FREEMEM (tbly2, SIZEOF (tbly2^) );
  360.   FREEMEM (tblx3, SIZEOF (tblx3^) );
  361.   FREEMEM (tbly3, SIZEOF (tbly3^) );
  362. END;
  363.  
  364. BEGIN
  365.   setvga;
  366.   SetUpVirtual;
  367.   Cls (0, vga);
  368.   Cls (0, Vaddr);
  369.   Cls (0, vaddr2);
  370.   
  371.   LoadPal ('sdemo.pal');
  372.   init;
  373.   liczenie;
  374.   
  375.   settext;
  376.   ShutDown;
  377.   WRITELN ('Very Small Demo by Andrzej Dzirba ');
  378.   WRITELN ('Dzirba@Vetter.Zse.Lublin.Pl');
  379. END.