figure generator follow-up [MWForum Archive]

Wow. You guys are waaaay too polite. New to this forum stuff, last week I sent off some CAD-like utilities I'd quickly extracted from one of my projects, along with the cavilier suggestion you clean it up. I soon realized there was zero possibility anybody could actually get it to work. Please accept my beet-faced apologies. I truly hope nobody spent much hair-pulling time with it. What really amazes me is nobody busted me for it. For penance, I have prepared a cleaned-up stand-alone version, along with a setup procedure to get it off on the right footing. It is set up to run in the MW default projectsize, with toolbar, console and narrow procedures tab exposed. I have used comments at the top of the procedures tab to present the menu and notes on its use. So, after you copy the entire thing into the procedures tab, run the tabs scroll bar clear to the top so you can see the menu and notes. First, run SETUP from the console. Run it only once. Next, run FIGURE from the console. You create a figure with mouseclicks in the graphs area. You close both the figure and the FIGURE procedure with a "c" keystroke. You can "donut" a figure with RING :name :num. If you do it immediately after creating a figure, use :fig for :name. But realize :fig changes with each use of FIGURE or RING. So if you want to be keep a figure (in the current session) you should do a: make "somename :fig immediately after creating a figure. You can then RING that figure at any time by using the name you've given it. If anybody has any trouble with this whatsoever, please let me know. ; COMMAND MENU: ;************************* ;FIGURE ******* ;Mode Keys: ;"r" rectangular (default) ;"d" diagonal mode ;Option Keys: ;"u" undo last segment ;"c" close ;NOTE: You can change modes 'on-the-fly' while entering a figure with mouseclicks. ;NOTE: the last segment is entered automatically when you press "c" (close). It closes both the procedure and the figure. ;NOTE: After closing a figure give it a name with: make "somename :fig <cr> ;NOTE: You can redraw a figure after a "clean" or "cg" with DRAWFIG :somename ;************************* ;RING :somename :num ;*************** ;creates a new figure that either circumscribes or inscribes (:num + or -) the named figure; :num is the offset in turtlesteps from the named figure. TO SETUP newtext "Xtext [-317 -168][62 22] set "xtext "showname? "false newtext "Ytext [-317 -190][62 22] set "ytext "showname? "false newtext "label1 [-371 -168][55 44] set "label1 "text [X dist: Y dist:] newturtle "cross pu setbg 9 setc 45 end TO FIGURE make "fig [] forever [GETMODE] tto "cross ht make "mode 3 make "col color pu set "yellow "mouseclick [DOPT] set "black "mouseclick [DOPT] forever [REPORT] ORTHO set "yellow "mouseclick [] set "black "mouseclick [] cancel [GETMODE] pu end TO GETMODE let [key readchar] if :key = "r [make "mode 3] ;rectangular if :key = "d [make "mode 2] ;diagonal if :key = "c [make "mode 4] ;close if :key = "u [make "mode 5] ;undo end TO ORTHO if not :fig = [] [if and (last mousepos) > -235 :mode = 3 [make "x (first mousepos) - (first last :fig) make "y (last mousepos) - (last last :fig) ifelse (abs :x) > (abs :y) [pd setc 9 setpos last :fig setc :col setx first mousepos sety last last :fig][pd setc 9 setpos last :fig setc :col sety last mousepos setx first last :fig]] if and (last mousepos) > -235 :mode = 2 [setc 9 setpos last :fig setc :col setpos mousepos]] if :mode = 4 [setc 9 setpos last :fig setc :col setpos first :fig make "fig lput first :fig :fig cancel [REPORT] setc 9 setpos mousepos setpos last :fig setc :col DRAWFIG :fig pu stop] if :mode = 5 [ifelse (count :fig) > 1 [setc 9 setpos last :fig pd setpos last bl :fig make "fig bl :fig make "mode 1 waituntil [:mode > 1]][make "fig [] pu make "mode 3]] ORTHO end TO DOPT make "pt mousepos if :fig = [] [setpos :pt pd make "fig lput :pt :fig stop] if :mode = 3 [ifelse (abs :x) > (abs :y) [make "fig lput list (first :pt) (last last :fig) :fig] [make "fig lput list (first last :fig) (last :pt) :fig]] if :mode = 2 [make "fig lput :pt :fig] end TO REPORT ifelse :fig = [] [][make "xdist (abs(first last :fig) - (first mousepos)) set "Xtext "text (word (int :xdist / 6) "' "- round (((:xdist / 6) - int (:xdist / 6)) * 12) "") make "ydist (abs(last last :fig) - (last mousepos)) set "Ytext "text (word (int :ydist / 6) "' "- round (((:ydist / 6) - int (:ydist / 6)) * 12) "")] end TO DRAWFIG :fig pu setpos first :fig pd DRWFIG bf :fig END TO DRWFIG :fig if :fig = [] [pu stop] setpos first :fig DRWFIG bf :fig end TO RING :pts :amt pu make "daring [] make "dastuff fput last bl :pts :pts RNG :dastuff :amt make "daring lput first :daring :daring DRAWFIG :daring end TO RNG :dastuff :amt if (count :dastuff) = 2 [stop] ANG (list first :dastuff first bf :dastuff first bf bf :dastuff) lt (:ang / 2) fd (:amt * (1 / sin (:ang / 2))) make "daring lput pos :daring RNG bf :dastuff :amt end TO ANG :pts local [hdga hdgb] setpos first bf :pts TOWARD first :pts make "hdga heading TOWARD last :pts make "hdgb heading ifelse :hdgb > :hdga [make "ang :hdgb - :hdga][make "ang :hdgb + 360 - :hdga] end TO TOWARD :pt if (first :pt) = (first pos) [ifelse (last :pt) > (last pos) [seth 0 stop][seth 180 stop]];;;no divide by 0 make "slp ((last :pt) - (last pos)) / ((first :pt) - (first pos)) ifelse (first :pt) > (first pos) [seth minus ((arctan :slp) - 90)] [seth minus ((arctan :slp) + 90)] end

; COMMAND MENU:

;*************************

;FIGURE

*******

;Mode Keys:

;"r" rectangular (default)

;"d" diagonal mode

;Option Keys:

;"u" undo last segment

;"c" close

;NOTE: You can change modes 'on-the-fly' while entering a figure with mouseclicks.

;NOTE: the last segment is entered automatically when you press "c" (close). It closes both the procedure and the figure.

;NOTE: After closing a figure give it a name with: make "somename :fig <cr>

;NOTE: You can redraw a figure after a "clean" or "cg" with DRAWFIG :somename

;*************************

;RING :somename :num

;***************

;creates a new figure that either circumscribes or inscribes (:num + or -) the named figure; :num is the offset in turtlesteps from the named figure.

TO SETUP

newtext "Xtext [-317 -168][62 22]

set "xtext "showname? "false

newtext "Ytext [-317 -190][62 22]

set "ytext "showname? "false

newtext "label1 [-371 -168][55 44]

set "label1 "text [X dist: Y dist:]

newturtle "cross pu

setbg 9

setc 45

end

TO FIGURE

make "fig []

forever [GETMODE]

tto "cross ht

make "mode 3

make "col color

set "yellow "mouseclick [DOPT]

set "black "mouseclick [DOPT]

forever [REPORT]

ORTHO

set "yellow "mouseclick []

set "black "mouseclick []

cancel [GETMODE]

end

TO GETMODE

let [key readchar]

if :key = "r [make "mode 3] ;rectangular

if :key = "d [make "mode 2] ;diagonal

if :key = "c [make "mode 4] ;close

