Съдържание

Приложение №2

cs ht

make "all.cw 0

make "all.wr 0

; Меню за избор

let "t1 [1. Първа буква на картинка]

pprop "codearea 1001 [-255 130 190 95]

let "t2 [2. Липсваща буква в дума]

pprop "codearea 1002 [-255 80 185 40]

let "t3 [3. Първа буква на чута дума]

pprop "codearea 1003 [-255 25 200 -5]

let "t4 [4. Разбъркани букви]

pprop "codearea 1004 [-255 -23 110 -60]

let "t5 [5. Чута буква]

pprop "codearea 1005 [-255 -75 15 -105]

setx -200 sety 200

settt [Hebar][20 700 0 0 1]

setpc 4 tt [Втора част - Игри с букви]

setx -250 sety ycor - 50

settt [Hebar][18 700 0 0 1] setpc 12

tt [Изберете:] setpc 0

sety ycor - 50 tt :t1

sety ycor - 50 tt :t2

sety ycor - 50 tt :t3

sety ycor - 50 tt :t4

sety ycor - 50 tt :t5

setpc 9 setx -200

sety ycor - 50 tt [Заб: Използвайте клавиша ESC за изход]

case readkey ~

[49 1001 [cs setmc 11 my.playw [abc3] erase props game.abc.picture setmc 0] ~

50 1002 [cs setmc 11 my.playw [abc4] erase props game.abc.picture.1 setmc 0] ~

51 1003 [cs setmc 11 my.playw [abc5] my.setshape "abc1 st repeat 40 [rt 360 / ~

count getshape wait 100] ht erase props game.abc.sound setmc 0] ~

52 1004 [erase props start.compare.letters] ~

53 1005 [setmc 11 erase props game.abc.sound.2 setmc 0] ~

27 [clean stop]]

abc.game

; процедурата визуализира картинка с буква, чиито клавиш е натиснат

pu ht clean

let "k readkey

