'
'
'
'
'
'                                Shapes! 3.3
'                               By Adam Smith
'                          Uses screen 12 graphics!
'                     Press F5 to begin, any key to exit
'                              F1 to customize                              
'
'
'                      So many shapes.. so little time.
'
'
'                  Contact me at: smitha@edmonds.wednet.edu
'               HomePage: http://www.edmonds.wednet.edu/~smitha
'
'
'

'Global Variable
                                     'The variable has to be global to avoid
COMMON SHARED CFG$()                 'Problems with the MakeINI routine

'Defining the Global Variable
DIM CFG$(5)

'This makes programming less painful
CONST NumShapes = 5

'Declare Subroutines

'The Shapes
DECLARE SUB SolidSquare (ShapeClr, Xc, Yc, Xc2, Yc2)
DECLARE SUB GridSquare (ShapeClr, Increment, Xc, Yc, Xc2, Yc2)
DECLARE SUB SolidTriangle (ShapeClr, Size, Xc, Yc)
DECLARE SUB GridTriangle (ShapeClr, Size, Xc, Yc, Increment)
DECLARE SUB SolidCircle (ShapeClr, Xc, Yc, Radius)
DECLARE SUB GridCircle (ShapeClr, Xc, Yc, Radius, Increment)

'Text Fader.
DECLARE SUB TextFade (FadeColor3, Text$, Yc, Xc)

'Introduction screen
DECLARE SUB Introduction (Secret$)

'Sub to create the SHAPES33.INI file
DECLARE SUB MakeINI (CFGMessage$, Message$, DelayConst)

'Delcare the only function, MetaGrab, which gets variables from a file
DECLARE FUNCTION MetaGrab$ (FileNum, Search$)

'Except this one, but it's just a one-liner... :) Used for circles
DEF FNg (Radius, X) = SQR(Radius ^ 2 - X ^ 2)

'Initialize, and set the Configuration key
GOSUB Initialize
KEY 1, "‘"                    'I don't think yer likely to push this key
ON KEY(1) GOSUB Customize

'Start the program and enable config
CALL Introduction(Secret$)
KEY(1) ON

CLS
'Check for secret keys ... see Shapes! 2.2
IF Secret$ = "`" THEN TextFade 15, "Nope! No secret screen savers! Hehheh. :)", -1, -1: SLEEP 2
IF Secret$ = "=" THEN Debug = 42
IF Debug = 42 THEN TextFade 4, "Debug Activated.", 28, -1

'MainLoop
DO
       
        RANDOMIZE TIMER
        DO
PickIt:
                PickShape = INT(RND * (NumShapes + 2))
                IF (PickShape = (NumShapes + 1)) THEN
                        IF (UCASE$(CFGMessage$) = "ON") THEN EXIT DO ELSE GOTO PickIt
                END IF
        LOOP UNTIL UCASE$(CFG$(PickShape)) = "ON"

        IF Debug = 42 THEN
                LOCATE 1, 1
                COLOR 7
                PRINT "CFG$";
                FOR i = 0 TO NumShapes
                        PRINT "("; i; ","; CFG$(i); "),";
                NEXT i
                PRINT "MSG="; CFGMessage$; ",";
                PRINT "PickShape:"; PickShape
        END IF
       
        FOR Scratch = 0 TO DelayConst: NEXT Scratch

        SELECT CASE PickShape
              
                CASE 0
                SolidSquare (INT(RND * 15) + 1), (INT(RND * 640)), (INT(RND * 480)), (INT(RND * 640)), (INT(RND * 480))

                CASE 1
                GridSquare (INT(RND * 15) + 1), (INT(RND * 30) + 2), (INT(RND * 640)), (INT(RND * 480)), (INT(RND * 640)), (INT(RND * 480))

                CASE 2
                SolidTriangle (INT(RND * 15) + 1), (INT(RND * 240) + 1), (INT(RND * 640)), (INT(RND * 480))

                CASE 3
                GridTriangle (INT(RND * 15) + 1), (INT(RND * 240) + 1), (INT(RND * 640)), (INT(RND * 480)), (INT(RND * 30) + 2)
       
                CASE 4
                SolidCircle (INT(RND * 15) + 1), (INT(RND * 640)), (INT(RND * 480)), (INT(RND * 100))

                CASE 5
                GridCircle (INT(RND * 15) + 1), (INT(RND * 640)), (INT(RND * 480)), (INT(RND * 100)), (INT(RND * 30) + 2)
               
                CASE 6
                TextFade (INT(RND * 15) + 1), Message$, (INT(RND * 28) + 1), (INT(RND * 68) + 1)

        END SELECT

