home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 21 / SOLOPROG21.iso / disk21 / cdemos / demovga.pas next >
Encoding:
Pascal/Delphi Source File  |  1996-02-08  |  8.7 KB  |  460 lines
  1. {                                                                        }
  2. {  D E M O V G A      U N I T                                            }
  3. {                                                                        }
  4. {                           LearnWare Code by <rom / Spanish Lords       }
  5. {                           ■e-mail: crom@sol.parser.es ■FIDO: 2:342/6.9 }
  6. {                                                                        }
  7. Unit DemoVGA;
  8.  
  9. INTERFACE
  10. CONST
  11.   LogicalWide   =        320;
  12.   LogicalHeight =        200;
  13.  
  14. PROCEDURE McgaOn;
  15. PROCEDURE McgaOff;
  16. PROCEDURE VerticalRetrace;
  17. PROCEDURE PutColor      (Color,R,G,B:Byte);
  18. PROCEDURE GetColor      (Color:Byte;Var R,G,B:Byte);
  19. PROCEDURE CopyColor     (Desde:Byte;Hasta:Byte);
  20. PROCEDURE RotaPal       (Color1,Color2:Byte);
  21. PROCEDURE PutPalette    (SegPal,OffPal:Word);
  22. PROCEDURE PutPixel      (SegDes:Word;X,Y:Integer;Color:Byte);
  23. PROCEDURE DrawLineH     (SegDes,X1,X2,Y1:Word; Color:Byte);
  24. PROCEDURE DrawLineV     (SegDes,X1,Y1,Y2:Word; Color:Byte);
  25. PROCEDURE ReadRaw       (Var DestinoPtr:Pointer;FileName:String);
  26. PROCEDURE Copy64K       (SegOrg,SegDes:Word);
  27. PROCEDURE Fill64K       (SegDes:Word;Data:Byte);
  28. FUNCTION  Mcga2Off      (X,Y:Word):Word;
  29. PROCEDURE PutSprite     (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);
  30. PROCEDURE CopySprite    (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);
  31. PROCEDURE PutSpriteClip (SegOrg,OffOrg,SegDes:Word;XDes,YDes:Integer;XDim,YDim,X1Clip,Y1Clip,X2Clip,Y2Clip:Word);
  32.  
  33. IMPLEMENTATION
  34. Var
  35.   OldMode    : Byte;
  36.   AuxPalette : Array [1..768] of Byte;
  37.  
  38. PROCEDURE McgaOn;assembler;
  39. Asm
  40.   mov  ah,0Fh
  41.   int  10h
  42.   mov  OldMode,al
  43.   mov  ax,13h
  44.   int  10h
  45. End;
  46.  
  47. PROCEDURE McgaOff;assembler;
  48. Asm
  49.   mov  al,[OldMode]
  50.   xor  ah,ah
  51.   int  10h
  52. End;
  53.  
  54. PROCEDURE VerticalRetrace;assembler;
  55. Asm
  56.   mov  dx,3DAh
  57. @@1:
  58.   in   al,dx
  59.   test al,8
  60.   jnz  @@1
  61. @@2:
  62.   in   al,dx
  63.   test al,8
  64.   jz   @@2
  65. End;
  66.  
  67. PROCEDURE PutColor (Color,R,G,B:Byte);assembler;
  68. Asm
  69.   mov  dx,03C8h
  70.   mov  al,Color
  71.   cli
  72.   out  dx,al
  73.   inc  dx
  74.   mov  al,R
  75.   out  dx,al
  76.   mov  al,G
  77.   out  dx,al
  78.   mov  al,B
  79.   out  dx,al
  80.   sti
  81. End;
  82.  
  83. PROCEDURE GetColor2 (Color:Byte;Var R,G,B:Byte);assembler;
  84. Asm
  85.   mov  dx,03C7h
  86.   mov  al,Color
  87.   cli
  88.   out  dx,al
  89.   mov  dx,03C9h
  90.   in   al,dx
  91.   mov  BYTE PTR R,al
  92.   in   al,dx
  93.   mov  BYTE PTR G,al
  94.   in   al,dx
  95.   sti
  96.   mov  BYTE PTR B,al
  97. End;
  98.  
  99. PROCEDURE GetColor(Color:Byte; VAR R,G,B:Byte);
  100. Begin
  101.   Port[$3C7]:=Color;
  102.   R:=Port[$3C9];
  103.   G:=Port[$3C9];
  104.   B:=Port[$3C9];
  105. End;
  106.  
  107. PROCEDURE CopyColor  (Desde:Byte;Hasta:Byte);
  108. Var
  109.   R,G,B : Byte;
  110. Begin
  111.   GetColor (Desde,R,G,B);
  112.   PutColor (Hasta,R,G,B);
  113. End;
  114.  
  115.  
  116. PROCEDURE PutPalette (SegPal,OffPal:Word);assembler;
  117. Asm
  118.      cli
  119.      mov    dx,03C8h
  120.      xor    al,al
  121.      out    dx,al
  122.      sti
  123.      mov    ax,SegPal
  124.      mov    es,ax
  125.      mov    si,OffPal
  126.      xor    cx,cx
  127. @@Loop:
  128.      cli
  129.      mov    al,cl
  130.      out    dx,al
  131.      inc    dx
  132.      mov    al,es:[si]
  133.      out    dx,al
  134.      inc    si
  135.      mov    al,es:[si]
  136.      out    dx,al
  137.      inc    si
  138.      mov    al,es:[si]
  139.      out    dx,al
  140.      inc    si
  141.      sti
  142.      dec    dx
  143.      inc    cl
  144.      jnz    @@Loop
  145. End;
  146. { Rota la Paleta de colores desde un color dado hasta otro.}
  147. { Compruebo cual es mayor para rotar a un lado o otro.     }
  148.   Procedure RotaPal (Color1,Color2:Byte);
  149.     Var
  150.       Cnt    : Byte;
  151.  
  152.       CAux1R : Byte;
  153.       CAux1G : Byte;
  154.       CAux1B : Byte;
  155.  
  156.       CAux2R : Byte;
  157.       CAux2G : Byte;
  158.       CAux2B : Byte;
  159.     Begin
  160.       If Color2>Color1 then
  161.         Begin
  162.           GetColor (Color1,CAux1R,CAux1G,CAux1B);
  163.           For Cnt:=Color1+1 to Color2 do
  164.             Begin
  165.               GetColor (Cnt,CAux2R,CAux2G,CAux2B);
  166.               PutColor (Cnt-1,CAux2R,CAux2G,CAux2B);
  167.             End;
  168.           PutColor (Color2,CAux1R,CAux1G,CAux1B);
  169.         End
  170.       else
  171.         Begin
  172.           GetColor (Color1,CAux1R,CAux1G,CAux1B);
  173.           For Cnt:=Color1-1 downto Color2 do
  174.             Begin
  175.               GetColor (Cnt,CAux2R,CAux2G,CAux2B);
  176.               PutColor (Cnt+1,CAux2R,CAux2G,CAux2B);
  177.             End;
  178.           PutColor (Color2,CAux1R,CAux1G,CAux1B);
  179.         End;
  180.     End;
  181. PROCEDURE PutPixel   (SegDes:Word;X,Y:Integer;Color:byte);assembler;
  182. Asm
  183.   cmp  X,0
  184.   jl   @@End
  185.   cmp  Y,0
  186.   jl   @@End
  187.   cmp  X,319
  188.   jg   @@End
  189.   cmp  Y,199
  190.   jg   @@End
  191.   mov  ax,SegDes
  192.   mov  es,ax
  193.   mov  al,Color
  194.   mov  di,Y
  195.   mov  bx,X
  196.   mov  dx,di
  197.   xchg dh,dl
  198.   shl  di,6
  199.   add  di,dx
  200.   add  di,bx
  201.   mov  es:[di],al
  202. @@End:
  203. End;
  204. PROCEDURE DrawLineH(SegDes,X1,X2,Y1:Word; Color:Byte);assembler;
  205. Asm
  206.   mov  ax,SegDes
  207.   mov  es,ax
  208.   mov  ax,y1
  209.   mov  di,ax
  210.   shl  di,1
  211.   shl  di,1
  212.   add  di,ax
  213.   mov  cl,6
  214.   shl  di,cl
  215.   mov  bx,x1
  216.   mov  dx,x2
  217.   cmp  bx,dx
  218.   jl   @@1
  219.   xchg bx,dx
  220. @@1:
  221.   inc  dx
  222.   add  di,bx
  223.   mov  cx,dx
  224.   sub  cx,bx
  225.   shr  cx,1
  226.   mov  al,Color
  227.   mov  ah,al
  228.   ror  bx,1
  229.   jnb  @@2
  230.   stosb
  231.   ror  dx,1
  232.   jnb  @@3
  233.   dec  cx
  234. @@3:
  235.   rol  dx,1
  236. @@2:
  237.   rep  stosw
  238.   ror  dx,1
  239.   jnb  @@4
  240.   stosb
  241. @@4:
  242. End;
  243. PROCEDURE DrawLineV(SegDes,X1,Y1,Y2:Word; Color:Byte);assembler;
  244. Asm
  245.   mov  ax,x1
  246.   mov  bx,y1
  247.   mov  dx,y2
  248.   cmp  bx,dx
  249.   jl   @@1
  250.   xchg bx,dx
  251. @@1:
  252.   mov  di,bx
  253.   shl  di,1
  254.   shl  di,1
  255.   add  di,bx
  256.   mov  cl,6
  257.   shl  di,cl
  258.   add  di,ax
  259.   mov  cx,SegDes
  260.   mov  es,cx
  261.   mov  cx,dx
  262.   sub  cx,bx
  263.   inc  cx
  264.   mov  al,Color
  265.   mov  bx,319
  266. @@2:
  267.   stosb
  268.   add  di,bx
  269.   loop @@2
  270. End;
  271. Procedure ReadRaw (Var DestinoPtr:Pointer;FileName:String);
  272. Var
  273.   FFile : File;
  274. Begin
  275.   Assign (FFile,FileName);
  276.   Reset  (FFile,1);
  277.   BlockRead(FFile,DestinoPtr^,64768);
  278.   Close  (FFile);
  279. End;
  280. PROCEDURE Copy64K    (SegOrg,SegDes:Word);assembler;
  281. Asm
  282.   push ds
  283.   mov  ax,SegOrg
  284.   mov  ds,ax
  285.   mov  ax,SegDes
  286.   mov  es,ax
  287.   xor  di,di
  288.   xor  si,si
  289.   mov  cx,32000
  290.   rep movsw { optimize it!! rep movsd }
  291.   pop  ds
  292. End;
  293. PROCEDURE Fill64K    (SegDes:Word;Data:Byte);assembler;
  294. Asm
  295.   mov  ax,SegDes
  296.   mov  es,ax
  297.   xor  di,di
  298.   mov  al,Data
  299.   mov  ah,al
  300.   mov  cx,32000
  301.   rep  stosw { optimize it!! rep stosd }
  302. End;
  303.  
  304. FUNCTION Mcga2Off (X,Y:Word):Word;assembler;
  305. Asm
  306.   mov  ax,Y
  307.   mov  bx,X
  308.   mov  dx,ax
  309.   xchg dh,dl
  310.   shl  ax,6
  311.   add  ax,dx
  312.   add  ax,bx
  313. End;
  314. PROCEDURE PutSprite (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);assembler;
  315. Asm
  316.   push ds
  317.   mov  ax,SegDes
  318.   mov  es,ax
  319.   mov  di,OffDes
  320.   mov  ax,SegOrg
  321.   mov  ds,ax
  322.   mov  si,OffOrg
  323.   mov  bx,LogicalWide
  324.   sub  bx,XDim             { Wide Cte }
  325.   mov  dx,YDim
  326. @@MoreY:
  327.   mov  cx,XDim
  328. @@MoreX:
  329.   mov  al,ds:[si]
  330.   cmp  al,0
  331.   je   @@NoPut
  332.   mov  es:[di],al
  333. @@NoPut:
  334.   inc  di
  335.   inc  si
  336.   dec  cx
  337.   jnz  @@MoreX
  338.   add  di,bx
  339.   add  si,bx
  340.   dec  dx
  341.   jnz  @@MoreY
  342.   pop  ds
  343. End;
  344. PROCEDURE CopySprite (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);assembler;
  345. Asm
  346.   push ds
  347.   mov  ax,SegOrg
  348.   mov  ds,ax
  349.   mov  si,OffOrg
  350.   mov  ax,SegDes
  351.   mov  es,ax
  352.   mov  di,OffDes
  353.   mov  dx,LogicalWide
  354.   sub  dx,XDim             { Wide Cte }
  355.   mov  bx,YDim
  356. @@MoreY:
  357.   mov  cx,XDim
  358.   rep  movsb
  359.   add  si,dx
  360.   dec  bx
  361.   jnz  @@MoreY
  362.   pop  ds
  363. End;
  364. PROCEDURE PutSpriteClip (SegOrg,OffOrg,SegDes:Word;XDes,YDes:Integer;XDim,YDim,X1Clip,Y1Clip,X2Clip,Y2Clip:Word);assembler;
  365. Asm
  366.   mov  ax,X1Clip
  367.   mov  bx,XDes
  368.   add  bx,XDim
  369.   cmp  bx,ax
  370.   jle  @@End
  371.   mov  ax,Y1Clip
  372.   mov  bx,YDes
  373.   add  bx,YDim
  374.   cmp  bx,ax
  375.   jle  @@End
  376.   mov  ax,X2Clip
  377.   cmp  XDes,ax
  378.   jge  @@End
  379.   mov  ax,Y2Clip
  380.   cmp  YDes,ax
  381.   jge  @@End
  382.  
  383.   push ds
  384.   mov  ax,SegOrg
  385.   mov  ds,ax
  386.   mov  si,OffOrg
  387.   mov  ax,SegDes
  388.   mov  es,ax
  389.  
  390.   mov  ax,XDes
  391.   cmp  ax,X1Clip
  392.   jg   @@NoClipIzqdo
  393.   mov  ax,X1Clip
  394.   sub  ax,XDes
  395.   add  si,ax
  396.   mov  ax,XDes
  397.   add  ax,XDim
  398.   sub  ax,X1Clip
  399.   mov  XDim,ax
  400.   mov  ax,X1Clip
  401.   mov  XDes,ax
  402. @@NoClipIzqdo:
  403.   mov  ax,YDes
  404.   cmp  ax,Y1Clip
  405.   jg   @@NoClipSup
  406.   mov  ax,Y1Clip
  407.   sub  ax,YDes
  408.   mov  bx,LogicalWide
  409.   imul bx
  410.   add  si,ax
  411.   mov  ax,YDes
  412.   add  ax,YDim
  413.   sub  ax,Y1Clip
  414.   mov  YDim,ax
  415.   mov  ax,Y1Clip
  416.   mov  YDes,ax
  417. @@NoClipSup:
  418.   mov  ax,LogicalWide  { Calcula el offset }
  419.   mov  bx,YDes
  420.   imul bx
  421.   mov  di,ax
  422.   add  di,XDes
  423.   mov  ax,XDes
  424.   add  ax,XDim
  425.   cmp  ax,X2Clip
  426.   jl   @@NoClipDrcho
  427.   mov  ax,X2Clip
  428.   sub  ax,XDes
  429.   mov  XDim,ax
  430. @@NoClipDrcho:
  431.   mov  ax,YDes
  432.   add  ax,YDim
  433.   cmp  ax,Y2Clip
  434.   jl   @@NoClipInf
  435.   mov  ax,Y2Clip
  436.   sub  ax,YDes
  437.   mov  YDim,ax
  438. @@NoClipInf:
  439.   mov  cx,LogicalWide  { Cte de cambio de linea }
  440.   sub  cx,XDim
  441. @@AnotherLine:
  442.   mov  dx,XDim
  443. @@AnotherPix:
  444.   mov  al,ds:[si]
  445.   cmp  al,0
  446.   je   @@NoPutPix
  447.   mov  es:[di],al
  448. @@NoPutPix:
  449.   inc  di
  450.   inc  si
  451.   dec  dx
  452.   jnz  @@AnotherPix
  453.   add  di,cx
  454.   add  si,cx
  455.   dec  YDim
  456.   jnz  @@AnotherLine
  457.   pop  ds
  458. @@End:
  459. End;
  460. END.