home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD2.mdf / doc / graphdoc / supervga.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-14  |  53KB  |  1,830 lines
  1.  
  2. unit supervga;
  3.  
  4. interface
  5. uses dos;
  6.  
  7.  
  8.  
  9.   {$i defvga.pas}   {Definitions}
  10.  
  11. {$i idvga.pas}
  12.  
  13.  
  14.  
  15.   (*  Set memory bank  *)
  16.  
  17. procedure setbank(bank:word);
  18. var x:word;
  19. begin
  20.   if bank=curbank then exit;   {Only set bank if diff. from current value}
  21.   vseg:=$a000;
  22.   curbank:=bank;
  23.   case chip of
  24.     __aheadA:begin
  25.                wrinx(GRC,13,bank shr 1);
  26.                x:=inp($3cc) and $df;
  27.                if odd(bank) then inc(x,32);
  28.                outp($3c2,x);
  29.              end;
  30.     __aheadB:wrinx(GRC,13,bank*17);
  31.     __al2101:begin
  32.                outp($3d7,bank);
  33.                outp($3D6,bank);
  34.              end;
  35.       __ati1:modinx(IOadr,$b2,$1e,bank shl 1);
  36.       __ati2:begin
  37.                x:=bank*$22;          {Roll bank nbr into bit 0}
  38.                modinx(IOadr,$b2,$ff,hi(x) or lo(x));
  39.              end;
  40.     __atiGUP:begin
  41.                x:=(bank and 15)*$22;          {Roll bank nbr into bit 0}
  42.                modinx(IOadr,$b2,$ff,hi(x) or lo(x));
  43.                modinx(IOadr,$AE,3,bank shr 4);
  44.              end;
  45.   __chips451:wrinx(IOadr,$B,bank);
  46.   __chips452:begin
  47.                if memmode<=_pl4 then bank:=bank shl 2;
  48.                wrinx(IOadr,$10,bank shl 2);
  49.              end;
  50.   __chips453:begin
  51.                if memmode<=_pl4 then bank:=bank shl 2;
  52.                wrinx(IOadr,$10,bank shl 4);
  53.              end;
  54.      __cir54:begin
  55.                if (rdinx(GRC,$B) and 32)=0 then bank:=bank shl 2;
  56.                wrinx(GRC,9,bank shl 2);
  57.              end;
  58.      __cir64:begin
  59.                bank:=bank shl 4;
  60.                wrinx(GRC,$E,bank);
  61.                wrinx(GRC,$F,bank);
  62.              end;
  63.     __compaq:begin
  64.                wrinx(GRC,$f,5);
  65.                bank:=bank shl 4;
  66.                wrinx(GRC,$45,bank);
  67.                if (rdinx(GRC,$40) and 1)>0 then inc(bank,8);
  68.                wrinx(GRC,$46,bank);
  69.              end;
  70.     __ET3000:outp($3cd,bank*9+64);
  71.     __Weitek,
  72.     __ET4000:outp($3cd,bank*17);
  73.     __ET4w32:begin
  74.                outp($3cd,(bank and 15)*17);
  75.                outp($3cb,(bank shr 4)*17);
  76.              end;
  77.     __everex:begin
  78.                x:=inp($3cc) and $df;
  79.                if (bank and 2)>0 then inc(x,32);
  80.                outp($3c2,x);
  81.                modinx(SEQ,8,$80,bank shl 7);
  82.              end;
  83.      __genoa:wrinx(SEQ,6,bank*9+64);
  84.        __HMC:begin
  85.                if memmode=_p8 then modinx(SEQ,$EE,$70,bank shl 4)
  86.                else if bank=0 then vseg:=$A000 else vseg:=$B000;
  87.              end;
  88.     __iitagx:if (inp(IOadr) and 4)>0 then outp(IOadr+8,bank)
  89.              else begin
  90.                wrinx(SEQ,$B,0);
  91.                if rdinx(SEQ,$B)=0 then;
  92.                modinx(SEQ,$E,$f,bank xor 2);
  93.              end;
  94.       __mxic:wrinx(SEQ,$c5,bank*17);
  95.        __ncr:begin
  96.                if memmode<=_pl4 then bank:=bank shl 2;
  97.                wrinx(SEQ,$18,bank shl 2);
  98.                wrinx(SEQ,$1C,bank shl 2);
  99.              end;
  100.        __oak:wrinx($3de,$11,bank*17);
  101.      __oak87:begin
  102.                wrinx($3DE,$23,bank);
  103.                wrinx($3DE,$24,bank);
  104.              end;
  105.   __paradise:begin
  106.                wrinx(GRC,9,bank shl 4);
  107.                wrinx(GRC,$A,bank shl 4);
  108.              end;
  109.  
  110.      __p2000,
  111.    __realtek:begin
  112.                outp($3d6,bank);
  113.                outp($3d7,bank);
  114.              end;
  115.         __s3:begin
  116.                wrinx(crtc,$38,$48);
  117.                wrinx(crtc,$39,$A5);
  118.                setinx(crtc,$31,9);
  119.                if memmode<=_pl4 then bank:=bank*4;
  120.                modinx(crtc,$35,$f,bank);
  121.                modinx(crtc,$51,$C,bank shr 2);
  122.                wrinx(crtc,$39,$5A);
  123.                wrinx(crtc,$38,0);
  124.              end;
  125.     __tridBR:begin
  126.                modinx(SEQ,$E,6,bank);
  127.                if (bank and 1)>0 then vseg:=$B000 else vseg:=$A000;
  128.              end;
  129.     __tridCS,__poach,__trid89
  130.             :if version=TR_8900CL then outp($3D8,bank)
  131.              else begin
  132.         (*       wrinx(SEQ,$B,0);
  133.                if rdinx(SEQ,$B)=0 then;  {New mode}
  134.                modinx(SEQ,$E,$f,bank xor 2);  *)
  135.                wrinx(SEQ,$B,0);
  136.                if rdinx(SEQ,$B)=0 then;  {New mode}
  137.                if (memmode<=_pl4) and (bank>1) then inc(bank,2);
  138.                modinx(SEQ,$E,$f,bank xor 2);
  139.              end;
  140.     __video7:if Version<V7_208A then
  141.              begin
  142.                x:=inp($3cc) and $df;
  143.                if (bank and 2)>0 then inc(x,32);
  144.                outp($3c2,x);
  145.                modinx(SEQ,$f9,1,bank);
  146.                modinx(SEQ,$f6,$80,(bank shr 2)*5);
  147.              end
  148.              else begin
  149.                wrinx(SEQ,$E8,bank);
  150.                wrinx(SEQ,$E9,bank);
  151.              end;
  152.        __UMC:wrinx(SEQ,6,bank*17);
  153.       __vesa:begin
  154.                rp.bx:=0;
  155.                bank:=bank*longint(64) div vgran;
  156.                rp.dx:=bank;
  157.                vio($4f05);
  158.                rp.bx:=1;
  159.                rp.dx:=bank;
  160.                vio($4f05);
  161.              end;
  162.  __xbe,__xga:outp(IOadr+8,bank);
  163.   __WeitekP9:outp($3CD,bank or $20);
  164.   end;
  165. end;
  166.  
  167. procedure setRbank(bank:word);
  168. var x:word;
  169. begin
  170.   curbank:=$FFFF;    {always flush}
  171.   case chip of
  172.    __aheadB:modinx(GRC,$D,$F,bank);
  173.    __al2101:outp($3D6,bank);
  174.      __ati2:begin
  175.               x:=bank shl 5;          {Roll bank nbr into bit 0}
  176.               modinx(IOadr,$b2,$e1,hi(x) or lo(x));
  177.             end;
  178.    __atiGUP:begin
  179.               x:=(bank and 15) shl 5;          {Roll bank nbr into bit 0}
  180.               modinx(IOAdr,$b2,$e1,hi(x) or lo(x));
  181.               modinx(IOadr,$AE,$C,bank shr 2);
  182.             end;
  183.     __cir64:wrinx(GRC,$E,bank shl 4);
  184.    __ET3000:modreg($3CD,$38,bank shl 3);
  185.    __Weitek,
  186.    __ET4000:modreg($3CD,$F0,bank shl 4);
  187.    __ET4w32:begin
  188.               modreg($3cd,$F0,bank shl 4);
  189.               modreg($3cb,$F0,bank);
  190.             end;
  191.      __mxic:modinx(SEQ,$C5,$f0,bank shl 4);
  192.       __ncr:begin
  193.                if memmode<=_pl4 then bank:=bank shl 2;
  194.                wrinx(SEQ,$1C,bank shl 2);
  195.             end;
  196.       __oak:modinx($3de,$11,$f,bank);
  197.     __oak87:wrinx($3DE,$23,bank);
  198.  __paradise:wrinx(GRC,9,bank shl 4);
  199.     __p2000:outp($3D7,bank);
  200.   __realtek:outp($3D6,bank);
  201.    __Video7:wrinx(SEQ,$E9,bank);
  202.       __UMC:modinx(SEQ,6,$F,bank);
  203.   end;
  204. end;
  205.  
  206.  
  207.  
  208. procedure vesamodeinfo(md:word;vbe1:_vbe1p);
  209. const
  210.   width :array[$100..$11b] of word=
  211.       (640,640,800,800,1024,1024,1280,1280,80,132,132,132,132
  212.       ,320,320,320,640,640,640,800,800,800,1024,1024,1024,1280,1280,1280);
  213.   height:array[$100..$11b] of word=
  214.       (400,480,600,600, 768, 768,1024,1024,60, 25, 43, 50, 60
  215.       ,200,200,200,480,480,480,600,600,600, 768, 768, 768,1024,1024,1024);
  216.   bits  :array[$100..$11b] of byte=
  217.       (  8,  8,  4,  8,   4,   8,   4,   8, 0,  0,  0,  0,  0
  218.       , 15, 16, 24, 15, 16, 24, 15, 16, 24,  15,  16,  24,  15,  16,  24);
  219.  
  220.  
  221. var
  222.   vbxx:_vbe1;
  223. begin
  224.   if vbe1=NIL then vbe1:=@vbxx;
  225.   fillchar(vbe1^,sizeof(_vbe1),0);
  226.   viop($4f01,0,md,0,vbe1);
  227.   if ((vbe1^.attr and 2)=0) and (md>=$100) and (md<=$11b)
  228.    then  (* optional info missing *)
  229.   begin
  230.     vbe1^.width :=width[md];
  231.     vbe1^.height:=height[md];
  232.     vbe1^.bits  :=bits[md];
  233.   end;
  234.  
  235.  
  236.   vgran :=vbe1^.gran;
  237.   bytes :=vbe1^.bytes;
  238.   pixels:=vbe1^.width;
  239.   lins  :=vbe1^.height;
  240. end;
  241.  
  242.  
  243. procedure initxga;
  244. var xbe1:_xbe1;
  245.   phadr:longint;
  246.   x:word;
  247. begin
  248.   outp(IOAdr+1,1);
  249.   modreg(IOadr+9,$8,0);
  250.  
  251.   mem [xgaseg:$12]:=1;
  252.   meml[xgaseg:$14]:=phadr;
  253.   memw[xgaseg:$18]:=pixels;
  254.   memw[xgaseg:$1A]:=lins;
  255.   case memmode of
  256.    _pk4:x:=2;
  257.     _p8:x:=3;
  258.    _p16:x:=4;
  259.   end;
  260.   mem [xgaseg:$1C]:=x;
  261.  
  262. end;
  263.  
  264. function safemode(md:word):boolean;
  265. var x,y:word;
  266. begin                 {Checks if we entered a Graph. mode}
  267.   safemode:=false;
  268.   wrinx(crtc,$11,0);
  269.   wrinx(crtc,1,0);
  270.   vio(lo(md));
  271.   if (rdinx(crtc,1)<>0) or (rdinx(crtc,$11)<>0) then
  272.   begin
  273.     if (md<=$13) or (mem[0:$449]<>3) then safemode:=true;
  274.   end;
  275. end;
  276.  
  277. function tsvio(ax,bx:word):boolean;   {Tseng 4000 Hicolor mode set}
  278. begin
  279.   rp.bx:=bx;
  280.   vio(ax);
  281.   tsvio:=rp.ax=16;
  282. end;
  283.  
  284. function setATImode(md:word):boolean;
  285. begin
  286.   rp.bx:=$5506;
  287.   rp.bp:=$ffff;
  288.   rp.si:=0;
  289.   vio($1200+md);
  290.   if rp.bp=$ffff then setATImode:=false
  291.   else begin
  292.     vio(md);
  293.     setATImode:=true;
  294.   end;
  295. end;
  296.  
  297. function setmode(md:word):boolean;
  298. var x,y,prt:word;
  299. begin
  300.   setmode:=true;
  301.   curmode:=md;
  302.   case chip of
  303. __ati1,__ati2:setmode:=setATImode(md);
  304.      __atiGUP:if md<$100 then setmode:=setATImode(md)
  305.               else begin
  306.                 case memmode of
  307.                  _p15:x:=$6;
  308.                  _p16:x:=$E;
  309.                  _p24:x:=$7;
  310.                 end;
  311.                   {mov al,[md]  mov ah,[x]  mov bx,1  call C000h:64h
  312.                     mov al,1  call C000h:68h}
  313.                 inline($8A/$46/<md/$8A/$66/<x/$BB/>1/$9A/>$64/>$C000
  314.                       /$B8/>1/$9A/>$68/>$C000);
  315.               end;
  316.      __compaq:begin
  317.                 setmode:=safemode(md);
  318.                 if memmode=_p16 then outp($3C8+DAC_RS3,$38);
  319.               end;
  320.      __ET4w32,
  321.      __ET4000:case hi(md) of
  322.                 0:setmode:=safemode(md);
  323.                 1:if tsvio($10e0,lo(md)) then
  324.                   begin
  325.                     {Diamond SpeedStar 24 does not clear memory}
  326.                     for x:=0 to 15 do         {clear memory}
  327.                     begin
  328.                       setbank(x);
  329.                       mem[$a000:0]:=0;
  330.                       fillchar(mem[$a000:1],65535,0);
  331.                     end;
  332.                   end else setmode:=false;
  333.                 2:if tsvio($10f0,md shl 8+$ff) then
  334.                   begin
  335.                     if bytes=2048 then
  336.                     begin         {Bug correction for the MEGAVGA BIOS}
  337.                       outp($3bf,3);
  338.                       outp(crtc+4,$a0);   {enable Tseng 4000 Extensions}
  339.                       wrinx(crtc,$13,0);
  340.                       setinx(crtc,$3f,$80);
  341.                     end
  342.                   end else setmode:=false;
  343.                 3:if tsvio($10f0,lo(md)) and setdac15 then
  344.                   else setmode:=false;
  345.                 4:if tsvio($10f0,lo(md)) and setdac16 then
  346.                   else setmode:=false;
  347.               end;
  348.      __everex:begin
  349.                 rp.bl:=md;
  350.                 vio($70);
  351.               end;
  352.       __oak87:if safemode(md) then
  353.                 case memmode of
  354.                   _p15:setmode:=setdac15;
  355.                   _p16:setmode:=setdac16;
  356.                   _p24:setmode:=setdac24;
  357.                 end
  358.               else setmode:=false;
  359.          __s3:if md<$100 then setmode:=safemode(md)
  360.               else begin
  361.                 rp.bx:=md;
  362.                 vio($4f02);
  363.                 if rp.ax=$4f then
  364.                 begin
  365.                   if md<$200 then vesamodeinfo(md,NIL);
  366.                   if (memmode=_p16) and setdac16 then;
  367.                 end
  368.                 else begin
  369.                   setmode:=false;
  370.                   dac2comm;
  371.                   outp($3C6,0);
  372.                   dac2pel;
  373.                 end;
  374.               end;
  375.      __iitagx,
  376.      __trid89:begin
  377.                 vio(md);
  378.                 if (rp.ah<>0) then setmode:=false;
  379.                 case memmode of   {9000i doesn't set HiColor modes}
  380.                   _p15:if not setdac15 then setmode:=false;
  381.                   _p16:if not setdac16 then setmode:=false;
  382.                 end;
  383.  
  384.  
  385.               end;
  386.      __video7:begin
  387.                 rp.bl:=md;
  388.                 vio($6f05);
  389.               end;
  390.        __vesa:begin
  391.                 rp.bx:=md;
  392.                 vio($4f02);
  393.                 if rp.ax<>$4f then setmode:=false
  394.                 else begin
  395.                   vesamodeinfo(md,NIL);
  396.                   chip:=__vesa;
  397.                 end;
  398.               end;
  399.         __UMC:begin
  400.                 setmode:=safemode(md);
  401.                 case memmode of
  402.                   _p15:setmode:=setdac15;
  403.                   _p16:setmode:=setdac16;
  404.                 end;
  405.               end;
  406.         __xbe:begin
  407.                 viop($4E03,md,0,instance,NIL);
  408.                 if rp.ax<>$4E then setmode:=false;
  409.               end;
  410.   else setmode:=safemode(md);
  411.   end;
  412.  
  413.   if (inp($3CC) and 1)=0 then crtc:=$3B4 else crtc:=$3D4;
  414.   case (rdinx(GRC,6) shr 2) and 3 of
  415.     0,1:vseg:=$A000;
  416.       2:vseg:=$B000;
  417.       3:vseg:=$B800;
  418.   end;
  419.  
  420.  
  421.   case chip of
  422.      __aheadA,
  423.      __aheadB:begin
  424.                 setinx(GRC,$F,$20);
  425.                 if (memmode>_cga2) and (md<>$13) then setinx(GRC,$C,$20);
  426.               end;
  427.      __al2101:begin
  428.                 setinx(crtc,$1A,$10);    {Enable extensions}
  429.                 setinx(crtc,$19,2);      {Enable >256K}
  430.                 setinx(GRC,$F,4);        {Enable RWbank}
  431.               end;
  432.      __atiGUP,
  433.        __ati2:begin
  434.                 setinx(IOadr,$B6,1);    {enable display >256K}
  435.                 setinx(IOAdr,$Be,8);    {enable RWbanks}
  436.                 setinx(IOAdr,$Bf,$1);
  437.               end;
  438.    __chips451,__chips452,__chips453:
  439.               begin
  440.                 prt:=$46E8;
  441.                 x:=inp(prt);
  442.                 outp(prt,x or $10);
  443.                 y:=inp($103);
  444.                 outp($103,y or $80);
  445.                 outp(prt,x and $EF);
  446.                 if (y and $40)=0 then IOadr:=$3D6 else IOadr:=$3B6;
  447.                 setinx(IOadr,4,4);
  448.                 if chip<>__chips451 then
  449.                 begin
  450.                   modinx(IOadr,$B,3,1);
  451.                   wrinx(IOadr,$C,0);
  452.                 end;
  453.               end;
  454.       __cir54:begin
  455.                 wrinx(SEQ,6,$12);
  456.                 setinx(crtc,$1B,2);      {Enable mem >256K}
  457.                 if mm>1024 then
  458.                 begin
  459.                   setinx(GRC,11,$20);    {Set 16K banks}
  460.                   setinx(SEQ,$f,$80);    {Enable Ext mem}
  461.                 end;
  462.                 wrinx(crtc,$25,$FF);
  463.               end;
  464.       __cir64:begin
  465.                 wrinx(GRC,$A,$EC);       {Enable extensions}
  466.                 if memmode>_cga2 then setinx(GRC,$D,7);
  467.               end;
  468.      __compaq:begin
  469.                 modinx(GRC,$F,$f,5);
  470.                 setinx(GRC,$10,8);
  471.               end;
  472.      __ET3000:setinx(SEQ,4,2);
  473.         __HMC:if memmode>=_cga2 then
  474.               begin
  475.                 if memmode=_pl4 then
  476.                 begin
  477.                   setinx(SEQ,$E7,$4);
  478.                   clrinx(GRC,6,$C);
  479.                 end;
  480.                 setinx(SEQ,$E8,$9);
  481.  
  482.               end;
  483.      __iitagx:begin
  484.                 modinx(GRC,6,$C,4);
  485.                 spcreg:=0;
  486.                 if (inp(IOadr) and 4)>0 then
  487.                 begin
  488.                   initxga;
  489.                   spcreg:=$1F0-(rdinx(IOadr+10,$75) and 3)*$10;
  490.                 end;
  491.               end;
  492.        __mxic:begin
  493.                 setinx(SEQ,$65,$40);
  494.                 wrinx(SEQ,$a7,$87);    {enable extensions}
  495.                 setinx(SEQ,$c3,4);     {Enable banks}
  496.                 setinx(SEQ,$f0,8);     {Enable display >256k}
  497.               end;
  498.         __ncr:begin
  499.                 wrinx(SEQ,5,5);
  500.                 wrinx(SEQ,$18,0);
  501.                 wrinx(SEQ,$19,0);
  502.                 wrinx(SEQ,$1A,0);
  503.                 wrinx(SEQ,$1B,0);
  504.                 wrinx(SEQ,$1C,0);
  505.                 wrinx(SEQ,$1D,0);
  506.                 setinx(SEQ,$1e,$1C);
  507.               end;
  508.         __oak:begin
  509.                 if memmode>=_pl4 then setinx($3DE,$D,$1C);
  510.               end;
  511.       __oak87:begin
  512.                 if memmode=_pl4 then setinx($3DE,$D,$10);
  513.              (*   if md=$13 then
  514.                 begin
  515.                   wrinx(crtc,$14,0);
  516.                   wrinx(crtc,$13,20);
  517.                   wrinx(crtc,$17,$c3);
  518.                   setinx($3DE,$21,4);
  519.                 end; (* Creates a 320x200 mode without 64K limitations
  520.                         however there is no pixel doubling, creating a
  521.                         "double screen"  *)
  522.               end;
  523.    __paradise:begin
  524.                 modinx(GRC,$F,$17,5); {Enable extensions}
  525.                 wrinx(crtc,$29,$85);  {Enable extensions 2}
  526.                 clrinx(GRC,$B,8);
  527.                 clrinx(crtc,$2F,$62);
  528.                 setinx(SEQ,$11,$80);  {enable dual bank}
  529.               end;
  530.       __p2000:begin
  531.                 if memmode=_p16 then
  532.                 begin
  533.                   dac2comm;
  534.                   outp($3c6,$c0);
  535.                 end;
  536.          (*       if memmode=_p24 then
  537.                 begin            {This can trick a ATT20c492 into 24bit mode}
  538.                   dactocomm;
  539.                   outp($3c6,$e0);
  540.                   bytes:=1600;
  541.                   pixels:=530;
  542.                 end;  *)
  543.               end;
  544.     __realtek:begin
  545.                 setinx(crtc,$19,$A2);   {display from upper 512k}
  546.                 setinx(GRC,$C,32);
  547.                 setinx(GRC,$F,4);       {dual bank}
  548.               end;
  549.          __s3:if memmode>_CGA2 then
  550.               begin
  551.                 wrinx(crtc,$38,$48);
  552.                 wrinx(crtc,$39,$A5);
  553.                 setinx(crtc,$31,8);   {Enable access >256K}
  554.                 wrinx(crtc,$38,0);
  555.                 wrinx(crtc,$39,$5A);
  556.               end;
  557.      __trid89:begin
  558.                 setinx(crtc,$1e,$80);   (* Enable 17bit display start *)
  559.                 if (memmode>_cga2) AND (Version=TR_8900C) then
  560.                 begin
  561.                   wrinx(SEQ,$B,0);
  562.                   x:=inp(SEQ+1);    {Switch to new mode}
  563.                   x:=rdinx(SEQ,$E);
  564.                   wrinx(SEQ,$E,$80);
  565.                   setinx(SEQ,$C,$20);
  566.                   wrinx(SEQ,$E,x);
  567.                 end;
  568.               end;
  569.         __umc:begin
  570.                 OUTP($3BF,$AC);     {Enable extensions}
  571.                 setinx(SEQ,8,$80);    {Enable banks bit0}
  572.                 clrinx(crtc,$2F,$2);  {Enable >256K}
  573.               end;
  574.      __video7:begin
  575.                 wrinx(SEQ,6,$EA);  (* Enable extensions *)
  576.                 if Version>=V7_208A then
  577.                   setinx(SEQ,$E0,$80);  {Enable Dual bank}
  578.               end;
  579.      __Weitek:begin
  580.                 x:=rdinx(SEQ,$11);
  581.                 outp(SEQ+1,x);
  582.                 outp(SEQ+1,x);
  583.                 outp(SEQ+1,inp(SEQ+1) and $DF);
  584.               end;
  585.   __xbe,__xga:initxga;
  586.   end;
  587.   curbank:=$ffff;    {Set curbank invalid }
  588.   planes:=1;
  589.   setinx(SEQ,4,2);    {Set "more than 64K" flag}
  590.  
  591.   case memmode of
  592.   _text,_text2,_text4,
  593.   _pl1e,_pl2:planes:=2;
  594.         _pl4:planes:=4;
  595.   end;
  596.   if vseg=$A000 then
  597.     for x:=1 to mm div 64 do
  598.     begin
  599.       setbank(x-1);
  600.       mem[vseg:$FFFF]:=0;
  601.       fillchar(mem[vseg:0],$ffff,0);
  602.     end;
  603.   AnalyseMode;
  604. end;
  605.  
  606. const
  607.   set15:array[0..13] of byte=(0,0,$A0,$A0,$A0,$A0,$C1,0,$80,$F0,$A0,0,0,0);
  608.   msk15:array[0..13] of byte=(0,0,$80,$C0,$FF,$E0,$C7,0,$C0,$FF,$E0,0,0,0);
  609.  
  610.   set16:array[0..13] of byte=(0,0,  0,$E0,$A6,$C0,$C5,0,$C0,$E1,$C0,0,0,0);
  611.   msk16:array[0..13] of byte=(0,0,  0,$C0,$FF,$E0,$C7,0,$C0,$FF,$E0,0,0,0);
  612.  
  613.   set24:array[0..13] of byte=(0,0,  0,  0,$9E,$E0,$80,0,$60,$E5,$E0,0,0,0);
  614.   msk24:array[0..13] of byte=(0,0,  0,  0,$FF,$E0,$C7,0,$E0,$FF,$E0,0,0,0);
  615.  
  616.  
  617. function prepDAC:word;     {Sets DAC up to receive command word}
  618. var x:word;
  619. begin
  620.   dac2comm;
  621.   if dactype=_dacss24 then
  622.   begin
  623.     dac2comm;
  624.     x:=8;
  625.     while (x>0) and (daccomm<>$8E) do
  626.     begin
  627.       daccomm:=inp($3C6);
  628.       dec(x);
  629.     end;
  630.     prepDAC:=daccomm;
  631.   end
  632.   else begin
  633.     prepDAC:=inp($3C6);
  634.     dac2comm;
  635.   end;
  636. end;
  637.  
  638. procedure dacmode(andmsk,ormsk:word);
  639. begin
  640.   ormsk:=ormsk and (not andmsk);
  641.   if DAC_RS2<>0 then
  642.   begin
  643.     outp($3C6+DAC_RS2,(inp($3C6+DAC_RS2) and andmsk) or ormsk);
  644.   end
  645.   else begin
  646.     outp($3C6,(prepDAC and andmsk) or ormsk);
  647.     dac2pel;
  648.  
  649.   end;
  650. end;
  651.  
  652. procedure setdac6;
  653. var m:word;
  654. begin
  655.   case dactype of
  656.    _dacSC24:begin
  657.               dac2comm;
  658.               outp($3C6,$10);
  659.               outp($3C7,8);
  660.               outp($3C8,0);
  661.               outp($3C9,0);
  662.               outp($3C6,0);
  663.               dac2pel;
  664.             end;
  665.     _dacATT,_dacBt484:
  666.             dacmode(0,0);
  667.     _dacCEG,
  668.       _dac8:;
  669.   end;
  670. end;
  671.  
  672. procedure setdac8;
  673. begin
  674.   case dactype of
  675.    _dacSC24:begin
  676.               dac2comm;
  677.               outp($3C6,$10);
  678.               outp($3C7,8);
  679.               outp($3C8,1);
  680.               outp($3C9,0);
  681.               outp($3C6,0);
  682.               dac2pel;
  683.             end;
  684.     _dacATT,_dacBt484:
  685.             dacmode($FD,2);
  686.     _dacCEG,
  687.       _dac8:;
  688.   end;
  689. end;
  690.  
  691. function setdac15:boolean;
  692. var m:word;
  693. begin
  694.   if msk15[dactype]=0 then setdac15:=false
  695.   else begin
  696.     m:=msk15[dactype];
  697.     if (chip<>__ET4000) and (chip<>__ET4W32) and
  698.       (dactype<=_dac16) then m:=m or $20;
  699.     dacmode(not m,set15[dactype]);
  700.     setdac15:=true;
  701.   end;
  702. end;
  703.  
  704. function setdac16:boolean;
  705. var m:word;
  706. begin
  707.   if msk16[dactype]=0 then setdac16:=false
  708.   else begin
  709.     m:=msk15[dactype];
  710.     if (chip<>__ET4000) and (chip<>__ET4W32) and
  711.       (dactype<=_dac16) then m:=m or $20;
  712.     dacmode(not m,set16[dactype]);
  713.     setdac16:=true;
  714.   end;
  715. end;
  716.  
  717. function setdac24:boolean;
  718. begin
  719.   if msk24[dactype]=0 then setdac24:=false
  720.   else begin
  721.     dacmode(not msk24[dactype],set24[dactype]);
  722.     setdac24:=true;
  723.   end;
  724. end;
  725.  
  726.  
  727.  
  728. procedure setvstart(x,y:word);       {Set the display start address}
  729. var
  730.   l:longint;
  731.   stdvga:boolean;
  732. begin
  733.   stdvga:=true;
  734.  
  735.   case chip of
  736.     __vesa:begin
  737.                rp.bx:=0;
  738.                rp.cx:=x;
  739.                rp.dx:=y;
  740.                vio($4f07);
  741.                if rp.ax=0 then;
  742.                stdvga:=false;
  743.              end;
  744.   else
  745.     case memmode of
  746.         _text,_text2,_text4:
  747.                   l:=(bytes*y+x*2)*2;
  748.             _cga2:l:=(bytes*y+(x shr 2))*4;
  749.   _cga1,_pl1,_pl2,_pl4:
  750.                   l:=(bytes*y+(x shr 3))*4;
  751.              _pk4:l:=bytes*y+x shr 1;
  752.               _p8:l:=bytes*y+x;
  753.         _p15,_p16:l:=bytes*y+x*2;
  754.              _p24:l:=bytes*y+x*3;
  755.              _p32:l:=bytes*y+x*4;
  756.     end;
  757.  
  758.     y:=(l shr 18) and (pred(mm) shr 8);
  759.     case chip of
  760.       __aheadb:begin
  761.                  if (memmode=_p8) and ((rdinx(GRC,$C) and $20)>0) then
  762.                  begin
  763.                    y:=y shr 1;
  764.                    l:=l shr 1;
  765.                  end;
  766.                  modinx(GRC,$1c,3,y);
  767.                end;
  768.         __ati1:modinx(IOAdr,$b0,$40,y shl 6);
  769.       __atiGUP,
  770.         __ati2:begin
  771.                  if (rdinx(IOadr,$B0) and $20)>0 then
  772.                  begin
  773.                    l:=l shr 1;
  774.                    y:=y shr 1;
  775.                  end;
  776.                  modinx(IOadr,$b0,$40,y shl 6);
  777.                  modinx(IOadr,$A3,$10,y shl 3);
  778.                  modinx(IOadr,$AD,4,y);
  779.                end;
  780.       __al2101:begin
  781.                  if (rdinx(GRC,$C) and $10)<>0 then
  782.                  begin
  783.                    l:=l shr 1;
  784.                    y:=y shr 1;
  785.                  end;
  786.                  modinx(crtc,$20,7,y);
  787.                end;
  788.     __chips452,__chips453:
  789.                wrinx(IOadr,$C,y);
  790.        __cir54:begin
  791.                  inc(y,y and 6);     {move bit 1-2 to 2-3}
  792.                  modinx(crtc,$1b,$d,y);
  793.                end;
  794.        __cir64:wrinx(GRC,$7C,y);
  795.       __compaq:modinx(GRC,$42,$C,y shl 2);
  796.       __ET3000:begin
  797.                  if (memmode=_p8) or ((rdinx(SEQ,7) and $40)>0) then
  798.                  begin
  799.                    l:=l shr 1;
  800.                    y:=y shr 1;
  801.                  end;
  802.                  modinx(crtc,$23,2,y shl 1);
  803.                end;
  804.       __ET4000:modinx(crtc,$33,3,y);
  805.       __ET4W32:modinx(crtc,$33,$F,y);
  806.          __HMC:begin
  807.                  if (rdinx(SEQ,$E7) and 1)>0 then
  808.                  begin
  809.                    l:=l shr 1;
  810.                    y:=y shr 1;
  811.                  end;
  812.                  modinx(SEQ,$ED,1,y);
  813.                end;
  814.       __iitagx:if (inp(IOadr) and 4)=0 then modinx(crtc,$1e,$20,y shl 5)
  815.                else begin
  816.                  stdvga:=false;
  817.                  wrinx3(IOadr+10,$40,l shr 2);
  818.                end;
  819.         __mxic:modinx(SEQ,$F1,3,y);
  820.          __ncr:modinx(crtc,$31,$f,y);
  821.          __oak:begin
  822.                  if (memmode>_pl4) and (curmode<>$13) then
  823.                  begin
  824.                    l:=l shr 1;
  825.                    y:=y shr 1;
  826.                  end;
  827.                  modinx($3DE,$14,8,y shl 3);  {lower bit}
  828.                  modinx($3DE,$16,8,y shl 2);  {upper bit}
  829.                end;
  830.        __oak87:begin
  831.                  if (memmode>_pl4) and ((rdinx($3DE,$21) and 4)>0) then
  832.                  begin
  833.                    l:=l shr 1;
  834.                    y:=y shr 1;
  835.                  end;
  836.                  modinx($3DE,$17,7,y);
  837.                end;
  838.        __p2000:modinx(GRC,$21,$7,y);
  839.     __paradise:modinx(GRC,$d,$18,y shl 3);
  840.      __realtek:begin
  841.                  if (rdinx(GRC,$C) and $10)<>0 then
  842.                  begin
  843.                    l:=l shr 1;
  844.                    y:=y shr 1;
  845.                  end;
  846.                  if y>1 then inc(y,y and 2);   {shift high bit one up.}
  847.                  modinx(crtc,$19,$50,y shl 4);
  848.                end;
  849.           __s3:begin
  850.                  wrinx(crtc,$38,$48);
  851.                  wrinx(crtc,$39,$A5);
  852.                  modinx(crtc,$31,$30,y shl 4);
  853.                  modinx(crtc,$51,1,y shr 2);
  854.                  wrinx(crtc,$39,$5A);
  855.                  wrinx(crtc,$38,0);
  856.                end;
  857.       __tridcs:modinx(crtc,$1e,$20,y shl 5);
  858.       __trid89:begin
  859.         (*         wrinx(SEQ,$B,0);
  860.                  if (rdinx(SEQ,$D) and $10)>0 then l:=l shr 1;
  861.                  y:=rdinx(SEQ,$B);
  862.                  y:=l shr 18;
  863.                  modinx(crtc,$1E,$20,(y and 1) shl 5);
  864.                  wrinx(SEQ,$B,0);          {select old mode regs}
  865.                  modinx(SEQ,$E,1,y shr 1);
  866.                  if rdinx(SEQ,$B)=0 then;  {Select new mode regs}  *)
  867.  
  868.                  wrinx(SEQ,$B,0);          {select old mode regs}
  869.                  if (rdinx(SEQ,$D) and $10)>0 then
  870.                  begin
  871.                    l:=l shr 1;
  872.                    y:=y shr 1;
  873.                  end;
  874.                  modinx(SEQ,$E,1,y shr 1);
  875.                  if rdinx(SEQ,$B)=0 then;  {Select new mode regs}
  876.                  modinx(crtc,$1E,$20,y shl 5);
  877.                  if Version=TR_8900CL then modinx(crtc,$27,3,y shr 1);
  878.                end;
  879.          __UMC:begin
  880.                 if (rgs.crtcregs.x[$33] and $10)>0 then
  881.                 begin
  882.                   l:=l shr 1;
  883.                   y:=y shr 1;
  884.                 end;
  885.                 modinx(crtc,$33,1,y);
  886.                end;
  887.       __video7:modinx(SEQ,$f6,$70,(y shl 4) and $30);
  888.       __Weitek:modinx(GRC,$D,$18,y shl 3);
  889.    __xbe,__xga:begin
  890.                  stdvga:=false;
  891.                  wrinx3(IOadr+10,$40,l shr 2);
  892.                end;
  893.     end;
  894.   end;
  895.   if stdvga then
  896.   begin
  897.     x:=l shr 2;
  898.     wrinx(crtc,13,lo(x));
  899.     wrinx(crtc,12,hi(x));
  900.   end;
  901. end;
  902.  
  903.  
  904.  
  905. procedure WD_wait;
  906. begin
  907.   if version=WD_90c33 then
  908.   begin
  909.     repeat until (inp($23CE) and 15)=0;
  910.   end
  911.   else
  912.     repeat
  913.       outpw($23C0,$1001);
  914.     until (inpw($23C2) and $800)=0;
  915. end;
  916.  
  917. procedure WD_outl(index:word;l:longint);
  918. begin
  919.   outpw($23C2,index+(l and $FFF));
  920.   outpw($23C2,index+$1000+(l shr 12));
  921. end;
  922.  
  923. procedure setHWcurmap(VAR map:CursorType);
  924. var x,y,z,w,lbank,x0,y0:word;
  925.   l:longint;
  926.   bm:array[0..127] of byte;
  927.   mp:record
  928.        case integer of
  929.         0:(b:array[0..2047] of byte);
  930.         1:(w:array[0..1023] of word);
  931.         2:(l:array[0..511] of longint);
  932.      end;
  933.  
  934. procedure copyCurMap(bytes:word);
  935. var x,y:word;
  936. begin
  937.   setbank(lbank);
  938.   if memmode=_pl4 then
  939.   begin
  940.     wrinx(GRC,3,0);
  941.     clrinx(GRC,5,$3);
  942.     wrinx(GRC,8,$FF);
  943.     y:=-(bytes div 4);
  944.     for x:=0 to bytes-1 do
  945.     begin
  946.       wrinx(SEQ,2,1 shl (x and 3));
  947.       y0:=mem[$a000:y];
  948.       mem[$a000:y]:=mp.b[x];
  949.       if (x and 3)=3 then inc(y);
  950.     end;
  951.   end
  952.   else move(mp,mem[$A000:-bytes],bytes);
  953. end;
  954.  
  955. function al_packmap(map:byte):word;
  956. var i,j:word;
  957. begin
  958.   j:=0;
  959.   for i:=0 to 7 do
  960.   begin
  961.     j:=j shl 2+2;
  962.     if ((map shr i) and 1)>0 then dec(j);
  963.   end;
  964.   al_packmap:=j;
  965. end;
  966.  
  967. function al_packmap2(map:byte):longint;
  968. var i:word;
  969.     j:longint;
  970. begin
  971.   j:=0;
  972.   for i:=0 to 7 do
  973.   begin
  974.     j:=j shl 4+$A;
  975.     if ((map shr i) and 1)>0 then dec(j,5);
  976.   end;
  977.   al_packmap2:=j;
  978. end;
  979.  
  980. function pack8to16(w:word):word;
  981. var x,i:word;
  982. begin
  983.   i:=0;
  984.   for x:=0 to 7 do
  985.   begin
  986.     i:=i shl 2;
  987.     if ((w shl x) and 128)>0 then inc(i,3);
  988.   end;
  989.   pack8to16:=i;
  990. end;
  991.  
  992. function swapb(b:word):word;
  993. var i,j:word;
  994. begin
  995.   j:=0;
  996.   for i:=0 to 7 do
  997.     if ((b shr i) and 1)>0 then inc(j,128 shr i);
  998.   swapb:=j;
  999. end;
  1000.  
  1001. begin
  1002.   if memmode=_pl4 then lbank:=(mm div 256)-1
  1003.                   else lbank:=(mm div 64)-1;
  1004.   move(map,mp,128);
  1005.   move(map,bm,128);
  1006.   case chip of
  1007.     __al2101:begin
  1008.                x0:=0;
  1009.                w:=mm-1;
  1010.                fillchar(mp,1024,$aa);
  1011.                if memmode<=_p8 then
  1012.                begin
  1013.                  y:=0;
  1014.                  for x:=0 to 127 do
  1015.                  begin
  1016.                    mp.w[y+x]:=al_packmap(bm[x]);
  1017.                    if (x and 3)=3 then inc(y,4);
  1018.                  end;
  1019.                end
  1020.                else
  1021.                  for x:=0 to 127 do  {Double size for 64k mode}
  1022.                    mp.l[x]:=al_packmap2(bm[x]);
  1023.                CopyCurMap(1024);
  1024.  
  1025.                wrinx2(crtc,$27,w);
  1026.                x:=inp(crtc+6);     {force DAC to address mode}
  1027.                x:=inp($3C0);
  1028.                y:=rdinx($3C0,$31);
  1029.                z:=rdinx($3C0,$32);
  1030.                wrinx($3C0,$35,$f);
  1031.                wrinx($3C0,$36,0);
  1032.                wrinx($3C0,$31,y);
  1033.                wrinx($3C0,$32,z);
  1034.                outp($3C0,x);
  1035.              end;
  1036.     __atiGUP:begin          {Doesn't work yet}
  1037.                for x:=0 to 127 do mp.l[x]:=$ffaa5500;
  1038.  
  1039.                CopyCurMap(512);
  1040.                outpw($1AEE,$5533);
  1041.                outpw($1EEE,$2020);
  1042.                l:={(mm*longint(1024)-512) div 4} 0;
  1043.                outpw($AEE,l);
  1044.                outpw($EEE,(l shr 16) or $8000);
  1045.              end;
  1046.   __chips452:begin
  1047.                for x:=255 downto 0 do
  1048.                  mp.w[x]:=mp.w[x div 4];
  1049.                CopyCurMap(512);
  1050.  
  1051.                wrinx(IOadr,$A,0);
  1052.                wrinx2m(IOadr,$30,mm*longint(64)-$20);
  1053.                wrinx(IOadr,$32,$ff);
  1054.                wrinx(IOadr,$37,1);
  1055.                wrinx(IOadr,$38,$FF);
  1056.                wrinx(IOadr,$39,0);
  1057.                wrinx(IOadr,$3A,$F);
  1058.              end;
  1059.     __compaq:begin
  1060.                outp($3C8,$80);
  1061.                for x:=0 to 127 do outp($13C7,255);
  1062.                outp($3C8,0);
  1063.                for x:=0 to 127 do outp($13C7,mp.b[x]);
  1064.                outp($13C9,(inp($13C9) and $FC) or 2);
  1065.              end;
  1066.      __cir54:begin
  1067.                clrinx(SEQ,$12,3);
  1068.                wrinx(GRC,11,$24);
  1069.                move(mp,mp.b[128],128);
  1070.                CopyCurMap(256);
  1071.                setHWcurcol($ff0000,$ff);
  1072.                wrinx(SEQ,$13,$3f);
  1073.              end;
  1074.     __ET4W32:begin
  1075.                for x:=0 to 511 do mp.l[x]:=$AAAAAAAA;
  1076.                y:=128;
  1077.             {   if memmode>_p8 then
  1078.                begin
  1079.                  for x:=127 downto 0 do
  1080.                  begin
  1081.                    mp.l[x+y]:=al_packmap2(bm[x]);
  1082.                    if (x and 3)=0 then dec(y,4);
  1083.                  end;
  1084.                  CopyCurMap(2048);
  1085.                  wrinx($217A,$EE,2);
  1086.                  wrinx($217A,$EB,4);
  1087.                  l:=mm*longint(256)-512;
  1088.                end
  1089.                else} begin
  1090.                  for x:=127 downto 0 do
  1091.                  begin
  1092.                    mp.w[x+y]:=al_packmap(bm[x]);
  1093.                    if (x and 3)=0 then dec(y,4);
  1094.                  end;
  1095.                  CopyCurMap(1024);
  1096.                  wrinx($217A,$EE,1);
  1097.                  wrinx($217A,$EB,2);
  1098.                  l:=mm*longint(256)-256;
  1099.                end;
  1100.                wrinx3($217A,$E8,l);
  1101.  
  1102.                wrinx($217A,$EF,2);
  1103.                wrinx($217A,$ED,0);
  1104.                wrinx($217A,$EC,0);
  1105.                wrinx($217A,$E2,0);
  1106.                wrinx($217A,$E6,0);
  1107.                setinx($217A,$F7,$80);
  1108.              end;
  1109.     __IITAGX:if spcreg<>0 then
  1110.              begin
  1111.                outp(IOadr+10,$51);
  1112.                outp(spcreg+3,$ff);
  1113.                outp(IOadr+10,0);
  1114.                outp($3C8,1);
  1115.                outp(IOadr+10,$51);
  1116.                outp($3C9,0);
  1117.                outp($3C9,0);
  1118.                outp($3C9,0);
  1119.                outp($3C9,$FF);
  1120.                outp($3C9,$FF);
  1121.                outp($3C9,$FF);
  1122.                outp(IOadr+10,0);
  1123.                outp($3C8,$80);
  1124.                for x:=1 to 128 do outp(spcreg+3,$ff);
  1125.                for x:=1 to 128 do outp(spcreg+3,0);
  1126.              end;
  1127.        __ncr:begin
  1128.                w:=(mm*longint(16))-4;    {256 bytes from the end of Vmem.}
  1129.                y:=128;
  1130.                for x:=127 downto 0 do
  1131.                begin
  1132.                  mp.b[x+y]:=swapb(mp.b[x]);
  1133.                  if (x and 3)=0 then dec(y,4);
  1134.                end;
  1135.                for x:=0 to 31 do
  1136.                  mp.l[x*2]:=mp.l[x*2+1] xor $FFFFFFFF;
  1137.  
  1138.                wrinx2m(SEQ,$11,$101);
  1139.                CopyCurMap(256);
  1140.  
  1141.                wrinx(SEQ,$A,$f);
  1142.                wrinx(SEQ,$B,$0);
  1143.                wrinx2m(SEQ,$13,0);
  1144.                wrinx2m(SEQ,$15,w);
  1145.                wrinx(SEQ,$17,$ff);
  1146.                wrinx(SEQ,$C,3);
  1147.              end;
  1148.   __PARADISE:begin
  1149.                WD_wait;
  1150.                outp($23C0,2);
  1151.                for x:=127 downto 0 do
  1152.                  mp.w[x]:=mp.b[x] shl 8+$ff;  {XOR cursor, how to set
  1153.                                                fore&bkground colors ?}
  1154.  
  1155.  
  1156.                CopyCurMap(256);
  1157.                l:=mm*longint(256)-64;
  1158.                WD_outl($1000,l);
  1159.  
  1160.                if version=WD_90c33 then w:=$C000
  1161.                                    else w:=$5000;
  1162.                outpw($23C2,w);
  1163.                if memmode>_p8 then w:=$810 else w:=$800;
  1164.                outpw($23C2,w);
  1165.                outpw($23C0,1);
  1166.              end;
  1167.         __S3:begin
  1168.                if memmode>_p8 then
  1169.                begin
  1170.                  for x:=0 to 127 do
  1171.                  begin
  1172.                    y:=pack8to16(bm[x]);
  1173.                    mp.l[x]:=(longint(lo(y)) shl 24)+(y and $FF00)+$FF00FF;
  1174.                  end;
  1175.                  for x:=256 to 511 do mp.w[x]:=$ff;
  1176.                end
  1177.                else begin
  1178.                  for x:=0 to 255 do mp.l[x]:=$ffff;  {Transparent}
  1179.                  y:=376;
  1180.                  for x:=127 downto 0 do
  1181.                  begin
  1182.                    mp.b[x+y]:=bm[x];
  1183.                    if (x and 1)=0 then dec(y,2);
  1184.                    if (x and 3)=0 then dec(y,8);
  1185.                  end;
  1186.                  if memmode=_pk4 then
  1187.                    for x:=0 to 511 do
  1188.                      mp.b[x]:=lo((mp.b[x] shl 4)+(mp.b[x] shr 4));
  1189.                end;
  1190.                CopyCurMap(1024);
  1191.                wrinx(crtc,$39,$A0);
  1192.                wrinx(crtc,$45,2);
  1193.                wrinx2(crtc,$4E,0);
  1194.                wrinx(crtc,$4A,$FF);
  1195.                wrinx(crtc,$4B,0);
  1196.                wrinx2m(crtc,$4C,mm-1);
  1197.                wrinx(crtc,$39,0);
  1198.              end;
  1199.     __Video7:begin
  1200.                for x:=0 to 63 do mp.w[x]:=mp.w[x] xor $FFFF;
  1201.                move(map,mp.b[128],128);
  1202.                CopyCurMap(256);
  1203.                wrinx(SEQ,$94,$FF);
  1204.                modinx(SEQ,$FF,$60,(mm-1) shr 3);
  1205.                setinx(SEQ,$A5,$80); {Enable cursor}
  1206.              end;
  1207.  __xbe,__xga:begin
  1208.                wrinx(IOadr+10,$36,0);
  1209.                fillchar(mp,1024,$ff);
  1210.                wrinx2(IOadr+10,$60,0);
  1211.                for x:=0 to 1024 do wrinx(IOadr+10,$6A,mp.b[x]);
  1212.  
  1213.  
  1214.                setHWcurcol($ff0000,$ff);
  1215.                wrinx(IOadr+10,$32,0);
  1216.                wrinx(IOadr+10,$35,0);
  1217.                wrinx(IOadr+10,$36,1);
  1218.              end;
  1219.   end;
  1220. end;
  1221.  
  1222. procedure setHWcurcol(fgcol,bkcol:longint);
  1223. begin
  1224.   case chip of
  1225.      __cir54:begin
  1226.                modinx(SEQ,$12,3,2);
  1227.                outp($3C8,$ff);
  1228.                outp($3C9,lo(fgcol) shr 2);
  1229.                outp($3C9,hi(fgcol) shr 2);
  1230.                outp($3C9,fgcol shr 18);
  1231.                outp($3C8,0);
  1232.                outp($3C9,lo(bkcol) shr 2);
  1233.                outp($3C9,hi(bkcol) shr 2);
  1234.                outp($3C9,bkcol shr 18);
  1235.                modinx(SEQ,$12,3,1);
  1236.              end;
  1237.     __IITAGX,
  1238.  __xbe,__XGA:begin
  1239.                wrinx3m(IOadr+10,$38,fgcol);
  1240.                wrinx3m(IOadr+10,$3B,bkcol);
  1241.              end;
  1242.   end;
  1243. end;
  1244.  
  1245. procedure HWcuronoff(on:boolean);
  1246. begin
  1247.   case chip of
  1248.  
  1249.        __S3:begin
  1250.               wrinx(crtc,$39,$a0);
  1251.               modinx(crtc,$45,3,2+ord(on));
  1252.               wrinx(crtc,$39,0);
  1253.             end;
  1254.  __paradise:begin
  1255.               outp($23C0,2);
  1256.               outpw($23C2,ord(on)*$800);
  1257.             end;
  1258. __xbe,__xga:wrinx(IOadr+10,$36,0);
  1259.   end;
  1260. end;
  1261.  
  1262. procedure setHWcurpos(X,Y:word);
  1263. var l:longint;
  1264. begin
  1265.  
  1266.   if extpixfact>1 then x:=x*extpixfact;
  1267.   if extlinfact>1 then Y:=Y*extlinfact;
  1268.   case chip of
  1269.     __al2101:begin
  1270.                if (rdinx(crtc,$19) and 1)=0 then y:=y*2;
  1271.                if memmode>_p8 then x:=x*2;
  1272.                wrinx(crtc,$21,x shr 3);
  1273.                wrinx(crtc,$23,y shr 1);
  1274.                modinx(crtc,$25,$7f,((x and 7) shl 2) + (y shr 9)
  1275.                               +((y and 1) shl 6) or $20);
  1276.              end;
  1277.     __atiGUP:begin
  1278.                outpw($12EE,x and 7);
  1279.                outpw($16EE,y and 7);
  1280.                x:=x and $FFF8;
  1281.                case memmode of
  1282.             _p15,_p16:x:=x*2;
  1283.                  _p24:x:=x*3;
  1284.                end;
  1285.                l:=((y and $FFF8)*bytes+x) div 4;
  1286.                outpw($2AEE,l);
  1287.                outpw($2EEE,l shr 16);
  1288.              end;
  1289.   __chips452:begin
  1290.                wrinx2m(IOadr,$33,x);
  1291.                wrinx2m(IOadr,$35,y);
  1292.              end;
  1293.      __CIR54:BEGIN
  1294.                outpw(SEQ,(x shl 5) or $10);
  1295.                outpw(SEQ,(y shl 5) or $11);
  1296.              END;
  1297.     __compaq:begin
  1298.                inline($fa);
  1299.                outpw($93C8,x+32);
  1300.                outpw($93C6,y+32);
  1301.                inline($fb);
  1302.              end;
  1303.     __ET4W32:begin
  1304.                case memmode of
  1305.             _p15,_p16:x:=x*2;
  1306.                  _p24:x:=x*3;
  1307.                end;
  1308.                wrinx2($217A,$E0,x);
  1309.                wrinx2($217A,$E4,y);
  1310.              end;
  1311.     __IITAGX:if spcreg<>0 then
  1312.              begin
  1313.                outp(IOadr+10,$51);
  1314.                outpw(spcreg,x);
  1315.                outpw(spcreg,y);
  1316.                outp(IOadr+10,0);
  1317.              end;
  1318.        __ncr:begin
  1319.                wrinx2m(SEQ,$D,x);
  1320.                wrinx2m(SEQ,$F,y);
  1321.              end;
  1322.   __PARADISE:begin
  1323.                case memmode of
  1324.             _p15,_p16:x:=x*2;
  1325.                  _p24:x:=x*3;
  1326.                end;
  1327.                outp($23C0,2);
  1328.                if version=WD_90c33 then
  1329.                begin
  1330.                  outpw($23C2,$D000+x);
  1331.                  outpw($23C2,$E000+y);
  1332.                end
  1333.                else begin
  1334.                  outpw($23C2,$6000+x);
  1335.                  outpw($23C2,$7000+y);
  1336.                end;
  1337.              end;
  1338.         __S3:begin
  1339.                if memmode>_p8 then x:=x*2;
  1340.                wrinx(crtc,$39,$A0);
  1341.                wrinx2m(crtc,$46,x);
  1342.                wrinx2m(crtc,$48,y);
  1343.                wrinx(crtc,$45,3);
  1344.                wrinx(crtc,$39,0);
  1345.              end;
  1346.     __Video7:begin
  1347.                wrinx2m(SEQ,$9C,X);
  1348.                wrinx2m(SEQ,$9E,Y);
  1349.              end;
  1350.  __xbe,__XGA:begin
  1351.                wrinx2(IOadr+10,$30,x);
  1352.                wrinx2(IOadr+10,$33,y);
  1353.              end;
  1354.   end;
  1355. end;
  1356.  
  1357.  
  1358.  
  1359. procedure AL_DstCoor(xst,yst:word);
  1360. var l:longint;
  1361.     w:word;
  1362. begin
  1363.   l:=yst*longint(pixels)+xst;
  1364.   repeat until (inp($82AA) and $F)=0;
  1365.   if memmode>_p8 then
  1366.   begin
  1367.     l:=l*2;
  1368.     outpw($828A,pixels*2);
  1369.   end
  1370.   else outpw($828A,pixels);
  1371.   outpw($8286,l);
  1372.   outp( $8288,l shr 16);
  1373.   outpw($829C,xst);
  1374.   outpw($829E,yst);
  1375. end;
  1376.  
  1377. procedure AL_BlitArea(dx,dy:word);
  1378. begin
  1379.   if memmode>_p8 then dx:=dx*2;
  1380.   outpw($828C,dx);
  1381.   outpw($828E,dy);
  1382. end;
  1383.  
  1384. procedure AL_SrcCoor(xst,yst:word);
  1385. var l:longint;
  1386.     w:word;
  1387. begin
  1388.   l:=yst*longint(pixels)+xst;
  1389.   if memmode>_p8 then
  1390.   begin
  1391.     l:=l*2;
  1392.     outpw($8284,pixels*2);
  1393.   end
  1394.   else outpw($8284,pixels);
  1395.   outpw($8280,l);
  1396.   outp( $8282,l shr 16);
  1397. end;
  1398.  
  1399. procedure WD_coor(index,x,y:word);
  1400. var l,b:longint;
  1401. begin
  1402.   b:=bytes;
  1403.   if memmode<=_pl4 then b:=b*8;
  1404.   case memmode of
  1405.   _p15,_p16:x:=x*2;
  1406.        _p24:x:=x*3;
  1407.   end;
  1408.   l:=b*y+x;
  1409.   WD_outl(index,l);
  1410. end;
  1411.  
  1412. procedure WD_DstCoor(X,Y,dx,dy:word);
  1413. var b:longint;
  1414. begin
  1415.   WD_coor($4000,X,Y);
  1416.   b:=bytes;
  1417.   if memmode<=_pl4 then b:=b*8;
  1418.   case memmode of
  1419.   _p15,_p16:dx:=dx*2;
  1420.        _p24:dx:=dx*3;
  1421.   end;
  1422.   outpw($23C2,$6000+dx);
  1423.   outpw($23C2,$7000+dy);
  1424.   outpw($23C2,$8000+b);
  1425. end;
  1426.  
  1427. procedure P2000_DstCoor(X,Y,dx,dy:word);
  1428. var l:longint;
  1429. begin
  1430.   l:=longint(pixels)*y+x;
  1431.   if memmode>_p8 then
  1432.   begin
  1433.     dx:=dx*2;
  1434.     l:=l*2;
  1435.     wrinx2(GRC,$3A,pixels*2);
  1436.   end
  1437.   else wrinx2(GRC,$3A,pixels);
  1438.   wrinx2(GRC,$33,dx);
  1439.   wrinx3(GRC,$37,l);
  1440.   wrinx2(GRC,$35,dy);
  1441. end;
  1442.  
  1443. procedure P2000_SrcCoor(X,Y:word);
  1444. var l:longint;
  1445. begin
  1446.   l:=longint(pixels)*y+x;
  1447.   if memmode>_p8 then l:=l*2;
  1448.   if memmode=_pl4 then wrinx(GRC,5,0);  {set write mode 0}
  1449.   wrinx3(GRC,$30,l);
  1450.   wrinx2(GRC,$1E,pixels);
  1451. end;
  1452.  
  1453. procedure P2000_cmd(cmd:word);
  1454. begin
  1455.   wrinx(GRC,$3D,cmd);
  1456.   repeat until (rdinx(GRC,$3D) and 1)=0;
  1457.   wrinx(GRC,$3D,0);
  1458. end;
  1459.  
  1460. procedure S3_fill(xst,yst,dx,dy,col:word);
  1461. begin
  1462.   repeat until (inp($9AE8) and $FF)=0;
  1463.   outpw($82E8,yst);
  1464.   outpw($86E8,Xst);
  1465.   outpw($96E8,dx);
  1466.   outpw($A6E8,col);
  1467.   outpw($BAE8,$27);
  1468.   outpw($BEE8,dy-1);
  1469.   outpw($BEE8,$A000);
  1470.   outpw($9AE8,$40F1);
  1471. end;
  1472.  
  1473. procedure fillrect(xst,yst,dx,dy:word;col:longint);
  1474. const
  1475.   masks:array[0..3] of byte=(0,7,3,1);
  1476.   maske:array[0..3] of byte=($F8,$FC,$FE,$FF);
  1477.   masks4:array[0..7] of byte=(0,$7F,$3F,$1F,$F,7,3,1);
  1478.   maske4:array[0..7] of byte=($80,$C0,$E0,$F0,$F8,$FC,$FE,$FF);
  1479. var w:word;
  1480.     l:longint;
  1481. begin
  1482.   case chip of
  1483.     __al2101:begin
  1484.                AL_DstCoor(xst,yst);
  1485.                AL_BlitArea(dx,dy);
  1486.                wrinx(GRC,$D,col);
  1487.                outp( $8290,7);
  1488.                outp( $8292,$D);
  1489.                outp( $82AA,1);
  1490.              end;
  1491.     __compaq:begin
  1492.                case memmode of
  1493.             _pl4,_pk4:col:=(col and 15)*$11111111;
  1494.                   _p8:col:=lo(col)*$1010101;
  1495.                end;
  1496.                repeat until (inp($33CE) and 1)=0;
  1497.                if rdinx(GRC,$F)=$A5 then
  1498.                begin
  1499.                  if memmode=_p8 then
  1500.                  begin
  1501.                    l:=(yst*bytes+xst) shr 2;
  1502.                    w:=bytes shr 2;
  1503.                    outp($33C0,masks[xst and 3]);
  1504.                    outp($33C1,maske[((xst+dx-1) and 3)]);
  1505.                    outp($33C8,(-dx) and 3);
  1506.                    outp($33C9,masks[dx and 3]);
  1507.                    if ((xst and 3)=0) and ((dx and 3)=0) then inc(dx,4);
  1508.                    outpw($23C2,(dx +(xst and 3) +3) shr 2);
  1509.                  end
  1510.                  else begin
  1511.                    l:=yst*bytes+(xst shr 3);
  1512.                    w:=bytes;
  1513.                    outp($33C0,masks4[xst and 7]);
  1514.                    outp($33C1,maske4[(xst+dx-1) and 7]);
  1515.                    outp($33C8,(-dx) and 7);
  1516.                    outp($33C9,masks4[dx and 7]);
  1517.                    if ((xst and 7)=0) and ((dx and 7)=0) then inc(dx,8);
  1518.                    outpw($23C2,(dx +(xst and 7) +7) shr 3);
  1519.                  end;
  1520.                  outpw($23C0,l);
  1521.                  outpw($23CA,w);
  1522.                  outpw($23CC,w);
  1523.                 { outpw($33C0,$ffff); }
  1524.                  outp($33c7,$c);
  1525.                 { outpw($33c8,0); }
  1526.                  w:=(l shr 2) and $C000;
  1527.                  w:=w or ((dy shl 4) and $3000);
  1528.                  outpw($23C4,dy+w);
  1529.               {   if (xst and 3)>0 then inc(dx,4);
  1530.                  if ((xst+dx-1) and 3)>0 then inc(dx,4); }
  1531.                  outp($33CF,$30);
  1532.                end
  1533.                else begin
  1534.                  outpw($63CC,xst);
  1535.                  outpw($63CE,yst);
  1536.                  outpw($23C2,dx);
  1537.                  outpw($23C4,dy);
  1538.                  outp($33CF,$C0);
  1539.                  wrinx(GRC,$5A,2);
  1540.                end;
  1541.                outpw($33CA,col);
  1542.                outpw($33CA,col);
  1543.                outpw($33CC,col);
  1544.                outpw($33CC,col);
  1545.                outp($33CE,9);
  1546.              end;
  1547.      __cir54:begin
  1548.              end;
  1549.      __P2000:begin
  1550.                wrinx(GRC,$3E,col);
  1551.                P2000_DstCoor(xst,yst,dx,dy);
  1552.                P2000_cmd($19);
  1553.              end;
  1554.   __paradise:begin
  1555.                WD_wait;
  1556.                outpw($23C2,$1000);
  1557.                outpw($23C2,$E0FF);
  1558.                outpw($23C2,$2000);
  1559.                outpw($23C2,$3000);
  1560.                WD_DstCoor(xst,yst,dx,dy);
  1561.                outpw($23C2,$9300);
  1562.                outpw($23C2,$A000+col);
  1563.                w:=$808;
  1564.                if memmode>_pl4 then w:=w+$100;
  1565.                outpw($23C2,w);
  1566.                WD_wait;
  1567.              end;
  1568.         __S3:if bytes>=1024 then
  1569.              begin
  1570.                S3_fill(xst,yst,dx,dy,lo(col));
  1571.                if (memmode>_p8) then
  1572.                  S3_fill(xst+1024,yst,dx,dy,hi(col));
  1573.              end;
  1574. { __xbe,__xga:begin
  1575.                repeat until (mem[xgaseg:$11] and $80)=0;
  1576.                mem[xgaseg:$12]:=1;
  1577.                mem[xgaseg:$48]:=3;
  1578.                memw[xgaseg:$58]:=col;
  1579.                memw[xgaseg:$78]:=xst;
  1580.                memw[xgaseg:$7A]:=yst;
  1581.                memw[xgaseg:$60]:=dx-1;
  1582.                memw[xgaseg:$62]:=dy-1;
  1583.  
  1584.  
  1585.                meml[xgaseg:$7C]:=$8118000;
  1586.              end; }
  1587.   end;
  1588. end;
  1589.  
  1590. procedure S3_copy(srcX,srcY,dstX,dstY,dx,dy:word);
  1591. begin
  1592.   repeat until (inp($9AE8) and $FF)=0;
  1593.   outpw($82E8,SrcY);
  1594.   outpw($86E8,SrcX);
  1595.   outpw($8AE8,DstY);
  1596.   outpw($8EE8,DstX);
  1597.  
  1598.   outpw($96E8,dx);
  1599.   outpw($BAE8,$67);
  1600.   outpw($BEE8,dy-1);
  1601.   outpw($BEE8,$A000);
  1602.   repeat until (inp($9AE8) and $80)=0;
  1603.   outpw($9AE8,$C0F1);
  1604. end;
  1605.  
  1606. procedure copyrect(srcX,srcY,dstX,dstY,dx,dy:word);
  1607. var l:longint;
  1608.     w,dir:word;
  1609.     i1,i2:integer;
  1610. begin
  1611.   if (DstY<SrcY) or ((SrcY=DstY) and (DstX<SrcX)) then dir:=0
  1612.   else begin
  1613.     dir:=1;
  1614.     SrcX:=SrcX+dx-1;
  1615.     SrcY:=SrcY+dy-1;
  1616.     DstX:=DstX+dx-1;
  1617.     DstY:=DstY+dy-1;
  1618.   end;
  1619.   case chip of
  1620.     __al2101:begin
  1621.                AL_DstCoor(DstX,DstY);
  1622.                AL_BlitArea(dx,dy);
  1623.                AL_SrcCoor(SrcX,SrcY);
  1624.                outp( $8290,7);
  1625.                outpw($8292,$D);
  1626.                outp( $82AA,2);
  1627.              end;
  1628.     __compaq:begin
  1629.                repeat until (inp($33CE) and 1)=0;
  1630.                if rdinx(GRC,$F)=$A5 then   {AVGA}
  1631.                begin
  1632.                  l :=srcy*bytes+srcx;
  1633.                  w:=256;
  1634.                  if (dir>0) then w:=$FF00;
  1635.             {     begin
  1636.                    l:=l+(dy-1)*bytes+(dx-1);
  1637.                    w:=$ff00;
  1638.                  end; }
  1639.                  i1:=dsty-srcy;
  1640.                  i2:=dstx-srcx;
  1641.                  outpw($23C0,l shr 2);
  1642.                  outpw($23CC,lo(i1)*256+lo(i2 shr 2));
  1643.                  outp($23C2,dx shr 2);
  1644.                  outpw($23CA,w{bytes shr 2});
  1645.                  outpw($33C0,$ffff);
  1646.                  outp($33c7,$c);
  1647.                  outpw($33c8,0);
  1648.                  w:=(w and $c00) or ((l shr 4) and $C000);
  1649.                  w:=w or ((i1 shl 4) and $3000);
  1650.                  outpw($23C4,dy+w);
  1651.                  outp($33CF,$30);
  1652.                end
  1653.                else begin            {QVision}
  1654.                  outpw($63CC,DstX);
  1655.                  outpw($63CE,DstY);
  1656.                  outpw($63C0,SrcX);
  1657.                  outpw($63C2,SrcY);
  1658.                  outpw($23C2,dx);
  1659.                  outpw($23C4,dy);
  1660.                  outpw($23CA,256);
  1661.                  outpw($23CC,256);
  1662.                  outp($33CF,$C0);
  1663.                  wrinx(GRC,$5A,1);
  1664.                end;
  1665.                outp($33CE,$11);
  1666.              end;
  1667.      __cir54:begin
  1668.                repeat until (rdinx(GRC,$31) and 1)=0;
  1669.                case memmode of
  1670.              _p15,_p16:w:=2;
  1671.                   _p24:w:=3;
  1672.                else w:=1;
  1673.                end;
  1674.                wrinx2(GRC,$20,dx*w);
  1675.                wrinx2(GRC,$22,dy);
  1676.                wrinx2(GRC,$24,bytes);
  1677.                wrinx2(GRC,$26,bytes);
  1678.                wrinx3(GRC,$28,dstY*bytes+dstX*w);
  1679.                wrinx3(GRC,$2C,srcY*bytes+srcX*w);
  1680.                wrinx(GRC,$32,$d);
  1681.                wrinx(GRC,$31,2);
  1682.              end;
  1683.      __P2000:begin
  1684.                P2000_SrcCoor(SrcX,SrcY);
  1685.                P2000_DstCoor(DstX,DstY,dx,dy);
  1686.                P2000_Cmd(5);
  1687.              end;
  1688.   __paradise:begin
  1689.                WD_wait;
  1690.                outpw($23C2,$1000);
  1691.                outpw($23C2,$E0FF);
  1692.                WD_DstCoor(DstX,DstY,dx,dy);
  1693.                WD_Coor($2000,SrcX,SrcY);
  1694.                outpw($23C2,$9300);
  1695.                w:=$800;
  1696.                if memmode>_pl4 then w:=w+$100;
  1697.                if dir>0 then w:=w+$400;
  1698.                outpw($23C2,w);
  1699.                WD_wait;
  1700.              end;
  1701.         __S3:if bytes>=1024 then
  1702.              begin
  1703.                S3_copy(SrcX,SrcY,DstX,DstY,dx,dy);
  1704.                if (memmode>_p8) then
  1705.                  S3_copy(SrcX+1024,SrcY,DstX+1024,DstY,dx,dy);
  1706.              end;
  1707.  __xbe,__xga:begin
  1708.                repeat until (mem[xgaseg:$11] and $80)=0;
  1709.                mem[xgaseg:$48]:=3;
  1710.                memw[xgaseg:$70]:=SrcX;
  1711.                memw[xgaseg:$72]:=SrcY;
  1712.                memw[xgaseg:$78]:=DstX;
  1713.                memw[xgaseg:$7A]:=DstY;
  1714.                memw[xgaseg:$60]:=dx-1;
  1715.                memw[xgaseg:$62]:=dy-1;
  1716.  
  1717.  
  1718.                memw[xgaseg:$7C]:=$8000;
  1719.                memw[xgaseg:$7E]:=$811;
  1720.              end;
  1721.   end;
  1722. end;
  1723.  
  1724. procedure swp(var i,j:integer);
  1725. var z:integer;
  1726. begin
  1727.   z:=i;
  1728.   i:=j;
  1729.   j:=z;
  1730. end;
  1731.  
  1732. procedure S3_line(x0,y0,x1,y1,col:integer);
  1733. var w,z:word;
  1734. begin
  1735.   repeat until (inp($9AE8) and $FF)=0;
  1736.   outpw($82E8,Y0);
  1737.   outpw($86E8,X0);
  1738.   w:=0;z:=0;
  1739.   x1:=x1-x0;
  1740.   if x1<0 then
  1741.   begin
  1742.     x1:=-x1;
  1743.     w:=w or $20;
  1744.     z:=1;
  1745.   end;
  1746.   y1:=y1-y0;
  1747.   if y1<0 then
  1748.   begin
  1749.     y1:=-y1;
  1750.     w:=w or $80;
  1751.   end;
  1752.   if x1<y1 then
  1753.   begin
  1754.     swp(x1,y1);
  1755.     w:=w or $40;
  1756.   end;
  1757.   outpw($8AE8,2*y1);
  1758.   outpw($8EE8,2*(y1-x1));
  1759.   outpw($92E8,2*y1-x1-z);
  1760.   repeat until (inp($9AE8) and $FF)=0;
  1761.   outpw($96E8,x1);
  1762.   outpw($A6E8,col);
  1763.   outpw($BAE8,$27);
  1764.   outpw($BEE8,$A000);
  1765.   outpw($9AE8,$2017+w);
  1766. end;
  1767.  
  1768.  
  1769. procedure line(x0,y0,x1,y1:integer;col:longint);
  1770. var l:longint;
  1771.   z,w:word;
  1772. begin
  1773.   case chip of
  1774.     __al2101:begin
  1775.                AL_DstCoor(x0,y0);
  1776.                wrinx(GRC,$D,col);
  1777.                outpw($82A8,$FFFF);
  1778.                w:=0;
  1779.                x1:=x1-x0;
  1780.                if x1<0 then
  1781.                begin
  1782.                  x1:=-x1;
  1783.                  w:=w or $100;
  1784.                end;
  1785.                if memmode>_p8 then x1:=x1*2;
  1786.                y1:=y1-y0;
  1787.                if y1<0 then
  1788.                begin
  1789.                  y1:=-y1;
  1790.                  w:=w or $200;
  1791.                end;
  1792.                if x1<y1 then
  1793.                begin
  1794.                  swp(x1,y1);
  1795.                  w:=w or $400;
  1796.                end;
  1797.                outpw($82A2,2*y1);
  1798.                outpw($82A6,2*y1-x1);
  1799.                outpw($82A4,2*(y1-x1));
  1800.                outpw($828E,x1+1);
  1801.                outpw($8292,$80D+w);
  1802.                outp ($8290,0);
  1803.                outp ($82AA,8);
  1804.              end;
  1805.         __S3:if bytes>=1024 then
  1806.              begin
  1807.                S3_line(x0,y0,x1,y1,lo(col));
  1808.                if (memmode>_p8) then
  1809.                  S3_line(x0+1024,y0,x1+1024,y1,hi(col));
  1810.              end;
  1811.  __xbe,__xga:begin
  1812.                repeat until (mem[xgaseg:$11] and $80)=0;
  1813.                meml[xgaseg:$7C]:=$5010000;
  1814.  
  1815.              end;
  1816.   end;
  1817. end;
  1818.  
  1819.  
  1820.  
  1821.  
  1822.  
  1823.  
  1824.  
  1825.  
  1826.  
  1827.  
  1828. begin
  1829. end
  1830. .