REM BASIC 2 Demo Program Version 2.03 18 Jan 87
DIM apoint(6,2)
diam$=CHR$(27)+CHR$(7)
CLOSE #2,#1
CLOSE WINDOW 3
CLOSE WINDOW 4
OPEN #1 WINDOW 1
OPEN #2 WINDOW 2
OPEN #3 WINDOW 3

REM window sizes - device independent
xw2=XUSABLE*0.98: yw2=YUSABLE*0.85
xp2=(XUSABLE-xw2)/2: yp2=(YUSABLE-yw2)*0.80
xw3=XUSABLE*0.45: yw3=YUSABLE*0.45
xw1=XUSABLE*0.45: yw1=YUSABLE*0.50
xg=XUSABLE*0.05

SCREEN #3 TEXT FLEXIBLE
WINDOW #3 SIZE 35, 10
WINDOW #3 PLACE xw2/40;yw2/15

LABEL the_beginning

SCREEN #2 GRAPHICS xw2 FIXED,yw2 FIXED
myfont=1: mysize=10
FOR i=1 TO 4
  IF FONT$(#2,i){1 TO 5}="Swiss" THEN myfont=i:mysize=18
NEXT i
SET #2 FONT myfont POINTS mysize
ych2=YCELL(#2)*mysize/10 'text height in window 2
WINDOW #2 SIZE xw2, yw2
WINDOW #2 PLACE xp2;yp2
WINDOW #2 TITLE "Locomotive BASIC 2"
WINDOW #2 OPEN
GOSUB waitline
PRINT #2, COLOUR (7); " Welcome to ";COLOUR(2);"Locomotive Software's BASIC 2";COLOUR(7);" Interpreter"
GOSUB waitline
PRINT #2, COLOUR (4); " BASIC 2 is a programming language you can use "
PRINT #2, COLOUR (4); " to write programs quickly and simply."
GOSUB waitline
PRINT #2, COLOUR (4); " BASIC 2 uses GEM's windows to show you the results"
PRINT #2, COLOUR (4); " of your programs as and where you want them."
GOSUB waitline
PRINT #2, COLOUR (4); " BASIC 2 also uses windows to show you your program"
PRINT #2, COLOUR (4); " and your dialogue with the computer."
GOSUB wait2: GOSUB wait2
CLS #2
CLS #3
PRINT #2, COLOUR (2); " For example running a program to show powers
PRINT #2, COLOUR (4); " - the program reads ...
WINDOW #3 TITLE "Your Program"
WINDOW #3 OPEN

PRINT #3, diam$+"'Powers of 2 from 1 to 10
PRINT #3, diam$+"'------------------------
PRINT #3, diam$+"FOR i = 1 TO 10
PRINT #3, diam$+"  PRINT i, 2^i
PRINT #3, diam$+"NEXT i
PRINT #3, diam$+"END
GOSUB wait2
PRINT #2, COLOUR(4); " - and the results are ...
SCREEN #1 GRAPHICS xw1 FIXED,yw1 FIXED
WINDOW #1 SIZE xw1,yw1
WINDOW #1 PLACE xw3+xw2/40+xg;yw2/15
WINDOW #1 OPEN
FOR i = 1 TO 10
PRINT i, 2^i
NEXT i
GOSUB wait
CLS #2
PRINT #2, COLOUR (4); " Notice the names of the windows:
PRINT #2, COLOUR (4); " - one window shows the name of your program
PRINT #2, COLOUR (4); " - the Results-1 window shows your results
GOSUB wait2
CLS #1
CLS #3
CLS #2
PRINT #2, COLOUR (2); "Locomotive BASIC 2 is good at graphics too
GOSUB waitline
PRINT #2, COLOUR (4); "Think of the Results-1 window as a piece of graph paper
PRINT #2, COLOUR (4); "about 6000 units wide and 5000 high
LINE #1, 0;1000, XVIRTUAL-XPIXEL-1;1000 START 1 END 1
MOVE #1, 2000;1200: PRINT #1, "6000 units"
LINE #1, 1000; 0 , 1000;YVIRTUAL-YPIXEL START 1 END 1
MOVE #1, 1300;800: PRINT #1, ANGLE (90);"5000 units"
GOSUB wait2
PRINT #2, COLOUR (4); "Let's draw a circle radius 2000 units, centre (3000,2500)
PLOT 3000;2500 MARKER (2) SIZE (5) COLOUR (4)
MOVE 3100;2600: PRINT "(3000;2500)"
GOSUB wait2
PRINT #3, diam$+"CIRCLE 3000;2500, 2000
GOSUB wait
CLS #1
CIRCLE 3000;2500, 2000
GOSUB wait
CLS #2
PRINT #2, COLOUR (2); " You can change its colour and fill style too
GOSUB wait
PRINT #2, COLOUR (2); " - either from the program
CLS #3
PRINT #3, diam$+"CIRCLE 3000;2500, 2000 COLOUR 3"
PRINT #3, "-FILL WITH 19"
GOSUB wait
CIRCLE 3000;2500, 2000 COLOUR 3 FILL WITH 19
GOSUB wait2
PRINT #2, COLOUR (2); " - or by your choice from the menus . . . .
GOSUB wait
LABEL circle_loop
CLS #1
CLS #2
CLS #3
PRINT #2, COLOUR (4); " Use your mouse to select a colour by moving to the
PRINT #2, COLOUR (4); " Colours menu on the top line.  Click on a ";COLOUR(2);"graphics";COLOUR(4);" colour."
PRINT #2, COLOUR (4); " When you have done that press a key"
GOSUB waitkey
CLS #2
PRINT #2, COLOUR (2); " Now we'll use the circle command again
PRINT #2, COLOUR (2); "   and we'll fill it with your chosen colour
PRINT #3, diam$+"CIRCLE 3000;2500, 2000 FILL
GOSUB wait
CIRCLE 3000;2500, 2000 FILL
GOSUB wait
CLS #2
PRINT #2, COLOUR (2); " Do you want to have another go?
PRINT #2, COLOUR (2); " If so, type 'Y', if not type any other key
PRINT #2, COLOUR (2); " This time try using the Patterns and Lines menus too"
GOSUB waitkey
IF ans$="Y" THEN GOTO circle_loop

WINDOW #3 CLOSE
WINDOW #1 CLOSE
CLS #2
TEXT #2 FEED 2
PRINT #2, "There's a whole series of interesting effects....";
yuc2=YPOS-ych2*2
MOVE #2, ;YPOS+ych2/4
PRINT #2, ANGLE (180);"There's a whole series of interesting effects....";
xuc2=XVIRTUAL(#2)
GOSUB wait2
FOR i=1 TO 25
  FOR j=1 TO 6
    apoint(j,1)=RND(xuc2):apoint(j,2)=RND(yuc2)
  NEXT
  SHAPE #2, apoint(1,1);apoint(1,2), apoint(2,1);apoint(2,2), apoint(3,1);apoint(3,2), apoint(4,1);apoint(4,2), apoint(5,1);apoint(5,2), apoint(6,1);apoint(6,2) FILL WITH RND(17) COLOUR RND(14)+1
NEXT
GOSUB wait2
CLS #2
PRINT #2 COLOUR (4); " But special effects is not all that BASIC 2 is good at  "
GOSUB waitline

PRINT #2 COLOUR (4); " It has powerful features for data and file handling  "
PRINT #2 COLOUR (4); " You can produce a database as easily as a graph "
PRINT #2 COLOUR (4); "  or use all its features together"
GOSUB waitline
PRINT #2 COLOUR (2); " Think how good that would be for your business"
GOSUB wait2
CLS #2
PRINT #2 COLOUR (4); " At school too"
GOSUB waitline
PRINT #2 COLOUR (2); " BASIC 2 is a good language to learn"
PRINT #2 COLOUR (2); " You can see your program and its results together"
GOSUB waitline
PRINT #2 COLOUR (4); " BASIC 2's ";COLOUR(2);"Turtle Graphics";COLOUR(4);" make learning to program fun
GOSUB wait2: GOSUB wait2
CLS #1

SCREEN #2 GRAPHICS: WINDOW #2 FULL ON:
SET #2 FONT myfont POINTS mysize: CLS #2
PRINT #2, COLOUR(7);FONT(2);ADJUST(36) " BASIC 2 from "
PRINT #2, COLOUR(7);FONT(2);ADJUST(36) "      Locomotive Software"
PRINT #2
PRINT #2, COLOUR(2); " For further details, see the
PRINT #2, COLOUR (2); " Locomotive BASIC 2 User Guide or Reference Manual."
GOSUB wait
PRINT #2
PRINT #2, COLOUR (4); "To see this demonstration of BASIC 2 again ... Press SPACE
PRINT #2, COLOUR (4); "To return to the Gem Desktop ...  Press the RETURN key
PRINT #2, COLOUR (4); "Press 'Q' to enter BASIC 2";
LABEL final_loop
GOSUB waitkey
IF ans$=" " THEN WINDOW #2 CLOSE: GOTO the_beginning
IF ans$=CHR$(13) THEN SYSTEM
IF ans$<>"Q" GOTO final_loop
CLEAR RESET
NEW
END

LABEL waitline
MOVE #2, ;YPOS(#2)-100
GOTO wait

LABEL wait2
GOSUB wait
LABEL wait
y=TIME
REPEAT: UNTIL TIME > y+250
RETURN

LABEL waitkey
 y=TIME+3000
 REPEAT
  ans$=UPPER$(INKEY$)
  IF (TIME<6000) OR (TIME>y) THEN ans$=" "
 UNTIL ans$<>""
RETURN

END