P84 Shading


In Section 6 we saw that the ELECTRON could be used to produce a series of pretty pictures on the screen. In the collection of programs in this section we shall construct programs which could be used in the development of formal graphics programs.

This program draws a line by placing a series of dots along it. The density of the dots gives a measure of the illumination of the line.

Equation of line is

   y = mx+c

where

y2-y1
m =-----
x2-x1
c =y1-mx1

Number of dots on line is given by the number of dots per unit length (illumination) and the length of the line.

   The length = (y2-y1)2 + (x2-x1)2

To give an even illumination, we step from x1 to x2, an increment of (x2-x1)/dots, placing a dot at each point.

Note that this routine would have to be amended for plotting vertical lines.

This program uses the above procedure.

COMMANDS

Key in program
Type RUN.
Follow instructions.

  100 REM Program P84 - Shading
  110 MODE 6
  120 PRINT TAB(5,12)"SHADING : The line"
  130 X=INKEY(100)
  140 CLS
  150 PRINT TAB(0,5) "This program uses PLOT 69 to show the 
"
  160 PRINT "effect of 'shading' a line. The effect"
  170 PRINT "of shading is achieved by placing a "
  180 PRINT "series of dots along the line the number";
  190 PRINT "of dots corresponding to the"
  200 PRINT "illumination of the line."
  210 PRINT '''"The line is drawn in MODE 0 using black"
  220 PRINT "and white, only."
  230 PRINT '"The line is drawn between the points"
  240 PRINT "X1,Y1 and X2,Y2, with illumination "
  250 PRINT "constant between .05 and .9."
  260 INPUT '"ENTER FIRST POINT X1,Y1",X1,Y1
  270 PRINT "ENTER SECOND POINT X2,Y2",X2,Y2
  280 INPUT "ENTER ILLUMINATION CONSTANT",I
  290 MODE0
  300 VDU 29,640;512;
  310 PROCline(X1,Y1,X2,Y2,I)
  320 END
  330  
  340 DEF PROCline(X1,Y1,X2,Y2,illum)
  350 GCOL 0,1
  360 M=(Y2-Y1)/(X2-X1)
  370 C=Y1-M*X1
  380 dist=SQR((X1-X2)^2+(Y2-Y1)^2)
  390 dots=dist*illum
  400 dx=(X2-X1)/dots
  410 FOR K=1 TO dots
  420   J=X1+K*dx
  430   PLOT 69,J,M*J+C
  440 NEXT K
  450 ENDPROC


P85 Translation


To translate a line, we must compute the new end points of the line and then draw it.
A translation can be represented by a pair of numbers which is added to the number pair representing each point in the line. In vector nototation

   

Diagramatically, we have

This program implements the algorithm.

COMMANDS

Key in program.
Type RUN.
Follow instructions.

  100 REM Program P85 - Translation
  110 MODE 6
  120 PRINT TAB(5,12) "TRANSLATION"
  130 X=INKEY(100)
  140 CLS
  150 PRINT TAB(0,4)"This program introduces a simple"
  160 PRINT "mechanism for changing the position"
  170 PRINT "of a line. If you have a routine for"
  180 PRINT "moving single lines then you can move"
  190 PRINT "complete line drawings about the screen"
  200 PRINT "at your own convenience."
  210 PRINT ''"To move a line we must know its "
  220 PRINT "original position and the distance"
  230 PRINT "to be traversed in both the X and Y"
  240 PRINT "directions"
  250  
  260 INPUT '"Enter the first end point of the line   (X1,Y1
)",X1,Y1
  270 INPUT "Enter the second end point of the line   (X2,Y2
)",X2,Y2
  280 INPUT "Enter the illumination constant ",I
  290 INPUT "Enter the X-direction movement " K1
  300 INPUT "Enter the Y-direction movement " K2
  310 MODE 0
  320 VDU 29,640;512;
  330 PROCline(X1,Y1,X2,Y2,I)
  340 PROCtranslate(X1,Y1,X2,Y2,K1,K2,I)
  350 END
  360 DEF PROCtranslate(X1,Y1,X2,Y2,K1,K2,illum)
  370 U1=X1+K1:V1=Y1+K2
  380 U2=X2+K1:V2=Y2+K2
  390 PROCline(U1,V1,U2,V2,illum)
  400 ENDPROC
  410 DEF PROCline(X1,Y1,X2,Y2,illum)
  420 GCOL 0,1
  430 M=(Y2-Y1)/(X2-X1)
  440 C=Y1-M*X1
  450 dist=SQR((X1-X2)^2+(Y2-Y1)^2)
  460 dots=dist*illum
  470 dx=(X2-X1)/dots
  480 FOR K=1 TO dots
  490   J=X1+K*dx
  500   PLOT 69,J,M*J+C
  510 NEXT K
  520 ENDPROC


P86 PARALLELOGRAM


Using the routines developed in the previous program we can shade a parallelogram.
COMMANDS

Key in program.
Type RUN.
Follow instructions.

  100 REM Program P86 - Parallelogram
  110 MODE 6
  120 PRINT TAB(5,12) "PARALLELOGRAM"
  130 X=INKEY(100)
  140 CLS
  150 PRINT TAB(0,4)"This program uses the routines"
  160 PRINT "developed in the previous programs "
  170 PRINT "to shade a parallelogram. As pointed "
  180 PRINT "in the description, we can now specify"
  190 PRINT "illumination in two directions to "
  200 PRINT "produce variable shading."
  210 PRINT ''"To draw the parallelogram we need to"
  220 PRINT "know the generating vector position and"
  230 PRINT "the distance to be traversed in both"
  240 PRINT "the X and Y directions"
  250  
  260 INPUT '"Enter the first end point of the line  (X1,Y1)
",X1,Y1
  270 INPUT "Enter the second end point of the line  (X2,Y2)
",X2,Y2
  280 INPUT "Enter the X-illumination constant ",I1
  290 INPUT "Enter the Y-illumination constant ",I2
  300 INPUT "Enter the X-direction movement " K1
  310 INPUT "Enter the Y-direction movement " K2
  320 MODE 0
  330 VDU 29,640;512;
  340 PROCparm(X1,Y1,X2,Y2,K1,K2,I1,I2)
  350 END
  360 DEF PROCtranslate(X1,Y1,X2,Y2,K1,K2,illum)
  370 U1=X1+K1:V1=Y1+K2
  380 U2=X2+K1:V2=Y2+K2
  390 PROCline(U1,V1,U2,V2,illum)
  400 ENDPROC
  410 DEF PROCline(X1,Y1,X2,Y2,illum)
  420 GCOL 0,1
  430 M=(Y2-Y1)/(X2-X1)
  440 C=Y1-M*X1
  450 dist=SQR((X1-X2)^2+(Y2-Y1)^2)
  460 dots=dist*illum
  470 dx=(X2-X1)/dots
  480 FOR K=1 TO dots
  490   J=X1+K*dx
  500   PLOT 69,J,M*J+C
  510 NEXT K
  520 ENDPROC
  530 DEF PROCparm(X1,Y1,X2,Y2,K1,K2,I1,I2)
  540 PROCline(X1,Y1,X2,Y2,I1)
  550 length=SQR(K1*K1+K2*K2)
  560 lines=length*I2
  570 dK1=K1/lines
  580 dK2=K2/lines
  590 FOR L=1 TO lines
  600   PROCtranslate(X1,Y1,X2,Y2,L*dK1,L*dK2,I1)
  610 NEXT L
  620 ENDPROC


P87 Drawing Circles


When using the ELECTRON you have to make decisions when making up graphics. For example, if you wish to draw a circle you could draw it using:

short line segments
solid triangles
orshading a disc using dots.

This program shows the user all three methods of drawing circles.

COMMANDS

Key in program.
Type RUN.
Select routine from menu.

  100 REM Program P87 - Circles
  110 MODE6
  120 PRINT TAB(15,10) "CIRCLES"
  130 X=INKEY(100)
  140 REPEAT
  150   CLS
  160   PRINT '''"This program shows the various ways "
  170   PRINT "we can draw circles with the ELECTRON"
  180   PRINT ''"1. Short line segmets round the edge"
  190   PRINT ''"2. Solid disc using triangles"
  200   PRINT ''"3. Shaded circle using dots"
  210   PRINT ''"This program shows all 3 methods"
  220   REPEAT
  230     INPUT "Enter choice "C
  240   UNTIL C=1 OR C=2 OR C=3
  250   MODE 0
  260   VDU 29,640;512;
  270   IF C=1 THEN PROCc1
  280   IF C=2 THEN PROCc2
  290   IF C=3 THEN PROCc3
  300   MODE 6
  310   PRINT '''"Do you wish to see another ";
  320   INPUT resp$
  330 UNTIL LEFT$(resp$,1)<>"y" AND LEFT$(resp$,1)<>"Y"
  340 END
  345  
  350 DEF PROCc1
  360 INPUT "What is the radius of your circle "R
  370 GCOL 0,1
  380 MOVE R,0
  390 P=0
  400 REPEAT
  410   P=P+.1
  420   DRAW R*COS(P),R*SIN(P)
  430 UNTIL P>PI*2
  440 PRINT TAB(0,30)"PRESS ANY KEY TO CONTINUE"
  450 Z=GET
  460 ENDPROC
  465  
  470 DEF PROCc2
  480 INPUT "What is the radius of your circle "R
  490 GCOL 0,1
  500 MOVE R,0
  510 A=0
  520 REPEAT
  530   MOVE 0,0
  540   PLOT 85,R*COS(A),R*SIN(A)
  550   A=A+.1
  560   PLOT 85,R*COS(A),R*SIN(A)
  570   A=A+.1
  580 UNTIL A>2*PI+.01
  590 PRINT TAB(0,30)"PRESS ANY KEY TO CONTINUE"
  600 Z=GET
  610 ENDPROC
  620 DEF PROCc3
  630 INPUT "What is the radius of your circle "R
  640 INPUT "What is the illumination constant "illum
  650 length=2*R
  660 lines=length*illum
  670 DX=2*R/lines
  680 X=R+DX
  690 REPEAT
  700   X=X-DX
  710   T=R*R-X*X
  720   IF T>0 THEN Y=SQR(T) ELSE Y=0
  730   PROCline(X,Y,illum)
  740 UNTIL X<-R
  750 PRINT TAB(0,30)"PRESS ANY KEY TO CONTINUE"
  760 Z=GET
  770 ENDPROC
  775  
  780 DEF PROCline(X1,Y1,illum)
  790 GCOL 0,1
  800 dist=2*Y1
  810 dots=dist*illum
  820 IF dots=0 THEN dots=1
  830 dy=2*Y1/dots
  840 FOR K=1 TO dots
  850   J=-Y1+K*dy
  860   PLOT 69,X1,J
  870 NEXT K
  880 ENDPROC


P88 Shape Grabber


Line drawings can be recorded as an array of points. For example, a square has 4 points joined by straight lines.


The array A is known as a matrix. Using matrix arithmetic it is possible to represent many transformations in the plane. Matrix arithmetic involves some secondary school mathematics.

At this point, unfortunately, we must stop using the ELECTRON procedure, since we cannot pass arrays to procedures.

This program develops a shape drawing routine.

COMMANDS

Key in program
Type RUN.
Follow instructions.


100 REM Program P88 - Shape Grabber 110 MODE 6 120 PRINT TAB(15,10)"SHAPE GRABBER" 130 X=INKEY(100) 140 CLS 150 PRINT '''"This prgram is used to draw shapes in" 160 PRINT "MODE 0. The shape is recorded as an" 170 PRINT "array of points, which when joined" 180 PRINT "together form a line drawing. " 190 PRINT '"However, when using arrays we have the" 200 PRINT "problem that the ELECTRON cannot" 210 PRINT "pass arrays to procedures. Therefore," 220 PRINT "we have not written this program" 230 PRINT "using procedures. The routine can of" 240 PRINT "course be used as a subroutine within" 250 PRINT "other programs." 260 PRINT '"Note that the order in which the points" 270 PRINT "are drawn is important." 280 PRINT ''"PRESS ANY KEY TO CONTINUE" 290 X=GET 300 REPEAT 310 MODE 0 320 VDU 29,640;512; 330 VDU 28,0,7,15,0 340 PRINT "SHAPE DRAWING ROUTINE" 350 PRINT "Enter number of points in shape" 360 INPUT N 370 DIM S(2,N) 380 PRINT "Enter the"'"coordinates of points in shape" 390 PRINT "POINT 1 X,Y" 400 INPUT S(1,1),S(2,1) 410 MOVE S(1,1),S(2,1) 420 FOR I=2 TO N 430 PRINT "POINT ";I;" X,Y" 440 INPUT S(1,I),S(2,I) 450 DRAW S(1,I),S(2,I) 460 NEXT I 470 DRAW S(1,1),S(2,1) 480 CLS 490 PRINT "SHAPE OK (Y/N)"; 500 INPUT resp$ 510 UNTIL LEFT$(resp$,1)="y" OR LEFT$(resp$,1)="Y" 520 VDU 26 530 PRINT" " 540 END


