Three Rosetta Code inspired implementations

[tenochtitlanuk]

See Bioinfomatics, simple Turtle graphics and is a point in a triangle? from Rosetta code suggested new tasks.

The turtle houses are begging me to add colour fill among other things...

[tenochtitlanuk]

Have to run this in LB5 to get the figures accurate and closing the path. Now add the fill..

[tenochtitlanuk]

Old hands will remember that LB4 turtle graphic moves go to an (integer) pixel and don't store the 'precise' value. In LB5, they retain the precise position but we don't yet have dll calls.

When I add the fill routine, some of the figures do not close, and leak. In LB5 the new turtle does not suffer this problem.

The graphic cycles through spiral-of-houses with LB4 with size =1 ( leaves gaps occasionally), with size =2 ( less neat, but tends to close the gaps), and with LB5 ( figures close, but can't be filled).

[tsh73]

then you have house you can build a town
at least something with rows of houses and perspective
(but they should be filled)

(I used Piefilled for the roof, it is a bit off due to known bug)
'houses assembled to town, with some perspective
   UpperLeftX = 20
   UpperLeftY = 20
   WindowWidth = 600
   WindowHeight = 350
nomainwin
open "test" for graphics_nsb_nf as #gr
'open "test" for graphics_nsb_fs as #gr
global gr$
gr$="#gr"

#gr "trapclose [quit]"
#gr "down"
'#gr "fill white; flush"
#gr "home; posxy cx cy"

'#gr "home; circle 50"
'call housef cx, cy, 50
'wait
goto [skip1]
N=20
for i = 1 to 20
   s=randRange(10,80)
   x=randRange(10,2*cx-10-s)
   y=randRange(10+s,2*cy-10)
   'call box x, y, s
   call boxf x, y, s
next

[skip1]
'distance: d=0 => y = 2*sy-sy/2, s=100
'          d=inf => y = sy/2, s=0
'   linear perspective  y between => s between (still not sure about d)
'   s = (y-cy/2)/cy*100
' :: s=r*d0/(d0+z)
'while 1
d0=3 'trial and error
r=60
r=cy*2/5
y0=1.5*cy   'base is lower 3/4
yMx=0.5*cy  'horison is upprt 1/4
for z = 10 to 0 step -1
'for y = cy/2 to 2*cy-cy/2 step 30 'z-order
    skip1=0
   if z=2 or z = 3 then  skip1=1
   sc=1*d0/(d0+z)  'scale, always <=1
   s=r*sc
   'y=y0-sc*2*cy
   y=yMx+sc*cy   'other way round
   's=(y-cy/2)/cy*100
   'for x = -100*s to 2*cx+s step 1.4*s
   'x=50+randRange(0, 1.5*s)
   'while x<= 2*cx-50-s
   'for x = 50 to 2*cx-50-s step 1.5*s
   for x = -4.5 to 4.5
       skip2 =0
       if x=-1.5 or x = 1.5 then skip2=1
   'for i = 1 to 2*cx/s
       'x = cx-s/2
       'x=randRange(50,2*cx-50-s)
       'y = 1.2*cy-(z-1)*70
       xx=cx+x*s*1.7
       'call boxf xx, y, s
       if skip1+skip2=0 then
           call housef xx, y, s
       else
           call bottom xx, y, s
       end if
       SCAN
       '#gr "flush"
   'notice "?"
       'x=x+s+randRange(0, 1.5*s)
   'wend
   [nxtX]
   next
   'notice z;" ";sc;" ";s;" ";y
   'notice "?"
   [nxt]
next
dx=dx+1
call pause 100
   'notice "?"
'#gr "cls"
'wend

#gr "flush"
wait

[quit]
   timer 0
   close #gr
end

sub box x, y, s
'from bottom center
'was:from lower left
   #gr$, "place ";x-s/2;" ";y
   #gr$, "box ";x+s/2;" ";y-s
end sub

sub boxf x, y, s   'from lower left
'from bottom center
'was:from lower left
   #gr$, "place ";x-s/2;" ";y
   #gr$, "boxfilled ";x+s/2;" ";y-s
end sub

sub bottom x, y, s
'from bottom center
   #gr$, "place ";x-s/2;" ";y
   #gr$, "goto  ";x+s/2;" ";y
end sub

sub housef x, y, s
'from bottom center
   sq2=sqr(2)
   #gr$, "place ";x;" ";y-1.5*s
   '#gr$, "circle 10"
   '#gr$, "piefilled 50 50 45 90";
   #gr$, "piefilled ";s*sq2;" ";s*sq2;" 42 90"
   #gr$, "place ";x-s/2;" ";y
   #gr$, "boxfilled ";x+s/2;" ";y-s
end sub

'*****************************************************
'function returns a random integer in range [Min, Max)
function randRange(Min, Max)
   randRange = Min +  random(Max-Min)
end function

'*****************************************************
'function returns a random integer in range [0, n)
function random(n)
   random = int(rnd(1)*n)
end function

sub pause mil
   SCAN
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
   exit sub
 [quit]
   timer 0
   close #gr
end

end sub


[colinmcm]

When you fill them in, can I please have a green one and a pink one and a blue one and a yellow one?

[tenochtitlanuk]

'....and they ( no longer!) all come out the same....'

Pete Seeger 1963 for those who weren't there......

Little boxes on the hillside
Little boxes made of ticky tacky
Little boxes
Little boxes
Little boxes all the same
There's a green one and a pink one
And a blue one and a yellow one
And they're all made out of ticky tacky
And they all look just the same
And the people in the houses all go to the university
And they all get put in boxes, little boxes all the same
And there's doctors and there's lawyers
And business executives
And they're all made out of ticky tacky and they all look just the same
And they all play on the golf course and drink their martini dry
And they all have pretty children and the children go to school
And the children go to summer camp
And then to the university
And they all get put in boxes, and they all come out the same
And the boys go into business and marry and raise a family
And they all get put in boxes, little boxes all the same
There's a green one, and a pink one
And a blue one and a yellow one
And they're all made out of ticky tacky
And they all look just the same

[tenochtitlanuk]

....HSV coloured houses...

[tenochtitlanuk]

...and for completeness...

[colinmcm]

Da Iawn. Diolch. Looks just like the view from my sofa.

[tenochtitlanuk]

Diolch i ti hefyd.
Nice to see some Welsh on here.
My wife comes from a row of Welsh terrace houses in Swansea- so it's now my spiritual home.

JohnF