home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / wallpapr.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  1KB  |  69 lines
  1.  
  2. program tsenglabs_et4000_640x480x256_mode;
  3. { Direct screen writing in SuperVGA mode 640x480x256 on a TsengLabs ET4000 }
  4. { By Bas van Gaalen, Holland, PD }
  5. uses crt;
  6. var x,y:word; i,page:byte;
  7.  
  8. procedure setvideo(md:word); assembler;
  9. { 02dh - 630x350
  10.   02eh - 640x480
  11.   02fh - 640x400 }
  12. asm
  13.   mov ax,md
  14.   int 10h
  15. end;
  16.  
  17. procedure setpal(col,r,g,b : byte); assembler;
  18. asm
  19.   mov dx,03c8h
  20.   mov al,col
  21.   out dx,al
  22.   inc dx
  23.   mov al,r
  24.   out dx,al
  25.   mov al,g
  26.   out dx,al
  27.   mov al,b
  28.   out dx,al
  29. end;
  30.  
  31. procedure writescreen; assembler;
  32. asm
  33.   mov es,sega000
  34.   mov x,0
  35.   mov y,0
  36.  @l1:
  37.   mov ax,y
  38.   mov dx,640
  39.   mul dx
  40.   add ax,x
  41.   adc dx,0
  42.   mov di,ax
  43.   cmp dl,page
  44.   je @skip
  45.   mov page,dl
  46.   mov al,dl
  47.   mov dx,03cdh
  48.   out dx,al
  49.  @skip:
  50.   mov ax,x
  51.   add ax,y
  52.   mov [es:di],al
  53.   inc y
  54.   cmp y,480
  55.   jne @l1
  56.   mov y,0
  57.   inc x
  58.   cmp x,640
  59.   jne @l1
  60. end;
  61.  
  62. begin
  63.   setvideo($2e);
  64.   for i:=1 to 255 do setpal(i,255-i div 4,255-i div 4,30);
  65.   writescreen;
  66.   repeat until keypressed;
  67.   textmode(lastmode);
  68. end.
  69.