Category : Printer + Display Graphics
Archive   : DRGNFRAC.ZIP
Filename : QDRAGON.BAS

 
Output of file : QDRAGON.BAS contained in archive : DRGNFRAC.ZIP

' This program is QDRAGON.BAS, a QuickBASIC program for drawing fractals.
' Inputs to this program are the files with a .CRV suffix. Rules for
' running it are in QRULES.TXT.

d=4:l=2:m=4:w=1:s=10:n=5:x=320:y=175
dim i$(m-1),g(m,l),w(w):a=360/d
print"The program tries to anticipate your wishes."
print"You can cycle through the data for previewing"
print"or editing, or enter entirely new data."
print" cycles forward through data entry"
print"<]> cycles backwards through data entry."
print" at any time draws the dragon with current data."
print"But pressing it now will get you only an empty screen."
print"The backspace key allows erasing the last-typed character."
print

begin:
print"input dragon? ( or <]> if no) ";:t=pos(0)+1:gosub getcmd
if i$>"" then
open"I",#1,i$+".crv"
input#1,d,l,m:erase i$,g:dim i$(m-1),g(m,l):a=360/d
for i=0 to m-1:input#1,i$(i):for j=0 to l:input#1,g(i,j):next j,i
input#1,w:erase w:dim w(w):for i=1 to w:input#1,w(i):next i
input#1,s,n,x,y:close
end if
if a$="]" then goto crvsave
if a$=chr$(0) then goto program
locate csrlin,pos(0),1

drctns:
print"number of directions";
t=pos(0)+1:print d;:gosub getcmd
if i$>"" then d=val(i$):a=360/d
if a$=chr$(0) then goto program
if a$="]" then goto begin

dvsn:
print"max cell division";
t=pos(0)+1:print l;:gosub getcmd
if i$>"" then l=val(i$):erase g,i$:dim g(m-1,l),i$(m-1)
if a$=chr$(0) then goto program
if a$="]" then goto drctns

cellno:
print"number of cells";
t=pos(0)+1:print m;:gosub getcmd
if i$>"" then m=val(i$):erase g,i$:dim g(m-1,l),i$(m-1)
if a$=chr$(0) then goto program
if a$="]" then goto dvsn
i=0:j=1

gnetic:
if i$(i)="" then i$(i)="TA"+str$((i mod d)*a)+"R"
if g(i,0)=0 then g(i,0)=l
drawcode:
print"draw code for cell"i"is";
t=pos(0)+1:print" "i$(i)" <*> = 'do nothing'; <-> = 'invisible' ";
gosub getcmd
if i$>"" then
if instr(i$,"*") then i$(i)="TA"+str$((i mod d)*a)+"NBR":goto drawcode1
if instr(i$,"-") then i$(i)="TA"+str$((i mod d)*a)+"BR":goto drawcode1
i$(i)=i$
end if
drawcode1:
if a$=chr$(0) then goto program
if a$="]" then
i=i-1:if i<0 then goto cellno else j=g(i,0)
goto loop1
end if

j=1
loop1:
print" cell"i"'s number"j"child is";
t=pos(0)+1:print g(i,j);
if j=g(i,0) then
if (i mod d)=0 then print" (end this entry with (*) to abort skip)";
end if
gosub getcmd
if i$>"" then
g(i,j)=val(i$):if instr(i$,".") then g(i,0)=j
end if
if a$=chr$(0) then goto program
if a$="]" then
if j=1 then goto gnetic
j=j-1:goto loop1
end if
j=j+1:if j<=g(i,0) then goto loop1
if (i mod d)<>0 then i=i+1:goto ilupend
if i+d<=m then
if i$="" then i=i+1:goto ilupend
if instr(i$,"*") then i=i+1:goto ilupend
for u=i+1 to i+d-1
if i$(i)=" " then i$(u)=" ":goto 10
if instr(i$(i),"B") then i$(u)="TA"+str$((u mod d)*a)+"BR":goto 10
i$(u)="TA"+str$((u mod d)*a)+"R"
10 g(u,0)=g(i,0):for v=1 to g(i,0)
g(u,v)=g(i,v)-(g(i,v) mod d)+((g(i,v)+u) mod d)
next v,u:i=i+d:goto ilupend
end if
i=i+1
ilupend:
if i
initword:
print"birth cell list length";
t=pos(0)+1:print w;:gosub getcmd
if i$>"" then w=val(i$):erase w:dim w(w):goto bcells
if a$=chr$(0) then goto program
if a$="]" then i=m-1:j=g(i,0):goto loop1

bcells:
i=1:print"cells"
loop2:
print i"-th cell:";
t=pos(0)+1:print w(i);:gosub getcmd
if i$>"" then w(i)=val(i$)
if a$=chr$(0) then goto program
if a$="]" then if i=1 then goto initword else i=i-1:goto loop2
i=i+1:if i<=w then goto loop2

order:
print"number of day's growth";:t=pos(0)+1:print n;:gosub getcmd
if i$>"" then n=val(i$)
if a$=chr$(0) then goto program
if a$="]" then i=w:goto bcells

length:
print" cell length";
t=pos(0)+1:print s;:gosub getcmd
if i$>"" then s=val(i$)
if a$=chr$(0) then goto program
if a$="]" then goto order

xpos:
print"x-origin";
t=pos(0)+1:print x;:gosub getcmd

if i$>"" then x=val(i$)
if a$=chr$(0) then goto program
if a$="]" then goto length

ypos:
print"y-origin";
t=pos(0)+1:print y;:gosub getcmd
if i$>"" then y=val(i$)
if a$="]" then goto xpos
if a$=chr$(0) then goto program

crvsave:
print"save name? ( or <]> if no) ";:t=pos(0)+1:gosub getcmd
if i$="]" then goto ypos
if i$>"" then
open"O",1,i$+".crv"
print#1,d;l;m
for i=0 to m-1:print#1,i$(i):for j=0 to l:print#1,g(i,j);
next j:print#1,:next i
print#1,w;:for i=1 to w:print#1,w(i);:next i:print#1,
print#1,s;n;x;y:close
end if
if a$="]" then goto ypos
if a$=chr$(0) then goto program
goto begin

program:
screen 9:cls:dim k(n),cell(n)
draw"BM="+varptr$(x)+",="+varptr$(y)
for i=2 to w+1:cell(n)=w(i-1):draw"C="+varptr$(i):gosub dragon:next i
erase k,cell:goto crvsave

dragon:
if n=0 then draw i$(cell(n))+str$(s):return
k(n)=1:while k(n)<=g(cell(n),0):cell(n-1)=g(cell(n),k(n)):n=n-1
gosub dragon:n=n+1:k(n)=k(n)+1:wend
return

getcmd:
i$="":t0=pos(0)-1:locate csrlin,t,1
getcmd1:
a$="":a$=input$(1)
if instr(chr$(13)+"]"+chr$(0),a$) then print:return
if a$=chr$(8) then
if pos(0)=t then goto getcmd1
i$=left$(i$,len(i$)-1):locate csrlin,pos(0)-1,1:goto getcmd1
end if
I$=I$+a$:print a$;

if len(i$)=1 then print string$(t0-t+2,32);:locate csrlin,t+1,1
goto getcmd1