Support Forum / Форум поддержки

Code: Select all

' Automaton, 1D cellular automata, Byte magazine dec. 1986
' version january 31, 2019
'
option base 1
dim rule$(400),bs(600),r(10),ah$(200)
prog_init() ! goto begin
do
  sel=list_selected("rules")
  if sel>0 then
    selected=sel ! s_play=sel
    aton(rule$(sel),r)
    field "cur_rule" text ntoa$(.r)
    list "rules" select -1
    for i=1 to nb ! bs(i)=rnd(4) ! next i
    start(r,bs)
    end if
 if bp("help") then fhelp()
 if bp("rand") then
    begin: rand_rule(r)
    for i=1 to nb ! bs(i)=rnd(4) ! next i
    start(r,bs)
    end if
  if bp("start") then
    for i=1 to nb ! bs(i)=rnd(4) ! next i
    start(r,bs)
    end if
  if bp("1pix") then
    for i=1 to nb ! bs(i)=0 ! next i
    bs(floor(nb/2))=1+rnd(3)
    start(r,bs)
    end if
  if bp("cont") then start(r,bs)
  if bp("dump") then
    f$="dump_data" ! if file_exists(f$) then file f$ delete
    file f$ print b_size
    for i=1 to 10 ! file f$ print r(i) ! next i
    run "full_dump.sb"
    end if
  if bp("plus") and b_size<5 then
    b_size+=1 ! button "size" text "size="&b_size
    nb=floor(600/b_size) ! start(r,bs)
    end if
  if bp("mins") and b_size>1 then
    b_size-=1 ! button "size" text "size="&b_size
    nbo=nb ! nb=floor(600/b_size)
    for i=nbo+1 to nb ! bs(i)=rnd(4) ! next i
    start(r,bs)
    end if
  if bp("add") and nrec<400 then
    t$=field_text$("cur_rule") ! tcon$=""
    for i=1 to len(t$)
      c$=substr$(t$,i,i) ! if c$<>" " then tcon$&=c$
      next i
    nrec+=1 ! rule$(nrec)=tcon$ ! save_rules()
    c_list("rules","   Rules",rule$,nrec,ex-130,sy,ex,sh-20)
    end if
  if bp("del") and selected>0 then
    if selected<nrec then
      for i=selected to nrec-1 ! rule$(i)=rule$(i+1) ! next i
      end if
    nrec-=1 ! save_rules()
    c_list("rules","   Rules",rule$,nrec,ex-130,sy,ex,sh-20)
    end if
  if bp("pb_ss") then
    button "pb_ss" hide ! button "pb_st" show ! play(s_play,nrec,1,1)
    end if
  if bp("pb_bg") then
    button "pb_st" show ! play(1,nrec,1,1)
    end if
  if bp("pb_en") then
    button "pb_st" show ! play(nrec,1,-1,1)
    end if
  if bp("pb_bk") then
    button "pb_st" show ! play(s_play,1,-1,1)
    end if
  if bp("pb_fb") then
    button "pb_st" show ! play(s_play,1,-1,0)
    end if
  if bp("pb_ff") then
    button "pb_st" show ! play(s_play,nrec,1,0)
    end if
  if field_changed("cur_rule") then
    t$=field_text$("cur_rule")
    aton(t$,r)
    for i=1 to nb ! bs(i)=rnd(4) ! next i
    start(r,bs)
    end if
  if bp("stop") then break
  until forever
end

def play(rs,re,dr,dt)
for i=rs to re step dr
  list "rules" select i
  button "disp" text "Rule "&i
  aton(.rule$(i),.r)
  field "cur_rule" text ntoa$(.r)
  for j=1 to .nb ! .bs(j)=rnd(4) ! next j
  start(.r,.bs) ! pause dt
  if bp("pb_st") then
    .s_play=i ! button "pb_st" hide ! button "pb_ss" show ! break
    end if
  next i

end def

