;*********************************************************************
;** INFORMATION
;*********************************************************************
;-- Title: Animal Farm [Greek: Ç öÜñìá ôùí æþùí (ÓõììåôáâïëÝò junior)]
;-- History:
;--- 1st edition: 7 November 2002 (Ã.Ìðéñìðßëçò & Ê.Ãáâñßëçò)
;--- 2nd edition: 9 November 2002 (Ê.Ãáâñßëçò)
;--- 3d edition: 14 November 2002 (Ã.Ìðéñìðßëçò)
;--- 4th edition: 19 November 2002 (Ã.Ìðéñìðßëçò & Ê.Ãáâñßëçò)
;--- 5th edition: 13 April 2003 (Ã.Ìðéñìðßëçò)
;--- 6th edition (English translation): 10 June 2003 (G.Birbilis)
;*********************************************************************
;*** CONSTANT PARAMETERS
;*********************************************************************
;-- sheeps layout parameters
make "SHEEP_START [190 25]
make "SHEEP_GAP 30
make "SHEEP_SIDE 40
;-- barn & food layout parameters
make "FOOD_SIDE 25
make "BARN_NAME "Barn
make "BARN_COLOR [100 100 0]
make "BARN_LOCATION [78 340]
make "BARN_WIDTH 156
make "BARN_HEIGHT 680
;-- scene's background color ([red green blue], each color element range is 0-255)
make "SCENE_COLOR [188 182 129]
;-- each sheep will find all food that is placed in a vertical (Y+)
;-- order above it, using the rule (abs (food.x-sheep.x))<:DX
make "DX 10
;-- microworld component names
make "Scene "Scene
;*********************************************************************
;*** GLOBAL VARIABLES
;*********************************************************************
;-- two lists, holding sheep and food scene object names
make "sheep []
make "food []
;*********************************************************************
;*** GENERAL UTILITY SUBROUTINES
;*********************************************************************
;---------------------------------------------------------------------------
;-- return the given list without the given item
;---------------------------------------------------------------------------
to removeFromList :item :list
localmake "result []
repeat (len :list) [
localmake "current (item repcount :list)
if (not :current=:item) [ localmake "result (lput :current :result) ]
]
output :result
end
;---------------------------------------------------------------------------
;-- return given list's length
;-- (this is a workarround cause the "Scene" component [unfortunately] redefines the "length" primitive to return length quantity of a scene object)
;---------------------------------------------------------------------------
to len :list
output ifelse (:list=[]) [0] [(len butfirst :list)+1]
end
;---------------------------------------------------------------------------
;-- returns the folder where this microworld's file exists
;---------------------------------------------------------------------------
to myMicroworldFolder
output ask [] [tellall microworldFolder]
end
;*** SCENE UTILITY SUBROUTINES ************************************
;---------------------------------------------------------------------------
;-- returns the x part of a scene object's location, given the object's name
;---------------------------------------------------------------------------
to getLocationX :name
output (first ask :name [location] )
end
;---------------------------------------------------------------------------
;-- returns the y part of a scene object's location, given the object's name
;---------------------------------------------------------------------------
to getLocationY :name
output (last ask :name [location] )
end
;---------------------------------------------------------------------------
;-- returns the width of a scene object, given the object's name
;---------------------------------------------------------------------------
to getWidth :name
output (ask :name [width])
end
;---------------------------------------------------------------------------
;-- returns the height of a scene object, given the object's name
;---------------------------------------------------------------------------
to getHeight :name
output (ask :name [height])
end
;---------------------------------------------------------------------------
;-- make a scene object (using a SquareBox)
;-- initialize object with given name, location (x,y), side (=width=height)
;-- set object image using given image filename (relative path to microworld's folder)
;-- "refresh" parameter controls whether scene will be refreshed or not (use for batch creation of many sheep/food objects)
;---------------------------------------------------------------------------
to makeIcon :name :x :y :side :imageName :refresh
ask :Scene [
if :refresh [scene.disableRefresh]
localmake "autoName (scene.makeObject "SquareBox)
ask :autoName [
setName :name
setWidth :side
setHeight :side
setLocation (list :x :y)
setImage (word myMicroworldFolder :imageName)
]
if :refresh [scene.enableRefresh]
]
end
;---------------------------------------------------------------------------
;-- remove given name from given list and remove scene object with that name
;---------------------------------------------------------------------------
to removeIcon :name :list
;-- ask :Scene [ scene.removeObject :name ]
;-- *** not using the above primitive, seems to be causing a bad refreshing of the Stage component
ask :name [
setName (word :name (random 1000))
setLocation [1000 1000]
]
output (removeFromList :name :list)
end
;---------------------------------------------------------------------------
;-- return a given list of scene object names, sorted by the object locations' y part
;-- (used to have sheep start eating food above them from bottom to top)
;---------------------------------------------------------------------------
to sortIconsByY :icons
output qsort :icons [ [name1 name2] [ output (getLocationY :name1) < (getLocationY :name2) ] ]
end
;---------------------------------------------------------------------------
;-- return a given list of scene object names, sorted by the object locations' x part
;-- (used to have new sheep added to the right of the rightmost sheep)
;---------------------------------------------------------------------------
to sortIconsByX :icons
output qsort :icons [ [name1 name2] [ output (getLocationX :name1) < (getLocationX :name2) ] ]
end
;---------------------------------------------------------------------------
;-- return a given list of scene object names, sorted by the object locations
;-- (used to have new sheep added to the right of the rightmost sheep)
;---------------------------------------------------------------------------
to sortIconsByXY :icons
output qsort :icons [ [name1 name2] [ output (and ((getLocationX :name1) > (getLocationX :name2)) ((getLocationY :name1) < (getLocationY :name2))) ] ]
end
;*********************************************************************
;*** MICROWORLD SUBROUTINES
;*********************************************************************
;~~~~~~~~~~~~~~~
;~~~> BARN <~~~
;~~~~~~~~~~~~~~~
;---------------------------------------------------------------------------
;-- create and initialize barn object
;---------------------------------------------------------------------------
to makeBarn
ask :Scene [
scene.disableRefresh
localmake "autoName (scene.makeObject "Box)
ask :autoName [
setName :BARN_NAME
setLocation :BARN_LOCATION
setWidth :BARN_WIDTH
setHeight :BARN_HEIGHT
setcolor :BARN_COLOR
]
scene.enableRefresh
]
end
;---------------------------------------------------------------------------
;-- return list with names of food objects inside the barn
;---------------------------------------------------------------------------
to getFoodInBarn
localmake "leftX (getLocationX :BARN_NAME)-(getWidth :BARN_NAME)/2
localmake "rightX (getLocationX :BARN_NAME)+(getWidth :BARN_NAME)/2
localmake "topY (getLocationY :BARN_NAME)+(getHeight :BARN_NAME)/2
localmake "bottomY (getLocationY :BARN_NAME)-(getHeight :BARN_NAME)/2
localmake "result []
repeat (len :food) [
localmake "foodName (item repcount :food)
localmake "foodX (getLocationX :foodName)
localmake "foodY (getLocationY :foodName)
if (and (:foodX>:leftX) (:foodX<:rightX) (:foodY>:bottomY) (:foodY<:topY) ) [
localmake "result (lput :foodName :result)
]
]
output :result
end
;~~~~~~~~~~~~~~~
;~~~> SHEEP <~~~
;~~~~~~~~~~~~~~~
;---------------------------------------------------------------------------
;-- make sheep with given name and location (x,y)
;---------------------------------------------------------------------------
to makeSheep :name :x :y
makeIcon :name :x :y :SHEEP_SIDE "Sheep.gif true
end
;---------------------------------------------------------------------------
;-- make some sheep given a starting location (startX,startY) and a count
;-- for naming use given base name, appending an index to it (starting from startNameIndex)
;-- return list with those new sheep names
;---------------------------------------------------------------------------
to MakeSomeSheep :startX :startY :count :baseName :startNameIndex
localmake "result []
repeat :count [
localmake "sheepX :startX+(repcount-1)*(:SHEEP_SIDE+:SHEEP_GAP)
localmake "sheepName (word :baseName repcount+:startNameIndex-1)
makeSheep :sheepName :sheepX :startY
localmake "result (lput :sheepName :result)
]
output :result
end
;---------------------------------------------------------------------------
;-- return last (rightmost) sheep's name
;---------------------------------------------------------------------------
to getLastSheep
ifelse (:sheep=[])
[ output "|| ]
[ output (last sortIconsByX :sheep) ]
end
;---------------------------------------------------------------------------
;-- remove last sheep in sheep names' list and remove that from the scene too
;---------------------------------------------------------------------------
to removeLastSheep
if (:sheep=[]) [stop]
make "sheep (removeIcon getLastSheep :sheep)
end
;---------------------------------------------------------------------------
;-- add a given number of sheep to the right of the rightmost sheep
;-- if no sheep exist, start at SHEEP_START location
;---------------------------------------------------------------------------
to addSheep :count
ifelse (not :sheep=[]) [
localmake "lastSheep getLastSheep
localmake "startX (getLocationX :lastSheep) + :SHEEP_SIDE + :SHEEP_GAP
localmake "startY (getLocationY :lastSheep)
][
localmake "startX (first :SHEEP_START)
localmake "startY (last :SHEEP_START)
]
localmake "newSheep (MakeSomeSheep :startX :startY :count "Sheep (len :sheep)+1)
make "sheep (se :sheep :newSheep)
end
;---------------------------------------------------------------------------
;-- add one more sheep
;---------------------------------------------------------------------------
to addNewSheep
addSheep 1
end
;~~~~~~~~~~~~
;~~~ FOOD ~~~
;~~~~~~~~~~~~
;---------------------------------------------------------------------------
;-- make food with given name and location (x,y)
;-- "refresh" parameter controls whether scene will be refreshed or not (use for batch creation of many food objects)
;---------------------------------------------------------------------------
to makeFood :name :x :y :refresh
makeIcon :name :x :y :FOOD_SIDE "Food.gif :refresh
end
;---------------------------------------------------------------------------
;-- make some food given a count
;-- for naming use given base name, appending an index to it (starting from startNameIndex)
;-- return list with those new food names
;---------------------------------------------------------------------------
to MakeSomeFood :count :baseName :startNameIndex
localmake "result []
ask :Scene [scene.disableRefresh]
repeat :count [
localmake "foodName (word :baseName repcount+:startNameIndex-1)
makeFood :foodName -100 -100 false
localmake "result (lput :foodName :result)
]
ask :Scene [scene.enableRefresh]
output :result
end
;---------------------------------------------------------------------------
;-- visually store list of given food inside the barn
;---------------------------------------------------------------------------
to storeFood :food
localmake "leftX (getLocationX :BARN_NAME)-(getWidth :BARN_NAME)/2+(:FOOD_SIDE/2)+10
localmake "rightX (getLocationX :BARN_NAME)+(getWidth :BARN_NAME)/2-(:FOOD_SIDE/2)-10
localmake "topY (getLocationY :BARN_NAME)+(getHeight :BARN_NAME)/2-(:FOOD_SIDE/2)-10
localmake "bottomY (getLocationY :BARN_NAME)-(getHeight :BARN_NAME)/2+(:FOOD_SIDE/2)+10
localmake "foodX :leftX
localmake "foodY (getLocationY :BARN_NAME)+(getHeight :BARN_NAME)/2-(:FOOD_SIDE/2)-10
repeat (len :food) [
ask (item repcount :food) [
setLocation (list :foodX :foodY)
]
localmake "foodX :foodX+:FOOD_SIDE+10
if :foodX>:rightX [
localmake "foodY :foodY-:FOOD_SIDE-10
localmake "foodX :leftX
if :foodY<:bottomY [
localmake "leftX :leftX+1
localmake "foodX :leftX
localmake "topY :topY-1
localmake "foodY :topY
]
]
]
end
;---------------------------------------------------------------------------
;-- add given count of new food (into the barn)
;---------------------------------------------------------------------------
to addFood :count
localmake "newFood (MakeSomeFood :count "Food (len :food)+1)
make "food (se :food :newFood)
storeFood :newFood
storeFood getFoodInBarn
end
;---------------------------------------------------------------------------
;-- add one new portion of food (into the barn)
;---------------------------------------------------------------------------
to addNewFood
addFood 1
end
;---------------------------------------------------------------------------
;-- return food with given name
;---------------------------------------------------------------------------
to removeFood :foodName
make "food (removeIcon :foodName :food)
end
;---------------------------------------------------------------------------
;-- remove bottom-most food from those inside the barn
;-- if none inside barn, remove the bottomright-most food from any outside the barn
;---------------------------------------------------------------------------
to removeLastFood
if (:food = []) [stop]
localmake "foodList getFoodInBarn
if (:foodList=[]) [localmake "foodList :food]
removeFood (first sortIconsByXY :foodList)
end
;~~~~~~~~~~~~~~~~~~~~~
;~~~ SHEEP FEEDING ~~~
;~~~~~~~~~~~~~~~~~~~~~
;---------------------------------------------------------------------------
;-- place food with given name over sheep with given name, at given vertical index
;-- (location depends on x,y part of sheep's location and on FOOD_SIZE and this index)
;---------------------------------------------------------------------------
to placeFood :sheepName :foodName :index
localmake "foodX (getLocationX :sheepName)
ask :foodName [
localmake "foodY (getLocationY :sheepName) + :index*(:FOOD_SIDE+10)
setLocation (list :foodX :foodY)
]
end
;---------------------------------------------------------------------------
;-- feed: place given count of food from given list above sheep with given name
;---------------------------------------------------------------------------
to feedOneSheep :sheepName :theFood :count
localmake "result :theFood
repeat :count [
if (:theFood=[]) [output []]
placeFood :sheepName (item repcount :theFood) repcount
localmake "result (butFirst :result)
]
output :result
end
;---------------------------------------------------------------------------
;-- stores all food back in the barn, then equally feeds all sheep:
;-- all sheep get (integer (:footCount/:sheepCount)) food and any remaining
;-- food (it's the modulo of the integer division) remains in the barn
;---------------------------------------------------------------------------
to feedSheep
ask :Scene [
scene.disableRefresh
storeFood :food
scene.enableRefresh
]
localmake "sheepCount (len :sheep)
if :sheepCount=0 [stop]
localmake "foodCount (len :food)
localmake "foodPerSheep integer (:foodCount/:sheepCount)
localmake "theFood :food
repeat (len :sheep) [
localmake "theFood (feedOneSheep (item repcount :sheep) :theFood :foodPerSheep)
]
end
;---------------------------------------------------------------------------
;-- return list with names of food objects above sheep with given name
;-- using the rule (abs (food.x-sheep.x))<:DX to select a sheep's food
;---------------------------------------------------------------------------
to getSheepFood :theSheep
localmake "sheepX (getLocationX :theSheep)
localmake "result []
repeat (len :food) [
localmake "foodName (item repcount :food)
localmake "foodX (getLocationX :foodName)
if (abs (:sheepX-:foodX))<:DX [
localmake "result (lput :foodName :result)
]
]
output :result
end
;---------------------------------------------------------------------------
;-- sheep with given name eats (removes) the bottom-most food above it
;---------------------------------------------------------------------------
to eatOneSheepFood :sheepName
localmake "sheepFood (getSheepFood :sheepName)
if (:sheepFood=[]) [ output FALSE]
localmake "sheepTodayFood (first (sortIconsByY :sheepFood))
removeFood :sheepTodayFood
output TRUE
end
;---------------------------------------------------------------------------
;-- all sheep eat the bottom-most food above them
;---------------------------------------------------------------------------
to eatFood
localmake "result FALSE
repeat (len :sheep) [
if eatOneSheepFood (item repcount :sheep) [ localmake "result TRUE ]
]
output :result
end
;*********************************************************************
;*** SCENE SETUP
;*********************************************************************
;---------------------------------------------------------------------------
;-- set up scene with given number of sheep and food portions
;-- food portions get stored in the barn
;---------------------------------------------------------------------------
to setupScene :sheepCount :foodCount
ask :Scene [
scene.clear
setColor :SCENE_COLOR
]
makeBarn
make "sheep (MakeSomeSheep (first :SHEEP_START) (last :SHEEP_START) :sheepCount "Sheep 1)
make "food (MakeSomeFood :foodCount "Food 1)
storeFood :food
end
;---------------------------------------------------------------------------
;-- (re)initialize scene, creating as many sheep and food the user has specified
;-- food portions get stored in the barn
;-- reset day counter to 1
;---------------------------------------------------------------------------
to reset
localmake "sheepCount (ask "edSheepCount [TFIELD.TEXT])
localmake "foodCount (ask "edFoodCount [TFIELD.TEXT])
ask "edDay [ TFIELD.SETTEXT 1 ]
setupScene :sheepCount :foodCount
end
;*********************************************************************
;*** SHEEP EATING SIMULATION
;*********************************************************************
;---------------------------------------------------------------------------
;-- increase day counter (no other actions/side-effects done)
;---------------------------------------------------------------------------
to newDay
ask "edDay [ TFIELD.SETTEXT TFIELD.TEXT+1 ]
end
;---------------------------------------------------------------------------
;-- check if user wants to stop the automatic feeding (see if related checkbox has been checked)
;---------------------------------------------------------------------------
to feedingStopped
output (ask "cbStop [CheckBox.Selected] )
end
;---------------------------------------------------------------------------
;-- sheeps start eating, eat bottom-most food above them every day
;---------------------------------------------------------------------------
to startSimulation
ask "cbStop [CheckBox.Unselect]
while [eatFood] [
newDay
wait 4000
if feedingStopped [stop]
]
ask "cbStop [CheckBox.Unselect]
end
;*********************************************************************
;*** TEST: SETUP SCENE WITH 4 SHEEP AND 10 FOOD PORTIONS
;*********************************************************************
setupScene 4 10