DECLARE SUB ShowShapeTable ()
DECLARE SUB MakeShapeTable ()

'
' Make sure EGA or VGA mode is available for Apple Island
'
ON ERROR GOTO ScreenError: CLS : SCREEN 7
ON ERROR GOTO 0: SCREEN 0: WIDTH 80

CLS
PRINT "This program lets you view the 7 shapes used in The Lost Island of Apple and"
PRINT "the Pac-Man image from the intro story."
PRINT
PRINT "If you think they are too crude, blame Don Brown.  To make the conversion"
PRINT "more authentic, I kept his original art from the Apple II Version (although"
PRINT "I did add color)."
PRINT SPC(40); "-Frank K."
PRINT
PRINT " 1. Display shape table"
PRINT " 2. Store shapes"
PRINT " 3. Quit"
PRINT
PRINT "Enter 1-3:";
DO
k = VAL(INKEY$)
LOOP UNTIL k > 0 AND k < 4
PRINT k

IF k = 2 THEN CALL MakeShapeTable
IF k = 1 THEN CALL ShowShapeTable
IF k < 3 THEN PRINT "Hit any key to exit..."
DO
LOOP UNTIL INKEY$ <> ""
RUN "INTRO"

'  Can't initialize graphics screen
'
ScreenError:
RESUME ScreenError1
ScreenError1:
ON ERROR GOTO 0: SCREEN 0: WIDTH 80: CLS
COLOR 0, 2: PRINT " Sorry, ": COLOR 3, 0: PRINT
PRINT "You won't be able to play the adventure, "; q$; "Apple Island"; q$; ", because it requires"
PRINT "an EGA or VGA graphics display.": PRINT : PRINT
PRINT "Hit any key to exit..."
DO
LOOP UNTIL INKEY$ <> ""
RUN "INTRO"

'
' LINE coordinates for Pac-Man
'   1st number is number of coordinate sets
'   Data format is (x,y-x,y), color
'
' Open-mouthed Pac-Man shape
'
DATA 13
DATA 3,0,7,0,14,   2,1,9,1,14,  1,2,10,2,14,  0,3,8,3,14,   0,4,5,4,14
DATA 0,5,3,5,14,   0,6,5,6,14,  1,7,8,7,14,   1,8,10,8,14,  2,9,9,9,14
DATA 4,10,7,10,14, 5,1,6,1,0,   4,2,5,2,0

SUB MakeShapeTable

READ n
DIM s%(n, 5), pacman%(1 TO 46)
DIM shape1%(1 TO 66), shape2%(1 TO 66), shape3%(1 TO 66)
DIM shape4%(1 TO 66), shape5%(1 TO 66), shape6%(1 TO 66)
DIM shape7%(1 TO 66)

FOR a = 1 TO n
   FOR x = 1 TO 5: READ s%(a, x): NEXT
NEXT

SCREEN 7

x = 150: y = 50
GOSUB Sdraw
GET (150, 50)-(160, 60), pacman%

CLS
LINE (0, 0)-(320, 90), 2, BF
PUT (150, 50), pacman%, PSET
PUT (150, 100), pacman%, PSET

x = 10: y = 50
GOSUB shape1
GET (x, y)-(x + 15, y + 15), shape1%
PUT (x, 100), shape1%, PSET

x = 30: y = 50
GOSUB shape2
GET (x, y)-(x + 15, y + 15), shape2%
PUT (x, 100), shape2%, PSET

x = 50: y = 50
GOSUB shape3
GET (x, y)-(x + 15, y + 15), shape3%
PUT (x, 100), shape3%, PSET

x = 70: y = 50
GOSUB shape4
GET (x, y)-(x + 15, y + 15), shape4%
PUT (x, 100), shape4%, PSET

x = 90: y = 50
GOSUB shape5
GET (x, y)-(x + 15, y + 15), shape5%
PUT (x, 100), shape5%, PSET

x = 110: y = 50
GOSUB shape6
GET (x, y)-(x + 15, y + 15), shape6%
PUT (x, 100), shape6%, PSET

x = 130: y = 50
GOSUB shape7
GET (x, y)-(x + 15, y + 15), shape7%
PUT (x, 100), shape7%, PSET

LOCATE 21: PRINT "Storing shape table..."

