home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1986 March / Ahoy_Magazine_86-03_1986_Double_L.d64 / most (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  230 lines
  1. 1 rem *** the most and the least ***
  2. 2 rem an educational game:  put lists in the right order
  3. 3 rem this program looks for disk files that begin with "q "
  4. 4 rem these are created with the quiz files included, or make your own using
  5. 5 rem the format in the 'quiz maker' program
  6. 9 rem go set up video memory and the character set
  7. 10 gosub 1000
  8. 11 rem go display title screen and get directory
  9. 12 poke 808,234:gosub 900:poke 808,234
  10. 45 xp=cp+na:goto 140
  11. 49 rem ** joystick and keyboard read
  12. 50 get a$
  13. 51 a=255-peek(56320):b=a and16:a=a and3
  14. 52 return
  15. 59 rem ** animate 'next' string
  16. 60 nn=nn-1:if nn<1 then nn=nz
  17. 61 a=asc(mid$(ni$,nn,1)):b=10+val(mid$(nl$,nn,1))
  18. 62 print fc$(q,0)vv$(2+na)tab(1)mid$(nx$,a,b)
  19. 63 return
  20. 69 rem ** blank a line
  21. 70 print vv$(v)"[146]                                       ";:return
  22. 100 gosub 60:gosub 50:if a$=" "or b>1 then 200
  23. 105 if a$="[135]" or a=1 then 120
  24. 110 if a$="[136]" or a=2 then 130
  25. 115 goto 100
  26. 119 rem * upmove
  27. 120 if cp=(22-na) then cp=len(qr$(q)):goto 140
  28. 121 if cp=1 then cp=22-na:goto 140
  29. 122 cp=cp-1:goto 140
  30. 129 rem * downmove
  31. 130 if cp=(22-na) then cp=1:goto 140
  32. 131 if cp=len(qr$(q))then cp=22-na:goto 140
  33. 132 cp=cp+1:goto 140
  34. 139 rem * print cursor at new position
  35. 140 print vv$(2+xp)"[146] "vv$(2+cp+na)fc$(q,3)cu$;:xp=cp+na:goto 100
  36. 198 rem *** choice handling
  37. 199 rem * choice to quit?
  38. 200 v=2+na:gosub70:if cp=22-na then 300
  39. 201 rem * was it the right answer?
  40. 202 a=asc(mid$(qr$(q),cp,1)):if a=na then 230
  41. 209 rem ** wrong answer handling
  42. 210 tp=tp-1:rem score down
  43. 211 rem * find correct answer
  44. 212 for i=1 to len(qr$(q)):a=asc(mid$(qr$(q),i,1))
  45. 213 if a=na then cp=i
  46. 214 next:print vv$(2+xp)"[146] "vv$(2+cp+na)fc$(q,1)cu$;:xp=cp+na
  47. 215 rem * display error message
  48. 216 print vv$(2+na)tab(1)fc$(q,1)"[160][211][207][160][211][207][210][210][217][174][174][174]";:for i=0 to 999:next:goto 250
  49. 229 rem ** right answer handling
  50. 230 tp=tp+(qt(q)-na):rem score up
  51. 231 rem * display congratulations
  52. 232 print vv$(2+na)tab(1)fc$(q,1)"[160][210][201][199][200][212][160][207][206][161][161][161]";:for i=0 to 999:next:goto 250
  53. 248 rem ** shrink list and test for end
  54. 249 rem * move correct answer from available list to final list
  55. 250 print vv$(2+cp+na)"[146] ";:na=na+1:v=2+na:gosub 70
  56. 251 x=len(qr$(q)):if x<2 or na>qt(q)then qr$(q)="":gosub 960:goto 280
  57. 252 if cp=1 then qr$(q)=right$(qr$(q),x-1):goto 255
  58. 253 if cp=x then qr$(q)=left$(qr$(q),x-1):goto 255
  59. 254 qr$(q)=left$(qr$(q),cp-1)+right$(qr$(q),x-cp):goto 255
  60. 255 gosub 960:cp=1:goto 140
  61. 279 rem ** last question was answered
  62. 280 print vv$(24)fc$(q,3)cu$fc$(q,1)"[160][199][207][160][207][206][191][160]";
  63. 281 poke 198,0
  64. 282 gosub 50:if b=0 and a$="" then 282
  65. 283 rem * last quiz finished, show choices
  66. 284 x=len(rr$):if x<1 then 300
  67. 285 rem * go select next quiz
  68. 286 gosub 950:xp=cp+na:goto 140
  69. 299 rem *** quit handling
  70. 300 for v=3 to 24:gosub 70:next:poke 198,0
  71. 301 rem * display options
  72. 302 print vv$(3)fc$(q,2)" leave the game entirely";
  73. 303 print vv$(4)" display directory of quiz files";
  74. 304 print vv$(5)" repeat this group of lists";
  75. 305 rem * are there any quizzes left?
  76. 306 if len(rr$)<1 then 330
  77. 307 print vv$(6)" resume this quiz where we left it";
  78. 308 print vv$(7)fc$(q,1)"[160][160][160][215][200][193][212][160][215][201][204][204][160][215][197][160][196][207][160][206][207][215][191][160][160][160][160][160][160][160][160][160][160][160][160][160][160][160][160]";
  79. 309 rem ** player input loop (mid-game)
  80. 310 w=6:xw=6:print vv$(w)fc$(q,3)cu$;
  81. 311 rem * get player input
  82. 312 gosub 50:if a$=" " or b>0 then 340
  83. 313 if a$="[135]" or a=1 then w=w-1:gosub 320:goto 312
  84. 314 if a$="[136]" or a=2 then w=w+1:gosub 320:goto 312
  85. 315 goto 312
  86. 319 rem * move cursor (mid-game)
  87. 320 if w>6 then w=3
  88. 321 if w<3 then w=6
  89. 322 print vv$(xw)"[146] "vv$(w)cu$;:xw=w:return
  90. 324 rem * move cursor (end-game)
  91. 325 if w>5 then w=3
  92. 326 if w<3 then w=5
  93. 327 print vv$(xw)"[146] "vv$(w)cu$;:xw=w:return
  94. 329 rem ** player input loop (end-game)
  95. 330 w=5:xw=5:print vv$(w)fc$(q,3)cu$;
  96. 331 rem * get player input
  97. 332 gosub 50:if a$=" " or b>0 then 340
  98. 333 if a$="[135]" or a=1 then w=w-1:gosub 325:goto 332
  99. 334 if a$="[136]" or a=2 then w=w+1:gosub 325:goto 332
  100. 335 goto 332
  101. 339 rem ** option handling
  102. 340 on w-2 goto 1080,350,360,370:goto 300
  103. 349 rem ** resume game from the start
  104. 350 poke 53281,6:print "[154][147]":poke 53282,2:poke 53283,1:poke 53284,7:run
  105. 359 rem ** start this quiz group over
  106. 360 gosub 944:xp=cp+na:goto 140
  107. 369 rem ** resume quiz where we left it
  108. 370 for v=3 to 8:gosub 70:next
  109. 371 gosub 960:cp=1:goto 140
  110. 898 rem *** game opening
  111. 899 rem display titles
  112. 900 print"[147][144][160][160][160][160][160][160][160][160][212][200][197][160][205][207][211][212][160][193][206][196][160][212][200][197][160][204][197][193][211][212][160][160][160][160][160][160][160][160][160]"
  113. 901 poke 53281,6:poke 53280,6:print"[160][160][160][196][201][210][197][195][212][207][210][217][160][207][198][160][209][213][201][218][160][198][201][204][197][211][173][173][160][160][160][160][160][160][160][160][160][160][160]"
  114. 902 gosub 1040
  115. 903 if x=0 then print "insert disk with 'q ' files and start   again":goto 1080
  116. 904 for i=0 to x-1:print vv$(i+2)" "right$(ff$(i),len(ff$(i))-2)"[146]":next
  117. 905 print " quit":print "[160][160][160][202][207][217][211][212][201][195][203][160][207][210][160][198][181][173][198][183][160][212][207][160][205][207][214][197][160][193][210][210][207][215][174][160][160][160][160]"
  118. 906 print "[160][160][160][194][213][212][212][207][206][160][207][210][160][211][208][193][195][197][194][193][210][160][212][207][160][205][193][203][197][160][195][200][207][201][195][197][174][160][160]"
  119. 909 rem * get choice of quiz file
  120. 910 cp=2:xp=cp:cu$="[223][146]":print vv$(cp)cu$;
  121. 911 gosub 50:if a$="" and a=0 and b=0 then 911
  122. 912 xp=cp:if a$=" " or b>0 then 920
  123. 913 if a$="[135]" or a=1 then cp=cp-1:if cp<2 then cp=2+x
  124. 914 if a$="[136]" or a=2 then cp=cp+1:if cp>(2+x) then cp=2
  125. 915 print vv$(xp)" "vv$(cp)cu$;:goto 911
  126. 920 if cp=(x+2) then 1080
  127. 921 ff$=ff$(cp-2)
  128. 922 print vv$(24)"now loading "ff$"[146]";
  129. 929 rem ** load chosen file
  130. 930 open 15,8,15,"i":close 15:open 2,8,2,"0:"+ff$+",s,r"
  131. 931 rem * how many quizzes in file? (no more than 8)
  132. 932 input#2,nq:if nq>8 then nq=8
  133. 933 rem * dimension arrays
  134. 934 dim qe$(8,21),qf$(8,21),qr$(8),qt(8),fc$(8,3),bc(8,3),tl$(8),fl$(8),eh$(1,8)
  135. 935 rem * loop through the quizzes
  136. 936 for i=1 to nq:input#2,qt(i):a=fre(9)
  137. 937 rem * get colors
  138. 938 for j=0 to 3:input#2,bc(i,j):next:for j=0 to 3:input#2,fc$(i,j):next
  139. 939 rem * get quiz title, format, heads
  140. 940 input#2,tl$(i):input#2,fl$(i):input#2,eh$(0,i):input#2,eh$(1,i)
  141. 941 rem * loop through the entries
  142. 942 for j=1 to qt(i):input#2,qe$(i,j):input#2,qf$(i,j):next:next:close 2
  143. 943 rem * initialize random strings
  144. 944 for i=1 to nq:sr$=left$(ss$,qt(i)):a=rnd(0):gosub 1070:qr$(i)=zz$:next
  145. 945 rem * go set up random string to control quiz order
  146. 946 sr$=left$(ss$,nq):a=rnd(0):gosub 1070:rr$=zz$
  147. 947 rem * go set up 'next' line
  148. 948 gosub 1060
  149. 949 rem ** initialize next quiz
  150. 950 q=asc(left$(rr$,1)):a=len(rr$):if a<2 then rr$="":goto 953
  151. 951 rr$=right$(rr$,a-1)
  152. 952 rem * clear screen, print heading
  153. 953 for i=0 to 3:poke 53281+i,bc(q,i):next:poke 53280,bc(q,0):print "[147]";
  154. 954 print vv$(0)fc$(q,3)tl$(q);:print vv$(1)fc$(q,0)fl$(q);
  155. 955 print vv$(2)fc$(q,1)eh$(0,q)eh$(1,q);
  156. 956 rem * initial values for quiz
  157. 957 na=1
  158. 959 rem ** refresh screen
  159. 960 cp=1:if na=1 then 964
  160. 961 rem * print answers already given
  161. 962 for i=1 to na-1:print vv$(2+i)fc$(q,2)" "qe$(q,i)fc$(q,3)qf$(q,i);:next
  162. 963 rem * print random-order list of remaining answers
  163. 964 if len(qr$(q))<1 then 968
  164. 965 for i=1 to len(qr$(q))
  165. 966 print vv$(na+2+i)fc$(q,0)tab(1)qe$(q,asc(mid$(qr$(q),i,1)))
  166. 967 next
  167. 968 print vv$(24)fc$(q,1)" [160][209][213][201][212][160]"tab(18)fc$(q,2)" score "tp*10"[146]";
  168. 969 if(peek(52)-peek(50))>12 then return
  169. 970 print vv$(24)fc$(q,2)" pause for garbage collection..........";
  170. 971 a=fre(9):return
  171. 996 return
  172. 998 rem ** video set up
  173. 999 rem * lower top of memory; set video control values
  174. 1000 poke 55,255:poke 56,138:vm=35840:cm=40960:sm=140
  175. 1001 rem * set video block
  176. 1002 poke 56578,peek(56578)or3:poke 56576,(peek(56576)and 252)+1
  177. 1003 rem * set screen and character memory locations
  178. 1004 poke 53272,56:poke 648,sm:print "[147]loading character set........_[223][146]_[223]"
  179. 1005 rem * switch to extended background color mode
  180. 1006 poke 53265,peek(53265)or 64:poke 53282,8:poke 53283,7:poke 53284,1
  181. 1009 rem * copy character shapes into ram
  182. 1010 poke 56333,127:poke 1,peek(1) and 251
  183. 1011 for i=0 to 511:poke cm+i,peek(53248+i):next
  184. 1012 poke 1,peek(1)or 4:poke 56333,131
  185. 1013 rem * put in custom characters (comma, altered period, altered left arrow)
  186. 1014 for i=cm+30*8 to cm+30*8+15:read a:poke i,a:next
  187. 1015 data 0,0,0,0,0,96,96,192
  188. 1016 data 192,100,50,31,31,50,100,192
  189. 1017 for i=cm+46*8 to cm+46*8+7:read a:poke i,a:next
  190. 1018 data 0,0,0,0,0,96,96,0
  191. 1019 rem ** set up vertical movement strings
  192. 1020 dim vv$(24)
  193. 1021 vv$(0)="":for i=1 to 24:vv$(i)=vv$(i-1)+"":next
  194. 1022 rem * initialize order string
  195. 1023 ss$="":for i=1 to 21:ss$=ss$+chr$(i):next
  196. 1030 return
  197. 1038 rem *** directory search ***
  198. 1039 rem * open directory file
  199. 1040 open 15,8,15:print#15,"i":open2,8,2,"$"
  200. 1041 rem * skip past header block
  201. 1042 for i=0 to 253:get#2,a$:next
  202. 1043 rem ** loop to read a block
  203. 1044 rem * set up variables
  204. 1045 x=0:f=0:dim ff$(27),bb$(7)
  205. 1046 rem * read 8-file block
  206. 1047 for i=0 to 7:bb$(i)="":get#2,a$,a$,a$:for j=3 to 18:get#2,a$
  207. 1048 if len(a$)>0 thenif asc(a$)<96 then bb$(i)=bb$(i)+a$
  208. 1049 next
  209. 1050 for j=0 to 10:get#2,a$:next:if i<7 then get#2,a$,a$
  210. 1051 if(len(bb$(i))>0)and(left$(bb$(i),2)="q ")then ff$(x)=bb$(i):x=x+1
  211. 1052 next:f=f+1:if (x<20)and(f<2)andlen(bb$(7))>0 then 1047
  212. 1055 close 2:close 15:return
  213. 1059 rem ** initialize 'next' string
  214. 1060 tp=0:nx$="next[223]_[223][146]_[206][197][216][212]_[223][146]_[223]next[223][146]_[223]_[206][197][216][212][146]_[223]_[223][146]next[223]_[223][146]_[206][197][216]"
  215. 1061 nn=1:ni$="":nz=len(nx$)-14:a=fre(9):for i=1 to nz
  216. 1062 a$=mid$(nx$,i,1):if a$<>"" and a$<>"[146]" then ni$=ni$+chr$(i)
  217. 1063 next:a=fre(9)
  218. 1064 nl$="45556665567777666667666555666655":nz=len(nl$):return
  219. 1069 rem ** subroutine to set up random-rder strings
  220. 1070 zz$=""
  221. 1071 a=len(sr$):b=1+int(rnd(9)*a):if b<1 or b>a then 1071
  222. 1072 zz$=zz$+mid$(sr$,b,1):if len(sr$)=1 then return
  223. 1073 if b=1 then sr$=right$(sr$,a-1):goto 1071
  224. 1074 if b=a then sr$=left$(sr$,a-1):goto 1071
  225. 1075 sr$=left$(sr$,b-1)+right$(sr$,a-b):goto 1071
  226. 1079 rem *** quit, restoring screen memory to normal
  227. 1080 poke 53281,6:poke 53280,14:print"[154]":poke 55,255:poke 56,159:poke 808,237
  228. 1085 poke 648,4:poke 56576,peek(56576)or 3:poke 53272,20:print "[147]":end
  229. 2000 open 2,8,2,ff$:get#2,nq:print nq:close2:return
  230.