IF INKEY$ <> "" THEN SYSTEM

LOOP

Customize:
KEY(1) OFF
SCREEN 0
CLS

DO
        LOCATE 1, 1
        COLOR 7
        PRINT "Shapes! 3.3 customization"
        PRINT "-------------------------"
        PRINT "0-Solid Squares   :"; CFG$(0); "                       "
        PRINT "1-Grid Squares    :"; CFG$(1); "                       "
        PRINT "2-Solid Triangles :"; CFG$(2); "                       "
        PRINT "3-Grid Triangles  :"; CFG$(3); "                       "
        PRINT "4-Solid Circles   :"; CFG$(4); "                       "
        PRINT "5-Grid Circles    :"; CFG$(5); "                       "
        PRINT "A-Messages        :"; CFGMessage$; "                       "
        PRINT "   B-Message      :"; Message$; "                       "
        PRINT "C-Delay(0=Fastest):"; DelayConst; "                       "
        PRINT "-------------------------"
        PRINT "         X=Exit"
        PRINT : PRINT : PRINT
        Custom$ = INKEY$
        IF Custom$ <> "" THEN
                IF UCASE$(Custom$) = "X" THEN
                        MakeINI CFGMessage$, Message$, DelayConst
                        GOSUB Initialize
                        SCREEN 12
                        KEY(1) ON
                        RETURN
                ELSE
                        IF UCASE$(Custom$) = "B" THEN
                                LINE INPUT "New message: "; Message$
                                CLS
                        ELSE
                                IF UCASE$(Custom$) = "A" THEN
                                        IF UCASE$(CFGMessage$) = "ON" THEN CFGMessage$ = "Off" ELSE CFGMessage$ = "On"
                                ELSE
                                        IF UCASE$(Custom$) = "C" THEN
                                                PRINT "The higher the delay, the slower Shapes will run."
                                                LINE INPUT "Delay: "; Delay$
                                                DelayConst = VAL(Delay$)
                                                CLS
                                        ELSE
                                                Custom2 = VAL(Custom$)
                                                IF (Custom2 <= NumShapes) THEN
                                                        IF UCASE$(CFG$(Custom2)) = "ON" THEN CFG$(Custom2) = "Off" ELSE CFG$(Custom2) = "On"
                                                END IF
                                        END IF
                                END IF
                        END IF
                END IF
        END IF
LOOP

Initialize:
ON ERROR GOTO EHandle
OPEN "SHAPES33.INI" FOR INPUT AS #1
ON ERROR GOTO 0
PRINT "Initializing..."
RESTORE
FOR In = 0 TO NumShapes
        READ SName$
        CFG$(In) = MetaGrab$(1, SName$)
NEXT In
CFGMessage$ = MetaGrab$(1, "Messages")
Message$ = MetaGrab$(1, "Message")
DelayConst = VAL(MetaGrab$(1, "Delay"))
IF MetaGrab$(1, "Debug") = "On" THEN Debug = 42
CLOSE
RETURN

EHandle:
IF ERR = 53 THEN
        FOR Scratch = 0 TO NumShapes
                CFG$(Scratch) = "On"
        NEXT
        MakeINI "On", "Press [F1] to configure", DelayConst
        RESUME
END IF
SCREEN 0
COLOR 7
PRINT "Unexpected error="; ERR
PRINT "Please contact Adam Smith at: smitha@edmonds.wednet.edu, with the"
PRINT "error number, so it can be fixed. If you can, also give a listing"
PRINT "of the on/off conditions in the .INI file. Thank you."
SYSTEM

