home *** CD-ROM | disk | FTP | other *** search
/ The Party 1994: Try This At Home / disk_image.bin / source / phantcyb / vga256.pas < prev   
Pascal/Delphi Source File  |  1994-07-15  |  19KB  |  644 lines
  1. unit VGA256;
  2.  
  3. interface
  4.  
  5. uses Dos,crt;
  6. const SCREEN=$A000;
  7.  
  8. var p1,p2,p3,p4,p5,p6,p7: pointer;
  9.     bank1,bank2,bank3,bank4,bank5,sys,font: word;
  10.     r,g,b: array[0..255] of byte;
  11.  
  12. procedure Bar(segm,x1,y1,x2,y2: word; c: byte);
  13. procedure Polygon(segm,x1,y1,x2,y2,x3,y3,x4,y4: word; c: byte);
  14. procedure Checkers(segm: word);
  15. procedure ShowBank(segm: word);
  16. procedure LoadBank(s: string; segm: word);
  17. procedure SaveBank(s: string; segm: word);
  18. procedure DefaultPalette;
  19. procedure InitBanks;
  20. procedure LoadScreen(s: string; p: pointer);
  21. procedure InitScreen;
  22. procedure CloseScreen;
  23. procedure Palette (n,r,g,b: byte);
  24. procedure NCls(c: byte);
  25. procedure Hline (x1,y1,l,c: integer);
  26. procedure Vline (x1,y1,l,c: integer);
  27. procedure WaitVbl;
  28. procedure Mode(n: byte);
  29. procedure Plasma(segm: word);
  30. procedure Plasma256(segm: word);
  31. procedure C_Plasma(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
  32. procedure C_Plasma256(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
  33.  
  34. implementation
  35.  
  36. procedure Bar(segm,x1,y1,x2,y2: word; c: byte); Assembler;
  37. {Optimized ofcourse... Draws a bar using words in selected segment}
  38. var linec,width: word;
  39. label lines,drawwords,pixels,exit;
  40. asm
  41.    mov DI,[y1]             {Calculate screenaddress}
  42.    mov BX,DI
  43.    shl BX,6
  44.    shl DI,8
  45.    add DI,BX
  46.    add DI,[x1]
  47.    mov CX,[y2]             {Calculate number of lines}
  48.    sub CX,[y1]
  49.    mov [linec],CX
  50.    mov CX,[x2]             {Calculate width of square}
  51.    sub CX,[x1]
  52.    mov [width],CX
  53.    mov ES,[segm]           {Output segment}
  54.    mov AL,[c]              {Pixel color}
  55.    mov AH,AL
  56. lines:
  57.    mov CX,[width]          {Load pixelcounter}
  58.    mov SI,DI               {Load addresscounter}
  59.    add DI,320              {Increase linestartaddress}
  60.    mov BX,SI
  61.    and BX,1                {odd?}
  62.    jz drawwords
  63.    mov ES:[SI],AL          {then draw one pixel}
  64.    inc SI
  65.    dec CX
  66.    jz exit                 {No more pixels}
  67. drawwords:
  68.    mov BX,CX
  69.    shr CX,1                {Words=bytes/2}
  70.    jz exit
  71. pixels:
  72.    mov ES:[SI],AX
  73.    add SI,2
  74.    loop pixels
  75.    and BX,1                {Last odd pixel?}
  76.    jz exit
  77.    mov ES:[SI],AL
  78. exit:
  79.    dec [linec]
  80.    jnz lines
  81. end;
  82.  
  83. procedure Polygon(segm,x1,y1,x2,y2,x3,y3,x4,y4: word; c: byte);
  84. {Draws a polygon with four edges with color c in a bank or on screen}
  85. label pixels1,pixels2,pixels3,pixels4,clear,lines,drawit,nodraw
  86.       ,skip1a,skip1b,skip2a,skip2b,skip3a,skip3b,skip4a,skip4b
  87.       ,drawword,startfast,lastodd;
  88. var x,y: array[1..5] of word;
  89.     xs: word;
  90.     dy: integer;
  91.     dx: word;
  92.     i,l: word;
  93.     a,b: word;
  94.     h1,v1: word;
  95.     loopc: word;
  96. begin
  97.    x[1]:=x1; y[1]:=y1;
  98.    x[2]:=x2; y[2]:=y2;
  99.    x[3]:=x3; y[3]:=y3;
  100.    x[4]:=x4; y[4]:=y4;
  101.    x[5]:=x1; y[5]:=y1;
  102.    {Clear the start-end-of-horizontal-line table}
  103.    asm
  104.       mov AX,[sys]
  105.       mov ES,AX
  106.       mov DI,0
  107.       mov CX,200
  108.    clear:
  109.       mov word ptr ES:[DI],320       {min value at current line}
  110.       mov word ptr ES:[DI+2],0       {max value at current line}
  111.       add DI,4
  112.       loop clear
  113.    end;
  114.    {Draw lines}
  115.    for i:=1 to 4 do begin
  116.       b:=0;
  117.       if abs(y[i]-y[i+1])>0 then begin
  118.          if y[i]<y[i+1] then begin
  119.             if x[i]<x[i+1] then begin
  120.                h1:=x[i];
  121.                v1:=y[i];
  122.                dx:=x[i+1]-h1;
  123.                dy:=y[i+1]-v1;
  124.                xs:=(dx shl 7) div dy;
  125.                asm
  126.                   mov AX,[sys]          {write min&max values in bank6}
  127.                   mov ES,AX
  128.                   mov DI,[v1]           {first line to fill}
  129.                   shl DI,2              {4 bytes per line}
  130.                   mov BX,[h1]           {get start-x for line}
  131.                   shl BX,7              { *127 }
  132.                   mov DX,[xs]           {x-displacement per line}
  133.                   mov CX,[dy]
  134.                pixels1:
  135.                   mov SI,BX             {get x}
  136.                   shr SI,7              {divide by 127}
  137.                   cmp SI,ES:[DI]        {smaller than min at this line?}
  138.                   jae skip1a
  139.                   mov ES:[DI],SI        {replace min}
  140.                skip1a:
  141.                   cmp SI,ES:[DI+2]      {greater than max at this line?}
  142.                   jbe skip1b
  143.                   mov ES:[DI+2],SI      {replace max}
  144.                skip1b:
  145.                   add DI,4              {next line}
  146.                   add BX,DX             {update x-coord}
  147.                   loop pixels1          {next pixel}
  148.                end;
  149.             end else begin
  150.                h1:=x[i+1];
  151.                v1:=y[i+1];
  152.                dx:=x[i]-h1;
  153.                dy:=v1-y[i];
  154.                xs:=(dx shl 7) div dy;
  155.                asm
  156.                   mov AX,[sys]          {write min&max values in bank6}
  157.                   mov ES,AX
  158.                   mov DI,[v1]           {first line to fill}
  159.                   shl DI,2              {4 bytes per line}
  160.                   mov BX,[h1]           {get start-x for line}
  161.                   shl BX,7              { *127 }
  162.                   mov DX,[xs]           {x-displacement per line}
  163.                   mov CX,[dy]
  164.                pixels2:
  165.                   mov SI,BX             {get x}
  166.                   shr SI,7              {divide by 127}
  167.                   cmp SI,ES:[DI]        {smaller than min at this line?}
  168.                   jae skip2a
  169.                   mov ES:[DI],SI        {replace min}
  170.                skip2a:
  171.                   cmp SI,ES:[DI+2]      {greater than max at this line?}
  172.                   jbe skip2b
  173.                   mov ES:[DI+2],SI      {replace max}
  174.                skip2b:
  175.                   sub DI,4              {next line}
  176.                   add BX,DX             {update x-coord}
  177.                   loop pixels2          {next pixel}
  178.                end;
  179.             end
  180.          end else begin
  181.             if x[i]>x[i+1] then begin
  182.                h1:=x[i+1];
  183.                v1:=y[i+1];
  184.                dx:=x[i]-h1;
  185.                dy:=y[i]-v1;
  186.                xs:=(dx shl 7) div dy;
  187.                asm
  188.                   mov AX,[sys]          {write min&max values in bank6}
  189.                   mov ES,AX
  190.                   mov DI,[v1]           {first line to fill}
  191.                   shl DI,2              {4 bytes per line}
  192.                   mov BX,[h1]           {get start-x for line}
  193.                   shl BX,7              { *127 }
  194.                   mov DX,[xs]           {x-displacement per line}
  195.                   mov CX,[dy]
  196.                pixels3:
  197.                   mov SI,BX             {get x}
  198.                   shr SI,7              {divide by 127}
  199.                   cmp SI,ES:[DI]        {smaller than min at this line?}
  200.                   jae skip3a
  201.                   mov ES:[DI],SI        {replace min}
  202.                skip3a:
  203.                   cmp SI,ES:[DI+2]      {greater than max at this line?}
  204.                   jbe skip3b
  205.                   mov ES:[DI+2],SI      {replace max}
  206.                skip3b:
  207.                   add DI,4              {next line}
  208.                   add BX,DX             {update x-coord}
  209.                   loop pixels3          {next pixel}
  210.                end;
  211.             end else begin
  212.                h1:=x[i];
  213.                v1:=y[i];
  214.                dx:=x[i+1]-h1;
  215.                dy:=v1-y[i+1];
  216.                xs:=(dx shl 7) div dy;
  217.                asm
  218.                   mov AX,[sys]          {write min&max values in bank6}
  219.                   mov ES,AX
  220.                   mov DI,[v1]           {first line to fill}
  221.                   shl DI,2              {4 bytes per line}
  222.                   mov BX,[h1]           {get start-x for line}
  223.                   shl BX,7              { *127 }
  224.                   mov DX,[xs]           {x-displacement per line}
  225.                   mov CX,[dy]
  226.                pixels4:
  227.                   mov SI,BX             {get x}
  228.                   shr SI,7              {divide by 127}
  229.                   cmp SI,ES:[DI]        {smaller than min at this line?}
  230.                   jae skip4a
  231.                   mov ES:[DI],SI        {replace min}
  232.                skip4a:
  233.                   cmp SI,ES:[DI+2]      {greater than max at this line?}
  234.                   jbe skip4b
  235.                   mov ES:[DI+2],SI      {replace max}
  236.                skip4b:
  237.                   sub DI,4              {next line}
  238.                   add BX,DX             {update x-coord}
  239.                   loop pixels4          {next pixel}
  240.                end;
  241.             end;
  242.          end;
  243.       end;
  244.    end;
  245.    {determine highest and lowest y-coord}
  246.    i:=0;        {highest}
  247.    l:=200;      {lowest}
  248.    for a:=1 to 4 do begin
  249.       if y[a]<l then l:=y[a];
  250.       if y[a]>i then i:=y[a];
  251.    end;
  252.    {Now draw the horizontal lines really fast using words}
  253.    asm
  254.       mov CX,[i]                     {last line to draw}
  255.       mov DI,[l]                     {first line to draw}
  256.       sub CX,DI                      {number of lines to draw}
  257.       mov [loopc],CX
  258.       mov AX,DI
  259.       mov SI,DI                      {min-max table pointer}
  260.       shl SI,2
  261.       shl AX,6
  262.       shl DI,8
  263.       add DI,AX                      {DI=startline *320}
  264.       mov ES,[segm]
  265.       mov AL,[c]
  266.       mov AH,AL
  267.       push DS
  268.       mov DS,[sys]                   {min-max table segment}
  269.    lines:
  270.       mov BX,DS:[SI]                 {startpos of current line}
  271.       mov CX,DS:[SI+2]               {endpos of current line}
  272.       inc CX
  273.       sub CX,BX                      {length of current line}
  274.    drawit:
  275.       mov DX,BX                      {odd?}
  276.       and DX,1
  277.       jz  startfast                  {no:  start drawing words}
  278.       mov ES:[DI+BX],AL              {yes: draw the odd pixel}
  279.       inc BX                         {now it's even}
  280.       dec CX                         {was this the last pixel?}
  281.       jz  nodraw                     {then quit}
  282.    startfast:
  283.       mov DX,CX
  284.       shr CX,1                       {how many words?}
  285.       jz  lastodd                    {none}
  286.    drawword:
  287.       mov ES:[DI+BX],AX
  288.       add BX,2
  289.       loop drawword
  290.    lastodd:
  291.       and DX,1
  292.       jz  nodraw
  293.       mov ES:[DI+BX],AL
  294.    nodraw:
  295.       add SI,4                       {next min-max line}
  296.       add DI,320                     {next screen-line}
  297.       dec [loopc]
  298.       jnz lines
  299.       pop DS
  300.    end;
  301. end;
  302.  
  303.  
  304. procedure Checkers(segm: word);
  305. {Draws a nice checkers-pattern in a memory bank (256x256)}
  306. var x,y,h,v,a: word;
  307. begin
  308.    for y:=0 to 15 do for x:=0 to 15 do if odd(x+y) then begin
  309.       a:=x*16+y*16*256;
  310.       for h:=0 to 15 do for v:=0 to 15 do mem[segm:a+h+v shl 8]:=255;
  311.    end;
  312. end;
  313.  
  314. procedure ShowBank(segm: word);
  315. {Copy the contents of a bank to the screen (only first 64000 bytes,
  316.  320x200 format, current palette) }
  317. var i: word;
  318. begin
  319.    for i:=0 to 13999 do meml[$a000:i shl 2]:=meml[segm:i shl 2];
  320. end;
  321.  
  322. procedure LoadBank(s: string; segm: word);
  323. {Load a bank from disk}
  324. var f: file;
  325. begin
  326.    assign(f,s);
  327.    reset(f,1);
  328.    if segm=bank1 then BlockRead(f,p1^,65535);
  329.    if segm=bank2 then BlockRead(f,p2^,65535);
  330.    if segm=bank3 then BlockRead(f,p3^,65535);
  331.    if segm=bank4 then BlockRead(f,p4^,65535);
  332.    if segm=bank5 then BlockRead(f,p5^,65535);
  333.    close(f);
  334. end;
  335.  
  336. procedure SaveBank(s: string; segm: word);
  337. {Save a bank to disk}
  338. var f: file;
  339. begin
  340.    assign(f,s);
  341.    rewrite(f,1);
  342.    if segm=bank1 then BlockWrite(f,p1^,65535);
  343.    if segm=bank2 then BlockWrite(f,p2^,65535);
  344.    if segm=bank3 then BlockWrite(f,p3^,65535);
  345.    if segm=bank4 then BlockWrite(f,p4^,65535);
  346.    if segm=bank5 then BlockWrite(f,p5^,65535);
  347.    close(f);
  348. end;
  349.  
  350. procedure ClearBank(segm: word); Assembler;
  351. {Clear the contents of a memory bank}
  352. label clear;
  353. asm
  354.    mov ES,[segm]
  355.    mov DI,0
  356.    mov CX,32767
  357. clear:
  358.    mov word ptr ES:[DI],0
  359.    add DI,2
  360.    loop clear
  361. end;
  362.  
  363. procedure InitBanks;
  364. {Initialize the memory banks}
  365. begin
  366.    GetMem(p1,65535);
  367.    GetMem(p2,65535);
  368.    GetMem(p3,65535);
  369.    GetMem(p4,65535);
  370.    GetMem(p5,65535);
  371.    GetMem(p6,32767);
  372.    GetMem(p7,32767);
  373.    bank1:=Seg(p1^);
  374.    bank2:=Seg(p2^);
  375.    bank3:=Seg(p3^);
  376.    bank4:=Seg(p4^);
  377.    bank5:=Seg(p5^);
  378.    sys:=Seg(p6^);
  379.    font:=Seg(p7^);
  380.    ClearBank(bank1);
  381.    ClearBank(bank2);
  382.    ClearBank(bank3);
  383.    ClearBank(bank4);
  384.    ClearBank(bank5);
  385.    ClearBank(sys);
  386.    ClearBank(font);
  387. end;
  388.  
  389. procedure DefaultPalette;
  390. {Create a simple greyscale-palette}
  391. var i: byte;
  392. begin
  393.    for i:=0 to 255 do palette(i,i div 4,i div 4,i div 4);
  394. end;
  395.  
  396. procedure LoadScreen(s: string; p: pointer);
  397. {Load a screen from disk, including the palette}
  398. var f: file;
  399.    i: integer;
  400.    s1,o1: word;
  401. begin
  402.    s1:=Seg(p^);
  403.    o1:=Ofs(p^);
  404.    assign(f,s);
  405.    Reset(f,1);
  406.    BlockRead(f,p^,9);
  407.    BlockRead(f,p^,64000);
  408.    BlockRead(f,p^,256*3);
  409.    for i:=0 to 255 do begin
  410.       r[i]:=mem[s1:o1+i*3];
  411.       g[i]:=mem[s1:o1+i*3+1];
  412.       b[i]:=mem[s1:o1+i*3+2];
  413.       palette(i,r[i],g[i],b[i]);
  414.    end;
  415.    reset(f,1);
  416.    BlockRead(f,p^,9);
  417.    BlockRead(f,p^,64000);
  418. end;
  419.  
  420. procedure InitScreen;
  421. {Initialize 320x200x256 MCGA mode}
  422. var i: word;
  423. begin
  424.    Inline($B8/$13/0/$CD/$10);
  425.    NCls(0);
  426.    for i:=0 to 255 do palette(i,i div 4,i div 4,i div 4);
  427. end;
  428.  
  429. procedure CloseScreen;
  430. {Return to textmode}
  431. begin
  432.    Textmode(Lastmode);
  433. end;
  434.  
  435. Procedure Palette (n,r,g,b: byte);
  436. {Change the palette}
  437. Begin Port[$3C8] := n;
  438.       Port[$3C9] := r;
  439.       Port[$3C9] := g;
  440.       Port[$3C9] := b;
  441. End;
  442.  
  443. procedure NCls(c: byte);
  444. {Clear the screen}
  445. var i: word;
  446.     cc: longint;
  447. begin
  448.    cc:=c+c*256+c*65536+c*65536*256;
  449.    for i:=0 to $3e7f do meml[$a000:4*i]:=cc
  450. end;
  451.  
  452. procedure Line(x1,y1,x2,y2,c: integer);
  453. {Draw a line}
  454.    var dx,dy,l: real; i,z: integer;
  455. begin
  456.    l:=sqrt(abs((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)));
  457.    dx:=(x2-x1)/l;
  458.    dy:=(y2-y1)/l;
  459.    z:=x1+y1*320;
  460.    for i:=1 to round(l) do mem[$a000:z+round(i*dx)+320*round(i*dy)]:=c
  461. end;
  462.  
  463. procedure Hline(x1,y1,l,c: integer);
  464. {Draw a horizontal line}
  465.    var i,z: word;
  466.        q: word;
  467. begin
  468.    z:=x1+y1*320;
  469.    q:=c+256*c;
  470.    while l>1 do begin
  471.       l:=l-2;
  472.       memw[$a000:z]:=q;
  473.       z:=z+2
  474.    end;
  475.    for i:=1 to l do mem[$a000:z+i-1]:=c
  476. end;
  477.  
  478. procedure Vline(x1,y1,l,c: integer);
  479. {Draw a vertical line}
  480.    var i,z: integer;
  481. begin
  482.    z:=x1+y1*320;
  483.    for i:=0 to l-1 do mem[$a000:z+i*320]:=c
  484. end;
  485.  
  486. procedure WaitVbl; assembler;
  487. {Wait for sync}
  488. label
  489.   l1, l2;
  490. asm
  491.     cli
  492.     mov dx,3DAh
  493. l1:
  494.     in al,dx
  495.     and al,08h
  496.     jnz l1
  497. l2:
  498.     in al,dx
  499.     and al,08h
  500.     jz  l2
  501.     sti
  502. end;
  503.  
  504. procedure Mode (n: byte);
  505. {Initialize mode n}
  506. begin
  507.    asm
  508.      mov  AH,00
  509.      mov  AL,n
  510.      Int  10h
  511.    end;
  512. end;
  513.  
  514. procedure Plasma(segm: word);
  515. {Draw a default plasma (320x200) }
  516. begin
  517.    C_Plasma(segm,2,0,0,319,199,1,255);
  518. end;
  519.  
  520. procedure Plasma256(segm: word);
  521. {Draw a default plasma (256x256) }
  522. begin
  523.    C_Plasma256(segm,2,0,0,255,255,1,255);
  524. end;
  525.  
  526. procedure C_Plasma(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
  527. {Draw a customized plasma}
  528. var i: longint;
  529.     x,y: word;
  530.   procedure subDivide(x1,y1,x2,y2: integer);
  531.     var
  532.       x,y: word;          {OPTIMIZED BY THE PHANTOM}
  533.       v: integer;         {SPEED GAIN APPROX. 400% }
  534.   begin
  535.     if x2-x1>=2 then begin
  536.        x:=(x1+x2) shr 1;
  537.        y:=(y1+y2) shr 1;
  538.        if mem[segm:x+y1*320]=0 then begin
  539.           v:=round(((mem[segm:x1+y1*320]+mem[segm:x2+y1*320]) shr 1)+
  540.              (random-0.5)*(x2-x1)*F);
  541.           if v<minv then v:=minv;
  542.           if v>maxv then v:=maxv;
  543.           mem[segm:x+y1*320]:=v;
  544.        end;
  545.        if mem[segm:x2+y*320]=0 then begin
  546.           v:=round(((mem[segm:x2+y1*320]+mem[segm:x2+y2*320]) shr 1)+
  547.              (random-0.5)*(y2-y1)*F);
  548.           if v<minv then v:=minv;
  549.           if v>maxv then v:=maxv;
  550.           mem[segm:x2+y*320]:=v
  551.        end;
  552.        if mem[segm:x+y2*320]=0 then begin
  553.           v:=round(((mem[segm:x1+y2*320]+mem[segm:x2+y2*320]) shr 1)+
  554.              (random-0.5)*(x1-x2)*F);
  555.           if v<minv then v:=minv;
  556.           if v>maxv then v:=maxv;
  557.           mem[segm:x+y2*320]:=v
  558.        end;
  559.        if mem[segm:x1+y*320]=0 then begin
  560.           v:=round(((mem[segm:x1+y1*320]+mem[segm:x1+y2*320]) shr 1)+
  561.              (random-0.5)*(y2-y1)*F);
  562.           if v<minv then v:=minv;
  563.           if v>maxv then v:=maxv;
  564.           mem[segm:x1+y*320]:=v
  565.        end;
  566.        if mem[segm:x+y*320]=0 then
  567.            mem[segm:x+y*320]:=(mem[segm:x1+y1*320]+mem[segm:x2+y1*320]
  568.            +mem[segm:x2+y2*320]+mem[segm:x1+y2*320]) shr 2;
  569.        subDivide(x1,y1,x,y);
  570.        subDivide(x,y1,x2,y);
  571.        subDivide(x,y,x2,y2);
  572.        subDivide(x1,y,x,y2)
  573.      end
  574.   end;
  575. begin
  576.   Randomize;
  577.   for x:=h1 to h2 do for y:=v1 to v2 do mem[segm:x+y*320]:=0;
  578.   mem[segm:h1+v1*320]:=Random(maxv-minv)+minv;
  579.   mem[segm:h2+v1*320]:=Random(maxv-minv)+minv;
  580.   mem[segm:h2+v2*320]:=Random(maxv-minv)+minv;
  581.   mem[segm:h1+v2*320]:=Random(maxv-minv)+minv;
  582.   subDivide(h1,v1,h2,v2);
  583. end;
  584.  
  585. procedure C_Plasma256(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
  586. {Draw a customized plasma}
  587. var i: longint;
  588.     x,y: word;
  589.   procedure subDivide(x1,y1,x2,y2: integer);
  590.     var
  591.       x,y: word;          {OPTIMIZED BY THE PHANTOM}
  592.       v: integer;         {SPEED GAIN APPROX. 400% }
  593.   begin
  594.     if x2-x1>=2 then begin
  595.        x:=(x1+x2) shr 1;
  596.        y:=(y1+y2) shr 1;
  597.        if mem[segm:x+y1 shl 8]=0 then begin
  598.           v:=round(((mem[segm:x1+y1 shl 8]+mem[segm:x2+y1 shl 8]) shr 1)+
  599.              (random-0.5)*(x2-x1)*F);
  600.           if v<minv then v:=minv;
  601.           if v>maxv then v:=maxv;
  602.           mem[segm:x+y1 shl 8]:=v;
  603.        end;
  604.        if mem[segm:x2+y shl 8]=0 then begin
  605.           v:=round(((mem[segm:x2+y1 shl 8]+mem[segm:x2+y2 shl 8]) shr 1)+
  606.              (random-0.5)*(y2-y1)*F);
  607.           if v<minv then v:=minv;
  608.           if v>maxv then v:=maxv;
  609.           mem[segm:x2+y shl 8]:=v
  610.        end;
  611.        if mem[segm:x+y2 shl 8]=0 then begin
  612.           v:=round(((mem[segm:x1+y2 shl 8]+mem[segm:x2+y2 shl 8]) shr 1)+
  613.              (random-0.5)*(x1-x2)*F);
  614.           if v<minv then v:=minv;
  615.           if v>maxv then v:=maxv;
  616.           mem[segm:x+y2 shl 8]:=v
  617.        end;
  618.        if mem[segm:x1+y shl 8]=0 then begin
  619.           v:=round(((mem[segm:x1+y1 shl 8]+mem[segm:x1+y2 shl 8]) shr 1)+
  620.              (random-0.5)*(y2-y1)*F);
  621.           if v<minv then v:=minv;
  622.           if v>maxv then v:=maxv;
  623.           mem[segm:x1+y shl 8]:=v
  624.        end;
  625.        if mem[segm:x+y shl 8]=0 then
  626.            mem[segm:x+y shl 8]:=(mem[segm:x1+y1 shl 8]+mem[segm:x2+y1 shl 8]
  627.            +mem[segm:x2+y2 shl 8]+mem[segm:x1+y2 shl 8]) shr 2;
  628.        subDivide(x1,y1,x,y);
  629.        subDivide(x,y1,x2,y);
  630.        subDivide(x,y,x2,y2);
  631.        subDivide(x1,y,x,y2)
  632.      end
  633.   end;
  634. begin
  635.   Randomize;
  636.   for x:=h1 to h2 do for y:=v1 to v2 do mem[segm:x+y shl 8]:=0;
  637.   mem[segm:h1+v1 shl 8]:=Random(maxv-minv)+minv;
  638.   mem[segm:h2+v1 shl 8]:=Random(maxv-minv)+minv;
  639.   mem[segm:h2+v2 shl 8]:=Random(maxv-minv)+minv;
  640.   mem[segm:h1+v2 shl 8]:=Random(maxv-minv)+minv;
  641.   subDivide(h1,v1,h2,v2);
  642. end;
  643.  
  644. end.