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