def prog_init()
graphics ! graphics clear .8,.8,.8 ! draw color 0,0,0
set orientation portrait ! randomize
set toolbar off ! refresh off
get screen size .sw,.sh
.nrec=load_rules()
.sx=84 ! .ex=.sx+599 ! .sy=650 ! .s_play=1
.b_size=3 ! .nb=floor(600/.b_size)
draw rect .sx, 24 to .ex,.ex-.sx+24
c_list("rules","   Rules",.rule$,.nrec,.ex-130,.sy,.ex,.sh-20)
field "cur_rule" text "" at 250,.sy size 280,50
rand_rule(.r)
button "rand"  text "Random rule" at .sx,.sy size 140,30
button "start" text "Restart" at .sx,.sy+50 size 140,30
button "1pix" text "1 pix start" at .sx,.sy+100 size 140,30
button "cont" text "Continue" at .sx,.sy+150 size 140,30
button "dump" text "Full dump" at .sx,.sy+270 size 140,30
button "stop" text "Stop" at .sx,.sh-50 size 100,30
button "mins" text "-" at 250,.sy+70 size 50,30
button "size" text "size=3" at 320,.sy+70 size 140,30
button "plus" text "+" at 480,.sy+70 size 50,30
button "add"  text "Add rule" at 390,.sy+120 size 140,30
button "del"  text "Delete rule" at 390,.sy+170 size 140,30
button "disp" text "playing" at 334,930 size 140,30
button "help" text "Help" at 265,800 size 90,90
play_bar(280,965,30)
win_help("autohelp",.sx,24,600,600,3)
refresh
end def

def load_rules()
f$="auto_rules" 
if not file_exists(f$) then file f$ print  """"&"0230101303"&""""
while data_exist(f$)
  nrec+=1
  file f$ input .rule$(nrec)
  end while
return nrec
end def

def save_rules()
f$="auto_rules"
if file_exists(f$) then file f$ delete
if .nrec then
  for i=1 to .nrec
    rr$="""" & .rule$(i) & """"
    file f$ print rr$
    next i
  end if
end def

def start(r(),s())
for i=1 to .nb
  if i>1 then
    t1=s(.nb)+s(1)+s(2) ! tn=s(1)+s(.nb-1)+s(.nb)
    for j=2 to .nb-1
      t2=s(j-1)+s(j)+s(j+1) ! s(j-1)=t1 ! t1=t2
      next j
    s(.nb)=tn
    for j=1 to .nb ! s(j)=r(s(j)+1) ! next j
    end if
  for j=1 to .nb 
    set_col(s(j))
    x1=.sx+(j-1)*.b_size ! y1=24+(i-1)*.b_size
    x2=x1+.b_size ! y2=y1+.b_size
    fill rect x1,y1 to x2,y2
    next j
  refresh
  next i
end def

def ntoa$(r())
t$="  "
for i=1 to 10 ! t$=t$ & "   " & r(i) ! next i
return t$
end def

def aton(t$,r())
k=0
for i=1 to len(t$)
  c$=substr$(t$,i,i) 
  if c$<>" " then
    k=k+1 ! r(k)=c$
    end if
  next i
return k
end def

def rand_rule(r())
for i=1 to 10 !  r(i)=rnd(4) ! next i
tt$=ntoa$(r)
field "cur_rule" text tt$
end def

def set_col(p)
if p=0 then fill color 0,0,0
if p=1 then fill color 1,0,0
if p=2 then fill color 0,1,0
if p=3 then fill color 0,0,1
end def

def play_bar(x,y,bs)
dx=10 ! dy=5 ! yy=y+dy ! set buttons font size bs
button "pb_bar" text "" at x,y size 250,bs+10
button "pb_bg" text chr$(9198)  at x+dx,yy size bs,bs
button "pb_fb" text chr$(9194)  at x+bs+2*dx,yy size bs,bs
button "pb_bk" text chr$(57915) at x+2*bs+3*dx,yy size bs,bs
button "pb_ss" text chr$(57914) at x+3*bs+4*dx,yy size bs,bs
button "pb_st" text chr$(9209)  at x+3*bs+4*dx,yy size bs,bs
button "pb_ff" text chr$(9193)  at x+4*bs+5*dx,yy size bs,bs
button "pb_en" text chr$(9197)  at x+5*bs+6*dx,yy size bs,bs
button "pb_st" hide
end def

def fhelp()
page "autohelp" alpha 0 ! page "autohelp" show
for i=0 to 1 step .05
  page "autohelp" alpha i ! pause .05
  next i
do slowdown ! until bp("help") or bp("hback")
for i=1 to 0 step -.05
  page "autohelp" alpha i ! pause .05
  next i
page "autohelp" hide
end def

def win_help(hn$,xo,yo,w,h,t)
dim ah$(64) ! nr=0
do 
  nr+=1 ! file "automaton_help" readline ah$(nr)
  until file_end("automaton_help")
