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