XProfan

' DEQ.inc

Proc DEQHelp

    font 2:Cls:Imprimir:"\n\n============================================================"
    Imprimir "                        D E Q H e l p"
    Imprimir "============================================================"
    Imprimir "\n CLEAR q&[] ' natives XProfan ":Imprimir " sz&  = SizeOf(q&[]) ' sz=5 bedeutet: 0,1,2,3,4 "
    Imprimir " SetSize q&[],sizeof(q&[])+1 ' erweitert Array en 1 Punto "
    Imprimir " MakeIndexDEQ(q&[],n&) ":Imprimir " MakeRevertIndexDEQ(q&[],n&) "
    Imprimir " MakeConstDEQ(q&[],n&,wert&) ":Imprimir "\n ShowDEQ q&[],nw&   ' Temporary NumWidth "
    Imprimir "\n Wert&= PopBtm(q&[]) ' -999999999 = OutOfRange Error "
    Imprimir " Wert&= PopTop(q&[]) ' or -999999999 ":Imprimir " PutTop Wert&,q&[] "
    Imprimir " PutBtm Wert&,q&[] ":Imprimir "\n Wert&= CopyBtm(q&[]) "
    Imprimir " Wert&= CopyTop(q&[]) ' -999999999 ":Imprimir " Wert&= CopyFromDEQ(q&[],n&) "
    Imprimir "\n LogVgl&=CmpInDEQ(q&[],n&,m&)' n=Pos1,m=Pos2: <1,'=0',>-1 "
    Imprimir "\n NisM&= SwapInDEQ(q&[],n&,m&)' (N=M)=1, -999999999 "
    Imprimir " Wert&= DelFromDEQ(q&[],n&) ":Imprimir " DEQHelp ' esta Texto ausgeben":waitinput :ENDPROC
    :proc MakeIndexDEQ :parámetros q&[],n&:SetSize q&[],n&:q&[]=&index+1:ENDPROC
    :proc MakeRevertIndexDEQ :parámetros q&[],n&:SetSize q&[],n&:q&[]=n&-&index:ENDPROC
    :proc MakeConstDEQ :parámetros q&[],n&,wert&:SetSize q&[],n&:q&[]=Wert&:ENDPROC
    :Proc PopBtm :parámetros q&[]:var sz&=sizeof(q&[]):if sz&>0:var wert&=q&[0]
    q&[]=q&[&index+(&index<(sz&-1))]:setsize q&[],sizeof(q&[])-(sz&>0):volver wert&
    más :volver int(-999999999):endif :ENDPROC
    :proc PopTop :parámetros q&[]:declarar wert&:var sz&=sizeof(q&[]):if sz&>0:wert&=q&[sz&-1]
    más :wert&=int(-999999999):endif :setsize q&[],sz&-(sz&>0):volver wert&:ENDPROC
    :Proc PutTop :parámetros Wert&,q&[]:var sz&=sizeof(q&[]):inc sz&:setsize q&[],sz&:q&[sz&-1]=Wert&:ENDPROC
    :Proc PutBtm :parámetros Wert&,q&[]:declarar 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 :parámetros q&[]:var sz&=sizeof(q&[]):if sz&>0:volver q&[0]
    más :volver int(-999999999):endif :ENDPROC
    :proc CopyTop :parámetros q&[]:declarar wert&:var sz&=sizeof(q&[])

    if sz&>0:wert&=q&[sz&-1]:más :wert&=int(-999999999):endif :volver wert&:ENDPROC

        :proc ShowDEQ :parámetros q&[],nw&:var tmp&=get("numwidth"):set("numwidth",nw&)
        var sz&=sizeof(q&[]):imprimir tab(2);"n=";sz&;":  ";:whileloop 0,sz&-1:imprimir q&[&Loop],
        endwhile :imprimir:set("numwidth",tmp&):ENDPROC
        :proc CopyFromDEQ :parámetros q&[],n&:declarar wert&:var sz&=sizeof(q&[])

        if (sz&>0) and (n&>=0) and (n&<sz&):wert&=q&[n&]:más :wert&=int(-999999999):endif :volver wert&:ENDPROC

            :Proc CmpInDEQ :parámetros q&[],n&,m&
            var sz&=sizeof(q&[]):if (sz&>0) and (n&>=0) and (n&<sz&) and (m&>=0) and (m&<sz&)
            volver int((q&[n&]<q&[m&])-(q&[n&]>q&[m&])):más :volver int(-999999999):endif :ENDPROC
            :Proc SwapInDEQ :parámetros q&[],n&,m&'Swaps two elements en Queue
            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&:volver int(n&<>m&):más :volver int(-999999999):endif :ENDPROC
            :proc DelFromDEQ :parámetros q&[],n&:var sz&=sizeof(q&[]) :declarar 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&:más :wert&=int(-999999999):endif :volver wert&

            ENDPROC