VolksForth/8080/AmstradCPC/TURTDEMO.SCR

1 line
7.0 KiB
Plaintext

\ Turtle-Demo UH 03Dec86 Dieses File enthaelt einige Demonstrationen der Turtle-Grafik. Starten mit: INCLUDE TURTDEMO.SCR Einige Definitionen sind im Original in LOGO geschrieben, ihre Uebertragung konnte quasi 1 zu 1 geschehen. (Umsetzung von Prefix- in Postfix-Notation) \ Turtle-Demo UH 10Oct86 \needs Graphics include grafik.scr include turtle.scr 1 4 +thru : weiter key drop ; rosette weiter dreiecke weiter siedlung weiter $40 6 hilbert weiter \ n-eck UH 10Oct86 : eck ( seitenlaenge n -- ) &360 over / swap 0 DO over fd dup lt LOOP 2drop ; : quadrat 4 eck ; : rosette page home &36 0 DO &700 quadrat &10 lt LOOP ; \ Rekursives Drei-eck-muster UH 10Oct86 : muster ( groesse -- ) recursive dup &220 < IF pd 3 eck pu exit THEN 2/ dup muster dup fd dup muster &120 lt dup fd &120 rt dup muster &120 rt fd &120 lt ; : dreiecke ( -- ) page &300 0 setxy &60 seth pu &3500 muster pd ; \ Nikolaushaus UH 10Oct86| : diagonale ( len -- ) &7071 &10000 */ fd ; | : dies ( len -- len ) dup fd ; | : ist ( len -- len ) &45 rt dup diagonale ; | : das ( len -- len ) &90 rt dup diagonale ; | : haus ( len -- len ) &135 rt dup fd ; | : vom ( len -- len ) &135 lt dup 2* diagonale ; | ' haus Alias ni | : ko ( len -- len ) &135 rt dup 2* diagonale ; | ' haus alias laus : nikolaushaus &500 dies ist das haus vom ni ko laus drop ; : siedlung page 0 &170 setxy &10 0 DO &90 seth nikolaushaus pu 0 seth &60 fd pd LOOP ; \ Hilbert-Kurve Byte 9/86 S 14 10Oct86| Defer curvleft : curvright ( size order -- ) recursive dup 0= IF 2drop exit THEN 1- &90 left 2dup curvleft over forward &90 right 2dup curvright over forward 2dup curvright &90 right over forward curvleft &90 left ; : curvleft [ last @ name> is curvleft ] ( size order -- ) dup 0= IF 2drop exit THEN 1- &90 right 2dup curvright over forward &90 left 2dup curvleft over forward 2dup curvleft &90 left over forward curvright &90 right ; : hilbert ( size order -- ) page 0 0 setxy 0 setheading pendown curvright ;