home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 4: Phase Four / 17Bit_Phase_Four.iso / files / 3023.dms / 3023.adf / Source-Code / ListBase / ListBase.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1994-02-21  |  12.2 KB  |  146 lines
  1. ' ListBase (c) John White, 1993. All rights reserved.
  2. Close Workbench : Close Editor : Hide On : Dim YZ(7) : Dim H$(11) : Dim XH(11) : Dim YH(11)
  3. A$="                         " : B$="                           " : C$="                                                                    " : D$="                        " : I$="   "
  4. E$="                     " : F$="                                                " : G$="                                                                 "
  5. H$(0)="                                                                            " : H$(1)="                                                                            "
  6. H$(2)="                                                                            " : H$(3)="                                                                            "
  7. H$(4)="                                                                            " : H$(5)="                                                                            "
  8. H$(6)="                                                                            " : H$(7)="                                                                            "
  9. H$(8)="                                                                            " : H$(9)="                                                                            "
  10. H$(10)="                                                                            " : H$(11)="                                                                            "
  11. Erase 15 : Reserve As Chip Work 15,35791 : TT=Start(15) : For Z=0 To 35790 : Poke TT+Z,32 : Next Z
  12. Q=0 : R=0 : S=1 : T=12 : U=36 : V=0 : W=0 : X=12 : Y=2 : YU=0 : Gosub 24 : Gosub 25 : Screen Open 1,640,80,4,Hires : Screen Hide 1 : Curs Off : Flash Off : Screen Display 1,128,145,640,60
  13. Screen Open 0,640,273,8,Hires : Unpack 14 To 0 : Screen Hide 0 : Curs Off : Paper 0 : Pen 5 : Flash Off : Screen Display 0,128,33,640,273 : Paste Bob 393,216,1 : Paste Bob 393,238,3 : Paste Bob 471,216,5 : Paste Bob 471,238,8 : Paste Bob 548,216,9
  14. Paste Bob 159,216,24 : Paste Bob 232,238,26 : Paste Bob 19,222,21 : Paste Bob 589,216,11 : Paste Bob 217,216,13 : Paste Bob 260,216,19 : Paste Bob 304,216,17 : Paste Bob 548,238,22 : Paste Bob 300,238,23 : Paste Bob 346,216,15
  15. Paste Bob 159,238,28 : Print At(1,2);"Disk Name";At(40,2);"Author(s)";At(1,4);"Address";At(1,6);"Subject(s)";At(40,6);"Type of Prog(s)";At(1,8);"No. of Disks";At(22,8);"Rating";At(1,10);"Works on a" : Limit Mouse 128,42 To 440,290
  16. Get Palette 0 : For Z=0 To 7 : YZ(Z)=Colour(Z) : Colour Z,0 : Next Z : Screen Show 0 : Fade 1,YZ(0),YZ(1),YZ(2),YZ(3),YZ(4),YZ(5),YZ(6),YZ(7) : Wait 8 : Paper 2 : Pen 1 : Show On 
  17. 0
  18. Reserve Zone 13 : Set Zone 1,393,216 To 456,232 : Set Zone 2,393,238 To 456,254 : Set Zone 3,471,216 To 534,232 : Set Zone 4,471,238 To 534,254 : Set Zone 5,548,216 To 581,232 : Set Zone 6,589,216 To 622,232 : Set Zone 7,217,216 To 250,232
  19. Set Zone 8,260,216 To 293,232 : Set Zone 9,304,216 To 337,232 : Set Zone 10,346,216 To 379,232 : Set Zone 11,159,216 To 209,232 : Set Zone 12,232,238 To 292,254 : Set Zone 13,159,238 To 222,254
  20. 1
  21. Z$=Inkey$ : SC=Scancode : MZ=Mouse Zone : MK=Mouse Key : If Z$=>Chr$(32) and S=0 Then If Z$<Chr$(127) and S=0 Then Q=0 : Gosub 12
  22. If SC=70 and S=0 Then Gosub 13
  23. If MZ=13 and MK=1 Then Paste Bob 159,238,29 : End 
  24. If MZ=8 and MK=1 and S=0 or SC=79 and S=0 Then Paste Bob 217,216,13 : Paste Bob 260,216,20 : Paste Bob 304,216,17 : Paste Bob 346,216,15 : If R>0 Then Dec R : Gosub 18 : Gosub 11 : Gosub 28
  25. If MZ=9 and MK=1 and S=0 or SC=78 and S=0 Then Paste Bob 217,216,13 : Paste Bob 260,216,19 : Paste Bob 304,216,18 : Paste Bob 346,216,15 : If R<29 Then Add R,1 : Gosub 19 : Gosub 11 : Gosub 28
  26. If MZ=8 and MK=1 and S=1 or SC=79 and S=1 Then Paste Bob 217,216,13 : Paste Bob 260,216,20 : Paste Bob 304,216,17 : Paste Bob 346,216,15 : If R>0 Then Dec R : Gosub 18 : Gosub 16 : Gosub 28
  27. If MZ=9 and MK=1 and S=1 or SC=78 and S=1 Then Paste Bob 217,216,13 : Paste Bob 260,216,19 : Paste Bob 304,216,18 : Paste Bob 346,216,15 : If R<29 Then Add R,1 : Gosub 19 : Gosub 16 : Gosub 28
  28. If MZ=7 and MK=1 and S=0 Then Paste Bob 217,216,14 : Paste Bob 260,216,19 : Paste Bob 304,216,17 : Paste Bob 346,216,15 : R=0 : Gosub 25 : Gosub 11 : Gosub 28
  29. If MZ=10 and MK=1 and S=0 Then Paste Bob 217,216,13 : Paste Bob 260,216,19 : Paste Bob 304,216,17 : Paste Bob 346,216,16 : R=29 : Gosub 26 : Gosub 11 : Gosub 28
  30. If MZ=7 and MK=1 and S=1 Then Paste Bob 217,216,14 : Paste Bob 260,216,19 : Paste Bob 304,216,17 : Paste Bob 346,216,15 : R=0 : Gosub 25 : Gosub 16 : Gosub 28
  31. If MZ=10 and MK=1 and S=1 Then Paste Bob 217,216,13 : Paste Bob 260,216,19 : Paste Bob 304,216,17 : Paste Bob 346,216,16 : R=29 : Gosub 26 : Gosub 16 : Gosub 28
  32. If R+1<10 Then Text 344,249,Str$(R+1)+" "
  33. If R+1>9 Then Text 344,249,Str$(R+1)
  34. If MZ=1 and MK=1 Then Paste Bob 393,216,2 : Paper 3 : Pen 4 : Gosub 32 : If Exist("DF0:"+W$) Then Erase 15 : Load "DF0:"+W$,15 : Paste Bob 393,216,1 : Gosub 28 Else Paste Bob 393,216,1
  35. If MZ=2 and MK=1 Then Paste Bob 393,238,4 : Paper 3 : Pen 4 : Gosub 32 : Save "DF0:"+W$,15 : Paste Bob 393,238,3
  36. If MZ=3 and MK=1 Then Paste Bob 471,216,6 : Paste Bob 471,238,7 : S=0
  37. If MZ=4 and MK=1 Then Paste Bob 471,238,8 : Paste Bob 471,216,5 : S=1
  38. If MZ=6 and MK=1 and S=0 or SC=77 and S=0 Then YU=1 : Paste Bob 548,216,9 : Paste Bob 589,216,12 : Add W,1 : Gosub 11 : YU=0
  39. If MZ=5 and MK=1 and S=0 or SC=76 and S=0 Then YU=1 : Paste Bob 589,216,11 : Paste Bob 548,216,10 : Dec W : Gosub 11 : YU=0
  40. If MZ=6 and MK=1 and S=1 or SC=77 and S=1 Then Paste Bob 548,216,9 : Paste Bob 589,216,12 : Add W,1 : Gosub 16
  41. If MZ=5 and MK=1 and S=1 or SC=76 and S=1 Then Paste Bob 589,216,11 : Paste Bob 548,216,10 : Dec W : Gosub 16
  42. If W+1<10 Then Text 587,249,Str$(W+1)+" "
  43. If W+1>9 Then Text 587,249,Str$(W+1)
  44. If MZ=11 and MK=1 and S=0 Then Paste Bob 159,216,25 : Gosub 23 : Paste Bob 159,216,24
  45. If MZ=12 and MK=1 or SC=95 Then Paste Bob 232,238,27 : Gosub 10 : Paste Bob 232,238,26
  46. Goto 1
  47. 10
  48. Screen 1 : Paper 3 : Pen 1 : Ink 1 : Get Palette 0 : Cls 0 : For Z=0 To 7 : Print At(0,Z);"                                                                                " : Next Z : Draw 0,0 To 639,0 : Draw 0,59 To 639,59 : Ink 3
  49. Draw 0,1 To 639,1 : Draw 0,58 To 639,58 : Ink 1 : Draw 0,2 To 639,2 : Draw 0,57 To 639,57 : Ink 0 : Draw 0,3 To 639,3 : Draw 0,56 To 639,56 : Print At(1,1);"All the Disks in this list are Free!" : Pen 0 : Print At(1,2);"They are of very high quality."
  50. Pen 1 : Print At(1,3);"Only the Top Brand name disks are used in this collection of Disks." : Pen 0 : Print At(1,4);"Buy 10 disks and automatically win your dream Holiday." : Pen 1 : Print At(1,6);"What a shame the above text is only an example!"
  51. Screen To Front 1 : Screen Show 1 : Wait Key : Cls : Screen To Back 1 : Screen 0 : Return 
  52. 11
  53. If W<0 Then W=19
  54. If W>19 Then W=0
  55. If W=0 Then X=12 : Y=2 : U=36 : For Z=1 To 25 : Poke TT+XA+Z,32 : Next Z : If YU=1 Then For Z=1 To 25 : Mid$(A$,Z,1)=Chr$(Peek(TT+XA+Z)) : Next Z : Print At(X,Y);A$
  56. If W=1 Then X=51 : Y=2 : U=77 : For Z=1 To 27 : Poke TT+XB+Z,32 : Next Z : If YU=1 Then For Z=1 To 27 : Mid$(B$,Z,1)=Chr$(Peek(TT+XB+Z)) : Next Z : Print At(X,Y);B$
  57. If W=2 Then X=10 : Y=4 : U=77 : For Z=1 To 68 : Poke TT+XC+Z,32 : Next Z : If YU=1 Then For Z=1 To 68 : Mid$(C$,Z,1)=Chr$(Peek(TT+XC+Z)) : Next Z : Print At(X,Y);C$
  58. If W=3 Then X=13 : Y=6 : U=36 : For Z=1 To 24 : Poke TT+XD+Z,32 : Next Z : If YU=1 Then For Z=1 To 24 : Mid$(D$,Z,1)=Chr$(Peek(TT+XD+Z)) : Next Z : Print At(X,Y);D$
  59. If W=4 Then X=57 : Y=6 : U=77 : For Z=1 To 21 : Poke TT+XE+Z,32 : Next Z : If YU=1 Then For Z=1 To 21 : Mid$(E$,Z,1)=Chr$(Peek(TT+XE+Z)) : Next Z : Print At(X,Y);E$
  60. If W=5 Then X=15 : Y=8 : U=17 : For Z=1 To 3 : Poke TT+XI+Z,32 : Next Z : If YU=1 Then For Z=1 To 3 : Mid$(I$,Z,1)=Chr$(Peek(TT+XI+Z)) : Next Z : Print At(X,Y);I$
  61. If W=6 Then X=30 : Y=8 : U=77 : For Z=1 To 48 : Poke TT+XF+Z,32 : Next Z : If YU=1 Then For Z=1 To 48 : Mid$(F$,Z,1)=Chr$(Peek(TT+XF+Z)) : Next Z : Print At(X,Y);F$
  62. If W=7 Then X=13 : Y=10 : U=77 : For Z=1 To 65 : Poke TT+XG+Z,32 : Next Z : If YU=1 Then For Z=1 To 65 : Mid$(G$,Z,1)=Chr$(Peek(TT+XG+Z)) : Next Z : Print At(X,Y);G$
  63. If W=>8 and W<20 Then X=2 : Y=W+5 : U=77 : For Z=1 To 76 : Poke TT+XH(W-8)+Z,32 : Next Z : If YU=1 Then For Z=1 To 76 : Mid$(H$(W-8),Z,1)=Chr$(Peek(TT+XH(W-8)+Z)) : Next Z : Print At(X,Y);H$(W-8)
  64. Gosub 24 : T=X : Return 
  65. 16
  66. If W<0 Then W=19
  67. If W>19 Then W=0
  68. If W=0 Then X=12 : Y=2 : U=36
  69. If W=1 Then X=51 : Y=2 : U=77
  70. If W=2 Then X=10 : Y=4 : U=77
  71. If W=3 Then X=13 : Y=6 : U=36
  72. If W=4 Then X=57 : Y=6 : U=77
  73. If W=5 Then X=15 : Y=8 : U=17
  74. If W=6 Then X=30 : Y=8 : U=77
  75. If W=7 Then X=13 : Y=10 : U=77
  76. If W=>8 and W<20 Then X=2 : Y=W+5 : U=77
  77. Gosub 24 : T=X : Return 
  78. 12
  79. If V=1 Then X=T : V=0
  80. Paper 2 : Pen 1 : If X<=U Then Locate X,Y : Print Z$; : Gosub 14 : Add X,1 : If X>U Then Q=1
  81. If Q=1 and W=>8 and W<19 and X>U Then Add W,1 : Gosub 16
  82. Return 
  83. 13
  84. If X=>T Then Dec X : If X<T Then V=1
  85. If V=1 and W=>9 Then Dec W : Y=W+5 : X=U : V=0 : YH(W-8)=77
  86. Paper 2 : Pen 1 : If X=>T Then Locate X,Y : Print " "; : Gosub 15
  87. Return 
  88. 14
  89. If W=0 Then Poke TT+XA+YA,Asc(Z$) : Add YA,1
  90. If W=1 Then Poke TT+XB+YB,Asc(Z$) : Add YB,1
  91. If W=2 Then Poke TT+XC+YC,Asc(Z$) : Add YC,1
  92. If W=3 Then Poke TT+XD+YD,Asc(Z$) : Add YD,1
  93. If W=4 Then Poke TT+XE+YE,Asc(Z$) : Add YE,1
  94. If W=5 Then Poke TT+XI+YI,Asc(Z$) : Add YI,1
  95. If W=6 Then Poke TT+XF+YF,Asc(Z$) : Add YF,1
  96. If W=7 Then Poke TT+XG+YG,Asc(Z$) : Add YG,1
  97. If W=>8 and W<20 Then Poke TT+XH(W-8)+YH(W-8),Asc(Z$) : Add YH(W-8),1
  98. Return 
  99. 15
  100. If W=0 Then Dec YA : Poke TT+XA+YA,32
  101. If W=1 Then Dec YB : Poke TT+XB+YB,32
  102. If W=2 Then Dec YC : Poke TT+XC+YC,32
  103. If W=3 Then Dec YD : Poke TT+XD+YD,32
  104. If W=4 Then Dec YE : Poke TT+XE+YE,32
  105. If W=5 Then Dec YI : Poke TT+XI+YI,32
  106. If W=6 Then Dec YF : Poke TT+XF+YF,32
  107. If W=7 Then Dec YG : Poke TT+XG+YG,32
  108. If W=>8 and W<20 Then Dec YH(W-8) : Poke TT+XH(W-8)+YH(W-8),32
  109. Return 
  110. 18
  111. XA=XA-25 : XB=XB-27 : XC=XC-68 : XD=XD-24 : XE=XE-21 : XF=XF-48 : XG=XG-65 : XI=XI-3 : For Z=0 To 11 : XH(Z)=XH(Z)-76 : Next Z : Return 
  112. 19
  113. Add XA,25 : Add XB,27 : Add XC,68 : Add XD,24 : Add XE,21 : Add XF,48 : Add XG,65 : Add XI,3 : For Z=0 To 11 : Add XH(Z),76 : Next Z : Return 
  114. 23
  115. For Z=1 To 25 : Poke TT+XA+Z,32 : Next Z : For Z=1 To 27 : Poke TT+XB+Z,32 : Next Z : For Z=1 To 68 : Poke TT+XC+Z,32 : Next Z : For Z=1 To 24 : Poke TT+XD+Z,32 : Next Z
  116. For Z=1 To 21 : Poke TT+XE+Z,32 : Next Z : For Z=1 To 3 : Poke TT+XI+Z,32 : Next Z : For Z=1 To 48 : Poke TT+XF+Z,32 : Next Z : For Z=1 To 65 : Poke TT+XG+Z,32 : Next Z
  117. For Z=1 To 76 : For MA=0 To 11 : Poke TT+XH(MA)+Z,32 : Next MA : Next Z : Gosub 28 : Return 
  118. 24
  119. YA=1 : YB=1 : YC=1 : YD=1 : YE=1 : YF=1 : YG=1 : YI=1 : For Z=0 To 11 : YH(Z)=1 : Next Z : Return 
  120. 25
  121. XA=0 : XB=750 : XC=1560 : XD=3600 : XE=4320 : XF=4950 : XG=6390 : XI=8340 : XH(0)=8430 : XH(1)=10710 : XH(2)=12990 : XH(3)=15270 : XH(4)=17550 : XH(5)=19830 : XH(6)=22110 : XH(7)=24390 : XH(8)=26670 : XH(9)=28950 : XH(10)=31230
  122. XH(11)=33510 : Return 
  123. 26
  124. XA=725 : XB=1533 : XC=3532 : XD=4296 : XE=4929 : XF=6342 : XG=8275 : XI=8427 : XH(0)=10634 : XH(1)=12914 : XH(2)=15194 : XH(3)=17474 : XH(4)=19754 : XH(5)=22034 : XH(6)=24314 : XH(7)=26594 : XH(8)=28874 : XH(9)=31154
  125. XH(10)=33434 : XH(11)=35714 : Return 
  126. 28
  127. For Z=1 To 25 : Mid$(A$,Z,1)=Chr$(Peek(TT+XA+Z)) : Next Z : For Z=1 To 27 : Mid$(B$,Z,1)=Chr$(Peek(TT+XB+Z)) : Next Z : For Z=1 To 68 : Mid$(C$,Z,1)=Chr$(Peek(TT+XC+Z)) : Next Z : For Z=1 To 24 : Mid$(D$,Z,1)=Chr$(Peek(TT+XD+Z)) : Next Z
  128. For Z=1 To 21 : Mid$(E$,Z,1)=Chr$(Peek(TT+XE+Z)) : Next Z : For Z=1 To 48 : Mid$(F$,Z,1)=Chr$(Peek(TT+XF+Z)) : Next Z : For Z=1 To 65 : Mid$(G$,Z,1)=Chr$(Peek(TT+XG+Z)) : Next Z : For Z=1 To 3 : Mid$(I$,Z,1)=Chr$(Peek(TT+XI+Z)) : Next Z
  129. For Z=1 To 76 : For MA=0 To 11 : Mid$(H$(MA),Z,1)=Chr$(Peek(TT+XH(MA)+Z)) : Next MA : Next Z
  130. Paper 2 : Pen 1 : Print At(12,2);A$;At(51,2);B$;At(10,4);C$;At(13,6);D$;At(57,6);E$;At(30,8);F$;At(13,10);G$;At(15,8);I$;At(2,13) : For Z=0 To 11 : Print At(2,Z+13);H$(Z) : Next Z : Return 
  131. 32
  132. W$="" : EA=0 : EB=3 : EC=28 : Print At(3,28);"               ";At(3,28);
  133. 33
  134. U$=Inkey$ : If U$=Chr$(13) Then If W$="" Then Goto 33
  135. If U$=Chr$(13) Then Return 
  136. If U$=>Chr$(32) Then If U$<Chr$(127) Then Gosub 34
  137. If Scancode=70 or Scancode=65 Then Gosub 35
  138. Goto 33
  139. 34
  140. If EA=1 Then EB=3 : EA=0
  141. If EB<=17 Then Locate EB,EC : Print U$; : W$=W$+U$ : Add EB,1
  142. Return 
  143. 35
  144. If EB=>3 Then Dec EB : If EB<3 Then EA=1
  145. If EB=>3 Then Locate EB,EC : Print " "; : W$=Mid$(W$,1,Len(W$)-1)
  146. Return