Const resX = 800, resY = 600, resD = 32, resM = 2
Graphics3D resX,resY,resD,resM
SetBuffer BackBuffer() ; DoubeBuffering
AppTitle "BPS24 Solution by Hakkai"
Local Timer = CreateTimer(60)

Local Light =CreateLight () ;3d-part unused
Local Camera=CreateCamera() ;3d-part unused

;Pictureimports
Global IMGhoern = LoadAnimImage("hoern1.png",28,40,0,6) ;my picture of the hörnchen
Global IMGfood = LoadImage("Food.jpg")
Global IMGnofood = LoadImage("noFood.jpg")
;ResizeImage hoern, 20, 30
MaskImage IMGhoern,255,0,200
Dim reserveIMG(400)
Dim logmsg$(logmax)
Global logstart
Global logcount
Const logmax = 28

;gamestates
Global state = menu
Const menu = 1
Const run = 2
Const gameover = 3
Const m = 1, w = 2

Global round = 0

;haselhörnchen Type
Type Thoern
   Field id
   Field name$
   Field gender
   Field age
   Field color
   Field img ;copy of the picture
   Field frame ;what frame is currently shown
   Field x ;whers the picture placed
   Field y
   Field reserveIMG ;lock the position where the picture is shown, cant be used until this haselhörnchen dies
End Type

Global ThoernID = 0
Global hoernName$
Global population = 0, populationWhite = 0, populationBlack = 0, populationBrown, populationWomen, populationMen
Global no_food = 0

;make rnd() random :)
SeedRnd (MilliSecs())

;Main Loop Start #############
Repeat
   
   ;Variables update
   
   ;3D
      UpdateWorld() ;3d-part unused
      RenderWorld()
   ;2D
      visuals() ; handles drawings like background and hörnchen
      logbook() ; handles logbook-textoutput on the right side
      
      Select (state)
         Case menu:
            Text 20, 12, "1 - Starte völlig zufällig"
            Text 20, 24, "2 - Starte mit: 3 (w) diff.-pelz-Farbe, 2 (m), alle 0 jahre"
         Case run:
            Text 20, 12, "jetzige Runde: " + round + ", Bevölkerung: " + population + ", weiß: " + populationWhite + ", schwarz: " + populationBlack + ", braun: " + populationBrown + ", m: " + populationMen + ", w: " + populationWomen
            Text 20, 24, "1 - nächste Runde"
         Case gameover:
            Text 20, 12, "Deine Hörnchen-Bevölkerung ist leider ausgestorben"
            Text 20, 24, "ENTER - zurück zum Menü"
      End Select
      
      Select (state)
         Case menu:
            ;Keys
            If KeyHit(2) ;1
               For i = 1 To 5
                  createHoernchen(0, 0, Rnd(0,10))
               Next
               state = run
            EndIf
            If KeyHit(3) ;2
               createHoernchen(w, 1, 0)
               createHoernchen(w, 2, 0)
               createHoernchen(w, 3, 0)
               
               createHoernchen(m, 0, 0)
               createHoernchen(m, 0, 0)
               state = run
            EndIf
         Case run:
            If population = 0 Then
               state = gameover
            EndIf
            If KeyHit(2) ;1
               calculateNextRound()
            EndIf
         Case gameover:
            If KeyHit(28) ;enter
               state = menu
               round = 0
               FlushKeys
            EndIf
      End Select
      
   WaitTimer(Timer)
   Flip(0)
   
Until KeyHit(1)
;Free Loaded Images
FreeImage IMGhoern
FreeImage IMGfood
FreeImage IMGnofood
End
;Main Loop End #############

Function popChange(count = 0, id = 0, typ$) ;register population changes for gender and color
   Select (typ$)
      Case "gender":
         If id = m Then
            populationMen = populationMen + count
         Else
            populationWomen = populationWomen + count
         EndIf
      Case "color":
         If id = 1 Then
            populationWhite = populationWhite + count
         Else If id = 2 Then
            populationBlack = populationBlack + count
         Else If id = 3 Then
            populationBrown = populationBrown + count
         EndIf
   End Select
