; *********************************************************************

; ***               A demo of Power LOGO graphics                   ***

; *********************************************************************


make "demo [
   procedure [ [ ] [ ] [ :abort-screen :abort-window ] ]
   pr [ ]
   pr [ ]
   pr [ Welcome to the Power LOGO graphics demo! ]
   say [ Welcome to the Power lo go graphics demo ]
   pr [ ]
   dowhile
   [  about-windows
      about-turtles
      double-dragon
      inc-spiral
      nested-snowflake
      multi-ferns
      if namep "scram [ ] [ ( seedrand * 100 seconds ) make "scram 1 ] ]
   [ requester [ Would you like to see the demo again? ] ]
   if requester [ Do you want to quit LOGO? ] [ quit ] [ ] ]


; *********************************************************************


make "about-windows [
   procedure [ [ ] [ ] [ :dw1 :dw2 :dt1 :dt2 ] ]
   make "dw1 ( openwindow @0 0 [ Demo Window 1 ] 100 30 440 160 2 3 )
   make "dt1 openturtle :dw1
   setpen :dw1 1
   move :dw1 25 30
   text :dw1 [ With PowerLOGO you can open your own ]
   move :dw1 25 40
   text :dw1 [ custom graphics screens, windows, and turtles. ]
   say [ With power lo go you can open your own
         custom graphics screens, windows, and turtles. ]
   make "dw2 ( openwindow @0 15 [ Demo Window 2 ] 400 130 240 70 2 1 )
   make "dt2 ( openturtle :dw2 1 )
   setpen :dw2 3
   move :dw2 25 30
   text :dw2 [ As many as you wish. ]
   say [ As many as you, wish. ]
   wait 0.5

   clean
   setfont :dw1 "diamond 20
   move :dw1 25 50
   setpen :dw1 3
   text :dw1 [ Text may be in any font, ]
   setstyle :dw1 7
   move :dw1 25 75
   text :dw1 [ any style, ]
   setpen :dw1 1
   text :dw1 [ or any color. ]
   say [ Text may be in any font, any style, or any color. ]
   wait 0.5

   move :dw1 25 30
   setstyle :dw1 4
   setdrmode :dw1 1
   ( setpen :dw1 2 1 )
   clean
   text :dw1 [ You may use coordinate graphics: ]
   say [ You may use co ordinate graphics: ]
   move :dw1 25 55
   text :dw1 [ draw, flood, copy, ... ]
   say [ draw, flood, copy, \  ]

   move :dw1 100 100
   draw :dw1 200 130
   draw :dw1 300 100
   draw :dw1 400 140
   draw :dw1 200 140
   draw :dw1 20  120
   draw :dw1 100 100
   wait 0.2

   setpen :dw2 1
   move :dw2 100 30
   draw :dw2 200 20
   draw :dw2 200 60
   draw :dw2 100 50
   draw :dw2 100 30
   wait 1

   ( setpen :dw1 1 2 )
   setpen :dw1 3
   floodol :dw1 100 110
   wait 0.2

   setpen :dw2 2
   floodpc :dw2 150 40
   wait 1

   copyrect :dw2 90 15 :dw1 20 90 120 50
   wait 0.2
   copyrect :dw2 90 15 :dw1 150 70 120 50
   wait 0.2
   copyrect :dw2 90 15 :dw1 280 85 120 50
   wait 1

   move :dw1 25 30
   clean
   text :dw1 [ And of course turtle graphics. ]
   say [ And of course turtle graphics. ]
   ( settpn 1 0 :dt1 )
   ( settpn 3 0 :dt2 )
   rt 18 bk 12 cornerpoly 22 144 3 0.42 
   wait 1

   ( closewindow :dw1 :dw2 ) ]


