home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.ISO01.iso / magazin / optix / disk1 / optxppac.set / LINMORPH.OPT < prev    next >
Text File  |  1995-06-08  |  2KB  |  103 lines
  1.  
  2. def(i)
  3. def(buf)
  4. def(bufx)
  5. def(bufy)
  6. def(ecken,15)
  7. def(morph_faktor,1)
  8. defs(dum$)
  9. defs(obj$)
  10.  
  11. defai(objekt,3,2,15)
  12.  
  13. procedure setze_objekt(indx)
  14.   locals(i,j,x,y,ln)
  15.   len(obj$,ln)
  16.   for i:=1 to ln step 8 do
  17.     dum$:=obj$
  18.     mid(dum$,i,3)
  19.     val(dum$,x,j)
  20.     dum$:=obj$
  21.     mid(dum$,i+4,3)
  22.     val(dum$,y,j)
  23.     objekt[indx,1,i/8+1]:=x
  24.     objekt[indx,2,i/8+1]:=y
  25.   next(i)
  26. return
  27.  
  28. procedure zeichne_bild(m)
  29.   locals(i,j,sc)
  30.   sc:=2
  31.   j:=m*60-270/sc
  32.   line(objekt[3,1,1]/sc+j,objekt[3,2,1]/sc,objekt[3,1,1]/sc+j,objekt[3,2,1]/sc,0)
  33.   for i:=2 to ecken do
  34.     lineto(objekt[3,1,i]/sc+j,objekt[3,2,i]/sc,0)
  35.   next(i)
  36. return
  37.  
  38. procedure morph
  39.   locals(s,k,ecke)
  40.   for k:=1 to ecken do
  41.     buf:=objekt[1,1,k]
  42.     objekt[3,1,k]:=buf
  43.     buf:=objekt[1,2,k]
  44.     objekt[3,2,k]:=buf
  45.   next(k)
  46.  
  47.   repeat
  48.     if s<10-morph_faktor
  49.       inc(s,morph_faktor)
  50.       for ecke:=1 to ecken do
  51.         buf:=objekt[3,1,ecke]+(morph_faktor*(objekt[2,1,ecke]-objekt[1,1,ecke]))/10
  52.         objekt[3,1,ecke]:=buf
  53.         buf:=objekt[3,2,ecke]+(morph_faktor*(objekt[2,2,ecke]-objekt[1,2,ecke]))/10
  54.         objekt[3,2,ecke]:=buf
  55.       next(ecke)
  56.       zeichne_bild(s)
  57.     endif
  58.   until s>=10-morph_faktor
  59. return
  60.  
  61. begin
  62.  new(objekt)
  63.  setcolor(12)
  64.  
  65.   obj$:=     '301,148+301,167+317,175+326,238+348,266+'
  66.   obj$:=obj$+'348,304+329,331+285,342+253,320+257,265+'
  67.   obj$:=obj$+'283,219+291,173+296,168+298,148+301,148+'
  68.   setze_objekt(1)
  69.  
  70.   obj$:=     '297,196+297,209+315,202+344,221+355,267+'
  71.   obj$:=obj$+'345,304+315,325+280,323+257,295+253,256+'
  72.   obj$:=obj$+'258,218+279,204+292,207+293,191+297,196+'
  73.   setze_objekt(2)
  74.  
  75.   for i:= 1 to 15 do
  76.  
  77.     bufx:=objekt[3,1,i]
  78.     bufy:=objekt[3,2,i]
  79.  
  80.     buf:=objekt[1,1,i]
  81.     objekt[3,1,i]:=buf
  82.     buf:=objekt[1,2,i]
  83.     objekt[3,2,i]:=buf
  84.  
  85.     buf:=objekt[2,1,i]
  86.     objekt[1,1,i]:=buf
  87.     buf:=objekt[2,2,i]
  88.     objekt[1,2,i]:=buf
  89.  
  90.     buf:=objekt[3,1,i]
  91.     objekt[2,1,i]:=buf
  92.     buf:=objekt[3,2,i]
  93.     objekt[2,2,i]:=buf
  94.  
  95.     objekt[3,1,i]:=bufx
  96.     objekt[3,2,i]:=bufy
  97.  
  98.   next(i)
  99.   morph
  100.   pause(0)
  101. end
  102.  
  103.