Rem Worktime
Rem ¸1994-1995 Erik Johansen, ej@id.dtu.dk

Rem Worktime - Keeps track of projects, meetings and work hours and other
Rem timing tasks. Time how long you spend on meetings, on transport, at dinners.

Rem All of this is done by storing the start and end time of some action.
Rem Then the time difference and for projects the total cost calculated from
Rem the price per hour.

Rem Printouts of selected intervals, optionally grouped by day/week/month

Rem See bottom for user definable project keys

APP WorkTime
	TYPE $1003
	EXT "WTM"
	ICON "\OPD\Worktime.pic"
ENDA

PROC Start:
	global sad&,maxday&,d1970&,d2038&
	global off&,cur&,exists%,lastpro%
	global gcy%,gcmax%,mode$(1)
	global Tsetup&(10),Psetup&(10),Setup$(10,63)
	global PCtext$(50,255),PCdiff&(50),LastPC%
	global bbegin&,bend&,bnorm&,btext$(63)
	global fonttyp%,zoom%,lines%,h%,w%  Rem for zoomming
	global poff&,ppos%,pcur&,pex%,pgcy%,pcount%
	global toff&,tpos%,tcur&,tex%,tgcy%,tcount%
	global d1%,d2%,d3%,d4%,d5%,d6%,d7%,d8%,d9%,d10%,d11%,d12%,d13%,d14%,d15%
	global w1%,w2%,w3%,w4%,w5%,w6%,w7%,w8%,w9%,w10%,w11%,w12%,w13%,w14%,w15%

	Rem  --- Constants ---
	sad&    = 86400 REM Seconds a day (24*60*60)
	maxday& = 86399 REM 23:59:59
	d1970&  = 25567 REM days(1,1,1970)
	d2038&  = 50422 REM days(19,1,2038) Not 100% correct, but closer than a Pentium ;-)
	mode$   = "T"

	diaminit 1,"Time","Project"
	defaultwin 1
	statuswin on,2
	gsetwin 0,0,415,160
	giprint "Worktime is now Shareware",0
	SysReq:(cmd$(3),cmd$(2)) rem open file
	giprint "Press Psion-W for more info",0
	Handler:
ENDP

Rem Record fields (begin&, end&, norm&,total&,text$) have different meanings
Rem depending on the value of begin& :

Rem 0- 99    TSetup&(),PSetup&(),Setup$() values [internal]

Rem    0     Old setup, now unused

Rem          TSetup&(): - Time mode
Rem    1-7   a.end&=Normal hours
Rem    8-9   a.end&=morning/evening slack
Rem    10    a.end&=Font

Rem          PSetup&(): - Project mode
Rem    1-2   a.norm&=Project rounding single
Rem    3-4   a.norm&=Project rounding totals
Rem    5     a.norm&=Automatic project calculation
Rem    10    a.norm&=Font

Rem          Setup$():
Rem    1     a.text$=Print output file
Rem    2     a.text$="LOC::M:\*.WTM" (Not implemented)
Rem    3-10  a.text$=Titles for printout (Not implemented)

Rem 101-999  Projects / indexes

Rem          a.begin&=100+Project number
Rem          a.end&=100 * cost/hour
Rem          a.text$=Project text
Rem          a.norm&=UNUSED
Rem          a.total&=Total time used

Rem 1000-max Time slots

Rem          a.begin&=Meeting time
Rem          a.end&=Leaving time
Rem          a.text$=Project/entry text
Rem          a.norm&=Normal (estimated) time
Rem          a.total&=Accum. time diff


PROC SysReq:(act$,file$) REM For system requests
	SaveFile:
	if     act$="X" :stop             REM Close and Exit
	elseif act$="C" :MkFile:(file$)   REM Create new file
	elseif act$="O" :OpenFile:(file$) REM Open file
	endif
ENDP

PROC SetFont:(fnt&)
	local i%(32),font%,ws%

	Rem Recalculate all font size dependent values

	if fnt&
		fonttyp%=int(fnt&/4)*4+1
		zoom%   =fnt&-fonttyp%
	endif
	if fonttyp%<>5 :fonttyp%=9 :endif
	if zoom%<0 or zoom%>3 :zoom%=0 :endif
	font%=fonttyp%+zoom%
	if mode$="T"
		Tsetup&(10)=font%
	else
		Psetup&(10)=font%
	endif
	gfont font%
	font font%,0
	ginfo i%()
	h%=i%(3) rem Font Height
	rem (4) is descent, (5) is ascent
	w%=i%(6) rem Width of '0' character (average width)
	rem (7) is maximum character width
	lines%=(gheight-8)/h%
	gcmax%=(lines%-1)*h%
	if mode$="T"
		ws%=.5*w%
		w1%=7       :d1%=3.5*w%
		w2%=w1%+d1% :d2%=1.9*w%
		w3%=w2%+d2%+ws% :d3%=3.5*w%
		w4%=w3%+d3%
		w5%=w4%+ws% :d5%=4.5*w%
		w6%=w5%+d5% :d6%=1.5*w%
		w7%=w6%+d6% :d7%=4.5*w%
		w8%=w7%+d7%+ws% :d8%=0.7*w%
		w9%=w8%+d8% :d9%=5.5*w%
		w10%=w9%+d9%+ws%
		w11%=w10%+ws% :d11%=6.5*w%
		w12%=w11%+d11%+ws%
		w14%=gwidth-4
		w13%=w12%+ws% :d13%=w14%-w13%
		off&=Offset&:(cur&,1-lines%) :gcy%=gcmax%
	else
		off&=cur& :gcy%=0
	endif
	Repaint:
ENDP

PROC Handler:
	global a%(6)
	while 1
		onerr Error
		getevent a%()
		@(mode$+hex$(a%(1))):
		continue
		Rem This part is only reached when no corresponding event handler is found.
		Rem Keypresses fall back on either TextED: or RecED:
	Error::
		if err=-99
			onerr Error2
			@("A"+hex$(a%(1))):  Rem shared function
			continue
		endif
	Error2::
		if err=-99 and a%(1)<256
			@(mode$+"Default"):
		else
			ShowErr:(hex$(a%(1)))
		endif
	endwh
ENDP

PROC TDefault:
	if a%(1)>64 rem Textchars
		TextED:
	elseif a%(1)<256 Rem Other
		RecED:
	else
		ShowErr:(hex$(a%(1)))
	endif
ENDP
PROC PDefault:
	if a%(1)<256 Rem typing char
		ProjED:
	else
		ShowErr:(hex$(a%(1)))
	endif
ENDP

PROC MkFile:(reqfile$)
	local file$(128),o%(6)
	o%(1)=1 :o%(2)=6 :o%(3)=8 :o%(4)=8 :o%(5)=10 :o%(6)=0
	file$=parse$(reqfile$,"LOC::M:\*.WTM",o%())
	trap create file$,A,begin&,end&,norm&,total&,text$
	if err
		setname "-none-"
		ShowErr:("Cannot create '"+file$+"'")
		A26d: Rem file requester
		return
	endif
	setname file$
	Defaults:
	SaveSet:
	cur&=Early&:(Now&:) :off&=cur&-lines%*sad& :gcy%=gcmax% :exists%=0
	SetFont:(Tsetup&(10))