if :key = "u [make "mode 5] ;undo

end

TO ORTHO

if not :fig = [] [if and (last mousepos) > -235 :mode = 3 [make "x (first mousepos) - (first last :fig) make "y (last mousepos) - (last last :fig) ifelse (abs :x) > (abs :y) [pd setc 9 setpos last :fig setc :col setx first mousepos sety last last :fig][pd setc 9 setpos last :fig setc :col sety last mousepos setx first last :fig]] if and (last mousepos) > -235 :mode = 2 [setc 9 setpos last :fig setc :col setpos mousepos]]

if :mode = 4 [setc 9 setpos last :fig setc :col setpos first :fig make "fig lput first :fig :fig cancel [REPORT] setc 9 setpos mousepos setpos last :fig setc :col DRAWFIG :fig pu stop]

if :mode = 5 [ifelse (count :fig) > 1 [setc 9 setpos last :fig pd setpos last bl :fig make "fig bl :fig make "mode 1 waituntil [:mode > 1]][make "fig [] pu make "mode 3]]

ORTHO

end

TO DOPT

make "pt mousepos

if :fig = [] [setpos :pt pd make "fig lput :pt :fig stop]

if :mode = 3 [ifelse (abs :x) > (abs :y) [make "fig lput list (first :pt) (last last :fig) :fig] [make "fig lput list (first last :fig) (last :pt) :fig]]

if :mode = 2 [make "fig lput :pt :fig]

end

TO REPORT

ifelse :fig = [] [][make "xdist (abs(first last :fig) - (first mousepos)) set "Xtext "text (word (int :xdist / 6) "' "- round (((:xdist / 6) - int (:xdist / 6)) * 12) "") make "ydist (abs(last last :fig) - (last mousepos)) set "Ytext "text (word (int :ydist / 6) "' "- round (((:ydist / 6) - int (:ydist / 6)) * 12) "")]

end

TO DRAWFIG :fig

pu setpos first :fig pd

DRWFIG bf :fig

END

TO DRWFIG :fig

if :fig = [] [pu stop]

setpos first :fig

DRWFIG bf :fig

end

TO RING :pts :amt

make "daring []

make "dastuff fput last bl :pts :pts

RNG :dastuff :amt

make "daring lput first :daring :daring

DRAWFIG :daring

end

TO RNG :dastuff :amt

if (count :dastuff) = 2 [stop]

ANG (list first :dastuff first bf :dastuff first bf bf :dastuff)

lt (:ang / 2) fd (:amt * (1 / sin (:ang / 2))) make "daring lput pos :daring

RNG bf :dastuff :amt

end

TO ANG :pts

local [hdga hdgb]

setpos first bf :pts

TOWARD first :pts make "hdga heading

TOWARD last :pts make "hdgb heading

ifelse :hdgb > :hdga [make "ang :hdgb - :hdga][make "ang :hdgb + 360 - :hdga]

end

TO TOWARD :pt

if (first :pt) = (first pos) [ifelse (last :pt) > (last pos) [seth 0 stop][seth 180 stop]];;;no divide by 0

make "slp ((last :pt) - (last pos)) / ((first :pt) - (first pos))

ifelse (first :pt) > (first pos) [seth minus ((arctan :slp) - 90)] [seth minus ((arctan :slp) + 90)]

end