home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Gfx / Trace.e < prev   
Encoding:
Text File  |  1992-09-02  |  1.5 KB  |  66 lines
  1. /* This does something that looks like raytracing.
  2.    does absolutely nothing fancy. vary the positions of
  3.    the ball objects below to see the effect                 */
  4.  
  5. OBJECT ball
  6.   next,type,x,y,z,r,col
  7. ENDOBJECT
  8.  
  9. CONST S=100,T_BALL=1,SP=1,MI=$7FFFFFF0
  10.  
  11. DEF first:PTR TO ball,scr=NIL,last,next
  12.  
  13. PROC main()
  14.   scr:=OpenS(320,256,4,0,'Tracing...')
  15.   IF scr
  16.     last:=[NIL,T_BALL,6500,5500,5000,500,3]:ball
  17.     next:=[last,T_BALL,5000,5500,6000,1500,4]:ball
  18.     first:=[next,T_BALL,4000,5500,5000,1000,1]:ball
  19.     traceall()
  20.     WHILE Mouse()<>1 DO NOP
  21.     leave(NIL)
  22.   ELSE
  23.     leave('Could not open screen!')
  24.   ENDIF
  25. ENDPROC
  26.  
  27. PROC traceall()
  28.   DEF x,y
  29.   FOR x:=1000 TO 9000
  30.     FOR y:=1000 TO 9000
  31.       Plot(x/S+20*SP,y/S+20*SP,tracepixel(5000,5000,1000,x,y,9000))
  32.       y:=y+S
  33.       IF Mouse()=1 THEN RETURN
  34.     ENDFOR
  35.     x:=x+S
  36.   ENDFOR
  37. ENDPROC
  38.  
  39. PROC tracepixel(x,y,z,x2,y2,z2)               /* traces beam, returns rgb */
  40.   DEF fx,fy,f,bx,by,dx,dy,obj:PTR TO ball,o,fbest=MI
  41.   obj:=first; o:=first
  42.   REPEAT
  43.     f:=(obj.z-z*256)/(z2-z)
  44.     fx:=x2-x*f/256        /* get factor */
  45.     fy:=y2-y*f/256
  46.     bx:=obj.x-fx        /* new scaled ball position */
  47.     by:=obj.y-fy
  48.     dx:=bx-x                /* distance ball <--> line */
  49.     dy:=by-y
  50.     IF (f<fbest) AND (sqrt(dx*dx+(dy*dy))<obj.r)
  51.       fbest:=f
  52.       o:=obj
  53.     ENDIF
  54.     obj:=obj.next
  55.   UNTIL obj=NIL
  56.   obj:=o
  57. ENDPROC IF fbest<>MI THEN obj.col ELSE 2
  58.  
  59. PROC leave(erstr)
  60.   IF scr THEN CloseS(scr)
  61.   IF erstr THEN WriteF('\s\n',erstr)
  62.   CleanUp(0)
  63. ENDPROC
  64.  
  65. PROC sqrt(x) IS !Fsqrt(x!)!
  66.