XProfan

' DEQ.inc

Proc DEQHelp

    font 2:Cls:Print:"\n\n============================================================"
    Print "                        D E Q H e l p"
    Print "============================================================"
    Print "\n CLEAR q&[] ' native XProfan ":Print " sz&  = SizeOf(q&[]) ' sz=5 means: 0,1,2,3,4 "
    Print " SetSize q&[],sizeof(q&[])+1 ' extended aray circa 1 place "
    Print " MakeIndexDEQ(q&[],n&) ":Print " MakeRevertIndexDEQ(q&[],n&) "
    Print " MakeConstDEQ(q&[],n&,wert&) ":Print "\n ShowDEQ q&[],nw&   ' Temporary NumWidth "
    Print "\n Wert&= PopBtm(q&[]) ' -999999999 = OutOfRange Error "
    Print " Wert&= PopTop(q&[]) ' or -999999999 ":Print " PutTop Wert&,q&[] "
    Print " PutBtm Wert&,q&[] ":Print "\n Wert&= CopyBtm(q&[]) "
    Print " Wert&= CopyTop(q&[]) ' -999999999 ":Print " Wert&= CopyFromDEQ(q&[],n&) "
    Print "\n LogVgl&=CmpInDEQ(q&[],n&,m&)' n=Pos1,m=Pos2: <1,'=0',>-1 "
    Print "\n NisM&= SwapInDEQ(q&[],n&,m&)' (N=M)=1, -999999999 "
    Print " Wert&= DelFromDEQ(q&[],n&) ":Print " DEQHelp ' this Text ausgeben":waitinput :endproc
    :proc MakeIndexDEQ :parameters q&[],n&:SetSize q&[],n&:q&[]=&index+1:endproc
    :proc MakeRevertIndexDEQ :parameters q&[],n&:SetSize q&[],n&:q&[]=n&-&index:endproc
    :proc MakeConstDEQ :parameters q&[],n&,wert&:SetSize q&[],n&:q&[]=Wert&:endproc
    :Proc PopBtm :parameters q&[]:var sz&=sizeof(q&[]):if sz&>0:var wert&=q&[0]
    q&[]=q&[&index+(&index<(sz&-1))]:setsize q&[],sizeof(q&[])-(sz&>0):return wert&
    else :return int(-999999999):endif :endproc
    :proc PopTop :parameters q&[]:declare wert&:var sz&=sizeof(q&[]):if sz&>0:wert&=q&[sz&-1]
    else :wert&=int(-999999999):endif :setsize q&[],sz&-(sz&>0):return wert&:endproc
    :Proc PutTop :parameters Wert&,q&[]:var sz&=sizeof(q&[]):inc sz&:setsize q&[],sz&:q&[sz&-1]=Wert&:endproc
    :Proc PutBtm :parameters Wert&,q&[]:declare tmp&[]:var sz&=sizeof(q&[]):inc sz&
    setsize q&[],sz&:tmp&[]=q&[]:q&[]=tmp&[&index-(&index>0)]:clear tmp&[]:q&[0]=Wert&:endproc
    :Proc CopyBtm :parameters q&[]:var sz&=sizeof(q&[]):if sz&>0:return q&[0]
    else :return int(-999999999):endif :endproc
    :proc CopyTop :parameters q&[]:declare wert&:var sz&=sizeof(q&[])

    if sz&>0:wert&=q&[sz&-1]:else :wert&=int(-999999999):endif :return wert&:endproc

        :proc ShowDEQ :parameters q&[],nw&:var tmp&=get("numwidth"):set("numwidth",nw&)
        var sz&=sizeof(q&[]):print tab(2);"n=";sz&;":  ";:whileloop 0,sz&-1:print q&[&Loop],
        endwhile :print:set("numwidth",tmp&):endproc
        :proc CopyFromDEQ :parameters q&[],n&:declare wert&:var sz&=sizeof(q&[])

        if (sz&>0) and (n&>=0) and (n&<sz&):wert&=q&[n&]:else :wert&=int(-999999999):endif :return wert&:endproc

            :Proc CmpInDEQ :parameters q&[],n&,m&
            var sz&=sizeof(q&[]):if (sz&>0) and (n&>=0) and (n&<sz&) and (m&>=0) and (m&<sz&)
            return int((q&[n&]<q&[m&])-(q&[n&]>q&[m&])):else :return int(-999999999):endif :Endproc
            :Proc SwapInDEQ :parameters q&[],n&,m&'Swaps two elements in billiardcue
            var sz&=sizeof(q&[]):if (sz&>0) and (n&>=0) and (n&<sz&) and (m&>=0) and (m&<sz&):var tmp&=q&[n&]
            q&[n&]=q&[m&]:q&[m&]=tmp&:return int(n&<>m&):else :return int(-999999999):endif :endproc
            :proc DelFromDEQ :parameters q&[],n&:var sz&=sizeof(q&[]) :declare wert&

            if (sz&>0) and (n&>0) and (n&<sz&):wert&=q&[n&]:q&[]=q&[&index+(&index>=n&)*(&index<(sz&-1))]

                dec sz&:setsize q&[],sz&:else :wert&=int(-999999999):endif :return wert&

            endproc