Polymorphism/BASIC

From Rosetta Code

This is a programming example for the Polymorphism programming task. If the task description is not listed here, refer back to that page.

Interpeter: QuickBasic 4.5, PB 7.1

 DECLARE SUB PointInit0 (pthis AS POINT)
DECLARE SUB PointInit1 (pthis AS POINT, x0 AS INTEGER)
DECLARE SUB PointInit2 (pthis AS POINT, x0 AS INTEGER, y0 AS INTEGER)
DECLARE FUNCTION PointGetX%(pthis AS POINT)
DECLARE FUNCTION PointGetY%(pthis AS POINT)
DECLARE SUB PointSetX (pthis AS POINT, x0 AS INTEGER)
DECLARE SUB PointSetY (pthis AS POINT, y0 AS INTEGER)
DECLARE SUB PointPrint (pthis AS POINT)
 
DECLARE SUB CircleInit0 (pthis AS CIRCLE)
DECLARE SUB CircleInit1 (pthis AS CIRCLE, x0 AS INTEGER)
DECLARE SUB CircleInit2 (pthis AS CIRCLE, x0 AS INTEGER, y0 AS INTEGER)
DECLARE SUB CircleInit3 (pthis AS CIRCLE, x0 AS INTEGER, y0 AS INTEGER, r0 AS INTEGER)
DECLARE SUB CircleInitP0 (pthis AS CIRCLE, p AS POINT)
DECLARE SUB CircleInitP0 (pthis AS CIRCLE, p AS POINT, r0 AS INTEGER)
DECLARE FUNCTION CircleGetX%(pthis AS CIRCLE)
DECLARE FUNCTION CircleGetY%(pthis AS CIRCLE)
DECLARE FUNCTION CircleGetR%(pthis AS CIRCLE)
DECLARE SUB CircleSetX (pthis AS CIRCLE, x0 AS INTEGER)
DECLARE SUB CircleSetY (pthis AS CIRCLE, y0 AS INTEGER)
DECLARE SUB CircleSetR (pthis AS CIRCLE, r0 AS INTEGER)
DECLARE SUB CirclePrint (pthis AS CIRCLE)
DECLARE SUB PolyPrint (pthis AS ANY, type%)
 
TYPE POINT
x AS INTEGER
y AS INTEGER
END TYPE
TYPE CIRCLE
p AS POINT
r AS INTEGER
END TYPE
 
DIM SHARED POINT%, CIRCLE%
POINT% = 0
CIRCLE% = 1
 
DIM p AS POINT
DIM c AS CIRCLE
 
PointInit p
CircleInit c
 
REM No virtual FUNCTION CALL possible
PointPrint p
CirclePrint c
 
REM Faked virtual FUNCTION
PolyPrint p, POINT%
PolyPrint c, CIRCLE%
END
 
SUB PolyPrint (pthis AS ANY, type%)
IF (type% = CIRCLE%) THEN
CirclePrint pthis
ELSE
PointPrint pthis
END IF
 
END SUB
 
SUB PointInit0 (pthis AS POINT)
pthis.x = 0
pthis.y = 0
END SUB
 
SUB PointInit1 (pthis AS POINT, x0 AS INTEGER)
pthis.x = x0
pthis.y = 0
END SUB
 
SUB PointInit2 (pthis AS POINT, x0 AS INTEGER, y0 AS INTEGER)
pthis.x = x0
pthis.y = y0
END SUB
 
FUNCTION PointGetX% (pthis AS POINT)
PointGetX% = pthis.x
END SUB
 
FUNCTION PointGetY% (pthis AS POINT)
PointGetY% = pthis.y
END SUB
 
SUB PointSetX (pthis AS POINT, x0 AS INTEGER)
pthis.x = x0
END SUB
 
SUB PointSetY (pthis AS POINT, y0 AS INTEGER)
pthis.y = y0
END SUB
 
SUB PointPrint (pthis AS POINT)
PRINT "Point"
END SUB
 
SUB CircleInit0 (pthis AS CIRCLE)
pthis.x = 0
pthis.y = 0
pthis.r = 0
END SUB
 
SUB CircleInit1 (pthis AS CIRCLE, x0 AS INTEGER)
pthis.x = x0
pthis.y = y0
pthis.r = 0
END SUB
 
SUB CircleInit2 (pthis AS CIRCLE, x0 AS INTEGER, y0 AS INTEGER)
pthis.x = x0
pthis.y = y0
pthis.r = 0
END SUB
 
SUB CircleInit3 (pthis AS CIRCLE, x0 AS INTEGER, y0 AS INTEGER, r0 AS INTEGER)
pthis.x = x0
pthis.y = y0
pthis.r = r0
END SUB
 
SUB CircleInitP0 (pthis AS CIRCLE, p AS POINT)
pthis.x = p.x
pthis.y = p.y
pthis.r = 0
END SUB
 
SUB CircleInitP0 (pthis AS CIRCLE, p AS POINT, r0 AS INTEGER)
pthis.x = p.x
pthis.y = p.y
pthis.r = r0
END SUB
 
FUNCTION CircleGetX% (pthis AS CIRCLE)
CircleGetX% = pthis.x
END SUB
 
FUNCTION CircleGetY% (pthis AS CIRCLE)
CircleGetY% = pthis.y
END SUB
 
FUNCTION CircleGetR% (pthis AS CIRCLE)
CircleGetR% = pthis.r
END SUB
 
SUB CircleSetX (pthis AS CIRCLE, x0 AS INTEGER)
pthis.x = x0
END SUB
 
SUB CircleSetY (pthis AS CIRCLE, y0 AS INTEGER)
pthis.y = y0
END SUB
 
SUB CircleSetR (pthis AS CIRCLE, r0 AS INTEGER)
pthis.r = r0
END SUB
 
SUB CirclePrint (pthis AS CIRCLE)
PRINT "Circle"
END SUB