'===========================================================================
' Subject: VGA PAINT                         Date: 04/95 (00:00)          
' Author:  Timothy Culberson                 Code: QB, PDS                
' Origin:  culberson@itchy.mis.nb.ca       Packet: GRAPHICS.ABC
'===========================================================================
'I know this code is extremely messy and makes absoloutely no sense to anyone,
'But it was originally programmed for only myself. 


'-----------------------------------Documentation starts here--------------
'VGA Paint
'By
'Timothy culberson
'For QBasic programmers
'April, 1995
'Complete documentation

'Welcome Quick Basic programmer to the painting program made in Quick Basic.

'This Program will allow you to paint neat logos and graphics you can use with
'your BASIC programs using the Bsave and Bload commands in Basic.  Actually, it
'won't allow you to do much of anything, but anyways...here it is.

'How does it work?

'The drawing screen:
'This is where you'll be painting in.  It is an area 150 pixels by 120 pixels.

'The NEW button:
'This will clear the whole drawing screen

'The QUIT button:
'This quits the program

'The COLOR button:
'This changes the color.  The color is shown along the palette bar at the
'bottom of the screen and the box outline at the bottom of the screen.
'The left mouse button advances the color and the right mouse button decreases
'the color along the palette bar.

'The SAVE button:
'This button will save your waork with the extension .RAD

'The LOAD button:
'This button will load a previously saved work with the extension .RAD

'The SQUARE button:
'This button will change the size of the drawing square.  The left mouse
'button will increase the size and the right mouse button will decrease the
'size.  The size is shown at the bottom of the square.


'How to Bload your work in your Qbasic programs....the source code:

'Loading you program from memory is very easy.
'1] Create a drawing in VgaPaint
'2] Place the source code into your QB program wherever you want it.
'3] Watch the cool thing!

'Source Code: how is it done?

'SCREEN 13
'^^^^^^^^^^^^^^^
'This sets the graphic screen to 320/200 vga 256 colors.

'DIM cub(1 TO 9000)
'DEF SEG = VARSEG(cub(1))
'BLOAD "c:\qb\" + "R5" + ".RAD", VARPTR(cub(1))
'             ^^^^^^       ^^^--->filename
'          Path of file
'DEF SEG
'^^^^^^^^^^^^
'This will load it up.
'PUT (80, 25), cub, PSET
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'This line will put the graphic at desired X,Y coordinates.


'And that's it.

'E -mail:
'culberson@mis.nb.ca
'------------------------------Code starts here-------------------------------
STARTUP:
DECLARE SUB ENDPROGRAM ()
DECLARE SUB SAVE ()
DECLARE SUB LOAD ()
DECLARE SUB NEWSCREEN ()
DECLARE SUB ARROW ()
DECLARE SUB DRAWSCREEN ()
REM $INCLUDE: 'QB.BI'
DIM SHARED REGX  AS RegTypeX
DIM SHARED COL
DIM SHARED RAD
DIM SHARED RADI, SPD
CLS
SCREEN 13
CALL DRAWSCREEN


YO:

REGX.ax = 15
CALL INTERRUPTX(&H33, REGX, REGX)
REGX.cx = 16
REGX.dx = 16
CALL INTERRUPTX(&H33, REGX, REGX)
REGX.ax = 1
CALL INTERRUPTX(&H33, REGX, REGX)
REGX.ax = 3
CALL INTERRUPTX(&H33, REGX, REGX)
A$ = INKEY$
IF A$ = CHR$(27) THEN END
IF REGX.cx / 2 > 150 THEN GOTO ODA
IF REGX.dx > 120 THEN GOTO ODA

SQ:
IF REGX.cx / 2 < 150 AND REGX.dx < 120 AND REGX.cx / 2 > 0 AND REGX.dx > 0 AND REGX.bx = 1 THEN
LINE (REGX.cx / 2, REGX.dx)-(REGX.cx / 2 - SS, REGX.dx - SS), COL, BF
END IF

CALL INTERRUPTX(&H33, REGX, REGX)
GOTO YO

ODA:
'LINE (160, 0)-(220, 30), 32, B
IF REGX.cx / 2 > 160 AND REGX.dx > 0 AND REGX.cx / 2 < 220 AND REGX.dx < 30 AND REGX.bx = 1 THEN
COL = COL + 1
COLOR 15: PSET (COL, 194): CALL ARROW: COLOR 0: PSET (COL - 1, 194): CALL ARROW
IF COL > 255 THEN COL = 255
FOR DELAY = 1 TO 600: NEXT DELAY
COLOR COL
END IF

'LINE (160, 0)-(220, 30), 32, B
IF REGX.cx / 2 > 160 AND REGX.dx > 0 AND REGX.cx / 2 < 220 AND REGX.dx < 30 AND REGX.bx = 2 THEN
COL = COL - 1
COLOR 15: PSET (COL, 194): CALL ARROW: COLOR 0: PSET (COL + 1, 194): CALL ARROW
FOR DELAY = 1 TO 600: NEXT DELAY
IF COL < 0 THEN COL = 0
COLOR COL
END IF



'NEW TOOL
'LINE (250, 0)-(285, 20), 32, B
IF REGX.cx / 2 > 160 AND REGX.dx > 25 AND REGX.cx / 2 < 220 AND REGX.dx < 45 AND REGX.bx = 1 THEN
LINE (0, 0)-(150, 120), 0, BF
LINE (0, 0)-(150, 120), 15, B
END IF

'SAVE TOOL
'LINE (225, 25)-(285, 45), 32, B
IF REGX.cx / 2 > 225 AND REGX.dx > 25 AND REGX.cx / 2 < 285 AND REGX.dx < 45 AND REGX.bx = 1 THEN CALL SAVE

