home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Tools / Vector / vectest4.e < prev    next >
Encoding:
Text File  |  1992-09-02  |  2.6 KB  |  93 lines
  1. /* this is supposed to be one of them magnifying class vectors,
  2.    but it works a little bumpy right now (implementation=experimental).
  3.    change WINX and WINY below.
  4. */
  5.  
  6. MODULE 'tools/vector'
  7.  
  8. CONST R=100,S=-100,MAXD=24,N=3            /* set N=1..7 (number of shades) */
  9. CONST DISTANCE=80,WINX=639,WINY=282
  10.  
  11. OBJECT status
  12.   phi,theta,depth,x,y
  13. ENDOBJECT
  14.  
  15. DEF depth:PTR TO LONG,stats[N]:ARRAY OF status, translist:PTR TO LONG
  16.  
  17. PROC main()
  18.   DEF w,curphi=75,curtheta=40,curd=0,curs=0,a,fact=1,x,y,nx,ny,ox,oy
  19.   IF w:=OpenW(0,0,WINX,WINY,$200,$E,'3d VectorZ in E! (move mouse!)',NIL,1,NIL)
  20.     SetRast(stdrast,1)
  21.     translist:=[0,-16,-28,-36,-40,-40,-36,-28,-16,0,16,28,36,40,40,36,28,16,0]
  22.     FOR x:=0 TO WINX STEP 16
  23.       FOR y:=0 TO WINY STEP 16
  24.         nx,ny:=posttrans(x,y)
  25.         ox,oy:=posttrans(x,y+16)
  26.         Line(nx,ny,ox,oy,4)
  27.         ox,oy:=posttrans(x+16,y)
  28.         Line(nx,ny,ox,oy,4)
  29.       ENDFOR
  30.     ENDFOR
  31.     RefreshWindowFrame(w)
  32.     SetDrMd(stdrast,2)
  33.     PutChar(stdrast+24,3)
  34.     FOR a:=0 TO N-1 DO stats[a].phi:=-1
  35.     depth:=[200,201,202,205,208,211,215,220,224,230,238,246,254,262,270,276,280,285,289,292,295,298,299,300]
  36.     REPEAT
  37.       stats[curs].phi:=curphi
  38.       stats[curs].theta:=curtheta
  39.       stats[curs].depth:=curd
  40.       stats[curs].x:=Bounds(MouseX(w),DISTANCE,WINX-DISTANCE)
  41.       stats[curs].y:=Bounds(MouseY(w),DISTANCE,WINY-DISTANCE)
  42.       drawshape(stats[curs],2)
  43.       curs++
  44.       IF curs>=N THEN curs:=0
  45.       curd:=curd+fact
  46.       IF curd>=(MAXD-1) THEN (curd:=MAXD-1) BUT fact:=-fact
  47.       IF curd<=0 THEN (curd:=0) BUT fact:=-fact
  48.       curphi:=curphi+2
  49.       IF curphi>=360 THEN curphi:=0
  50.       curtheta:=curtheta+2
  51.       IF curtheta>=360 THEN curtheta:=0
  52.       IF stats[curs].phi>=0 THEN drawshape(stats[curs],1)
  53.     UNTIL GetMsg(Long(w+$56))
  54.     CloseW(w)
  55.   ELSE
  56.     WriteF('um,...\n')
  57.   ENDIF
  58. ENDPROC
  59.  
  60. PROC drawshape(s:PTR TO status,col)
  61.   setmiddle3d(s.x,s.y)
  62.   setpers3d(750,depth[s.depth])
  63.   init3d(s.phi,s.theta)
  64.   polygon([R,R,S, R,R,R, R,S,R, R,S,S, R,R,S, S,R,S, S,R,R, S,S,R, S,S,S, S,R,S],col)
  65.   polygon([R,S,R, S,S,R],col)
  66.   polygon([R,R,R, S,R,R],col)
  67.   polygon([R,S,S, S,S,S],col)
  68. ENDPROC
  69.  
  70. PROC posttrans(x,y)
  71.   IF x>DISTANCE
  72.     IF y>DISTANCE
  73.       IF DISTANCE+288>x
  74.         IF DISTANCE+288>y
  75.           x:=ListItem(translist,Shr(x-DISTANCE,4))+x
  76.           y:=ListItem(translist,Shr(y-DISTANCE,4))+y
  77.         ENDIF
  78.       ENDIF
  79.     ENDIF
  80.   ENDIF
  81. ENDPROC x,y
  82.  
  83. PROC polygon(list:PTR TO LONG,col=1)
  84.   DEF n,i,sx,sy,ox,oy,f=FALSE
  85.   n:=ListLen(list)/3
  86.   FOR i:=1 TO n
  87.     sx,sy:=vec3d(list[]++,list[]++,list[]++)
  88.     sx,sy:=posttrans(sx,sy)
  89.     IF f THEN Line(ox,oy,sx,sy,col) ELSE f:=TRUE
  90.     ox:=sx; oy:=sy;
  91.   ENDFOR
  92. ENDPROC
  93.