The Datafile PD-CD 3/PDCD_3.iso/pocketbk/utilsr/scbank23/src/scbank.opl

Text File | 1994-12-21 | 87KB | 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 "[e-mail]",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 "[e-mail]",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