Run in FB 3, and click the mouse for a new set of points, and polygon.
Zounds, That's cool. That's Fast. That's Revolutionary. (literally)

I should patent this, given all the other stuff I see out there that is for
no good reason. ;)

This isn't elegant at all in parts, and I don't care. :)

Don't use the longer delays on the larger point sets or you may wait to
regret it.

Robert Covington
7/3/01


// BEGIN  FB 3 Program

// Simple Salesman for FB 3

// Simple Closed Path Polygon maker for Random Points.
// Makes Polygon based on angles from each point to another.
// Sorts distances of perimeters from results to choose the
// best polygon.

// Alteration of Simple Closed Path algorithm
// from Robert Sedgewick book, Algorithms.

// Name derived from the complex problem of solving traveling
// salesman problem of visiting a group of towns in the
// shortest route, only visiting each once.

// *QuickStart* Click Mouse in Window to init new batch.

// Operation:
// Make Random Points
// Pick Point as Base
// Compute Angle To All Others
// Sort Angles To Make Polygon
// Repeat Using All Other Points As Base
// Sort Distance of All Resulting Polygon Perimeters
// Pick Shortest Distance, Plot That Polygon
// Get Nobel Prize
// Ah Cha Cha Cha.

// Use File Choice or "P" key to save points.
// "-" Symbol denotes new minimum found.

// Failure: When lines cross.
// Haven't seen one in the final poly in ages.
// Occurs when angles are the same for two points which happens
// when both are linear with the base point.

// Needs: Check for points along same line from base
// Fix:   Check sort so that in case of matching angles
// sort is altered so that path goes to most outer angle first,
// then to next closest.

// To make a path using normal approach (no other base points)
// choose base using maximum/ minimum Y coordinate typically.
// This can fail if another point shares the same Y however.
// Add/subtract a pad number to base Y to change the angle then.

// Easily converted to FB II
// Any problems, any FB : check/swap INT vs FIX where noted.
// Could be pref dependent depending on your headers.

// © 2000-2001 Robert Covington
// <artlythere@...>

Output file "Simple Salesman"

DIM &&

_maxPts=80// Max array DIM, current is 60 used.

DIM x(_maxPts) as Double
DIM y(_maxPts) as Double 'x y and theta angles

BEGIN RECORD myThetas 'Sort array for Angles, Base -> Test Pt.
DIM thetas as Double
DIM thI as Long
END RECORD

DIM ang(_maxPts) as myThetas

BEGIN RECORD myDist 'Sort array for Poly Distances.
DIM dist as Double
DIM dI as Long
END RECORD

DIM dis(_maxPts) as myDist

DIM mN as INT
DIM MaxN as Int
DIM gQuit as Int
DIM gPoints as INT
DIM gDelay as Long

END GLOBALS

'~'2
'FN could be skipped using ArcTan I believe.
CLEAR LOCAL
LOCAL FN FindTheta#(p1,p2)
DIM i
DIM dx,dy,ax,ay
DIM t as Double
DIM angle as Double

dx=x(p2)-x(p1)
IF dx<0 THEN ax=-dx ELSE ax=dx
dy=y(p2)-y(p1)
IF dy<0 THEN ay=-dy ELSE ay=dy

IF dx=0 AND dy=0 THEN t=0 ELSE t=dy/(ax+ay)
IF dx<0 THEN t = 2-t ELSE IF dy<0 THEN t = 4+t
angle = t*90.0

END FN = angle
'~'1
// Sorts angles of other points to base
'Adapted from FB CombSort example...
CLEAR LOCAL
LOCAL FN SortTheta(N as Int)
DIM testElem as Long
DIM gap as Long
DIM count as Long
DIM switch as Long

gap = N

DO
// Use INT in FB II
gap = FIX (gap \ 1.3)
IF gap < 1 THEN gap = 1
switch = 0
FOR count = 0 TO N - gap
testElem = count + gap
LONG IF ang.thetas(count) > ang.thetas(testElem)
SWAP ang.thetas(count),ang.thetas(testElem)
SWAP ang.thI(count),ang.thI(testElem)
INC (switch)
END IF
NEXT count

UNTIL switch = 0 AND gap = 1

END FN
'~'1
'Adapted from FB CombSort example...
CLEAR LOCAL
LOCAL FN SortDist(N)
DIM as Long testElem,gap
DIM as Long count,switch
N=N
gap = N
DO
// Use INT with FB II
gap = FIX (gap / 1.3)
IF gap < 1 THEN gap = 1
switch = 0
FOR count = 0 TO N - gap
testElem = count + gap
LONG IF dis.dist(count) > dis.dist(testElem)
SWAP dis.dist(count),dis.dist(testElem)
SWAP dis.dI(count),dis.dI(testElem)
INC (switch)
END IF
NEXT count
UNTIL switch = 0 AND gap = 1
END FN
'~'1
CLEAR LOCAL
LOCAL FN RePlotShortLines(N as INT)
DIM &&
DIM  as INT i,base
DIM as Double dx,dy,myDist,cnt

