CLEAR
int k, bc, nc, lc, ast, bsty
double x1, x2, y1, y2, br, a, b, c, an, bn, cn, th, nt, nh, asz, nt2
string ival[1], note2[1]

:begin
READ C:\CADKEY97R2\CDL\balloon, 0, bsty, br, bc, nh, nc, lc, asz, ast
GETMENU "Select option...", "Create", "Config", , , , , , , , 0, 1
IF (@key==2)
   GOTO config
IF (@error==1)
   GOTO end

:start
GETINT "Enter detail number to increment from...", 1, k
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO end

:loop
GETPOS "Select ARROW location...", 1
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO start
IF (@key==-1)
   GOTO end
x1=@xview
y1=@yview
:loop2
GETPOS "Select BALLOON location...", 1
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO loop
IF (@key==-1)
   GOTO loop2
x2=@xview
y2=@yview

a=x2-x1
IF (a==0)
   a=.00001
b=y2-y1
c=sqrt((a*a)+(b*b))
th=atan(b/a)
cn=c-br
an=(cos(th))*cn
bn=(sin(th))*cn

SPRINT $ival, "%d", k
CALL strlen, $ival, nt
IF (nt==1)
   nt=nh*.4
IF (nt==2)
   nt=nh*.8
IF (nt==3)
   nt=nh*1.2
IF (nt==4)
   nt=nh*1.6

IF (a<0)
   GOTO next
SET collect, 1
LEADER (an+x1), (bn+y1), x1, y1, asz, ast, 0, lc, 0, 1, 0, 0, 0
CIRCLE x2, y2, 0, br, 0, bc, 0, 1, 0, 0, 0, 0
IF (bsty==2)
LINE x2-br, y2, 0, x2+br, y2, 0, bc
IF (bsty==1)
NOTE x2-nt, y2-(nh/2), $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0
IF (bsty==2)
NOTE x2-nt, y2-(nh/2)+(br/2)-.02, $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0
IF (bsty==1)
GOTO redo
GETSTR "Enter bottom character...", "1", $note2
CALL strlen, $note2, nt2
IF (nt2==1)
   nt2=nh*.4
IF (nt2==2)
   nt2=nh*.8
IF (nt2==3)
   nt2=nh*1.2
IF (nt2==4)
   nt2=nh*1.6
IF (bsty==2)
NOTE x2-nt2, y2-(nh/2)-(br/2)+.02, $note2, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0
GOTO redo
:next
SET collect, 1
LEADER (x1-an), (y1-bn), x1, y1, asz, ast, 0, lc, 0, 1, 0, 0, 0
CIRCLE x2, y2, 0, br, 0, bc, 0, 1, 0, 0, 0, 0
IF (bsty==2)
LINE x2-br, y2, 0, x2+br, y2, 0, bc
IF (bsty==1)
NOTE x2-nt, y2-(nh/2), $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0
IF (bsty==2)
NOTE x2-nt, y2-(nh/2)+(br/2)-.02, $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0
IF (bsty==1)
GOTO redo
GETSTR "Enter bottom character...", "1", $note2
CALL strlen, $note2, nt2
IF (nt2==1)
   nt2=nh*.4
IF (nt2==2)
   nt2=nh*.8
IF (nt2==3)
   nt2=nh*1.2
IF (nt2==4)
   nt2=nh*1.6
IF (bsty==2)
NOTE x2-nt2, y2-(nh/2)-(br/2)+.02, $note2, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0
:redo
k=k+1
SET collect, 0
GOTO loop

:config
:c1
GETMENU "Select balloon style, or <ENTER>...", "Single", "Split", , , , , , , , 0, 1
IF (@key==1)
   bsty=1
IF (@key==2)
   bsty=2
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO begin
:c2
GETFLT "Select new balloon radius, or <ENTER>...", br, br
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO c1
:c3
GETINT "Select new balloon color (0-15), or <ENTER>...", bc, bc
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO c2
:c4
GETFLT "Select new note height, or <ENTER>...", nh, nh
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO c3
:c5
GETINT "Select new note color (0-15), or <ENTER>...", nc, nc
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO c4
:c6
GETINT "Select new leader color (0-15), or <ENTER>...", lc, lc
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO c5
:c7
GETFLT "Select new arrow size, or <ENTER>...", asz, asz
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO c6
:c8
GETINT "Select new arrow style (1-4), or <ENTER>...", ast, ast
IF (@key==-3)
   GOTO end
IF (@key==-2)
   GOTO c7
WRITE C:\CADKEY97R2\CDL\balloon, 0, bsty, br, bc, nh, nc, lc, asz, ast
GOTO begin

:end
CLEAR
EXIT