End Function

Function createHoernchen(g = 0, c = 0, a = 0) ;create new hoernchen by gender, color, age
   
   If c = 0 Then c = Rnd(1,3)
   If g = 0 Then g = Rnd(m,w)
   
   population = population + 1
   hoern.Thoern = New Thoern
   hoern\gender = g
   popChange(1,g,"gender")
   hoern\Color = c
   popChange(1,c,"color")
   
   generateName()
   hoern\name = hoernName$
   ThoernID = ThoernID + 1
   hoern\id = ThoernID
   hoern\age = a
   hoern\frame = Rnd(0,20)
   hoern\img = CopyImage(IMGhoern)
   
   Local i
   
   For i = 0 To 400
      If reserveIMG(i) = 0 Then Exit
   Next
   
   Local spaceInX = resX-200 ;200 logbook
   
   reserveIMG(i) = 1
   hoern\reserveIMG = i
   hoern\x = i*150 Mod spaceInX ;150 textspace
   hoern\y = 50 + ((i*150)/spaceInX)*50
   
End Function

Function generateName() ;generate somewhat random name
   
   Local s$ = "", sadd$
   Local elementeAnzahl = Rnd(2,4)
   For i = 1 To elementeAnzahl
      Local element = Rnd(0,10)
      Select (element)
         Case 0:
            sadd$ = "ri"
         Case 1:
            sadd$ = "ru"
         Case 2:
            sadd$ = "fi"
         Case 3:
            sadd$ = "fo"
         Case 4:
            sadd$ = "b"
         Case 5:
            sadd$ = "lu"
         Case 6:
            sadd$ = "mi"
         Case 7:
            sadd$ = "mu"
         Case 8:
            sadd$ = "ko"
         Case 9:
            sadd$ = "ki"
         Case 10:
            sadd$ = "go"
         Default:
            sadd$ = "-"
      End Select
      s$ = s$ + sadd$
   Next
   hoernName = s$
End Function

Function visuals() ;draw background and hoernchen
   
   Local imgSize = 340
   Local drawXn = resX/imgSize
   Local drawYn = resY/imgSize
   Local xn, yn
   
   ;Draw background
   If no_food = 0 Then
      For yn = 0 To drawYn
         For xn = 0 To drawXn
            DrawImage IMGfood, xn*imgSize, yn*imgSize
         Next
      Next
   Else
      For yn = 0 To drawYn
         For xn = 0 To drawXn
            DrawImage IMGnofood, xn*imgSize, yn*imgSize
         Next
      Next
   EndIf
   
   For hoern.Thoern = Each Thoern
      
      Local drawFrame
      If hoern\frame <= 10
         drawFrame = 0
      Else
         drawFrame = 1
      EndIf
      
      Select (hoern\Color)
         Case 1: ;white
            DrawImage hoern\img, hoern\x, hoern\y, drawFrame
         Case 2: ;black
            DrawImage hoern\img, hoern\x, hoern\y, drawFrame + 2
         Default: ;brown
            DrawImage hoern\img, hoern\x, hoern\y, drawFrame + 4
      End Select
      
      ;hoern Text
      Color 100, 100, 100
      Rect hoern\x+20, hoern\y, StringWidth("ID[" + hoern\id + "], age: " + (hoern\age)), 20
      Color 255, 255, 255
      Text hoern\x+20, hoern\y, hoern\name
      Text hoern\x+20, hoern\y+10, "ID[" + hoern\id + "], age: " + (hoern\age)
      
      ;Animation for the next loop
      If hoern\frame >= 20 Then
         hoern\frame = 0
      Else
         hoern\frame = hoern\frame + 1
      EndIf
   Next
   
   ;main text background menu
   Color 200, 200, 200
   Rect 0, 5, resX, 40
   Color 100, 100, 100
   Rect 0, 10, resX, 30
   Color 255, 255, 255
   
