The game of Hamurabi with a new coat

[Henko]

The internal mechanisms are based on my earlier text version "old school Hamurabi", with a few extentions.

2A921586-017E-425F-9068-8C1D6090EBB7.png (327.94 KiB) Viewed 10017 times

Code: Select all

' Hamurabi, version 18-02-2019
'
init_prog()
do
  start_next_period()
  decisions()
  period_results()
  do slowdown
    if b_p("stop") then stop
    until b_p("go")
  until forever
end


def init_prog()
' *** parameters
'y'
.C=120    ' starting # of kids
.V=300    ' starting # of adults
.bo=0.04  ' starting value of birth rate
.dco=0.01 ' starting value of mortuality of kids
.dvo=0.02 ' starting value of mortuality of adults
.S=100    ' starting value of acres of land
.e=2      ' needed # of bushels food per person
.m=3      ' needed # of adults per acre
.z=2      ' needed # bushels seed per acre
.q=13     ' basic # of bushels produced per acre 
.k=30     ' starting cost of additional purchased acre
.effo=1   ' starting value of production efficiency
.SQ=100   ' starting stock of bushels
.Zt=200   ' starting value of bushels of seed
.p_pl=0.15 ' probability of the plaque striking
.p_gh=0.2  ' probability of grasshoppers eating bushels
.p_el=0.15 ' probability of acres taken by the Elamites
''
.b=.bo ! .dc=.dco ! .dv=.dvo ! .eff=.effo
graphics ! graphics clear .8,.8,.8 ! draw color 0,0,0
set toolbar off ! get screen size .sw,.sh
draw font name "Papyrus" 
draw font size 40 ! draw text "The game of Hamurabi" at 170,10
draw font name "Courier-Bold" ! draw font size 18
.nmax=200
dim txt$(.nmax+1)
field "inp" text "" at 20,746 size 530,60 RO
field "inp" font name "Papyrus" ! field "inp" font size 24
draw text "Bushels on stock" at 574,530 ! draw font size 20
field "stock" text "" at 570,550 size 180,40 RO
field "stock" font name "Papyrus" ! field "stock" font size 32
button "stop" text chr$(10060) at 700,10 size 50,50
button "go" text "Next period" at 570,480 size 180,30
msg()
put_msg("REMEMBER!")
put_msg("one person needs about 2 bushels of food/year")
put_msg("one acre of land needs about 3 adults to harvest")
put_msg("one acre of land needs about 2 bushels of seed")
init_numpad(570,600,40,.5,.8,.8,1)
diag_text()
end def

def start_next_period()
yr+=1 ! put_msg(" ") ! put_msg("      Year "& yr &" of your reign")
Sv=max(1,.V/.m) ! Sz=max(1,.Zt/.z) ! Sc=min(Sv,Sz) ! Sc=min(Sc,.S)
dQ=int(.eff*.q*Sc)
.SQ+=dQ ! put_msg(dQ&" bushels have been produced")
if rnd(1)<.p_gh then
  gr=100+rnd(300) ! .SQ=max(.1,.SQ-gr)
  put_msg("*** Grasshoppers ate "&gr&" bushels!!! ***")
  end if
stock()
art(572,70,180,400)
end def

def decisions()
field "inp" text "  How many bushels food for the "&(.C+.V)&" people?"
.Et=numpad(0,.SQ) ! .SQ=max(1,.SQ-.Et)
field ("stock") text "        "&.SQ
put_msg(.Et&" bushels food for the population")
field "inp" text "How many bushels as seed for new crops?"
.Zt=numpad(0,.SQ) ! .SQ=max(1,.SQ-.Zt)
field ("stock") text "        "&.SQ
put_msg(.Zt&" bushels used as seed for new crop")
.k=max(10,int(.6*.k+.4*(rnd(61))))
field "inp" text "How many bushels for buying land at "&.k&"/acre?"
Kt=numpad(0,.SQ)
if Kt>0 then
  .SQ=max(1,.SQ-Kt) ! dS=int(Kt/.k) ! .S+=dS
  put_msg(dS&" acres of land bought for "&Kt&" bushels")
  field ("stock") text "        "&.SQ
  end if
ks=.k-2-rnd(7)
field "inp" text "How many acres to sell at "&ks&" bushels/acre?"
dS=numpad(0,.S)
if dS>0 then
  dSQ=int(dS*.k) !.SQ=max(1,.SQ+dSQ) ! .S-=dS
  put_msg(dS&" acres of land sold for "&dSQ&" bushels")
  field ("stock") text "        "&.SQ
  end if
field "inp" text " Touch next period button to continue"
end def

def period_results()
phi=max(.05,.Et/.e/(.C+.V)) ! phip=int(100*phi)
.b=0.6*.b+0.4*phi*.bo ! .eff=0.9*.eff+0.1*phi*.effo
.dc=0.2*.dc+0.8*.dco/phi ! .dv=0.4*.dv+0.6*.dvo/phi
adr=int(1000*(.dc*.C+.dv*.V)/(.C+.V))/10
aux=.C
.C=int(.C+.b*.V-(.dc+0.1)*.C) ! .V=int(.V+.1*aux-.dv*.V)
if phi>1.3 then
  dV=int((phi-1)*rnd(.V/10)) ! .V+=dV
  put_msg("*** "&dV&" Immigrants came to this paradise of milk and honey!! ***")
  pause 1
  end if
if rnd(1)<.p_pl then
  f=10+rnd(16)
  put_msg("*** The plague killed "&f&" percent of the people!! ***")
  f/=100 ! .C=int((1-f)*.C) ! .V=int((1-f)*.V) ! pause 1
  end if
if rnd(1)<.p_el then
  f=10+rnd(9)
  put_msg("*** Elamite warlords took "&f&" percent of your land!! ***")
  f/=100 ! .S=int((1-f)*.S) ! pause 1
  end if
put_msg("Population is now "&.C&" kids & "&.V&" adults") ! pause .3
put_msg("Average health of the people was "&phip&"%") ! pause .3
put_msg("Birth rate was "&int(1000*.b)/10&"%") ! pause .3
put_msg("Average death rate was "&adr&"%") ! pause .3
put_msg("Production efficiency is "&int(100*.eff)&"%") ! pause .3
put_msg("You now own "&.S&" acres of land") ! pause .3
stock()
end def

def stock()
  put_msg("you have "&int(.SQ)&" bushels left.")
  field ("stock") text "        "&.SQ
  end def

' numerical keypad
' 
' produce a simple keypad to quickly enter a number in an app
' upon entry, the keypad disappears
' initialize once, multiple use after
' left upper corner is placed at "xtop,ytop"
' "bs" is the button size (keypad becomes 4.3 times larger)
'
def init_numpad(xtop,ytop,bs,R,G,B,alpha)
name$="numpad" ! cn=10
page name$ set 
page name$ frame xtop,ytop,0,0
set buttons custom
if bs<20 then bs=20
sp=4 ! th=.5*bs+4 ! ww=4*bs+5*sp ! hh=th+4*bs+6*sp
fsize=.5*bs
draw font size fsize ! set buttons font size fsize
draw color 1,1,1 ! fill color .6,.6,.6
button "rec" title "" at 0,0 size ww,hh
button "res" title "" at 0,0 size ww,th+4
fill color R,G,B ! fill alpha alpha
button "0" title "0" at sp,th+3*bs+5*sp size bs,bs
for k=1 to 9
  x=(k-1)%3 ! y=2-floor((k-1)/3)
  button k title k at (x+1)*sp+x*bs,th+y*bs+(y+2)*sp size bs,bs
  next k
button "-" title "-" at 2*sp+bs,th+3*bs+5*sp size bs,bs
button "." title "." at 3*sp+2*bs,th+3*bs+5*sp size bs,bs
button "Cl" title "C" at 4*sp+3*bs,th+2*sp size bs,bs
button "del" title "<-" at 4*sp+3*bs,th+bs+3*sp size bs,bs
button "ok" title "ok" at 4*sp+3*bs,th+2*bs+4*sp size bs,2*bs+sp
page name$ hide 
page name$ frame xtop,ytop,ww,hh
set buttons default ! set buttons font size 20
page "" set ! draw font size 20 ! draw color 0,0,0
end def

