Bullwinkle's Corner program code

Bullwinkle's Corner source code

Bullwinkle's Corner BBS was one of a kind. This was because the source code was NEVER published, released, or shared. This kept the Corner unique among other bulletin boards. For the first time ever, the Corner's source code is shared with the public.
A note about getting the TI code to the web: I have developed a prototype package for transferring files from a TI to a PC and from a PC to a TI. The transfer software is controlled completely from the PC. I can even switch the TI drives I want to access from the PC. I intend to eventually make this package available for a reasonable price. If you are interested and wish to be notified when this package is complete, drop me an e-mail with the link below. I will keep your name on file and e-mail you back when this package is ready, and let you know what it will cost.

Bullwinkle's Corner consisted of quite a few modules. Each module is contained in it's own textbox below.

last assembly modification notes (S Clarke)

The only change in version 9 from version 8 is that in BBS/S9 the CALL CK3 (CALL LINK("CK3",A$) actally puts data for RS232/4 in the @PORT address instead of RS232/3. The reason for this is that /3 doesnt work correctly on the modified card (RS232) in the system. I think it may have a short. in the hardware. I changed the assembly to /4 (one line in CK3) to access /4. I did this rather than change all the references in the XB code. The only code in XB that had to be changed was line 260, where I opened up channel /4 instead of /3. (LOGON) I have saved it to disk (LOGON) and will use the modification until I either get the card fixed, or decide to keep the mod permanantly. Note that when the assembly is worked on to access the HD that v9 should be impli- mented in the compilation if we have the same problem. I had to use the Y cable to access /4 with the hardware.

go back up to the top

The main assembly code - routines to be accessed from the main modules

The main assembly code's core was written by Henry Carver. It was modified by Steve Clarke.

TITL 'AUG 26, 86 8:00 PM "ASSEMBLY FOR TI BBS"' IDT 'TI/BBS' * Written by Henry Carver started on January 22, 1985 * Modified and adapted for Bullwinkle's Corner BBS by Steve Clarke Last update by Steve Clarke for BC 12/31/91 DEF BAUD *Baud rate detect DEF ON *Force DTR hi DEF OFF *FORCE DTR low DEF SETUP *Setup memory & # of open disk files DEF TEST *Allows the SysOp to test system. SETUP resets the test mode. DEF DCDCHK *Returns single keystroke, 128=carrier or 255=no carrier DEF INPUT *Returns a "LINPUT" type string DEF SECRET *Same as input only it echo's "."(DOTS)' DEF OUTPUT *Sends out a string variable (CRs must be furnished) DEF LFNO *Sets auto-linefeeds OFF (No Linefeed with CRs) DEF LFYES *Sets auto-linefeeds ON (Automatic Linefeed with CRs) DEF UPPER *Changes lower case letters to upper case letters DEF JOYST * BC-Check JS #1 down (hangup) DEF CK1 * DEF CK2 DEF CK3 * DEF CK4 CARDET EQU 59 *Pin 19 "RS232/2" Pin 20 on RS232/1 is EQU -27 LIGHT EQU -25 *RS232 light PORT BSS 2 *BC TERMINAL RS1 DATA >1340 * RS2 DATA >1380 * RS3 DATA >1540 * RS4 DATA >1580 * * RS232 EQU >1340 *RS232 Port 1 STRASG EQU >2010 * STRREF EQU >2014 * KSCAN EQU >201C * VSBW EQU >2020 * VMBW EQU >2024 * VSBR EQU >2028 * VMBR EQU >202C * VWTR EQU >2030 KEYBRD EQU >8374 KEY EQU >8375 JSXADR EQU >8376 *BC-JS X adr 0=ok -4=hangup STATUS EQU >837C WS1 BSS >20 *Workspace registers (General) WS2 BSS >20 *Workspace registers for screen display VDPBUF BSS >320 *Used as buffer for screen display VDPSAV BSS >168 *Used to save screen memory during chat RESULT BSS >100 *Used for variable passing between Basic and Assembly MAXI DATA >50 *Maximum input for RS232 MAXO DATA >FF *Maximum output for RS232 NOCAR DATA >1FF *Used to show no carrier TESTON DATA 0 *Used to indicate test mode 0=off >FFFF=on CHECK DATA >180 *Used to show carrier YES DATA >959 *The letter "Y" and 8 characters NO DATA >14E *The letter "N" BTIMER DATA 5 *Timeout timer (In Minutes) for input WINDOW DATA 0 *Row 24 column 1 for windowing SCRBEG DATA 0 SCRCNT DATA 0 SCRLEN DATA 0 COL40 DATA 40 COL32 DATA 30 BAUDR BYTE 4 TEXT '2400' BYTE 4 TEXT '1200' BYTE 3 TEXT '300 ' BAUDTB DATA >0020,>00D0 * 2400 baud DATA >0075,>01A0 * 1200 baud DATA >7FFF,>04D0 * 300 baud CNTRL1 BYTE >62 *1 stop bit, even parity, 7 bit CNTRL2 BYTE >83 *1 stop bit, no parity, 8 bit INTVL BYTE >19 *Interrupt every 1.6 microsec 25 * 64 microsec SAME BYTE 0 HOLD BYTE 0 SMALL BYTE -32 *Difference between lower case to upper case SMALLA BYTE >61 *The letter "a" SMALLZ BYTE >7A *The letter "z" PERIOD BYTE >2E * A period "." BOARD0 BYTE 0 BOARD1 BYTE 1 *BC BOARD4 BYTE 4 BOARD5 BYTE 5 NOKEY BYTE >FF BELL BYTE >07 BS LEFT BYTE >08 RIGHT BYTE >09 CR BYTE >7E ENTER BYTE >0D LF BYTE >0A BREAK BYTE >02 QUIT BYTE >91 *CONTROL Q CHR32 BYTE >20 CHR128 SPACE BYTE >80 *>60 OFFSET FOR BASIC CURSOR BYTE >7E *>60 OFFSET FOR BASIC JSOK BYTE >00 * BC -JS OK value EVEN OFFSET DATA >6000 *>60 OFFSET FOR BASIC CHAR DATA >0070,>4070,>000E,>0808 DATA >3C42,>99A1,>A199,>423C TE2 DATA >0D0D,>0D0D,>1B47,>7F1B,>282C,>1B29 TENO DATA >0808,>0808,>0808,>0808 MSG DATA >070C TEXT 'You have been zapped to CHAT mode' TEXT ' via the wayback machine!' DATA >200D MSGEND EVEN CHT TEXT 'POOF!! Back to the present-' TEXT 'you are now in command mode' DATA >200D CHTEND EVEN SCREEN DATA WS2,$+2 MOVB @KEY,R1 CB R1,@BS JNE SCREE1 C R0,@WINDOW JEQ $+14 MOVB @SPACE,R1 DEC R0 DEC R3 BLWP @VSBW RTWP SCREE1 CB @KEY,@ENTER JNE $+6 MOVB @CR,R1 AB @OFFSET,R1 BLWP @VSBW INC R0 INC R3 CB @KEY,@ENTER JEQ $+8 C R3,R4 JEQ $+4 RTWP MOV @SCRBEG,R0 LI R1,VDPBUF MOV @SCRCNT,R2 BLWP @VMBR A @SCRLEN,R1 BLWP @VMBW MOV @WINDOW,R0 *Address of the last row on the screen CLR R3 RTWP BAUD LWPI WS1 MOV @PORT,R12 SBO LIGHT SBO 31 LDCR @CNTRL2,8 LDCR @INTVL,8 SBZ 13 SETO R1 CLR R3 C R3,@TESTON JEQ $+10 LI R2,BAUDR+10 B @BASIC+4 BL @CHKDCD *Check for carrier TB 15 *Check for start bit of <CR> JEQ $-6 INC R3 *Update counter for timing TB 15 JNE $-4 *Wait for character to be recieved LI R4,BAUDTB-2 INCT R4 INC R1 C R3,*R4+ *Does counter <= table entry JH $-6 *No, try again LDCR *R4,12 *Set data rate TB 21 *Wait for RBRL to be set JNE $-2 SBZ 18 *Reset RBRL SBZ LIGHT LI R0,R5 MPY R0,R1 LI R0,BAUDR A R0,2 B @BASIC+4 *Return SETUP LWPI WS1 CLR @TESTON MOV @PORT,R12 LI R0,VDPBUF *Clear the VDP buffer LI R1,>488 *The size of the buffer MOVB @SPACE,*R0+ DEC R1 JNE $-6 LWPI WS1 LI R0,>6F0 LI R1,CHAR LI R2,>10 BLWP @VMBW BL @CHAT9 TEST SETO @TESTON RT ON SBO 48 RT OFF SBZ 48 RT LFNO CLR R0 MOVB R0,@LF RT LFYES LI R0,>0A00 MOVB R0,@LF RT MSGOUT MOVB *R1+,@KEY CB @KEY,@CR JNE $+8 MOVB @ENTER,@KEY MSGOU1 SBO 16 SBO LIGHT TB 22 JNE $-2 LDCR @KEY,8 SBZ 16 SBZ LIGHT CB @KEY,@LF JEQ $+6 BLWP @SCREEN CB @KEY,@ENTER JNE $+10 MOVB @LF,@KEY JMP MSGOU1 DEC R2 JNE MSGOUT RT RS232X MOVB 0,@KEY RS232O SBO 16 SBO LIGHT TB 22 JNE $-2 LDCR @KEY,8 SBZ 16 SBZ LIGHT CB @KEY,@LF JEQ $+6 BLWP @SCREEN RT CHKDCD CLR R10 C R10,@TESTON JEQ $+4 RT TB CARDET JNE $+4 RT DEC R10 JNE $-8 MOV @NOCAR,@RESULT CI R11,CHAT6 JEQ $+6 B @BASIC B @CHAT8 DCDCHK LWPI WS1 MOV @PORT,R12 MOV @CHECK,@RESULT BL @CHKDCD MOVB @BOARD4,@KEYBRD BLWP @KSCAN CB @KEY,@CHR32 JEQ CHAT CB @KEY,@NOKEY JNE $+16 RS232I SBO LIGHT TB 21 JNE $+16 STCR @KEY,8 SBZ 18 SBZ LIGHT MOVB @KEY,@RESULT+1 B @BASIC CHAT LI R0,>07F5 BLWP @VWTR LI R0,>01B0 BLWP @VWTR SWPB R0 MOVB R0,@>83D4 LI R0,>C8 MOV R0,@SCRBEG LI R0,>2F8 MOV R0,@SCRCNT LI R0,>28 MOV R0,@SCRLEN LI R0,>398 *The VDP address of row 24 in 40 column moe MOV R0,@WINDOW LWPI WS2 MOV @COL40,R4 *Load register 4 with 40 column limit CLR R3 LWPI WS1 CLR R0 LI R1,VDPSAV LI R2,>80 BLWP @VMBR *Save first 4 rows LI R0,>300 LI R1,VDPSAV+128 LI R2,>E8 BLWP @VMBR *Save area for 40 column display LI R4,>1F LI R0,>201 LI R2,RESULT *Save last 4 rows transmitted CLR R3 MOV @COL32,R5 DEC R5 CHAT1 C R0,@WS2 JHE CHAT2 C R3,R5 JLT $+8 AI R0,R3 CLR R3 BLWP @VSBR SB @OFFSET,R1 MOVB R1,*R2+ INC R0 INC R3 CB R1,@CR JNE CHAT1 AI R0,>20 SZC R4,R0 INC R0 CLR R3 JMP CHAT1 CHAT2 LI R1,RESULT S R1,R2 MOV R2,R4 LI R1,MSG LI R2,MSGEND S R1,R2 BL @MSGOUT LI R0,>3E7 MOVB @SPACE,R1 BLWP @VSBW DEC R0 JNE $-6 BLWP @VSBW BLWP @KSCAN CB @KEY,@NOKEY JNE $-10 LI R0,>01F0 BLWP @VWTR SWPB R0 MOVB R0,@>83D4 MOVB @BOARD5,@KEYBRD BLWP @KSCAN MOVB @BOARD0,@KEYBRD CHAT3 MOV @WS2,R0 BLWP @VSBR CB R1,@CURSOR JEQ $+6 MOVB R1,@HOLD DEC R5 JGT CHAT4 CB R1,@CURSOR JEQ $+8 MOVB @CURSOR,R1 JMP $+6 MOVB @HOLD,R1 BLWP @VSBW LI R5,>100 CHAT4 MOVB @KEY,@SAME BLWP @KSCAN CB @KEY,@QUIT JNE $+4 JMP CHAT7 CHAT5 CB @KEY,@NOKEY JNE $+12 TB 21 JNE CHAT3 STCR @KEY,8 SBZ 18 CB @KEY,@SAME JNE $+16 INC R3 CI R3,>500 JLT CHAT3 LI R3,>4C0 JMP $+10 CLR R3 MOVB @KEY,@SAME MOVB @HOLD,R1 BLWP @VSBW BL @CHKDCD CHAT6 BL @RS232O LI R5,>200 CB @KEY,@ENTER JNE $+12 MOVB @LF,@KEY BL @RS232O JMP CHAT3 CHAT7 LI R1,CHT LI R2,CHTEND S R1,R2 BL @MSGOUT CHAT8 LI R0,>01B0 BLWP @VWTR SWPB R0 MOV R0,@>83D4 CLR R0 LI R1,VDPSAV LI R2,>80 BLWP @VMBW LI R0,>300 LI R1,VDPSAV+128 LI R2,>E8 BLWP @VMBW BLWP @KSCAN CB @KEY,@NOKEY JNE $-10 LI R0,>07F1 BLWP @VWTR LI R0,>01E0 BLWP @VWTR SWPB R0 MOV R0,@>83D4 CHAT9 LWPI WS2 LI R0,VDPBUF MOVB @SPACE,R3 LI R4,VDPSAV MOVB R3,*R0+ C R0,R4 JNE $-4 LI R0,>260 MOV R0,@SCRCNT LI R0,>20 MOV R0,@SCRLEN LI R0,>A0 MOV R0,@SCRBEG LI R0,>2E1 *The VDP address of row 24 MOV R0,@WINDOW CLR R3 MOV @COL32,R4 *The last column used in normal mode DEC R4 LWPI WS1 CI R11,TEST JNE $+6 B @BASIC1 LI 1,RESULT *Send out last 4 rows MOV R4,R2 BL @MSGOUT MOV @CHECK,@RESULT B @BASIC SECRET SETO @WS1+10 INPUT LWPI WS1 MOVB @BOARD5,@KEYBRD BLWP @KSCAN MOVB @BOARD0,@KEYBRD MOV @PORT,R12 LI R1,RESULT+1 CLR R0 CLR R2 MOV @BTIMER,R3 INPUT1 CB @TESTON,@JSOK JNE CONTIN BLWP @KSCAN CB @KEY,@NOKEY JNE CONTI1 BL @JOYST CONTIN BLWP @KSCAN CONTI1 CB @KEY,@BREAK JNE $+6 B @BASIC MOVB @STATUS,@STATUS JNE INPUT2+4 SBO LIGHT TB 21 JEQ INPUT2 DEC R2 JNE INPUT1 DEC R3 JNE INPUT1 JMPOUT MOV @NOCAR,@RESULT B @BASIC INPUT2 STCR @KEY,8 SBZ 18 SBZ LIGHT CB @KEY,@BS JNE $+16 MOV R0,R0 JEQ INPUT1 DEC R0 DEC R1 BL @RS232O JMP INPUT1 CB @KEY,@ENTER JNE INPUT3 MAXOUT MOV @MAXI,R6 DEC R6 C R0,R6 JNE $+16 LWPI WS2 INC R0 INC R3 LWPI WS1 INC R0 BL @RS232O MOVB @LF,@KEY BL @RS232O SWPB R0 MOVB R0,@RESULT B @BASIC INPUT3 CB @KEY,@CHR32 JL INPUT1 CB @KEY,@CHR128 JHE INPUT1 MOVB @KEY,*R1+ INC R0 MOV R5,R5 JEQ $+8 MOVB @PERIOD,@KEY BL @RS232O C R0,@MAXI JLT INPUT4 MOVB @BS,@KEY BL @RS232O DEC R0 DEC R1 MOVB @BELL,@KEY BL @RS232O MOVB @ENTER,@KEY BL @RS232O B @MAXOUT INPUT4 JMP INPUT1 JOYST CB @TESTON,@JSOK JNE GOBACK MOVB @BOARD1,@KEYBRD * BC-Joyst routine BLWP @KSCAN CB @JSXADR,@JSOK JNE HANGUP MOVB @BOARD0,@KEYBRD GOBACK RT HANGUP B @JMPOUT CK1 LWPI WS1 MOV @RS1,@PORT CLR @TESTON B @DCDCHK *CK2 MOV @RS2,@PORT * RT CK3 LWPI WS1 MOV @RS4,@PORT SETO @TESTON B @DCDCHK RT *CK4 MOV @RS4,@PORT * RT OUTPUT LWPI WS1 MOV @PORT,R12 CLR R0 LI R1,1 MOVB @MAXO+1,@RESULT LI R2,RESULT BLWP @STRREF MOV R2,R1 CLR R2 MOVB @RESULT,R2 SWPB R2 LI R1,RESULT+1 BL @MSGOUT B @BASIC1 UPPER CLR R0 LI R1,R1 MOVB @MAXO+1,@RESULT LI R2,RESULT BLWP @STRREF INC R2 CLR R0 MOVB @RESULT,R0 SWPB R0 MOV R0,R0 JNE $+6 B @BASIC UPPER1 CB *R2,@SMALLA JL $+12 CB *R2,@SMALLZ JH $+6 AB @SMALL,*R2 INC R2 DEC R0 JNE UPPER1 BASIC LI R2,RESULT CLR R0 CLR R5 LI R1,1 BLWP @STRASG BASIC1 SBZ LIGHT LWPI >83E0 CLR @>8322 B @>6A * END

go back up to the top

the file transfer assembly code

The file transfer assembly code was written by Michael Riccio and very slightly modified by Steve Clarke.

DEF XMODEM * * EQUATES * * VDP UTILITIES NUMASG EQU >2008 XBASIC NUMASG NUMREF EQU >200C XBASIC NUMREF STRREF EQU >2014 XBASIC STRREF XMLLNK EQU >2018 XBASIC XMLLNK KSCAN EQU >201C XBASIC KSCAN VSBW EQU >2020 XBASIC VSBW VMBW EQU >2024 XBASIC VMBW VSBR EQU >2028 XBASIC VSBR VMBR EQU >202C XBASIC VMBR VWTR EQU >2030 XBASIC VWTR * SCRATCHPAD RAM PAD EQU >8300 SCRATCHPAD RAM ADDINF EQU PAD ADDITIONAL INFO BLOCK SEC# EQU PAD+>02 SECTOR NUMBER FAC EQU PAD+>4A FLOATING POINT ACCUMULATOR SCLEN EQU PAD+>55 DSR NAME LENGTH SCNAME EQU PAD+>56 POINTER TO PAB VDP ADDRESS TYPE EQU PAD+>6D TYPE BYTE FOR GPL DSRLNK SUBSTK EQU PAD+>73 GPL SUBROUTINE STACK POINTER KEYVAL EQU PAD+>75 KEY CODE FROM KSCAN ST EQU PAD+>7C GPL STATUS BYTE INTADD EQU PAD+>C4 INTERRUPT ROUTINE FLAG CRULST EQU PAD+>D0 CRU POINTER FOR DSRLNK SADDR EQU PAD+>D2 ADDRESS SAVE FOR DSRLNK VDP EQU PAD+>D4 COPY OF VDP REGISTER 1 GPLWS EQU PAD+>E0 GPL WORKSPACE GR4 EQU PAD+>E8 GPLWS R4 GR4LB EQU PAD+>E9 GPLWS R4 LSB GR6 EQU PAD+>EC GPLWS R6 * ABSOLUTE CPU ADDRESSES PUTSTK EQU >0050 PUSH GROM ADDR TO STACK LDGADD EQU >0060 LOAD GROM ADDR AND EXECUTE CFI EQU >12B8 XBASIC CFI FOR XMLLNK GETSTK EQU >166C GET GROM ADDR FROM STACK XTAB27 EQU >200E LOW MEM XML TABLE 27 ADDR VDPRD EQU >8800 VDP READ DATA VDPWD EQU >8C00 VDP WRITE DATA VDPWA EQU >8C02 VDP WRITE ADDRESS * ABSOLUTE VDP RAM ADDRESSES NAMLEN EQU >03C0 PAB VDP ADDRESS FNAME EQU >03C6 FILENAME BUFFER FOR GPL SECTOR EQU >1000 SECTOR BUFFER * * WORKSPACES * MYREG BSS >20 MAIN WORKSPACE UTILWS BSS >20 UTILITY WORKSPACE EVEN * * DATA * NINE DATA 9 MAXIMUM NUMBER OF RETRIES TEN DATA 10 TEN FOR DIVISION SEC#10 DATA 10*60 TEN SECONDS SEC#12 DATA 12*60 TWELVE SECONDS HEDDAT BYTE >07 TI FILE HEADER TEXT 'TIFILES' TEMPR# BYTE 0 TEMP RECORD NUMBER ACKFLG BYTE 0 ACK FLAG FOR RECEIVE H0A BYTE >0A MAXIMUM FILENAME LENGTH SOH BYTE 1 EOT BYTE 4 ACK BYTE 6 ASCII CODES NAK BYTE 21 CAN BYTE 24 CRC TEXT 'C' EVEN TIMER DATA 0 TIMER FIRST1 DATA 0 FIRST RECORD FLAG RETRY DATA 0 NUMBER OF RETRIES BRKCNT DATA 0 INTSAV DATA 0 OLD INTERRUPT ADDRESS SAVPAD BSS 10 SCRATCHPAD RAM BUFFER EVEN * * BUFFERS * SECBUF BSS 256 SECTOR BUFFER RECORD BSS 128 RECORD BUFFER SCRLBF BSS 28 SCROLL BUFFER * * PABS * XMDPAB DATA 0,0,>8080 REC# DATA 0 BYTE 0 LEN1 BYTE 0 TEXT 'DSK' DRIVE# BYTE 0 XMDLEN BYTE 0 XMDNAM TEXT '123456789 ' EVEN * * TEXT * MSG1 TEXT 'XMODEM File Transfers in Progress.' TEXT 'Sending' TEXT 'Receiving' MSG2 TEXT 'Not' MSG3 TEXT 'TI' MSG4 TEXT 'DSK' MSG4D TEXT '1.' MSG5 TEXT 'Protocol:' MSG6 TEXT 'CRC ' MSG7 TEXT 'Checksum' MSG8 TEXT 'Sector: 0 Record: 0 Retries: 0' MSG9 TEXT 'To Cancel, Press FCTN-4.' MSG10 TEXT 'Bullwinkles Corner transfers by ' TEXT 'COM-LINK enterprises - Copyright' TEXT '(C)1986 Mike Riccio. All Rights' TEXT 'Reserved. Version 1.0 11/28/86' WAIMSG TEXT 'Waiting for Ready Signal...' CRCREQ TEXT 'CRC Requested.' CHKREQ TEXT 'Checksum Requested.' DIRHDR TEXT 'Sending Directory Info.' SENM1 TEXT 'Sending File.' NOWCHK TEXT 'Switching to Checksum...' REQCRC TEXT 'Requesting CRC...' REQCHK TEXT 'Requesting Checksum...' NOTDIR TEXT 'Not a TI File Header.' AWAMSG TEXT 'Receiving File.' EVEN * * GPLLNK ROUTINE - XBASIC GPLLNK * GPLLNK DATA GLNKWS,GPLENT ENTRY VECTOR RTNAD DATA XMLRTN ADDR WHERE GPL RETURNS TO US GXMLAD DATA >176C GROM ADDR OF GPL XML OPCODE DATA >0050 PUTSTK ADDRESS LOCATION GLNKWS EQU $->18 WORKSPACE BSS >08 (ONLY R7-R15 ARE USED) GPLENT MOV *R11,@GR4 STORE PUTSTK ADDR IN R4 OF GPLWS MOV *R14+,@GR6 PUT GPL ROUTINE ADDR IN R6 MOV @XTAB27,R12 SAVE THE VALUE AT >200E MOV R9,@XTAB27 PUT RETURN ADDR IN >200E LWPI GPLWS USE GPL REGISTERS BL *R4 SAVE GROM ADDR ON STACK MOV @GXMLAD,@>8302(R4) PUSH XML ADDR ON STACK INCT @SUBSTK ADJUST STACK POINTER B @LDGADD EXECUTE GPL ROUTINE XMLRTN MOV @GETSTK,R4 GET GETSTK POINTER BL *R4 RESTORE OLD GROM ADDR LWPI GLNKWS USE OUR REGISTERS MOV R12,@XTAB27 RESTORE VALUE AT >200E RTWP RETURN TO CALLER * * DSRLNK ROUTINE - XBASIC DSRLNK * DSRLNK DATA DSRWS,DSRENT ENTRY VECTOR DSRWS EQU $ START OF DSRLNK WORKSPACE DR3LB EQU $+7 DSRWS R3 LOW BYTE DSRENT MOV R12,R12 DID WE LOOK UP LINK ADDR? JNE DLINK3 YES, SKIP LOOK UP ROUTINE LWPI GPLWS NO, USE GPL REGISTERS MOV @PUTSTK,R4 GET ADDRESS OF PUTSTK BL *R4 STORE GROM ADDR ON STACK LI R4,>0011 ADDR OF LINK ROUTINE VECTOR MOVB R4,@>0402(R13) SET UP GROM ADDR JMP DLINK2 JUMP AROUND R12-R15 DATA 0 R12, CONTAINS >2000 FLAG DATA 0,0,0 R13-R15, CONTEXT SWITCH DLINK2 MOVB @GR4LB,@>0402(R13) FINISH SETTING GROM ADDR MOV @GETSTK,R5 SET UP GETSTK POINTER MOVB *R13,@DSRAD1 GET GPL DSRLNK VECTOR INCT @DSRADD ADJUST TO PASS GPL FETCH BL *R5 RESTORE GROM ADDRESS LWPI DSRWS RELOAD DSRLNK WORKSPACE LI R12,>2000 SET FLAG THAT ADDR IS SET DLINK3 INC R14 SET R14 TO POINT TO TYPE BYTE MOVB *R14+,@TYPE STORE IT FOR GPL DSRLNK MOV @SCNAME,R3 SAVE VDP ADDR OF NAME LENGTH AI R3,-8 ADJUST TO POINT TO FLAG BYTE BLWP @GPLLNK EXECUTE GPL DSRLNK DSRADD BYTE >03 HIGH BYTE OF GPL VECTOR ADDR DSRAD1 BYTE >00 LOW BYTE OF GPL VECTOR ADDR MOVB @DR3LB,@VDPWA SET UP VDP ADDR LSB MOVB R3,@VDPWA SET UP VDP ADDR MSB SZCB R12,R15 CLEAR EQ BIT FOR ERROR REPORT MOVB @VDPRD,R3 GET PAB ERROR FLAG SRL R3,5 ADJUST IT TO 0-7 ERROR CODE MOVB R3,*R13 PUT IT INTO CALLER'S R0 MSB JNE SETEQ NOT ZERO, SET EQ BIT COC @ST,R12 TEST COND BIT FOR LINK ERROR JNE DSREND NO ERROR, RETURN TO CALLER SETEQ SOCB R12,R15 ERROR, SET CALLER'S EQ BIT DSREND RTWP RETURN TO CALLER * * VMBWS ROUTINE - WRITES CHARATERS TO VDP WITH * BASIC BIAS OF >60 * * USES SAME PARAMETERS AS VMBW ROUTINE * VMBWS DATA UTILWS,VMBWSE VMBWSE MOV *R13,R0 GET VDP ADDR MOV @2(R13),R2 GET CPU ADDR MOV @4(R13),R3 GET NUMBER OF BYTES BL @SETVDP SET VDP ADDRESS VMBWSR MOVB *R2+,R1 GET NEXT BYTE AI R1,>6000 ADD BIAS >60 MOVB R1,@VDPWD WRITE OUT THE BYTE DEC R3 ANY BYTES LEFT? JNE VMBWSR YES, DO THEM RTWP NO, RETURN TO CALLER * * SETVDP ROUTINE - SETS VDP WRITE ADDRESS * * R0- VDP ADDRESS * SETVDP ORI R0,>4000 SET VDP WRITE BIT SWPB R0 VDP LIKES TO BE BACKWARDS MOVB R0,@VDPWA LOW BYTE GOES FIRST SWPB R0 PUT HIGH BYTE BACK MOVB R0,@VDPWA HIGH BYTE GOES NEXT NOP WASTE TIME RT RETURN TO CALLER * * FILL ROUTINE - FILLS VDP ADDRESSES WITH A BYTE * * R0- START VDP ADDRESS * R1- BYTE TO FILL WITH * R2- NUMBER OF BYTES TO FILL * FILL MOV R11,R10 SAVE RETURN ADDRESS BL @SETVDP SET VDP ADDRESS FILLLP MOVB R1,@VDPWD WRITE A BYTE DEC R2 ARE WE DONE YET? JNE FILLLP NO, WRITE ANOTHER B *R10 YES, RETURN TO CALLER * * STLINE ROUTINE - UPDATES STATUS LINE WITH REC/SEC/RTY * STLINE MOV R11,R10 SAVE RETURN ADDRESS LI R0,451 ADDRESS FOR SECTOR NUMBER MOV @SEC#,R2 SECTOR NUMBER MOV @REC#,R3 IS RECORD NUMBER ZERO? JEQ STLIN1 YES, SKIP THIS INC R2 ADJUST SECTOR NUMBER STLIN1 BL @STRING DISPLAY IT LI R0,465 ADDRESS FOR RECORD NUMBER MOV @REC#,R2 RECORD NUMBER BL @STRING DISPLAY IT LI R0,479 ADDRESS FOR RETRIES MOV @RETRY,R2 RETRIES BL @STRING DISPLAY IT B *R10 RETURN TO CALLER STRING CLR R1 CLEAR HIGH WORD FOR DIV DIV @TEN,R1 DIVIDE NUMBER BY 10 MOV R1,R3 SAVE QUOTIENT MOV R2,R1 POSITION REMAINDER SWPB R1 MAKE IT THE MSB AI R1,>9000 MAKE ASCII WITH XBASIC OFFSET BLWP @VSBW WRITE IT TO SCREEN DEC R0 POINT TO NEXT DIGIT ADDR MOV R3,R2 RESTORE QUOTIENT JNE STRING IF NOT ZERO, CONTINUE RT RETURN TO CALLER * * PROTCL ROUTINE - DISPLAYS CURRENT PROTOCOL CRC/CHECKSUM * PROTCL LI R0,320 VDP ADDRESS FOR TEXT LI R1,MSG6 ASSUME CRC LI R2,8 LENGTH OF TEXT MOV R6,R6 CRC? JNE PROTC1 YES, SKIP THIS A R2,R1 NO, ADDRESS OF TEXT PROTC1 BLWP @VMBWS DISPLAY PROTOCOL RT RETURN TO CALLER * * GETNUM ROUTINE - GETS A NUMBER FROM XBASIC LINK * * R1- PARAMETER NUMBER * FAC- NUMBER OBTAINED * GETNUM CLR R0 NOT AN ARRAY BLWP @NUMREF GET THE NUMBER BLWP @XMLLNK CONVERT TO INTEGER DATA CFI RT RETURN TO CALLER * * DISP ROUTINE - DISPLAYS STRING IN STATUS WINDOW * * R3- ADDRESS OF TEXT * R4- LENGTH OF TEXT * DISP MOV R11,R12 SAVE RETURN ADDRESS LI R0,291 START OF WINDOW LI R1,SCRLBF SCROLL BUFFER LI R2,28 LENGTH OF BUFFER BLWP @VMBR READ IN TOP LINE LI R0,331 BOTTOM LINE ADDRESS BLWP @VMBW WRITE IT ON BOTTOM LINE LI R0,291 START OF WINDOW LI R1,>8000 SPACE BL @FILL BLANK OUT TOP LINE LI R0,291 START OF WINDOW MOV R3,R1 ADDRESS OF TEXT MOV R4,R2 LENGTH OF TEXT BLWP @VMBWS WRITE IT TO WINDOW B *R12 RETURN TO CALLER * * CALL LINK("XMODEM",drive,filename,flag1,flag2) * * PERFORM AN XMODEM FILE TRANSFER. * * drive- DRIVE NUMBER * filename- FILENAME TO TRANSFER * flag1- NUMERIC VARIABLE ONLY * GIVEN: 0- SEND FILE * 1- RECEIVE FILE * RETURN: 0- NO ERROR * 1- BAD FILENAME FOR SEND * 2- BAD FILENAME FOR RECEIVE * 3- TOO MANY RETRIES * 4- OTHER SYSTEM CANCELLED * 5- FCTN-4 PRESSED (CANCEL) * 6- CARRIER LOSS * flag2- 0- CRC ERROR CHECKING * 1- CHECKSUM ERROR CHECKING * XMODEM LWPI MYREG USE MY REGISTERS LIMI 0 DISABLE INTERRUPTS * GET PARAMETERS AND SET UP SCREEN DISPLAY LI R0,PAD SCRATCHPAD RAM LI R1,SAVPAD SAVE BUFFER LI R2,10 NUMBER OF BYTES TO SAVE SLOOP1 MOVB *R0+,*R1+ SAVE A BYTE DEC R2 ANY MORE BYTES TO SAVE? JNE SLOOP1 YES, SAVE THEM LI R0,SECTOR NO, VDP SECTOR BUFFER LI R1,SECBUF SAVE BUFFER LI R2,256 NUMBER OF BYTES TO SAVE BLWP @VMBR SAVE BUFFER CONTENTS MOV @INTADD,@INTSAV SAVE OLD INTERRUPT LI R0,JIFFY ADDRESS OF NEW INTERRPUT MOV R0,@INTADD INSTALL INTERRUPT LI R5,SENDS1 INSTALL ROUTINE VECTOR LI R1,1 FIRST ARGUMENT BL @GETNUM GET drive MOV @FAC,R14 RETRIEVE drive SLA R14,8 PUT IT IN MSB MOV R14,R2 COPY IT AI R2,>3000 MAKE IT AN ASCII NUMBER MOVB R2,@MSG4D PUT IT IN TEXT INC R1 SECOND ARGUMENT LI R2,XMDLEN FILENAME BUFFER MOVB @H0A,*R2+ SET MAXIMUM LENGTH LI R3,>2000 SPACE CHARACTER LI R4,10 NUMBER OF BYTES TO BLANK XMDL1 MOVB R3,*R2+ BLANK A BYTE DEC R4 ANY MORE BYTES? JNE XMDL1 YES, BLANK THEM LI R2,XMDLEN NO, BUFFER ADDRESS BLWP @STRREF GET filename INC R1 THIRD ARGUMENT BL @GETNUM GET flag1 LI R0,>01F0 ******** BLWP @VWTR added to SWPB R0 change to MOVB R0,@>83D4 40 col LI R0,>07F1 BLWP @VWTR ******** LI R0,160 START SCREEN ADDRESS LI R1,>8000 SPACE CHARACTER LI R2,800 LENGTH OF SCREEN BL @FILL BLANK SCREEN LI R0,923 VDP ADDR FOR TEXT LI R1,MSG1 ADDRESS OF TEXT LI R2,34 LENGTH OF TEXT BLWP @VMBWS "XMODEM File Transfers in Progress." LI R0,200 VDP ADDR FOR TEXT A R2,R1 ADDRESS OF TEXT LI R2,7 LENGTH OF TEXT MOV @FAC,R13 RETRIEVE flag1 JEQ XMR1 SENDING, SKIP THIS LI R13,1 RECEIVING, SET flag1 TO 1 A R2,R1 ADDRESS OF TEXT INCT R2 LENGTH OF TEXT XMR1 BLWP @VMBWS "Sending" OR "Receiving" A R2,R0 VDP ADDRESS FOR TEXT INC R0 ADJUST ADDRESS LI R1,MSG4 ADDRESS OF TEXT LI R2,5 LENGTH OF TEXT BLWP @VMBWS "DSKx." A R2,R0 VDP ADDRESS FOR TEXT LI R1,XMDLEN ADDRESS OF TEXT MOVB *R1+,R2 GET LENGTH OF TEXT SRL R2,8 MAKE IT A NUMBER JNE XMR4 LENGTH IS OK, SKIP THIS LI R0,1 ZERO LENGTH, SET ERROR CODE A R13,R0 ADD IN flag1 B @ABORT ISSUE ERROR XMR4 BLWP @VMBWS DISPLAY filename LI R1,4 FOURTH ARGUMENT BL @GETNUM GET flag2 SETO R6 ASSUME CRC MOV @FAC,R0 CRC? JEQ XMRA YES, SKIP THIS CLR R6 NO, SET CHECKSUM FLAG XMRA LI R0,280 VDP ADDRESS FOR TEXT LI R1,MSG5 ADDRESS OF TEXT LI R2,9 LENGTH OF TEXT BLWP @VMBWS "Protocol:" LI R0,440 VDP ADDRESS FOR TEXT LI R1,MSG8 ADDRESS OF TEXT LI R2,40 LENGTH OF TEXT BLWP @VMBWS "Sector: 0 Record: 0 Retries: 0" LI R0,568 VDP ADDRESS FOR TEXT LI R1,MSG9 ADDRESS OF TEXT LI R2,24 LENGTH OF TEXT BLWP @VMBWS "To Cancel, Press FCTN-4.' LI R0,644 VDP ADDRESS FOR TEXT LI R1,MSG10 ADDRESS OF TEXT LI R2,32 LENGTH OF TEXT LI R3,4 NUMBER OF LINES XMR3 BLWP @VMBWS DISPLAY A LINE AI R0,40 MOVE TO NEXT LINE A R2,R1 MOVE TO NEXT TEXT LINE DEC R3 ANY MORE LINES? JNE XMR3 YES, DISPLAY THEM * INITIALIZE RS232 PORT * LI R12,>1300 NO, SET CRU BASE TO RS232 * SBO 0 TURN ON RS232 CARD * LI R12,>1340 OFFSET INTO RS232/1 * SBO 31 SELECT RESET OF 9902 * LI R10,>10 DELAY COUNTER * XMR5 DEC R10 HAVE WE WAITED LONG ENOUGH? * JNE XMR5 NO, WAIT SOME MORE * SBZ 13 YES, LOAD CONTROLS * LI R1,>8300 DATA FOR N,8,1 * LDCR R1,8 LOAD IT TO 9902 * LI R1,>04D0 DATA FOR 300 BAUD * LDCR R1,12 LOAD IT TO RS232 * LI R12,>1300 OFFSET TO RS232 CARD * SBZ 0 TURN OFF RS232 CARD * SET UP BLOCKS FOR DSR DIRECT FILE ACCESS MOV R14,@FAC+2 DRIVE NUMBER CLR @FAC+6 FILE INFORMATION LI R0,FNAME FILENAME LI R1,XMDNAM PAB ADDRESS LI R2,10 LENGTH OF FILENAME BLWP @VMBW WRITE IT TO BUFFER MOVB @XMDLEN,R0 GET LENGTH OF FILENAME AI R0,>0500 ADJUST FOR DSKx. MOVB R0,@LEN1 SAVE IT FOR PAB AI R14,'0.' ADJUST DRIVE NUMBER MOVB R14,@DRIVE# SAVE IT FOR PAB SWPB R14 GET AT THE LSB MOVB R14,@DRIVE#+1 SAVE IT ALSO MOV @FAC+2,R14 RESTORE DRIVE NUMBER MOV R13,R1 GET flag1 JEQ SF SENDING, SKIP THIS B @RF RECEIVING, SKIP THIS * * SEND FILE * * GET HEADER SF BL @FILE2 GET FILE INFO DATA >0114 SUBROUTINE NAME CLR R0 CLEAR TEMP MOVB @FAC+6,R0 ERROR? JEQ XSJ1 NO, SKIP THIS LI R0,1 BAD FILENAME FOR SEND B @ABORT ISSUE ERROR XSJ1 INC R14 SET TO READ ONE SECTOR LI R0,RECORD START OF RECORD BUFFER LI R1,>CA53 FILLER DATA XSL1 MOV R1,*R0+ BLANK THIS WORD CI R0,RECORD+128 DONE YET? JLT XSL1 NO, CONTINUE LI R0,HEDDAT YES, TI HEADER DATA LI R1,RECORD RECORD BUFFER LI R2,4 NUMBER OF WORDS TO MOVE MOV R2,R3 COPY IT XSL1A MOV *R0+,*R1+ MOVE A WORD DEC R3 DONE YET? JNE XSL1A NO, CONTINUE LI R0,ADDINF+2 YES, ADDRESS OF FILE INFO XSL1B MOV *R0+,*R1+ MOVE A WORD DEC R2 DONE YET? JNE XSL1B NO, CONTINUE LI R3,WAIMSG ADDRESS OF TEXT LI R4,27 LENGTH OF TEXT BL @DISP DISPLAY IT MOV @SEC#,R9 GET LENGTH OF FILE LI R0,231 VDP ADDRESS FOR LENGTH MOV R9,R2 LENGTH OF FILE INC R2 ADJUST IT BL @STRING DISPLAY IT * WAIT FOR READY SIGNAL XSL2A CLR @RETRY CLEAR NUMBER OF RETRIES CLR @REC# CLEAR RECORD NUMBER CLR @SEC# CLEAR SECTOR NUMBER XSL2B MOV @SEC#12,@TIMER RESET TIMER BL @STLINE UPDATE STATUS LINE XSL2C BL @GETS1 GET A CHARACTER ANDI R1,>7F00 STRIP OFF MSBIT CB R1,@NAK CHECKSUM REQUESTED? JEQ XSNAK YES, SKIP THIS CB R1,@CRC NO, CRC REQUESTED? JEQ XSCRC YES, SKIP THIS CB R1,@CAN NO, CANCEL? JEQ XSCAN YES, SKIP THIS MOV @TIMER,R0 NO, TIMED OUT YET? JNE XSL2C NO, WAIT SOME MORE INC @RETRY YES, INCREMENT # OF RETRIES C @RETRY,@NINE TOO MANY RETRIES? JLT XSL2B NO, WAIT SOME MORE LI R0,3 YES, TOO MANY RETRIES B @ABORT ISSUE ERROR XSCAN LI R0,4 OTHER SYSTEM CANCELLED B @ABORT ISSUE ERROR XSCRC SETO R6 SET CRC FLAG LI R3,CRCREQ ADDRESS OF TEXT LI R4,14 LENGTH OF TEXT JMP XMR6 SKIP THIS XSNAK CLR R6 CLEAR CRC FLAG LI R3,CHKREQ ADDRESS OF TEXT LI R4,19 LENGTH OF TEXT XMR6 BL @DISP DISPLAY TEXT BL @PROTCL DISPLAY PROTOCOL * SEND TI HEADER IF NOT DIS/FIX 128 FILE LI R0,238 VDP ADDRESS FOR TEXT LI R1,MSG3 ADDRESS OF TEXT LI R2,2 LENGTH OF TEXT BLWP @VMBWS DISPLAY TEXT "TI" MOV @>8304,R0 GET STATUS FLAGS ANDI R0,>EFFF MASK OUT PROTECT BIT DECT R0 2 RECORDS PER SECTOR? JNE XSJ3 NO, NOT DIS/FIX 128, SKIP THIS MOVB @>8307,R0 YES, GET RECORD LENGTH CI R0,>8000 IS IT 128? JEQ XMR7 YES, DIS/FIX 128, SKIP THIS XSJ3 LI R3,DIRHDR NO, ADDRESS OF TEXT LI R4,23 LENGTH OF TEXT BL @DISP DISPLAY IT BL @SENDR SEND TI HEADER JMP XMR8 SKIP THIS XMR7 LI R0,234 VDP ADDRESS FOR TEXT LI R1,MSG2 ADDRESS OF TEXT LI R2,3 LENGTH OF TEXT BLWP @VMBWS DISPLAY TEXT "Not" XMR8 LI R3,SENM1 ADDRESS OF TEXT LI R4,13 LENGTH OF TEXT BL @DISP DISPLAY IT * SEND SECTORS XSL3 BL @FILE2 READ IN ONE SECTOR DATA >0114 NAME OF SUBROUTINE LI R0,SECTOR SECTOR BUFFER LI R1,RECORD RECORD BUFFER LI R2,128 LENGTH OF RECORD BLWP @VMBR READ IN RECORD BL @SENDR SEND RECORD LI R0,SECTOR+128 SECOND HALF OF SECTOR LI R1,RECORD RECORD BUFFER LI R2,128 LENGTH OF RECORD BLWP @VMBR READ IN RECORD BL @SENDR SEND RECORD INC @SEC# NEXT SECTOR DEC R9 ANY MORE SECTORS? JNE XSL3 YES, CONTINUE * SEND EOT TO END TRANSFER XSL4 MOVB @EOT,R0 YES, EOT CHARACTER BL *R5 SEND IT BL @GETACK GET RESPONSE MOV R0,R0 DID WE GET IT? JNE XSL4 NO, WAIT SOME MORE B @STOPP YES, END TRANSFER * SENDR ROUTINE: SEND ONE RECORD SENDR MOV R11,R15 SAVE RETURN ADDRESS CLR @RETRY CLEAR NUMBER OF RETRIES INC @REC# NEXT RECORD NUMBER SENDR1 BL @STLINE UPDATE STATUS LINE MOVB @SOH,R0 SOH CHARACTER BL *R5 SEND IT MOVB @REC#+1,R0 GET LSB RECORD NUMBER BL *R5 SEND IT INV R0 INVERT IT BL *R5 SEND IT CLR R7 CLEAR CHECKSUM CLR R8 CLEAR CRC LI R3,RECORD START OF RECORD BUFFER SENDR2 MOVB *R3+,R0 GET A BYTE BL *R5 SEND IT BL @CRCUPD UPDATE CRC AND CHECKSUM CI R3,RECORD+128 END OF RECORD? JLT SENDR2 NO, SEND NEXT BYTE MOVB R7,R0 YES, GET CHECKSUM VALUE MOV R6,R6 CRC ERROR CHECKING? JEQ SENDR3 NO, SKIP THIS MOV R8,R0 GET CRC VALUE BL *R5 SEND MSB SWPB R0 GET LSB SENDR3 BL *R5 SEND LSB CRC (OR CHECKSUM) BL @GETACK GET RESPONSE MOV R0,R0 DID WE GET IT? JNE SENDR1 NO, RESEND RECORD B *R15 YES, RETURN TO CALLER * ROUTINE TO GET RESPONSE (ACK/NAK/CAN) GETACK MOV R11,R13 SAVE RETURN ADDRESS MOV @SEC#12,@TIMER SET TIMER GETA1 BL @GETS1 GET A CHARACTER ANDI R1,>7F00 STRIP OFF MSBIT CB R1,@CAN CANCEL? JEQ GABORT YES, SKIP THIS CB R1,@ACK NO, ACKNOWLEDGE? JNE GETA2 NO, SKIP THIS CLR R0 YES, CLEAR FLAG B *R13 RETURN TO CALLER GETA2 CB R1,@NAK NO ACKNOWLDGE? JEQ TRYAGA YES, SKIP THIS CB R1,@CRC NO, CRC? JEQ TRYAGA YES, SKIP THIS MOV @TIMER,R0 NO, TIMER ELAPSED? JNE GETA1 NO, WAIT SOME MORE TRYAGA INC @RETRY YES, INCREMENT RETRIES LI R0,3 TOO MANY RETRIES C @RETRY,@NINE TOO MANY RETRIES? JGT GAB2 YES, ISSUE ERROR SETO R0 NO, SET FLAG B *R13 RETURN TO CALLER GABORT LI R0,4 OTHER SYSTEM CANCELLED GAB2 B @ABORT ISSUE ERROR * SEND CHARACTER ROUTINE SENDS1 LI R12,>1300 SET CRU BASE TO RS232 SBO 0 TURN ON RS232 CARD LI R12,>1340 OFFSET INTO RS232/1 SBO 16 REQUEST TO SEND CHARACTER SENDS2 TB 22 IS BUFFER READY? JEQ SENDS3 YES, SKIP THIS TB 28 NO, CARRIER LOSS? JEQ SENDS2 NO, WAIT SOME MORE LI R12,>1300 YES, OFFSET OUT TO RS232 SBZ 0 TURN OFF RS232 CARD LI R0,6 CARRIER LOSS B @ABORT ISSUE ERROR SENDS3 LDCR R0,8 LOAD CHARACTER TO RS232 SBZ 16 SEND IT LI R12,>1300 OFFSET OUT TO RS232 SBZ 0 TURN OFF RS232 CARD RT RETURN TO CALLER * * RECEIVE A FILE *RF BL @PROTCL DISPLAY PROTOCOL MOVB @CRC,@ACKFLG ASSUME CRC LI R3,REQCRC ADDRESS OF TEXT LI R4,17 LENGTH OF TEXT MOV R6,R6 CRC? JNE CRC#J1 YES, SKIP THIS MOVB @NAK,@ACKFLG NO, SET FOR CHECKSUM LI R3,REQCHK ADDRESS OF TEXT LI R4,22 LENGTH OF TEXT CRC#J1 BL @DISP DISPLAY IT SETO @FIRST1 SET FIRST RECORD FLAG CLR @RETRY CLEAR RETRIES CLR @REC# CLEAR RECORD NUMBER INC @REC# SET RECORD NUMBER TO ONE CLR @SEC# CLEAR SECTOR NUMBER* LOOP TO GET RECORDS* SEND ACK/NAK FOR LAST RECORDRDLOOP BL @STLINE UPDATE STATUS LINE CLR R0 CLEAR TEMP MOVB @ACKFLG,R0 GET RESPONSE BL *R5 SEND ITSOH1 MOV @SEC#10,@TIMER SET TIMER SOH2 BL @GETS1 GET RESPONSE MOV @TIMER,R0 TIMED OUT? JEQ SOH3 YES, SKIP THIS ANDI R1,>7F00 NO, STRIP OFF MSBIT JEQ SOH2 ZERO, WAIT SOME MORE CB R1,@SOH SOH? JEQ GOTSOH YES, SKIP THIS CB R1,@EOT NO, EOT? JNE SOH2 NO, WAIT SOME MORE B @RCLOSE YES, CLOSE FILESOH3 B @RECRTY RETRY THE RECORDGET1 MOV R11,R15 SAVE RETURN ADDRESS MOV @SEC#10,@TIMER SET TIMER BL @GETS1 GET CHARACTER MOV @TIMER,R0 TIMED OUT? JNE GET#2 NO, SKIP THIS JMP SOH3 YES, RETRY THE RECORD GET#2 B *R15 RETURN TO CALLERGOTSOH BL @GET1 GET A CHARACTER CLR R3 CLEAR TEMP MOVB R1,R3 COPY CHARACTER CB R1,@REC#+1 CORRECT RECORD NUMBER? JEQ GOTSO1 YES, SKIP THIS MOV @FIRST1,R0 NO, FIRST RECORD? JNE SOH3 YES, RETRY THE RECORDGOTS#2 AI R1,->0100 NO, DECREMENT RECORD NUMBER CB R1,@REC#+1 DID THEY MISS OUR ACK? JNE SOH3 NO, RETRY RECORDGOTSO1 MOVB R1,@TEMPR# SAVE RECORD NUMBER BL @GET1 GET A CHARACTER AB R1,R3 ADD IT TO RECORD NUMBER AI R3,>0100 INCREMENT IT JNE SOH3 BAD HEADER, RETRY RECORD LI R3,RECORD START OF RECORD BUFFER CLR R7 CLEAR CHECKSUM CLR R8 CLEAR CRC RCHR1 BL @GET1 GET A CHARACTER MOVB R1,*R3+ PUT IT IN BUFFER MOVB R1,R0 COPY CHARACTER BL @CRCUPD UPDATE CHECKSUM AND CRC CI R3,RECORD+128 END OF RECORD? JLT RCHR1 NO, CONTINUE* GET CRC/CHECKSUM BL @GET1 YES, GET A CHARACTER MOV R6,R6 CRC? JEQ GOTCHK NO, SKIP THIS MOVB R1,R0 YES, COPY CHARACTER BL @CRCUPD UPDATE CRC BL @GET1 GET CHARACTER MOVB R1,R0 COPY IT BL @CRCUPD UPDATE CRC MOV R8,R8 CRC OK? JNE SOH3 NO, RETRY RECORD JMP RECOK YES, SKIP THIS GOTCHK CB R1,R7 CHECKSUM OK? JNE SOH3 NO, RETRY RECORD RECOK MOVB @ACK,@ACKFLG YES, SET ACK FLAG CLR @RETRY CLEAR NUMBER OF RETRIES* SEND IT TO DISK MOV @FIRST1,R0 FIRST RECORD? JEQ RECWRT NO, SKIP THIS LI R3,AWAMSG YES, ADDRESS OF TEXT LI R4,15 LENGTH OF TEXT BL @DISP DISPLAY IT LI R0,238 VDP ADDRESS FOR TEXT LI R1,MSG3 ADDRESS OF TEXT LI R2,2 LENGTH OF TEXT BLWP @VMBWS DISPLAY TEXT "TI"* OPEN THE FILE CLR @REC# CLEAR RECORD NUMBER CLR @FIRST1 RESET FIRST RECORD FLAG CLR @XMDPAB+2 CLEAR OUT PAB LI R0,RECORD START OF RECORD BUFFER LI R1,HEDDAT START OF TI HEADER LI R2,4 NUMBER OF WORDS TO COMPARE MOV R2,R3 COPY IT OPNL1 C *R0+,*R1+ IS IT A TI HEADER? JNE DF128 NO, SKIP THIS DEC R2 YES SO FAR, ANY MORE WORDS? JNE OPNL1 YES, CONTINUE LI R1,>8302 NO, INFORMATION BLOCK OPNL2 MOV *R0+,*R1+ COPY FILE INFO DEC R3 DONE YET? JNE OPNL2 NO, CONTINUE* TI FILE (HOPEFULLY!) BL @FILE2 YES, OPEN THE FILE DATA >0115 SUBROUTINE NAME CLR @SEC# CLEAR SECTOR NUMBER INC R14 SET TO WRITE ONE SECTOR CLR R0 CLEAR TEMP MOVB @FAC+6,R0 ERROR? JEQ

go back up to the top

the onhook/offhook routines - connections and disconnections

The onhook/offhook routines were written by Alex Bayti. The electronics to respond to / control the software was built by Bill Blew.

DEF ONHOOK,OFHOOK * DEF TERM3,TERM12 CASS1 DATA >002C * CASS2 DATA >002E STRR12 DATA 0 ONHOOK MOV R12,@STRR12 MOV @CASS1,R12 SBZ >00 MOV @STRR12,R12 B @>0070 OFHOOK MOV R12,@STRR12 MOV @CASS1,R12 SBO >00 MOV @STRR12,R12 B @>0070 * TERM3 MOV R12,@STRR12 * MOV @CASS2,R12 * SBZ >00 * MOV @STRR12,R12 * B @>0070 * TERM12 MOV R12,@STRR12 * MOV @CASS2,R12 * SBO >00 * MOV @STRR12,R12 * B @>0070 * END

go back up to the top

the clock routines

The clock routines were written by James S. McCulloch for MBP, makers of the clock card used on the BBS.

******************************************************************************** * A RELOCATABLE ASSEMBLY LANGUAGE ROUTINE USING THE MBP CLOCK/ADC CARD * * TO PLACE TIME AND DATE ON SCREEN WHILE IN ANY GPL ENVIRONMENT (EXTENDED * * BASIC OR TI BASIC WITH E/A OR MINIMEM INSTALLED). ALTHOUGH INSPIRED BY A * * PROGRAM ON THE WICHITA TIBBS (316-681-3167), THIS IS BASICALLY A SLIGHTLY * * MODIFIED VERSION OF "TIMCLK.ASM" IN DL3. THIS VERSION DONE 12 FEBRUARY 1985. * * * * AFTER CALL LOAD(ing) THE OBJECT FILE GENERATED FROM ASSEMBLING THIS SOURCE * * CODE, YOU CAN START THE CLOCK AND DATE DISPLAY BY DOING A CALL LINK("STARTT")* * AND STOP IT BY DOING A CALL LINK("STOP"). * * * *James S. McCulloch * ******************************************************************************** DEF STARTT,STOP DEFINES LABELS TO BE PLACED IN REF/DEF TABLE STATUS EQU >837C GPL STATUS REGISTER VDPWA EQU >8C02 VDP WRITE ADDRESS REGISTER-SELECTS PLACE TO * WRITE DATA ON SCREEN. FIRST 2 BITS MUST BE 01. VDPWD EQU >8C00 VDP WRITE DATA REGISTER-DATA PLACED HERE WILL * BE WRITTEN TO SUCCESSIVE BYTES BEGINNING AT * ADDRESS IN VDPWA. LC DATA >003C LOOP COUNTER=60 SL DATA >0017 SCREEN LOCATION=23 MSB01 DATA >4000 WILL BE USED TO SET FIRST 2 BITS TO 01 SEC EQU >8644 LOCATION TO FIND SECONDS FROM MBP CLOCK CARD MIN EQU >8646 " " " MINUTES " " " " HRS EQU >8648 " " " HOURS " " " " DAY EQU >864C " " " DATE " " " " MON EQU >864E " " " MONTH " " " " SAVRTN DATA 0 AREA TO SAVE RETURN ADDRESS IN WS BSS 32 PROGRAM WORKSPACE ************************************************* * WORKSPACE REGISTERS USED IN THIS PROGRAM * * R0=SCREEN LOCATION POINTER * * R1=GENERAL SCRATCHPAD FOR DATA MANIPULATION * * R2=VDP INTERRUPT COUNTER-DECREMENTED 60X/SEC * * R11=RETURN ADDRESS * ************************************************* STARTT MOV R11,@SAVRTN SAVE GPL RETURN ADDRESS LWPI WS SWITCH TO PROGRAMS WORKSPACE MOV @LC,R2 LOAD LOOP COUNTER LI R1,LOOP TAKE ADDRESS OF MAIN PROGRAM SEGMENT AND MOV R1,@>83C4 LOAD IT INTO USER DEFINABLE INTERRUPT SERVICE * ROUTINE. ON EACH VDP INTERRUPT (60/SEC), WILL * BRANCH TO ROUTINE WHOSE ADDRESS IS HERE CLR @STATUS GET READY TO LWPI >83E0 RETURN TO GPL TERRITORY MOV @SAVRTN,R11 AND B *R11 GO ON STOP CLR @>83C4 CLEAR THE ISR HOOK (NO ROUTINE TO BRANCH TO) B *R11 RETURN LOOP MOV R11,@SAVRTN SAVE GPL RETURN ADDRESS LIMI >0000 DISABLE VDP INTERRUPTS FOR POTENTIAL VDP WRITE LWPI WS SWITCH TO THIS PROGRAM'S WORKSPACE DEC R2 HAS ONE SECOND (60 VDP INTERRUPTS) GONE BY? JNE EXIT IF NOT, GO BACK TO GPL MOV @LC,R2 OTHERWISE GO ON, RELOADING LOOP COUNTER MOV @SL,R0 LOAD SCREEN LOCATION POINTER BL @ADDR SET ADDRESS OF FIRST LINE TO DISPLAY MOV @HRS,R1 GET HOURS FROM MBP CARD BL @DIGITS PRINT HOURS BL @COLON PRINT COLON MOV @MIN,R1 GET MINUTES FROM MBP CARD BL @DIGITS PRINT MINUTES BL @COLON PRINT ANOTHER COLON MOV @SEC,R1 GET SECONDS FROM MBP CARD BL @DIGITS PRINT SECONDS AI R0,>0020 INCREMENT DISPLAY ADDRESS TO NEXT LINE DOWN BL @ADDR SET ADDRESS OF VDPWA TO NEXT LINE MOV @MON,R1 GET MONTH FROM MBP CARD BL @DIGITS PRINT MONTH BL @SLASH PRINT SLASH MOV @DAY,R1 GET DATE FROM MBP CARD BL @DIGITS PRINT DATE BL @SLASH PRINT SLASH LI R1,>9200 THIS YEAR=1986 BL @DIGITS PRINT YEAR EXIT LWPI >83E0 RETURN TO GPL TERRITORY MOV @SAVRTN,R11 AND B *R11 GO ON. * SUBROUTINES * ADDR SWPB R0 GET LSB OF R0 MOVB R0,@VDPWA AND LOAD IT INTO VDPWA SWPB R0 RESTORE R0 SOC @MSB01,R0 SET MOST SIGNIFICANT BITS OF R0 TO 01-TELLS VDPWA * TO GET READY TO WRITE DATA. MOVB R0,@VDPWA LOAD THE PREPARED MSB TO VDPWA SZC @MSB01,R0 RESTORE R0 B *R11 RETURN TO CALLING PROGRAM DIGITS SRL R1,4 MOVE R1 OVER 1 NYBBLE AI R1,>9000 ADD APPROPRIATE MASK MOVB R1,@VDPWD WRITE OUT FIRST DIGIT TO SCREEN SLA R1,4 RESTORE R1 ANDI R1,>0F00 NOW WE ONLY WANT THE SECOND DIGIT AI R1,>9000 ADD MASK VALUE MOVB R1,@VDPWD AND PRINT IT TO SCREEN B *R11 RETURN TO CALLING PROGRAM COLON LI R1,>9A00 MASKED COLON MOVB R1,@VDPWD PRINT IT B *R11 AND RETURN TO CALLING PROGRAM SLASH LI R1,>8F00 MASKED SLASH MOVB R1,@VDPWD PRINT IT B *R11 AND RETURN TO CALLING PROGRAM END

go back up to the top

initialization (load the assembly)

The initialization routines were written by S. Clarke

10 CALL INIT :: CALL LOAD(8196,63,248):: CALL LOAD(16376,65,32,32,32,32,32,255,4 8):: CALL LINK("A") 100 REM POWERLOAD(8)12/31/91 110 CALL LINK("SETUP"):: DISPLAY AT(1,1)ERASE ALL:"Bullwinkle's Corner BBS":"Ass embly loaded (ver .O8)":"Loading Logon....":"Please wait..." 120 RUN "DSK1.LOGON" 130 ! ALL ASSEMBLY ASSEMBLED TOGETHER USING THE COPY DIRECTIVE - THEN BURIED WITH ALSAVE 140 !ORDER OF COPY DIRECTIVE (SEE ASSEM/ALL8 FILE)

go back up to the top

Bullwinkle's Corner BBS routines

The remainder of this code (Load, Logon, BoardA, BoardB, BoardC, Manager, Boggle, etc was written in TI Extended Basic with assembly code links (hybrid) for support.

the LOAD code - initialize the BBS

The LOAD code and menu code was written by S. Clarke

10 ! V.JAN 28 1994 LOAD 20 FOR I=0 TO 14 :: CALL COLOR(I,16,5):: NEXT I :: CALL SCREEN(5) 30 BD$(1)="300" :: BD$(2)="1200" :: BD$(3)="4800" :: BD$(4)="9600" 40 CALL CHAR(130,"50A060900906050A") 50 ON ERROR 70 :: OPEN #28:"DSK1.DEFAULTF",INTERNAL,INPUT ,RELATIVE,FIXED 20 :: INPUT #28,REC 1:PRB$ :: INPUT #28,REC 2:CT$ 60 INPUT #28,REC 3:MB$ :: INPUT #28,REC 4:AV$ :: CLOSE #28 70 ON ERROR 370 80 DISPLAY AT(1,4)ERASE ALL:"Bullwinkle's Corner" :: DISPLAY AT(2,3):"Bulletin B oard Program" 90 DISPLAY AT(4,1):RPT$(CHR$(130),28) 100 DISPLAY AT(6,2):"Welcome to Bullwinkle's!" :: DISPLAY AT(7,2):"Please select option:" 110 DISPLAY AT(9,1):RPT$(CHR$(130),28) 120 DISPLAY AT(11,2):"1/Run board" :: DISPLAY AT(12,2):"2/File management" :: DI SPLAY AT(13,2):"3/Stop" :: DISPLAY AT(14,2):"4/Bye" 130 DISPLAY AT(15,2):"5/Printer baud (";PRB$;")":" 6/MODEM baud (";MB$;")":" 7/C heck /3? ";CT$:" 8/Run DM":" 9/Run M-COPIER" 135 DISPLAY AT(20,1):"10/Set clock":"11/Auto-val? ";AV$ 140 DISPLAY AT(23,2):"---->1" :: ACCEPT AT(23,7)SIZE(-2)VALIDATE("1234567890")BE EP:SELECT$ :: SELECT=VAL(SELECT$):: IF SELECT=3 THEN STOP 150 IF SELECT=4 THEN CALL INIT :: CALL LOAD(-31804,0,36) 155 IF SELECT>11 THEN 140 160 ON SELECT GOTO 180,170,160,160,320,365,360,380,390,400,356 170 DISPLAY AT(24,4):"LOADING FILE MANAGER" :: RUN "DSK1.MANAGER" 180 ON ERROR 320 :: OPEN #5:"RS232/2.BA="&PRB$,VARIABLE 132 190 PRINT #5:"BULLWINKLE'S CORNER *** POWER-UP ";:: GOTO 280 200 DISPLAY AT(17,1):"Zero message files? N" :: FLAG2=1 :: ACCEPT AT(17,21)SIZE( -1)VALIDATE("YN"):ZERO$ 210 IF ZERO$="N" THEN 240 220 OPEN #8:"DSK1.MFILE",INTERNAL,RELATIVE,FIXED 84 :: PRINT #8,REC 0:VAL("0");V AL("0"):: CLOSE #8 230 DISPLAY AT(18,1):"Message files zeroed." 240 DISPLAY AT(19,1):"Zero user files? N" :: ACCEPT AT(19,21)SIZE(-1)VALIDATE ("YN"):ZERO$ 250 IF ZERO$="N" THEN 280 260 OPEN #6:"DSK1.UFILE",INTERNAL,RELATIVE,FIXED 126 :: PRINT #6,REC 0:"0","0"," 0","0" :: CLOSE #6 270 DISPLAY AT(20,1)):"User files zeroed." 280 OPEN #6:"DSK1.UFILE",INTERNAL,RELATIVE,FIXED 126 290 INPUT #6,REC 0:AM$,CALLS$,AU$,LF$ :: DISPLAY AT(23,1):"#/users=";AU$,"Calls= ";CALLS$ :: CLOSE #6 300 PRINT #5:"Users=";AU$;" Calls=";CALLS$ 310 RUN "DSK1.POWERLOAD" 320 DISPLAY AT(18,1):"Printer baud:" :: DISPLAY AT(19,2):"1 - 300":" 2 - 1200":" 3 - 4800":" 4 - 9600":" ---->4" 330 ACCEPT AT(23,7)SIZE(-1)VALIDATE("1234"):PRB$ 340 IF PRB$="" THEN 320 ELSE PRB$=BD$(VAL(PRB$)) 350 OPEN #28:"DSK1.DEFAULTF",INTERNAL,RELATIVE,OUTPUT,FIXED 20 :: PRINT #28,REC 1:PRB$ :: PRINT #28,REC 2:CT$ 355 PRINT #28,REC 3:MB$ :: PRINT #28,REC 4:AV$ :: CLOSE #28 :: GOTO 70 356 ACCEPT AT(21,14)SIZE(-1)VALIDATE("YN"):AV$ :: GOTO 350 360 ACCEPT AT(17,14)SIZE(-1)VALIDATE("YN"):CT$ :: GOTO 350 365 DISPLAY AT(18,1):"Modem baud:" :: DISPLAY AT(19,2):"1 - 300":" 2 - 1200":" 3 - 2400": :" ---->3" 366 ACCEPT AT(23,7)SIZE(-1)VALIDATE("123"):MB$ 367 IF MB$="1" THEN MB$="300" ELSE IF MB$="2" THEN MB$="1200" ELSE IF MB$="3" TH EN MB$="2400" ELSE 366 368 GOTO 350 370 CALL ERR(E1,E2,E3,E4):: DISPLAY AT(23,1)BEEP:"ERROR IN LOAD":E1;E2;E3;E4 :: STOP 380 CALL INIT :: CALL LOAD("DSK1.DMXB"):: CALL LINK("GO") 390 DISPLAY AT(24,6):"Loading M-COPIER" :: RUN "DSK1.MCOPY/XB" 400 DISPLAY AT(24,6):"Loading CLOCK" :: RUN "DSK1.CLOCK"

go back up to the top

the LogOn code - wait for incoming call and get user information

The LogOn code was written by S. Clarke

10 ! LOGON Rev 1/1/94 PRACTICAL MODEM 2400SA 300-1200-2400 BAUD 20 CALL ERR(E1,E2,E3,E4):: PRINT E1;E2;E3;E4 30 ! HAYES 300 DIPS D D D D U D U U 40 CALL LINK("CK3",A$):: CALL LINK("SETUP"):: CALL LINK("CK1",A$):: CALL LINK("S ETUP") 50 OPTION BASE 1 60 DIM E$(10),EE$(10) 70 CALL KEY(4,K,S):: CALL LINK("LFYES"):: ER$="" :: MOD1$=CHR$(0):: MOD2$=CHR$(0 ):: MOD3$=CHR$(0) 80 FOR X=1 TO 14 :: CALL COLOR(X,16,5):: NEXT X :: DISPLAY AT(12,10)ERASE ALL:"L OADING" :: CALL SCREEN(5) 90 ON ERROR 3220 :: ER$="DSK1.DEFAULTF" 100 OPEN #28:"DSK1.DEFAULTF",INPUT ,INTERNAL,RELATIVE,FIXED 20 :: INPUT #28,REC 1:PB$ :: INPUT #28,REC 2:B3$ 110 INPUT #28,REC 3:MB$ :: INPUT #28,REC 4:AV$ :: CLOSE #28 120 OPEN #5:"RS232/2.BA="&PB$,VARIABLE 132 130 ER$="DSK1.LASTFILE" 140 OPEN #11:"DSK1.LASTFILE",INTERNAL,INPUT ,VARIABLE 80 150 FOR X=1 TO 10 :: INPUT #11:E$(X):: NEXT X :: CLOSE #11 160 ER$="DSK1.UFILE" 170 OPEN #6:"DSK1.UFILE",INTERNAL,RELATIVE,FIXED 126 :: INPUT #6,REC 0:AM$,CALLS $,AU$,LF$ :: CLOSE #6 180 ER$="VIB on drive" 190 FOR X=1 TO 4 :: SL(X)=.01 :: NEXT X 200 FOR X=1 TO 4 :: OPEN #93:"DSK"&STR$(X)&".",INPUT ,RELATIVE,INTERNAL :: INPUT #93:A$,XX,XX,SL(X):: CLOSE #93 :: NEXT X 210 ER$="ULDL file" 220 OPEN #93:"DSK4.ULDL",INTERNAL,RELATIVE,INPUT ,FIXED 84 :: INPUT #93,REC 0:FC :: CLOSE #93 230 VALID$=AV$&"NNNNNNNNN" 240 CALL TIM(T1$,T2$,T3$) 250 PRINT #5:RPT$("#",100);T3$;" ## WAITING:": : :: ON ERROR 3230 260 IF B3$="Y" THEN OPEN #246:"RS232/3.BA=2400" 270 IF MB$="300" THEN 290 280 OPEN #100:"RS232.BA=2400",UPDATE,VARIABLE 255 :: PRINT #100:"AT&F L3" :: GOT O 300 290 OPEN #100:"RS232.BA=300",UPDATE,VARIABLE 255 :: PRINT #100:"AT" :: X=0 300 PRINT #100:"AT E0 V0 S0=1" 310 CALL LINK("DCDCHK",MOD1$):: PRINT ASC(MOD1$):: IF ASC(MOD1$)=13 OR ASC(MOD1$ )=0 THEN CALL SAY("LINE+O+K"):: GOTO 330 320 X=X+1 :: IF X>10 THEN CALL SAY("CHECK+LINE"):: ER$="Check Line" ELSE 300 330 RESTORE 350 340 FOR X=1 TO 10 :: READ BOOT$(X):: NEXT X 350 DATA FUCK,SHIT,CUNT,DICK,COCK,ASSHOLE,JERKOFF,PRICK,PUSSY,PENIS 360 ON ERROR 3270 :: ER$="DSK1.METER" 370 OPEN #28:"DSK1.METER",INPUT ,INTERNAL,RELATIVE,FIXED 40 :: INPUT #28,REC 0:X ,X,X,MO$ :: CLOSE #28 380 IF POS(MO$,"/",1)=0 THEN 410 390 IF SEG$(T2$,1,POS(T2$,"/",1)-1)=SEG$(MO$,1,POS(MO$,"/",1)-1)THEN MO$="OK" :: GOTO 410 400 MO$="READ" :: CALL SAY("TIME+TO+READ+DEVICE"):: CALL SOUND(200,3000,2) 410 ON ERROR 3280 :: ER$="Misc error" 420 DISPLAY AT(1,3)ERASE ALL:"REDIWARE" :: DISPLAY AT(1,13):"Time:" :: DISPLAY A T(2,3):"SOFTWARE" :: DISPLAY AT(2,13):"Date:" 430 DISPLAY AT(3,1):CHR$(127);" FEB 1986 S.Clarke/B.Blew" 440 DISPLAY AT(5,5):"Bullwinkle's Corner" :: DISPLAY AT(6,2):"Texas Instruments Computer" :: DISPLAY AT(7,4):"Bulletin Board System" 450 DISPLAY AT(9,1):"System operation: Waiting":"System status : ";ASC(MOD1$): "Sys ptr/mod baud: ";PB$;"/";MB$ 460 DISPLAY AT(12,1):"Terminal (/3) ck: ";B3$:"Last reset : ";T1$ 470 DISPLAY AT(14,1):"Number of users : ";AU$;"/";AM$:"Number of calls : ";CALLS $:"Meter status : ";MO$ 480 DISPLAY AT(17,1):"UL/DL rec write : ";STR$(FC);"/200" 490 DISPLAY AT(18,1):"Sec Avl :";STR$(SL(1));" ";STR$(SL(2));" ";STR$(SL(3));" " ;STR$(SL(4)) 500 DISPLAY AT(20,1):"Last:";SEG$(E$(1),1,23) 510 IF SL(2)<60 THEN DISPLAY AT(18,18):" DSK 2 FULL" :: CALL SAY("CLEAR DISKETTE NUMBER 2") 520 ON ERROR 3290 530 X=0 :: DISPLAY AT(24,1):"PROC'D displays option menu" :: ER$="" :: PRINT #10 0:"AT" 540 CALL LINK("DCDCHK",MOD2$):: DISPLAY AT(10,18):ASC(MOD2$):: IF ASC(MOD2$)=13 OR MOD2$="0" THEN CALL SAY("ON+LINE"):: GOTO 560 550 X=X+1 :: IF X>=10 THEN CALL SAY("LINE+OUT+OF+ORDER"):: LOCK=2 :: CALL LINK(" OFHOOK"):: ER$="Line out/order" ELSE 540 560 DISPLAY AT(19,1):"ERR Stat:";ER$;" ";E4 :: BYP=0 :: IF LOCK=1 THEN DISPLAY A T(23,8):"BOARD LOCKED" 570 IF LOCK=2 THEN DISPLAY AT(23,8):"BOARD DOWN" 580 TIMER=130 :: IF LOCK=2 THEN CALL LINK("OFHOOK")ELSE CALL LINK("ONHOOK"):: ! CALL LINK("TERM3") 590 CALL LINK("DCDCHK",B$):: DISPLAY AT(10,18):ASC(B$):: IF B$<>CHR$(128)THEN 59 0 600 FOR X=1 TO 10 :: CALL LINK("CK1",B$):: CALL LINK("DCDCHK",B$):: NEXT X 610 X=0 :: CALL LINK("CK1",B$):: IF ASC(B$)<>128 THEN 720 620 DISPLAY AT(22,4):"standing by for calls" :: TIMER=TIMER+1 :: IF TIMER<130 TH EN 700 630 CALL TIM(T1$,T2$,T3$):: DISPLAY AT(1,21):T1$ :: DISPLAY AT(2,21):T2$ :: TIME R=0 640 IF SEG$(T1$,POS(T1$,":",1)+1,1)=LTIM$ THEN 700 650 FOR X=1 TO 5 :: PRINT #100:"AT" 660 CALL LINK("DCDCHK",MOD3$):: DISPLAY AT(10,18):ASC(MOD3$):: B$=MOD3$ :: IF B$ <>CHR$(128)THEN 690 670 NEXT X 680 X=9 :: GOTO 550 690 LTIM$=SEG$(T1$,POS(T1$,":",1)+1,1) 700 DISPLAY AT(10,19):STR$(ASC(MOD1$));" ";STR$(ASC(MOD2$));" ";STR$(ASC(MOD3$)) 710 IF LOCK=2 THEN CALL SOUND(100,800,5) 720 IF B$=CHR$(140)THEN CALL LINK("OFHOOK"):: GOTO 2800 ELSE IF B$=CHR$(128)THEN 850 730 CALL LINK("INPUT",B$):: ON ERROR 3310 740 A=VAL(B$)+1 :: ON A GOTO 750,760,770,780,790,800,810,820,830,730,840 750 DISPLAY AT(10,19):"OK" :: GOTO 730 760 DISPLAY AT(9,19):"CON-300" :: BDRT$="300" :: GOTO 870 770 DISPLAY AT(10,19):"RING" :: GOTO 730 780 DISPLAY AT(9,19):"NO CARRIER" :: CLOSE #100 :: GOTO 270 790 DISPLAY AT(10,19):"ERROR" :: GOTO 610 800 DISPLAY AT(9,19):"CON-1200" :: BDRT$="1200" :: GOTO 870 810 DISPLAY AT(10,19):"NO DT" :: CLOSE #100 :: GOTO 270 820 DISPLAY AT(10,19):"BUSY" :: CLOSE #100 :: GOTO 270 830 DISPLAY AT(10,19):"NO ANS" :: CLOSE #100 :: GOTO 270 840 DISPLAY AT(9,19):"CON-2400" :: BDRT$="2400" :: GOTO 870 850 DISPLAY AT(22,4):"STANDING BY FOR CALLS" :: IF B3$="N" THEN 610 ELSE CALL LI NK("CK3",Z$):: DISPLAY AT(12,21):ASC(Z$) 860 IF Z$<>CHR$(13)THEN 610 ELSE 2910 870 CALL CK :: CALL LINK("BAUD",BD$):: CALL CK 880 IF BDRT$<>BD$ THEN 870 890 IF BD$="1200" THEN CALL SAY("TWELVE+HUNDRED")ELSE IF BD$="300" THEN CALL SAY ("THREE+HUNDRED") 900 IF BD$="2400" THEN CALL SAY("TWENTY+FOUR+HUNDRED") 910 BD=VAL(BD$):: CALL CLEAR :: CALL SOUND(500,1200,15):: DISPLAY AT(4,1):"FCTN 3=Manual boot!" :: DISPLAY AT(1,25):BD$ 920 IF LOCK=0 THEN 960 930 A$="~~~~ Welcome to BULLWINKLE'S CORNER~~ A Texas Instruments computer bas ed~ bulletin system~" :: CALL LINK("OUTPUT",A$) 940 A$="~Bullwinkles Corner is down for maintainance~We will be back up ASAP~Ple ase try calling back again later~Sorry........." 950 CALL LINK("OUTPUT",A$):: CALL LINK("OFHOOK"):: GOTO 410 960 A$="~Carrier Detected:"&BD$&" baud connect~~~~~" :: CALL OUT(A$):: CALL LINK ("DCDCHK",A$) 970 CALL SAY("COMPUTER CONNECTED"):: FILE$="FILE/T" :: GOSUB 2720 980 OPEN #6:"DSK1.UFILE",UPDATE,RELATIVE,INTERNAL,FIXED 126 990 CALLS$=STR$(VAL(CALLS$)+1):: PRINT #6,REC 0:AM$,CALLS$,AU$,LF$ 1000 CALL TIM(T1$,T2$,T3$):: A$="~~"&T3$&"~You are caller #: "&CALLS$&"~~" :: CA LL OUT(A$) 1010 PRINT #5:T3$;" Caller #";CALLS$;" ";BD$;" BAUD "; 1020 CALL LINK("DCDCHK",A$) 1030 A$="~Enter:NEW or #/PASSWORD--->" :: CALL OUT(A$):: CALL LINK("SECRET",A$): : A1$=A$ :: CALL UP(A1$) 1040 IF SEG$(A1$,1,3)="BP/" THEN A$=SEG$(A$,4,LEN(A$)-3):: BYP=1 1050 PRINT #5:"Ent:#/PASS=";A$;:: IF BYP=1 THEN A1$="~"&RPT$("-",80)&"~" :: CALL OUT(A1$):: PRINT #5:"(BYPASS ACTIVE)";:: A1$=A$ :: CALL UP(A1$) 1060 IF POS(A1$,"NEW",1)>0 THEN USER,LML=0 :: NAM$,ADR$,PASS$,CALL$,PH$,COM$="" :: GOTO 1120 1070 IF POS(A1$,"/",1)=0 THEN A$="~You must type in your user number, a~slash (/ ),and your password. Try again~~" :: CALL OUT(A$):: GOTO 1020 1080 USER$=SEG$(A$,1,POS(A$,"/",1)-1):: CKPS$=SEG$(A$,POS(A$,"/",1)+1,LEN(A$)-1- LEN(USER$)) 1090 CALL CN(USER$,1,VAL(AM$),USER):: IF USER$="-" THEN A$="~User number invalid ~" :: CALL OUT(A$):: GOTO 1020 1100 ON ERROR 3320 1110 GOTO 1730 1120 FILE$="FILE/N" :: GOSUB 2720 1130 A$="~~Welcome to the Rocky and Bullwinkle~show...~(Note: - use ctrl H to ba ckspace)~~~NEW USER/GUEST LOGON:~~" :: CALL OUT(A$) 1140 CALL SAY("NUMBER+ZERO"):: A$="~Enter BYE to exit.~" :: CALL OUT(A$):: ON ER ROR 3400 1150 A$="Name (or handle): " :: CALL OUT(A$):: CALL IN(NAM$):: CALL UP(NAM$) 1160 IF NAM$="BYE" THEN CLOSE #6 :: GOTO 2950 1170 IF NAM$="" THEN 1150 ELSE CALL CBT(NAM$,BOOT$()) 1180 A$="~From: Example-~PHILA,PA" :: CALL OUT(A$) 1190 A$="~From: " :: CALL OUT(A$):: CALL IN(ADR$):: CALL UP(ADR$):: IF ADR$="" T HEN 1180 ELSE CALL CBT(ADR$,BOOT$()) 1200 A$="~Phone #:Example-~XXX-XXX-XXXX~Phone #(voice):" :: CALL OUT(A$):: CALL IN(PH$):: IF LEN(PH$)<>12 THEN 1200 1210 A$="~Computer type: (select)" :: CALL OUT(A$) 1220 A$="~~1 TI99/4A~2 Geneve 9640~3 Commodore~4 Atari~5 IBM~6 IBM compatable~7 Tandy~8 Apple~9 Mac~" :: CALL OUT(A$) 1230 A$="10 Terminal~11 Can't fit into any of the above~~" :: CALL OUT(A$) 1240 A$="~Number: " :: CALL OUT(A$):: CALL IN(A$):: CALL CN(A$,1,11,A):: IF A$=" -" THEN 1210 1250 ON A GOTO 1260,1270,1280,1290,1300,1310,1320,1330,1340,1350,1360 1260 COM$="TI99/4A" :: GOTO 1380 1270 COM$="GENEVE 9640" :: GOTO 1380 1280 COM$="Commodore" :: GOTO 1370 1290 COM$="Atari" :: GOTO 1370 1300 COM$="IBM" :: GOTO 1370 1310 COM$="IBM compat." :: GOTO 1370 1320 COM$="Tandy" :: GOTO 1370 1330 COM$="Apple" :: GOTO 1370 1340 COM$="Mac" :: GOTO 1370 1350 COM$="Terminal" :: GOTO 1380 1360 A$="Input computer type: " :: CALL OUT(A$):: CALL IN(COM$):: GOTO 1380 1370 A$="Input model #(if any-limit 8 chars):" :: CALL OUT(A$):: CALL IN(A$):: I F LEN(A$)>8 THEN 1370 ELSE COM$=COM$&" "&A$ 1380 CALL UP(COM$):: IF COM$="" THEN 1250 ELSE CALL CBT(COM$,BOOT$()) 1390 A$="~You entered:~Name: "&NAM$&"~From: "&ADR$&"~" :: CALL OUT(A$) 1400 A$="Phone #: "&PH$&"~Computer type: "&COM$&"~~" :: CALL OUT(A$) 1410 A$="Correct Y/N " :: CALL OUT(A$):: CALL YN(A$) 1420 IF A$="N" THEN 1130 1430 A$="~~Wait a minute...lemmee stuff it in~the bottle!!...~" :: CALL OUT(A$) 1440 INPUT #6,REC 0:AM$,CALLS$,AU$,LF$ 1450 FOR X=VAL(LF$)TO VAL(AM$) 1460 INPUT #6,REC X:CKNAM$ :: IF CKNAM$="DELETED" THEN 1490 1470 NEXT X 1480 X=VAL(AM$)+1 :: LF$=STR$(X):: AM$=STR$(X) 1490 USER=X :: USER$=STR$(USER) 1500 A$="~Please enter a password~up to seven characters long.~Make it something you will remember!~" :: CALL OUT(A$) 1510 A$="~NOTE! Capital and lower case letters~are DIFFERENT!~" :: CALL OUT(A$ ) 1520 A$="-->" :: CALL OUT(A$):: CALL IN(PASS$) 1530 IF POS(PASS$,"/",1)>0 THEN A$="~Please, no / allowed in your password.~Try again.~~" :: CALL OUT(A$):: GOTO 1520 1540 A$=PASS$ :: CALL UP(A$):: IF POS(A$,"NEW",1)>0 THEN A$="~Sorry, cannot use NEW in your password~try again.~~" :: CALL OUT(A$):: GOTO 1520 1550 IF PASS$="" OR LEN(PASS$)>7 THEN 1500 ELSE CALL CBT(PASS$,BOOT$()):: A$="~Y our User # is "&USER$&"~" :: CALL OUT(A$) 1560 A$="~Please WRITE DOWN your User# and~Password. You will need them to get~b ack on the show and to gain access to~the boards.~~~" 1570 CALL OUT(A$):: CALL ENT 1580 A$=RPT$("~",28)&"To make sure you wrote them correctly...~" :: CALL OUT(A$) 1590 A$="User #: " :: CALL OUT(A$):: CALL IN(USERA$) 1600 A$="~Password: " :: CALL OUT(A$):: CALL IN(CKPS$) 1610 IF USERA$=USER$ AND CKPS$=PASS$ THEN 1630 1620 A$=CHR$(7)&"~~Your User# is "&USER$&"~Your Password is "&PASS$&"~" :: CALL OUT(A$):: GOTO 1560 1630 A$="~Please wait..." :: CALL OUT(A$):: CALL$="1" :: INPUT #6,REC 4:UF$,UF$, UF$,UF$,UF$,UF$,UF$,UF$ 1640 DISPLAY AT(1,1):NAM$;" #";USER;BD$;"baud" 1650 DISPLAY AT(2,1):"ADDRESS:";ADR$ :: GOSUB 2780 1660 IF VAL(CALL$)=1 AND AV$="Y" THEN LF$=STR$(USER):: AU$=STR$(VAL(AU$)+1) 1670 PRINT #6,REC 0:AM$,CALLS$,AU$,LF$ 1680 CALL TIM(T1$,T2$,T3$):: PRINT #5: :T3$;" Caller #";CALLS$;" ";BD$;" baud" :"NEW USER#:"; 1690 PRINT #5:USER;RPT$("NEW USER ",14) 1700 PRINT #5:NAM$;" Address:";ADR$;" Pass=";PASS$; 1710 PRINT #5:" Phone #";PH$;" Computer=";COM$: : :: IF AV$="Y" THEN PRINT #5: "***AUTO VALIDATED***": 1720 A$="~~~" :: CALL OUT(A$):: CLOSE #6 :: GOTO 1870 1730 A$="Hold on...~Checking with Mr.Peabody...~~" :: CALL OUT(A$):: GOSUB 2790 1740 IF CKPS$=PASS$ THEN A$="~Mr. Peabody tells me he knows you~" :: CALL OUT(A$ ):: PRINT #5: :: GOTO 1800 1750 A$="~Sorry, Mr. Peabody says user number and~password don't match.~" :: CAL L OUT(A$):: PRINT #5:"entered wrong password: ";CKPS$ 1760 SH=SH+1 :: IF SH<>9 THEN 1020 1770 A$="Either you have forgotten your password,~or you have not called within 90 days~or you have been DELETED" 1780 CALL OUT(A$):: A$="~because of other reasons. You may call back~and log on as a GUEST or NEW USER.~~" :: CALL OUT(A$) 1790 CLOSE #6 :: FN$,NAM$="the LOST one" :: PRINT #5:"Invalid ticket! ********** *" :: GOTO 2950 1800 A$="~Mr. Peabody is telling Sherman you are~here - please have a seat...." :: CALL OUT(A$):: A=VAL(CALL$):: CALL SAY("NUMBER",,USER$) 1810 A=A+1 :: CALL$=STR$(A):: CALL TIM(T1$,T2$,T3$):: GOSUB 2780 1820 PRINT #5:NAM$;" #";USER; 1830 PRINT #5:" From:";ADR$;" Pass=";PASS$;" Calls=";CALL$;" Last=";DATE$;" Phone #";PH$: 1840 PRINT #5:"Computer=";COM$;" VALIDATION=";VALID$;" U-FLAG=";UF$; 1850 PRINT #5:" Last mess.read: Main=";LML: : 1860 CLOSE #6 :: DISPLAY AT(1,1):NAM$;" #";USER$;" ";BD$;"baud" :: DISPLAY AT(2, 1):"Calls:"&CALL$&" Last:"&DATE$ 1870 IF POS(NAM$," ",1)=0 THEN FN$=NAM$ :: GOTO 1890 1880 FN$=SEG$(NAM$,1,(POS(NAM$," ",1)-1)) 1890 DISPLAY AT(3,1):COM$;"/";ADR$:"F3=bt F7=menu Chat:bar/ctrlQ" 1900 A$="~Hi "&FN$&"~From "&ADR$&"~" :: CALL OUT(A$) 1910 IF SEG$(VALID$,1,1)="Y" AND VAL(CALL$)<4 THEN 1920 ELSE 2000 1920 A$=CHR$(7)&"Welcome to the Corner-"&CHR$(7)&"~you have been validated for f ull access to~this system~"&CHR$(7):: CALL OUT(A$) 1930 CALL SAY("JUST+V"):: CALL DEL(400):: IF VAL(CALL$)=1 AND AV$="Y" THEN 1940 ELSE 2000 1940 A$=CHR$(7)&"~~AUTO-VALIDATION IS ON!!!~~"&CHR$(7):: CALL OUT(A$):: ON ERROR 3430 1950 OPEN #77:"DSK1.NEWFILE",INTERNAL,INPUT ,VARIABLE 80 1960 FOR X=1 TO 10 :: INPUT #77:EE$(X):: NEXT X :: CLOSE #77 1970 FOR X=10 TO 2 STEP -1 :: EE$(X)=EE$(X-1):: NEXT X :: A$=NAM$&" from "&ADR$ 1980 OPEN #77:"DSK1.NEWFILE",INTERNAL,OUTPUT,VARIABLE 80 :: PRINT #77:A$ 1990 FOR X=2 TO 10 :: PRINT #77:EE$(X):: NEXT X :: CLOSE #77 2000 A$="~the last purchased ticket was~on "&DATE$&"~" :: CALL OUT(A$) 2010 IF SEG$(VALID$,2,1)<>"Y" THEN 2050 2020 A$="~Your validation shows that you have requested some files for DL. If yo u haven't~gotten them yet, they should be available today." 2030 A$=A$&"~You may want to check for them on board #3.~Use D)ownload (special files)~" :: CALL OUT(A$) 2040 A$="On board #3, select F)ile transfers, D)ownload (special files)~~" :: CA LL OUT(A$) 2050 B=1 :: IF VAL(CALL$)=1 THEN 2240 2060 IF BYP=1 AND SEG$(VALID$,8,1)="Y" THEN 2240 2070 A$="~Check bottles for messages~for you? (Y/N) " :: CALL OUT(A$):: CALL YN( A$):: IF A$="N" THEN 2240 2080 A$="~Popping the corks...." :: CALL OUT(A$):: ON ERROR 3440 2090 OPEN #9:"DSK1.MESSAGES",INTERNAL,RELATIVE,INPUT ,FIXED 84 :: INPUT #9,REC 0 :FM,LM :: MS=0 2100 A$="~Messages range from "&STR$(FM)&" to "&STR$(LM)&"~Last message you read was "&STR$(LML)&"~" 2110 A$=A$&"Number unread messages = "&STR$(LM-LML)&"~~" :: CALL OUT(A$) 2120 A$="~Checking for messages to "&NAM$&"~hold on...~~" :: CALL OUT(A$) 2130 IF LML=0 OR LML<=FM THEN A=FM ELSE A=LML+1 2140 FOR Z=A TO LM 2150 IF LEN(STR$(Z))=1 THEN READREC=(READREC-1)*13+1 :: GOTO 2170 2160 READREC=VAL(SEG$(STR$(Z),LEN(STR$(Z))-1,2)):: READREC=READREC*13+1 2170 INPUT #9,REC READREC:MESN,TO$,FROM$,SUB$,DATE$ :: IF TO$=NAM$ THEN 2180 ELS E IF TO$="ALL" THEN 2190 ELSE 2200 2180 MS=1 :: A$=STR$(MESN)&" is for you~" :: CALL OUT(A$):: GOTO 2200 2190 A$=STR$(MESN)&" is for ALL~" :: CALL OUT(A$) 2200 IF MESN=LM THEN CLOSE #9 :: GOTO 2220 2210 NEXT Z 2220 IF MS=0 THEN A$="~Sorry, no messages for you today.~Why not leave a few?~~" :: CALL OUT(A$) 2230 CALL ENT 2240 IF SEG$(VALID$,1,1)="N" THEN 2490 2250 A=POS(UF$,"1",1):: IF A=0 THEN 2490 2260 ON ERROR 3450 2270 OPEN #59:"DSK2.FLASH",INPUT :: V=VAL(SEG$(UF$,10,1)) 2280 FOR X=1 TO 9 2290 A$=SEG$(UF$,X,1):: IF A$<>"1" THEN 2340 ELSE SK$="@S"&STR$(X)&"@" 2300 LINPUT #59:A$ :: IF A$<>SK$ THEN 2300 :: SK$="@E"&STR$(X)&"@" 2310 LINPUT #59:A$ :: IF A$=SK$ THEN A$="~" :: CALL OUT(A$):: CALL ENT :: CALL O UT(A$):: GOTO 2330 2320 A$=A$&"~" :: CALL OUT(A$):: GOTO 2310 2330 UF$=SEG$(UF$,1,X-1)&"0"&SEG$(UF$,X+1,10-X) 2340 NEXT X 2350 IF V=0 THEN CLOSE #59 :: GOTO 2480 2360 A$="~~~THE VOTING BOX~~Please cast your vote on the following. All votes ar e confidential~" :: CALL OUT(A$) 2370 A$="and all results are tallied as percentages and available on board #1~~" :: CALL OUT(A$) 2380 LINPUT #59:A$ :: A1$=SEG$(A$,1,2):: IF A1$<>"@V" THEN 2380 2390 LINPUT #59:A$ :: IF SEG$(A$,1,3)="@E@" THEN CLOSE #59 :: A$="~" :: CALL OUT (A$):: GOTO 2410 2400 A$=A$&"~" :: CALL OUT(A$):: GOTO 2390 2410 OPEN #67:"DSK1.BALLOT",UPDATE,RELATIVE,INTERNAL,FIXED 15 2420 INPUT #67,REC 0:NC 2430 A$="~Enter your vote now- number?-> " :: CALL OUT(A$):: CALL IN(A$):: CALL CN(A$,1,NC,A):: IF A$="-" THEN 2430 2440 PRINT #5:"V/";A$;",";:: IF A=NC THEN A$="~Vote reserved for a later date... ~" :: CALL OUT(A$):: GOTO 2480 2450 INPUT #67,REC A:RC 2460 RC=RC+1 :: PRINT #67,REC A:RC 2470 CLOSE #67 :: A$="~Thankyou for participating...~~" :: CALL OUT(A$):: UF$=SE G$(UF$,1,9)&"0" 2480 ON ERROR 3450 :: OPEN #6:"DSK1.UFILE",UPDATE,RELATIVE,INTERNAL,FIXED 126 :: GOSUB 2780 :: CLOSE #6 2490 IF SEG$(VALID$,1,1)<>"Y" THEN 2550 ELSE B=0 :: A$="~Set the wayback machine :~~" :: CALL OUT(A$) 2500 A$="~~ 1) Board #1~ 2) Board #2~ 3) Board #3~ 4) Boggle board~ 5) Spy adven ture~" :: E=5 2510 IF SEG$(VALID$,10,1)="Y" THEN A$=A$&" 6) Remote~" :: E=6 2520 A$=A$&"~Select option -->" :: CALL OUT(A$) 2530 CALL KY(A$):: CALL CN(A$,1,E,B):: IF A$="-" THEN 2520 2540 A$="Board #"&STR$(B)&" it is!~" :: CALL OUT(A$) 2550 A$="~Please wait while the selected show~is tuned in~This will take less th an one minute...~~" :: CALL OUT(A$) 2560 A$="Ten last viewers to see the show:~~"&NAM$&" <--Now viewing" :: CALL OUT (A$) 2570 FOR X=1 TO 10 :: A$="~"&E$(X):: CALL OUT(A$):: NEXT X 2580 ON ERROR 3460 2590 A$="~ Tuning in the selected show... " :: CALL LINK("OUTPUT",A$):: IF BYP =1 AND SEG$(VALID$,8,1)="Y" THEN 2640 2600 ON ERROR 3470 2610 FOR X=2 TO 10 :: EE$(X)=E$(X-1):: NEXT X :: EE$(1)=NAM$&"-"&ADR$ 2620 OPEN #11:"DSK1.LASTFILE",INTERNAL,OUTPUT,VARIABLE 80 2630 FOR X=1 TO 10 :: PRINT #11:EE$(X):: NEXT X :: CLOSE #11 2640 OPEN #10:"DSK1.TRANSFILE",INTERNAL,OUTPUT,FIXED 80 :: PRINT #10:USER;XP;BD; FN$;NAM$;PASS$ :: CLOSE #10 2650 ON B GOTO 2660,2670,2680,2690,2700,2710 2660 RUN "DSK1.BOARDA" 2670 RUN "DSK1.BOARDB" 2680 RUN "DSK1.BOARDC" 2690 RUN "DSK1.BOGGLE" 2700 RUN "DSK1.CIA" 2710 RUN "DSK1.REMOTE" 2720 ON ERROR 3300 :: A$="~Commands:~~P)ause R)esume~~~" :: CALL OUT(A$) 2730 OPEN #20:"DSK2."&FILE$,DISPLAY ,VARIABLE,INPUT 2740 IF EOF(20)THEN CLOSE #20 :: GOTO 2770 2750 LINPUT #20:A$ :: A$=A$&"~" :: CALL OUT(A$):: CALL KYCK(A):: IF A=1 THEN CAL L PAUSE 2760 CALL KEY(0,K,S):: IF K=65 THEN CLOSE #20 :: GOTO 2770 ELSE GOTO 2740 2770 A$="~~" :: CALL OUT(A$):: CALL ENT :: RETURN 2780 PRINT #6,REC USER:NAM$;ADR$;PASS$;CALL$;T3$;PH$;COM$;UF$;VALID$;LML :: RETU RN 2790 INPUT #6,REC USER:NAM$,ADR$,PASS$,CALL$,DATE$,PH$,COM$,UF$,VALID$,LML :: RE TURN 2800 DISPLAY AT(2,2)ERASE ALL:"Sysop menu:" :: DISPLAY AT(5,1):"1 Enter board" : : DISPLAY AT(6,1):"2 File management" 2810 DISPLAY AT(7,1):"3 Run (normal operation)" :: DISPLAY AT(8,1):"4 Stop" :: D ISPLAY AT(9,1):"5 BYE" :: DISPLAY AT(10,1):"6 Lock board" 2820 DISPLAY AT(11,1):"7 Run LOAD":"8 Disk Manager":"9 Cat drive":"10 BREAK (CON )":"11 M-COPIER":"12 Read Ascii file":"13 Set clock" 2830 ACCEPT AT(19,2)SIZE(2)VALIDATE(DIGIT):K :: IF K<0 OR K>13 THEN 2830 2840 ER$="" :: DISPLAY AT(19,1):"Selection ";K 2850 ON K GOTO 2900,2920,2930,2940,2960,2880,2970,2980,3000,2860,2990,3130,3200 2860 PRINT : :"type CON to continue": : :: BREAK 2870 LOCK=0 :: GOTO 410 2880 LOCK=1 :: GOTO 420 2890 FOR X=1 TO 14 :: CALL COLOR(X,15,2):: NEXT X :: CALL SCREEN(8):: GOTO 2800 2900 CALL LINK("TEST"):: BD$="1200" :: GOTO 890 2910 CALL LINK("OFHOOK"):: BD$="2400" :: GOTO 890 2920 DISPLAY AT(22,3):"Loading......" :: RUN "DSK1.MANAGER" 2930 LOCK=0 :: GOTO 410 2940 STOP 2950 A$="~~~You have been disconnected~Please remember to hang up your phone~~" :: CALL OUT(A$):: CALL HANGUP 2960 CALL INIT :: CALL LOAD(-31804,0,36) 2970 RUN "DSK1.LOAD" 2980 CALL INIT :: CALL LOAD("DSK1.DMXB"):: CALL LINK("GO") 2990 DISPLAY AT(24,6):"Loading M-COPIER" :: RUN "DSK1.MCOPY/XB" 3000 DISPLAY AT(1,6)ERASE ALL:"CAT DRIVE" 3010 DISPLAY AT(3,1):"DRIVE?" :: ACCEPT AT(3,7):X$ :: IF X$="" THEN 2800 3020 ON ERROR 3110 3030 OPEN #107:"DSK"&X$&".",INTERNAL,RELATIVE,INPUT :: INPUT #107:A$,J,J,K :: PR INT "DSKNAME-";A$;" AV=";K:RPT$("-",28) 3040 PRINT "FILENAME";TAB(12);"SIZE":RPT$("-",28): : 3050 FOR X=1 TO 127 3060 INPUT #107:A$,A,J,K :: IF LEN(A$)=0 THEN CLOSE #107 :: GOTO 3100 3070 PRINT A$;TAB(12);J 3080 CALL KEY(0,K,S):: IF S<>0 THEN 3080 3090 NEXT X 3100 PRINT :"ANY KEY TO RETURN" :: GOTO 3120 3110 PRINT "DISK DRIVE ERROR": : : :: RETURN 3100 3120 CALL KEY(0,K,S):: IF S=0 THEN 3120 ELSE 2800 3130 DISPLAY AT(1,5)ERASE ALL:"Read ASCII file": :"Drive #? 2" :: ACCEPT AT(3,10 )SIZE(-1):DR$ 3140 DISPLAY AT(4,1):"Filename? FILE/" :: ACCEPT AT(4,11)SIZE(-10):FN$ 3150 ON ERROR 3110 3160 OPEN #107:"DSK"&DR$&"."&FN$,INPUT 3170 IF EOF(107)THEN CLOSE #107 :: GOTO 3100 3180 LINPUT #107:A$ :: PRINT A$ 3190 CALL KEY(0,K,S):: IF S=0 THEN 3170 ELSE IF K=65 THEN CLOSE #107 :: GOTO 310 0 ELSE 3190 3200 RUN "DSK1.CLOCK" 3210 !************************************************** BEGIN ERROR ROUTINE S AND SUBPROGRAMS **************************** 3220 LOCK=2 :: CALL ERR(E1,E2,E3,E4):: RETURN 420 3230 CALL ERR(E1,E2,E3,E4):: CALL LINK("OFHOOK"):: DISPLAY AT(12,10):"MODEM ERRO R":" ";E1;E2;E3;E4 :: DISPLAY AT(22,1):"LEN(A$)=";LEN(A$) 3240 CALL SAY("ERROR") 3250 FOR X=1 TO 200 :: NEXT X 3260 DISPLAY AT(23,1):"A$=";A$ :: DISPLAY AT(24,1):"RELOADING..." :: RUN 3270 RETURN 410 3280 CALL ERR(E1,E2,E3,E4):: RETURN 420 3290 X=9 :: RETURN 550 3300 CALL ERR(E1,E2,E3,E4):: PRINT #5:"*****DISK FILE ERR-";FILE$;E1;E2;E3;E4 :: RETURN 2770 3310 RETURN 850 3320 EA$=A$ :: A$="~~ERROR in board~please wait while error is logged~" :: CALL OUT(A$) 3330 CALL ERR(E1,E2,E3,E4):: PRINT #5: : : :RPT$("ERROR ",21) 3340 IF USER>3 THEN 3360 ELSE A$="~ERROR: "&STR$(E1)&" "&STR$(E2)&" "&STR$(E3)&" "&STR$(E4)&"~A$="&EA$&"~" :: CALL OUT(A$) 3350 CALL DEL(1000) 3360 PRINT #5:"********** ERROR **********in LOGON" :: PRINT #5:"Error code:";E1 ;E2;E3;E4 3370 PRINT #5:EA$ 3380 PRINT #5:RPT$("ERROR ",21): : : : 3390 ON ERROR 3320 :: RETURN NEXT 3400 A$="~CRASH!! A FATAL error!~Sorry but I can't continue.Try again later.~" : : CALL OUT(A$) 3410 A$="If you are a new caller, your user # and~password may not have been fil ed. Meanwhile, I'll look into this!~~" :: CALL OUT(A$) 3420 CALL LINK("OFHOOK"):: CALL ERR(E1,E2,E3,E4):: PRINT E1;E2;E3;E4 :: STOP 3430 CALL ERR(E1,E2,E3,E4):: PRINT #5:"ERROR - LOGON:";E1;E2;E3;E4 :: CLOSE #77 :: RETURN 2000 3440 CALL ERR(E1,E2,E3,E4):: PRINT #5:"ERROR - LOGON:";E1;E2;E3;E4 :: A$="~Can't read the file...~" :: CALL OUT(A$):: RETURN 2240 3450 CALL ERR(E1,E2,E3,E4):: PRINT #5:"ERROR - LOGON:";E1;E2;E3;E4 :: RETURN 249 0 3460 CALL ERR(E1,E2,E3,E4):: PRINT #5:"ERROR ";E1;E2;E3;E4 :: A$="~Changing the channel to..." :: CALL LINK("OUTPUT",A$):: RETURN 2600 3470 CALL ERR(E1,E2,E3,E4):: PRINT #5:"ERROR - LOGON(LASTFILE):";E1;E2;E3;E4 :: RETURN 2640 3480 !@P+ 3490 SUB TIM(T1$,T2$,T3$) 3500 DEF TIME=TV1-6*INT(TV1/16)!BCD to Decimal Converter 3510 CALL PEEK(-31158,X1,X2,C,X4,X5):: TV1=C :: A1$=STR$(TIME):: TV1=X5 :: X5=TI ME :: T2$=STR$(X5)&"/"&A1$&"/94" 3520 CALL PEEK(-31164,X1,X2,X3,X4,X5):: TV1=X1 :: SEC$=STR$(TIME):: IF X1<10 THE N SEC$="0"&SEC$ 3530 TV1=X3 :: MIN$=STR$(TIME):: IF X3<10 THEN MIN$="0"&MIN$ 3540 TV1=X5 :: HR=TIME :: M$="am" :: IF HR>11 THEN M$="pm" 3550 IF HR=0 THEN HR=12 3560 IF HR>12 THEN HR=HR-12 3570 HR$=STR$(HR):: T1$=HR$&":"&MIN$&M$ :: T3$=T2$&" "&T1$ 3580 SUBEND 3590 SUB YN(A$) 3600 CALL CK :: CALL LINK("DCDCHK",A$):: CALL UP(A$):: IF A$<>"Y" AND A$<>"N" TH EN 3600 3610 IF A$="Y" THEN A1$="Yes~" ELSE IF A$="N" THEN A1$="No~" 3620 CALL OUT(A1$):: SUBEND 3630 SUB HANGUP 3640 CALL LINK("OFHOOK"):: RUN 3650 SUBEND 3660 SUB IN(A$):: CALL LINK("INPUT",A$):: CALL CK :: SUBEND 3670 SUB TI(A$):: CALL LINK("TICHK",A$):: A$=SEG$(A$,1,1):: SUBEND 3680 SUB OUT(A$):: CALL LINK("OUTPUT",A$):: CALL CK :: SUBEND 3690 SUB UP(A$):: CALL LINK("UPPER",A$):: SUBEND 3700 SUB ENT :: A$="Press <ENTER> " :: CALL OUT(A$):: CALL IN(A$):: SUBEND 3710 SUB CK 3720 CALL KEY(0,K,ST):: IF K=135 THEN A$="~Have a BOOT!~~" :: CALL LINK("OUTPUT" ,A$):: PRINT #5:"**MANUAL BOOT!!**" :: CALL HANGUP 3730 IF K<>129 THEN 3790 3740 A$="~~Please stand by.....~Board is under SysOp control...~~~~" :: CALL LIN K("OUTPUT",A$) 3750 DISPLAY AT(23,1)BEEP:"1- 2- 3-Manager":"4-Return Spacebar-Cha t" 3760 CALL KEY(0,K,S):: IF S=0 THEN 3750 3770 IF K=51 THEN RUN "DSK1.MANAGER" ELSE IF K=52 THEN 3790 ELSE IF K=32 THEN 37 80 ELSE 3760 3780 CALL LINK("DCDCHK",A$) 3790 A$="" :: CALL LINK("JOYST",A$):: IF LEN(A$)=0 THEN SUBEXIT 3800 IF ASC(A$)<>255 THEN SUBEXIT 3810 PRINT #5:"***HANGUP***" :: CALL HANGUP 3820 SUBEND 3830 SUB CN(A$,MN,MX,A) 3840 IF A$="" THEN 3880 3850 FOR X=1 TO LEN(A$):: IF POS("0123456789",SEG$(A$,X,1),1)=0 THEN 3880 3860 NEXT X 3870 A=VAL(A$):: IF A<MN OR A>MX THEN 3880 ELSE SUBEXIT 3880 A$=CHR$(7)&"~Invalid entry~" :: CALL OUT(A$):: A$="-" :: SUBEND 3890 SUB KY(A$) 3900 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)THEN 3900 3910 CALL UP(A$):: A1$=A$&"~" :: CALL OUT(A1$):: SUBEND 3920 SUB KY2(A$) 3930 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)THEN 3930 3940 CALL UP(A$):: SUBEND 3950 SUB DEL(A) 3960 FOR X=1 TO A :: NEXT X 3970 SUBEND 3980 SUB CBT(A$,BOOT$()) 3990 A1$=A$ :: CALL UP(A1$) 4000 FOR X=1 TO 10 :: IF POS(A1$,BOOT$(X),1)>0 THEN A$="~You've earned a BOOT!" :: CALL OUT(A$):: PRINT #5:"**BOOT!!**(";A1$;")" :: CALL HANGUP 4010 NEXT X 4020 SUBEND 4030 SUB KYCK(LEFT) 4040 CALL LINK("DCDCHK",A$):: CALL UP(A$):: LEFT=POS("PSRA",A$,1):: SUBEND 4050 SUB PAUSE 4060 A$="R)esume " :: CALL OUT(A$) 4070 CALL CK :: CALL LINK("DCDCHK",A$):: CALL UP(A$):: IF A$="R" THEN A$=RPT$(CH R$(8),8):: CALL OUT(A$):: SUBEXIT 4080 GOTO 4070 4090 SUBEND

go back up to the top

BoardA - message base, activities

The BoardA code was written by S. Clarke with concept and design by S. Clarke and W. Blew

10 CALL LINK("OUTPUT","~~ rev 010194 BOARD #1~~") 20 CALL KEY(4,X,X):: GOTO 80 30 A,BD,E1,E2,E3,E4,FM,FST,L,LEFT,LF,LM,LML,LST,MESN,NEWREC,NOM,P,READREC,R,RR,S TP,USER,X,XP,Z=0 40 A$,A1$,AA$,ADR$,AM$,AU$,B$,CALL$,CALLS$,CKPASS$,COM$,CPASS$,D$,DATE$,E$,EA$,F $,FN$,FNM$,FROM$,KEY$,LF$,LN$,NAM$,PASS$,PH$,RR$,SUB$="" 50 T1$,T2$,T3$,TO$,UF$,VALID$="" 60 CALL CLEAR :: CALL COLOR :: CALL HCHAR :: CALL JOYST :: CALL SOUND :: CALL LI NK :: CALL PEEK :: CALL ERR :: CALL CHARPAT 70 CALL SAY :: CALL SCREEN 80 OPTION BASE 1 90 DIM MS$(12),FDT$(20),BOOT$(10),DLF$(6),RS(9) 100 DATA FUCK,SHIT,CUNT,DICK,COCK,ASSHOLE,JERKOFF,PRICK,PUSSY,PENIS 110 DATA TEXAS,GENEVE,OTHER,OTHER,PICS,OTHER 120 !@P- 130 CALL SAY("PROGRAM A") 140 FOR X=1 TO 10 :: READ BOOT$(X):: NEXT X :: NOM=100 150 FOR X=1 TO 6 :: READ DLF$(X):: NEXT X 160 OPEN #27:"DSK1.DEFAULTF",INPUT ,INTERNAL,RELATIVE,FIXED 20 :: INPUT #27,REC 1:B$ :: CLOSE #27 170 OPEN #5:"RS232/2.BA="&B$,VARIABLE 132 180 CALL CK :: OPEN #10:"DSK1.TRANSFILE",INTERNAL,INPUT ,FIXED 80 :: INPUT #10:U SER,XP,BD,FN$,NAM$,PASS$ :: CLOSE #10 190 OPEN #11:"DSK1.FILEDATES",INTERNAL,RELATIVE,INPUT ,FIXED 12 200 FOR X=1 TO 20 :: INPUT #11,REC X:FDT$(X):: NEXT X :: CLOSE #11 210 A$=CHR$(7)&"~~Loading your user file..." :: CALL OUT(A$):: OPEN #6:"DSK1.UFI LE",UPDATE,INTERNAL,RELATIVE,FIXED 126 :: GOSUB 2320 220 A=0 :: CLOSE #6 230 CALL LINK("DCDCHK",A$):: A$="~Enter password for verification~--->" :: CALL OUT(A$):: CALL LINK("SECRET",A$) 240 IF POS(A$,"/",1)>0 THEN A$=SEG$(A$,POS(A$,"/",1)+1,LEN(A$)-1-LEN(STR$(USER)) ) 250 CKPASS$=A$ :: IF CKPASS$<>PASS$ THEN A=A+1 ELSE 280 260 IF A=8 THEN A$="Sorry, too many tries...BYE!!!" :: CALL OUT(A$):: CALL HANGU P 270 A$="Nope...try again~~~" :: CALL OUT(A$):: GOTO 230 280 PRINT #5:"Main menu-BD#1:"; 290 ON ERROR 3150 300 CALL TIM(T1$,T2$,T3$):: A$="~"&T3$&"~" :: CALL OUT(A$) 310 IF XP=1 THEN 400 320 A$="~~"&RPT$("%",40)&"~% BULLWINKLE'S CORNER * BD#1:MENU %~"&RPT$("%",4 0)&"~~" :: CALL OUT(A$) 330 A$="A)scii file menu N)~B)oard map O)~C)ost evaluation P)assw ord change~" :: CALL OUT(A$) 340 A$="D) Q)~E) R)emote~" :: CALL OUT(A$) 350 A$="F) S)end note to SysOp~G)oodbye T)~" :: CALL OUT(A$) 360 A$="H) U)sers [list/search]~I)ntroducing V)oting res ults~" :: CALL OUT(A$) 370 A$="J)ump boards W)ake up~K) X)pert mode [toggle]~" :: CALL OUT(A$) 380 A$="L)inefeed [toggle] Y)ell for SysOp~M)essage base menu Z)~" :: CALL OUT (A$) 390 GOTO 410 400 A$="~~Main menu:BD#1" :: CALL OUT(A$) 410 A$="~Choice-?~A,B,C,G,I,J,L,M,P,R,S,U,V,W,X,Y,?~--->" :: CALL OUT(A$):: CALL KY("ABCGIJLMPRSUVWXY?",A$,R) 420 ON R GOTO 430,440,450,460,470,510,530,550,560,570,580,590,600,610,640,660,67 0 430 GOSUB 2490 :: GOTO 290 440 A$="M" :: A1$="RT" :: GOSUB 2940 :: GOTO 290 450 GOSUB 2360 :: GOTO 290 460 CALL LOFF(CALL$,FN$,USER,NAM$,VALID$):: GOTO 290 470 A$="~~~Introducing....~the newest members here at the Corner~~" :: CALL OUT( A$) 480 OPEN #11:"DSK1.NEWFILE",INTERNAL,INPUT ,VARIABLE 80 490 FOR X=1 TO 10 :: INPUT #11:A$ :: A$=A$&"~" :: CALL OUT(A$):: NEXT X :: CLOSE #11 500 A$="~~Bullwinkle's Corner extends its sincere welcome!~~" :: CALL OUT(A$):: CALL ENT :: GOTO 290 510 IF SEG$(VALID$,1,1)="Y" THEN CALL CNG(USER,XP,BD,FN$,NAM$,PASS$,VALID$):: GO TO 290 520 A$="~Sorry, you must be validated~to access alternate boards~~" :: CALL OUT( A$):: GOTO 410 530 IF LF=0 THEN CALL LINK("LFNO"):: A$="~Linefeeds off~" :: CALL OUT(A$):: LF=1 :: GOTO 290 540 IF LF=1 THEN CALL LINK("LFYES"):: A$="~Linefeeds on~" :: CALL OUT(A$):: LF=0 :: GOTO 290 550 GOSUB 680 :: GOTO 290 560 GOSUB 2430 :: GOTO 290 570 IF SEG$(VALID$,10,1)="Y" THEN 740 ELSE A$="~~Sorry, Remote is a sysop option only.~~" :: CALL OUT(A$):: CALL DEL(400):: GOTO 290 580 E1=99 :: GOSUB 1000 :: GOTO 290 590 GOSUB 2030 :: GOTO 290 600 GOSUB 3020 :: GOTO 290 610 FOR X=1 TO 5 :: A$=CHR$(7)&"~WAKE UP!!! " :: CALL OUT(A$):: NEXT X 620 A$="~did that make you alert again Y/N? " :: CALL OUT(A$):: CALL YN(A$):: IF A$="N" THEN 610 630 A$="~See! works good, huh!!~~" :: CALL OUT(A$):: CALL DEL(250):: GOTO 290 640 IF XP=0 THEN XP=1 :: A$="~Expert mode on.....~" :: CALL OUT(A$):: GOTO 290 650 IF XP=1 THEN XP=0 :: A$="~Expert mode off.....~" :: CALL OUT(A$):: GOTO 290 660 CALL RING(NAM$):: GOTO 290 670 GOTO 320 680 PRINT #5: :"Message base:"; 690 OPEN #9:"DSK1.MESSAGES",UPDATE,RELATIVE,INTERNAL,FIXED 84 700 INPUT #9,REC 0:FM,LM :: LEFT=58-LEN(NAM$)-LEN(T3$) 710 A$="~~Bottle info:~~First message..."&STR$(FM)&"~Last message...."&STR$(LM)& "~Last you read..."&STR$(LML)&"~" :: CALL OUT(A$) 720 A$="Unread messages."&RPT$(".",4-LEN(STR$(LM-LML)))&STR$(VAL(STR$(LM))-VAL(S TR$(LML)))&"~" :: CALL OUT(A$) 730 IF LML<FM THEN LML=FM-1 740 IF XP=1 AND R<>11 THEN 790 750 A1$="~+"&RPT$("-",38)&"+~" :: A$="| MESSAGE BASE:MAIN MENU |" :: A$=A1$&A$&A1$ :: CALL OUT(A$) 760 A$="~~ (A)bort this menu~ (C)heck for messages~ (E)nter message~ (F)orwa rd read" :: CALL OUT(A$) 770 A$="~ (G)oodbye(fast log-off)~ (I)ndividual read~ (N)ew read~ (R)everse read~ (S)earch for message(with read option)" 780 A$=A$&"~ (T)itles of messages(with read option)~~" :: CALL OUT(A$):: GOTO 8 00 790 A$="~Message base:Main menu~" :: CALL OUT(A$) 800 A$="CHOICE->A,C,E,F,G,I,N,R,S,T or?~--->" :: CALL OUT(A$):: CALL KY("ACEFGIN RST?",A$,R) 810 IF R=11 THEN 710 820 IF R=1 OR R=5 THEN A$="~Bottle is being sealed.........~~" :: CALL OUT(A$):: CLOSE #9 :: GOSUB 2340 :: GOTO 840 830 A$="Popping the cork out of the bottle..~~" :: CALL OUT(A$) 840 IF R=5 THEN CALL LOFF(CALL$,FN$,USER,NAM$,VALID$):: RETURN 850 IF R=1 THEN PRINT #5: :"MAIN-BD#1:";:: RETURN 860 A$="~~" :: CALL OUT(A$) 870 ON R GOSUB 32767,1520,890,1640,32767,1680,1670,1660,1550,1600,32767 880 GOTO 700 890 IF SEG$(VALID$,1,1)="Y" THEN 920 900 A$="~Sorry, you cannot enter messages until~you have been validated (usually within~a week).~~" :: CALL OUT(A$) 910 CALL DEL(400):: PRINT #5:"(***NO VAL***)";:: RETURN 920 A$="~Roll up a message and stuff~the bottle with it...~" :: CALL OUT(A$):: I F XP=1 THEN 950 930 A$="INSTRUCTIONS:~~-Max lines:12~-Max chars per line:80~ (bell signals limi t)~-Press <ENTER> on a blank line~when finished~" 940 A$=A$&"-Type PRIVATE for subject to make message private~DO NOT make private if it does not~contain private info!~" :: CALL OUT(A$) 950 A$="~To: " :: CALL OUT(A$):: CALL IN(TO$):: CALL UP(TO$) 960 IF LEN(TO$)>20 THEN A$="~Under 20 characters please~" :: CALL OUT(A$):: GOTO 950 ELSE LEFT=LEFT-LEN(TO$) 970 A$="~"&STR$(LEFT)&" characters remain for subject~Subject: " :: CALL OUT(A$) :: CALL IN(SUB$) 980 IF LEN(SUB$)>LEFT THEN 970 ELSE CALL UP(SUB$) 990 IF SUB$="PRIVATE" THEN A$="Message designated as PRIVATE~" :: CALL OUT(A$):: GOTO 1050 ELSE A$="Public message~" :: CALL OUT(A$):: GOTO 1050 1000 OPEN #9:"DSK1.MESSAGES",UPDATE,RELATIVE,INTERNAL,FIXED 84 :: INPUT #9,REC 0 :FM,LM 1010 IF XP=1 THEN 1030 1020 A$="INSTRUCTIONS:~~-Max lines:12~-Max chars per line:80~ (bell signals lim it)~-Press <ENTER> on a blank line~when finished~" 1030 A$="~Message to Bullwinkle:~" :: CALL OUT(A$):: TO$="BULLWINKLE" :: IF SEG$ (VALID$,1,1)="N" THEN SUB$="PRIVATE" :: GOTO 1050 1040 A$="~Will this message be PRIVATE? (Y/N)? " :: CALL OUT(A$):: CALL YN(A$):: IF A$="Y" THEN SUB$="PRIVATE" ELSE SUB$="COMMENT" 1050 A$="Do you want line numbers? (Y/N) " :: CALL OUT(A$):: CALL YN(LN$) 1060 FOR L=1 TO 12 :: MS$(L)="" :: NEXT L :: A$="Type your scroll~(press <ENTER> after eack line or auto linefeed)~~" :: CALL OUT(A$) 1070 FOR L=1 TO 12 1080 A$="~" :: CALL OUT(A$) 1090 IF LN$="N" THEN 1100 :: A$="Line # "&STR$(L)&" " :: A=LEN(A$):: CALL OUT(A $):: A$=RPT$(CHR$(8),A):: CALL OUT(A$) 1100 CALL IN(A$) 1110 IF A$="" THEN L=L-1 :: GOTO 1150 1120 MS$(L)=A$ :: IF L=11 THEN A$=CHR$(7)&"~One more line will fill the bottle~" :: CALL OUT(A$) 1130 NEXT L 1140 L=L-1 1150 A$="~~(A)bort,(C)ontinue,(F)ix,(S)ave,(V)iew ?~--->" :: CALL OUT(A$):: CALL KY("ACFSV",A$,R) 1160 IF R=1 AND E1=99 THEN CLOSE #9 :: E1=0 :: RETURN ELSE IF R=1 THEN RETURN 1170 ON R GOTO 690,1180,1230,1380,1200 1180 IF L=12 THEN A$="~The bottle is packed to the top now!~" :: CALL OUT(A$):: GOTO 1150 1190 GOTO 1130 1200 A$="~~To:"&TO$&"~From:"&NAM$&"~Subject:"&SUB$&"~" :: CALL OUT(A$) 1210 FOR Z=1 TO L :: A$=STR$(Z)&"~"&MS$(Z)&"~" :: CALL OUT(A$):: NEXT Z 1220 IF R=5 THEN 1150 1230 A$="Fix:~(T)o,(S)ubject,(L)ine,(N)evermind,(V)iew~-->" :: CALL OUT(A$):: CA LL KY("TSLNV",A$,R):: IF R=4 THEN 1150 1240 IF R<3 AND SEG$(VALID$,1,1)="N" THEN A$="~OPS! cant edit that selection 'ti l validated.~~" :: CALL OUT(A$):: GOTO 1150 1250 IF R=5 THEN 1200 1260 IF R<>1 THEN 1300 ELSE LEFT=58-(LEN(SUB$)+LEN(T3$)+LEN(NAM$)) 1270 A$="~Max characters "&STR$(LEFT)&"~" :: CALL OUT(A$) 1280 A$="~To:" :: CALL OUT(A$):: CALL IN(A$):: CALL UP(A$):: IF LEN(A$)<=LEFT TH EN TO$=A$ ELSE 1270 1290 GOTO 1150 1300 IF R<>2 THEN 1340 ELSE LEFT=58-(LEN(TO$)+LEN(T3$)+LEN(NAM$)) 1310 A$="~Max characters "&STR$(LEFT)&"~" :: CALL OUT(A$) 1320 A$="~Subject:" :: CALL OUT(A$):: CALL IN(A$):: CALL UP(A$):: IF LEN(A$)<=LE FT THEN SUB$=A$ ELSE 1310 1330 GOTO 1150 1340 IF R<>3 THEN 1230 ELSE A$="Enter line number " :: CALL OUT(A$):: CALL IN(A$ ):: CALL CN(A$,1,L,A) 1350 IF A$="-" THEN A$="~There is no line for that number~" :: CALL OUT(A$):: GO TO 1150 1360 A$="~Present line~"&STR$(A)&" "&MS$(A)&"~New line: (<ENTER>=no change~" :: CALL OUT(A$):: CALL IN(A$) 1370 IF A$="" THEN 1150 ELSE MS$(A)=A$ :: GOTO 1150 1380 A$="~Saving message #"&STR$(LM+1):: CALL OUT(A$) 1390 IF SEG$(VALID$,1,1)="Y" THEN 1410 1400 FOR Z=1 TO 12 :: CALL CBT(MS$(Z),BOOT$()):: NEXT Z 1410 PRINT #5: :"#";LM+1;" ";RPT$("=",110);" ENTER MESSAGE":"To-";TO$;" Subject -";SUB$ :: FM=FM+1 :: LM=LM+1 1420 CALL FINDREC(LM,NEWREC):: CALL TIM(T1$,T2$,T3$):: PRINT #9,REC 0:FM,LM :: P RINT #9,REC NEWREC:LM,TO$;NAM$,SUB$,T3$ 1430 IF L<>12 THEN MS$(L+1)="@END@" 1440 FOR Z=1 TO 12 :: PRINT #9,REC NEWREC+Z:MS$(Z):: NEXT Z 1450 Z=1 :: A$=MS$(Z) 1460 IF LEN(A$)>132 THEN 1490 1470 Z=Z+1 :: IF Z>L THEN 1500 ELSE A$=A$&" "&MS$(Z):: GOTO 1460 1480 A$=A$&MS$(Z):: GOTO 1460 1490 PRINT #5:SEG$(A$,1,132):: A$=SEG$(A$,133,LEN(A$)-132):: GOTO 1460 1500 IF E1=99 THEN PRINT #5:A$: :"Main menu (cont'd)";ELSE PRINT #5:A$: :"Messag e base (cont'd)"; 1510 A$="~Message saved" :: CALL OUT(A$):: IF E1=99 THEN CLOSE #9 :: E1=0 :: RET URN ELSE RETURN 1520 A$="~~Check for new messages:~ for "&NAM$&"~~From who in particular?~(pres s <ENTER> for all)~From who? " :: CALL OUT(A$) 1530 CALL IN(KEY$):: CALL UP(KEY$):: A$="~'A' will A)bort routine~Checking...... ~Hold on to your hat!... " :: CALL OUT(A$) 1540 FST=LML+1 :: LST=LM :: STP=1 :: GOTO 1700 1550 A$="~~Search messages:~" :: CALL OUT(A$) 1560 A$="<ENTER> aborts~Enter a keyword that might be~found in TO,FROM,or SUBJEC T~Keyword-->" :: CALL OUT(A$) 1570 CALL IN(A$):: IF A$="" THEN RETURN 1580 CALL UP(A$):: KEY$=A$ :: A$="~'A' will A)bort routine~ Peeking...." :: CAL L OUT(A$):: PRINT #5:"KEY=";KEY$;","; 1590 FST=FM :: LST=LM :: STP=1 :: GOTO 1700 1600 A$="~Read Titles (with read option):~" :: CALL OUT(A$) 1610 A$="~Titles range from #"&STR$(FM)&" to #"&STR$(LM)&"~zero will abort~Start listing titles with # " :: CALL OUT(A$):: CALL IN(A$) 1620 IF A$="0" THEN RETURN ELSE CALL CN(A$,FM,LM,FST):: IF A$="-" THEN 1610 1630 LST=LM :: STP=1 :: GOTO 1700 1640 A$="~Read messages - forward:~"&STR$(FM)&"-"&STR$(LM)&"~or zero to abort~St art at which message? " :: CALL OUT(A$):: CALL IN(A$) 1650 IF A$="0" THEN RETURN ELSE CALL CN(A$,FM,LM,FST):: IF A$="-" THEN 1640 ELSE LST=LM :: STP=1 :: GOTO 1700 1660 A$="~Read messages - reverse~~" :: CALL OUT(A$):: LML=LM :: STP=-1 :: FST=L M :: LST=FM :: GOTO 1700 1670 A$="~Read new messages~~" :: CALL OUT(A$):: FST=LML+1 :: LST=LM :: STP=1 :: GOTO 1700 1680 A$="Individual read:~"&STR$(FM)&"-"&STR$(LM)&"~or zero to abort~Which messa ge? " :: CALL OUT(A$):: CALL IN(A$):: IF A$="0" THEN RETURN 1690 CALL CN(A$,FM,LM,A):: IF A$="-" THEN 1680 ELSE FST=A :: LST=A :: STP=1 1700 A$="~Reading commands:~P)ause S)kip R)esume A)bort~~" :: CALL OUT(A$) 1710 ON ERROR 2020 1720 FOR Z=FST TO LST STEP STP 1730 CALL FINDREC(Z,READREC):: INPUT #9,REC READREC:MESN,TO$,FROM$,SUB$,DATE$ 1740 IF TO$="DELETED" AND R=6 THEN A$="~Message #"&STR$(Z)&" has been deleted.~" :: CALL OUT(A$):: GOTO 1960 1750 IF TO$="DELETED" THEN 1970 1760 IF SUB$<>"PRIVATE" OR NAM$=SEG$(TO$,1,LEN(NAM$))OR NAM$=FROM$ OR SEG$(VALID $,7,1)="Y" THEN 1790 1770 IF R=6 AND SUB$="PRIVATE" THEN A$="~Message #"&STR$(MESN)&" is private.~~" :: CALL OUT(A$):: GOTO 1960 1780 IF SUB$="PRIVATE" THEN 1970 1790 ON R GOTO 32767,1800,32767,1850,32767,1850,1850,1850,1810,1820,32767 1800 GOSUB 2010 :: IF AA$="A" THEN RETURN ELSE IF TO$=NAM$ AND POS(FROM$,KEY$,1) <>0 THEN 1820 ELSE 1970 1810 GOSUB 2010 :: IF AA$="A" THEN RETURN ELSE IF POS(TO$,KEY$,1)=0 AND POS(FROM $,KEY$,1)=0 AND POS(SUB$,KEY$,1)=0 THEN 1970 ELSE 1820 1820 A$="~Message #"&STR$(MESN)&"~" :: IF R=2 OR R=9 THEN A$=A$&CHR$(7) 1830 A$=A$&"To:"&TO$&"~From:"&FROM$&"~Subject:"&SUB$&"~Date:"&DATE$&"~~~Read now ?(Y)es,(N)o,(A)bort " :: CALL OUT(A$) 1840 CALL KY("YNA",A$,P):: IF P=1 THEN 1880 ELSE IF P=2 THEN 1960 ELSE RETURN 1850 A$="~Message #"&STR$(MESN)&" ~To:"&TO$&"~From:"&FROM$&"~Subject:"&SUB $&"~"&DATE$&"~" :: CALL OUT(A$) 1860 CALL KYCK(LEFT):: IF LEFT=0 THEN 1880 ELSE IF LEFT=1 THEN CALL PAUSE :: GOT O 1880 1870 IF LEFT=2 THEN A$="~SKIP~" :: CALL OUT(A$):: GOTO 1960 ELSE IF LEFT=4 THEN A$="~Aborted~" :: CALL OUT(A$):: RETURN 1880 A$="~" :: CALL OUT(A$) 1890 FOR X=1 TO 12 :: INPUT #9,REC READREC+X:A$ :: IF A$="@END@" THEN 1930 ELSE A$=A$&"~" :: CALL OUT(A$) 1900 CALL KYCK(LEFT):: IF LEFT=0 THEN 1920 ELSE IF LEFT=1 THEN CALL PAUSE :: GOT O 1920 1910 IF LEFT=2 THEN A$="SKIP~" :: CALL OUT(A$):: GOTO 1960 ELSE IF LEFT=4 THEN A $="~Aborted~" :: CALL OUT(A$):: RETURN 1920 NEXT X 1930 A$="~End # "&STR$(MESN)&"~~" :: CALL OUT(A$):: IF TO$<>NAM$ THEN 1950 1940 TO$=TO$&"(del'vd)" :: PRINT #9,REC READREC:MESN;TO$;FROM$;SUB$;DATE$ 1950 IF R=2 OR R=6 OR R=9 THEN 1960 ELSE IF LML<Z THEN LML=Z 1960 IF R=2 THEN A$="~checking..." :: CALL OUT(A$)ELSE IF R=9 THEN A$="~searchin g..." :: CALL OUT(A$) 1970 NEXT Z 1980 IF R=4 OR R=7 OR R=8 THEN A$="~Last message read~" :: CALL OUT(A$) 1990 IF R=2 OR R=9 OR R=10 THEN A$="~~All messages scanned~" :: CALL OUT(A$) 2000 CALL ENT :: RETURN 2010 CALL LINK("DCDCHK",AA$):: CALL UP(AA$):: IF AA$="A" THEN A$="~Search aborte d~" :: CALL OUT(A$):: RETURN ELSE RETURN 2020 PRINT #5:"****Can't read ";MESN+1: :: ON ERROR 2020 :: RETURN 1970 2030 A$="~~The official Bullwinkle's Corner~user log~~" :: CALL OUT(A$) 2040 OPEN #6:"DSK1.UFILE",INTERNAL,INPUT ,RELATIVE,FIXED 126 2050 INPUT #6,REC 0:AM$,CALLS$,AU$,LF$ 2060 IF AM$="0" THEN A$="There are no validated users~at this time" :: CALL OUT( A$):: GOTO 2290 2070 A$="~C)omputer search, L)ist or N)ame Search?~Choice-(C,L,N)->" :: CALL OUT (A$):: CALL KY("CLN",A$,R):: IF R=2 THEN 2110 2080 IF R=1 THEN A$=" <ENTER> aborts~Enter segment of type:" :: CALL OUT(A$):: C ALL IN(A$):: CALL UP(A$) 2090 IF R=3 THEN A$=" <ENTER> aborts~Enter segment of name:" :: CALL OUT(A$):: C ALL IN(A$):: CALL UP(A$) 2100 IF A$="" THEN CLOSE #6 :: RETURN ELSE RR=1 :: EA$=A$ :: A$="Searching..." : : CALL OUT(A$):: GOTO 2140 2110 A$="There are "&AM$&" tickets for the show....~Start listing with user# " : : CALL OUT(A$):: CALL IN(RR$) 2120 CALL CN(RR$,1,VAL(AM$),RR):: IF RR$="-" THEN 2110 2130 A$="~~Commands:~ P)ause R)esume A)bort~~" :: CALL OUT(A$):: GOTO 2150 2140 A$="~~Commands:~ A)bort~~" :: CALL OUT(A$) 2150 FOR X=RR TO VAL(AM$) 2160 INPUT #6,REC X:AA$,B$,F$,D$,E$,A1$,A1$,F$,F$ 2170 ON R GOTO 2190,2200,2180 2180 IF POS(AA$,EA$,1)=0 THEN 2250 ELSE 2200 2190 CALL UP(A1$):: IF POS(A1$,EA$,1)=0 THEN 2250 ELSE 2200 2200 IF AA$="DELETED" OR AA$="RESERVED" THEN 2250 2210 A$="~Name: "&AA$&"~User # "&STR$(X)&"~From: "&B$ :: CALL OUT(A$) 2220 A$="~Times tuned in: "&D$&"~" :: CALL OUT(A$) 2230 A$="Last tuned in: "&E$&"~Computer type:"&A1$&"~Validated:"&SEG$(F$,1,1)&"~ " :: CALL OUT(A$) 2240 IF R=1 OR R=3 THEN A$="~Searching..." :: CALL OUT(A$) 2250 CALL KYCK(LEFT):: IF LEFT=0 THEN 2280 2260 IF LEFT=1 AND R=2 THEN CALL PAUSE :: GOTO 2280 2270 IF LEFT=4 THEN CLOSE #6 :: A$="~ABORTED~" :: CALL OUT(A$):: RETURN 2280 NEXT X 2290 CLOSE #6 2300 A$="~End of viewers...~" :: CALL OUT(A$):: CALL ENT :: RETURN 2310 PRINT #6,REC USER:NAM$;ADR$;PASS$;CALL$;T3$;PH$;COM$;UF$;VALID$;LML :: RETU RN 2320 INPUT #6,REC USER:NAM$,ADR$,PASS$,CALL$,DATE$,PH$,COM$,UF$,VALID$,LML 2330 RETURN 2340 OPEN #6:"DSK1.UFILE",UPDATE,INTERNAL,RELATIVE,FIXED 126 2350 PRINT #6,REC USER:NAM$;ADR$;PASS$;CALL$;T3$;PH$;COM$;UF$;VALID$;LML :: CLOS E #6 :: RETURN 2360 L=0 :: A$="~~Bullwinkle's Corner electrical usage~and cost evaluation:~~Usa ge/kwh Rate Cost Date~~" :: CALL OUT(A$) 2370 OPEN #84:"DSK1.METER",INPUT ,RELATIVE,INTERNAL,FIXED 40 :: INPUT #84,REC 0: A,A,A,A$ :: IF A=2 THEN X=1 ELSE X=2 2380 INPUT #84,REC X:F$,Z,RR :: E$=STR$(Z):: RR$=SEG$(STR$(RR),1,6):: B$="$"&STR $(Z*RR) 2390 A$=E$&" $"&RR$&" "&B$&" "&F$&"~" :: CALL OUT(A$):: L=L+(Z*RR):: X= X+1 2400 IF X<>A THEN 2380 2410 CLOSE #84 :: A$="~~Total Corner electrical cost~to date: $"&STR$(L):: CALL OUT(A$) 2420 A$="~~~End of cost evaluation~" :: CALL OUT(A$):: CALL ENT :: RETURN 2430 A$="~~Change your password:~--> LIMIT 7 CHARACTERS! <--~<ENTER> aborts~I wi sh it was-->" :: CALL OUT(A$):: CALL IN(CPASS$) 2440 IF LEN(CPASS$)>7 THEN 2430 ELSE IF CPASS$="" THEN RETURN 2450 A$="~Your wish is granted!~Please wait while I update your file...~~" :: CA LL OUT(A$) 2460 PASS$=CPASS$ :: GOSUB 2340 :: A$="File updated~Be sure to make a note of th e change~Your old password is no longer valid!!~~" 2470 CALL OUT(A$):: CALL DEL(250):: RETURN 2480 IF XP=1 THEN 2680 2490 A$="~~* ASCII Files *~~ File"&RPT$(" ",18)&"Last Updated~"&RPT$("-",40)&"~ ~A)bort to main" :: CALL OUT(A$) 2500 A1$="~B)ulletins" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(1):: CALL OUT(A$) 2510 A1$="~C)urios" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(15):: CALL OUT(A$) 2520 A1$="~E)ditorials etc." :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(14):: CALL OUT (A$) 2530 A1$="~F)ile transfer list (BD#3)" :: A$=A1$&RPT$("-",28-LEN(A1$))&"See subm enu" :: CALL OUT(A$) 2540 A1$="~G)eneve & TI articles" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(18):: CAL L OUT(A$) 2550 A1$="~H)ymn" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(12):: CALL OUT(A$) 2560 A1$="~I)nfo/system" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(2):: CALL OUT(A$) 2570 A1$="~L)ogon flash files" :: A$=A1$&RPT$("-",30-LEN(A1$))&"n/a" :: CALL OUT (A$) 2580 A1$="~M)ap of Bullwinkle's Corner" :: A$=A1$&RPT$("-",30-LEN(A1$))&"n/a" :: CALL OUT(A$) 2590 A1$="~N)ew users:policies/tips" :: A$=A1$&RPT$("-",30-LEN(A1$))&"n/a" :: CA LL OUT(A$) 2600 A1$="~O)ther systems" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(3):: CALL OUT(A$ ) 2610 A1$="~P)oints to ponder" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(4):: CALL OUT (A$) 2620 A1$="~R)eveal last mystery" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(17):: CALL OUT(A$) 2630 A1$="~S)olve this mystery!" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(16):: CALL OUT(A$) 2640 A1$="~T)itle screen" :: A$=A1$&RPT$("-",30-LEN(A1$))&"n/a" :: CALL OUT(A$) 2650 A1$="~U)sers Groups (TI)" :: A$=A1$&RPT$("-",30-LEN(A1$))&"n/a" :: CALL OUT (A$) 2660 A1$="~V)ote box (previous)" :: A$=A1$&RPT$("-",30-LEN(A1$))&FDT$(5):: CALL OUT(A$) 2670 GOTO 2690 2680 A$="~* ASCII files *~" :: CALL OUT(A$) 2690 A$="~Choice->A,B,C,E,F,G,H,I,L,M,N,O,P,R,S,T,U,,V?~--->" :: CALL OUT(A$):: CALL KY("ABCEFGHILMNOPRSTUV?",A$,R) 2700 PRINT #5:"/FILE,";:: IF A$="?" THEN 2490 2710 IF A$="A" THEN RETURN 2720 IF A$<>"L" THEN 2830 2730 OPEN #20:"DSK2.FLASH",INPUT 2740 FOR P=1 TO 9 :: AA$="@S"&STR$(P)&"@" 2750 LINPUT #20:A$ :: IF A$<>AA$ THEN 2750 ELSE AA$="~File # "&STR$(P)&":~~" 2760 LINPUT #20:A$ :: IF POS(A$,"EMPTY FILE",1)>0 THEN 2810 ELSE CALL OUT(AA$):: A$=A$&"~" :: CALL OUT(A$) 2770 AA$="@E"&STR$(P)&"@" 2780 LINPUT #20:A$ :: IF A$=AA$ THEN 2800 2790 A$=A$&"~" :: CALL OUT(A$):: GOTO 2780 2800 A$="~" :: CALL OUT(A$):: CALL ENT 2810 NEXT P 2820 CLOSE #20 :: GOTO 2480 2830 IF A$<>"F" THEN 2940 2840 A$="~~Select system type:~~0 - Abort this menu~" :: CALL OUT(A$) 2850 A1$="1 - TI" :: A$=A1$&RPT$("-",24-LEN(A1$))&FDT$(6)&"~" :: CALL OUT(A$) 2860 A1$="2 - Geneve" :: A$=A1$&RPT$("-",24-LEN(A1$))&FDT$(7)&"~" :: CALL OUT(A$ ) 2870 A1$="3 - Atari" :: A$=A1$&RPT$("-",24-LEN(A1$))&FDT$(8)&"~" :: CALL OUT(A$) 2880 A1$="4 - Commodore" :: A$=A1$&RPT$("-",24-LEN(A1$))&FDT$(9)&"~" :: CALL OUT (A$) 2890 A1$="5 - Pics(GIF,RLE etc.)" :: A$=A1$&RPT$("-",24-LEN(A1$))&FDT$(11)&"~" : : CALL OUT(A$) 2900 A1$="6 - IBM" :: A$=A1$&RPT$("-",24-LEN(A1$))&FDT$(10)&"~" :: CALL OUT(A$) 2910 A$="~~Select number--->" :: CALL OUT(A$):: CALL KY("1234560",A$,P):: IF P=7 THEN 2480 2920 FNM$="DL/"&DLF$(P) 2930 OPEN #20:"DSK2."&FNM$,DISPLAY ,VARIABLE,INPUT :: GOTO 2950 2940 OPEN #20:"DSK2.FILE/"&A$,DISPLAY ,VARIABLE,INPUT 2950 A$="~Reading Commands:~ P)ause R)esume A)bort~~~" :: CALL OUT(A$) 2960 IF EOF(20)THEN CLOSE #20 :: GOTO 3010 2970 CALL KYCK(LEFT):: IF LEFT=0 THEN 2990 ELSE IF LEFT=1 THEN CALL PAUSE :: GOT O 2990 2980 IF LEFT=4 THEN CLOSE #20 :: A$="~Aborted~" :: CALL OUT(A$):: IF A1$="RT" TH EN RETURN ELSE 2480 2990 LINPUT #20:A$ :: IF A$="@S@" OR A$="@E@" THEN 2960 3000 A$=A$&"~" :: CALL OUT(A$):: GOTO 2960 3010 A$="~~End of File-" :: CALL OUT(A$):: CALL ENT :: IF A1$="RT" THEN RETURN E LSE 2480 3020 A$="~~Getting topic voted on...." :: CALL OUT(A$) 3030 OPEN #59:"DSK2.FLASH",INPUT 3040 LINPUT #59:A$ :: IF SEG$(A$,1,2)<>"@V" THEN 3040 ELSE A$="~~" :: CALL OUT(A $) 3050 IF EOF(59)THEN CLOSE #59 :: GOTO 3070 3060 LINPUT #59:A$ :: IF A$="@E@" THEN CLOSE #59 :: GOTO 3070 ELSE A$=A$&"~" :: CALL OUT(A$):: GOTO 3050 3070 A$="~~Vote results so far:~~" :: CALL OUT(A$):: P=0 3080 OPEN #67:"DSK1.BALLOT",INPUT ,RELATIVE,INTERNAL,FIXED 15 :: INPUT #67,REC 0 :Z 3090 FOR X=1 TO Z-1 :: INPUT #67,REC X:RS(X):: P=P+RS(X):: NEXT X 3100 CLOSE #67 :: IF P=0 THEN P=1 3110 IF P<11 THEN A$="~Insufficient amount of votes to report" :: CALL OUT(A$):: GOTO 3130 3120 FOR X=1 TO Z-1 :: A$="number "&STR$(X)&"-"&STR$(INT((RS(X)/P)*10000)/100)&" %~" :: CALL OUT(A$):: NEXT X 3130 A$="~~" :: CALL OUT(A$):: CALL ENT :: RETURN 3140 !************************************************** BEGIN ERROR ROUTINE S AND SUBPROGRAMS **************************** 3150 CALL ERR(E1,E2,E3,E4) 3160 EA$=A$ :: A$="~~ERROR in board~please wait while error is logged~" :: CALL OUT(A$) 3170 DISPLAY AT(23,3):"IN ERROR ROUTINE" :: CALL SAY("UHOH I HAVE AN ERROR IN PR OGRAM A") 3180 PRINT #5: : : :RPT$("ERROR ",21) 3190 IF USER>3 THEN 3210 ELSE A$="~ERROR: "&STR$(E1)&" "&STR$(E2)&" "&STR$(E3)&" "&STR$(E4)&"~A$="&EA$&"~" :: CALL OUT(A$) 3200 CALL DEL(1000) 3210 PRINT #5:"********** ERROR **********in BOARDA" :: PRINT #5:"Error code:";E 1;E2;E3;E4 3220 PRINT #5:"READREC=";READREC;" MESN=";MESN;" A$=";:: PRINT #5:EA$ 3230 PRINT #5:RPT$("ERROR ",21): : : : 3240 RETURN 290 3250 !@P+ 3260 SUB RING(NAM$) 3270 A$="~~~Ring Chat:~~~What do you wish to chat about? " :: CALL OUT(A$):: CAL L IN(C$) 3280 IF C$="" THEN A$="~I can't hear you!!!!!~" :: CALL OUT(A$):: GOTO 3270 3290 IF LEN(C$)<3 OR SEG$(C$,1,1)=SEG$(C$,2,1)THEN A$="~Is that in code??~" :: C ALL OUT(A$):: GOTO 3270 3300 DISPLAY AT(5,1):"Chat:";C$ 3310 A$="~~Chat mode~~~~Let me see if someone is nearby~Hey Someone!~"&NAM$&" is callin'~~" :: CALL OUT(A$) 3320 PRINT #5: :"*** Chat request from ";NAM$;" on the subject of ";C$; 3330 FOR X=1 TO 25 :: CALL SOUND(10,1000+(X*4),0,500+(X*4),0,-4,0):: NEXT X 3340 A$="Bells and sirens have gone off!~If anyone is available,~they'll break i n~~" :: CALL OUT(A$) 3350 PRINT #5:"*** Main menu-BD#1(cont'd)";:: CALL ENT 3360 SUBEND 3370 SUB LOFF(CALL$,FN$,USER,NAM$,VALID$) 3380 A1$="" :: IF CALL$<>"1" THEN 3440 3390 A$="~In order for you to be validated, I may~call you to verify your phone number.~" :: CALL OUT(A$) 3400 IF CALL$="1" AND SEG$(VALID$,1,1)="Y" THEN 3410 ELSE 3420 3410 A$=CHR$(7)&"~~Your user file HAS BEEN AUTO-VALIDATED. If you do not want yo ur user~file deleted, select Y)es~~"&CHR$(7):: CALL OUT(A$) 3420 A$="Do you wish to be validated for full~access to this system?? (Y/N)" :: CALL OUT(A$):: CALL YN(A1$):: IF A1$="N" THEN 3440 3430 A$="~If I don't call you in a few days,~check back here-you may already be validated~Thanks for the visit,"&FN$&".~~" :: CALL OUT(A$) 3440 A$="~~~Are you sure you want to logoff? Y/N " :: CALL OUT(A$):: CALL YN(A$) 3450 IF A$<>"Y" THEN SUBEXIT 3460 CALL TIM(T1$,T2$,T3$):: A$="~~Thanks for tuning in...~"&FN$&" tuned out...~ "&T3$&"~Bye... " :: CALL OUT(A$):: IF A1$="N" THEN 3490 3470 A$="~Remember to call at least every 90 days~or your user# will be thrown~t o the flounder!...(yuck!!)~~~" :: CALL OUT(A$) 3480 A$="~~~Hope you enjoyed the show.~See ya next time.~-->disconnected<--~~" : : CALL OUT(A$) 3490 CALL LINK("OFHOOK"):: IF A1$<>"N" THEN 3530 3500 OPEN #6:"DSK1.UFILE",UPDATE,INTERNAL,RELATIVE,FIXED 126 3510 PRINT #6,REC USER:"DELETED";"DELETED";"DELETED";"DELETED";"DELETED";"DELETE D";"DELETED";"DELETED";"DELETED";0 :: CLOSE #6 3520 PRINT #5:"User #";USER;" does not wish to be validated->has been deleted" 3530 PRINT #5: :"USER "&FN$&" "&STR$(USER)&" LOGGED OFF "&T3$:RPT$("=",121);" LO GGED OFF" :: RUN "DSK1.LOGON" 3540 SUBEND 3550 SUB TIM(T1$,T2$,T3$) 3560 DEF TIME=TV1-6*INT(TV1/16)!BCD to Decimal Converter 3570 CALL PEEK(-31158,X1,X2,C,X4,X5):: TV1=C :: A1$=STR$(TIME):: TV1=X5 :: X5=TI ME :: T2$=STR$(X5)&"/"&A1$&"/94" 3580 CALL PEEK(-31164,X1,X2,X3,X4,X5):: TV1=X1 :: SEC$=STR$(TIME):: IF X1<10 THE N SEC$="0"&SEC$ 3590 TV1=X3 :: MIN$=STR$(TIME):: IF X3<10 THEN MIN$="0"&MIN$ 3600 TV1=X5 :: HR=TIME :: M$="am" :: IF HR>11 THEN M$="pm" 3610 IF HR=0 THEN HR=12 3620 IF HR>12 THEN HR=HR-12 3630 HR$=STR$(HR):: T1$=HR$&":"&MIN$&M$ :: T3$=T2$&" "&T1$ 3640 SUBEND 3650 SUB CNG(USER,XP,BD,FN$,NAM$,PASS$,VALID$) 3660 A$="~~Select board:~~ 1 Return (Board #1)~ 2 Board #2~ 3 Board #3~" :: E =3 :: CALL OUT(A$) 3670 IF SEG$(VALID$,10,1)<>"Y" THEN 3690 3680 A$=" 4 Remote~~" :: CALL OUT(A$):: E=4 3690 A$="~~Choice-->" :: CALL OUT(A$):: CALL KY("1234",A$,R) 3700 CALL CN(A$,1,E,A):: IF A$="-" THEN 3660 3710 IF A=1 THEN SUBEXIT 3720 A$="~~Loading Board "&STR$(A)&"~Please wait...." :: CALL OUT(A$) 3730 OPEN #10:"DSK1.TRANSFILE",INTERNAL,OUTPUT,FIXED 80 :: PRINT #10:USER;XP;BD; FN$;NAM$;PASS$ :: CLOSE #10 3740 ON A GOTO 3660,3750,3760,3770 3750 RUN "DSK1.BOARDB" 3760 RUN "DSK1.BOARDC" 3770 RUN "DSK1.REMOTE" 3780 SUBEND 3790 SUB YN(A$) 3800 CALL CK :: CALL LINK("DCDCHK",A$) 3810 IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR$(13)THEN 3800 ELSE CALL UP(A$) 3820 IF A$="Y" THEN A1$="Yes~" ELSE IF A$="N" THEN A1$="No~" ELSE A1$=CHR$(7):: CALL OUT(A1$):: GOTO 3800 3830 CALL OUT(A1$):: SUBEND 3840 SUB HANGUP 3850 CALL LINK("OFHOOK"):: CALL DEL(2000):: A$="ATZ"&CHR$(13):: CALL LINK("OUTPU T",A$):: RUN "DSK1.LOGON" 3860 SUBEND 3870 SUB IN(A$):: CALL LINK("INPUT",A$):: CALL CK :: SUBEND 3880 SUB OUT(A$):: CALL LINK("OUTPUT",A$):: CALL CK :: SUBEND 3890 SUB UP(A$):: CALL LINK("UPPER",A$):: SUBEND 3900 SUB ENT :: A$="Press <ENTER> " :: CALL OUT(A$):: CALL IN(A$):: SUBEND 3910 SUB CK :: CALL KEY(0,K,ST):: IF K=135 THEN A$="~Have a BOOT!~~" :: CALL LIN K("OUTPUT",A$):: PRINT #5:"**MANUAL BOOT!!**" :: CALL HANGUP 3920 IF K<>129 THEN 3990 3930 A$="~~Please stand by.....~Board is under SysOp control...~~~~" :: CALL LIN K("OUTPUT",A$) 3940 DISPLAY AT(23,1)BEEP:"1-BdB 2-BdC 3-Manager":"4-Return Spacebar-Cha t" 3950 CALL KEY(0,K,S):: IF S=0 THEN 3950 ELSE IF K=145 THEN 3990 3960 IF K=49 THEN RUN "DSK1.BOARDB" ELSE IF K=50 THEN RUN "DSK1.BOARDC" 3970 IF K=51 THEN RUN "DSK1.MANAGER" ELSE IF K=52 THEN 3990 ELSE IF K=32 THEN 39 80 ELSE 3950 3980 CALL LINK("DCDCHK",A$) 3990 A$="" :: CALL LINK("JOYST",A$):: IF LEN(A$)=0 THEN SUBEXIT 4000 PRINT #5:"***HANGUP***" :: CALL HANGUP 4010 SUBEND 4020 SUB CN(A$,MN,MX,A) 4030 IF A$="" THEN 4070 4040 FOR X=1 TO LEN(A$):: IF POS("0123456789",SEG$(A$,X,1),1)=0 THEN 4070 4050 NEXT X 4060 A=VAL(A$):: IF A<MN OR A>MX THEN 4070 ELSE SUBEXIT 4070 A$=CHR$(7)&"~Invalid entry~" :: CALL OUT(A$):: A$="-" :: SUBEND 4080 SUB KY(A1$,A$,R) 4090 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)OR A$="" THEN 4090 4100 CALL UP(A$):: R=POS(A1$,A$,1):: IF R=0 THEN A$=CHR$(7)&"Invalid entry~-->" :: CALL OUT(A$):: GOTO 4090 4110 A1$=A$&"~" :: CALL OUT(A1$):: PRINT #5:A$;",";:: SUBEND 4120 SUB DEL(A) 4130 FOR X=1 TO A :: NEXT X 4140 SUBEND 4150 SUB CBT(A$,BOOT$()) 4160 A1$=A$ :: CALL UP(A1$) 4170 FOR X=1 TO 10 :: IF POS(A1$,BOOT$(X),1)=0 THEN 4190 4180 PRINT #5:"**BOOT!!**-LINE EARNING BOOT=";A$ :: A$="~You've earned a BOOT!" :: CALL OUT(A$):: CALL HANGUP 4190 NEXT X 4200 SUBEND 4210 SUB KYCK(LEFT) 4220 CALL LINK("DCDCHK",A$):: CALL UP(A$):: LEFT=POS("PSRA",A$,1):: SUBEND 4230 SUB PAUSE 4240 A$="R)esume " :: CALL OUT(A$) 4250 CALL CK :: CALL LINK("DCDCHK",A$):: CALL UP(A$):: IF A$="R" THEN A$=RPT$(CH R$(8),8):: CALL OUT(A$):: SUBEXIT 4260 GOTO 4250 4270 SUBEND 4280 SUB FINDREC(A,NEWREC):: IF LEN(STR$(A))=1 THEN NEWREC=A*13+1 :: SUBEXIT 4290 NEWREC=VAL(SEG$(STR$(A),LEN(STR$(A))-1,2)):: NEWREC=NEWREC*13+1 :: SUBEND

go back up to the top

BoardB - games

The BoardB code was written by S. Clarke with concept and design by S. Clarke and W. Blew

10 !@P+ 20 GOTO 70 ! V.JAN 1 1994 *BOARDB* BULLWINKLE'S CORNER 30 A$,ADR$,AN$,C$,CALL$,CD$,COM$,DATE$,EA$,FN$,L$,M$,NAM$,PASS$,PH$,PK$,R$,SW$,T 1$,T2$,T3$,UF$,VALID$,WORD$="" 40 AN,AV,BD,C,CB,CO,CU,D,DC,DD,E1,E2,E3,E4,F,FB,FS,I,J,K,L,LB,LML,LX,M,MB,MISS,M O,MS,N,NC,NET,NF,NL,NM,NN,NS,OW,P,R,S,SB,SP,USER,V,XP,X=0 50 Y,Z,Z1,Z2,Z3=0 60 CALL CLEAR :: CALL COLOR :: CALL ERR :: CALL KEY :: CALL LINK :: CALL PEEK :: CALL SAY :: CALL SCREEN :: CALL SOUND :: CALL ERR 70 CALL SAY("PROGRAM B"):: CALL KEY(4,X,X) 80 OPTION BASE 0 90 DIM WD$(26),E$(51),A(21),B(21) 100 !@P- 110 OPEN #27:"DSK1.DEFAULTF",INPUT ,INTERNAL,RELATIVE,FIXED 20 :: INPUT #27,REC 1:C$ :: CLOSE #27 120 OPEN #5:"RS232/2.BA="&C$,VARIABLE 132 130 CALL CK :: OPEN #10:"DSK1.TRANSFILE",INTERNAL,INPUT ,FIXED 80 :: INPUT #10:U SER,XP,BD,FN$,NAM$,PASS$ :: CLOSE #10 140 X=1 :: A$=CHR$(7)&"~~Loading your user file..." :: CALL OUT(A$) 150 OPEN #6:"DSK1.UFILE",UPDATE,INTERNAL,RELATIVE,FIXED 126 :: GOSUB 3150 :: CLO SE #6 160 CALL LINK("DCDCHK",A$):: A$="~Enter password for verification~--->" :: CALL OUT(A$):: CALL LINK("SECRET",A$) 170 IF POS(A$,"/",1)>0 THEN A$=SEG$(A$,POS(A$,"/",1)+1,LEN(A$)-1-LEN(STR$(USER)) ) 180 IF A$<>PASS$ THEN X=X+1 ELSE 210 190 IF X>=8 THEN A$="Sorry, too namy tries...BYE!!!" :: CALL OUT(A$):: PRINT #5: "INVALID PASSWORD" :: CALL HANGUP 200 A$="Nope...try again~~~" :: CALL OUT(A$):: GOTO 160 210 PRINT #5:"Main-BD#2:"; 220 ON ERROR 3180 230 CALL TIM(T1$,T2$,T3$):: A$="~"&T3$&"~" :: CALL OUT(A$) 240 IF XP=1 THEN 310 250 A$="~~~%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~% BULLWINKLE'S CORNER * BD #2:MENU %~" :: CALL OUT(A$) 260 A$="%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~" :: CALL OUT(A$) 270 A$="~G)oodbye~" :: CALL OUT(A$) 280 A$="J)ump boards~P)lay games~" :: CALL OUT(A$) 290 A$="S)end mess.=>SysOp~" :: CALL OUT(A$) 300 A$="X)pert [on/off]~Y)ell for SysOp~" :: CALL OUT(A$):: GOTO 320 310 A$="~~Main menu:BD#2" :: CALL OUT(A$) 320 A$="~Choice->G,J,P,S,X,Y or ?~--->" :: CALL OUT(A$):: CALL KY("GJPSXY?",A$,P ) 330 ON P GOTO 340,380,390,350,370,360,250 340 CALL LOFF(FN$,USER,NAM$,VALID$):: GOTO 220 350 CALL SEND(NAM$,USER,VALID$):: GOTO 220 360 CALL RING(NAM$):: GOTO 220 370 IF XP=0 THEN XP=1 :: A$="~Expert mode on.....~" :: CALL OUT(A$):: GOTO 220 E LSE XP=0 :: A$="Expert mode off....~" :: CALL OUT(A$):: GOTO 220 380 CALL CNG(USER,XP,BD,FN$,NAM$,PASS$):: GOTO 220 390 A$="~~Corner Games:~" :: CALL OUT(A$):: IF XP=1 THEN 430 400 A$="~~A)bort~B)oggle board~C)ar dealer~" :: CALL OUT(A$) 410 A$="D)epth charges~H)angman~N)im~R)iver~" :: CALL OUT(A$) 420 A$="S)equences~T)ext adventure~" :: CALL OUT(A$) 430 A$="~Choice->A,B,C,D,H,N,R,S,T or ?~--->" :: CALL OUT(A$):: CALL KY("AHNCDRS BT?",A$,P):: IF P=10 THEN 400 ELSE IF P=1 THEN 220 440 ON P GOSUB 220,790,460,1240,1940,2310,2590,3130,3140,400 450 GOTO 390 460 A$=" The Game of NIM~~Developed from a very ancient oriental~game.~~Transcri bed by Steve Clarke~~" :: CALL OUT(A$) 470 CALL INST(A$):: IF A$="N" THEN 550 480 A$="This is a game that has eluded many men~many times.~" :: CALL OUT(A$) 490 A$="A number of charms, chosen by you will~be shown on the screen. You may a t any~" :: CALL OUT(A$) 500 A$="turn take away 1,2, or 3 charms. then~I will take 1, 2, or 3 charms.~" : : CALL OUT(A$) 510 A$="The object is to force me to take the~last charm, as I will attempt to f orce~" 520 A$=A$&"you to take the last one. The loser~is the one stuck with taking the last~charm.~~" :: CALL OUT(A$) 530 A$="EXAMPLE:4 charms remaining, your turn:~You will take 3 charms, leaving m e with~the last one.~" :: CALL OUT(A$) 540 A$="~<ENTER> to play " :: CALL OUT(A$):: CALL IN(A$) 550 A$="~~Do you want:~~ 1> To have an advantage~ 2> Fair play ? " :: CALL OUT (A$):: CALL KY("12",AN$,P):: C=VAL(AN$) 560 A$="~~Select who goes first:~~ 1> Mere human~ 2> TI 99/4A ? " :: CALL OUT(A $):: CALL KY("12",AN$,P):: X=VAL(AN$) 570 A$="~~Select the number of charms~from 50 to 100. ? " :: CALL OUT(A$):: CAL L IN(A$):: CALL CN(A$,50,100,N):: IF A$="-" THEN 570 580 NN=N 590 P=1 :: P=P+1 :: IF P>=NN THEN 600 ELSE P=P+1 600 A$="Charms taken "&STR$(NM)&"~Charms left "&STR$(N)&"~"&RPT$("@",N)&"~" :: C ALL OUT(A$) 610 IF X=1 THEN 620 ELSE A$="~ My turn.~" :: CALL OUT(A$) 620 IF X=2 THEN 650 ELSE A$="~ Your turn.~" :: CALL OUT(A$) 630 A$="~* means you give up!!~Select 1,2,3 or * " :: CALL OUT(A$):: CALL KY(" 123*",AN$,P):: IF AN$="*" THEN RETURN ELSE NM=VAL(AN$) 640 N=N-NM :: IF N=1 THEN 710 ELSE X=2 :: GOTO 590 650 IF N>40 THEN 690 ELSE IF X=2 THEN NM=1 660 IF (N-2)/4<>INT((N-2)/4)THEN 670 ELSE N=N-NM :: IF N=1 THEN 750 ELSE X=1 :: GOTO 590 670 NM=2 :: IF (N-3)/4<>INT((N-3)/4)THEN 680 ELSE N=N-NM :: IF N=1 THEN 750 ELSE X=1 :: GOTO 590 680 NM=3 :: IF (N-4)/4<>INT((N-4)/4)THEN 690 ELSE N=N-NM :: IF N=1 THEN 750 ELSE X=1 :: GOTO 590 690 RANDOMIZE :: NM=INT(RND*3)+1 :: N=N-NM :: X=1 :: GOTO 590 700 X=1 :: GOTO 590 710 A$="~~You have beaten me fair and square.~I congratulate you.~I hope you hav e enjoyed playing NIM.~~" :: CALL OUT(A$) 720 A$="~~~ Good goin'!~~" :: CALL OUT(A$) 730 A$="~~You have taken "&STR$(NM)&" charm(s)~leaving me with "&STR$(N)&" charm .~~" :: CALL OUT(A$) 740 GOTO 780 750 A$="~~I have beaten you fair and square!!~Do not give up but try me~again so metime!~~" :: CALL OUT(A$) 760 A$="I am not unbeatible!!!~~" :: CALL OUT(A$) 770 A$="I have taken "&STR$(NM)&" charm(s)~leaving you with "&STR$(N)&" charm.~~ (which was the last!)~~" :: CALL OUT(A$) 780 CALL ENT :: RETURN 790 A$="~~ Play HANGMAN!!~be right with you..." :: CALL OUT(A$):: OPEN #36:"DSK1 .HANGMAN",INPUT ,INTERNAL,RELATIVE,FIXED 32 800 FOR NF=1 TO 24 :: INPUT #36,REC NF:WD$(NF):: NEXT NF 810 CLOSE #36 820 R$="" :: NM=0 830 FOR X=1 TO LEN(WD$(24)) 840 IF SEG$(WD$(24),X,1)=" " THEN R$=R$&" " ELSE R$=R$&"_" 850 NEXT X 860 EA$=R$ 870 A$="~Word list is from 1 to 23~Where do you wish to start? #" :: CALL OUT(A$ ):: CALL IN(A$):: CALL CN(A$,1,23,NL):: IF A$="-" THEN 870 880 FOR NF=NL TO 23 890 PK$="" :: MISS=0 :: A$="~HERE COMES HANGMAN !!!!~" :: CALL OUT(A$) 900 A$="~Todays theme is "&EA$&"~~" :: CALL OUT(A$) 910 WORD$=WD$(NF):: A$="Word #"&STR$(NF)&"~" :: CALL OUT(A$):: Z=0 :: SW$="" 920 FOR X=1 TO LEN(WORD$) 930 IF SEG$(WORD$,X,1)=" " THEN SW$=SW$&" " :: E$(X)=" " ELSE SW$=SW$&"_" :: E$( X)="_" :: Z=Z+1 940 NEXT X 950 A$="* aborts game~" :: CALL OUT(A$) 960 M$=STR$(Z):: A$="~~The word you are looking for~has "&M$&" letters~~ "&SW$&" ~~Select a letter or * " :: CALL OUT(A$) 970 CALL KY("ANY",L$,P):: IF L$="*" THEN RETURN 980 IF ASC(L$)<65 OR ASC(L$)>90 THEN A$="~Try picking a letter!!!~Reselect-->" : : CALL OUT(A$):: GOTO 970 990 IF POS(PK$,L$,1)=0 THEN 1010 1000 A$=CHR$(7)&"Duplicate choice~Select a letter or * " :: CALL OUT(A$):: GOTO 970 1010 PK$=PK$&L$ :: P=POS(WORD$,L$,1):: IF P=0 THEN 1070 1020 FOR X=1 TO LEN(WORD$):: IF SEG$(WORD$,X,1)=L$ THEN E$(X)=L$ 1030 NEXT X :: SW$="" 1040 FOR X=1 TO LEN(WORD$):: SW$=SW$&E$(X):: NEXT X 1050 IF POS(SW$,"_",1)<>0 THEN 1080 1060 IF POS(SW$,"_",1)=0 THEN A$="~Congratulations!!~The word is "&WORD$&"~" :: CALL OUT(A$):: CALL ENT :: GOTO 1100 1070 A$="~~There are no "&L$&"'s~~" :: CALL OUT(A$):: MISS=MISS+1 :: IF MISS=5 T HEN 1090 1080 A$="~The word is "&SW$&"~you've already chosen "&PK$&"~Misses="&STR$(MISS)& "~~Select a letter or * " :: CALL OUT(A$):: GOTO 970 1090 A$="~Sorry! you're out with 5 misses.~" :: CALL OUT(A$):: CALL ENT 1100 IF NM>0 THEN 1220 1110 A$="~~What is the current theme?~~"&EA$&"~~? " :: CALL OUT(A$):: CALL IN(A$ ):: CALL UP(A$) 1120 IF A$<>"" THEN PRINT #5:A$;","; 1130 SW$="" 1140 IF A$=WD$(24)THEN EA$=A$ :: A$="~That's it!! Good job!!~~" :: CALL OUT(A$): : NM=1 :: GOTO 1220 1150 SW$="~~Lets see what letters match up....." :: CALL OUT(SW$):: SW$="" 1160 FOR X=1 TO LEN(WD$(24)) 1170 IF SEG$(WD$(24),X,1)=" " THEN SW$=SW$&" " :: GOTO 1190 1180 IF SEG$(A$,X,1)=SEG$(WD$(24),X,1)THEN SW$=SW$&SEG$(WD$(24),X,1)ELSE SW$=SW$ &"_" 1190 NEXT X 1200 A$="~~No, that's not it, "&FN$&", but keep on trying!!!~~~" :: CALL OUT(A$) 1210 A$="~You've gotten this much correct:~ "&SW$&"~~" :: CALL OUT(A$):: EA$=SW$ 1220 NEXT NF 1230 A$="~All words have been played-" :: CALL OUT(A$):: CALL ENT :: RETURN 1240 A$="~~~Car dealer~~" :: CALL OUT(A$) 1250 CALL INST(A$):: IF A$="N" THEN 1350 1260 A$="You are a car dealer who sells five types~of cars. Compact, midsize, fu llsize,~luxury and sports cars." :: CALL OUT(A$) 1270 A$=" The following~table shows the cost and selling price~of each car.~~" : : CALL OUT(A$) 1280 A$="CAR COST PRICE~---------------------------~Compact 560 0 6000~" :: CALL OUT(A$) 1290 A$="Midsize 6600 7000~Fullsize 7500 8000~Luxury 10300 11000~Sports 11000 12000~~" :: CALL OUT(A$) 1300 CALL ENT 1310 A$="~~In a typical month you can expect to~sell about 20 cars. You can orde r as~many cars " :: CALL OUT(A$) 1320 A$="as you wish but you must~pay 2% interest on the cost of all~unsold cars for that " :: CALL OUT(A$) 1330 A$="month. You have~to share half of the profit with the~salespersons who s ell the cars. If you~wish to advertise it will cost you~" 1340 CALL OUT(A$):: A$="$600 each month but you should sell~about three more car s that month.~" :: CALL OUT(A$):: CALL ENT 1350 RANDOMIZE 1360 CO,MS,FS,LX,SP=0 1370 FOR MO=1 TO 8 1380 N=27 1390 A$="~~MONTH "&STR$(MO):: CALL OUT(A$) 1400 ON MO GOSUB 1860,1860,1850,1870,1860,1850,1870,1860 1410 A$="~INVENTORY:~" :: CALL OUT(A$) 1420 A$="~Compact "&STR$(CO)&"~Midsize "&STR$(MS)&"~Fullsize "&STR$(FS)&"~L uxury "&STR$(LX):: CALL OUT(A$) 1430 A$="~Sports "&STR$(SP)&"~~" :: CALL OUT(A$):: AV=0 1440 A$="~Do you wish to advertise~this month (Y/N)?" :: CALL OUT(A$):: CALL YN( A$):: IF A$="Y" THEN AV=600 :: N=N+4 ELSE AV=0 1450 A$="~~Time to order:~(100 on first item quits)~~" :: CALL OUT(A$) 1460 A$="~How many compacts? " :: CALL OUT(A$):: CALL IN(A$):: CALL CN(A$,0,100, C):: IF C=100 THEN RETURN ELSE IF A$="-" THEN 1460 1470 A$="~How many midsize? " :: CALL OUT(A$):: CALL IN(A$):: CALL CN(A$,0,100,M ):: IF A$="-" THEN 1470 1480 A$="~How many fullsize? " :: CALL OUT(A$):: CALL IN(A$):: CALL CN(A$,0,100, F):: IF A$="-" THEN 1480 1490 A$="~How many luxury? " :: CALL OUT(A$):: CALL IN(A$):: CALL CN(A$,0,100,L) :: IF A$="-" THEN 1490 1500 A$="~How many sports? " :: CALL OUT(A$):: CALL IN(A$):: CALL CN(A$,0,100,S) :: IF A$="-" THEN 1500 1510 A$="~~selling...." :: CALL OUT(A$) 1520 CO=CO+C :: MS=MS+M :: FS=FS+F :: LX=LX+L :: SP=SP+S 1530 OW=OW+5600*C+6600*M+7500*F+10300*L+11000*S 1540 FOR X=1 TO N 1550 R=INT(RND*20)+1 :: IF R=1 THEN 1750 ELSE IF R<4 THEN 1770 ELSE IF R<7 THEN 1790 ELSE IF R<11 THEN 1810 ELSE IF R<16 THEN 1830 1560 NEXT X 1570 CU=CB+MB+FB+LB+SB 1580 A$="~~You sold "&STR$(CU)&" cars this month.~The following cars were sold:~ ~" :: CALL OUT(A$) 1590 A$="~Compact "&STR$(CB)&"~Midsize "&STR$(MB)&"~Fullsize "&STR$(FB)&"~Luxu ry "&STR$(LB)&"~Sports "&STR$(SB)&"~" :: CALL OUT(A$) 1600 MISS=NC+NM+NF+NL+NS 1610 A$="~You missed "&STR$(MISS)&" sales because you didn't~have these cars in stock:~" :: CALL OUT(A$) 1620 A$="~Compact "&STR$(NC)&"~Midsize "&STR$(NM)&"~Fullsize "&STR$(NF)&"~L uxury "&STR$(NL)&"~Sports "&STR$(NS)&"~~" 1630 CALL OUT(A$):: NS,NL,NF,NM,NC=0 1640 P=200*CB+200*MB+250*FB+350*LB+500*SB :: CALL ENT 1650 A$="~~This month gross profit was $"&STR$(P*2)&"~But your interest was $"&S TR$(INT(.02*OW))&" and~" :: CALL OUT(A$) 1660 A$="had to pay $"&STR$(P)&" to your sales staff~" :: CALL OUT(A$) 1670 IF AV=600 THEN 1920 1680 A$="~Your net profit for the month was $"&STR$(P-AV-INT(.02*OW))&"~" :: CAL L OUT(A$) 1690 NET=NET+P-AV-INT(.02*OW) 1700 OW=INT(1.02*OW):: SB,LB,FB,MB,CB=0 :: CALL ENT 1710 NEXT MO 1720 A$="~~Net profit was $"&STR$(NET):: CALL OUT(A$) 1730 IF NET>27000 THEN 1880 ELSE IF NET>22500 THEN 1890 ELSE IF NET>18000 THEN 1 900 1740 A$="~~YOUR PERFORMANCE WAS POOR!~" :: GOTO 1910 1750 IF SP=0 THEN 1760 ELSE SP=SP-1 :: SB=SB+1 :: OW=OW-11000 :: GOTO 1560 1760 NS=NS+1 :: GOTO 1560 1770 IF LX=0 THEN 1780 ELSE LX=LX-1 :: LB=LB+1 :: OW=OW-10300 :: GOTO 1560 1780 NL=NL+1 :: GOTO 1560 1790 IF FS=0 THEN 1800 ELSE FS=FS-1 :: FB=FB+1 :: OW=OW-7500 :: GOTO 1560 1800 NF=NF+1 :: GOTO 1560 1810 IF MS=0 THEN 1820 ELSE MS=MS-1 :: MB=MB+1 :: OW=OW-6600 :: GOTO 1560 1820 NM=NM+1 :: GOTO 1560 1830 IF CO=0 THEN 1840 ELSE CO=CO-1 :: CB=CB+1 :: OW=OW-5600 :: GOTO 1560 1840 NC=NC+1 :: GOTO 1560 1850 A$="~This month you can expect to sell about~5 more cars than usual.~" :: C ALL OUT(A$):: N=33 :: RETURN 1860 RETURN 1870 A$="~This month you can expect to sell about 5~ fewer cars than usual~" :: CALL OUT(A$):: N=20 :: RETURN 1880 A$="~~AN EXCELLENT PERFORMANCE!~" :: GOTO 1910 1890 A$="~~YOUR PERFORMANCE WAS GOOD!~" :: GOTO 1910 1900 A$="~~ONLY A FAIR PERFORMANCE!~" 1910 CALL OUT(A$):: CALL ENT :: RETURN 1920 A$="~In addition, advertising cost you $600.~" :: CALL OUT(A$) 1930 GOTO 1680 1940 RANDOMIZE 1950 A$="~DEPTH CHARGES~Find and sink the submarine lurking in~these waters. Use your computer to input~coordinates into the missile system." 1960 A$=A$&"~Misses are determined by the coordinate~you are furthest away on.~" :: CALL OUT(A$) 1970 A$="~~Level 1 or 2 (*=quit) " :: CALL OUT(A$):: CALL KY2(AN$):: IF POS("*12 ",AN$,1)=0 THEN 1970 1980 IF AN$="*" THEN RETURN ELSE L=VAL(AN$)+1 1990 A$=RPT$(CHR$(8),16)&STR$(L-1)&"-Input: LONGITUDE,LATITUDE" :: IF L=3 THEN A$=A$&",DEPTH" 2000 A$=A$&"~* will quit" :: CALL OUT(A$):: A$="~ A B C D E F G H I *~1[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~" :: CALL OUT(A$) 2010 A$="2[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~3[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~4[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~" :: CALL OUT(A$) 2020 A$="5[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~6[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~7[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~" :: CALL OUT(A$) 2030 A$="8[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~9[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]~~" :: CALL OUT(A$) 2040 FOR N=1 TO L :: A(N)=INT(RND*9+1):: NEXT N :: DC=3*L 2050 A$="Longitude(A-I or *)?" :: CALL OUT(A$):: CALL KY2(A$):: IF POS("ABCDEFGH I*",A$,1)=0 THEN 2050 ELSE B(1)=ASC(A$) 2060 IF B(1)=42 THEN RETURN 2070 A$=RPT$(CHR$(8),20)&"Latitude (1-9 or *)?" :: CALL OUT(A$):: CALL KY2(A$):: IF POS("123456789*",A$,1)=0 THEN 2070 ELSE B(2)=ASC(A$) 2080 IF B(2)=42 THEN RETURN 2090 IF L=2 THEN 2120 2100 A$=RPT$(CHR$(8),20)&" Depth (1-9 or *)? " :: CALL OUT(A$):: CALL KY2(A$):: IF POS("123456789*",A$,1)=0 THEN 2100 ELSE B(3)=ASC(A$) 2110 IF B(3)=42 THEN RETURN 2120 A$=RPT$(CHR$(8),20)&"Missile fired at bearing "&CHR$(B(1))&","&CHR$(B(2)):: IF L=3 THEN A$=A$&","&CHR$(B(3)) 2130 A$=A$&"~" :: CALL OUT(A$) 2140 D=0 :: B(1)=B(1)-16 2150 FOR N=1 TO L 2160 DD=ABS(A(N)-(B(N)-48)) 2170 IF DD<D THEN 2180 ELSE D=DD 2180 NEXT N 2190 IF D=0 THEN 2280 2200 A$="Missed by "&CHR$(D+48):: CALL OUT(A$) 2210 B(1)=B(1)+16 2220 DC=DC-1 2230 A$=" Charges remaining-"&CHR$(48+DC)&"~" :: CALL OUT(A$) 2240 IF DC=0 THEN 2260 2250 GOTO 2050 2260 A$="~~Sorry "&FN$&",~but you did not succeed in blowing~up the enemy sub. H e has now moved out~of range. It was located at~" 2270 CALL OUT(A$):: A$="bearing "&CHR$(A(1)+64)&","&CHR$(A(2)+48):: IF L=3 THEN A$=A$&","&CHR$(A(3)+48):: GOTO 2300 ELSE 2300 2280 FOR L=1 TO 5 :: A$=CHR$(7):: CALL OUT(A$):: FOR X=1 TO 25 :: NEXT X :: NEXT L 2290 A$="~Direct hit!!~excellent manuvering "&FN$ 2300 A$=A$&"~" :: CALL OUT(A$):: CALL ENT :: RETURN 2310 A$=CHR$(12)&"~~Cross-the-River~~You have on the left bank 3 missionaries~an d 3 cannibals. You must get them to~" :: CALL OUT(A$) 2320 A$="the right bank. You may load up to 2 in~the boat at a time, and at no t ime may~you leave more cannibals than~" :: CALL OUT(A$) 2330 A$="missionaries together or the~missionaries will be eaten!~" :: CALL OUT( A$) 2340 E1,E2=3 :: E3,E4=0 :: L$=" \boat______/ " :: R$=" \______boat/ " :: CD$=L$ :: GOSUB 2570 :: A$="~ * quits~" :: CALL OUT(A$) 2350 A$="~* or How many missionaries? " :: CALL OUT(A$):: CALL KY("0123456789*", AN$,P):: IF AN$="*" THEN RETURN ELSE M=VAL(AN$) 2360 IF M>E1 THEN A$="~Are some hiding? I don't see that many~" :: CALL OUT(A$): : GOTO 2350 2370 A$="~* or How many cannibals? " :: CALL OUT(A$):: CALL KY("0123456789*",AN$ ,P):: IF AN$="*" THEN RETURN ELSE C=VAL(AN$) 2380 IF C>E2 THEN A$="~Rub your eyes and count again!~" :: CALL OUT(A$):: GOTO 2 370 2390 IF C+M>2 THEN A$="~You dummy! You sunk the boat!~~" :: CALL OUT(A$):: GOTO 2340 2400 IF M+C=0 THEN A$="~How do you expect to cross the river?~You just lost the boat!~~" :: CALL OUT(A$):: GOTO 2340 2410 E1=E1-M :: E2=E2-C :: E3=E3+M :: E4=E4+C :: CD$=R$ :: GOSUB 2570 2420 IF E1=0 AND E2=0 THEN GOTO 2580 2430 IF E2>E1 AND E1<>0 THEN 2450 2440 IF E4>E3 AND E3<>0 THEN 2450 ELSE 2460 2450 A$="~~Yum! Yum!~The cannibals thank you for that meal!~" :: CALL OUT(A$):: GOTO 2340 2460 A$="~* or How many missionaries? " :: CALL OUT(A$):: CALL KY("0123456789*", AN$,P):: IF AN$="*" THEN RETURN ELSE M=VAL(AN$) 2470 IF M>E3 THEN A$="~Check your missionaries!~" :: CALL OUT(A$):: GOTO 2460 2480 A$="~* or How many cannibals? " :: CALL OUT(A$):: CALL KY("0123456789*",AN$ ,P):: IF AN$="*" THEN RETURN ELSE C=VAL(AN$) 2490 IF C>E4 THEN A$="~Don't make more problems than you~already have!~" :: CALL OUT(A$):: GOTO 2480 2500 IF C+M>2 THEN A$="~You dummy! You sunk the boat!~~" :: CALL OUT(A$):: GOTO 2340 2510 IF M+C=0 THEN A$="~The boat had drifted out!~ You lost it!~~" :: CALL OUT(A $):: GOTO 2340 2520 E1=E1+M :: E2=E2+C :: E3=E3-M :: E4=E4-C :: CD$=L$ :: GOSUB 2570 2530 IF E2>E1 AND E1<>0 THEN 2550 2540 IF E4>E3 AND E3<>0 THEN 2550 ELSE 2560 2550 A$="~~I smell something cooking!~The cannibal's bellys are now full!~" :: C ALL OUT(A$):: GOTO 2340 2560 IF E1=0 AND E2=0 THEN GOTO 2580 ELSE 2350 2570 A$="~~"&RPT$("M",E1)&RPT$("C",E2)&CD$&RPT$("M",E3)&RPT$("C",E4)&"~~" :: CAL L OUT(A$):: RETURN 2580 A$="~Very good! Everybody is safe and on the~other side! But then, who care s?~~" :: CALL OUT(A$):: RETURN 2590 A$="~~Sequences of numbers-~Pick the next number in sequence.~~" :: CALL OU T(A$) 2600 FOR J=1 TO 20 2610 A$="* on input quits~PROBLEM # "&STR$(J)&"~~" :: CALL OUT(A$):: K=1 :: C=0 2620 ON J GOSUB 2790,2800,2810,2820,2830,2840,2860,2880,2900,2920,2940,2950,2970 ,2980,2990,3020,3040,3080,3090,3110 2630 IF K>5 THEN 2650 2640 A$=STR$(A(K))&"," :: CALL OUT(A$):: K=K+1 :: GOTO 2620 2650 A$="~* or Next in sequence? " :: CALL OUT(A$):: CALL IN(AN$):: IF AN$="*" T HEN RETURN 2660 CALL CN(AN$,0,999999999,CB):: IF AN$="-" THEN 2650 2670 IF CB=A(K)THEN 2690 2680 A$="~Sorry, that's wrong; it is "&STR$(A(K))&"~" :: CALL OUT(A$):: C=0 :: K =K+1 :: IF K>12 THEN 2780 ELSE 2620 2690 A$="~"&STR$(A(K))&" is correct!!~" :: CALL OUT(A$) 2700 C=C+1 2710 IF C=2 THEN 2740 2720 K=K+1 2730 IF K>12 THEN 2780 ELSE 2620 2740 CALL ENT 2750 NEXT J 2760 A$="~~Congradulations!! You made it to the top!!~Excellent work!!~" :: CALL OUT(A$):: CALL ENT 2770 RETURN 2780 A$="~Ahhhhaahaa! Missing that one puts you~back to square one!!~~" :: CALL OUT(A$):: GOTO 2590 2790 A(K)=A(K-1)+2 :: RETURN 2800 IF K=1 THEN A(K)=1 :: RETURN ELSE A(K)=2*(A(K-1)):: RETURN 2810 IF K=1 THEN A(K)=1 :: X=1 :: RETURN ELSE X=X+1 :: A(K)=A(K-1)+X :: RETURN 2820 IF K=1 THEN A(K)=2048 :: RETURN ELSE A(K)=A(K-1)/2 :: RETURN 2830 IF K=1 THEN A(K)=1 :: A(0)=0 :: RETURN ELSE A(K)=A(K-1)+A(K-2):: RETURN 2840 IF K=1 THEN X=0 2850 X=X+1 :: A(K)=2*X*X :: RETURN 2860 IF K=1 THEN X=12 2870 A(K)=X*X :: X=X+1 :: RETURN 2880 IF K=1 THEN X=2 2890 A(K)=X*(X-1):: X=X+1 :: RETURN 2900 IF K=1 THEN X=0 2910 X=X+1 :: A(K)=X^3 :: RETURN 2920 IF K=1 THEN X=0 :: A(0)=1 2930 A(K)=A(K-1)+X*X :: X=X+1 :: RETURN 2940 IF K=4 OR K=6 OR K=9 OR K=11 THEN A(K)=30 :: RETURN ELSE IF K=2 THEN A(K)=2 8 :: RETURN ELSE A(K)=31 :: RETURN 2950 IF K=1 THEN X=12 :: A(0)=0 2960 A(K)=A(K-1)+X :: X=X-1 :: RETURN 2970 IF K=1 THEN A(K)=1 :: X=1 :: RETURN ELSE X=X+1 :: A(K)=A(K-1)*X :: RETURN 2980 A(0)=0 :: A(K)=2*A(K-1)+1 :: RETURN 2990 IF K=1 THEN A(K)=17 :: RETURN 3000 X=INT(A(K-1)/100):: Y=INT((A(K-1)-X*100)/10):: Z=A(K-1)-100*X-10*Y :: A(K)= A(K-1)+X+Y+Z :: RETURN 3010 X=INT(A(K-1)/100):: Y=INT((A(K-1)-X*100)/10):: Z=A(K-1)+-100*X-10*Y :: A(K) =A(K-1)+X+Y+Z :: STOP 3020 IF K=1 THEN X=1 3030 A(K)=INT((1/X)*1000+.5):: X=X+1 :: RETURN 3040 IF K<4 THEN A(1)=1 :: A(2)=2 :: A(3)=3 :: X=4 :: RETURN 3050 X=X+1 :: V=2 3060 IF INT(X/V)=X/V THEN 3050 3070 V=V+1 :: IF V<X THEN 3060 ELSE A(K)=X :: RETURN 3080 A(1)=3 :: A(2)=3 :: A(3)=5 :: A(4)=4 :: A(5)=4 :: A(6)=3 :: A(7)=5 :: A(8)= 5 :: A(9)=4 :: A(10)=3 :: A(11)=6 :: A(12)=6 :: A(13)=8 :: RETURN 3090 IF K=1 THEN X=12 3100 A(K)=INT(360/X+.5):: X=X-1 :: RETURN 3110 IF K=1 THEN X=1 3120 Z1=INT((X^2)/100):: Z2=INT((X^2-Z1*100)/10):: Z3=X^2-Z1*100-Z2*10 :: A(K)=Z 1+Z2+Z3 :: X=X+1 :: RETURN 3130 A$="~Boggle board loading....just a minute~......" :: CALL OUT(A$):: RUN "D SK1.BOGGLE" 3140 A$="~Text adventure loading....just a minute~......" :: CALL OUT(A$):: RUN "DSK1.CIA" 3150 INPUT #6,REC USER:NAM$,ADR$,PASS$,CALL$,DATE$,PH$,COM$,UF$,VALID$,LML 3160 RETURN 3170 !************************************************** BEGIN ERROR ROUTINE S AND SUBPROGRAMS **************************** 3180 CALL ERR(E1,E2,E3,E4):: PRINT #5: : : :RPT$("ERROR ",21):: PRINT #5:"ERROR CODE";E1;E2;E3;E4 3190 EA$=A$ :: A$="~~ERROR in board~please wait while error is logged~" :: CALL OUT(A$) 3200 CALL SAY("UHOH I HAVE AN ERROR IN PROGRAM B") 3210 IF USER>3 THEN 3230 ELSE A$="~ERROR: "&STR$(E1)&" "&STR$(E2)&" "&STR$(E3)&" "&STR$(E4)&"~A$="&EA$&"~" :: CALL OUT(A$) 3220 CALL DEL(1000) 3230 PRINT #5:"********** ERROR **********in BOARDB" :: PRINT #5:"Error code:";E 1;E2;E3;E4 3240 PRINT #5:" A$=";EA$ 3250 PRINT #5:RPT$("ERROR ",21): : : : 3260 RETURN 220 3270 !@P+ 3280 SUB INST(A$):: A$="~Need instructions?(Y/N)" :: CALL OUT(A$):: CALL YN(A$): : SUBEND 3290 SUB SEND(NAM$,USER,VALID$) 3300 A$="~~Messages to Bullwinkle are ONLY readable~by the Crew. limit of 10 lin es~MAX 80 CHARACTERS EACH LINE!~~~" :: CALL OUT(A$) 3310 A$="~From:"&NAM$&" "&STR$(USER)&"~To: Bullwinkle~~" :: CALL OUT(A$) 3320 A$="~Enter text- Press <ENTER> on BLANK line~when finished.~~" :: CALL OUT( A$):: X=1 3330 A$=STR$(X)&">" :: CALL OUT(A$):: CALL IN(A$):: IF LEN(A$)=0 THEN 3340 ELSE MS$(X)=A$ :: X=X+1 :: IF X=11 THEN 3340 ELSE 3330 3340 IF X=1 AND LEN(A$)=0 THEN 3410 ELSE A$="~~Stuffing the Winkle's bottle...~~ ~" :: CALL OUT(A$) 3350 PRINT #5: :RPT$("=",110);" MESSAGE TO BULLWINKLE" 3360 PRINT #5:"MESSAGE TO ""Bullwinkle"" FROM: "&NAM$&" "&STR$(USER) 3370 N=1 :: A$=MS$(N) 3380 IF LEN(A$)>132 THEN 3400 ELSE N=N+1 :: IF N=X THEN 3410 ELSE A$=A$&" "&MS$( N):: GOTO 3380 3390 A$=A$&MS$(N):: GOTO 3380 3400 PRINT #5:SEG$(A$,1,132):: A$=SEG$(A$,133,LEN(A$)-132):: GOTO 3380 3410 PRINT #5:A$: :"Main menu BD#2(cont'd)";:: IF X=1 AND LEN(A$)=0 THEN 3430 3420 A$="~~ ** Message afloat...... **~~" :: CALL OUT(A$):: CALL DEL(100) :: GOTO 3440 3430 A$="~Can't make up your mind, huh?~~~" :: CALL OUT(A$):: CALL DEL(100) 3440 SUBEND 3450 SUB RING(NAM$) 3460 A$="~~~Ring Chat:~~~What do you wish to chat about? " :: CALL OUT(A$):: CAL L IN(C$) 3470 DISPLAY AT(5,1):"Chat:";C$ 3480 A$="~~Chat mode~~~~Let me see if someone is nearby~Hey Someone!~"&NAM$&" is callin'~~" :: CALL OUT(A$) 3490 PRINT #5: :"*** Chat request from ";NAM$;" on the subject of ";C$; 3500 FOR X=1 TO 25 :: CALL SOUND(10,1000+(X*4),0,500+(X*4),0,-4,0):: NEXT X 3510 A$="Bells and sirens have gone off!~If anyone is available,~they'll break i n~~" :: CALL OUT(A$) 3520 PRINT #5:"*** Main menu-BD#2(cont'd)";:: CALL ENT 3530 SUBEND 3540 SUB LOFF(FN$,USER,NAM$,VALID$) 3550 A$="~~~Are you sure you've got to go?~?????? Y/N " :: CALL OUT(A$):: CALL Y N(A$):: IF A$<>"Y" THEN SUBEXIT 3560 CALL TIM(T1$,T2$,T3$):: A$="~~Thanks for tuning in...~"&FN$&" tuned out...~ "&T3$&"~Bye... " :: CALL OUT(A$) 3570 A$="~Remember to call at least every 90 days~or your user# will be thrown~ to the flounder!...(ouch!)" :: CALL OUT(A$) 3580 A$="~~~Hope you enjoyed the show.~See ya next time.~~~" :: CALL OUT(A$):: C ALL LINK("OFHOOK") 3590 PRINT #5: :"USER "&FN$&" "&STR$(USER)&" LOGGED OFF "&T3$:RPT$("=",121);" LO GGED OFF" :: RUN "DSK1.LOGON" 3600 SUBEND 3610 SUB TIM(T1$,T2$,T3$) 3620 DEF TIME=TV1-6*INT(TV1/16)!BCD to Decimal Converter 3630 CALL PEEK(-31158,X1,X2,C,X4,X5):: TV1=C :: A1$=STR$(TIME):: TV1=X5 :: X5=TI ME :: T2$=STR$(X5)&"/"&A1$&"/94" 3640 CALL PEEK(-31164,X1,X2,X3,X4,X5):: TV1=X1 :: SEC$=STR$(TIME):: IF X1<10 THE N SEC$="0"&SEC$ 3650 TV1=X3 :: MIN$=STR$(TIME):: IF X3<10 THEN MIN$="0"&MIN$ 3660 TV1=X5 :: HR=TIME :: M$="am" :: IF HR>11 THEN M$="pm" 3670 IF HR=0 THEN HR=12 3680 IF HR>12 THEN HR=HR-12 3690 HR$=STR$(HR):: T1$=HR$&":"&MIN$&M$ :: T3$=T2$&" "&T1$ 3700 SUBEND 3710 SUB CNG(USER,XP,BD,FN$,NAM$,PASS$) 3720 A$="~~Select board:~~ 1 Board #1~ 2 Return (Board #2)~ 3 Board #3~" :: E =3 :: CALL OUT(A$) 3730 IF USER>3 THEN 3750 3740 A$=" 4 Remote~~" :: CALL OUT(A$):: E=4 3750 A$="~~Choice-->" :: CALL OUT(A$):: CALL KY("1234",A$,P) 3760 CALL CN(A$,1,E,A):: IF A$="-" THEN 3720 3770 IF A=2 THEN SUBEXIT 3780 A$="~~Loading Board "&STR$(A)&"~Please wait...." :: CALL OUT(A$) 3790 OPEN #10:"DSK1.TRANSFILE",INTERNAL,OUTPUT,FIXED 80 :: PRINT #10:USER;XP;BD; FN$;NAM$;PASS$ :: CLOSE #10 3800 ON A GOTO 3810,3720,3820,3830 3810 RUN "DSK1.BOARDA" 3820 RUN "DSK1.BOARDC" 3830 RUN "DSK1.REMOTE" 3840 SUBEND 3850 SUB YN(A$) 3860 CALL CK :: CALL LINK("DCDCHK",A$) 3870 IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR$(13)THEN 3860 ELSE CALL UP(A$) 3880 IF A$="Y" THEN A1$="Yes~" ELSE IF A$="N" THEN A1$="No~" ELSE A1$=CHR$(7):: CALL OUT(A1$):: GOTO 3860 3890 CALL OUT(A1$):: SUBEND 3900 SUB HANGUP 3910 CALL LINK("OFHOOK"):: CALL DEL(2000):: A$="ATZ"&CHR$(13):: CALL LINK("OUTPU T",A$):: RUN "DSK1.LOGON" 3920 SUBEND 3930 SUB IN(A$):: CALL LINK("INPUT",A$):: CALL CK :: SUBEND 3940 SUB OUT(A$):: CALL LINK("OUTPUT",A$):: CALL CK :: SUBEND 3950 SUB UP(A$):: CALL LINK("UPPER",A$):: SUBEND 3960 SUB ENT :: A$="Press <ENTER> " :: CALL OUT(A$):: CALL IN(A$):: SUBEND 3970 SUB CK :: CALL KEY(0,K,ST):: IF K=135 THEN A$="~Have a BOOT!~~" :: CALL LIN K("OUTPUT",A$):: PRINT #5:"**MANUAL BOOT!!**" :: CALL HANGUP 3980 IF K<>129 THEN 4050 3990 A$="~~Please stand by.....~Board is under SysOp control...~~~~" :: CALL LIN K("OUTPUT",A$) 4000 DISPLAY AT(23,1)BEEP:"1-BdA 2-BdC 3-Manager":"4-Return Spacebar-Cha t" 4010 CALL KEY(0,K,S):: IF S=0 THEN 4010 ELSE IF K=145 THEN 4050 4020 IF K=49 THEN RUN "DSK1.BOARDA" ELSE IF K=50 THEN RUN "DSK1.BOARDC" 4030 IF K=51 THEN RUN "DSK1.MANAGER" ELSE IF K=52 THEN 4050 ELSE IF K=32 THEN 40 40 ELSE 4010 4040 CALL LINK("DCDCHK",A$) 4050 A$="" :: CALL LINK("JOYST",A$):: IF LEN(A$)=0 THEN SUBEXIT 4060 PRINT #5:"***HANGUP***" :: CALL HANGUP 4070 SUBEND 4080 SUB CN(A$,MN,MX,A) 4090 IF A$="" THEN 4130 4100 FOR X=1 TO LEN(A$):: IF POS("0123456789",SEG$(A$,X,1),1)=0 THEN 4130 4110 NEXT X 4120 A=VAL(A$):: IF A<MN OR A>MX THEN 4130 ELSE SUBEXIT 4130 A$=CHR$(7)&"~Invalid entry~" :: CALL OUT(A$):: A$="-" :: SUBEND 4140 SUB KY(A1$,A$,P) 4150 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)OR A$="" THEN 4150 4160 CALL UP(A$):: IF A1$="ANY" THEN 4180 4170 P=POS(A1$,A$,1):: IF P=0 THEN A$=CHR$(7)&"Invalid entry~-->" :: CALL OUT(A$ ):: GOTO 4150 ELSE 4190 4180 IF ASC(A$)<41 OR ASC(A$)>97 THEN 4150 ELSE P=ASC(A$) 4190 A1$=A$&"~" :: CALL OUT(A1$):: PRINT #5:A$;",";:: SUBEND 4200 SUB KY2(A$) 4210 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)THEN 4210 4220 CALL UP(A$):: SUBEND 4230 SUB DEL(A) 4240 FOR X=1 TO A :: NEXT X 4250 SUBEND

go back up to the top

BoardC - file transfers

The BoardC code was written by S. Clarke with concept and design by S. Clarke and W. Blew

10 CALL LINK("OUTPUT","~~ rev 010194 BOARD #3~~") 20 ! *BOARDC* BULLWINKLE'S CORNER Michael Riccio Xmodem 30 CALL SAY("PROGRAM C"):: CALL KEY(4,X,X):: GOTO 70 40 BD,DR,E1,E2,E3,E4,,LML,N,P,SFK,T,USER,V,W,X,XP,Z=0 50 A$,A1$,ADR$,B$,C$,CALL$,CM$,COM$,DATE$,EA$,F$,FN$,FNM$,K$,OK$,LD$,NAM$,PASS$, PH$,SP$,T1$,T2$,T3$,USER$,UF$,VALID$="" 60 CALL CLEAR :: CALL COLOR :: CALL ERR :: CALL KEY :: CALL LINK :: CALL PEEK :: CALL SAY :: CALL SCREEN :: CALL SOUND :: CALL DELSPRITE 70 OPTION BASE 1 80 DIM WD$(100),DLF$(6) 90 DATA DL/TEXAS,DL/GENEVE,DL/OTHER,DL/OTHER,DL/PICS,DL/OTHER 100 !@P- 110 CALL SCREEN(2):: FOR X=0 TO 14 :: CALL COLOR(X,15,1):: NEXT X 120 FOR X=1 TO 6 :: READ DLF$(X):: NEXT X 130 OPEN #27:"DSK1.DEFAULTF",INPUT ,INTERNAL,RELATIVE,FIXED 20 :: INPUT #27,REC 1:C$ :: CLOSE #27 140 OPEN #5:"RS232/2.BA="&C$,VARIABLE 132 150 CALL CK :: OPEN #10:"DSK1.TRANSFILE",INTERNAL,INPUT ,FIXED 80 :: INPUT #10:U SER,XP,BD,FN$,NAM$,PASS$ :: CLOSE #10 160 A$=CHR$(7):: CALL OUT(A$) 170 A$="~~Loading your user file..." :: CALL OUT(A$):: OPEN #6:"DSK1.UFILE",UPDA TE,INTERNAL,RELATIVE,FIXED 126 :: GOSUB 1000 :: CLOSE #6 180 CALL LINK("DCDCHK",A$):: A$="~Please enter your password:~--->" :: CALL OUT( A$):: CALL LINK("SECRET",A$) 190 IF POS(A$,"/",1)>0 THEN A$=SEG$(A$,POS(A$,"/",1)+1,LEN(A$)-1-LEN(STR$(USER)) ) 200 IF A$<>PASS$ THEN A$="Nope...not correct. Check it and~try again.~~" :: CALL OUT(A$):: GOTO 180 210 PRINT #5:"Main-BD#3:"; 220 ON ERROR 1520 230 CALL TIM(T1$,T2$,T3$):: A$="~"&T3$&"~" :: CALL OUT(A$) 240 IF XP=1 THEN 310 250 A$="~~~%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~% BULLWINKLE'S CORNER * BD #3:MENU %~" :: CALL OUT(A$) 260 A$="%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~" :: CALL OUT(A$) 270 A$="F)ile transfers~G)oodbye~" :: CALL OUT(A$) 280 A$="J)ump boards~" :: CALL OUT(A$) 290 A$="S)end mess.=>SysOp~" :: CALL OUT(A$) 300 A$="X)pert [on/off]~Y)ell for SysOp~" :: CALL OUT(A$):: GOTO 320 310 A$="~~Main menu:BD#3" :: CALL OUT(A$) 320 A$="~Choice->F,G,J,S,X,Y or ?~-->" :: CALL OUT(A$):: CALL KY("FGJSXY?",A$,P) :: IF P=7 THEN 250 330 IF A$="G" THEN CALL LOFF(FN$,USER,NAM$,VALID$):: GOTO 220 340 IF A$="S" THEN CALL SEND(NAM$,USER,VALID$):: GOTO 220 350 IF A$="Y" THEN CALL RING(NAM$):: GOTO 220 360 IF A$="X" AND XP=0 THEN XP=1 :: A$="~Expert mode on.....~" :: CALL OUT(A$):: GOTO 220 370 IF A$="X" AND XP=1 THEN XP=0 :: A$="~Expert mode off.....~" :: CALL OUT(A$): : GOTO 220 380 IF A$="J" THEN CALL CNG(USER,XP,BD,FN$,NAM$,PASS$):: GOTO 220 390 IF A$="F" THEN 400 400 A$="~~File transfers-XMODEM (8N1)~~A)bort~D)ownload (Special files)~I)ndivid ual DL~L)ist files with mark/DL option~U)pload file" 410 CALL OUT(A$):: A$="~~Choice?-->" :: CALL OUT(A$):: CALL KY("ADULI",A$,P):: S P$="" 420 IF P=1 THEN 220 430 ON P GOSUB 220,450,880,1110,1400 440 GOTO 400 450 IF SEG$(VALID$,2,1)<>"Y" THEN A$="~There are no special files for~you today, "&FN$&"~" :: CALL OUT(A$):: RETURN 460 A$="~D/L special files? (Y/N) " :: CALL OUT(A$):: CALL YN(A$):: IF A$="Y" TH EN SP$="SPEC" :: DR=2 ELSE RETURN 470 A$="~Download files:~~Press Y or N to select~~File list:~" :: CALL OUT(A$):: CALL SAY("DOWN LOAD") 480 OPEN #90:"DSK"&STR$(DR)&".",INPUT ,RELATIVE,INTERNAL :: INPUT #90:K$,W,W,V : : A$="~~Filename Size~---------- ----~" :: CALL OUT(A$) 490 INPUT #90:OK$,T,W,V :: IF OK$="" THEN 570 500 IF (SEG$(OK$,1,LEN(USER$))<>USER$)AND(SEG$(OK$,1,1)<>"*")THEN 490 510 IF SEG$(OK$,1,1)="*" THEN K$=SEG$(OK$,2,LEN(OK$)-1):: GOTO 530 520 K$=SEG$(OK$,LEN(USER$)+1,LEN(OK$)-LEN(USER$)) 530 A$=K$&RPT$(" ",19-LEN(K$)-1-LEN(STR$(INT(W))))&STR$(INT(W))&"~" :: CALL OUT( A$) 540 A$="Download file? Y/N " :: CALL OUT(A$):: CALL YN(A$):: IF A$="Y" THEN 580 550 A$="Should I Delete file? Y/N " :: CALL OUT(A$):: CALL YN(A$):: IF A$="N" TH EN 490 560 DELETE "DSK"&STR$(DR)&"."&OK$ :: A$="~"&K$&" has been deleted~~" :: CALL OUT (A$):: GOTO 490 570 CLOSE #90 :: A$="~~End of special file selections~" :: CALL OUT(A$):: CALL E NT :: RETURN 580 A$="~~Verify:~Chosen file:"&K$&"~Download? Y/N " :: CALL OUT(A$):: CALL YN(A $):: IF A$="N" THEN 550 ELSE CLOSE #90 590 A$="~~Loading "&K$&"~c1986 Michael Riccio~Com-Link enterprises:Xmodem downlo ad~~Activate transfer now!" :: PRINT #5:"D/";K$&","; 600 CALL OUT(A$):: T=0 :: LD$="DL" 610 IF SP$="NONTI" THEN DR=3 :: K$="*"&K$ 620 IF SP$="TI" OR SP$="GENEVE" THEN DR=4 :: K$="*"&K$ 630 IF SP$="SPEC" THEN K$=OK$ :: DR=2 640 IF SP$="INDIV" THEN K$="*"&K$ 650 IF SP$="" THEN RETURN 660 IF BD=300 THEN 670 ELSE IF BD=1200 THEN 680 ELSE 690 670 OPEN #14:"RS232/1.BA=300.PA=N.DA=8" :: GOTO 700 680 OPEN #14:"RS232/1.BA=1200.PA=N.DA=8" :: GOTO 700 690 OPEN #14:"RS232/1.BA=2400.PA=N.DA=8" 700 CALL DEL(3000):: CALL LINK("XMODEM",DR,K$,T,0):: CLOSE #14 710 CALL LINK("SETUP"):: CALL DEL(2000):: CALL DELSPRITE(ALL):: GOSUB 1010 :: IF T<>0 THEN RETURN 720 IF SP$<>"SPEC" THEN 770 730 A$="~If this file WAS NOT one that you requested, then please select NO for file~to be deleted so original request can be filled~~" 740 CALL OUT(A$):: A$="~If you recieved a good copy, I'll delete~the file. Shoul d I delete it?(Y/N) " :: CALL OUT(A$) 750 CALL YN(A$):: IF A$="N" THEN 770 760 DELETE "DSK"&STR$(DR)&"."&OK$ :: A$="~"&K$&" has been deleted~~" :: CALL OUT (A$) 770 ON ERROR 870 780 IF LD$<>"UL" THEN CM$,C$,EA$=" " :: GOTO 820 790 A$="~~Please enter brief description of how~to use the program just uploaded ~and hardware/software needed~~3 lines of 80 chars max~~" 800 CALL OUT(A$):: CALL IN(C$):: CALL UP(C$):: CALL IN(CM$):: CALL UP(CM$):: CAL L IN(EA$):: CALL UP(EA$) 810 A$="~~Thank you very much, "&FN$&"~~" :: CALL OUT(A$) 820 A$="~Please wait a moment as I~tidy up here a bit..." :: CALL OUT(A$):: IF S P$<>"" THEN LD$=LD$&"("&SP$&")" 830 CALL TIM(T1$,T2$,T3$):: OPEN #16:"DSK4.ULDL",INTERNAL,RELATIVE,UPDATE,FIXED 84 :: INPUT #16,REC 0:Z 840 IF SEG$(K$,1,1)="*" THEN K$=SEG$(K$,2,LEN(K$)-1) 850 PRINT #16,REC Z:NAM$;T2$;K$;LD$;COM$ :: PRINT #16,REC Z+1:C$ :: PRINT #16,RE C Z+2:CM$ :: PRINT #16,REC Z+3:EA$ 860 Z=Z+4 :: PRINT #16,REC 0:Z :: CLOSE #16 :: RETURN 870 PRINT #5:"ERROR IN LOGGING TRANSFER->";NAM$;" ";T2$;" ";K$;" ";LD$;" ";COM$; " ";C$;" ";CM$;" ";EA$ :: RETURN 400 880 A$="~~Upload file:~~" :: CALL OUT(A$):: CALL SAY("UP LOAD") 890 CALL CK :: OPEN #90:"DSK2.",INPUT ,RELATIVE,INTERNAL :: INPUT #90:K$,W,W,V : : CLOSE #90 900 IF V<50 THEN A$="~Sorry, disk is full. Try again later.~" :: CALL OUT(A$):: PRINT #5:"**U/L DISK IS FULL**";:: RETURN 910 A$="~"&STR$(V)&" sectors available~("&STR$((V-1)*256)&" bytes free)~" :: CAL L OUT(A$) 920 A$="~UPLOAD:~Enter filename -9 character MAX~<ENTER> aborts" :: CALL OUT(A$) 930 A$="~File: " :: CALL OUT(A$):: CALL IN(A$):: CALL UP(A$):: IF A$="" OR LEN(A $)<1 THEN RETURN 940 IF LEN(A$)>9 THEN A$="~Must be less than 10 chars long~~" :: CALL OUT(A$):: GOTO 910 950 IF POS(A$," ",1)>1 THEN A$="~Please, no spaces in filename~~" :: CALL OUT(A$ ):: GOTO 910 960 IF POS(A$,".",1)>1 THEN A$="~Please substitute a : for the .~(Use a colon in stead of a period)~~" :: CALL OUT(A$):: GOTO 910 970 K$="@"&A$ 980 PRINT #5:"U/";K$&",";:: T=1 :: LD$="UL" :: DR=2 990 A$="~~c1986 Michael Riccio~Com-Link enterprises:Xmodem upload~~~Activate tra nsfer now!" :: CALL OUT(A$):: GOTO 660 1000 INPUT #6,REC USER:NAM$,ADR$,PASS$,CALL$,DATE$,PH$,COM$,UF$,VALID$,LML :: US ER$=STR$(USER):: RETURN 1010 IF T<0 OR T>6 THEN RETURN 1020 IF T=0 THEN A$="~~Successful file transfer!~~" :: GOTO 1100 1030 ON T GOTO 1040,1050,1060,1070,1080,1090 1040 A$="~~Could not open file to send~Sysop has been notified.~~" :: GOTO 1100 1050 A$="~~Could not open file to save~Sysop has been notified.~~" :: GOTO 1100 1060 A$="~~Too many retries~transfer cancelled.~~" :: GOTO 1100 1070 A$="~~User cancelled transfer.~~" :: GOTO 1100 1080 A$="~~Sysop cancelled transfer.~~" :: GOTO 1100 1090 A$="~~Carrier Lost-transfer canceled.~~" :: GOTO 1100 1100 PRINT #5:A$;",";:: CALL OUT(A$):: CALL DEL(100):: RETURN 1110 A$="~~Select system type:~~" :: CALL OUT(A$) 1120 A$="0 - Abort~1 - Texas Instruments~2 - Geneve~3 - Atari~4 - Commodore~5 - Pictures (GIF,RLE,MAC,MYART etc.)~" :: CALL OUT(A$) 1130 A$="6 - IBM~~~" :: CALL OUT(A$) 1140 A$="Select number--->" :: CALL OUT(A$):: CALL KY("1234560",A$,P):: IF P=7 T HEN RETURN 1150 IF P=1 THEN SP$="TI" ELSE IF P=2 THEN SP$="GENEVE" ELSE SP$="NONTI" 1160 OPEN #20:"DSK2.DL",DISPLAY ,VARIABLE,INPUT :: A$="~~" :: CALL OUT(A$) 1170 IF EOF(20)THEN CLOSE #20 :: GOTO 1190 1180 LINPUT #20:A$ :: A$=A$&"~" :: CALL OUT(A$):: GOTO 1170 1190 FNM$=DLF$(P) 1200 A$="~Commands:~ P)ause R)esume A)bort~~~~" :: CALL OUT(A$):: Z=0 1210 OPEN #20:"DSK2."&FNM$,DISPLAY ,VARIABLE,INPUT 1220 IF EOF(20)THEN CLOSE #20 :: GOTO 1330 1230 CALL KYCK(SFK):: IF SFK=0 THEN 1260 1240 IF SFK=4 THEN A$="~Aborted~" :: CALL OUT(A$):: CLOSE #20 :: RETURN 1250 IF SFK=1 THEN CALL PAUSE 1260 LINPUT #20:A$ :: IF SEG$(A$,1,3)="@S@" THEN 1270 ELSE IF SEG$(A$,1,3)="@E@" THEN 1280 ELSE 1320 1270 LINPUT #20:A$ :: A1$=SEG$(A$,1,POS(A$," ",1)-1):: GOTO 1320 1280 A$="~~A)bort C)ontinue M)ark " :: CALL OUT(A$):: CALL KY("ACM",A$,N):: IF N=1 AND Z=0 THEN CLOSE #20 :: RETURN 1290 IF N=1 AND Z>0 THEN CLOSE #20 :: GOTO 1340 1300 IF N=2 THEN 1220 1310 Z=Z+1 :: WD$(Z)=A1$ :: A$="~Marked for D/L~" :: CALL OUT(A$):: GOTO 1220 1320 A$=A$&"~" :: CALL OUT(A$):: GOTO 1220 1330 A$="~~End of File-" :: CALL OUT(A$):: CALL ENT :: IF Z>0 THEN 1340 ELSE RET URN 1340 A$="~Download marked files~~" :: CALL OUT(A$) 1350 FOR X=1 TO Z 1360 K$=WD$(X):: A$="~~Verify:~Chosen file:"&K$&"~Download? Y/N " :: CALL OUT(A$ ):: CALL YN(A$):: IF A$="N" THEN 1380 1370 GOSUB 590 1380 NEXT X 1390 A$="~End of marked files~~~" :: CALL OUT(A$):: RETURN 1400 A$="~Enter the name of the file you wish~to download~~Be sure it is spelled properly~~Enter LIST to list all~~Empty CR will abort~" 1410 A$=A$&"~DL which file? " :: CALL OUT(A$):: CALL IN(K$):: CALL UP(K$):: IF K $="" THEN RETURN 1420 IF K$="LIST" THEN 1430 ELSE A$="~Searching directories...~CATALOG:~-------~ ~" :: CALL OUT(A$):: GOTO 1440 1430 A$="~Listing directory...~CATALOG:~-------~~" :: CALL OUT(A$) 1440 FOR DR=3 TO 4 1450 OPEN #90:"DSK"&STR$(DR)&".",INPUT ,RELATIVE,INTERNAL :: INPUT #90:A$,W,W,V 1460 INPUT #90:A$,T,W,V :: IF A$="" THEN CLOSE #90 :: GOTO 1480 ELSE IF A$="ULDL " THEN 1460 1470 A$=SEG$(A$,2,LEN(A$)-1):: IF A$=K$ THEN CLOSE #90 :: GOTO 1510 ELSE A$=" " &A$&"~" :: CALL OUT(A$):: GOTO 1460 1480 NEXT DR 1490 IF K$="LIST" THEN 1500 ELSE A$="~~Sorry, I can't find "&K$&"~" :: CALL OUT( A$) 1500 A$="~" :: CALL OUT(A$):: CALL ENT :: RETURN 1510 SP$="INDIV" :: A$="~I have found "&K$&"~Download "&K$&"?(Y/N)" :: CALL OUT( A$):: CALL YN(A$):: IF A$="Y" THEN 590 ELSE RETURN 1520 !************************************************** BEGIN ERROR ROUTINE S AND SUBPROGRAMS **************************** 1530 EA$=A$ :: A$="~~ERROR in board~please wait while error is logged~" :: CALL OUT(A$) 1540 DISPLAY AT(23,3):"IN ERROR ROUTINE" :: CALL SAY("UHOH I HAVE AN ERROR IN PR OGRAM C") 1550 CALL ERR(E1,E2,E3,E4):: PRINT #5: : : :RPT$("ERROR ",21) 1560 IF USER>3 THEN 1580 ELSE A$="~ERROR: "&STR$(E1)&" "&STR$(E2)&" "&STR$(E3)&" "&STR$(E4)&"~A$="&EA$&"~" :: CALL OUT(A$) 1570 CALL DEL(1000) 1580 PRINT #5:"********** ERROR **********in BOARDC" :: PRINT #5:"Error code:";E 1;E2;E3;E4 :: PRINT #5:EA$ 1590 PRINT #5:RPT$("ERROR ",21): : : : 1600 RETURN 220 1610 !@P+ 1620 SUB SEND(NAM$,USER,VALID$) 1630 A$="~~Messages to Bullwinkle are ONLY readable~by the Crew. limit of 10 lin es of~80 characters each line.~~~" :: CALL OUT(A$) 1640 A$="~From:"&NAM$&" "&STR$(USER)&"~To: Bullwinkle~~" :: CALL OUT(A$) 1650 A$="~Enter text- Press <ENTER> on BLANK line~when finished.~~" :: CALL OUT( A$):: X=1 1660 A$=STR$(X)&">" :: CALL OUT(A$):: CALL IN(A$):: IF LEN(A$)=0 THEN 1670 ELSE MS$(X)=A$ :: X=X+1 :: IF X=11 THEN 1670 ELSE 1660 1670 IF X=1 AND LEN(A$)=0 THEN 1740 ELSE A$="~~Stuffing the Winkle's bottle...~~ ~" :: CALL OUT(A$) 1680 PRINT #5: :RPT$("=",110);" MESSAGE TO BULLWINKLE" 1690 PRINT #5:"MESSAGE TO ""Bullwinkle"" FROM: "&NAM$&" "&STR$(USER) 1700 N=1 :: A$=MS$(N) 1710 IF LEN(A$)>132 THEN 1730 ELSE N=N+1 :: IF N=X THEN 1740 ELSE A$=A$&" "&MS$( N):: GOTO 1710 1720 A$=A$&MS$(N):: GOTO 1710 1730 PRINT #5:SEG$(A$,1,132):: A$=SEG$(A$,133,LEN(A$)-132):: GOTO 1710 1740 PRINT #5:A$: :"Main menu BD#3(cont'd)";:: IF X=1 AND LEN(A$)=0 THEN 1760 1750 A$="~~ ** Message afloat...... **~~" :: CALL OUT(A$):: CALL DEL(100) :: GOTO 1770 1760 A$="~Can't make up your mind, huh?~~~" :: CALL OUT(A$):: CALL DEL(100) 1770 SUBEND 1780 SUB RING(NAM$) 1790 A$="~~~Ring Chat:~~~What do you wish to chat about? " :: CALL OUT(A$):: CAL L IN(C$) 1800 IF C$="" THEN A$="~I can't hear you!!!!!~" :: CALL OUT(A$):: GOTO 1790 1810 IF LEN(C$)<3 OR SEG$(C$,1,1)=SEG$(C$,2,1)THEN A$="~Is that in code??~" :: C ALL OUT(A$):: GOTO 1790 1820 DISPLAY AT(5,1):"Chat:";C$ 1830 A$="~~Chat mode~~~~Let me see if someone is nearby~Hey Someone!~"&NAM$&" is callin'~~" :: CALL OUT(A$) 1840 PRINT #5: :"*** Chat request from ";NAM$;" on the subject of ";C$; 1850 FOR X=1 TO 25 :: CALL SOUND(10,1000+(X*4),0,500+(X*4),0,-4,0):: NEXT X 1860 A$="Bells and sirens have gone off!~If anyone is available,~they'll break i n~~" :: CALL OUT(A$) 1870 PRINT #5:"*** Main menu-BD#3(cont'd)";:: CALL ENT 1880 SUBEND 1890 SUB LOFF(FN$,USER,NAM$,VALID$) 1900 A$="~~~Are you sure you've got to go?~?????? Y/N " :: CALL OUT(A$):: CALL Y N(A$) 1910 IF A$<>"Y" THEN SUBEXIT 1920 A$="~~Would you like to leave a message~for Bullwinkle ? Y/N " :: CALL OUT( A$):: CALL YN(A$) 1930 IF A$="Y" THEN CALL SEND(NAM$,USER,VALID$) 1940 CALL TIM(T1$,T2$,T3$):: A$="~~Thanks for tuning in...~"&FN$&" tuned out...~ "&T3$&"~Bye... " :: CALL OUT(A$) 1950 A$="~Remember to call at least every 90 days~or your user# will be thrown~ to the flounder!..." :: CALL OUT(A$) 1960 A$="~~~Hope you enjoyed the show.~See ya next time.~~~" :: CALL OUT(A$):: C ALL LINK("OFHOOK") 1970 PRINT #5: :"USER "&FN$&" "&STR$(USER)&" LOGGED OFF "&T3$:RPT$("=",121);" LO GGED OFF" :: RUN "DSK1.LOGON" 1980 SUBEND 1990 SUB TIM(T1$,T2$,T3$) 2000 DEF TIME=TV1-6*INT(TV1/16)!BCD to Decimal Converter 2010 CALL PEEK(-31158,X1,X2,C,X4,X5):: TV1=C :: A1$=STR$(TIME):: TV1=X5 :: X5=TI ME :: T2$=STR$(X5)&"/"&A1$&"/94" 2020 CALL PEEK(-31164,X1,X2,X3,X4,X5):: TV1=X1 :: SEC$=STR$(TIME):: IF X1<10 THE N SEC$="0"&SEC$ 2030 TV1=X3 :: MIN$=STR$(TIME):: IF X3<10 THEN MIN$="0"&MIN$ 2040 TV1=X5 :: HR=TIME :: M$="am" :: IF HR>11 THEN M$="pm" 2050 IF HR=0 THEN HR=12 2060 IF HR>12 THEN HR=HR-12 2070 HR$=STR$(HR):: T1$=HR$&":"&MIN$&M$ :: T3$=T2$&" "&T1$ 2080 SUBEND 2090 SUB CNG(USER,XP,BD,FN$,NAM$,PASS$) 2100 A$="~~Select board:~~ 1 Board #1~ 2 Board #2~ 3 Return (Board #3)~" :: E =3 :: CALL OUT(A$) 2110 IF USER>3 THEN 2130 2120 A$=" 4 Remote~~" :: CALL OUT(A$):: E=4 2130 A$="~~Choice-->" :: CALL OUT(A$):: CALL KY("1234",A$,P) 2140 CALL CN(A$,1,E,A):: IF A$="-" THEN 2100 2150 IF A=3 THEN SUBEXIT 2160 A$="~~Loading Board "&STR$(A)&"~Please wait...." :: CALL OUT(A$) 2170 OPEN #10:"DSK1.TRANSFILE",INTERNAL,OUTPUT,FIXED 80 :: PRINT #10:USER;XP;BD; FN$;NAM$;PASS$ :: CLOSE #10 2180 ON A GOTO 2190,2200,2220,2210 2190 RUN "DSK1.BOARDA" 2200 RUN "DSK1.BOARDB" 2210 RUN "DSK1.REMOTE" 2220 SUBEND 2230 SUB YN(A$) 2240 CALL CK :: CALL LINK("DCDCHK",A$) 2250 IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR$(13)THEN 2240 ELSE CALL UP(A$) 2260 IF A$="Y" THEN A1$="Yes~" ELSE IF A$="N" THEN A1$="No~" ELSE A1$=CHR$(7):: CALL OUT(A1$):: GOTO 2240 2270 CALL OUT(A1$):: SUBEND 2280 SUB HANGUP 2290 CALL LINK("OFHOOK"):: CALL DEL(2000):: A$="ATZ"&CHR$(13):: CALL LINK("OUTPU T",A$):: RUN "DSK1.LOGON" 2300 SUBEND 2310 SUB IN(A$):: CALL LINK("INPUT",A$):: CALL CK :: SUBEND 2320 SUB OUT(A$):: CALL LINK("OUTPUT",A$):: CALL CK :: SUBEND 2330 SUB UP(A$):: CALL LINK("UPPER",A$):: SUBEND 2340 SUB ENT :: A$="Press <ENTER> " :: CALL OUT(A$):: CALL IN(A$):: SUBEND 2350 SUB CK :: CALL KEY(0,K,ST):: IF K=135 THEN A$="~Have a BOOT!~~" :: CALL LIN K("OUTPUT",A$):: PRINT #5:"**MANUAL BOOT!!**" :: CALL HANGUP 2360 IF K<>129 THEN 2430 2370 A$="~~Please stand by.....~Board is under SysOp control...~~~~" :: CALL LIN K("OUTPUT",A$) 2380 DISPLAY AT(23,1)BEEP:"1-BdA 2-BdB 3-Manager":"4-Return Spacebar-Cha t" 2390 CALL KEY(0,K,S):: IF S=0 THEN 2390 ELSE IF K=145 THEN 2430 2400 IF K=49 THEN RUN "DSK1.BOARDA" ELSE IF K=50 THEN RUN "DSK1.BOARDB" 2410 IF K=51 THEN RUN "DSK1.MANAGER" ELSE IF K=52 THEN 2430 ELSE IF K=32 THEN 24 20 ELSE 2390 2420 CALL LINK("DCDCHK",A$) 2430 A$="" :: CALL LINK("JOYST",A$):: IF LEN(A$)=0 THEN SUBEXIT 2440 PRINT #5:"***HANGUP***" :: CALL HANGUP 2450 SUBEND 2460 SUB CN(A$,MN,MX,A) 2470 IF A$="" THEN 2510 2480 FOR X=1 TO LEN(A$):: IF POS("0123456789",SEG$(A$,X,1),1)=0 THEN 2510 2490 NEXT X 2500 A=VAL(A$):: IF A<MN OR A>MX THEN 2510 ELSE SUBEXIT 2510 A$=CHR$(7)&"~Invalid entry~" :: CALL OUT(A$):: A$="-" :: SUBEND 2520 SUB KY(A1$,A$,P) 2530 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)OR A$="" THEN 2530 2540 CALL UP(A$):: P=POS(A1$,A$,1):: IF P=0 THEN A$=CHR$(7)&"Invalid entry~--->" :: CALL OUT(A$):: GOTO 2530 2550 A1$=A$&"~" :: CALL OUT(A1$):: PRINT #5:A$;",";:: SUBEND 2560 SUB KY2(A$) 2570 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)THEN 2570 2580 CALL UP(A$):: SUBEND 2590 SUB DEL(A) 2600 FOR X=1 TO A :: NEXT X 2610 SUBEND 2620 SUB KYCK(SFK) 2630 CALL LINK("DCDCHK",A$):: CALL UP(A$):: SFK=POS("PSRA",A$,1):: SUBEND 2640 SUB PAUSE 2650 A$="R)esume " :: CALL OUT(A$) 2660 CALL CK :: CALL LINK("DCDCHK",A$):: CALL UP(A$):: IF A$="R" THEN A$=RPT$(CH R$(8),8):: CALL OUT(A$):: SUBEXIT 2670 GOTO 2660 2680 SUBEND

go back up to the top

Manager - BBS maintenance

The Manager code was written by S. Clarke with concept and design by S. Clarke and W. Blew

10 ! V.JAN 1 1994 MANAGER 20 OPTION BASE 1 30 CALL KEY(5,K,S) 40 DIM A$(20),B$(25),E$(10),A(20),FDT$(20),DU$(400) 50 OPEN #27:"DSK1.DEFAULTF",INPUT ,INTERNAL,RELATIVE,FIXED 20 :: INPUT #27,REC 1 :C$ :: CLOSE #27 60 OPEN #5:"RS232/2.BA="&C$,VARIABLE 132 :: AR$="OFF" 70 IF AR$="ON" THEN DISPLAY AT(12,6)ERASE ALL:"Auto-run activated": :" Loadi ng LOGON" :: RUN "DSK1.LOGON" 80 DISPLAY AT(1,8)ERASE ALL:"FILE MANAGER" :: DISPLAY AT(2,6):"BULLWINKLE BOARD" :: ON ERROR 2330 90 DISPLAY AT(4,1):"SELECT" 100 DISPLAY AT(6,1):"1- Users:cng/obsrv/del/srch" 110 DISPLAY AT(7,1):"2- Messages(BD#1):obsrv/del" :: DISPLAY AT(8,1):"3- User fi le-hard copy" 120 DISPLAY AT(9,1):"4- Run board from load" 130 DISPLAY AT(10,1):"5- ASCII file dates" 140 DISPLAY AT(11,1):"6- Meter readings/viewings" 150 DISPLAY AT(12,1):"7- Change hangman words" 160 DISPLAY AT(13,1):"8- Find duplicate users" 170 DISPLAY AT(14,1):"9- Exit (BD#/logon/Stp/Bye)":"10-DM":"11-BOGWIN (edit/intl )":"12-LASTFILE(edit)" 180 DISPLAY AT(18,1):"13-NEWFILE(edit)" 190 DISPLAY AT(19,1):"14-Reset actv users/low free" 200 DISPLAY AT(20,1):"15-Zero out all user flags":"16-Toggle 'AUTO-RUN':";AR$ 210 DISPLAY AT(22,1):"17-VOTE:read/save/zero" 220 ACCEPT AT(4,8)VALIDATE("0123456789")SIZE(2)BEEP:SEL$ :: IF SEL$="" THEN 220 ELSE SEL=VAL(SEL$) 230 IF SEL<1 OR SEL>17 THEN 220 240 IF SEL<>16 THEN 290 250 ON ERROR 280 :: CALL LINK("TEST") 260 IF AR$="ON" THEN AR$="OFF" :: DISPLAY AT(21,22):AR$ :: GOTO 220 270 IF AR$="OFF" THEN AR$="ON" :: DISPLAY AT(21,22):AR$ :: GOTO 220 ELSE 220 280 CALL ERR(E1,E2,E3,E4):: DISPLAY AT(21,1):"16-ASSEMBLY NOT LOADED!" :: ON ERR OR 2330 :: RETURN 220 290 ON SEL GOSUB 310,1270,1680,2150,1030,2350,2180,3060,2950,3260,2780,3280,3370 ,3460,3620,250,3830 300 GOTO 70 310 Z=0 :: OPEN #2:"DSK1.UFILE",UPDATE,RELATIVE,INTERNAL,FIXED 126 :: INPUT #2,R EC 0:AMOUNT$,CALLS$,AU$,LF$ :: AMOUNT=VAL(AMOUNT$) 320 DISPLAY AT(1,3)ERASE ALL:"CHANGE/SEARCH USER FILE" :: DISPLAY AT(2,1):"0-QUI T 999 to SEARCH":"Valid records: 1 -";AMOUNT 330 DISPLAY AT(4,2):"RECORD #?" :: ACCEPT AT(4,13):RN1 :: IF RN1=999 THEN MD=1 E LSE MD=0 :: RN=RN1 340 IF MD=1 THEN 790 350 IF RN>AMOUNT THEN 330 ELSE IF RN<>0 THEN 430 360 ON ERROR 420 370 PRINT #2,REC 0:AMOUNT$,CALLS$,AU$,LF$ 380 CLOSE #2 390 IF Z=0 THEN RETURN 400 OPEN #11:"DSK1.NEWFILE",INTERNAL,OUTPUT,VARIABLE 80 410 FOR Z=1 TO 10 :: PRINT #11:E$(Z):: NEXT Z :: CLOSE #11 420 RETURN 430 INPUT #2,REC RN:A$(1),A$(2),A$(3),A$(4),A$(5),A$(6),A$(7),A$(8),A$(9),A(10) 440 DISPLAY AT(7,1):"NAM":"ADR":"PWD":"CLS":"LST":"PHN":"CMP":"FLG":"VLD" 450 DISPLAY AT(16,1):"#MS" 460 FOR ITEM=1 TO 9 :: DISPLAY AT(ITEM+6,5):A$(ITEM):: NEXT ITEM 470 ITEM=10 :: DISPLAY AT(ITEM+6,5):A(ITEM) 480 IF MD<>1 THEN 500 490 DISPLAY AT(23,1):"This user? N" :: ACCEPT AT(23,16)SIZE(-1)VALIDATE("YN" ):CU$ :: IF CU$="N" THEN 980 500 DISPLAY AT(23,1):"C)nge D)el R)tn V)al S)pval" 510 CALL KEY(0,K,S):: IF S=0 THEN 510 520 IF K<>67 AND K<>68 AND K<>82 AND K<>86 AND K<>83 THEN 510 530 IF K<>83 THEN 620 540 DISPLAY AT(8,1):"":"1 Std validation-----":"2 D/L special files--":"3 ------ -------------":"4 -------------------" 550 DISPLAY AT(13,1):"5 -------------------":"6 -------------------":"7 Read pri vate mail--":"8 Bypass fctn active-" 560 DISPLAY AT(17,1):"9 Access to tests----":"10 Access to Remote--" 570 FOR X=1 TO 10 :: DISPLAY AT(8+X,22):SEG$(A$(9),X,1):: NEXT X 580 A$(9)="" 590 FOR X=1 TO 10 :: ACCEPT AT(8+X,22)SIZE(-1)VALIDATE("YN"):X$ :: A$(9)=A$(9)&X $ :: NEXT X 600 DISPLAY AT(23,1)BEEP:" A)bort R)edo F)ile" 610 CALL KEY(0,K,S):: IF K=65 THEN 320 ELSE IF K=82 THEN 580 ELSE IF K=70 THEN 6 50 ELSE 610 620 DISPLAY AT(23,1):"" :: IF K<>86 THEN 670 630 A$(9)="YNNNNNNNNN" :: DISPLAY AT(15,5):"VALIDATED" :: AU$=STR$(VAL(AU$)+1) 640 FOR Z=10 TO 2 STEP -1 :: E$(Z)=E$(Z-1):: NEXT Z :: E$(1)=A$(1)&" of "&A$(2) 650 FOR ITEM=1 TO 9 :: B$(ITEM)=A$(ITEM):: NEXT ITEM 660 B(10)=A(10):: GOTO 780 670 IF K=67 THEN 740 680 IF K=82 THEN 320 690 IF K=68 THEN DISPLAY AT(24,1)BEEP:"ARE YOU SURE? Y/N" :: ACCEPT AT(24,19)VAL IDATE("YN"):SURE$ :: IF SURE$="N" THEN 320 700 IF SURE$<>"Y" THEN GOTO 320 710 FOR ITEM=1 TO 8 :: B$(ITEM)="DELETED" :: NEXT ITEM 720 B$(9)="NNNNNNNNNN" 730 B(10)=0 :: AU$=STR$(VAL(AU$)-1):: IF RN<VAL(LF$)THEN LF$=STR$(RN):: GOTO 780 ELSE 780 740 FOR ITEM=1 TO 9 :: ACCEPT AT(ITEM+6,5)SIZE(-20):B$(ITEM):: NEXT ITEM 750 ACCEPT AT(16,6)SIZE(-20):B$(10) 760 ON ERROR 440 770 B(10)=VAL(B$(10)) 780 PRINT #2,REC RN:B$(1);B$(2),B$(3),B$(4),B$(5),B$(6),B$(7),B$(8),B$(9),B(10): : IF MD=1 AND ND$="D" THEN 980 ELSE 320 790 DISPLAY AT(7,1):"Search N)ame/D)ate/Spvl N" :: ACCEPT AT(7,25)SIZE(-1)VALIDA TE("NDS"):ND$ :: IF ND$="N" THEN 830 ELSE IF ND$="S" THEN 840 800 DISPLAY AT(7,1)BEEP:"Enter last acceptable month" :: DISPLAY AT(9,1):"Search -" :: ACCEPT AT(9,8)SIZE(2)VALIDATE(DIGIT)BEEP:SN$ 810 DISPLAY AT(7,1)BEEP:"Enter last acceptable year" :: DISPLAY AT(9,1):"Search- " :: ACCEPT AT(9,8)SIZE(2)VALIDATE(DIGIT)BEEP:YR$ 820 GOTO 840 830 DISPLAY AT(7,1):"Enter name or any correct portion of name" :: DISPLAY AT( 9,1):"Search-" :: ACCEPT AT(9,8)BEEP:SN$ :: GOTO 840 840 IF RN=0 THEN RN=1 850 DISPLAY AT(11,2):"Start rec #?";RN :: ACCEPT AT(11,15)SIZE(-3)VALIDATE(DIGIT ):BEGIN 860 FOR RN=BEGIN TO AMOUNT 870 DISPLAY AT(4,12):RN 880 INPUT #2,REC RN:A$(1),A$(2),A$(3),A$(4),A$(5),A$(6),A$(7),A$(8),A$(9),A(10) 890 IF ND$="N" THEN 960 ELSE IF ND$="S" THEN 970 900 IF A$(1)="DELETED" OR A$(1)="RESERVED" THEN 980 910 ON ERROR 950 920 IF VAL(SEG$(A$(5),POS(A$(5)," ",1)-2,2))<VAL(YR$)THEN 440 930 IF VAL(SEG$(A$(5),POS(A$(5)," ",1)-2,2))=VAL(YR$)+1 THEN 980 940 IF VAL(SN$)<=VAL(SEG$(A$(5),1,POS(A$(5),"/",1)-1))THEN 980 ELSE 440 950 CALL ERR(E1,E2,E3,E4):: DISPLAY AT(4,12):RN :: RETURN 440 960 IF POS(A$(1),SN$,1)>0 THEN 440 ELSE 980 970 IF POS(A$(9),"Y",2)>0 THEN 440 980 DISPLAY AT(23,1):"Searching.(space bar aborts)":"" 990 CALL KEY(0,K,S):: IF K=32 THEN CLOSE #2 :: RETURN 1000 NEXT RN 1010 DISPLAY AT(23,1)BEEP:"ALL RECORDS SEARCHED-ENTER" 1020 CALL KEY(0,K,S):: IF K<>13 THEN 1020 ELSE 320 1030 DISPLAY AT(1,4)ERASE ALL:"ASCII FILE DATE UPDATES" :: ON ERROR 1060 1040 OPEN #1:"DSK1.FILEDATES",INTERNAL,RELATIVE,INPUT ,FIXED 12 1050 FOR RC=1 TO 20 :: INPUT #1,REC RC:A$(RC):: NEXT RC :: CLOSE #1 1060 DISPLAY AT(3,1):"Bulletins" :: DISPLAY AT(4,1):"Info/system" :: DISPLAY AT( 5,1):"Other BBS's" 1070 DISPLAY AT(6,1):"Points" :: DISPLAY AT(7,1):"Votes(prev)" :: DISPLAY AT(8,1 ):"T/TI" 1080 DISPLAY AT(9,1):"T/Geneve" :: DISPLAY AT(10,1):"T/Atari" :: DISPLAY AT(11,1 ):"T/Commodore" :: DISPLAY AT(12,1):"T/IBM" :: DISPLAY AT(13,1):"T/Pics" 1090 DISPLAY AT(14,1):"Hymn" :: DISPLAY AT(15,1):"----------":"Editorial":"Curio s" 1100 DISPLAY AT(18,1):"Solve mstry" :: DISPLAY AT(19,1):"Reveal mstry" 1110 DISPLAY AT(20,1):"Geneve/TI":"----------":"----------" 1120 FOR FL=1 TO 20 :: DISPLAY AT(2+FL,19):A$(FL):: NEXT FL 1130 DISPLAY AT(2,13):"Update?" :: DISPLAY AT(24,1):" A)bort Y)es N)o" 1140 COL=13 :: ROW=3 :: FOR RC=1 TO 20 :: B$(RC)="" :: NEXT RC 1150 FOR FL=1 TO 20 :: DISPLAY AT(ROW,COL)SIZE(1):"N" :: ACCEPT AT(ROW,COL)SIZE( -1)VALIDATE("AYN"):UD$ 1160 IF UD$="N" THEN 1200 ELSE IF UD$="A" THEN RETURN 1170 DISPLAY AT(ROW,COL):"A (Auto/Manual)" :: ACCEPT AT(ROW,COL)SIZE(-1)VALIDATE ("AM"):MA$ 1180 IF MA$="A" THEN DISPLAY AT(ROW,COL):"A" :: GOSUB 1980 :: B$(FL)=T2$ :: DISP LAY AT(ROW,19):B$(FL):: GOTO 1210 1190 DISPLAY AT(ROW,COL):"Date? " :: ACCEPT AT(ROW,19):B$(FL):: GOTO 1210 1200 B$(FL)=A$(FL) 1210 ROW=ROW+1 1220 NEXT FL 1230 DISPLAY AT(24,1):"A>bort * R>edo * F>ile" :: CALL KEY(0,K,S):: IF S=0 THEN 1230 ELSE IF K<>70 AND K<>82 AND K<>65 THEN 1230 1240 IF K=65 THEN RETURN ELSE IF K=82 THEN 1030 1250 OPEN #1:"DSK1.FILEDATES",INTERNAL,RELATIVE,UPDATE,FIXED 12 1260 FOR RC=1 TO 20 :: PRINT #1,REC RC:B$(RC):: NEXT RC :: CLOSE #1 :: RETURN 1270 OPEN #9:"DSK1.MESSAGES",INTERNAL,RELATIVE,UPDATE,FIXED 84 :: INPUT #9,REC 0 :FM,LM 1280 DISPLAY AT(1,6)ERASE ALL:"DELETE MESSAGES(BOARDA)" 1290 DISPLAY AT(2,1):"Which message?" :: DISPLAY AT(3,1):FM;" to";LM;" Zero quit s" 1300 ACCEPT AT(2,17)SIZE(4)VALIDATE(DIGIT):DMN :: IF DMN=0 THEN CLOSE #9 :: RETU RN ELSE MESN=DMN 1310 IF DMN<FM OR DMN>LM THEN 1280 1320 IF LEN(STR$(DMN))=1 THEN DMN=DMN*13+1 ELSE DMN=VAL(SEG$(STR$(DMN),LEN(STR$( DMN))-1,2)):: DMN=DMN*13+1 1330 DISPLAY AT(4,1):"Make file? N" :: ACCEPT AT(4,12)SIZE(-1)VALIDATE("YN"):MF$ :: IF MF$="N" THEN 1360 1340 DISPLAY AT(5,1):"Out DRV #? 4" :: ACCEPT AT(5,12)SIZE(-1)VALIDATE("01234"): DR$ :: IF DR$="0" THEN MF$="N" 1350 IF MF$="Y" THEN OPEN #31:"DSK"&DR$&".F"&STR$(MESN),OUTPUT 1360 ON ERROR 1660 1370 INPUT #9,REC DMN:MESN,TO$,FROM$,SUB$,DATE$ :: I=9 1380 DISPLAY AT(4,1):"To: ";TO$:"From: ";FROM$:"Sub: ";SUB$:"Date: ";DATE$ 1390 IF MF$="Y" THEN PRINT #31:TO$:FROM$:SUB$:DATE$ :: GOTO 1470 1400 DISPLAY AT(24,1):"A)bort E)dit N)ext D)elete" 1410 CALL KEY(0,K,S):: IF K<>65 AND K<>69 AND K<>78 AND K<>68 THEN 1410 1420 IF K=65 THEN 1280 ELSE IF K=78 THEN 1470 ELSE IF K=68 THEN 1600 1430 ACCEPT AT(4,7)SIZE(-18):TO$ :: ACCEPT AT(5,7)SIZE(-18):FROM$ :: ACCEPT AT(6 ,7)SIZE(-18):SUB$ :: ACCEPT AT(7,7)SIZE(-18):DATE$ 1440 DISPLAY AT(24,1):"S)ave D)isregard" 1450 CALL KEY(0,K,S):: IF K=68 THEN 1470 ELSE IF K<>83 THEN 1450 1460 PRINT #9,REC DMN:MESN,TO$,FROM$,SUB$,DATE$ 1470 FOR X=1 TO 12 1480 INPUT #9,REC DMN+X:MS$ :: IF MS$="@END@" THEN 1600 1490 DISPLAY AT(I,1):MS$ :: IF MF$="Y" THEN PRINT #31:MS$ :: GOTO 1580 1500 DISPLAY AT(24,1):"A)bort E)dit N)ext" 1510 CALL KEY(0,K,S):: IF K<>65 AND K<>69 AND K<>78 THEN 1510 1520 IF K=65 THEN 1280 ELSE IF K=78 THEN 1580 1530 DISPLAY AT(24,1):"enter new line-80 chars:" 1540 ACCEPT AT(I,1)SIZE(-28):A$(1):: ACCEPT AT(I+1,1)SIZE(-28):A$(2):: ACCEPT AT (I+2,1)SIZE(-24):A$(3) 1550 DISPLAY AT(24,1):"S)ave D)isregard" 1560 CALL KEY(0,K,S):: IF K=68 THEN 1580 ELSE IF K<>83 THEN 1560 1570 MS$=A$(1)&A$(2)&A$(3):: PRINT #9,REC DMN+X:MS$ :: GOTO 1500 1580 IF I=9 THEN I=13 ELSE IF I=13 THEN I=17 ELSE IF I=17 THEN I=21 ELSE IF I=21 THEN CALL HCHAR(9,1,32,480):: I=9 1590 NEXT X 1600 IF MF$="N" THEN 1620 1610 CLOSE #31 :: GOTO 1280 1620 DISPLAY AT(24,1):"Delete? N" :: ACCEPT AT(24,9)SIZE(-1)VALIDATE("YyNn"):SUR E$ 1630 IF SURE$="N" OR SURE$="n" THEN 1280 1640 PRINT #9,REC DMN:MESN;"DELETED";"DELETED";"DELETED";"DELETED" 1650 GOTO 1280 1660 PRINT : : : 1670 DISPLAY AT(23,1)BEEP:"CAN'T READ MESS/FILE" :: GOTO 1600 1680 DISPLAY AT(1,6)ERASE ALL:"PRINT USER FILE" 1690 DISPLAY AT(7,1):"PRINT:A)ll or N)on-validated" 1700 CALL KEY(0,K,S):: IF S=0 THEN 1700 1710 IF K=65 THEN MODE$="" ELSE IF K=78 THEN MODE$="NON" ELSE 1700 1720 GOSUB 1980 :: IF MODE$="" THEN DISPLAY AT(7,1):"Printing all users" :: PRIN T #5:"List of all users: Bullwinkle's Corner ";T3$: : 1730 IF MODE$="NON" THEN DISPLAY AT(7,1):"Printing non-validated users" :: PRINT #5:"List of non-validated users: Bullwinkle's Corner ";T3$: : 1740 OPEN #1:"DSK1.UFILE",INPUT ,INTERNAL,RELATIVE,FIXED 126 1750 INPUT #1,REC 0:AM$,CALLS$,AU$,LF$ :: AM=VAL(AM$):: IF MODE$="NON" THEN EN=A M :: ST=1 :: GOTO 1790 1760 DISPLAY AT(6,1):"PRINT STARTING AT # 1" :: DISPLAY AT(7,1):"PRINT ENDING AT #";AM 1770 ACCEPT AT(6,21)SIZE(-3):ST :: IF ST<0 OR ST>AM THEN 1770 1780 ACCEPT AT(7,19)SIZE(-3):EN :: IF EN<1 OR EN>AM THEN 1780 1790 GOSUB 1950 1800 FOR X=ST TO EN 1810 DISPLAY AT(10,1):"NUMBER OF USERS: ";AM :: DISPLAY AT(12,1):"PRINTING USER #";X 1820 INPUT #1,REC X:A$(1),A$(2),A$(3),A$(4),A$(5),A$(6),A$(7),A$(8),A$(9),A(10) 1830 IF LEN(A$(5))<>0 AND POS(A$(5)," ",1)<>0 THEN A$(5)=SEG$(A$(5),1,POS(A$(5), " ",1)-1) 1840 IF LEN(A$(2))<>0 THEN A$(2)=SEG$(A$(2),1,10) 1850 IF MODE$<>"NON" THEN 1890 1860 IF MODE$="NON" AND SEG$(A$(9),1,1)<>"Y" AND A$(1)<>"DELETED" AND A$(1)<>"RE SERVED" THEN 1870 ELSE 1930 1870 PRINT #5:STR$(X);TAB(5);A$(1);TAB(25);A$(2);TAB(37);A$(3);TAB(46);A$(4);TAB (54);A$(5);TAB(65);A$(6);TAB(80);A$(7); 1880 PRINT #5:TAB(80+LEN(A$(7)));RPT$(".",32-LEN(A$(7)));TAB(112);"[]V []D []B [ ]NA []O" :: GOTO 1930 1890 IF A$(1)="DELETED" THEN PRINT #5:STR$(X);TAB(5);"VACANT USER NUMBER" :: GOT O 1920 1900 PRINT #5:STR$(X);TAB(5);SEG$(A$(1),1,20);TAB(25);A$(2);TAB(37);A$(3);TAB(46 );A$(4);TAB(54);A$(5);TAB(65);A$(6); 1910 PRINT #5:TAB(80);A$(7);TAB(104);A$(8);TAB(115);A$(9);TAB(126);A(10) 1920 IF X/54=INT(X/54)THEN PRINT #5: : : : : : : : : : : :: GOSUB 1950 1930 NEXT X 1940 CLOSE #1 :: RETURN 1950 PRINT #5:"U#";TAB(5);"NAME";TAB(25);"ADDRESS";TAB(37);"PASSWD";TAB(46);"CAL LS";TAB(54);"LAST";TAB(65);"PHONE"; 1960 PRINT #5:TAB(80);"COMPUTER";:: IF MODE$="NON" THEN PRINT #5:" [V]al [D]el [B]usy [N]o-ans [O]ther":RPT$("=",132):: RETURN 1970 PRINT #5:TAB(104);"U/FLAG";TAB(115);"VALID";TAB(126);"READ":RPT$("=",132):: RETURN 1980 DEF TIME=TV1-6*INT(TV1/16)!BCD to Decimal Converter 1990 CALL PEEK(-31158,X1,X2,DV,X4,X5) 2000 TV1=DV :: DV$=STR$(TIME) 2010 TV1=X5 :: X5=TIME 2020 T2$=STR$(X5)&"/"&DV$&"/94" 2030 CALL PEEK(-31164,X1,X2,X3,X4,X5) 2040 TV1=X1 :: SEC$=STR$(TIME) 2050 IF X1<10 THEN SEC$="0"&SEC$ 2060 TV1=X3 :: MIN$=STR$(TIME) 2070 IF X3<10 THEN MIN$="0"&MIN$ 2080 TV1=X5 :: HR=TIME :: M$="am" 2090 IF HR>11 THEN M$="pm" 2100 IF HR=0 THEN HR=12 2110 IF HR>12 THEN HR=HR-12 2120 HR$=STR$(HR) 2130 T1$=HR$&":"&MIN$&M$ 2140 T3$=T2$&" "&T1$ :: RETURN 2150 DISPLAY AT(1,1)ERASE ALL:"LOAD BOARD" 2160 DISPLAY AT(3,3):"LOAD:LOAD/POWERUP/LOGON" 2170 DISPLAY AT(23,10):"Loading...." :: RUN "DSK1.LOAD" 2180 DISPLAY AT(1,1)ERASE ALL:"INPUT NEW WORDS FOR HANGMAN" 2190 DISPLAY AT(3,1):"Input 23 words/20 char limit":"CHECK SPELLING!":"ALPHA LOC K DOWN!!!!!!!" 2200 FOR DELAY=1 TO 400 :: NEXT DELAY :: CALL CLEAR :: C=1 2210 DISPLAY AT(1,1):"THEME? " :: ACCEPT AT(1,1)SIZE(-28):B$(24) 2220 FOR X=1 TO 23 :: DISPLAY AT(X+1,1)BEEP:STR$(X) 2230 ACCEPT AT(X+1,C)SIZE(-28):B$(X):: NEXT X 2240 ND$="A-bort E-dit F-ile" :: CALL SOUND(200,1000,2) 2250 FOR ND=1 TO LEN(ND$):: CALL HCHAR(ND+5,28,ASC(SEG$(ND$,ND,1)),1):: NEXT ND 2260 CALL KEY(0,K,S):: IF S=0 THEN 2260 ELSE IF K=65 THEN RETURN ELSE IF K=70 TH EN 2300 ELSE IF K<>69 THEN 2260 2270 DISPLAY AT(24,1):"Edit which number?" :: ACCEPT AT(24,20)VALIDATE(NUMERIC): X :: IF X>24 THEN 2270 2280 ACCEPT AT(X+1,1)SIZE(-28):B$(X) 2290 GOTO 2240 2300 DISPLAY AT(24,1)ERASE ALL:"FILING" :: ON ERROR 2320 :: OPEN #36:"DSK1.HANGM AN",OUTPUT,INTERNAL,RELATIVE,FIXED 32 2310 FOR X=1 TO 24 :: DISPLAY AT(11,2):"Printing ": :B$(X):: PRINT #36,REC X:B$( X):: NEXT X :: CLOSE #36 :: RETURN 2320 CALL ERR(E1,E2,E3,E4):: DISPLAY AT(24,1)BEEP:"DISK ERROR ";E1;E2;E3;E4 :: F OR DELAY=1 TO 500 :: NEXT DELAY :: RETURN 2240 2330 CALL ERR(E1,E2,E3,E4):: PRINT "ERROR DETECTED-NOT ROUTINED":E1;E2;E3;E4 :: STOP 2340 RETURN 1270 2350 ON ERROR 2370 2360 OPEN #1:"DSK1.METER",INPUT ,RELATIVE,INTERNAL,FIXED 40 :: INPUT #1,REC 0:R, LR,NR,MO$ :: CLOSE #1 :: GOTO 2410 2370 CALL ERR(E1,E2,E3,E4):: CALL SOUND(800,110,2):: DISPLAY AT(24,1):"INITIALIZ E? Y/N" 2380 CALL KEY(0,K,S):: IF S=0 THEN 2380 ELSE IF K=78 THEN 2760 ELSE IF K<>89 THE N 2380 2390 DISPLAY AT(24,1)BEEP:"START READING:" :: ACCEPT AT(24,16)SIZE(4)VALIDATE(DI GIT):TR :: NR=1 :: GOSUB 1980 :: MO$=T2$ :: US,R=0 2400 GOSUB 2550 :: GOTO 2760 2410 DISPLAY AT(1,4)ERASE ALL:"METER READINGS/VIEW" 2420 DISPLAY AT(3,1):"Last read on:":" reading:":"Energy rate :$":"Ready - l og#:":"Total usage :":"Total cost :$" 2430 DISPLAY AT(3,18):MO$ :: DISPLAY AT(4,17):LR :: DISPLAY AT(5,17):R :: DISPLA Y AT(6,17):NR 2440 DISPLAY AT(22,1):"1-New reading":"2-View month 3-Print month":"4-Abort" 2450 CALL KEY(0,K,S):: IF S=0 OR K>52 OR K<49 THEN 2450 2460 IF K=52 THEN RETURN 2470 TCOST=0 :: CALL HCHAR(22,1,32,96) 2480 ON K-48 GOTO 2490,2620,2620 2490 ACCEPT AT(8,18)VALIDATE(NUMERIC)SIZE(-7):COST 2500 ACCEPT AT(7,18)VALIDATE(DIGIT)SIZE(4):US 2510 ACCEPT AT(4,18)SIZE(-4)VALIDATE(DIGIT):TR :: GOSUB 1980 :: MO$=T2$ :: DISPL AY AT(3,17):MO$ :: R=COST/US 2520 R=INT(R*100000)/100000 :: DISPLAY AT(5,18):R 2530 IF TR-LR<0 THEN US=10000-LR+TR ELSE US=TR-LR 2540 DISPLAY AT(7,17):US :: COST=US*R :: DISPLAY AT(8,17):COST :: DISPLAY AT(7,1 )SIZE(5):"Board" :: DISPLAY AT(8,1)SIZE(5):"Board" 2550 DISPLAY AT(24,1)BEEP:" A)bort F)ile" 2560 CALL KEY(0,K,S):: IF S=0 THEN 2560 2570 IF K=65 THEN RETURN ELSE IF K<>70 THEN 2560 2580 OPEN #1:"DSK1.METER",UPDATE,RELATIVE,INTERNAL,FIXED 40 :: PRINT #1,REC NR:M O$;US;R :: NR=NR+1 2590 PRINT #1,REC 0:R;TR;NR;MO$ :: CLOSE #1 2600 DISPLAY AT(24,1):" PRESS ANY KEY TO RETURN" 2610 CALL KEY(0,K,S):: IF S=0 THEN 2610 ELSE RETURN 2620 X=1 :: IF K=50 THEN OPT$="V" ELSE OPT$="P" 2630 OPEN #1:"DSK1.METER",INPUT ,RELATIVE,INTERNAL,FIXED 40 :: INPUT #1,REC 0:R, LR,NR,MO$ 2640 IF OPT$="V" THEN 2660 2650 PRINT #5:"DATE";TAB(10);"RATE";TAB(20);"USAGE";TAB(30);"COST" :: PRINT #5:R PT$("-",80): : 2660 INPUT #1,REC X:MO$,US,R 2670 DISPLAY AT(3,18):MO$ :: DISPLAY AT(4,17):"" :: DISPLAY AT(5,17):R :: DISPLA Y AT(6,17):X 2680 DISPLAY AT(7,17):US :: COST=US*R :: DISPLAY AT(8,17):COST 2690 IF OPT$="V" THEN 2710 2700 PRINT #5:MO$;TAB(10);R;TAB(20);US;TAB(30);"$";COST :: TCOST=TCOST+COST :: G OTO 2730 2710 DISPLAY AT(24,1):" N)ext R)eturn" 2720 CALL KEY(0,K,S):: IF S=0 THEN 2720 ELSE IF K=82 THEN CLOSE #1 :: RETURN 2730 CALL HCHAR(24,1,32,32):: X=X+1 :: IF X=NR THEN CLOSE #1 :: IF OPT$="P" THEN PRINT #5: :"TOTAL COST ACCUMULATIVE=$";TCOST 2740 IF X=NR THEN RETURN 2750 GOTO 2660 2760 RETURN 2770 2770 RETURN 2780 DISPLAY AT(1,8)ERASE ALL:"BOGWIN-": :"A)bort E)dit I)nit" 2790 CALL KEY(0,K,S):: IF S=0 THEN 2790 2800 IF K=65 THEN RETURN ELSE IF K=73 THEN 2920 ELSE IF K<>69 THEN 2790 2810 OPEN #20:"DSK1.BOGWIN",INTERNAL,RELATIVE,INPUT ,FIXED 80 2820 INPUT #20,REC 0:NOQ,NOP :: DISPLAY AT(3,1):"QUEST=";NOQ,"PLAYS=";NOP 2830 FOR X=1 TO 10 :: INPUT #20,REC X:E$(X),E(X):: DISPLAY AT(4+X,1):E$(X):: DIS PLAY AT(4+X,18):E(X):: NEXT X :: CLOSE #20 2840 ACCEPT AT(3,8)SIZE(-3):NOQ :: ACCEPT AT(3,22)SIZE(-3):NOP 2850 FOR X=1 TO 10 :: ACCEPT AT(4+X,1)SIZE(-18):E$(X):: ACCEPT AT(4+X,19)SIZE(-4 ):E(X):: NEXT X 2860 DISPLAY AT(24,1):"A)bort E)dit F)ile" 2870 CALL KEY(0,K,S):: IF S=0 THEN 2870 2880 IF K=65 THEN RETURN ELSE IF K=69 THEN 2840 ELSE IF K<>70 THEN 2870 2890 OPEN #20:"DSK1.BOGWIN",INTERNAL,RELATIVE,OUTPUT,FIXED 80 2900 PRINT #20,REC 0:NOQ;NOP 2910 FOR X=1 TO 10 :: PRINT #20,REC X:E$(X);E(X):: NEXT X :: CLOSE #20 :: RETURN 2920 OPEN #20:"DSK1.BOGWIN",INTERNAL,RELATIVE,OUTPUT,FIXED 80 2930 PRINT #20,REC 0:267;0 2940 FOR X=1 TO 10 :: PRINT #20,REC X:"Vacant Spot";0 :: NEXT X :: CLOSE #20 :: RETURN 2950 DISPLAY AT(1,14)ERASE ALL:"EXIT" :: DISPLAY AT(3,2):"1 Stop":" 2 Bye":" 3 R eturn":" 4 Logon":" 5 BoardA":" 6 BoardB":" 7 BoardC" 2960 DISPLAY AT(11,2):"Choice?" 2970 CALL KEY(0,K,S):: IF S=0 THEN 2970 ELSE IF K<49 OR K>55 THEN 2970 2980 ON K-48 GOTO 2990,3000,3010,3050,3020,3030,3040 2990 CALL CLEAR :: STOP 3000 CALL INIT :: CALL LOAD(-31804,0,36) 3010 RETURN 3020 DISPLAY AT(24,1):"Loading BoardA...." :: RUN "DSK1.BOARDA" 3030 DISPLAY AT(24,1):"Loading BoardB...." :: RUN "DSK1.BOARDB" 3040 DISPLAY AT(24,1):"Loading BoardC...." :: RUN "DSK1.BOARDC" 3050 DISPLAY AT(24,1):"Loading Logon...." :: RUN "DSK1.LOGON" 3060 DISPLAY AT(1,2)ERASE ALL:"SEARCH AND POST DUP USERS" :: DISPLAY AT(3,2):"Re ading all users:" :: DISPLAY AT(5,1):"NAME:":"PHONE:" 3070 OPEN #2:"DSK1.UFILE",UPDATE,RELATIVE,INTERNAL,FIXED 126 :: INPUT #2,REC 0:A MOUNT$ :: AMOUNT=VAL(AMOUNT$) 3080 FOR X=1 TO AMOUNT :: INPUT #2,REC X:NA$,NU$,NU$,NU$,NU$,NU$ :: DISPLAY AT(5 ,8):NA$ :: DISPLAY AT(6,8):NU$ 3090 IF NA$="DELETED" OR NA$="RESERVED" THEN DU$(X)=NA$&"@"&NU$ :: GOTO 3110 3100 DU$(X)=NA$&"@"&SEG$(NU$,LEN(NU$)-7,8) 3110 DISPLAY AT(3,21):X 3120 NEXT X 3130 DISPLAY AT(5,1):"":"" :: DISPLAY AT(3,21):"" :: CLOSE #2 3140 DISPLAY AT(3,2):"Comparing:" :: R=5 :: C=1 3150 FOR X=1 TO AMOUNT-1 3160 FOR Y=X+1 TO AMOUNT 3170 DISPLAY AT(3,13):STR$(X);" to ";STR$(Y):: IF POS(DU$(X),"DELETED",1)>1 OR P OS(DU$(X),"RESERVED",1)>1 THEN 3210 3180 A$(1)=SEG$(DU$(X),1,POS(DU$(X),"@",1)-1):: B$(1)=SEG$(DU$(X),POS(DU$(X),"@" ,1)+1,LEN(DU$(X))-LEN(A$(1))-1) 3190 A$(2)=SEG$(DU$(Y),1,POS(DU$(Y),"@",1)-1):: B$(2)=SEG$(DU$(Y),POS(DU$(Y),"@" ,1)+1,LEN(DU$(Y))-LEN(A$(2))-1) 3200 IF A$(1)=A$(2)OR B$(1)=B$(2)THEN GOSUB 3240 3210 NEXT Y 3220 NEXT X 3230 DISPLAY AT(3,2)BEEP:"End of compares" :: RETURN 3240 DISPLAY AT(R,C):STR$(X);"-";STR$(Y):: R=R+1 :: IF R=24 THEN R=5 :: C=C+8 3250 PRINT #5:STR$(X);TAB(5);A$(1);TAB(30);B$(1);TAB(40);STR$(Y);TAB(45);A$(2);T AB(70);B$(2):: RETURN 3260 DISPLAY AT(1,7)ERASE ALL:"DISK MANAGER SYSTEM": : 10 CALL INIT :: CALL LOAD(8196,63,248):: CALL LOAD(16376,65,32,32,32,32,32,255,4 8):: CALL LINK("A") 100 REM POWERLOAD(8)12/31/91 110 CALL LINK("SETUP"):: DISPLAY AT(1,1)ERASE ALL:"Bullwinkle's Corner BBS":"Ass embly loaded (ver .O8)":"Loading Logon. :: CLOS E #20 :: GOTO 3320 3310 DISPLAY AT(24,1):"" :: FOR X=1 TO 10 :: ACCEPT AT(3+X,1)SIZE(-32):E$(X):: N EXT X 3320 DISPLAY AT(24,1):" A)bort E)dit F)ile" 3330 CALL KEY(0,K,S):: IF S=0 THEN 3330 3340 IF K=65 THEN RETURN ELSE IF K=69 THEN 3310 ELSE IF K<>70 THEN 3330 3350 OPEN #20:"DSK1.LASTFILE",INTERNAL,OUTPUT,VARIABLE 80 3360 FOR X=1 TO 10 :: PRINT #20:E$(X):: NEXT X :: CLOSE #20 :: RETURN 3370 DISPLAY AT(1,7)ERASE ALL:"NEWFILE EDIT" 3380 OPEN #20:"DSK1.NEWFILE",INTERNAL,INPUT ,VARIABLE 80 3390 FOR X=1 TO 10 :: INPUT #20:E$(X):: DISPLAY AT(3+X,1):E$(X):: NEXT X :: CLOS E #20 :: GOTO 3410 3400 DISPLAY AT(24,1):"" :: FOR X=1 TO 10 :: ACCEPT AT(3+X,1)SIZE(-32):E$(X):: N EXT X 3410 DISPLAY AT(24,1):" A)bort E)dit F)ile" 3420 CALL KEY(0,K,S):: IF S=0 THEN 3420 3430 IF K=65 THEN RETURN ELSE IF K=69 THEN 3400 ELSE IF K<>70 THEN 3420 3440 OPEN #20:"DSK1.NEWFILE",INTERNAL,OUTPUT,VARIABLE 80 3450 FOR X=1 TO 10 :: PRINT #20:E$(X):: NEXT X :: CLOSE #20 :: RETURN 3460 DISPLAY AT(1,1)ERASE ALL:"Reset actv users/lowest free" 3470 OPEN #2:"DSK1.UFILE",UPDATE,RELATIVE,INTERNAL,FIXED 126 :: INPUT #2,REC 0:A M$,CALLS$,AU$,LF$ :: AM=VAL(AM$):: AU=0 :: LF=AM 3480 DISPLAY AT(4,1):"Calls to date :";TAB(18);CALLS$ :: DISPLAY AT(5,1):"Avail accounts:";TAB(18);AM$ 3490 DISPLAY AT(6,1):"Active users :";TAB(18);AU$ :: DISPLAY AT(7,1):"Lowest fr ee :";TAB(18);LF$ 3500 DISPLAY AT(8,1):"Empty accounts:";TAB(17);VAL(AM$)-VAL(AU$):" (or not val)" 3510 DISPLAY AT(23,1)BEEP:" C)alculate R)eturn" 3520 CALL KEY(0,K,S):: IF S=0 THEN 3520 3530 IF K=67 THEN 3540 ELSE IF K=82 THEN CLOSE #2 :: RETURN ELSE 3520 3540 FOR RN=1 TO AM 3550 INPUT #2,REC RN:A$(1) 3560 IF A$(1)="DELETED" AND RN<LF THEN LF=RN 3570 IF A$(1)<>"DELETED" AND A$(1)<>"RESERVED" THEN AU=AU+1 3580 DISPLAY AT(4,1):"Name:";A$(1):: DISPLAY AT(5,1):"Record:";TAB(17);RN :: DIS PLAY AT(6,1):"Active users:";TAB(17);AU 3590 DISPLAY AT(7,1):"Lowest free:";TAB(17);LF 3600 NEXT RN 3610 AU$=STR$(AU):: LF$=STR$(LF):: PRINT #2,REC 0:AM$,CALLS$,AU$,LF$ :: GOTO 348 0 3620 OPEN #2:"DSK1.UFILE",UPDATE,RELATIVE,INTERNAL,FIXED 126 :: INPUT #2,REC 0:A MOUNT$,CALLS$,AU$,LF$ :: AMOUNT=VAL(AMOUNT$) 3630 INPUT #2,REC 4:A$(1),A$(2),A$(3),A$(4),A$(5),A$(6),A$(7),A$(8),A$(9),A(10) 3640 DISPLAY AT(1,3)ERASE ALL:"ZERO OUT USER FLAGS":"(master record is user #4)" 3650 DISPLAY AT(4,1):"File------1" :: DISPLAY AT(5,1):"File------2" :: DISPLAY A T(6,1):"File------3" :: DISPLAY AT(7,1):"File------4" 3660 DISPLAY AT(8,1):"File------5" :: DISPLAY AT(9,1):"File------6" :: DISPLAY A T(10,1):"File------7" :: DISPLAY AT(11,1):"File------8" 3670 DISPLAY AT(12,1):"File------9" :: DISPLAY AT(13,1):"Vote flag" 3680 FOR X=1 TO 10 :: DISPLAY AT(X+3,15):SEG$(A$(8),X,1);" (0/1/No cng)" :: NEXT X 3690 FOR X=1 TO 10 :: ACCEPT AT(X+3,15)SIZE(-1)VALIDATE("01N"):B$(X):: NEXT X 3700 DISPLAY AT(24,1)BEEP:"A)bort F)ile R)edo" 3710 CALL KEY(0,K,S):: IF K=65 THEN CLOSE #2 :: RETURN ELSE IF K=82 THEN DISPLAY AT(24,1):"" :: GOTO 3680 ELSE IF K<>70 THEN 3710 3720 FOR X=1 TO AMOUNT 3730 DISPLAY AT(21,1):"USER FLAG #";X 3740 INPUT #2,REC X:A$(1),A$(2),A$(3),A$(4),A$(5),A$(6),A$(7),A$(8),A$(9),A(10): : ND$="" :: DISPLAY AT(23,1):"Old flag:";A$(8) 3750 FOR P=1 TO 10 3760 IF B$(P)="N" THEN ND$=ND$&SEG$(A$(8),P,1):: GOTO 3780 3770 ND$=ND$&B$(P) 3780 NEXT P 3790 DISPLAY AT(24,1):"New flag:";ND$ 3800 PRINT #2,REC X:A$(1);A$(2),A$(3),A$(4),A$(5),A$(6),A$(7),ND$,A$(9),A(10) 3810 NEXT X 3820 CLOSE #2 :: RETURN 3830 DISPLAY AT(1,1)ERASE ALL:"VOTE: Read file/zero flag" 3840 DR$="0" :: DISPLAY AT(3,1):"R)eadF S)aveF I)nit tally" 3850 DISPLAY AT(5,1):" To redo the voting box:":"1 S)aveF (to blank disk)":"2 In corporate saved VF into FILE/V" 3860 DISPLAY AT(9,1):"3 Rewrite new issue in FLASH number=# of selections":"4 R eset user flag #10 (1)":"5 Copy FLASH & FILE/V to sys" 3870 DISPLAY AT(13,1):"6 Update Vote (prev) date":"7 Init Vote tally file" 3880 CALL KEY(0,K,S):: IF K=73 THEN 3890 ELSE IF K=82 THEN 4030 ELSE IF K=83 THE N 3990 ELSE 3880 3890 OPEN #59:"DSK2.FLASH",INPUT 3900 IF EOF(59)THEN CLOSE #59 :: DISPLAY AT(24,1)BEEP:"No @V found!!" :: GOTO 40 20 3910 LINPUT #59:X$ :: IF SEG$(X$,1,2)<>"@V" THEN 3900 ELSE N=VAL(SEG$(X$,3,1)) 3920 DISPLAY AT(16,1):N;"choices" 3930 IF EOF(59)THEN CLOSE #59 :: DISPLAY AT(24,1)BEEP:"No @E@ found!!" :: GOTO 4 020 3940 LINPUT #59:X$ :: IF SEG$(X$,1,3)<>"@E@" THEN 3930 ELSE CLOSE #59 3950 OPEN #67:"DSK1.BALLOT",RELATIVE,INTERNAL,OUTPUT,FIXED 15 3960 PRINT #67,REC 0:N 3970 FOR X=1 TO N :: PRINT #67,REC X:0 :: NEXT X 3980 CLOSE #67 :: PRINT "BALLOT zeroed" :: RETURN 3990 DISPLAY AT(5,1):"Save drive #? 4" :: ACCEPT AT(5,15)SIZE(-1):DR$ :: IF DR$= "0" THEN 4030 4000 OPEN #28:"DSK"&DR$&".VF",OUTPUT :: GOTO 4030 4010 DISPLAY AT(22,1)BEEP:"Finished...Don't forget to":"reset flag 10 in user fi les":" PRESS ENTER" 4020 CALL KEY(0,K,S):: IF K<>13 THEN 4020 ELSE RETURN 4030 DISPLAY AT(5,1):"Getting topic voted on...." 4040 OPEN #59:"DSK2.FLASH",INPUT 4050 LINPUT #59:X$ :: IF SEG$(X$,1,2)<>"@V" THEN 4050 4060 IF EOF(59)THEN CLOSE #59 :: GOTO 4090 4070 LINPUT #59:X$ :: IF X$="@E@" THEN CLOSE #59 :: GOTO 4090 ELSE PRINT X$ :: I F DR$<>"0" THEN PRINT #28:X$ 4080 CALL KEY(0,K,S):: IF S=0 THEN 4060 ELSE 4080 4090 PRINT : :"Vote results so far:": : :: P=0 :: IF DR$<>"0" THEN PRINT #28:" Total vote count:"; 4100 OPEN #67:"DSK1.BALLOT",INPUT ,RELATIVE,INTERNAL,FIXED 15 :: INPUT #67,REC 0 :Z 4110 FOR X=1 TO Z-1 :: INPUT #67,REC X:RS(X):: P=P+RS(X):: NEXT X 4120 CLOSE #67 :: IF P=0 THEN P=1 4130 PRINT "Total number of votes:";P 4140 FOR X=1 TO Z-1 :: PRINT "number ";STR$(X);"-";STR$(INT((RS(X)/P)*10000)/100 );"%" :: NEXT X 4150 IF DR$="0" THEN 4190 4160 PRINT #28:P; 4170 FOR X=1 TO Z-1 :: PRINT #28:TAB(30);"number ";STR$(X);" ";STR$(INT((RS (X)/P)*10000)/100);"%" :: NEXT X 4180 CLOSE #28 4190 PRINT : :"PRESS ENTER" :: GOTO 4020

go back up to the top

the Boggle board (a game)

The Boggle code was written by S. Clarke

The actual questions/answers for this game are not published here. This game can now be played on this site.

10 GOTO 40 ! V.JUN 07 1991 *BOGGLE*BULLWINKLE'S CORNER* 20 !PUT VARIABLES HERE 30 CALL CLEAR :: CALL COLOR :: CALL ERR :: CALL KEY :: CALL LINK :: CALL PEEK :: CALL SAY :: CALL SCREEN :: CALL SOUND 40 CALL SAY("PROGRAM D"):: CALL KEY(4,X,X) 50 OPTION BASE 1 60 DIM E$(10),E(10) 70 CALL SCREEN(2):: FOR X=1 TO 14 :: CALL COLOR(X,15,1):: NEXT X 80 OPEN #27:"DSK1.DEFAULTF",INPUT ,INTERNAL,RELATIVE,FIXED 20 :: INPUT #27,REC 1 :C$ :: CLOSE #27 90 OPEN #5:"RS232/2.BA="&C$,VARIABLE 132 100 CALL CK :: OPEN #10:"DSK1.TRANSFILE",INTERNAL,INPUT ,FIXED 80 :: INPUT #10:U SER,XP,BD,FN$,NAM$,PASS$ :: CLOSE #10 110 OPEN #6:"DSK1.UFILE",INPUT ,INTERNAL,RELATIVE,FIXED 126 120 INPUT #6,REC USER:NAM$,ADR$,PASS$,CALL$,DATE$,PH$,COM$,UF$,VALID$,LML :: CLO SE #6 130 PRINT #5:"Boggle:"; 140 ON ERROR 650 150 A$="~~~?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!~! BULLWINKLE'S CORNER * BOG GLE BOARD ?~" :: CALL OUT(A$) 160 A$="?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!?!~" :: CALL OUT(A$) 170 A$="~B)ogglers~G)oodbye~J)ump boards~" :: CALL OUT(A$) 180 A$="~Choice->B,G,J~--->" :: CALL OUT(A$):: CALL KY("BGJ",A$,P) 190 ON P GOTO 220,200,210 200 CALL LOFF(FN$,USER,NAM$,VALID$):: GOTO 140 210 CALL CNG(USER,XP,BD,FN$,NAM$,PASS$):: GOTO 140 220 A$="~Boggle:~~ This is a series of puzzles to boggle~the mind. Scores will be kept, with the~ten highest scorers recorded.~" 230 CALL OUT(A$):: A$="Note that a wrong answer will subtract~from your score. Y ou may quit at any~time by entering " 240 CALL OUT(A$):: A$="an asterisk * at any~answer. Your score will be tallyed a t~that point, and compared with the high~scores. Good luck," 250 A$=A$&"~you'll definitely need it!~~~" :: CALL OUT(A$):: SCORE=0 :: FILE$="1 " :: CALL ENT 260 A$="~Your starting score is 0~Scores to beat:~" :: CALL OUT(A$):: GOSUB 440 :: X=1 :: Q=0 :: A$="~" :: CALL OUT(A$):: CALL ENT 270 OPEN #20:"DSK2.BOGFILE"&FILE$,INPUT ,DISPLAY ,VARIABLE 80 280 A$="~~Commands:~ P)ause R)esume A)bort~~Boggler section "&STR$(X)&"~~" :: CA LL OUT(A$) 290 IF EOF(20)THEN CLOSE #20 :: IF FILE$="1" THEN FILE$="2" :: GOTO 270 ELSE 430 300 CALL KYCK(KE):: IF KE=0 THEN 320 ELSE IF KE=1 THEN CALL PAUSE :: GOTO 320 310 IF KE=4 THEN CLOSE #20 :: A$="~Aborted~" :: CALL OUT(A$):: GOTO 430 320 LINPUT #20:A1$ :: IF POS(A1$,"@",1)>0 THEN X=X+1 :: GOTO 280 330 IF POS(A1$,"*",1)>0 THEN A1$=SEG$(A1$,3,LEN(A1$)-2):: TRY=1 :: Q=Q+1 :: GOTO 350 340 A1$=A1$&"~" :: CALL OUT(A1$):: GOTO 290 350 A$="~* or Answer? " :: CALL OUT(A$) 355 CALL IN(A$):: IF A$="" OR A$=CHR$(255)THEN 355 ELSE CALL UP(A$) 360 IF A$="*" THEN CLOSE #20 :: A$="~Had enough for today, eh?~" :: CALL OUT(A$) :: GOTO 430 370 P=POS(A1$,":",1):: IF P=0 THEN A2$="" :: GOTO 390 380 A2$=SEG$(A1$,P+1,LEN(A1$)-P):: A1$=SEG$(A1$,1,P-1) 390 IF A$=A1$ THEN SCORE=SCORE+10 :: A$="~That is the correct answer!~Your score is now "&STR$(SCORE)&"~" :: CALL OUT(A$):: GOTO 290 400 IF A2$="" THEN 410 ELSE A1$=A2$ :: A2$="" :: GOTO 390 410 PRINT #5:STR$(Q);")";A$;"/";:: TRY=TRY+1 :: IF TRY<3 THEN A$="~Nope, how abo ut another crack at it?~" :: CALL OUT(A$):: GOTO 350 420 SCORE=SCORE-10 :: A$="~Sorry, you must lose 10 points!~Your score is now "&S TR$(SCORE)&"~" :: CALL OUT(A$):: GOTO 290 430 A$="~Let's see where you fit in on the~scoreboard with a score of "&STR$(SCO RE)&"~" :: CALL OUT(A$):: GOSUB 440 :: GOTO 500 440 OPEN #20:"DSK1.BOGWIN",INTERNAL,RELATIVE,INPUT ,FIXED 80 450 INPUT #20,REC 0:NOQ,NOP :: A$="~Total number of questions:"&STR$(NOQ)&"~Tota l number of plays:"&STR$(NOP)&"~" :: CALL OUT(A$) 460 A$="~Present scoring:~" :: CALL OUT(A$) 470 FOR X=1 TO 10 :: INPUT #20,REC X:E$(X),E(X) 480 A$=E$(X)&RPT$("-",30-LEN(E$(X)))&STR$(E(X))&"~" :: CALL OUT(A$) 490 NEXT X :: CLOSE #20 :: RETURN 500 A$="Low="&STR$(E(10))&" by "&E$(10)&"/High="&STR$(E(1))&" by"&E$(1)&"/This s core="&STR$(SCORE):: PRINT #5:A$ 501 IF SCORE<=E(10)THEN A$="~Sorry, your score does not make the~top ten. Maybe another time?~~~Listing remains:~~" :: CALL OUT(A$):: GOTO 600 502 IF SCORE>E(1)THEN A$="~May I congradulate you! You are~the NEW TOP SCORER!!! ~" :: CALL OUT(A$):: GOTO 506 503 A$="~Congradulations!!! You are in~the TOP TEN!~" :: CALL OUT(A$) 506 FOR X=1 TO 10 540 IF SCORE>E(X)THEN 560 550 NEXT X 560 FOR D=9 TO X STEP -1 570 E$(D+1)=E$(D):: E(D+1)=E(D) 580 NEXT D 590 E$(X)=NAM$ :: E(X)=SCORE :: A$="~New listing of top ten:~~" :: CALL OUT(A$) 600 NOP=NOP+1 :: OPEN #20:"DSK1.BOGWIN",INTERNAL,RELATIVE,OUTPUT,FIXED 80 610 PRINT #20,REC 0:NOQ;NOP 620 FOR X=1 TO 10 :: PRINT #20,REC X:E$(X);E(X):: NEXT X :: CLOSE #20 630 FOR X=1 TO 10 :: A$=E$(X)&RPT$("-",30-LEN(E$(X)))&STR$(E(X))&"~" :: CALL OUT (A$):: NEXT X 640 CALL ENT :: GOTO 140 650 !************************************************** BEGIN ERROR ROUTINES AND SUBPROGRAMS **************************** 660 CALL ERR(E1,E2,E3,E4):: PRINT #5: : : :RPT$("ERROR ",21) 670 EA$=A$ :: A$="~~ERROR in board~please wait while error is logged~" :: CALL O UT(A$) 680 CALL SAY("UHOH I HAVE AN ERROR IN PROGRAM D") 690 IF USER>3 THEN 710 ELSE A$="~ERROR: "&STR$(E1)&" "&STR$(E2)&" "&STR$(E3)&" " &STR$(E4)&"~A$="&EA$&"~" :: CALL OUT(A$) 700 CALL DEL(1000) 710 PRINT #5:"********** ERROR **********in BOGGLE" :: PRINT #5:"Error code:";E1 ;E2;E3;E4 720 PRINT #5:" A$=";EA$ 730 PRINT #5:RPT$("ERROR ",21): : : : 740 RETURN 140 750 SUB LOFF(FN$,USER,NAM$,VALID$) 760 A$="~~~Are you sure you've got to go?~?????? Y/N " :: CALL OUT(A$):: CALL YN (A$):: IF A$<>"Y" THEN SUBEXIT 770 A$="~~Thanks for tuning in...~"&FN$&" tuned out...~"&T3$&"~Bye... " :: CALL OUT(A$) 780 A$="~Remember to call at least every 90 days~or your user# will be thrown~ to the flounder!...(ouch!)" :: CALL OUT(A$) 790 A$="~~~Hope you enjoyed the show.~See ya next time.~~~" :: CALL OUT(A$):: CA LL LINK("OFHOOK") 800 PRINT #5: :"USER "&FN$&" "&STR$(USER)&" LOGGED OFF "&T3$:RPT$("=",121);" LOG GED OFF" :: RUN "DSK1.LOGON" 810 SUBEND 820 SUB CNG(USER,XP,BD,FN$,NAM$,PASS$) 830 A$="~~Select board:~~ 1 Board #1~ 2 Board #2~ 3 Board #3~ 4 Return this b oard" :: CALL OUT(A$) 840 A$="~~Choice-->" :: CALL OUT(A$):: CALL KY("1234",A$,P) 850 IF P=4 THEN SUBEXIT 860 A$="~~Loading Board "&STR$(P)&"~Please wait...." :: CALL OUT(A$) 870 OPEN #10:"DSK1.TRANSFILE",INTERNAL,OUTPUT,FIXED 80 :: PRINT #10:USER;XP;BD;F N$;NAM$;PASS$ :: CLOSE #10 880 ON P GOTO 890,900,910 890 RUN "DSK1.BOARDA" 900 RUN "DSK1.BOARDB" 910 RUN "DSK1.BOARDC" 920 SUBEND 930 SUB YN(A$) 940 CALL CK :: CALL LINK("DCDCHK",A$) 950 IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR$(13)THEN 940 ELSE CALL UP(A$) 960 IF A$="Y" THEN A1$="Yes~" ELSE IF A$="N" THEN A1$="No~" ELSE A1$=CHR$(7):: C ALL OUT(A1$):: GOTO 940 970 CALL OUT(A1$):: SUBEND 980 SUB HANGUP 990 CALL LINK("OFHOOK"):: CALL DEL(2000):: A$="ATZ"&CHR$(13):: CALL LINK("OUTPUT ",A$):: RUN "DSK1.LOGON" 1000 SUBEND 1010 SUB IN(A$):: CALL LINK("INPUT",A$):: CALL CK :: SUBEND 1020 SUB OUT(A$):: CALL LINK("OUTPUT",A$):: CALL CK :: SUBEND 1030 SUB UP(A$):: CALL LINK("UPPER",A$):: SUBEND 1040 SUB CK 1050 A$="" :: CALL LINK("JOYST",A$):: IF LEN(A$)=0 THEN SUBEXIT 1060 PRINT #5:"***HANGUP***" :: CALL HANGUP 1070 SUBEND 1080 SUB KY(A1$,A$,P) 1090 CALL CK :: CALL LINK("DCDCHK",A$):: IF A$=CHR$(128)OR A$=CHR$(255)OR A$=CHR $(13)OR A$="" THEN 1090 1100 CALL UP(A$) 1110 P=POS(A1$,A$,1):: IF P=0 THEN A$=CHR$(7)&"Invalid entry~-->" :: CALL OUT(A$ ):: GOTO 1090 ELSE 1120 1120 A1$=A$&"~" :: CALL OUT(A1$):: PRINT #5:A$;",";:: SUBEND 1130 SUB DEL(A) 1140 FOR X=1 TO A :: NEXT X 1150 SUBEND 1160 SUB KYCK(KE) 1170 CALL LINK("DCDCHK",A$):: CALL UP(A$):: KE=POS("PSRA",A$,1):: SUBEND 1180 SUB PAUSE 1190 A$="R)esume " :: CALL OUT(A$) 1200 CALL CK :: CALL LINK("DCDCHK",A$):: CALL UP(A$):: IF A$="R" THEN A$=RPT$(CH R$(8),8):: CALL OUT(A$):: SUBEXIT 1210 GOTO 1200 1220 SUBEND 1230 SUB ENT :: A$="Press <ENTER> " :: CALL OUT(A$):: CALL LINK("INPUT",A$):: SU BEND

go back up to the top