home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 24 / 024.d81 / communique (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  5KB  |  213 lines
  1. 0 z$=""
  2. 200 rem           "communique"
  3. 300 rem      written by alan gardner
  4. 400 rem             2-21-86
  5. 500 rem
  6. 600 rem
  7. 700 iflf=0thenlf=1:load"input.bload.o",8,1
  8. 900 sys831,50759,"text@50759.o"
  9. 925 sys831,51309,"scr/line.wp.o"
  10. 950 sys831,51456,"unpacker"
  11. 970 sys831,18176,"ctitle.shp"
  12. 1000 :
  13. 1100 poke55,0:poke56,90:clr
  14. 1200 :
  15. 1500 z$="":dimt$(350),vl$(30),vl%(30),s%(10),v%(20)
  16. 1550 x=49152:f$=""
  17. 1552 ifpeek(x)<>0thenf$=f$+chr$(peek(x)):x=x+1:goto1552
  18. 1600 ba=52224:te=50759:bl%=831:in%=828:mo%=1:sw=51309:lw=51312:s%(0)=0
  19. 1700 cl%=1:re%=0:c$=""
  20. 1800 lm%=0:rm%=39:tm%=0:bm%=23:ty%=0:fl%=0
  21. 1900 s$="                                       "
  22. 2000 d$=""
  23. 2050 :
  24. 2060 gosub15000:sys51456:sys51459:           poke53280,0
  25. 2100 :
  26. 2102 gosub15000
  27. 2110 open8,8,8,f$:lc%=0:ll%=0:cl%=1
  28. 2120 sysin%,8,80:z$=z$+"":ifleft$(z$,2)="^ "then2120
  29. 2130 ifleft$(z$,2)="^@"thenll%=ll%+1:vl$(ll%)=mid$(z$,3):vl%(ll%)=lc%+1:goto2120
  30. 2140 ifz$<>"[199]"andz$<>"[196]"thenlc%=lc%+1:t$(lc%)=z$:goto2120
  31. 2150 close8:close15:lc%=lc%-1
  32. 2152 zz=fre(0):gosub15000
  33. 2200 :
  34. 2202 pf$(0)=chr$(171):pf$(1)=chr$(184):pf$(2)=chr$(177):pf=0
  35. 2300 :
  36. 2400 rem
  37. 2500 geta$:ifa$=pf$(pf)thenpf=pf+1:ifpf=3then60000
  38. 2510 c$=t$(cl%):ifc$=""thent$(cl%)=" ":goto2900
  39. 2600 c$=left$(t$(cl%),1):ifc$="'"thencl%=cl%+1:goto2500
  40. 2700 ifc$="^"thengosub3800:goto2400
  41. 2800 :
  42. 2900 rem  routine to print text here
  43. 3000 z$=t$(cl%):syste,z$,lm%*8,(tm%+ty%)*8
  44. 3100 printt$(cl%):ifhf=1thenhf=0:lm%=ss
  45. 3200 ty%=ty%+1
  46. 3300 cl%=cl%+1:goto2400
  47. 3400 rem     *************************
  48. 3500 end:rem *     end of body       *
  49. 3600 rem     *************************
  50. 3700 :
  51. 3800 rem   check options
  52. 3900 c$=mid$(t$(cl%),2,1)
  53. 4000 :
  54. 4500 :
  55. 4600 ifc$="g"thengosub9800:goto5800:         rem goto
  56. 4700 ifc$="s"thengosub10900:goto5800:        rem gosub
  57. 4800 ifc$="p"thengosub7300:goto5600:         rem plot shp
  58. 4900 ifc$="#"then16000:                      rem massage variables
  59. 5000 ifc$="d"then11300:                      rem disk option
  60. 5100 ifc$="c"thengosub6000:goto5600:         rem clear
  61. 5200 ifc$="w"thengosub7000:goto5600:         rem wipe
  62. 5300 ifc$="x"thenifs%(0)=0then14300:         rem exit program
  63. 5400 ifc$="x"thencl%=s%(s%(0))+1:s%(0)=s%(0)-1:goto5800:rem return from sub
  64. 5500 ifc$="k"then9500:                       rem wait
  65. 5550 ifc$="i"thengosub12000:goto5800:        rem input
  66. 5551 ifc$="v"thengosub17000:goto5600:        rem vtab
  67. 5552 ifc$="h"thengosub18000:goto5600:        rem htab
  68. 5553 ifc$="l"theni%=3:gosub8800:lm%=n%-1:goto5600
  69. 5554 ifc$="r"theni%=3:gosub8800:rm%=n%-1:goto5600
  70. 5556 ifc$="t"theni%=3:gosub8800:tm%=n%-1:goto5600
  71. 5558 ifc$="b"theni%=3:gosub8800:bm%=n%-1:goto5600
  72. 5600 rem  return to line 2500
  73. 5700 x=cl%:x=x+1:cl%=x
  74. 5800 return
  75. 5900 :
  76. 6000 rem   clear current window
  77. 6100 i%=3:gosub8800:op=n%
  78. 6200 ifop=0thenx=16
  79. 6300 ifop=1thenx=1
  80. 6400 sp$=left$(s$,rm%-lm%+1)
  81. 6500 for t=tm% to bm%
  82. 6600 sys te,sp$,lm%*8,t*8:                   sys lw,ba+t*40+lm%,rm%-lm%,x
  83. 6700 next t:ty%=0
  84. 6800 return
  85. 6900 :
  86. 7000 rem   clear entire screen
  87. 7100 i%=3:gosub8800:op=n%
  88. 7110 ifop=0thensyssw,16
  89. 7120 ifop=1thensyssw,1
  90. 7130 ty%=0
  91. 7140 return
  92. 7200 :
  93. 7300 rem   plot a shape
  94. 7400 i%=3:gosub8800:sh%=n%:sh%=sh%-1
  95. 7500 gosub8800:mo%=n%
  96. 7600 gosub8800:px%=n%
  97. 7800 py%=val(mid$(t$(cl%),i%))
  98. 7900 :
  99. 8000 rem *** plot a shape ***
  100. 8100 poke249,224:poke250,204
  101. 8150 ad%=23296:ifmo%=2thenad%=28416
  102. 8200 poke251,0:poke252,ad%/256
  103. 8300 poke253,px%:poke254,py%
  104. 8400 poke255,sh%
  105. 8500 sys51462
  106. 8600 return
  107. 8700 :
  108. 8800 rem   parse out a value
  109. 8900 rem   i%=start posn in t$(cl%)
  110. 9000 rem   returns n% as value parsed
  111. 9100 c%=0:e%=0:l%=len(t$(cl%))
  112. 9110 ifmid$(t$(cl%),i%,1)="#"thene%=1:i%=i%+1
  113. 9200 t$=mid$(t$(cl%),i%,1)
  114. 9210 if(t$>="0")and(t$<="9")theni%=i%+1:c%=c%+1:ifi%<=l%then9200
  115. 9300 i%=i%-c%:n%=val(mid$(t$(cl%),i%,c%))
  116. 9350 ife%=1thenn%=v%(n%)
  117. 9375 i%=i%+c%+1:return
  118. 9400 :
  119. 9500 rem  wait for a keypress
  120. 9525 l$="":iflen(t$(cl%))<3then9600
  121. 9550 ifpeek(198)<>0thenl$=mid$(t$(cl%),5):gosub10200:cl%=l:poke198,0:goto5800
  122. 9560 goto5600
  123. 9600 poke198,0:wait198,1:getk$:goto5600
  124. 9700 :
  125. 9800 rem  goto a label
  126. 9900 l$=mid$(t$(cl%),4):l=0:gosub10200
  127. 10000 cl%=l:return
  128. 10100 :
  129. 10200 rem  find a label in the text
  130. 10300 for x=1 to ll%
  131. 10400 ifvl$(x)=l$thenl=vl%(x):goto10700
  132. 10500 nextx:t$="unknown label --- "+l$
  133. 10600 syssw,16:syste,t$,0,0:stop
  134. 10700 return
  135. 10800 :
  136. 10900 rem  gosub a label
  137. 11000 l$=mid$(t$(cl%),4):l=0:gosub10200
  138. 11050 ifs%(0)=10thensyssw,16:syste,"stack overflow",0,0:stop
  139. 11100 s%(0)=s%(0)+1:s%(s%(0))=cl%:cl%=l:      return
  140. 11200 :
  141. 11300 rem   get something from disk
  142. 11400 ifmid$(t$(cl%),3,1)="t"thenf$=mid$(t$(cl%),5):goto2100
  143. 11410 :
  144. 11450 i%=5:c%=0
  145. 11460 ifmid$(t$(cl%),i%,1)<>","theni%=i%+1:c%=c%+1:goto11460
  146. 11470 i%=i%-c%:f$=mid$(t$(cl%),i%,c%)
  147. 11480 mo%=val(mid$(t$(cl%),i%+c%+1))
  148. 11485 ad%=23296:ifmo%=2thenad%=28416
  149. 11490 x=ad%:sysbl%,x,f$
  150. 11492 poke249,224:poke250,204
  151. 11495 goto 5600
  152. 11900 :
  153. 12000 rem  input certain keys and                  goto the designated label
  154. 12100 t$=t$(cl%)
  155. 12200 nk=1:c=4
  156. 12300 vk$(nk)=mid$(t$,c,1)
  157. 12400 ifmid$(t$,c+1,1)=","thennk=nk+1:c=c+2:goto12300
  158. 12500 rem  nk=num of valid keys
  159. 12600 c=c+2:ch%=c
  160. 12700 forx=1tonk-1
  161. 12800 ifmid$(t$,ch%,1)=","then13000
  162. 12900 ch%=ch%+1:goto12800
  163. 13000 ll$(x)=mid$(t$,c,ch%-c)
  164. 13100 c=ch%+1:ch%=c
  165. 13200 nextx:ll$(nk)=mid$(t$,ch%)
  166. 13300 rem  labels in% vl$(1-nk)
  167. 13400 :
  168. 13500 poke198,0:wait198,1:getk$
  169. 13600 forx=1tonk
  170. 13700 ifk$=vk$(x)thenl$=ll$(x):goto13900
  171. 13800 nextx:goto13500
  172. 13900 gosub10200
  173. 14000 cl%=l
  174. 14100 return
  175. 14200 :
  176. 14300 rem  re%turn to magazette
  177. 14400 sys 51459:print"[147]":poke56,160:clr
  178. 14500 load"hello connect",8:end
  179. 14502 end
  180. 14600 rem ***** end *****
  181. 15000 rem
  182. 15005 rem  set parameters
  183. 15010 poke249,224:poke250,204
  184. 15015 poke251,0:poke252,71
  185. 15020 poke253,0:poke254,0
  186. 15025 poke255,0
  187. 15040 return
  188. 15050 :
  189. 16000 rem  massage variables
  190. 16010 c$=t$(cl%)
  191. 16020 i%=3:gosub8800:vn%=n%
  192. 16025 op$=mid$(c$,i%-1,1)
  193. 16030 gosub8800:nu%=n%
  194. 16040 l$=mid$(c$,i%)
  195. 16060 ifop$="="thenv%(vn%)=nu%:                goto5700
  196. 16070 ifop$="-"thenv%(vn%)=v%(vn%)-nu%:        goto5700
  197. 16075 ifop$="+"thenv%(vn%)=v%(vn%)+nu%:        goto5700
  198. 16080 ifop$="?"thenifv%(vn%)=nu%then           gosub10200:cl%=l:goto5800
  199. 16490 goto5700
  200. 16499 :
  201. 17000 rem   vtab
  202. 17010 i%=3:gosub8800:ty%=n%:return
  203. 17020 :
  204. 18000 rem   htab
  205. 18010 i%=3:gosub8800:ss=lm%:lm%=n%:hf=1
  206. 18020 return
  207. 18030 :
  208. 60000 rem   too bad!!!
  209. 60010 sys831,18176,"ctitle.shp"
  210. 60020 gosub15000:sys51456
  211. 60030 fordl=1to1000:next:print"[147]":sys51459:poke53280,0:poke53281,0:run1100
  212. 60040 :
  213.