P89 Rotation


This program shows a user defined shape being rotated about the origin PI/2 radians at a time.

A rotation of PI/2 radians about the origin maps any point (a,b) to the corresponding point (-b,a)

(a,b)   (-b,a)

If we write the point (a,b) as a vector then we have

   

This mapping is achieved by multiplying the vector by the matrix

that is

Thus if we have a shape held as an array or matrix we can compute the new co-ordinates by simply performing a matrix multiplication.

This program allows the user to enter a shape and to then transform it using a selection of transformations, interactively.

COMMANDS

Key in program.
Type RUN.
Follow instructions.


100 REM Program P89 - Rotation 110 MODE 6 120 PRINT TAB(10,10)"ROTATION " 130 X=INKEY(100) 140 CLS 150 PRINT ''"This program first of all allows the" 160 PRINT "user to enter a shape, the shape is" 170 PRINT "then rotated about the origin through" 180 PRINT "ninety degrees. The rotation can be" 190 PRINT "repeated." 200 PRINT '''"PRESS ANY KEY TO CONTINUE" 210 X=GET 220 MODE 0 230 VDU 29,640;512; 240 GOSUB 380: REM get shape 250 VDU 29,640;512; 260 DIM NS(2,N) 270 CLS 280 GOSUB 650: REM Draw shape anew 290 REPEAT 300 GOSUB 740: REM Compute new shape 310 FOR I=1 TO N 320 S(1,I)=NS(1,I):S(2,I)=NS(2,I) 330 NEXT I 340 GOSUB 650 : REM Draw the rotated shape 350 PRINT TAB(0,30) "PRESS ANY KEY FOR NEXT ROTATION" 360 X=GET 370 UNTIL 0 380 REM Shape grabbing routine 390 REPEAT 400 MODE 0 410 VDU 29,640;512; 420 VDU 28,0,7,15,0 430 PRINT "SHAPE DRAWING ROUTINE" 440 PRINT "Enter number of points in shape" 450 INPUT N 460 DIM S(2,N) 470 PRINT "Enter the"'"coordinates of points in shape" 480 PRINT "POINT 1 X,Y" 490 INPUT S(1,1),S(2,1) 500 MOVE S(1,1),S(2,1) 510 FOR I=2 TO N 520 PRINT "POINT ";I;" X,Y" 530 INPUT S(1,I),S(2,I) 540 DRAW S(1,I),S(2,I) 550 NEXT I 560 DRAW S(1,1),S(2,1) 570 CLS 580 PRINT "SHAPE OK (Y/N)"; 590 INPUT resp$ 600 UNTIL LEFT$(resp$,1)="y" OR LEFT$(resp$,1)="Y" 610 VDU 26 620 PRINT" " 630 RETURN 640 650 REM Shape drawing subroutine 660 REM shape held in array S(2,N) 670 MOVE S(1,1),S(2,1) 680 FOR I=2 TO N 690 DRAW S(1,I),S(2,I) 700 NEXT I 710 DRAW S(1,1),S(2,1) 720 RETURN 730 740 REM Rotation subroutine 750 REM old shape held in array S(2,N) 760 REM new shape to be held in NS(2,N) 770 FOR I=1 TO N 780 NS(1,I)=-S(2,I) 790 NS(2,I)=S(1,I) 800 NEXT I 810 RETURN


P90 Transformations


This program allows the user to, first of all, enter a shape using the shape grabber routine. The user can then study the effects of various transformations interactively.

COMMANDS

Key in programs.
Type RUN.
Follow instructions.


  100 REM Program P90 - Transformations
  110 MODE 6
  120 PRINT TAB(10,10) "TRANSFORMATIONS"
  130 X=INKEY(100)
  140 CLS
  150 PRINT ''"This program first of all allows the"
  160 PRINT "user to enter a shape, the user then"
  170 PRINT "chooses which transformation to put"
  180 PRINT "the shape through. The choices are :"
  190 PRINT '''"I - identity   R - Reflection in Y-X"
  200 PRINT "H - Half turn  X - Reflection in x-axis"
  210 PRINT "Q - Quarter    Y - Reflection in y-axis"
  220 PRINT "    turn       B - Back quarter turn"
  230 PRINT '''"PRESS ANY KEY TO CONTINUE"
  240 X=GET
  250 MODE 0
  260 VDU 29,640;512;
  270 GOSUB 490: REM get shape
  280 VDU 29,640;512;
  290 DIM NS(2,N),T(2,2)
  300 CLS
  310 GOSUB 760: REM Draw shape anew
  320 REPEAT
  330   PRINT TAB(0,30) "PRESS FROM 'IRHXQYB' TO CONTINUE"
  340   X$=GET$
  350   X=INSTR("IRHXQYB",X$)
  360   RESTORE X*10+1030
  370   FOR I=1 TO 2
  380     FOR J=1 TO 2
  390       READ T(I,J)
  400     NEXT J
  410   NEXT I
  420   GOSUB 850: REM Compute new shape
  430   GOSUB 930 : REM Undraw old shape
  440   FOR I=1 TO N
  450     S(1,I)=NS(1,I):S(2,I)=NS(2,I)
  460   NEXT I
  470   GOSUB 760 : REM Draw the rotated shape
  480 UNTIL 0
  490 REM Shape grabbing routine
  500 REPEAT
  510   MODE 0
  520   VDU 29,640;512;
  530   VDU 28,0,7,15,0
  540   PRINT "SHAPE DRAWING   ROUTINE"
  550   PRINT "Enter number of points in shape"
  560   INPUT N
  570   DIM S(2,N)
  580   PRINT "Enter the"'"coordinates of  points in shape"
  590   PRINT "POINT 1 X,Y"
  600   INPUT S(1,1),S(2,1)
  610   MOVE S(1,1),S(2,1)
  620   FOR I=2 TO N
  630     PRINT "POINT ";I;" X,Y"
  640     INPUT S(1,I),S(2,I)
  650     DRAW S(1,I),S(2,I)
  660   NEXT I
  670   DRAW S(1,1),S(2,1)
  680   CLS
  690   PRINT "SHAPE OK (Y/N)";
  700   INPUT resp$
  710 UNTIL LEFT$(resp$,1)="y" OR LEFT$(resp$,1)="Y"
  720 VDU 26
  730 PRINT"                     "
  740 RETURN
  750  
  760 REM Shape drawing subroutine
  770 REM shape held in array S(2,N)
  780 MOVE S(1,1),S(2,1)
  790 FOR I=2 TO N
  800   DRAW S(1,I),S(2,I)
  810 NEXT I
  820 DRAW S(1,1),S(2,1)
  830 RETURN
  840  
  850 REM Rotation subroutine
  860 REM old shape held in array S(2,N)
  870 REM new shape to be held in NS(2,N)
  880 FOR I=1 TO N
  890   NS(1,I)=T(1,1)*S(1,I)+T(1,2)*S(2,I)
  900   NS(2,I)=T(2,1)*S(1,I)+T(2,2)*S(2,I)
  910 NEXT I
  920 RETURN
  930  
  940 REM Undraw old shape
  950 GCOL 0,0
  960 MOVE S(1,1),S(2,1)
  970 FOR I=2 TO N
  980   DRAW S(1,I),S(2,I)
  990 NEXT I
 1000 DRAW S(1,1),S(2,1)
 1010 GCOL 0,1
 1020 RETURN
 1030 REM DATA for transformations
 1040 DATA 1,0,0,1   : REM IDENTITY
 1050 DATA 0,1,1,0   : REM REFLECTION IN Y=X
 1060 DATA -1,0,0,-1 : REM HALF TURN ABOUT 0
 1070 DATA 1,0,0,-1  : REM REFLECTION IN X-AXIS
 1080 DATA 0,-1,1,0  : REM ROTATION OF PI/2 ABOUT 0
 1090 DATA -1,0,0,1  : REM REFLECTION IN Y-AXIS
 1100 DATA 0,1,-1,0  : REM ROTATION OF -PI/2 ABOUT 0
 1110 REM END OF DATA


P91 General Transformation


This program allows the user to specify a shape, and then rotate that shape through a given angle.

COMMANDS

Key in program.
Type RUN.
Follow instructions.

  100 REM Program P91 - General Transformation
  110 MODE 6
  120 PRINT TAB(10,10) "GENERAL TRANSFORMATION"
  130 X=INKEY(100)
  140 CLS
  150 PRINT ''"This program first of all allows the"
  160 PRINT "user to enter a shape, the user then"
  170 PRINT " enters the angle of rotation of the"
  180 PRINT "trnasformation to be executed."
  190 PRINT '''"PRESS ANY KEY TO CONTINUE"
  200 X=GET
  210 MODE 0
  220 VDU 29,640;512;
  230 GOSUB 380: REM get shape
  240 VDU 29,640;512;
  250 DIM NS(2,N),T(2,2)
  260 CLS
  270 GOSUB 650: REM Draw shape anew
  280 REPEAT
  290   PRINT TAB(0,30) "ENTER ROTATION ANGLE (RADIANS) ";:I
