The amount of background detail, history and documentation which accompanies this program is phenomenal: nine pages of a carefully-written and elaborate description of the harmonograph, plus the listing. This is followed by five pages of diagrams of two different types of harmonograph, and two pages and three photographs of harmonograph output. There just isn't room in Program File for all this documentation, and since the program is, essentially, concerned with program listings, I decided to concentrate on these.
Just to précis the documentation a little, a harmonograph is a mechanical device for producing abstract drawings. It consists of a large, flat board which can easily be swung in two dimensions. Over this is suspended a pen in such a way that it stays still, relative to the board, but remains in contact. If a sheet of paper is attached to the board and the board is set in motion, the harmonograph draws pleasing patterns made up of elliptical curves. The basic mechanism can be enhanced to produce more complex swinging and so more complex patterns.
The first three procedures in the program are support routines which interface to the Spectrum ROM for plotting points and drawing lines. They have been taken from the Hisoft Pascal Manual. The program produces points along the curve which the harmonograph produces, and joins these by straight lines. The program terminates when dimension or angle limits are reached, unlike the harmonograph itself which stops when friction finally gets the better of it.
It should be pointed out that friction is an important part of the harmonograph and helps to make the drawings more interesting.
The program is based upon the formulae for two swinging pendulums: one describing a rotating, diminishing ellips; the other a diminishing circle.
C4A2 20 {$L+}
C4A2 30
C4A2 40 PROGRAM HARMONOGRAPH;
C4A2 50 {Version 19}
C4A2 60
C4A2 70 {
C4A2 80 Aim - To draw a diminishing circle superimposed on a
C4A2 90 rotating diminishing ellipse.
C4A2 100
C4A2 110 Variable name terminology:-
C4A2 120
C4A2 130 ellip, circ = ellipse, circle.
C4A2 140 len, wid = ellipse length and width.
C4A2 150 rad = circle radius.
C4A2 160 ang = angle.
C4A2 170 axisang = axis angle for rotation.
C4A2 180 incr = increment (-ve = decrement).
C4A2 190 start = starting value.
C4A2 200
C4A2 210 e.g elliplenincr = increment for ellipse length
C4A2 220 to be added at each calculation/plot.
C4A2 230
C4A2 240
C4A2 250
C4A2 260
C4A2 270
C4A2 280 {Switch off run time checks for speed}
C4A2 290 {$O-,S-,A-}
C4A2 300
C4A2 310
C4A2 320
C4A2 330 {-----------------------------------------------------}
C4A2 340 {Constants}
C4A2 350 {-----------------------------------------------------}
C4A2 360 CONST
C4A2 370 {Offset from origin}
C4A2 380 xoffset = 128;
C4A2 390 yoffset = 87;
C4A2 400
C4A2 410
C4A2 420 {Dimension start values}
C4A2 430 elliplenstart = 120;
C4A2 440 ellipwidstart = 20;
C4A2 450 circradstart = 5;
C4A2 460
C4A2 470
C4A2 480 {Angle start values}
C4A2 490 ellipangstart = 1.5;
C4A2 500 circangstart = 1.5;
C4A2 510 axisangstart = 0;
C4A2 520
C4A2 530
C4A2 540 {Dimension increments}
C4A2 550 elliplenincr = -0.08;
C4A2 560 ellipwidincr = -0.01;
C4A2 570 circradincr = -0.001;
C4A2 580
C4A2 590
C4A2 600 {Angle increments}
C4A2 610 ellipangincr = -0.3;
C4A2 620 circangincr = 0.32;
C4A2 630 axisangincr = -0.003;
C4A2 640
C4A2 650
C4A2 660 {Dimension limits}
C4A2 670 elliplenlimit = 20;
C4A2 680 ellipwidlimit = 5;
C4A2 690 circradlimit = 1;
C4A2 700
C4A2 710 {Angle limits (if reqd}
C4A2 720 axisanglimit = -3; {radians}
C4A2 730
C4A2 740
C4A2 750 {-----------------------------------------------------}
C4A2 760 {Variables}
C4A2 770 {-----------------------------------------------------}
C4A2 780 VAR
C4AB 790 {Dimensions}
C4AB 800 elliplen,
C4AB 810 ellipwid,
C4AB 820 circrad : REAL;
C4AB 830
C4AB 840 {Angles}
C4AB 850 ellipang,
C4AB 860 circang,
C4AB 870 axisang : REAL;
C4AB 880
C4AB 890 {Coordinates}
C4AB 900 xold,
C4AB 910 xnew,
C4AB 920 yold,
C4AB 930 ynew : INTEGER;
C4AB 940
C4AB 950
C4AB 960
C4AB 970 {-----------------------------------------------------}
C4AB 980 {Graphics Support Routines (from HISOFT manual}
C4AB 990 {-----------------------------------------------------}
C4AB 1000
C4AB 1010 PROCEDURE drawlinesupport
C4AE 1020 (x, y, signx, signy : INTEGER);
C4AE 1030
C4AE 1040 {
C4AE 1050 Aim - used in conjunction with the LINEDRAW procedure.
C4AE 1060 Machine code sets up Z80 regs &
C4AE 1070 calls Spectrum ROM DRAW routine.
C4AE 1080 }
C4AE 1090
C4AE 1100 BEGIN
C4BE 1110
C4BE 1120 INLINE
C4BE 1130 (
C4BE 1140 #FD,#21,#3A,#5C, {LD IY,#5C3A}
C4C2 1150 #DD,#56,#02, {LD D,(IX+2)}
C4C5 1160 #DD,#5E,#04, {LD E,(IX+4)}
C4C8 1170 #DD,#46,#06, {LD B,(IX+6)}
C4CB 1180 #DD,#4E,#08, {LD C,(IX+8)}
C4CE 1190 #CD,#BA,#24 {CALL #24BA ;ROM DRAW routine}
C4D0 1200 )
C4D1 1210
C4D1 1220 END;
C4DB 1230 {-----------------------------------------------------}
C4DB 1240
C4DB 1250 PROCEDURE drawline (x, y : INTEGER);
C4DE 1260
C4DE 1270 {
C4DE 1280 Aim - To draw a line from the current plot position
C4DE 1290 (CX, CY) to (CX+x, CY+y).
C4DE 1300 (Equivalent to BASIC DRAW command).
C4DE 1310 }
C4DE 1320
C4DE 1330 VAR
C4DE 1340 signx,
C4DE 1350 signy : INTEGER;
C4DE 1360
C4DE 1370
C4DE 1380 BEGIN
C4EB 1390
C4EB 1400 {Calculate sign of x & y}
C4EB 1410 IF x <0 THEN
C502 1420 signx := -1
C506 1430 ELSE
C511 1440 signx := 1;
C51A 1450
C51A 1460 IF y <0 THEN
C531 1470 signy := -1
C535 1480 ELSE
C540 1490 signy := 1;
C549 1500
C549 1510 drawlinesupport(ABS (x), ABS (y), signx, signy)
C56B 1520
C56B 1530 END;
C580 1540 {-----------------------------------------------------}
C580 1550
C580 1560 PROCEDURE plot (x, y : INTEGER);
C583 1570
C583 1580 {
C583 1590 Aim - To plot the specified point (x,y).
C583 1600 Machine code sets up Z80 regs &
C583 1610 calls Spectrum ROM PLOT routine.
C583 1620 (Equivalent to BASIC PLOT command).
C583 1630 }
C583 1640
C583 1650
C583 1660 BEGIN
C593 1670
C593 1680 INLINE
C593 1690 (
C593 1700 #FD,#21,#3A,#5C, {LD IY,#5C3A}
C597 1710 #DD,#46,#02, {LD B,(IX+2)}
C59A 1720 #DD,#4E,#04, {LD C,(IX+2)}
C59D 1730 #CD,#E5,#22 {CALL #22E5 ;ROM PLOT routine}
C59F 1740 )
C5A0 1750
C5A0 1760 END;
C5AA 1770 {-----------------------------------------------------}
C5AA 1780
C5AA 1790
C5AA 1800
C5AA 1810
C5AA 1820
C5AA 1830 {-----------------------------------------------------}
C5AA 1840 {Harmonograph Routines}
C5AA 1850 {-----------------------------------------------------}
C5AA 1860
C5AA 1870 FUNCTION xcalc : INTEGER;
C5AD 1880
C5AD 1890 {
C5AD 1900 Aim - To calculate & return the new value of X.
C5AD 1910 }
C5AD 1920
C5AD 1930 BEGIN
C5BD 1940
C5BD 1950 xcalc := ENTIER (
C5BD 1960 elliplen * COS (ellipang) * COS (axisang) +
C5E4 1970 ellipwid * SIN (ellipang) * SIN (axisang) +
C60E 1980 circrad * COS (circang) +
C629 1990 xoffset)
C634 2000
C634 2010 END;
C641 2020 {-----------------------------------------------------}
C641 2030
C641 2040 FUNCTION ycalc : INTEGER;
C644 2050
C644 2060 {
C644 2070 Aim - To calculate & return the new value of Y.
C644 2080 }
C644 2000
C644 2100 BEGIN
C654 2110
C654 2120 ycalc := ENTIER (
C654 2130 ellipwid * SIN (ellipang) * COS (axisang) +
C67B 2140 elliplen * COS (ellipang) * SIN (axisang) +
C6A9 2150 circrad * SIN (circang) +
C6C4 2160 yoffset)
C6CF 2170
C6CF 2180 END;
C6D8 2190 {-----------------------------------------------------}
C6DC 2200
C6DC 2210 PROCEDURE initialisesizes;
C6DF 2220
C6DF 2230 {
C6DF 2240 Aim - To initialise all dimension & angle sizes
C6DF 2250 to their start values as defined in the CONST
C6DF 2260 section.
C6DF 2270 }
C6DF 2280
C6DF 2290
C6DF 2300 BEGIN
C6EF 2310
C6EF 2320 elliplen := elliplenstart;
C6FC 2330 ellipwid := ellipwidstart;
C709 2340 circrad := circradstart;
C716 2350
C716 2360
C716 2370 ellipang := ellipangstart;
C723 2380 circang := circangstart;
C730 2390 axisang := axisangstart;
C73D 2400
C73D 2410 END;
C743 2420 {-----------------------------------------------------}
C743 2430
C743 2440 PROCEDURE incrementsizes;
C746 2450
C746 2460 {
C746 2470 Aim - To increment dimension & angle sizes by the
C746 2480 values defined in the CONST section.
C746 2490 Sizes can be decreased by using -ve increments.
C746 2500 }
C746 2510
C746 2520 BEGIN
C756 2530
C756 2540 elliplen := elliplen + elliplenincr;
C76F 2550 ellipwid := ellipwid + ellipwidincr;
C788 2560 circrad := circrad + circradincr;
C7A1 2570
C7A1 2580 ellipang := ellipang + ellipangincr;
C7BA 2590 circang := circang + circangincr;
C7D3 2600 axisang := axisang + axisangincr;
C7EC 2610
C7EC 2620 END;
C7F2 2630 {-----------------------------------------------------}
C7F2 2640
C7F2 2650
C7F2 2660 {-----------------------------------------------------}
C7F2 2670 {MAIN PROGRAM BODY}
C7F2 2680 {-----------------------------------------------------}
C7F2 2690
C7F2 2700 BEGIN
C7FB 2710
C7FB 2720 WRITE (CHR (12)); {clear screen}
C802 2730
C802 2740 initialisesizes;
C807 2750
C807 2760 {Calculate & plot 1st point as a reference}
C807 2770 xold := xcalc;
C811 2780 yold := ycalc;
C81B 2790 plot (xold, yold);
C828 2800
C828 2810 WHILE
C82B 2820 {
C82B 2830 Loop until limits reached.
C82B 2840 'Comment-out' checks as reqd. for speed.
C82B 2850 }
C82B 2860 (axisang > axisanglimit)
C84E 2870 {
C84E 2880 AND
C84E 2890 (elliplen > elliplenlimit)
C84E 2900 AND
C84E 2910 (ellipwid > ellipwidlimit)
C84E 2920 AND
C84E 2930 (circrad > circradlimit)
C84E 2940 }
C84E 2950 DO
C851 2960 BEGIN
C851 2970
C851 2980 incrementsizes;
C856 2990
C856 3000 {Calculate new point}
C856 3010 xnew := xcalc;
C860 3020 ynew := ycalc;
C86A 3030
C86A 3040 {Draw line from old point to new}
C86A 3050 drawline (xnew - xold, ynew - yold);
C889 3060
C889 3070 {Transfer new point to old for next time}
C889 3080 xold := xnew;
C88F 3090 yold := ynew;
C895 3100
C895 3110 END;
C898 3120
C898 3130
C898 3140 {
C898 3150 Loop-stop to prevent PASCAL prompt from racking up
C898 3160 the picture & losing the top line!
C898 3170 Can break in using SHIFT+SPACE as normal.
C898 3180 }
C898 3190 WHILE TRUE DO;
C8A4 3200
C8A4 3210 END.
End Address: C88D
Run?