'populater7          8 Feb 2006

    'draws and updates population pyramids as cohorts ( 5 year groups)
    '   are born, die or have children.

    'put in real data to watch, or implement your own eugenics
    '   eg kill everyone off when they reach 40
    '   or enforce 1 child per family...

    'a work-in-progress

    'let me know of any ideas to improve it.

nomainwin

dim men( 20), women( 20), drm( 20), drw( 20), brm( 20), brw( 20)
'   population, death rates of men & women in each cohort,
'   and birth rates of male & female babies (so I can include
'   eugenics like choosing male babies as a preference!)

global future, currentpop, delay, deltap

for cohort =0 to 19 '            The start data can easily be changed . . . .
    read a:   men( cohort) =a   'number of males in cohort
    read a: women( cohort) =a   'females
    read a:   drm( cohort) =a   'death rate for males in cohort
    read a:   drw( cohort) =a   'females
    read a:   brm( cohort) =a   'birth rate of   male babies to girls in cohort
    read a:   brw( cohort) =a   'birth rate of female babies
next cohort

'       pop  pop  drm drw  brm  brw
'       num  num  %     %    %    %
data    50,  50,   2,   2,   0,   0 ' cohort zero   ages  0 to 4
data     0,   0,   1,   1,   0,   0 ' cohort one    ages  5 to 9
data     0,   0,   1,   1,   2,   2 ' cohort 10 to 14   first fertile cohort
data     0,   0,   1,   1,   7,   7 ' cohort 15 to 19
data     0,   0,   2,   1,  21,  21 ' cohort 20 to 24   men are silly at this age...
data     0,   0,   1,   1,  30,  30 ' cohort 25 to 29   NB I assume equal m/f birth rate- with no selection they are within 3% of each other, females higher

data     0,   0,   1,   1,  33,  33 ' cohort 30 to 34
data     0,   0,   1,   1,  12,  12 ' cohort 35 to 39
data     0,   0,   1,   1,   6,   6 ' cohort 40 to 44
data     0,   0,   1,   1,   1,   1 ' cohort 45 to 49

data     0,   0,   5,   5,   0,   0 ' cohort 50 to 54
data     0,   0,   8,   7,   0,   0 ' cohort 55 to 59  About here death rates start to rise . . .
data     0,   0,  12,   9,   0,   0 ' cohort 60 to 64    but less for women than for men . . . .
data     0,   0,  18,  11,   0,   0 ' cohort 65 to 69
data     0,   0,  28,  15,   0,   0 ' cohort 70 to 74
data     0,   0,  40,  28,   0,   0 ' cohort 75 to 79
data     0,   0,  70,  50,   0,   0 ' cohort 80 to 84
data     0,   0,  80,  65,   0,   0 ' cohort 85 to 89
data     0,   0,  90,  70,   0,   0 ' cohort 90 to 94
data     0,   0,  98,  95,   0,   0 ' cohort 95+

WindowWidth  =880
WindowHeight =620

UpperLeftX   =INT( ( DisplayWidth  -WindowWidth)  /2)
UpperLeftY   =INT( ( DisplayHeight -WindowHeight) /2)


menu #jf, "&File", "E&xit",  [quit]
menu #jf, "&Help", "&About", [about]

graphicbox #jf.g5,  203,  82,  16, 200
graphicbox #jf.g,    10,  70, 400, 220
graphicbox #jf.g2,   10, 310, 400, 204
graphicbox #jf.g3,  520,  10,  50,  50
graphicbox #jf.g4,   10, 300, 400,   8


textbox    #jf.t1,   10,  30, 400,  30
textbox    #jf.t2,   10, 520, 400,  30

texteditor #jf.t3,  420,  70, 440, 460

button #jf.delayup, "Slower",     slower, UR, 380, 34
button #jf.delaydn, "Faster",     faster, UR, 380,  8
button #jf.war,     "War!",          war, UR, 260,  8
button #jf.famine,  "Famine!",    famine, UR, 180,  8
button #jf.boom,    "Baby boom!",   boom, UR,  80,  8
button #jf.over,    "Boom over!",   over, UR,  80, 34
button #jf.plague,  "Plague!",    plague, UR, 180, 34

open "Population Modeller-  'Populater'    JohnF    Feb 2006." for window_nf as #jf

print #jf,    "trapclose [out]"
print #jf.g,  "size 4"
print #jf.t1, "!font courier_new 16 bold"
print #jf.t2, "!font courier_new 8"
print #jf.t1, "     Females  ...  Males"
print #jf.t3, "!font courier_new 8"

open "Malthus.txt" for input as #autoexec
print #jf.t3, "!contents #autoexec";
close #autoexec

delay  =50000
deltap =    0

print #jf.g2, "down ; size 2 ; color black ; line 0 198 400 198 ; line 2 198 2 10"
print #jf.g3, "cls ; backcolor yellow ; fill green ; goto 25 25 ; down ; circlefilled "; str$( int( 2 +delay /4000))

cp    =    0

for future =0 to 200
    cp =currentpop
    call update5years   'display current situation

    for d =0 to delay  'increase to delay each update
        scan
    next d

    if future =0 then
        notice "Just a notice!" + chr$(13) + "Holding start display." +chr$(13) +"Click to proceed!"
    end if

    century =int( cp /100)  ' horizontal every 100 pop'n
    print #jf.g2, "down ; size 1 ; color darkgray"
    print #jf.g2, "line 0 "; str$( 200- 10 *century); " 400 "; str$( 200 -10 *century); "up"

    call generation
    scan
    deltap =int( currentpop -cp) '  rate of growth
