Activities/Turtle Art/Tutorials/Logo Code for Turtle Art Turing Machine

Logo code saved from Turtle Art Turing Machine session

window

comment: functions that implement Turtle Art blocks

to tasetpalette :i :r :g :b :myshade 
make "s ((:myshade - 50) / 50) 
ifelse lessp :s 0 [ 
make "s (1 + (:s *0.8)) 
make "r (:r * :s) 
make "g (:g * :s) 
make "b (:b * :s) 
] [ make "s (:s * 0.9) 
make "r (:r + ((99-:r) * :s)) 
make "g (:g + ((99-:g) * :s)) 
make "b (:b + ((99-:b) * :s)) 
] setpalette :i (list :r :g :b) 
end 


to rgb :myi :mycolors :myshade 
make "myr first :mycolors 
make "mycolors butfirst :mycolors 
make "myg first :mycolors 
make "mycolors butfirst :mycolors 
make "myb first :mycolors 
make "mycolors butfirst :mycolors 
tasetpalette :myi :myr :myg :myb :myshade 
output :mycolors 
end 


to processcolor :mycolors :myshade 
if emptyp :mycolors [stop] 
make "i :i + 1 
processcolor (rgb :i :mycolors :myshade) :myshade 
end 


to tasetshade :shade 
make "myshade modulo :shade 200 
if greaterp :myshade 99 [make "myshade (199-:myshade)] 
make "i 7 
make "mycolors :colors 
processcolor :mycolors :myshade 
end 


to tasetpencolor :c 
make "color (modulo (round :c) 100) 
setpencolor :color + 8 
end 


make "colors [
 99  0  0
 99  5  0
 99 10  0
 99 15  0
 99 20  0
 99 25  0
 99 30  0
 99 35  0
 99 40  0
 99 45  0
 99 50  0
 99 55  0
 99 60  0
 99 65  0
 99 70  0
 99 75  0
 99 80  0
 99 85  0
 99 90  0
 99 95  0
 99 99  0
 90 99  0
 80 99  0
 70 99  0
 60 99  0
 50 99  0
 40 99  0
 30 99  0
 20 99  0
 10 99  0
  0 99  0
  0 99  5
  0 99 10
  0 99 15
  0 99 20
  0 99 25
  0 99 30
  0 99 35
  0 99 40
  0 99 45
  0 99 50
  0 99 55
  0 99 60
  0 99 65
  0 99 70
  0 99 75
  0 99 80
  0 99 85 
  0 99 90
  0 99 95
  0 99 99
  0 95 99
  0 90 99
  0 85 99
  0 80 99
  0 75 99
  0 70 99
  0 65 99
  0 60 99
  0 55 99 
  0 50 99
  0 45 99
  0 40 99
  0 35 99
  0 30 99
  0 25 99
  0 20 99
  0 15 99
  0 10 99
  0  5 99
  0  0 99
  5  0 99
 10  0 99
 15  0 99
 20  0 99
 25  0 99
 30  0 99
 35  0 99
 40  0 99
 45  0 99
 50  0 99
 55  0 99
 60  0 99
 65  0 99
 70  0 99
 75  0 99
 80  0 99
 85  0 99
 90  0 99
 95  0 99
 99  0 99
 99  0 90
 99  0 80
 99  0 70
 99  0 60
 99  0 50
 99  0 40
 99  0 30
 99  0 20
 99  0 10] 
make "shade  50 
tasetshade :shade 


to tapop
if emptyp :taheap [stop]
make "tmp first :taheap
make "taheap butfirst :taheap
output :tmp
end


to taminus :y :x
output sum :x minus :y
end


to tasetxy :x :y
setxy :x :y
end


comment: Turing Machine procedures


to turtleblocks_0
comment: Comment
 #sTuring_Machine 
end


to start
comment: main program
comment: Creates and initializes necessary variables, writes program block, writes tape, runs program
 clean #sSetup #sProgram #sTape #sExecute 
end


to #sSetup
comment: Create variables, set initial values
 right 90.0
 setpensize 25.0
 tasetpencolor 0.0
 tasetshade 50.0 penup
 make "#scell 0.0
 make "#ssymbol 0.0
 make "#smove 0.0
 make "#sstate 1.0
 make "#sleftedge -390.0
 make "#stapey 290.0
 make "#sprogramy 200.0
 make "#scellwidth 25.0
 make "#sright 1.0
 make "#shalt 4.0 
 make "#sA 3.0
 make "#sB 2.0
end


to #sTape
comment: Write initial tape. User can change values in repeat statements to change arguments.
 #sToTape
 pendown
 tasetpencolor 20.0
 repeat #sA [ #sWriteCell ] 
 tasetpencolor 0.0
 #sWriteCell
 tasetpencolor 20.0
 repeat #sB [ #sWriteCell ] 
 tasetpencolor 0.0
 #sWriteCell #sToTape penup 
