' THE WONDERFUL WORLD OF EAMON DELUXE EDITION
'            BY FRANK Black
'
'   A COMPUTERIZED FANTASY ROLE-PLAYING SYSTEM
' BASED UPON THE APPLE II VERSION BY DONALD BROWN,
'    JOHN NELSON, TOM ZUCHOWSKI, & FRANK Black
'
'               The Heart of Gold
'     Hitchhiker's Guide editor
'
'OPEN "GUIDEDIR.DAT" FOR OUTPUT AS #1
'PRINT #1, 0
'OPEN "GUIDE.DSC" FOR RANDOM AS #1 LEN = 255
'CLOSE
'END
'---------------------------------------------------------------------------
TYPE DESC
TEXT AS STRING * 255
END TYPE
DIM DS AS DESC

OPEN "..\SETTINGS.DAT" FOR INPUT AS #1: INPUT #1, dly#, CC1#, CC2#, CC3#: CLOSE

OPEN "GUIDEDIR.DAT" FOR INPUT AS #1
INPUT #1, nh
DIM h$(200), h%(200, 2), p$(20)
IF nh > 0 THEN
  FOR r = 1 TO nh
     LINE INPUT #1, h$(r)
     INPUT #1, h%(r, 1), h%(r, 2)
  NEXT
END IF
nr = h%(nh, 1) + h%(nh, 2) - 1
IF nr < 1 THEN nr = 0

CLOSE
OPEN "GUIDE.DSC" FOR RANDOM AS #1 LEN = 255

'----------------------------------------------------------------------------
'  Main menu
'
Menu:
CLS : COLOR 6
PRINT "Hitchhiker's Guide to the Galaxy simulator:  Editing program"
PRINT "Another fine product of Frank Black Productions": PRINT
PRINT "Number of entries:"; nh;
IF nh = 200 THEN PRINT " (Maximum)";
PRINT : PRINT
PRINT " 1. Add an entry.": PRINT
PRINT " 2. Edit an entry.": PRINT
PRINT " 3. List entries.": PRINT
PRINT " 4. List entry names.": PRINT
PRINT " 5. Quit.": PRINT
PRINT
PRINT "Enter your choice.  (1-5): ";
GOSUB GetKey: k = INT(VAL(k$)): IF k < 1 OR k > 5 THEN GOTO Menu
CLS
ON k GOTO Add, Edit, HList, HListNames, Quit

'----------------------------------------------------------------------------
Add:
IF nh = 200 THEN GOTO Menu
PRINT "Enter title of entry:"
I2$ = "": nh = nh + 1:  tl = 70: GOSUB LineInput
h$(nh) = I$: p = 1
PRINT : PRINT "Enter hint.": PRINT

Add1:
CLS
PRINT "Paragraph #"; LTRIM$(STR$(p)): PRINT
I2$ = "": tl = 253: GOSUB LineInput
p$(p) = I$
IF p = 20 THEN GOTO Add3
PRINT "Another paragraph?  (Y/N): "; : GOSUB GetKey
IF k$ <> "Y" THEN GOTO Add3
p = p + 1: GOTO Add1

Add3:
h%(nh, 1) = nr + 1: h%(nh, 2) = p
nr = nr + p:
FOR r = 1 TO p
   DS.TEXT = p$(r)
   x = h%(nh, 1) + r - 1
   PUT #1, x, DS
NEXT
GOTO Menu

'----------------------------------------------------------------------------
Edit:
CLS
IF nh < 1 THEN GOTO Menu
PRINT "Enter # of entry to edit (1-"; LTRIM$(RTRIM$(STR$(nh)));
LINE INPUT "): "; A$: xh = INT(VAL(A$))
IF xh < 1 OR xh > nh THEN GOTO Menu

PRINT "Enter name of entry:"
I2$ = h$(xh): tl = 70: GOSUB LineInput: h$(xh) = I$

p = h%(xh, 2)
FOR r = 1 TO p
   xxh = h%(xh, 1) + r - 1
   GET #1, xxh, DS
   CLS : PRINT "Enter paragraph #"; r; "of"; h%(xh, 2)
   I2$ = RTRIM$(DS.TEXT): tl = 253: GOSUB LineInput
   DS.TEXT = I$
   PUT #1, xxh, DS
NEXT
GOTO Menu

'----------------------------------------------------------------------------
HList:
pt = 0: L = 0
PRINT "List to printer? (Y/N):"; : GOSUB GetKey: IF k$ = "Y" THEN pt = 1
CLS
FOR r = 1 TO nh
   IF pt = 1 THEN LPRINT RTRIM$(STR$(r)); ": "; h$(r)
   IF pt = 0 THEN PRINT RTRIM$(STR$(r)); ": "; h$(r)
   GOSUB Lp6: PRINT : GOSUB Lp6
   IF pt = 1 THEN LPRINT
   FOR k = h%(r, 1) TO h%(r, 1) + h%(r, 2) - 1
      GET #1, k, DS: A$ = RTRIM$(DS.TEXT)
HList1:
      IF LEN(A$) < 80 AND pt = 1 THEN
        LPRINT A$: GOTO HList2
      END IF
      IF LEN(A$) < 80 AND pt = 0 THEN
        PRINT A$: GOTO HList2
      END IF
      IF pt = 1 THEN
        LPRINT LEFT$(A$, 79): A$ = MID$(A$, 80): GOSUB Lp6: GOTO HList1
      END IF
      PRINT LEFT$(A$, 79): A$ = MID$(A$, 80): GOSUB Lp6: GOTO HList1
HList2:
   GOSUB Lp6
   IF pt = 1 THEN LPRINT
   PRINT
   GOSUB Lp6
   NEXT
