home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 051-075 / apd064 / scrolist.amos / scrolist.amosSourceCode
AMOS Source Code  |  1990-10-31  |  4KB  |  124 lines
  1. Rem ************************************** 
  2. Rem * AMOS : Scrolling List  by          * 
  3. Rem *                        G.Lancaster * 
  4. Rem ************************************** 
  5. Rem * NOTE: This program uses the data   * 
  6. Rem * file SCROLIST.DAT on this disk for * 
  7. Rem * the demo. It is just a normal ASCII* 
  8. Rem * file. Feel free to mess around!    * 
  9. Rem ************************************** 
  10. Rem * Need help? Want to swap ideas?     * 
  11. Rem * Drop me a line at this address;    * 
  12. Rem *                                    * 
  13. Rem * Gareth Lancaster                   * 
  14. Rem * 40, Appleby Gardens                * 
  15. Rem * Dunstable                          * 
  16. Rem * Bedfordshire                       * 
  17. Rem * LU6 3DB                            * 
  18. Rem *                                    * 
  19. Rem ************************************** 
  20. Screen Open 0,320,256,32,Lowres : Dim A$(50)
  21. Paper 0 : Pen 15 : Cls 
  22. Global A$(),G,POSITION,COI,POS
  23. POSITION=1 : POS=1
  24. Locate 16,4 : Print "INSTRUCTIONS"
  25. Locate 16,5 : Print "~~~~~~~~~~~~"
  26. Locate 16,7 : Print "Joy UP    = scroll up"
  27. Locate 16,8 : Print "Joy DOWN  = scroll down"
  28. Locate 16,9 : Print "Joy LEFT  = go to top"
  29. Locate 16,10 : Print "Joy RIGHT = go to bottom"
  30. Locate 16,11 : Print "Joy FIRE  = choose"
  31. Locate 16,13 : Print "Also you can use cursor"
  32. Locate 16,14 : Print "keys  with  'RETURN' to"
  33. Locate 16,15 : Print "        choose"
  34. Locate 16,17 : Print "Check source for hints!"
  35. Locate 16,18 : Print "Press Q to quit program"
  36. Rem **************************************   
  37. Rem * To call;                           *   
  38. Rem * ~~~~~~~~                           *   
  39. Rem * SCROLIST[l,i,x,y,b,m]              *   
  40. Rem * ~~~~~~~~~~~~~~~~~~~~~              *   
  41. Rem * l = length of string (size of box) * 
  42. Rem * i = number of items on screen      * 
  43. Rem * x = x position on screen           * 
  44. Rem * y = y position on screen           * 
  45. Rem * b = border 1 = yes : other = no    * 
  46. Rem * m = method for highlight           * 
  47. Rem *      1 = different ink colour      * 
  48. Rem *      2 = invert choice             * 
  49. Rem *      3 = shade all but choice      * 
  50. Rem *      4 = under line choice         * 
  51. Rem ************************************** 
  52. LOPSC:
  53. SCROLIST[9,15,5,5,1,2]
  54. Locate 5,22 : Cline : Print "YOUR CHOICE: ";A$(COI)
  55. Goto LOPSC
  56. Procedure SCROLIST[LGTH,ITEMS,LOCX,LOCY,BORD,METHOD]
  57.    Open In 1,"scrolist.dat"
  58.    For F=1 To 50
  59.    If Eof(1) Then F=F-1 : Close 1 : Goto LABEL
  60.    Input #1,B$
  61.    A$(F)=B$
  62.    Next F
  63.    LABEL:
  64.    Curs Off 
  65.    For G=1 To F
  66.    If Len(A$(G))<LGTH Then A$(G)=A$(G)+Space$(LGTH-Len(A$(G)))
  67.    If Len(A$(G))>LGTH Then A$(G)=Mid$(A$(G),1,LGTH)
  68.    Next G
  69.    G=F
  70. If BORD=1 Then BORDPRINT[LOCX-1,LOCY-1,LGTH+2,ITEMS+2,1]
  71. LABEL2:
  72.    For F=POSITION To POSITION+ITEMS
  73.    If METHOD=3 Then Shade On 
  74.    Locate LOCX,LOCY+(F-POSITION)-1
  75.    If F=POSITION+POS-1 Then Gosub METHODPEN : Print A$(F) : Pen 15 : Paper 0 : If METHOD=3 : Shade On : End If : Under Off : Goto 2
  76.    Print A$(F)
  77.    2 Next F
  78.    1 Q$=Inkey$
  79.    SAC=Scancode
  80.    If Upper$(Q$)="Q" Then Run "autoexec.amos"
  81.    If Q$=Chr$(30) Then Gosub ROUT1 : Goto LABEL2
  82.    If Jup(1) and Fire(1)=0 Then Gosub ROUT1 : Goto LABEL2
  83.    If Q$=Chr$(31) Then Gosub ROUT2 : Goto LABEL2
  84.    If Jdown(1) and Fire(1)=0 Then Gosub ROUT2 : Goto LABEL2
  85.    If Q$=Chr$(13) Then COI=POS+POSITION-1 : Pop Proc
  86.    If Fire(1) and Jup(1)=0 and Jdown(1)=0 Then COI=POS+POSITION-1 : Pop Proc
  87.    If Q$=Chr$(28) Then POSITION=G-ITEMS : POS=ITEMS+1 : Goto LABEL2
  88.    If Jright(1) and Fire(1)=0 Then POSITION=G-ITEMS : POS=ITEMS+1 : Goto LABEL2
  89.    If Q$=Chr$(29) Then POSITION=1 : POS=1 : Goto LABEL2
  90.    If Jleft(1) and Fire(1)=0 Then POSITION=1 : POS=1 : Goto LABEL2
  91.    Goto 1
  92.    ROUT1:
  93.       If POS>1 Then POS=POS-1 : Return 
  94.       If POSITION>1 Then POSITION=POSITION-1 : Return 
  95.    Return 
  96.    ROUT2:
  97.       If POS<ITEMS+1 Then POS=POS+1 : Return 
  98.       If POSITION<G-ITEMS Then POSITION=POSITION+1 : Return 
  99.    Return 
  100. METHODPEN:
  101. If METHOD=1 Then Pen 4 : Return 
  102. If METHOD=2 Then Paper 15 : Pen 0 : Return 
  103. If METHOD=3 Then Shade Off : Return 
  104. If METHOD=4 Then Under On : Return 
  105. Pen 4 : Return 
  106. End Proc
  107. Procedure BORDPRINT[CX,CY,CL,CI,CO]
  108.    Pen CO
  109.    Locate CX,CY-1 : Print Chr$(136);
  110.    For F=1 To CL-2
  111.    Print Chr$(137);
  112.    Next F
  113.    Print Chr$(138)
  114.    For F=CY+1 To CY+CI-1
  115.    Locate CX,F-1 : Print Chr$(139)
  116.    Locate CX+CL-1,F-1 : Print Chr$(139)
  117.    Next F
  118.    Locate CX,CY+CI-1 : Print Chr$(140);
  119.    For F=1 To CL-2
  120.    Print Chr$(137);
  121.    Next F
  122.    Print Chr$(141)
  123.    Pen 15
  124. End Proc