The program uses the 'critical path' method, with the 'activity on node' mode.
A project plan is 'drawn' on the screen, the screen highlighting a part of a large worksheet.
For further info, use the 'help' button in the app,
for theory behind networkplanning : internet.
This version has limited capabilities. Functions that i may (or may not) incorporate in future
versions are:
- mapping of time schedule on a calendar
- a 'printable' project report (to file)
- a Gannt chart output on screen, perhaps 'printable' to file
- resources and resource loading (but no resource levelling)
- real-time monitoring of a project
and perhaps other features that come up.
As i'm not a dropbox user, i will upload one example project file wich must be placed in the directory where the program resides. For filename i suggest "itproject.prj". It can be loaded under the given name using the menu. the extension ".prj" is mandatory.
Code: Select all
' PERT planner/monitor, version 0.2, april 2014
' by Henk Overtoom
'
' kalender mapping
' Gannt chart
' printable overzicht
' real-time monitor
' check calc en save flag plaatsen
' bij saven : check of new of load project (moet kunnen saven)
'
option base 1
maxbox=50 ! dim box(maxbox,9) ! nbox=0
maxlink=2*maxbox ! dim link(maxlink,3) ! nlink=0
dim task$(maxbox,2)
gosub init_prog ! menu() ! calc()
loop: ! task=muis()
if task=1 then disp_descr(hit_box(xo,yo))
if task=2 then task_data(hit_box(xo,yo)) ' add/edit/del task
if task=3 then
hit1=hit_box(xo,yo) ! hit2=hit_box(xe,ye)
if not hit1 then ' drag screen
trans(xe-xo,ye-yo) ! refresh()
end if
if hit1 and (hit1=hit2 or not hit2) then ' drag task
box(hit1,2)+=(xe-xo) ! box(hit1,3)+=(ye-yo)
refresh()
end if
if hit1 and hit2 and hit1<>hit2 then ' predecessor link
if nlink=0 then labmain1
k=hit_link(hit2,hit1)
if k then ' edit/delete existing link
link_data(k)
else ' add a new link
labmain1:
lnr=add_link(hit2,hit1)
if lnr then ! refresh() ! cflag=1 ! end if
end if
end if
end if
if cflag and calc_flag then calc()
goto loop
end
init_prog:
option angle degrees
graphics ! graphics clear .8,.8,.8
draw color 0,0,0 ! fill color .8,.8,.8
lw=screen_width() ! lh=screen_height()
gw=3000 ! gh=3000
box_x=160 ! box_y=80 ! bx2=.box_x/2 ! by2=.box_y/2
xs=0 ! ys=0
proj_file$="file name" ! proj_name$="project name"
proj_start=0 ! proj_otime=0 ! cflag=0 ! sflag=0
button "menu" title "menu" at 20,20 size 60,40
button "help" title "help" at 100,20 size 60,40
button "calc" title "calculate" at 180,20 size 100,40
draw font size 14 ! draw color 0,0,1
draw text "auto-calc auto-save snap to grid" at lw-295,12
draw font size 20 ! draw color 0,0,0
switch "calc" state 1 at lw-280,30 ! calc_flag=1
switch "save" state 0 at lw-180,30 ! save_flag=0
switch "grid" state 1 at lw-80,30 ! grid_flag=1
return
def menu()
xt=.lw/2-150 ! yt=.lh/2-100
w_open("main menu",xt,yt,xt+300,yt+200)
button "npro" title "new/change project" at xt+10,yt+40 size 160,30
button "load" title "load project" at xt+10,yt+80 size 160,30
button "save" title "save project" at xt+10,yt+120 size 160,30
button "oke" title "close" at xt+230,yt+160 size 60,30
labmenu1:
if but("npro") then
w1_delete(xt,yt)
w_open("new/change project",xt,yt,xt+300,yt+240)
field "fname" text .proj_file$ at xt+10,yt+40 size 160,30
field "pname" text .proj_name$ at xt+10,yt+80 size 280,30
draw text "project start" at xt+10,yt+124
field "start" text .proj_start at xt+180,yt+120 size 110,30
draw text "def.overtime %" at xt+10,yt+164
field "otime" text .proj_otime at xt+180,yt+160 size 110,30
button "oke" title "ok" at xt+230,yt+200 size 60,30
labmenu2:
if fc("start") or fc("otime") then cc=1 else cc=0
cflag=cc
if fc("fname") or fc("pname") or cc then sflag=1
.proj_file$=field_text$("fname")
.proj_name$=field_text$("pname")
.proj_start=val(field_text$("start"))
.proj_otime=val(field_text$("otime"))
if not but("oke") then labmenu2
w2_delete(xt,yt) ! sflag=1 ! cflag=1 ! return
end if
if but("load") then
labmenu3: loaded=0
field "pf" text "filename?" at xt+50,yt+250 size 160,30
wait: if not field_changed("pf") then wait
pfile$=field_text$("pf") ! f$=pfile$ & ".prj"
if not file_exists(f$) then labmenu3
field "pf" delete ! .proj_file$=pfile$ ! loaded=1
file f$ input .proj_name$
file f$ input .proj_start,.proj_otime
file f$ input .xs,.ys,.nbox,.nlink
if .nbox then
for i=1 to .nbox ! for j=1 to 8
if j<3 then file f$ input .task$(i,j)
file f$ input .box(i,j)
next j ! next i
end if
if .nlink then
for i=1 to .nlink ! for j=1 to 3
file f$ input .link(i,j)
next j ! next i
end if
goto labmenu4
end if
if but("save") and .proj_file$>"" then
f$=.proj_file$ & ".prj"
if file_exists(f$) then file f$ delete
file f$ print """" & .proj_name$ & """"
file f$ print .proj_start,.proj_otime
file f$ print .xs,.ys,.nbox,.nlink
if .nbox then
for i=1 to .nbox ! for j=1 to 8
if j<3 then file f$ print """" & .task$(i,j) & """"
file f$ print .box(i,j)
next j ! next i
end if
if .nlink then
for i=1 to .nlink ! for j=1 to 3
file f$ print .link(i,j)
next j ! next i
end if
goto labmenu4
end if
if not but("oke") then labmenu1
labmenu4: w1_delete(xt,yt)
if loaded then .cflag=1
end def
def disp_descr(ti)
if ti=0 then return else flag=0
xo=x2l(.box(ti,2)) ! yo=y2l(.box(ti,3))
sprite "descr" scan xo-2,yo-2,300,40
loopdes: get touch 0 as x,y
if x>=0 then
draw text .task$(ti,2) at xo,yo-40
flag=1 ! goto loopdes
end if
if not flag then loopdes
sprite "descr" at xo-2,yo-2 ! sprite "descr" stamp
sprite "descr" delete
end def
def task_data(ti)
if ti=0 then
if .nbox=.maxbox then return
.nbox+=1 ! ti=.nbox ! tio=0
.box(ti,2)=x2g(.xo-.bx2) ! .box(ti,3)=y2g(.yo-.by2)
d1$="" ! d2$="" ! d3$="" ! d4$="0" ! d5$="0"
else
d1$=.task$(ti,1) ! d2$=.task$(ti,2) ! tio=ti
d3$=.box(ti,4) ! d4$=.box(ti,5) ! d5$=.box(ti,6)
end if
xt=.lw/2-200 ! yt=.lh/2-300 ! x1=xt+10 ! ot=.box(ti,6) ! ret=0
d6$=u2t$(.box(ti,7),ot) ! d7$=u2t$(.box(ti,8),ot)
d8$=u2t$(.box(ti,7)+.box(ti,4),ot)
d9$=u2t$(.box(ti,8)+.box(ti,4),ot)
d10$=u2t$(.box(ti,9),ot)
w_open("task data",xt,yt,xt+400,yt+480)
draw text "task id. :" at x1,yt+40
draw text "description:" at x1,yt+80
draw text "duration :" at x1,yt+120
draw text "not before :" at x1,yt+160
draw text "overtime % :" at x1,yt+200
draw text "earliest start : "& d6$ at x1,yt+240
draw text "latest start : "& d7$ at x1,yt+280
draw text "earliest end : "& d8$ at x1,yt+320
draw text "latest end : "& d9$ at x1,yt+360
draw text "slack time : "& d10$ at x1,yt+400
field "short" text d1$ at xt+160,yt+35 size 160,30
field "desc" text d2$ at xt+160,yt+75 size 230,30
field "dur" text d3$ at xt+160,yt+115 size 120,30
field "gstart" text d4$ at xt+160,yt+155 size 120,30
field "otime" text d5$ at xt+160,yt+195 size 120,30
if tio then
button "del" title "delete task" at xt+10,yt+440 size 160,30
end if
button "canc" title "cancel" at xt+200,yt+440 size 80,30
button "oke" title "ok" at xt+300,yt+440 size 80,30
do
if but("canc") then ! ret=1 ! goto labnw ! end if
if but("del") then ! task_del(tio) ! ret=1 ! goto labnw ! end if
until button_pressed("oke")
.task$(ti,1)=field_text$("short")
.task$(ti,2)=field_text$("desc")
.box(ti,6)=val(field_text$("otime"))
if fc("dur") then
.box(ti,4)=t2u(field_text$("dur"),.box(ti,6)) ! .cflag=1
end if
if fc("gstart") then
.box(ti,5)=val(field_text$("gstart")) ! .cflag=1
end if
labnw:
graphics lock ! w3_delete(xt,yt) ! refresh() ! graphics unlock
if ret then return
disp_box(ti)
end def
def task_del(ti)
dim lt(.maxlink) ! nsuc=0
for i=1 to .nlink
if .link(i,2)=ti then ! nsuc+=1 ! lt(nsuc)=.link(i,1) ! end if
next i
if nsuc then
for k=1 to nsuc
for i=1 to .nlink
if .link(i,1)=ti then
.nlink+=1 ! .link(.nlink,3)=.link(i,3)
.link(.nlink,1)=lt(k) ! .link(.nlink,2)=.link(i,2)
end if
next i
next k
end if
if .nlink=0 then labdel1
for i=1 to .nlink
if .link(i,1)=ti or .link(i,2)=ti then
for k=i+1 to .nlink
for j=1 to 3 ! .link(k-1,j)=.link(k,j) ! next j
next k ! i-=1 ! .nlink-=1
end if
next i
labdel1:
if .nbox>1 and ti<.nbox then
for i=ti+1 to .nbox ! for j=1 to 9
.box(i-1,j)=.box(i,j)
if j<3 then .task$(i-1,j)=.task$(i,j)
next j ! next i
end if
for j=1 to 9 ! .box(.nbox,j)=0 ! next j
.task$(.nbox,1)="" ! .task$(.nbox,2)=""
.nbox-=1
for i=1 to .nlink ! for j=1 to 2
if .link(i,j)>ti then .link(i,j)-=1
next j ! next i
sflag=1 ! cflag=1
end def
def link_data(k)
suc=.link(k,1) ! pred=.link(k,2) ! lag$=u2t$(.link(k,3),0)
xt=.lw/2-180 ! yt=.lh/2-80 ! ret=0
w_open("predecessor link",xt,yt,xt+360,yt+190)
draw text "sucessor : " & .task$(suc,1) at xt+10,yt+40
draw text "predecessor : " & .task$(pred,1) at xt+10,yt+70
draw text "lag time : " at xt+10,yt+110
field "lag" text lag$ at xt+180,yt+105 size 110,30
button "del" title "delete link" at xt+10,yt+150 size 120,30
button "oke" title "ok" at xt+270,yt+150 size 80,30
lablink1:
if fc("lag") then
.link(k,3)=t2u(field_text$("lag"),0) ! .cflag=1
end if
if but("del") then ! del_link(k) ! goto lablink2 ! end if
if but("oke") then lablink2
goto lablink1
lablink2: w4_delete(xt,yt) ! refresh()
end def
def add_link(suc,pred)
if .nlink=.maxlink then ! add_link=0 ! return ! end if
.nlink+=1 ! .link(.nlink,1)=suc ! .link(.nlink,2)=pred
.calc=1 ! add_link=.nlink
end def
def draw_link(lnr)
draw size 1 ! bo=.link(lnr,2) ! be=.link(lnr,1)
if .box(bo,9)=0 and .box(be,9)=0 then
draw size 2 ! draw color 1,0,0
end if
if .link(lnr,3) then ! draw dash 5 ! draw size 2 ! end if
xo=x2l(.box(bo,2))+.box_x ! yo=y2l(.box(bo,3))+.by2
xe=x2l(.box(be,2)) ! ye=y2l(.box(be,3))+.by2
draw line xo,yo to xe,ye
draw color 0,0,0 ! draw size 1 ! draw dash 0
end def
def hit_link(hit2,hit1)
hit_link=0
for i=1 to .nlink
if hit2=.link(i,1) and hit1=.link(i,2) then
hit_link=i ! break
end if
next i
end def
def del_link(k)
if .nlink=0 then return else .cflag=1
for i=k+1 to .nlink ! for j=1 to 3
.link(i-1,j)=.link(i,j)
next j ! next i ! .nlink-=1
end def
def disp_box(i)
x=x2l(.box(i,2)) ! y=y2l(.box(i,3)) ! draw size 2
fill rect x,y to x+.box_x,y+.box_y
draw rect x,y to x+.box_x,y+.box_y ! y1=y+.box_y-22
draw line x,y+20 to x+.box_x,y+20 ! draw size 1
draw line x,y1 to x+.box_x,y1
x1=x+.box_x/2 ! draw line x1,y1 to x1,y+.box_y
draw font size 18 !
if .box(i,9)=0 then draw color 1,0,0 else draw color 0,0,.8
w$=.task$(i,1) ! if len(w$)>14 then w$=left$(w$,14)
draw text w$ at x+5,y
draw font size 15 ! draw color 0,0,0
draw text pr$(.box(i,7)) at x+3,y1+3
draw text pr$(.box(i,4)) at x1+3,y1+3
draw text "slip : " & pr$(.box(i,9)) at x+3,y1-18
draw font size 20
end def
def pr$(tt)
w$=u2t$(floor(10*tt)/10,0)
if len(w$)>8 then w$=left$(w$,8)
pr$=w$
end def
def refresh()
graphics lock ! graphics clear .8,.8,.8
for i=1 to .nlink ! draw_link(i) ! next i
for i=1 to .nbox
xo=x2l(.box(i,2)) ! xe=xo+.box_x
yo=y2l(.box(i,3)) ! ye=yo+.box_y
if xo>.lw or xe<0 or yo>.lh or ye<0 then
.box(i,1)=0 ! continue
end if
.box(i,1)=1 ! disp_box(i)
next i
draw font size 14 ! draw color 0,0,1
draw text "auto-calc auto-save snap to grid" at .lw-295,12
draw font size 20 ! draw color 0,0,0
graphics unlock
end def
def hit_box(x,y)
hit_box=0 ! if .nbox=0 then return
for i=1 to .nbox
xo=x2l(.box(i,2)) ! xe=xo+.box_x
yo=y2l(.box(i,3)) ! ye=yo+.box_y
if x>xo and x<xe and y>yo and y<ye then
hit_box=i ! break
end if
next i
end def
def x2g(x)=x+.xs ! def y2g(y)=y+.ys
def x2l(x)=x-.xs ! def y2l(y)=y-.ys
def trans(dx,dy)
.xs-=dx ! .xs=max(.xs,0) ! .xs=min(.xs,.gw-.lw)
.ys-=dy ! .ys=max(.ys,0) ! .ys=min(.ys,.gh-.lh)
end def
def muis()
muis=0
if switch_changed("calc") then .calc_flag=switch_state("calc")
if switch_changed("save") then
.save_flag=switch_state("save") ! return
end if
if switch_changed("grid") then
.grid_flag=switch_state("grid") ! return
end if
lab1: get touch 0 as .xo,.yo
if but("menu") then ! menu() ! return ! end if
if but("help") then ! intro() ! return ! end if
if but("calc") or (cflag and .calc_flag) then
calc() ! return
end if
if .xo=-1 then lab1 else pause .1
if .grid_flag then ! .xo=snap(.xo) ! .yo=snap(.yo) ! end if
lab2: get touch 0 as x,y
if x>=0 then
if abs(x-.xo)>8 or abs(y-.yo)>8 then
sleep=1 ! .xe=x ! .ye=y
end if
if .grid_flag then ! .xe=snap(x) ! .ye=snap(y) ! end if
goto lab2
end if
if sleep then ! sleep=0 ! muis=3 ! return ! end if
timer reset
lab3: get touch 0 as x,y
if x>=0 then ! muis=2 ! return ! end if
if timer()<300 then lab3
muis=1 ! return
end def
def calc()
if .nbox=0 then return
dim ee(.nbox),le(.nbox)
pred_sort(.nlink,.link,1) ! proj_end=0 ! .cflag=0
for i=1 to .nbox
.box(i,7)=max(.proj_start,.box(i,5))
ee(i)=.box(i,7)+.box(i,4) ! proj_end=max(proj_end,ee(i))
next i
if .nlink then
for i=1 to .nlink
suc=.link(i,1) ! pred=.link(i,2) ! lag=.link(i,3)
.box(suc,7)=max(.box(suc,7),ee(pred)+lag)
ee(suc)=.box(suc,7)+.box(suc,4)
proj_end=max(proj_end,ee(suc))
next i
end if
pred_sort(.nlink,.link,2)
for i=1 to .nbox
le(i)=proj_end ! .box(i,8)=le(i)-.box(i,4)
.box(i,9)=.box(i,8)-.box(i,7)
next i
if .nlink then
for i=1 to .nlink
suc=.link(i,1) ! pred=.link(i,2) ! lag=.link(i,3)
le(pred)=min(le(pred),.box(suc,8)-lag)
.box(pred,8)=le(pred)-.box(pred,4)
.box(pred,9)=.box(pred,8)-.box(pred,7)
next i
end if
refresh()
end def
def pred_sort(nl,pa(,),d)
if nl<2 then return
if d=1 then ! k1=2 ! k2=1 ! else ! k1=1 ! k2=2 ! end if
for i=1 to nl
labpr:
for j=i+1 to nl
if pa(i,k1)=pa(j,k2) then
for k=1 to 3
temp=pa(i,k) ! pa(i,k)=pa(j,k) ! pa(j,k)=temp
next k
goto labpr
end if
next j
next i
end def
def t2u(t$,ot)
ot=min(ot,200)
lt=len(t$) ! t=0 ! fac8_24=8+.08*ot
u=val(t$) ! if u<0 then tek=-1 else tek=1 ! u*=tek
pos=instr(t$,"d")
if pos>=0 then
t+=fac8_24*u
t$=right$(t$,lt-pos)
u=val(t$) ! lt=len(t$)
end if
pos=instr(t$,"h")
if pos>=0 then
t+=u
t$=right$(t$,lt-pos)
u=val(t$)
end if
pos=instr(t$,"m")
if pos>=0 then t+=u/60
if t=0 then t=u
t*=tek ! t2u=t
end def
def u2t$(u,ot)
ot=min(ot,200)
if u<0 then tek=-1 else tek=1 ! u*=tek
fac8_24=8+.08*ot
f=u/fac8_24 ! d=floor(f) ! r=u-d*fac8_24
h=floor(r) ! m=60*(r-h)
if tek<0 then t$="-" else t$=""
if d then t$=t$ & d & "d"
if h then t$=t$ & h & "h"
if m then t$=t$ & m & "m"
if len(t$)=0 then u2t$="0" else u2t$=t$
end def
def w_open(title$,xtop,ytop,xbot,ybot)
wid=xbot-xtop ! hgt=ybot-ytop
sprite "task" scan xtop-2,ytop-2,wid+4,hgt+4
r=10 ! draw size 4 ! fs=font_size()
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
if title$<>"" then
l=(xbot-xtop-.6*fs*len(title$))/2
draw line xtop,ytop+24 to xbot,ytop+24
draw color 0,0,1
draw text title$ at xtop+l,ytop+60/fs
draw color 0,0,0
end if
graphics unlock
end def
def w1_delete(x,y)
button "npro" delete ! button "load" delete
button "save" delete ! button "oke" delete
sprite "task" at x-2,y-2 ! sprite "task" stamp
sprite "task" delete
end def
def w2_delete(x,y)
field "fname" delete ! field "pname" delete
field "start" delete ! field "otime" delete
button "oke" delete
sprite "task" at x-2,y-2 ! sprite "task" stamp
sprite "task" delete
end def
def w3_delete(x,y)
field "short" delete ! field "desc" delete
field "dur" delete ! field "gstart" delete
field "otime" delete ! button "del" delete
button "canc" delete ! button "oke" delete
sprite "task" at x-2,y-2 ! sprite "task" stamp
sprite "task" delete
end def
def w4_delete(x,y)
field "lag" delete
button "del" delete ! button "oke" delete
sprite "task" at x-2,y-2 ! sprite "task" stamp
sprite "task" delete
end def
def date$() ' gives date as m$-dd-yyyy
dim month$(12) ' (option base 1)
for i=1 to 12 ! read month$(i) ! next i
data "yan","febr","march","april","may","june"
data "july","aug","sept","oct","nov","dec"
yy=current_year()
mm=current_month()
dd=current_date()
date$=month$(mm) & "-" & dd & "-" & yy
end def
def snap(x) = 20*int(x/20)
def but(a$) = button_pressed(a$)
def fc(a$) = field_changed(a$)
def intro()
w_open("Short manual networkplanning",50,100,.lw-50,.lh-50)
graphics lock
drt("* for theory on networkplanning: search internet")
drt("* this program uses the CPM method, activity-on-node")
drt("* activities are identical to the word 'task'")
drt("* a project plan may be saved and loaded via the menu")
drt("* double-tap on an empty place of the screen to create")
drt.y-=20 ! drt(" a new task on that spot")
drt("* double-tap on an existing task to edit/delete it")
drt("* drag from one task to another to create a new link")
drt("* drag over an existing link to edit/delete that link")
drt("* drag an empty spot on the screen to move the network")
drt("* when the 'auto-calc' switch is on, the network cal-")
drt.y-=20 ! drt(" culation is done whenever needed")
drt("* the earliest possible start of a task is shown")
drt.y-=20 ! drt(" bottom left, the duration bottom right")
drt("* a link with a lag time>0 has a dashed line")
drt("* times are shown in ..d.h.m (day,hour.minute) format,")
drt.y-=20 ! drt(" all calculations are done in hours")
drt("* 'open-ended' networks are treated correctly")
drt("* when a task is deleted, new links are generated to")
drt.y-=20 ! drt(" preserve the network logic")
button "go" title "ok" at .lw/2-50,.lh-110 size 100,40
graphics unlock
labin: if not but("go") then labin
sprite "task" at 48,98 ! sprite "task" stamp
sprite "task" delete ! button "go" delete
drt.y=0
end def
def drt(a$)
if not y then y=150
draw text a$ at 60,y
y+=40
end def
' box-i,1 : yes/no in viewport
' box-i,2 : globale x-coordinaat linkerbovenhoek
' box-i,3 : idem y-coordinaat
' box-i,4 : duration
' box-i,5 : given start (not before ...)
' box-i,6 : overtime %
' box-i,7 : earliest start
' box-i,8 : latest start
' box-i,9 : slack time
' link-i,1 : successor task
' link-i,2 : predecessor task
' link-i,3 : lag
