home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / graphscr.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  3KB  |  107 lines
  1. {$G+}
  2.  
  3. { Partialy Assembler written graphics scroll.
  4.   G+ : 80x86+ only!
  5.   Btw: text by Aerosmith (Livin' on the Edge) ;-))
  6.   Still very backward. First assembler try-outs! }
  7.  
  8. program GraphicScroll;
  9.  
  10. uses
  11.   crt,dos;
  12.  
  13. const
  14.   ScrSeg : word = $a000;
  15.   ScrTxt : string = 'Tell me what you think about your situation... Complication... Aggravation... Is getting to you!      ';
  16.   Color  : array[0..15] of byte = (
  17.     blue,lightblue,blue,lightblue,lightblue,cyan,lightblue,cyan,
  18.     cyan,lightblue,cyan,lightblue,lightblue,blue,lightblue,blue);
  19.  
  20. var
  21.   F8x8Seg,F8x8Ofs  : word;
  22.  
  23. {----------------------------------------------------------------------------}
  24.  
  25. procedure GetFont8x8; assembler; asm
  26.   mov ax,01130h; mov bh,3; int 10h; mov F8x8Seg,es; mov F8x8Ofs,bp; end;
  27.  
  28. {----------------------------------------------------------------------------}
  29.  
  30. procedure VideoMode(Mode : word); assembler; asm
  31.   mov ax,Mode; int 10h end;
  32.  
  33. {----------------------------------------------------------------------------}
  34.  
  35. procedure setRGB (register, red, green, blue : byte);
  36. begin
  37.   port[$3C8] := register;       { register in video DAC kiezen }
  38.   port[$3C9] := red;               { kleurwaarden laden }
  39.   port[$3C9] := green;
  40.   port[$3C9] := blue;
  41. end;
  42.  
  43. {----------------------------------------------------------------------------}
  44.  
  45. procedure Scroll;
  46.  
  47. var
  48.   TxtPos : word;
  49.   J,CharPos,Character : byte;
  50.   I : shortint;
  51.  
  52. begin
  53.   TxtPos := 1;
  54.   repeat
  55.     CharPos := 0;
  56.     Character := ord(ScrTxt[TxtPos]);
  57.     for CharPos := 0 to 7 do begin
  58.       {setrgb(0,0,20,30);}
  59.  
  60.       I := 15;
  61.       while I >= 0 do begin
  62.         if (mem[F8x8Seg:F8x8Ofs+(8*Character)+(I div 2)] shl CharPos) and 128 <> 0 then begin
  63.           memw[$A000:318+((23*8+I)*320)] := Color[I]+Color[I]*256;
  64.          memw[$A000:638+((23*8+I)*320)] := Color[I]+Color[I]*256;
  65.         end
  66.         else begin
  67.           memw[$A000:318+((23*8+I)*320)] := black;
  68.           memw[$A000:638+((23*8+I)*320)] := black;
  69.         end;
  70.         dec(I);
  71.       end;
  72.  
  73.       asm
  74.         push ds
  75.         mov dx,$3da
  76.        @Wait:
  77.         in al,dx
  78.         test al,8
  79.         jz @Wait
  80.        @Retr:
  81.         in al,dx
  82.         test al,8
  83.         jnz @Retr
  84.         mov si,2+(23*8*320)
  85.         mov di,0+(23*8*320)
  86.         mov es,ScrSeg
  87.         mov ds,ScrSeg
  88.         mov cx,320*16
  89.         rep movsw
  90.         pop ds
  91.       end;
  92.       {setrgb(0,0,0,0);}
  93.     end;
  94.     inc(TxtPos);
  95.     if TxtPos = length(ScrTxt) then TxtPos := 1;
  96.   until keypressed;
  97. end;
  98.  
  99. {----------------------------------------------------------------------------}
  100.  
  101. begin
  102.   Videomode($13);
  103.   GetFont8x8;
  104.   Scroll;
  105.   textmode(lastmode);
  106. end.
  107.