home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0155_credits scroller.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  5.1 KB  |  158 lines
  1. {
  2. Here's an example of one of the possibilities mode-q offers. Of course the same
  3. can be done in any other mode, too... Well, just check it out. To Jens and the
  4. other carefull ones: keep being carefull (read the text).
  5.  
  6. >--- cut here
  7. }
  8. {$define cpu386}
  9.  
  10. program creditscroll;
  11. { Made by Bas van Gaalen, Holland, PD }
  12. uses
  13.   crt,umodeq;
  14. const
  15.   vseg:word=$a000; fseg=$f000; fofs=$fa6e; lines=45;
  16.   txt:array[0..lines-1] of string[30]=(
  17.    {.........|.........|.........|}
  18.     'This is a credits-scroll',
  19.     'in mode-q: 256x256x256.',
  20.     'That''s a chained mode, with',
  21.     'a lineair addressing sceme.',
  22.     'The graphics-screen is',
  23.     'initialized in the unit',
  24.     'umodeq. It''s enclosed in the',
  25.     'next message (I hope).','','',
  26.     'and so the credits go to','','',
  27.     '...Bas van Gaalen...','','',
  28.     'Btw: this is quite lame:',
  29.     'not even a hardware-scroll!',
  30.     'But it''s just to show the',
  31.     'nice overscan-mode...','',
  32.     'Uuuhm, can someone supply',
  33.     'some shit, to fill up this',
  34.     'text?','',
  35.     'Oyeah, before I forget,',
  36.     'mode-q is a tweaked mode,',
  37.     'and it plays a bit with the',
  38.     'VGA-registers!',
  39.     'So again: I won''t take any',
  40.     'responsebilty for this code!',
  41.     'It works fine on my ET-4000.','','','',
  42.     'Gayle, place this in the SWAG',
  43.     'if you like...','','','','','','','','');
  44.  
  45. procedure retrace; assembler; asm
  46.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  47.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  48.  
  49. procedure moveup; assembler; asm
  50.   push ds; mov es,vseg; mov ds,vseg; xor di,di; mov si,0100h
  51.   {$ifdef cpu386} mov cx,255*256/4; db $66; rep movsw
  52.   {$else} mov cx,255*256/2; rep movsw {$endif} pop ds; end;
  53.  
  54. var i,j,slidx,txtidx:byte;
  55. begin
  56.   setmodeq;
  57.   txtidx:=0; slidx:=0;
  58.   repeat
  59.     retrace;
  60.     for i:=1 to length(txt[txtidx]) do for j:=0 to 7 do
  61.       if ((mem[fseg:fofs+ord(txt[txtidx][i])*8+slidx] shl j) and 128)<>0 then
  62.         mem[vseg:$fe00+i*8+(256-8*length(txt[txtidx])) div 2+j]:=32+txtidx+slidx+j;    moveup;
  63.     slidx:=(1+slidx) mod 8;
  64.     if slidx=0 then txtidx:=(1+txtidx) mod lines;
  65.   until keypressed;
  66.   inittxt;
  67. end.
  68.  
  69. { UNIT NEEDED BY SCROLLER !! }
  70.  
  71. { Original by Robert Schmidt in C, converted to Pas by Bas van Gaalen,
  72.   fido: 2:285/213.8, email: bas.van.gaalen@schotman.nl, Holland, Aug. '94, PD }
  73.  
  74. unit umodeq;
  75.  
  76. interface
  77.  
  78. const
  79.   vidseg:word=$a000;
  80.  
  81. procedure setpal(col,r,g,b : byte);
  82. procedure initvga; { not public }
  83. procedure inittxt;
  84. procedure openregs; { not public }
  85. procedure closeregs; { not public }
  86. procedure setmodeq;
  87.  
  88. implementation
  89.  
  90. type
  91.   twrec=record reg:word; func,data:byte; end;
  92.   twarr=array[0..22] of twrec;
  93.  
  94. const
  95.   tweak:twarr=(
  96.     (reg:$03d4; func:$00; data:$5f), { hor. total }
  97.     (reg:$03d4; func:$01; data:$3f), { hor. display enable end }
  98.     (reg:$03d4; func:$02; data:$40), { blank start }
  99.     (reg:$03d4; func:$03; data:$82), { blank end }
  100.     (reg:$03d4; func:$04; data:$4e), { retrace start }
  101.     (reg:$03d4; func:$05; data:$9a), { retrace end }
  102.     (reg:$03d4; func:$06; data:$23), { vertical total }
  103.     (reg:$03d4; func:$07; data:$b2), { overflow register }
  104.     (reg:$03d4; func:$08; data:$00), { preset row scan }
  105.     (reg:$03d4; func:$09; data:$61), { max scan line/char heigth }
  106.     (reg:$03d4; func:$10; data:$0a), { ver. retrace start }
  107.     (reg:$03d4; func:$11; data:$ac), { ver. retrace end }
  108.     (reg:$03d4; func:$12; data:$ff), { ver. display enable end }
  109.     (reg:$03d4; func:$13; data:$20), { offset/logical width }
  110.     (reg:$03d4; func:$14; data:$40), { underlinde location }
  111.     (reg:$03d4; func:$15; data:$07), { ver. blank start }
  112.     (reg:$03d4; func:$16; data:$17), { ver. blank end }
  113.     (reg:$03d4; func:$17; data:$a3), { mode control }
  114.     (reg:$03c4; func:$01; data:$01), { clock mode register }
  115.     (reg:$03c4; func:$04; data:$0e), { memory mode register }
  116.     (reg:$03ce; func:$05; data:$40), { mode register }
  117.     (reg:$03ce; func:$06; data:$05), { misc. register }
  118.     (reg:$03c0; func:$10; data:$41)  { mode control }
  119.   );
  120.  
  121. procedure setpal(col,r,g,b : byte); assembler; asm
  122.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r; out dx,al
  123.   mov al,g; out dx,al; mov al,b; out dx,al; end;
  124.  
  125. procedure initvga; assembler; asm mov ax,13h; int 10h; end;
  126. procedure inittxt; assembler; asm mov ax,3; int 10h; end;
  127.  
  128. procedure openregs; assembler; asm
  129.   mov dx,03d4h; mov al,11h; out dx,al; inc dx; in al,dx; and al,7fh
  130.   mov ah,al; mov al,11h; dec dx; out dx,ax; end;
  131.  
  132. procedure closeregs; assembler; asm
  133.   mov dx,03d4h; mov al,11h; out dx,al; inc dx; in al,dx; or al,80h
  134.   mov ah,al; mov al,11h; dec dx; out dx,ax; end;
  135.  
  136. procedure setmodeq;
  137. var i:byte;
  138. begin
  139.   initvga;
  140.   openregs;
  141.   for i:=0 to 22 do
  142.     with tweak[i] do begin
  143.       if reg<>$03c0 then port[reg]:=func else port[reg]:=func+32;
  144.       port[reg+1]:=data;
  145.     end;
  146.   closeregs;
  147. end;
  148.  
  149. {var x,y:byte;
  150. begin
  151.   setmodeq;
  152.   for x:=0 to 255 do setpal(x,x div 4,x div 5,x div 6);
  153.   for x:=0 to 255 do for y:=0 to 255 do mem[vidseg:y*256+x]:=(x+y) mod 255;
  154.   readln;
  155.   inittxt;}
  156. end.
  157.  
  158.