'===========================================================================
' Subject: ETCH-A-SKETCH PAINT PROGRAM       Date: 02-24-98 (13:26)       
' Author:  Aaron Andersen                    Code: QB, QBasic, PDS        
' Origin:  kc7gza@hotmail.com              Packet: EGAVGA.ABC
'===========================================================================
'                   This is my paint program. hit ? for help.
'                          Kc7gza@hotmail.com
'
'
'
'
'
DECLARE SUB credits ()
DECLARE SUB MoreHelp (mh$)
DECLARE SUB Spread (Text$, Row%, Col%, Delay!)
DECLARE SUB help ()
DIM SHARED d%
SCREEN 12
start:
CLS
LINE (42, 237)-(109, 26), 4
LINE (111, 25)-(176, 237), 4
LINE (176, 237)-(16, 101), 4
LINE (16, 100)-(207, 100), 4
COLOR 2
LOCATE 11, 21: PRINT "1998"
COLOR 3
LOCATE 13, 23: PRINT "Aaron"
COLOR 9
LOCATE 15, 26: PRINT "Andersen"
SLEEP
DIM sec(5000)
DIM pix(5000)
x% = 1
y% = 1
bk% = 0
1
LINE (0, 0)-(636, 476), 4, B
IF bk% = 0 THEN c% = 15
LINE (1, 1)-(635, 475), bk%, BF
DO
LINE (x%, y%)-(x% + s%, y% + s%), c%, BF
DO
a$ = UCASE$(INKEY$)
LOOP UNTIL a$ <> ""

COLOR c%
LOCATE 1, 70
PRINT x%
LOCATE 1, 75
PRINT y%
LINE (200, 0)-(635, 0), 4
SELECT CASE a$
CASE "?"
CALL help
GOTO start
CASE CHR$(0) + "G"
x% = x% - (s% + 1)
y% = y% - (s% + 1)

CASE CHR$(0) + "H"
y% = y% - (s% + 1)

CASE CHR$(0) + "I"
x% = x% + (s% + 1)
y% = y% - (s% + 1)

CASE CHR$(0) + "K"
x% = x% - (s% + 1)

CASE CHR$(0) + "M"
x% = x% + (s% + 1)

CASE CHR$(0) + "O"
x% = x% - (s% + 1)
y% = y% + (s% + 1)

CASE CHR$(0) + "P"
y% = y% + (s% + 1)

CASE CHR$(0) + "Q"
x% = x% + (s% + 1)
y% = y% + (s% + 1)

CASE "C"
LOCATE 1
COLOR c%
GET (0, 0)-(100, 50), sec
INPUT "Color", nc$
IF (VAL(nc$) > 0 AND VAL(nc$) < 16) OR (nc$ = "0") THEN c% = VAL(nc$): GOTO 4576
IF nc$ = "" THEN GOTO 4576
c% = INT(RND * 15) + 1
4576
PUT (0, 0), sec, PSET
nc$ = ""
COLOR c%
LOCATE 1, 70
PRINT x%
LOCATE 1, 75
PRINT y%
LINE (200, 0)-(635, 0), 4



CASE "S"
LOCATE 1
COLOR c%
GET (0, 0)-(100, 50), sec
INPUT "Size", ns$
IF VAL(ns$) > -1 THEN s% = VAL(ns$)
PUT (0, 0), sec, PSET
ns$ = ""

CASE "N"
LOCATE 1
COLOR c%
GET (0, 0)-(100, 50), sec
PRINT "New (Y/N)"
DO
a$ = UCASE$(INKEY$)
LOOP UNTIL a$ = "Y" OR a$ = "N"
IF a$ = "Y" THEN GOTO 1
IF a$ = "N" THEN PUT (0, 0), sec, PSET
CASE "+"
LOCATE 1
COLOR c%
GET (0, 0)-(100, 100), sec
INPUT "X +:", xp$
INPUT "Y +:", yp$
x% = x% + VAL(xp$)
y% = y% + VAL(yp$)
PUT (0, 0), sec, PSET

CASE "L"
GET (0, 0)-(100, 100), sec
LOCATE 1
COLOR c%
INPUT "X", x$
INPUT "Y", y$
x% = VAL(x$)
y% = VAL(y$)
PUT (0, 0), sec, PSET


CASE "F"
PSET (x%, y%), bk%
PAINT (x%, y%), c%

