'===========================================================================
' Subject: ETCH-A-SKETCH                     Date: 05/96 (00:00)          
' Author:  Steven Anthony Morisi             Code: QB, QBasic, PDS        
' Origin:  steve179@ix.netcom.com          Packet: EGAVGA.ABC
'===========================================================================
DECLARE SUB instructions ()
DECLARE SUB pause ()
DECLARE SUB errtone ()
DECLARE SUB drawetch ()
DECLARE SUB quake ()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Program  :  Etch Etch     Date : 5/96
' Author   :  Steve Morisi
' Comments :  Not much to the program but my son & daughter ( 8 & 12)
'             thought it was cute. Also I did use 2 snippets from the
'             ABC packets.
'             My son Paul Anthony thought of incorporating the QUAKE
'             as a sub routine.    
'             Credit for the Quake code goes to William Yu. It was in one
'             of the ABC packets in the Graphic section under the name of
'             EARTHQUAKE EFFECT DEMO.
'
'             Another snippet I used was ENDS.BAS written by RATBOY
'             If you invoke the code by QBASIC /RUN ETCH
'             then when you end the program you'll back out to the
'             prompt rather than the QBASIC editor.
'
'             I'd appreciate any comments/suggestions at
'             STEVE179@IX.NETCOM.COM
'
'             Thanks
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'etch a sketch emulator
DIM box%(1 TO 30000)

SCREEN 9
x = 280
y = 175

'Assign names to colors
blue = 1
greenB = 2
cyan = 3
red = 4
magenta = 5
rust = 6
white = 7
grey = 8
blueB = 9
green = 10
cyanB = 11
orange = 12
magentaB = 13
yellow = 14
whiteB = 15

'Set up keys
KEY(2) ON    'F2
KEY(11) ON   'Up arrow
KEY(12) ON   'Left
KEY(13) ON   'Right
KEY(14) ON   'Down
instructions
drawetch ' initialize drawing area

'Drawing routine
DO WHILE (key.Press$ <> CHR$(27))

   PSET (x, y), 0
   key.Press$ = INKEY$

   ON KEY(2) GOSUB newscreen
   ON KEY(11) GOSUB arrow.up
   ON KEY(12) GOSUB arrow.left
   ON KEY(13) GOSUB arrow.right
   ON KEY(14) GOSUB arrow.down

LOOP
CLS
SYSTEM
REM CHAIN "menu"
END

arrow.up:
IF y < 76 THEN
   errtone
   RETURN
END IF
y = y - 1
   
RETURN

arrow.left:
IF x < 121 THEN
   errtone
   RETURN
END IF
x = x - 1
RETURN

arrow.right:
IF x > 439 THEN
   errtone
   RETURN
END IF
x = x + 1
RETURN

arrow.down:
IF y > 274 THEN
   errtone
   RETURN
END IF
y = y + 1
RETURN

newscreen:
  quake
  CLS 0
  drawetch
  x = 280
  y = 175
RETURN

SUB drawetch
errtone
'colors
blue = 1
greenB = 2
cyan = 3
red = 4
magenta = 5
rust = 6
white = 7
grey = 8
blueB = 9
green = 10
cyanB = 11
orange = 12
magentaB = 13
yellow = 14
whiteB = 15


'draw etch sketch
LINE (120, 75)-(440, 275), blueB, B
LINE (70, 30)-(500, 330), blueB, B
PAINT (1, 1), cyan, blueB
PAINT (71, 31), red, blueB
PAINT (121, 76), grey, blueB
CIRCLE (145, 300), 20, blueB
CIRCLE (410, 300), 20, blueB
PAINT (400, 300), white, blueB
PAINT (150, 300), white, blueB

'text
LOCATE 2, 26
PRINT " F2=CLEAR  ESC=QUIT "
LOCATE 22, 22
PRINT "  Etch Etch by MorisiWare  "
LOCATE 23, 22
PRINT "      Copyright 1996       "

END SUB

SUB errtone
SOUND 450, 2
SOUND 500, 4
SOUND 450, 2

END SUB

SUB instructions
SCREEN 9
CLS
FOR i = 50 TO 90 STEP 5
LINE (125, 1 + i)-(500, 250 - i), 3, B
'LINE (125, 1 + i + 1)-(500, 5 + i), 4, B
FOR delay% = 1 TO 15000: NEXT delay%
NEXT i
LOCATE 9, 18
PRINT " Draw by using Arrow keys on the Number Pad "
LOCATE 11, 18
PRINT "               Press Enter                  "
pause
END SUB

SUB pause
DO UNTIL INKEY$ <> ""
LOOP
END SUB

SUB quake
delay = 5500
FOR x = 1 TO delay
OUT &H3D4, 8: OUT &H3D5, x
NEXT x

END SUB