home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / plasma2.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  3KB  |  110 lines
  1.  
  2. program plasma;
  3. uses
  4.   crt;
  5. const
  6.   vidseg:word=$a000;
  7.   border:boolean=true;
  8. var
  9.   stab1,stab2:array[0..255] of byte;
  10.   address,x,y:word;
  11.   i1,i2,j1,j2,c:byte;
  12.  
  13. procedure setmode; assembler; asm
  14.   mov ax,0013h; int 10h; mov dx,03c4h; mov ax,0604h; out dx,ax; mov dx,03d4h
  15.   mov ax,4109h; out dx,ax; mov ax,0014h; out dx,ax; mov ax,0e317h; out dx,ax
  16.   mov es,vidseg; xor di,di; xor ax,ax; mov cx,32000; rep stosw; end;
  17.  
  18. procedure setborder(col:byte); assembler; asm
  19.   xor ch,ch; mov cl,border; jcxz @out; mov dx,3dah; in al,dx
  20.   mov dx,3c0h; mov al,11h+32; out dx,al; mov al,col; out dx,al; @out: end;
  21.  
  22. procedure setpal(c,r,g,b:byte); assembler; asm
  23.   mov dx,3c8h; mov al,[c]; out dx,al; inc dx; mov al,[r]
  24.   out dx,al; mov al,[g]; out dx,al; mov al,[b]; out dx,al; end;
  25.  
  26. procedure retrace; assembler; asm
  27.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  28.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  29.  
  30. procedure setaddress(ad:word); assembler; asm
  31.   mov dx,3d4h; mov al,0ch; mov ah,[byte(ad)+1]; out dx,ax
  32.   mov al,0dh; mov ah,[byte(ad)]; out dx,ax; end;
  33.  
  34. procedure doplasma; assembler;
  35. asm
  36.   mov es,vidseg
  37.   add i1,255
  38.   add j1,1
  39.   mov di,address
  40.   mov si,25
  41.   mov ax,si
  42.   shl ax,4
  43.   add di,ax
  44.   shl ax,2
  45.   add di,ax
  46.   add di,5
  47.  @l0:
  48.   mov bx,si
  49.   add bx,word ptr i1
  50.   and bx,$ff
  51.   mov dl,byte ptr stab1[bx]
  52.   mov bx,word ptr j1
  53.   mov dh,byte ptr stab2[bx]
  54.   mov cx,5
  55.  @l1:
  56.   mov bx,cx
  57.   add bl,dl
  58.   mov al,byte ptr stab1[bx]
  59.   mov bx,si
  60.   add bl,dh
  61.   add al,byte ptr stab2[bx]
  62.   mov [es:di],al
  63.   inc di
  64.   inc cx
  65.   cmp cx,75
  66.   jne @l1
  67.   add di,10
  68.   inc si
  69.   cmp si,175
  70.   jne @l0
  71. end;
  72.  
  73. begin
  74.   setmode;
  75.   for x:=0 to 63 do begin
  76.     setpal(x,x div 4,x div 2,x div 2);
  77.     setpal(127-x,x div 4,x div 2,x div 2);
  78.     setpal(127+x,x,x div 4,x div 2);
  79.     setpal(254-x,x,x div 4,x div 2);
  80.   end;
  81.   for x:=0 to 255 do begin
  82.     stab1[x]:=round(sin(2*pi*x/255)*128)+128;
  83.     stab2[x]:=round(cos(2*pi*x/255)*128)+128;
  84.   end;
  85.  
  86.   i1:=0; j1:=90; address:=0;
  87.   repeat
  88.     retrace;
  89.     setborder(50);
  90.     address:=32000-address;
  91.     setaddress(address);
  92.     doplasma;
  93.     {
  94.     inc(i1,-1);
  95.     inc(j1,1);
  96.     for y:=10 to 189 do begin
  97.       i2:=stab1[(y+i1) and 255];
  98.       j2:=stab1[j1 and 255];
  99.       for x:=5 to 74 do begin
  100.         c:=stab1[(x+i2) and 255]+stab2[(y+j2) and 255];
  101.         mem[vidseg:address+y*80+x]:=c and 255;
  102.       end;
  103.     end;
  104.     }
  105.     setborder(0);
  106.   until keypressed;
  107.  
  108.   textmode(lastmode);
  109. end.
  110.