home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / 33MASTER.DSK / BIORHYTHM.int < prev    next >
Text File  |  2014-09-09  |  5KB  |  110 lines
  1. 0  POKE 51,150:REM SET PROMPT
  2. 2 GOTO 20
  3. 5  POKE 34,19: POKE 35,19:RETURN 
  4. 10  POKE 34,21: POKE 35,24:RETURN 
  5. 20 SETWND=5:RESETWND=10:GOTO 1060
  6. 40 FOR I=1 TO 3:COLOR= 1*(I=1)+12*(I=2)+2*(I=3):VLIN 0,39 AT 33+I+I:VTAB 24
  7. 60 FOR X=0 TO 31:P=(N MOD BV(I)+X) MOD BV(I)
  8. 80 A=(19-(P*B(I)/100))*(P*100<C(I))+(P*100>C(I))*(P*100<=3*C(I))*((P*100-C(I))/100*B(I)/100)
  9. 100 A=A+(P*100>3*C(I))*(38-((P*100-3*C(I))/100*B(I)/100)):A=39*(A>39)+A*(A<40)
  10. 120 PLOT X,A:IF  PEEK (-16384)=155 THEN RETURN :REM LET USER  'ESCAPE' IF WANTED
  11. 140 KK=7:TM=5: POKE 1,TM MOD 256: POKE 24,TM/256+1: POKE 0,KK:CALL 2:NEXT X:NEXT I:RETURN 
  12. 160  POKE 1,TM MOD 256: POKE 24,TM/256+1: POKE 0,KK:CALL 2
  13. 180 RETURN 
  14. 200 GOSUB 300:IF FLAG THEN 220:GOSUB 1320:Y=Y+(Y<100)*1900:GOTO 240
  15. 220 M=FM:D=FD:Y=FY
  16. 240 A=Y-(M<3):N=Y MOD 58*365-Y/58*82+A/4-A/400+M*31-M/12-M/7-M/5-3*(M>2)+D:IF N<0 THEN N=N+21252:RETURN 
  17. 260 TT=3:GOSUB 300:RETURN 
  18. 280 PRINT "***************************************":RETURN 
  19. 300 KK=8:TM=1000:GOSUB 160:RETURN 
  20. 320 DIM B(3),C(3),BV(3):B(1)=348:B(2)=286:B(3)=242:C(1)=575:C(2)=700:C(3)=825:BV(1)=23:BV(2)=28
  21. 340 DIM B$(255),N$(255),IN$(255),MONTH$(10)
  22. 360 BV(3)=33:TEXT :CALL -936:VTAB 7:GOSUB 280:GOSUB 260:PRINT :TAB 16:PRINT "BIORHYTHMS"
  23. 380 PRINT :GOSUB 260
  24. 400 TAB 10:PRINT "BY COMPUTER GENERATION":PRINT :GOSUB 260
  25. 420 GOSUB 280
  26. 440 PRINT :PRINT :PRINT "     MODIFIED BY BRUCE TOGNAZZINI"
  27. 460 GOSUB SETWND:VTAB 22:KK=9:TM=2500:GOSUB 160
  28. 480 GOSUB RESETWND:CALL -936:GOSUB SETWND:VTAB 22:INPUT "YOUR NAME, PLEASE? ",N$:VTAB 23
  29. 485 IF NOT  LEN(N$) THEN 490:FOR I=1 TO  LEN(N$):IF  ASC(N$(I))=160 THEN NEXT I:IF I>= LEN(N$) THEN 487:N$=N$(I, LEN(N$))
  30. 487 IF  ASC(N$)=160 THEN N$=""
  31. 490 PRINT N$;:VTAB 22:PRINT :CALL -868:PRINT "BIRTHDATE (MM/DD/YYYY)? ";:GOSUB 200:VTAB 23:TAB 21
  32. 500 BN=N:BD=D:BM=M:BY=Y
  33. 520 N=BN:D=BD:M=BM:Y=BY:PRINT "BIRTHDATE ";M;"/";D;"/";Y;:GOSUB SETWND:VTAB 22:N1=N:CALL -868
  34. 530 GOSUB SETWND:PRINT :VTAB 22:CALL -868
  35. 540 IF NOT FLAG THEN PRINT "FORECAST DATE (MM/DD/YYYY)? ";:GOSUB 200
  36. 542 IF Y<BY OR (Y=BY AND M<BM) OR (Y=BY AND M=BM AND D<BD) THEN 540
  37. 545 N=N-N1:IF N<0 THEN N=N+21252
  38. 550 VTAB 22:PRINT :CALL -868
  39. 560 VTAB 24:TAB 18:IF M>9 AND D>9 THEN PRINT "FORECST";:IF M<10 OR D<10 THEN PRINT "FORECAST";:PRINT " DATE          ";
  40. 580 VTAB 24:TAB 32-(M>9 AND D>9):PRINT M;"/";D;"/";Y;:VTAB 22:FLAG=0
  41. 600 GOSUB 300:FOR K=1 TO 2:NEXT K:KK=9:TM=2500:GOSUB 160
  42. 610  POKE 50,63:PRINT "---------PRESS "ESC" TO STOP PLOT-------": POKE 50,255
  43. 620 GR :FOR SX=1 TO 32:COLOR= 5+5*(SX MOD 2=1)-10*(SX MOD 7=0)+5*(SX MOD 14=0):PLOT SX-1,39:PLOT SX-1,19:NEXT SX
  44. 640 J=1:VTAB 21:PRINT :FOR X=18 TO 20 STEP 2:COLOR= 3:HLIN 0,31 AT X:NEXT X:HLIN 1,3 AT 3:HLIN 1,3 AT 37:VLIN 2,4 AT 2:VTAB 21
  45. 660 GOSUB 1040
  46. 680 FOR Z=1 TO 31 STEP 3
  47. 700 IF D<CD+1 THEN 720:D=D-CD:M=M+1-12*(M>11):GOSUB 1040:IF M=1 THEN Y=Y+1:MFLAG=1
  48. 720 PRINT D;:IF D<10 THEN PRINT " ";:PRINT " ";:D=D+3:NEXT Z:PRINT "  P E M":VTAB 22
  49. 740 VTAB 24:PRINT "DAYS LIVED       ";:TAB 12:PRINT N;
  50. 760 GOSUB 40
  51. 780  POKE -16368,0
  52. 790  POKE 34,21: POKE 35,21
  53. 800 VTAB 22:PRINT :VTAB 22:PRINT "ANOTHER PLOT, ";
  54. 810 IF NOT  LEN(N$) THEN 830
  55. 820 FOR Q=1 TO  LEN(N$):PRINT N$(Q,Q);:IF  ASC(N$(Q))#160 THEN NEXT Q:IF Q< LEN(N$) THEN  POKE 36, PEEK (36)-1:GOTO 840
  56. 830  POKE 36, PEEK (36)-2
  57. 840 INPUT "? ",B$:IF  LEN(B$)=0 THEN 940:IF B$(1,1)#"N" THEN 530
  58. 850 GOSUB RESETWND:CALL -936
  59. 860 VTAB 22:INPUT "MAY I CHART SOMEONE ELSE, PLEASE? ",B$
  60. 870 IF NOT  LEN(B$) THEN 860
  61. 880 GOSUB RESETWND:CALL -936
  62. 885 IF B$(1,1)="N" THEN 900
  63. 890 VTAB 22:TAB 16:PRINT "BIORHYTHMS":PRINT :TAB 10:PRINT "BY COMPUTER GENERATION";
  64. 895 KK=8:TM=1000:FOR I=1 TO 3:GOSUB 160:NEXT I:GOTO 460
  65. 900 VTAB 22:TAB 15:PRINT "THANK YOU":END 
  66. 940 REM ADVANCE TO NEXT MONTH
  67. 960 FY=Y:FM=M:FD=1
  68. 980 IF NOT MFLAG THEN FM=M+1-12*(M>11):IF NOT MFLAG AND FM=1 THEN FY=Y+1:MFLAG=0
  69. 1000 GOSUB 300
  70. 1020 FLAG=1:GOTO 520
  71. 1040 CD=31-1*(M=9 OR M=4 OR M=6 OR M=11)-3*(M=2)+1*(NOT (Y MOD 4) AND (Y MOD 100) AND M=2):RETURN 
  72. 1060 REM  INIT
  73. 1080  POKE 14,198: POKE 15,24: POKE 16,240: POKE 17,5: POKE 18,198: POKE 19,1: POKE 20,76: POKE 21,2: POKE 22,0: POKE 23,96
  74. 1100  POKE 2,173: POKE 3,48: POKE 4,192: POKE 5,165: POKE 6,0: POKE 7,32: POKE 8,168: POKE 9,252: POKE 10,165: POKE 11,1: POKE 12,208: POKE 13,4
  75. 1120 GOTO 320
  76. 1140 REM 
  77.  
  78.  
  79. /-------------------------\     * STRING VALUE SUBROUTINE *     \-------------------------/
  80.  
  81.  
  82.  
  83. 1160 NUM=0:SIGN=0:IF  LEN(IN$)=0 THEN RETURN 
  84. 1180 IF  LEN(IN$)<LOC THEN RETURN :SIGN=1:FOR SCR=LOC TO  LEN(IN$):CHR= ASC(IN$(SCR))
  85. 1200 IF CHR=160 THEN 1280
  86. 1220 IF CHR<176 OR CHR>185 THEN 1300
  87. 1240 IF NUM<3276 OR NUM=3276 AND CHR<184 THEN 1260:SIGN=0:RETURN 
  88. 1260 NUM=10*NUM-176+CHR
  89. 1280 NEXT SCR
  90. 1300 SIGN=SIGN*(SCR#LOC):NUM=SIGN*NUM:LOC=SCR+1:RETURN 
  91. 1310 REM 
  92.  
  93.  
  94. /-----------------------\       * DATE INPUT SUBROUTINE *       \-----------------------/
  95.  
  96.  
  97.  
  98.  
  99. 1320 TB= PEEK (36)
  100. 1340  POKE 36,TB:CALL -868:LOC=1:M=0:D=0:INPUT IN$:IF  LEN(IN$)=0 THEN 1340
  101. 1360 GOSUB 1140:IF NOT SIGN THEN 1340:M=NUM
  102. 1380 IF M<1 OR M>12 THEN 1340
  103. 1400 GOSUB 1140:IF NOT SIGN THEN 1340:D=NUM
  104. 1420 IF D<1 THEN 1340
  105. 1440 GOSUB 1140:IF NOT SIGN THEN 1340:Y=NUM
  106. 1460 IF (Y>0 AND Y<100) OR (Y>1899 AND Y<2999) THEN 1480:GOTO 1340
  107. 1480 GOSUB 1040:IF D>CD THEN 1340:RETURN 
  108. 65534 REM  ORIGINAL PROGRAM COPYRIGHT  1977 BY APPLE COMPUTER 
  109. 65535 REM NEW MATERIAL COPYRIGHT BRUCE TOGNAZZINI C/O CARR ELECTRONICS CORP. 5811 GEARY BLVD. SAN FRANCISCO,CA 94121 (415)668-4243
  110.