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 vars_list )
 
multiplier item vars_list
 
dilation = (item vars_list)
 
modulus item vars_list
 
polygon_ item vars_list
 
p_size =item vars_list
 
shuff item vars_list
 
my_f=frame [][my_windowwxCaption+wxResize_Border+wxClose_Box [10 70][] ;[200 470]
 
FrameSetClientSize my_f 200 470 
 
bshuffle = (Button my_f [shuffle&&go][go_shuffle updategraphwxBU_LEFT [5 0][60 20])
 
bweave = (Button my_f [&weave][weave updategraph wxBU_LEFT [5 25][60 20])
 
bgo = (Button my_f[&go][go updategraphwxBU_LEFT [5 50][60 20])
 
bnew_list = (Button my_f [new_list][new_listwxBU_LEFT [90 0][60 20])
 
sfactor = (Slider my_f [ang_factor0 20 100 [factor SliderValue/10wxSL_HORIZONTAL+wxSL_LABELS [5 80] [150 60])
 
smultiplier = (Slider my_f [mod_factor1 36 100 [multiplier SliderValue]wxSL_HORIZONTAL+wxSL_LABELS  [5 140] [150 60])
 
sdilation = (Slider my_f [magnification10 29 29 [dilation SliderValue*10]wxSL_HORIZONTAL+wxSL_LABELS  [5 200] [150 60]) 
 
smodulus = (Slider my_f [modulus1 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_size2 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_fwxBU_LEFT [5 440][60 20])
 
;(map [SliderSetValue ?1 ?2] [sfactor smultiplier sdilation smodulus spolygon sp_size]   butlast vars_list) 
SliderSetValue sfactor (item vars_list)*10 
 
SliderSetValue smultiplier (item vars_list)
 
SliderSetValue sdilation int (item vars_list)/10 
 
SliderSetValue smodulus (item vars_list)
 
SliderSetValue spolygon (item vars_list) 
 
SliderSetValue sp_size (item 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 :listextend :n-:list#
end

to gen_list :n
 
op h_gen :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 setpensize list 0 3
 
make "start_pos pos
 
make "p_list fput :start_pos trim_p_list plot :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 :f_list
 
centre_plot p_list pu
 
make "seg_list (fput :start_pos trim_p_list (plot :f_list))*size_corr ;;ALL PLOT SAME SIZE
 
plot1 :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][ymaxcentre list 0-(:xmin+:xmax)/2 0-(:ymin+:ymax)/stop];size_corr = 250/ymax
 
local[1st x ymake "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+:n lput :v :list#
end

to h_make_pf :el :list:k1 :k2 :p_list :flag
 
if empty? bf :p_liststop]
 
if empty? :list[h_make_pf first :p_list bf bf :p_list :k1 :k1 bf :p_list 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 :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 :listh_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 bf :pf_list]
 
segment :p1 :p2
 
if :ci==1[h_weave 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 :listfirst bf :listmake_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*(: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 :listmy_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 :listmy_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-: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+bf :f_list
end

to plot1 :k :p_list
 
if empty? :p_list[stop]
 
setpos first :p_list
 
pd
 
plot1 :k+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 1setpc 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 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 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-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 :pf_pr_list
end