CASE "E"
GET (0, 0)-(100, 50), sec
LOCATE 1
INPUT "Radius", r%
PUT (0, 0), sec, PSET
CIRCLE (x%, y%), r%, c%


CASE "M"
GET (400, 0)-(550, 20), sec
LOCATE 1, 60: PRINT "Moving"



DO

IF fr% = 1 THEN GET (x%, y%)-(x% + s%, y% + s%), pix
LINE (x%, y%)-(x% + s%, y% + s%), c%, BF

DO
a$ = UCASE$(INKEY$)
LOOP UNTIL a$ <> ""
IF fr% = 1 THEN PUT (x%, y%), pix, PSET
fr% = 1
COLOR c%
LOCATE 1, 70
PRINT x%
LOCATE 1, 75
PRINT y%
LINE (200, 0)-(635, 0), 4
SELECT CASE a$
CASE CHR$(0) + "G"
x% = x% - (s% + 1)
y% = y% - (s% + 1)

CASE CHR$(0) + "H"
y% = y% - (s% + 1)

CASE CHR$(0) + "I"
x% = x% + (s% + 1)
y% = y% - (s% + 1)

CASE CHR$(0) + "K"
x% = x% - (s% + 1)

CASE CHR$(0) + "M"
x% = x% + (s% + 1)

CASE CHR$(0) + "O"
x% = x% - (s% + 1)
y% = y% + (s% + 1)

CASE CHR$(0) + "P"
y% = y% + (s% + 1)

CASE CHR$(0) + "Q"
x% = x% + (s% + 1)
y% = y% + (s% + 1)
END SELECT
LOOP UNTIL a$ = CHR$(13)
fr% = 0
PUT (400, 0), sec, PSET
END SELECT












IF y% < 1 THEN y% = 1
IF x% < 1 THEN x% = 1
IF y% > (475 - s%) THEN y% = (475 - s%)
IF x% > (635 - s%) THEN x% = (635 - s%)
LOOP UNTIL a$ = CHR$(27)

SUB credits
CLS
DIM cre(25) AS STRING
DIM co(25) AS INTEGER
co(1) = 2
co(2) = 15
co(12) = 5
co(13) = 15
co(18) = 2
co(20) = 15
cre(1) = "Credits"
cre(2) = SPACE$(10)
cre(3) = ""
cre(4) = ""
cre(5) = ""
cre(6) = "Programming by Aaron Andersen"
cre(7) = "    Programmed in Qbasic 4.5    "
cre(8) = "Game idea by Aaron Andersen"
cre(9) = CHR$(34) + "Spread" + CHR$(34) + "sub (used in help) by Matthew R. Usner"
cre(10) = SPACE$(70)
cre(11) = ""
cre(12) = "The programmer would like to thank:"
cre(13) = "Matthew R. Usner for his wonderfull subs."
cre(14) = "          William Yu for the ABC packets.          "
cre(15) = "and Daren Orth (my uncle) for teaching me alot about Qbasic"
cre(16) = SPACE$(65)
cre(17) = "Visit my home page at"
cre(18) = "Http://www.geocities.com/siliconvalley/peaks/2845"
cre(19) = SPACE$(55)
cre(20) = "If anyone knows how I could put in a saving function let me know"
cre(21) = "               I couldn't figure out how to do one.               "
cre(22) = SPACE$(75)
cre(23) = "E-mail me at Kc7gza@yahoo.com"
cre(24) = SPACE$(33)
cre(25) = ""

q = 28
FOR i = 1 TO 25
q = q - 1
FOR j = 1 TO i
LOCATE (q + j), (40 - (LEN(cre(j)) / 2))
IF co(j) <> 0 THEN COLOR co(j)
PRINT cre(j)
NEXT j
ot = TIMER
DO
LOOP UNTIL TIMER >= ot + .7
NEXT i
END SUB