ENDP

PROC Defaults:
	Tsetup&(1)=28800 REM 08:00:00 = 8*60*60 / Mon
	Tsetup&(2)=28800 REM 08:00:00 = 8*60*60 / Tue
	Tsetup&(3)=28800 REM 08:00:00 = 8*60*60 / Wed
	Tsetup&(4)=28800 REM 08:00:00 = 8*60*60 / Thu
	Tsetup&(5)=18000 REM 05:00:00 = 5*60*60 / Fri
	Tsetup&(6)=0 rem Sat
	Tsetup&(7)=0 rem Sun
	Tsetup&(8)=0 rem Morning slack
	Tsetup&(9)=0 rem Evening slack
	Tsetup&(10)=9
	Psetup&(1)=0
	Psetup&(2)=0
	Psetup&(3)=0
	Psetup&(4)=0
	Psetup&(5)=0
	Psetup&(10)=9
ENDP

PROC OpenFile:(file$)
	local n%,sp%,set$(255),v$(10),sep$(1)
	trap open file$,A,begin&,end&,norm&,total&,text$
	if err
		setname "-none-"
		ShowErr:("Cannot open '"+file$+"'")
		A26f: Rem File requester
		return
	endif
	setname file$

	Rem Comment string from first entry holds all the setup values.
	Rem Extract and save as Tsetup&(1-10)

	if a.begin&>15
		giprint "Whoa! Resorting needed!" :Sort: :first
		giprint "OK, lets see how it looks now"
	endif
	if a.begin&
		while a.begin&<11 and not eof Rem increase num along with no of setup records
			Tsetup&(a.begin&)=a.End&
			Psetup&(a.begin&)=a.Norm&
			Setup$(a.begin&)=a.Text$
			next
		endwh
	else
		Rem All of this is for converting to new format
		giprint "Converting to new file format"
		busy "Converting"
		set$=a.text$
		Rem old setup overrides all setup records and projects !
		first :while not eof and a.begin&<=99 :erase :endwh
		Rem Decide on what seperator was used
		Rem for packing the setup values.
		if loc(set$,chr$(13)) :sep$=chr$(13) :else :sep$=" " :endif
		Defaults:
		n%=1 :sp%=loc(set$,sep$)
		while sp%>0 and n%<=10
			Tsetup&(n%)=val(left$(set$,sp%-1))
			a.begin&=n%
			a.end&=Tsetup&(n%)
			a.norm&=Psetup&(n%)
			a.text$=Setup$(n%)
			append
			if sp%>=len(set$) :break :endif
			set$=right$(set$,len(set$)-sp%)
			n%=n%+1 :sp%=loc(set$,sep$)
		endwh
		if sp%
			set$=left$(set$,sp%-1)+","
			n%=101 :sp%=loc(set$,",")
			while sp%>0
				a.begin&=n%
				a.end&=0
				a.norm&=0
				a.total&=0
				a.text$=left$(set$,sp%-1)
				if a.text$<>"11" :append :endif
				if sp%>=len(set$) :break :endif
				set$=right$(set$,len(set$)-sp%)
				n%=n%+1 :sp%=loc(set$,",")
			endwh
		endif
		busy "Rewriting base"
		first :while a.begin&>999 and not eof :update :giprint num$(a.begin&,15),0 :first :endwh
		busy off
	endif
	if mode$="P" :MovTo:(&101,0) :else :MovTo:(datetosecs(year,month,day,23,59,59),0) :endif
	SetFont:(Tsetup&(10))
ENDP

PROC ShowErr:(txt$)
	dinit
	dtext "",txt$,$400
	dtext "",err$(err),$600
	dtext ""," "
	dbuttons "Exit program",%x,"Continue",-13
	lock on
	if dialog=%x :stop :endif
	lock off
ENDP

PROC Repaint:
	ggrey 2 :gcls
	@(mode$+"Paint"):(off&,lines%)
	Cursor:
ENDP

PROC Cursor:
	gat 1,gcy%+4
	if mode$="T" :ginvert w12%,h% :else :ginvert 400,h% :endif
ENDP

PROC Paint:(from&,l%)
	@(mode$+"Paint"):(from&,l%)
ENDP

PROC TPaint:(from&,l%)
	local y%,dy%,lin%,ay%
	local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
	local oldcur&,oldpos%,oldex%,oldcurd&
	oldpos%=pos :oldcur&=cur& :oldex%=exists%
	gborder $203
	
	TMovTo:(off&,0)
	y%=TMovCnt%:(from&,0)*h%
	dy%  = h%*l%
	ggrey 1
	gat   w4%,y%+4 :glineby 0,dy%
	gat   w8%,y%+4 :glineby 0,dy%
	gat  w10%,y%+4 :glineby 0,dy%
	gat  w12%,y%+4 :glineby 0,dy%
	lin%=l%
	while (lin%>0)
		if cur&=oldcur& :gcy%=y% :endif
		secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
		wd% = dow(da%,mo%,yr%)
		ggrey 1 :gat 1,y%+4
		if wd%=6 or wd%=7
			gfill w12%,h%,0
		else
			glineby w12%,0
		endif
		ggrey 0
		ay%=y%+3+h%
		gat w1%,ay% :gprintb dayname$(wd%),d1%
		gat w2%,ay% :gprintb num$(da%,2),d2%,1
		gat w3%,ay% :gprintb month$(mo%),d3%
		if exists%
			gat w5%,ay% :gprintb Time$:(cur&,0,0),d5%,1
			gat w6%,ay% :gprintb "-",d6%,3
			if a.end&
				gat  w7%,ay% :gprintb Time$:(a.end&,0,0),d7%,1
				gat  w9%,ay% :gprintb Time$:(Use&:,1,0),d9%,1
				gat w11%,ay% :gprintb Time$:(RoundT&:(a.total&),1,0),d11%,1
			endif
			gat w13%,ay% :gprintb a.text$,d13%
		endif
		TMovRel:(1,0)
		y% = y%+h% :lin%=lin%-1
	endwh
	ggrey 1 :gat 1,y%+4 :glineby w13%,0 :ggrey 0
	position oldpos% :cur&=oldcur& :exists%=oldex%
ENDP

PROC PPaint:(from&,l%)
	local y%,dy%,lin%
	local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
	local oldcur&,oldpos%,oldex%,oldcurd&
	oldpos%=pos :oldcur&=cur& :oldex%=exists%
	gborder $203
	y%=(from&-off&)*h%
	PMovTo:(from&,0)
	dy%  = h%*l%
	ggrey 1
	gat  40,y%+4 :glineby 0,dy%
	gat 190,y%+4 :glineby 0,dy%
	gat 250,y%+4 :glineby 0,dy%
	gat 310,y%+4 :glineby 0,dy%
	lin%=l%
	while (lin%>0)
		if cur&=oldcur& :gcy%=y% :endif
		ggrey 1 :gat 1,y%+4 :glineby 400,0
		ggrey 0
		gat 7,y%+3
		gmove 0,h% :gprintb num$(cur&-100,-3),25,1
		if exists%
			gmove 40,0 :gprintb a.text$,140
			gmove 150,0 :gprintb fix$(a.end&/100.0,2,8),50,1
			gmove  50,0 :gprintb Time$:(RoundT&:(a.total&),1,0),55,1
			gmove  70,0 :gprintb fix$(RoundT&:(a.total&)/3600.0*a.end&/100.0,2,8),40,1