' size of number is accepted between "minval" and "maxval"
' if both "minval" and "maxval" are zero, then no restrictions
' max number of tokens in the number is 10 (minus and dot included)
' works for option base 0 and 1
'
def numpad(minval,maxval)
page "numpad" set ! page "numpad" show
a$="" ! pflag=0 ! sflag=0 ! ob=1-option_base()
nump1:
if b_p("stop") then stop
if b_p("ok") then
  number=val(a$) ! a$="" ! button "res" text ""
  if minval<>0 or maxval<>0 then
    if number<minval or number>maxval then
      button "res" text "range error"
      pflag=0 ! a$="" ! pause 1
      button "res" text ""
      goto nump1
      end if
    end if
  page "numpad" hide ! page "" set
  return number
  end if
if b_p("Cl") then
  a$ = "" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p("del") and len(a$) then
  ll=len(a$) ! if substr$(a$,ll-ob,ll-ob)="." then pflag=0
  a$ = left$(a$,ll-1) ! sflag=0 ! goto nump3
  end if
if b_p("-") then
  a$ = "-" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_p(".") and not pflag and not sflag then
  a$ &= "." ! pflag=1 ! goto nump3
  end if
for k=0 to 9
  t$=k
  if b_p(t$) and not sflag then
    a$ &= t$ ! goto nump3
    end if
  next k
goto nump1
nump3:
if len(a$)>10 then ! sflag=1 ! goto nump1 ! end if
button "res" text a$
goto nump1
end def

def msg()   ' *** define name, position, size of the message window
'y'
nmax=200         ' max # of kept messages in the (FIFO) table
dim txt$(nmax+1) ' table with messages
n$  ="msg"       ' name (handle) of the list
t$  ="Messages"  ' title of the list
x   =20          ' x position of the left upper window corner
y   =70         ' y position
w   =530         ' width
h   =660         ' height (determines the # of displayed messages)
''
end def 


def put_msg(a$)
pt+=1 ! if pt>msg.nmax then pt=1 ! m+=1 ! msg.txt$(pt)=a$
c_list(msg.n$,msg.t$,msg.txt$,msg.nmax,pt,msg.x,msg.y,msg.w,msg.h)
end def

' id$ = object name
' cont$ = array met elementen
' size = aantal elementen in de list
' pt = current pointer
'
def c_list(id$,title$,cont$(),size,pt,xt,yt,w,h)
set lists font size 14
if pt=size then full=1
if full then dm=size+1 else dm=pt+1
dim temp$(dm)
k=0
if full then
  for i=pt+1 to size ! k+=1 ! temp$(k)=cont$(i) ! next i
  end if
for i=1 to pt ! k+=1 ! temp$(k)=cont$(i) ! next i
list id$ text temp$ at xt+2,yt+32 size w-4,h-34
list id$ select k
draw size 3
draw rect xt,yt to xt+w,yt+h ! draw line xt,yt+30 to xt+w,yt+30
draw color 0,0,1
if not done then
  draw text title$ at (2*xt+w-text_width(title$))/2,yt+5 
  done=1
  end if
end def

' museum of modern art, free tour along the paintings
' graphics mode assumed
' x,y,w,h are position and size of the paintings
' p is admiration time in seconds for each painting
' button$ is the name of the button in the calling app
'    that is used to activate the function
' press the button again to stop and to restore 
'    the original background of the app
'
def art(x,y,w,h)
refresh off ! draw color .5,.5,.5
w-=odd(w) ! t=6 ! npx=w/2-t ! npy=h/2-t
xs=x+t/3-1 ! ys=y+t/3-1 ! toggle=0
dim va(npx+2),vb(npx+2),r(11)
draw size t ! draw rect x,y to x+w-t-1,y+h-t ! randomize
  for i=1 to 10 ! r(i)=rnd(4) ! next i
  for i=1 to npx ! va(i)=rnd(4) ! next i
  for k=0 to npy ! yy=ys+2*k+2
    for i=1 to npx
      if toggle=0 then ! s=r(va(i-1)+va(i)+va(i+1)) ! vb(i)=s
        else ! s=r(vb(i-1)+vb(i)+vb(i+1)) ! va(i)=s
        end if
      if s=0 then fill color 0,0,0 ! if s=1 then fill color 1,0,0
      if s=2 then fill color 0,1,0 ! if s=3 then fill color 0,0,1
      xx=xs+2*i ! fill rect xx,yy to xx+1,yy+1
      next i ! toggle=1-toggle
    next k
refresh on
end def

def diag_text()
option angle degrees
a$="Reserved for future use."
draw font name "Papyrus" ! draw font size 60
draw text a$ at 50,880 ! tl=text_width(a$)
sprite "diag" scan 50,880,tl,60
fill color .8,.8,.8 ! fill rect 50,880 to 50+tl,940
SPRITE "diag" AT 50,870 SCALE 1 ANGLE -13
sprite "diag" stamp ! sprite "diag" delete
end def

def b_p(a$) = button_pressed(a$)

[rbytes]

Very nice! The game is much easier to play with the on-screen keyboard. So far I have not been impeached!

[Henko]

I have to report a wrong calculation inthe function DEF DECISIONS():

Code: Select all

def decisions()
field "inp" text "  How many bushels food for the "&(.C+.V)&" people?"
.Et=numpad(0,.SQ) ! .SQ=max(1,.SQ-.Et)
field ("stock") text "        "&.SQ
put_msg(.Et&" bushels food for the population")
field "inp" text "How many bushels as seed for new crops?"
.Zt=numpad(0,.SQ) ! .SQ=max(1,.SQ-.Zt)
field ("stock") text "        "&.SQ
put_msg(.Zt&" bushels used as seed for new crop")
.k=max(10,int(.6*.k+.4*(rnd(61))))
field "inp" text "How many bushels for buying land at "&.k&"/acre?"
Kt=numpad(0,.SQ)
if Kt>0 then
  .SQ=max(1,.SQ-Kt) ! dS=int(Kt/.k) ! .S+=dS
  put_msg(dS&" acres of land bought for "&Kt&" bushels")
  field ("stock") text "        "&.SQ
  end if
ks=.k-2-rnd(7)
field "inp" text "How many acres to sell at "&ks&" bushels/acre?"
dS=numpad(0,.S)
if dS>0 then

'y'
  dSQ=int(dS*.k) !.SQ=max(1,.SQ-dSQ) ! .S+=dS
''

  put_msg(dS&" acres of land sold for "&dSQ&" bushels")
  field ("stock") text "        "&.SQ
  end if
field "inp" text " Touch next period button to continue"
end def

In the isolated line, two signs, a plus and a minus must be changed as follows:

dSQ=int(dS*.k) !.SQ=max(1,.SQ+dSQ) ! .S-=dS

I will also edit the code in the first post

[Dutchman]

Nice "coat" for that old interesting game

[Henko]

Nice "coat" for that old interesting game :!:

Thanks. I merely grabbed three already existing utilities together ;)

[GeorgeMcGinn]

I like your version of Hammurabi game. It has some of the features that I'm putting into mine, plus I'm adding a lot more decision making processes.

However, in the three original source codes that I provided, plus in the one that I am currently coding, the original authors decided that you should either buy or sell land first, before deciding on how much you have to feed and plant for the next season.

I ran into a situation playing your game where I did not have enough grain to feed people, but if I was able to sell some land first I would have had enough grain not only feed my population but also to plant enough for the next season.

I think the original authors put those choices first so that you could maintain your population, i.e. not starving them, and allowed you to rebuild the amount of the land that you need for your population, which is more than 10 acres per person.

Another way to set up the order in which things are done would be to allow the selling of land first and then feeding the population, planting the harvest, and then if you have anything left over you can then purchase land.

