Betelgeuse - Small Graphics Routine

[Gary Barnes]

Just a small graphics diversion

' 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

Regards