SUB help
help:
CLS
COLOR 14
Spread "                          ", 1, 40, 28
COLOR 2
Spread "Welcome to program help.", 1, 40, 25
COLOR 11
Spread "While painting:", 2, 40, 20
COLOR 15
Spread "Use the arrow keys to paint.", 3, 40, 15
Spread "Press ? to start this help program.", 4, 40, 15
Spread "Press S to change the size of the brush.", 5, 40, 15
Spread "Press C to change the color of the brush.", 6, 40, 15
Spread "Press M to move the brush.", 7, 40, 15
Spread "Press L to locate a place on the screen.", 8, 40, 15
Spread "Press + to Jump around on the screen.", 9, 40, 15
Spread "Press E for a Circle.", 10, 40, 15
Spread "Press F to fill.", 11, 40, 15
Spread "Press N for a new screen.", 12, 40, 15
COLOR 11
Spread "While in this help program:", 13, 40, 20
COLOR 15
Spread "Press one of the " + CHR$(34) + "Hot Keys" + CHR$(34) + " to view a detailed help for that key.", 14, 40, 15
Spread "Press Esc to exit this help program", 15, 40, 15
Spread "Press Enter to view the credits", 16, 40, 15
st:
FOR i = 1 TO 30
ckbb$ = INKEY$
NEXT i
ckbb$ = ""

DO
h$ = UCASE$(INKEY$)
LOOP UNTIL h$ <> ""
SELECT CASE h$

CASE "S", "C", "M", "L", "+", "E", "F", "N"
CALL MoreHelp(h$)
CASE CHR$(27)
EXIT SUB

CASE "R"
GOTO help

CASE CHR$(13)
CALL credits
EXIT SUB

CASE ELSE
GOTO st
END SELECT
GOTO st
END SUB



SUB MoreHelp (mh$)
LOCATE 18, 1: PRINT SPACE$(d% * 80)

SELECT CASE mh$

CASE "S"
Spread "Type the size of brush you want.", 18, 40, 15

CASE "C"
Spread "Type the number of the color you want (0 - 15). Anything else for random.", 18, 40, 15
LOCATE 19, 1
FOR i = 1 TO 15
COLOR i: PRINT i; " ";
NEXT i
PRINT "Zero is black."
d% = 2
CASE "M"
Spread "Press M and you can move the brush around without painting.", 18, 40, 15
Spread "Press Enter when done", 19, 40, 15
d% = 2
CASE "L"
Spread "Type the X location, then type the Y location.", 18, 40, 15
Spread "The brush will jump to that point", 19, 40, 15
d% = 2
CASE "+"
Spread "Type an X and Y number to " + CHR$(34) + "add " + CHR$(34) + "to the brush location", 18, 40, 15
d% = 1
CASE "E"
Spread "Type the radius of the circle. The center will be the current bruch location.", 18, 40, 15
d% = 1
CASE "F"
Spread "Fill an enclosed erea with the brush color. ", 18, 40, 15
Spread "The border needs to be the same color as the brush color.", 19, 40, 15
Spread "If it is not the entire screen will be filled", 20, 40, 15
d% = 3
CASE "N"
Spread "Press Y for a new screen or N to Cancel.", 18, 40, 15
d% = 1

CASE "?"
Spread "Start a dumb help proram.", 18, 40, 15
d% = 1
END SELECT






END SUB

SUB Spread (Text$, Row%, Col%, Delay)

'*******************************************************************************
'*  Spreads text on the screen in both directions starting from the specified  *
'*  coordinates.  Delay is measured in 100ths of a second                      *
'*******************************************************************************

'   convert delay to single precision
    d! = Delay

'   always have at least 1/20 sec. delay
    IF d! < 1 THEN
       d! = 5
    END IF

'   change to 100ths
    d! = d! / 100

'   if null, get out
    IF Text$ = "" THEN
       EXIT SUB
    END IF
 
    Txt$ = Text$

'   make text length even if not already so
    IF LEN(Txt$) MOD 2 = 1 THEN
       Txt$ = Txt$ + " "
    END IF

'   divide text into left and right sides
    LeftSide$ = LEFT$(Txt$, LEN(Txt$) \ 2)
    RightSide$ = RIGHT$(Txt$, LEN(Txt$) \ 2)

    FOR x% = 1 TO LEN(RightSide$)

        LOCATE Row%, Col%
        PRINT RIGHT$(RightSide$, x%);

'       print a letter from the left side
        IF (Col% - x%) >= 1 THEN
          LOCATE Row%, Col% - x%
          PRINT LEFT$(LeftSide$, x%);
        END IF

        CurrentTimer! = TIMER
        WHILE TIMER < (CurrentTimer! + d!)
        WEND    'Wait for timer to increase by d!

        IF INKEY$ <> "" THEN
           d! = 0        'if a key is pressed, stop delaying
        END IF
     
    NEXT x%

END SUB