home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 351-375 / apd372 / jason_banks / queue.amos / queue.amosSourceCode
AMOS Source Code  |  1991-06-13  |  7KB  |  207 lines
  1. '
  2. ' Queue.amos 
  3. '
  4. ' (c) 12/91 Jason Banks - Routines used to manipulate a double-linked list 
  5. '
  6. ' Program to demonstrate use of linked lists - see docs procedure for notes
  7. '
  8. LISTBASE=0
  9. '
  10. _NEXT=0 : _PREV=4 : Rem add in other data-pointers here. 
  11. _CARDNO=8 : _CARDVAL=12 : SIZEOF=16
  12. '
  13. Global _NEXT,_PREV,_CARDNO,_CARDVAL,SIZEOF
  14. '
  15. ' Structure is:- 
  16. ' 00   Next     long 
  17. ' 04   Prev     long 
  18. ' 08   cardno   word 
  19. ' 0A   cost     word 
  20. '
  21. INITSCREEN
  22. MAINMENU
  23. '
  24. ' Specific Use (Main Program Body) procedures
  25. '
  26. Procedure MAINMENU
  27.    Shared LISTBASE
  28.    DNE=False
  29.    While Not DNE
  30.       Cls 0
  31.       Locate 2,2 : Centre "QUEUE"
  32.       Locate 2,3 : Centre "Christmas Card List"
  33.       Locate 0,10 : Centre "1 ... Add New Card to list"
  34.       Locate 0,11 : Centre "2 ...       List all cards"
  35.       Locate 0,12 : Centre "3 ...        Delete A Card"
  36.       Locate 0,13 : Centre "4 ...        Locate a Card"
  37.       Locate 0,16 : Centre "0 ...    Quit this program"
  38.       _GETOPT["12340"] : OPT$=Param$
  39.       On Val(OPT$) Proc _ADD,_LIST,_DELETE,_LOCATE
  40.       If OPT$="0" Then DNE=True
  41.    Wend 
  42.    _KILLLIST[LISTBASE,SIZEOF] : Cls 0 : Home : Print Param;" items deleted!" : Clear Key : Wait Key 
  43. End Proc
  44. Procedure INITSCREEN
  45.    While Screen>-1 : Screen Close Screen : Wend 
  46.    Screen Open 0,640,256,4,Hires : Curs Off : Flash Off : Hide On : Palette Colour(1),0 : Cls 0 : Pen 1 : Paper 0 : Ink 1,0,0
  47. End Proc
  48. Procedure _ADD
  49.    Shared LISTBASE
  50.    Cls 0
  51.    Locate 0,5 : Centre "Add New Record"
  52.    Locate 0,10 : Input "Card #     : ";CNO
  53.    Locate 0,11 : Input "Card Value : ";CVAL#
  54.    _GETMEM[16] : ITEM=Param : Loke ITEM+_CARDNO,CNO : Loke ITEM+_CARDVAL,CVAL#*100
  55.    _ADDLIST[LISTBASE,ITEM] : LISTBASE=Param
  56. End Proc
  57. Procedure _LIST
  58.    Shared LISTBASE
  59.    If LISTBASE=0 Then Pop Proc Else Cls 0 : Home 
  60.    STRT=LISTBASE : COUNT=0
  61.    While STRT<>0 and COUNT>-1
  62.       Inc COUNT
  63.       Print COUNT,"# ";Leek(STRT+_CARDNO),"$ ";(Leek(STRT+_CARDVAL)/100)
  64.       If COUNT mod 20=0 Then Print "Continue? [Y/N]" : _GETOPT["YN"] : If OPT$="N" Then COUNT=-5
  65.       _GETNEXT[STRT] : STRT=Param
  66.    Wend 
  67.    If COUNT mod 20<>0 and COUNT>0 Then Clear Key : Wait Key 
  68. End Proc
  69. Procedure _DELETE
  70.    Shared LISTBASE
  71.    _REMOVE[LISTBASE,LISTBASE,SIZEOF] : LISTBASE=Param
  72. End Proc
  73. Procedure _LOCATE
  74.    Shared LISTBASE
  75.    Cls : Locate 0,5 : Centre "LOCATE:-"
  76.    Locate 0,10 : Input "Card # = ";CNO : CVAL=0 : ITEM=LISTBASE
  77.    While ITEM<>0 and CVAL=0
  78.       If Leek(ITEM+_CARDNO)=CNO
  79.          CVAL=Leek(ITEM+_CARDVAL)
  80.       Else 
  81.          _GETNEXT[ITEM] : ITEM=Param
  82.       End If 
  83.    Wend 
  84.    If CVAL<>0
  85.       Cls 0 : Home : Print "Card found at ";Hex$(ITEM);" with value of : ",(CVAL/100)
  86.    Else 
  87.       Cls 0 : Home : Centre "Card Not Found!"
  88.    End If 
  89.    Clear Key : Wait Key 
  90. End Proc
  91. '
  92. ' general use procedures 
  93. '
  94. Procedure _ADDLIST[LISTBASE,ITEM]
  95. ' TAKES THE LOCATION OF A PRE-DEFINED DATA ELEMENT, AND ADDS IT INTO THE LIST
  96. ' usage is :: _ADDLIST[listbase,itemptr] : listbase=param
  97. '
  98.    NEWLISTBASE=ITEM
  99.    Loke ITEM+_PREV,0
  100.    If LISTBASE=0
  101.       Loke ITEM+_NEXT,0
  102.    Else 
  103.       Loke ITEM+_NEXT,LISTBASE
  104.       TEMPITEM=LISTBASE
  105.       Loke TEMPITEM+_PREV,ITEM
  106.    End If 
  107. End Proc[NEWLISTBASE]
  108. Procedure _INSERT[LISTBASE,ITEMPTR,ITEM]
  109. ' Inserts a data element in the list, before the itemptr passed as a pointer 
  110. ' usage is :: _INSERT[Listbase,insertposition,itemptr] : listbase=param  
  111. '
  112.    If Leek(ITEMPTR+_PREV)=0
  113.    ' at start of list!
  114.       _ADDLIST[LISTBASE,ITEM] : LISTBASE=Param
  115.    Else 
  116.       PPTR=Leek(ITEMPTR+_PREV)
  117.       Loke PPTR+_NEXT,ITEM : Loke ITEMPTR+_PREV,ITEM
  118.       Loke ITEM+_NEXT,ITEMPTR : Loke ITEM+_PREV,PPTR
  119.    End If 
  120. End Proc[LISTBASE]
  121. Procedure _GETNEXT[ITEM]
  122. ' Returns the address of the next item in the list 
  123. ' usage is :: _Getnext[item] : itemnext=param  
  124.    If ITEM=0
  125.       NITEM=0
  126.    Else 
  127.       NITEM=Leek(ITEM+_NEXT)
  128.    End If 
  129. End Proc[NITEM]
  130. Procedure _GETPREV[ITEM]
  131. ' Returns the address of the previous item in the list 
  132. ' usage is :: _GetPrev[item]: itemprev=param 
  133.    If ITEM=0
  134.       PITEM=0
  135.    Else 
  136.       PITEM=Leek(ITEM+_PREV)
  137.    End If 
  138. End Proc[PITEM]
  139. Procedure _GETFIRST[ITEM]
  140. ' This can be used to find the start of a list, when the LISTBASE has been lost, or is unknown.
  141. ' a problem that can occur here, is that in a circular-linked list (one that does not have a start or end) 
  142. ' this can possibly cause an infinite loop.
  143. ' usage _getfirst[item] : strt=param 
  144. '
  145.    _GETNEXT[ITEM] : STP=Param
  146.    While(Leek(ITEM+_PREV)<>0) and(ITEM<>STP)
  147.       ITEM=Leek(ITEM+_PREV)
  148.    Wend 
  149. End Proc
  150. Procedure _GETLAST[ITEM]
  151. ' This can be used to find the end item of a lst.
  152. ' usage _getlast[item] : finish=param  
  153. '
  154.    _GETPREV[ITEM] : STP=Param
  155.    While(Leek(ITEM+_NEXT)<>0) and(ITEM<>STP)
  156.       ITEM=Leek(ITEM+_NEXT)
  157.    Wend 
  158. End Proc
  159. Procedure _REMOVE[LISTBASE,ITEM,SIZE]
  160. ' can be used to delete a record from the list. Note that it is essential that you get all of the parameters 
  161. ' correct - it always is, but this can crash the computer VERY VERY easily.
  162. ' Usage :: _Remove[Listbase,Itemptr,SizeofItem]
  163. '  
  164.    If ITEM=0 or LISTBASE=0 Then Pop Proc
  165.    NITEM=Leek(ITEM+_NEXT) : PITEM=Leek(ITEM+_PREV)
  166.    _FREEMEM[ITEM,SIZE]
  167.    If NITEM<>0 Then Loke NITEM+_PREV,PITEM
  168.    If PITEM<>0 Then Loke PITEM+_NEXT,NITEM
  169.    If PITEM=0 Then LISTBASE=NITEM
  170. End Proc[LISTBASE]
  171. Procedure _GETMEM[SIZE]
  172.    Dreg(0)=SIZE : Dreg(1)=$10001 : PTR=Execall(-198)
  173. End Proc[PTR]
  174. Procedure _FREEMEM[PTR,SIZE]
  175.    Dreg(0)=SIZE : Areg(1)=PTR : DUMMY=Execall(-210)
  176. End Proc
  177. Procedure _KILLLIST[LISTBASE,SIZE]
  178. ' This procedure kills an entire list, and thus free's the memory consumed by it.
  179. ' USAGE :: _KIlllist[listbase,sizeofitem]
  180. '
  181.    ITEM=LISTBASE : ICOUNT=0
  182.    While ITEM<>0
  183.       NITEM=Leek(ITEM+_NEXT) : _FREEMEM[ITEM,SIZE] : ITEM=NITEM : Inc ICOUNT
  184.       ' note that we are not using the _REMOVE procedure.
  185.       ' this is because we do not need to use a "Safe" procedure,
  186.       ' as we don't care what happens to the list once we've deleted it! 
  187.    Wend 
  188.    LISTBASE=0
  189. End Proc[ICOUNT]
  190. Procedure _DOCS
  191. '
  192. ' This is a simple program that will keep track of a list of numbers,
  193. ' used to represent a christmas card, and the cost of that christmas card
  194. ' in pence.
  195. '
  196. ' Also note, that I've altered the KILLLIST procedure a little, so that it returns 
  197. ' as a param, the number of records that it has deleted. This is so that you can check 
  198. ' that the program is working properly. One of the major drawbacks (and advantages at times!)
  199. ' of working with linked lists, is that they are totally dependant on the programmer - one mistake 
  200. ' and you can loose the entire list!, while the basic arrays are a "Safe" (but slow) form of 
  201. ' storing data.
  202. '
  203. End Proc
  204. Procedure _GETOPT[TXT$]
  205.    TXT$=Upper$(TXT$) : OUT$=""
  206.    While Instr(TXT$,OUT$)<1 : OUT$=Upper$(Inkey$) : Wend 
  207. End Proc[OUT$]