rem			gmove 60,0 :gprintb Time$:(a.norm&,1,0),45,1
		endif
		PMovRel:(1,0)
		y% = y%+h% :lin%=lin%-1
	endwh
	ggrey 1 :gat 1,y%+4 :glineby 400,0 :ggrey 0
	position oldpos% :cur&=oldcur& :exists%=oldex%
ENDP

PROC num2$:(n%)
	if n%<10 :return "0"+num$(n%,5) :else :return num$(n%,5) :endif
ENDP

PROC Time$:(t&,sign%,secs%)
	local res$(30),yr%,mo%,da%,ho%,mi%,se%,yrd%
	secstodate abs(t&),yr%,mo%,da%,ho%,mi%,se%,yrd%
	if yr%<1972 :ho%=abs(t&)/3600 :endif
	if t&<0      :res$=res$+"-"
	elseif sign% :res$=res$+"+"
	else         :res$=res$+" "
	endif
	res$=res$+num2$:(ho%)+":"+num2$:(mi%)
	if secs% :res$=res$+":"+num2$:(se%) :endif
	return res$
ENDP

PROC RecED:
	local m&,l&,n&,c$(63),morn&,even&
	local yr%,mo%,dy%,hr%,mn%,sc%,yd%,wd%
	local ret%,new$(13)
	morn& = Early&:(cur&)
	secstodate cur&,yr%,mo%,dy%,hr%,mn%,sc%,yd%
	wd%=dow(dy%,mo%,yr%)
	Rem See if an entry already exists
	if exists%
		m&=cur&-morn&
		l&=a.end&
		if l& :l&=l&-morn& :endif
		n&=a.norm&
		c$=a.text$
		PAdd:(c$,-Use&:)
		new$=""
	else
		Rem Fill in Defaults
		m&=8*60*60
		n&=Tsetup&(wd%)
		l&=m&+n&
		new$="  (new entry)"
	endif
	Rem   Display edit dialog
	dinit dayname$(wd%)+" "+num$(dy%,2)+" "+month$(mo%)+" "+num$(yr%,4)+new$
	dtime m&,"Begin",1,0,maxday&
	dtime l&,"End",1,0,maxday&
	dtext "Worktime",Time$:(l&-m&,0,1),0
	dtime n&,"Normal time",0,0,maxday&
	dtext "Todays diff",Time$:(RoundS&:(l&-m&-n&),1,1)+" ("+Time$:(l&-m&-n&,1,1)+")",0
	dtext "Total diff",Time$:(RoundT&:(a.total&),1,1)+" ("+Time$:(a.total&,1,1)+")",0
	dedit c$,"Comment",63
	lock on :ret% = dialog :lock off
	if ret%
		a.begin&=m&+morn&
		if l& :l&=l&+morn& :if m&>l& :l&=l&+sad& :endif :endif
		a.end&=l&
		a.norm&=n&
		a.text$=c$
		Insert:(exists%)
	endif
	PAdd:(c$,Use&:)
ENDP

PROC ProjED:
	local cost,proj$(63)
	local ret%,new$(13)
	local tot&,rtot&,norm&
	Rem See if an entry already exists
	if exists%
		proj$=a.text$
		cost=a.end&/100.0
		norm&=a.norm&
		tot&=a.total&
		dinit "Project "+num$(cur&-100,3)
	else
		dinit "Project "+num$(cur&-100,3)+" (New project)"
		proj$=""
		cost=0
		tot&=0
		norm&=0
	endif
	rtot&=RoundT&:(tot&)
	dedit proj$,"Project",20
	Rem   Display edit dialog
	dfloat cost,"Cost/hour",0,999999
	dtext "Time spent on project",Time$:(rtot&,1,1)+" ("+Time$:(tot&,1,1)+")",0
	dtext "Total cost",fix$(cost*rtot&/3600.0,2,10)+" ("+fix$(cost*tot&/3600.0,2,10)+")",0
	lock on :ret% = dialog :lock off
	if ret%
		a.begin&=cur&
		a.text$=proj$
		a.end&=cost*100
		a.norm&=norm&
		a.total&=tot&
		Insert:(exists%)
	endif
ENDP

PROC RoundS&:(tim&) Rem Round single timing entry
	if PSetup&(1)<2 or PSetup&(2)=0 Rem No rounding
		return tim&
	elseif PSetup&(1)=2 Rem UP
		return int(.9999+tim&*1.0/PSetup&(2))*PSetup&(2)
	elseif PSetup&(1)=3 Rem Down
		return int(tim&/PSetup&(2))*PSetup&(2)
	elseif PSetup&(1)=4 Rem Nearest
		return int(.5+tim&*1.0/PSetup&(2))*PSetup&(2)
	endif
ENDP

PROC RoundT&:(tim&) Rem Round Total times
	if PSetup&(3)<2 or PSetup&(4)=0 Rem No rounding
		return tim&
	elseif PSetup&(3)=2 Rem UP
		return int(.9999+tim&*1.0/PSetup&(4))*PSetup&(4)
	elseif PSetup&(3)=3 Rem Down
		return int(tim&/PSetup&(4))*PSetup&(4)
	elseif PSetup&(3)=4 Rem Nearest
		return int(.5+tim&*1.0/PSetup&(4))*PSetup&(4)
	endif
ENDP

PROC TextED:
	local c$(63), ret%
	if exists%
		c$=a.text$
	else
		a.begin&=Early&:(cur&)+Now&:-Early&:(Now&:)
		a.norm&=0
		a.end&=0
		c$=chr$(a%(1))
	endif
	dinit "Comment"
	dedit c$,"",63
	REM So how do I position the cursor to the end of the 'dedit' string ?
	REM If you have an idea please tell me...
	lock on :ret% = dialog :lock off
	if ret%
		a.text$=c$
		Insert:(exists%)
	endif
ENDP

PROC SaveFile:
	PCflush:
	trap close
	if err<>0 and err<>-102
		ShowErr:("Error closing file")
	endif
ENDP

PROC PaintCur:
	Cursor:
	@(mode$+"Paint"):(cur&,1)
	Cursor:
ENDP

Rem current entry is always the one just less than or eual to cur&
Rem exists% tells if rec really exists

PROC MovCurs:(d%)
	local rd%
	if abs(d%)>lines%
		if d%>0
			off&=Offset&:(cur&,1-lines%) :gcy%=gcmax%
		else
			off&=cur& :gcy%=0
		endif
		Repaint:
		return
	endif
	Cursor:
	gcy%=gcy%+d%*h%
	if gcy%<0  rem Move UP (scrolls down)
		rd% = gcy%/h%
		off&=cur&
		ggrey 2 :gscroll 0,-rd%*h%,1,4,411,gcmax% :ggrey 0
		@(mode$+"Paint"):(off&,-rd%)
		gcy% = 0
	elseif gcy%>gcmax%  rem Move DOWN (scrolls up)
		rd% = (gcy%-gcmax%)/h%
		off& = Offset&:(off&,rd%)
		ggrey 2 :gscroll 0,-rd%*h%,1,4+h%,411,gcmax% :ggrey 0
		@(mode$+"Paint"):(Offset&:(off&,lines%-rd%),rd%)
		gcy%=gcmax%
	endif
	Cursor:
ENDP

Rem Move to Entry specified as time&
Rem cur& will point to
Rem 1) Entry, if exists
Rem 2) Prev entry same day, if any
Rem 3) Following entry same day, if any
Rem 4) Start of day (exists%=0)

PROC MovTo:(time&,show%)
 @(mode$+"MovTo"):(time&,show%)
ENDP

PROC PMovTo:(pnum&,show%)
	local origcur&,lin%
	origcur&=cur&
	cur&=pnum&
	while a.begin&<pnum& and not eof :next :endwh
	if eof :back :endif
	while a.begin&>pnum& and not eof :back :endwh
	exists%=a.begin&=cur&
	if show% :lin%=cur&-origcur& :MovCurs:(lin%) :endif
ENDP

PROC TMovTo:(time&,show%)
	local day&,lin%,d&
	d&=int(time&/sad&)-int(cur&/sad&)
	if abs(d&)<50 and show%
		lin%=d&
		while a.begin&<time& and not eof
			next
			if int(a.begin&/sad&)=int(cur&/sad&) :lin%=lin%+1 :endif
			cur&=a.begin&
		endwh
		if eof :back :endif
		while a.begin&>time& and not eof
			back
			if int(a.begin&/sad&)=int(cur&/sad&) :lin%=lin%-1 :endif
			cur&=a.begin&
		endwh
	else
		REM - Fast seek
		if time&>cur& :lin%=50 :else :lin%=-50 :endif
		while a.begin&<time& and not eof :next :endwh
		if eof :back :endif
		while a.begin&>time& and not eof :back :endwh
	endif
	day&=Early&:(time&)
	exists%=1 Rem High probability
	if a.begin&=time&
		cur&=time&
	elseif a.begin&>=day& and a.begin&<day&+sad&
		cur&=a.begin&
	else
		next
		if not eof and a.begin&>=day& and a.begin&<day&+sad&
			cur&=a.begin&
		else
			back :cur&=day& :exists%=0
		endif
	endif
	if show% :MovCurs:(lin%) :endif
ENDP


PROC MovRel:(lin%,show%)
 @(mode$+"MovRel"):(lin%,show%)
ENDP

PROC PMovRel:(lines%,show%)
	local new&
	new&=max(min(cur&+lines%,999),101)
	PMovTo:(new&,show%)
ENDP

PROC TMovRel:(lin%,show%)
	local l%,day&
	l%=lin%
	while l%<0 Rem go back
		if exists% :back :endif
		day&=Early&:(cur&)-sad& Rem Yesterday
		if a.begin&<day&
			cur&=day& :exists%=0
		else
			cur&=a.begin& :exists%=1
		endif
		l%=l%+1
	endwh
	while l%>0
		next
		day&=Early&:(cur&)+sad& Rem Tomorrow
		if eof
			back
			cur&=day& :exists%=0
		elseif a.begin&>=day&+sad& Rem after the morning of the day after tomorrow
			back
			cur&=day& :exists%=0
		else
			cur&=a.begin& :exists%=1
		endif
		l%=l%-1
	endwh
	if show% :MovCurs:(lin%) :endif
ENDP

PROC TMovCnt%:(time&,show%)
	local lin%
	while cur&<time& :MovRel:( 1,show%) :lin%=lin%+1 :endwh
	while cur&>time& :MovRel:(-1,show%) :lin%=lin%-1 :endwh
	if show% :MovCurs:(lin%) :endif
	return lin%
ENDP

PROC Insert:(upd%)
	local p%,np%,b&,scroll%
	b&=a.begin&
	if upd%
		update
		scroll%=0
	else
		p%=pos
		append :np%=pos
		position p%
		if b&<a.begin&
			scroll%=-1	Rem Perhaps this should really scroll top half screen up (split) or bottom half down
		else
			scroll%=1
		endif
	endif
	last
	
	Reorder:
	MovTo:(b&,1)
	
	if scroll% and gcy%<gcmax%
		Repaint:
	else
		PaintCur:
	endif
ENDP

PROC Reorder:
	local p%,begin&,total&,cnt%
	rem We know that only last rec can be out of order
	busy "Sorting..."
	onerr Error
	last :begin&=a.begin&
	back
	while a.begin&>begin& :cnt%=cnt%+1 :back :endwh
	
	Rem Erase duplicates
	while a.begin&=begin& and cnt% :erase :back :endwh
	if a.begin&>999 :total&=a.total& :else :total&=0 :endif
	next :p%=pos
	last
	if a.end& :total&=total&+Use&: :endif
	a.total&=total&
	update :Rem still remains at end
	while cnt%
		position p%
		if a.begin&>999
			if a.end& :total&=total&+Use&: :endif
			a.total&=total&
		endif
		update :Rem Move to end (after new rec)
		cnt%=cnt%-1
	endwh
	busy off
	MovTo:(cur&,0)
	return
	
Error::
	ShowErr:("Problem while sorting")
	busy off
	MovTo:(cur&,0)
ENDP

PROC Offset&:(from&,lin%)
	local oldcur&,oldpos%,oldex%,oldcurd&
	local offs&
	if mode$="P" :return from&+lin% :endif
	oldpos%=pos :oldcur&=cur& :oldex%=exists%
	MovTo:(from&,0)
	MovRel:(lin%,0)
	offs&=cur&
	position oldpos% :cur&=oldcur& :exists%=oldex%
	return offs&
ENDP

PROC Now&:
	return datetosecs(year,month,day,hour,minute,second)
ENDP

PROC Early&:(tim&)
	return int(tim&/sad&)*sad&
ENDP


PROC A8: rem Delete
	DelCur:
ENDP

PROC T7f: rem shift-delete (backspace)
	DelRang:
ENDP

PROC DelCur:
	local stat%,oldcur&
	if exists%
		oldcur&=cur&
		dinit
		dtext "","Remove"
		dbuttons "Yes",%y,"No",%n
		lock on : stat%=dialog :lock off
		if stat%=%y
			CopyBuf:
			ERASE
			MovTo:(oldcur&,1)
			Repaint: Rem sometimes, we could do with less
			giprint "Removed"
		endif
	else
		giprint "Nothing to remove"
	endif
ENDP

