REM Putting global constants here, because can't find a better place...
CONST CURLEN% = 2 'Cursor line length, cursor has 4 lines forming a crosshair
CONST SCRWIDTH% = 319 'maximum X coordinate on screen
CONST SCRHEIGHT% = 199 'maximum Y coordinate on screen
CONST COLORON% = 15
CONST COLOROFF% = 0
CONST TRUE = 1
CONST FALSE = 0
CONST DOTSINSHAPE = 15
CONST MAXSHAPES = 5
REM Custom data types to describe our objects
TYPE Dot
x AS INTEGER
y AS INTEGER
END TYPE
TYPE Shape
dotCount AS INTEGER
isClosed AS INTEGER
END TYPE
REM Autogenerated declarations
DECLARE FUNCTION ADDDOT% (curPos AS ANY, curShape AS INTEGER, shapes() AS Shape, dots() AS Dot)
DECLARE SUB DRAWSHAPE (shapes() AS Shape, dots() AS Dot, curPos AS Dot, i%)
DECLARE SUB PAINTCURSOR (d AS Dot, CURCOLOR%)
DECLARE FUNCTION MAX% (A%, B%)
DECLARE FUNCTION MIN% (A%, B%)
DECLARE FUNCTION MOVECURSOR% (k$, d AS ANY)
REM This is main (though basic does not have main)
SCREEN 7
DIM shapes(MAXSHAPES) AS Shape
DIM dots(MAXSHAPES, DOTSINSHAPE) AS Dot 'We have to do this because QB dosn't support arrays in user types
curShape% = 0
DIM curPos AS Dot
DIM oldPos AS Dot
curPos.x = SCRWIDTH% / 2
curPos.y = SCRHEIGHT% / 2
CALL PAINTCURSOR(curPos, COLORON%)
REM Event loop
DO
oldPos = curPos
CURKEY$ = INKEY$
IF CURKEY$ = CHR$(32) THEN
changed = ADDDOT(curPos, curShape%, shapes(), dots())
ELSE
changed = MOVECURSOR(CURKEY$, curPos)
END IF
IF changed = TRUE THEN
CALL PAINTCURSOR(oldPos, COLOROFF%)
REM Delete line to cursor
DIM cs AS Shape
cs = shapes(curShape%)
IF cs.isClosed = FALSE AND cs.dotCount > 0 THEN
LINE (dots(curShape%, cs.dotCount - 1).x, dots(curShape%, cs.dotCount - 1).y)-(oldPos.x, oldPos.y), 0
END IF
FOR i% = 0 TO curShape%
CALL DRAWSHAPE(shapes(), dots(), curPos, i%)
NEXT i%
CALL PAINTCURSOR(curPos, COLORON%)
END IF
LOOP UNTIL CURKEY$ = CHR$(27)
FUNCTION ADDDOT% (curPos AS Dot, curShape%, shapes() AS Shape, dots() AS Dot)
REM If we are out of shapes, do nothing
IF shapes(curShape%).isClosed = TRUE THEN
ADDDOT = FALSE
EXIT FUNCTION
END IF
needClose = FALSE
ADDDOT = TRUE
REM If this is first dot in shape, just add it
IF shapes(curShape%).dotCount = 0 THEN
dots(curShape%, 0) = curPos
shapes(curShape%).dotCount = 1
ELSE
REM Check if same position as first dot
IF curPos.x = dots(curShape%, 0).x AND curPos.y = dots(curShape%, 0).y THEN
needClose = TRUE
ELSE
dots(curShape%, shapes(curShape%).dotCount) = curPos
shapes(curShape%).dotCount = shapes(curShape%).dotCount + 1
IF shapes(curShape%).dotCount = DOTSINSHAPE THEN needClose = TRUE
END IF
END IF
IF needClose = TRUE THEN
shapes(curShape%).isClosed = TRUE
IF curShape% < MAXSHAPES - 1 THEN
curShape% = curShape% + 1
END IF
END IF
END FUNCTION
SUB DRAWSHAPE (shapes() AS Shape, dots() AS Dot, curPos AS Dot, i%)
DIM s AS Shape
s = shapes(i%)
REM Make sure we don't try to draw line to non-existant dot!
IF s.dotCount > 1 THEN
FOR d% = 0 TO s.dotCount - 2
LINE (dots(i%, d%).x, dots(i%, d%).y)-(dots(i%, d% + 1).x, dots(i%, d% + 1).y)
NEXT d%
END IF
REM last line in shape, may go to cursor
IF s.dotCount > 0 THEN
IF s.isClosed THEN
LINE (dots(i%, s.dotCount - 1).x, dots(i%, s.dotCount - 1).y)-(dots(i%, 0).x, dots(i%, 0).y)
ELSE
LINE (dots(i%, s.dotCount - 1).x, dots(i%, s.dotCount - 1).y)-(curPos.x, curPos.y)
END IF
END IF
END SUB
FUNCTION MAX% (A%, B%)
IF A% >= B% THEN MAX = A% ELSE MAX% = B
END FUNCTION
FUNCTION MIN% (A%, B%)
IF A% <= B% THEN MIN = A% ELSE MIN = B%
END FUNCTION
FUNCTION MOVECURSOR% (k$, d AS Dot)
IF RIGHT$(k$, 1) = "K" AND d.x > 0 THEN
d.x = d.x - 1
MOVECURSOR = TRUE
ELSEIF RIGHT$(k$, 1) = "M" AND d.x < SCRWIDTH% THEN
d.x = d.x + 1
MOVECURSOR = TRUE
ELSEIF RIGHT$(k$, 1) = "H" AND d.y > 0 THEN
d.y = d.y - 1
MOVECURSOR = TRUE
ELSEIF RIGHT$(k$, 1) = "P" AND d.y < SCRHEIGHT% THEN
d.y = d.y + 1
MOVECURSOR = TRUE
ELSE
MOVECURSOR = FALSE
END IF
END FUNCTION
SUB PAINTCURSOR (d AS Dot, CURCOLOR%)
IF d.y > 0 THEN LINE (d.x, MAX(d.y - 1, 0))-(d.x, MAX(d.y - (1 + CURLEN%), 0)), CURCOLOR%
IF d.y < SCRHEIGHT% THEN LINE (d.x, MIN(d.y + 1, SCRHEIGHT%))-(d.x, MIN(d.y + 1 + CURLEN%, SCRHEIGHT%)), CURCOLOR%
IF d.x > 0 THEN LINE (MAX(d.x - 1, 0), d.y)-(MAX(d.x - (1 + CURLEN%), 0), d.y), CURCOLOR%
IF d.x < SCRWIDTH% THEN LINE (MIN(d.x + 1, SCRWIDTH%), d.y)-(MIN(d.x + 1 + CURLEN%, SCRWIDTH%), d.y), CURCOLOR%
END SUB