'LOAD TOOL
'LINE (160, 50)-(220, 70), 32, B
IF REGX.cx / 2 > 160 AND REGX.dx > 50 AND REGX.cx / 2 < 220 AND REGX.dx < 70 AND REGX.bx = 1 THEN GOTO WHATINTHEHECK

'SQUARE SIZE TOOL
'LINE (225, 50)-(285, 70), 32, B
IF REGX.cx / 2 > 225 AND REGX.dx > 50 AND REGX.cx / 2 < 285 AND REGX.dx < 70 AND REGX.bx = 1 THEN
SS = SS + 1
IF SS > 10 THEN SS = 10
FOR DELAY = 1 TO 700: NEXT DELAY
END IF

IF REGX.cx / 2 > 225 AND REGX.dx > 50 AND REGX.cx / 2 < 285 AND REGX.dx < 70 AND REGX.bx = 2 THEN
SS = SS - 1
IF SS < 1 THEN SS = 1
FOR DELAY = 1 TO 700: NEXT DELAY
'LOCATE 10, 23: PRINT SS
END IF

'QUIT...
'LINE (225, 0)-(285, 20), 32, B
IF REGX.cx / 2 > 225 AND REGX.dx > 0 AND REGX.cx / 2 < 285 AND REGX.dx < 20 AND REGX.bx = 1 THEN CALL ENDPROGRAM

'color and SQUARE STATUS...
LINE (250, 170)-(290, 190), COL, B
LOCATE 23, 33: COLOR 32: PRINT SS

HMM:
CALL INTERRUPTX(&H33, REGX, REGX)
GOTO YO


WHATINTHEHECK:
ON ERROR GOTO fIxerIT
DIM cub(1 TO 9000)
DEF SEG = VARSEG(cub(1))
LOCATE 17, 1
INPUT "FILENAME(8 CHARACTERS MAX):", LOADER$
IF LOADER$ = "" THEN GOTO PARTYBASHCRASH
BLOAD LOADER$ + ".RAD", VARPTR(cub(1))
CONST badfilename = 53
PUT (0, 0), cub, PSET
DEF SEG
PARTYBASHCRASH:
LOCATE 17, 1: PRINT "                                      "
LINE (0, 0)-(150, 120), 15, B
fIxerIT:
IF ERR = badfilename THEN
LOCATE 17, 1: PRINT "                                                      "
END IF
GOTO HMM

SUB ARROW
DRAW "D2U3R1L2RU"
END SUB

SUB CIRCLES
'***************DRAWING AREA****************AND DRAWING TOOL
IF REGX.cx / 2 < 147 AND REGX.dx < 117 AND REGX.cx / 2 > 2 AND REGX.dx > 2 AND REGX.bx = 1 THEN
CALL INTERRUPTX(&H33, REGX, REGX)
CIRCLE (REGX.cx / 2 - RAD, REGX.dx - RAD), RADI
END IF
END SUB

SUB DRAWSCREEN
LINE (0, 0)-(150, 120), 15, B
'***************************PALLETTE
LOCATE 17, 1
FOR X = 0 TO 255
COLOR X
PSET (X, 170)
DRAW "D20"
NEXT X

'***************************DRAW BUTTONS**************************************
'COLOR BUTTON
LINE (160, 0)-(220, 20), 32, B
COLOR 15
LOCATE 2, 22: PRINT "COLOR"

'NEW BUTTON
LINE (160, 25)-(220, 45), 32, B
LOCATE 5, 23: PRINT "NEW"


'save button draw
LINE (225, 25)-(285, 45), 32, B
LOCATE 5, 31: PRINT "SAVE"

'LOAD IT!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
LINE (160, 50)-(220, 70), 32, B
LOCATE 8, 23: PRINT "LOAD"
'SQUARE SIZE BUTTON DRAW
LINE (225, 50)-(285, 70), 32, B
LOCATE 8, 30: PRINT "SQUARE"

'QUIT BUTTON DRAW
LINE (225, 0)-(285, 20), 32, B
LOCATE 2, 31: PRINT "QUIT"



END SUB

SUB ENDPROGRAM
SCREEN 12: SCREEN 13
FOR X = 1 TO 55
PALETTE X, X
COLOR X
PSET (X, 33)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 50, 33)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 100, 33)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 150, 33)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 200, 33)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 250, 33)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 300, 33)
DRAW "D10"
NEXT X


FOR X = 1 TO 55
PALETTE X, X
COLOR X
PSET (X, 93)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 50, 93)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 100, 93)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 150, 93)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 200, 93)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 250, 93)
DRAW "D10"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X
COLOR X
PSET (X + 300, 93)
DRAW "D10"
NEXT X

FOR X = 1 TO 55
PALETTE X, X * 65536
COLOR X
LOCATE 10, 16: PRINT "Apoky!"
NEXT X

FOR X = 55 TO 1 STEP -1
PALETTE X, X * 256
COLOR X
LOCATE 10, 16: PRINT "Apoky!"
NEXT X

SLEEP 10

END
END SUB

SUB NEWSCREEN
LINE (0, 0)-(150, 120), 0, BF
LINE (0, 0)-(150, 120), 15, B
END SUB

SUB SAVE
DIM Cube(1 TO 9999)
LOCATE 17, 1
INPUT "FILENAME(8 CHARACTERS MAX):", SAVIT$
IF SAVIT$ = "" THEN GOTO YEEEE:
GET (0, 0)-(150, 120), Cube
DEF SEG = VARSEG(Cube(1))
BSAVE SAVIT$ + ".RAD", VARPTR(Cube(1)), 25000
DEF SEG
YEEEE:
LOCATE 17, 1: PRINT "                                         "
LINE (0, 0)-(150, 120), 15, B
END SUB