PROC DelRang:
	local stat%,from&,to&,cnt%,oldcur&
	oldcur&=cur&
	from&=cur&/sad&+d1970&
	to&=cur&/sad&+1+d1970&
	dinit
	dtext "","Remove"
	ddate from&,"from",d1970&,d2038&
	ddate to&,"to (excl.)",d1970&,d2038&
	dbuttons "Yes",%y,"No",%n
	lock on : stat%=dialog :lock off
	if stat%=%y
		busy "Removing"
		from&=(from&-d1970&)*sad&
		to&=(to&-d1970&)*sad&
		first
		while a.begin&<from& and not eof :next :endwh
		while a.begin&<to& and not eof
			cnt%=cnt%+1
			REM This is silly, when removing a range
			REM only last entry is remembered
			REM But to remember all takes up way too much memory (does it, really ?)
			CopyBuf:
			ERASE
		endwh
		onerr off
		if cnt%
			MovTo:(oldcur&,1)
			Repaint:
			giprint num$(cnt%,5)+" entries removed"
		else
			giprint "No entries removed"
		endif
		busy off
	endif
ENDP

PROC DelPRang:
ENDP

PROC CopyBuf:
	onerr Problem::
	rem Copy to paste buffer
	bbegin&=a.begin&
	bend&=a.end&
	bnorm&=a.norm&
	btext$=a.text$
Problem::
ENDP

PROC P9: rem TAB
	JumpProj:
ENDP
PROC T9: rem TAB
	JumpDate:
ENDP

PROC Td: rem ENTER
	RecED:
ENDP

PROC A1b: rem ESC
	call($198d,100,0)  Rem background
ENDP

PROC T20: rem Space
	local wd%,tim&
	if exists% and cur&>999 and a.end&=0
		tim&=cur&
	else
		tim&=Now&:
		MovTo:(tim&,1)
	endif
	if exists% and a.end&=0
		a.end&=Now&:+Tsetup&(9)
		PAdd:(a.text$,Use&:)
		Insert:(exists%)
	else
		if cur&>tim& :MovCurs:(1) :endif
		a.begin&=tim&-Tsetup&(8)
		a.end&=0
		wd%=dow(day,month,year)
		a.norm&=Tsetup&(wd%)
		a.text$=""
		Insert:(0)
	endif
ENDP

PROC P20: rem Space
	if exists% :else :ProED: :endif
	if exists% :ProStart:(a.text$) :endif
ENDP

PROC A100: rem up
	if a%(2) and 2  rem Shift
		MovRel:(-3,1)
	elseif a%(2) and 4  rem Control
		if mode$="T"
			MovTo:(cur&-30*sad&,1)
		else
			MovRel:(-30,1)
		endif
	else
		MovRel:(-1,1)
	endif
ENDP

PROC A101: rem down
	if a%(2) and 2  rem Shift
		MovRel:(3,1)
	elseif a%(2) and 4  rem Control
		if mode$="T"
			MovTo:(cur&+30*sad&,1)
		else
			MovRel:(30,1)
		endif
	else
		MovRel:(1,1)
	endif
ENDP

PROC T102: rem right
 TextED:
ENDP
PROC T103: rem left
 RecED:
ENDP

PROC A104: rem Page up
	MovRel:(-10,1)
ENDP

PROC A105: rem Page down
	MovRel:(10,1)
ENDP

rem PROC T106: rem Page right
rem ENDP
rem PROC T107: rem Page left
rem ENDP

PROC A122: rem Menu
	local menu%
	onerr Error
	minit
	rem a(b)cdDef[gh]ij[k]lmnopqrs[t](u)[v]wx[y]z
	mcard "File","Open file",%o,"Make new file",%m,"Print",%p,"Who did this?",%w,"Exit",%x
	mcard "Edit","Insert",%i,"Copy",%c,"Delete",%D,"Delete range",%R,"Edit",%e
	mcard "Screen","Repaint",%r,"Sort/Recalc",%s,"Jump to date",%j,"Font type",%f,"Zoom in",%z,"Zoom out",%Z
	mcard "Project","Begin",%b,"Project Usage",%u,"Tally/Recalc projects",%t
	mcard "Settings","Normal worktime",%n,"Slack",%l,"Rounding",%q,"Auto Calculation",%a
	lock on :menu% = MENU :lock off
	if menu%
		@(mode$+hex$(menu%+$200)):
	endif
	return
Error::
	if err=-99
		onerr Error2
		@("A"+hex$(menu%+$200)):
		return
	endif
Error2::
	ShowErr:(hex$(menu%+$200))
ENDP

PROC A123: rem Help
	local file$(20)
	file$="\opo\Workhelp.opo"
	trap loadm file$
	if err
		ShowErr:("'"+file$+"' - Help not installed")
	else
		WorkHelp:
		unloadm file$
	endif
ENDP

PROC T124: rem Star/diamond
	ToPMode:
ENDP
PROC P124: rem Star/diamond
	ToTMode:
ENDP

PROC ToPMode:
	tpos%=pos :tcur&=cur& :toff&=off& :tex%=exists% :tgcy%=gcy% :tcount%=count
	PCflush:
	mode$="P"
	diampos 2
	if pcount%=count
		position ppos% :cur&=pcur& :off&=poff& :exists%=pex% :gcy%=pgcy%
	else
		first
		while not eof and a.begin&<101 :next :endwh
		if not eof and a.begin&>100 and a.begin&<=999
			exists%=1 :cur&=a.begin&
		else
			exists%=0 :cur&=101
		endif
		off&=cur& :gcy%=0
	endif
	SetFont:(Psetup&(10))
ENDP

PROC ToTMode:
	ppos%=pos :pcur&=cur& :poff&=off& :pex%=exists% :pgcy%=gcy% :pcount%=count
	mode$="T"
	diampos 1
	cur&=tcur& :off&=toff& :exists%=tex% :gcy%=tgcy%
	if count=tcount%
		position tpos%
	else
		MovTo:(cur&,0)
	endif
	SetFont:(Tsetup&(10))
ENDP

PROC A244:
	DelCur:
ENDP

PROC T252:
	DelRang:
ENDP
PROC P252:
	giprint "Not implemented yet, sorry"
ENDP

PROC A261: rem psion-a = Automatic project calc
	local stat%,apc%
	apc%=PSetup&(5)+1
	dinit "Automatic project calculation"
	dchoice apc%,"Auto calc","Off,On"
	lock on :stat%=dialog :lock off
	if stat%
		PSetup&(5)=apc%-1
		SaveSet:
	endif
ENDP

PROC T262: rem psion-b = Begin project
	T124: Rem move to project mode
	giprint "Move cursor to project and press SPACE"
	return
ENDP

PROC ProStart:(proj$) rem Start project
	local wd%,tim&,today&
	if mode$<>"T" :ToTMode: :endif Rem Shift to time mode
	tim&=Now&:
	MovTo:(tim&,1)
	today&=Early&:(tim&)
	if exists% and a.end&=0 and a.begin&>today& and a.begin&<today&+sad&
		if a.norm& :a.end&=Now&:+Tsetup&(9) :else a.end&=Now&: :endif
		Insert:(exists%)
	endif
	a.begin&=tim&
	a.end&=0
	a.norm&=0  Rem Projects won't use this
	a.text$=proj$
	insert:(0)
ENDP

PROC A263: rem psion-c = Copy
	if exists%
		CopyBuf:
		giprint "Copied"
	else
		giprint "Nothing to Copy"
	endif
ENDP

PROC A264: rem psion-d = Delete Project/Entry
	DelCur:
ENDP

PROC T265: rem psion-e = Edit
	RecED:
ENDP
PROC P265: rem psion-e = Edit
	ProjED:
ENDP

PROC A266: rem psion-f = Font type
	local stat%,typ%
	if fonttyp%=5 :typ%=1 :else :typ%=2 :endif
	dinit "Font type"
	dchoice typ%,"","Roman,Swiss"
	lock on :stat%=dialog :lock off
	if stat%
		if typ%=1 :fonttyp%=5 :else fonttyp%=9 :endif
		SetFont:(&0) :REM ***TODO*** int(0)
		SaveSet:
	endif
ENDP

PROC T269: rem psion-i = Insert
	if bbegin&>999
		a.begin&=bbegin&-Early&:(bbegin&)+Early&:(cur&)
		if bend& :a.end&=bend&-Early&:(bend&)+Early&:(cur&) :else :a.end&=0 :endif
		a.norm&=bnorm&
		a.text$=btext$
		Insert:(0)
	else
		giprint "Nothing to insert"
	endif
ENDP
PROC P269: rem psion-i = Insert
	if bbegin&>100 and bbegin&<=999
		a.begin&=cur&
		a.end&=bend&
		a.norm&=bnorm&
		a.text$=btext$
		Insert:(0)
		PAdd:(btext$,Use&:)
	else
		giprint "Nothing to insert"
	endif
ENDP

PROC T26a: rem psion-j = Jump to date
	JumpDate:
ENDP
PROC P26a: rem psion-j = Jump to project
	JumpProj:
ENDP

PROC JumpDate:
	local to&,ret%
	to&=days(day,month,year)
	dinit "Jump to date"
	ddate to&,"",d1970&,d2038&
	lock on :ret% = dialog :lock off
	if ret%
		Rem point to last entry of the day
		MovTo:((to&-d1970&+1)*sad&-1,1)
	endif
ENDP
PROC JumpProj:
	local to&,ret%
	to&=cur&-100
	dinit "Jump to project"
	dlong to&,"",&1,&899
	REM Later: also search for text
	lock on :ret% = dialog :lock off
	if ret% :MovTo:(to&+100,1) :endif
ENDP

PROC A26c: rem psion-l = Slack
	dinit "Slack setup"
	dtime Tsetup&(8),"Begin",1,0,datetosecs(1970,1,1,0,59,59)
	dtime Tsetup&(9),"End",1,0,datetosecs(1970,1,1,0,59,59)
	lock on :if dialog :SaveSet: :endif :lock off
ENDP

PROC A26d: rem psion-m = Make new
	local file$(128),ret%
	dinit "Make new file"
	dfile file$,"",$9
	lock on :ret% = dialog :lock off
	if ret%
		SaveFile:
		MkFile:(file$)
	endif
ENDP

PROC A26e: rem psion-n = Normal worktime
	local n%
	dinit "Normal worktime"
	n%=1
	while n%<=7
		dtime Tsetup&(n%),dayname$(n%),1,0,maxday&
		n%=n%+1
	endwh
	lock on :if dialog :SaveSet: :endif :lock off
ENDP

PROC SaveSet:
	local n%
	busy "Saving setup"
	Rem Remove old setup records
	first :while a.begin&<100 and not eof :ERASE :first :endwh
	n%=1
	while n%<=10
		a.begin&=n%
		a.end&=Tsetup&(n%)
		a.norm&=Psetup&(n%)
		a.text$=Setup$(n%)
		append
		n%=n%+1
	endwh
	first
	while a.begin&>100 and not eof :update :first :endwh
	busy off
	giprint "Saved"
ENDP

PROC A26f: rem psion-o = Open/Load
	local file$(128),ret%
	dinit "Open file"
	dfile file$,"",$10
	lock on
	if dialog
		SaveFile:
		OpenFile:(file$)
	endif
	lock off
ENDP

PROC T270: rem psion-p Print
	local stat%,from&,to&,showsec%,showsel%,showby%
	local file$(128)

	file$=Setup$(1)
	if file$="" :file$="LOC::M:\Time.out" :endif
	showsel%=2
	dinit "Print to file"
	from&=days(1,month,year)
	if month<12 :to&=days(1,month+1,year) :else :to&=days(1,1,year+1) :endif
	ddate from&,"from",d1970&,d2038&
	ddate to&,"to (excl.)",d1970&,d2038&
	dchoice showby%,"Grouped","No,by month,by week,by day"
	dchoice showsel%,"Show","Entries only,Entries & Totals,Totals only"
	dchoice showsec%,"Show seconds","No,Yes"
	dfile file$,"File",1
	lock on :stat% = dialog :lock off
	if stat%=0 :return :endif

	if Setup$(1)<>file$ :Setup$(1)=file$ :SaveSet: :endif
	from&=(from&-d1970&)*sad&
	to&=(to&-d1970&)*sad&
	
	LOpen file$
	busy "Printing"
	
	PrintIt:(from&,to&,showby%,showsel%,showsec%-1)
	
	busy off
	lclose
ENDP
PROC P270:
	giprint "Project Printing not implemented, sorry."
ENDP