NPUT theta
  300   PRINT TAB(0,30) STRING$(40," ");
  310   GOSUB 740: REM Compute new shape
  320   GOSUB 840 : REM Undraw old shape
  330   FOR I=1 TO N
  340     S(1,I)=NS(1,I):S(2,I)=NS(2,I)
  350   NEXT I
  360   GOSUB 650 : REM Draw the rotated shape
  370 UNTIL 0
  380 REM Shape grabbing routine
  390 REPEAT
  400   MODE 0
  410   VDU 29,640;512;
  420   VDU 28,0,7,15,0
  430   PRINT "SHAPE DRAWING   ROUTINE"
  440   PRINT "Enter number of points in shape"
  450   INPUT N
  460   DIM S(2,N)
  470   PRINT "Enter the"'"coordinates of  points in shape"
  480   PRINT "POINT 1 X,Y"
  490   INPUT S(1,1),S(2,1)
  500   MOVE S(1,1),S(2,1)
  510   FOR I=2 TO N
  520     PRINT "POINT ";I;" X,Y"
  530     INPUT S(1,I),S(2,I)
  540     DRAW S(1,I),S(2,I)
  550   NEXT I
  560   DRAW S(1,1),S(2,1)
  570   CLS
  580   PRINT "SHAPE OK (Y/N)";
  590   INPUT resp$
  600 UNTIL LEFT$(resp$,1)="y" OR LEFT$(resp$,1)="Y"
  610 VDU 26
  620 PRINT"                     "
  630 RETURN
  640  
  650 REM Shape drawing subroutine
  660 REM shape held in array S(2,N)
  670 MOVE S(1,1),S(2,1)
  680 FOR I=2 TO N
  690   DRAW S(1,I),S(2,I)
  700 NEXT I
  710 DRAW S(1,1),S(2,1)
  720 RETURN
  730  
  740 REM Rotation subroutine
  750 REM old shape held in array S(2,N)
  760 REM new shape to be held in NS(2,N)
  770 REM angle of rotation theta
  780 sint=SIN(theta) : cost=COS(theta)
  790 FOR I=1 TO N
  800   NS(1,I)=cost*S(1,I)-sint*S(2,I)
  810   NS(2,I)=sint*S(1,I)+cost*S(2,I)
  820 NEXT I
  830 RETURN
  840  
  850 REM Undraw old shape
  860 GCOL 0,0
  870 MOVE S(1,1),S(2,1)
  880 FOR I=2 TO N
  890   DRAW S(1,I),S(2,I)
  900 NEXT I
  910 DRAW S(1,1),S(2,1)
  920 GCOL 0,1
  930 RETURN


