'SHAPES and COLOURS

'copyright P. B. Allwood 1987


'------------

'Main program

GOSUB initialize

REPEAT
  GOSUB reset_game
  GOSUB choose_reward
  GOSUB game
  GOSUB another
UNTIL NOT again

GOSUB end_game

END

'------------


LABEL initialize
RANDOMIZE

'close all windows
CLOSE WINDOW 1 : CLOSE WINDOW 2 : CLOSE WINDOW 3 : CLOSE WINDOW 4

'set up screens
'reward screen
reward = 2
SCREEN #reward GRAPHICS 145 FIXED, 177 FIXED
WINDOW #reward PLACE 3;2 : WINDOW #reward OPEN

'play screen
play = 1 : origin_x = 155 : origin_y = 2
SCREEN #play GRAPHICS 480 FIXED, 177 FIXED
WINDOW #play TITLE "SHAPES and COLOURS"
WINDOW #play PLACE origin_x;origin_y : WINDOW #play OPEN

DIM shapes(1 TO 16), colours(1 TO 16), guess(1 TO 16)
no_of_rewards = 2
nothing = -1
correct = 1
incorrect = 2

DIM shapes$(1 TO 3)
shapes$(1) = "SQUARE" : shapes$(2) = "CIRCLE" : shapes$(3) = "TRIANGLE"

DIM colour$(0 TO 6)
FOR c = 0 TO 6 : READ colour$(c) : NEXT c
DATA WHITE, BLACK, RED, GREEN, BLUE, CYAN, YELLOW

