I don't know what is wrong. Something strange happens.
Anyhow, the version i have on my iPad works normal.
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