End Function

Function calculateNextRound() ;end the round, calculate whos going to die, how many newborns, catastrophys
   
   round = round + 1
   Local offspring = 0
   Local hoern_pregnant_color1 = 0
   Local hoern_pregnant_color2 = 0
   Local hoern_pregnant_color3 = 0
   
   logbook("Runde: " + round)
   
   ;tragedy occurs --> no food, no offspring, 75% dies
   If population > 200
      ;75% dies
      Local populationToDie = 75.0/100 * population
      Local died = 0
      Local count = 0
      Local whoDiesNext = 0
      
      While(died < populationToDie)
         whoDiesNext = Rnd(0,population-1)
         count = 0
         
         For hoern4.Thoern = Each Thoern
            If (whoDiesNext = count) Then Exit
            count = count + 1
         Next
         
         reserveIMG(hoern4\reserveIMG) = 0
         FreeImage hoern4\img
         popChange(-1,hoern4\gender,"gender")
         popChange(-1,hoern4\Color,"color")
         Delete hoern4
         died = died + 1
         population = population - 1
      Wend
      no_food = 0
      logbook(died + " verstorben (Dürre)")
   EndIf
   
   ;Check for m >= 2 years --> offspring
   For hoern.Thoern = Each Thoern
      hoern\age = hoern\age + 1 ;increase age
      ;If hoern\age > 10 Then Stop
      If hoern\gender = m And hoern\age >= 2 And no_food = 0
         offspring = 1
      EndIf
   Next
   
   ;Check for w >= 2 years --> offspring same color as mother
   If offspring = 1 Then
      For hoern2.Thoern = Each Thoern
         If (hoern2\gender = w) And (hoern2\age >= 2)
            Select (hoern2\Color)
               Case 1:
                  hoern_pregnant_color1 = hoern_pregnant_color1 + 1
               Case 2:
                  hoern_pregnant_color2 = hoern_pregnant_color2 + 1
               Default:
                  hoern_pregnant_color3 = hoern_pregnant_color3 + 1
            End Select
         EndIf
      Next
      
      For i = 1 To hoern_pregnant_color1
         createHoernchen(0, 1, 0)
      Next
      For i = 1 To hoern_pregnant_color2
         createHoernchen(0, 2, 0)
      Next
      For i = 1 To hoern_pregnant_color3
         createHoernchen(0, 3, 0)
      Next
      logbook(hoern_pregnant_color1+hoern_pregnant_color2+hoern_pregnant_color3 + " neugeburten")
   EndIf

   ;Check Die-Chance
   Local populationOld = population
   For hoern3.Thoern = Each Thoern
      Local age = hoern3\age
      If (age < 8)
         If (Rnd(1,10) = 1) Then ;10 % chance to die
            ;die
            reserveIMG(hoern3\reserveIMG) = 0
            FreeImage hoern3\img
            popChange(-1,hoern3\gender,"gender")
            popChange(-1,hoern3\Color,"color")
            Delete hoern3
            population = population - 1
         Else
            ;see you next round
         EndIf
      ElseIf (age >= 8 And age < 9)
         If (Rnd(1,2) = 1) Then ;50 % chance to die
            ;die
            reserveIMG(hoern3\reserveIMG) = 0
            FreeImage hoern3\img
            popChange(-1,hoern3\gender,"gender")
            popChange(-1,hoern3\Color,"color")
            Delete hoern3
            population = population - 1
         Else
            ;see you next round
         EndIf
      ElseIf (age >= 9 And age < 10)
         If (Rnd(1,4) < 4) Then ;75 % chance to die
            ;die
            reserveIMG(hoern3\reserveIMG) = 0
            FreeImage hoern3\img
            popChange(-1,hoern3\gender,"gender")
            popChange(-1,hoern3\Color,"color")
            Delete hoern3
            population = population - 1
         Else
            ;see you next round
         EndIf
      ElseIf (age >= 10)
         If (Rnd(1,100) < 100) Then ;99 % chance to die
            ;die
            reserveIMG(hoern3\reserveIMG) = 0
            FreeImage hoern3\img
            popChange(-1,hoern3\gender,"gender")
            popChange(-1,hoern3\Color,"color")
            Delete hoern3
            population = population - 1
         Else
            ;see you next round
         EndIf
      EndIf
   Next
   logbook((populationOld-population) + " verstorben (Alter)")
   logbook("____________________")
   
   ;tragedy occurs next round
   If population > 200
      no_food = 1 ;draw dried background
   EndIf
   