base = dis.dI(0)

COLOR _zBlack
'Fill Window
BOX FILL 0,0 TO 500,400

FOR i=0 TO N
'get current point and start pt angle
ang.thetas(i) = FN FindTheta#(base,i)
'store its "i" for later plot after sort
ang.thI(i)=i
NEXT i

'Sort by angle from smallest to highest.
FN SortTheta(N)

cnt = 0


'Plot the Simple Closed Path Polygon
COLOR _zRed
FOR i= 0 TO N
LONG IF i<N
dx = x(ang.thI(i))-x(ang.thI(i+1))
IF dx < 0 THEN dx = -dx
dy = y(ang.thI(i)) - y(ang.thI(i+1))
IF dy < 0 THEN dy = -dy
XELSE
dx = x(ang.thI(i)) - x(ang.thI(0))
IF dx < 0 THEN dx = -dx
dy = y(ang.thI(i)) - y(ang.thI(0))
IF dy < 0 THEN dy = -dy
END IF
myDist =SQR((dx*dx)+(dy*dy))
cnt = cnt + myDist

NEXT i

LONG IF cnt = dis.dist (0)
FOR i= 0 TO N
LONG IF i<N
PLOT x(ang.thI(i)),y(ang.thI(i)) TO x(ang.thI(i+1)),y(ang.thI(i+1))
XELSE
PLOT x(ang.thI(i)),y(ang.thI(i)) TO x(ang.thI(0)),y(ang.thI(0))
END IF
NEXT i

XELSE
COLOR _zYellow
PRINT "Crossing Lines!"
FOR i= 0 TO N
LONG IF i<N
PLOT x(ang.thI(i)),y(ang.thI(i)) TO x(ang.thI(i+1)),y(ang.thI(i+1))
XELSE
PLOT x(ang.thI(i)),y(ang.thI(i)) TO x(ang.thI(0)),y(ang.thI(0))
END IF
NEXT i

END IF

'Plot the actual Points now.
COLOR _zYellow
FOR i=0 TO N
PLOT x(i),y(i)
NEXT i
Text _Geneva, 9
CALL MOVETO (8,16)
PRINT "Perimeter: ";
Color _zWhite:Print INT(cnt);
Text _Sysfont,12
Color _zBlack

END FN
'~'1
CLEAR LOCAL
LOCAL FN PolyMaker(N as INT)
DIM as INT i,StartPt,k
DIM minDist as Long

minDist = 99999

// Little translations of point to keep away from edges.
FOR i=0 TO N
x(i)=RND(450)+25
y(i)=RND(350)+25
NEXT i

FOR k= 0 TO N
COLOR _zBlack
BOX FILL 0,0 TO 500,400
Long if  k<8
// No black, can't see lines then
If k = 7 then color 4 Else COLOR k
XELSE
if k/8 = _Zblack then COLOR 4 Else Color k/8
End IF

'Skip first point, it is the start point
FOR i=0 TO N
'get current point and start pt angle
ang.thetas(i) = FN FindTheta#(k,i)
'store its "i" for later plot after sort
ang.thI(i)=i
NEXT i

'Sort by angle from smallest to highest.
FN SortTheta(N)

dis.dist(k)=0
DIM as Double dx,dy,myDist

'Plot the Simple Closed Path Polygon
FOR i= 0 TO N
LONG IF i<N
dx = x(ang.thI(i)) - x(ang.thI(i+1))
IF dx < 0 THEN dx = -dx
dy = y(ang.thI(i))-y(ang.thI(i+1))
IF dy < 0 THEN dy = -dy
PLOT x(ang.thI(i)),y(ang.thI(i)) TO x(ang.thI(i+1)),y(ang.thI(i+1))
XELSE
dx=x(ang.thI(i)) - x(ang.thI(0))
IF dx < 0 THEN dx = -dx
dy = y(ang.thI(i)) - y(ang.thI(0))
IF dy < 0 THEN dy = -dy
PLOT x(ang.thI(i)),y(ang.thI(i)) TO x(ang.thI(0)),y(ang.thI(0))
END IF
myDist = SQR((dx*dx)+(dy*dy))
dis.dist(k)=dis.dist(k)+myDist
dis.dI(k)=k

NEXT i

'Plot the actual Points
COLOR _zYellow
FOR i=0 TO N
PLOT x(i),y(i)
NEXT i

Long if gDelay > 0
Text _Geneva, 9
CALL MOVETO (8,16)
COLOR _zRed
if INT(dis.dist(k)) < minDist Then minDist = INT(dis.dist(k))
Long if minDist = INT(dis.dist(k))
PRINT "Perimeter: ";
Color _zWhite:Print INT(dis.dist(k));
Long color 0,65535,0:Print +" -"
Xelse
PRINT "Perimeter: ";INT(dis.dist(k));
End IF
Text _Sysfont,12
End IF

