8-Bit Software Online Conversion
Logo Subset - Listing
10MODE4
20VDU23,1,0;0;0;0;
30PRINTTAB(14,13);"Logo Subset"
40PRINTTAB(14,30);"Press Space"
50REPEAT:UNTIL INKEY$(0)=" "
60MODE4
70PROCinitialise
80REPEAT
90PROCprocessline
100UNTIL FALSE
110END
120DEFPROCgetnextsymbol
130LOCAL j
140IF MID$(line$,linep,1)=" " THEN REP
EAT : linep=linep+1 : UNTIL MID$(line$,l
inep,1)<>" "
150IF INSTR("[!]:",MID$(line$,linep,1)
) THEN symbol$=MID$(line$,linep,1):linep
=linep+1 : ENDPROC
160j=linep
170REPEAT
180j=j+1
190UNTIL INSTR("[!]: ",MID$(line$,j,1)
)
200symbol$=MID$(line$,linep,j-linep)
210linep=j
220ENDPROC
230DEFPROCinitialise
240DIMvar$(100),val(100)
250DIM procname$(10),start(10),finish(
10),procline$(10)
260DIM params(10),paramstart(10),param
name$(30)
270lastproc=0:lastline=0
280lastpn=0
290stackp=0
300VDU24,0;128;1279;1023;
310VDU28,0,31,39,28
320PROCclearscreen
330ENDPROC
340DEFPROCclearscreen
350CLG
360x=642 : y=578 : MOVE x,y
370xdir=0 : ydir=1 : angle=90 : penup=
TRUE
380ENDPROC
390DEFPROCprocessline
400PROCgetline("Line: ")
410linep=1 : PROCgetnextsymbol
420IF symbol$="TO" THEN PROCdefineproc
ELSE PROCprocessgroup("!")
430ENDPROC
440DEFPROCgetline(prompt$)
450REPEAT : PRINT prompt$; : INPUT LIN
E ""line$
460UNTIL line$<>""
470line$=line$+"!"
480ENDPROC
490DEFPROCprocessgroup(terminator$)
500failed=FALSE
510REPEAT
520PROCprocesscommand
530PROCgetnextsymbol
540UNTIL symbol$=terminator$ OR failed
550ENDPROC
560DEFPROCprocesscommand
570LOCAL procfound,proc
580 IF symbol$="PENDOWN" OR symbol$="P
DWN" THEN penup=FALSE:ENDPROC
590IF symbol$="PENUP" OR symbol$="PUP"
THEN penup=TRUE:ENDPROC
600IF symbol$="CLEARSCREEN" OR symbol$
="CLS" THEN PROCclearscreen:ENDPROC
610IF symbol$="FORWARD" OR symbol$="F"
THEN PROCforward:ENDPROC
620IF symbol$="BACK" OR symbol$="B" TH
EN PROCback:ENDPROC
630IF symbol$="LEFT" OR symbol$="L" TH
EN PROCleft:ENDPROC
640IF symbol$="RIGHT" OR symbol$="R" T
HEN PROCright:ENDPROC
650IF symbol$="REPEAT" OR symbol$="REP
" THEN PROCrepeat :ENDPROC
660IF symbol$="WHITE" THEN PROCwhite :
ENDPROC
670IF symbol$="BLACK" THEN PROCblack :
ENDPROC
680IF symbol$="quit" THEN CLS:CLG:END
690PROClookup
700IF procfound THEN PROCcall(proc):EN
DPROC
710PROCfail(1)
720ENDPROC
730DEFPROCforward
740LOCAL d
750d=FNgetvalue
760IF failed THEN ENDPROC
770x=x+d*xdir
780y=y+d*ydir
790IF penup THEN MOVE x,y ELSE DRAW x,
y
800ENDPROC
810DEFPROCback
820LOCAL d
830d=FNgetvalue
840IF failed THEN ENDPROC
850x=x-d*xdir
860y=y-d*ydir
870IF penup THEN MOVE x,y ELSE DRAW x,
y
880ENDPROC
890DEFPROCleft
900LOCAL a
910a=FNgetvalue
920IF failed THEN ENDPROC
930angle=(angle+a) MOD 360
940xdir=COS(RAD(angle))
950ydir=SIN(RAD(angle))
960ENDPROC
970DEFPROCright
980LOCAL a
990a=FNgetvalue
1000IF failed THEN ENDPROC
1010angle=(angle-a) MOD 360
1020xdir=COS(RAD(angle))
1030ydir=SIN(RAD(angle))
1040ENDPROC
1050DEFFNgetvalue
1060PROCgetnextsymbol
1070IF symbol$=":" THEN =FNvarvalue
1080value=VAL(symbol$)
1090IF value=0 THEN PROCfail(2)
1100=value
1110DEFPROCfail(errorno)
1120PRINT"Error ";errorno
1130PRINTLEFT$(line$,LEN(line$)-1)'TAB(
linep-2);""
1140failed=2
1150ENDPROC
1160DEFPROCrepeat
1170LOCAL start,no,loop
1180no=FNgetvalue
1190IF failed THEN ENDPROC
1200PROCgetnextsymbol
1210IF symbol$<>"["THEN PROCfail(3)
1220start=linep:loop=0
1230REPEAT
1240loop=loop+1
1250linep=start
1260PROCgetnextsymbol
1270PROCprocessgroup("]")
1280UNTIL loop=no OR failed
1290ENDPROC
1300DEFPROCdefineproc
1310PROCgetnextsymbol
1320lastproc=lastproc+1
1330procname$(lastproc)=symbol$
1340PROCgetparamname
1350start(lastproc)=lastline+1
1360PROCgetline("TO line: ")
1370REPEAT
1380lastline=lastline+1
1390procline$(lastline)=line$
1400PROCgetline("TO line: ")
1410UNTIL line$="END!"
1420finish(lastproc)=lastline
1430ENDPROC
1440DEFPROClookup
1450IF lastproc=0 THEN procfound=FALSE
: ENDPROC
1460proc=0
1470REPEAT
1480proc=proc+1
1490procfound=procname$(proc)=symbol$
1500UNTIL procfound OR proc=lastproc
1510ENDPROC
1520DEFPROCcall(proc)
1530PROCgetparamvals :IF failed ENDPROC
1540LOCAL line$,linep,count
1550count=start(proc)
1560REPEAT
1570line$=procline$(count)
1580linep=1:PROCgetnextsymbol
1590PROCprocessgroup("!")
1600count=count+1
1610UNTIL count>finish(proc) OR failed
1620stackp=stackp-params(proc)
1630ENDPROC
1640DEFPROCgetparamname
1650params(lastproc)=0
1660PROCgetnextsymbol
1670IF symbol$<>":" THEN ENDPROC
1680paramstart(lastproc)=lastpn+1
1690REPEAT
1700params(lastproc)=params(lastproc)+1
1710PROCgetnextsymbol
1720lastpn=lastpn+1
1730paramname$(lastpn)=symbol$
1740PROCgetnextsymbol
1750UNTIL symbol$<>":"
1760ENDPROC
1770DEFPROCgetparamvals
1780LOCAL pn,nextpn,v
1790IF params(proc)=0 ENDPROC
1800pn=paramstart(proc)
1810nextpn=pn+params(proc)
1820REPEAT
1830v=FNgetvalue
1840stackp=stackp+1
1850var$(stackp)=paramname$(pn) : val(s
tackp)=v
1860pn=pn+1
1870UNTIL pn=nextpn OR failed
1880ENDPROC
1890DEFFNvarvalue
1900LOCAL varfound,sp
1910PROCgetnextsymbol
1920IF stackp=0 THEN PROCfail(5): =0
1930sp=stackp+1 : varfound=FALSE
1940REPEAT
1950sp=sp-1
1960varfound=var$(sp)=symbol$
1970UNTIL varfound OR sp=1
1980IF varfound THEN =val(sp)
1990PROCfail(5)
2000=0
2010DEFPROCblack
2020GCOL0,0:ENDPROC
2030DEFPROCwhite
2040GCOL0,7:ENDPROC