Решение в лоб(недостатки - глобальные переменные, возня с циклами), алгоритм - как делал бы человек с карандашом и точками на мм-ке.
Запускаем программу, получаем exe-файл. Пишем bat-файл, например такой:
Запускаем этот bat-файл, inkscape.exe(д.б. установлен) выводит результат.
Программа дает результат при числе точек больше 0(в том числе при одной и двух точках - в отличие от программы true-grue).
101 CONSTANT gbr \ размер стороны поля для точек
35 CONSTANT N-points \ количество точек
CREATE Abeg gbr DUP * ALLOT
REQUIRE RANDOMIZE lib\ext\rnd.f
: gen-points N-points RANDOMIZE 0 DO 1 Abeg gbr CHOOSE gbr * gbr CHOOSE + + C! LOOP ;
\ геом. характеристики множества точек
gbr VALUE X- gbr VALUE Y- 0 VALUE X+ 0 VALUE Y+
gbr VALUE X-- gbr VALUE Y-- 0 VALUE Y+- 0 VALUE X+- 0 VALUE X++ 0 VALUE Y++ gbr VALUE Y-+ gbr VALUE X-+
\ параметры для функции поиска точки
0 VALUE XB 0 VALUE XE 0 VALUE YB 0 VALUE YE 0 VALUE AREA?
0 VALUE X 0 VALUE Y 0 VALUE dX 0 VALUE dY
0 VALUE XO 0 VALUE YO 0 VALUE dXO 0 VALUE dYO
: @A gbr * + Abeg + C@ ;
: xy-bounds \ Определение характеристик
Abeg gbr DUP * + Abeg
DO I C@
IF I Abeg - gbr /MOD \ Y X
DUP X- MIN TO X- X+ MAX TO X+ DUP Y- MIN TO Y- Y+ MAX TO Y+
THEN
LOOP
X- TO X BEGIN Y- X @A IF X TO X-- 1 ELSE X 1+ TO X 0 THEN UNTIL
X+ TO X BEGIN Y- X @A IF X TO X+- 1 ELSE X 1- TO X 0 THEN UNTIL
X- TO X BEGIN Y+ X @A IF X TO X-+ 1 ELSE X 1+ TO X 0 THEN UNTIL
X+ TO X BEGIN Y+ X @A IF X TO X++ 1 ELSE X 1- TO X 0 THEN UNTIL
Y- TO Y BEGIN Y X- @A IF Y TO Y-- 1 ELSE Y 1+ TO Y 0 THEN UNTIL
Y+ TO Y BEGIN Y X- @A IF Y TO Y+- 1 ELSE Y 1- TO Y 0 THEN UNTIL
Y- TO Y BEGIN Y X+ @A IF Y TO Y-+ 1 ELSE Y 1+ TO Y 0 THEN UNTIL
Y+ TO Y BEGIN Y X+ @A IF Y TO Y++ 1 ELSE Y 1- TO Y 0 THEN UNTIL
;
: AREA XB XE > YE YB > AND XB XE < YB YE > AND OR IF 1 ELSE 0 THEN TO AREA? ;
: d+ < IF 1- ELSE 1+ THEN ;
: dX+ XE XB d+ ; : dY+ YE YB d+ ;
: x++ X dX+ TO X ; : y++ Y dY+ TO Y ;
: K1++ AREA? IF x++ ELSE y++ THEN ;
: K2++ AREA? IF y++ ELSE x++ THEN ;
: K1=E? AREA? IF X XE = ELSE Y YE = THEN ;
: K2=E? AREA? IF Y YE = ELSE X XE = THEN ;
: K1=B++ AREA? IF XB dX+ TO X ELSE YB dY+ TO Y THEN ;
: SET-dXYO XE XB - ABS TO dXO YE YB - ABS TO dYO ;
: SET-dXY X XB - ABS TO dX Y YB - ABS TO dY ;
: ANG< SET-dXY AREA? IF dY dXO * dYO dX * ELSE dX dYO * dXO dY * THEN < ;
: ~dXYO dY TO dYO dX TO dXO X TO XO Y TO YO ;
: ~XYB XO TO XB YO TO YB ;
: POINT? Abeg X gbr * Y + + C@ ;
: point. ." <circle cx=' " . ." ' cy=' " gbr SWAP - . ." ' r='0.4'/>" CR ;
: points. Abeg gbr DUP * + Abeg DO I C@ IF I Abeg - gbr /MOD point. THEN LOOP ;
: poligon. SWAP . ." , " gbr SWAP - . ;
: area. \ XB XE YB YE --
TO YE TO YB TO XE TO XB AREA
BEGIN
XE XB - ABS 1 > YE YB - ABS 1 > AND
IF XB dX+ TO X YB dY+ TO Y SET-dXYO SET-dXY XB TO XO YB TO YO
BEGIN
POINT? IF ANG< IF ~dXYO THEN THEN K1++ K1=E? IF K2++ K2=E? IF 1 ELSE K1=B++ 0 THEN ELSE 0 THEN
UNTIL
XO XB = YO YB = AND XB XE = OR IF 1 ELSE ~XYB XB YB poligon. 0 THEN
ELSE 1 THEN
UNTIL
;
: contur. \ по часовой стрелке
." <polygon fill='none' points=' "
X-- Y- poligon. X-- X- Y- Y-- area.
X- Y-- poligon. X- Y+- poligon. X- X-+ Y+- Y+ area.
X-+ Y+ poligon. X++ Y+ poligon. X++ X+ Y+ Y++ area.
X+ Y++ poligon. X+ Y-+ poligon. X+ X+- Y-+ Y- area.
X+- Y- poligon. ." '/>" CR
;
: SVG gen-points xy-bounds
." <?xml version='1.0'?>" CR ." <svg height=' " gbr . ." ' width=' " gbr . ." '>" CR
." <g style='fill-opacity:1.0; stroke:black; stroke-width:0.2;'>" CR
points. contur. ." </g></svg>" ;
' SVG MAINX ! S" svg.exe" SAVE BYE
Вход
Регистрация
Благодарности
Forth-FAQ
решение этой задачки показал кому следует.