make "cornerpoly [
   procedure [ [ :size :angle :limit :factor ] [ ] [ :totalturn ] ]
   if =0 :limit [ stop ] [ ]
   make "totalturn 0
   dowhile 
   [  fd :size
      cornerpoly * :factor :size +- :angle - :limit 1 :factor
      rt :angle
      make "totalturn + :totalturn :angle ]
   [  not =0 remainder :totalturn 360 ] ]


; *********************************************************************


make "about-turtles [
   procedure [ [ ] [ ] [ :ds1 :dw1 :dt1 :dt2 :dt3 :dt4 :d :tl :ct ] ]
   recycle
   make "ds1 ( openscreen 3 2 [ ] )
   set-abort :ds1
   setrgb :ds1 0 [  0  0  0 ]
   setrgb :ds1 1 [ 15  0  0 ]
   setrgb :ds1 2 [  0 15  0 ]
   setrgb :ds1 3 [ 13 13 13 ]
   make "dw1 openwindow :ds1
   ( intuition 7 :ds1 0 )
   make "dt1 ( openturtle :dw1 3.8 0.88 128 350 0 0 )
   ( settpn 1 0 :dt1 )
   ( wrap :dt1 )
   make "dt2 ( openturtle :dw1 3.8 0.88 256 350 0 -1 )
   ( settpn 1 0 :dt2 )
   ( settpn 2 1 :dt2 )
   ( settdm 1 :dt2 )
   ( settlp "xxx-----xxx----- :dt2 )
   make "dt3 ( openturtle :dw1 2 0.88 384 350 0 0 )
   ( settpn 2 0 :dt3 )
   make "dt4 ( openturtle :dw1 5 0.88 512 350 0 0 )
   ( settpn 3 0 :dt4 )
   ( settlp "xxxxxxxx---xx--- :dt4 )

   setfont :dw1 "diamond 20
   setpen :dw1 2
   move :dw1 50 27
   text :dw1 [ Each turtle can have it's own pens, line pattern, ]
   move :dw1 50 52
   text :dw1 [ sense of distance, and sense of direction. ]
   say [ Each turtle can have it's own penz, line pattern,
         sense of distance, andsense ofdirection. ]
   move :dw1 50 76
   text :dw1 [ Turtles may be used all together, ]
   say [ Turtles may be used all together, ]
   rt 165
   repeat 2 [
      make "d 2
      repeat 26 [
         fd :d
         rt 124.21
         make "d + :d 1 ] ]
   wait 0.2

   move :dw1 50 100
   text :dw1 [ one at a time, ]
   say [ one at a time, ]
   make "tl ( list :dt1 :dt2 :dt3 :dt4 )
   repeat 4 [
      make "ct first :tl
      make "tl bf :tl
      make "d 2
      repeat 26 [
         ( fd :d :ct )
         ( rt 124.21 :ct )
         make "d + :d 1 ]
      wait 0.2 ]

   text :dw1 [ or in any combination. ]
   say [ or in any combination. ]
   make "tl ( list :dt2 :dt4 )
   make "d 2
   repeat 26 [
      ( fd :d :tl )
      ( rt 124.21 :tl )
      make "d + :d 1 ]
   wait 0.2
   make "tl ( list :dt1 :dt2 :dt3 )
   make "d 2
   repeat 26 [
      ( fd :d :tl )
      ( rt 124.21 :tl )
      make "d + :d 1 ]
   wait 0.2
   make "tl ( list :dt1 :dt3 )
   make "d 2
   repeat 26 [
      ( fd :d :tl )
      ( rt 124.21 :tl )
      make "d + :d 1 ]
   wait 0.2

   repeat 10 [
      make "d 2
      repeat 26 [
         fd :d
         rt 124.21
         make "d + :d 1 ] ]
   wait 1

   clear-abort
   closescreen :ds1 ]


; *********************************************************************


make "double-dragon [
   procedure [ [ ] [ ] [ :ds1 :dw1 :dt1 :dt2 ] ]
   recycle
   make "ds1 ( openscreen 3 1 [ ] )
   set-abort :ds1
   setrgb :ds1 0 [  0  0  0 ]
   setrgb :ds1 1 [ 15  2  0 ]
   make "dw1 openwindow :ds1
   ( intuition 7 :ds1 0 )
   make "dt1 ( openturtle :dw1 3.8 0.88 150 288 0 0 )
   ( settpn 1 0 :dt1 )
   make "dt2 ( openturtle :dw1 3.8 0.88 490 288 0 -1 )
   ( settpn 1 0 :dt2 )
   s-dragon 70 2 35
   wait 10
   clear-abort
   closescreen :ds1 ]


;  s-dragon       size limit angle
;     Size limit dragon.
;  s-dragon 50 5 45

make "s-dragon [
   procedure [ [ :size :size-limit :angle1 ] [ ] [ :leg1 :leg2 :angle2 ] ]
   make "angle2 - 90 :angle1
   make "leg1  /  * 0.5 sin - 180 * 2 :angle1  sin :angle1
   make "leg2  /  * 0.5 sin - 180 * 2 :angle2  sin :angle2
   s-dragon1 :size 1 ]

make "s-dragon1 [
   procedure [ [ :size :par ] ]
   if > :size-limit :size [ fd :size stop ] [ ]
   if >0 :par
      [  rt :angle1
         s-dragon1 * :size :leg1 1
         lt 90
         s-dragon1 * :size :leg2 -1
         rt :angle2 ]
      [  lt :angle2
         s-dragon1 * :size :leg2 1
         rt 90
         s-dragon1 * :size :leg1 -1
         lt :angle1 ] ]


; *********************************************************************


make "inc-spiral [
   procedure [ [ ] [ ] [ :ds1 :dw1 :dt1 ] ]
   recycle
   make "ds1 ( openscreen 3 2 [ ] )
   set-abort :ds1
   setrgb :ds1 0 [  0  0  0 ]
   setrgb :ds1 1 [ 15 15 15 ]
   setrgb :ds1 2 [  0  0  4 ]
   setrgb :ds1 3 [ 10  2  0 ]
   make "dw1 openwindow :ds1
   ( intuition 7 :ds1 0 )
   make "dt1 ( openturtle :dw1 )
   ( settpn 1 0 :dt1 )
   pu
   settpos [ 104.1 48.3 ]
   seth 277.5
   pd
   ( inspi 3.3 349 3.25 1338 )
   setdrmode :dw1 1
   setafpt :dw1 [ xxx----x----xxxx
                  xx-----x-----xxx
                  x-----xxx-----xx
                  -----xxxxx-----x
                  ----xxxxxxx----x
                  x--xxxxxxxxx--xx
                  xxxxxxxxxxxxxxxx
                  x--xxxxxxxxx--xx
                  ----xxxxxxx----x
                  -----xxxxx-----x
                  x-----xxx-----xx
                  xx-----x-----xxx
                  xxx----x----xxxx
                  xxxx--xxx--xxxxx
                  xxxxxxxxxxxxxxxx
                  xxxx--xxx--xxxxx ]
   ( setpen :dw1 3 0 )
   ( setpen :dw1 2 1 )
   floodpc :dw1 0 0
   setafpt :dw1 [ x-------x-------
                  x-------x-------
                  -x-------x------
                  -x-------x------
                  --x-------x-----
                  --x-------x-----
                  ---x-------x----
                  ---x-------x----
                  ----x-------x---
                  ----x-------x---
                  -----x-------x--
                  -----x-------x--
                  ------x-------x-
                  ------x-------x-
                  -------x-------x
                  -------x-------x ]
   ( setpen :dw1 3 0 )
   ( setpen :dw1 0 1 )
   floodpc :dw1 630 390
   wait 15
   clear-abort
   closescreen :ds1 ]


make "inspi [
   procedure [ [ :side :angle :i-inc :steps ] ]
   repeat :steps
   [  fd :side
      rt :angle
      make "angle remainder + :angle :i-inc 360 ] ]


; *********************************************************************


make "nested-snowflake [
   procedure [ [ ] [ ] [ :ds1 :dw1 :dt1 :d :c :i :s ] ]
   recycle
   make "ds1 ( openscreen 3 3 )
   set-abort :ds1
   setrgb :ds1 0 [  0  0  0 ]
   setrgb :ds1 1 [  0 15  0 ]
   setrgb :ds1 2 [ 14  2  0 ]
   setrgb :ds1 3 [  2 13  4 ]
   setrgb :ds1 6 [  8  8  8 ]
   make "dw1 openwindow :ds1
   ( intuition 7 :ds1 0 )
   make "dt1 openturtle :dw1
   make "s 112
   make "i 4
   repeat 4 [
      make "d :i
      make "c 2
      repeat + 1 :i [
         ( settpn :c 0 :dt1 )
         setpen :dw1 :c
         snowflake :s :d
         floodpc :dw1 320 200
         make "c + 1 :c
         make "d - :d 1 ]
      make "s / :s 2
      make "i - :i 1 ]
   wait 15
   clear-abort
   closescreen :ds1 ]


make "snowflake [
   procedure [ [ :size :depth ] [ ] [ :d ] ]
   make "d * 0.577350269189626 :size
   pu
   bk :d
   lt 30
   pd
   flake :size :depth
   rt 120
   flake :size :depth
   rt 120
   flake :size :depth
   rt 150
   pu
   fd :d ]


make "flake [
   procedure [ [ :size :depth ] ]
   if =0 :depth [ fd :size stop ] [ ]
   make "size / :size 3
   make "depth - :depth 1
   flake :size :depth
   lt 60
   flake :size :depth
   rt 120
   flake :size :depth
   lt 60
   flake :size :depth ]


; *********************************************************************


make "multi-ferns [
   procedure [ [ ] [ ] [ :ds1 :dw1 :dt1 :p :c :i :t ] ]
   recycle
   make "ds1 ( openscreen 3 3 )
   set-abort :ds1
   setrgb :ds1 0 [  0  0  0 ]
   make "dw1 ( openwindow :ds1 224 )
   ( intuition 7 :ds1 0 )
   make "c [   [  9 12  1 ]
               [ 15 13  0 ]
               [  9  8  0 ]
               [  3  9  1 ]
               [  0 10  1 ]
               [  0 12  0 ]
               [  1 14  0 ] ]
   make "p [   "-xxxx-----xxxx--
               "--xx-xxx-xx-----
               "x-----x------xxx
               "x-xxx--xx---xxx-
               "--xxxxx--xxxxx--
               "xx-----xxx-xxxxx ]
   make "i 1
   repeat 7 [
      make "dt1 ( openturtle  :dw1
                              + 1.4 * 3.5 rand
                              0.88
                              320
                              395
                              0
                              +- random 2 )
      ( settpn :i 0 :dt1 )
      ( settpn + 1 random 7 1 :dt1 )
      ( rt - random 120 60 :dt1 )
      setrgb :ds1 :i item :i :c
      ( settlp item + 1 random 6 :p :dt1 )
      make "i + 1 :i ]
   settdm 1
   fern2 80 2.8 4 0.35 0.3 60
   clear-abort
   setpen :dw1 2
   move :dw1 164 10
   text :dw1 [ End of demo. Press any key to continue. ]
   say [ End of demo. Press any key to continue. ]
   sleep
   closescreen :ds1 ]


;  fern2          size size-limit curl thickness node-spacing branch-angle
;     A more versatile fern leaf.
;  fern2 90 3 2 0.2 0.1 60
;  fern2 90 3 2 0.3 0.18 60
;  fern2 90 2 4 0.35 0.3 60

make "fern2 [
   procedure [ [ :size :limit :curl :thick :nspace :angle ] [ ]
               [ :d1 :d2 :a1 ] ]
   make "d1 * :size :nspace
   make "d2 * - 1 :nspace :size
   fd :d1
   if > :limit :size
   [  make "a1 atan / :thick - 1 :nspace
      fd :d2
      rt :a1
      bk :d2
      fd :d2
      lt + :a1 :a1
      bk :d2
      fd :d2
      rt :a1
      bk :d2 ]
   [  rt :curl
      fern2 :d2 :limit :curl :thick :nspace :angle
      rt - :angle :curl
      fern2 * :thick :size :limit :curl :thick :nspace :angle
      lt + :angle :angle
      fern2 * :thick :size :limit :curl :thick :nspace :angle
      rt :angle ]
   bk :d1 ]


; *********************************************************************


make "requester [
   procedure [ [ :t ] [ ] [ :rw :m ] ]
   make "rw ( openwindow @0 131 [ LOGO Request ] 0 0 400 64 )

   setpen :rw 1
   rectfill :rw 2 10 397 62
   rectfill :rw 4 12 395 60

   setpen :rw 0
   ( setpen :rw 1 1 )
   move :rw 25 27
   text :rw :t

   move :rw 38 48
   text :rw [ YES ]
   move :rw 341 48
   text :rw [ NO ]

   move :rw 20 37
   draw :rw 80 37
   draw :rw 80 54
   draw :rw 20 54
   draw :rw 20 37
   move :rw 319 37
   draw :rw 379 37
   draw :rw 379 54
   draw :rw 319 54
   draw :rw 319 37

   setpen :rw 3
   move :rw 19 36
   draw :rw 81 36
   draw :rw 81 55
   draw :rw 19 55
   draw :rw 19 36
   move :rw 318 36
   draw :rw 380 36
   draw :rw 380 55
   draw :rw 318 55
   draw :rw 318 36

   ( intuition 6 @0 )

   while [ true ]
   [  make "m getmouse
      if = :rw first :m
      [  make "mx item 2 :m
         make "my item 3 :m
         if and   >= :my 36
                  <= :my 55
         [  if and   >= :mx 19
                     <= :mx 81
            [  closewindow :rw
               op true ] [ ]
            if and   >= :mx 318
                     <= :mx 380
            [  closewindow :rw
               op false ] [ ] ] [ ] ] [ ] ] ]
   

; *********************************************************************


make "set-abort [
   procedure [ [ :screen ] ]
   make "abort-screen :screen
   make "abort-window ( openwindow :screen 0 [ ] 540 380 100 20 0 1 )
   setpen :abort-window 1
   move :abort-window 14 12
   text :abort-window [ Quit Demo ]
   while [ mousep ] [ ignore getmouse ]
   whenmouse [ abort-demon ] ]


make "clear-abort [
   procedure [ ]
   closewindow :abort-window
   whenmouse [ ] ]


make "abort-demon [
   procedure [ [ ] [ ] [ :m :comp ] ]
   make "m getmouse
   if = :abort-window first :m
   [  comp-abort
      make "comp true
      while [ true ]
      [  make "m mouse :abort-window
         if =0 last :m
         [  if or <0 first :m <0 item 2 :m
            [  if :comp [ comp-abort ] [ ]
               stop ]
            [  clear-abort
               if requester [ Do you want to quit LOGO? ] [ quit ] [ ]
               while [ not emptyp screenlist ]
                  [ closescreen first screenlist ]
               toplevel ]
         ]
         [  if or <0 first :m <0 item 2 :m
            [  if :comp
               [  comp-abort
                  make "comp false ] [ ] ]
            [  if :comp
               [ ]
               [  comp-abort
                  make "comp true ] ]
         ]
      ]
   ] [ ]
]


make "comp-abort [
   procedure [ ]
   ( copyrect :abort-window 0 0 :abort-window 0 0 100 20 80 ) ]



; *********************************************************************

launch [ demo ]