home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / demosrce / vectmorf / vectk.pas next >
Encoding:
Pascal/Delphi Source File  |  1994-08-01  |  5.4 KB  |  351 lines
  1. UNIT VECTK;
  2.  
  3. INTERFACE
  4.  
  5. PROCEDURE YMode360x480;
  6. PROCEDURE YModeTexte;
  7. PROCEDURE YRemplitEcran(couleur:BYTE);
  8. PROCEDURE YLigne (x,y,x2,y2:WORD;couleur:BYTE);
  9. PROCEDURE YAttenteSynchro;
  10. PROCEDURE PauseSynchro(soixantedixiemes:WORD);
  11. PROCEDURE VideTamponClavier;
  12. FUNCTION  ToucheAppuyee:BOOLEAN;
  13.  
  14. IMPLEMENTATION
  15.  
  16. PROCEDURE YMode360x480;ASSEMBLER;
  17. ASM
  18.   mov   ax, 013h
  19.   int   10h
  20.   mov   dx, 03C4h
  21.   mov   ax, 0604h
  22.   out   dx, ax
  23.   mov   ax, 0F02h
  24.   out   dx, ax
  25.   mov   dx, 03C2h
  26.   mov   ax, 0E7h
  27.   out   dx, ax
  28.   mov   dx, 03D4h
  29.   mov   ax, 011h
  30.   out   dx, ax
  31.   inc   dx
  32.   in    al, dx
  33.   and   al, 7Fh
  34.   dec   dx
  35.   mov   cx, ax
  36.   mov   ax, 011h
  37.   out   dx, ax
  38.   inc   dx
  39.   mov   cx, ax
  40.   out   dx, ax
  41.   dec   dx
  42.   {Les 18 registres CRTC du mode 360x480}
  43.   mov   ax, 6B00h
  44.   out   dx, ax
  45.   mov   ax, 5901h
  46.   out   dx, ax
  47.   mov   ax, 5A02h
  48.   out   dx, ax
  49.   mov   ax, 8E03h
  50.   out   dx, ax
  51.   mov   ax, 5E04h
  52.   out   dx, ax
  53.   mov   ax, 8A05h
  54.   out   dx, ax
  55.   mov   ax, 0D06h
  56.   out   dx, ax
  57.   mov   ax, 3E07h
  58.   out   dx, ax
  59.   mov   ax, 4009h
  60.   out   dx, ax
  61.   mov   ax, 0EA10h
  62.   out   dx, ax
  63.   mov   ax, 0DF12h
  64.   out   dx, ax
  65.   mov   ax, 2D13h
  66.   out   dx, ax
  67.   mov   ax, 0014h
  68.   out   dx, ax
  69.   mov   ax, 0E715h
  70.   out   dx, ax
  71.   mov   ax, 0616h
  72.   out   dx, ax
  73.   mov   ax, 0E317h
  74.   out   dx, ax
  75.   mov   ax, 0AC11h
  76.   out   dx, ax
  77. END;
  78.  
  79.  
  80. PROCEDURE YModeTexte;ASSEMBLER;
  81. ASM
  82.   mov   ax, 03h
  83.   int   10h
  84. END;
  85.  
  86.  
  87. PROCEDURE YAttenteSynchro;ASSEMBLER;
  88. ASM
  89.   mov   dx, 03DAh
  90.  @Bcl1:
  91.   in    al, dx
  92.   test  al, 8
  93.   jnz   @Bcl1
  94.  @Bcl2:
  95.   in    al, dx
  96.   test  al, 8
  97.   jz    @Bcl2
  98. END;
  99.  
  100.  
  101. PROCEDURE YRemplitEcran(couleur:BYTE);ASSEMBLER;
  102. ASM
  103.   mov   ax, 0A000h
  104.   mov   es, ax
  105.   mov   dx, 3C4h
  106.   mov   ax, 0F02h
  107.   out   dx, ax
  108.   xor   di, di
  109.   mov   cx, 8000h
  110.   cld
  111.   mov   al, couleur
  112.   mov   ah, al
  113.   repz  stosw
  114. END;
  115.  
  116.  
  117. PROCEDURE YLigne(x,y,x2,y2:WORD;couleur:BYTE);ASSEMBLER;
  118. VAR
  119.   IncVert,Inc1,Inc2,Routine:WORD;
  120. ASM
  121.   mov   ax, 0A000h
  122.   mov   es, ax
  123.   mov   dx, 03C4h
  124.   mov   si, 90
  125.   mov   cx, x2
  126.   sub   cx, x
  127.   jz    @@LigneVert
  128.   jns   @@L01
  129.   neg   cx
  130.   mov   bx, x2
  131.   xchg  bx, x
  132.   mov   x2, bx
  133.   mov   bx, y2
  134.   xchg  bx, y
  135.   mov   y2, bx
  136.  @@L01:
  137.   mov   bx, y2
  138.   sub   bx, y
  139.   jnz   @@Saut
  140.   jmp   @@LigneHori
  141.  @@Saut:
  142.   jns   @@L03
  143.   neg   bx
  144.   neg   si
  145.  @@L03:
  146.   mov   incvert, si
  147.   mov   routine, offset @@PenteB
  148.   cmp   bx, cx
  149.   jle   @@L04
  150.   mov   routine, offset @@PenteH
  151.   xchg  bx, cx
  152.  @@L04:
  153.   shl   bx, 1
  154.   mov   inc1, bx
  155.   sub   bx, cx
  156.   mov   si, bx
  157.   sub   bx, cx
  158.   mov   inc2, bx
  159.   push  cx
  160.   mov   ax, y
  161.   mov   bx, x
  162.   mov   cl, bl
  163.   push  dx
  164.   mov   dx, 90
  165.   mul   dx
  166.   pop   dx
  167.   shr   bx, 2
  168.   add   bx, ax
  169.   and   cl, 3
  170.   mov   di, bx
  171.   mov   al, 1
  172.   shl   al, cl
  173.   mov   ah, al
  174.   shl   al, 4
  175.   add   ah, al
  176.   mov   bl, ah
  177.   pop   cx
  178.   inc   cx
  179.   jmp   routine
  180.  @@LigneVert:
  181.   mov   ax, y
  182.   mov   bx, y2
  183.   mov   cx, bx
  184.   sub   cx, ax
  185.   jge   @@L31
  186.   neg   cx
  187.   mov   ax, bx
  188.  @@L31:
  189.   inc   cx
  190.   mov   bx, x
  191.   push  cx
  192.   mov   cl, bl
  193.   push  dx
  194.   mov   dx, 90
  195.   mul   dx
  196.   pop   dx
  197.   shr   bx, 2
  198.   add   bx, ax
  199.   and   cl, 3
  200.   mov   ah, 1
  201.   shl   ah, cl
  202.   mov   al, 02h
  203.   out   dx, ax
  204.   pop   cx
  205.   mov   ax, word ptr [couleur]
  206.  @@L32:
  207.   mov   es:[bx], al
  208.   add   bx, si
  209.   loop  @@L32
  210.   jmp   @@Lexit
  211.  @@LigneHori:
  212.   push  ds
  213.   mov   ax, y
  214.   mov   bx, x
  215.   mov   cl, bl
  216.   push  dx
  217.   mov   dx, 90
  218.   mul   dx
  219.   pop   dx
  220.   shr   bx, 2
  221.   add   bx, ax
  222.   and   cl, 3
  223.   mov   di, bx
  224.   mov   dl, 00Fh
  225.   shl   dl, cl
  226.   mov   cx, x2
  227.   and   cl, 3
  228.   mov   dh, 00Eh
  229.   shl   dh, cl
  230.   not   dh
  231.   mov   ax, x2
  232.   mov   bx, x
  233.   shr   ax, 2
  234.   shr   bx, 2
  235.   mov   cx, ax
  236.   sub   cx, bx
  237.   mov   ax, dx
  238.   mov   dx, 03C4h
  239.   mov   bx, word ptr [couleur]
  240.   or    cx, cx
  241.   jnz   @@L42
  242.   and   ah, al
  243.   jmp   @@L44
  244.  @@L42:
  245.   push  ax
  246.   mov   ah, al
  247.   mov   al, 02h
  248.   out   dx, ax
  249.   mov   al, bl
  250.   stosb
  251.   dec   cx
  252.  @@L43:
  253.   mov   ah, 0Fh
  254.   mov   al, 02h
  255.   out   dx, ax
  256.   mov   al, bl
  257.   rep   stosb
  258.   pop   ax
  259.  @@L44:
  260.   mov   al, 02h
  261.   out   dx, ax
  262.   mov   byte ptr es:[di], bl
  263.   pop   ds
  264.   jmp   @@Lexit
  265.  @@PenteB:
  266.   mov   al, 02h
  267.   mov   bh, byte ptr [couleur]
  268.  @@L10:
  269.   mov   ah, bl
  270.  @@L11:
  271.   or    ah, bl
  272.   rol   bl, 1
  273.   jc    @@L14
  274.   or    si, si
  275.   jns   @@L12
  276.   add   si, inc1
  277.   loop  @@L11
  278.   out   dx, ax
  279.   mov   es:[di], bh
  280.   jmp   @@Lexit
  281.  @@L12:
  282.   add   si, inc2
  283.   out   dx, ax
  284.   mov   es:[di], bh
  285.   add   di, incvert
  286.   loop  @@L10
  287.   jmp   @@Lexit
  288.  @@L14:
  289.   out   dx, ax
  290.   mov   es:[di], bh
  291.   inc   di
  292.   or    si, si
  293.   jns   @@L15
  294.   add   si, inc1
  295.   loop  @@L10
  296.   jmp   @@Lexit
  297.  @@L15:
  298.   add   si, inc2
  299.   add   di, incvert
  300.   loop  @@L10
  301.   jmp   @@Lexit
  302.  @@PenteH:
  303.   mov   bx, incvert
  304.   mov   al, 02h
  305.  @@L21:
  306.   out   dx, ax
  307.   push  ax
  308.   mov   ax, word ptr [couleur]
  309.   mov   es:[di], al
  310.   pop   ax
  311.   add   di, bx
  312.  @@L22:
  313.   or    si, si
  314.   jns   @@L23
  315.   add   si, inc1
  316.   loop  @@L21
  317.   jmp   @@Lexit
  318.  @@L23:
  319.   add   si, inc2
  320.   rol   ah, 1
  321.   adc   di, 0
  322.  @@lx21:
  323.   loop  @@L21
  324.  @@Lexit:
  325. END;
  326.  
  327.  
  328. PROCEDURE PauseSynchro(soixantedixiemes:WORD);
  329. VAR
  330.   i:WORD;
  331. BEGIN
  332.   FOR i:=1 TO soixantedixiemes DO
  333.     YAttenteSynchro;
  334. END;
  335.  
  336.  
  337. PROCEDURE VideTamponClavier;
  338. BEGIN
  339.   MemW[$40:$1A]:=MemW[$40:$1C];
  340. END;
  341.  
  342.  
  343. FUNCTION ToucheAppuyee:BOOLEAN;ASSEMBLER;
  344. ASM
  345.   mov   ah, 0Bh
  346.   int   21h
  347.   and   al, 0FEh
  348. END;
  349.  
  350.  
  351. END.