I have decided to release my gfx functions to make things easier for people to start off using the language.
I will be updating this to include a text command soon.
If you want to use this, just start off with this program and slot your own program in.
It draws filled triangles, lines, plots, filled circles and rectangles. Thanks go to stonemonkey, tetra, rbraz and Jim who have all helped at various stages to develop these routines, which although basic, you can do a lot with them!
This is only for use with tinyptc. I recomend that you use the version made by Rbraz and Jim.
' GENERAL PURPOSE FRAMEWORK FOR FREEBASIC BY SHOCKWAVE, USE FREELY.
' IF YOU LIKE IT A LOT, AND YOU WANT TO SAY THANKS, A PLUG FOR THE SITE
' WOULD DO NICELY! WWW.DBFINTERACTIVE.COM
'
' =================================================================
' This framework uses Tinyptc. You can use this routine as a shortcut if you
' want. It has functions to draw filled circles, Filled triangles, Rectangles
' Plots and lines.
'
' The functions are quite easy to use and they are all pretty fast.
'
' Hope that this helps some people to get started.
'
' You can exit the program by pressing escape.
' It is strongly reccomended that you replace your tinyptc library with the version
' by RBRAZ. The original used GDI drawing and has a crap refresh.
'-------------------------------------------------------------------------------
' REMOVE COMMENT ON LINE BELOW FOR WINDOWED MODE
#DEFINE PTC_WIN
#INCLUDE "TINYPTC.BI"
' ALL VARIABLES MUST BE DECLARED.
' -------------------------------
OPTION STATIC
OPTION EXPLICIT
' SCREEN DIMENSIONS.
' ------------------
CONST XRES = 640:' WIDTH
CONST YRES = 480:' HEIGHT
DECLARE SUB TRIANGLE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL X3 AS INTEGER, BYVAL Y3 AS INTEGER , BYVAL TR AS INTEGER,BYVAL TG AS INTEGER,BYVAL TB AS INTEGER)
DECLARE SUB CIRC(BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CR AS INTEGER,BYVAL CG AS INTEGER,BYVAL CB AS INTEGER)
DECLARE SUB RECT(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL XW AS INTEGER , BYVAL YH AS INTEGER , BYVAL RR AS INTEGER , BYVAL RG AS INTEGER, BYVAL RB AS INTEGER)
DECLARE SUB EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER, BYVAL LG AS INTEGER, BYVAL LB AS INTEGER)
DECLARE SUB DOT (BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL DR AS INTEGER , BYVAL DG AS INTEGER , BYVAL DB AS INTEGER )
'-------------------------------------------------------------------------------
' OPEN THE SCREEN
'-------------------------------------------------------------------------------
DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
If( PTC_OPEN( "FREEBASIC GRAPHICS SCREEN", XRES, YRES ) = 0 ) Then
End -1
End If
'-------------------------------------------------------------------------------
' THE MAIN LOOP;
'-------------------------------------------------------------------------------
while (1)
TRIANGLE (0,0 , 0,100 , 100 , 100 , 255 , 155 , 55)
CIRC (200 , 200 , 153 , 100 , 50 , 25)
RECT (39 , 80, 100 , 105 , 250, 250, 250)
EDGE (-10,-10 , 800,700 , 255 , 100 , 255 )
DOT (500,400 ,255,255,255)
PTC_UPDATE @ BUFFER (0)
ERASE BUFFER
wend
'-------------------------------------------------------------------------------
' CUSTOM GRAPHICS SUBS;
'-------------------------------------------------------------------------------
SUB DOT (BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL DR AS INTEGER , BYVAL DG AS INTEGER , BYVAL DB AS INTEGER )
'-------------------------------------------------------------------------------
' THIS SUB DRAWS A DOT AT X1 , Y1
' USAGE : DOT ( X1 , Y1 , R , G , B)
'
'-------------------------------------------------------------------------------
DIM TC AS INTEGER
TC = RGB (DR , DG , DB)
IF X1>0 AND X1 < XRES AND Y1>0 AND Y1<YRES THEN
BUFFER ( X1 + (Y1 * XRES)) = TC
END IF
END SUB
SUB EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER, BYVAL LG AS INTEGER, BYVAL LB AS INTEGER)
'-------------------------------------------------------------------------------
'
' THIS LINE ROUTINE IS NOT VERY FAST BUT IT WORKS.
' USAGE:
' EDGE ( X1 , Y1 , X2 , Y2 , R , G , B )
'
'-------------------------------------------------------------------------------
DIM xdistance AS DOUBLE
DIM ydistance AS DOUBLE
DIM TC AS INTEGER
DIM i AS INTEGER
DIM h2 AS INTEGER
DIM StartX AS DOUBLE
DIM StartY AS DOUBLE
DIM XRatio AS DOUBLE
DIM YRatio AS DOUBLE
TC = RGB ( LR,LG,LB )
xdistance = X2 - X1
ydistance = Y2 - Y1
h2 = sqr( xdistance * xdistance + ydistance * ydistance )
StartX = X1
StartY = Y1
XRatio = xdistance * ( 1.0 / h2 )
YRatio = ydistance * ( 1.0 / h2 )
for i = 0 to h2
IF STARTX>0 AND STARTX<XRES AND STARTY>0 AND STARTY<YRES THEN
BUFFER ( INT(StartX) + (INT(StartY) * XRES ) ) = TC
END IF
StartX = StartX + XRatio
StartY = StartY + YRatio
next i
END SUB
SUB RECT(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL XW AS INTEGER , BYVAL YH AS INTEGER , BYVAL RR AS INTEGER , BYVAL RG AS INTEGER, BYVAL RB AS INTEGER)
'-------------------------------------------------------------------------
'
' FILLED RECTANGLE ROUTINE WITH ASSEMBLY LANGUAGE RASTERISING.
' USAGE RECT ( TOPX , TOPY , WIDTH , HEIGHT , R , G , B )
' THIS ROUTINE HAS BASIC CLIPPING TO SCREEN BOUNDARIES.
'
'-------------------------------------------------------------------------
DIM PP AS INTEGER PTR
DIM AS INTEGER SLICE,LP,TC
'-------------------------------------------------------------------------
' BASIC CLIPPING TO SCREEN;
'-------------------------------------------------------------------------
IF X1 < 0 THEN
XW = XW + X1
X1=0
END IF
IF Y1 < 0 THEN
YH = YH + Y1
Y1=0
END IF
IF XW + X1 > XRES THEN
XW = XRES - X1
END IF
IF YH + Y1 > YRES THEN
YH = (YRES - Y1)
END IF
IF XW>0 AND YH>0 THEN
TC = RGB ( RR , RG , RB )
FOR LP =Y1 TO (YH+Y1)-1
pp=@buffer((XRES*LP)+X1)
slice = XW
if slice>0 then
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP]
rep stosd
end asm
end if
NEXT
END IF
END SUB
SUB CIRC(BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CR AS INTEGER,BYVAL CG AS INTEGER,BYVAL CB AS INTEGER)
'-------------------------------------------------------------------------
'
' FILLED CIRCLE ROUTINE WITH ASSEMBLY LANGUAGE RASTERISING.
' USAGE CIRC ( X , Y , RADIUS , R , G , B )
' REMEMBER THAT X + Y ARE THE CENTER OF YOUR CIRCLE.
' THIS HAS BASIC CLIPPING TO SCREEN BOUNDARIES.
'
'-------------------------------------------------------------------------
DIM as integer r2,cc,loopy,ww,l,clipl , clipr,slice,tc
dim pp as integer ptr
r2=r*r
cc=-r
TC = RGB ( CR , CG , CB )
for loopy = cc to r
ww = Sqr(r2-loopy*loopy)
if loopy+cy>=0 and loopy+cy<yres then
clipl = cx-ww
clipr = (cx+ww)-1
if clipl<0 then clipl=0
if clipr>xres-1 then clipr = xres-1
pp=@buffer((XRES*(loopy+CY))+clipl)
slice = clipr-clipl
if slice>0 then
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP]
rep stosd
end asm
end if
end if
next
END SUB
SUB TRIANGLE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL X3 AS INTEGER, BYVAL Y3 AS INTEGER , BYVAL TR AS INTEGER,BYVAL TG AS INTEGER,BYVAL TB AS INTEGER)
'-------------------------------------------------------------------------
' FLAT TRIANGLE RENDERER WITH ASSEMBLY LANGUAGE RASTERISING BY SHOCKWAVE ^ DBF ^ S!P 2006.
'
' USAGE : TRIANGLE ( X1 , Y1 , X2 , Y2 , X3 , Y3 , R , G , B )
' CLIPS TO SCREEN BOUNDARIES.
'
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
' WE NEED TO SORT THESE POINTS INTO ORDER FROM TOP TO BOTTOM, AN EXCHANGE SORT IS OK.
' AS WE ONLY HAVE GOT 3 POINTS TO ARRANGE.
'-------------------------------------------------------------------------
DIM AS INTEGER TEMPX,TEMPY,LO,LI,TC
DIM AS INTEGER PX(3)
DIM AS INTEGER PY(3)
DIM TFLAG AS INTEGER
dim pp as uinteger PTR
DIM AS INTEGER IL1,IL2,SLICE
TFLAG=0
TC = RGB ( TR , TG , TB )
PX(1)= X1
PX(2)= X2
PX(3)= X3
PY(1)= Y1
PY(2)= Y2
PY(3)= Y3
FOR LO = 1 TO 2
FOR LI =1 TO 2
IF PY(LI+1) <= PY(LI) THEN
TEMPX = PX(LI) : TEMPY = PY(LI)
PX(LI) = PX(LI+1)
PY(LI) = PY(LI+1)
PX(LI+1) = TEMPX
PY(LI+1) = TEMPY
END IF
NEXT LI
NEXT LO
' BOOT OUT INVISIBLE TRIANGLES!
IF PX(1)<0 AND PX(2)<0 AND PX(3)< 0 THEN TFLAG=1
IF PX(1)>XRES AND PX(2)>XRES AND PX(3)>XRES THEN TFLAG=1
IF PY(1)>YRES AND PY(2)>YRES AND PY(3)>YRES THEN TFLAG=1
DIM AS DOUBLE XP1,XP2:' SCREEN POSITIONS.
DIM AS DOUBLE XI1,XI2:' INTERPOLATIONS.
'***
'*** REGULAR TRIANGLE (Y1<Y2 Y2<Y3)
'***
IF PY(1)<PY(2) AND PY(2)<PY(3) or (PY(2) = PY(3)) THEN
TFLAG=1
XP1 = PX(1)
XP2 = PX(1)
XI1 = (PX(1)-PX(2)) / (PY(2) - PY(1))
XI2 = (PX(1)-PX(3)) / (PY(3) - PY(1))
FOR LO = PY(1) TO PY(2)-1
IF LO>=0 AND LO<YRES THEN
IF XP1<=XP2 THEN
IL1=XP1
IL2=XP2
ELSE
IL1=XP2
IL2=XP1
END IF
IF IL2>XRES THEN IL2=XRES
IF IL1<0 THEN IL1=0
SLICE = IL2-IL1
IF SLICE>0 THEN
PP = @BUFFER(IL1+(LO*XRES))
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP]
rep stosd
end asm
END IF
END IF
XP1=XP1-XI1
XP2=XP2-XI2
NEXT
XI1 = (PX(2)-PX(3)) / (PY(3) - PY(2))
XP1 = PX(2)
FOR LO = PY(2) TO PY(3)
IF LO>=0 AND LO<YRES THEN
IF XP1<=XP2 THEN
IL1=XP1
IL2=XP2
ELSE
IL1=XP2
IL2=XP1
END IF
IF IL2>XRES THEN IL2=XRES
IF IL1<0 THEN IL1=0
SLICE = IL2-IL1
IF SLICE>0 THEN
PP = @BUFFER(IL1+(LO*XRES))
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP]
rep stosd
end asm
END IF
END IF
XP1=XP1-XI1
XP2=XP2-XI2
NEXT
END IF
'***
'*** FLAT TOPPED TRIANGLE Y1=Y2
'***
IF TFLAG=0 AND PY(1) = PY(2) THEN
TFLAG=1
XP1 = PX(1)
XP2 = PX(2)
XI1 = (PX(1)-PX(3)) / (PY(3) - PY(1))
XI2 = (PX(2)-PX(3)) / (PY(3) - PY(2))
FOR LO = PY(1) TO PY(3)
IF LO>=0 AND LO<YRES THEN
IF XP1<=XP2 THEN
IL1=XP1
IL2=XP2
ELSE
IL1=XP2
IL2=XP1
END IF
IF IL2>XRES THEN IL2=XRES
IF IL1<0 THEN IL1=0
SLICE = IL2-IL1
IF SLICE>0 THEN
PP = @BUFFER(IL1+(LO*XRES))
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP]
rep stosd
end asm
END IF
END IF
XP1=XP1-XI1
XP2=XP2-XI2
NEXT
END IF
END SUB
