diff --git a/AtariST-GFA.txt b/AtariST-GFA.txt new file mode 100644 index 0000000..482c8da --- /dev/null +++ b/AtariST-GFA.txt @@ -0,0 +1,283 @@ +' BASIC Challenge #6: Terraspin +' http://reddit.com/r/RetroBattlestations +' written by FozzTexx - Atari ST GFA port by LaceySnr +CLS +' Resolution detection +SELECT XBIOS(4) +CASE 0 + COLOR 4 + width%=320 + height%=200 +CASE 1 + COLOR 2 + width%=640 + height%=200 +CASE 2 + COLOR 1 + width%=640 + height%=400 +ENDSELECT +PRINT width%,height% +' INPUT wait$ +' Calculate step sizes +xs=width%/1000 +ys=(height%*4)/(1000*3) +width=width%-1 +height=height%-1 +pi=3.14159 +' initial position and heading +tx=500 +ty=500 +ta=90 +tp=1 +tc=1 +COLOR 1 +' Comands to execute +cm$="5 ( D 12 ( 1 C 210 M 5 ( 30 T 10 M ) ) U 100 T 150 M )" +' cm$="60 (6 T 1 C 4 ( 100 M 90 T )) " +CLS +' Interpreter: instruction pointer, stack pointer, stack +ip=1 +sp=0 +DIM sk(10000) +' +getcommand: +c$=MID$(cm$,ip,1) +SELECT c$ +CASE "(" + v=ip + GOSUB pushstack +CASE ")" + GOSUB doloop +CASE "-" TO "9" + v=VAL(MID$(cm$,ip)) + GOSUB pushstack + GOSUB skipnumber +CASE "M" + GOSUB move +CASE "T" + GOSUB turn +CASE "U" + GOSUB penup +CASE "D" + GOSUB pendown +CASE "C" + GOSUB changecol +ENDSELECT +ip=ip+1 +IF ip>LEN(cm$) + GOTO finished +ENDIF +GOTO getcommand +finished: +PRINT "Greetz /r/retrobattlestations" +PRINT "/u/LaceySnr - 8th July, 2016" +END +' +PROCEDURE pushstack + sk(sp)=v + sp=sp+1 +RETURN +' +PROCEDURE popstack + sp=sp-1 + v=sk(sp) +RETURN +' +PROCEDURE skipnumber +sn_loop: + ip=ip+1 + IF ip>LEN(cm$) THEN + GOTO sn_done + ENDIF + c2$=MID$(cm$,ip,1) + IF c2$>="-" AND c2$<="9" + GOTO sn_loop + ENDIF +sn_done: + ip=ip-1 +RETURN +' +PROCEDURE doloop + GOSUB popstack + bp=v + GOSUB popstack + lr=v + lr=lr-1 + IF lr<1 + GOTO lb_done + ENDIF + v=lr + GOSUB pushstack + v=bp + GOSUB pushstack + ip=bp +lb_done: +RETURN +' +PROCEDURE changecol + GOSUB popstack + tc=AND(tc+v,15) + IF tc=0 + tc=tc+v + ENDIF + COLOR tc +RETURN +' +PROCEDURE move + GOSUB popstack + lx=v*COS((360-ta)*PI/180) + ly=v*SIN((360-ta)*PI/180) + IF tp>0 THEN + x1=tx + y1=ty + x2=x1+lx + y2=y1+ly + GOSUB drawline + ENDIF + tx=tx+lx + ty=ty+ly +RETURN +' +PROCEDURE turn + GOSUB popstack + ta=ta+v +turn_left: + IF ta<0 THEN + ta=ta+360 + GOTO turn_left + ENDIF +turn_right: + IF ta>360 THEN + ta=ta-360 + GOTO turn_right + ENDIF +RETURN +' +PROCEDURE penup + tp=0 +RETURN +' +PROCEDURE pendown + tp=1 +RETURN +' +PROCEDURE drawline + x1=x1*xs + x2=x2*xs + y1=y1*ys + y2=y2*ys +dl_loop: + x=x1 + y=y1 + GOSUB calcregioncode + c1=c + x=x2 + y=y2 + GOSUB calcregioncode + c2=c + IF c1=0 AND c2=0 THEN + GOSUB plotline + GOTO dl_done + ENDIF + IF AND(c1,c2) THEN + GOTO dl_done + ENDIF + c=c1 + IF c=0 + c=c2 + ENDIF + IF AND(c,1) THEN + x=x1+(x2-x1)*(height-y1)/(y2-y1) + y=height + GOTO dl_checkend + ENDIF + IF AND(c,2) THEN + x=x1+(x2-x1)*(0-y1)/(y2-y1) + y=0 + GOTO dl_checkend + ENDIF + IF AND(c,4) THEN + y=y1+(y2-y1)*(width-x1)/(x2-x1) + x=width + GOTO dl_checkend + ENDIF + IF AND(c,8) THEN + y=y1+(y2-y1)*(0-x1)/(x2-x1) + x=0 + ENDIF +dl_checkend: + IF c=c1 THEN + x1=x + y1=y + GOTO dl_loop + ENDIF + x2=x + y2=y + GOTO dl_loop +dl_done: +RETURN +' +PROCEDURE calcregioncode + c=0 + IF y>height + c=1 + ENDIF + IF y<0 + c=2 + ENDIF + IF x>width + c=OR(c,4) + ENDIF + IF x<0 + c=OR(c,8) + ENDIF +RETURN +' +PROCEDURE plotline + x1%=x1 + x2%=x2 + y1%=y1 + y2%=y2 + dx%=ABS(x2%-x1%) + sx%=-1 + IF x1%dy% + er%=dx% + ENDIF + er%=er%/2 +pl_plot: + GOSUB plot + IF x1%=x2% AND y1%=y2% + GOTO pl_done + ENDIF + e2%=er% + IF e2%>-dx% + er%=er%-dy% + x1%=x1%+sx% + ENDIF + IF x1%=x2% AND y1%=y2% + GOTO pl_done + ENDIF + IF e2%