OPEN "shapes.dat" FOR OUTPUT AS #1
FOR x = 1 TO 46: WRITE #1, pacman%(x): NEXT
FOR x = 1 TO 66: WRITE #1, shape1%(x): NEXT
FOR x = 1 TO 66: WRITE #1, shape2%(x): NEXT
FOR x = 1 TO 66: WRITE #1, shape3%(x): NEXT
FOR x = 1 TO 66: WRITE #1, shape4%(x): NEXT
FOR x = 1 TO 66: WRITE #1, shape5%(x): NEXT
FOR x = 1 TO 66: WRITE #1, shape6%(x): NEXT
FOR x = 1 TO 66: WRITE #1, shape7%(x): NEXT
CLOSE
EXIT SUB
'
' The player's icon
'
shape1:
c = 15
LINE (x + 9, y)-(x + 11, y), c
LINE (x + 9, y + 1)-(x + 11, y + 1), c
LINE (x + 10, y + 2)-(x + 10, y + 2), c
LINE (x + 1, y + 3)-(x + 1, y + 8), c
LINE (x, y + 7)-(x + 4, y + 7), c
LINE (x + 4, y + 6)-(x + 4, y + 7), c
LINE (x + 5, y + 4)-(x + 5, y + 5), c
LINE (x + 6, y + 3)-(x + 13, y + 3), c
LINE (x + 14, y + 3)-(x + 14, y + 8), c
FOR z = 1 TO 5
   LINE (x + 7 + z, y + 4)-(x + 7 + z, y + 9 + 4 * ABS(z <> 3)), c
NEXT
RETURN
'
' The slavers' icon
'
shape2:
c = 15
LINE (x + 7, y)-(x + 9, y), c
LINE (x + 7, y + 1)-(x + 9, y + 1), c
LINE (x + 7, y + 2)-(x + 9, y + 2), c
LINE (x + 8, y + 3)-(x + 8, y + 3), c
LINE (x + 3, y + 4)-(x + 12, y + 4), c
LINE (x + 3, y + 5)-(x + 3, y + 5), c
LINE (x + 2, y + 6)-(x + 2, y + 7), c
LINE (x, y + 8)-(x, y + 10), c
LINE (x + 1, y + 8)-(x + 1, y + 12), c
LINE (x + 2, y + 13)-(x + 2, y + 14), c
LINE (x + 13, y + 5)-(x + 13, y + 5), c
LINE (x + 14, y + 6)-(x + 14, y + 7), c
LINE (x + 15, y + 8)-(x + 15, y + 8), c
LINE (x + 13, y + 9)-(x + 14, y + 9), c
LINE (x + 12, y + 10)-(x + 12, y + 10), c
FOR z = 1 TO 5
   LINE (x + 5 + z, y + 5)-(x + 5 + z, y + 10 + 5 * ABS(z <> 3)), c
NEXT
RETURN
'
' The hermit
'
shape3:
c = 8
LINE (x + 3, y)-(x + 5, y), c
LINE (x + 3, y + 1)-(x + 5, y + 1), c
LINE (x + 3, y + 2)-(x + 5, y + 2), c
LINE (x, y + 5)-(x, y + 8), c
LINE (x + 1, y + 4)-(x + 1, y + 5), c
LINE (x + 8, y + 5)-(x + 8, y + 8), c
LINE (x + 7, y + 4)-(x + 7, y + 5), c
LINE (x + 1, y + 11)-(x + 7, y + 11), c
LINE (x, y + 12)-(x + 8, y + 12), c
FOR z = 2 TO 6
LINE (x + z, y + 3)-(x + z, y + 10), c: NEXT
RETURN
'
' The wagon
'
shape4:
c = 0
LINE (x + 2, y)-(x + 12, y), c
LINE (x + 1, y + 1)-(x + 1, y + 2), c
LINE (x + 8, y + 1)-(x + 8, y + 2), c
LINE (x + 13, y + 1)-(x + 13, y + 2), c
LINE (x, y + 3)-(x, y + 7), c
LINE (x + 7, y + 3)-(x + 7, y + 6), c
LINE (x + 10, y + 4)-(x + 10, y + 5), c
LINE (x + 11, y + 4)-(x + 11, y + 5), c
LINE (x + 14, y + 3)-(x + 14, y + 5), c
LINE (x + 7, y + 7)-(x + 14, y + 7), c
LINE (x + 10, y + 6)-(x + 14, y + 6), c
LINE (x, y + 8)-(x + 14, y + 8), c
LINE (x, y + 9)-(x + 13, y + 9), c
LINE (x, y + 10)-(x + 10, y + 10), c
LINE (x, y + 11)-(x + 8, y + 11), c
LINE (x, y + 12)-(x + 2, y + 12), c
LINE (x + 5, y + 12)-(x + 7, y + 12), c
LINE (x + 1, y + 13)-(x + 1, y + 13), c
LINE (x + 6, y + 13)-(x + 6, y + 13), c
c = 15
LINE (x + 1, y + 3)-(x + 1, y + 7), c
LINE (x + 2, y + 1)-(x + 2, y + 7), c
LINE (x + 3, y + 1)-(x + 3, y + 7), c
LINE (x + 4, y + 1)-(x + 4, y + 7), c
LINE (x + 5, y + 1)-(x + 5, y + 7), c
LINE (x + 6, y + 1)-(x + 6, y + 7), c
LINE (x + 7, y + 1)-(x + 7, y + 2), c
LINE (x + 8, y + 3)-(x + 8, y + 6), c
LINE (x + 9, y + 1)-(x + 9, y + 6), c
LINE (x + 10, y + 1)-(x + 10, y + 3), c
LINE (x + 11, y + 1)-(x + 11, y + 3), c
LINE (x + 12, y + 1)-(x + 12, y + 5), c
LINE (x + 13, y + 3)-(x + 13, y + 5), c
RETURN
'
' The bear
'
shape5:
c = 0
LINE (x + 3, y)-(x + 5, y), c
LINE (x + 3, y + 1)-(x + 5, y + 1), c
LINE (x + 3, y + 2)-(x + 5, y + 2), c
LINE (x + 4, y + 3)-(x + 4, y + 3), c
LINE (x, y + 4)-(x + 8, y + 4), c
LINE (x, y + 5)-(x + 2, y + 5), c
LINE (x + 7, y + 5)-(x + 8, y + 5), c
FOR z = 1 TO 5
   LINE (x + 1 + z, y + 6)-(x + 1 + z, y + 10 + 5 * ABS(z <> 3)), c
