home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / dypp.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  3KB  |  137 lines
  1.  
  2. {$g+}
  3. program different_y_pixel_position;
  4. { Fast DYPP, including scroll, by Bas van Gaalen, Holland, PD }
  5. uses crt;
  6. const
  7.   border=false;
  8.   amp1=20; amp2=8;
  9.   spd1=2; spd2=4;
  10.   slen1=250; slen2=180; { experiment with these, keep below byte-size (255) }
  11.   lines=23; lineoffset=4;
  12.   txt:string='This thing is called a DYPP: Different-Y-Pixel-Position... '+
  13.     ' Uh huh huh huh m... Hey Beavis, shut up!                           ';
  14. type styp = array[0..255] of integer;
  15. var
  16.   bitmap:array[0..lines*320-1] of byte;
  17.   cpos:array[0..319] of word;
  18.   stab1,stab2:styp;
  19.   fseg,fofs:word;
  20.  
  21. procedure getfont; assembler;
  22. asm
  23.   mov ax,1130h
  24.   mov bh,6
  25.   int 10h
  26.   mov fseg,es
  27.   mov fofs,bp
  28. end;
  29.  
  30. procedure setborder(col:byte); assembler;
  31. asm
  32.   mov cx,word ptr border
  33.   jcxz @out
  34.   mov dx,3dah
  35.   in al,dx
  36.   mov dx,3c0h
  37.   mov al,11h+32
  38.   out dx,al
  39.   mov al,col
  40.   out dx,al
  41.  @out:
  42. end;
  43.  
  44. procedure retrace; assembler;
  45. asm
  46.   mov dx,03dah
  47.  @l1:
  48.   in al,dx
  49.   test al,8
  50.   jnz @l1
  51.  @l2:
  52.   in al,dx
  53.   test al,8
  54.   jz @l2
  55. end;
  56.  
  57. procedure init;
  58. var i:word; j:byte;
  59. begin
  60.   asm mov ax,13h; int 10h; end;
  61.   for j:=0 to slen1 do stab1[j] := round(sin(2*j*pi/slen1)*amp1)+amp1;
  62.   for j:=0 to slen2 do stab2[j] := round(sin(2*j*pi/slen2)*amp2)+amp2;
  63.   fillchar(bitmap,sizeof(bitmap),0);
  64. end;
  65.  
  66. procedure drawmap; assembler;
  67. { for j:=0 to 11 do for i:=0 to 319 do
  68.     mem[sega000:cpos[i]+j*320]:=bitmap[j,i];}
  69. var _cx:word;
  70. asm
  71.   mov es,sega000
  72.   xor cx,cx                  { i (0 -> 319) }
  73.  @l0:
  74.   xor dx,dx                  { j (0 -> 11) }
  75.   mov si,cx
  76.   add si,cx
  77.   mov di,word ptr cpos[si]
  78.   mov si,cx
  79.  @l1:
  80.   mov al,byte ptr bitmap[si]
  81.   mov [es:di],al
  82.   add si,320
  83.   add di,320
  84.   inc dl
  85.   cmp dl,lines
  86.   jne @l1
  87.   inc cx
  88.   cmp cx,319
  89.   jne @l0
  90. end;
  91.  
  92. procedure scrollbitmap(var map); assembler;
  93. asm
  94.   lds si,map
  95.   les di,map
  96.   inc si
  97.   add si,lineoffset*320
  98.   add di,lineoffset*320
  99.   mov cx,2560
  100.   rep movsw
  101. end;
  102.  
  103. procedure dypp;
  104. var i:word; j,idx,idx2,scridx,ch,cp:byte;
  105. begin
  106.   idx:=0; idx2:=0; cp:=7; scridx:=1; ch:=byte(txt[scridx]);
  107.   repeat
  108.     retrace;
  109.     setborder(44);
  110.     for i:=0 to 319 do
  111.       cpos[i]:=320*(stab1[(i+idx) mod slen1]+stab2[(i+idx2) mod slen2])+i;
  112.     setborder(40);
  113.     scrollbitmap(bitmap);
  114.     setborder(36);
  115.     for j:=0 to 15 do
  116.       bitmap[(lineoffset+j)*320+319]:=
  117.         ((mem[fseg:fofs+ch*16+j] shr cp) and 1)*(32+cp+j+scridx mod 60);
  118.     dec(cp); cp:=cp mod 8;
  119.     if cp=0 then begin
  120.       scridx:=1+scridx mod length(txt);
  121.       ch:=byte(txt[scridx]);
  122.     end;
  123.     setborder(32);
  124.     drawmap;
  125.     idx:=spd1+idx mod slen1;
  126.     idx2:=spd2+idx2 mod slen2;
  127.     setborder(0);
  128.   until keypressed;
  129. end;
  130.  
  131. begin
  132.   getfont;
  133.   init;
  134.   dypp;
  135.   textmode(lastmode);
  136. end.
  137.