home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol112 / rbbexit1.bqs / EXITBBS1.BAS
Encoding:
BASIC Source File  |  1985-02-10  |  4.1 KB  |  113 lines
  1. 10 '  EXITRBBS.BAS, version 1.1
  2. 20 '  Routine to allow users to leave comments before logging off
  3. 30 '  Original by Brian Kantor & Skip Hansen 09/81 (?)
  4. 40 '  Minor text changes, bye call, and time-on-system stuff added
  5. 50 '            by Ben Bronson, 10/11/81
  6. 60 '     Note that this is meant to be compiled and called "BYE.COM", while
  7. 70 '     the real assembly-language BYE.COM (which is still needed) is
  8. 80 '     given another name (here, 'BYEX.COM').  The easiest way to handle
  9. 90 '     this is to use Macro-80 to assemble a dummy file like the following:
  10. 91 '            ENTRY    BYEX
  11. 92 '            BYEX     EQU    0F800H
  12. 93 '                RET
  13. 94 '     where '0F800H' is the address at which the real BYE runs.  Then you
  14. 95 '     just include BYEX.REL when using L80 to load the BYE.REL file pro-
  15. 96 '     duced by BASCOMing BYE.BAS:  'L80 BYE,BYEX,BYE/N/E'
  16. 97 '  
  17. 100 '  Main routine for users to leave comments before logging off
  18. 120 '
  19. 130 DEFINT A-Z
  20. 140 DIM H(6),HT(6),HD(6)
  21. 150 ERS$=CHR$(8)+" "+CHR$(8)
  22. 165 OPEN "I",1,"A:LASTCALR":INPUT #1,N$,O$,F$,DT$:CLOSE
  23. 170 PRINT
  24. 180 PRINT "Want to leave any comments (Y/N)? ";:C=1:GOSUB 400:C=0
  25. 190 IF LEFT$(B$,1)="N" OR LEFT$(B$,1)="n" THEN 360
  26. 200 IF LEFT$(B$,1)<>"Y" AND LEFT$(B$,1)<>"y" THEN 180
  27. 210 PRINT
  28. 230 OPEN "R",1,"A:COMMENTS",65:FIELD#1,65 AS RR$
  29. 240 GET#1,1:RE=VAL(RR$)+1:RL=65
  30. 250 IF RE=1 THEN RE=2
  31. 260 S$="From: "+N$+" "+O$+" "+DT$:GOSUB 510   'This assumes you have the date in LASTCALR as "DT$"
  32. 270 PUT#1,RE
  33. 280 PRINT "Enter comments, <return> to end, (16 lines max)"
  34. 290 PRINT
  35. 300 PRINT "*";
  36. 310 GOSUB 400
  37. 320 IF B$="" THEN 350 
  38. 330 RE=RE+1:S$=B$:RL=65:GOSUB 510:PUT#1,RE 
  39. 340 GOTO 300
  40. 350 S$=STR$(RE):RL=65:GOSUB 510:PUT#1,1:CLOSE
  41. 360 GOSUB 44000
  42. 370 PRINT "Please call again"
  43. 390 CALL BYEX   'Calling the dummy file that points to the real BYE
  44. 395 END
  45. 400 '
  46. 410 '  Accept string into B$ from console
  47. 420 '
  48. 430 GOSUB 560
  49. 440 B$=SAV$
  50. 450 IF LEN(B$)=0 THEN RETURN
  51. 460 IF C=0 THEN 500
  52. 470 FOR ZZ=1 TO LEN(B$)
  53. 480    MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96))
  54. 490 NEXT ZZ
  55. 500 RETURN
  56. 510 '
  57. 520 '  Fill and store disk record
  58. 530 '
  59. 540 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  60. 550 RETURN
  61. 560 CHC=0: SAV$=""
  62. 570 NCH=ASC(INPUT$(1))
  63. 580 IF NCH=127 THEN 640
  64. 590 IF NCH<32 THEN 670
  65. 600 IF CHC>=62 THEN PRINT CHR$(7);:GOTO 570
  66. 610 SAV$=SAV$+CHR$(NCH): CHC=CHC+1: PRINT CHR$(NCH);
  67. 620 IF CHC=55 THEN PRINT CHR$(7);
  68. 630 GOTO 570
  69. 640 IF CHC=0 THEN 570 ELSE PRINT RIGHT$(SAV$,1);: GOTO 660
  70. 650 IF CHC=0 THEN 570 ELSE PRINT ERS$;
  71. 660 CHC=CHC-1: SAV$=LEFT$(SAV$,CHC): GOTO 570
  72. 670 IF NCH=8 THEN 650
  73. 680 IF NCH=13 THEN PRINT: RETURN
  74. 690 IF NCH=21 THEN PRINT " #": GOTO 560
  75. 700 IF NCH<>24 OR CHC=0 THEN 570
  76. 710 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: GOTO 560
  77. 44000 ' Clock routine from Hank Szyszka, modified
  78. 44010 ' Print present time first
  79. 44210 C=32 : ' C=CLOCK PORT (20H)
  80. 44220 ' Note that this is a Mountain Hardware 100,000 DAY Clock 
  81. 44230 H(1)=INP(C+9) AND 15:H(2)=INP(C+8) AND 15
  82. 44240 H(3)=INP(C+7) AND 15:H(4)=INP(C+6) AND 15
  83. 44250 H(5)=INP(C+5) AND 15:H(6)=INP(C+4) AND 15
  84. 44260 REM
  85. 44270 PRINT:PRINT N$+" "+O$+" logged off at ";
  86. 44280 TF$="#"
  87. 44290 FOR I=1 TO 6
  88. 44300 PRINT USING TF$;H(I);
  89. 44310 IF I=2 THEN PRINT ":";
  90. 44320 IF I=4 THEN PRINT ":";
  91. 44330 NEXT I
  92. 44340 PRINT
  93. 44700 '  Now get hh/mm/ss stored by enterbbs prog (not yet released as of 10/11/81)
  94. 44710 HT(1)=PEEK(74):HT(2)=PEEK(75):HT(3)=PEEK(76)
  95. 44720 HT(4)=PEEK(77):HT(5)=PEEK(78):HT(6)=PEEK(79)
  96. 44730 '  And calculate the difference...
  97. 44740 IF H(6)<HT(6) THEN H(6)=H(6)+10:H(5)=H(5)-1
  98. 44750 IF H(5)<HT(5) THEN H(5)=H(5)+6:H(4)=H(4)-1
  99. 44760 IF H(4)<HT(4) THEN H(4)=H(4)+10:H(3)=H(3)-1
  100. 44770 IF H(3)<HT(3) THEN H(3)=H(3)+6:H(2)=H(2)-1
  101. 44780 IF H(2)<HT(2) THEN H(2)=H(2)+10:H(1)=H(1)-1
  102. 44790 HD(6)=H(6)-HT(6):HD(5)=H(5)-HT(5):HD(4)=H(4)-HT(4)
  103. 44800 HD(3)=H(3)-HT(3):HD(2)=H(2)-HT(2):HD(1)=H(1)-HT(1)
  104. 44810 PRINT "You were on the system for ";
  105. 44820 TF$="#"
  106. 44830 FOR I=1 TO 6
  107. 44840 PRINT USING TF$;HD(I);
  108. 44850 IF I=2 THEN PRINT ":";
  109. 45860 IF I=4 THEN PRINT ":";
  110. 45870 NEXT I
  111. 45880 PRINT " (hrs/mins/secs)":PRINT
  112. 45890 RETURN
  113.