'PRIORITY QUEUE WITH 16 LEVELS

uses console

% pl 16 'priority levels

===================
Class PriorityQueue
===================

indexbase 1
bstring buf[pl] 'buffers to hold priority queues content
int      bg[pl] 'buffers base offset
int       i[pl] 'indexers
int      le[pl] 'length of buffer

method constructor()
====================
int p
for p=1 to pl
  buf[p]=""
  le[p]=0
  bg[p]=0
  i=[p]=0
next
end method

method destructor()
===================
int p
for p=1 to pl
  del (buf[p])
  le[p]=0
  bg[p]=0
  i=[p]=0
next
end method

method Encodelength(int ls,p)
=============================
int ll at i[p]+strptr(buf[p])
ll=ls
i[p]+=sizeof int
end method

method limit(int*p)
===================
if p>pl
  p=pl
endif
if p<1
  p=1
endif
end method

method push(string s,int p)
=============================
limit p
int ls
ls=len s
if i[p]+ls+8 > le[p] then
  int e=8000+(ls*2) 'extra buffer bytes
  buf[p]=buf[p]+nuls e 'extend buf
  le[p]=len buf[p]
end if
EncodeLength ls,p   'length of input s
mid buf[p],i[p]+1,s 'patch in s
i[p]+=ls
end method


method popLength(int p) as int
==============================
if bg[p]>=i[p]
  return -1 'buffer empty
endif
int ll at (bg[p]+strptr buf[p])
bg[p]+=sizeof int
return ll
end method

method pop(string *s, int *p=1, lpl=0) as int
=============================================
limit p
int ls
do
  ls=popLength p
  if ls=-1
    if not lpl 'lpl: lock priority level
      p++ 'try next priority level
      if p<=pl
        continue do
      endif
    endif
    s=""
    return ls 'empty buffers
  endif
  exit do
loop
s=mid buf[p],bg[p]+1,ls
bg[p]+=ls
'cleanup buffer
if bg[p]>1e6 then
  buf[p]=mid buf[p],bg[p]+1 'remove old popped data
  le[p]=len buf[p]
  i[p]-=bg[p] 'shrink buf
  bg[p]=0
end if
end method

method clear()
==============
constructor
end method


end class 'PriorityQueue


'====
'DEMO
'====
new PriorityQueue  medo()
string s

def inp
  medo.push %2,%1
end def

'   Priority         Task
'   ══════════         ════════════════
inp        3         "Clear drains"
inp        4         "Feed cat"
inp        5         "Make tea"
inp        1         "Solve RC tasks"
inp        2         "Tax return"
inp        4         "Plant beans"
'
int er
int p
print "Priority Task" cr
print "=================" cr
do
  er=medo.pop s,p
  if er=-1
    print "(buffer empty)"
    exit do
  endif
  print p tab s cr
loop
pause
del medo

/*
RESULTS:
Priority Task
=================
1       Solve RC tasks
2       Tax return
3       Clear drains
4       Feed cat
4       Plant beans
5       Make tea
(buffer empty)
*/