home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / PRISONER.DSK / PR.HOSPITAL.bas < prev    next >
BASIC Source File  |  2014-09-09  |  4KB  |  70 lines
  1. 1  TEXT : HOME :ZZ =  FRE(0): POKE  -16368,0
  2. 2  ONERR  GOTO 32000
  3. 5  PRINT D$;"BLOAD TONES"
  4. 9  GOTO 1000
  5. 351  FOR I3 = 1 TO 1000: NEXT I: RETURN 
  6. 397 T1% = L6% -L5% +1: VTAB H5%: HTAB L5%: PRINT  SPC( T1%): FOR I3 = H5% TO H6%: HTAB L5%: PRINT " ";: HTAB L6%: PRINT " ": NEXT I3: VTAB H6%: HTAB L5%: PRINT  SPC( T1%): RETURN 
  7. 400 A% =  PEEK( -16384): IF A% <128  THEN 400
  8. 401  POKE  -16368,0:A% = A% -128: RETURN 
  9. 410  FOR I4 = 1 TO  LEN(TP$):A$ =  MID$ (TP$,I4,1):A% =  ASC(A$) -31: PRINT A$;: POKE P1,A%: POKE P2,A%: CALL P3: NEXT I4: RETURN 
  10. 1000 H5% = 2:H6% = 6:L5% = 10:L6% = 26: INVERSE : GOSUB 397: VTAB 4: HTAB 13: NORMAL : PRINT "THE HOSPITAL": VTAB 12: HTAB 7:TP$ = "I SEE IT'S TIME FOR ANOTHER": GOSUB 410
  11. 1010 TP$ = "CHECK-UP, #. STEP THIS WAY": PRINT : HTAB 7: GOSUB 410: GOSUB 400
  12. 1020  ON  INT( RND(1) *2) +1 GOSUB 3000,5000
  13. 1025  HOME 
  14. 1030 H5% = 2:H6% = 23:L5% = 1:L6% = 39: INVERSE : GOSUB 397: VTAB 1: HTAB 2: PRINT "PSYCHOLOGICAL PROFILE"
  15. 1035  NORMAL : VTAB 10: HTAB 3: GOSUB 410: PRINT : PRINT CH$
  16. 1040  CALL 520"PR.VILLAGE"
  17. 1999  END 
  18. 3000  HOME : FOR I = 1 TO 24: PRINT  SPC( 40): NEXT I: FLASH : VTAB 2: HTAB 12: PRINT "FREE ASSOCIATION"
  19. 3002 T1% =  INT( RND(1) *5) +7: FOR I = 1 TO T1%
  20. 3003  INVERSE : VTAB 10: HTAB 10: PRINT  SPC( 15): ON  INT( RND(1) *7) +1 GOSUB 3101,3102,3103,3104,3105,3106,3107: HTAB 10: PRINT TP$
  21. 3005 CT% = 0: VTAB 15: HTAB 20: NORMAL : PRINT  SPC( 15):IP$ = "": HTAB 20
  22. 3006  GET A$: IF A$ =  CHR$(8)  THEN 3006
  23. 3007 CT% = CT% +1: PRINT A$;:IP$ = IP$ +A$: IF A$ < > CHR$(13)  AND CT% <15  THEN 3006
  24. 3008 IP$ = " " +IP$:IP$ =  LEFT$(IP$, LEN(IP$) -1) +"    ":T2% = 0: FOR J = 1 TO  LEN(IP$) -3:A$ =  MID$ (IP$,J,4): IF A$ = "FREE"  OR A$ = "SELF"  OR A$ = "INDI"  THEN T2% = 1: GOTO 3020
  25. 3010  IF A$ = "DIGN"  OR A$ = "REBE"  OR A$ = "INDE"  THEN T2% = 1: GOTO 3020
  26. 3013  IF A$ = "INDE"  OR A$ = "LIBE"  OR A$ = "HUMA"  OR A$ = "PRIV"  THEN T2% = 1
  27. 3020  NEXT J: IF T2%  THEN 4000
  28. 3029  NEXT I:TP$ = "SUBJECT IS ADAPTING NICELY":ID% = ID% -20: RETURN 
  29. 3101 TP$ = "CONFORMITY": RETURN 
  30. 3102 TP$ = "AUTHORITY": RETURN 
  31. 3103 TP$ = "HARMONY": RETURN 
  32. 3104 TP$ = "OBEDIENCE": RETURN 
  33. 3105 TP$ = "TRADITION": RETURN 
  34. 3106 TP$ = "ORDER": RETURN 
  35. 3107 TP$ = "DEPENDABILITY": RETURN 
  36. 4000  NORMAL : VTAB 24: PRINT :ID% = ID% +15
  37. 4005  PRINT  CHR$(7);"?SYNTAX ERROR IN ";RC$: PRINT 
  38. 4008  PRINT "]";:IP$ = ""
  39. 4010  GET A$: PRINT A$;:IP$ = IP$ +A$: IF A$ < > CHR$(13)  THEN 4010
  40. 4011  IF  LEN(IP$) <2  THEN  PRINT : GOTO 4008
  41. 4013 CT% = 0: IF  LEN(IP$) <3  THEN IP$ = IP$ +" ": GOTO 4013
  42. 4014 IP$ = IP$ +"  "
  43. 4015  FOR I = 1 TO  LEN(IP$) -2:A$ =  MID$ (IP$,I,3): IF A$ = "LIS"  THEN CT% = 1
  44. 4018  IF A$ = RC$  THEN CT% = 2
  45. 4020  IF A$ = "PR#"  OR A$ = "NEW"  THEN CT% = 3
  46. 4021  IF A$ = "FUC"  OR A$ = "SHI"  OR A$ = "HEL"  OR A$ = "DAM"  THEN CT% = 4
  47. 4023  NEXT I:CT% = CT% +1: ON CT% GOTO 4030,4031,4032,4033,4040
  48. 4030 TP$ = "SUBJECT IS ANTISOCIAL": RETURN 
  49. 4031  LIST : GOTO 4008
  50. 4032  POP : GOTO 14000
  51. 4033 TP$ = "SUBJECT IS EASILY DISCOURAGED":ID% = ID% -20: RETURN 
  52. 4040 ID% = ID% -10:TP$ = "SUBJECT IS EASILY FRUSTRATED": RETURN 
  53. 5000  HOME :TP$ = "THIS IS A TEST TO SEE HOW WELL YOU ARE": GOSUB 410: PRINT :TP$ = "ADAPTING TO LIFE HERE ON THE ISLAND": GOSUB 410: PRINT :TP$ = "PRESS ANY KEY TO CONTINUE": GOSUB 410: PRINT : GOSUB 400
  54. 5002 T7% = 0:CT% = 99:T3% = 0: HOME : GOTO 5014
  55. 5003 CT% = 0::T2% = 48 + RND(1) *20:T3% =  RND(1) *3 +3:T4% =  RND(1) *5 +1
  56. 5005  NORMAL : VTAB 12: HTAB 13:A% = T2%: FOR I = 1 TO T3%: PRINT  CHR$(A%);" ";:A% = A% +T4%: NEXT I
  57. 5008 A% =  PEEK( -16384): IF A% <127  THEN CT% = CT% +1: GOTO 5008
  58. 5010 A% = A% -128: POKE  -16368,0:T5% = 0:T6% = T2%: FOR I = 1 TO T3%: IF A% = T6%  THEN T5% = 1
  59. 5013 T6% = T6% +T4%: NEXT I: IF   NOT T5%  THEN 5008
  60. 5014 T7% = T7% +1: IF CT% >T3% +T7%  THEN H5% = T7%:H6% = 24 -T7%:L5% = T7%:L6% = 40 -T7%: FLASH : GOSUB 397: GOTO 5018
  61. 5016  IF  INT( RND(1) *4)  THEN T7% = T7% -2: NORMAL : GOSUB 397: IF   NOT T7%  THEN TP$ = "SUBJECT IS IMPULSIVE": RETURN 
  62. 5018  IF T7% <12  THEN 5003
  63. 5020 TP$ = "SUBJECT IS ADAPTING NICELY": RETURN 
  64. 13000  PRINT CH$
  65. 13003  CALL 520"PR.SQ1"
  66. 14000  PRINT CH$: CALL 520"PR.LOSE"
  67. 32000 T1% =  PEEK(222): CALL 1002: IF T1% = 5  OR T1% = 6  OR T1% = 7  OR T1% = 13  THEN  RESUME 
  68. 32003  NORMAL : PRINT : PRINT CH$
  69. 32005  IF T1% = 255  THEN  CALL 520"PR.SAVE"
  70. 32008  CALL 520"PR.ERR"