Code:
' The Control Key 2008 ' This is a little routine that was featured as a graphics sample for GFA-BASIC ' GFA-BASIC was a moderately popular compiler for a while last century. #COMPILE EXE #DIM ALL #INCLUDE "win32api.inc" SUB betel(cx AS LONG, cy AS LONG, radius AS LONG, fg AS LONG, bg AS LONG) LOCAL xm,ym,rd,xs,ys,xe,ye,i,j,vx,vy AS LONG LOCAL lx,ly,lz,ll,vz,vl,w AS SINGLE xm = cx ym = cy rd = radius xs = xm + rd + 10 ys = ym + rd + 10 xe = xm - rd - 10 ye = ym - rd - 10 lx = -1.5 ly = -1.5 lz = -.25 ll = SQR(lx ^ 2 + ly ^ 2 + lz ^ 2) FOR i = xm - rd TO xm + rd FOR j = ym - rd TO ym + rd SLEEP 0 IF SQR((i - xm) ^ 2 + (j - ym) ^ 2) < rd THEN VX = i - xm VY = j - ym vz = SQR(rd ^ 2 - VX ^ 2 - VY ^ 2) vl = SQR(VX ^ 2 + VY ^ 2 + vz ^ 2) w = (lx * VX + ly * VY + lz * vz) / (ll * vl) IF w + RND(1) * 1.5 - .75 > 0 THEN GRAPHIC SET PIXEL (CINT(i), CINT(j)), fg ELSE GRAPHIC SET PIXEL (CINT(i), CINT(j)), bg END IF END IF NEXT j NEXT i GRAPHIC ELLIPSE (xm-radius,ym-radius)-(xm+radius,ym+radius),fg END SUB FUNCTION PBMAIN () AS LONG LOCAL hwin, x, y AS LONG GRAPHIC WINDOW "Betelgeuse",100,100,800,800 TO hwin GRAPHIC ATTACH hwin,0 ,REDRAW GRAPHIC COLOR %RED,%WHITE GRAPHIC CLEAR FOR y = 99 TO 799 STEP 200 FOR x = 99 TO 799 STEP 200 IF x > 400 THEN betel x,y,100, %CYAN, %BLUE ELSE betel x,y,100, %BLUE, %CYAN END IF GRAPHIC REDRAW NEXT x NEXT y WHILE iswindow(hwin) : SLEEP 100 : WEND ' Loop until the graphics window is destroyed END FUNCTION