aUCBLogo Demos and Tests / woven_patterns1

to woven_patterns1
erns
(ss 0.8)
vars_list = read_file "vars_file.txt
if empty? vars_list[vars_list = [0.5 85 280 8 6 2    [7 4 6 7 4 3 7 5]]]
factor = (item 1 vars_list )
multiplier = item 2 vars_list
dilation = (item 3 vars_list)
modulus = item 4 vars_list
polygon_ = item 5 vars_list
p_size =item 6 vars_list
shuff = item 7 vars_list
my_f=frame [][my_window] wxCaption+wxResize_Border+wxClose_Box [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 20 100 [factor = SliderValue/10] wxSL_HORIZONTAL+wxSL_LABELS [5 80] [150 60])
smultiplier = (Slider my_f [mod_factor] 1 36 100 [multiplier = SliderValue]wxSL_HORIZONTAL+wxSL_LABELS  [5 140] [150 60])
sdilation = (Slider my_f [magnification] 10 29 29 [dilation = SliderValue*10]wxSL_HORIZONTAL+wxSL_LABELS  [5 200] [150 60])
smodulus = (Slider my_f [modulus] 1 6 8 [modulus = SliderValue new_list]wxSL_HORIZONTAL+wxSL_LABELS  [5 260] [150 60])
spolygon = (Slider my_f [polygon_] 1 5 7 [polygon_ = SliderValue new_list]wxSL_HORIZONTAL+wxSL_LABELS  [5 320] [150 60])
sp_size = (Slider my_f [p_size] 2 2 4 [p_size = SliderValue]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])
;(map [SliderSetValue ?1 ?2] [sfactor smultiplier sdilation smodulus spolygon sp_size]   butlast vars_list)
SliderSetValue sfactor (item 1 vars_list)*10
SliderSetValue smultiplier (item 2 vars_list)
SliderSetValue sdilation int (item 3 vars_list)/10
SliderSetValue smodulus (item 4 vars_list)
SliderSetValue spolygon (item 5 vars_list)
SliderSetValue sp_size (item 6 vars_list)

end

to read_file v_file
local "d_list
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 multiplier dilation modulus polygon_ p_size shuff)
close  v_file
setwriter []
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 extend :n :list#
if :n==0[op[]]
op se :list# extend :n-1 :list#
end

to gen_list :n
op h_gen 1 :n []
end

to go
cs
;if not :mult==multiplier[make "mult multiplier new_list]
local "ang0 make "ang0 :multiplier*360/((1+:factor)*:modulus*:polygon_)
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  :polygon_ se :shuff reverse :shuff
make "p [] make "polygon_list []
ht pu home
setpc 1 setpensize list 0 3
make "start_pos pos
make "p_list fput :start_pos trim_p_list plot 1 :f_list
centre_plot :p_list ;DETERMINES C.OF G.
setpos centre
make "start_pos pos
make "p_list fput :start_pos trim_p_list plot 1 :f_list
centre_plot p_list pu
make "seg_list (fput :start_pos trim_p_list (plot 1 :f_list))*size_corr ;;ALL PLOT SAME SIZE
plot1 0 :seg_list
pu
;make "p_pr_list make_p_pr_list :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_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];size_corr = 250/ymax
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 h_gen :k :n :list#
local "v make "v remainder :k :n
if :v==0[op :list#]
op h_gen :k+1 :n lput :v :list#
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 gen_list :modulus
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[]]
local "v make "v pick :list#
op fput :v pick_list :n-1 :list#
end

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

to plot1 :k :p_list
if empty? :p_list[stop]
setpos first :p_list
pd
plot1 :k+1 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  ifelse 1==remainder :p_size 2[1.5+:p_size/2][1+:p_size/2]
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 modify_pf_list make_pf_pr_list make_p_pr_list :seg_list
h_weave 1 :pf_pr_list
end