bicycle.f

Intro/: Directory containing introductory examples. HelloWorld.c A simple program that draws a bo

$alias fdopen='fdopen'(%val, %ref)
      include 'phigs.f1.h'			! get the HP-PHIGS aliases
      program Bicycle				! program "Bicycle.f"
      include 'phigs.f2.h'			! get the HP-PHIGS constants

      integer*4	WorkstnID			! workstation identifier
      parameter	(WorkstnID=1)			! value chosen by the user
      integer*4	ConnID				! connection identifier
      integer*4	WorkstnType			! workstation type
      parameter	(WorkstnType=POIDDX)		! out/in, direct, dbl bfr, X
      integer*4	Bike, Wheel, Frame		! \ structure IDs
      parameter	(Bike=1, Wheel=2, Frame=3)	! / (defined by user)
      real	WheelAngle			! current rotation of wheels
      real	Xpos				! current position of bike
      real	pi, dTheta, dX			! required constants
      integer*4	Spokes				! \ specifies number of spokes
      parameter	(Spokes=30)			! / and number of sides on rim
      parameter	(pi=3.14159265358979323846)	! circumference/diameter
      parameter	(dTheta=2*pi/Spokes)		! angle between spokes
      parameter	(dX=-.003)			! speed of moving bike
      real	FAreaX(26), FAreaY(26)		! points for fill area (frame)
      real	PolylineX(100), PolylineY(100)	! points for circles (wheels)
      real	SpokeX(2), SpokeY(2)		! points for spokes
      data	FAreaX /-0.95, -0.87, -0.60, 			! fork
     +		  -0.05, 1.00, 0.55, 0.50, 0.85, 0.08, 0.60,	! r. triangle
     +		  0.70, 0.73, 0.70, 0.37, 0.34, 0.51,		! seat
     +		  -0.01, -0.56, -0.52, 0.40, 0.44, -0.51,	! fr. triangle
     +		  -0.45, -0.10, -0.10, -0.50/			! handlebars
      data	FAreaY /-1.03, -1.05, -0.33,			! fork
     +		  -1.05, -1.05, 0.00, -0.10, -0.95, -0.95, 0.10,! r. triangle
     +		  0.10, 0.15, 0.20, 0.20, 0.15, 0.13,		! seat
     +		  -0.92, -0.20, -0.10, -0.10, 0.00, 0.00,	! fr. triangle
     +		  0.15, 0.15, 0.20, 0.20/			! handlebars
      !--- transformation matrix variables -----------------------------++++++
      real	Translation(3,3), Scaling(3,3)	! transformation matrices
      real	Matrix(3,3)			! temporary matrix
      real	TransXf, TransXr, TransY, Scale	! front/rear transl., scaling
      parameter	(TransXf=-0.9, TransXr=0.9, TransY=-1.0, Scale=0.5)
      integer*4	Error				! error-return variable
      integer*4	I				! loop control variable
      real	Theta				! temporary variable
      integer*4	fdopen				! to get file descriptor
      real	rad, d				! \ for converting degrees
      rad(d)=	(d*pi/180.0)			! / to radians

      call popph(fdopen(fnum(7), 'w'//char(0)), 0)	! open phigs
      call pue004('/dev/screen/phigs_window', ConnID)	! get connection ID
      call popwk(WorkstnID, ConnID, WorkstnType)	! open workstation
      call psdus(WorkstnID, PWAITD, PNIVE)	! set display update state
      call ppost(WorkstnID, Bike, 1.)		! mark structure for display
      !=== define all CSS structures ===================================++++++
      !--- define the "Frame" structure --------------------------------++++++
      call popst(Frame)				! open structure
      call pfa(26, FAreaX, FAreaY)		! fill area primitive
      call pbltm(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, Error, Matrix)
      call pslmt(Matrix, PCREPL)		! set local transformation
      call pexst(Wheel)				! execute structure
      call pslmt(Matrix, PCREPL)		! set local transformation
      call pexst(Wheel)				! execute structure
      call pclst				! close structure
      !--- define the "Wheel" structure --------------------------------++++++
      call popst(Wheel)				! open structure
      do I=1, Spokes+1				! define the wheel rim
	  Theta=(I-1)*dTheta			! calculate required angle
	  PolylineX(I)=cos(Theta)		! x=r*cos(Theta) where r=1
	  PolylineY(I)=sin(Theta)		! y=r*sin(Theta) where r=1
      end do
      call ppl(Spokes+1, PolylineX, PolylineY)	! 2D polyline
      do I=0, Spokes				! define the spokes
	  Theta=(I-1)*dTheta			! calculate required angle
	  SpokeX(1)=0.0				! \  start defining each
	  SpokeY(1)=0.0				!  \ spoke from the center,
	  SpokeX(2)=cos(Theta)			!  / and then proceed
	  SpokeY(2)=sin(Theta)			! /  rimward.
	  call ppl(2, SpokeX, SpokeY)		! 2D polyline
      end do
      call pclst				! close structure
      !--- define the "Bike" structure ---------------------------------++++++
      call popst(Bike)				! open structure
      call pschh(0.04)				! set character height
      call ptx(0.1, 0.8, 'Joe''s Olde Bike Shoppe')	! 2D text
      call psc(0.25, 0.25, Error, Scaling)		! scale
      call ptr(0.6, 0.6, Error, Translation)		! translate
      call pcom(Translation, Scaling, Error, Matrix)	! concatenate matrices
      call pslmt(Matrix, PCREPL)		! set local transform
      call pexst(Frame)				! execute structure
      call pclst				! close the structure
      !=== display the stucture ========================================++++++
      call ppost(WorkstnID, Bike, 1.0)		! post structure
      call psedm(PREPLC)			! set edit mode to replace
      Xpos=1.4					! starting location for bike
      WheelAngle=0.0				! starting rotation for wheels
      do while (Xpos .gt. -.36)			! loop for structure editing
	  !--- first, open "Bike" structure and move the frame ---------++++++
	  call popst(Bike)			! open structure
	  call psep(3)				! bike xform is element #3
	  call ptr(Xpos, 0.6, Error, Translation)! build translation matrix
	  call pcom(Translation, Scaling, Error, Matrix)! concatenate matrices
	  call pslmt(Matrix, PCREPL)		! set local transform
	  call pclst()				! close structure
	  Xpos=Xpos+dX				! increment X value
	  !--- next, open the "Frame" structure and rotate the wheels --++++++
	  call popst(Frame)			! open structure
	  call pbltm(0.0, 0.0, TransXr, 	! build matrix
     +	    TransY, rad(WheelAngle), Scale, Scale, Error, Matrix)
	  call psep(2)				! front wheel xform is ele. #2
	  call pslmt(Matrix, PCREPL)		! set local transform
	  call psep(4)				! back wheel xform is ele. #4
	  call pbltm(0.0, 0.0, TransXf,		! build matrix
     +	    TransY, rad(WheelAngle+5.), Scale, Scale, Error, Matrix)
	  call pslmt(Matrix, PCREPL)		! set local transform
	  WheelAngle=WheelAngle-dX*3000/(2*pi)	! increment wheel angle
	  call pclst()				! close structure
	  call puwk(WorkstnID, PPERFO)		! update workstation
      end do					! end of movement loop
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program