P92 3D Rotation - 1


The object of this program is to rotate a 2-D shape in the plane of the screen. As before, the shape will be held in a matrix, which will then be multiplied by an appropriate rotation matrix and the new shape drawn.

The shape chosen is a regular polygon. (Note that in the limit the polygon becomes a circle.)

The polygon is centred at the point x0, y0, z0 and has NS sides.

COMMANDS

Key in program.
Type RUN.
Follow instructions.


  100 REM Program P92 - 3D Rotation - 1
  110 MODE 6
  120 PRINT TAB(10,10) "3D ROTATION - 1"
  130 PRINT TAB(11,12) "ABOUT Y-AXIS"
  140 X=INKEY(100)
  150 CLS
  160 PRINT '''"The object of this program is to form"
  170 PRINT "a three dimensional shape by rotating"
  180 PRINT "a two dimensional object in the plane"
  190 PRINT "of the screen. The coordinates of the"
  200 PRINT "shape are held in the array S(3,50)."
  210 PRINT "Note that the two dimensional shape "
  220 PRINT "has a maximum of 50 sides. The shape"
  230 PRINT "is a polygon, and a polygon with 50"
  240 PRINT "sides is almost a circle, so in the"
  250 PRINT "limit we will form a sphere."
  260 PRINT'''"The polygon is centred at the origin"
  270 PRINT "and has N sides."
  280 PRINT ''"PRESS ANY KEY TO CONTINUE"
  290 X=GET
  300 CLS
  310 DIM S(3,50),NS(3,50),C(3,3)
  320 INPUT '"Enter Polygon Radius ",R
  330 INPUT '"Enter number of sides ",N
  340 INPUT '"Enter x-axis rotation (degs) "beta
  350 beta=RAD(beta)
  360 MODE 0
  370 VDU 29,640;512;
  380 theta=beta
  390 PROCrotation_y
  400 PROCshape
  410 PROCdraw
  420 REPEAT
  430   PROCnew_view
  440   PROCdraw
  450   theta=theta+beta
  460 UNTIL theta>PI*2
  470 END
  480  
  490 DEF PROCshape
  500 dalpha=2*PI/N
  510 alpha=-dalpha
  520 FOR I=1 TO N
  530   alpha=alpha+dalpha
  540   S(1,I)=R*COS(alpha)
  550   S(2,I)=R*SIN(alpha)
  560   S(3,I)=0
  570 NEXT I
  580 ENDPROC
  590  
  600 DEF PROCnew_view
  610 FOR I=1 TO N
  620   NS(1,I)=S(1,I)*C(1,1)+S(2,I)*C(2,1)+S(3,I)*C(3,1)
  630   NS(2,I)=S(2,I)*C(1,2)+S(2,I)*C(2,2)+S(3,I)*C(3,2)
  640   NS(3,I)=S(1,I)*C(1,3)+S(2,I)*C(2,3)+S(3,I)*C(3,3)
  650 NEXT I
  660 FOR J=1 TO N
  670   FOR K=1 TO 3
  680     S(K,J)=NS(K,J)
  690   NEXT K
  700 NEXT J
  710 ENDPROC
  720  
  730 DEF PROCdraw
  740 MOVE S(1,1),S(2,1)
  750 FOR I=2 TO N
  760   DRAW S(1,I),S(2,I)
  770 NEXT I
  780 DRAW S(1,1),S(2,1)
  790 ENDPROC
  800  
  810 DEF PROCrotation_y
  820 C(1,1)=COS(theta)
  830 C(1,2)=0
  840 C(1,3)=-SIN(theta)
  850 C(2,1)=0
  860 C(2,2)=1
  870 C(2,3)=0
  880 C(3,1)=SIN(theta)
  890 C(3,2)=0
  900 C(3,3)=COS(theta)
  910 ENDPROC


