RosettaCodeData/Task/Mad-Libs/Commodore-BASIC/mad-libs.basic

87 lines
2.4 KiB
Plaintext

10 rem mad lib for rosetta code
15 dim bf$(100),wd$(50),tg$(50):tb=49152
20 print chr$(147);chr$(14);"Mad Lib Processor":print
25 gosub 1000
30 gosub 100:gosub 250:gosub 300:gosub 400
40 print:print:print "Again? ";:gosub 500:print k$
45 if k$<>"y" then end
50 goto 20
100 tg=1:for i=1 to bp:n$="":mo=0
105 t$=bf$(i)
110 for j=1 to len(t$)
115 ch$=mid$(t$,j,1)
120 if ch$="<" then mo=1:goto 140
125 if ch$=">" then mo=0:gosub 200:n$=n$+wd$:tg$="":goto 140
130 if mo=0 then n$=n$+ch$
135 if mo=1 then tg$=tg$+ch$
140 next j
145 bf$(i)=n$
150 next i
155 return
200 for z=1 to tg
205 if tg$(z)=tg$ then wd$=wd$(z):return
210 next z
215 tg=tg+1:tg$(tg)=tg$
220 print "Enter a ";tg$(tg);:input wd$
225 wd$(tg)=wd$
230 return
250 print chr$(147):print "Processing...":print
255 m=tb:os=0:ns=0:for i=1 to bp-1
260 t$=bf$(i)
265 for c=1 to len(t$):ch$=mid$(t$,c,1)
270 poke m,asc(ch$+chr$(0)):m=m+1:next c
275 next i:rem poke m,32:m=m+1
280 m=m-1:return
300 rem insert cr for word wrap
310 pt=tb:sz=0:ll=0
320 if peek(pt)=32 then gosub 350:if(ll+sz>39) then poke pt,13:ll=-1:sz=0
325 if peek(pt)=13 then ll=-1
330 if pt<>m then pt=pt+1:ll=ll+1:goto 320
340 return
350 rem look ahead to next space
355 nx=pt+1:sz=1
360 if peek(nx)=32 or peek(nx)=13 then return
365 nx=nx+1:sz=sz+1
370 if nx=m then return
375 goto 360
400 rem output memory buffer
401 ln=0:print chr$(147);
410 for i=tb to m:c=peek(i)
420 if c=13 then ln=ln+1
425 print chr$(c);
430 if ln=23 then ln=0:print:gosub 550
440 next i
450 return
500 rem clear buffer, wait for a key
501 get k$:if k$<>"" then 501
505 get k$:if k$="" then 505
510 return
550 rem pause prompt
560 print"[Pause]{CRSR-LEFT 7}";
565 gosub 500
570 print"{SPACE 7}{CRSR-LEFT 7}{CRSR-UP}";
575 return
1000 rem load file
1005 bp=1
1010 print:input "Enter name of file: ";fi$
1020 open 7,8,7,"0:"+fi$+",s,r"
1025 rem gosub 2000
1030 rem if er<>0 then print:gosub 2100:return
1035 get#7,a$
1036 ifa$=chr$(13)thenbf$(bp)=t$+a$:print" ";:t$="":bp=bp+1:goto 1040
1038 t$=t$+a$
1040 if (st and 64)=0 then goto 1035
1049 close 7:gosub 2000
1050 if er=0 then printchr$(147):return
1055 gosub 2100
1060 if er<>0 then goto 1000
1080 return
2000 rem check disk error
2001 open 15,8,15:input#15,er,en$,et$,es$:close15
2010 return
2100 rem print pretty error
2101 ca$=left$(en$,1):ca$=chr$(asc(ca$)+128):en$=ca$+right$(en$,len(en$)-1)
2105 print:print er;"- ";en$;" at .:";et$;" .:";es$
2110 print:print "Press a key.":gosub 500
2115 return