End Function

Function logbook(s$ = "") ;some information about whats going on in each round
   ;Add new elements
   If s$ <> "" Then
      logmsg(logstart Mod logmax) = s$
      If logcount < logmax Then logcount = logcount + 1
      logstart = (logstart + 1) Mod logmax
      Return ;just added a value to the array, no need to draw it with the next lines
   EndIf
   
   ;show all elements
   Color 200, 200, 200
   Rect resX-200, 40, 195, resY-40
   Color 100, 100, 100
   Rect resX-195, 40, 185, resY-40
   Color 255, 255, 255
   
   If logcount = logmax Then
      ;the newest msges to the bottom
      For i = 0 To logcount
         Text resX-190, 40+i*20, logmsg((logstart+i)Mod logmax )
      Next
   Else
      ;fill the array if its not full yet
      For i = 0 To logcount
         Text resX-190, 40+i*20, logmsg(i)
      Next
   EndIf
   
End Function

;ozzi789
Graphics 800,800,32,2
SetBuffer BackBuffer()
AppTitle "Hazlevazel Simulator"
Global global_id, global_year, global_mature=2, global_population, global_population_m, global_population_w, global_message_count, font_small,font_big
Dim names$(30)
SeedRnd MilliSecs()
font_small=LoadFont("Verdana",13)
font_big=LoadFont("Verdana",16)

Type message
   Field content$
   Field mode% ; 0-3 for colours
End Type

Type hazel
   Field id%
   Field name$
   Field sex% ; 0=M , 1=W
   Field colour% ; 0=White , 1=Black, 2= Brown
   Field age% ; 0-10
End Type


start_simulation()

While Not KeyHit(1)
   Cls
   display_messages()
   render_info()
   birthdays()
   mate()
   death()
   over_population()

   global_year=global_year+1
   Flip 0
   WaitKey
   add_message("-----NEW YEAR ("+global_year+")-----",0)
Wend

End


Function render_info()
   SetFont(font_big)
   Line 400,0,400,1000
   Text 450,50,"Year:"+global_year
   Text 450,70,"Population: "+global_population
   Text 480,90,"Male Population: "+global_population_m
   Text 480,110,"Female Population: "+global_population_w
   Text 490,180,"Visualization of Population"
   Text 490,280,"Overpopulation Limit"
   xcount=-4
   Color 100,100,100
   Rect 448,178,34,102,1
   Color 200,40,30
   Rect 448,280,34,50
   Color 255,255,255
   For h.hazel=Each hazel
      xcount=xcount+4
      If xcount>30
         xcount=0
         ycount=ycount+4
      EndIf
      Select h\colour%
         Case 0
            Color 255,255,255
         Case 1
            Color 20,20,20
         Case 2
            Color 180,120,90
      End Select
      Rect 450+x+xcount,180+y+ycount,2,2,1
   Next
      
   
End Function
   

Function birthdays()
   For h.hazel=Each hazel
      h\age%=h\age%+1
   Next
End Function

Function chance(percentage%)
   numbers=Rand(1,100)
End Function


