home *** CD-ROM | disk | FTP | other *** search
/ Loadstar - Compleat Programmer / comprog1.d81 / b.gosub (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-01-01  |  6.4 KB  |  222 lines
  1. 1 rem maurice jones,box 324,laneville,texas 75667  march 1989
  2. 2 deffns(x)=int(x/13):deffnv(x)=x-13*int(x/13):dimi,j,su,t:goto400
  3. 3 rem ========raspberry========
  4. 4 :
  5. 5 s=54272:pokes+6,240:pokes+1,4:pokes+5,0:pokes+4,33:pokes+24,15
  6. 6 forz=1024to512step-8:pokes+1,z/256:pokes,zand255:next:pokes+4,0:return
  7. 7 :
  8. 8 rem==========fanfare=========
  9. 9 :
  10. 10 t=87:n$="251331421502421502"
  11. 11 s=54272:pokes+6,96:pokes+24,15
  12. 12 fori=1to18step3
  13. 13 pokes+1,val(mid$(n$,i,2)):pokes+4,33
  14. 14 forj=1tot*val(mid$(n$,i+2,1)):next
  15. 15 pokes+4,0:next:return
  16. 16 :
  17. 17 rem ======creates screen save
  18. 18 :
  19. 20 for i=828to972:reada:pokei,a:next:return
  20. 22 data169,000,133,251,133,253,141
  21. 23 data055,003,141,057,003,141,059
  22. 24 data003,162,000,160,000,177,251
  23. 25 data145,253,200,192,000,208,247
  24. 26 data230,252,230,254,232,224,004
  25. 27 data208,238,173,056,003,133,252
  26. 28 data173,058,003,133,254,238,059
  27. 29 data003,174,059,003,224,002,208
  28. 30 data214,096,169,004,133,252,169
  29. 31 data192,133,254,169,216,141,056
  30. 32 data003,169,196,141,058,003,076
  31. 33 data060,003,169,192,133,252,169
  32. 34 data004,133,254,169,196,141,056
  33. 35 data003,169,216,141,058,003,076
  34. 36 data060,003,169,004,133,252,169
  35. 37 data200,133,254,169,216,141,056
  36. 38 data003,169,204,141,058,003,076
  37. 39 data060,003,169,200,133,252,169
  38. 40 data004,133,254,169,204,141,056
  39. 41 data003,169,216,141,058,003,076
  40. 42 data060,003,000,000,000
  41. 47 :
  42. 48 rem==========again?==============
  43. 49 :
  44. 50 x=15:y=10:w$="[144] again? [157][157][157][157][157][157][157][157] (y/n)  ":gosub66:goto62
  45. 54 :
  46. 55 rem==========any key-get a$=========
  47. 56 :
  48. 58 x=14:y=24:w$=" any key [145]":gosub66
  49. 59 :
  50. 60 rem============get a$===========
  51. 61 :
  52. 62 geta$:ifa$=""then 62:return
  53. 63 :
  54. 64 rem=======print at=============
  55. 65 :
  56. 66 poke783,peek(783)and254:poke782,x:poke781,y:sys65520:printw$
  57. 68 poke783,peek(783)or1:return
  58. 106 :
  59. 107 rem===dim,define,once only stuff===
  60. 109 :
  61. 111 nc=52:dims(nc),d$(14),va$(13),c(3),b(3,52):z9=0
  62. 112 fori=0to3:reads$(i):readco$(i):next
  63. 113 fori=0to12:readva$(i):next
  64. 114 fori=1to5:readch$(i):next
  65. 115 data"[216]","[144]","[218]","","[211]","","[193]","[144]",    2,3,4,5,6,7,8,9,10,j,q,k,a
  66. 116 data"1","2","3","h","q",
  67. 119 c$="[176][192][192][192][192][174][157][157][157][157][157][157][221]    [221][157][157][157][157][157][157][221]    [221][157][157][157][157][157][157][221]    [221]"
  68. 120 c$=c$+     "[157][157][157][157][157][157][221]    [221][157][157][157][157][157][157][221]    [221][157][157][157][157][157][157][173][192][192][192][192][189]"+"[145][145][145][145][145][157][157][157][157][157]"
  69. 121 b$=c$+"[166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166]"
  70. 122 bl$="      [157][157][157][157][157][157]      [157][157][157][157][157][157]      [157][157][157][157][157][157]      [157][157][157][157][157][157]      [157][157][157][157][157][157]"
  71. 123 bl$=bl$+"      [157][157][157][157][157][157]      [157][157][157][157][157][157]      "
  72. 125 rem========shuffle & deal======
  73. 126 :
  74. 127 forj=0tonc-1:s(j)=j:next
  75. 128 forj=otonc-2:j%=j+int(rnd(0)*(nc-j)):temp=s(j):s(j)=s(j%):s(j%)=temp:next
  76. 129 fori=0to47:b(1,i+1)=s(i):next:fori=1to4:b(2,i)=s(i+47):next
  77. 130 c(1)=48:c(2)=4:c(3)=0:return
  78. 137 :
  79. 138 rem ======suits,values,graphics===
  80. 139 :
  81. 140 w$=c$+co$(fns(b(i,j)))+va$(fnv(b(i,j)))+s$(fns(b(i,j)))
  82. 146 if c(i)=0thenw$=bl$
  83. 148 goto66
  84. 157 :
  85. 158 rem=======print board=======
  86. 159 :
  87. 160 y=5:x=33:w$=bl$:forj=1to9:gosub66:x=x-4:next
  88. 162 y=5:x=1:i=2: a=1:ifc(2)>9thena=c(2)-8
  89. 164 for j=atoc(2):gosub140:x=x+4:next:cp=x:return
  90. 167 :
  91. 168 rem ======top of waste=========
  92. 169 :
  93. 170 y=13:x=12:i=3:j=c(3):gosub140:return
  94. 187 :
  95. 188 rem=====restore deck========
  96. 189 :
  97. 190 fori=c(3)to1step-1:c(1)=c(1)+1:b(1,c(1))=b(3,i):next:c(3)=0
  98. 192 gosub170:fori=1to100:next:y=13:x=3:w$=b$:gosub66:return
  99. 207 :
  100. 208 rem======get choice   ======
  101. 209 :
  102. 210 geta$:if a$=""then210
  103. 212 for i=1to5:ifa$=right$(ch$(i),1)then216
  104. 214 next:goto210
  105. 216 return
  106. 219 :
  107. 220 rem=====help screen=====
  108. 222 print"[147]       [164][175][185][162] marathon sol [162][185][175][164]"
  109. 224 print:print:print"the object of the game is to play all "
  110. 226 print"of the cards to the waste pile.  cards "
  111. 228 print"are dealt from the deck to the table, "
  112. 230 print"one at a time."
  113. 232 print:print"only the top four cards on the table"
  114. 234 print"are considered in playing to the waste"
  115. 236 print"pile.  if the top card and the fourth "
  116. 238 print"card are of the same suit, the two "
  117. 240 print"cards between them can be played to "
  118. 242 print"the waste pile.  if they are of the"
  119. 244 print"same value, all four may be played to"
  120. 246 print"the waste pile.  "
  121. 248 print:print"you may play through the deck as many"
  122. 250 print"times as you like.  one time through"
  123. 252 print"is the short game.  when the deck is "
  124. 254 print"used up, the deal option will cause"
  125. 256 print"the waste pile to be turned over."
  126. 260 sys886:z9=1:return
  127. 297 :
  128. 298 rem=====erase four========
  129. 299 :
  130. 300 y=5:x=cp-12: fori=1to3:w$=bl$:gosub66:x=x+4:next:return
  131. 397 :
  132. 398 rem========start of program=======
  133. 399 :
  134. 400 z9=0:poke53280,1:poke53281,1:printchr$(8);chr$(142):print"[147][144]"
  135. 401 print"       [164][175][185][162] marathon  sol [162][185][175][164]"
  136. 402 print:print"                 by
  137. 403 [153]:[153]"            maurice jones
  138. 404 print:print: print"even as we speak, the subroutine at"
  139. 405 print"line 20 is poking in fender tucker's"
  140. 407 print"screen switching routine."
  141. 409 print:print"when the 'any  key' prompt appears at"
  142. 411 print"the bottom, please hit a key to proceed"
  143. 413 print"to the next screen."
  144. 415 gosub20:rem==load screen switch====
  145. 417 gosub58
  146. 419 print"[144][147]"
  147. 423 print:print"now the subroutine at 111 is breaking"
  148. 425 print"out and shuffling a new deck of cards."
  149. 427 print:print"when the game screen appears, type 'h'"
  150. 429 print "for instructions."
  151. 431 print:print"when the 'any  key' prompt appears at"
  152. 433 print"the bottom, please hit a key to proceed"
  153. 435 print"to the next screen."
  154. 445 :
  155. 446 gosub 111: rem== deal============
  156. 447 :
  157. 450 gosub 58:goto460
  158. 454 print"[147]         a moment, please .  .  .":gosub128
  159. 457 :
  160. 458 rem =====playing board=============
  161. 459 :
  162. 460 print"[147]       [164][175][185][162] marathon sol [162][185][175][164]"
  163. 470 y=13:x=3:w$=b$:gosub66:x=12:w$=b$:gosub66:y=21:x=4:w$="[144]deck":gosub66
  164. 474 x=13:w$="waste":gosub66
  165. 480 y=15:x=25:w$="1-play two":gosub66:y=16:w$="2-play four":gosub66
  166. 484 y=17:w$="3-deal card":gosub66:y=20:w$="h-help":gosub66:y=21:w$="q-quit"
  167. 488 gosub66
  168. 492 y=5:x=1:i=2: forj=1to4:gosub140:x=x+4:next:cp=x
  169. 496 gosub 170
  170. 500 x=14:y=24:w$=" choice? [145]":gosub66:gosub210:onigoto520,560,600,990,995
  171. 517 :
  172. 518 rem=====play two=========
  173. 519 :
  174. 520 ifc(2)<4then522
  175. 521 iffns(b(2,c(2)-3))=fns(b(2,c(2)))then 524
  176. 522 gosub5:goto500
  177. 524 c(3)=c(3)+1:b(3,c(3))=b(2,c(2)-2)
  178. 526 c(3)=c(3)+1:b(3,c(3))=b(2,c(2)-1):b(2,c(2)-2)=b(2,c(2)):c(2)=c(2)-2
  179. 530 gosub300:x=x-12:i=2:j=c(2):gosub140:cp=x+4: gosub170:ifcp<16thengosub160
  180. 534 goto500
  181. 557 :
  182. 558 rem =======play four=======
  183. 559 :
  184. 560 ifc(2)<4then522
  185. 566 iffnv(b(2,c(2)))=fnv(b(2,c(2)-3))then572
  186. 568 gosub5:goto500
  187. 572 fori=0to3:c(3)=c(3)+1:b(3,c(3))=b(2,c(2)-3+i):next:c(2)=c(2)-4
  188. 574 gosub160:gosub170:goto500
  189. 597 :
  190. 598 rem=========deal card=========
  191. 599 :
  192. 600 x=14:y=24:w$="          [145]":gosub66
  193. 601 ifc(1)=1then610
  194. 602 ifc(1)>0then608
  195. 604 ifc(3)=0then700
  196. 606 gosub190
  197. 608 c(2)=c(2)+1:b(2,c(2))=b(1,c(1)):c(1)=c(1)-1:gosub160:goto500
  198. 610 y=13:x=3:w$=bl$:gosub66:goto608
  199. 700 x=12:y=6:w$="  sorry, you  [157][157][157][157][157][157][157][157][157][157][157][157][157][157]  have lost   [146]":gosub66
  200. 702 gosub50:goto995
  201. 797 :
  202. 798 rem========win screen============
  203. 799 :
  204. 800 w$=bl$:x=34:y=7:gosub66:gosub10:gosub127:w$="   you win!!!  "
  205. 802 x=3:y=1:fori=1to22:gosub66:x=x+1:y=y+1:next:goto995
  206. 987 :
  207. 988 rem========display help screen====
  208. 989 :
  209. 990 sys928:if z9=0thengosub222
  210. 991 sys907:gosub58:sys949:goto500
  211. 992 :
  212. 993 rem=====play again?=======
  213. 994 :
  214. 995 gosub50:ifa$="n"then60000
  215. 997 if a$="y"then454
  216. 999 gosub 62:goto995
  217. 60000 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  218. 60010 if er<>63 then print"[147]":end
  219. 60020 a$="hello connect":q$=chr$(34)
  220. 60030 print"[147]load"q$a$q$",8"
  221. 60040 print"run":poke631,13:             poke632,13:poke198,2:end
  222.