home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / demosrce / texture / texture.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-11  |  26.0 KB  |  1,309 lines
  1. {///////////////////////////////////////////////////////////////////////////}
  2. { Ca y est...  je  me suis  décidé  à  mettre  le  source de TEXTURE dans le
  3.   domaine public!  A mon point  de vue,  c'est  un  petit  programme   assez
  4.   important,  et  c'est a priori c'est susceptible d'intéresser quelques uns
  5.   d'entre vous.  Il reprend certaines parties de la démo de mon  CV (SBAL01)
  6.   du SBAL_Kit (chez DP Tool). Je sais... il y'a 50% de BASM, mais il faut ce
  7.   qu'il faut pour être rapide! Voilà!, sachez donc tirer profit  de ce petit
  8.   cadeau  et évitez  de faire  partie  du club  très  large  des  LAMERS  en
  9.   "pompant"  bêtement le code...
  10.  
  11.   Pour  de  plus  amples  informations,  d'éventuelles suggestions,  ou tout
  12.   simplement pour le fun, vous pouvez m'écrire à l'adresse suivante:
  13.  
  14.                                Patrick Ruelle
  15.                          43, av. de Grande Bretagne
  16.                                 98000 Monaco
  17.                             Principauté de Monaco
  18.  
  19.   Evidemment  je n'ai pas pris  la décision  de diffuser  ce source  dans le
  20.   but de demander de l'argent,  mais il va de soit que toutes sortes de dons
  21.   sont acceptés (carte  postale,  matos,  argent, spécialités locales, docs,
  22.   etc...).  N'oubliez pas non plus que cette diffusion ne m'enlève nullement
  23.   mes  droits d'auteur  de cette mmm... de démo;  ce petit package peut être
  24.   diffusé librement à condition de rester sous sa forme initiale:
  25.  
  26.  TEXTURE .EXE  11/08/94  12928 L'exécutable de la démo
  27.  TEXTURE .PAS  11/08/94  26596 Le source de la démo
  28.  TEXTURE .RAW  10/08/94  64768 L'image brute (pal+bitmap)
  29.                         ------
  30.                TOTAL    104292
  31.  
  32.   La version  actuelle  est remaniée exprès pour la diffusion de ce package,
  33.   mais en fait ce programme date de début 1994...
  34.  
  35.                                           Patrick Ruelle (Monac) / GRYPHAEA }
  36. {///////////////////////////////////////////////////////////////////////////}
  37. {-------------------------------------------------------}
  38. { Le code 80386 concernant les affichages  ultra-rapides}
  39. { est disponible auprès de l'auteur moyennant 50FF...   }
  40. {-------------------------------------------------------}
  41. PROGRAM TEXTURE;
  42.  
  43.  
  44. USES Crt,DOS;
  45.  
  46.  
  47. CONST centerx    =0;
  48.       centery    =0;
  49.       centerz    =-160;
  50.  
  51.  
  52. VAR   F                      :FILE;
  53.       minbuf,maxbuf          :WORD;
  54.       a1,a2,a3               :Integer;
  55.       back                   :Pointer;
  56.       anzi,zoom              :Integer;
  57.       times,picture_ofs,segp,
  58.       picture2_ofs,segp2     :WORD;
  59.       loader,loader2,buffer  :Pointer;
  60.       way,mx,my,angle,di,i   :Integer;
  61.       maxx,lminy,lmaxy       :WORD;
  62.       tcos,tsin              :ARRAY[0..500] OF Integer;
  63.       buffer2,paltmp         :Pointer;
  64.       gy,dist,zl1            :Integer;
  65.       l1,l2                  :ARRAY[0..500] OF Integer;
  66.       regs                   :Registers;
  67.       int_truc,old_int_truc  :Pointer;
  68.  
  69.  
  70. PROCEDURE Buf2Scrn;ASSEMBLER;{pour 286; le code pour 386 est disponible}
  71. ASM                          {sur  demande  auprès de  l'auteur  contre}
  72.   push  ds                   {l'envoi de 50FF (code 2 x plus rapide!!!)}
  73.   lds   si,buffer
  74.   mov   ax,0A000h
  75.   mov   es,ax
  76.   mov   di,minbuf
  77.   add   si,minbuf
  78.   mov   cx,32000
  79.   shr   minbuf,2
  80.   sub   cx,minbuf
  81.   shr   maxbuf,2
  82.   sub   cx,maxbuf
  83.   cld
  84.   rep   movsw
  85.   pop   ds
  86. END;
  87.  
  88.  
  89. PROCEDURE ClrBuf;ASSEMBLER;{pour 286; idem ici plus haut}
  90. ASM
  91.   push  ds
  92.   les   di,buffer
  93.   add   di,minbuf
  94.   mov   cx,32000
  95.   shr   minbuf,2
  96.   sub   cx,minbuf
  97.   shr   maxbuf,2
  98.   sub   cx,maxbuf
  99.   cld
  100.   xor   ax,ax
  101.   rep   stosw
  102.   pop   ds
  103. END;
  104.  
  105.  
  106. PROCEDURE Nothing;Interrupt;
  107. BEGIN
  108. END;
  109.  
  110.  
  111. PROCEDURE LineAsm(decal:WORD;x1,y1,x2,y2:Integer;buffer,back:Pointer);
  112. VAR zl,zi   :WORD;
  113.     co      :BYTE;
  114.     S1,S2,S4:WORD;
  115.     pixel  :WORD;
  116. BEGIN
  117.   IF (x1>319) OR (x2>319) OR (y1>199) OR (y2>199) OR
  118.      (x1<0) OR (x2<0) OR (y1<0) OR (y2<0) THEN Exit;
  119.   IF Abs(y2-y1)>Abs(x2-x1) THEN
  120.     pixel:=abs(y2-y1)
  121.   ELSE
  122.     pixel:=Abs(x2-x1);
  123.   IF pixel=0 THEN
  124.     zi:=0
  125.   ELSE
  126.     zi:=(maxx*64) DIV pixel;
  127.   zl:=0;
  128.   back:=Ptr(Seg(back^),Ofs(back^)+decal);
  129.   ASM
  130.     push  ds
  131.     MOV   AX,X2
  132.     SUB   AX,X1
  133.     JNS   @@LAB1
  134.     NEG   AX
  135.    @@LAB1:
  136.     MOV   BX,Y2
  137.     SUB   BX,Y1
  138.     JNS   @@LAB2
  139.     NEG   BX
  140.    @@LAB2:
  141.     CMP   AX,BX
  142.     JGE   @@LAB3A
  143.     JMP   @@LAB20
  144.    @@LAB3A:
  145.     MOV   CX,X1
  146.     CMP   CX,X2
  147.     JG    @@LAB4
  148.     MOV   CX,1
  149.     JMP   @@LAB5
  150.    @@LAB4:
  151.     MOV   CX,-1
  152.    @@LAB5:
  153.     MOV   DX,Y1
  154.     CMP   DX,Y2
  155.     JG    @@LAB6
  156.     MOV   DX,320
  157.     JMP   @@LAB7
  158.    @@LAB6:
  159.     MOV   DX,-320
  160.    @@LAB7:
  161.     MOV   ds,CX
  162.     MOV   S2,DX
  163.     ADD   BX,BX
  164.     MOV   si,BX
  165.     SUB   BX,AX
  166.     MOV   CX,BX
  167.     SUB   CX,AX
  168.     MOV   S4,CX
  169.     {affiche pixel!!!}
  170.     MOV   CX,X1
  171.     MOV   DX,Y1
  172.     mov   ax,dx
  173.     xor   dx,dx
  174.     shl   ax,6
  175.     add   dx,ax
  176.     shl   ax,2
  177.     add   dx,ax
  178.     les   di,back
  179.     mov   ax,zl
  180.     shr   ax,5
  181.     add   di,ax
  182.     mov   ax,es:[di]
  183.     les   di,buffer
  184.     add   di,cx
  185.     add   di,dx
  186.     mov   es:[di],ax       {2 pixels d'un coup!}
  187.     mov   ax,zi
  188.     add   zl,ax
  189.    @@LAB8:
  190.     CMP   CX,X2
  191.     JZ    @@LAB3
  192.     mov   ax,ds
  193.     ADD   CX,ax
  194.     OR    BX,BX
  195.     JNS   @@LAB10
  196.     ADD   BX,si
  197.     JMP   @@LAB11
  198.    @@LAB10:
  199.     ADD   BX,S4
  200.     ADD   DX,S2
  201.    @@LAB11:
  202.    {Traitement couleur}
  203.     les   di,back
  204.     mov   ax,zl
  205.     shr   ax,5
  206.     add   di,ax
  207.     mov   ax,es:[di]
  208.     les   di,buffer
  209.     add   di,cx
  210.     add   di,dx
  211.     mov   es:[di],ax       {2 pixels d'un coup!}
  212.    @@wei1:
  213.     mov   ax,zi
  214.     add   zl,ax
  215.     JMP   @@LAB8
  216.    @@LAB20:
  217.     MOV   CX,Y1
  218.     CMP   CX,Y2
  219.     JG    @@LAB12
  220.     MOV   CX,1
  221.     JMP   @@LAB13
  222.    @@LAB12:
  223.     MOV   CX,-1
  224.    @@LAB13:
  225.     MOV   DX,X1
  226.     CMP   DX,X2
  227.     JG    @@LAB14
  228.     MOV   DX,1
  229.     JMP   @@LAB15
  230.    @@LAB14:
  231.     MOV   DX,-1
  232.    @@LAB15:
  233.     MOV   S1,CX
  234.     MOV   S2,DX
  235.     ADD   AX,AX
  236.     MOV   si,AX
  237.     SUB   AX,BX
  238.     MOV   CX,AX
  239.     SUB   CX,BX
  240.     MOV   S4,CX
  241.     MOV   BX,AX
  242.     mov   ax,y1
  243.     mov   y1,0
  244.     shl   ax,6
  245.     add   y1,ax
  246.     shl   ax,2
  247.     add   y1,ax
  248.     mov   ax,y2
  249.     mov   y2,0
  250.     shl   ax,6
  251.     add   y2,ax
  252.     shl   ax,2
  253.     add   y2,ax
  254.     mov   ax,s1
  255.     mov   s1,0
  256.     shl   ax,6
  257.     add   s1,ax
  258.     shl   ax,2
  259.     add   s1,ax
  260.     {Affiche pixel!!!}
  261.     MOV   CX,X1
  262.     MOV   DX,Y1
  263.     les   di,back
  264.     mov   ax,zl
  265.     shr   ax,5
  266.     add   di,ax
  267.     mov   ax,es:[di]
  268.     les   di,buffer
  269.     add   di,cx
  270.     add   di,dx
  271.     mov   es:[di],ax
  272.     mov   ax,zi
  273.     add   zl,ax
  274.    @@LAB16:
  275.     CMP   DX,Y2
  276.     JZ    @@LAB3
  277.     ADD   DX,s1
  278.     OR    BX,BX
  279.     JNS   @@LAB18
  280.     ADD   BX,si
  281.     JMP   @@LAB19
  282.    @@LAB18:
  283.     ADD   BX,S4
  284.     ADD   CX,S2
  285.    @@LAB19:
  286.     {Affiche pixel!!!}
  287.     les   di,back
  288.     mov   ax,zl
  289.     shr   ax,5
  290.     add   di,ax
  291.     mov   ax,es:[di]
  292.     les   di,buffer
  293.     add   di,cx
  294.     add   di,dx
  295.     mov   es:[di],ax
  296.     mov   ax,zi
  297.     add   zl,ax
  298.     JMP   @@LAB16
  299.    @@LAB3:
  300.     Pop   ds
  301.   END;
  302. END;
  303.  
  304.  
  305. PROCEDURE LineAsmQuadro(decal:WORD;x1,y1,x2,y2:Integer;buffer,back:Pointer;maxx:WORD);
  306. VAR zl,zi   :WORD;
  307.     co      :BYTE;
  308.     S1,S2,S4:WORD;
  309.     pixel  :WORD;
  310. BEGIN
  311.   IF (x1>319) OR (x2>319) OR (y1>199) OR (y2>199) OR
  312.      (x1<0) OR (x2<0) OR (y1<0) OR (y2<0) THEN Exit;
  313.   IF Abs(y2-y1)>Abs(x2-x1) THEN
  314.     pixel:=Abs(y2-y1)
  315.   ELSE
  316.     pixel:=Abs(x2-x1);
  317.   IF pixel=0 THEN
  318.     zi:=0
  319.   ELSE
  320.     zi:=(maxx*64) DIV pixel;
  321.   zl:=0;
  322.   back:=Ptr(Seg(back^),Ofs(back^)+decal);
  323.   ASM
  324.     push  ds;
  325.     MOV   AX,X2
  326.     SUB   AX,X1
  327.     JNS   @@LAB1
  328.     NEG   AX
  329.    @@LAB1:
  330.     MOV   BX,Y2
  331.     SUB   BX,Y1
  332.     JNS   @@LAB2
  333.     NEG   BX
  334.    @@LAB2:
  335.     CMP   AX,BX
  336.     JGE   @@LAB3A
  337.     JMP   @@LAB20
  338.    @@LAB3A:
  339.     MOV   CX,X1
  340.     CMP   CX,X2
  341.     JG    @@LAB4
  342.     MOV   CX,1
  343.     JMP   @@LAB5
  344.    @@LAB4:
  345.     MOV   CX,-1
  346.    @@LAB5:
  347.     MOV   DX,Y1
  348.     CMP   DX,Y2
  349.     JG    @@LAB6
  350.     MOV   DX,320
  351.     JMP   @@LAB7
  352.    @@LAB6:
  353.     MOV   DX,-320
  354.    @@LAB7:
  355.     MOV   ds,CX
  356.     MOV   S2,DX
  357.     ADD   BX,BX
  358.     MOV   si,BX
  359.     SUB   BX,AX
  360.     MOV   CX,BX
  361.     SUB   CX,AX
  362.     MOV   S4,CX
  363.     MOV   CX,X1
  364.     MOV   DX,Y1
  365.     mov   ax,dx
  366.     xor   dx,dx
  367.     shl   ax,6
  368.     add   dx,ax
  369.     shl   ax,2
  370.     add   dx,ax
  371.     mov   ax,zi
  372.     add   zl,ax
  373.    @@LAB8:
  374.     CMP   CX,X2
  375.     JZ    @@LAB3
  376.     mov   ax,ds
  377.     ADD   CX,ax
  378.     OR    BX,BX
  379.     JNS   @@LAB10
  380.     ADD   BX,si
  381.     JMP   @@LAB11
  382.    @@LAB10:
  383.     ADD   BX,S4
  384.     ADD   DX,S2
  385.    @@LAB11:
  386.     les   di,back
  387.     mov   ax,zl
  388.     shr   ax,5
  389.     add   di,ax
  390.     mov   ax,es:[di]
  391.     les   di,buffer
  392.     add   di,cx
  393.     add   di,dx
  394.     mov   es:[di],ax       {2+2+2 pixels d'un coup!}
  395.     add   di,320
  396.     mov   es:[di],ax
  397.     add   di,320
  398.     mov   es:[di],ax
  399.    @@wei1:
  400.     mov   ax,zi
  401.     add   zl,ax
  402.     JMP   @@LAB8
  403.    @@LAB20:
  404.     MOV   CX,Y1
  405.     CMP   CX,Y2
  406.     JG    @@LAB12
  407.     MOV   CX,1
  408.     JMP   @@LAB13
  409.    @@LAB12:
  410.     MOV   CX,-1
  411.    @@LAB13:
  412.     MOV   DX,X1
  413.     CMP   DX,X2
  414.     JG    @@LAB14
  415.     MOV   DX,1
  416.     JMP   @@LAB15
  417.    @@LAB14:
  418.     MOV   DX,-1
  419.    @@LAB15:
  420.     MOV   S1,CX
  421.     MOV   S2,DX
  422.     ADD   AX,AX
  423.     MOV   si,AX
  424.     SUB   AX,BX
  425.     MOV   CX,AX
  426.     SUB   CX,BX
  427.     MOV   S4,CX
  428.     MOV   BX,AX
  429.     mov   ax,y1
  430.     mov   y1,0
  431.     shl   ax,6
  432.     add   y1,ax
  433.     shl   ax,2
  434.     add   y1,ax
  435.     mov   ax,y2
  436.     mov   y2,0
  437.     shl   ax,6
  438.     add   y2,ax
  439.     shl   ax,2
  440.     add   y2,ax
  441.     mov   ax,s1
  442.     mov   s1,0
  443.     shl   ax,6
  444.     add   s1,ax
  445.     shl   ax,2
  446.     add   s1,ax
  447.     MOV   CX,X1
  448.     MOV   DX,Y1
  449.     mov   ax,zi
  450.     add   zl,ax
  451.    @@LAB16:
  452.     CMP   DX,Y2
  453.     JZ    @@LAB3
  454.     ADD   DX,s1
  455.     OR    BX,BX
  456.     JNS   @@LAB18
  457.     ADD   BX,si
  458.     JMP   @@LAB19
  459.    @@LAB18:
  460.     ADD   BX,S4
  461.     ADD   CX,S2
  462.    @@LAB19:
  463.     les   di,back
  464.     mov   ax,zl
  465.     shr   ax,5
  466.     add   di,ax
  467.     mov   ax,es:[di]
  468.     les   di,buffer
  469.     add   di,cx
  470.     add   di,dx
  471.     mov   es:[di],ax
  472.     add   di,320
  473.     mov   es:[di],ax       {2 pixels d'un coup!}
  474.     add   di,320
  475.     mov   es:[di],ax       {et 2 autres la ligne en dessous!}
  476.     mov   ax,zi
  477.     add   zl,ax
  478.     JMP   @@LAB16
  479.    @@LAB3:
  480.     Pop   ds
  481.   END;
  482. END;
  483.  
  484.  
  485. PROCEDURE LineAsmHoz(decal:WORD;x1,x2,y1:Integer;buffer,back:Pointer);
  486. VAR zl,zi   :WORD;
  487.     co      :BYTE;
  488.     S1,S2,S4:WORD;
  489.     pixel  :WORD;
  490. BEGIN
  491.   IF (x1>319) OR (x2>319) OR (y1>199) OR
  492.      (x1<0) OR (x2<0) OR (y1<0) THEN Exit;
  493.   pixel:=Abs(x2-x1);
  494.   IF pixel=0 THEN
  495.     zi:=0
  496.   ELSE
  497.     zi:=(maxx*256) DIV pixel;
  498.   zl:=0;
  499.   back:=Ptr(Seg(back^),Ofs(back^)+decal);
  500.   ASM
  501.     push  ds
  502.     {Affiche pixel!!!}
  503.     MOV   CX,X1
  504.     MOV   DX,Y1
  505.     mov   ax,dx
  506.     xor   dx,dx
  507.     shl   ax,6
  508.     add   dx,ax
  509.     shl   ax,2
  510.     add   dx,ax
  511.     les   di,back
  512.     mov   ax,zl
  513.     shr   ax,5
  514.     add   di,ax
  515.     mov   ax,es:[di]
  516.     les   di,buffer
  517.     add   di,cx
  518.     add   di,dx
  519.     mov   es:[di],ax       {2 pixels d'un coup!}
  520.     mov   ax,zi
  521.     add   zl,ax
  522.     lds   si,buffer
  523.     add   si,cx
  524.     add   si,dx
  525.     mov   bx,zl
  526.    @@LAB8:
  527.     CMP   CX,X2
  528.     JZ    @@LAB3
  529.     inc   cx
  530.     inc   si
  531.     les   di,back
  532.     mov   ax,bx
  533.     shr   ax,7
  534.     add   di,ax
  535.     mov   ax,es:[di]
  536.     mov   ds:[si],ax       {2 pixels d'un coup!}
  537.     add   bx,zi
  538.     JMP   @@LAB8
  539.    @@LAB3:
  540.     Pop   ds
  541.   END;
  542. END;
  543.  
  544.  
  545. PROCEDURE Line2(x1,y1,x2,y2:WORD;feld:Pointer;VAR m:WORD);
  546. VAR S2,S4,zi:WORD;
  547. BEGIN
  548.   zi:=0;
  549.   ASM
  550.     push  ds;
  551.     MOV   AX,X2
  552.     SUB   AX,X1
  553.     JNS   @@LAB1
  554.     NEG   AX
  555.    @@LAB1:
  556.     MOV   BX,Y2
  557.     SUB   BX,Y1
  558.     JNS   @@LAB2
  559.     NEG   BX
  560.    @@LAB2:
  561.     CMP   AX,BX
  562.     JGE   @@LAB3A
  563.     JMP   @@LAB20
  564.    @@LAB3A:
  565.     MOV   CX,X1
  566.     CMP   CX,X2
  567.     JG    @@LAB4
  568.     MOV   CX,1
  569.     JMP   @@LAB5
  570.    @@LAB4:
  571.     MOV   CX,-1
  572.    @@LAB5:
  573.     MOV   DX,Y1
  574.     CMP   DX,Y2
  575.     JG    @@LAB6
  576.     MOV   DX,1
  577.     JMP   @@LAB7
  578.    @@LAB6:
  579.     MOV   DX,-1
  580.    @@LAB7:
  581.     MOV   ds,CX
  582.     MOV   S2,DX
  583.     ADD   BX,BX
  584.     MOV   si,BX
  585.     SUB   BX,AX
  586.     MOV   CX,BX
  587.     SUB   CX,AX
  588.     MOV   S4,CX
  589.     MOV   CX,X1
  590.     MOV   DX,Y1
  591.     les   di,feld
  592.     mov   ax,zi
  593.     add   di,ax
  594.     add   di,ax
  595.     add   di,ax
  596.     add   di,ax
  597.     mov   es:[di],cx
  598.     add   di,2
  599.     mov   es:[di],dx
  600.     add   ax,1
  601.     mov   zi,ax
  602.    @@LAB8:
  603.     CMP   CX,X2
  604.     JZ    @@LAB3
  605.     mov   ax,ds
  606.     ADD   CX,ax
  607.     OR    BX,BX
  608.     JNS   @@LAB10
  609.     ADD   BX,si
  610.     JMP   @@LAB11
  611.    @@LAB10:
  612.     ADD   BX,S4
  613.     ADD   DX,S2
  614.    @@LAB11:
  615.     les   di,feld
  616.     mov   ax,zi
  617.     add   di,ax
  618.     add   di,ax
  619.     add   di,ax
  620.     add   di,ax
  621.     mov   es:[di],cx
  622.     add   di,2
  623.     mov   es:[di],dx
  624.     add   ax,1
  625.     mov   zi,ax
  626.     JMP   @@LAB8
  627.    @@LAB20:
  628.     MOV   CX,Y1
  629.     CMP   CX,Y2
  630.     JG    @@LAB12
  631.     MOV   CX,1
  632.     JMP   @@LAB13
  633.    @@LAB12:
  634.     MOV   CX,-1
  635.    @@LAB13:
  636.     MOV   DX,X1
  637.     CMP   DX,X2
  638.     JG    @@LAB14
  639.     MOV   DX,1
  640.     JMP   @@LAB15
  641.    @@LAB14:
  642.     MOV   DX,-1
  643.    @@LAB15:
  644.     MOV   ds,CX
  645.     MOV   S2,DX
  646.     ADD   AX,AX
  647.     MOV   si,AX
  648.     SUB   AX,BX
  649.     MOV   CX,AX
  650.     SUB   CX,BX
  651.     MOV   S4,CX
  652.     MOV   BX,AX
  653.     MOV   CX,X1
  654.     MOV   DX,Y1
  655.     les   di,feld
  656.     mov   ax,zi
  657.     add   di,ax
  658.     add   di,ax
  659.     add   di,ax
  660.     add   di,ax
  661.     mov   es:[di],cx
  662.     add   di,2
  663.     mov   es:[di],dx
  664.     add   ax,1
  665.     mov   zi,ax
  666.    @@LAB16:
  667.     CMP   DX,Y2
  668.     JZ    @@LAB3
  669.     mov   ax,ds
  670.     ADD   DX,ax
  671.     OR    BX,BX
  672.     JNS   @@LAB18
  673.     ADD   BX,si
  674.     JMP   @@LAB19
  675.    @@LAB18:
  676.     ADD   BX,S4
  677.     ADD   CX,S2
  678.    @@LAB19:
  679.     les   di,feld
  680.     mov   ax,zi
  681.     add   di,ax
  682.     add   di,ax
  683.     add   di,ax
  684.     add   di,ax
  685.     mov   es:[di],cx
  686.     add   di,2
  687.     mov   es:[di],dx
  688.     add   ax,1
  689.     mov   zi,ax
  690.     JMP   @@LAB16
  691.    @@LAB3:
  692.     Pop ds
  693.   END;
  694.   m:=zi;
  695. END;
  696.  
  697.  
  698. PROCEDURE coordconv(VAR x1,y1:Integer);
  699. VAR w,xx1,yy1,xs,ys:Integer;
  700.     sinu,cosi      :Integer;
  701. BEGIN
  702.   w:=angle MOD 360;
  703.   sinu:=tsin[w];
  704.   cosi:=tcos[w];
  705.   xs:=x1;
  706.   ys:=y1;
  707.   ASM
  708.     mov   ax,cosi
  709.     mov   bx,xs
  710.     sub   dx,dx
  711.     imul  bx
  712.     mov   cl,ah
  713.     mov   ch,dl
  714.     mov   ax,sinu
  715.     mov   bx,ys
  716.     sub   dx,dx
  717.     imul  bx
  718.     mov   al,ah
  719.     mov   ah,dl
  720.     sub   cx,ax
  721.     mov   xx1,cx
  722.   END;
  723.   x1:=xx1;
  724.   ASM
  725.     mov   ax,cosi
  726.     mov   bx,ys
  727.     sub   dx,dx
  728.     imul  bx
  729.     mov   cl,ah
  730.     mov   ch,dl
  731.     mov   ax,sinu
  732.     mov   bx,xs
  733.     sub   dx,dx
  734.     imul  bx
  735.     mov   al,ah
  736.     mov   ah,dl
  737.     add   cx,ax
  738.     mov   yy1,cx
  739.   END;
  740.   y1:=yy1;
  741. END;
  742.  
  743.  
  744. PROCEDURE Init(segp,picture_ofs:WORD);
  745. BEGIN
  746.   ASM
  747.     push  ds
  748.     mov   ax,$13
  749.     int   $10
  750.     mov   ax,segp
  751.     mov   es,ax
  752.     mov      ds,ax
  753.     mov   dx,picture_ofs
  754.     mov   ax,$1012
  755.     xor      bx,bx
  756.     mov   cx,256
  757.     int   $10
  758.     pop   ds
  759.   END;
  760. END;
  761.  
  762.  
  763. PROCEDURE CopperA(buffer:Pointer;miny,maxy:WORD);
  764. {Copie du tampon vers l'écran sans VBL!}
  765. BEGIN
  766.   minbuf:=miny;
  767.   maxbuf:=maxy;
  768.   Buf2Scrn;
  769. END;
  770.  
  771.  
  772. PROCEDURE ClearBuffer(buffer:Pointer;miny,maxy:WORD);
  773. {Efface le tampon!}
  774. BEGIN
  775.   minbuf:=miny;
  776.   maxbuf:=maxy;
  777.   ClrBuf;
  778. END;
  779.  
  780.  
  781. PROCEDURE Cube(x1,y1,x2,y2,x3,y3,x4,y4,myy,mxx:Integer);
  782. {carré!}
  783. VAR decal,inc1,z,pixel1,pixel2,maxy,inc2:WORD;
  784. BEGIN
  785.   maxx:=mxx;
  786.   maxy:=myy;
  787.   FOR i:=0 TO 200 DO
  788.     l1[i]:=-2;
  789.   FOR i:=0 to 200 DO
  790.     l2[i]:=-2;
  791.   Line2(x1,y1,x4,y4,Ptr(Seg(l1),Ofs(l1)),pixel1);
  792.   Line2(x2,y2,x3,y3,Ptr(Seg(l2),Ofs(l2)),pixel2);
  793.   IF pixel1>pixel2 THEN
  794.   BEGIN
  795.     IF pixel1>0 THEN
  796.     BEGIN
  797.       inc1:=(maxy*200) DIV pixel1;
  798.       inc2:=(pixel2*100) DIV pixel1;
  799.     END
  800.     ELSE
  801.     BEGIN
  802.       inc1:=0;
  803.       inc2:=0;
  804.     END;
  805.     z    :=0;
  806.     decal:=0;
  807.     FOR i:=0 TO pixel1 DO
  808.     BEGIN
  809.       LineAsm((decal DIV 200)*320,l1[i*2],l1[i*2+1]
  810.               ,l2[(z DIV 100)*2],l2[(z DIV 100)*2+1],buffer,back);
  811.       z:=z+inc2;
  812.       IF z DIV 100>pixel2-1 THEN
  813.         z:=(pixel2-1)*100;
  814.       decal:=decal+inc1;
  815.     END;
  816.   END
  817.   ELSE
  818.   BEGIN
  819.     IF pixel2>0 THEN
  820.     BEGIN
  821.       inc1:=(maxy*200) DIV pixel2;
  822.       inc2:=(pixel1*100) DIV pixel2;
  823.     END
  824.     ELSE
  825.     BEGIN
  826.       inc1:=0;
  827.       inc2:=0;
  828.     END;
  829.     z    :=0;
  830.     decal:=0;
  831.     FOR i:=0 TO pixel2 DO
  832.     BEGIN
  833.       LineAsm((decal DIV 200)*320,l1[(z DIV 100)*2],l1[(z DIV 100)*2+1]
  834.               ,l2[i*2],l2[i*2+1],buffer,back);
  835.       z:=z+inc2;
  836.       IF z DIV 100>pixel1-1 THEN
  837.         z:=(pixel1-1)*100;
  838.       decal:=decal+inc1;
  839.     END;
  840.   END;
  841.   maxx:=158;
  842. END;
  843.  
  844.  
  845. PROCEDURE Cube3(x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,nx,ny,nz:Integer;VAR done:Integer);
  846. {cube!}
  847. BEGIN
  848.   angle:=a1;
  849.   coordconv(x1,y1);
  850.   coordconv(nx,ny);
  851.   angle:=a2;
  852.   coordconv(y1,z1);
  853.   coordconv(ny,nz);
  854.   angle:=a3;
  855.   coordconv(x1,z1);
  856.   coordconv(nx,nz);
  857.   done:=0;
  858.   IF nz<z1-15 THEN
  859.   BEGIN
  860.     done:=1;
  861.     angle:=a1;
  862.     coordconv(x2,y2);
  863.     coordconv(x3,y3);
  864.     coordconv(x4,y4);
  865.     angle:=a2;
  866.     coordconv(y2,z2);
  867.     coordconv(y3,z3);
  868.     coordconv(y4,z4);
  869.     angle:=a3;
  870.     coordconv(x2,z2);
  871.     coordconv(x3,z3);
  872.     coordconv(x4,z4);
  873.     x1:=(centerX*(z1+dist)-centerZ*x1) DIV ((z1+dist)-centerZ)+mx;
  874.     y1:=(centerY*(z1+dist)-centerZ*y1) DIV ((z1+dist)-centerZ)+my;
  875.     x2:=(centerX*(z2+dist)-centerZ*x2) DIV ((z2+dist)-centerZ)+mx;
  876.     y2:=(centerY*(z2+dist)-centerZ*y2) DIV ((z2+dist)-centerZ)+my;
  877.     x3:=(centerX*(z3+dist)-centerZ*x3) DIV ((z3+dist)-centerZ)+mx;
  878.     y3:=(centerY*(z3+dist)-centerZ*y3) DIV ((z3+dist)-centerZ)+my;
  879.     x4:=(centerX*(z4+dist)-centerZ*x4) DIV ((z4+dist)-centerZ)+mx;
  880.     y4:=(centerY*(z4+dist)-centerZ*y4) DIV ((z4+dist)-centerZ)+my;
  881.     Cube(x1,y1,x2,y2,x3,y3,x4,y4,198,158);
  882.   END;
  883.   Inc(anzi);
  884. END;
  885.  
  886.  
  887. PROCEDURE LineRain(i:WORD;buffer:Pointer);
  888. BEGIN
  889.   i:=i*320;
  890.   ASM
  891.     push  ds
  892.     les   di,buffer
  893.     add   di,i
  894.     xor   cx,cx
  895.     mov   al,10
  896.     mov   ah,10
  897.    @@l1:
  898.     mov   es:[di],ax
  899.     inc   al
  900.     inc   ah
  901.     inc   cx
  902.     add   di,2
  903.     cmp   cx,160
  904.     jne   @@l1
  905.    @@l2:
  906.     mov   es:[di],ax
  907.     dec   al
  908.     dec   ah
  909.     inc   cx
  910.     add   di,2
  911.     cmp   cx,320
  912.     jne   @@l2
  913.     pop   ds
  914.   END;
  915. END;
  916.  
  917.  
  918. PROCEDURE Anim3(buffer:Pointer);
  919. VAR az1,az2,az3,az4,ax1,ay1,ax2,ay2,ax3,ay3,ax4,ay4:Integer;
  920.     bz1,bz2,bz3,bz4,bx1,by1,bx2,by2,bx3,by3,bx4,by4:Integer;
  921.     cz1,cz2,cz3,cz4,cx1,cy1,cx2,cy2,cx3,cy3,cx4,cy4:Integer;
  922.     dz1,dz2,dz3,dz4,dx1,dy1,dx2,dy2,dx3,dy3,dx4,dy4:Integer;
  923.     ez1,ez2,ez3,ez4,ex1,ey1,ex2,ey2,ex3,ey3,ex4,ey4:Integer;
  924.     fz1,fz2,fz3,fz4,fx1,fy1,fx2,fy2,fx3,fy3,fx4,fy4:Integer;
  925.     anx,any,anz:Integer;
  926.     bnx,bny,bnz:Integer;
  927.     cnx,cny,cnz:Integer;
  928.     dnx,dny,dnz:Integer;
  929.     enx,eny,enz:Integer;
  930.     done,fnx,fny,fnz:Integer;
  931.     mx,my,anzi,dim  :Integer;
  932. BEGIN
  933.   dist :=100;
  934.   dim  :=50;
  935.   a1   :=0;
  936.   a2   :=0;
  937.   a3   :=0;
  938.   ax1  :=-50;
  939.   ay1  :=-50;
  940.   ax2  :=50;
  941.   anx  :=-50;
  942.   any  :=-50;
  943.   anz  :=160;
  944.   ay2  :=-50;
  945.   ax3  :=50;
  946.   ay3  :=50;
  947.   ax4  :=-50;
  948.   ay4  :=50;
  949.   az1  :=dim;
  950.   az2  :=dim;
  951.   az3  :=dim;
  952.   az4  :=dim;
  953.   bx1  :=-50;
  954.   by1  :=-50;
  955.   bx2  :=50;
  956.   bnx  :=-50;
  957.   bny  :=-50;
  958.   bnz  :=-160;
  959.   by2  :=-50;
  960.   bx3  :=50;
  961.   by3  :=50;
  962.   bx4  :=-50;
  963.   by4  :=50;
  964.   bz1  :=-dim;
  965.   bz2  :=-dim;
  966.   bz3  :=-dim;
  967.   bz4  :=-dim;
  968.   cx1  :=-50;
  969.   cy1  :=-dim;
  970.   cx2  :=50;
  971.   cnx  :=-50;
  972.   cny  :=-160;
  973.   cnz  :=50;
  974.   cy2  :=-dim;
  975.   cx3  :=+50;
  976.   cy3  :=-dim;
  977.   cx4  :=-50;
  978.   cy4  :=-dim;
  979.   cz1  :=50;
  980.   cz2  :=50;
  981.   cz3  :=-50;
  982.   cz4  :=-50;
  983.   dx1  :=-50;
  984.   dy1  :=dim;
  985.   dx2  :=50;
  986.   dy2  :=dim;
  987.   dnx  :=-50;
  988.   dny  :=160;
  989.   dnz  :=50;
  990.   dx3  :=50;
  991.   dy3  :=dim;
  992.   dx4  :=-50;
  993.   dy4  :=dim;
  994.   dz1  :=50;
  995.   dz2  :=50;
  996.   dz3  :=-50;
  997.   dz4  :=-50;
  998.   ex1  :=dim;
  999.   ey1  :=-50;
  1000.   ex2  :=dim;
  1001.   enx  :=160;
  1002.   eny  :=-50;
  1003.   enz  :=50;
  1004.   ey2  :=-50;
  1005.   ex3  :=dim;
  1006.   ey3  :=50;
  1007.   ex4  :=dim;
  1008.   ey4  :=50;
  1009.   ez1  :=50;
  1010.   ez2  :=-50;
  1011.   ez3  :=-50;
  1012.   ez4  :=50;
  1013.   fx1  :=-dim;
  1014.   fy1  :=-50;
  1015.   fx2  :=-dim;
  1016.   fnx  :=-160;
  1017.   fny  :=-50;
  1018.   fnz  :=50;
  1019.   fy2  :=-50;
  1020.   fx3  :=-dim;
  1021.   fy3  :=50;
  1022.   fx4  :=-dim;
  1023.   fy4  :=50;
  1024.   fz1  :=50;
  1025.   fz2  :=-50;
  1026.   fz3  :=-50;
  1027.   fz4  :=50;
  1028.   times:=0;
  1029.   REPEAT
  1030.     ClearBuffer(buffer,0*320,0*320);
  1031.     mx  :=155;
  1032.     my  :=120;
  1033.     anzi:=0;
  1034.     done:=4;
  1035.     Cube3(ax1,ay1,az1,ax2,ay2,az2,ax3,ay3,az3,ax4,ay4,az4,anx,any,anz,done);
  1036.     IF done=0 THEN
  1037.       Cube3(bx1,by1,bz1,bx2,by2,bz2,bx3,by3,bz3,bx4,by4,bz4,bnx,bny,bnz,done);
  1038.     Cube3(cx1,cy1,cz1,cx2,cy2,cz2,cx3,cy3,cz3,cx4,cy4,cz4,cnx,cny,cnz,done);
  1039.     IF done=0 THEN
  1040.       Cube3(dx1,dy1,dz1,dx2,dy2,dz2,dx3,dy3,dz3,dx4,dy4,dz4,dnx,dny,dnz,done);
  1041.     Cube3(ex1,ey1,ez1,ex2,ey2,ez2,ex3,ey3,ez3,ex4,ey4,ez4,enx,eny,enz,done);
  1042.     IF done=0 THEN
  1043.       Cube3(fx1,fy1,fz1,fx2,fy2,fz2,fx3,fy3,fz3,fx4,fy4,fz4,fnx,fny,fnz,done);
  1044.     CopperA(buffer,0*320,0*320);
  1045.     Inc(times);
  1046.     a1:=a1+6;
  1047.     a3:=a3+5;
  1048.     IF a1>=360
  1049.       THEN a1:=a1-360;
  1050.     IF a3>=360
  1051.       THEN a3:=a3-360;
  1052.   UNTIL (times=500);
  1053. END;
  1054.  
  1055.  
  1056. PROCEDURE Anim2;
  1057. VAR ans2,i,y,mx,d,my,x1,y1,x2,y2,ans:Integer;
  1058. BEGIN
  1059.   ans  :=0;
  1060.   ans2 :=0;
  1061.   angle:=0;
  1062.   mx   :=110;
  1063.   my   :=60;
  1064.   REPEAT
  1065.     ClearBuffer(buffer,0*320,0*320);
  1066.     FOR y:=0 TO 66 DO
  1067.     BEGIN
  1068.       i :=y*1;
  1069.       x1:=-40;
  1070.       x2:=40;
  1071.       y2:=i-35;
  1072.       y1:=i-35;
  1073.       d :=x2;
  1074.       IF ans=0 THEN
  1075.       BEGIN
  1076.         coordconv(x1,d);
  1077.         coordconv(x2,d);
  1078.       END
  1079.       ELSE
  1080.       IF ans=1 THEN
  1081.       BEGIN
  1082.         coordconv(x1,y1);
  1083.         coordconv(x2,y1);
  1084.       END
  1085.       ELSE
  1086.       IF ans=2 THEN
  1087.       BEGIN
  1088.         coordconv(x1,y2);
  1089.         coordconv(x2,y2);
  1090.       END
  1091.       ELSE
  1092.       IF ans=3 THEN
  1093.       BEGIN
  1094.         coordconv(x1,y1);
  1095.         coordconv(x2,y1);
  1096.       END
  1097.       ELSE
  1098.       IF ans=4 THEN
  1099.       BEGIN
  1100.         coordconv(x1,y2);
  1101.         coordconv(x2,y2);
  1102.       END
  1103.       ELSE
  1104.       IF ans=5 THEN
  1105.       BEGIN
  1106.         coordconv(x1,x2);
  1107.         coordconv(x2,y1);
  1108.       END
  1109.       ELSE
  1110.       IF ans=6 THEN
  1111.       BEGIN
  1112.         coordconv(x1,y1);
  1113.         coordconv(x2,x2);
  1114.       END
  1115.       ELSE
  1116.       IF ans=7 THEN
  1117.       BEGIN
  1118.         coordconv(x1,y1);
  1119.         coordconv(x2,x1);
  1120.       END;
  1121.       IF ans=8 THEN
  1122.       BEGIN
  1123.         coordconv(x1,y1);
  1124.         coordconv(x2,x1);
  1125.       END
  1126.       ELSE
  1127.       IF ans=9 THEN
  1128.       BEGIN
  1129.         coordconv(x1,y2);
  1130.         coordconv(x2,y2);
  1131.       END;
  1132.       Inc(x1,40+mx);
  1133.       Inc(x2,40+mx);
  1134.       Inc(y1,35+my);
  1135.       Inc(y2,35+my);
  1136.       LineAsmQuadro(i*3*320,x1,y1,x2,y2,buffer,back,150);
  1137.     END;
  1138.     CopperA(buffer,0*320,0*320);
  1139.     Inc(angle,6);
  1140.     IF angle>360 THEN
  1141.     BEGIN
  1142.       angle:=angle-360;
  1143.       Inc(ans);
  1144.       IF ans=10 THEN
  1145.       BEGIN
  1146.         ans:=0;
  1147.         Inc(ans2);
  1148.       END;
  1149.     END;
  1150.   UNTIL (ans2=1);
  1151. END;
  1152.  
  1153.  
  1154. PROCEDURE Anim1;
  1155. VAR mx,my,m,alpha:WORD;
  1156.     ans,w,dist,z1,z2,z3,z4,x1,y1,x2,y2,x3,y3,x4,y4:Integer;
  1157.     r1,r2,r3:Boolean;
  1158. BEGIN
  1159.   mx   :=155;
  1160.   my   :=92;
  1161.   dist :=100;
  1162.   m    :=60;
  1163.   alpha:=0;
  1164.   times:=0;
  1165.   r1   :=False;
  1166.   r2   :=False;
  1167.   r3   :=False;
  1168.   ans  :=0;
  1169.   REPEAT
  1170.     x1:=-60;
  1171.     y1:=-60;
  1172.     x2:=60;
  1173.     y2:=-60;
  1174.     x3:=60;
  1175.     y3:=60;
  1176.     x4:=-60;
  1177.     y4:=60;
  1178.     z1:=0;
  1179.     z2:=0;
  1180.     z3:=0;
  1181.     z4:=0;
  1182.     angle:=alpha;
  1183.     IF r1 THEN
  1184.     BEGIN
  1185.       coordconv(x1,y1);
  1186.       coordconv(x2,y2);
  1187.       coordconv(x3,y3);
  1188.       coordconv(x4,y4);
  1189.     END;
  1190.     IF r2 THEN
  1191.     BEGIN
  1192.       coordconv(x1,z1);
  1193.       coordconv(x2,z2);
  1194.       coordconv(x3,z3);
  1195.       coordconv(x4,z4);
  1196.     END;
  1197.     IF r3 THEN
  1198.     BEGIN
  1199.       coordconv(y1,z1);
  1200.       coordconv(y2,z2);
  1201.       coordconv(y3,z3);
  1202.       coordconv(y4,z4);
  1203.     END;
  1204.     x1:=(centerX*(z1+dist)-centerZ*x1) DIV ((z1+dist)-centerZ)+mx;
  1205.     y1:=(centerY*(z1+dist)-centerZ*y1) DIV ((z1+dist)-centerZ)+my;
  1206.     x2:=(centerX*(z2+dist)-centerZ*x2) DIV ((z2+dist)-centerZ)+mx;
  1207.     y2:=(centerY*(z2+dist)-centerZ*y2) DIV ((z2+dist)-centerZ)+my;
  1208.     x3:=(centerX*(z3+dist)-centerZ*x3) DIV ((z3+dist)-centerZ)+mx;
  1209.     y3:=(centerY*(z3+dist)-centerZ*y3) DIV ((z3+dist)-centerZ)+my;
  1210.     x4:=(centerX*(z4+dist)-centerZ*x4) DIV ((z4+dist)-centerZ)+mx;
  1211.     y4:=(centerY*(z4+dist)-centerZ*y4) DIV ((z4+dist)-centerZ)+my;
  1212.     ClearBuffer(buffer,0*320,0*320);
  1213.     Cube(x1,y1,x2,y2,x3,y3,x4,y4,197,158);
  1214.     CopperA(buffer,0*320,0*320);
  1215.     alpha:=alpha+6;
  1216.     Inc(times);
  1217.     IF alpha>360 THEN
  1218.     BEGIN
  1219.       alpha:=alpha-360;
  1220.       w    :=Random(5);
  1221.       IF w=2 THEN
  1222.         r1:=False
  1223.       ELSE
  1224.         r1:=True;
  1225.       w    :=random(5);
  1226.       IF w=2 THEN
  1227.         r2:=False
  1228.       ELSE
  1229.         r2:=True;
  1230.       w    :=random(5);
  1231.       IF w=2 THEN
  1232.         r3:=False
  1233.       ELSE
  1234.         r3:=True;
  1235.       Inc(ans);
  1236.     END;
  1237.   UNTIL ans=13;
  1238. END;
  1239.  
  1240.  
  1241. PROCEDURE Start;
  1242. BEGIN
  1243.   InLine($FA);
  1244.   GetIntVec($1B,old_int_truc);
  1245.   int_truc:=Ptr(Seg(Nothing),Ofs(Nothing));
  1246.   SetIntVec($1B,int_truc);
  1247.   InLine($FB);
  1248.   MemW[$40:$1A]:=MemW[$40:$1C];
  1249.   ClrScr;
  1250.   Init(segp2,picture2_ofs);
  1251.   Move(back^,MEM[$A000:$0],64000);
  1252.   Delay(2000);
  1253.   ClearBuffer(buffer,0*320,0*320);
  1254.   CopperA(buffer,0*320,0*320);
  1255.   move(loader2^,loader^,64000);
  1256.   ClearBuffer(buffer,0*320,0*320);
  1257.   CopperA(buffer,0*320,0*320);
  1258.   Anim1;
  1259.   Anim2;
  1260.   Anim3(buffer);
  1261.   ASM
  1262.     mov   ax,0003
  1263.     int   $10
  1264.   END;
  1265.   FreeMem(paltmp,768);
  1266.   FreeMem(buffer,64000);
  1267.   FreeMem(buffer2,64000);
  1268.   FreeMem(loader,64000);
  1269.   FreeMem(loader2,64000);
  1270.   InLine($FA);
  1271.   SetIntVec($1B,old_int_truc);
  1272.   InLine($FB);
  1273. END;
  1274.  
  1275.  
  1276. BEGIN
  1277.   Randomize;
  1278.   GetMem(loader,64800);
  1279.   GetMem(loader2,64800);
  1280.   Assign(f,'texture.raw');
  1281.   Reset(f,1);
  1282.   BlockRead(f,loader^,64768);
  1283.   Close(f);
  1284.   move(loader^,loader2^,64768);
  1285.   picture2_ofs:=ofs(loader^);
  1286.   segp2       :=seg(loader^);
  1287.   back        :=Ptr(segp2,picture2_ofs+768);
  1288.   GetMem(buffer,64000);
  1289.   GetMem(buffer2,64000);
  1290.   times:=0;
  1291.   FOR i:=0 TO 500 DO
  1292.   BEGIN
  1293.     tsin[i]:=Round(Sin(i/180*PI)*256.0);
  1294.     tcos[i]:=Round(Cos(i/180*PI)*256.0);
  1295.   END;
  1296.   lminy:=0;
  1297.   lmaxy:=0;
  1298.   angle:=10;
  1299.   di:=5;
  1300.   GetMem(paltmp,768);
  1301.   maxx:=150;
  1302.   mx  :=130+25;
  1303.   my  :=60+25;
  1304.   way :=1;
  1305.   zl1 :=0;
  1306.   gy  :=0;
  1307.   maxx:=158;
  1308.   Start;
  1309. END.