home *** CD-ROM | disk | FTP | other *** search
/ Supremacy 1 / Supremacy-1.iso / DEMOS / S-T / TOXIC11.ZIP / PROGRAMS / CODING / MORPHING.ZIP / MORPHING / SOURCES / MORPHING.GFA (.txt) next >
Encoding:
GFA-BASIC Atari  |  1996-02-10  |  11.7 KB  |  295 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 ch