P93 3D Rotation - 2


This program allows the user to enter a polygon and to rotate it about the x-axis.

COMMANDS

Key in program.
Type RUN.
Follow instructions.


  100 REM Program P93 - 3D Rotation - 2
  110 MODE 6
  120 PRINT TAB(10,10) "3D ROTATION - 2"
  130 PRINT TAB(11,12) "ABOUT X-AXIS"
  140 X=INKEY(100)
  150 CLS
  160 PRINT '''"The object of this program is to form"
  170 PRINT "a three dimensional shape by rotating"
  180 PRINT "a two dimensional object in the plane"
  190 PRINT "of the screen. The coordinates of the"
  200 PRINT "shape are held in the array S(3,50)."
  210 PRINT "Note that the two dimensional shape "
  220 PRINT "has a maximum of 50 sides. The shape"
  230 PRINT "is a polygon, and a polygon with 50"
  240 PRINT "sides is almost a circle, so in the"
  250 PRINT "limit we will form a sphere."
  260 PRINT'''"The polygon is centred at the origin"
  270 PRINT "and has N sides."
  280 PRINT ''"PRESS ANY KEY TO CONTINUE"
  290 X=GET
  300 CLS
  310 DIM S(3,50),NS(3,50),C(3,3)
  320 INPUT '"Enter Polygon Radius ",R
  330 INPUT '"Enter number of sides ",N
  340 INPUT '"Enter y-axis rotation (degs) "beta
  350 beta=RAD(beta)
  360 MODE 0
  370 VDU 29,640;512;
  380 theta=beta
  390 PROCrotation_x
  400 PROCshape
  410 PROCdraw
  420 REPEAT
  430   PROCnew_view
  440   PROCdraw
  450   theta=theta+beta
  460 UNTIL theta>PI*2
  470 END
  480  
  490 DEF PROCshape
  500 dalpha=2*PI/N
  510 alpha=-dalpha
  520 FOR I=1 TO N
  530   alpha=alpha+dalpha
  540   S(1,I)=R*COS(alpha)
  550   S(2,I)=R*SIN(alpha)
  560   S(3,I)=0
  570 NEXT I
  580 ENDPROC
  590  
  600 DEF PROCnew_view
  610 FOR I=1 TO N
  620   NS(1,I)=S(1,I)*C(1,1)+S(2,I)*C(2,1)+S(3,I)*C(3,1)
  630   NS(2,I)=S(2,I)*C(1,2)+S(2,I)*C(2,2)+S(3,I)*C(3,2)
  640   NS(3,I)=S(1,I)*C(1,3)+S(2,I)*C(2,3)+S(3,I)*C(3,3)
  650 NEXT I
  660 FOR J=1 TO N
  670   FOR K=1 TO 3
  680     S(K,J)=NS(K,J)
  690   NEXT K
  700 NEXT J
  710 ENDPROC
  720  
  730 DEF PROCdraw
  740 MOVE S(1,1),S(2,1)
  750 FOR I=2 TO N
  760   DRAW S(1,I),S(2,I)
  770 NEXT I
  780 DRAW S(1,1),S(2,1)
  790 ENDPROC
  800  
  810 DEF PROCrotation_x
  820 C(1,1)=1
  830 C(1,2)=0
  840 C(1,3)=0
  850 C(2,1)=0
  860 C(2,2)=COS(theta)
  870 C(2,3)=SIN(theta)
  880 C(3,1)=0
  890 C(3,2)=-SIN(theta)
  900 C(3,3)=COS(theta)
  910 ENDPROC


