[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

program dotspin;

var inPort1:word;
procedure waitRetrace;assembler;asm
 mov dx,inPort1; {find crt status reg (input port #1)}
@L1: in al,dx; test al,8; jnz @L1;  {wait for no v retrace}
@L2: in al,dx; test al,8; jz @L2; {wait for v retrace}
 end;

const
 tableWriteIndex=$3C8;
 tableDataRegister=$3C9;

procedure setColor(color,r,g,b:byte);assembler;asm {set DAC color}
 mov dx,tableWriteIndex; mov al,color; out dx,al; inc dx;
 mov al,r; out dx,al; mov al,g; out dx,al; mov al,b;out dx,al;
 end; {write index now points to next color}

{plot a pixel in mode $13}
procedure plot(x,y:word);Inline(
  $5E/                   { pop si  ;y}
  $5F/                   { pop di  ;x}
  $B8/$00/$A0/           { mov ax,$A000}
  $8E/$C0/               { mov es,ax}
  $B8/$40/$01/           { mov ax,320}
  $F7/$E6/               { mul si}
  $01/$C7/               { add di,ax}
  $26/$F6/$15);          {es: not byte[di]}

procedure plot4(x,y:word);const f=60;begin
 plot(x+f,y);
 plot(199+f-x,199-y);
 plot(199+f-y,x);
 plot(y+f,199-x);
 end;

procedure click;assembler;asm
 in al,$61; xor al,2; out $61,al;
 end;

const nDots=21;

var
 dot:array[0..nDots-1]of record
  x,y,sx,sy:integer;
  end;

function colorFn(x:integer):byte;begin
 colorFn:=63-(abs(100-x)div 2);
 end;

procedure moveDots;var i:word;begin
 for i:=0 to nDots-1 do with dot[i] do begin
  plot4(x,y);
  inc(x,sx);inc(y,sy);
  if(word(x)>200)then begin
   sx:=-sx;inc(x,sx);click;
   end;
  if(word(y)>199)then begin
   sy:=-sy;inc(y,sy);click;
   end;
  plot4(x,y);
  end;
 waitRetrace;waitRetrace;waitRetrace;{waitRetrace;}
 setcolor(255,colorFn(dot[0].x),colorFn(dot[3].x),colorFn(dot[6].x));
 end;

procedure drawdots;var i:word;begin
 for i:=0 to nDots-1 do with dot[i] do plot4(x,y);
 end;

procedure initDots;var i,j,k:word;begin
 j:=1;k:=1;
 for i:=0 to nDots-1 do with dot[i] do begin
  x:=100;y:=99;
  sx:=j;sy:=k;
  inc(j);if j>=k then begin j:=1;inc(k); end;
  end;
 end;

function readKey:char;Inline(
  $B4/$07/               {mov ah,7}
  $CD/$21);              {int $21}

function keyPressed:boolean;Inline(
  $B4/$0B/               {mov ah,$B}
  $CD/$21/               {int $21}
  $24/$FE);              {and al,$FE}

begin
 inPort1:=memw[$40:$63]+6;
 port[$61]:=port[$61]and (not 1);
 setcolor(255,60,60,63);
 initDots;
 asm mov ax,$13; int $10; end;
 drawDots;
 repeat moveDots until keypressed;
 readkey;
 drawDots;
 asm mov ax,3; int $10; end;
 end.


 * OLX 2.2 * Printers do it without wrinkling the sheets.

--- Maximus 2.01wb
 * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)
                                                                                                 

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]