NEXT
RETURN
'
' The wolf
'
shape6:
c = 8
LINE (x, y)-(x, y), c
LINE (x + 9, y)-(x + 9, y), c
LINE (x + 1, y + 1)-(x + 1, y + 1), c
LINE (x + 9, y + 1)-(x + 11, y + 1), c
LINE (x + 2, y + 2)-(x + 9, y + 2), c
LINE (x + 3, y + 3)-(x + 9, y + 3), c
LINE (x + 3, y + 4)-(x + 3, y + 6), c
LINE (x + 9, y + 4)-(x + 9, y + 6), c
RETURN
'
' The dragon
'
shape7:
c = 4
LINE (x, y + 8)-(x, y + 14), c
LINE (x + 1, y + 7)-(x + 1, y + 15), c
LINE (x + 2, y + 6)-(x + 2, y + 8), c
LINE (x + 2, y + 14)-(x + 2, y + 15), c
FOR z = 1 TO 6
   LINE (x + 3, y + 9 + z)-(x + 9, y + 9 + z), c
NEXT
LINE (x + 4, y + 9)-(x + 12, y + 9), c
LINE (x + 4, y + 8)-(x + 9, y + 8), c
LINE (x + 5, y + 7)-(x + 9, y + 7), c
LINE (x + 5, y + 6)-(x + 12, y + 6), c
LINE (x + 5, y + 5)-(x + 8, y + 5), c
LINE (x + 6, y + 4)-(x + 9, y + 4), c
LINE (x + 7, y + 3)-(x + 9, y + 3), c
LINE (x + 12, y + 7)-(x + 12, y + 7), c
LINE (x + 10, y + 15)-(x + 11, y + 15), c
LINE (x + 9, y + 2)-(x + 13, y + 2), c
LINE (x + 10, y + 1)-(x + 13, y + 1), c
LINE (x + 11, y)-(x + 13, y), c
RETURN
'
' Draw Pac-Man
'
Sdraw:
FOR a = 1 TO 13
   LINE (x + s%(a, 1), y + s%(a, 2))-(x + s%(a, 3), y + s%(a, 4)), s%(a, 5)
NEXT
RETURN
END SUB

SUB ShowShapeTable

'          SHAPE DIMENSION IS 1 TO 225

DIM pacman%(1 TO 100), shape%(1575)

CLS : LOCATE 10: PRINT "Loading shape P"

OPEN "shapes.dat" FOR INPUT AS #1
FOR x = 1 TO 46: INPUT #1, pacman%(x): NEXT
FOR x = 1 TO 462
   IF x / 66 = INT(x / 66) THEN LOCATE 10, 14: PRINT x / 66
   INPUT #1, shape%(x)
NEXT
CLOSE

SCREEN 7: LINE (0, 40)-(190, 70), 2, BF

y = 50: s = 0
FOR x = 20 TO 140 STEP 20
   s = s + 1: s2 = 66 * (s - 1) + 1: GOSUB DrawShape
NEXT
PUT (160, y), pacman%, PSET

y = 100: s = 0
FOR x = 20 TO 140 STEP 20
   s = s + 1: s2 = 66 * (s - 1) + 1: GOSUB DrawShape
NEXT
PUT (160, y), pacman%, PSET

LOCATE 16, 4: PRINT "1 2  3 4  5 6  7 P"
EXIT SUB

DrawShape:
PUT (x, y), shape%(s2), PSET
RETURN
END SUB

