home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / HEJB / GRAPH / LIS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1994-04-21  |  4.6 KB  |  186 lines
  1. { ************************* Program Lis ******************************* }
  2. { je takovou krátkou ukázkou toho, jak mûæe vypadat HEJB v grafice.     }
  3. { Smûla je, æe PC+TP6.0 má omezená pole na velikost 64kB,               }
  4. { a tak velikost virtuální 3D obrazovky je asi 100x100 pixelû,          }
  5. { coæ není mnoho.                                                       }
  6.  
  7. uses graph, obraz3d, unhejb, crt, dos, unpismeno;
  8. const moc = 32000;
  9.  
  10.       zoom  = 50;
  11. var ven : text;
  12. type typbod = record
  13.                 x,y : typ_souradnic end;
  14.      typptrbod = ^typbod;
  15.  
  16. type typpolebodu = array[0..moc]of typbod;
  17.  
  18. type tliss = object(typ_hejbaci)
  19.               sirka    : integer;
  20.               delka    : integer;
  21.  
  22.               body     : ^typpolebodu;
  23.               zaplneno : integer;
  24.               aktivni  : integer;
  25.  
  26.               parametr : real;
  27.               pomer    : real;
  28.               rych     : real;
  29.               sirrych  : real;
  30.  
  31.               constructor init(_sirka, _delka : integer; posun, perioda, pompomer : real; pbarva : integer);
  32.               procedure zobraz;
  33.               procedure jedenkrok;
  34.             end;
  35.  
  36. constructor tliss.init;
  37. begin
  38.   typ_hejbaci.init;
  39.   parametr := posun;
  40.   pomer    := pompomer;
  41.   rych     := perioda;
  42.  
  43.   barva    := pbarva;
  44.  
  45.   sirrych  := 0.021;
  46.  
  47.   aktivni  := 0;
  48.   zaplneno := 0;
  49.   barva    := pbarva;
  50.  
  51.   delka := _delka;
  52.   sirka := _sirka;
  53.  
  54.   getmem(body, ((sirka+1)*(delka+1)*sizeof(typbod)));
  55.   _get_mem_tvar((sirka+1)*(delka+1));
  56. end;
  57.  
  58. procedure tliss.zobraz;
  59. begin
  60. end;
  61.  
  62. procedure tliss.jedenkrok;
  63. var sqdy, dy, cykn, x, y, psin : real;
  64.     isir : integer;
  65.     z : typ_souradnic;
  66.  
  67. begin
  68.   aktivni := (aktivni+1) mod delka;
  69.  
  70. {      if zaplneno = delka then}
  71.         for isir := 0 to sirka-1 do
  72.           obrazovka.zhasni_bod_xy(body^[isir+aktivni*sirka].x, body^[isir+aktivni*sirka].y, dej_bod(isir+aktivni*sirka));
  73.  
  74.       cykn := - (sirka div 2) * sirrych;
  75.  
  76.       x := cos(parametr);
  77.       y := sin(pomer*parametr);
  78.  
  79.       psin := sin(parametr);
  80.  
  81.       if abs(psin) < 1e-8 then psin := 1e-8;
  82.  
  83.       dy := -pomer*cos(parametr*pomer)/psin;
  84.  
  85.       sqdy := 1/sqrt(dy*dy+1.0);
  86.  
  87.       z := trunc(sin(parametr)*100);
  88.       for isir := 0 to sirka-1 do
  89.         begin
  90.           body^[isir+aktivni*sirka].x := round( (x+cykn*dy*sqdy) *zoom);
  91.           body^[isir+aktivni*sirka].y := round( (y-cykn*sqdy)    *zoom);
  92.           set_bod(isir+aktivni*sirka, barva);
  93.           set_bod_z(isir+aktivni*sirka, z);
  94.           obrazovka.zobraz_bod_xy(body^[isir+aktivni*sirka].x, body^[isir+aktivni*sirka].y, dej_bod(isir+aktivni*sirka));
  95.           cykn := cykn + sirrych;
  96.         end;
  97.       if zaplneno < delka then inc(zaplneno);
  98.       inc(aktivni);
  99. {      inc(barva);}
  100.       parametr := parametr + rych;
  101. end;
  102.  
  103. var
  104.  grdriver       : integer;
  105.  grmode         : integer;
  106.  errcode        : integer;
  107.  i              : integer;
  108.  p1, p2         : typ_pismeno;
  109.  liss1, liss2, liss3, liss4, liss5 : tliss;
  110.  
  111. begin
  112.   assign(ven, 'con');
  113.   rewrite(ven);
  114.  
  115.  grdriver := detect;
  116.  grmode := 0;
  117.  initgraph(grdriver, grmode,' ');
  118.  errcode := graphresult;
  119.  if errcode = grok then
  120.    begin  { do graphics }
  121.  
  122.      settextstyle(0, horizdir, 4);
  123.      setcolor(magenta);
  124.      settextjustify(centertext, centertext);
  125.      outtextxy(100,120, '3d');
  126. {     setcolor(14);}
  127.  
  128.      obrazovka.zacni(80, 80, -58, 56, -56, 56);   { zjisteni parametru obrazu}
  129.  
  130.      p1.init;
  131.      p2.init;
  132.      p1.vytvor('3', 4, lightmagenta);
  133.      p2.vytvor('d', 4, lightmagenta);
  134.      p2.presun_rel(28, 20, 120);
  135.      p1.presun_rel(0, 20, 120);
  136.      p1.zobraz;
  137.      p2.zobraz;
  138.  
  139.      liss1.init(11,  700,   5.1, 0.007,  1.6, red);
  140.      liss2.init(5, 1000,  -15.6, 0.010, 1.28, green);
  141.      liss3.init(7,  900,  12.2, 0.008, 1.55, blue);
  142.      liss4.init(7,  500,  29.2, 0.011, 1, yellow);
  143.      liss5.init(7,  50,  19.2, 0.031, 1.7, white);
  144.  
  145.      repeat
  146.        liss1.jedenkrok;
  147.        liss2.jedenkrok;
  148.        liss3.jedenkrok;
  149.        liss4.jedenkrok;
  150.        liss5.jedenkrok;
  151. {       inc(i);
  152.        if (i mod 22) - 10 > 0
  153.          then p2.r
  154.          else p2.l;
  155.  }{       i := byte(readkey);
  156.        delay(10);
  157. }     until keypressed; {i = 27;}
  158.    end
  159.  else
  160.    writeln('graphics error:', grapherrormsg(errcode));
  161.  
  162. end.
  163.  
  164.  
  165.  
  166. {     for i := 1 to 1000 do
  167.        begin
  168.          liss1.jedenkrok;
  169.          liss2.jedenkrok;
  170.          liss3.jedenkrok;
  171.          liss4.jedenkrok;
  172.        end;
  173.      for i:=1 to 5 do begin
  174.        p2.r;
  175.        p2.r;
  176.        p2.r;
  177.        p2.r;
  178.        p2.r;
  179.        p2.l;
  180.        p2.l;
  181.        p2.l;
  182.        p2.l;
  183.        p2.l;
  184.      end;
  185. }
  186.