home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-12-21 | 85.4 KB | 3,392 lines
app Scbank type $1003 rem s3a rem s3z type 3 path "\bank" ext "bnk" icon "\opd\scbanka.pic" rem s3a rem s3z icon "\opd\scbank.pic" enda proc main: rem way too much global stuff :-) rem sorder% last thing on statement global total,stotal,sorder% global filepos%,scrpos%,typel$(255),stypel$(255) rem currency list rem remember where we are moving from global oldpos% rem for display helpfuls global lastpos% global mark$(6),scrlen%,statlen% rem found a repeats file yet global nfile$(255),stdstat$(10) rem indexes global chqidx%,stmidx%,curidx% rem filter info global onfilt$(3),filt$(20) rem font info global linehi%,lined%,linea% rem screensizes global scwidth%,schight% global dispwin% rem search string and direction% global search$(20),sdir% global statwin%,stmwin% global stmstat$(3),mrkstat$(3),sttstat$(3) global ordstat$(10),why$(3),clkstat$(3) rem marker so banka: knows to do transfer global trans$(3) global mrkwin%,sttwin%,tmpfile$(255),stem$(255) global version$(25),filenm$(128) global statnx%,statmx%,statny%,statmy% rem fonts for zooming global curfont%,zfontid%(4),zfonts% rem statuswindow type global swintp% rem are we moving a window global moving$(3) rem statement repeats global stmrep$(80) rem last cheque number global lastchq& rem auto cheque numbering global chqstat$(3) rem collapse mark totals global clpstat$(3) rem scroll optimizer global doscr% rem last position where something done global zapto% local infowin% rem sc needs optimising cache 2000,2000 rem s3a version$="Version 2.3" rem load up extra procs needed if compiling on S3a rem loadm "\opo\sceven.opo" rem loadm "\opo\scmore.opo" rem version$=version$+"(develop)" scwidth%=gwidth : schight%=gheight rem remove text window screen 1,1,1,1 gsetwin 1,1,2,2 infowin%=strtscr%: rem setup font array zfonts%=4 rem s3a zfontid%(1)=9 rem swiss8 rem s3a zfontid%(2)=10 rem swiss11 rem s3a zfontid%(3)=11 rem swiss13 rem s3a zfontid%(4)=12 rem swiss16 rem s3a rem s3z tmpfile$=ssdfind$:("\opd\scbank.fon") rem s3z if (exist(tmpfile$)=-1) rem s3z zfontid%(2)=gloadfont(tmpfile$) rem s3z zfonts%=2 rem s3z else rem s3z zfonts%=1 rem s3z endif rem s3z zfontid%(1)=1 rem swiss8 diaminit 1,"ChqBook","Statmnt" rem s3a rem set up repeat string stmrep$="Daily,Weekly,BiWeekly,Monthly,Quarterly,6Monthly,Yearly" fset:(cmd$(3),cmd$(2)) startup: gclose infowin% mainloop: endp proc startup: rem things to do when starting up new file rem start without repeats window stmstat$="On" rem start without mark window mrkstat$="On" rem start without statistics window sttstat$="On" rem we dont start off moving transaction moving$="Off" rem start without a display filter onfilt$="On" rem start in chequebook mode ordstat$="Statement" rem make sure the diamond is in the right place diampos 1 rem s3a rem dont do transfer till we say trans$="Off" statwin%=gcreate(2,12,1,schight%-16,1,1) rem s3a rem s3z statwin%=gcreate(2,12,1,schight%-16,1) dispwin%=statwin% while (findval%:<>1) endwh rem display titles sizewin: rem current index as chqbk curidx%=chqidx% rem mark lastchq& as unset lastchq&=-1 rem set jump place to c/f initially zapto%=0 guse dispwin% bankp: endp proc foninfo: rem font size info local info%(32) gfont zfontid%(curfont%) ginfo info%() linehi%=info%(3)+1 rem how high is this font lined%=info%(4)+1 rem font descent linea%=info%(5)+1 rem font ascent endp proc sizewin: rem determine size of main window local extent%(4),tamm$(10) statwininfo(-1,extent%()) rem s3a statnx%=0 statmx%=extent%(1) rem s3a rem s3z statmx%=scwidth% guse statwin% foninfo: gsetwin statnx%,0,statmx%,schight% statny%=linehi%+3 statmy%=schight%-statny%-1 statlen%=statmy%/linehi% statmy%=statlen%*linehi% rem make sue we don't have any left over rem gsetwin statnx%+2,statny%,statmx%-4,statmy% if (onfilt$="On") if (ordstat$="Statement") tamm$="ChequeBook" else tamm$="Statement" endif dottl:("Date","Type","Amount",tamm$,"Mark","",79,statmx%-232,statmx%-160,statmx%-63,statmx%-24,statmx%-10,79) rem s3a rem s3z dottl:("Date","Type","Amount",tamm$,"Mrk","",53,statmx%-139,statmx%-95,statmx%-34,statmx%-14,statmx%-9,53) else dottl:("Date","filter="+filt$,"Amount","","Mark","",79,statmx%-232,statmx%-160,statmx%-63,statmx%-24,statmx%-10,79) rem s3a rem s3z dottl:("Date","filter="+filt$,"Amount","","Mrk","",53,statmx%-139,statmx%-95,statmx%-34,statmx%-14,statmx%-9,53) endif guse dispwin% gfont zfontid%(curfont%) scrlen%=statlen% endp proc stmzwin: rem determine size of repeats window guse stmwin% foninfo: statnx%=5 rem s3a rem s3z statnx%=0 statny%=7 statmx%=scwidth%-11 rem s3a rem s3z statmx%=scwidth% statmy%=schight%-10 statlen%=(statmy%-linehi%-4)/linehi% statmy%=statlen%*linehi% rem make sue we don't have any left over gsetwin statnx%,statny%,statmx%,statmy%+linehi%+6 dottl:("Statement","Description","Amount","Process","Type","Until",83,185,256,329,386,460,460) rem s3a rem s3z dottl:("Statement","Desc","Amount","Process","Type","Until",53,77,112,160,185,232,232) guse dispwin% gfont zfontid%(curfont%) scrlen%=statlen% endp proc mrkzwin: rem determine size of mark totals window guse mrkwin% foninfo: statnx%=5 statny%=5 statmx%=200 statmy%=schight%-5 statlen%=(statmy%-linehi%-4)/linehi% statmy%=statlen%*linehi% rem make sue we don't have any left over gsetwin statnx%,statny%,statmx%,statmy%+linehi%+4 dottl:("Mark","Total","","","","",60,statmx%-24,statmx%-10,60,60,60,60) guse dispwin% gfont zfontid%(curfont%) scrlen%=statlen% endp proc sttzwin: rem determine size of statistics window guse sttwin% foninfo: statnx%=5 statny%=5 statmx%=300 rem s3a rem s3z statmx%=230 statmy%=schight%-5 statlen%=(statmy%-linehi%-4)/linehi% statmy%=statlen%*linehi% rem make sue we don't have any left over gsetwin statnx%,statny%,statmx%,statmy%+linehi%+4 dottl:("Month","Year","Type","Total","","",50,100,220,290,290,290,290) rem s3a rem s3z dottl:("Month","Year","Type","Total","","",40,75,145,222,222,222,222) guse dispwin% gfont zfontid%(curfont%) scrlen%=statlen% endp proc createb:(file$,dire$) rem create account file trap create file$,A,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ if err rem it could be just no directory trap mkdir dire$ if err rem give up showerr:(err) stop else trap create file$,A,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ if err rem give up showerr:(err) stop endif endif endif endp proc fset:(opt$,file$) rem parse command line args local p%(6),x%(6) parse$("",file$,x%()) stem$=mid$(file$,1,x%(5)) nfile$=stem$+"stm" if opt$="C" stdstat$="NoFile" createb:(file$,mid$(file$,1,x%(4)-1)) wrcf:(days(day,month,year),"c/f",0.0,"On,2,2,On",0,0,"delta,hiw,visa,chq,dd,bc,dep,trf,amex,bp,text","food,petrol,computer,invest,sport,work,clothes,goodies,general,text"," ","x") append elseif opt$="O" if (exist(nfile$)=-1) trap open nfile$,B,sdate$,pdate$,desc$,amm$,type$,rep$,always$,until$ if err showerr:(err) stop endif stdstat$="File" else stdstat$="NoFile" endif trap open file$,A,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ if err showerr:(err) stop endif endif filenm$=file$ setname file$ use A endp proc strtscr%: rem start up screen local infowin% infowin%=gcreate(statnx%+90,statny%+5,250,120,1,1) rem s3a rem s3z infowin%=gcreate(statnx%+45,statny%+1,130,60,1) gxborder 1,1 rem s3a rem s3z gborder 1 gat 5,40 rem s3a rem s3z gat 5,17 gfont 12 rem s3a rem s3z gfont 2 gstyle 8 gprintb "SCBank",240,3 rem s3a gat 5,60 rem s3a gfont 11 rem s3a gstyle 0 rem s3a gprintb version$,240,3 rem s3a gat 5,80 rem s3a gprintb "╕ Susan Carter 1994",240,3 rem s3a gat 5,110 rem s3a gprintb "Sue@squish.demon.co.uk",240,3 rem s3a rem s3z gprintb "SCBank",120,3 rem s3z gat 5,30 rem s3z gfont 1 rem s3z gstyle 0 rem s3z gprintb version$,120,3 rem s3z gat 5,44 rem s3z gprintb "╕ Susan Carter 1994",120,3 rem s3z gat 5,55 rem s3z gprintb "Sue@squish.demon.co.uk",120,3 return infowin% endp proc getnth$:(list$,num%) rem get nth item from list local i%,j%,first%,second% i%=1:j%=1 while (j%<>num%) while (mid$(list$,i%,1)<>",")and(i%<=len(list$)) i%=i%+1 endwh if (i%>=len(list$)) rem there wasn't as many items as we thought return "NotFound" endif j%=j%+1 i%=i%+1 endwh first%=i% while ((i%<=len(list$))and(mid$(list$,i%,1)<>",")) i%=i%+1 endwh second%=i% return (mid$(list$,first%,(second%-first%))) endp proc which%:(list$,item$) rem return position in list local i%,j%,first%,second% first%=1:second%=1 i%=1:j%=1 while (i%<len(list$)) i%=i%+1 if ((mid$(list$,i%,1)=",")or(i%=len(list$))) if (mid$(list$,first%,i%-first%)=item$) return (j%) else j%=j%+1 i%=i%+1 first%=i% endif endif endwh return (-1) endp proc wrinit:(date&,desc$,amm,state$,order%,sorder%,total,stotal,type$,stm$,rate,default,symbol$) rem assign record fields for account local date$(10),amm$(10),order$(8),sorder$(8) local temp%,yr%,mo%,dy% secstodate ((date&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% date$=right$("0"+num$(dy%,2),2)+"/"+right$("0"+num$(mo%,2),2)+"/"+right$(num$(yr%,4),2) A.date$=date$ A.desc$=desc$ if (rate>0) rem foriegn currancy A.amm$="$,"+fix$(amm,2,10)+","+fix$(rate,2,10)+","+fix$(default,2,10)+","+symbol$ else A.amm$=fix$(amm,2,10) endif A.state$=state$ A.order$=num$(order%,10) A.sorder$=num$(sorder%,10) A.total$=fix$(total,2,10) A.stotal$=fix$(stotal,2,10) A.type$=type$ A.stm$=stm$ endp proc wrcf:(date&,desc$,amm,state$,order%,sorder%,typel$,stypel$,type$,stm$) rem assign record fields for c/f line local date$(10),amm$(10),order$(8),sorder$(8) local temp%,yr%,mo%,dy% secstodate ((date&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% date$=right$("0"+num$(dy%,2),2)+"/"+right$("0"+num$(mo%,2),2)+"/"+right$(num$(yr%,4),2) A.date$=date$ A.desc$=desc$ A.amm$=fix$(amm,2,10) A.state$=state$ A.order$=num$(order%,10) A.sorder$=num$(sorder%,10) A.total$=typel$ A.stotal$=stypel$ A.type$=type$ A.stm$=stm$ endp proc wrstm:(ds&,dsday%,dp&,dpday%,desc$,amm,type$,rep$,always$,until&) rem assign record fields for repeats local date$(13),amm$(10) local temp%,yr%,mo%,dy% secstodate ((dp&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% date$=right$("0"+num$(dy%,2),2)+"/"+right$("0"+num$(mo%,2),2)+"/"+right$(num$(yr%,4),2) if (dpday%>=29) rem potential end of month problem date$=date$+"*"+num$(dpday%,2) endif B.pdate$=date$ secstodate ((ds&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% date$=right$("0"+num$(dy%,2),2)+"/"+right$("0"+num$(mo%,2),2)+"/"+right$(num$(yr%,4),2) if (dsday%>=29) rem potential end of month problem date$=date$+"*"+num$(dsday%,2) endif B.sdate$=date$ B.desc$=desc$ B.amm$=fix$(amm,2,10) B.type$=type$ B.rep$=rep$ B.always$=always$ secstodate ((until&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% date$=right$("0"+num$(dy%,2),2)+"/"+right$("0"+num$(mo%,2),2)+"/"+right$(num$(yr%,4),2) B.until$=date$ endp proc shutd: rem shut everything down if (mrkstat$="Off") markj: elseif (stmstat$="Off") stmt: elseif (sttstat$="Off") stth: endif gclose statwin% if (stdstat$<>"NoFile") use B trap close if err showerr:(err) endif endif use A trap close if err showerr:(err) endif freealloc chqidx% rem s3a freealloc stmidx% rem s3a rem s3z call($0381,0,chqidx%) rem s3z call($0381,0,stmidx%) endp proc mainloop: rem main control loop local k%,mod%,h$(30),hu$(30),a$(6),a%(6),t$(1),file$(128),pname$(6),zaptmp%,line% filepos%=count-1 lastpos%=filepos% if (count<scrlen%) scrpos%=count else scrpos%=scrlen% endif while 1 gat 2,(scrpos%-1)*linehi%+linea%+linehi%+3 rem s3z if moving$="Off" gprint " " rem s3z else rem s3z gprint chr$($0a) rem s3z endif ggrey 1 rem s3a if moving$="Off" rem s3a gat 2,(scrpos%-1)*linehi%+1+linehi%+3 rem s3a gfill scwidth%,linehi%-1,2 rem s3a else rem s3a gat 2,(scrpos%)*linehi%+linehi%+3 rem s3a gtmode 2 rem s3a gprint rept$(chr$($0d),255) rem s3a endif rem s3a ggrey 0 rem s3a getevent a%() gat 2,(scrpos%-1)*linehi%+linea%+linehi%+3 rem s3z if moving$="Off" gprintb " ",gtwidth(" ")-1 rem s3z else rem s3z gprintb "",gtwidth(chr$($0a))-1 rem s3z endif ggrey 1 rem s3a if moving$="Off" rem s3a gat 2,(scrpos%-1)*linehi%+1+linehi%+3 rem s3a gfill scwidth%,linehi%-1,2 rem s3a else rem s3a gat 2,(scrpos%)*linehi%+linehi%+3 rem s3a gtmode 2 rem s3a gprint rept$(chr$($0d),255) rem s3a endif rem s3a ggrey 0 rem s3a if ((a%(1) and $400)<>0) rem not keypress if a%(1)=$404 rem system action file$=getcmd$ t$=left$(file$,1) file$=mid$(file$,2,128) if t$="X" bankx: elseif t$="C" or t$="O" shutd: fset:(t$,file$) startup: endif endif else rem a keypress sc should optimise this k%=a%(1) mod%=a%(2) and $00ff if (mrkstat$="Off") h$="cijnoxz" REM Hot keys hu$="Z" rem upper case hot keys rem s3a pname$="mark" elseif (sttstat$="Off") h$="aihnorxz" REM Hot keys hu$="Z" rem upper case hot keys rem s3a pname$="stt" elseif (stmstat$="Off") h$="adeinoptwxz" REM Hot keys hu$="Z" rem upper case hot keys rem s3a pname$="stm" elseif (moving$="On") h$="ainoxvz" REM Hot keys hu$="Z" rem upper case hot keys rem s3a pname$="move" elseif (onfilt$="Off") h$="cdeinomxz*-" REM Hot keys hu$="OCZ" rem upper case hot keys rem s3a rem s3z hu$="" rem should be able to use the standard bank procedures in filter mode pname$="bank" elseif (stmstat$="On") h$="acdefghijklmnopqrstvuwxyz" REM Hot keys rem s3a rem s3z h$="acdefghijklmnopqrstvuwxyz*-" REM Hot keys hu$="OCZ" rem upper case hot keys rem s3a rem s3z hu$="" pname$="bank" endif if k%=$122 rem menu key rem only on main screen if ((mod%=4)and(mrkstat$="On")and(stmstat$="On")and(sttstat$="On")) if (swintp%=0) rem s3a swintp%=2 rem s3a statuswin on, swintp% rem s3a elseif (swintp%=1) rem s3a swintp%=0 rem s3a statuswin off rem s3a else rem s3a swintp%=1 rem s3a statuswin on, swintp% rem s3a endif rem s3a sizewin: display:(filepos%,scrpos%) else minit if (mrkstat$="Off") mcard "File","New File...",%n,"Open File...",%o mcard "Edit","Check",%c rem s3a rem s3z mcard "Edit","Check",%c mcard "View","Info...",%i,"Mark totals "+mrkstat$+"...",%j mcard "Special","Exit",-%x,"Zoom in",%z,"Zoom out",%Z rem s3a rem s3z mcard "Special","Exit",%x,"Zoom Font",%z elseif (sttstat$="Off") mcard "File","New File...",%n,"Open File...",-%o,"Order",%r,"Save stats as...",%a rem s3a rem s3z mcard "File","New File...",%n,"Open File...",%o,"Order",%r,"Save stats as...",%a mcard "View","Info...",%i,"Statistics "+sttstat$+"...",%h mcard "Special","Exit",-%x,"Zoom in",%z,"Zoom out",%Z rem s3a rem s3z mcard "Special","Exit",%x,"Zoom Font",%z elseif (stmstat$="Off") mcard "File","New File...",%n,"Open File...",-%o,"Process repeats",%p rem s3a rem s3z mcard "File","New File...",%n,"Open File...",%o,"Process repeats",%p mcard "Edit","Add...",%a,"Edit...",%e,"Delete",%d mcard "View","Spend Type "+why$,%w,"Info...",%i,"Repeats "+stmstat$+"...",%t mcard "Special","Exit",-%x,"Zoom in",%z,"Zoom out",%Z rem s3a rem s3z mcard "Special","Exit",%x,"Zoom Font",%z elseif (moving$="On") mcard "File","New File...",%n,"Open File...",%o mcard "Edit","Place",%a,"Quit Moving",%v mcard "View","Info...",%i mcard "Special","Exit",-%x,"Zoom in",%z,"Zoom out",%Z rem s3a rem s3z mcard "Special","Exit",%x,"Zoom Font",%z elseif (onfilt$="Off") mcard "File","New File...",%n,"Open File...",%o mcard "Edit","Edit...",%e,"Delete",-%d,"Check",%c,"Check Off",-%C,"Mark...",%m rem s3a rem s3z mcard "Edit","Edit...",%e,"Delete",%d,"Check",%c,"Check Off",%-,"Mark...",%m mcard "Search","Filter "+onfilt$+"...",%O rem s3a rem s3z mcard "Search","Filter "+onfilt$+"...",%* mcard "View","Info...",%i mcard "Special","Exit",-%x,"Zoom in",%z,"Zoom out",%Z rem s3a rem s3z mcard "Special","Exit",%x,"Zoom Font",%z elseif (stmstat$="On") mcard "File","New File...",%n,"Open File...",-%o,"Compress",%s,"Archive...",%k,"Merge...",%y,"Recalc",-%l,"Process repeats",%p,"Statistics "+sttstat$,%h rem s3a rem s3z mcard "File","New File...",%n,"Open File...",%o,"Compress",%s,"Archive...",%k,"Merge...",%y,"Recalc",%l rem s3z mcard "2","Process repeats",%p,"Statistics "+sttstat$,%h,ordstat$+" view",%r mcard "Edit","Add...",%a,"Edit...",%e,"Delete",%d,"Transfer...",-%u,"Check",%c,"Check Off",-%C,"Mark...",%m,"Move...",%v rem s3a rem s3z mcard "Edit","Add...",%a,"Edit...",%e,"Delete",%d,"Transfer...",%u,"Check",%c,"Check Off",%- rem s3z mcard "2","Mark...",%m,"Move...",%v mcard "Search","Find...",%f,"Find again",%g,"Filter "+onfilt$+"...",%O rem s3a rem s3z mcard "Search","Find...",%f,"Find again",%g,"Filter "+onfilt$+"...",%* mcard "View","Spend Type "+why$,%w,"Info...",%i,"Repeats "+stmstat$+"...",%t,"Mark totals "+mrkstat$+"...",%j mcard "Special","Set preferences...",-%q,"Exit",-%x,"Zoom in",%z,"Zoom out",%Z rem s3a rem s3z mcard "Special","Set preferences...",%q,"Exit",%x,"Zoom Font",%z mcard chr$(4),ordstat$+" view",%r rem s3a endif lock on k%=menu lock off if ((k%>=%A)and(k%<=%Z)) rem s3a if loc(hu$,chr$(k%)) a$=pname$+"u"+chr$(k%) @(a$): endif else rem s3a if k% and (loc(h$,chr$(k%))<>0) if (k%=%*) a$=pname$+"st" elseif (k%=%-) a$=pname$+"sr" else a$=pname$+chr$(k%) endif @(a$): endif endif rem s3a endif elseif k% and $200 rem hot key k%=k%-$200 if ((mod% and 2)=2) rem s3a if loc(hu$,chr$(k%)) a$=pname$+"u"+chr$(k%) @(a$): endif else rem s3a if loc(h$,chr$(k%)) if (k%=%*) a$=pname$+"st" elseif (k%=%-) a$=pname$+"sr" else a$=pname$+chr$(k%) endif @(a$): endif endif rem s3a elseif (k%=13) rem enter does add if (loc(h$,chr$(%a))) rem only do it if a valid command for this mode @(pname$+"a"): endif elseif (k%=8) rem delete key if (loc(h$,chr$(%d))) rem only do it if a valid command for this mode @(pname$+"d"): endif elseif ((k%=260)and((mod% and 4)=4)) currkey:(262) rem same as home elseif ((k%=261)and((mod% and 4)=4)) currkey:(263) rem same as home rem spacebar elseif ((k%=32)and(mrkstat$="On")and(stmstat$="On")and(sttstat$="On")) lastpos%=filepos% zaptmp%=zapto% zapto%=filepos% line%=scrlen%/2 display:(zaptmp%,line%) rem diamond key elseif ((k%=292)and(mrkstat$="On")and(stmstat$="On")and(sttstat$="On")and(onfilt$="On")) rem s3a bankr: rem s3a rem help key elseif (k%=291) trap loadm ssdfind$:("\opo\sys$sch.opo") if err giprint "Help module not found" else if (schelp%:(ssdfind$:("\opd\scbank.hlp"))=-1) giprint "Help not available" endif unloadm ssdfind$:("\opo\sys$sch.opo") guse dispwin% endif else rem process any cursor key currkey:(k%) endif endif endwh rem never get here! endp proc ssdfind$:(file$) rem find file on ssd devices local lfile$(128),ssd$(4),i% ssd$="mabc" i%=1 while (i%<=4) lfile$=mid$(ssd$,i%,1)+":"+file$ if exist(lfile$) return lfile$ endif i%=i%+1 endwh return file$ rem just in case endp proc currkey:(k%) rem do a cursor movement local moved% if (k%=262) rem home lastpos%=filepos% filepos%=0 posfp%:(0,1) display:(filepos%,1) elseif (k%=263) rem end lastpos%=filepos% filepos%=count posfp%:(0,-1) display:(filepos%,scrlen%) elseif ((k%=257)and(filepos%<count-1)) rem down arrow rem alert(num$(filepos%,10),num$(count,10)) if (posfp%:(1,1)) if (scrpos%=scrlen%) doscr%=1 display:(filepos%,scrlen%) else scrpos%=scrpos%+1 endif endif elseif ((k%=261)and(filepos%<count-1)) rem page down if (scrpos%=scrlen%) if (posfp%:(scrlen%-1,1)<>0) display:(filepos%,scrlen%) endif else moved%=posfp%:(-scrpos%+scrlen%,1) rem alert(num$(filepos%,10)+"*"+num$(moved%,10),num$(count,10)) scrpos%=scrpos%+moved% endif elseif ((k%=256)and(filepos%>0)) rem up arrow if (posfp%:(1,-1)<>0) if (scrpos%=1) doscr%=1 display:(filepos%,1) else scrpos%=scrpos%-1 endif endif elseif ((k%=260)and(filepos%>0)) rem page up if (scrpos%=1) if (posfp%:(scrlen%-1,-1)<>0) display:(filepos%,1) endif else if (posfp%:(scrpos%-1,-1)<>0) scrpos%=1 endif endif endif endp proc showerr:(val%) alert ("Error "+err$(val%)) busy off endp proc bankj: rem mark totals local mrknx%,mrkmx%,mrkny%,mrkmy%,mrklen%,line&,val%,win% tmpfile$=stem$+"mrk" if (exist(tmpfile$)=-1) delete tmpfile$ endif trap create tmpfile$,C,mark$,amm$,stm$ if err showerr:(err) return endif use A first win%=createg%:("Mark Totals...") while not eof rem only bother with transactions that have marks and not the c/f line if ((A.state$<>" ")and(A.order$<>"0")) use C first while not eof if (A.state$=C.mark$) C.amm$=fix$((getamm:(A.amm$)+val(C.amm$)),2,10) if (A.stm$<>C.stm$) C.stm$="?" endif update break endif next endwh if eof C.mark$=A.state$ C.amm$=fix$(getamm:(A.amm$),2,10) C.stm$=A.stm$ append endif use A endif next line&=pos val%=line&*100/count dispg:(win%,val%) endwh delg:(win%) mrkstat$="Off" mrknx%=10 rem s3a mrkny%=10 rem s3a mrkmx%=scwidth%-300 rem s3a mrkmy%=schight%-30 rem s3a mrkwin%=gcreate(mrknx%+2,mrkny%+linehi%+3,mrkmx%-4,mrkmy%-linehi%-4,1,1) rem s3a rem s3z mrknx%=10 rem s3z mrkny%=10 rem s3z mrkmx%=210 rem s3z mrkmy%=schight%-30 rem s3z mrkwin%=gcreate(mrknx%+2,mrkny%+linehi%+3,mrkmx%-4,mrkmy%-linehi%-4,1) dispwin%=mrkwin% mrkzwin: scrpos%=1 filepos%=0 lastpos%=filepos% use C reorder:("Mark") use C display:(filepos%,scrpos%) endp proc bankh: rem statistics local d&,yr%,mo%,junk%,c1%,c2%,c3%,c4%,win%,line&,val% dinit "Statistics by" dchoice c1%,"Month","Yes,No" dchoice c2%,"Year","Yes,No" dchoice c3%,"Spend Type","Yes,No" dchoice c4%,"Order Output","Yes,No" if dialog tmpfile$=stem$+"stt" if (exist(tmpfile$)=-1) delete tmpfile$ endif trap create tmpfile$,C,type$,mon$,yr$,amm$ if err showerr:(err) return endif use A first win%=createg%:("Statistics...") while not eof rem not the c/f line if (A.order$<>"0") d&=strtod&:(A.date$,"/") secstodate ((d&-days(1,1,1970))*60*60*24),yr%,mo%,junk%,junk%,junk%,junk%,junk% use C first while not eof if ((A.type$=C.type$)or(c3%=2)) if ((yr%=val(C.yr$))or(c2%=2)) if ((mo%=val(C.mon$))or(c1%=2)) C.amm$=fix$((getamm:(a.amm$)+val(C.amm$)),2,10) update break endif endif endif next endwh if eof if (c1%=1) C.mon$=num$(mo%,10) else C.mon$="0" endif if (c2%=1) C.yr$=num$(yr%,10) else C.yr$="0" endif if (c3%=1) C.type$=A.type$ endif C.amm$=fix$(getamm:(A.amm$),2,10) append endif use A endif next line&=pos val%=line&*100/count dispg:(win%,val%) endwh delg:(win%) sttstat$="Off" use C if (c4%=1) rem want to order file reorder:("Stats") endif use A rem s3z sttwin%=gcreate(0,3,4,4,1) sttwin%=gcreate(0,3,4,4,1,1) rem s3a dispwin%=sttwin% sttzwin: scrpos%=1 filepos%=0 lastpos%=filepos% use C display:(filepos%,scrpos%) endif endp proc bankz: rem font resize up curfont%=curfont%+1 if (curfont%>zfonts%) curfont%=1 endif rem if displaying repeats window if (stmstat$="Off") stmzwin: elseif (mrkstat$="Off") mrkzwin: elseif (sttstat$="Off") sttzwin: else sizewin: endif display:(filepos%,scrpos%) endp proc bankuz: rem font resize down curfont%=curfont%-1 if (curfont%<1) curfont%=zfonts% endif rem if displaying repeats window if (stmstat$="Off") stmzwin: elseif (mrkstat$="Off") mrkzwin: elseif (sttstat$="Off") sttzwin: else sizewin: endif display:(filepos%,scrpos%) endp proc bankv: rem move transaction position rptr%:(curidx%,filepos%) if (A.order$="0") alert ("You can't move the c/f line!") return endif if ((ordstat$="ChequeBook") and (val(A.sorder$)=-1)) alert("Doesn't make sense to move transactions","not on statement in statement mode") return endif if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")and(A.state$<>" ")and(A.order$<>"0")and(A.stm$="x")) alert("Can't move a collapsed Mark Total","Turn off Mark Totals") return endif moving$="On" oldpos%=filepos% lastpos%=filepos% display:(filepos%,scrpos%) endp proc bankk: rem archive to file local delto%,arctotal,d&,date$(20),file$(128) local handle%,ret%,mode%,txt$(255),address% local c1%,c2%,c3%,delim&,i%,j%,line&,val%,win% position rptr%:(curidx%,filepos%) if (A.stm$<>"x") alert ("Only archive transactions on statement") return endif if (A.order$="0") alert ("You want to archive more than just the c/f line!") return endif delim&=asc(",") file$="\Bank\Archive.bnk" dinit "Archive to" dfile file$,"",3 dchoice c1%,"Archive as","Bank,Text" dchoice c3%,"Delimiter","Tab,Comma,Semicolon,Other" dlong delim&,"Delimiter code",0,255 dchoice c2%,"Archive","Copy to file and delete entries,Copy to file,Delete entries" if dialog if ((c2%=1)or(c2%=2)) rem Copy to file requested if (c1%=1) rem Archive in native bank format trap create file$,D,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ if err showerr:(err) return endif use A elseif (c1%=2) rem Archive in text format using delimiter if (c3%<>4) rem special delimiter if (c3%=1) delim&=asc(" ") endif if (c3%=2) delim&=asc(",") endif if (c3%=3) delim&=asc(";") endif endif mode%=$0100 or $0020 or $0001 ret%=ioopen(handle%,file$,mode%) if ret%<0 showerr:(ret%) return endif address%=addr(txt$) endif endif win%=createg%:("Archiving...") position rptr%:(curidx%,filepos%) arctotal=0 delto%=val(A.sorder$) date$=A.date$ i%=0 while (i%<=delto%) position rptr%:(stmidx%,i%) arctotal=arctotal+getamm:(a.amm$) if ((c2%=1)or(c2%=2)) rem Copy to file requested if (c1%=1) rem Archive in native bank format D.date$=A.date$ D.desc$=A.desc$ D.amm$=A.amm$ D.state$=A.state$ D.order$=A.order$ D.sorder$=A.sorder$ D.total$=A.total$ D.stotal$=A.stotal$ D.type$=A.type$ D.stm$=A.stm$ use D append use A elseif (c1%=2) rem Archive in text format using delimiter if (i%=0) rem c/f line txt$=A.date$+chr$(delim&)+A.desc$+chr$(delim&)+fix$(getamm:(A.amm$),2,10)+chr$(delim&)+fix$(getamm:(A.amm$),2,10)+chr$(delim&)+fix$(getamm:(A.amm$),2,10)+chr$(delim&)+A.order$+chr$(delim&)+A.sorder$+chr$(delim&)+" "+chr$(delim&)+A.type$ txt$=txt$+chr$(delim&)+A.stm$ else txt$=A.date$+chr$(delim&)+A.desc$+chr$(delim&)+fix$(getamm:(A.amm$),2,10)+chr$(delim&)+A.total$+chr$(delim&)+A.stotal$+chr$(delim&)+A.order$+chr$(delim&)+A.sorder$+chr$(delim&)+A.state$+chr$(delim&)+A.type$+chr$(delim&)+A.stm$ endif ret%=iowrite(handle%,address%+1,len(txt$)) if ret%<0 showerr:(ret%) return endif endif endif i%=i%+1 line&=i% val%=line&*100/delto%/2 rem the first half if (c2%=2) val%=val%*2 endif dispg:(win%,val%) endwh if ((c2%=1)or(c2%=2)) rem Copy to file requested if (c1%=1) rem Archive in native bank format use D close use A elseif (c1%=2) rem Archive in text format using delimiter ret%=ioclose(handle%) if ret% showerr:(ret%) endif endif giprint "Archive file written" endif if ((c2%=1)or(c2%=3)) rem delete archived entries rem go to the c/f line and write new value i%=0 j%=count first while (i%<j%) if (val(A.sorder$)=0) rem the c/f line d&=strtod&:(date$,"/") wrcf:(d&,"c/f",arctotal,A.state$,0,0,typel$,stypel$," ","x") update elseif ((val(A.sorder$)<=delto%)and(A.stm$="x")) rem to be archived erase else update endif i%=i%+1 line&=i% val%=line&*100/j%/2+50 rem the second half dispg:(win%,val%) first endwh freealloc chqidx% rem s3a freealloc stmidx% rem s3a chqidx%=alloc(count*2) rem s3a stmidx%=alloc(count*2) rem s3a rem s3z call($0381,0,chqidx%) rem s3z call($0381,0,stmidx%) rem s3z chqidx%=call($0081,0,count*2) rem s3z stmidx%=call($0081,0,count*2) if ((chqidx%=0)or(stmidx%=0)) alert ("Not enough memory to allocate index","Account file preserved") stop endif altcurp: calc: sizewin: display:(0,1) endif delg:(win%) endif endp proc bankn: rem new file option local file$(128),off%(6) file$="\bank\" dinit "Create new file" dfile file$,"",1+16+64 if dialog shutd: file$=parse$(file$,"\bank\*.bnk",off%()) fset:("C",file$) startup: endif endp proc banko: rem open file option local file$(128) file$="\bank\*.bnk" dinit "Open file" dfile file$,"",64 if dialog shutd: fset:("O",file$) startup: endif endp proc bankp: rem process repeats local dp&,ds&,du&,today&,amm,date$(20) local dsday%,dpday% local yr%,mo%,dy%,temp% local i%,changed%,deleted%,many% if (stdstat$<>"NoFile") busy "Repeats ..." use B many%=0 today&=days(day,month,year) do changed%=0 i%=1 while (i%<=count) first deleted%=0 dp&=strtod&:(B.pdate$,"/") if (dp&<=today&) ds&=strtod&:(B.sdate$,"/") du&=strtod&:(B.until$,"/") amm=val(B.amm$) total=total+amm use A wrinit:(ds&,B.desc$,amm," ",count,-1,total,0.0,B.type$," ",-1.0,-1.0,"") append addptr: many%=many%+1 if (B.rep$="Monthly") secstodate ((ds&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% if mo%=12 mo%=1 yr%=yr%+1 else mo%=mo%+1 endif if (mid$(B.sdate$,9,1)="*") rem end of month condition dy%=val(right$(B.sdate$,2)) endif dsday%=dy% ds&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) secstodate ((dp&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% if mo%=12 mo%=1 yr%=yr%+1 else mo%=mo%+1 endif if (mid$(B.pdate$,9,1)="*") rem end of month condition dy%=val(right$(B.pdate$,2)) endif dpday%=dy% dp&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) elseif (B.rep$="Quarterly") secstodate ((ds&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% mo%=mo%+3 if (mo%>12) mo%=mo%-12 yr%=yr%+1 endif if (mid$(B.sdate$,9,1)="*") rem end of month condition dy%=val(right$(B.sdate$,2)) endif dsday%=dy% ds&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) secstodate ((dp&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% mo%=mo%+3 if (mo%>12) mo%=mo%-12 yr%=yr%+1 endif if (mid$(B.pdate$,9,1)="*") rem end of month condition dy%=val(right$(B.pdate$,2)) endif dpday%=dy% dp&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) elseif (B.rep$="6Monthly") secstodate ((ds&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% mo%=mo%+6 if (mo%>12) mo%=mo%-12 yr%=yr%+1 endif if (mid$(B.sdate$,9,1)="*") rem end of month condition dy%=val(right$(B.sdate$,2)) endif dsday%=dy% ds&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) secstodate ((dp&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% mo%=mo%+6 if (mo%>12) mo%=mo%-12 yr%=yr%+1 endif if (mid$(B.pdate$,9,1)="*") rem end of month condition dy%=val(right$(B.pdate$,2)) endif dpday%=dy% dp&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) elseif (B.rep$="Yearly") secstodate ((ds&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% yr%=yr%+1 dsday%=dy% ds&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) secstodate ((dp&-days(1,1,1970))*60*60*24),yr%,mo%,dy%,temp%,temp%,temp%,temp% yr%=yr%+1 dpday%=dy% dp&=((scdtos&:(yr%,mo%,dy%))/24/60/60)+days(1,1,1970) elseif (B.rep$="Daily") ds&=ds&+1 dsday%=0 dp&=dp&+1 dpday%=0 elseif (B.rep$="Weekly") ds&=ds&+7 dsday%=0 dp&=dp&+7 dpday%=0 elseif (B.rep$="BiWeekly") ds&=ds&+14 dsday%=0 dp&=dp&+14 dpday%=0 endif use B if ((B.always$="No")and(du&<dp&)) rem times up erase deleted%=1 else wrstm:(ds&,dsday%,dp&,dpday%,B.desc$,amm,B.type$,B.rep$,B.always$,du&) endif changed%=1 endif if (deleted%=0) update endif i%=i%+1 endwh until (changed%=0) busy off if (many%<>0) rem things have been added giprint num$(many%,10)+" transactions added" endif if (stmstat$="On") use A setpos: else use B filepos%=count-1 scrpos%=scrlen% endif else setpos: endif display:(filepos%,scrpos%) endp proc bankt: local stmnx%,stmmx%,stmny%,stmmy%,stmlen% if (stdstat$="NoFile") if (sure%:("Create Repeats File?")) trap create nfile$,B,sdate$,pdate$,desc$,amm$,type$,rep$,always$,until$ if err showerr:(err) return endif stdstat$="File" else return endif endif stmnx%=5 stmny%=10 stmmx%=scwidth%-10 stmmy%=schight%-10 stmwin%=gcreate(stmnx%+2,stmny%+linehi%+3,stmmx%-4,stmmy%-linehi%-4,1,1) rem s3a rem s3z stmwin%=gcreate(stmnx%+2,stmny%+linehi%+3,stmmx%-4,stmmy%-linehi%-4,1) dispwin%=stmwin% stmzwin: scrpos%=1 filepos%=0 lastpos%=filepos% stmstat$="Off" use B display:(filepos%,scrpos%) endp proc banki: local k%,infowin% infowin%=strtscr%: k%=get gclose infowin% guse dispwin% endp proc bankd: rem delete entry local i%,oldchq%,oldstm%,thispos%,x%,extra%,pval% position rptr%:(curidx%,filepos%) if (A.order$<>"0") if (sure%:("Delete entry?")) zapto%=filepos% busy "Deleting entry ..." if (A.stm$="x") stotal=stotal-getamm:(a.amm$) sorder%=sorder%-1 endif total=total-getamm:(a.amm$) oldchq%=val(A.order$) oldstm%=val(A.sorder$) erase freealloc chqidx% rem s3a freealloc stmidx% rem s3a chqidx%=alloc(count*2) rem s3a stmidx%=alloc(count*2) rem s3a rem s3z call($0381,0,chqidx%) rem s3z call($0381,0,stmidx%) rem s3z chqidx%=call($0081,0,count*2) rem s3z stmidx%=call($0081,0,count*2) if ((chqidx%=0)or(stmidx%=0)) alert ("Not enough memory to allocate index","Account file preserved") stop endif i%=0 extra%=1 while (i%<count) first x%=val(A.order$) if (x%>=oldchq%) x%=x%-1 endif wptr:(chqidx%,x%,i%+1) A.order$=fix$(x%,0,10) x%=val(A.sorder$) pval%=x% if (x%=-1) rem not on statement pval%=sorder%+extra% extra%=extra%+1 else if ((x%>=oldstm%)and(oldstm%<>-1)) x%=x%-1 pval%=x% endif endif wptr:(stmidx%,pval%,i%+1) A.sorder$=fix$(x%,0,10) update i%=i%+1 endwh altcurp: if((posfp%:(0,1)=0)and(onfilt$="Off")) rem nothing to filter busy off bankuo: rem turn off filter else lastpos%=filepos% position rptr%:(curidx%,filepos%) busy off display:(filepos%,scrpos%) endif endif else alert("Can't delete the c/f line!") endif endp proc sure%:(disp$) rem a yes/no tester local k% dinit disp$ dbuttons "No",%N,"Yes",%Y k%=dialog if (k%=%y) return 1 endif return 0 endp proc bankf: local found%,line%,c% c%=(3-sdir%)/2 dinit "Find" dedit search$,"Search for" dchoice c%,"Direction","Forwards,Backwards" lock on if dialog zapto%=filepos% sdir%=c%*(-2)+3 found%=ptrfind%:(filepos%,search$,sdir%) if (found%<>-1) line%=int(scrlen%/2) position rptr%:(curidx%,found%) display:(found%,line%) else giprint "Not found" endif endif lock off endp proc bankg: local found%,line% found%=ptrfind%:(filepos%,search$,sdir%) if (found%<>-1) line%=int(scrlen%/2) position rptr%:(curidx%,found%) display:(found%,line%) else giprint "Not found" endif endp proc bankw: if (why$="On") why$="Off" else why$="On" endif display:(filepos%,scrpos%) endp proc bankm: rem mark transaction position rptr%:(curidx%,filepos%) if (A.order$="0") alert ("You can't mark the c/f line!") return endif if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")and(A.state$<>" ")and(A.order$<>"0")and(A.stm$="x")) alert("Can't change Mark on a collapsed Mark Total","Switch to ChequeBook mode") return endif dinit "Marker" dedit mark$,"Mark",6 lock on if dialog zapto%=filepos% if (A.order$<>"0") rem not the c/f line A.state$=mark$ update upidx:(filepos%) display:(filepos%,scrpos%) else alert("Not the c/f line") endif endif lock off endp proc bankl: rem recalc calc: setpos: display:(filepos%,scrpos%) endp proc bankx: rem exit stop endp proc bankr: rem switch display modes dottl:("Date","Type","Amount",ordstat$,"Mark","",79,statmx%-232,statmx%-160,statmx%-63,statmx%-24,statmx%-10,79) rem s3a rem s3z dottl:("Date","Type","Amount",ordstat$,"Mrk","",53,statmx%-139,statmx%-95,statmx%-34,statmx%-14,statmx%-9,53) guse dispwin% if (ordstat$="Statement") ordstat$="ChequeBook" diampos 2 rem s3a curidx%=stmidx% display:(sorder%,2) else ordstat$="Statement" diampos 1 rem s3a curidx%=chqidx% display:(count-1,scrlen%) endif endp rem sceven.opl begins here proc setpos: if (ordstat$="Statement") filepos%=count-1 scrpos%=scrlen% else filepos%=sorder% scrpos%=2 endif endp proc bankq: local c1%,c2%,c3%,c4%,c5%,switch$(10),quest$(5),x%,font$(40),swinch$(40) switch$="Off,On" font$="Small,Medium,Large,XLarge" rem s3a rem s3z font$="Large,Small" swinch$="Off,Small,Large" c1%=which%:("On,Off",why$) c2%=curfont% c3%=swintp%+1 c4%=which%:("On,Off",chqstat$) c5%=which%:("On,Off",clpstat$) dinit "Set preferences" dchoice c1%,"Spend type",switch$ dchoice c2%,"Font Size",font$ dchoice c3%,"Status Window",swinch$ rem s3a dchoice c4%,"Auto cheque numbers",switch$ dchoice c5%,"Collapse Mark Totals",switch$ dedit typel$,"Transaction type",20 dedit stypel$,"Spend type",0 lock on if dialog position rptr%:(curidx%,0) A.total$=typel$ A.stotal$=stypel$ A.state$=getnth$:(switch$,c1%)+","+num$(c2%,2)+","+num$(c3%-1,2)+","+getnth$:(switch$,c4%)+","+getnth$:(switch$,c5%) update upidx:(0) getpref: sizewin: display:(filepos%,scrpos%) endif lock off endp proc banky: rem merge local file$(128),line% local lorder%,lsorder%,cftot,win%,line&,val% file$="\bank\*.bnk" dinit "Merge with file" dfile file$,"",64 if dialog lorder%=count-1 lsorder%=sorder% trap open file$,D,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ if err showerr:(err) stop endif win%=createg%:("Merging...") rem find the c/f line in new file first cftot=0 while not eof if (D.desc$="c/f") cftot=val(D.amm$) break endif next endwh use D first while not eof rem assume both files are correctly calced if (D.desc$<>"c/f") rem dont do anything for c/f line A.date$=D.date$ A.desc$=D.desc$ A.amm$=D.amm$ A.state$=D.state$ A.order$=num$(val(D.order$)+lorder%,10) if (val(D.sorder$)=-1) rem not on statement A.sorder$="-1" else A.sorder$=num$(val(D.sorder$)+lsorder%,10) if (val(A.sorder$)>sorder%) rem greater than old sorder% sorder%=val(A.sorder$) endif endif A.total$=fix$(val(D.total$)-cftot+total,2,10) if (val(D.sorder$)=-1) rem not on statement A.stotal$="0.0" else A.stotal$=fix$(val(D.stotal$)-cftot+stotal,2,10) endif A.type$=D.type$ A.stm$=D.stm$ use A append use D endif next line&=pos val%=line&*100/count dispg:(win%,val%) endwh use D trap close if err showerr:(err) endif use A delg:(win%) freealloc chqidx% rem s3a freealloc stmidx% rem s3a rem s3z call($0381,0,chqidx%) rem s3z call($0381,0,stmidx%) while (findval%:<>1) endwh altcurp: line%=int(scrlen%/2) display:(lorder%,line%) endif endp proc banks: rem compress rem close and open file to compress it busy "Compressing ..." use A close open filenm$,A,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ busy off endp proc bankc: rem check onto statement local x%,oldstat% position rptr%:(curidx%,filepos%) if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")and(A.state$<>" ")and(A.order$<>"0")and(A.stm$="x")) alert("Can't check on a collapsed Mark Total","Aleady on statement") return endif zapto%=filepos% if A.stm$<>"x" checkon: if (ordstat$="ChequeBook") filepos%=sorder% scrpos%=2 endif display:(filepos%,scrpos%) else alert("Already on statement!") endif endp rem s3zproc banksr: rem s3z bankuc: rem s3zendp proc bankuc: rem check off statement local i%,lorder%,lamm position rptr%:(curidx%,filepos%) if (A.order$="0") alert ("You can't check off the c/f line!") return endif if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")and(A.state$<>" ")and(A.order$<>"0")and(A.stm$="x")) alert("Can't check off a collapsed Mark Total","Check off individually") return endif zapto%=filepos% if (A.stm$="x") if (sure%:("Remove from statement?")) busy "Checking off ..." lorder%=val(A.sorder$) lamm=getamm:(A.amm$) sorder%=sorder%-1 stotal=stotal-getamm:(A.amm$) i%=1 while (i%<=count) first if (val(A.sorder$)>lorder%) A.sorder$=num$((val(A.sorder$)-1),10) elseif (val(A.sorder$)=lorder%) A.sorder$="-1" A.stm$=" " A.stotal$="0.00" endif update i%=i%+1 endwh busy off buildidx: display:(filepos%,scrpos%) endif else alert("Not on statement!") endif endp proc checkon: rem check a transaction onto a statement sorder%=sorder%+1 stotal=stotal+getamm:(A.amm$) A.sorder$=num$(sorder%,10) A.stotal$=fix$(stotal,2,10) A.stm$="x" update rem might it be quicker to be clever here? buildidx: endp proc upidx:(uppos%) local i%,oldpos% busy "Updating Index..." oldpos%=rptr%:(curidx%,uppos%) i%=0 while (i%<count) if (rptr%:(chqidx%,i%)=oldpos%) wptr:(chqidx%,i%,count) elseif (rptr%:(chqidx%,i%)>oldpos%) wptr:(chqidx%,i%,(rptr%:(chqidx%,i%))-1) endif if (rptr%:(stmidx%,i%)=oldpos%) wptr:(stmidx%,i%,count) elseif (rptr%:(stmidx%,i%)>oldpos%) wptr:(stmidx%,i%,(rptr%:(stmidx%,i%))-1) endif i%=i%+1 endwh busy off endp proc getamm:(amm$) rem get the amount coping with foreign currency if (left$(amm$,1)="$") rem foriegn currency return val(getnth$:(amm$,4)) else return val(amm$) endif endp proc banke: local d&,c%,ttype$(60),d%,stype$(60),amm,state$(20),order&,sorder&,desc$(60),type$(60),lorder%,lsorder%,ltotal,lstotal,stm$(1) local rate,default,symbol$(5),oamm,orate,odef,chq&,namm position rptr%:(curidx%,filepos%) if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")and(A.state$<>" ")and(A.order$<>"0")and(A.stm$="x")) alert("Can't edit a collapsed Mark Total","Switch to ChequeBook mode") return endif d&=strtod&:(A.date$,"/") desc$=A.desc$ order&=val(A.order$) sorder&=val(A.sorder$) if (order&>0) rem ordinary transaction chq&=-1 if (left$(desc$,3)="chq") chq&=findnum&:(desc$) if (chq&>=0) desc$="chq" endif endif type$=A.type$ c%=which%:(typel$,desc$) d%=which%:(stypel$,A.type$) state$=A.state$ stm$=A.stm$ ltotal=val(A.total$) lstotal=val(A.stotal$) if (left$(A.amm$,1)="$") rem foriegn currency amm=val(getnth$:(A.amm$,2)) rate=val(getnth$:(A.amm$,3)) default=val(getnth$:(A.amm$,4)) oamm=amm orate=rate odef=default symbol$=getnth$:(A.amm$,5) else amm=val(A.amm$) rate=-1 default=-1 symbol$="" endif dinit "Transaction details" ddate d&,"Date",0,days(31,12,2100) dchoice c%,"Trans type",typel$ if (chq&>=0) rem auto cheque numbering dlong chq&,"Chq No.",0,1e9 endif dfloat amm,"Amount",-1E13,1E13 dchoice d%,"Spend type",stypel$ if (left$(A.amm$,1)="$") rem foriegn currency rem s3z lock on rem s3z if dialog rem s3z dinit "Currency details" dfloat rate,"Exchange rate",-1e13,1e13 dfloat default,"Amount in default",-1e13,1e13 dedit symbol$,"Currency symbol" rem s3z else rem s3z return rem s3z endif endif lock on rem s3a if dialog zapto%=filepos% ttype$=getnth$:(typel$,c%) stype$=getnth$:(stypel$,d%) if ttype$="text" dinit "Enter free text description" dedit desc$,"Trans Type" if dialog ttype$=desc$ endif endif if stype$="text" dinit "Enter free text description" dedit type$,"Spend Type" if dialog stype$=type$ endif endif if (left$(A.amm$,1)="$") rem foriegn currency if (oamm<>amm) rem changed amoutnt recalc default using rate giprint "Recalc default from new amount" if (rate=0) rate=1 endif default=amm/rate elseif (odef<>default) rem changed the defualt amount recalc rate giprint "Recalc rate from new default amount" if (default=0) default=1 endif rate=amm/default elseif (orate<>rate) rem changed the rate recalc default giprint "Recalc default from new rate" if (rate=0) rate=1 endif default=amm/rate endif namm=default else namm=amm endif if (getamm:(A.amm$)<>namm) ltotal=ltotal+namm-getamm:(A.amm$) if stm$="x" lstotal=lstotal+namm-getamm:(A.amm$) endif if (val(A.order$)<>count-1) giprint "Do a recalc to be safe :-)" endif endif if (chq&>=0) rem did we have a chq no. ttype$=ttype$+"("+num$(chq&,8)+")" endif lorder%=order& lsorder%=sorder& wrinit:(d&,ttype$,amm,state$,lorder%,lsorder%,ltotal,lstotal,stype$,stm$,rate,default,symbol$) update upidx:(filepos%) display:(filepos%,scrpos%) endif lock off else rem edit the c/f line amm=val(A.amm$) ltotal=val(A.amm$) lstotal=val(A.amm$) dinit "Carried forward details" ddate d&,"Date",0,days(31,12,2100) dfloat ltotal,"c/f",-1E13,1E13 lock on if dialog total=total+ltotal-val(A.amm$) stotal=stotal+lstotal-val(A.amm$) if (count<>1) giprint "Do a recalc to be safe :-)" endif wrcf:(d&,"c/f",ltotal,A.state$,0,0,typel$,stypel$," ","x") update upidx:(filepos%) lastpos%=filepos% display:(filepos%,scrpos%) endif lock off endif endp rem s3zproc bankst: rem s3z bankuo: rem s3zendp proc bankuo: rem filter on/off local found%,tamm$(10) if (onfilt$="On") dinit "Filter string" dedit filt$,"" lock on if dialog position rptr%:(curidx%,0) found%=ptrfind%:(0,filt$,1) if (found%<>-1) onfilt$="Off" filepos%=found% lastpos%=filepos% sizewin: else giprint filt$+" not found" endif endif rem alert (num$(filepos%,10)+num$(found%,10)+num$(count,10)) lock off else onfilt$="On" lastpos%=filepos% sizewin: endif rem alert (num$(filepos%,10)) display:(filepos%,scrpos%) endp proc ptrfind%:(from%,fstr$,direct%) local i%,txt$(255),disp$(20) i%=from%+direct% if ((i%<1) or (i%>count-1)) return -1 endif do position rptr%:(curidx%,i%) txt$=A.date$+":"+A.desc$+":"+A.amm$+":"+A.state$+":"+A.type$ if ((loc(txt$,fstr$))<>0) return i% endif i%=i%+direct% until ((i%>=count)or(i%<1)or(direct%=0)) return -1 endp proc banka: local d&,c%,ttype$(20),d%,stype$(20),amm,state$(10),order&,sorder&,file$(128) local e%,ctype$(20),rate,basic,symbol$(5),orate,odef,currl$(255),loc% d&=days(day,month,year) currl$="Default," if (exist(ssdfind$:("\bank\currency.dbf"))=-1) trap open ssdfind$:("\bank\currency.dbf"),D,text$,rate$,symbol$ if err showerr:(err) stop endif first while not eof currl$=currl$+D.text$+"," next endwh close use A endif currl$=currl$+"Other" dinit "Transaction details" ddate d&,"Date",0,days(31,12,2100) dchoice c%,"Trans type",typel$ dfloat amm,"Amount",-1E13,1E13 dchoice d%,"Spend type",stypel$ dchoice e%,"Currency",currl$ if (trans$="On") rem s3z lock on rem s3z if dialog rem s3z dinit "Transfer details" file$="\bank\*.bnk" dfile file$,"Transfer to",64 rem s3z else rem s3z return rem s3z endif endif lock on if dialog zapto%=filepos% if (trans$="On") trap open file$,D,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ if err alert("Unable to open as bank file",file$) lock off return endif close endif ttype$=getnth$:(typel$,c%) stype$=getnth$:(stypel$,d%) ctype$=getnth$:(currl$,e%) if ttype$="text" dinit "Enter free text transaction type" dedit ttype$,"Trans Type" dialog endif if stype$="text" dinit "Enter free text spend type" dedit stype$,"Spend Type" dialog endif if (chqstat$="Off") rem are we doing autonumbering if (ttype$="chq") rem special case for cheque autonumbering if (lastchq&=-1) rem dont have the last chq number lastchq&=valchq&: endif lastchq&=lastchq&+1 dinit "Cheque Number" dlong lastchq&,"",0,1e9 if dialog ttype$=ttype$+"("+num$(lastchq&,8)+")" endif endif endif if (ctype$<>"Default") if (ctype$="Other") rem a user entered currency symbol$="╧" rate=1 basic=amm else rem must have come from currency file if (exist(ssdfind$:("\bank\currency.dbf"))=-1) trap open ssdfind$:("\bank\currency.dbf"),D,text$,rate$,symbol$ if err showerr:(err) stop endif position e%-1 rate=val(D.rate$) if (rate=0) rate=1 endif basic=amm/rate rem get roung bug in dfloat that only shows *last* 10 digits of float num basic=intf(basic*100)/100 symbol$=D.symbol$ close use A endif endif orate=rate odef=basic rem sc get details for currency dinit "Foreign Currency" dfloat rate,"Rate",-1e13,1e13 dfloat basic,"Amount in default",-1e13,1e13 dedit symbol$,"Symbol" if dialog if (odef<>basic) rem changed the defualt amount recalc rate giprint "Recalc rate from new default amount" if (basic=0) basic=1 endif rate=amm/basic elseif (orate<>rate) rem changed the rate recalc default giprint "Recalc default from new rate" if (rate=0) rate=1 endif basic=amm/rate endif endif endif if (rate>0) total=total+basic else total=total+amm endif wrinit:(d&,ttype$,amm," ",count,-1,total,0.0,stype$," ",rate,basic,symbol$) append addptr: rem do the stuff to add the transfer to other file if (trans$="On") busy "Transfering..." use A close trap open file$,A,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ if err alert("Unable to open as bank file",file$) return endif rem find last item in chqbook mode to get total first while not eof if (val(A.order$)=count-1) break rem found it endif next endwh if (rate>0) orate=basic else orate=amm endif wrinit:(d&,ttype$,-amm," ",count,-1,val(A.total$)-orate,0.0,stype$," ",rate,-basic,symbol$) append close open filenm$,A,date$,desc$,amm$,state$,order$,sorder$,total$,stotal$,type$,stm$ busy off giprint "Transaction transfered" endif doscr%=1 display:(count-1,scrlen%) endif lock off endp proc banku: rem transfer rem all a bit of a hack because too hard to pass para to banka: trans$="On" banka: trans$="Off" endp proc valchq&: local chqtest&,biggest& busy "Finding cheque..." biggest&=-1 first while not eof if (left$(A.desc$,3)="chq") chqtest&=findnum&:(A.desc$) if (chqtest&>biggest&) biggest&=chqtest& endif endif next endwh rem alert("Biggest cheque number",num$(biggest&,10)) busy off return biggest& endp proc findnum&:(desc$) local chqtest$(30),loc% if (right$(A.desc$,1)=")") rem looking good! loc%=loc(A.desc$,"(") if (loc%<>0) chqtest$=mid$(A.desc$,loc%+1,len(A.desc$)-loc%-1) if (isanum%:(chqtest$)=1) return val(chqtest$) endif endif endif return -1 endp proc isanum%:(chstr$) local i% i%=1 while (i%<=len(chstr$)) if ((mid$(chstr$,i%,1)<"0")or(mid$(chstr$,i%,1)>"9")) return 0 endif i%=i%+1 endwh return 1 endp proc addptr: chqidx%=realloc(chqidx%,count*2) rem s3a stmidx%=realloc(stmidx%,count*2) rem s3a rem s3z call($0381,0,chqidx%) rem s3z call($0381,0,stmidx%) rem s3z chqidx%=call($0081,0,(count+1)*2) rem s3z stmidx%=call($0081,0,(count+1)*2) if ((chqidx%=0)or(stmidx%=0)) alert ("Not enough memory to allocate index","Account file preserved") stop endif rem addresses might have changed, so reassign curidx% altcurp: rem s3z buildidx: wptr:(chqidx%,count-1,count) rem s3a wptr:(stmidx%,count-1,count) rem s3a endp proc altcurp: rem the addresses might have changed if (ordstat$="ChequeBook") curidx%=stmidx% else curidx%=chqidx% endif endp proc wptr:(index%,value%,count%) rem write value in address pokew uadd(index%,value%*2),count% rem s3a rem s3z pokew index%+value%*2,count% endp proc rptr%:(index%,value%) rem read value from address return (peekw(uadd(index%,value%*2))) rem s3a rem s3z return (peekw(index%+value%*2)) endp proc display:(from%,posit%) rem display current screen of entries local i%,j%,k%,pos%,lposit%,disp$(128) local amdisp$(40),tdisp$(50),lstate$(30) rem missing used to move lposit% up if lines are missing local missing%,end% local htotal rem alert(num$(from%,10),num$(posit%,10)) lposit%=posit% rem if position beyond start of file, should be unnecessary if (from%<0) filepos%=0 rem if position beyond end of file, should be unnecessary else filepos%=min(from%,count-1) endif rem the following code tries to intelligently place lposit given where rem the user suggested and the size of the file. filepos% itself is unaltered rem rem if the gap between screenpos and end of screen is greater than rem gap from file position and end of file then fill up resultant gap on screen if ((scrlen%-lposit%)>(count-filepos%-1))and(onfilt$="On") rem if there is enough left over to move downto fill whole screen if (scrlen%<count) lposit%=scrlen%-(count-filepos%-1) else rem move down the spare stuff lposit%=filepos%+1 endif endif rem simple check for small files if ((lposit%>count)and(onfilt$="On")) lposit%=count endif rem stop positioning beyond end of screen, should be unnecessary if (lposit%>scrlen%) lposit%=scrlen% endif rem alert(num$(lposit%,10),"filepos "+num$(filepos%,10)) rem i counts position on screen j counts how many printed rem j% not always i%+1; see scroll down i%=0:j%=1 gupdate off rem top of display is current - start rem this is right unless we mess about collapsing or filtering pos%=filepos%-lposit%+1 if (pos%<0) pos%=0 lposit%=filepos%+1 endif rem alert(num$(oldpos%,10),"filepos "+num$(filepos%,10)) rem only use indexes for main display rem if ((stmstat$="On")and(mrkstat$="On")and(sttstat$="On")) if ((scrpos%=1)and(lposit%=1)and(doscr%=1)) gscroll 0,linehi%,2,linehi%+3,gwidth-10,statmy%-linehi% j%=scrlen% elseif ((scrpos%=scrlen%)and(lposit%=scrlen%)and(doscr%=1)) gscroll 0,-linehi%,2,linehi%+3+linehi%,gwidth-10,statmy%-linehi% j%=scrlen% i%=scrlen%-1 endif rem turn off scroll optimizer doscr%=0 gfont zfontid%(curfont%) :gstyle 0 if (onfilt$="On") if (pos%<>0) gat (gwidth-8),linea%+linehi%+3 :gprint " " else gat (gwidth-8),linea%+linehi%+3 :gprintb " ",6 endif endif missing%=0 rem only time not k%=0 if scroll down one k%=i% position rptr%:(curidx%,pos%+k%) rem alert(clpstat$+ordstat$+A.order$+A.stm$+A.state$+mrkstat$+sttstat$+stmstat$) rem what if we are starting half way through a mark total if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")and(A.order$<>"0")and(A.stm$="x")and(A.state$<>" ")and(mrkstat$="On")and(sttstat$="On")and(stmstat$="On")) rem posibility that there is something above this (defensive coding?) lstate$=A.state$ position rptr%:(curidx%,(pos%+k%-1)) rem alert(lstate$,A.state$) if (lstate$=A.state$) rem already there, dont worry while ((A.state$=lstate$)and(pos%+k%>=1)) k%=k%-1 if (pos%+k%<filepos%) rem should always be true missing%=missing%-1 endif lstate$=A.state$ position rptr%:(curidx%,pos%+k%-1) rem alert(lstate$+"*"+A.state$+"*",num$(pos%,10)) endwh endif endif rem alert("missing "+num$(missing%,10)) pos%=pos%+k% k%=0 rem alert(num$(pos%,10)) lstate$="Nothing" htotal=0 rem initialise hold total to 0 for mark total compression while ((j%<=scrlen%)and(pos%+k%<count)) if ((stmstat$="On")and(mrkstat$="On")and(sttstat$="On")) position rptr%:(curidx%,(pos%+k%)) else position pos%+k%+1 endif if (mrkstat$="Off") gat 6,(i%*linehi%+linea%+linehi%+3) :gprintb C.mark$,55,3 gat 79,(i%*linehi%+linea%+linehi%+3) :gprintb C.amm$,statmx%-104,1 gat statmx%-21,(i%*linehi%+linea%+linehi%+3) :gprintb C.stm$,10,3 elseif (sttstat$="Off") rem dont print month and year if they are 0 if (C.mon$<>"0") gat 2,(i%*linehi%+linea%+linehi%+3) :gprintb C.mon$,28,1 rem s3a rem s3z gat 2,(i%*linehi%+linea%+linehi%+3) :gprintb C.mon$,30,1 endif if (C.yr$<>"0") gat 52,(i%*linehi%+linea%+linehi%+3) :gprintb C.yr$,48,3 rem s3a rem s3z gat 37,(i%*linehi%+linea%+linehi%+3) :gprintb C.yr$,48,3 endif gat 102,(i%*linehi%+linea%+linehi%+3) :gprintb C.type$,188,2 rem s3a gat 200,(i%*linehi%+linea%+linehi%+3) :gprintb C.amm$,90,1 rem s3a rem s3z gat 77,(i%*linehi%+linea%+linehi%+3) :gprintb C.type$,120,2 rem s3z gat 132,(i%*linehi%+linea%+linehi%+3) :gprintb C.amm$,90,1 elseif (stmstat$="Off") if (why$="Off") disp$=B.desc$+"("+B.type$+")" else disp$=B.desc$ endif gat 8,(i%*linehi%+linea%+linehi%+3) :gprintb left$(B.sdate$,8),80,3 rem s3a gat 90,(i%*linehi%+linea%+linehi%+3) :gprintb disp$,120,2 rem s3a gat 202+(40-gtwidth(B.amm$)),(i%*linehi%+linea%+linehi%+3) :gprintb B.amm$,gtwidth(B.amm$)+10,1 rem s3a gat 254,(i%*linehi%+linea%+linehi%+3) :gprintb left$(B.pdate$,8),78,3 rem s3a gat 334,(i%*linehi%+linea%+linehi%+3) :gprintb B.rep$,126,2 rem s3a rem s3z gat 5,(i%*linehi%+linea%+linehi%+3) :gprintb left$(B.sdate$,8),50,3 rem s3z gat 54,(i%*linehi%+linea%+linehi%+3) :gprintb disp$,60,2 rem s3z gat 111-gtwidth(B.amm$),(i%*linehi%+linea%+linehi%+3) :gprintb B.amm$,gtwidth(B.amm$)+1,1 rem s3z gat 112,(i%*linehi%+linea%+linehi%+3) :gprintb left$(B.pdate$,8),50,3 rem s3z gat 162,(i%*linehi%+linea%+linehi%+3) :gprintb B.rep$,70,2 if (B.always$="No") gat 388,(i%*linehi%+linea%+linehi%+3) :gprintb B.until$,71,3 rem s3a rem s3z gat 184,(i%*linehi%+linea%+linehi%+3) :gprintb B.until$,48,3 endif else if (why$="Off") disp$=A.desc$+"("+A.type$+")" else disp$=A.desc$ endif if (left$(A.amm$,1)="$") rem foriegn currancy disp$=disp$+"("+getnth$:(A.amm$,5)+getnth$:(A.amm$,2)+")" amdisp$=getnth$:(A.amm$,4) else amdisp$=A.amm$ endif if (onfilt$="Off") rem filters on if (ptrfind%:(pos%+k%,filt$,0)<>-1) rem does this line have this string on displn:(A.date$,disp$,amdisp$," ",A.state$,A.stm$,i%) else j%=j%-1 i%=i%-1 if (pos%+k%<filepos%) missing%=missing%+1 endif endif else rem normal line if (A.order$="0") rem the c/f line tdisp$=A.amm$ rem never foriegn currency for the c/f line! elseif (ordstat$="Statement") tdisp$=A.total$ else tdisp$=A.stotal$ endif if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")and(A.order$<>"0")and(A.stm$="x")and(A.state$<>" ")) rem are we collapsing rem alert(ordstat$+"*"+A.state$+"*"+lstate$+"*"+A.order$) htotal=0 lstate$=A.state$ while ((lstate$=A.state$)and(A.stm$="x")and(k%<count)) if (left$(A.amm$,1)="$") rem foriegn currancy disp$=disp$+"("+getnth$:(A.amm$,5)+getnth$:(A.amm$,2)+")" amdisp$=getnth$:(A.amm$,4) else amdisp$=A.amm$ endif if (pos%+k%<filepos%) rem only interested if before where cursor would be missing%=missing%+1 endif htotal=htotal+val(amdisp$) lstate$=A.state$ k%=k%+1 position rptr%:(curidx%,(pos%+k%)) endwh k%=k%-1 position rptr%:(curidx%,(pos%+k%)) if (ordstat$="Statement") tdisp$=A.total$ else tdisp$=A.stotal$ endif displn:(" ","Mark "+A.state$+" total",fix$(htotal,2,10),tdisp$,A.state$,A.stm$,i%) if (pos%+k%<filepos%) rem printed one now missing%=missing%-1 endif rem alert(A.state$,"missing "+num$(missing%,10)) else displn:(A.date$,disp$,amdisp$,tdisp$,A.state$,A.stm$,i%) endif endif endif i%=i%+1 j%=j%+1 k%=k%+1 endwh rem alert("missing "+num$(missing%,10)) end%=pos%+k% rem remember where we were for down arrow printing rem alert(num$(i%,10)+"*"+num$(j%,10)+"*"+num$(k%,10)+"*"+num$(pos%,10)+"*"+num$(count,10)) rem can we go back and fill in gap with rows above if ((clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")) if ((j%<=scrlen%)and(pos%+k%=count)) rem would we have continued on if not for colapsing k%=1 rem these are subtracted so go to 1 before where we started while ((pos%-k%>=0)and(j%<=scrlen%)) position rptr%:(curidx%,(pos%-k%)) gscroll 0,linehi%,2,linehi%+3,gwidth-10,statmy%-linehi% missing%=missing%-1 if (why$="Off") disp$=A.desc$+"("+A.type$+")" else disp$=A.desc$ endif if (left$(A.amm$,1)="$") rem foriegn currancy disp$=disp$+"("+getnth$:(A.amm$,5)+getnth$:(A.amm$,2)+")" amdisp$=getnth$:(A.amm$,4) else amdisp$=A.amm$ endif if (A.order$="0") rem the c/f line tdisp$=A.amm$ rem never foriegn currency for the c/f line! elseif (ordstat$="Statement") tdisp$=A.total$ else tdisp$=A.stotal$ endif if ((A.state$=" ")or(A.order$="0")) displn:(A.date$,disp$,amdisp$,tdisp$,A.state$,A.stm$,0) else htotal=0 lstate$=A.state$ while (lstate$=A.state$) rem relies on the fact that this will always terminate on a least the c/f line if (left$(A.amm$,1)="$") rem foriegn currancy disp$=disp$+"("+getnth$:(A.amm$,5)+getnth$:(A.amm$,2)+")" amdisp$=getnth$:(A.amm$,4) else amdisp$=A.amm$ endif htotal=htotal+val(amdisp$) lstate$=A.state$ k%=k%+1 position rptr%:(curidx%,(pos%-k%)) endwh k%=k%-1 position rptr%:(curidx%,(pos%-k%)) displn:(" ","Mark "+A.state$+" total",fix$(htotal,2,10),tdisp$,A.state$,A.stm$,0) endif i%=i%+1 j%=j%+1 k%=k%+1 endwh endif endif rem can we go back and fill in gap with rows above for filter if (onfilt$="Off") if ((j%<=scrlen%)and(pos%+k%=count)) rem would we have continued on if not for colapsing k%=1 rem these are subtracted so 1 before where we started while ((pos%-k%>=0)and(j%<=scrlen%)) position rptr%:(curidx%,(pos%-k%)) if (why$="Off") disp$=A.desc$+"("+A.type$+")" else disp$=A.desc$ endif if (ptrfind%:(pos%-k%,filt$,0)<>-1) rem does this line have this string on gscroll 0,linehi%,2,linehi%+3,gwidth-10,statmy%-linehi% missing%=missing%-1 if (left$(A.amm$,1)="$") rem foriegn currancy disp$=disp$+"("+getnth$:(A.amm$,5)+getnth$:(A.amm$,2)+")" amdisp$=getnth$:(A.amm$,4) else amdisp$=A.amm$ endif displn:(A.date$,disp$,amdisp$," ",A.state$,A.stm$,0) i%=i%+1 j%=j%+1 endif k%=k%+1 endwh pos%=pos%-k% endif endif if (onfilt$="Off") if (ptrfind%:(pos%,filt$,-1)<>-1) gat (gwidth-8),linea%+linehi%+3 :gprint " " else gat (gwidth-8),linea%+linehi%+3 :gprintb " ",6 endif endif while (j%<=scrlen%) rem insert blank lines to tidy up any junk gat 4,(i%*linehi%+linea%+linehi%+3) :gprintb " ",statmx%-10,3 rem s3a rem s3z gat 5,(i%*linehi%+linea%+linehi%+3) :gprintb " ",statmx%-10,3 i%=i%+1 j%=j%+1 endwh if (onfilt$="On") if ((end%)<>count) gat (gwidth-8),gheight-lined% :gprint chr$($0d) else gat (gwidth-8),gheight-lined% :gprintb " ",6 endif else if (ptrfind%:(end%,filt$,1)<>-1) gat (gwidth-8),gheight-lined% :gprint chr$($0d) else gat (gwidth-8),gheight-lined% :gprintb " ",6 endif endif rem alert("missing "+num$(missing%,10),"lposit "+num$(lposit%,10)) scrpos%=max(lposit%-missing%,1) rem if file is empty gupdate on if ((stmstat$="On")and(mrkstat$="On")and(sttstat$="On")) position rptr%:(curidx%,filepos%) else position filepos%+1 endif lastpos%=filepos% endp proc displn:(date$,disp$,amdisp$,total$,state$,stm$,i%) local ppos%,qpos%,opos%,rpos%,spos%,tpos% local psz%,qsz%,osz%,rsz%,ssz%,tsz% spos%=4 :ssz%=80 rem s3a tpos%=82 :tsz%=statmx%-90 rem s3a opos%=statmx%-201+(40-gtwidth(amdisp$)) rem s3a ppos%=statmx%-124 rem s3a qpos%=statmx%-61 :qsz%=36 rem s3a rpos%=statmx%-21 :rsz%=10 rem s3a rem s3z spos%=5 :ssz%=50 rem s3z tpos%=55 :tsz%=100 rem s3z opos%=statmx%-95-gtwidth(amdisp$) rem s3z ppos%=statmx%-94 rem s3z qpos%=statmx%-33 :qsz%=18 rem s3z rpos%=statmx%-13 :rsz%=5 gat spos%,(i%*linehi%+linea%+linehi%+3) :gprintb date$,ssz%,3 gat tpos%,(i%*linehi%+linea%+linehi%+3) :gprintb disp$,tsz%,2 gat opos%,(i%*linehi%+linea%+linehi%+3) :gprintb amdisp$,gtwidth(amdisp$)+1,1 gat ppos%,(i%*linehi%+linea%+linehi%+3) :gprintb total$,61,1 if (A.order$<>"0") rem the c/f line gat qpos%,(i%*linehi%+linea%+linehi%+3) :gprintb state$,qsz%,3 else gat qpos%,(i%*linehi%+linea%+linehi%+3) :gprintb " ",qsz%,3 endif gat rpos%,(i%*linehi%+linea%+linehi%+3) :gprintb stm$,rsz%,3 endp proc posfp%:(inc%,direct%) rem move file pos by inc% taking into account any filter local i%,b%,lstate$(20),lstm$(1),stpos% lastpos%=filepos% if ((mrkstat$="On")and(sttstat$="On")and(stmstat$="On")and(onfilt$="Off")) rem only do for Ordinary view with filter on position rptr%:(curidx%,filepos%) stpos%=-1 i%=0 b%=0 while (((abs(i%)<abs(inc%))or((abs(i%)=abs(inc%))and((ptrfind%:(filepos%+b%,filt$,0)=-1))))and(filepos%+b%>=0)and(filepos%+b%<=count)) position rptr%:(curidx%,(filepos%+b%+direct%)) if ((ptrfind%:((filepos%+b%+direct%),filt$,0)<>-1)) i%=i%+1 stpos%=filepos%+b%+direct% rem remeber where we last found something endif b%=b%+direct% rem alert(num$(i%,5)+" "+num$(b%,5)+" "+num$(direct%,5)+" "+num$(filepos%,5)+" "+num$(inc%,5)) endwh rem if we were justing looking for a home (ie inc=0) and we haven't found;look in the other direction if ((stpos%=-1)and(inc%=0)) b%=0 while ((ptrfind%:((filepos%+b%),filt$,0)=-1)and(filepos%+b%>=0)and(filepos%+b%<=count)) position rptr%:(curidx%,(filepos%+b%-direct%)) if ((ptrfind%:((filepos%+b%-direct%),filt$,0)<>-1)) stpos%=filepos%+b%-direct% rem remeber where we last found something i%=i%+1 rem just so the return works endif b%=b%-direct% endwh endif if (stpos%<>-1) filepos%=stpos% endif return i% elseif ((mrkstat$="On")and(sttstat$="On")and(stmstat$="On")and(clpstat$="Off")and(ordstat$="ChequeBook")and(onfilt$="On")) position rptr%:(curidx%,filepos%) stpos%=filepos% lstate$=A.state$ lstm$=A.stm$ i%=0 b%=0 while ((abs(i%)<abs(inc%))and(filepos%+b%>=0)and(filepos%+b%<=count-1)) if ((filepos%+b%+direct%)<=count-1) rem check we don't go down position rptr%:(curidx%,(filepos%+b%+direct%)) if ((A.state$<>lstate$)or(A.stm$<>lstm$)or(A.stm$<>"x")or(A.state$=" ")) rem alert("*"+A.state$+"*","*"+lstate$+"*") i%=i%+1 endif endif b%=b%+direct% lstate$=A.state$ lstm$=A.stm$ rem alert(num$(i%,5)+" "+num$(b%,5)+" "+num$(direct%,5)+" "+num$(filepos%,5)+" "+num$(inc%,5)) endwh filepos%=min(filepos%+b%,count-1) rem alert(num$(i%,10),num$(inc%,10)) if (i%=0) rem did we move anywhere filepos%=stpos% endif position rptr%:(curidx%,filepos%) return i% else stpos%=filepos% filepos%=min(filepos%+(inc%*direct%),count-1) return (filepos%-stpos%) endif endp proc buildidx: local x%,extra% busy "Rebuilding Indexes ..." first extra%=1 while not eof x%=val(A.order$) wptr:(chqidx%,x%,pos) x%=val(A.sorder$) if (x%=-1) rem not on statement wptr:(stmidx%,sorder%+extra%,pos) rem alert(num$(sorder%,10),num$(extra%,10)) extra%=extra%+1 else wptr:(stmidx%,x%,pos) endif next endwh busy off endp proc stmw: bankw: endp proc stmz: bankz: endp proc stmuz: bankuz: endp rem scmore.opl begins here proc stmp: bankp: endp proc stmt: gclose stmwin% dispwin%=statwin% stmstat$="On" rem process any repeat changes bankp: guse dispwin% use A rem need this to redo grey background. A quicker way? sizewin: display:(filepos%,scrpos%) endp proc stmx: bankx: endp proc stmd: position filepos%+1 if (count>0) if (sure%:("Delete entry?")) erase endif endif display:(filepos%,scrpos%) endp proc stmi: banki: endp proc stmo: banko: endp proc stmn: bankn: endp proc stme: local ds&,dp&,amm,desc$(20),type$(20),c1%,c2%,until& local dsday%,dpday%,temp% if (count=0) rem nothing here to edit return endif position filepos%+1 dp&=strtod&:(B.pdate$,"/") ds&=strtod&:(B.sdate$,"/") desc$=B.desc$ type$=B.type$ amm=val(B.amm$) c1%=which%:(stmrep$,B.rep$) c2%=which%:("Yes,No",B.always$) until&=strtod&:(B.until$,"/") dinit "Repeats details" ddate ds&,"Statement Date",0,days(31,12,2100) ddate dp&,"Processing Date",0,days(31,12,2100) dedit desc$,"Order type" dfloat amm,"Amount",-1E13,1E13 dedit type$,"Spend type" rem s3z lock on rem s3z if dialog rem s3z dinit "Repeats details (cont)" dchoice c1%,"Repeat",stmrep$ dchoice c2%,"Forever","Yes,No" ddate until&,"Repeat until",0,days(31,12,2100) lock on rem s3a if dialog if ((until&<dp&)and(c2%=2)) alert("Error: until date is before processing date") else secstodate ((ds&-days(1,1,1970))*60*60*24),temp%,temp%,dsday%,temp%,temp%,temp%,temp% secstodate ((dp&-days(1,1,1970))*60*60*24),temp%,temp%,dpday%,temp%,temp%,temp%,temp% wrstm:(ds&,dsday%,dp&,dpday%,desc$,amm,type$,getnth$:(stmrep$,c1%),getnth$:("Yes,No",c2%),until&) update display:(count,scrlen%) endif endif rem s3z endif lock off endp proc stma: local ds&,dp&,ttype$(20),amm,type$(20),c1%,c2%,until& local dsday%,dpday%,temp% ds&=days(day,month,year) dp&=days(day,month,year) until&=days(day,month,year) dinit "Repeats details" ddate ds&,"Statement Date",0,days(31,12,2100) ddate dp&,"Processing Date",0,days(31,12,2100) dedit ttype$,"Order type" dfloat amm,"Amount",-1E13,1E13 dedit type$,"Spend type" rem s3z lock on rem s3z if dialog rem s3z dinit "Repeats details (cont)" c1%=4 dchoice c1%,"Repeat",stmrep$ dchoice c2%,"Forever","Yes,No" ddate until&,"Repeat until",0,days(31,12,2100) lock on rem s3a if dialog if ((until&<dp&)and(c2%=2)) alert("Error: until date is before processing date") else secstodate ((ds&-days(1,1,1970))*60*60*24),temp%,temp%,dsday%,temp%,temp%,temp%,temp% secstodate ((dp&-days(1,1,1970))*60*60*24),temp%,temp%,dpday%,temp%,temp%,temp%,temp% wrstm:(ds&,dsday%,dp&,dpday%,ttype$,amm,type$,getnth$:(stmrep$,c1%),getnth$:("Yes,No",c2%),until&) append doscr%=1 display:(count,scrlen%) endif endif rem s3z endif lock off endp proc markc: local state$(30),i%,oldpos% position filepos%+1 if (C.stm$="x") alert("Already on statement!") elseif (C.stm$="?") alert("Some transactions already on statement","Check them on individually") else state$=C.mark$ use A rem run through in chqbook order i%=0 while (i%<count) position rptr%:(chqidx%,i%) if (A.state$=state$) checkon: endif i%=i%+1 endwh use C markj: endif endp proc markx: close delete tmpfile$ bankx: endp proc markj: gclose mrkwin% scrlen%=statlen% dispwin%=statwin% mrkstat$="On" guse dispwin% close delete tmpfile$ use A setpos: sizewin: display:(filepos%,scrpos%) endp proc marki: banki: endp proc marko: banko: endp proc markn: bankn: endp proc markz: bankz: endp proc markuz: bankuz: endp proc sttx: close delete tmpfile$ bankx: endp proc stta: local file$(128) local handle%,ret%,mode%,txt$(255),address% local c1%,c2%,delim& delim&=asc(",") file$="\wrd\stats.wrd" dinit "Save as" dfile file$,"",3 dchoice c1%,"Delimiter","Tab,Comma,Semicolon,Other" dlong delim&,"Delimiter code",0,255 if dialog busy "Writing file ..." if (c1%<>4) rem special delimiter if (c1%=1) delim&=asc(" ") endif if (c1%=2) delim&=asc(",") endif if (c1%=3) delim&=asc(";") endif endif mode%=$0100 or $0020 or $0001 ret%=ioopen(handle%,file$,mode%) if ret%<0 showerr:(ret%) return endif address%=addr(txt$) first while not eof txt$=C.mon$+chr$(delim&)+C.yr$+chr$(delim&)+C.type$+chr$(delim&)+C.amm$ ret%=iowrite(handle%,address%+1,len(txt$)) if ret%<0 showerr:(ret%) return endif next endwh ret%=ioclose(handle%) if ret% showerr:(ret%) endif busy off giprint "File written" endif endp proc stth: gclose sttwin% scrlen%=statlen% dispwin%=statwin% sttstat$="On" guse dispwin% close delete tmpfile$ use A setpos: sizewin: display:(filepos%,scrpos%) endp proc sttr: rem order stats file reorder:("Stats") use C display:(0,1) endp proc stti: banki: endp proc stto: banko: endp proc sttn: bankn: endp proc sttz: bankz: endp proc sttuz: bankuz: endp proc movev: moving$="Off" lastpos%=filepos% display:(oldpos%,scrpos%) endp proc movez: bankz: endp proc moveuz: bankuz: endp proc movex: bankx: endp proc movea: local i% position rptr%:(curidx%,filepos%) if ((ordstat$="ChequeBook")and(val(A.sorder$)=-1)) alert ("Need to place this somewhere on the statement") return endif busy "Moving..." i%=1 while (i%<=count) first if (ordstat$="Statement") if ((val(A.order$)>oldpos%)and(val(A.order$)<=filepos%)) A.order$=num$(val(A.order$)-1,10) elseif ((val(A.order$)<oldpos%)and(val(A.order$)>filepos%)) A.order$=num$(val(A.order$)+1,10) elseif ((val(A.order$)=oldpos%)and(oldpos%>filepos%)) A.order$=num$(filepos%+1,10) elseif ((val(A.order$)=oldpos%)and(oldpos%<filepos%)) A.order$=num$(filepos%,10) endif endif if (ordstat$="ChequeBook") if ((val(A.sorder$)>oldpos%)and(val(A.sorder$)<=filepos%)) A.sorder$=num$(val(A.sorder$)-1,10) elseif ((val(A.sorder$)<oldpos%)and(val(A.sorder$)>filepos%)) A.sorder$=num$(val(A.sorder$)+1,10) elseif ((val(A.sorder$)=oldpos%)and(oldpos%>filepos%)) A.sorder$=num$(filepos%+1,10) elseif ((val(A.sorder$)=oldpos%)and(oldpos%<filepos%)) A.sorder$=num$(filepos%,10) endif endif update i%=i%+1 endwh moving$="Off" busy off buildidx: lastpos%=filepos% display:(filepos%,scrpos%) endp proc movei: banki: endp proc moveo: banko: endp proc moven: bankn: endp proc findval%: local order%,x%,extra%,stmcnt% busy "Creating Indexes ..." order%=-1:sorder%=-1 total=0:stotal=0 extra%=1 rem set up indexes chqidx%=alloc(count*2) rem s3a stmidx%=alloc(count*2) rem s3a rem s3z chqidx%=call($0081,0,count*2) rem s3z stmidx%=call($0081,0,count*2) if ((chqidx%=0)or(stmidx%=0)) alert ("Not enough memory to allocate index","Account file preserved") stop endif rem unfortunately we have to find sorder% first, so scan for it first while not eof if ((sorder%<(val(A.sorder$)))and(A.stm$="x")) rem remember where last thing on statement is sorder%=(val(A.sorder$)) if (sorder%=0) rem the c/f line stotal=getamm:(A.amm$) else stotal=val(A.stotal$) endif endif next endwh first while not eof x%=val(A.order$) if (x%>=count) alert("Found index value too big ("+num$(x%,10)+")","Doing a recalc") calc: rem startagain after recalc freealloc chqidx% rem s3a freealloc stmidx% rem s3a rem s3z call($0381,0,chqidx%) rem s3z call($0381,0,stmidx%) return 0 endif wptr:(chqidx%,x%,pos) x%=val(A.sorder$) if ((x%>=count)or(sorder%+extra%>count)) alert("Statement index value too big ("+num$(x%,10)+","+num$(sorder%+extra%,10)+")","Doing a recalc") calc: rem startagain after recalc freealloc chqidx% rem s3a freealloc stmidx% rem s3a rem s3z call($0381,0,chqidx%) rem s3z call($0381,0,stmidx%) return 0 endif if (x%=-1) rem not on statement wptr:(stmidx%,sorder%+extra%,pos) extra%=extra%+1 else wptr:(stmidx%,x%,pos) endif if (val(A.order$)=count-1) if (A.order$="0") rem the c/f line total=getamm:(A.amm$) else total=val(A.total$) endif endif next endwh getpref: busy off return 1 endp proc getpref: rem get preferences from c/f line local quest$(20) rem find options from c/f line position rptr%:(chqidx%,0) typel$=A.total$ stypel$=A.stotal$ rem display spend types quest$=getnth$:(A.state$,1) rem display spend types if (quest$="On") why$="Off" else why$="On" endif rem set size off status window quest$=getnth$:(A.state$,3) rem size of status win swintp%=val(quest$) rem s3a if (swintp%=0) rem s3a statuswin off rem s3a else rem s3a statuswin on, swintp% rem s3a endif rem s3a rem set font quest$=getnth$:(A.state$,2) rem font size curfont%=val(quest$) if (curfont%>zfonts%) curfont%=zfonts% endif rem new from v2.3 so can cope with option not in file. backward compat. quest$=getnth$:(A.state$,4) rem do auto cheque numbering if ((quest$="On")or(quest$="NotFound")) rem old version go to default chqstat$="Off" else chqstat$="On" endif quest$=getnth$:(A.state$,5) rem collapse mark totals if ((quest$="Off")or(quest$="NotFound")) rem old version go to default clpstat$="On" else clpstat$="Off" endif endp proc reorder:(afield$) local last&,e$(40),e1$(40),f$(40),e%,lpos%,n$(128),c%,win%,altf$(128),val% last :last&=pos if (afield$="Statement") altf$="Chequebook" elseif (afield$="Chequebook") altf$="Statement" elseif (afield$="Stats") altf$="Statistics" elseif (afield$="Mark") altf$="Mark Totals" endif win%=createg%:("Reorder "+altf$+" ...") if count>0 rem not really necessary while last&<>0 val%=(100-(last&*100/count)) dispg:(win%,val%) position last& :e%=pos if (afield$="Stats") e$=C.type$ e1$=C.yr$ f$=C.mon$ do if ((C.type$<e$)or((C.type$=e$)and(val(C.yr$)<val(e1$)))or((C.type$=e$)and(val(C.yr$)=val(e1$))and(val(C.mon$)<=val(f$)))) e$=C.type$ :e%=pos e1$=C.yr$ f$=C.mon$ endif lpos%=pos :back until pos=1 and lpos%=1 endif if (afield$="Mark") e$=C.mark$ do if C.mark$<=e$ e$=C.mark$ :e%=pos endif lpos%=pos :back until pos=1 and lpos%=1 endif if (afield$="Statement") e$=A.order$ do if val(A.order$)<=val(e$) e$=A.order$ :e%=pos endif lpos%=pos :back until pos=1 and lpos%=1 endif if (afield$="Chequebook") e$=A.sorder$ e1$=A.sorder$ if (e1$="-1") e1$="32000" endif do rem nasty nasty hack, just need to think about it f$=A.sorder$ if (f$="-1") f$="32000" endif if ((val(f$)<val(e1$))) e$=A.sorder$ e1$=f$ e%=pos endif lpos%=pos :back until pos=1 and lpos%=1 endif position e% update :last&=last&-1 endwh endif delg:(win%) rem compress file banks: endp proc calc: local count%,lorder% count%=1 stotal=0 reorder:("Chequebook") busy "Totaling ..." first rem first one should be the carried forward if (A.desc$="c/f") stotal=getamm:(A.amm$) A.sorder$="0" update first count%=count%+1 else alert("Can't find c/f line") endif lorder%=1 while (count%<=count) if (A.stm$="x") stotal=stotal+getamm:(A.amm$) A.stotal$=fix$(stotal,2,10) A.sorder$=num$(lorder%,10) lorder%=lorder%+1 else A.stotal$="0.00" A.sorder$="-1" endif count%=count%+1 update first endwh count%=1 total=0 busy off reorder:("Statement") busy "Totalling ..." first rem first one should be the carried forward if (A.desc$="c/f") total=getamm:(A.amm$) A.order$="0" update first count%=count%+1 else alert("Can't find c/f line") endif lorder%=1 while (count%<=count) total=total+getamm:(A.amm$) A.total$=fix$(total,2,10) A.order$=num$(lorder%,10) lorder%=lorder%+1 count%=count%+1 update first endwh busy off rem compress file banks: rem unfortunately sorder% may have changed, so scan for it sorder%=-1 first while not eof if ((sorder%<(val(A.sorder$)))and(A.stm$="x")) rem remember where last thing on statement is sorder%=(val(A.sorder$)) if (sorder%=0) rem the c/f line stotal=getamm:(A.amm$) else stotal=val(A.stotal$) endif endif next endwh buildidx: endp proc createg%:(text$) rem create a guage local win%,id% local midx%,midy% midx%=(scwidth%-0)/2 midy%=(schight%-0)/2 id%=gidentity win%=gcreate(midx%-100,midy%-20,200,40,1) gborder 1 gat 8,15 gprintb text$,180,3 gat 0,18 glineby 200,0 gat 10,21 gborder $400,180,14 guse id% return win% endp proc dispg:(win%,val%) rem display gauge local i%,id% id%=gidentity guse win% gupdate off rem sc this seems to achieve nothing i%=val%+(val%-((val%/2)*2)) gat 11,22 gfill 178,12,1 gfill val%*1.78,12,0 gupdate on guse id% endp proc delg:(win%) rem delete window local id% id%=gidentity guse win% gclose win% guse id% endp proc strtod&:(date$,sep$) local dy%,mo%,yr%,sep1%,sep2% if (mid$(date$,3,1)=sep$) sep1%=3 sep2%=6 else sep1%=2 sep2%=5 endif if (mid$(date$,sep2%,1)<>sep$) sep2%=sep2%-1 endif rem alert(left$(date$,sep1%-1)) rem alert(mid$(date$,sep1%+1,sep2%-sep1%-1)) rem alert(mid$(date$,sep2%+1,2)) dy%=val(left$(date$,sep1%-1)) mo%=val(mid$(date$,sep1%+1,sep2%-sep1%-1)) yr%=val(mid$(date$,sep2%+1,2)) return ((scdtos&:(1900+yr%,mo%,dy%))/24/60/60)+days(1,1,1970) endp proc scdtos&:(yr%,mo%,dy%) rem datetosecs function that handles days like 31/2/94 local ldy%,done%,rvalue& ldy%=dy% done%=0 onerr decday do rvalue&=datetosecs (yr%,mo%,ldy%,1,1,1) done%=1 decday:: if (done%<>1) ldy%=ldy%-1 else return rvalue& endif until (done%=1) endp proc dottl:(m$,n$,p$,q$,r$,s$,mpos%,npos%,ppos%,qpos%,rpos%,spos%,tpos%) local tsize%,i% ggrey 2 rem s3a gcls ggrey 0 rem s3a gborder 0 tsize%=linehi%+2 gat 2,tsize%-lined% :gprintb m$,mpos%-2,3 gat mpos%+1,tsize%-lined% :gprintb n$,npos%-mpos%,3 gat npos%+1,tsize%-lined% :gprintb p$,ppos%-npos%,3 gat ppos%+1,tsize%-lined% :gprintb q$,qpos%-ppos%,3 gat qpos%+1,tsize%-lined% :gprintb r$,rpos%-qpos%,3 gat rpos%+1,tsize%-lined% :gprintb s$,spos%-rpos%,3 gat 0,tsize% :glineby gwidth,0 gat mpos%,tsize% :glineby 0,-tsize% gat npos%,tsize% :glineby 0,-tsize% gat ppos%,tsize% :glineby 0,-tsize% gat qpos%,tsize% :glineby 0,-tsize% gat rpos%,tsize% :glineby 0,-tsize% gat spos%,tsize% :glineby 0,-tsize% gat tpos%,tsize% :glineby 0,-tsize% ggrey 1 rem s3a gat mpos%,0 :glineby 0,gheight rem s3a gat npos%,0 :glineby 0,gheight rem s3a gat ppos%,0 :glineby 0,gheight rem s3a gat qpos%,0 :glineby 0,gheight rem s3a gat rpos%,0 :glineby 0,gheight rem s3a gat spos%,0 :glineby 0,gheight rem s3a gat tpos%,0 :glineby 0,gheight rem s3a i%=0 rem s3a do rem s3a gat 0,linehi%*i%+linehi%+3 :glineby gwidth,0 rem s3a i%=i%+1 rem s3a until i%>statlen% rem s3a rem guse dispwin% ggrey 0 rem s3a endp 