end


to #sProgram
comment: Write program table
 tasetxy :#sleftedge :#sprogramy
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 40.0
 #sWriteCell
 tasetxy :#sleftedge taminus ycor :#scellwidth 
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 20.0
 #sWriteCell
 tasetxy :#sleftedge taminus ycor :#scellwidth 
 tasetpencolor 0.0
 #sWriteCell
 tasetpencolor 0.0
 #sWriteCell
 tasetpencolor 60.0
 #sWriteCell
 stack1 
end

to stack1
comment: Continuation of Program so that the segments fit on the Turtle Art screen
 tasetxy :#sleftedge taminus ycor :#scellwidth 
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 40.0
 #sWriteCell
 tasetxy :#sleftedge taminus ycor :#scellwidth 
 tasetpencolor 0.0
 #sWriteCell
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 80.0
 #sWriteCell
 tasetxy
  :#sleftedge taminus ycor
  :#scellwidth
 tasetpencolor 0.0
 #sWriteCell
 tasetpencolor 20.0
 #sWriteCell
 tasetpencolor 80.0
 #sWriteCell
 penup 
end


to #sExecute

comment: Test for halt or next program step
 make "#sstep 0.0
 forever 
  [ ifelse ( equal? :#sstate :#shalt )
  [  stop ]
  [ #sReadPixel
    #sSetValue
    make "#ssymbol :#sValue
    #sToProgram
    wait 1.0
    #sSetSymbol
    forward :#scellwidth
    #sSetMove
    forward :#scellwidth
    #sSetState
    #sLog
    #sToTape
    #sWriteSymbol
    #sNewCell
    wait 1.0
    make "#sstep sum :#sstep 1.0 ] ] 
end


to #sToTape
comment: Move turtle to current cell on tape
 tasetxy
  sum :#sleftedge product :#scellwidth :#scell
  :#stapey 
end


to #sToProgram
comment: Move Turtle to beginning of current program row to execute
 tasetxy
  taminus :#sleftedge 3.0 
  taminus :#sprogramy product :#scellwidth sum :#ssymbol product 2.0 taminus :#sstate 1.0 
end


to #sWriteCell

comment: Write current color to current cell, and move to next cell
 pendown
 forward 0.0
 penup
 forward :#scellwidth 
end


to #sWriteSymbol
comment: Write current color in cell without moving
 pendown
 forward 0.0
 penup 
end


to #sReadPixel

comment: Read RGB values of pixel to stack, pop to variables
 keyboard
 make "#sR tapop
 make "#sG tapop
 make "#sB tapop 
end


to #sSetValue
comment: Find value of cell symbol from RGB numbers
  ifelse not ( equal? :#sB 128.0 ) 
   [  ifelse not ( equal? :#sR 128.0 ) 
    [  ifelse not ( equal? :#sG 128.0 ) 
     [  ifelse ( equal? :#sG 0.0 )
     [  make "#sValue 0.0 ]
    [ make "#sValue 1.0 ] ]
   [ make "#sValue 3.0 ] ]
  [ make "#sValue 4.0 ] ]
 [ make "#sValue 2.0 ] 
end


to #sSetMove
comment: Read next Move direction from program table
 #sReadPixel
 #sSetValue
 make "#smove :#sValue 
end


to #sSetSymbol
comment: Read next Symbol to write from program table
 #sReadPixel
 #sSetValue
 make "#ssymbol :#sValue 
 ifelse ( equal? :#ssymbol 0.0 )
  [  tasetpencolor 0 ]
  [ tasetpencolor 20.0 ] 
end


to #sSetState
comment: Read next State from program table
 #sReadPixel
 #sSetValue
 make "#sstate :#sValue 
end


to #sNewCell
comment: Move left or right and set cell number of new location
  ifelse ( equal? :#smove :#sright )
   [ forward :#scellwidth
     make "#scell sum :#scell 1.0 ]
   [ back :#scellwidth
     make "#scell taminus :#scell 1.0 ] 
end


to #sLog
comment: Write Step number, Symbol, Move, State, Cell number on new log line in black, saving and restoring
comment: current position and current color
 make "#sx xcor
 make "#sy ycor
 tasetxy -300.0 taminus 200.0 product 20.0 :#sstep 
 make "#scolor pencolor
 tasetpencolor 0
 label sentence ('box', "427)
 #sstep
 forward 30.0
 label sentence ('box', "339)
 #ssymbol
 forward 20.0
 label sentence ('box', "341)
 #smove
 forward 20.0
 label sentence ('box', "537)
 #sstate
 forward 20.0
 label sentence ('box', "562)
 #scell
 tasetpencolor :#scolor 
end