while [not and ( :k > 0 ) ( :k < 255 )][let "k readkey]

if :k = 27 [ht clean setmc 0 stop]

if not member? char :k \QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm ~

[my.playw [abc15 []] abc.learn stop]

if :k > 96 [let "sw item :k - 96 :abc][let "sw item :k - 64 :abc]

my.setshape first :sw

setx - ( ( first imagesize getshape ) / 2 + 160 )

sety -30

tt list char ( ascii ( first first :sw ) ) - 32 first first :sw

setx ( first imagesize getshape ) / 2 + 40

settt [Hebar][28 700 0 0 1] setpc 9

sety 15 tt list first :sw

settt [Hebar][24 400 0 0 0] setpc 0

sety -10 tt list last :sw

my.playw ( list first first :sw [] first :sw )

setpos [0 0] st setphasemode "true

while [not key?][setphase phase + 1 wait 400]

ht

abc.learn

; процедурата представя последователно буквите от английския език

ht cs pu

setmc 11

my.playw [abc1]

repeat 70 [setphase phase + 1 wait 100]

setphase 1

ht

( loadscreen "keyboard [-320 -50] )

maketurtle 2 [-250 160 350 pu tell ht]

maketurtle 3 [100 40 10 pu tell ht]

maketurtle 4 [140 150 pu tell ht]

maketurtle 5 [45 0 0 pu tell ht]

maketurtle 6 [-254 -142 0 pu ht "key]

ask 0 [my.setshape "abc]

ask 5 [my.setshape "abc setphasemode "true setphase 27]

ask 1 [settt [Times New Roman][60 700 0 0 1] setpc 15]

ask 2 [settt [Hebar][50 700 1 0 1] setpc 12]

ask 3 [settt [Times New Roman][35 400 1 0 1] setpc 13]

ask 4 [settt [Hebar][72 400 0 0 1] setpc 10]

let "abcd "ABCDEFGHIJKLMNOPQRSTUVWXYZ

ask [0 5 6][st]

repeat count :abc [pd tt se item repc :abcd char ( ( ascii item repc :abcd ) + 32 ) ~

my.playw item repc :abcd ask 6 [setpos item repc :key.pos] ~

wait 2000 ~

pe tt se item repc :abcd char ( ( ascii item repc :abcd ) + 32 ) ~

ask 0 [setphase phase + 1] ask 5 [setphase phase + 1] ~

if key? [if readkey = 27 [erturtle [1 2 3 4 5 6] ht clean ( ~

loadscreen "keyboard [-320 90] ) my.playw [abc2 []] setphasemode "false ( readkey 0 ) stop]]]

erturtle [1 2 3 4 5 6] ht

clean ( loadscreen "keyboard [-320 90] )

my.playw [abc2 []]

( readkey 0 )

setphasemode "false

end
to compare.letters :level

; ПРОЦЕДУРАТА ИНИЦИАЛИЗИРА ИГРАТА ЗА СРАВНЯВАНЕ НА 5 БУКВИ С ВЕЗНА

; При вход 1 буквите са последователни, при 2 случайно избрани

clean ( readkey 0 )

case :level ~

[1 [let "letters shuffle item se 1 + random 21 "5 "ABCDEFGHIJKLMNOPQRSTUVWXYZ] ~

2 [let "letters item [1 5] shuffle "QWERTYUIOPASDFGHJKLZXCVBNM]]

make "g.c.l 0

; създаване на променливи за състоянието на лявата и дясна везна

let "l1 [] let "l2 []

erturtle 0

; създаване на костенурки с образ съответните букви и костенурки - чекмеджета

repeat 5 ~

[let "n.t item repc :letters ~

let "pos.x ( repc * 50 - 165 ) ~

maketurtle :n.t ( se :pos.x 100 [st pu setphasemode "abc] ) ~

ask :n.t [setphase ( ascii :n.t ) - 64] ~

let "n.t.c word item repc merge.sort :letters "1 ~

let "pos.x ( repc * 65 - 220 ) ~

maketurtle :n.t.c ( se :pos.x 250 "st "pu ":cupboard )]

foreach "i all [if count :i = 1 [maketurtle :i]]

; създаване на костенурка ВЕЗНА

maketurtle "vezna [0 0 0 st pu "vezna setphasemode]

ask "vezna [setphase 2]

game.comp.let

if readkey = 27 [stop][compare.letters :level]

end
to dictionary

; процедурата връща в списък всички думи от проекта

op ( se :abc ~

bl bf :airport ~

bl bf :body ~

bl bf :clothes ~

bl bf :colors ~

:days :dictionl ~

bl bf :family ~

bl bf :food ~

bl bf :home ~

bl bf :house ~

bl bf :lunch ~

bl bf :me ~

:months ~

bl bf :numbers ~

bl bf :park ~

bl bf :people ~

bl bf :picture ~

bl bf :restaurant ~

bl bf :room ~

bl bf :school ~

bl bf :street ~

bl bf :swim ~

bl bf :weekend ~

:my.dictionary )

; :opposites :verbs

end
to dictionary.abc :eb

; процедурата генерира азбучен речник на думите от проекта

cs setx -90 tt [Моля, изчакайте ...]

setmc 1

sety -20 setx -10

case :eb [EB [let "dic merge.sort map "first dictionary] ~

BE [let "dic merge.sort map "last dictionary]]

my.playw [abc25]

printto "dict.txt

let "Letter "

pr se [Общ брой думи:] count :dic

repeat count :dic ~

[setphase phase + 1 ~

if :letter <> first item repc :dic [let "Letter first item repc :dic pr [] ~

pr ( se [> >] :letter [< <] )][] ~

type item repc :dic type ( se char 32 [\<\-\>] char 32 ) ~

case :eb [EB [pr item member item repc :dic map "first dictionary map "last dictionary] ~

BE [pr item member item repc :dic map "last dictionary map "first dictionary]]]

printto []

cs ( readkey 0 )

playw []

edfile "dict.txt

setmc 0

waituntil [key?]

end
to dictionary.add

; Процедурата добавя дума към речника на потребителя

maketurtle 0 [pu ht]

gs cs setbg 3 setpc 0

settt [Hebar][16 400 0 0 1]

let "t1 [Въведете новата дума на английски:]

sety 100 setx - ( item 1 textsize :t1 ) / 2

tt :t1

sety ycor - 50

let "nwe ( rlt [] 200 )

if empty? :nwe [cs stop][let "nwe first :nwe]

setpc 1 setx - ( first textsize :nwe ) / 2 tt :nwe

setx -100 sety ycor - 50 setpc 0

if member? :nwe map "first dictionary ~

[tt [Превод:] setx 0 setpc 12 tt last item ( member ~

:nwe map "first dictionary ) dictionary waituntil [key?]] ~

[tt [Превод:] setx 160 - item 1 textsize [Превод:] ~

let "nwb ( rlt [] 200 ) if empty? :nwb [stop][let "nwb first :nwb] ~

setpc 12 setx 0 tt :nwb ~

let "picture emptyimage my.playw [abc12] ed [:picture] sety 30 setx 50 + first ~

textsize :nwe ~

putimage :picture saveimage if count :nwe > 8 [item [1 8] :nwe][:nwe] :picture ~

make "my.dictionary fput list :nwe :nwb :my.dictionary]

if readkey = 27 [cs stop][dictionary.add]

end
to dictionary.search

; Процедурата търси дума за превод

maketurtle 0 [pu ht]

cs gs setbg 3 setpc 0

settt [Hebar][16 400 0 0 1]

let "t1 [Въведете дума за търсене:]

setx -10 - item 1 textsize :t1

tt :t1

let "wsearch ( rlt [] 200 )

test empty? :wsearch

ift [cs stop]

iff [if member? char 45 :wsearch [let "wsearch ( word first :wsearch char 45 last ~

:wsearch )][let "wsearch first :wsearch]]

; проверява се дали думата е на английски или български

test ascii :wsearch < 122

ift [test member? :wsearch map "first dictionary ~

ift [setx 0 setpc 12 tt first item ( member :wsearch map "first ~

dictionary ) dictionary ~

setpos [-90 -40] setpc 0 tt [Превод:] setx 0 setpc 1 tt last ~

item ( member :wsearch map "first dictionary ) dictionary] ~

iff [cs setpc 12 setx -120 tt [Няма такава дума в моя речник!] waituntil ~

[key?] ignore readkey dictionary.search stop]]

iff [test member? :wsearch map "last dictionary ~

ift [setx 0 setpc 12 tt last item ( member :wsearch map "last dictionary ~

) dictionary ~

setpos [-90 -40] setpc 0 tt [Превод:] setx 0 setpc 1 let "wsearch ~

first item ~

( member :wsearch map "last dictionary ) dictionary tt :wsearch] ~

iff [cs setpc 12 setx -120 tt [Няма такава дума в моя речник!] ~

waituntil [key?] ignore readkey dictionary.search stop]]

if count :wsearch > 8 [let "wsearch item [1 8] :wsearch]

my.setshape :wsearch

sety -20

st

my.playw list :wsearch

end
to dictionary.subject

; процедурата запознава с думи по теми

cs pu ht

maketurtle 0 [-250 200 0 ht pu tell]

settt [Hebar][12 700 0 1 0] setpc 0

let "subjects [Me Body Family House Room Clothes Home Food Weekend Street School ~

Park Swim Restaurant Numbers Picture Airport Lunch People Colors]

let "sub.bg [Аз Тяло Семейство Къща Стая Дрехи Жилище Храна Почивка Улица Училище ~

Парк Басейн Ресторант Числа Рисунка Летище Обяд Професии Цветове]

repeat count :subjects [maketurtle item repc :subjects se pos [0 pu ht] ~

ask item repc :subjects [setshape item repc loadimage "temi []] ~

sety ycor - 40 setx xcor - ( first textsize item repc :sub.bg ) / 2 ~

tt item repc :sub.bg ~

sety ycor + 40 setx xcor + ( first textsize item repc :sub.bg ) / 2 ~

if xcor > 170 [sety ycor - 100 setx -250][setx xcor + 130]]

erturtle 0

tell all st

( readkey 0 )

my.playw [abc10]

setmc 14

while [not member? :k [0 27]][let "k readkey]

case :k [0 [if not empty? touched ~

[my.playw [abc11] let "el touched erturtle all setbg 15 ~

( loadscreen item [1 8] :el first thing :el ) ~

dictionary.subject.elements]] ~

27 [erturtle all maketurtle 0 [0 0 0 tell ht] setmc 0 setgs item [3 2] ~

logosize cs setbg 3 stop]]

erturtle all

dictionary.subject

end
to dictionary.subject.elements

; процедурата визуализира думите по дадена тема в textbox turtle

let "el bf thing :el

repeat ( count :el ) - 1 [make repc item repc :el ~

maketurtle repc se item repc last :el [0 st pu tell] ~

ask repc [setboxmode "true setbox [frame 1 pp 4 title 0 bg 15 edit 0]]]

( readkey 0 )

play.dictionary.subject.elements

repeat ( count :el ) - 1 [erase word ": repc]

erturtle all

maketurtle 0 [0 0 0 pu ht tell]

setgs item [3 2] logosize

cs setbg 3

end
to dictionary.trans :LLL

; Процедурата проверява знанията за думи при превод от английски на български ( ~

ЕВ ) и обратно ( ВЕ )

maketurtle 0 [pu ht]

cs setbg 3 setpc 0

settt [Hebar][16 400 0 0 1]

my.playw [abc17]

let "t1 [Преведете думата:]

setx -10 - first textsize :t1

tt :t1

setx 10

let "pos.wtrans 1 + random count map "first dictionary

case :LLL [EB [tt item :pos.wtrans map "first dictionary] ~

BE [tt item :pos.wtrans map "last dictionary]]

setx -230 sety -40 setpc 0 tt [Превод от моя речник:] setx 100 setpc 1

let "wtrans ( rlt [] 200 )

if empty? :wtrans [rezult :all.cw :all.wr stop][let "wtrans first :wtrans]

setpc 10 setx 10 tt :wtrans

case :LLL ~

[EB [if :wtrans = item :pos.wtrans map "last dictionary [make "all.cw :all.cw + 1] ~

[make "all.wr :all.wr + 1 repeat 3 [setpc 12 tt :wtrans wait 200 setpc 10 tt :wtrans wait 200] ~

pe tt :wtrans pd tt item :pos.wtrans map "last dictionary]] ~

BE [if :wtrans = item :pos.wtrans map "first dictionary [make "all.cw :all.cw + 1] ~

[make "all.wr :all.wr + 1 repeat 3 [setpc 12 tt :wtrans wait 200 setpc 10 tt :wtrans wait 200] ~

pe tt :wtrans pd tt item :pos.wtrans map "first dictionary]]]

if readkey = 27 [rezult :all.cw :all.wr stop][dictionary.trans :LLL]

end
to filter.dir :list.dir

; процедурата, връща списък само с първите елементи на подадения вход

if word? first :list.dir [op :list.dir]

op filter.dir lput first first :list.dir bf :list.dir

end
to game.abc.picture

; процедурата показва картинка, чиято първа буква потребителя трябва да въведе

( readkey 0 )

let "letter pick :abc

setphasemode "true

settt [Hebar][36 700 0 0 0]

cs pu

setpath "%image

[game.abc.picture stop]

setx 0 - ( item 1 textsize last :letter ) / 2

sety 100 + ( last imagesize getshape ) / 2

setpc 0 tt list last :letter

setpos [0 0] st

while [not key?][setphase phase + 1 wait 400] stamp ht

let "k readkey

while [not and ( :k > 0 ) ( :k < 255 )][let "k readkey]

ht

if :k = 27 [rezult :all.cw :all.wr stop]

sety 40

tt list char :k

my.playw se list char :k []

setpc pick [12 15 1 9 13 14 5]

setx 30 + ( first imagesize getshape ) / 2

tt list char ( ascii ( first first :letter ) ) - 32 first first :letter

if char :k = first first :letter [my.playw [abc21 []] make "all.cw :all.cw + 1] ~

[my.playw se [abc26] first first :letter setx -90 - ( first imagesize getshape ~

) / 2 putimage :X make "all.wr :all.wr + 1]

setx 0 - ( item 1 textsize first :letter ) / 2

sety - 50 - ( first imagesize getshape ) / 2

tt list first :letter

if readkey = 27 [rezult :all.cw :all.wr stop]

game.abc.picture

end
to game.abc.picture.1

let "letter pick :abc

maketurtle 1 [0 0 0 setphasemode]

settt [Hebar][28 700 0 0 0]

cs pu

ask [1 0][my.setshape first :letter]

sety 60 + ( last imagesize getshape ) / 2

setpc 0 tt list last :letter

setpc pick [15 1 9 13 14 5]

sety - 20 - ( last imagesize getshape ) / 2

setx 0 - ( item 1 textsize first :letter ) / 2

let "pos.l 1 + random count first :letter

let "fl item :pos.l first :letter

tt list replace :pos.l first :letter "_

ask 1 [setpos [0 0] st while [not key?][setphase phase + 1 wait 400] stamp ht]

let "w readkey

while [not and ( :w > 0 ) ( :w < 255 )][let "w readkey]

my.playw list char :w []

if :w = 27 [rezult :all.cw :all.wr stop]

pe tt list replace :pos.l first :letter "_

pu setpc 0

tt list replace :pos.l first :letter char :w

if char :w = :fl [make "all.cw :all.cw + 1 my.playw [abc21]] ~

[setx -12 sety -10 - ( last imagesize getshape ) / 2 ~

putimage :X make "all.wr :all.wr + 1 wait 1000 setpc 10 my.playw ( se [abc27 abc30] :fl [] ) ~

sety 0 setx - 100 - ( first imagesize getshape ) / 2 setpc pick [15 1 9 13 14 5] tt :fl ~

setx 20 + ( first imagesize getshape ) / 2 sety 0 tt list first :letter]

if readkey = 27 [rezult :all.cw :all.wr stop]

game.abc.picture.1

end
to game.abc.picture.2

; процедурата представя картинка, чието име потребителя трябва да въведе

let "letter pick :abc

settt [Hebar][28 700 0 0 0]

cs pu

my.setshape first :letter

sety 50 + ( last imagesize getshape ) / 2

setpc 0 tt list last :letter

setpos [0 0] stamp

setpc pick [1 9 13 5]

sety - 50 - ( last imagesize getshape ) / 2

setx 0

my.playw [abc8]

let "w ( rlt [] first textsize word first :letter "a )

if empty? :w [rezult :all.cw :all.wr stop]

my.setshape first :letter ht

if :w = [x - ray][let "w word "x\-ray][let "w first :w]

setx 0 - ( item 1 textsize :w ) / 2

sety - 10 - ( last imagesize getshape ) / 2

tt list :w

if :w = first :letter [make "all.cw :all.cw + 1 my.playw [abc22]] ~

[setx -12 sety - 5 - ( last imagesize getshape ) / 2 ~

putimage :X make "all.wr :all.wr + 1 my.playw ( se [abc29] first :letter [] ) ~

setpc 10 setx 10 + ( first imagesize getshape ) / 2 sety 0 tt list first :letter]

if readkey = 27 [rezult :all.cw :all.wr stop]

game.abc.picture.2

end
to game.abc.sound

cs pu

let "letter pick :abc

let "b 0

while [not key?][if mod :b 5000 = 0 [my.playw se first :letter] let "b :b + 1]

let "k readkey

while [not and ( :k > 0 ) ( :k < 255 )][let "k readkey]

if :k = 27 [rezult :all.cw :all.wr stop]

settt [Hebar][28 700 0 0 0]

my.setshape first :letter

setx 0 - ( item 1 textsize last :letter ) / 2

sety 50 + ( last imagesize getshape ) / 2

setpc 0 tt list last :letter

setpos [0 0] stamp

ht

setpc 0

setx -90 - ( first imagesize getshape ) / 2

tt list char :k

if char :k = first first :letter [make "all.cw :all.cw + 1 my.playw [abc21]] ~

[setx -90 - ( first imagesize getshape ) / 2 putimage :X make "all.wr :all.wr + 1 ~

my.playw ( se [abc28 abc6] first :letter [abc7] first first :letter [ ] )]

setpc pick [12 15 1 9 13 14 5]

setx 30 + ( first imagesize getshape ) / 2

tt list char ( ascii ( first first :letter ) ) - 32 first first :letter

setx 0 - ( item 1 textsize first :letter ) / 2

sety - 20 - ( last imagesize getshape ) / 2

tt list first :letter

( readkey 0 )

if readkey = 27 [rezult :all.cw :all.wr stop]

game.abc.sound

end
to game.abc.sound.1

setshape emptyimage

setbg 3 setpc 0

settt [Hebar][28 700 0 0 0]

let "letter pick :abc

if member? word first :letter ".wav filter.dir dir "*.wav [my.playw se [abc9] first ~

:letter][game.abc.sound.1 stop]

setpos [0 0]

let "w ( rlt [] item 1 textsize word "a first :letter )

if empty? :w [rezult :all.cw :all.wr stop]

if :w = [x - ray][let "w word "x\-ray][let "w first :w]

cs pu

my.setshape first :letter

sety 50 + ( last imagesize getshape ) / 2

setpc 0 tt list last :letter

setpos [0 0] stamp

ht

setpc 0

sety -10 - ( last imagesize getshape ) / 2 ~

tt list :w " make "all.cw :all.cw + 1 my.playw [abc22]] ~

[sety 40 setx -20 - ( first imagesize getshape ) / 2 - ( item 1 textsize :w ) tt list :w " ~

setx -90 - ( first imagesize getshape ) / 2 putimage :X make "all.wr :all.wr + 1 ~

my.playw se [abc29] first :letter ~

setpc pick [12 15 1 9 13 14 5] ~

setx 30 + ( first imagesize getshape ) / 2 ~

tt list first :letter]

( readkey 0 )

if readkey = 27 [rezult :all.cw :all.wr stop]

game.abc.sound.1

end
to game.abc.sound.2

cs pu

settt [Hebar][20 700 0 0 0]

setpc 13

tt [Натиснете клавиша с чутата буква]

settt [Hebar][36 700 0 0 0]

let "letter pick :abc

my.playw first first :letter

let "k readkey

while [not and ( :k > 0 ) ( :k < 255 )][let "k readkey]

cs

if :k = 27 [rezult :all.cw :all.wr stop]

setx 0 - ( item 1 textsize last :letter ) / 2

sety 100 + ( last imagesize getshape ) / 2

setpc 0 tt list last :letter

setpos [0 0] stamp

ht

setpc 0

setx -90 - ( first imagesize getshape ) / 2

tt list char :k

if char :k = first first :letter [make "all.cw :all.cw + 1 my.playw [abc21]] ~

[setx -90 - ( first imagesize getshape ) / 2 putimage :X make "all.wr :all.wr + 1 ~

my.playw ( se [abc26] first first :letter [] )]

setpc pick [12 15 1 9 13 14 5]

setx 30 + ( first imagesize getshape ) / 2

tt list char ( ascii ( first first :letter ) ) - 32 first first :letter

setx 0 - ( item 1 textsize first :letter ) / 2

sety - 20 - ( first imagesize getshape ) / 2

tt list first :letter

( readkey 0 )

waituntil [key?]

if readkey = 27 [rezult :all.cw :all.wr stop]

game.abc.sound.2

end
to game.abc.spell

setshape emptyimage

setbg 3

settt [Hebar][28 700 0 0 0]

my.playw [abc9 []]

repeat count first :letter [my.playw item repc first :letter wait 1000]

setpos [0 0]

let "w ( rlt [] item 1 textsize word "a first :letter )

if empty? :w [rezult :all.cw :all.wr stop]

if member? char 45 :w [let "w ( word first :w char 45 last :w )][let "w first :w]

cs pu

setx 0 - ( item 1 textsize last :letter ) / 2

sety 100 + ( last imagesize getshape ) / 2

setpc 9 tt list last :letter

setpos [0 0] stamp

ht

setpc 0

tt list :w

setpc pick [12 15 1 9 13 5]

test :w = first :letter

ift [make "all.cw :all.cw + 1 my.playw [abc22]]

iff [setx -90 - ( first imagesize getshape ) / 2 putimage :X make "all.wr :all.wr + 1 ~

setpath "%wave ~

if member? word first :letter ".wav filter.dir dir "*.wav ~

[my.playw ( se [abc29] first :Letter [] )][my.playw [abc28 []]] ~

sety -20 setx 30 + ( first imagesize getshape ) / 2 ~

tt list first :letter]

( readkey 0 )

if readkey = 27 [rezult :all.cw :all.wr stop]

game.abc.spell

end
to game.comp.let

; ПРОЦЕДУРАТА СЛЕДИ ДЕЙСТВИЯТА НА ПОТРЕБИТЕЛЯ ЗА ИГРАТА:СРАВНЯВАНЕ НА БУКВИ С ВЕЗНА

case readkey ~

[0 [make "last.t touched tell :last.t] ~

-1 [if count :last.t = 1 [setpos mouse]] ~

-2 [if not empty? touched [if count :last.t = 1 ~

[if overlap? "vezna [my.playw [abc32] if empty? :l1 [make "l1 se :last.t ask :last.t ~

[xcor] ask :last.t [sety -60]][vezna]] ~

[test overlap? word who "1 ~

ift [my.playw [abc31] setpos ask word who "1 [pos] make "g.c.l :g.c.l + 1 if :g.c.l ~

= 5 [my.playw [abc23] game.comp.let.rezult stop]] ~

iff [home]]]]] ~

27 [game.comp.let.rezult stop]]

game.comp.let

end
to game.comp.let.rezult

erturtle [vezna]

foreach "t filter [[k][op count :k = 1]] all [ask :t [if overlap? word :t "1 [ask word :t "1 [ht]] ~

[setpos ask word :t "1 [pos]]]]

waituntil [key?]

erturtle all

maketurtle 0 [0 0 0 ht tell pu]

end
to game.dictionary.subject

cs pu ht

setmc 11

settt [Hebar][12 700 0 1 0] setpc 0

let "subjects [Me Body Family House Room Clothes Home Food Weekend Street School ~

Park Swim Restaurant Numbers Picture Airport Lunch People Colors]

let "sub.bg [Аз Тяло Семейство Къща Стая Дрехи Жилище Храна Почивка Улица Училище ~

Парк Басейн Ресторант Числа Рисунка Летище Обяд Професии Цветове]

repeat count :subjects [maketurtle item repc :subjects se pos [0 pu ht] ~

ask item repc :subjects [setshape item repc loadimage "temi []] ~

sety ycor - 40 setx xcor - ( first textsize item repc :sub.bg ) / 2 ~

tt item repc :sub.bg ~

sety ycor + 40 setx xcor + ( first textsize item repc :sub.bg ) / 2 ~

if xcor > 170 [sety ycor - 100 setx -250][setx xcor + 130]]

erturtle 0

setmc 14 tell all st

( readkey 0 )

my.playw [abc10]

case readkey [0 [if not empty? touched ~

[setmc 0 let "el touched ~

erturtle all setbg 15 ~

( loadscreen item [1 8] :el first thing :el ) ~

my.playw [abc11 abc14] game.dictionary.subject.elements]] ~

27 [setmc 0 rezult :all.cw :all.wr erturtle all setgs item [3 2] ~

logosize cs setbg 3 maketurtle 0 [0 0 0 ht tell] stop]]

erturtle all

game.dictionary.subject

end
to game.dictionary.subject.elements

let "el bf thing :el

repeat ( count :el ) - 1 [make repc item repc :el ~

maketurtle repc se item repc last :el [0 ht pu tell] ~

ask repc [setboxmode "true setbox [frame 0 pp 4 title 0 bg 15 edit 0]] ~

make word "a repc " ~

maketurtle word "a repc se item repc last :el [0 st pu tell] ~

ask word "a repc [setboxmode "true setbox [frame 1 pp 2 title 0 bg 0 edit 1 size [10 1]]]]

waituntil [readkey = 27]

repeat ( count :el ) - 1 [if thing word "a repc = first thing repc [make "all.cw ~

:all.cw + 1 ask word "a repc [setbox [bg 2]]] ~

[make "all.wr :all.wr + 1 ask word "a repc [setbox [bg 12]] make word "a repc first ~

thing repc]]

st

waituntil [key?]

repeat ( count :el ) - 1 [( erase word ": repc ( word ": "a repc ) )]

erturtle all

maketurtle 0 [0 0 0 pu ht tell]

cs setbg 3

end
to garden

cs setbg 15

my.playw [abc19]

( loadscreen pick [tree1 tree2][-280 200] )

let "dict shuffle dictionary

let "s1234 item [1 4] :dict

let "sw first :s1234

let "label shuffle :label.pos

make "tree1 shuffle :tree1

let "shape pick [applel pear]

my.setshape :shape

settt [Hebar][14 700 0 0 1]

if :shape = "applel [setpc 15][setpc 0]

repeat count first :sw [setpos item repc :tree1 stamp tt list item repc first :sw]

;

; textbox turtle with correct word

maketurtle "cw [st pu]

let "mar div ( 15 - count first :sw ) 2

ask "cw [setpos item 1 :label setboxmode "true setbox ( se [size [15 3] edit 0 title ~

0 bg 7 pp 4] "margin :mar )]

;

; textbox turtle with 1 wrong word

maketurtle "w1 [st pu]

let "mar div ( 15 - count first bf :w1 ) 2

ask "w1 [setpos item 2 :label setboxmode "true setbox ( se [size [15 3] edit 0 title ~

0 bg 7 pp 4] "margin :mar )]

;

; textbox turtle with 2 wrong word

maketurtle "w2 [st pu]

let "mar div ( 15 - count first bf :w2 ) 2

ask "w2 [setpos item 3 :label setboxmode "true setbox ( se [size [15 3] edit 0 title ~

0 bg 7 pp 4] "margin :mar )]

;

; textbox turtle with 3 wrong word

maketurtle "w3 [st pu]

let "mar div ( 15 - count first bf :w3 ) 2

ask "w3 [setpos item 4 :label setboxmode "true setbox ( se [size [15 3] edit 0 title ~

0 bg 7 pp 4] "margin :mar )]

;

( readkey 0 )

while [( not member? :k [0 27] )][let "k readkey]

if :k = 27 [rezult :all.cw :all.wr stop]

let "c touched

if not empty? :c ~

[my.playw [abc13] test :c = "cw ~

ift [make "all.cw :all.cw + 1 ask :c [setbox [bg 2]]] ~

iff [make "all.wr :all.wr + 1 ask :c [setbox [bg 12]]] ~

my.playw [abc19] ~

repeat 6 [ask "cw [setbox [bg 7] wait 300 setbox [bg 2] wait 300]]]

erturtle all

maketurtle 0 [0 0 0 ht pu tell]

garden

end
to garden.1

setbg 15

( loadscreen pick [tree1 tree2][-280 200] )

let "sw first shuffle dictionary

while [count first :sw > 4][let "sw first shuffle dictionary]

make "tree1 shuffle :tree1

let "shape pick [applel pear]

my.setshape :shape

settt [Hebar][14 700 0 0 1]

if :shape = "applel [setpc 15][setpc 0]

repeat count first :sw [setpos item repc :tree1 stamp tt list item repc first :sw]

setpos [170 0] setpc 0

settt [Hebar][16 700 0 0 1]

let "ans ( rlt [] ( first textsize first :sw ) + 20 )

if :ans = [][rezult :all.cw :all.wr setmc 0 stop]

let "ans first :ans

test :ans = first :sw

ift [make "all.cw :all.cw + 1 setpc 2 tt first :sw]

iff [make "all.wr :all.wr + 1 setpc 12 tt :ans setpc 10 sety ycor - 30 tt first :sw]

pu sety ycor - 30 setpc 0 tt last :sw

if readkey = 27 [rezult :all.cw :all.wr setmc 0 stop][garden.1]

end
to ini

hidespeedbar

hidebuttons

erturtle all

maketurtle 0 [0 0 0 tell ht pu]

randomize

cs

setlogosize [0 0 640 480 5 [Learning ABC...]]

setgs se item 3 logosize item 4 logosize

window

setbg 3

ini.path

setpath loadpath

( setpath "image word path "\\image )

( setpath "wave word path "\\wave )

( setpath "screen word path "\\screen )

end
to main

.setmousepos [-300 200]

; области от графичния екран за влизане в различните части

pprop "codearea 1001 [-150 105 -3 -12]

pprop "codearea 1002 [6 105 151 -11]

pprop "codearea 1003 [-151 -19 -3 -129]

pprop "codearea 1004 [5 -18 151 -127]

( setbg 3 0 ) ( loadscreen "win1 [-240 190] )

setshape :but.window

pu

( readkey 0 )

[if and ( last mousestate < [151 105] ) ( last mousestate > [-147 -128] ) [st setmc ~

14][ht setmc 0] ~

if and ( last mousestate < [-3 106] ) ( last mousestate > [-147 -9] ) [if pos ~

if and ( last mousestate < [152 104] ) ( last mousestate > [6 -10] ) [if pos <> ~

[4 104][playw [abc20] setpos [4 104] st]][] ~

if and ( last mousestate < [-2 -19] ) ( last mousestate > [-149 -129] ) [if pos ~

if and ( last mousestate < [151 -18] ) ( last mousestate > [5 -130] ) [if pos ~

case readkey ~

[1001 [setmc 0 erase props abc.learn.alphabet abc.learn] ~

1002 [setmc 0 erase props abc.game] ~

1003 [setmc 0 erase props word.learn] ~

1004 [setmc 0 erase props word.game] ~

27 [draw setmc 0 showspeedbar ss setlogosize [] stop]]

main

if empty? :s1 [op :s2]

if empty? :s2 [op :s1]

test first :s1 < first :s2

ift [op fput first :s1 merge bf :s1 :s2]

iff [op fput first :s2 merge :s1 bf :s2]

end
to merge.sort :s

if empty? bf :s [op :s]

local [half1 half2]

make "half1 only.odd :s

make "half2 only.odd bf :s

op merge merge.sort :half1 merge.sort :half2

end
to my.playw :filewave

; процедурата проверява за наличието на звукови файлове и

; ако се окаже, че даден липсва не го изпълнява

setpath "%wave

repeat count :filewave ~

[test empty? item repc :filewave ~

iff [if not member? word item repc :filewave ".wav filter.dir dir "*.wav ~

[make "filewave replace repc :filewave "]]]

playwave :filewave

end
to my.setshape :shape

setpath "%image

if member? word :shape ".lgw filter.dir dir "*.lgw [setshape :shape][setshape emptyimage]

end
to only.odd :s

if empty? :s [op :s]

if empty? bf :s [op :s]

op fput first :s only.odd bf bf :s

end
to play.dictionary.subject.elements

case readkey [0 [if not empty? touched [ask touched [setbox [bg 2]] ~

my.playw list first item touched :el [] ~

ask touched [setbox [bg 15]]]] ~

27 [stop]]

play.dictionary.subject.elements

end
to rezult :corr :rong

erturtle all

maketurtle 0 [0 0 0 ht pu tell]

setbg 3

setshape :correct

setx -50 stamp

setx -80 - item 1 textsize :corr tt list :corr

setshape :wrong

setx 50 stamp

setx 100 tt list :rong

if :corr > :rong [my.playw [abc23]][my.playw [abc18]]

( readkey 0 )

waituntil [key?]

ignore readkey

playw []

end
to start.compare.letters

; процедурата дава възможност на избор за ниво при сравняване на букви от азбуката

cs ( readkey 0 )

settt [Hebar][18 700 0 0 0]

my.playw [abc24]

sety 150

let "tg [Игра - РАЗБЪРКАНИ БУКВИ]

let "tn [Заб: Използвайте клавиша ESC за изход]

let "t1 [1. Първо ниво]

pprop "codearea 1001 [-105 30 80 5]

let "t2 [2. Второ ниво]

pprop "codearea 1002 [-105 -20 70 -50]

setpc 1

tt :tg

setpc 12 tt [Изберете ниво:]

setpc 0

sety ycor - 50 tt :t1

setpc 9

sety ycor - 50

tt :tn

let "k readkey

case :k [49 1001 [compare.letters 1] ~

50 1002 [compare.letters 2] ~

27 [erase props stop]]

erase props

start.compare.letters

end
to start.garden

cs

settt [Hebar][18 700 0 0 0]

sety 150

let "tn [Заб: Използвайте клавиша ESC за изход]

let "t1 [1. Първо ниво]

pprop "codearea 1001 [-105 30 80 5]

let "t2 [2. Второ ниво]

pprop "codearea 1002 [-105 -20 70 -50]

setpc 1

setx - ( first textsize :tg ) / 2

sety ycor - 70 setx -100

setpc 12 tt [Изберете ниво:]

setpc 0

sety ycor - 50 tt :t2

setpc 9

setx - ( first textsize :tn ) / 2

tt :tn

start.garden

end
to startup

ini ; настройки на основния прозорец

setmc 11

my.playw [abc0]

( loadscreen "win1 [-240 190] )

; създаване на котенурки с образ завеси

maketurtle 1 [-154 105 0 tell st pu setphasemode "winl]

maketurtle 2 [150 105 0 tell st pu setphasemode "winr]

ask [1 2][repeat 3 [setphase repc wait 500]]

erturtle [1 2]

setmc 0

main

; ignore error

setlogosize []

showspeedbar

ss

end
to vezna

ask :last.t [sety -60]

; проверява подредбата на буквите

test ascii first :l1 < ascii first :l2

iff [if last :l1 < 0 [ask "vezna [setphase 1] ask first :l2 [sety ycor + 10] ~

ask first :l1 [sety ycor - 10]] ~

[ask "vezna [setphase 3] ask first :l1 [sety ycor - 10] ~

ask first :l2 [sety ycor + 10]]]

ift [if last :l2 < 0 [ask "vezna [setphase 1] ask first :l1 [sety ycor + 10] ~

ask first :l2 [sety ycor - 10]] ~

[ask "vezna [setphase 3] ask first :l2 [sety ycor - 10] ~

ask first :l1 [sety ycor + 10]]]

waituntil [key?]

ask se first :l1 first :l2 [home]

ask "vezna [setphase 2]

make "l1 []

make "l2 []

end
to word.game

cs ht pu

make "all.cw 0

make "all.wr 0

; Меню за избор

let "t1 [1. Дума от картинка]

pprop "codearea 1001 [-255 180 -10 150]

let "t2 [2. Чута дума]

pprop "codearea 1002 [-255 130 -100 100]

let "t3 [3. В градината]

pprop "codearea 1003 [-255 80 -80 50]

let "t4 [4. Превод на дума: английско - български]

pprop "codearea 1004 [-255 30 260 -5]

let "t5 [5. Превод на дума: българо - английски]

pprop "codearea 1005 [-255 -20 250 -55]

let "t6 [6. Дума от тема]

pprop "codearea 1006 [-255 -70 -65 -105]

let "t7 [7. Дума по чути букви]

pprop "codearea 1007 [-255 -120 20 -155]

setx -200 sety 230

settt [Hebar][20 700 0 0 1]

setpc 4 tt [Четвърта част - Игри с думи]

settt [Hebar][18 700 0 0 1]

setx -250 sety ycor - 30

setpc 12 tt [Изберете:]

setpc 0

sety ycor - 50 tt :t1

sety ycor - 50 tt :t3

sety ycor - 50 tt :t4

sety ycor - 50 tt :t5

sety ycor - 50 tt :t6

sety ycor - 50 tt :t7

setpc 9 setx -200

sety ycor - 50 tt [Заб: Използвайте клавиша ESC за изход]

case readkey ~

[49 1001 [erase props setmc 11 game.abc.picture.2 setmc 0] ~

50 1002 [erase props setmc 11 game.abc.sound.1 setmc 0] ~

51 1003 [erase props start.garden] ~

52 1004 [erase props setmc 11 dictionary.trans "EB setmc 0] ~

53 1005 [erase props setmc 11 dictionary.trans "BE setmc 0] ~

54 1006 [erase props game.dictionary.subject] ~

55 1007 [erase props setmc 11 game.abc.spell setmc 0] ~

27 [clean erase props stop]]

word.game

end
to word.learn

cs pu ht

let "t1 [1. Тематичен речник]

pprop "codearea 1001 [-255 130 5 95]

let "t2 [2. Азбучен английско - български речник]

pprop "codearea 1002 [-255 80 250 50]

let "t3 [3. Азбучен българо - английски речник]

pprop "codearea 1003 [-255 30 225 -5]

let "t4 [4. Търсене на дума]

pprop "codearea 1004 [-255 -25 -15 -55]

let "t5 [5. Добавяне на дума в речника]

pprop "codearea 1005 [-255 -50 130 -105]

setx -200 sety 200

settt [Hebar][20 700 0 0 1]

setpc 4 tt [Трета част - Запознаване с думи]

settt [Hebar][18 700 0 0 1]

setpc 12 setx -250 sety ycor - 50

tt [Изберете:] setpc 0

sety ycor - 50 tt :t1

sety ycor - 50 tt :t2

sety ycor - 50 tt :t3

sety ycor - 50 tt :t4

sety ycor - 50 tt :t5

setpc 9 setx -200

sety ycor - 50 tt [Заб: Използвайте клавиша ESC за изход]

case readkey ~

[49 1001 [erase props dictionary.subject] ~

50 1002 [erase props dictionary.abc "EB] ~

51 1003 [erase props dictionary.abc "BE] ~

52 1004 [setmc 11 erase props dictionary.search setmc 0] ~

53 1005 [setmc 11 erase props dictionary.add setmc 0] ~

27 [clean stop]]

word.learn