Color _zBlack

// via Menu
Delay gDelay

NEXT k

FN SortDist(mN)
FN RePlotShortLines(mN)

 End FN
'~'1
CLEAR LOCAL
LOCAL FN SavePts(N)
DIM @volRefNum
DIM @fileName$
DIM i as INT
fileName$=FILES$(_fSave,"Save File As...","Points File",volRefNum%)
LONG IF LEN(fileName$)
'set output file type , creator
DEF OPEN "TEXTttxt"
OPEN "R",#1,fileName$,,volRefNum%'Open the file
// # denotes comment in Future Rotater XYZ/OBJ format
PRINT #1,"# Simple Salesman, Artly There Software"
PRINT #1,"# ";N;" Total Points"
PRINT #1, "# Points: "
PRINT #1,
// Write Points
FOR i=0 TO N
PRINT #1, x(i);" , ";y(i);" , 0 "// 0 "z"
NEXT i
// Done with Points
// Write Angles
PRINT #1, "#  Angles "
FOR i=0 TO N
// Angle + sort order
PRINT #1,"# ";ang.thetas(i);" , ";ang.thI(i)
NEXT i
// Done with angles.
// Close File
CLOSE #1
END IF
END FN
'~'1
Local FN PlotANew
COLOR _zBlack
'Fill Window
BOX FILL 0,0 TO 500,400
FN PolyMaker(mN)
End FN

CLEAR LOCAL
LOCAL FN DoMouse
FN PlotANew
END FN
'~'1
CLEAR LOCAL
LOCAL FN doDialog
DIM evnt,id
evnt = DIALOG(0)
id   = DIALOG(evnt)
SELECT evnt
CASE _wndClose
gQuit=_True
CASE _wndRefresh
COLOR _zBlack
'only on first refresh is this needed
PLOT 0,0
FN RePlotShortLines(mN)
CASE _evKey
'112 = "P" key  (US)
IF id=112 THEN FN SavePts(mN)
END SELECT
END FN

Clear Local
LOCAL FN doMenu
DIM menuID%,itemID%, i as int,err as int
DIM result%,nextName$

'get menu id
menuID% = MENU(_menuID)
'get menu item
itemID% = MENU(_itemID)

SELECT menuID%
case 1
Select itemID%
case 1
FN SavePts(mN)
Case 2
gQuit = _True
End Select
case 2
Select itemID%
Case 1
gPoints = 5
cASe 2
gPoints = 10
case 3
gPoints = 15
case 4
gPoints = 25
case 5
gPoints = 35
case 6
gPoints = 60
End Select
DEF CheckOneItem (2,itemID%)
mN = gPoints
FN PlotANew
case 3
Select itemID%
Case 1
gDelay = 0
case 2
gDelay = 40
cASe 3
gDelay = 80
case 4
gDelay = 160
End Select
DEF CheckOneItem (3,itemID%)
ENd Select
menu
End FN

LOCAL FN InitMenus

'File Menu
MENU 1,0, _enable,     "File"
Menu 1,1, _enable,     "Save Points..."
MENU 1,2, _enable,     "Quit/Q"

'How many points
MENU 2,0, _enable,     "Points"
Menu 2,1, _enable,     "5"
MENU 2,2, _CheckMark,  "10"
MENU 2,3, _enable,     "15"
MENU 2,4, _enable,     "25"
MENU 2,5, _enable,     "35"
MENU 2,6, _enable,     "60"


// Allows seeing testing of intermediate polygons
MENU 3,0, _enable,     "Sort Delay"
MENU 3,1, _CheckMark,  "Delay 0"
Menu 3,2, _enable,     "Delay 40"
Menu 3,3, _enable,     "Delay 80"
Menu 3,4, _enable,     "Delay 160"

'
End FN
'******************************************* MAIN
******************************************
"Main"

' Points Variable
DIM  as INT N

' Build Menus
FN InitMenus

gQuit=_False
gDelay = 0
gPoints = 10

' To Avoid array overrun
MaxN=_maxPts-1

' Make Test Window
WINDOW 1,"Simple Salesman",(0,0)-(500,400),_docNoGrow

COLOR _zBlack
BOX FILL 0,0 TO 500,400 'Fill Window

' Set number of test points to build polygon around.
N = gPoints

' Need three points for polygon : 0,1,2 at minumum.
IF N < 2 THEN N=2
' Avoid Array Overrun
IF N > MaxN THEN N = MaxN
'
mN = N

' make good seed for built app.

Random

FN PolyMaker(N)

On Menu FN doMenu
ON MOUSE FN DoMouse

'Kill Dot'th (in)Vader at 0,0
ON DIALOG FN doDialog

DO
HANDLEEVENTS
UNTIL gQuit = _True

// END FB 3 Program