PROC PrintIt:(from&,to&,showby%,showsel%,showsec%)
	local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
	local p%,pcnt%,proj$(30,63),ptot&(30),pbyx&(30)
	local by%,newby%
	local transf&,projlen%
	local oldcur&,oldpos%,oldex%,oldcurd&
	
	oldpos%=pos :oldcur&=cur& :oldex%=exists%
	
	MovTo:(from&,0)
	if showsel%<3
		if exists% :back :transf&=a.total& :next :else :transf&=a.total& :endif
		lprint "Transfer";rept$(" ",45+12*showsec%)+Time$:(transf&,1,showsec%)
	endif
	while (cur& < to&)
		secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
		if showby%>1
			if showby%=2  Rem by Month
				newby%=mo%
			elseif showby%=3  Rem by Week
				newby%=week(da%,mo%,yr%)
			elseif showby%=4  Rem by Day
				newby%=int(cur&/sad&)
			endif
			if newby%<>by% and pcnt%>0 and by%>0
				lprint
				if showby%=2  Rem by Month
					lprint "Month totals (";month$(by%);")"
				elseif showby%=3  Rem by Week
					lprint "Week totals (week ";by%;")"
				elseif showby%=4  Rem by Day
					secstodate sad&*by%,yr%,mo%,da%,ho%,m%,s%,yrd%
					wd% = dow(da%,mo%,yr%)
					lprint "Day totals ";dayname$(wd%);" ";num$(da%,-2);". ";month$(mo%)
					secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
				endif
				p%=1 :projlen%=projlen%+2
				while p%<=pcnt%
					if pbyx&(p%) :lprint proj$(p%);rept$(" ",projlen%-len(proj$(p%)));Time$:(pbyx&(p%),0,showsec%) :pbyx&(p%)=0 :endif
					p%=p%+1
				endwh
				lprint
			endif
			by%=newby%
		endif
		wd% = dow(da%,mo%,yr%)
		if showsel%<3 :lprint dayname$(wd%);" ";num$(da%,-2);". ";month$(mo%); :endif
		if exists%
			if showsel%<3 :lprint "  ";Time$:(cur&,0,showsec%);" -"; :endif
			if a.end&
				if showsel%<3 :lprint " ";Time$:(a.end&,0,showsec%);"  ";Time$:(PUse&:,0,showsec%);" ";Time$:(a.norm&,0,0);"  ";Time$:(Use&:,1,showsec%);"  ";Time$:(RoundT&:(a.total&),1,showsec%); :endif
				transf&=a.total&
				if a.text$<>""
					if showsel%<3 :lprint "   ";a.text$; :endif
					if showsel%>1
						p%=1 :while p%<=pcnt% and proj$(p%)<>a.text$ :p%=p%+1 :endwh
						if proj$(p%)<>a.text$ and pcnt%<30
							pcnt%=pcnt%+1
							proj$(pcnt%)=a.text$ :p%=pcnt%
							projlen%=max(projlen%,len(a.text$))
						endif
						ptot&(p%)=ptot&(p%)+PUse&:
						pbyx&(p%)=pbyx&(p%)+PUse&:
					endif
				endif
			elseif a.text$<>"" and showsel%<3
				lprint rept$(" ",38+12*showsec%);a.text$;
			endif
		endif
		if showsel%<3 :lprint :endif
		MovRel:(1,0)
	endwh
	if showsel%<3 :lprint "Transfer";rept$(" ",45+12*showsec%)+Time$:(transf&,1,showsec%) :endif
	if pcnt%
		if showby%>1 and by%>0
			lprint
			if showby%=2  Rem by Month
				lprint "Month totals (";month$(by%);")"
			elseif showby%=3  Rem by Week
				lprint "Week totals (week ";by%;")"
			elseif showby%=4  Rem by Day
				secstodate sad&*by%,yr%,mo%,da%,ho%,m%,s%,yrd%
				wd% = dow(da%,mo%,yr%)
				lprint "Day totals ";dayname$(wd%);" ";num$(da%,-2);". ";month$(mo%)
				secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
			endif
			p%=1 :projlen%=projlen%+2
			while p%<=pcnt%
				if pbyx&(p%) :lprint proj$(p%);rept$(" ",projlen%-len(proj$(p%)));Time$:(pbyx&(p%),0,showsec%) :pbyx&(p%)=0 :endif
				p%=p%+1
			endwh
		endif
		lprint :lprint "Project totals:"
		p%=1 :projlen%=projlen%+2
		while p%<=pcnt%
			lprint proj$(p%);rept$(" ",projlen%-len(proj$(p%)));Time$:(ptot&(p%),0,showsec%)
			p%=p%+1
		endwh
	endif
	position oldpos% :cur&=oldcur& :exists%=oldex%
ENDP

PROC A271:  rem psion-q - Rounding
	local r1%,r2%
	if Psetup&(1) :r1%=Psetup&(1) :else :r1%=1 :endif
	if Psetup&(3) :r2%=Psetup&(3) :else :r2%=1 :endif
	dinit "Rounding"
	dtext "","On Entries",$102
	dchoice r1%,"Direction","No rounding,Up,Down,Nearest"
	dtime Psetup&(2),"Time",1,0,maxday&
	dtext "","On Totals",$102
	dchoice r2%,"Direction","No rounding,Up,Down,Nearest"
	dtime Psetup&(4),"Time",1,0,maxday&
	lock on
	if dialog
		Psetup&(1)=r1%
		Psetup&(3)=r2%
		SaveSet:
	endif
	lock off
ENDP

PROC P272:  rem psion-r - Repaint
	Repaint:
ENDP
PROC T272:  rem psion-r - Repaint
	if a%(2) and 2  rem Shift
		DelRang:
	else
		Repaint:
	endif
ENDP

PROC Sort:
	local remain%,us%,i%,j%,prev&,e&,total&,lo%,hi%,po%
	local v&(251),p%(251)
	if count=0 :return :endif
	busy "Sorting..."
	onerr error::
	remain%=count
	while remain%
		first :us%=1 :v&(us%)=a.begin& :p%(us%)=pos :next
		if pos<remain%
			while pos<=remain%
giprint num$(pos,3),0
				e&=a.begin&
				if (e&>v&(us%)) and (us%>=250) :next :continue :endif
				lo%=1 :hi%=us%+1
				while lo%<hi% :i%=(lo%+hi%)/2 :if e&<v&(i%) :hi%=i% :else :lo%=i%+1 :endif :endwh
				i%=us% :while i%>=lo% :v&(i%+1)=v&(i%) :p%(i%+1)=p%(i%) :i%=i%-1 :endwh
				v&(lo%)=e& :p%(lo%)=pos
				if us%<250 :us%=us%+1 :endif
				next
			endwh
		endif
		i%=1
		while i%<=us%
			position p%(i%)
			e&=a.begin& :while e&<>v&(i%) :giprint "Index mismatch "+num$(i%,5)+" = "+num$(e&,15) :pause -50 :back :e&=a.begin& :endwh
giprint num$(e&,15),0
			if e&=prev& :giprint "Duplicate removed "+num$(e&,15) :erase
			elseif e&>999 :if a.end& :total&=total&+Use&: :endif :a.total&=total& :update
			elseif e&>100 :a.total&=0 :update
			else
				update
			endif
			prev&=e&
			po%=p%(i%) :j%=i%+1 :while j%<=us% :if p%(j%)>po% :p%(j%)=p%(j%)-1 :endif :j%=j%+1 :endwh
			i%=i%+1
		endwh
		remain%=remain%-us%
	endwh
	busy off
	if cur& :MovTo:(cur&,0) :endif
	giprint num$(count-1,5)+" entries sorted"
	return
Error::
	ShowErr:("Error while sorting - rec will be deleted")
	erase
	Sort:
ENDP

PROC Tally: rem "Daaaoo, we say daaaoo..."
	local e&,i%,oldpon%
	oldpon%=PSetup&(5) :PSetup&(5)=1
	busy "Tallying projects"  rem  Or is it bananas....
	i%=30 :while i% :PCtext$(i%)="" :i%=i%-1 :endwh
	first
	while not eof
		e&=a.begin&
		if e&<=999 or a.text$="" or a.end&=0 :next :continue :endif
		i%=pos
		PAdd:(a.text$,Use&:)
		position i% :while a.begin&<=e& and not eof :next :endwh
	endwh
	busy off
	if mode$="P" :PCFlush: :Repaint: :endif
	PSetup&(5)=oldpon%
ENDP

PROC A273: rem psion-s = Sort/Recalc
	Sort:
	first :MovTo:(cur&,0)
	Repaint:
ENDP

PROC A274: rem psion-T = Tally projects
	Tally:
ENDP