x_div = INT(XVIRTUAL(#play)/4)
y_div = INT((YVIRTUAL(#play)-400)/4)

RETURN


LABEL reset_game
score = 0
WINDOW #play MOUSE 3
GOSUB zero_arrays
RETURN


LABEL zero_arrays
FOR item = 1 TO 16 : shapes(item) = nothing : colours(item) = nothing : guess(item) = nothing : NEXT item
RETURN


LABEL choose_reward
visited = FALSE
reward_display = RND(3)
RETURN


LABEL game
ON reward_display GOSUB flower,rocket,flag

FOR question = 1 TO 10
  WINDOW TITLE "SHAPES and COLOURS   question" + STR$(question)
  GOSUB zero_arrays
  GOSUB get_question
  GOSUB display_question
  GOSUB get_answer
  GOSUB show_results
NEXT question

BOX 0;0,XVIRTUAL,YVIRTUAL FILL WITH 4 COLOUR 15
WINDOW TITLE "SHAPES and COLOURS   FINISHED"
text$ = STR$(score) + " out of 10"
ALERT 0 TEXT "  YOU SCORED","",text$ BUTTON RETURN "Press to go on"

RETURN


LABEL get_question
'find out if colour matters in answer
IF RND(2) = 2 THEN colour_matters = TRUE ELSE colour_matters = FALSE

'get shape to find
shape_to_find = RND(3)

'get colour if it matters
IF colour_matters THEN colr = RND(6)-1

'get number of shapes to find
IF colour_matters THEN no_to_find = RND(5) ELSE no_to_find = RND(10)

'place shapes to be found
FOR item = 1 TO no_to_find
  REPEAT : location = RND(16) : UNTIL shapes(location) = nothing
  shapes(location) = shape_to_find
  IF colour_matters THEN colours(location) = colr ELSE colours(location) = RND(6)-1
NEXT item

'fill in rest of arrays
FOR item = 1 TO 16
  IF shapes(item) = nothing THEN GOSUB fill_in
NEXT item

'change cyan to yellow
FOR item = 1 TO 16
  IF colours(item) = 5 THEN colours(item) = 6
NEXT item
IF colr = 5 THEN colr = 6

'make up promt
number$ = STR$(no_to_find) : number$ = number${2 TO}
IF colour_matters THEN colr$ = " "+colour$(colr) ELSE colr$ = ""
shape$ = shapes$(shape_to_find)
promt$ = number$ + colr$ + " " + shape$
IF no_to_find > 1 THEN promt$ = promt$ + "S"

RETURN


LABEL fill_in
IF colour_matters THEN shape_fill = RND(3) ELSE REPEAT : shape_fill = RND(3) : UNTIL shape_fill <> shape_to_find
other_colrs = RND(6)-1
IF colour_matters AND shape_fill = shape_to_find THEN REPEAT : other_colrs = RND(6)-1 : UNTIL other_colrs <> colr

shapes(item) = shape_fill
colours(item) = other_colrs
RETURN


LABEL display_question
CLS #play
BOX #play 0;0,XVIRTUAL(#play),400 FILL WITH 4 COLOUR 3
BOX #play 0;400,XVIRTUAL(#play),YVIRTUAL(#play)-400 FILL WITH 4 COLOUR 8
BOX #play 0;400,XVIRTUAL(#play),YVIRTUAL(#play)-400

FOR item = 1 TO 16
x_origin = x_div * ((item-1) - 4 * INT((item-1)/4))
y_origin = y_div * INT((item-1)/4) + 400

ON shapes(item) GOSUB square, circles, triangle
NEXT item
col = LEN(promt$)*1.6
col = col + LEN("Find ") + LEN(end_promt$)
col = (63-col)/2 : IF col < 1 THEN col = 1
PRINT #play AT(col;22) MODE(2) "Find ";POINTS(16);promt$;POINTS(10);end_promt$;

RETURN


LABEL square
BOX x_origin+(x_div/5);y_origin+(y_div/8),y_div*.75,y_div*.75 FILL COLOUR colours(item)
BOX x_origin+(x_div/5);y_origin+(y_div/8),y_div*.75,y_div*.75
RETURN


LABEL circles
CIRCLE x_origin+x_div/2;y_origin+y_div/2,x_div*.75/2-100 FILL COLOUR colours(item)
CIRCLE x_origin+x_div/2;y_origin+y_div/2,x_div*.75/2-100
RETURN


LABEL triangle
SHAPE x_origin+(x_div/8);y_origin+(y_div/8),x_origin+x_div/2;y_origin+y_div*7/8,x_origin+x_div*7/8;y_origin+(y_div/8) FILL COLOUR colours(item)
SHAPE x_origin+(x_div/8);y_origin+(y_div/8),x_origin+x_div/2;y_origin+y_div*7/8,x_origin+x_div*7/8;y_origin+(y_div/8)
RETURN


LABEL get_answer
right_answers = 0
FOR guess = 1 TO no_to_find
  REPEAT
    REPEAT
      REPEAT
        REPEAT : UNTIL BUTTON > -1
        x = XMOUSE-XPLACE
        y = YMOUSE-YPLACE
      UNTIL x >= 0 AND x <= XWINDOW AND y >= 0 AND y <= YWINDOW
      x = x * XPIXEL : y = y * YPIXEL
    UNTIL y >= 400
    x = INT(x/x_div)+1
    y = INT((y-400)/y_div)
    item = y * 4 + x
    REPEAT : UNTIL BUTTON < 0
  UNTIL guess(item) = nothing
  colour_true = TRUE : IF colour_matters AND colours(item) <> colr THEN colour_true = FALSE
  IF shapes(item)=shape_to_find AND colour_true THEN GOSUB correct ELSE GOSUB incorrect
NEXT

RETURN


LABEL show_results
GOSUB remove
IF right_answers = no_to_find THEN GOSUB all_right ELSE GOSUB part_right
WINDOW TITLE "CLICK MOUSE TO GO ON"
REPEAT : UNTIL BUTTON > -1
REPEAT : UNTIL BUTTON < 0
RETURN


LABEL correct
right_answers = right_answers + 1
guess(item) = correct
x_origin = x_div * ((item-1) - 4 * INT((item-1)/4))
y_origin = y_div * INT((item-1)/4) + 400
BOX x_origin;y_origin,x_div,y_div FILL ONLY WITH 8 COLOUR 5
BOX #play 0;400,XVIRTUAL(#play),YVIRTUAL(#play)-400
ON shapes(item) GOSUB square, circles, triangle
RETURN


LABEL incorrect
guess(item) = incorrect
x_origin = x_div * ((item-1) - 4 * INT((item-1)/4))
y_origin = y_div * INT((item-1)/4) + 400
BOX x_origin;y_origin,x_div,y_div FILL ONLY WITH 4 COLOUR 1
BOX #play 0;400,XVIRTUAL(#play),YVIRTUAL(#play)-400
ON shapes(item) GOSUB square, circles, triangle
RETURN


LABEL remove
FOR item = 1 TO 16
  colour_true = TRUE : IF colour_matters AND colours(item) <> colr THEN colour_true = FALSE
  IF NOT((shapes(item)=shape_to_find AND colour_true) OR guess(item) <> nothing) THEN x_origin = x_div*((item-1)-4*INT((item-1)/4)) : y_origin = y_div*INT((item-1)/4)+400 : BOX x_origin;y_origin,x_div,y_div FILL ONLY WITH 4 COLOUR 8
NEXT item
BOX #play 0;400,XVIRTUAL(#play),YVIRTUAL(#play)-400
RETURN


LABEL all_right
IF no_to_find > 2 THEN begin$ = "all " ELSE IF no_to_find = 1 THEN begin$ = "the " ELSE begin$ = "both "
IF no_to_find < 3 THEN promt$ = promt${3 TO}
begin$ = "WELL DONE! You found " + begin$
col = LEN(promt$)*1.6
col = col + LEN(begin$)
col = (63-col)/2 : IF col < 1 THEN col = 1
BOX #play 0;0,XVIRTUAL(#play),400 FILL WITH 4 COLOUR 3
PRINT #play AT(col;22) MODE(2) begin$;POINTS(16);promt$;
score = score + 1
ON reward_display GOSUB flower,rocket,flag
RETURN


LABEL part_right
IF right_answers = 0 THEN number$ = "NO" ELSE number$ = STR$(right_answers) : number$ = number${2 TO}
IF colour_matters THEN colr$ = " "+colour$(colr) ELSE colr$ = ""
shape$ = shapes$(shape_to_find)
promt$ = number$ + colr$ + " " + shape$
IF right_answers > 1 THEN promt$ = promt$ + "S"
begin$ = "BAD LUCK! You found " : IF right_answers > 0 THEN begin$ = begin$ + "only "
col = LEN(promt$)*1.6
col = col + LEN(begin$)
col = (63-col)/2 : IF col < 1 THEN col = 1
BOX #play 0;0,XVIRTUAL(#play),400 FILL WITH 4 COLOUR 3
PRINT #play AT(col;22) MODE(2) begin$;POINTS(16);promt$;
RETURN


LABEL another
again = ALERT 2 TEXT "Do you want to play","","   another game" BUTTON "YES","NO"
IF again = 1 THEN again = TRUE ELSE again = FALSE
RETURN


LABEL end_game
CLOSE WINDOW 1 : CLOSE WINDOW 2 : CLOSE WINDOW 3 : CLOSE WINDOW 4
ALERT 0 TEXT "GOODBYE FOR NOW  " BUTTON RETURN "Please Press"
RETURN



'The following are the reward screens

LABEL flower
WHILE NOT visited
  end_promt$ = " to make the flower grow"
  CLS #reward : WINDOW #reward TITLE "FLOWER"
  visited = TRUE
WEND

'wall
BOX #reward 0;0,XVIRTUAL(#reward),YVIRTUAL(#reward) FILL COLOUR 2
BOX #reward 0;0,XVIRTUAL(#reward),YVIRTUAL(#reward) MODE 2 FILL WITH 9 COLOUR 0
xline = XVIRTUAL(#reward)/2
radius = XVIRTUAL(#reward)/6.5
hyp = radius/2
xdis = 2*SQR((hyp*hyp)/2)

'leaves
LINE #reward xline;xdis,xline+2*radius;score*xdis WIDTH (score+1)*3/2 COLOUR 3 START 2 END 2
LINE #reward xline;xdis,xline+2*radius;score*xdis
LINE # reward xline;xdis,xline-2*radius;score*xdis/2*3 WIDTH (score+1)*2 COLOUR 3 START 2 END 2
LINE #reward xline;xdis,xline-2*radius;score*xdis/2*3

'stem
FOR count = 1 TO score
  xcent = xline+xdis : sta = 135 : ena = 225
  IF count MOD 2 THEN xcent = xline-xdis : sta = -45 : ena = 45
  ycent = count*2*xdis-xdis
  CIRCLE #reward xcent;ycent,radius PART RAD(sta),RAD(ena) WIDTH 10 COLOUR 11
NEXT count

'petals
ycent = (score+1)*2*xdis-xdis
xcent = xline
radius = radius + radius*(score+1)/22
FOR count = 0 TO 5
  xdis = radius*SIN(count*RAD(60))
  ydis = radius*COS(count*RAD(60))
  IF ycent+ydis < 0 THEN ydis = -ycent
  CIRCLE #reward xcent+xdis;ycent+ydis,radius/4*3 FILL COLOUR 4
NEXT count

'flower centre
CIRCLE #reward xcent;ycent,radius/8*7 FILL COLOUR 6
CIRCLE #reward xcent;ycent,radius/2 FILL COLOUR 2

RETURN



LABEL rocket
WHILE NOT visited
  end_promt$ = " to launch the rocket"
  CLS #reward : WINDOW #reward TITLE "ROCKET"
  visited = TRUE
WEND

yful = YVIRTUAL(#reward)/5
ht = score*950+500

'sky
BOX #reward, 0;0,XVIRTUAL(#reward),YVIRTUAL(#reward) FILL COLOUR 1
PLOT #reward, 4000;13000,500;3000,1000;5000,3000;4000,2000;10000 MARKER 7 COLOUR 0
'landscape
SHAPE # reward, 0;0,0;yful,750;yful-200,2000;yful-100,2500;yful+200,3100;yful+100,4000;yful,4300;yful-50,5000;yful+100,5000;0 FILL COLOUR 13
ELLIPSE #reward, 1500;yful/4*3,1000,.3
ELLIPSE #reward, 3400;yful/3,700,.3

'rocket
'main tank
SHAPE #reward, 1950;ht+200,1950;ht+2000,3050;ht+2000,3050;ht+200 FILL WITH 22 COLOUR 6
SHAPE #reward, 1950;ht+2000,2200;ht+2200,2800;ht+2200,3050;ht+2000 FILL COLOUR 2

'top tank
SHAPE #reward, 2200;ht+2200,2200;ht+3000,2800;ht+3000,2800;ht+2200 FILL WITH 22 COLOUR 6

'cone
SHAPE #reward, 2200;ht+3000,2500;ht+3400,2800;ht+3000 FILL COLOUR 4

'fins
SHAPE #reward, 1350;ht-100,1950;ht+1800,1950;ht FILL WITH 29 COLOUR 11
SHAPE #reward, 3050;ht,3050;ht+1800,3650;ht-100 FILL WITH 29 COLOUR 11

'nozzles
SHAPE #reward, 2050;ht,2050;ht+200,2350;ht+200,2350;ht FILL COLOUR 7
SHAPE #reward, 2950;ht,2950;ht+200,2650;ht+200,2650;ht FILL COLOUR 7

'flames
SHAPE #reward, 2050;ht,2200;ht/4-100,2350;ht FILL MODE 2 COLOUR 2
SHAPE #reward, 2950;ht,2800;ht/4-100,2650;ht FILL MODE 2 COLOUR 2
SHAPE #reward, 2050;ht,2200;ht/4-100,2350;ht FILL WITH 4 MODE 2 COLOUR 0
SHAPE #reward, 2950;ht,2800;ht/4-100,2650;ht FILL WITH 4 MODE 2 COLOUR 0

RETURN



LABEL flag
WHILE NOT visited
  end_promt$ = " to raise the flag"
  CLS #reward : WINDOW #reward TITLE "FLAG"
  visited = TRUE
WEND

ht = score*9500/10+500
'The following variables save line space in drawing the flag
y = 1500 : z = 3000

'sky
BOX #reward, 0;3000,XVIRTUAL,YVIRTUAL-3000 FILL COLOUR 4
'grass
BOX #reward, 0;0,XVIRTUAL,3000 FILL COLOUR 3
'pole and rope
SHAPE #reward, 600;0,700;13000,800;13000,900;0 FILL COLOUR 0
LINE #reward, 1250;0,1500;ht WIDTH 2
LINE #reward, 800;13000,1500;ht+2500 WIDTH 2
CIRCLE #reward, 750;13200,300 FILL COLOUR 0
'flag
SHAPE #reward, 1500;ht,1500;ht+2500,2000;ht+2700,2500;ht+2700,3000;ht+2500,3500;ht+2300,4000;ht+2200,4500;ht+2300,4800;ht+2500,4800;ht,4500;ht-200,4000;ht-300,3500;ht-200,3000;ht,2500;ht+200,2000;ht+200 FILL COLOUR 2
SHAPE #2, y;ht+1000,y;ht+y,2000;ht+1700,2500;ht+1700,z;ht+y,z;ht+2500,3500;ht+2300,3500;ht+1300,4000;ht+1200,4500;ht+1300,4800;ht+y,4800;ht+1000,4500;ht+800,4000;ht+700,3500;ht+800,3500;ht-200,z;ht,z;ht+1000,2500;ht+1200,2000;ht+1200 FILL COLOUR 6

RETURN