next future

[quit]
print #jf.g,  "flush"
print #jf.g, "getbmp pyramid 1 1 399 219"
filedialog "Save pyramid as", "pyramid*.bmp", p$
if p$ <> "" then bmpsave "pyramid", p$
print #jf.g2, "flush"
print #jf.g2, "getbmp graph 1 1 399 203"
filedialog "Save graph as", "graph*.bmp", g$
if g$ <>"" then bmpsave "graph", g$
[out]
confirm "Are you ready to QUIT?"; rv$
'and if No??
close #jf
end

sub update5years
    #jf.g, "cls"
    'Add a routine to put on cohort ages, so the scale/ ages are obvious.
    #jf.g5, "down ; font Times_New_Roman 7"
    for m =0 to 95 step 5
        #jf.g5, "goto 4 "; str$( int( 2.0 *( 100 -m) -5))
        #jf.g5, "\"; str$( m)
    next m
    type =0
    if deltap >10  then type = 1
    if deltap <-10 then type =-1
    select case type
        case 1
             #jf.g4 "fill green"
        case -1
            #jf.g4 "fill red"
        case 0
            #jf.g4 "fill white"
    end select

    if abs( ( future *5 /100) -int( future *5 /100)) <0.01 then ' vertical grid every 100 years
        print #jf.g2, "down ; size 1 ; color darkgray ; line "; str$( future *2); " 10 "; str$( future *2); " 198"
    end if

for cohort =0 to 19
    print #jf.g, " down ; color "; str$( cohort/20 *255); " "; str$( cohort/20 *255); " 255"
    print #jf.g, "line 210 "; str$( 210 -cohort *10); " "; str$( 210 +2*  men( cohort)); " "; str$( 210 -cohort *10)

    print #jf.g, "color 255 "; str$( cohort/20 *255); " "; str$( cohort/20 *255); " ; down"
    print #jf.g, "line 190 "; str$( 210 -cohort *10); " "; str$( 190 -2*women( cohort)); " "; str$( 210 -cohort *10)
next cohort
end sub

sub generation
    currentpop =0

    for cohort =19 to 1 step -1 'each cohort moves up and some die
          men( cohort) =   men( cohort -1) *(100 -drm( cohort -1))/ 100
        women( cohort) = women( cohort -1) *(100 -drw( cohort -1))/ 100
    next cohort

      men( 0) =0
    women( 0) =0

    for cohort =0 to 19 'and others are born
         men( 0) =  men( 0) +brm( cohort)/ 100 *women( cohort)
       women( 0) =women( 0) +brw( cohort)/ 100 *women( cohort)
       currentpop= currentpop +men( cohort) + women( cohort)
    next cohort

    print #jf.g2, "down ; size 2 ; color blue ; set "; str$( 4 +2 *future); " "; str$( 200 -int( currentpop /10))
    print #jf.t2, 5 *( future +1); " years ahead. The population now is "; int( currentpop); " & change "; deltap
end sub

sub faster buttonhandle$
    if delay >100 then delay =delay *0.8
    print #jf.g3, "cls ; fill green ; goto 25 25 ; down ; circlefilled "; str$( 2 +int( delay /4000))
end sub

sub slower buttonhandle$
    if delay <100000 then delay =delay *1.2
    print #jf.g3, "cls ; fill   red ; goto 25 25 ; down ; circlefilled "; str$( 2 +int( delay /4000))
end sub

sub war buttonhandle$ ' Modern war kills all ages, but especially men 15 to 30
    for cohort =0 to 19
          men( cohort) =  men( cohort) *0.8
        women( cohort) =women( cohort) *0.8
    next cohort
    for cohort =3 to 6
          men( cohort) =  men( cohort) *0.7
        women( cohort) =women( cohort) *0.7
    next cohort
end sub

sub famine buttonhandle$
      men( 0) =  men( 0) *0.1
      men( 1) =  men( 1) *0.2
    women( 0) =women( 0) *0.05 ' girl babies are seen as less important!
    women( 1) =women( 0) *0.1
    for cohort =2 to 10 '   Parents try to feed children and starve themselves & the old
          men( cohort) =  men( cohort) *0.6
        women( cohort) =women( cohort) *0.6
    next cohort
    for cohort =11 to 19
          men( cohort) =  men( cohort) *0.3
        women( cohort) =women( cohort) *0.3
    next cohort
end sub

sub boom buttonhandle$ '    all birth rates up 50%
    for cohort =2 to 10
        brm( cohort) =brm( cohort) *1.5
        brw( cohort) =brw( cohort) *1.5
    next cohort
end sub

sub over buttonhandle$ '    all birth rates down 50%
    for cohort =2 to 10
        brm( cohort) =brm( cohort) *0.67
        brw( cohort) =brw( cohort) *0.67
    next cohort
end sub

sub plague buttonhandle$ ' Hits old and young disproportionately
    for cohort =0 to 4
          men( cohort) =  men( cohort) *0.5
        women( cohort) =women( cohort) *0.5
    next cohort
        for cohort =5 to 12
          men( cohort) =  men( cohort) *0.8
        women( cohort) =women( cohort) *0.8
    next cohort
    for cohort =13 to 19
          men( cohort) =  men( cohort) *0.5
        women( cohort) =women( cohort) *0.5
    next cohort

end sub