to demo
cs
st
setbitmode 1
setpensize [1 1]
setpencolor [0 0 0]
pennormal
ifelse greaterp first bf machine 30 ~
[settextfont[[Times New Roman] 20 400 0 0 0]] ~
[settextfont[[System] 20 400 0 0 0]]
rt 90
label [I am timing your computer]
make "scale 4
settimer 1 100 [make "scale :scale+1]
repeat 60 [rt 6]
cleartimer 1
make "scale round 100/:scale 
show :scale
st
if not yesnobox "Demo [Welome to MswLogo Demonstration (more?)] [stop]
cs
if not yesnobox [Demo] [Up to 1024 independent turtles (more?)] [stop]
repeat 8 [setturtle repcount-1 rt (repcount-1) * 360/8 fd 100]
wait 60
if not yesnobox [Demo] [Each turtle has it's own Heading and Pen mode (more?)] [stop]
repeat 4*:scale [repeat 8 [setturtle repcount-1 rt (random 30)-15 fd 20]]
if not yesnobox [Demo] [Each turtle can be mapped to a bitmap (more?)] [stop]
cs
pu
repeat 8 [rt 90 label repcount-1 lt 90 bk 20 setbitindex repcount-1 bitcut 20 20 cs]
pd
repeat 8 [setturtle repcount-1 rt (repcount-1) * 360/8 fd 100]
repeat 8 [setturtle repcount-1 bitmapturtle]
wait 60
if not yesnobox [Demo] [The numbers you see are bitmaps, they could be anything (more?)] [stop]
repeat 4*:scale [repeat 8 [setturtle repcount-1 rt (random 30)-15 fd 20]]
if not yesnobox "Demo [MswLogo can do Fonts, at any angle and any color (more?)] [stop]
ifelse greaterp first bf machine 30 ~
[settextfont[[Times New Roman] 50 400 0 0 0]] ~
[settextfont[[System] 50 400 0 0 0]]
cs
ht
pu
repeat 36 [fd 175 setpencolor (list 0 repcount*8 0) label heading bk 175 rt 10]
pd
if not yesnobox "Demo [MswLogo can do Flood Fills (more?)] [stop]
cs 
repeat 18 [pu fd 100 pd repeat 4 [fd 50 rt 90] rt 45 pu fd 5 setfloodcolor (list repcount*15 0 0) fill bk 5 lt 45 bk 100 rt 20]
pd
if not yesnobox "Demo [MswLogo can use the full range of colors (more?)] [stop]
cs 
setpensize [2 2]
clearpalette
repeat 72 [repeat 4 [fd 100 rt 90] setpencolor (list repcount*3 0 0) rt 5]
pu
if not yesnobox "Demo [MswLogo can cut Bitmaps (more?)] [stop]
setxy -50 -50
bitcut 100 100
if not yesnobox "Demo [MswLogo can paste Bitmaps (more?)] [stop]
cs
pu
repeat 36 [fd 150 bitpaste bk 150 rt 10]
if not yesnobox "Demo [MswLogo can even control what you normally control (more?)] [stop]
repeat 10 [scrollx 10]
repeat 10 [scrolly 10]
repeat 10 [scrollx -10]
repeat 10 [scrolly -10]
if not yesnobox "Demo [You can find out what MswLogo is up to at any time (more?)] [stop]
status
cs
pd
setpensize [1 1]
rose 150 30 [pu  setx xcor + 5  pd]
if not yesnobox "Demo [This image will be pasted onto a Neutral background 9 ways (more?)] [stop]
nostatus
setxy 0 0
bitcut 50 50
rt 90
setfloodcolor [125 125 125]
setxy -250 -50
bitblock 550 150
setxy -200 0
repeat 9 [setbitmode repcount bitpaste fd 50]
if not yesnobox "Demo [MswLogo can solve complex problems with your help (more?)] [stop]
nostatus
cs
hanoi 3
pd
if not yesnobox "Demo [MswLogo can make all the sounds you like (more?)] [stop]
cs
repeat 50 [sound (list repcount*10 100)]
if not yesnobox "Demo [MswLogo can even do more than one thing at a time Note that the tone you will here is a timer executing code while the picture is being drawn (more?)] [stop]
cs
settimer 1 1000 [sound [1000 40]]
penpaint
spiral 91 2 10 100
if not yesnobox "Demo [MswLogo can even write Windows programs (more?)] [stop]
cs
cleartimer 1
win
if not yesnobox "Demo [End of Demonstration and the Start of your imagination (more?)] [stop]
end

to drawthing
setpencolor (list scrollbarget "s1 scrollbarget "s2 scrollbarget "s3)
ifelse checkboxget "cb1 [ht] [st]
ifelse checkboxget "cb2 [status] [nostatus]
repeat scrollbarget "s4~
  [~
  if equalp [HEXAGON] listboxgetselect "l1 [repeat 6 [fd 100 rt 60]]~
  if equalp [SQUARE] listboxgetselect "l1 [repeat 4 [fd 100 rt 90]]~
  if equalp [TRIANGLE] listboxgetselect "l1 [repeat 3 [fd 100 rt 120]]~
  run comboboxgettext "c2~
  ]
end

to hanoi :number 
;
; Towers of Hanoi
; Meyer A. Billmers
; November, 1983
;
; This procedure plays a graphic version of the Towers of Hanoi puzzle
; The argument is the number of disks in the configuration.
;
; c.f. putdisk, towercnt,towerset, hanoihlpr
; 
local "from
local "to
local "other
local "datfil
;make "datfil openw "hanoi.dat
;fileprint :datfil (sentence [Hanoi of ] :number [towers Started at: ] time)
; to change the starting and ending needles, change the next three assignments
make "from 1
make "to 3
make "other 2
cs
ht
penpaint
setpensize [5 5]
; first we draw the table and the golden needles
setpencolor [255 0 0]
pu
setxy -350 -100
pd
setxy 350 -100
pu
setx -240
pd
fd 250
pu
setxy -15 -100
pd
fd 250
pu
setxy 210 -100
pd
fd 250
make "tower1 0
make "tower2 0
make "tower3 0
; draw the initial stack of disks. note that putdisk draws the 
; "fixed up" towers.
repeat :number ~
   [~
   putdisk :from :number - repcount + 1 "final ~
   ifelse :from = 1 ~
      [make "tower1 :tower1 + 1] ~
      [ifelse :from = 2 ~
         [make "tower2 :tower2 + 1] ~
         [make "tower3 :tower3 + 1] ~
      ] ~
   ]
hanoihlpr :number :from :to :other
; fileprint :datfil (sentence [Hanoi Ended at: ] time)
; close :datfil
end

to hanoihlpr :number :from :to :other
;
; Called by HANOI. Contains the actual recursive Towers of Hanoi algorithm
;
local "tcf 
local "tct
if equalp :number 0 [stop]
hanoihlpr :number-1 :from :other :to
make "tcf towercnt :from
make "tct towercnt :to
towerset :from :tcf - 1
putdisk :from :number "temp
putdisk :to :number "temp
putdisk :from :number "erase
putdisk :to :number "final
towerset :to :tct + 1
hanoihlpr :number-1 :other :to :from
end

to line :length
fd :length / 2
pu
bk :length
pd
fd :length / 2
end

to myblue
staticupdate "st13 sentence [Blue] scrollbarget "s3
end

to myend
windowdelete "d1
end

to mygreen
staticupdate "st12 sentence [Grn] scrollbarget "s2
end

to mynil
end

to myred
staticupdate "st11 sentence [Red] scrollbarget "s1 
end

to myrepeat
staticupdate "st14 sentence [Repeat Count] scrollbarget "s4 
end

to mystatic
staticupdate "st14 sentence [Repeat Count] scrollbarget "s4 
end

to putdisk :tnum :dnum :state
;
; Called by HANOI to put a disk on a tower.
; first arg. is number of tower (1,2 or 3)
; second arg. is number of disk to draw (1 is smallest)
; third arg. is "final, "temp, or "erase depending on whether
;   disk is drawn in final state, in temporary state to indicate
;   motion, or is being erased (removed from this tower)
; Note that this procedure re-draws the tower correctly.
;
local "tc
local "halfsize
make "tc towercnt :tnum
make "halfsize sum 20 product :dnum 10
pu
ifelse :tnum = 1 ~
   [setxy "-240 "-100] ~
   [ ~
   ifelse :tnum = 2 ~
      [setxy "-15 "-100] ~
      [setxy 210 "-100] ~
   ]
pe
fd product 30 :tc
pu
setxy xcor - :halfsize ycor
pd
penpaint
ifelse :state = "final ~
   [setpencolor [0 255 0]] ~
   [ ~
   ifelse :state = "temp ~
      [setpencolor [0 0 255]] ~
      [pe] ~
   ]
fd 30
rt 90
fd product :halfsize 2
rt 90
fd 30
rt 90
pu
fd :halfsize
rt 90
setpencolor [255 0 0]
ifelse :state = "erase ~
   [ ~
   pd ~
   penpaint ~
   fd 30 ~
   ] ~
   [ ~
   pe ~
   fd 30 ~
   ]
end

to rose :size :petalcount :function
make "ctr 0
do.while ~
   [ ~
   line :size ~
   rt 360 / :petalcount ~
   make "ctr :ctr + 1 ~
   run :function ~
   ] ~
   [:ctr < :petalcount]
end

to setup
staticcreate "d1 "st2 [Run mode] :gapx :mary :cmw :sth
groupboxcreate "d1 "g1 :gapx :sth+:mary :cmw :cmh
checkboxcreate "d1 "g1 "cb1 [Hide Turtle] :gapx+:gapx :sth+:mary+:gapy :btw :bth
checkboxcreate "d1 "g1 "cb2 [Status]      :gapx+:gapx :sth+:mary+:bth+4 :btw :bth

staticcreate "d1 "st3 [Select Post-Command] :wnx2+:gapx :mary :cmw :sth
comboboxcreate "d1 "c2 :wnx2+:gapx :sth+:mary :cmw :cmh
comboboxaddstring "c2 [RT 2]
comboboxaddstring "c2 [RT 5]
comboboxaddstring "c2 [RT 10]
comboboxsettext "c2 [RT 5]

staticcreate "d1 "st4 [Select Shape] :gapx :row2 :lsw :sth
listboxcreate "d1 "l1 :gapx :row2+:sth+1 :lsw :lsh
listboxaddstring "l1 "SQUARE
listboxaddstring "l1 "TRIANGLE
listboxaddstring "l1 "HEXAGON

staticcreate "d1 "st11 "Red :wnx6*3+:gapx :row2 :st2w :sth
scrollbarcreate "d1 "s1 :wnx6*3+:gapx :row2+:sth :scw :sch [myred]
scrollbarset "s1 1 255 125 myred

staticcreate "d1 "st12 "Grn :wnx6*4+:gapx :row2 :st2w :sth
scrollbarcreate "d1 "s2 :wnx6*4+:gapx :row2+:sth :scw :sch [mygreen]
scrollbarset "s2 1 255 125 mygreen

staticcreate "d1 "st13 "Blue :wnx6*5+:gapx :row2 :st2w :sth
scrollbarcreate "d1 "s3 :wnx6*5+:gapx :row2+:sth :scw :sch [myblue]
scrollbarset "s3 1 255 125 myblue

staticcreate "d1 "st14 [Repeat Count] :gapx :row3 :sch*2 :sth
scrollbarcreate "d1 "s4 :gapx :row3+:sth :sch*2 :scw [myrepeat]
scrollbarset "s4 1 360 72 myrepeat

buttoncreate "d1 "b1 "END :gapx :wny-:bth-:gapy :btw :bth [myend]
buttoncreate "d1 "b3 "CLEAR :wnx2-:btw/2 :wny-:bth-:gapy :btw :bth [cs]
buttoncreate "d1 "b2 "DRAW :wnx-:btw-:gapx :wny-:bth-:gapy :btw :bth [drawthing]
end

to spiral :angle :repeat :incr :segs
;; 
;; Spirals, by Meyer A. Billmers
;;  
;; This procedure makes pretty spirals. I suggest you first do a 
;; hideturtle so the drawing will proceed at a reasonable rate.
;; 
;; angle   is the amount of turn at each piece, 
;; repeat  is the number of turns before the distance is incremented, and
;; incr    is the amount of distance increment.
;; 
;; Suggested fun spirals:
;;     spiral 90 2 10
;;     spiral 91 2 10
;;     spiral 60 3 10
;;     spiral 61 3 10
;;     spiral 179 2 5
;;     spiral 20 10 4
;; 
make "len :incr
make "ctr 0
repeat :segs ~
  [ ~
  fd :len ~
  rt :angle ~
  make "ctr :ctr + 1 ~
  if :ctr = :repeat ~
     [ ~
     make "ctr 0 ~
     make "len :len + :incr ~
     ] ~
  ]
end

to towercnt :tn
;
; Called by HANOI. Returns the current number of disks on tower :tn,
; as stored in the globals tower1, tower2, and tower3.
;
ifelse :tn = 1 ~
   [output :tower1] ~
   [ ~
   ifelse :tn = 2 ~
      [output :tower2] ~
      [output :tower3] ~
   ]
end

to towerset :tn :value
;
; Called by HANOI. Sets the current number of disks on tower :tn,
; as stored in the globals tower1, tower2, and tower3.
;
ifelse :tn = 1 ~
   [make "tower1 :value] ~
   [ ~
   ifelse :tn = 2 ~
      [make "tower2 :value] ~
      [make "tower3 :value] ~
   ]
end

to win
make "cmw 75
make "cmh 30
make "sth 12
make "lsw :cmw
make "lsh 20
make "scw 10
make "sch 40
make "btw 50
make "bth 12
make "gapx 6
make "gapy 6
make "mary 2
make "wnx 180
make "wny 120
make "wnx2 :wnx / 2
make "wny2 :wny / 2
make "wnx3 :wnx / 3
make "wny3 :wny / 3
make "wnx6 :wnx / 6
make "wny6 :wny / 6
make "st2w 30
make "row2 :wny3+:gapy
make "row3 :wny3*2-:gapy/2

windowcreate "main "d1 [This is a Demo Windows Application] 0 0 :wnx+:gapy :wny+:gapy+5 [setup]
end

Make "bth 12
Make "btw 50
Make "cmh 30
Make "cmw 75
Make "count 75
Make "ctr 0
Make "gapx 6
Make "gapy 6
Make "len 510
Make "lsh 20
Make "lsw 75
Make "mary 2
Make "row2 46
Make "row3 77
Make "scale 3
Make "sch 40
Make "scw 10
Make "st2w 30
Make "sth 12
Make "tower1 0
Make "tower2 0
Make "tower3 3
Make "wnx 180
Make "wnx2 90
Make "wnx3 60
Make "wnx6 30
Make "wny 120
Make "wny2 60
Make "wny3 40
Make "wny6 20