NEXT
L = 99: GOSUB Lp6: GOTO Menu

'----------------------------------------------------------------------------
HListNames:
pt = 0: L = 0
PRINT "List to printer? (Y/N):"; : GOSUB GetKey: IF k$ = "Y" THEN pt = 1
CLS
FOR r = 1 TO nh
   IF pt = 1 THEN LPRINT RTRIM$(STR$(r)); ": "; h$(r)
   IF pt = 0 THEN PRINT RTRIM$(STR$(r)); ": "; h$(r)
   GOSUB Lp6
NEXT
L = 99: GOSUB Lp6: GOTO Menu

'----------------------------------------------------------------------------
'  Exit
'
Quit:
CLOSE
OPEN "GUIDEDIR.DAT" FOR OUTPUT AS #1
PRINT #1, nh
FOR r = 1 TO nh
   PRINT #1, h$(r)
   PRINT #1, h%(r, 1), h%(r, 2)
NEXT
CLOSE
RUN "INTRO"

'---------------------------------------------------------------------------
'  Subroutines
'
Lp6:
L = L + 1
IF pt = 1 OR L < 21 THEN RETURN
PRINT "Hit any key..."; : GOSUB GetKey: L = 0: CLS : RETURN

GetKey:
BS = POS(0): CC# = 0
DO
   A = RND
   CC# = CC# + 1                           ' CC = Cursor Counter
   IF CC# = CC1# THEN PRINT "/": LOCATE CSRLIN - 1, BS
   IF CC# = CC2# THEN PRINT CHR$(179): LOCATE CSRLIN - 1, BS
   IF CC# = CC3# THEN PRINT "\": LOCATE CSRLIN - 1, BS: CC# = 0
   k$ = INKEY$
LOOP UNTIL k$ <> ""
k$ = UCASE$(k$): PRINT k$: RETURN

'
'  Special text editor
'   by Frank Black 1995
'
' Length of string to get must be
' already specified in "TL" variable
'
' If string is being edited, put it in
' the "I2$" variable
'
'
LineInput:
LN$ = CHR$(196)                          ' Blank text line
CRS1 = CSRLIN: CRS2 = POS(0)

IF LEN(I2$) < tl THEN
   FOR x = 1 TO tl - LEN(I2$): I2$ = I2$ + LN$: NEXT
END IF

PRINT I2$;
LOCATE CRS1, CRS2
CR = CRS1: CL = CRS2
IC = 1

LIGetKey:
A2$ = MID$(I2$, IC, 1)                  ' Save character cursor is on
LOCATE CR, CL: CC = 0
DO
 CC = CC + 1
 IF CC = 300 THEN PRINT "_"; : LOCATE CR, CL
 IF CC = 600 THEN
   PRINT A2$;
   LOCATE CR, CL
   CC = 0
 END IF
 A$ = INKEY$
LOOP UNTIL A$ <> ""
PRINT A2$; : LOCATE CR, CL
'
'    Sort key presses
'
A = ASC(A$)
IF LEN(A$) = 2 THEN GOTO SpecialKey      ' Arrow keys
IF A = 13 GOTO AcceptText                ' Enter/Return key

IF A = 27 THEN                           ' Escape key (Accept all text)
  I$ = I2$: GOTO InputDone
END IF

IF A = 8 GOTO Delete                     ' Backspace/Delete key
IF A = 9 AND IC = tl GOTO ErrorRtn       ' Tab key (Insert a space)
IF A = 9 THEN                            '
  I2$ = LEFT$(I2$, IC - 1) + " " + MID$(I2$, IC, LEN(I2$) - IC - 1)
  GOTO Delete1
END IF

IF IC = tl GOTO ErrorRtn                 ' Line too long

'
'   Add key pressed to input string and increment string counter
'
IC = IC + 1: I2$ = LEFT$(I2$, IC - 2) + A$ + MID$(I2$, IC)
CL = CL + 1
IF CL = 81 THEN
  CL = 1: CR = CR + 1
END IF
PRINT A$;
GOTO Delete1

Delete:
IF IC = 1 GOTO ErrorRtn                  ' Nothing to delete
I2$ = LEFT$(I2$, IC - 2) + MID$(I2$, IC) + LN$
IC = IC - 1
CL = CL - 1
IF CL = 0 THEN
  CL = 80: CR = CR - 1
END IF

Delete1:
LOCATE CRS1, CRS2: PRINT I2$
GOTO LIGetKey


SpecialKey:
A = ASC(RIGHT$(A$, 1))
IF A = 75 AND IC = 1 THEN GOTO ErrorRtn   '
IF A = 75 THEN                            '
  CL = CL - 1                             '
  IF CL = 0 THEN                          '  Left arrow
    CL = 80: CR = CR - 1                  '
  END IF                                  '
  IC = IC - 1                             '
  GOTO Delete1                            '
END IF

IF A = 77 AND IC = tl THEN GOTO ErrorRtn  '
IF A = 77 THEN                            '
  CL = CL + 1                             '
  IF CL = 81 THEN                         '  Right arrow
    CL = 1: CR = CR + 1                   '
  END IF                                  '
  IC = IC + 1                             '
  GOTO Delete1                            '
END IF


ErrorRtn:
  SOUND 2000, 5
  GOTO LIGetKey

AcceptText:
I$ = LEFT$(I2$, IC - 1)

InputDone:
I$ = RTRIM$(I$)
IF RIGHT$(I$, 1) = LN$ THEN
  I$ = LEFT$(I$, LEN(I$) - 1): GOTO InputDone
END IF

'
'        Display string
'
FOR x = 1 TO tl: PRINT " "; : NEXT
LOCATE CRS1, CRS2: PRINT I$: PRINT
RETURN

