Activities/Turtle Art/Tutorials/Logo Code for Turtle Art Turing Machine: Difference between revisions

Mokurai (talk | contribs)
Turing Machine in Logo
 
Rdrsadhu (talk | contribs)
Migrate to GitHub
 
(One intermediate revision by one other user not shown)
Line 1: Line 1:
Logo code saved from Turtle Art Turing Machine session
== Turtle Art/Tutorials/Logo Code for Turtle Art Turing Machine ==


<pre>window
Read at https://help.sugarlabs.org/turtleart_tutorials/logo_code_for_turing_machine.html


comment: functions that implement Turtle Art blocks
The source file has been moved to [https://github.com/godiard/help-activity/blob/master/source/turtleart_tutorials/logo_code_for_turing_machine.rst GitHub]
 
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
</pre>