t2=2*t ! t4=4*t
page hn$ set
page hn$ frame xo,yo, w,h
page hn$ color .8,.8,.8,1
set buttons custom ! set buttons font size 22
draw color 0,0,0 ! fill color .8,.8,.8
button "h1" text "" at -t2,0 size w+t4,3
button "h2" text "" at 0,-t2 size t,h+t4
button "h3" text "" at -t2,h-t size w+t4,t
button "h4" text "" at w-t,-t2 size t,h+t4
button "h5" text "" at -t2,48 size w+t4,t
field "htitle" text "   Automaton help" at 90,10 size 320,33 RO
field "htitle" back color .8,.8,.8
field "htitle" font color 0,0,0
field "htitle" font name "Courier-Bold"
field "htitle" font size 30
button "hback" text "Return" at w-100,10 size 92,33
set lists custom
set lists font size 20 ! draw color 0,0,1
list hn$ text ah$ at 7,52 size w-10,h-56
draw color 0,0,0
page hn$ hide
end def

' id$ = object name
' cont$ = array met elementen
' size = aantal elementen in de list
'
def c_list(id$,title$,cont$(),size,xt,yt,xb,yb)
dim temp$(size)
for i=1 to size ! temp$(i)=cont$(i) ! next i
fill color 1,1,1 ! draw color 0,0,0 ! set lists font size 16
list id$ text temp$ at xt+2,yt+32 size xb-xt-4,yb-yt-34
draw size 3
draw rect xt,yt to xb,yb ! draw line xt,yt+30 to xb,yt+30
draw color 0,0,1 ! draw text title$ at xt+5,yt+5
end def

def bp(a$) = button_pressed(a$)

Code: Select all

[code]

Code: Select all

'Automaton'
The 'automaton' is a very simple digital machine, 
extensively described in the december 1986 edition of
the Byte magazine. It consists of a one-dimensional
array of elements that can each have 1 out of 4 statusses.
By assigning a color to each of the statusses, the array
can be put on the screen as a multicolored line.
For the next step, the status of each element is
recalculated as the sum of his former status and those of
its neighbours (points). This sum can be anything between
0 and 9. That sum is reduced to a value between
0 and 3 by a 'rule'. An example of such rule:        
    sum:  0  1  2  3  4  5  6  7  8  9       
    rule:   0  2  3  0  1  1  0  2  2  1
The new line is drawn, and the proces is repeated a
number of times to produce a pattern.
Dependent on the starting values of the points and the
rule that is applied, interesting patterns may emerge.
In general, all patterns converge to a stable pattern,
some quickly, others only after a considerable number of
steps.
The screen has a display window in which the pattern
enrolls, an edit window containing the current rule,
a scrollable listbox containing all saved rules that
produce an interesting pattern, and some buttons.
Buttons:
Tapping the 'random rule' button places a new rule in the
edit window and starts rendering that rule.
The 'restart' button will use the same rule in the edit
window, but starts rendering with a new random starting
line.
The '1 pix start' button uses one non-zero pixel in the
middle of the rendering square as a new starting line.
The 'continue' button continues the rendering with the
same rule and using the last generated line as starting
line.
The 'full dump' button starts rendering a full screen with
the current rule. The program is ended upon completion of
the rendering.
The 'stop' button will end the program.

The size of the 'pixels' may be adapted using the 
'+' and the '-' button.
Default is the value 3, the maximum size is 5 pixels.
The rendering speed varies strongly with the pixel size.

Rules: In the edit field the rule may be modified.
Spaces are inserted for readability, but they need not be
retained. Just take care, that 10 numbers remain in the
window after editing.
A rule in the edit window can be added to the rules table
with the 'Add rule' button. 

The rules table is displayed in a scrollable listbox.
When selecting a rule, the rule is placed in the edit field
and rendering starts immediatly.
A selected rule may be deleted from the table using the
'delete rule' button.
Using the playing buttons, the rules in the table may be
processed sequentially in both directions, fast or slow.
Starting points are the beginning or the end of the table,
or an arbitrary rule as set by the button 'random rule'.
The rules in the listbox are kept in a file, which is
loaded and updated automatically. 

Code: Select all

"0232133112"
"1032201112"
"0020231331"
"2331113001"
"0230101303"
"1230332320"
"1212202313"
"0111032213"
"0203020332"
"2303112313"
"2331200111"
"2113131220"