Function over_population()
   Local to_die#
   If global_population>=200
      to_die#=Float(global_population)/100*75
      For i=1 To Int(to_die)
         h.hazel= First hazel
         If h\sex%=0
            global_population_m=global_population_m-1
         EndIf
         If h\sex%=1
            global_population_w=global_population_w-1
         EndIf      
         global_population=global_population-1
         Delete h.hazel
         ;WIP
      Next
      add_message("Overpopulation has taken it's victims",3)
      add_message(Int(to_die)+" souls... RIP",3)
   EndIf
End Function
   

Function death()
   If global_population=0
      Cls
      Text 0,0,"All of them are dead.... noooooooooooooooooooooooooooooooo!"
      Flip
      WaitKey
      End
   EndIf
   
   For h.hazel=Each hazel
      random=Rand(1,100)
      If h\age%<8 Then chance=10
      If h\age%>8 Then chance=50
      If h\age%>9 Then chance=75
      If h\age%>10 Then chance=99
      If random=<chance
         add_message(h\name%+" died. Age: "+h\age%,1 )
         global_population=global_population-1
         If h\sex%=0 Then global_population_m=global_population_m-1
         If h\sex%=1 Then global_population_w=global_population_w-1
         Delete h.hazel
      EndIf
   Next
   
End Function


Function mate()
   If global_population<=200   
      Local mateing_ok=0
      For h.hazel=Each hazel
         If h\sex%=0 And h\age%>=global_mature
            mateing_ok=1
         EndIf
      Next
      If mateing_ok=1
         For h.hazel=Each hazel
            If h\sex%=1 And h\age%>=global_mature
               spawn_hazel(Rand(0,1),h\colour%)
            EndIf
         Next
      Else
         add_message("No mateable male hazels there!..",3)
      EndIf
   EndIf
End Function


Function start_simulation()
   spawn_hazel(0,0)
   spawn_hazel(0,3)
   spawn_hazel(1,0)
   spawn_hazel(1,1)
   spawn_hazel(1,2)
End Function

Function spawn_hazel(sex%,colour%)
   Local name_index%
   
   h.hazel=New hazel
      global_population=global_population+1
      global_id=global_id+1
      h\id%=global_id
      h\sex%=sex%
      If h\sex%=0 Then global_population_m=global_population_m+1
      If h\sex%=1 Then global_population_w=global_population_w+1
      h\colour%=colour%
      h\age%=0
      If h\sex%=0
         Restore names_m
      EndIf
      If h\sex%=1
         Restore names_w
      EndIf

      name_index%=Rand(0,24)
      For i=0 To 24
         Read name$
         If i=name_index%
            h\name$=name$
         EndIf
      Next
      
   add_message("a hazel was born - "+h\name$,2)
End Function

Function add_message(content$,mode=0)
   m.message=New message
      m\content$="->"+content$
      m\mode%=mode
      global_message_count=global_message_count+1
   If global_message_count=72 Then Delete First message:global_message_count=global_message_count-1
End Function 


Function display_messages()
   SetFont(font_small)
   Local i=-1
   For m.message=Each message
      i=i+1
      Select m\mode%
         Case 0
            Color 255,255,255
         Case 1
            Color 240,120,20
         Case 2
            Color 0,255,0
         Case 3
            Color 255,10,10
      End Select
      Text 0,i*11,m\content$
   Next
   Color 255,255,255
End Function


.names_m
Data "Leon","Lucas","Ben","Finn","Jonas","Paul","Louis", "Maximilian","Luca","Felix","Tim","Elias","Max","Noah", "Philip","Niclas","Julian","Moritz","Jan","David", "Fabian","Alexander","Simon","Jannik","Tom"


.names_w
Data "Mia","Hannah","Lena","Lea","Emma","Anna", "Leonie","Lilli","Emilie","Lina","Laura","Marie","Sarah", "Sophia","Lara","Sophie","Maja","Amelie","Luisa", "Johanna","Emilia","Nele","Clara","Leni","Alina"