DATA "SolidSquare","GridSquare","SolidTriangle","GridTriangle","SolidCircle","GridCircle"

SUB GridCircle (ShapeClr, Xc, Yc, Radius, Increment)
       
        'Validate XY coords
        IF (Yc < 0) OR (Yc > 480) OR (Xc < 0) OR (Xc > 640) THEN EXIT SUB
        IF (Yc2 < 0) OR (Yc2 > 480) OR (Xc2 < 0) OR (Xc2 > 640) THEN EXIT SUB
     
        'Verify that Color is acceptable
        IF (ShapeClr > 15) OR (ShapeClr < 1) THEN EXIT SUB

        'Verify radius isn't extreme
        IF Radius > 400 THEN EXIT SUB

        'Increment needs to be smaller than the diameter
        IF Increment > Radius * 2 THEN EXIT SUB

        'Do it!
        CIRCLE (Xc, Yc), Radius, ShapeClr

        FOR i = -Radius TO Radius STEP Increment
                LINE (-FNg(Radius, i) + Xc, i + Yc)-(FNg(Radius, i) + Xc, i + Yc), ShapeClr
                LINE (i + Xc, FNg(Radius, i) + Yc)-(i + Xc, -FNg(Radius, i) + Yc), ShapeClr
        NEXT i

END SUB

SUB GridSquare (ShapeClr, Increment, Xc, Yc, Xc2, Yc2)

        'Validate XY coords
        IF (Yc < 0) OR (Yc > 480) OR (Xc < 0) OR (Xc > 640) THEN EXIT SUB
        IF (Yc2 < 0) OR (Yc2 > 480) OR (Xc2 < 0) OR (Xc2 > 640) THEN EXIT SUB
       
        'Verify that Color is acceptable
        IF (ShapeClr > 15) OR (ShapeClr < 1) THEN EXIT SUB

        'Do it!
        LINE (Xc, Yc)-(Xc2, Yc2), ShapeClr, B
        FOR Counter = Xc TO Xc2 STEP Increment
                LINE (Counter, Yc)-(Counter, Yc2), ShapeClr
        NEXT Counter
        FOR Counter = Xc TO Xc2 STEP -(Increment)
                LINE (Counter, Yc)-(Counter, Yc2), ShapeClr
        NEXT Counter
        FOR Counter = Yc TO Yc2 STEP Increment
                LINE (Xc, Counter)-(Xc2, Counter), ShapeClr
        NEXT Counter
        FOR Counter = Yc TO Yc2 STEP -(Increment)
                LINE (Xc, Counter)-(Xc2, Counter), ShapeClr
        NEXT Counter

END SUB

SUB GridTriangle (ShapeClr, Size, Xc, Yc, Increment)
      
        'Validate coordinates
        IF (Xc < 0) OR (Xc > 640) OR (Yc < 0) OR (Yc > 480) THEN EXIT SUB

        'Verify Color
        IF (ShapeClr < 1) OR (ShapeClr > 15) THEN EXIT SUB

        'Cut size if too large
        IF (Size + Yc) > 480 THEN Size = 480 - Yc - 1
      
        'Do it
        FOR Counter = 0 TO Size STEP Increment
                LINE (Xc - Counter, Yc + Counter)-(Xc + Counter, Yc + Size), ShapeClr, B
        NEXT Counter
        LINE (Xc, Yc)-(Xc - Size, Yc + Size), ShapeClr
        LINE (Xc - Size, Yc + Size)-(Xc + Size, Yc + Size), ShapeClr
        LINE (Xc + Size, Yc + Size)-(Xc, Yc), ShapeClr

END SUB