PROC A275:  Rem Psion-U Project Usage
	local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
	local p%,po%,pcnt%,lin$(255),proj$(30,63),ptot&(30)
	local oldcur&,oldpos%,oldex%,oldcurd&
	local stat%,from&,to&,showsec%
	showsec%=2
	dinit "Project Usage"
	from&=days(1,month,year)
	if month<12 :to&=days(1,month+1,year) :else :to&=days(1,1,year+1) :endif
	ddate from&,"from",d1970&,d2038&
	ddate to&,"to (excl.)",d1970&,d2038&
	dchoice showsec%,"Show secs","No,Yes"
	lock on :stat% = dialog :lock off
	if stat%=0 or from&>to& :return :endif
	from&=(from&-d1970&)*sad&
	to&=(to&-d1970&)*sad&
	showsec%=showsec%-1
	REM Calc
	oldpos%=pos :oldcur&=cur& :oldex%=exists%
	busy "Calculating"
	MovTo:(from&,0)
	if not exists% :next :endif
	while a.begin&<to& and not eof
		if a.end& and a.text$<>""
			p%=1 :while p%<=pcnt% and proj$(p%)<>a.text$ :p%=p%+1 :endwh
			if proj$(p%)<>a.text$ and pcnt%<30
				pcnt%=pcnt%+1 :proj$(pcnt%)=a.text$ :p%=pcnt%
			endif
			ptot&(p%)=ptot&(p%)+PUse&:
		endif
		next
	endwh
	busy off
	if pcnt%
		po%=1
		while 1
			dinit "Project totals"
			p%=po%
			while p%<po%+5 and p%<=pcnt%
				dtext proj$(p%),Time$:(ptot&(p%),0,showsec%),1
				p%=p%+1
			endwh
			if pcnt%<8
			elseif po%<2       :dbuttons "Down",&101
			elseif po%>pcnt%-5 :dbuttons "Up",&100
			else               :dbuttons "Up",&100,"Down",&101
			endif
			lock on :stat% = dialog :lock off
			if		 stat%=&100 :po%=po%-1
			elseif stat%=&101 :po%=po%+1
			else
				break
			endif
		endwh
	else
		giprint "No projects found"
	endif
	position oldpos% :cur&=oldcur& :exists%=oldex%
ENDP


PROC A277: rem psion-w = Who created this ? (whoinfo)
	lock on
	dinit "Worktime"
	dtext "","Version 2.71",2
	dtext "","Created Dec 1994 - Sep 1995",2
	dtext "","by",2
	dtext "","Erik Johansen",$102
	dtext "","ej@id.dtu.dk",$102
	dtext "","(icon by ja@id.dtu.dk)",2
	dialog
	dinit "Worktime is now Shareware"
	dtext "","If you have decided to keep and use Worktime",2
	dtext "","please send me $15 as shareware fee.",2
	dtext ""," "
	dtext "","Include your E-mail address,",2
	dtext "","and I will mail future updates to you",2
	dtext "","before making the updates available to",2
	dtext "","the rest of the net.",2
	dialog
	dinit "So where do I send the money?"
	dtext "","Send $15 in your local currency to:"
	dtext "","(No coins, please)",2
	dtext ""," "
	dtext "","Erik Johansen",$102
	dtext "","Department for Computer Science",$102
	dtext "","DTU, building 344/345",$102
	dtext "","2800 Lyngby",$102
	dtext "","Denmark",$102
	dialog
	lock off
ENDP

PROC A278: rem psion-x = Exit
	SaveFile: :stop
ENDP

PROC A25a: rem shift-psion-Z (from menu) = Zoom out
	zoom%=zoom%-1 :if zoom%<0 :zoom%=3 :endif
	SetFont:(&0) :SaveSet:
ENDP

PROC A27a: rem psion-z = Zoom
	if a%(2) and 2  rem Shift
		zoom%=zoom%-1 :if zoom%<0 :zoom%=3 :endif
	else
		zoom%=zoom%+1 :if zoom%>3 :zoom%=0 :endif
	endif
	SetFont:(&0) :SaveSet:
ENDP

PROC A401: rem Foreground
ENDP

PROC A402: rem Background
ENDP

Rem To enable wakeup (power on) signals
Rem add the following call at start of
Rem the program:  call($6c8d)
Rem How come the signal comes in anyway ?

PROC A403: rem Powerup
ENDP

PROC A404: rem sys request
	local c$(129)
	c$ = getcmd$
	SysReq:(left$(c$,1),mid$(c$,2,128))
ENDP

PROC T405: rem Date change
	MovTo:(Now&:,1)
ENDP
PROC P405: rem Date change - ignored in project mode
ENDP

PROC A2000: rem + contrast
ENDP

PROC A2001: rem - contrast
ENDP

PROC Use&:
	return RoundS&:(a.end&-a.begin&-a.norm&)
ENDP
PROC PUse&:
	return RoundS&:(a.end&-a.begin&)
ENDP

PROC PAdd:(text$, time&)
	local n%
	if PSetup&(5)=0 or text$="" :return :endif
	n%=20
	while n%
		if PCtext$(n%)=text$
			PCdiff&(n%)=PCdiff&(n%)+time&
			return
		elseif PCtext$(n%)="" or PCdiff&(n%)=0
			PCtext$(n%)=text$
			PCdiff&(n%)=time&
			return
		endif
		n%=n%-1
	endwh
	PCFlush:
	n%=20
	PCtext$(n%)=text$
	PCdiff&(n%)=time&
ENDP

PROC PCFlush:
	local oldcur&,n%,las&,c%
	if PSetup&(5)=0 :return :endif rem Return if auto update not enabled
	
	Rem Check if anything in cache, otherwise return
	n%=20
	while n%>0
		if PCdiff&(n%)<>0 and PCtext$(n%)<>"" :n%=-1 :endif
		n%=n%-1
	endwh
	if n%=0 :return :endif
	
	busy "Updating Projects"
	c%=count
	oldcur&=a.begin&
	first
	while c%>0 and a.begin&<101 :update :first :c%=c%-1 :endwh
	las&=100
	while c%>0 and a.begin&<=999
		las&=a.begin&
		n%=20
		while n%
			if PCtext$(n%)=a.text$
				a.total&=a.total&+PCdiff&(n%)
				PCtext$(n%)=""
				PCdiff&(n%)=0
			endif
			n%=n%-1
		endwh
		update :first :c%=c%-1
	endwh
	
	n%=20
	while n%
		if PCtext$(n%)<>"" and PCdiff&(n%)<>0
			las&=las&+1
			if las&>998
				giprint "Too many projects"
			else
				a.begin&=las&
				a.end&=0
				a.norm&=0
				a.text$=PCtext$(n%)
				a.total&=PCdiff&(n%)
				append
			endif
			PCtext$(n%)=""
			PCdiff&(n%)=0
		endif
		n%=n%-1
	endwh
	busy "Updating"
	first
	while c%>0
giprint num$(a.begin&,15),0
		update :first :c%=c%-1
	endwh
	busy off
ENDP

REM ===== Project keys =====

Rem Procedure name is constructed like this:
Rem ("T" Time mode, "P" project mode or "A" any) + hexadecimal key value

PROC T6c: REM 'l'-key
	ProStart:("Lunch")
ENDP

PROC T6d: REM 'm'-key
	ProStart:("Meeting")
ENDP

PROC T74: REM 't'-key
	ProStart:("Transport")
ENDP

PROC T77: REM 'w'-key
	ProStart:("Work")
ENDP

Rem --------------------------------