home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0119_plasma.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  2.7 KB  |  151 lines
  1. {
  2. Yesterday I saw Bas' plasma routine. Real nice! But... a little slow I thought
  3. so I improved it. Another thing, Bas, the bouble buffer didn't work on my
  4. et4000, the bplptr never changed in your mode.
  5.  
  6. Well, enjoy this new routine!
  7. }
  8.  
  9. program plasma;
  10.  
  11. { bigscreenplasma, by Bas van Gaalen & Sven van Heel, Holland, PD   }
  12. { Improved by GEM, Sweden (convertion to asm --> many times faster) }
  13.  
  14. uses
  15.   crt;
  16.  
  17. const
  18.   vidseg:word=$a000;
  19.  
  20. var
  21.   stab1,stab2:array[0..255+80] of byte;
  22.   x:word;
  23.  
  24. procedure setpal(c,r,g,b:byte); assembler;
  25. asm
  26.    mov dx,3c8h
  27.    mov al,[c]
  28.    out dx,al
  29.    inc dx
  30.    mov al,[r]
  31.    out dx,al
  32.    mov al,[g]
  33.    out dx,al
  34.    mov al,[b]
  35.    out dx,al
  36. end;
  37.  
  38. begin
  39.   asm
  40.      mov ax,0013h
  41.      int 10h
  42.      mov dx,03c4h
  43.      mov ax,0604h
  44.      out dx,ax
  45.      mov dx,03d4h
  46.      mov ax,4609h
  47.      out dx,ax
  48.      mov ax,0014h
  49.      out dx,ax
  50.      mov ax,0e317h
  51.      out dx,ax
  52.      mov es,vidseg
  53.      xor di,di
  54.      xor ax,ax
  55.      mov cx,16000
  56.      rep stosw
  57.   end;
  58.   for x:=0 to 63 do begin
  59.     setpal(x,x div 4,x div 2,x);
  60.     setpal(127-x,x div 4,x div 2,x);
  61.     setpal(127+x,20+x div 4,x div 2,x);
  62.     setpal(254-x,20+x div 4,x div 2,x);
  63.   end;
  64.   for x:=0 to 255+80 do begin
  65.     stab1[x]:=round(sin(2*pi*x/255)*128)+128;
  66.     stab2[x]:=round(cos(2*pi*x/255)*128)+128;
  67.   end;
  68.   asm
  69.      mov cl,50
  70.      mov ch,90
  71.      mov es,vidseg
  72.      push bp
  73.    @main:
  74.  
  75. {     mov dx,3c8h    (* For checking rastertime *)
  76.      xor al,al
  77.      out dx,al
  78.      inc dx
  79.      out dx,al
  80.      out dx,al
  81.      out dx,al}
  82.  
  83.      mov dx,3dah
  84.    @vert1:
  85.      in al,dx
  86.      test al,8
  87.      jz @vert1
  88.    @vert2:
  89.      in al,dx
  90.      test al,8
  91.      jnz @vert2
  92.  
  93.      mov dx,3dah    (* This is kinda rediculous! *)
  94.    @vert1b:         (* I have to insert another vbl to slow it down.... *)
  95.      in al,dx
  96.      test al,8
  97.      jz @vert1b
  98.    @vert2b:
  99.      in al,dx
  100.      test al,8
  101.      jnz @vert2b
  102.  
  103. {     mov dx,3c8h    (* For checking rastertime *)
  104.      xor al,al
  105.      out dx,al
  106.      mov al,30
  107.      inc dx
  108.      out dx,al
  109.      out dx,al
  110.      out dx,al}
  111.  
  112.      inc cl
  113.      inc ch
  114.      xor di,di
  115.      mov bp,di
  116.    @loooooop:
  117.      mov si,offset stab1
  118.      mov bx,bp
  119.      add bl,cl
  120.      mov dl,[si+bx]
  121.      xor dh,dh
  122.      mov bl,ch
  123.      mov al,[si+bx]
  124.      add si,dx
  125.      mov bx,bp
  126.      add bl,al
  127.      mov bl,[bx+offset stab2]
  128.      mov bh,bl
  129.      mov dx,40
  130.    @again:
  131.      lodsw
  132.      add ax,bx
  133.      stosw
  134.      dec dx
  135.      jnz @again
  136.      cmp si,offset stab1[256]
  137.      jb @1
  138.      sub si,256
  139.    @1:
  140.      inc bp
  141.      cmp bp,58
  142.      jne @loooooop
  143.      in al,60h
  144.      cmp al,1
  145.      jne @main
  146.      pop bp
  147.   end;
  148.   textmode(lastmode);
  149. end.
  150.  
  151.