aUCBLogo Demos and Tests / woven_patterns_t

to woven_patterns_t
comment
  [These patterns are made by starting with a list of numbers, of length "modulus",
   generated by random selections from the numbers: 1, 2, ....modulus. To this list is
   appended its reverse (gives additional symmetry) e.g. [3 2 1 2 2 1 2 3]. These numbers are the lengths of
   segments. A segment is plotted, but the next segment is then plotted at a given angle, x(say).
   When the list is exhausted, the process is repeated with the same list until closure is
   is obtained. The plot either returns to its starting point or proceeds in a line (to infinity).
   x is calculated from values of the variables: polygon, modulus, ang_factor and mod_factor.
   polygon_n: integer values 3..8 determines the overall symmetry of the pattern.
   modulus: the length of the initial list.
   mod_factor: determines how many repetitions of the plotted list there are.
   ang_factor: more interesting results are found by using 2 angles in turn. If the
      first is x, the second is ang_factor*x. This variable governs the finer details
      of a plot.
   p_size: pen size
   magnification: maximum value fixed to keep the plot within the screen boundaries

   The larger the values of polygon_n and modulus the more complicated the design. I suggest
   polygon_n = 5, modulus = 6, ang_factor = 200 and mod_factor = 73 as a start.
   Press shuffle&go repeatedly. This shuffles the modulus list.
]
setUpdateGraph false
erns
closeall
(ss 0.8)
vars_list = read_file "vars_file.txt
if empty? vars_list[vars_list = [5 85 28 8 6 2    [7 4 6 7 4 3 7 5]]]
factor = (item 1 vars_list )/100
multiplier = item 2 vars_list
dilation = (item 3 vars_list)*10
modulus = item 4 vars_list
polygon1 = item 5 vars_list
p_size =item 6 vars_list
shuff = item 7 vars_list
mult=multiplier
my_f=frame [][my_window] wxcaption+wxresize_border+wxclose_box+wxsystem_menu [10 70][200 470]
FrameSetClientSize my_f 200 470
bshuffle = (Button my_f [shuffle&&go][go_shuffle updategraph] wxbu_left [5 0][60 20])
bweave = (Button my_f [&weave][weave updategraph ] wxbu_left [5 25][60 20])
bgo = (Button my_f[&go][go updategraph] wxbu_left [5 50][60 20])
bnew_list = (Button my_f [new_list][new_list] wxbu_left [90 0][60 20])
sfactor = (Slider my_f [ang_factor] 0 1 1000 [factor = SliderValue/100 go updategraph] wxsl_horizontal+wxsl_labels [5 80] [150 60])
; SliderSetLineSize sfactor 1
; SliderSetPageSize sfactor 25
WindowOnMouseWheel sfactor
[   tmp=Int (SliderValue sfactor)+MouseZ/120
   SliderSetValue sfactor tmp
   factor = tmp/100 go updategraph
]
smultiplier = (Slider my_f [mod_factor] 1 36 100 [multiplier = SliderValue go updategraph]wxsl_horizontal+wxsl_labels  [5 140] [150 60])
sdilation = (Slider my_f [magnification] 10 29 29 [dilation = SliderValue*10 go updategraph]wxsl_horizontal+wxsl_labels  [5 200] [150 60])
smodulus = (Slider my_f [modulus] 4 6 8 [modulus = SliderValue new_list go updategraph]wxsl_horizontal+wxsl_labels  [5 260] [150 60])
spolygon = (Slider my_f [polygon_n] 3 5 7 [polygon1 = SliderValue new_list go updategraph]wxsl_horizontal+wxsl_labels  [5 320] [150 60])
sp_size = (Slider my_f [p_size] 2 2 5 [p_size = SliderValue go updategraph]wxsl_horizontal+wxsl_labels  [5 380] [150 60])
bexit = (Button my_f [save&&exit][file_vars "vars_file.txt framedestroy my_f] wxbu_left [5 440][60 20])
bsavepic = (Button my_f [save_pict][save_pict ] wxbu_left [130 440][60 20])
(foreach (list sfactor smultiplier sdilation smodulus spolygon sp_size)   butlast vars_list [SliderSetValue ?1 ?2])
end

to save_pict
savepic (word "weave "_ factor*100 "_ multiplier "_ modulus "_ polygon1 "_ list_to_word shuff)
end

to list_to_word list#
if empty? list#[op " ]
op word first list# list_to_word bf list#
end

to read_file v_file
local "d_list
if not File? v_file [output []]
openread v_file
setreader v_file
d_list = readlist
close v_file
setreader []
op d_list
end

to file_vars v_file
openwrite v_file
setwriter v_file
pr (list factor*100 multiplier dilation/10 modulus polygon1 p_size shuff)
close  v_file
setwriter []
end

to extend :n :list#
if :n==0[op[]]
op se :list# extend :n-1 :list#
end

to if_factor
  if  (remainder multiplier modulus) == 0
   [multiplier = multiplier +signum (multiplier-mult)
    SliderSetValue smultiplier multiplier
    if_factor stop
   ]
if  (remainder multiplier polygon1) == 0
   [multiplier = multiplier +signum (multiplier-mult)
       SliderSetValue smultiplier multiplier
   if_factor
   ]
end

to go
cs
if_factor
mult = multiplier
local "ang0
make "ang0 :multiplier*360/((1+:factor)*:modulus*:polygon1)
make "ang_list list :ang0 :factor*:ang0
make "len_ang_list count :ang_list
local [f_list p polygon_list p_list]
make "f_list extend  :polygon1 se :shuff reverse :shuff
make "p [] make "polygon_list []
ht pu home
setpc 1 setpensize list 1 0
make "start_pos pos
make "p_list fput :start_pos plot :f_list
centre_plot :p_list ;DETERMINES C.OF G.
;setpos centre
;make "start_pos pos
p_list = map [?+centre]p_list
centre_plot p_list pu
make "seg_list p_list*size_corr
plot1  :seg_list
pu
end

to centre_plot :p_list
local[len p 2nd 1st ]
make "len count :p_list
make "p first :p_list
make "1st first :p
make "2nd last :p
make "xmin :1st
make "xmax :1st
make "ymin :2nd
make "ymax :2nd
h_centre_plot :p_list
end

to h_centre_plot :p_list
if empty? :p_list
    [size_corr = dilation/ifelse ymax==0[0.1][ymax]
     centre = list 0-(:xmin+:xmax)/2 0-(:ymin+:ymax)/2
     stop]
local[1st x y] make "1st first :p_list
make "x first :1st make "y last :1st
if :xmin>:x[make "xmin :x]
if :xmax<:x[make "xmax :x]
if :ymin>:y[make "ymin :y]
if :ymax<:y[make "ymax :y]
  h_centre_plot bf :p_list
end

to go_shuffle
;if not :mult==multiplier[make "mult multiplier new_list] ;
shuff = my_shuffle :shuff
go
show :shuff
end

to h_make_pf :el :list# :k1 :k2 :p_list :flag
if empty? bf :p_list[ stop]
if empty? :list# [h_make_pf first :p_list bf bf :p_list :k1 + 1 :k1 + 3 bf :p_list 1 stop]
local "soln make "soln solve :el first :list#
(if not empty? :soln
     [local[1st 2nd]
      make "1st first :soln make "2nd last :soln
      (if and (and  0<:1st  :1st<1) (and  0<:2nd :2nd<1)
         [make "pf_list subst :1st :k1 :pf_list
          make "pf_list subst :2nd :k2 :pf_list
         ])
     ])
h_make_pf :el bf :list# :k1 :k2 + 1 :p_list 1
end

to h_sort :el :list#
if empty? :list#[op (list :el)]
if :el<first :list#[op fput :el :list#]
op fput first :list# h_sort :el bf :list#
end

to h_weave :ci :pf_list
if empty? :pf_list[stop]
local[1st p f p1 p2]
make "1st first :pf_list
make "p first :1st make "f last :1st
make "p1 first :p make "p2 last :p
if not empty? :f[make "ci 1-:ci]
if :ci==0[h_weave 0 bf :pf_list]
segment :p1 :p2
if :ci==1[h_weave 1 bf :pf_list stop]
end

to make_initial_pf_pr_list :list#
if empty?  :list#[op []]
op fput list  first :list#  [] make_initial_pf_pr_list bf :list#
end

to make_p_pr_list :list#
if empty? bf :list#[op[]]
op fput list first :list# first bf :list# make_p_pr_list bf :list#
end

to make_pf_pr_list :p_pr_list
local "pf_list
make "pf_list make_initial_pf_pr_list :p_pr_list ;GENERATED BY PLOT AND TRIMMED
h_make_pf first :p_pr_list bf bf :p_pr_list 1 3 bf :p_pr_list 0
op :pf_list
end

to modify_item  :f_list
if empty? bf :f_list[op[]]
local[f1 f2 fm]
make "f1 first :f_list
make "f2 first bf :f_list
make "fm (:f1 + :f2) / 2
op  fput  ( :p1*(1 - :fm)  + :p2*:fm ) modify_item bf :f_list
end

to modify_pf_list :pf_list
if empty? :pf_list [op[]]
local[1st p_list f_list p1 p2]
make "1st first :pf_list
make "p_list first :1st
make "f_list my_sort last :1st
make "p1 first :p_list
make "p2 last :p_list
if empty? :f_list[op fput :1st modify_pf_list bf :pf_list]
make "p_list fput :p1 lput :p2 modify_item :f_list
;show :p_list stop
(op se pf_extend :p_list  :f_list  modify_pf_list bf :pf_list)
end

to my_remove :i :list#
if empty? :list#[op[]]
if :i==first :list#[op bf :list#]
op fput first :list# my_remove :i bf :list#
end

to my_shuffle :list#
if empty? :list#[op[]]
local "i i=pick :list#
op fput :i my_shuffle my_remove :i :list#
end

to my_sort :list#
if empty? :list#[op[]]
if empty? bf :list#[op :list#]
op h_sort first :list# my_sort bf :list#
end

to new_list
ct
make "shuff pick_list modulus  [1 2 4 3] ;iseq 1 3
show :shuff
end

to pf_extend :p_list :f_list
if empty? bf :p_list[op[]]
(op fput list (list first :p_list first bf :p_list)
               (list first :f_list)
          pf_extend bf :p_list :f_list)
end

to pick_list :n :list#
if :n==0[op[]]
op fput pick :list# pick_list :n-1 :list#
end

to plot  :f_list [k 0]
if empty? :f_list[op[]]
lt item 1+remainder :k 2 :ang_list
fd 30*first :f_list
op fput pos (plot  bf :f_list k+1 )
end

to plot1  :p_list
if empty? :p_list [stop]
if empty? bf :p_list [stop]
segment first :p_list first bf :p_list
;setpos first :p_list
;pd
plot1  bf :p_list
end

to segment :p1 :p2
local "d
t1=newturtle t2=newturtle
setturtle t1 ht pu setpos :p1
seth towards :p2
make "d distance :p2
setturtle t2 ht pu setpos :p1
seth towards :p2
setpensize [1 1] setpc 1
pu lt 90 fd  ifelse 1==remainder :p_size 2[:p_size/2][:p_size/2]
rt 90 pd fd :d pu
rt 90 fd  :p_size ;ifelse 1==remainder :p_size 2[:p_size/1][:p_size] ;1.5 1
rt 90 pd fd :d pu
setturtle t1
setpensize list :p_size :p_size
setpc 4 pd fd :d pu
end

to solve :pr1 :pr2
local[p1 p1 p3 p4 x1 y1
       x2 y2 x3 y3 x4 y4
       f1 f2 p0 p  delta]
make "p1 first :pr1
make "p2 last :pr1
make "p3 first :pr2
make "p4 last :pr2
make "x1 first :p1
make "y1 last  :p1
make "x2 first :p2
make "y2 last  :p2
make "x3 first :p3
make "y3 last  :p3
make "x4 first :p4
make "y4 last  :p4
make "f1 0 make "p0 []  make "p []
make "f2 0  make "delta (:x2 - :x1) * (:y3 - :y4) - (:y2 - :y1) * (:x3 - :x4)
if  0.001 > abs :delta [op []]
make "f1 ((:x3 - :x1) * (:y3 - :y4) - (:y3 - :y1) * (:x3 - :x4)) / :delta
make "f2 ((:x2 - :x1) * (:y3 - :y1) - (:y2 - :y1) * (:x3 - :x1)) / :delta
op list :f1 :f2
end

to subst :f :k :pf_pr_list
if :k>count :pf_pr_list[op "ERROR]
(if :k==1
   [local "1st make "1st first :pf_pr_list
    (op fput list first :1st fput :f last :1st
             bf :pf_pr_list)
   ])
op fput first :pf_pr_list  subst :f :k-1 bf :pf_pr_list
end

to trim_p_list :p_list
if empty? :p_list[op[]]
if equal? :start_pos first :p_list[op (list first :p_list)]
op fput first :p_list trim_p_list bf :p_list
end

to weave
go
pu cs home
;make "pf_pr_list
h_weave 1 modify_pf_list make_pf_pr_list make_p_pr_list :seg_list
end