P94 Perspective


Most people will remember from school days about perspective. The method I remember is to locate a vanishing point, and all parallel lines should converge to that point.
From the above figure it is seen that we have to find the intersection of a line drawn between a point on the object and the view point and the image plane. Normally, we consider the view screen to be the Z=0 plane.

Normally, we do not wish to view from (0,0,0) and with an image plane at Z=K. We will normally have an arbitrary view point (Vx,Vy,Vz) and use the plane Z=0 as the image plane.

The algorithm to find the co-ordinates of an image point is then:

1Rewrite the co-ordinates of the point with respect to the view point
(X,Y,Z)(X-Vx,X-Vy,X-Vz)
=(Px,Py,Pz)
2Calculate the co-ordinates of the projection in the plane Z=-Vz
Qx = -Vz/Pz * Px
Qy = -Vz/Pz * Py
Qz = -Vz
3Rewrite the co-ordinates with respect to the old co-ordinates
(Qx,Qy,Qz)(Qx + Vx,Qx + Vy,Qx + Vz)
= (-Vz/Pz*Px + Vx , -Vz/Pz*Py + Vy , 0)

Draw your shape at the new co-ordinates.

This program uses the above theory to implement a perspective routine.

COMMANDS
Key in program
Type RUN.
Follow instructions.