SUB Introduction (Secret$)

   SCREEN 12

   'Draw blue background
   LINE (0, 0)-(640, 480), 15, BF
      FOR Delay = 1 TO 1000: NEXT
   LINE (0, 0)-(640, 480), 9, BF
      FOR Delay = 1 TO 1000: NEXT
   LINE (0, 0)-(640, 480), 1, BF
      FOR Delay = 1 TO 1000: NEXT
  
   'Draw Red Box
   LINE (264, 184)-(112 + 264, 112 + 184), 15, BF
      FOR Delay = 1 TO 1000: NEXT
   LINE (264, 184)-(112 + 264, 112 + 184), 12, BF
      FOR Delay = 1 TO 1000: NEXT
   LINE (264, 184)-(112 + 264, 112 + 184), 4, BF
  
   'Fadein the yellow grid
   FOR ScratchA = 1 TO 3
      IF ScratchA = 1 THEN COLOR 0 ELSE IF ScratchA = 2 THEN COLOR 6 ELSE COLOR 14
      FOR Delay = 1 TO 1000: NEXT
     
      'Draw the yellow grid
      FOR ScratchB = 0 TO 56 STEP 5
         LINE (ScratchB + 264, 56 + 184)-(56 + 264, 56 - ScratchB + 184)', 14
         LINE (ScratchB + 264, 57 + 184)-(56 + 264, ScratchB + 57 + 184)', 14
         LINE (57 + 264, ScratchB + 184)-(57 + ScratchB + 264, 56 + 184)', 14
         LINE (57 + ScratchB + 264, 57 + 184)-(57 + 264, 112 - ScratchB + 184)', 14
      NEXT ScratchB
  
   NEXT ScratchA
  
   TextFade 15, "SHAPES!3.3", 15, 36
   TextFade 7, "A |\/|EGA=|/\|ARE Production", 20, -1
   TextFade 14, "By: Adam Smith", 21, -1

   SLEEP 3
   Secret$ = INKEY$
   
  
   'Whee! Flashy exit
   LINE (0, 0)-(640, 480), 9, BF
   FOR Delay = 1 TO 1000: NEXT
   LINE (0, 0)-(640, 480), 15, BF
   FOR Delay = 1 TO 1000: NEXT
   LINE (0, 0)-(640, 480), 7, BF
   FOR Delay = 1 TO 1000: NEXT
   LINE (0, 0)-(640, 480), 8, BF
   FOR Delay = 1 TO 1000: NEXT
  
END SUB

SUB MakeINI (CFGMessage$, Message$, DelayConst)
        CLOSE
        OPEN "SHAPES33.INI" FOR OUTPUT AS #1
        PRINT #1, ";Shapes! 3.3 Initialization file"
        PRINT #1, ";By Adam Smith"
        PRINT #1, ";"
        PRINT #1, ";Shapes On/Off"
        PRINT #1, "SolidSquare="; CFG$(0)
        PRINT #1, "GridSquare="; CFG$(1)
        PRINT #1, "SolidTriangle="; CFG$(2)
        PRINT #1, "GridTriangle="; CFG$(3)
        PRINT #1, "SolidCircle="; CFG$(4)
        PRINT #1, "GridCircle="; CFG$(5)
        PRINT #1, "Messages="; CFGMessage$
        PRINT #1, ";And speaking of messages"
        PRINT #1, "Message="; Message$
        PRINT #1, ";"
        PRINT #1, ";Use this to slow down Shapes, if it runs too fast"
        PRINT #1, ";...whatever too fast is. :)"
        PRINT #1, "Delay="; DelayConst
        PRINT #1, ";"
        PRINT #1, ";More coming soon!!!"
        PRINT #1, ";This file may be modified in any way you wish."
        PRINT #1, ";Comments may be added with semicolons. ';'"
        PRINT #1, ";Please do not use equal signs in the comments."
        PRINT #1, ";Set the DEBUG variable to ON for debug mode."
        PRINT #1, "Debug=Off"
        CLOSE
END SUB

FUNCTION MetaGrab$ (FileNum, Search$)
        SHARED Debug
        SEEK #FileNum, 1
        DO WHILE NOT EOF(FileNum)
                LINE INPUT #FileNum, Text$
                IF UCASE$(LEFT$(Text$, LEN(Search$) + 1)) = UCASE$(Search$ + "=") THEN EXIT DO
        LOOP
        IF UCASE$(LEFT$(Text$, LEN(Search$) + 1)) <> UCASE$(Search$ + "=") THEN MetaGrab$ = "No Match": EXIT FUNCTION
        MetaGrab$ = RIGHT$(Text$, LEN(Text$) - LEN(Search$) - 1)
