Task: Dragon curve








VB: option explicit


const pi180= 0.01745329251994329576923690768489 
const pi=3.1415926535897932384626433832795 
class turtle
   
   dim fso
   dim fn
   dim svg
   
   dim iang  
   dim ori   
   dim incr
   dim pdown
   dim clr
   dim x
   dim y

   public property let orient(n):ori = n*pi180 :end property
   public property let iangle(n):iang= n*pi180 :end property
   public sub pd() : pdown=true: end sub 
   public sub pu()  :pdown=FALSE :end sub 
   
   public sub rt(i)  
     ori=ori - i*iang:
     
   end sub 
   public sub lt(i):  
     ori=(ori + i*iang) 
     
   end sub
   
   public sub bw(l)
      x= x+ cos(ori+pi)*l*incr
      y= y+ sin(ori+pi)*l*incr
     
   end sub 
   
   public sub fw(l)
      dim x1,y1 
      x1=x + cos(ori)*l*incr
      y1=y + sin(ori)*l*incr
      if pdown then line x,y,x1,y1
      x=x1:y=y1
   end sub
   
   Private Sub Class_Initialize()  
      setlocale "us"   
      initsvg
      x=400:y=400:incr=100
      ori=90*pi180
      iang=90*pi180
      clr=0
      pdown=true
   end sub
   
   Private Sub Class_Terminate()   
      disply
   end sub
   
   private sub line (x,y,x1,y1)
      svg.WriteLine "<line x1=""" & x & """ y1= """& y & """ x2=""" & x1& """ y2=""" & y1 & """/>"
   end sub 

   private sub disply()
       dim shell
       svg.WriteLine "</svg></body></html>"
       svg.close
       Set shell = CreateObject("Shell.Application") 
       shell.ShellExecute fn,1,False
   end sub 

   private sub initsvg()
     dim scriptpath
     Set fso = CreateObject ("Scripting.Filesystemobject")
     ScriptPath= Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
     fn=Scriptpath & "SIERP.HTML"
     Set svg = fso.CreateTextFile(fn,True)
     if SVG IS nothing then wscript.echo "Can
     svg.WriteLine "<!DOCTYPE html>" &vbcrlf & "<html>" &vbcrlf & "<head>"
     svg.writeline "<style>" & vbcrlf & "line {stroke:rgb(255,0,0);stroke-width:.5}" &vbcrlf &"</style>"
     svg.writeline "</head>"&vbcrlf & "<body>"
     svg.WriteLine "<svg xmlns=""http://www.w3.org/2000/svg"" width=""800"" height=""800"" viewBox=""0 0 800 800"">" 
   end sub 
end class

sub dragon(st,le,dir)
if st=0 then x.fw le: exit sub
  x.rt dir
  dragon st-1, le/1.41421 ,1
  x.rt dir*2
  dragon st-1, le/1.41421 ,-1
  x.rt dir
end sub

 
dim x
set x=new turtle
x.iangle=45
x.orient=45
x.incr=1
x.x=200:x.y=200
dragon 12,300,1
set x=nothing   


COBOL:          >>SOURCE FORMAT FREE

identification division.
program-id. dragon.
environment division.
configuration section.
repository. function all intrinsic.
data division.
working-storage section.
01  segment-length pic 9 value 2.
01  mark pic x value '.'.
01  segment-count pic 9999 value 513.

01  segment pic 9999.
01  point pic 9999 value 1.
01  point-max pic 9999.
01  point-lim pic 9999 value 8192.
01  dragon-curve.
    03  filler occurs 8192.
        05  ydragon pic s9999.
        05  xdragon pic s9999.

01  x pic s9999 value 1.
01  y pic S9999 value 1.

01  xdelta pic s9 value 1. 
01  ydelta pic s9 value 0.

01  x-max pic s9999 value -9999.
01  x-min pic s9999 value 9999.
01  y-max pic s9999 value -9999.
01  y-min pic s9999 value 9999.

01  n pic 9999.
01  r pic 9.

01  xupper pic s9999.
01  yupper pic s9999.

01  window-line-number pic 99.
01  window-width pic 99 value 64.
01  window-height pic 99 value 22.
01  window.
    03  window-line occurs 22.
        05  window-point occurs 64 pic x.

01  direction pic x.

procedure division.
start-dragon.

    if segment-count * segment-length > point-lim
        
        compute segment-count = point-lim / segment-length
    end-if

    perform varying segment from 1 by 1
    until segment > segment-count

        
        
        
        

        
        divide 2 into segment giving n remainder r
        perform until r <> 0
            divide 2 into n giving n remainder r
        end-perform
        divide 2 into n giving n remainder r

        
        evaluate r also xdelta also ydelta
        when 0 also 1 also 0  
        when 1 also -1 also 0 
            
            move 0 to xdelta
            move 1 to ydelta
        when 1 also 1 also 0  
        when 0 also -1 also 0 
            
            move 0 to xdelta
            move -1 to ydelta
        when 0 also 0 also 1  
        when 1 also 0 also -1 
            
            move 0 to ydelta
            move -1 to xdelta
        when 1 also 0 also 1  
        when 0 also 0 also -1 
            
            move 0 to ydelta
            move 1 to xdelta
        end-evaluate

        
        perform segment-length times
            add xdelta to x
            add ydelta to y

            move x to xdragon(point)
            move y to ydragon(point)

            add 1 to point
        end-perform

        
        compute x-max = max(x, x-max)
        compute x-min = min(x, x-min)
        compute y-max = max(y, y-max)
        compute y-min = min(y, y-min)
        move point to point-max

    end-perform

    
    
    
    
    

    move 1 to yupper xupper

    perform with test after
    until direction <> 'h' and 'j' and 'k' and 'l'

        
        
        

        
        evaluate true
        when direction = 'h' 
        and xupper > x-min + window-width
           subtract 1 from xupper
        when direction = 'j' 
        and yupper < y-max - window-height
           add 1 to yupper
        when direction = 'k' 
        and yupper > y-min + window-height
           subtract 1 from yupper
        when direction = 'l' 
        and xupper < x-max - window-width
            add 1 to xupper
        end-evaluate

        
        move spaces to window
        perform varying point from 1 by 1
        until point > point-max
            if ydragon(point) >= yupper and < yupper + window-height
            and xdragon(point) >= xupper and < xupper + window-width
                
                compute y = ydragon(point) - yupper + 1
                compute x =  xdragon(point) - xupper + 1
                move mark to window-point(y, x)
            end-if
         end-perform

         
         perform varying window-line-number from 1 by 1
         until window-line-number > window-height
             display window-line(window-line-number)
         end-perform

         
         display 'hjkl?' with no advancing
         accept direction
    end-perform

    stop run
    .
end program dragon.