home *** CD-ROM | disk | FTP | other *** search
/ Supremacy 1 / Supremacy-1.iso / DEMOS / S-T / TOXIC11.ZIP / PROGRAMS / CODING / MORPHING.ZIP / MORPHING / SOURCES / MORPHING.LST < prev    next >
Encoding:
File List  |  1996-02-10  |  12.3 KB  |  489 lines
  1. ' *******************************************************************************
  2. ' Programme de Morphing filaire 2D §upeRnovA Décembre 95
  3. ' GFA ver 3.5E
  4. ' pour TOXIC MAG 11
  5. '
  6. ' Procédures:
  7. '       @init:                   a appeler en debut de programme
  8. '       @demander_points_depart: pour entrer les coordonnées de l'objet
  9. '                                de depart avec la souris
  10. '       @sauver_objet_depart:    stocker sur disque l'objet de depart
  11. '       @charger_objet_depart:   pour charger l'objet de depart
  12. '                                (ne pas utiliser avec demander_points_depart!)
  13. '       @calcule_droites:        calcule du morphing
  14. '       @optimise:               a utiliser pour que le deplacement des points
  15. '                                se fasse progressivement. Tous les points
  16. '                                arrivent a destination en meme temps.
  17. '       @store:                  sauvegarde des calculs sur disc
  18. '       @anime:                  replay des calculs
  19. '
  20. ' ******************************************************************************
  21. '
  22. @init
  23. @demander_points_depart
  24. ' @sauver_objet_depart
  25. ' @charger_objet_depart
  26. ' @charger_objet_arrivee
  27. @demander_points_arrivee
  28. ' @sauver_objet_arrivee
  29. @calcule_droites
  30. @optimise
  31. ' @store
  32. @anime
  33. '
  34. > PROCEDURE anime
  35.   ' ****************************************************************************
  36.   ' Entrees: rien
  37.   '
  38.   ' Role: joue l'animation des deux objet morphes en mode ping-pong. appuyer
  39.   '       sur le bouton gauche de la souris pour passer d'un objet a l'autre
  40.   ' ****************************************************************************
  41.   COLOR 1
  42. loop:
  43.   FOR t=1 TO distance_max+1
  44.     FOR pt=1 TO nbliens STEP 2
  45.       LINE bufferx(liens(pt),t),buffery(liens(pt),t),bufferx(liens(pt+1),t),buffery(liens(pt+1),t)
  46.     NEXT pt
  47.     SWAP e1%,e2%
  48.     ~XBIOS(5,L:e1%,L:e2%,-1)
  49.     ~XBIOS(37)
  50.     CLS
  51.   NEXT t
  52.   REPEAT
  53.   UNTIL MOUSEK=1
  54.   FOR n=t TO 1 STEP -1
  55.     FOR pt=1 TO nbliens STEP 2
  56.       LINE bufferx(liens(pt),n),buffery(liens(pt),n),bufferx(liens(pt+1),n),buffery(liens(pt+1),n)
  57.     NEXT pt
  58.     SWAP e1%,e2%
  59.     ~XBIOS(5,L:e1%,L:e2%,-1)
  60.     ~XBIOS(37)
  61.     CLS
  62.   NEXT n
  63.   REPEAT
  64.   UNTIL MOUSEK=1
  65.   GOTO loop
  66. RETURN
  67. > PROCEDURE calcule(xa,ya,xb,yb)
  68.   ' ****************************************************************************
  69.   ' Entrees: xa: abcsisse du point source
  70.   '          ya: ordonnee       "
  71.   '          xb: abcsisse du point destination
  72.   '          yb: ordonnee       "
  73.   '
  74.   ' Role: trace virtuellement la droite reliant les deux points et stocke les
  75.   ' coordonnees successive dans bufferx() et buffery()
  76.   ' ****************************************************************************
  77.   IF xa=xb AND ya=yb THEN
  78.     xb=xa+1
  79.   ENDIF
  80.   t=1
  81.   IF xb>xa THEN
  82.     a=(yb-ya)/(xb-xa)
  83.     b=ya-xa*a
  84.     x=xa
  85.     WHILE xb>=x
  86.       y=a*x+b
  87.       bufferx(pt,t)=x
  88.       buffery(pt,t)=y
  89.       x=x+precision
  90.       INC t
  91.       ' PSET x,y,1
  92.     WEND
  93.   ENDIF
  94.   '
  95.   IF xb<xa THEN
  96.     SWAP xb,xa
  97.     SWAP yb,ya
  98.     a=(yb-ya)/(xb-xa)
  99.     b=ya-xa*a
  100.     x=xb
  101.     WHILE x>xa
  102.       y=a*x+b
  103.       bufferx(pt,t)=x
  104.       buffery(pt,t)=y
  105.       x=x-precision
  106.       INC t
  107.       '   PSET x,y,1
  108.     WEND
  109.   ENDIF
  110.   '
  111.   distances(pt)=t
  112.   IF t>distance_max THEN
  113.     distance_max=t
  114.   ENDIF
  115.   '
  116.   FOR w=t TO max_transitions
  117.     bufferx(pt,w)=xarrivee(pt)
  118.     buffery(pt,w)=yarrivee(pt)
  119.   NEXT w
  120.   '
  121. RETURN
  122. > PROCEDURE demander_points_depart
  123.   ' ****************************************************************************
  124.   ' Entrees: rien
  125.   '
  126.   ' Role: tracage de l'objet de depart en fil de fer.
  127.   '       bouton gauche: relier le dernier point entrer au point actuel
  128.   '       bouton droit:  nouveau point de depart.
  129.   ' ****************************************************************************
  130.   liens(1)=1
  131.   liens(2)=2
  132.   pt=2
  133.   n=2
  134.   '
  135.   @ask_plot
  136.   xdepart(1)=x
  137.   ydepart(1)=y
  138.   '
  139.   REPEAT
  140.     xdepart(2)=MOUSEX
  141.     ydepart(2)=MOUSEY
  142.     COLOR 4
  143.     LINE xdepart(1),ydepart(1),xdepart(2),ydepart(2)
  144.     COLOR 0
  145.     LINE xdepart(1),ydepart(1),xdepart(2),ydepart(2)
  146.   UNTIL MOUSEK=1
  147.   REPEAT
  148.   UNTIL MOUSEK=0
  149.   COLOR 4
  150.   LINE xdepart(1),ydepart(1),xdepart(2),ydepart(2)
  151.   '
  152.   REPEAT
  153.     REPEAT
  154.       a$=INKEY$
  155.       x=MOUSEX
  156.       y=MOUSEY
  157.       k=MOUSEK
  158.       EXIT IF ASC(a$)=27
  159.     UNTIL k<>0
  160.     '
  161.     EXIT IF ASC(a$)=27
  162.     '
  163.     IF k=1
  164.       INC n
  165.       liens(n)=liens(n-1)
  166.       INC n
  167.       INC pt
  168.       liens(n)=pt
  169.       @elastik
  170.     ENDIF
  171.     '
  172.     IF k=2
  173.       PRINT CHR$(7);
  174.       INC n
  175.       INC pt
  176.       liens(n)=pt
  177.       ask_plot
  178.       xdepart(pt)=x
  179.       ydepart(pt)=y
  180.       INC n
  181.       INC pt
  182.       liens(n)=pt
  183.       @elastik
  184.     ENDIF
  185.   UNTIL pt=nbpts
  186.   nbliens=n
  187.   nbpts=pt
  188. RETURN
  189. > PROCEDURE ask_plot
  190.   ' ***************************************************************************
  191.   ' Attend un front montant de la souris pour afficher un point
  192.   ' ***************************************************************************
  193.   REPEAT
  194.     x=MOUSEX
  195.     y=MOUSEY
  196.   UNTIL MOUSEK=1
  197.   REPEAT
  198.   UNTIL MOUSEK=0
  199.   PLOT x,y
  200. RETURN
  201. > PROCEDURE elastik
  202.   ' ****************************************************************************
  203.   ' Permet de tracer une droite entre le dernier point entré et le point actuel
  204.   ' tant que le bouton gauche de la souris n'a pas ete relache
  205.   ' ****************************************************************************
  206.   REPEAT
  207.     xdepart(pt)=MOUSEX
  208.     ydepart(pt)=MOUSEY
  209.     COLOR 4
  210.     ' LINE xdepart(pt-1),ydepart(pt-1),xdepart(pt),ydepart(pt)
  211.     LINE xdepart(liens(n-1)),ydepart(liens(n-1)),xdepart(liens(n)),ydepart(liens(n))
  212.     COLOR 0
  213.     LINE xdepart(pt-1),ydepart(pt-1),xdepart(pt),ydepart(pt)
  214.   UNTIL MOUSEK=0
  215.   COLOR 4
  216.   LINE xdepart(pt-1),ydepart(pt-1),xdepart(pt),ydepart(pt)
  217. RETURN
  218. > PROCEDURE demander_points_arrivee
  219.   FOR pt=1 TO nbpts
  220.     xarrivee(pt)=xdepart(pt)
  221.     yarrivee(pt)=ydepart(pt)
  222.   NEXT pt
  223. test:
  224.   REPEAT
  225.     COLOR 1
  226.     FOR pt=1 TO nbpts
  227.       BOX xarrivee(pt)-2,yarrivee(pt)-2,xarrivee(pt)+2,yarrivee(pt)+2
  228.     NEXT pt
  229.     REPEAT
  230.       x=MOUSEX
  231.       y=MOUSEY
  232.       IF ASC(INKEY$)=27 THEN
  233.         GOTO done
  234.       ENDIF
  235.     UNTIL MOUSEK=1
  236.     FOR pt=1 TO nbpts
  237.       IF x>xarrivee(pt)-3 AND x<xarrivee(pt)+3 AND y<yarrivee(pt)+3 AND y>yarrivee(pt)-3 THEN
  238.         trouve=TRUE
  239.       ENDIF
  240.       EXIT IF trouve
  241.     NEXT pt
  242.     IF trouve THEN
  243.       n=1
  244.       WHILE liens(n)<>pt
  245.         INC n
  246.       WEND
  247.       IF liens(n+1)=pt
  248.         link=2
  249.         b=liens(n-1)
  250.         c=liens(n+2)
  251.       ENDIF
  252.       IF liens(n+1)<>pt
  253.         IF n/2=INT(n/2) THEN
  254.           b=liens(n-1)
  255.         ELSE
  256.           b=liens(n+1)
  257.         ENDIF
  258.         link=1
  259.       ENDIF
  260.       WHILE MOUSEK=1
  261.         x=MOUSEX
  262.         y=MOUSEY
  263.         xarrivee(pt)=x
  264.         yarrivee(pt)=y
  265.         IF link=1
  266.           COLOR 4
  267.           LINE x,y,xarrivee(b),yarrivee(b)
  268.           COLOR 0
  269.           LINE x,y,xarrivee(b),yarrivee(b)
  270.         ENDIF
  271.         IF link=2
  272.           COLOR 4
  273.           LINE x,y,xarrivee(b),yarrivee(b)
  274.           LINE x,y,xarrivee(c),yarrivee(c)
  275.           COLOR 0
  276.           LINE x,y,xarrivee(b),yarrivee(b)
  277.           LINE x,y,xarrivee(c),yarrivee(c)
  278.         ENDIF
  279.       WEND
  280.       trouve=FALSE
  281.       COLOR 4
  282.       CLS
  283.       FOR pt=1 TO nbliens STEP 2
  284.         LINE xarrivee(liens(pt)),yarrivee(liens(pt)),xarrivee(liens(pt+1)),yarrivee(liens(pt+1))
  285.       NEXT pt
  286.       COLOR 1
  287.       BOX xmin,ymin,xmax,ymax
  288.     ENDIF
  289.     a$=INKEY$
  290.   UNTIL 1=2
  291. done:
  292. RETURN
  293. > PROCEDURE calcule_droites
  294.   ' ****************************************************************************
  295.   ' Cette procedure se charge d'appeler @calcule pour effectuer les liens entre
  296.   ' tous les points de depart et les points d'arrivee correspondant
  297.   ' ****************************************************************************
  298.   PRINT AT(1,18);"Calcul de la transformation:";
  299.   PRINT AT(1,19);vum$;
  300.   PRINT AT(1,20);"Optimisation:";
  301.   PRINT AT(1,21);vum$;
  302.   PRINT AT(1,22);"Stockage des coordonnees finales:";
  303.   PRINT AT(1,23);vum$;
  304.   FOR pt=1 TO nbpts
  305.     v=(pt*LEN(st$))/nbpts
  306.     PRINT AT(1,19);MID$(st$,1,v);
  307.     @calcule(xdepart(pt),ydepart(pt),xarrivee(pt),yarrivee(pt))
  308.   NEXT pt
  309. RETURN
  310. > PROCEDURE init
  311.   ' ****************************************************************************
  312.   ' Reserve la memoire necessaire et les tableaux de coordonnees
  313.   ' ****************************************************************************
  314.   e1%=XBIOS(2)
  315.   e2$=STRING$(32000,0)
  316.   e2%=V:e2$
  317.   max_transitions=150
  318.   nbpts=100
  319.   precision=2
  320.   DIM xdepart(nbpts),ydepart(nbpts),xarrivee(nbpts),yarrivee(nbpts),bufferx(nbpts,max_transitions),buffery(nbpts,max_transitions),liens(nbpts*2),distances(nbpts),bufferx2(nbpts,max_transitions),buffery2(nbpts,max_transitions),donnee$(nbpts*4)
  321.   st$=STRING$(40,"*")
  322.   vum$=STRING$(40,".")
  323.   ON BREAK GOSUB braik
  324.   xmin=96
  325.   xmax=224
  326.   ymin=50
  327.   ymax=170
  328.   BOX xmin,ymin,xmax,ymax
  329. RETURN
  330. > PROCEDURE store
  331.   xy$=xy$+SPACE$(distance_max*nbpts)
  332.   xy%=V:xy$
  333.   ixy%=xy%
  334.   FOR pt=1 TO nbpts
  335.     FOR t=1 TO distance_max+1
  336.       x=bufferx(pt,t)
  337.       y=buffery(pt,t)
  338.       DPOKE xy%,x
  339.       ADD xy%,2
  340.       DPOKE xy%,y
  341.       ADD xy%,2
  342.     NEXT t
  343.   NEXT pt
  344.   CLS
  345.   PRINT "Sauver coordonnees"
  346.   FILESELECT "a:\*.xy","",f$
  347.   BSAVE f$,ixy%,xy%-ixy%
  348.   '
  349.   liens$=SPACE$(nbliens)
  350.   liens%=V:liens$
  351.   iliens%=liens%
  352.   DPOKE liens%,nbliens/2
  353.   ADD liens%,2
  354.   DPOKE liens%,(distance_max+1)*4
  355.   ADD liens%,2
  356.   FOR n=1 TO nbliens
  357.     DPOKE liens%,liens(n)-1
  358.     ADD liens%,2
  359.   NEXT n
  360.   CLS
  361.   PRINT "Sauver fichier d'info."
  362.   FILESELECT "a:\*.dat","",f$
  363.   BSAVE f$,iliens%,liens%-iliens%
  364. RETURN
  365. > PROCEDURE optimise
  366.   FOR pt=1 TO nbpts
  367.     v=(pt*LEN(st$))/nbpts
  368.     PRINT AT(1,21);MID$(st$,1,v);
  369.     coeff=ROUND(distance_max/distances(pt))
  370.     t=0
  371.     FOR coordonnee=1 TO distances(pt)
  372.       FOR n=1 TO coeff
  373.         INC t
  374.         bufferx2(pt,t)=bufferx(pt,coordonnee)
  375.         buffery2(pt,t)=buffery(pt,coordonnee)
  376.       NEXT n
  377.     NEXT coordonnee
  378.     FOR n=t TO distance_max
  379.       bufferx2(pt,n)=xarrivee(pt)
  380.       buffery2(pt,n)=yarrivee(pt)
  381.     NEXT n
  382.   NEXT pt
  383.   FOR pt=1 TO nbpts
  384.     FOR t=1 TO distance_max
  385.       v=(pt*LEN(st$))/nbpts
  386.       PRINT AT(1,23);MID$(st$,1,v);
  387.       bufferx(pt,t)=bufferx2(pt,t)
  388.       buffery(pt,t)=buffery2(pt,t)
  389.     NEXT t
  390.     bufferx(pt,t)=xarrivee(pt)
  391.     buffery(pt,t)=yarrivee(pt)
  392.     bufferx(pt,t+1)=xarrivee(pt)
  393.     buffery(pt,t+1)=yarrivee(pt)
  394.   NEXT pt
  395. RETURN
  396. > PROCEDURE braik
  397.   END
  398. RETURN
  399. > PROCEDURE sauver_objet_depart
  400.   donnee$(1)=STR$(nbpts)
  401.   donnee$(2)=STR$(nbliens)
  402.   n=3
  403.   FOR pt=1 TO nbpts
  404.     donnee$(n)=STR$(xdepart(pt))
  405.     INC n
  406.     donnee$(n)=STR$(ydepart(pt))
  407.     INC n
  408.   NEXT pt
  409.   FOR pt=1 TO nbliens
  410.     donnee$(n)=STR$(liens(pt))
  411.     INC n
  412.   NEXT pt
  413.   CLS
  414.   PRINT "Sauver objet depart"
  415.   FILESELECT "a:\*.obj","",f$
  416.   OPEN "o",#1,f$
  417.   STORE #1,donnee$(),nbpts*2+4+nbliens
  418.   CLOSE #1
  419. RETURN
  420. > PROCEDURE charger_objet_depart
  421.   CLS
  422.   PRINT "Charger objet depart"
  423.   FILESELECT "a:\*.obj","",f$
  424.   OPEN "i",#1,f$
  425.   RECALL #1,donnee$(),5000,size
  426.   CLOSE #1
  427.   nbpts=VAL(donnee$(1))
  428.   nbliens=VAL(donnee$(2))
  429.   n=3
  430.   FOR pt=1 TO nbpts
  431.     xdepart(pt)=VAL(donnee$(n))
  432.     INC n
  433.     ydepart(pt)=VAL(donnee$(n))
  434.     INC n
  435.   NEXT pt
  436.   FOR pt=1 TO nbliens
  437.     liens(pt)=VAL(donnee$(n))
  438.     INC n
  439.   NEXT pt
  440. RETURN
  441. > PROCEDURE charger_objet_arrivee
  442.   CLS
  443.   PRINT "Charger objet arrivee"
  444.   FILESELECT "a:\*.obj","",f$
  445.   OPEN "i",#1,f$
  446.   RECALL #1,donnee$(),5000,size
  447.   CLOSE #1
  448.   IF nbpts<>VAL(donnee$(1)) THEN
  449.     PRINT "Nbpts differents!"
  450.     END
  451.   ENDIF
  452.   IF nbliens<>VAL(donnee$(2)) THEN
  453.     PRINT "Liens differents!"
  454.     END
  455.   ENDIF
  456.   n=3
  457.   FOR pt=1 TO nbpts
  458.     xarrivee(pt)=VAL(donnee$(n))
  459.     INC n
  460.     yarrivee(pt)=VAL(donnee$(n))
  461.     INC n
  462.   NEXT pt
  463.   FOR pt=1 TO nbliens
  464.     liens(pt)=VAL(donnee$(n))
  465.     INC n
  466.   NEXT pt
  467. RETURN
  468. > PROCEDURE sauver_objet_arrivee
  469.   donnee$(1)=STR$(nbpts)
  470.   donnee$(2)=STR$(nbliens)
  471.   n=3
  472.   FOR pt=1 TO nbpts
  473.     donnee$(n)=STR$(xarrivee(pt))
  474.     INC n
  475.     donnee$(n)=STR$(yarrivee(pt))
  476.     INC n
  477.   NEXT pt
  478.   FOR pt=1 TO nbliens
  479.     donnee$(n)=STR$(liens(pt))
  480.     INC n
  481.   NEXT pt
  482.   CLS
  483.   PRINT "Sauver objet arrivee"
  484.   FILESELECT "a:\*.obj","",f$
  485.   OPEN "o",#1,f$
  486.   STORE #1,donnee$(),nbpts*2+4+nbliens
  487.   CLOSE #1
  488. RETURN
  489.