END FUNCTION

SUB SolidCircle (ShapeClr, Xc, Yc, Radius)

        'Validate XY coords
        IF (Yc < 0) OR (Yc > 480) OR (Xc < 0) OR (Xc > 640) THEN EXIT SUB
        IF (Yc2 < 0) OR (Yc2 > 480) OR (Xc2 < 0) OR (Xc2 > 640) THEN EXIT SUB
      
        'Verify that Color is acceptable
        IF (ShapeClr > 15) OR (ShapeClr < 1) THEN EXIT SUB

        'Verify radius isn't extreme
        IF Radius > 400 THEN EXIT SUB

        'Do it!
        FOR i = -Radius TO Radius
                LINE (-FNg(Radius, i) + Xc, i + Yc)-(FNg(Radius, i) + Xc, i + Yc), ShapeClr
        NEXT i

END SUB

SUB SolidSquare (ShapeClr, Xc, Yc, Xc2, Yc2)
       
        'Get the coordinates and determine if they are valid; if not, abort
        IF (Yc < 0) OR (Yc > 480) OR (Xc < 0) OR (Xc > 640) THEN EXIT SUB
        IF (Yc2 < 0) OR (Yc2 > 480) OR (Xc2 < 0) OR (Xc2 > 640) THEN EXIT SUB

        'Is the color given valid? If not, exit subroutine.
        IF (ShapeClr < 1) OR (ShapeClr > 15) THEN EXIT SUB

        'Draw the square already!
        LINE (Xc, Yc)-(Xc2, Yc2), ShapeClr, BF

END SUB

SUB SolidTriangle (ShapeClr, Size, Xc, Yc)

        'Validate coordinates
        IF (Xc < 0) OR (Xc > 640) OR (Yc < 0) OR (Yc > 480) THEN EXIT SUB

        'Verify Color
        IF (ShapeClr < 1) OR (ShapeClr > 15) THEN EXIT SUB

        'Cut size if too large
        IF (Size + Yc) > 480 THEN Size = 480 - Yc
       
        'Do it
        FOR Counter = 0 TO Size
                LINE (Xc - Counter, Yc + Counter)-(Xc + Counter, Yc + Counter), ShapeClr
        NEXT Counter

END SUB

SUB TextFade (FadeColor3, Text$, Yc, Xc)
    
   'Does the user want text centered?
   IF Yc = -1 THEN Yc = 15
   IF Xc = -1 THEN Xc = (40 - (INT(LEN(Text$) / 2)))
  
   'Verify useable coordinates; if not, abort
   IF (Yc < 1) OR (Yc > 29) OR (Xc < 1) OR (Xc > 79) THEN EXIT SUB
     
   'Verify usable color; if not, use 15
   IF (FadeColor3 < 1) OR (FadeColor3 > 15) THEN FadeColor3 = 7
     
   'Set the Fade Colors
   IF FadeColor3 < 8 THEN FadeColor1 = 15: FadeColor2 = FadeColor3 + 8
   IF FadeColor3 > 7 THEN FadeColor1 = 8: FadeColor2 = FadeColor3 - 8
     
   'White needs to be reset because of color palette layout
   IF FadeColor3 = 15 THEN FadeColor1 = 8: FadeColor2 = 7
   IF FadeColor3 = 7 THEN FadeColor1 = 8
   IF FadeColor3 = 8 THEN FadeColor1 = 15: FadeColor2 = 7

   'Locate the position stated and fade the colors
   LOCATE Yc, Xc
   COLOR FadeColor1: PRINT Text$;
   FOR Delay = 1 TO 500: NEXT
   LOCATE Yc, Xc
   COLOR FadeColor2: PRINT Text$;
   FOR Delay = 1 TO 500: NEXT
   LOCATE Yc, Xc
   COLOR FadeColor3: PRINT Text$;

END SUB