home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / disk22 / cdemos / demovga.pas next >
Encoding:
Pascal/Delphi Source File  |  1996-04-12  |  11.0 KB  |  626 lines
  1. {                                                                        }
  2. {  D E M O V G A      U N I T                                            }
  3. {                                                                        }
  4. {                           LearnWare Code by <rom / Spanish Lords       }
  5. {                           Extracts by The Faker. Thanks and greetings :}
  6. {                           ■e-mail: crom@sol.parser.es ■FIDO: 2:342/6.9 }
  7. {                                                                        }
  8. Unit DemoVGA;
  9.  
  10. INTERFACE
  11. CONST
  12.   LogicalWide   =        320;
  13.   LogicalHeight =        200;
  14.  
  15. PROCEDURE McgaOn;
  16. PROCEDURE McgaOff;
  17. PROCEDURE VerticalRetrace;
  18. PROCEDURE PutColor      (Color,R,G,B:Byte);
  19. PROCEDURE GetColor      (Color:Byte;Var R,G,B:Byte);
  20. PROCEDURE CopyColor     (Desde:Byte;Hasta:Byte);
  21. PROCEDURE RotaPal       (Color1,Color2:Byte);
  22. PROCEDURE PutPalette    (SegPal,OffPal:Word);
  23. PROCEDURE PutPixel      (SegDes:Word;X,Y:Integer;Color:Byte);
  24. PROCEDURE DrawLineH     (SegDes,X1,X2,Y1:Word; Color:Byte);
  25. PROCEDURE DrawLineV     (SegDes,X1,Y1,Y2:Word; Color:Byte);
  26. PROCEDURE DrawLine      (SegDes:Word;X1,Y1,X2,Y2:Integer; Color:Byte);
  27. PROCEDURE ReadRaw       (Var DestinoPtr:Pointer;FileName:String);
  28. PROCEDURE Copy64K       (SegOrg,SegDes:Word);
  29. PROCEDURE Fill64K       (SegDes:Word;Data:Byte);
  30. FUNCTION  Mcga2Off      (X,Y:Word):Word;
  31. PROCEDURE PutSprite     (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);
  32. PROCEDURE CopySprite    (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);
  33. PROCEDURE PutSpriteClip (SegOrg,OffOrg,SegDes:Word;XDes,YDes:Integer;XDim,YDim,X1Clip,Y1Clip,X2Clip,Y2Clip:Word);
  34.  
  35. IMPLEMENTATION
  36. Var
  37.   OldMode    : Byte;
  38.   AuxPalette : Array [1..768] of Byte;
  39.  
  40. PROCEDURE McgaOn;assembler;
  41. Asm
  42.   mov  ah,0Fh
  43.   int  10h
  44.   mov  OldMode,al
  45.   mov  ax,13h
  46.   int  10h
  47. End;
  48.  
  49. PROCEDURE McgaOff;assembler;
  50. Asm
  51.   mov  al,[OldMode]
  52.   xor  ah,ah
  53.   int  10h
  54. End;
  55.  
  56. PROCEDURE VerticalRetrace;assembler;
  57. Asm
  58.   mov  dx,3DAh
  59. @@1:
  60.   in   al,dx
  61.   test al,8
  62.   jnz  @@1
  63. @@2:
  64.   in   al,dx
  65.   test al,8
  66.   jz   @@2
  67. End;
  68.  
  69. PROCEDURE PutColor (Color,R,G,B:Byte);assembler;
  70. Asm
  71.   mov  dx,03C8h
  72.   mov  al,Color
  73.   cli
  74.   out  dx,al
  75.   inc  dx
  76.   mov  al,R
  77.   out  dx,al
  78.   mov  al,G
  79.   out  dx,al
  80.   mov  al,B
  81.   out  dx,al
  82.   sti
  83. End;
  84.  
  85. PROCEDURE GetColor2 (Color:Byte;Var R,G,B:Byte);assembler;
  86. Asm
  87.   mov  dx,03C7h
  88.   mov  al,Color
  89.   cli
  90.   out  dx,al
  91.   mov  dx,03C9h
  92.   in   al,dx
  93.   mov  BYTE PTR R,al
  94.   in   al,dx
  95.   mov  BYTE PTR G,al
  96.   in   al,dx
  97.   sti
  98.   mov  BYTE PTR B,al
  99. End;
  100.  
  101. PROCEDURE GetColor(Color:Byte; VAR R,G,B:Byte);
  102. Begin
  103.   Port[$3C7]:=Color;
  104.   R:=Port[$3C9];
  105.   G:=Port[$3C9];
  106.   B:=Port[$3C9];
  107. End;
  108.  
  109. PROCEDURE CopyColor  (Desde:Byte;Hasta:Byte);
  110. Var
  111.   R,G,B : Byte;
  112. Begin
  113.   GetColor (Desde,R,G,B);
  114.   PutColor (Hasta,R,G,B);
  115. End;
  116.  
  117.  
  118. PROCEDURE PutPalette (SegPal,OffPal:Word);assembler;
  119. Asm
  120.      cli
  121.      mov    dx,03C8h
  122.      xor    al,al
  123.      out    dx,al
  124.      sti
  125.      mov    ax,SegPal
  126.      mov    es,ax
  127.      mov    si,OffPal
  128.      xor    cx,cx
  129. @@Loop:
  130.      cli
  131.      mov    al,cl
  132.      out    dx,al
  133.      inc    dx
  134.      mov    al,es:[si]
  135.      out    dx,al
  136.      inc    si
  137.      mov    al,es:[si]
  138.      out    dx,al
  139.      inc    si
  140.      mov    al,es:[si]
  141.      out    dx,al
  142.      inc    si
  143.      sti
  144.      dec    dx
  145.      inc    cl
  146.      jnz    @@Loop
  147. End;
  148. { Rota la Paleta de colores desde un color dado hasta otro.}
  149. { Compruebo cual es mayor para rotar a un lado o otro.     }
  150.   Procedure RotaPal (Color1,Color2:Byte);
  151.     Var
  152.       Cnt    : Byte;
  153.  
  154.       CAux1R : Byte;
  155.       CAux1G : Byte;
  156.       CAux1B : Byte;
  157.  
  158.       CAux2R : Byte;
  159.       CAux2G : Byte;
  160.       CAux2B : Byte;
  161.     Begin
  162.       If Color2>Color1 then
  163.         Begin
  164.           GetColor (Color1,CAux1R,CAux1G,CAux1B);
  165.           For Cnt:=Color1+1 to Color2 do
  166.             Begin
  167.               GetColor (Cnt,CAux2R,CAux2G,CAux2B);
  168.               PutColor (Cnt-1,CAux2R,CAux2G,CAux2B);
  169.             End;
  170.           PutColor (Color2,CAux1R,CAux1G,CAux1B);
  171.         End
  172.       else
  173.         Begin
  174.           GetColor (Color1,CAux1R,CAux1G,CAux1B);
  175.           For Cnt:=Color1-1 downto Color2 do
  176.             Begin
  177.               GetColor (Cnt,CAux2R,CAux2G,CAux2B);
  178.               PutColor (Cnt+1,CAux2R,CAux2G,CAux2B);
  179.             End;
  180.           PutColor (Color2,CAux1R,CAux1G,CAux1B);
  181.         End;
  182.     End;
  183. PROCEDURE PutPixel   (SegDes:Word;X,Y:Integer;Color:byte);assembler;
  184. Asm
  185.   cmp  X,0
  186.   jl   @@End
  187.   cmp  Y,0
  188.   jl   @@End
  189.   cmp  X,319
  190.   jg   @@End
  191.   cmp  Y,199
  192.   jg   @@End
  193.   mov  ax,SegDes
  194.   mov  es,ax
  195.   mov  al,Color
  196.   mov  di,Y
  197.   mov  bx,X
  198.   mov  dx,di
  199.   xchg dh,dl
  200.   shl  di,6
  201.   add  di,dx
  202.   add  di,bx
  203.   mov  es:[di],al
  204. @@End:
  205. End;
  206. PROCEDURE DrawLineH(SegDes,X1,X2,Y1:Word; Color:Byte);assembler;
  207. Asm
  208.   mov  ax,SegDes
  209.   mov  es,ax
  210.   mov  ax,y1
  211.   mov  di,ax
  212.   shl  di,1
  213.   shl  di,1
  214.   add  di,ax
  215.   mov  cl,6
  216.   shl  di,cl
  217.   mov  bx,x1
  218.   mov  dx,x2
  219.   cmp  bx,dx
  220.   jl   @@1
  221.   xchg bx,dx
  222. @@1:
  223.   inc  dx
  224.   add  di,bx
  225.   mov  cx,dx
  226.   sub  cx,bx
  227.   shr  cx,1
  228.   mov  al,Color
  229.   mov  ah,al
  230.   ror  bx,1
  231.   jnb  @@2
  232.   mov  es:[di],al
  233.   inc  di
  234.   ror  dx,1
  235.   jnb  @@3
  236.   dec  cx
  237. @@3:
  238.   rol  dx,1
  239. @@2:
  240.   rep  stosw
  241.   ror  dx,1
  242.   jnb  @@4
  243.   mov  es:[di],al
  244.   inc  di
  245. @@4:
  246. End;
  247. PROCEDURE DrawLineV(SegDes,X1,Y1,Y2:Word; Color:Byte);assembler;
  248. Asm
  249.   mov  ax,x1
  250.   mov  bx,y1
  251.   mov  dx,y2
  252.   cmp  bx,dx
  253.   jl   @@1
  254.   xchg bx,dx
  255. @@1:
  256.   mov  di,bx
  257.   shl  di,1
  258.   shl  di,1
  259.   add  di,bx
  260.   mov  cl,6
  261.   shl  di,cl
  262.   add  di,ax
  263.   mov  cx,SegDes
  264.   mov  es,cx
  265.   mov  cx,dx
  266.   sub  cx,bx
  267.   inc  cx
  268.   mov  al,Color
  269.   mov  bx,319
  270. @@2:
  271.   mov  es:[di],al
  272.   inc  di
  273.   add  di,bx
  274.   loop @@2
  275. End;
  276. Procedure DrawLine(SegDes:Word;X1,Y1,X2,Y2:Integer; Color:Byte);assembler;
  277. Asm
  278.   mov  al,Color
  279.   xor  ah,ah
  280.   mov  si,ax
  281.   mov  ax,x1
  282.   cmp  ax,319
  283.   ja  @@TheEnd
  284.   mov  bx,x2
  285.   cmp  bx,319
  286.   ja   @@TheEnd
  287.   mov  cx,y1
  288.   cmp  cx,199
  289.   ja   @@TheEnd
  290.   mov  dx,y2
  291.   cmp  dx,199
  292.   ja   @@TheEnd
  293.   cmp  ax,bx
  294.   jnz  @@Horizontal
  295.   cmp  cx,dx
  296.   jnz  @@vertical
  297.   push SegDes
  298.   push ax
  299.   push cx
  300.   push si
  301.   call Putpixel
  302.   jmp  @@TheEnd
  303. @@Horizontal:
  304.   cmp  cx,dx
  305.   jnz  @@Horizontal2
  306.   push SegDes
  307.   push ax
  308.   push bx
  309.   push cx
  310.   push si
  311.   call DrawLineH
  312.   jmp  @@TheEnd
  313. @@Vertical:
  314.   push SegDes
  315.   push ax
  316.   push cx
  317.   push dx
  318.   push si
  319.   call DrawLineV
  320.   jmp @@TheEnd
  321. @@Horizontal2:
  322.   cmp  cx,dx
  323.   jbe  @@1
  324.   xchg cx,dx
  325.   xchg ax,bx
  326. @@1:
  327.   mov  di,cx
  328.   shl  di,1
  329.   shl  di,1
  330.   add  di,cx
  331.   push si
  332.   mov  si,bx
  333.   mov  bx,dx
  334.   sub  bx,cx
  335.   mov  cl,06
  336.   shl  di,cl
  337.   add  di,ax
  338.   mov  dx,si
  339.   pop  si
  340.   sub  dx,ax
  341.   mov  ax,SegDes
  342.   mov  es,ax
  343.   mov  ax,si
  344.   push bp
  345.   or   dx,0
  346.   jge  @@Jmp1
  347.   neg  dx
  348.   cmp  dx,bx
  349.   jbe  @@Jmp3
  350.   mov  cx,dx
  351.   inc  cx
  352.   mov  si,dx
  353.   shr  si,1
  354.   std
  355.   mov  bp,320
  356. @@1c:
  357.   stosb
  358. @@1b:
  359.   or   si,si
  360.   jge  @@1a
  361.   add  di,bp
  362.   add  si,dx
  363.   jmp  @@1b
  364. @@1a:
  365.   sub  si,bx
  366.   loop @@1c
  367.   jmp  @@TheEnd2
  368. @@Jmp3:
  369.   mov  cx,bx
  370.   inc  cx
  371.   mov  si,bx
  372.   neg  si
  373.   sar  si,1
  374.   cld
  375.   mov  bp,319
  376. @@2c:
  377.   stosb
  378. @@2b:
  379.   or   si,si
  380.   jl   @@2a
  381.   sub  si,bx
  382.   dec  di
  383.   jmp  @@2b
  384. @@2a:
  385.   add  di,bp
  386.   add  si,dx
  387.   loop @@2c
  388.   jmp  @@TheEnd2
  389. @@Jmp1:
  390.   cmp  dx,bx
  391.   jbe  @@Jmp4
  392.   mov  cx,dx
  393.   inc  cx
  394.   mov  si,dx
  395.   shr  si,1
  396.   cld
  397.   mov  bp,320
  398. @@3c:
  399.   stosb
  400. @@3b:
  401.   or   si,si
  402.   jge  @@3a
  403.   add  di,bp
  404.   add  si,dx
  405.   jmp  @@3b
  406. @@3a:
  407.   sub  si,bx
  408.   loop @@3c
  409.   jmp  @@TheEnd2
  410. @@Jmp4:
  411.   mov  cx,bx
  412.   inc  cx
  413.   mov  si,bx
  414.   neg  si
  415.   sar  si,1
  416.   std
  417.   mov  bp,321
  418. @@4c:
  419.   stosb
  420. @@4b:
  421.   or   si,si
  422.   jl   @@4a
  423.   sub  si,bx
  424.   inc  di
  425.   jmp  @@4b
  426. @@4a:
  427.   add  di,bp
  428.   add  si,dx
  429.   loop @@4c
  430. @@TheEnd2:
  431.   pop  bp
  432.   cld
  433. @@TheEnd:
  434. End;
  435. Procedure ReadRaw (Var DestinoPtr:Pointer;FileName:String);
  436. Var
  437.   FFile : File;
  438. Begin
  439.   Assign (FFile,FileName);
  440.   Reset  (FFile,1);
  441.   BlockRead(FFile,DestinoPtr^,64768);
  442.   Close  (FFile);
  443. End;
  444. PROCEDURE Copy64K    (SegOrg,SegDes:Word);assembler;
  445. Asm
  446.   push ds
  447.   mov  ax,SegOrg
  448.   mov  ds,ax
  449.   mov  ax,SegDes
  450.   mov  es,ax
  451.   xor  di,di
  452.   xor  si,si
  453.   mov  cx,32000
  454.   rep movsw { optimize it!! rep movsd }
  455.   pop  ds
  456. End;
  457. PROCEDURE Fill64K    (SegDes:Word;Data:Byte);assembler;
  458. Asm
  459.   mov  ax,SegDes
  460.   mov  es,ax
  461.   xor  di,di
  462.   mov  al,Data
  463.   mov  ah,al
  464.   mov  cx,32000
  465.   rep  stosw { optimize it!! rep stosd }
  466. End;
  467.  
  468. FUNCTION Mcga2Off (X,Y:Word):Word;assembler;
  469. Asm
  470.   mov  ax,Y
  471.   mov  bx,X
  472.   mov  dx,ax
  473.   xchg dh,dl
  474.   shl  ax,6
  475.   add  ax,dx
  476.   add  ax,bx
  477. End;
  478. PROCEDURE PutSprite (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);assembler;
  479. Asm
  480.   push ds
  481.   mov  ax,SegDes
  482.   mov  es,ax
  483.   mov  di,OffDes
  484.   mov  ax,SegOrg
  485.   mov  ds,ax
  486.   mov  si,OffOrg
  487.   mov  bx,LogicalWide
  488.   sub  bx,XDim             { Wide Cte }
  489.   mov  dx,YDim
  490. @@MoreY:
  491.   mov  cx,XDim
  492. @@MoreX:
  493.   mov  al,ds:[si]
  494.   cmp  al,0
  495.   je   @@NoPut
  496.   mov  es:[di],al
  497.   inc  di
  498. @@NoPut:
  499.   inc  di
  500.   inc  si
  501.   dec  cx
  502.   jnz  @@MoreX
  503.   add  di,bx
  504.   add  si,bx
  505.   dec  dx
  506.   jnz  @@MoreY
  507.   pop  ds
  508. End;
  509. PROCEDURE CopySprite (SegOrg,OffOrg,SegDes,OffDes,XDim,YDim:Word);assembler;
  510. Asm
  511.   push ds
  512.   mov  ax,SegOrg
  513.   mov  ds,ax
  514.   mov  si,OffOrg
  515.   mov  ax,SegDes
  516.   mov  es,ax
  517.   mov  di,OffDes
  518.   mov  dx,LogicalWide
  519.   sub  dx,XDim             { Wide Cte }
  520.   mov  bx,YDim
  521. @@MoreY:
  522.   mov  cx,XDim
  523.   rep  movsb
  524.   add  si,dx
  525.   dec  bx
  526.   jnz  @@MoreY
  527.   pop  ds
  528. End;
  529. PROCEDURE PutSpriteClip (SegOrg,OffOrg,SegDes:Word;XDes,YDes:Integer;XDim,YDim,X1Clip,Y1Clip,X2Clip,Y2Clip:Word);assembler;
  530. Asm
  531.   mov  ax,X1Clip
  532.   mov  bx,XDes
  533.   add  bx,XDim
  534.   cmp  bx,ax
  535.   jle  @@End
  536.   mov  ax,Y1Clip
  537.   mov  bx,YDes
  538.   add  bx,YDim
  539.   cmp  bx,ax
  540.   jle  @@End
  541.   mov  ax,X2Clip
  542.   cmp  XDes,ax
  543.   jge  @@End
  544.   mov  ax,Y2Clip
  545.   cmp  YDes,ax
  546.   jge  @@End
  547.  
  548.   push ds
  549.   mov  ax,SegOrg
  550.   mov  ds,ax
  551.   mov  si,OffOrg
  552.   mov  ax,SegDes
  553.   mov  es,ax
  554.  
  555.   mov  ax,XDes
  556.   cmp  ax,X1Clip
  557.   jg   @@NoClipIzqdo
  558.   mov  ax,X1Clip
  559.   sub  ax,XDes
  560.   add  si,ax
  561.   mov  ax,XDes
  562.   add  ax,XDim
  563.   sub  ax,X1Clip
  564.   mov  XDim,ax
  565.   mov  ax,X1Clip
  566.   mov  XDes,ax
  567. @@NoClipIzqdo:
  568.   mov  ax,YDes
  569.   cmp  ax,Y1Clip
  570.   jg   @@NoClipSup
  571.   mov  ax,Y1Clip
  572.   sub  ax,YDes
  573.   mov  bx,LogicalWide
  574.   imul bx
  575.   add  si,ax
  576.   mov  ax,YDes
  577.   add  ax,YDim
  578.   sub  ax,Y1Clip
  579.   mov  YDim,ax
  580.   mov  ax,Y1Clip
  581.   mov  YDes,ax
  582. @@NoClipSup:
  583.   mov  ax,LogicalWide  { Calcula el offset }
  584.   mov  bx,YDes
  585.   imul bx
  586.   mov  di,ax
  587.   add  di,XDes
  588.   mov  ax,XDes
  589.   add  ax,XDim
  590.   cmp  ax,X2Clip
  591.   jl   @@NoClipDrcho
  592.   mov  ax,X2Clip
  593.   sub  ax,XDes
  594.   mov  XDim,ax
  595. @@NoClipDrcho:
  596.   mov  ax,YDes
  597.   add  ax,YDim
  598.   cmp  ax,Y2Clip
  599.   jl   @@NoClipInf
  600.   mov  ax,Y2Clip
  601.   sub  ax,YDes
  602.   mov  YDim,ax
  603. @@NoClipInf:
  604.   mov  cx,LogicalWide  { Cte de cambio de linea }
  605.   sub  cx,XDim
  606. @@AnotherLine:
  607.   mov  dx,XDim
  608. @@AnotherPix:
  609.   mov  al,ds:[si]
  610.   cmp  al,0
  611.   je   @@NoPutPix
  612.   mov  es:[di],al
  613.   inc  di
  614. @@NoPutPix:
  615.   inc  di
  616.   inc  si
  617.   dec  dx
  618.   jnz  @@AnotherPix
  619.   add  di,cx
  620.   add  si,cx
  621.   dec  YDim
  622.   jnz  @@AnotherLine
  623.   pop  ds
  624. @@End:
  625. End;
  626. END.