I hope to have my version or most of it ready in a month, and it's going to be one hell of a game to play. I will be taking Hammurabi to new levels of decision-making and complexity, rivaling any strategy game on the market today.

I really like the numeric keypad that you have put in the game, and I may use a version of it, but I think also rbytes wrote a numeric keypad program as well. I plan to not scroll but put each year in a box with a button so you can look back and forth on previous years. Also my GUI Will have a continuous running total of all the numbers needed to make decisions. But we'll see how far I get with the graphics on the next version.

Well done on the game I like it, and if you're going to come up with a new version I can't wait.

George

[Henko]

However, in the three original source codes that I provided, plus in the one that I am currently coding, the original authors decided that you should either buy or sell land first, before deciding on how much you have to feed and plant for the next season.

Yes, i see the logic of that. I will change the order of things accordingly, although i do not persé strive to a one-to-one relationship with the original game.
I will post the next (and final) of my version, when i have implemented a graphics representation at the bottom of the screen.

You make me/us very curious about your top of the top strategy game. One month ehh..., i'll put a note in my agenda .

[Henko]

If you are interested in management-like games, i designed and coded an "oil company simulation" game in april/may 2013.

The game and the manual can be find in the program section:
viewtopic.php?f=20&t=115

Perhaps, after 6 years, i will give that game also a new "coat" and add functionality to it (transportation of crude oil and gasoline with a oil tanker fleet)

The introduction of the manual follows:


Oil company simulation game (version 2)

This simulation consists of an infinite number of rounds (periods) in which one must try to make an oil company as succesfull as possible. The game ends with bankruptcy if you make a mess of it or by simply hitting the cross in the right upper side of the window. A simulation can be saved and resumed afterwards. The program code complies with Smart Basic version 2.0.1. It does not run under previous versions of Smart Basic.

Each period (say a quarter of a year) has 3 phases:
- an exploration & acquisition phase, in which to find oil wells and acquire concessions.
- a production phase, in which to decide about production, storage and sales.
- an investment phase, in which to decide about production and storage capacities.

There are two products: crude oil from the wells and (refined) gasoline.
There are four types of production means:
- exploitation of oil wells (production of crude oil)
- storage of crude oil (tank park)
- refinery of crude oil into gasoline (plant)
- storage of gasoline (tank park)

Selling prices for each of the two products vary with a trend factor, a season factor and some arbitrary fluctuations.
The minimum price for crude oil is 60 dollars per unit, maximum is 200.
The minimum price for gasoline is 200 dollars per unit, maximum is 500.

Oil wells are scattered randomly in a 45x45 lots area. Each lot may be concessioned by you or by competitors (if there are any).
Oil fields vary in size from one single lot to large 6x6 lots, distributed as follows:
6x6 lots: 2 fields
5x5 lots: 2 fields
4x4 lots: 3 fields
3x3 lots: 5 fields
2x2 lots: 10 fields
1x1 lot : 30 fields
Large lots have more oil in the centre parts then at the outskirts.
Oil fields may (partly) overlap, other shapes than square fields are possible.
The probability that an arbitrary lot contains oil is less than 14% (less than 1 out of 7).
Oil wells are depleted as the oil is taken out by the company.

[GeorgeMcGinn]

I loaded the game, but I'm fighting a ton of syntax errors.