100 REM Program P94 - Perspective 110 MODE 6 120 PRINT TAB(10,10) "PERSPECTIVE" 130 X=INKEY(100) 140 CLS 150 PRINT '''"This program shows a figure first of" 160 PRINT "all without considering perspective" 170 PRINT "then after the user requests, the" 180 PRINT "figure in perspective." 190 PRINT '"The figure chosen is a line drawing of" 200 PRINT "a house." 210 PRINT ''"PRESS ANY KEY TO CONTINUE" 220 X=GET 230 CLS 240 DIM H(10,3), s(10,3), p(10,3) 250 FOR I=1 TO 10 260 FOR J=1 TO 3 270 READ H(I,J):s(I,J)=H(I,J) 280 NEXT J 290 NEXT I 300 310 DATA 0,0,-200,100,0,-200,100,80,-200,50,100 320 DATA -200,0,80,-200,0,0,-50,100,0,-50,100 330 DATA 80,-50,50,100,-50,0,80,-50 340 350 MODE 0 360 VDU 29,640;512; 370 PROChouse 380 390 REPEAT 400 INPUT "View point (x,y,z) " vx,vy,vz 410 CLS 420 430 FOR I=1 TO 10 440 PROCpers(s(I,1),s(I,2),s(I,3)) 450 p(I,1)=qx:p(I,2)=qy:p(I,3)=0 460 NEXT I 470 480 FOR I=1 TO 10 490 FOR J=1 TO 3 500 H(I,J)=p(I,J) 510 NEXT J 520 NEXT I 530 540 PROChouse 550 PRINT TAB(0,30) "ANOTHER VIEW (Y/N) "; 560 INPUT resp$ 570 UNTIL LEFT$(resp$,1)="n" OR LEFT$(resp$,1)="N" 580 END 590 600 DEF PROChouse 610 REM Draws house held in array h(I,J) 620 MOVE H(1,1),H(1,2) 630 FOR J=2 TO 5 640 DRAW H(J,1),H(J,2) 650 NEXT J 660 DRAW H(1,1),H(1,2) 670 REM next draw back of the house 680 MOVE H(6,1),H(6,2) 690 FOR J=7 TO 10 700 DRAW H(J,1),H(J,2) 710 NEXT 720 DRAW H(6,1),H(6,2) 730 REM next join the back to the front 740 MOVE H(6,1),H(6,2) 750 DRAW H(1,1),H(1,2) 760 MOVE H(10,1),H(10,2) 770 DRAW H(5,1),H(5,2) 780 MOVE H(9,1),H(9,2) 790 DRAW H(4,1),H(4,2) 800 MOVE H(8,1),H(8,2) 810 DRAW H(3,1),H(3,2) 820 MOVE H(7,1),H(7,2) 830 DRAW H(2,1),H(2,2) 840 ENDPROC 850 860 DEF PROCpers(X,Y,Z) 870 PX=X-vx 880 PY=Y-vy 890 PZ=Z-vz 900 R=-vz/PZ 910 qx=R*PX+vx 920 qy=R*PY+vy 930 ENDPROC


P95 Rotating House


Using the techniques developed in the previous program we can develop a program to show an object continuously rotating about the origin. This program shows a house.

COMMANDS

Key in program.
Type RUN.


  100 REM Program P95 - Rotating House
  110 MODE 6
  120 PRINT TAB(10,10) "ROTATING HOUSE"
  130 X=INKEY(100)
  140 CLS
  150 DIM H(10,3), s(10,3), p(10,3), C(3,3)
  160 FOR I=1 TO 10
  170   FOR J=1 TO 3
  180     READ H(I,J):s(I,J)=H(I,J)
  190   NEXT J
  200 NEXT I
  210  
  220 DATA 0,0,-200,100,0,-200,100,80,-200,50,100
  230 DATA -200,0,80,-200,0,0,-50,100,0,-50,100
  240 DATA 80,-50,50,100,-50,0,80,-50
  250  
  260 MODE 0
  270 VDU 29,640;512;
  280 PROChouse
  290 vx=500:vy=500:vz=500 : REM View point
  300 PROCrotation
  310 REPEAT
  320   B=INKEY(50)
  330   CLS
  340   FOR I=1 TO 10
  350     PROCpers(s(I,1),s(I,2),s(I,3))
  360     p(I,1)=qx:p(I,2)=qy:p(I,3)=0
  370   NEXT I
  380   FOR I=1 TO 10
  390     FOR J=1 TO 3
  400       H(I,J)=p(I,J)
  410     NEXT J
  420   NEXT I
  430   PROChouse
  440   PROCrotate
  450 UNTIL 0
  460 END
  470  
  480 DEF PROChouse
  490 REM Draws house held in array h(I,J)
  500 MOVE H(1,1),H(1,2)
  510 FOR J=2 TO 5
  520   DRAW H(J,1),H(J,2)
  530 NEXT J
  540 DRAW H(1,1),H(1,2)
  550 REM next draw back of the house
  560 MOVE H(6,1),H(6,2)
  570 FOR J=7 TO 10
  580   DRAW H(J,1),H(J,2)
  590 NEXT
  600 DRAW H(6,1),H(6,2)
  610 REM next join the back to the front
  620 MOVE H(6,1),H(6,2)
  630 DRAW H(1,1),H(1,2)
  640 MOVE H(10,1),H(10,2)
  650 DRAW H(5,1),H(5,2)
  660 MOVE H(9,1),H(9,2)
  670 DRAW H(4,1),H(4,2)
  680 MOVE H(8,1),H(8,2)
  690 DRAW H(3,1),H(3,2)
  700 MOVE H(7,1),H(7,2)
  710 DRAW H(2,1),H(2,2)
  720 ENDPROC
  730  
  740 DEF PROCpers(X,Y,Z)
  750 PX=X-vx
  760 PY=Y-vy
  770 PZ=Z-vz
  780 R=-vz/PZ
  790 qx=R*PX+vx
  800 qy=R*PY+vy
  810 ENDPROC
  820  
  830 DEFPROCrotate
  840 FOR I=1 TO 10
  850   X=C(1,1)*s(I,1)+C(2,1)*s(I,2)+C(3,1)*s(I,3)
  860   Y=C(1,2)*s(I,1)+C(2,2)*s(I,2)+C(3,2)*s(I,3)
  870   Z=C(1,3)*s(I,1)+C(2,3)*s(I,2)+C(3,3)*s(I,3)
  880   s(I,1)=X:s(I,2)=Y:s(I,3)=Z
  890 NEXT I
  900 ENDPROC
  910  
  920 DEF PROCrotation
  930 C(1,1)=COS(PI/10)
  940 C(1,2)=0
  950 C(1,3)=-SIN(PI/10)
  960 C(2,1)=0
  970 C(2,2)=1
  980 C(2,3)=0
  990 C(3,1)=SIN(PI/10)
 1000 C(3,2)=0
 1010 C(3,3)=COS(PI/10)
 1020 ENDPROC