aUCBLogo Demos and Tests / juniper9
to juniper9
local [firstname maxnum first_time_thru person_move scores ~
consecutive_count difficulty]
utilities
; check if licence statement has previously been displayed and accepted.
; If not, display it.
GNU_licence_display "Juniper
[ [JUNIPER GREEN: Version 1.0]
[2001 David Peacock]
]
cs ht setLabelAlign 1 -1
za_initialise
dotilthrow "end_playgame [ab_playgame :maxnum]
; game ended, say goodbye
cs
(backgroundcolour yellow)
(dispmsg sentence [Thanks] :firstname -210 60 red ~
[[Times] -48 0 0 700 0 0 0 0 3 2 1 66])
dispmsg [I hope you enjoyed your game!] -200 -40 magenta
wait 200
exitlogo
end
to ab_playgame :maxnum
; This routine plays multiple games until the player chooses to exit
local [numbers_used scorecolr]
clearmsgstack
ua_new_game_setup :maxnum
dotilthrow "end_playgame1 [ab_playgame1 :maxnum]
ze_clear_messages
ifelse :person_move
[ dispmsg [Sorry you lost!] -150 250 red
sounds [1100 30 600 30 300 30]
setflag "person_move
make "consecutive_count 0
dispmsg last :scores 320 -170 white
replacelast "scores (last :scores) + 1
dispmsg last :scores 320 -170 run last :scorecolr
][ ud_thinking_message
dispmsg [CONGRATULATIONS - YOU WON!] -150 250 Blue
sounds [400 30 800 30 1200 30]
clrflag "person_move
increment "consecutive_count
dispmsg first :scores 180 -170 white
replacefirst "scores (first :scores) + 1
dispmsg first :scores 180 -170 run first :scorecolr
]
; clear "Click here for help" message
foreach getmsgstack [run ?]
if not yesno_mouse [Play Again?] -150 -210 30
[ throw "end_playgame
]
end
to ab_playgame1 :maxnum
; This routine plays one game until either side wins.
local [move]
ifelse :person_move
[ alert
make "move ac1_make_choice :numbers_used :maxnum
clrflag "person_move
][
ignore [
move=(list word "cm1_computer_move_
ad1_get_difficulty :numbers_used :maxnum)
runmove=run :move
show runmove
move=run runmove
show move
]
make "move run (list word "cm1_computer_move_ ~
ad1_get_difficulty :numbers_used :maxnum)
setflag "person_move
]
make "numbers_used lput :move :numbers_used
make "numbercoordinates ~
uc_setup_board :numbers_used :maxnum :person_move :scorecolr
ub_display_used_numbers :numbers_used
; if the computer has just played, exit now.
if :person_move [stop]
; detect end of game
if memberp 1 :numbers_used
[ if :move > (:maxnum / 2)
[ if primep :move
[ throw "end_playgame1
]
]
]
; not a big prime with '1' already used
; check if number entered is a factor or multiple already used.
if subsetp factors :move :numbers_used
[ if subsetp multiples :move :maxnum :numbers_used
[ throw "end_playgame1
]
]
end
to ac1_make_choice :numbers_used :maxnum
;***************************************
; This routine accepts an input number from the human player.
; If the number is the first number of the game, it must
; be even.
ze_clear_messages
(dispmsg [Left mouse button to pick number] -380 -200 black ~
[[Comic] -16 0 0 400 0 0 0 0 3 2 1 66])
(dispmsg [Right mouse button to quit this game] -380 -220 black ~
[[Comic] -16 0 0 400 0 0 0 0 3 2 1 66])
local [work1]
ifelse emptyp :numbers_used
[ do_until
[ dispmsg [Please choose number from those above] -215 -45 randcolr
dispmsg [The number must be EVEN to start the game] -215 -65 blue
(dispmsg (list "Oops! "can't "use getrepository "!!) -120 240 white ~
[[ariblk] -24 0 0 500 0 0 0 0 3 2 1 82]) ~
make "work1 mousepick :numbercoordinates "end_playgame1
ifelse clickherep :work1
[ run (list bf member "% :work1)
][ if not memberp :work1 sequence 2 [?+2] :maxnum
[ beep
pushrepository :work1
(dispmsg (list "Oops! "can't "use :work1 "!!) -120 240 red ~
[[ariblk] -24 0 0 500 0 0 0 0 3 2 1 82])
wait 100
]
]
][memberp :work1 sequence 2 [?+2] :maxnum]
][ do_until
[ dispmsg [Please choose number from those above] -215 -45 randcolr
(dispmsg (list "Oops! "can't "use getrepository "!!) -120 240 white ~
[[ariblk] -24 0 0 500 0 0 0 0 3 2 1 82])
make "work1 mousepick :numbercoordinates "end_playgame1 ~
ifelse numberp :work1
[ if not (or factorp :work1 last :numbers_used ~
factorp last :numbers_used :work1)
[ beep
pushrepository :work1
(dispmsg (list "Oops! "can't "use :work1 "!!) -120 240 red ~
[[ariblk] -24 0 0 500 0 0 0 0 3 2 1 82])
wait 100
]
][ if clickherep :work1
[ run (list bf member "% :work1)
]
]
][(or factorp :work1 last :numbers_used ~
factorp last :numbers_used :work1)]
]
op :work1
end
to ad1_get_difficulty
;********************
; This routine increases the computer skill level if the
; human opponent has won three consecutive games.
if greaterp :consecutive_count 2
[ make "consecutive_count 0
dispmsg first indices (list :difficulty) [easy moderate hard] ~
-205 -170 white
if equalp :difficulty "moderate
[ make "difficulty "hard
]
if equalp :difficulty "easy
[ make "difficulty "moderate
]
]
dispmsg first indices (list :difficulty)
[easy moderate hard] -205 -170 dkgreen
op :difficulty
end
to ae_help_free_moves
;********************
; This routine indicates if there are any moves left.
; clear help messages
foreach popmsgstack [run ?]
foreach popmsgstack [run ?]
if emptyp :numbers_used
[ dispmsg [There are SOME moves left] 100 -220 magenta
wait 150
dispmsg [There are SOME moves left] 100 -220 white
stop
]
if emptyp setdifference ~
(union (factors last :numbers_used) ~
(multiples last :numbers_used :maxnum)) :numbers_used
[ dispmsg [There are NO moves left] 100 -220 magenta
wait 150
dispmsg [There are NO moves left] 100 -220 white
stop
]
ifelse onememberp setdifference ~
(union (factors last :numbers_used) ~
(multiples last :numbers_used :maxnum)) :numbers_used
[ ae_help_free_moves_1 :numbers_used
][ dispmsg [There are SOME moves left] 100 -220 magenta
wait 150
dispmsg [There are SOME moves left] 100 -220 white
]
end
to ae_help_free_moves_1 :numbers_used
; ***********************************
ifelse memberp 1 :numbers_used
[ dispmsg [Only one number left] 100 -220 magenta
wait 150
dispmsg [Only one number left] 100 -220 white] ~
[dispmsg [Only number '1' is left] 100 -220 magenta
wait 150
dispmsg [Only number '1' is left] 100 -220 white
]
end
to ae_help_proc
;**************
; This routine is called if 'Help' is requested. It gives the two further
; options of listing the game rules or indicating if there are any moves
; left.
; clear 'Click here for help' message
foreach popmsgstack [run ?]
localmake "helpcoords lput clickhere [for rules] 120 -200 "ae_help_rules []
make "helpcoords lput clickhere [for free moves] ~
120 -230 "ae_help_free_moves :helpcoords
localmake "work1 mousepick :helpcoords "end_playgame1
run (list bf member "% :work1)
; restore board
make "numbercoordinates ~
uc_setup_board :numbers_used :maxnum :person_move :scorecolr
ub_display_used_numbers :numbers_used
(dispmsg [Left mouse button to pick number] -380 -200 black ~
[[Comic] -16 0 0 400 0 0 0 0 3 2 1 66])
(dispmsg [Right mouse button to quit this game] -380 -220 black ~
[[Comic] -16 0 0 400 0 0 0 0 3 2 1 66])
end
to ae_help_rules
;***************
; clear 'Click here for rules' message
clearmsgstack
zc_listrules
end
to cm12_get_hard_first_move :maxnum
;**********************************
; Get a winning starting number if possible.
op pick firsts ~
filter [lessp last last ? (:maxnum / 3)] ~
filter [lessp count last ? 3] ~
merge_ sequence 4 [?+2] :maxnum ~
map "bf ~
map [cm20_factors_multiples ? :maxnum []] ~
sequence 4 [?+2] :maxnum
end
to cm1_computer_move_easy :numbers_used :maxnum
;**********************************************
; The only 'strategy' that this program uses is to play
; moves randomly - if that can be called a strategy!
; numbers_used contains all the numbers already played;
ud_thinking_message
; If computer has to make first move, pick even number
if emptyp :numbers_used
[ op cm40_get_first_move :maxnum
]
; >>>>> not first move
; If last move played was 1, play large prime as the winning move.
if equalp last :numbers_used 1
[ op pick filter [greaterp ? (:maxnum / 2)] primes :maxnum
]
; otherwise randomly choose number (except 1 and 2, if possible)
op cm41_random_choice :numbers_used :maxnum
end
to cm1_computer_move_hard :numbers_used :maxnum
;**************************************************
; numbers_used contains all the numbers already played;
local [work1 winning_moves losing_moves]
ud_thinking_message
; If computer has to make first move, has to pick even number
if emptyp :numbers_used
[ op cm12_get_hard_first_move :maxnum
]
; do initial scan of restricted options
localmake "options ~
cm20_factors_multiples last :numbers_used :maxnum :numbers_used
if emptyp :options ~
[ ifelse memberp 1 :numbers_used
[ throw "end_playgame1
][ op 1
]
]
if onememberp :options
[ op first :options
]
; Try and determine winning and losing sequences by doing a
; breadth-search of possible moves.
make "work1 cm51_tree :numbers_used :maxnum
show :work1
; check for winning moves
if not emptyp :work1
[ make "winning_moves cm1_computer_move_hard1w :work1
if not emptyp :winning_moves
[ op pick :winning_moves
]
]
; check for losing moves
if not emptyp :work1
[ make "losing_moves cm1_computer_move_hard1l :work1
if not emptyp :losing_moves
[ op cm41_random_choice se
:numbers_used :losing_moves :maxnum
]
]
cm1_computer_move_hard_message
; otherwise randomly choose number (except 1 and 2, if possible)
op cm41_random_choice :numbers_used :maxnum
end
to cm1_computer_move_hard1l :inseq
;*********************************
; output the first member(s) of any losing sequences(s)
op firsts filter [evenp count ?] :inseq
end
to cm1_computer_move_hard1w :inseq
;*********************************
; output the first member(s) of any winning sequences(s)
op firsts filter [oddp count ?] :inseq
end
to cm1_computer_move_hard_message
;********************************
(flashmessage [Gosh, this is hard!] -20 250 green black 10 ~
[[Arial] -28 0 0 500 0 0 0 0 3 2 1 82])
end
to cm1_computer_move_moderate :numbers_used :maxnum
;**************************************************
; This routine tries to play moderately well.
; numbers_used contains all the numbers already played.
ud_thinking_message
; If computer has to make first move, has to pick even number
; (but avoid 2).
if emptyp :numbers_used
[ op cm40_get_first_move :maxnum
]
; >>>>> not first move
; If last move played was 1, play large prime as the winning move.
if equalp last :numbers_used 1
[ op pick filter [greaterp ? (:maxnum / 2)] primes :maxnum
]
; do initial scan of restricted options
localmake "options ~
cm20_factors_multiples last :numbers_used :maxnum :numbers_used
if emptyp :options ~
[ ifelse memberp 1 :numbers_used
[ throw "end_playgame1
][ op 1
]
]
if onememberp :options
[ op first :options
]
; ** Try to avoid obvious losing moves
localmake "losing_options filter [cm39_losing_movep ? :maxnum :numbers_used] ~
:options
if not emptyp :losing_options
[ make "options notmemberf :options :losing_options
]
; If list emptyp, risk playing losing move anyway because opponent
; may not recognise it.
if emptyp :options
[ op pick fput 1 cm20_factors_multiples last :numbers_used :maxnum :numbers_used
]
;*****
; Consider those factors-multiples with few options.
localmake "work1 catch "cm28gfm1 [(cm28_get_few_members :options ~
:maxnum :numbers_used 0)]
if emptyp :work1 ~
[ ifelse memberp 1 :numbers_used
[ throw "end_playgame1
][ op 1
]
]
; Check if there are any possible winning moves.
if equalp last first :work1 0
[ op pick map "first :work1
]
; Now try to find chain of moves that will lead to a win.
op catch "cm1_moderate
[ cm31_get_move union :losing_options :numbers_used :maxnum
]
end
to cm1h_get_possible_chain :inval :maxnum :numbers_used
;******************************************************
if emptyp :inval [op []]
local "work1
make "work1 filter "oddp ~
cm20_factors_multiples :inval :maxnum :numbers_used
if onememberp :work1
[ make "work1 first :work1
op fput :work1 ~
cm1h_get_possible_chain
:work1 :maxnum remove :inval :numbers_used
]
op cm1h_get_possible_chain [] :maxnum :numbers_used
end
to cm1h_winning_move :inlist :maxnum :numbers_left
;************************************************
; This routine checks if one or more of the factors/multiples
; of the last move are the end of the chain
; (ie their only factor/multiple is 1.)
; If it is/they are, output them.
if emptyp :inlist [op []]
if emptyp intersection joinlists factors first :inlist ~
multiples first :inlist :maxnum :numbers_left
[ op fput first :inlist
cm1h_winning_move bf :inlist :maxnum :numbers_left
]
op cm1h_winning_move bf :inlist :maxnum :numbers_left
end
to cm20_factors_multiples :in_num :maxnum :numbers_used
;*****************************************************
; The input to this routine is a number; the output is a
; list containing all of the factors and the
; multiples (less than or equal to maxnum) of the number
; that are still available to be be used (ie minus the
; numbers used and the number 1).
local "work1
make "work1 bl factors :in_num
if emptyp :work1 [make "work1 [1]]
op notmemberf se (bl :work1) ~
(multiples :in_num :maxnum) :numbers_used
end
to cm28_factors_multiples :in_num :maxnum :numbers_left
;*****************************************************
op intersection ~
joinlists bf factors :in_num multiples :in_num :maxnum ~
:numbers_left
end
to cm28_few_membersf :inlist :maxnum :numbers_used [:length 1]
;************************************************************
; For each member of inlist, this routine calculates the set of its
; factors and multiples. If the size of this set is less than the
; specified length, the input value is assembled into the output list.
if emptyp :inlist [op []]
if lessp count cm20_factors_multiples first :inlist :maxnum :numbers_used ~
:length+1
[ op fput fput first :inlist (list :length) ~
(cm28_few_membersf bf :inlist :maxnum :numbers_used :length)
]
op (cm28_few_membersf bf :inlist :maxnum :numbers_used :length)
end
to cm28_get_few_members :inlist :maxnum :numbers_used [:length 1]
;************************************************************
if emptyp :inlist [(throw "cm28gfm1 [])]
local "work1
make "work1 (cm28_few_membersf :inlist :maxnum :numbers_used :length)
if emptyp :work1
[ (cm28_get_few_members :inlist :maxnum :numbers_used (:length + 1))
]
(throw "cm28gfm1 :work1)
end
to cm28_get_second_level_factors :inval :maxnum :numbers_used
;************************************************************
; This routine outputs a list of lists.
; The first member of each sublist is a factor/multiple of
; :inval, the remaining members are its factors and multiples.
localmake "work1 cm20_factors_multiples :inval :maxnum :numbers_used
op map "flattenlist merge_ :work1 ~
map [cm20_factors_multiples ? :maxnum fput :inval :numbers_used] :work1
end
to cm28_get_shortest :inlist :maxnum :numbers_used [:countr 1] ~
[:length 100] [:index 1]
;*******************************************************************
; This routine outputs the index of the sublist within inlist that
; has the fewest factors.
if emptyp :inlist [op :index]
local [work1]
if primep last first :inlist
[ make "work1 count cm20_factors_multiples last first :inlist :maxnum ~
fput first first :inlist :numbers_used
if equalp :work1 0
[ op (cm28_get_shortest bf :inlist :maxnum ~
fput first first :inlist :numbers_used :countr + 1 :length :index)
]
]
make "work1 count cm20_factors_multiples last first :inlist :maxnum ~
fput first first :inlist :numbers_used
if lessp :work1 :length
[ op (cm28_get_shortest bf :inlist :maxnum ~
fput first first :inlist :numbers_used :countr + 1 :work1 :countr)
]
op (cm28_get_shortest bf :inlist :maxnum ~
fput first first :inlist :numbers_used :countr + 1 :length :index)
end
to cm28_select_short_chains :inlist :length
;*****************************************
op filter [lessp count ? :length] :inlist
end
to cm29_losing_movep :inval :maxnum :numbers_left
;************************************************
; This routine checks if the chosen value does not
; immediately lead to a losing move.
; For example, in a game of 40 numbers, if 5 is played,
; then the opponent could respond with 25, a winning move.
; The routine outputs 'true' if the potential move would
; lose on the opponent's next move.
op memberp [] map [intersection joinlists factors ? ~
multiples ? :maxnum remove :inval :numbers_left] ~
cm28_factors_multiples :inval :maxnum :numbers_left
end
to cm31_get_move :numbers_used :maxnum
;*************************************
if not lessp count :numbers_used :maxnum
[ (throw "cm1_moderate first :work1)
]
local [work1]
make "work1 ~
cm20_factors_multiples last :numbers_used :maxnum :numbers_used
if emptyp :work1
[ (throw "cm1_moderate 1)
]
if onememberp :work1
[ (throw "cm1_moderate first :work1)
]
make "work1 cm37_process_factors (list last :numbers_used) :maxnum ~
(fput last :numbers_used :numbers_used)
; If chain created (although it may not necessarily be a winning chain),
; If only one option, play it.
if onememberp :work1
[ (throw "cm1_moderate first :work1)
]
; Play first move if it is not a losing move.
if not emptyp :work1
[ ifelse cm39_losing_movep first :work1 :maxnum :numbers_used
[ cm31_get_move fput first :work1 :numbers_used :maxnum
][ (throw "cm1_moderate first :work1)
]
]
; otherwise randomly choose number (except 1 and 2, if possible)
(throw "cm1_moderate ~
first cm41_random_choice :numbers_used :maxnum)
end
to cm37_process_factors :inval :maxnum :numbers_used
;***************************************************
if emptyp :inval [op []]
local [work1 work2]
make "work1 cm37_process_factors1 first :inval :maxnum :numbers_used
if not emptyp :work1
[ make "work2 item (cm28_get_shortest :work1 :maxnum ~
(fput first :inval :numbers_used)) :work1 ~
op fput first :work2 ~
cm37_process_factors bf :work2 :maxnum (fput
first :work2 :numbers_used)
]
op cm37_process_factors [] :maxnum :numbers_used
end
to cm37_process_factors1 :inval :maxnum :numbers_used [:length 3]
;****************************************************************
; This routine outputs a list of short chains of odd factors of the
; factors of the input value.
local [work1 work2 loopflag length2]
make "work1 cm28_get_second_level_factors :inval :maxnum :numbers_used
make "length2 :length
setflag "loopflag
while [:loopflag]
[ make "work2 filter [lessp count ? :length2] :work1
ifelse not emptyp :work2
[ clrflag "loopflag
][ ifelse lessp :length2 13
[ increment "length2
][ clrflag "loopflag
]
]
]
op map "flattenlist merge_ map "first :work2 map [oddf bf ?] :work2
end
to cm39_losing_movep :inval :maxnum :numbers_used
;************************************************
; This routine checks if the chosen value does not
; immediately lead to a losing move.
; For example, in a game of 40 numbers, if 5 is played,
; then the opponent could respond with 25, a winning move.
; The routine outputs 'true' if the potential move could
; lose on the opponent's next move. (It doesn't necessarily
; lose because there could be other non-losing moves
; that are played instead if the human opponent
; overlooks the winning move.)
op memberp [] map [cm20_factors_multiples ? :maxnum ~
fput :inval :numbers_used] ~
cm20_factors_multiples :inval :maxnum :numbers_used
end
to cm40_get_first_move :maxnum
;*****************************
local [work1 valid_flag]
do_until
[ make "work1 pick sequence 4 [?+2] :maxnum
setflag "valid_flag
if greaterp :work1 (:maxnum / 2)
[ if memberp (:work1 / 2) primes :maxnum
[ clrflag "valid_flag
]
]
][ :valid_flag
]
op :work1
end
to cm41_random_choice :numbers_used :maxnum
;******************************************
; This routine outputs a random choice from the
; valid moves available except that it tries to avoid
; choosing 1 or 2.
localmake "work1 ~
cm20_factors_multiples last :numbers_used :maxnum :numbers_used
if emptyp :work1 [op 1]
make "work1 remove 1 :work1
if emptyp :work1 [op 1]
make "work1 remove 2 :work1
if emptyp :work1 [op 2]
op pick :work1
end
to cm51_1_tree :in_num :inlist :maxnum :numbers_used
;***************************************************
; This routine accumulates each factor-multiple into a list containing
; three members:
; [the factor-multiple
; the upper bound of the game (:maxnum)
; the future available moves (with the input value "in_num" added)]
if emptyp :inlist [op []]
op lput (list first :inlist :maxnum :numbers_used) ~
cm51_1_tree :in_num bf :inlist :maxnum :numbers_used
end
to cm51_tree :numbers_used :maxnum
;*********************************
; This routine is performed once to establish the original inputs
; into the tree search. It outputs any indentified possible winning
; or losing sequences.
localmake "move_chain [[][]]
; localmake "work1 notemptyf cm53_get_chain_sequence last :numbers_used ~
op catch "cm51% [cm52_breadth_descend ~
cm51_1_tree last :numbers_used ~
(cm20_factors_multiples last :numbers_used :maxnum :numbers_used) ~
:maxnum :numbers_used]
op :work1
end
to cm52_1_process :inlist
;************************
; This routine determines if the number of succeeding moves is zero or one.
; If there are no more moves, the sequence is stored and no further processing
; is done. If this is only one more move, that move is processed.
; Otherwise the routine outputs "false and further processing of the move
; sequence is not done.
localmake "work1 ~
cm20_factors_multiples first :inlist first bf :inlist last :inlist
if greaterp count :work1 1 [op "false]
if emptyp :work1
[ make "move_chain fput lput :inlist first :move_chain bf :move_chain
op "false
]
make "move_chain lput lput :inlist last :move_chain bl :move_chain
op "true
end
to cm52_2_children :inlist
;***********************
; This routine outputs the odd factors-multiples of the first value
; of inlist. Otherwise, it outputs the empty list.
if emptyp :inlist [op []]
local [work2]
make "work2 []
foreach cm20_factors_multiples first :inlist first bf :inlist last :inlist
[ make "work2 lput (list ? first bf :inlist lput
first :inlist last :inlist) :work2
]
op :work2
end
to cm52_breadth_descend :queue_
;*****************************
if emptyp :queue_
[ (throw "cm51% :move_chain)
]
if cm52_1_process first :queue_
[ cm52_breadth_descend update_queue :queue_ cm52_2_children first :queue_
]
cm52_breadth_descend bf :queue_
end
to cm53_get_chain_sequence :in_num :inlist
;*****************************************
; This routine strips off the sequences of possible winning moves
; and accumulates them into an output list. It removes the moves that
; have been played before this move sequences started:
; ie if the moves played before the current move were [24 3 9 18] and
; the possible succeeding move sequence was [6 2 34 17] then the input
; list (:inlist) would be [24 3 9 18 6 2 34 17]. This routine would
; output the list [6 2 34 17].
if emptyp :inlist [op []]
op lput lput first first :inlist ~
afterf :in_num last first :inlist cm53_get_chain_sequence :in_num bf :inlist
end
to cm1h_any_primes :in_num :maxnum :numbers_used
;************************************************
op filter [anyprimesp cm20_factors_multiples ? :maxnum se :numbers_used :in_num] ~
cm20_factors_multiples :in_num :maxnum :numbers_used
end
to cm1h_short_chain :in_num :maxnum :numbers_used
;************************************************
op filter [onememberp cm20_factors_multiples ? :maxnum se :numbers_used :in_num] ~
cm20_factors_multiples :in_num :maxnum :numbers_used
end
to ua_new_game_setup :maxnum
;***************************
; draw initial board
setblank
; get who moves first
if :first_time_thru
[ clrflag "first_time_thru
clrflag "person_move
if yes [Who Starts?] [Do you want to make the first move?]
[ setflag "person_move
]
]
; make scores match the screen colour of the numbers played.
ifelse :person_move
[ make "scorecolr [red blue]
][ make "scorecolr [blue red]
]
make "numbercoordinates uc_setup_board [] :maxnum :person_move :scorecolr
make "numbers_used []
end
to ub_display_used_numbers :numbers_used
;***************************************
localmake "number_count 0
localmake "xcoord -285
localmake "ycoord -70
foreach :numbers_used
[ ifelse evenp :number_count
[ localmake "colour red
][ localmake "colour blue
]
dispmsg ? :xcoord :ycoord :colour
make "xcoord :xcoord+30
if :number_count > 18
[ make "ycoord :ycoord - 20
make "xcoord -285
make "number_count -1
]
make "number_count :number_count+1
]
end
to uc_setup_board :numbers_used :maxnum :person_move :scorecolr
;**************************************************************
; This routine displays the available numbers on the screen
; and also sets up a file of screen coordinates to be used
; by the mouse when selecting numbers.
local [xcoord ycoord number work1 numcooords]
cs ht
setlabelfontList [[Times] -24 0 0 400 0 0 0 0 3 2 1 18]
dispmsg [Difficulty Level] -380 -170 magenta
dispmsg first indices (list :difficulty) [easy moderate hard] -205 -170 dkgreen
dispmsg [Scores: ] 80-(11*(count :firstname)) -170 black
dispmsg :firstname 160-(11*(count :firstname)) -170 run first :scorecolr
dispmsg first :scores 180 -170 run first :scorecolr
dispmsg "Computer 210 -170 run last :scorecolr
dispmsg last :scores 320 -170 run last :scorecolr
make "ycoord 240
make "work1 ((:maxnum / 10) - 1)
make "numcoords []
if :person_move
[ make "numcoords lput clickhere [for help] 120 -220 "ae_help_proc []
]
for [i 0 :work1]
[ make "ycoord :ycoord - 22
make "xcoord -120
for [j 1 10]
[ make "number (:i*10)+:j
ifelse memberp :number :numbers_used
[ dispmsg :number :xcoord :ycoord white
][ make "numcoords lput labelpos 20 12
:number :xcoord :ycoord magenta :numcoords
]
make "xcoord :xcoord + 35
]
]
op :numcoords
end
to ud_thinking_message
;*********************
(flashmessage "Thinking 20 250 red blue 1 ~
[[Arial] -28 0 0 500 0 0 0 0 3 2 1 82])
end
to za_initialise
;;***********
zb_initialise1
; The first entry of scores is for the human player,
; the second for the computer
make "scores [0 0]
make "consecutive_count 0
; get game level
dialogboxmake "root [Choose Game Size]
[[30 Numbers] [40 Numbers] [100 Numbers]] ~
[[make "maxnum 30] [make "maxnum 40] [make "maxnum 100]]
; get difficulty level
dialogboxmake "root [Choose Difficulty Level] ~
[[Beginner] [Intermediate][Expert]] ~
[ [make "difficulty "easy]
[make "difficulty "moderate]
[make "difficulty "hard]
]
setflag "first_time_thru
end
to zb_initialise1
;*************
savefont
author
(backgroundcolour white)
local [ycoord]
setblank
cs
setlabelfontList [[Arial] -40 0 0 400 0 0 0 0 3 2 1 49]
dispmsg [Welcome to] -160 70 blue
dispmsg [JUNIPER GREEN!!!] -210 20 green
wait 20
repeat 4
[ (backgroundcolour red ) wait 1
(backgroundcolour yellow) wait 1
]
cs
(backgroundcolour magenta)
setlabelfontList [[Arial] -30 40 0 400 0 0 0 0 3 2 1 49]
dispmsg [The game] -170 160 blue
setlabelfontList [[Arial] -48 50 0 400 1 0 0 0 3 2 1 49]
dispmsg [Juniper Green]-300 120 green
setlabelfontList [[Arial] -30 50 0 400 0 0 0 0 3 2 1 49]
dispmsg [was invented by] -360 60 blue
setlabelfontList [[Arial] -48 50 0 400 0 0 0 0 3 2 1 49]
dispmsg [Rob Porteous] -280 20 red
setlabelfontList [[Arial] -18 0 0 400 0 0 0 0 3 2 1 49]
dispmsg [see "Scientific American" March 1997] -250 -110 blue
(continue_click [to continue] -320 -200 green)
cs
; setheading 90
(backgroundcolour yellow)
setlabelfontList [[Arial] -30 20 0 400 0 0 0 0 3 2 1 49]
dispmsg [It is a game to help] -210 160 blue
setlabelfontList [[Arial] -30 20 0 400 0 0 0 0 3 2 1 49]
dispmsg [with] -40 120 blue
setlabelfontList [[Arial] -48 40 0 400 1 0 0 0 3 2 1 49]
dispmsg [Multiplication] -285 60 red
setlabelfontList [[Arial] -30 10 0 400 0 0 0 0 3 2 1 49]
dispmsg [and] -20 -10 magenta
setlabelfontList [[Arial] -48 40 0 400 1 0 0 0 3 2 1 49]
dispmsg [Division] -170 -80 red
wait 200
cs
; get player's name
(backgroundcolour blue)
setlabelfontList [[Times] -40 0 0 400 0 0 0 0 3 2 1 18]
ConsoleSetFocus
make "firstname meetyou se rudewords [computer]
restfont
end
to zc_listrules
; this routine simply displays the rules of "Juniper Green"
cs
(backgroundcolour yellow)
setlabelfontList [[Arial] -32 20 0 400 0 0 0 0 3 2 1 49]
dispmsg [The Rules of ] -300 220 blue
dispmsg [Juniper Green] -40 220 green
setlabelfontList [[Arial] -22 0 0 400 0 0 0 0 3 2 1 49]
dispmsg [You are playing against the computer] -380 160 magenta
dispmsg [1. You and the computer take turns] -380 120 red
dispmsg [2. Numbers played must be picked from the list given] -380 80 red
dispmsg [3. The first number played must be even] -380 40 red
dispmsg [4. Each number can only be used once] -380 0 red
dispmsg [5. After the first move, each number played must be] -380 -40 red
dispmsg [either an exact multiple or an exact divisor of] -340 -80 red
dispmsg [the previous number played] -340 -120 red
dispmsg [6. The first player who can't play a valid move, loses] -380 -160 red
continue_click
cs
(backgroundcolour yellow)
setlabelfontList [[Arial] -18 0 0 400 0 0 0 0 3 2 1 49]
dispmsg [For the first game, you can choose who plays first.] -380 160 magenta
dispmsg [For all the other games, the loser of the previous] -380 120 magenta
dispmsg [game plays first.] -380 80 magenta
dispmsg [If you win three games in a row, the computer will] -380 -40 magenta
dispmsg [try to play better. The "difficulty level" is] -380 -80 magenta
dispmsg [shown in the bottom left corner of the screen.] -380 -120 magenta
continue_click
end
to ze_clear_messages
dispmsg [Please choose number from those above] -215 -45 white
(dispmsg [Left mouse button to pick number] -380 -200 white ~
[[Comic] -16 0 0 400 0 0 0 0 3 2 1 66])
(dispmsg [Right mouse button to quit this game] -380 -220 white ~
[[Comic] -16 0 0 400 0 0 0 0 3 2 1 66])
(dispmsg (list "Oops! "can't "use getrepository "!!) -120 240 white ~
[[ariblk] -24 0 0 500 0 0 0 0 3 2 1 82])
end