I first fixed all the comments that were put after a label (action: ' comment was here) and one after a THEN where the next line was a multi-statement line.

Now I'm getting Syntax errors on the BUTTON statements. I've been replacing title with text, and now I think the + and - signs in the button name and the text are causing the errors. Here is an example:

button "+exp" text "+" at 210,60  size 40,40

I am assuming that the +/- signs are important as far as telling me I'm either adding or subtracting something in the game.

I will do a walk through on the code to make sure those symbols are not used to build mathematical formula, or concatenated to the front of a string and converted using the VAL statement.

So far, I've yet to strike oil, but I'll keep drilling down the code unless you have an updated version!

Cheers, George.

[Henko]

I don't know what is wrong. Something strange happens.
Anyhow, the version i have on my iPad works normal.
Here is the code:

Code: Select all

' oil company simulation game
' version 2
'
option base 1
dim stat(45,45),oil(45,45),glob(45,45),nveld(6),parm(50)
dim mes$(60),cons(100,4)

gosub prog_init

period:
per=per+1 ! parm(25)=per
disp(stat)
numbers()
balance(per,parm,cons,oil,mes$)
button "glo" title "Global search" at 16,760 size 160,40
button "viw" title "Global view" at 16,810 size 160,40
button "exp" title "Exploration" at 16,860 size 160,40
button "con" title "Concession" at 16,910 size 160,40
button "pek" title "" at 190,950 size 10,10
draw font size 20
put_mes(parm," Start new period",mes$)
if parm(28)>1 then disaster(parm,stat,cons,oil,mes$)
parm(20)=1 ! parm(21)=3 ! parm(22)=3
prices(parm,mes$)
check_cons(parm,cons,oil)
button "kassa" delete
list_box("Message-box",mes$,parm(24),5,340,760,400,1)
button "pro" title "To operations phase" at 420,910 size 160,40
if parm(29) then
  button "sav" title "Auto-save is ON" at 590,910 size 160,40
  else 
  button "sav" title "Auto-save is OFF" at 590,910 size 160,40
  endif
draw text "Acquisition phase" at 200,920
if parm(13)>0 then kas(parm,0.01*parm(13)) else kas(parm,-parm(36)*parm(13)/100)
cost=1000+1000*parm(23)+0.5*(parm(14)+parm(18))+10*parm(16)
kas(parm,-cost)
button "kassa" title "cash:" & n2a$(parm(13),8,0) at 610,760 size 130,40

action:     ' acquisition phase
if button_pressed("glo") then global_search(parm,oil,glob)
if button_pressed("viw") then global_cumul(stat,glob)
if button_pressed("exp") then exploration(parm,glob,stat,oil)
if button_pressed("con") then concession(parm,stat,cons,oil)
if button_pressed("pek") then peek_oil(oil)
if button_pressed("sav") then
  if parm(29)=0 then
    button "sav" title "Auto-save is ON" at 590,910 size 160,40
    else
    button "sav" title "Auto-save is OFF" at 590,910 size 160,40
    end if
  parm(29)=1-parm(29)
  end if
if button_pressed("pro") then
  button "glo" delete ! button "viw" delete ! button "exp" delete
  button "con" delete ! button "pek" delete ! button "pro" delete
  button "sav" delete
  goto oper
  end if
goto action

oper:  ' operation phase
cash=0
fill rect 0,0 to screen_width(),750
fill rect 200,920 to 420,950
draw text "Operations phase" at 200,920
w_open("Operations panel",10,10,maxx-10,600)
op_text(parm)
if parm(23) then prod=prod_calc(parm,cons,oil) else prod=0
draw text n2a$(parm(15),7,0) at 200,70
draw text n2a$(prod,7,0) at 200,95
cp=-10*prod ! cash=cash+cp
draw text n2a$(cp,8,0) at 360,95
draw text n2a$(parm(17),7,0) at 200,265
draw text n2a$(parm(19),7,0) at 200,240
prod=prod+parm(15) ! gas=parm(17) ! cp=-200*gas
cash=cash+cp
draw text n2a$(cp,8,0) at 360,265                             
if prod and parm(14) then      ' input refinery qty
  max=prod ! if max>parm(16)-parm(35) then max=parm(16)-parm(35)
  if max then
    mut=getn(200,120,max) ! if mut>max then mut=max
    fill rect 200,120 to 320,150
    draw text n2a$(mut,7,0) at 200,120
    if mut<0 then mut=0
    prod=prod-mut ! parm(17)=mut
    end if
  end if
if prod then
  sales=getn(200,145,prod)
  if sales>prod then sales=prod
  if sales<prod-parm(14) then sales=prod-parm(14)
  fill rect 200,145 to 320,175
  draw text n2a$(sales,7,0) at 200,145
  cp=parm(11)*sales ! cash=cash+cp
  draw text n2a$(cp,8,0) at 360,145
  parm(15)=prod-sales
  end if
draw text n2a$(parm(15),7,0) at 200,170
gas=gas+parm(19)
if gas then
  sales=getn(200,290,gas) ! if sales>gas then sales=gas
  if sales<gas-parm(18) then sales=gas-parm(18)
  fill rect 200,290 to 320,320
  draw text n2a$(sales,7,0) at 200,290
  cp=parm(12)*sales ! cash=cash+cp
  draw text n2a$(cp,8,0) at 360,290
  gas=gas-sales ! parm(19)=gas
  end if
draw text n2a$(parm(19),7,0) at 200,315
kas(parm,cash)
draw text "Operational cashflow" at 100,350
draw text n2a$(cash,8,0) at 360,350
button "inv" title "to investment phase" at 425,910 size 160,40
wait1:
if button_pressed("inv") then goto invest
goto wait1

invest:         ' investment phase
ncons=parm(23)
button "inv" delete
fill rect 200,920 to 420,950
draw text "Investments phase" at 200,920
w_open("Investments panel",10,10,maxx-10,640)
draw font size 24 ! draw color 0,0,.8
draw text "Exploitation" at 30,64
draw text "Crude oil" at 30,254
draw text "Refinery" at 30,379
draw text "Gasoline" at 30,504
draw font size 20 ! draw color 0,0,0
button "show" title "Show concessions" at 530,70 size 160,30
button "oke" title "Done" at 320,600 size 120,30
button "+exp" title "+" at 210,60  size 40,40
draw text "first 100 cost 10.000" at 30,104
draw text "next 100's cost 3.000" at 30,134
button "+cru" title "+" at 170,250 size 40,40
draw text "first 1000  cost 5.000" at 30,294
draw text "next 1000's cost 3.000" at 30,324
button "+ref" title "+" at 170,375 size 40,40
draw text "first 100  cost 50.000" at 30,419
draw text "next 100's cost 10.000" at 30,449
button "+gas" title "+" at 170,500 size 40,40
draw text "first 1000  cost 5.000" at 30,544
draw text "next 1000's cost 3.000" at 30,574
draw text "capacity: " & n2a$(parm(14),5,0) at 230,258
draw text "capacity: " & n2a$(parm(16)-parm(35),5,0) at 230,383
draw text "capacity: " & n2a$(parm(18),5,0) at 230,508
if parm(39) then
  message(" no investments allowed (solvability problem) ",105,180)
  goto next_period
  end if

c_loop:
if button_pressed("+exp") then goto inv_loop1
if button_pressed("+cru") then goto inv_loop2
if button_pressed("+ref") then goto inv_loop3
if button_pressed("+gas") then goto inv_loop4
if button_pressed("oke")   then goto next_period
if button_pressed("show") then 
  show_cons(ncons,cons,oil)
  button "show" title "Show concessions" at 530,70 size 160,30
  end if
goto c_loop

inv_loop1:       ' exploitation
if ncons=0 then goto c_loop
fill rect 30,160 to 460,250
i=get_num("row:",30,170) ! draw text "row: "& i at 30,160
j=get_num("col:",30,200) ! draw text "col: "& j at 30,190
just=0
for k=1 to ncons
  if i=cons(k,1) and j=cons(k,2) then
    just=1 ! p=k ! k=ncons
    endif
  next k
if just=0 then goto c_loop
if cons(p,4) then
  kas(parm,-3000)
  cons(p,4)=cons(p,4)+100  
  else
  kas(parm,-10000)
  cons(p,4)=cons(p,4)+100  
  end if
fill rect 270,64 to 440,84
draw text "capac.= " & cons(p,4) at 270,64
draw text "press + for more capacity" at 30,220
goto c_loop
inv_loop2:      ' storage crude oil
if parm(14) then kas(parm,-3000) else kas(parm,-5000)
parm(14)=parm(14)+1000
fill rect 230,258 to 440,288
draw text "capacity: " & n2a$(parm(14),5,0) at 230,258
goto c_loop
inv_loop3:      ' refinery capacity
if parm(16) then kas(parm,-10000) else kas(parm,-50000)
parm(16)=parm(16)+100
fill rect 230,383 to 440,413
draw text "capacity: " & n2a$(parm(16)-parm(35),5,0) at 230,383
goto c_loop
inv_loop4:      ' storage gasoline
if parm(18) then kas(parm,-3000) else kas(parm,-5000)
parm(18)=parm(18)+1000
fill rect 270,508 to 440,538
draw text "capacity: " & n2a$(parm(18),5,0) at 230,508
goto c_loop

next_period:
button "+exp" delete
button "+cru" delete
button "+ref" delete
button "+gas" delete
button "kassa" delete
button "oke" delete
button "show" delete
fill rect 0,0 to maxx,644
fill rect 200,920 to 420,950
if parm(27)>1 then concur(parm,stat)
if parm(29) then save(parm,cons,mes$,stat,oil,glob,nveld)
goto period
end

def disaster(parm(),stat(,),cons(,),oil(,),mes$())
if parm(28)=2 then goto dis1
if parm(30) then       ' unrest in mid-east
  if rnd(100)<60-5*parm(28) then
    parm(30)=0
    put_mes(parm," mid-east now quiet",mes$)
    goto dis1
    end if
  put_mes(parm," unrest in mid-east",mes$)
  if rnd(100)<10*parm(28)-15 and parm(23) then
    put_mes(parm," concession lost",mes$)
    k=1+rnd(parm(23))
    i=cons(k,1) ! j=cons(k,2) ! oil(i,j)=0
    end if
  else
    if rnd(100)<45*parm(28)-15 then parm(30)=1
  end if
dis1:      ' fire in oil well
if rnd(100)>10*parm(28)-10 or parm(23)=0 then goto dis2
k=1+rnd(parm(23))
put_mes(parm," fire in oil well " & k,mes$)
cons(k,4)=0
dis2:      ' fire in crude oil storage
if rnd(100)>10*parm(28)-10 or parm(14)=0 then goto dis3
perc=.1+.05*parm(28) ! pp=100*perc ! pp$=" -" & pp & "%"
parm(14)=(1-perc)*parm(14) ! parm(15)=(1-perc)*parm(15)
put_mes(parm," fire in crude oil" & pp$,mes$)
dis3:      ' fire in refinery
if rnd(100)>8*parm(28)-10 or parm(16)=0 then goto dis4
perc=.05*parm(28) ! pp=100*perc ! pp$=" -" & pp & "%"
parm(16)=(1-perc)*parm(16) ! parm(17)=(1-perc)*parm(17)
put_mes(parm," fire in refinery" & pp$,mes$)
dis4:      ' fire in gasoline storage
if rnd(100)>10*parm(28)-10 or parm(18)=0 then goto dis5
perc=.1+.05*parm(28) ! pp=100*perc ! pp$=" -" & pp & "%"
parm(18)=(1-perc)*parm(18) ! parm(19)=(1-perc)*parm(19)
put_mes(parm," fire in gasoline" & pp$,mes$)
dis5:      ' strike in refinery
if parm(16)=0 then goto dis6
if parm(35) then
  if rnd(100)<45-10*parm(28) then
    parm(35)=0
    put_mes(parm," strike has ended",mes$)
    end if
  else 
  if rnd(100)<5+5*parm(28) then
    parm(35)=(0.2+rnd(0.3))*parm(16)
    put_mes(parm," strike in refinery" & pp$,mes$)
    end if
  end if
dis6:          ' high interest %
if parm(36)>3 then
  if rnd(100)<50-10*parm(28) then
    parm(36)=3 ! put_mes(parm," interest back to normal",mes$)
    end if
  else
  if rnd(100)<5+10*parm(28) then
    parm(36)=5+rnd(5)
    put_mes(parm," interest rate now " & parm(36) & "%",mes$)
    end if
  end if
if parm(37) then      ' price crude oil
  if rnd(100)<45-10*parm(28) then
    parm(37)=0 ! put_mes(parm," crude oil back to normal",mes$)
    end if
  else
  if rnd(100)<5+7*parm(28) then
    parm(37)=20+rnd(40)
    put_mes(parm," price drop crude oil",mes$)
    end if
  end if
if parm(38) then      ' price gasoline
  if rnd(100)<45-10*parm(28) then
    parm(38)=0 ! put_mes(parm," gasoline back to normal",mes$)
    end if
  else
  if rnd(100)<5+7*parm(28) then
    parm(38)=20+rnd(40)
    put_mes(parm," price drop gasoline",mes$)
    end if
  end if
end def

def load(parm(),cons(,),mes$(),stat(,),oil(,),glob(,),nveld())
for i=1 to 6 ! file "save_oil" input nveld(i) ! next i
for i=1 to 50 ! file "save_oil" input parm(i) ! next i
for i=1 to parm(23)
  for j=1 to 4
    file "save_oil" input cons(i,j)
    next j
  next i
for k=1 to 2025
  file "save_oil" input i,j,temp
  if i then stat(i,j)=temp else goto load_1
  next k
load_1:
for k=1 to 2025
  file "save_oil" input i,j,temp
  if i then oil(i,j)=temp else goto load_2
  next k
load_2:
for k=1 to 2025
  file "save_oil" input i,j,temp
  if i then glob(i,j)=temp else goto load_3
  next k
load_3:
for i=1 to parm(24) ! file "save_oil" input mes$(i) ! next i
end def

def save(parm(),cons(,),mes$(),stat(,),oil(,),glob(,),nveld())
draw text "saving" at 300,300
file "save_oil" delete
zero=0
for i=1 to 6 ! file "save_oil" print nveld(i) ! next i
for i=1 to 50 ! file "save_oil" print parm(i) ! next i
for i=1 to parm(23)
  for j=1 to 4
    file "save_oil" print cons(i,j)
    next j
  next i
draw text "..1" at 384,300
for i=1 to 45
  for j=1 to 45
    if stat(i,j) then file "save_oil" print i,j,stat(i,j)
    next j
  next i
file "save_oil" print zero,zero,zero
draw text "..2" at 426,300
for i=1 to 45
  for j=1 to 45
    if oil(i,j) then file "save_oil" print i,j,oil(i,j)
    next j
  next i
file "save_oil" print zero,zero,zero
draw text "..3" at 468,300
for i=1 to 45
  for j=1 to 45
    if glob(i,j) then file "save_oil" print i,j,glob(i,j)
    next j
  next i
file "save_oil" print zero,zero,zero
for i=1 to parm(24)
  file "save_oil" print """" & mes$(i) & """"
  next i
draw text "..4" at 510,300
end def

def op_text(parm())
draw text "CRUDE OIL.        QTY.        CASHFLOW" at 20,40
draw text "old stock   : " at 30,70
draw text "production  : " at 30,95
draw text "to refinery : " at 30,120
draw text "sales       : " at 30,145
draw text "new stock   : " at 30,170
draw text "GASOLINE" at 20,210
draw text "old stock   : " at 30,240
draw text "ex refinery : " at 30,265
draw text "sales       : " at 30,290
draw text "new stock   : " at 30,315
draw text "storage capacity crude oil :" & n2a$(parm(14),7,0) at 20,400
draw text "max. refinery capacity     :" & n2a$(parm(16),7,0) at 20,430
draw text "storage capacity gasoline  :" & n2a$(parm(18),7,0) at 20,460
end def

def check_cons(parm(),cons(,),oil(,))
ncons=parm(23)
for k=1 to ncons
  i=cons(k,1) ! j=cons(k,2)
  if oil(i,j)=0 then
    if k<ncons then
      for i=k to ncons-1
        for j=1 to 4
          cons(i,j)=cons(i+1,j)
          next j
        next i
      end if
    ncons=ncons-1
    end if
  next k   
parm(23)=ncons
end def

def show_cons(ncons,cons(,),oil(,))
dim con$(100)
button "show" delete
con$(1)="  r  c   res  expl"
if ncons then
  for k=1 to ncons
    i=cons(k,1) ! i$=i ! i$=pre_pad$(3,i$)
    j=cons(k,2) ! j$=j ! j$=pre_pad$(3,j$)
    con$(k+1)=i$ & j$ & n2a$(oil(i,j),6,0) & n2a$(cons(k,4),6,0)
    next k
  end if
list_box("Concessions",con$,ncons+1,21,470,40,280,1)
end def

def prod_calc(parm(),cons(,),oil(,))
ncons=parm(23) ! prod=0
for k=1 to ncons
  cap=cons(k,4)
  if cap then
    i=cons(k,1) ! j=cons(k,2)
    if oil(i,j) then
      if cap>oil(i,j) then cap=oil(i,j)
      prod=prod+cap ! oil(i,j)=oil(i,j)-cap
      end if
    end if
  next k
prod_calc=prod
end def

def global_search(parm(),oil(,),g(,))
blanc()
lines()
if parm(20)=0 then
  message("only one search per turn! ",250,800)
  return
  else
  parm(20)=0
  end if
if parm(39) then
  message("not allowed (solvability problem) ",250,800)
  return
  end if
graphics lock
for i=1 to 45
  for j=1 to 45
    if rnd(1)<.25 then
      ind=0
      if oil(i,j) then
        if rnd(1)<(.25-.05*parm(26)) then ind=1
        else
        if rnd(1)<.05 then ind=1
        end if
      if ind then
        g(i,j)=g(i,j)+1
        pix(i,j,.8,0,0)
      end if
    end if
  next j
next i
graphics unlock
temp=parm(1)
kas(parm,-2000)
end def

def global_cumul(stat(,),g(,))
blanc()
lines()
graphics lock
for i=1 to 45
  for j=1 to 45
    ind=g(i,j) ! if ind>3 then ind=3
    if ind then pix(i,j,ind/3,0,0)
    if stat(i,j)=3 then
      fill color 1,1,1 ! fill rect 16*j+7,16*i+7 to 16*j+10,16*i+10
      fill color .8,.8,.8
      end if
    if stat(i,j)=-1 then pix(i,j,0,0,0)
    next j
  next i  
graphics unlock
end def

def exploration(parm(),g(,),stat(,),oil(,))
disp(stat)
if parm(28)=3 and parm(30) then
  message("Unrest in mid-east; no explorations! ",200,800)
  return
  end if
if parm(21)=0 then
  message("No more explorations this turn! ",200,800)
  return
  else
  parm(21)=parm(21)-1
  end if
if parm(39) then
  message("not allowed (solvability problem) ",200,800)
  return
  end if
ex_loop:
i=get_num("row number:",200,800)
draw text "row number: "& i at 200,800
j=get_num("col number:",200,850)
draw text "col number: "& j at 200,850
if i=0 or j=0 then goto ex_loop
if stat(i,j)<0 then goto ex_loop
if stat(i,j)=0 then stat(i,j)=1
fill rect 200,760 to 440,880
if oil(i,j) and rnd(1)<(1-.15*parm(26)) then
    if stat(i,j)<2 then 
      stat(i,j)=2
      else
      if stat(i,j)=3 then stat(i,j)=4
      end if
    pix(i,j,.8,.8,0)
    draw text "oil well found !!" at 330,768 ! pause 2
    fill rect 330,768 to 560,800
    end if
fill color 0,0,0 ! fill rect 16*j+7,16*i+7 to 16*j+10,16*i+10
fill color .8,.8,.8
temp=parm(1)
kas(parm,-2000)
end def

def concession(parm(),stat(,),cons(,),oil(,))
temp=parm(1) ! temp=stat(1,1) ! temp=cons(1,1)
disp(stat)
if parm(28)=3 and parm(30) then
  message("Unrest in mid-east; no concessions! ",200,800)
  return
  end if
if parm(22)=0 then
  message("No more consessions this turn! ",200,800)
  return
  else
  parm(22)=parm(22)-1
  end if
if parm(39) then
  message("not allowed (solvability problem) ",200,800)
  return
  end if
con1:
' i=get_num("row number:",200,800)
i=numpad(300,500,40,1,45)
draw text "row number: "& i at 200,800
' j=get_num("col number:",200,850)
j=numpad(300,500,40,1,45)
if i=0 or j=0 then goto con1
draw text "col number: "& j at 200,850
fill rect 200,760 to 440,880
if stat(i,j)=-1 or stat(i,j)>2 then return
if oil(i,j) then stat(i,j)=3 else stat(i,j)=4
ncons=parm(23)+1 ! parm(23)=ncons
cons(ncons,1)=i ! cons(ncons,2)=j ! cons(ncons,4)=0
draw text "c" at 16*j+2,16*i-6 ! pause 2
kas(parm,-5000)
end def

def concur (parm(),stat(,))
if parm(28)=3 and parm(30) then return
c_d=2 ! c_s=3 ! temp=stat(1,1)
for i=2 to 44
  for j=2 to 44
    if c_d=0 and c_s=0 then return
    if stat(i,j)<1 then goto con3
    if parm(27)>2 and c_s>0 and rnd(1)<.3 then
      if claim(i,j,stat)=1 then c_s=c_s-1
      end if
    if stat(i,j)>2 and c_d>0 and rnd(1)<.3 then
      if parm(27)=2 or parm(27)=4 then
        if claim(i,j,stat)=1 then c_d=c_d-1
        end if
      end if
    con3:
    next j
  next i 
end def

def claim (p,q,stat(,))
claim=0
for i=p-1 to p+1
  for j=q-1 to q+1
    if i<>p or j<>q then
      if stat(i,j)>-1 and stat(i,j)<3 then
        stat(i,j)=-1 ! claim=1 ! return
        end if
      end if
    next j
  next i
end def

def peek_oil (oil(,))
blanc()
lines()
graphics lock
for i=1 to 45
  for j=1 to 45
    if oil(i,j) then
      r=oil(i,j)/4000 ! if r>1 then r=1
      pix (i,j,r,0,0)
      end if
    next j
  next i
graphics unlock
end def

def cls()
graphics clear .8,.8,.8
end def

def disp(stat(,))
blanc()
graphics lock
for i=1 to 45
  for j=1 to 45
    if stat(i,j)=-1 then
      pix(i,j,0,0,0) ! goto nxt
      end if
    if stat(i,j)=1 then
      fill color 0,0,0 ! fill rect 16*j+7,16*i+7 to 16*j+10,16*i+10
      fill color .8,.8,.8
      goto nxt
      end if
    if stat(i,j)=2 or stat(i,j)=3 then
      pix(i,j,.8,.8,0)
      fill color 0,0,0 ! fill rect 16*j+7,16*i+7 to 16*j+10,16*i+10
      fill color .8,.8,.8
      end if
    if stat(i,j)=3 or stat(i,j)=4 then
      draw text "c" at 16*j+2,16*i-6
      goto nxt
      end if
    nxt:
  next j
next i
graphics unlock
lines()
end def

def blanc()
fill color .6,.6,.6 ! fill rect 16,16 to 736,736
fill color .8,.8,.8
end def

def lines()
graphics lock
for i=1 to 46
  x=16*i ! y=x
  draw line 16,y to 736,y ! draw line x,16 to x,736
  next i
graphics unlock
end def

def numbers()
graphics lock
draw font size 12
for i=1 to 45
  x=16*i ! y=x ! i$=i
  draw text i$ at 1,y ! draw text i$ at 742,y
  draw text i$ at x+2,2 ! draw text i$ at x+2,736
  next i
graphics unlock
draw font size 20
end def

def pix (i,j,r,g,b)
fill color r,g,b ! fill rect 16*j+1,16*i+1 to 16*j+15,16*i+15
fill color .8,.8,.8
end def

def kas(parm(),mut)
parm(13)=parm(13)+mut
button "kassa" title "cash:" & n2a$(parm(13),8,0) at 610,760 size 130,40
end def

def prices(parm(),m$())
alf=mod(parm(25),12)/2
if rnd(1)<0.125 then
  if parm(3)>1 then
    parm(3)=1-rnd(0.02)
    put_mes(parm," trend crude negative",m$)
    else
    parm(3)=1+rnd(0.02)
    put_mes(parm," trend crude positive",m$)
    end if
  end if
if rnd(1)<0.125 then
  if parm(8)>1 then
    parm(8)=1-rnd(0.03)
    put_mes(parm," trend gasoline negative",m$)
    else
    parm(8)=1+rnd(0.03)
    put_mes(parm," trend gasoline positive",m$)
    end if
  end if
parm(2)=parm(3)*parm(2)
parm(11)=parm(2)+parm(4)*sin(alf)-parm(5)/2+rnd(parm(5))
parm(11)=parm(11)-parm(37)
if parm(11)<parm(1) then parm(11)=parm(1)
if parm(11)>200 then parm(11)=200
put_mes(parm," price crude oil " & n2a$(parm(11),4,1),m$)
parm(12)=parm(7)+parm(9)*sin(alf)-parm(10)/2+rnd(parm(10))
parm(12)=parm(12)-parm(38)
if parm(12)<parm(6) then parm(12)=parm(6)
if parm(12)>500 then parm(12)=500
put_mes(parm," price gasoline " & n2a$(parm(12),4,1),m$)
end def

def put_mes(parm(),tt$,m$())
parm(24)=parm(24)+1 ! if parm(24)>60 then parm(24)=60
nmes=parm(24)
for k=nmes-1 to 1 step -1
  m$(k+1)=m$(k)
  next k
m$(1)=n2a$(parm(25),3,0) & "" & tt$
end def

def mod(a,m)
d=a/m
mod=m*(d-floor(d))
end def

def message (t$,x,y)
z=12*len(t$)+10 ! if z<300 then z=300
xb=x+z ! yb=y+50
w_open ("",x,y,xb,yb)
draw text t$ at x+5,y+2
button "oki" title "ok" at (x+xb-60)/2,y+24 size 60,20
loki:
if button_pressed("oki") then
  fill rect x-2,y-2 to xb+2,yb+2
  button "oki" delete
  else
  goto loki
  end if  
end def

def list_box (titel$,mes$(),max,nr,xtop,ytop,breed,stop)
dh=25
fill color .8,.8,.8
xbot=xtop+breed ! ybot=ytop+(nr+1)*dh+40
w_open (titel$,xtop,ytop,xbot,ybot)
' draw font size 18
if stop then button "ok" title "Done" at xbot-130,ybot-35 size 120,30
xs=xtop+50 ! ys=ytop ! top=1
goto sel3
sel1:
graphics lock
fill rect xs,ys+30 to xs+breed-55,ybot-5
for j=top to bot
  k=j-top+1
  draw text mes$(j) at xs,ys+25*k
next j
graphics unlock
sel2:
if button_pressed("down")=1 then
  bot=bot+nr
  if bot>=max then
    bot=max ! button "down" delete
  end if
  top=bot-nr+1
  if top<=1 then
    top=1 ! button "up" delete
  else
    button "up" title "^" at xs-40,ys+40 size 30,60
  end if
  goto sel1
end if
if button_pressed("up")=1 then
  top=top-nr
  if top<=1 then
    top=1 ! button "up" delete
  end if
sel3:
  bot=top+nr-1
  if bot>=max then
    bot=max ! button "down" delete
  else
    button "down" title "v" at xs-40,ybot-70 size 30,60
  end if
  goto sel1
end if
if stop=0 then return
if button_pressed("ok")=1 then
   button "ok" delete ! button "up" delete ! button "down" delete 
   fill rect xtop-2,ytop-2 to xbot+2,ybot+2
   return
   end if
goto sel2
end def

def w_open (title$,xtop,ytop,xbot,ybot)
r=10
draw color 0,0,0 ! draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
if title$<>"" then
  l=(xbot-xtop-12*len(title$))/2
  draw line xtop,ytop+24 to xbot,ytop+24
  draw color 0,0,1
  draw text title$ at xtop+l,ytop+1
  draw color 0,0,0
end if
draw size 1
end def

def getn(xpos,ypos,default)
field "data" text n2a$(default,8,0) at xpos,ypos size 100,30
get1:
if field_changed("data")=0 then goto get1
hulp=field_text$("data")
field "data" delete
fill rect xpos,ypos to xpos+120,ypos+30
draw text n2a$(hulp,8,0) at xpos,ypos
getn=hulp
end def

def get_num(t$,x,y)
draw text t$ at x,y
xs=x+14*len(t$)+10
for i=0 to 4
  i$=i ! b$="t" & i$ ! button b$ title i$ at xs+35*i,y-13 size 24,24
  next i
for i=0 to 9
  i$=i ! b$="e" & i$ ! button b$ title i$ at xs+35*i,y+16 size 24,24
  next i
t=0
loop1:
for i=0 to 4
  b$="t" & i
  if button_pressed(b$) then
    t=i ! goto loop2
    end if
  next i
goto loop1
loop2:
e=0 ! s=9
if t=4 then
  s=5
  for i=6 to 9
    b$="e" & i ! button b$ delete
    next i
  end if  
for i=0 to s
  b$="e" & i
  if button_pressed(b$) then
    e=i ! goto loop3
    end if
  next i
goto loop2
loop3:
fill rect x,y to xs,y+24
for i=0 to 9
  b$="t" & i
  if i<5 then button b$ delete
  b$="e" & i
  if t<4 or t=4 and i<6 then button b$ delete
  next i
get_num=10*t+e
end def

def numpad(xtop,ytop,bs,minval,maxval)
sp=3 ! th=bs-16 ! pflag=0 ! sflag=0
if bs<20 then bs=20
draw font size .9*bs-18
ww=4*bs+5*sp ! hh=th+4*bs+6*sp
xbot=xtop+ww ! ybot=ytop+hh
sprite "bg" scan xtop-2,ytop-2,ww+4,hh+4

r=10 ! graphics lock
draw color 0,0,0 ! draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
draw line xtop,ytop+th to xbot,ytop+th
graphics unlock

button "0" title "0" at xtop+sp,ytop+th+3*bs+5*sp size bs,bs
button "1" title "1" at xtop+sp,ytop+th+2*bs+4*sp size bs,bs
button "2" title "2" at xtop+2*sp+bs,ytop+th+2*bs+4*sp size bs,bs
button "3" title "3" at xtop+3*sp+2*bs,ytop+th+2*bs+4*sp size bs,bs
button "4" title "4" at xtop+sp,ytop+th+bs+3*sp size bs,bs
button "5" title "5" at xtop+2*sp+bs,ytop+th+bs+3*sp size bs,bs
button "6" title "6" at xtop+3*sp+2*bs,ytop+th+bs+3*sp size bs,bs
button "7" title "7" at xtop+sp,ytop+th+2*sp size bs,bs
button "8" title "8" at xtop+2*sp+bs,ytop+th+2*sp size bs,bs
button "9" title "9" at xtop+3*sp+2*bs,ytop+th+2*sp size bs,bs
button "-" title "-" at xtop+2*sp+bs,ytop+th+3*bs+5*sp size bs,bs
button "." title "." at xtop+3*sp+2*bs,ytop+th+3*bs+5*sp size bs,bs
button "Cl" title "C" at xtop+4*sp+3*bs,ytop+th+2*sp size bs,bs
button "del" title "<-" at xtop+4*sp+3*bs,ytop+th+bs+3*sp size bs,bs
button "ok" title "ok" at xtop+4*sp+3*bs,ytop+th+2*bs+4*sp size bs,2*bs+sp

a$=""
nump1:
if b_s("ok") then
  number=val(a$)
  if minval<>0 or maxval<>0 then
    if number<minval or number>maxval then
      fill rect xtop+8,ytop+2 to xbot-10,ytop+th-2
      draw color .6,0,0 ! draw text "range err" at xtop+8,ytop+2
      pflag=0 ! a$="" ! pause 1
      fill rect xtop+8,ytop+2 to xbot-10,ytop+th-2
      goto nump1
      end if
    end if
  button "-" delete ! button "." delete ! button "Cl" delete
  button "del" delete ! button "ok" delete
  for i=0 to 9 ! button i delete ! next i
  sprite "bg" at xtop-2,ytop-2 ! sprite "bg" stamp
  draw font size 24 ! draw size 1
  numpad=number ! return
  end if

if b_s("Cl") then
  a$ = "" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_s("del") and len(a$) then
  ll=len(a$) ! if substr$(a$,ll,ll)="." then pflag=0
  a$ = left$(a$,ll-1) ! sflag=0 ! goto nump3
  end if
if b_s("-") then
  a$ = "-" ! pflag=0 ! sflag=0 ! goto nump3
  end if
if b_s(".") and not pflag and not sflag then
  a$ &= "." ! pflag=1 ! goto nump3
  end if
for k=0 to 9
  t$=k
  if b_s(t$) and not sflag then
    a$ &= t$ ! goto nump3
    end if
  next k
goto nump1

nump3:
if len(a$)>10 then ! sflag=1 ! goto nump1 ! end if
fill rect xtop+8,ytop+2 to xbot-6,ytop+th-2
draw color 0,0,1 ! draw text a$ at xtop+8,ytop+2 ! draw color 0,0,0
goto nump1

end def

def b_s(n$) = button_pressed(n$)


def n2a$(num,lang,dec)
b$="               "
fac=10^dec
num$=floor(fac*num+.5)/fac
tot=lang-len(num$)
if tot<1 then tot=1
a$=substr$(b$,1,tot) & num$
n2a$=a$
end def

def pre_pad$(w,a$)
sp$="               "
tot=w-len(a$)
if tot then pre_pad$=substr$(sp$,1,tot) & a$ else pre_pad$=a$
end def

def difficulty(parm())
fill color .8,.8,.8
top=50
w_open ("Set difficulty profile",10,top,758,top+670)
draw text "Select hit probability while searching for oil" at 20,top+100
button "1" title "High" at 600,top+30 size 120,40
button "2" title "Medium" at 600,top+90 size 120,40
button "3" title "Low" at 600,top+150 size 120,40
draw text "select level of competitive oil companies" at 20,top+326
button "4" title "No competition" at 530,top+230 size 190,40
button "5" title "one dumb company" at 530,top+290 size 190,40
button "6" title "one smart company" at 530,top+350 size 190,40
button "7" title "both companies" at 530,top+410 size 190,40
draw text "Select disaster level" at 20,top+560
button "8" title "No disasters" at 530,top+490 size 190,40
button "9" title "Some disasters" at 530,top+550 size 190,40
button "10" title "Many disasters" at 530,top+610 size 190,40
button "11" title "Done" at 20,top+610 size 120,40
draw font size 24
draw text "Oil company simulation game" at 200,top+700
draw font size 20
draw text "version 1, may/1/2013" at 270,top+730
draw text "idea and programming by Henk Overtoom, Netherlands" at 90,top+760
draw text "no rights claimed; feel free to nick this program" at 96,top+790
diff1:
for i=1 to 11 ! i$=i ! if button_pressed(i$) then goto diff2 ! next i
goto diff1
diff2:
k=i$
if k=11 then goto diff3
if k>7 then
  parm(28)=k-7 ! goto diff1
end if
if k>3 then
  parm(27)=k-3 ! goto diff1
end if
parm(26)=k ! goto diff1
diff3:
fill rect 0,0 to 760,880
for i=1 to 11 ! i$=i ! button i$ delete ! next i
end def

def balance(per,parm(),cons(,),oil(,),mes$())
w_open("Balance sheet period " & per,20,766,736,940)
button "ok_bal" title "Done" at 600,900 size 120,30
res=0 ! bal=0 ! explo=0
for k=1 to parm(23)
  i=cons(k,1) ! j=cons(k,2)
  explo=explo+cons(k,4)
  res=res+oil(i,j)
  next k
act=8*explo+80*parm(16)+2*(parm(14)+parm(18)) ! bal=bal+act
draw text "Installations  :" & n2a$(act,10,0) at 30,800
resd=5*res ! bal=bal+resd
draw text "Oil reserves   :" & n2a$(resd,10,0) at 30,822
resd=50*(parm(15)+parm(17)) ! bal=bal+resd
draw text "Crude oil stock:" & n2a$(resd,10,0) at 30,844
resd=180*parm(19) ! bal=bal+resd
draw text "Gasoline stock :" & n2a$(resd,10,0) at 30,866
resd=parm(13) ! if resd<0 then resd=0 ! bal=bal+resd
draw text "Cash           :" & n2a$(resd,10,0) at 30,888
draw line 220,912 to 340,912
draw text "Balance total  :" & n2a$(bal,10,0) at 30,912
loan=0 ! if parm(13)<0 then loan=-parm(13)
draw text "Loans at " & parm(36) & "%    :" & n2a$(loan,10,0) at 400,800
cap=bal-loan
draw text "Capital        :" & n2a$(cap,10,0) at 400,822
draw line 590,846 to 710,846
draw text "Balance total  :" & n2a$(bal,10,0) at 400,846
if loan<cap then goto bal_loop
draw text "Solvability problem !!" at 450,870
if parm(15) then
  pr=parm(11)-parm(37)
  target=(2*loan-bal)/(2*pr-50)
  put_mes(parm," crude oil sold !!",mes$)
  quant=target/pr ! if quant>parm(15) then quant=parm(15)
  parm(15)=parm(15)-quant
  loan=loan-quant*pr
  bal=bal-50*quant ! cap=bal-loan
  end if
if loan<cap then
  parm(39)=0 ! goto bal_loop
  end if
if parm(19) then
  pr=parm(12)-parm(38)
  target=(2*loan-bal)/(2*pr-50)
  put_mes(parm," gasoline sold !!",mes$)
  quant=target/pr ! if quant>parm(19) then quant=parm(19)
  parm(19)=parm(19)-quant
  loan=loan-quant*pr
  bal=bal-180*quant ! cap=bal-loan
  end if
eval:
if loan>4*cap then
  cls! draw font size 40
  draw text "YOU ARE BANKRUPT !!" at 140,400 ! pause 5
  stop
  end if
if loan>cap then
  parm(39)=1 ! put_mes(parm," restricted operations",mes$)
  else
  if parm(39)=1 then
    parm(39)=0 ! put_mes(parm," full operations again",mes$)
    end if
  end if
bal_loop:
if button_pressed("ok_bal")=0 then goto bal_loop
button "ok_bal" delete
fill rect 18,764 to 738,942
end def

prog_init:
maxx=screen_width() ! maxy=screen_height()
randomize
graphics
draw color 0,0,0
cls
button "new" title "New game" at 200,300 size 160,40
button "res" title "Resume game" at 400,300 size 160,40

ini_loop:
if button_pressed("new") then goto cont
if button_pressed("res") then
  button "new" delete
  button "res" delete
  load(parm,cons,mes$,stat,oil,glob,nveld)
  per=parm(25)
  return
  end if
goto ini_loop

cont:
button "new" delete
button "res" delete
parm(1)=60       ' minimum price crude oil
parm(2)=100      ' starting price crude oil
parm(3)=1.02     ' initial trend crude oil price
parm(4)=0.3      ' seasonal amplitude crude oil price
parm(5)=20       ' max. fluctuation crude oil price
parm(6)=150      ' minimum price gasoline
parm(7)=300      ' starting price gasoline
parm(8)=1.01     ' initial trend gasoline price
parm(9)=0.25     ' seasonal amplitude gasoline price
parm(10)=40      ' max. fluctuation gasoline price
parm(11)=100     ' current price crude oil
parm(12)=300     ' current price gasoline
parm(13)=0       ' cash
parm(14)=0       ' storage capacity crude oil
parm(15)=0       ' crude oil on stock
parm(16)=0       ' refinery capacity
parm(17)=0       ' refine in progress
parm(18)=0       ' storage capacity gasoline
parm(19)=0       ' gasoline on stock
parm(20)=1       ' global searches this turn
parm(21)=3       ' explorations this turn
parm(22)=3       ' concessions this turn
parm(23)=0       ' # concessies in bezit
parm(24)=0       ' # messages in message window
parm(25)=0       ' current period
parm(26)=1       ' difficulty level hit probability
parm(27)=1       ' difficulty level competitors
parm(28)=1       ' difficulty level disasters
parm(29)=0       ' automatic save on/off
parm(30)=0       ' unrest in mid-east
parm(31)=0       ' fire in oil well
parm(32)=0       ' fire in crude oil storage
parm(33)=0       ' fire in refinery
parm(34)=0       ' fire in gasoline storage
parm(35)=0       ' strike in refinery
parm(36)=3       ' high interest %
parm(37)=0       ' price crude oil
parm(38)=0       ' price gasoline
parm(39)=0       ' surseance: most actions not allowed
difficulty(parm)
parm(13)=130000-10000*(parm(26)+parm(27)+parm(28))
for i=1 to 6 ! read nveld(i) ! next i
data 30,10,5,3,2,2

for k=1 to nveld(1)
  x=1+rnd(45) ! y=1+rnd(45)
  oil(x,y)=oil(x,y)+800+rnd(400)
  next k
for k=1 to nveld(2)
  x=1+rnd(44) ! y=1+rnd(44)
  for i=x to x+1
    for j=y to y+1
      oil(i,j)=oil(i,j)+800+rnd(400)
      next j
    next i
  next k
for k=1 to nveld(3)
  x=1+rnd(43) ! y=1+rnd(43)
  for i=x to x+2
    for j=y to y+2
      oil(i,j)=oil(i,j)+800+rnd(400)
      next j
    next i
  oil(x+1,y+1)=oil(x+1,y+1)+800+rnd(400)
  next k
for k=1 to nveld(4)
  x=1+rnd(42) ! y=1+rnd(42)
  for i=x to x+3
    for j=y to y+3
      oil(i,j)=oil(i,j)+800+rnd(400)
      next j
    next i
  for i=x+1 to x+2
    for j=y+1 to y+2
      oil(i,j)=oil(i,j)+1000+rnd(500)
      next j
    next i
  next k
for k=1 to nveld(5)
  x=1+rnd(41) ! y=1+rnd(41)
  for i=x to x+4
    for j=y to y+4
      oil(i,j)=oil(i,j)+800+rnd(400)
      next j
    next i
  for i=x+1 to x+3
    for j=y+1 to y+3
      oil(i,j)=oil(i,j)+1000+rnd(500)
      next j
    next i
  oil(x+2,y+2)=oil(x+2,y+2)+1000+rnd(500)
  next k
for k=1 to nveld(6)
  x=1+rnd(40) ! y=1+rnd(40)
  for i=x to x+5
    for j=y to y+5
      oil(i,j)=oil(i,j)+800+rnd(400)
      next j
    next i
  for i=x+1 to x+4
    for j=y+1 to y+4
      oil(i,j)=oil(i,j)+1000+rnd(500)
      next j
    next i
  for i=x+2 to x+3
    for j=y+2 to y+3
      oil(i,j)=oil(i,j)+1000+rnd(500)
      next j
    next i
  next k
return

def test (in$,in)
fill rect 30,900 to 400,940
a$="test " & in$ & in ! draw text a$ at 30,900
button "cont" title "doorgaan ?" at 440,890
loopje:
if button_pressed("cont")=0 then goto loopje
button "cont" delete
fill rect 30,900 to 400,940
end def