Calculate area of irregular shape

General Computer Utilities
Post Reply
1way

Calculate area of irregular shape

Post by 1way »

I've dozens of BASIC programs I wrote, or found and modified, back in the early 80's. As a thank you for releasing this free BASIC I'll start revising them to work with JustBASIC and post some of them here from time to time.

The next one I post will calculate the size and length of various tube materials to produce wind chimes that are musically tuned, i.e. resonate at a particular frequency. Makes listening to them so much more pleasant.

The little program below calculates the square area of any irregular 2D shape. The program contanins the instructions, here is the code:

10 REM AREA.BAS - Area from X|Y coordinates - 1984-2005 Bill Yotter
20 CLS:PRINT:PRINT
22 PRINT" 2D irregular shape area from X|Y coordinates, 1984-2005 Bill Yotter"
24 PRINT" Program revised from: ZX81 BASIC to GWBASIC to APBASIC to JustBASIC"
26 PRINT""
30 PRINT" Setup:"
40 PRINT""
50 PRINT" Draw a square grid over your shape. The grids size and the"
60 PRINT" number of data points you use will dictate the resolution."
70 PRINT""
80 PRINT" Now enter the X,Y coordinates of the outside diameter of your"
90 PRINT" shape, you may move around the perimeter in either direction."
100 PRINT" Enter 0's as the last set of coordinates to display results."
110 PRINT""
120 A=1:X=1
130 LOCATE 15,15:PRINT "Coordinates #";X;:INPUT " X= ";B:LOCATE 40,15:INPUT " Y= ";C
140 LOCATE 15,15:PRINT " "
150 IF B=0 OR C=0 THEN GOTO 170
160 GOSUB 200:X=X+1:GOTO 130
170 LOCATE 15,16:PRINT"The square area = ";ABS(E);" input units":GOSUB 230
180 LOCATE 15,18:INPUT"Another Caculation ? ";A$
190 IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN 10 ELSE END
200 IF A=1 THEN GOTO 220
210 E=F+G*C-H*B:F=E:G=B:H=C:E=(E+B*J-I*C)*.5:RETURN
220 I=B:J=C:A=0:F=0:E=0:G=B:H=C:RETURN
230 A=0:B=0:C=0:E=0:F=0:G=0:H=0:I=0:J=0:A$="":RETURN

I know it could be cleaned up a little ;) but what the heck, it works!

Bill Yotter - way@1way.ws - www.1way.ws

PS: The forum seems to reduce blank space bewteen quotes in PRINT statements to one. In line 140 add spaces bewteen the " " until the second " moves out even to the end of the line above it.
Stefan Pendl

Post by Stefan Pendl »

Use

Code: Select all

 [code] 
-tags[/code] and it will work :wink:
Post Reply