home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1998 July / pcx23_9807.iso / PC-XUSER / PC-XUSER.16 / DEMO / DNSS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1998-04-05  |  7.2 KB  |  352 lines
  1. Uses crt;
  2.  
  3. Type T3d=Record
  4.       x : longint;
  5.       y : longint;
  6.       z : longint;
  7.      end;
  8.  
  9.     T2d=Record
  10.       x : longint;
  11.       y : longint;
  12.      end;
  13.  
  14.     Tpoint = Record
  15.       map : T3d;
  16.       coords : T3d;
  17.       ScreenCoords : T2d;
  18.      end;
  19.  
  20. Const  sorok=5;
  21.        pointn=500;
  22.        M=400;
  23.        P=500;
  24.        CENTX=160;
  25.        CENTY=100;
  26.        szoveg : array[1..sorok] of string=
  27.        ('DEMO ROVAT',
  28.        'Hasonlít nem?',
  29.        'Nem olyan, mint az eredeti',
  30.        'De azért elmegy...',
  31.        'Blaa  Blaa   Blaaa');
  32.        ztab : array[1..8] of integer=(8,6,3,2,2,3,6,8);
  33.        mt : array[1..6,1..6] of byte=((0,0,4,4,0,0),
  34.                                       (0,4,4,4,4,0),
  35.                                       (4,4,4,4,4,4),
  36.                                       (4,4,4,4,4,4),
  37.                                       (0,4,4,4,4,0),
  38.                                       (0,0,4,4,0,0));
  39. Var charset: array[1..2048] of byte;
  40.     ScreenSeg: word;
  41.     sint,cost: array[0..511] of longint;
  42.     points: array[1..pointn] of Tpoint;
  43.     text  : array[1..1000] of Tpoint;
  44.     rotmatr : array[1..3,1..3] of longint;
  45.     tpoints,actsor : integer;
  46.     a,b,c,g,t,db,dc,da,veg : integer;
  47.  
  48. Procedure FillTables;
  49. var n : integer;
  50. begin
  51.  for n:=0 to 511 do
  52.  begin
  53.   sint[n]:=round(256*sin(n*2*pi/512));
  54.   cost[n]:=round(256*cos(n*2*pi/512));
  55.  end;
  56. end;
  57.  
  58. procedure fillpoints;
  59. var x,y,n : integer;
  60. begin
  61.  randomize;
  62.  points[1].map.x:=-160;points[2].map.x:=160;
  63.  points[1].map.z:=0;points[2].map.z:=0;
  64.  points[1].map.y:=40;points[2].map.y:=90;
  65.  for n:=3 to pointn do
  66.  begin
  67.   points[n].map.x:=longint(random(300))-150;
  68.   points[n].map.y:=longint(random(250))-125;
  69.   points[n].map.z:=longint(random(50));
  70.  end;
  71. end;
  72.  
  73.  
  74. Procedure GetCharSet(buffer : word); Assembler;
  75. asm
  76.  push ds
  77.  push es
  78.  push bp
  79.  
  80.  mov ax,1130h
  81.  mov bh,03h
  82.  int 10h
  83.  mov cx,2048
  84.  mov si,bp
  85.  pop bp
  86.  
  87.  push es
  88.  push ds
  89.  pop es
  90.  pop ds
  91.  mov di,buffer
  92.  rep movsb
  93.  
  94.  pop es
  95.  pop ds
  96. end;
  97.  
  98. procedure initscreen;
  99. var p: pointer;
  100. begin
  101.  getmem(p,65535);
  102.  ScreenSeg:=seg(p^);
  103.  asm
  104.   push es
  105.  
  106.   xor ax,ax
  107.   mov cx,32000
  108.   mov es,screenseg
  109.   mov di,0
  110.   rep stosw
  111.  
  112.   mov ax,13h
  113.   int 10h
  114.  
  115.   pop es
  116.  end;
  117. end;
  118.  
  119. procedure dopal(c,r,g,b:byte);assembler;
  120. asm
  121.    mov dx,3c8h
  122.    mov al,c
  123.    out dx,al
  124.    inc dx
  125.    mov al,r
  126.    out dx,al
  127.    mov al,g
  128.    out dx,al
  129.    mov al,b
  130.    out dx,al
  131. end;
  132.  
  133. procedure setpal;
  134. var n: integer;
  135. begin
  136.  for n:=0 to 255 do dopal(n,0,0,0);
  137.  dopal(1,16,16,16);
  138.  dopal(2,32,32,32);
  139.  dopal(3,48,48,48);
  140.  dopal(4,63,63,63);
  141. end;
  142.  
  143. procedure blur; assembler;
  144. asm
  145.  push ds
  146.  
  147.  mov ds, ScreenSeg
  148.  xor si,si
  149.  mov cx,64000
  150.  mov al,0
  151.  @cik:
  152.   cmp [si],al
  153.   jz @tov
  154.   mov ah,[si]
  155.   dec ah
  156.   mov [si],ah
  157.   @tov:
  158.   inc si
  159.  loop @cik
  160.  @ki:
  161.  
  162.  pop ds
  163. end;
  164.  
  165. procedure dump; assembler;
  166. asm
  167.  push ds
  168.  push es
  169.  
  170.  mov ds,ScreenSeg
  171.  mov ax,0a000h
  172.  mov es,ax
  173.  xor si,si
  174.  xor di,di
  175.  
  176.  mov cx,32000
  177.  rep movsw
  178.  
  179.  pop es
  180.  pop ds
  181. end;
  182.  
  183. function bitset(d : byte; b : byte) : boolean;
  184. begin
  185.  if (d and (1 shl b))<>0 then bitset:=true else bitset:=false;
  186. end;
  187.  
  188. procedure buildtext;
  189. var cnx,cny,actchar : integer;
  190.     chx,chy,tp   :integer;
  191. begin
  192.  cny:=4;
  193.  cnx:=-160;
  194.  tp:=1;
  195.  for actchar:=1 to length(szoveg[actsor]) do
  196.  begin
  197.   for chx:=1 to 8 do
  198.    for chy:=1 to 8 do
  199.    begin
  200.     if bitset(charset[8*word(szoveg[actsor][actchar])+chy],chx) then
  201.     begin
  202.      text[tp].map.x:=(actchar*8-chx)*5-cnx;
  203.      text[tp].map.y:=(chy-1)*5-cny;
  204.      text[tp].map.z:=ztab[chx];
  205.      tp:=tp+1;
  206.     end;
  207.    end;
  208.  end;
  209.  tpoints:=tp-1;
  210. end;
  211.  
  212. procedure pp(x : word; y : word; c : byte); assembler;
  213. asm
  214.  push es
  215.  
  216.  cmp x,319
  217.  ja @ki
  218.  cmp y,200
  219.  ja @ki
  220.  
  221.  mov ax,320
  222.  mul y
  223.  add ax,x
  224.  mov di,ax
  225.  mov es,screenseg
  226.  mov al,4
  227.  cmp es:[di],al
  228.  jnl @ki
  229.  mov al,c
  230.  mov es:[di],al
  231.  
  232.  @ki:
  233.  pop es
  234. end;
  235.  
  236. procedure mugli(x: integer; y: integer);
  237. var n,m: integer;
  238. begin
  239.  for n:=1 to 6 do
  240.   for m:=1 to 6 do
  241.    pp(x-3+n,y-3+m,mt[n,m]);
  242. end;
  243.  
  244. procedure shifttext;
  245. var n: integer;
  246. begin
  247.  veg:=1;
  248.  for n:=1 to tpoints do
  249.  begin
  250.   dec(text[n].map.x);
  251.   if text[n].map.x>-160 then veg:=0;
  252.  end;
  253. end;
  254.  
  255. procedure puttext;
  256. var n: integer;
  257. begin
  258.  for n:=1 to tpoints do
  259.  begin
  260.    if (text[n].map.x>=points[1].map.x) and (text[n].map.x<=points[2].map.x) then
  261.      mugli(text[n].screencoords.x,text[n].screencoords.y);
  262.  end;
  263. end;
  264.  
  265. procedure putpoints;
  266. var n : integer;
  267. begin
  268.  for n:=1 to 100 do pp(points[n].screencoords.x,points[n].screencoords.y,4);
  269. end;
  270.  
  271. procedure comp(a,b,c : integer);
  272. var n,i : integer;
  273. begin
  274.  rotmatr[1,1]:=(cost[a]*cost[c]-((sint[a]*sint[b]) div 256)*sint[c]) div 256;
  275.  rotmatr[1,2]:=(-cost[c]*sint[a]-((sint[b]*cost[a]) div 256)*sint[c]) div 256;
  276.  rotmatr[1,3]:=(sint[c]*cost[b]) div 256;
  277.  rotmatr[2,1]:=(sint[a]*cost[b]) div 256;
  278.  rotmatr[2,2]:=(cost[b]*cost[a]) div 256;
  279.  rotmatr[2,3]:=sint[b];
  280.  rotmatr[3,1]:=(sint[c]*cost[a]+((cost[c]*sint[b]) div 256)*sint[a]) div 256;
  281.  rotmatr[3,2]:=(((cost[c]*sint[b]) div 256)*cost[a]-sint[c]*sint[a]) div 256;
  282.  rotmatr[3,3]:=-(cost[b]*cost[c]) div 256;
  283.  
  284.  for i:=1 to tpoints do
  285.  begin
  286.   text[i].coords.x:=(text[i].map.x*rotmatr[1,1]+text[i].map.y*rotmatr[1,2]-text[i].map.z*rotmatr[1,3]) div 256;
  287.   text[i].coords.y:=(text[i].map.x*rotmatr[2,1]+text[i].map.y*rotmatr[2,2]-text[i].map.z*rotmatr[2,3]) div 256;
  288.   text[i].coords.z:=(text[i].map.x*rotmatr[3,1]+text[i].map.y*rotmatr[3,2]-text[i].map.z*rotmatr[3,3]) div 256;
  289.  end;
  290.  
  291.  for n:=1 to tpoints do
  292.  begin
  293.   if text[n].coords.z+p>0 then text[n].screencoords.x:=round((M*text[n].coords.x)/(text[n].coords.z+P))+CENTX
  294.    else text[n].screencoords.x:=-10;
  295.   if text[n].coords.z+P>0
  296.   then text[n].screencoords.y:=round(M*(text[n].coords.y)/(text[n].coords.z+P))+CENTY
  297.   +(sint[((text[n].screencoords.x shl 3)+40*t) and 511] div 64) else text[n].screencoords.x:=-10;
  298.  end;
  299.  
  300.  for i:=1 to pointn do
  301.  begin
  302.   points[i].coords.x:=((points[i].map.x)*rotmatr[1,1]+points[i].map.y*rotmatr[1,2]-points[i].map.z*rotmatr[1,3]) div 256;
  303.   points[i].coords.y:=((points[i].map.x)*rotmatr[2,1]+points[i].map.y*rotmatr[2,2]-points[i].map.z*rotmatr[2,3]) div 256;
  304.   points[i].coords.z:=((points[i].map.x)*rotmatr[3,1]+points[i].map.y*rotmatr[3,2]-points[i].map.z*rotmatr[3,3]) div 256;
  305.  end;
  306.  
  307.  for n:=1 to pointn do
  308.  begin
  309.   if points[n].coords.z+p>0 then points[n].screencoords.x:=round((M*points[n].coords.x)/(points[n].coords.z+P))+CENTX
  310.    else points[n].screencoords.x:=-10;
  311.   if points[n].coords.z+P>0
  312.   then points[n].screencoords.y:=round(M*(points[n].coords.y)/(points[n].coords.z+P))+CENTY else points[n].screencoords.x:=-10;
  313.  end;
  314. end;
  315.  
  316. Begin
  317.  FillTables;
  318.  Fillpoints;
  319.  GetCharSet(word(@CharSet));
  320.  db:=4;dc:=3;da:=1;
  321.  initscreen;
  322.  SetPal;
  323.  actsor:=1;
  324.  buildtext;
  325.  veg:=0;
  326.  repeat
  327.   blur;
  328.   comp(a and 511,b and 511,c and 511);
  329.   shifttext;
  330.   puttext;
  331.   putpoints;
  332.   dump;
  333.   if (a>111) or (a<-111) then da:=-da;
  334.   if (b>111) or (b<-111) then db:=-db;
  335.   if (c>111) or (c<-111) then dc:=-dc;
  336.   a:=a+da;
  337.   c:=c+dc;
  338.   b:=b+db;
  339.   t:=t+1;
  340.   if veg=1 then
  341.   begin
  342.    if actsor<sorok then inc(actsor) else actsor:=1;
  343.    buildtext;
  344.   end;
  345.   delay(100);
  346.  until keypressed;
  347.  
  348.  asm
  349.   mov ax,3
  350.   int 10h
  351.  end;
  352. End.