Source Code 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / funadv / part05 < prev next >

Wrap

Internet Message Format | 1992-03-07 | 47.9 KB

Path: uunet!think.com!yale.edu!heifetz!emory!dragon.com!cts From: cts@dragon.com Newsgroups: vmsnet.sources.games Subject: funadv Part 05/08 Message-ID: <1992Mar7.222151.828@dragon.com> Date: 8 Mar 92 03:21:51 GMT Organization: Computer Projects Unlimited Lines: 1154 -+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+ X<1E0000ABA1000265F0F9020BFDFAF4F5E5E4EFF0F7F7DF0219FDE7FAF7FAF7F80203FDDE2B X<1E0000ABBF00FBF7B50218FDF8FDF2FCFEF8F6DAD0D7D3F30203FB0203D7BFF3F8FAF8F735 X<1E0000ABDD00F6ECFBF6EAF3F3F0F2F2DF0205E6F7FDFD0201E0F7E4F7F5F6F1E5E5F702D2 X<1E0000ABFB0001F7F60201E1F7FAFA0204FDE7F8EDFAEDF5FBFA0201C6E7FA0206F2F8F251 X<1E0000AC1900F30204FDE6F7FA0218FD0201BDE7F5F8E7F8FBFBFAF3FBFAEDF6E5FBFAF33E X<1E0000AC37000207FDF0C2B9F5E3FAFAFBF8F8F60248FD0215EFF0FDEDECFC0201E4EFFC00 X<1D0000AC5500F8E90234FDF3F0DDF3EFEFF2DFF5E5F20201FDFAEFDEF7F50E0609660664 X<1E0000AC7300CFF7F7F70201FD0201D5F7F7F6EC0201FDD3F7F7E3E6D2F7F30201FEE8F741 X<1E0000AC91000201FEF1E0E8EC0E00095D0600F5F3EAE3F7EFE1030C02FDE9FBF0EAF70244 X<1E0000ACAF0003FDF9020CFDF3F4F4F40201FDFA0E0809380400FC035604F6FC0204CD023F X<1E0000ACCD0001E0FCEBF1EDF70203FDF8F9FB0203FDE1DADAE4E4E4E40E5D090D0600022E X<1E0000ACEB0001E003E502FD0201EA0208FDF8FA0201FDFAF7C2B9F7F70E33096D0700E3A2 X<1E0000AD0900E4F1FA039701FC0235FDFAFAE10207B2F5E5EC0E0B09BC0400ECF7F3F5F59A X<1E0000AD2700F5F5F5F8F902AAF4F7F3F8F8FCFBECEBFCF10203F4F0F2F40205F4F7FE0248 X<1E0000AD450001EA0E0509830500F5F5F50E03096B0500EEEE0E03095D0500F8E2F80201CB X<1E0000AD6300FDF7F50201FDF80E0309530500ECFAFAF20E0309350500F2EBF9F7FCF6F7A3 X<1E0000AD81000201FDDCF8F5F5CBF9FE0201FDFAFEF70201FDE4F30E0809C80400F0DFF9BB X<1E0000AD9F00FE02C3FEF4EFEFE7EDE5E9F2F70E0309CE0400EEF4EEF50207E4F2D1020114 X<1E0000ADBD00FDEAECF2C2B9F5E5F90204FDF4EE0205F0EBDCF9F70205FDF60207FDF0F0F2 X<1D0000ADDB00F6F7E5EAD8F7F90201FDE8F3ECF7F5F5F7F5FAF0F90204FD0E0609D30469 X<1E0000ADF900EDFEEBF7F9024BFDE8F6F3F7FB0201FDF7F7E7031F04FDF8F8EFFC0201CAC9 X<1E0000AE1700D8FAFDEFFBFAFDD6FA0E0309AD04000201DE039404FCF8F80201E00219FD6F X<1E0000AE3500EEF6F9D40203F7FDF7F7F7FDFAF80203FA0201E00E0309C00800EAECEDF703 X<1E0000AE53000201FEF9E6F5FA0203FDED035501F70E0C09D408000201EA0201F70203F7F1 X<1E0000AE7100E6F8F3FBF7F3ED0203FD0E0709E408000201EA74B90201FDFBF7F3EDFDF536 X<1E0000AE8F000201EAFD0201E7F70208FDF8020EFDEDFDE7EDF7FDFFEDF90204F4F9F3FE53 X<1D0000AEAD00EBF50E0009170900F5F5F70206FD0201F1F80201F0F7F8FE020100F80EB6 X<1E0000AECB00093A0400033B06F40203C4FA0201EAF90204F9EDF5F4F9F40202D80201FEA2 X<1D0000AEE9000E1B097F0A000201EA021100F701EF0006BF004652000001BD0ABC0001C8 X<1D0000AF0900034255470ABE00487E03000342554709B9000219FE0203E0F906BF002931 X<1E0000AF290001BD0CBC00010000000543415252590CBE00747E030005434152525912B9ED X<1D0000AF4800020AFEEFEFFAFCF4F4FFF7F7FAFEF0FF06BF007200000001BD0BBC000195 X<1E0000AF68000444524F500BBE00E87E03000444524F500EB9000209FEEFECF5FEF5F7F0AD X<1E0000AF8600F6FF06BF006300000001BD0CBC000100000005474554494E0CBE004C7F03F5 X<1E0000AFA50005474554494E44B900020EE7F9F90201E3FCF70203F5FDF3F0F9FBF4F6F7A4 X<1E0000AFC300F2FD0205FEECF4F6FEFAF2F1F1F0F4FCF6F0FD0E0209240000FCF70E0209CE X<1C0000AFE1001600000201D90220F5F8E30201D7FF06BF00E701000001BD10BC00015F X<1D0000B0000009494D4147455F44495210BE003481030009494D4147455F44495217B989 X<1E0000B01E000219EFF7F1F60201F70201F2FAF30201FD0201F5FF06BF006C00000001BD6A X<1E0000B03C000DBC0001000000064A5547474C450DBE00A0810300064A5547474C450AB9F2 X<1E0000B05B000209F7F4F7F3EBFF06BF004100000001BD0DBC0001000000064C44434F4D0A X<1E0000B079004E0DBE00E4810300064C44434F4D4E25B9000211F70201F8FC0201D50202BA X<1C0000B09700F20202F2E60201D3F80205FFE5E50E0709230000F5E5FF06BF00100141 X<1E0000B0B50001BD0EBC0001000000074D494E504D49440EBE00F4820300074D494E504D12 X<1E0000B0D300494406B9000204F7E806BF002100000001BD0BBC0001000000044D4F564587 X<1D0000B0F1000BBE0018830300044D4F56450CB900020AF7F6F4FEF1E3EEFF06BF00600A X<1E0000B1110001BD0DBC00010000000650535045414B0DBE00788303000650535045414B3B X<1C0000B12F000EB9000212F7F4FBFBF7E5EBFCF5FF06BF006800000001BD0ABC0001DF X<1D0000B14E00035055540ABE00E08303000350555409B9000206F70201EFF606BF00242C X<1E0000B16E0001BD0DBC00010000000652414E444F4D0DBE00048403000652414E444F4D57 X<1E0000B18C0006B900020AF7EB06BF001E00000001BD0DBC00010000000652535045414BC1 X<1E0000B1AA000DBE00248403000652535045414B07B9000206F7E7FF06BF002300000001B7 X<1D0000B1C800BD0CBC000100000005535045414B0CBE004884030005535045414B13B98D X<1E0000B1E6000216F7F9E00201E30201F90201CCFEEBFF06BF00A000000001BD0DBC0001DD X<1E0000B20700065356434F4D4E0DBE00E8840300065356434F4D4E18B900020BF7FC020163 X<1D0000B22500D50202F20202F5E8D3F8FFF70201EAFF06BF00BF00000001BD0CBC0001A8 X<1E0000B2450005564F4341420CBE00A885030005564F43414217B900020EEFFAE7F7ECF08E X<1E0000B26300FC0201F8FCF5E50201F8F7EAFB06BF00BF00000001BD0DBC00010000000617 X<1E0000B2810057495A4152440DBE00688603000657495A41524458B9000208F7FD0201EA4F X<1E0000B29F000201DAF8E9F30203F00201F8F8FC021DF00203EA0E04091C0000FA0201EAE0 X<1E0000B2BD00D0F8F8EAE3F0F00202EADAF8E60201EADAF8F3FC0203EA0205FC0203E302D6 X<1E0000B2DB0003E50202EAFD0201E90E03091200000201E7FD06BF00C502000001BD0ABC73 X<1E0000B2FA0001000000035945530ABE0030890300035945532CB9000209F7EEFCF9F8FA0D X<1D0000B318000201E9FCFD0202E7FCFD0201DEF8E9E90201EAEE0203FEFDEE0E030921A0 X<1E0000B33700FCEEFC06BF002601000001BD11BC00060000000A5348494654244D41494EC4 X<1E0000B3550006B910968A030034B9090000020CFC0205EB0201FBDE0201F90201F902011F X<1E0000B37300EB0201DB0201ED0202D50201FC0203F80201F10201DC0201F00203E80E0469 X<1E0000B3910010B800588A03000524434F44456F0100000CBE00988A0300055348494654CB X<1E0000B3AF0006BF002F01000001BD0EBC0006000000074745545553455206B910C88B03B2 X<1E0000B3CE0012B90900000212FE020200F9FAF8F5F7E00E0110B800C88B03000524434FD8 X<1E0000B3EC0044454C00000011B800DC2D000006244C4F43414C180000000BBE00C88B03D0 X<0E0000B40B00045553455206BF004C00000001BD21 X<000000B600004A X<000000B600FA50 X<00000000000000 $ CALL UNPACK FUNADV.HEX;1 1045702204 $ create 'f' X .TITLE DEHEX X .SBTTL Stuart Hecht and Eric McQueen, Stevens Inst of Technology X X .LIBRARY /SYS$LIBRARY:STARLET/ X .LIBRARY /SYS$LIBRARY:LIB/ X .IDENT /1.1.02/ X;++ X;1.1.01 X;Updated March 9, 1898, by Susan Webb and Jerry Holliday of Lockheed Aircraf Vt X;Systems Co, Marietta, GA, to work for files longer than 64K. Added lines X;marked with ";JH". X;-- X;++ X;1.1.02 X;Updated March 15, 1989, by Tom Allebrandi of Advanced Computer Consulting, X;Inc, Charlottesville, VA. (ta2@acci.com) X; X;On March 14, 1989, I pulled this file and VMSMIT.HEX from Columbia via X;KERMSRV. After compiling, this utility would not decode the VMSMIT file. X;The problem was the 1.1.01 fix noted above. X; X;I have removed the 1.1.01 fix and coded it so that it works correctly. X;My changes are marked ";ta2" X;-- X X;++ X;This will take a set hexidecimal strings created by the hexify program and X; recreate the source file(s). X;-- X X .EXTRN LIB$GET_INPUT X .EXTRN LIB$PUT_OUTPUT X .EXTRN DSC$K_DTYPE_T X .EXTRN DSC$K_CLASS_S X .EXTRN SS$_NORMAL X .MCALL $FAB ; RMS calls X .MCALL $RAB X .MCALL $CLOSE X .MCALL $CONNECT X .MCALL $CREATE X .MCALL $DISCONNECT X .MCALL $GET X .MCALL $OPEN X .MCALL $WRITE X .MCALL $RAB_STORE X .MCALL $FAB_STORE X X .SBTTL Definitions of symbols X XDWRLUN =1 ; Disk read LUN XDWWLUN =5 ; Disk write LUN XTRUE =1 ; True XFALSE =0 ; False XKNORMAL =0 ; No error XLEFTBYTE=`5EO377*`5EO400 ; All ones in left byte XHEXOFFSET=7 ; Offset to get to 'A from '9+1 XCR =13. ; Carriage return XLF =10. ; Line feed XMAX.MSG =256. ; Maximum number of chars from XK XRCV.SOH =`5EA/:/ ; Receive start of packet XRCV.EOL =13. ; End of line character XMSB =128. ; Most significant bit X; Packet types currently supported XPKDATA =00 ; Data packet code XPKRFM =255. ; Record format XPKRAT =254. ; Record attributes XPKMRS =253. ; Maximum record size XPKALQ =252. ; File length(blocks) XPKFILNM =251. ; File name XPKEOF =250. ; End of task file X; X X X .SBTTL RMS Data X X .PSECT $PLIT$,LONG X XDEFALT: .ASCIZ 'SYS$DISK:' ; System default. XDEFALN =.-DEFALT ; Size of the default device. X .EVEN X X .SBTTL Data X X XM$FILE: .BYTE CR,LF X .ASCII 'Please type the file name: ' XL$FILE= .-M$FILE X XM$CRLF: .BYTE CR,LF ; Data for carriage return/line feed XL$CRLF =.-M$CRLF X X;M$AK: X; .ASCII 'Y' ; Data for aknowledged X XM$NAK: X ;.ASCII 'N' ; Data for not aknowledged X .ASCII 'BAD CHECK SUM' ; Data for not aknowledged XL$NAK =.-M$NAK X XM$UN: X ;.ASCII 'U' ; Data for unrecognized code X .ASCII 'UNKNOWN BLOCK TYPE' ; Data for unrecognized code XL$UN =.-M$UN X XM$RMS: .BYTE CR,LF,LF X .ASCII 'RMS ERROR' XL$RMS =.-M$RMS X XM$REC: .BYTE CR,LF,LF X .ASCII 'RECEIVE ERROR - Try again.' XL$REC =.-M$REC X .EVEN X X X .SBTTL Storage locations X X .PSECT $OWN$,LONG X .ALIGN LONG X XMSGDSC: .BLKW 1 ; Data block for terminal output X .BYTE DSC$K_DTYPE_T X .BYTE DSC$K_CLASS_S XADDR: .ADDRESS ADDR XLNGADR: .BLKL 1 X XINP_STR_D: ; Key string desciptor X .BLKL 1 XINP_BUF: .ADDRESS ADDR X XINP_STR_LEN: .BLKL 1 ; Key string length X XWTCOUNT: .BLKL 1 ; Number of characters written XLENGTH: .BLKL 1 ; Length of data portion of packet XOPENFL: .BLKL 1 ; Tells us if the file is open X XCHKSUM: .BLKL 1 ; Checksum for the line XADDRESS: .BLKL 1 ; Current address XALQLOC: .BLKW 2 ; Storage for allocation X XOUT.N: .BLKB 28. ; Space for output file name XOUT.L =.-OUT.N ; Length of output file name X XINP.N: .BLKB 28. ; Space for input file name XINP.L =.-INP.N ; Length of input file name X X .EVEN ; Need to start RDBUF on even bounda Vry XRDBUF: .BLKB MAX.MSG ; XK read buffer X .EVEN XWTBUF: .BLKB 512. ; Disk write buffer X .EVEN X X X X .SBTTL RMS Data structures X .ALIGN LONG X XRDFAB:: $FAB DNA=DEFALT,DNS=DEFALN,FNA=INP.N,FNS=INP.L,- X LCH=DWRLUN,FAC=GET,SHR=GET X X .ALIGN LONG XRDRAB:: $RAB FAB=RDFAB,RAC=SEQ ; Beginning of RAB block. X X .ALIGN LONG XWTFAB:: $FAB DNA=DEFALT,DNS=DEFALN,FNA=OUT.N,FNS=OUT.L,- X LCH=DWWLUN,FAC=PUT,SHR=NIL X XWTRAB:: $RAB FAB=WTFAB,RAC=SEQ ; Beginning of RAB block. X X X .SBTTL Start of program X X .PSECT $CODE$,LONG,EXE X XDEHEX:: .WORD `5EM<> XFILE: MOVAB M$FILE,R11 ; Output the get file name message X MOVZBL #L$FILE,R12 X MOVAB INP.N,R10 ; Get the file name X MOVZBL #INP.L,R1 X JSB READ X TSTL R0 ; Check for no input X BEQL FILE ; Go back and get some X;Open the file X MOVAL RDFAB,R1 ; Put address of FAB into R1. X $FAB_STORE FAB=R1,FNS=R0 ; Tell RMS file name length X $OPEN #RDFAB ; Open the file X JSB RMSERR ; Check for file error X MOVAL RDRAB,R1 ; Put address of RAB into R1. X; Put address of user buffer and size and record buffer and size in RAB. X $RAB_STORE RAB=R1,UBF=RDBUF,RBF=RDBUF,USZ=#MAX.MSG,RSZ=#MAX.MSG X $CONNECT #RDRAB ; Connect to record. X JSB RMSERR ; Check for file error X X X .SBTTL Do the real work X;++ X; Do the actual work X;-- XBEGIN: MOVAL M$CRLF,R10 ; Get a return/linefeed and output t Vhem X MOVZBL #L$CRLF,R1 X JSB WRITE X X20$: CLRL WTCOUNT ; Initialize the pointer X CLRL ADDRESS ; Initialize the address X CLRL OPENFL ; Set the file to not open X X .SBTTL Main loop X X; Main loop to get data XDOLIN: X CLRL CHKSUM ; Clear the checksum X JSB RECEIVE ; Get the line X JSB CVTBIN ; Convert it to a real number X MOVL R10,LENGTH ; Save the length XNAB: JSB CVTBIN ; X BISL R10,R3 ; Save a byte of the address X ASHL #8.,R3,R3 ; Make room for next byte X SOBGEQ LNGADR,NAB ; If there are more than 2 bytes X JSB CVTBIN ; X BISL R10,R3 ; Fill in the low byte of address X X;ta2 The fix for 1.1.01 converted two more hex values here. As of March X; 1989, this doesn't appear to be required. The conversion has been X; removed. X X JSB CVTBIN ;ta2 Pick up the record type code X X CMPL #PKDATA,R10 ; Check to see if this is regular da Vta X BNEQ NOTDAT ; If not then check the special case Vs X; Check for end of hex file X TSTL R3 ; Check to see if the address is all X BNEQ DATST ; zero, if not then branch X TSTL LENGTH ; Check to see if the length is zero X BNEQ DATST ; also, if not then branch X JMP FINISH ; Must be end of hex file so finish V up X; Regular data to put into the file XDATST: TSTL OPENFL ; Check to see if the file is open y Vet X BNEQ DAT1 ; If it is then skip the open X JSB OPEN ; Open the file XDAT1: CMPL R3,ADDRESS ; Check for null compression X BEQL 10$ ; If none compressed then continue p Vast X CLRL R10 ; Make a null X JSB PUT ; and put it into the file X INCL ADDRESS ; Point to next address X BRW DAT1 ; Go see if there are any more nulls X; Go to work on the HEX we got on the line X10$: MOVL LENGTH,R2 ; Get the length X TSTL R2 ; See if there is any data X BEQL 30$ ; If not then branch X25$: JSB CVTBIN ; Convert it X JSB PUT ; Put the character in the file X INCL ADDRESS ; Increment the address X SOBGTR R2,25$ ; Repeat until all done X30$: BRW LINDON ; Go finish this line X X X XNOTDAT: MOVAL WTFAB,R5 ; Get the FAB address X CMPL #PKRFM,R10 ; Check to see if this is record fmt X BNEQ NOTRFM ; If not then don't do this stuff X; Store the Record format (FIX, VAR, ...) X JSB CVTBIN ; X $FAB_STORE FAB=R5,RFM=R10 ; Store the record format X BRW LINDON ; Go finish this line X XNOTRFM: CMPL #PKRAT,R10 ; Check to see if this is record typ Ve X BNEQ NOTRAT ; If not then branch X; Store the record type (CR, ...) X JSB CVTBIN ; X $FAB_STORE FAB=R5,RAT=R10 ; Store the record type X BRW LINDON ; Go finish this line X XNOTRAT: CMPL #PKMRS,R10 ; Check to see if this is max record X BNEQ NOTMRS ; size, branch if not X; Get the maximum record size (512. for tasks) X JSB CVTBIN ; Convert high order byte X MOVL R10,R3 ; Save it X ASHL #8.,R3,R3 ; Shift it to the high order byte X JSB CVTBIN ; Convert low order byte X BISL R10,R3 ; Put low order word into R3 also X $FAB_STORE FAB=R5,MRS=R3 ; Store the maximum record size X BRW LINDON ; Go finish this line X XNOTMRS: CMPL #PKALQ,R10 ; Check to see if this is allocation X BNEQ NOTALQ ; If not then branch X; Get the file length (in blocks) X JSB CVTBIN ; Convert high order byte X MOVL R10,R3 ; Save it X ASHL #8.,R3,R3 ; Shift it to the high order byte X JSB CVTBIN ; Convert low order byte X BISL R10,R3 ; Put low order word into R3 also X MOVZWL R3,ALQLOC ; Save it X $FAB_STORE FAB=R5,ALQ=ALQLOC ; Store the allocation X BRW LINDON ; Go finish this line X XNOTALQ: CMPL #PKFILNM,R10 ; Check to see if this is file name X BNEQ NOTFILNM ; If not then branch X; Get the file name X MOVL LENGTH,R2 ; Get the length X $FAB_STORE FAB=R5,FNS=R2 ; Store the file name length X MOVAB OUT.N,R3 ; Get the output file name address X25$: JSB CVTBIN ; Convert next character of the name X MOVB R10,(R3)+ ; Save the character X SOBGTR R2,25$ ; Repeat until all done X MOVAB M$CRLF,R10 ; X MOVZBL #L$CRLF,R1 ; X JSB WRITE ; Output a return/line feed X MOVAB OUT.N,R10 ; X MOVL LENGTH,R1 ; X JSB WRITE ; Output the file name X MOVAB M$CRLF,R10 ; X MOVZBL #L$CRLF,R1 ; X JSB WRITE ; Output a return/line feed X BRW LINDON ; Go finish this line X X X XNOTFILNM: X CMPL #PKEOF,R10 ; Check to see if this is end of tas Vk X BNEQ NOTPKEOF ; If not then branch X; End of ouput file record found X JSB CLTSK ; Close the task file X CLRL WTCOUNT ; Initialize the pointer X CLRL ADDRESS ; Initialize the address X JMP LINDON ; Go finish this line X X; Unknown code XNOTPKEOF: ; Since we don't know what the code X MOVAB M$UN,R10 ; just send the unknown code text V to X MOVZBL #L$UN,R1 ; the terminal X JSB WRITE ; X JMP DOLIN ; Go do next input line X X X .SBTTL Finished with this line X X; Line processed without a problem XLINDON: X; MOVAB M$AK,R10 ; Get the data address of the X ; single character X; MOVZBL #1,R1 ; Only write single char to terminal X; JSB WRITE ; Write to the terminal X JMP DOLIN ; Good so do next line X X X .SBTTL Finish up X;++ X;Finish up X;-- XFINISH: X; Close the file(s) X JSB CLTSK ; Close the task file if it isn't ye Vt X MOVAL RDFAB,R1 ; Get FAB for input file X $CLOSE R1 ; Close the input file X JSB RMSERR ; Check for file error XEND: MOVL #SS$_NORMAL,R0 ; Set up successful completion X RET X X .SBTTL Close file X X;++ X; Close the output file if there is one open X; X; If there is an error the program stops with an RMS error X; X; Registers destroyed: R0, R1 X; The OPENFL state is changed to file not open (OPENFL=0). X;-- X XCLTSK: TSTL OPENFL ; See if the task file is open X BEQL 10$ ; If not then just return X X; Write last buffer if needed X TSTL WTCOUNT ; See if there is any data not writt Ven X BEQL 8$ ; If not then branch X MOVAL WTRAB,R1 ; Get the RAB address X $RAB_STORE RAB=R1,RSZ=WTCOUNT ; Put its size into the RAB. X $WRITE R1 ; Put the buffer of data. X JSB RMSERR ; Check for file error X X; Close the file X8$: MOVAL WTFAB,R1 ; Get FAB for output file X $CLOSE R1 ; Close output file X JSB RMSERR ; Check for file error X CLRL OPENFL ; Set the state to file not open X10$: RSB ; Return to sender X X X .SBTTL Output and input to/from terminal X;++ X; Write data to terminal. X; R10 Address of data to output X; R1 Length of data X;-- XWRITE: X MOVW R1,MSGDSC ; Store the length in the descript b Vlk X MOVL R10,ADDR ; Store the address of the ASCII X PUSHAQ MSGDSC ; Push the descriptor block address X CALLS #1,G`5ELIB$PUT_OUTPUT ; Do the output X RSB ; Return to sender X X;++ X; Read from the terminal X; R10 Address of buffer X; R1 Number of characters to read X; R11 Input prompt address X; R12 Length of prompt X; X;Returned: X; R0 Number of characters read X;-- XREAD: X MOVL R1,INP_STR_D ; Store the buffer length in desc bl Vock X MOVL R10,INP_BUF ; Store the buffer address in desc b Vlk X MOVL R11,ADDR ; Store prompt address in desc block X MOVW R12,MSGDSC ; Store length in desctriptor block X PUSHAB INP_STR_LEN ; Address for string length X PUSHAQ MSGDSC ; Push address of prompt descriptor V blk X PUSHAB INP_STR_D ; String buffer descriptor X CALLS #3,G`5ELIB$GET_INPUT ; Get input string value X MOVL INP_STR_LEN,R0 ; Get actual input length back X RSB ; Return to sender X X X .SBTTL RMS error routine X;++ X;Check for RMS error X; Call with: R0 Status of last RMS call (automatically store Vd X; in R0 by RMS after an operation) X; X; Returned: R0 Status X; Registers destroyed: R0 X; Program stops after error message is displayed if there is any type of err Vor. X;-- XRMSERR: X BLBC R0,60$ ; If error, go check it out X MOVL #KNORMAL,R0 ; Set up a successful return code. X RSB ; Return to caller X X; Here if there is an RMS error we don't know how to handle X60$: PUSHL R0 ; Save the error code X MOVAB M$RMS,R10 ; Get the address and length of the X MOVL #L$RMS,R1 ; message to output X JSB WRITE ; Output it X POPL R0 ; Get the error code back X RET ; Exit program X X X .SBTTL Open the output file X;++ X; Create and open the output file and set the file open flag X; X; Registers destroyed: R0, R1 X; Program stops after error message is displayed if there is any type of err Vor. X;-- X XOPEN: MOVL #TRUE,OPENFL ; State that the file is open X MOVAL WTFAB,R1 ; Put address of FAB into R1. X $FAB_STORE FAB=R1,FAC=<BIO,GET> ; Set the block I/O in FAB. X ;$FAB_STORE FAB=R1,FOP=CTG ; Tell RMS to make the task contiguo Vus X $CREATE #WTFAB ; Create the file X JSB RMSERR ; Check for file error X MOVAL WTRAB,R1 ; Put address of RAB into R1. X; Put address of user buffer and record buffer and sizes into RAB X $RAB_STORE RAB=R1,UBF=WTBUF,RBF=WTBUF,USZ=#512.,RSZ=#512. X $CONNECT #WTRAB ; Connect to record. X JSB RMSERR ; Check for file error X RSB ; Return to sender X X .SBTTL Put a character to the file X;++ X; Put a character to the output file. X; The buffer is only written when 512. characters have been sent to the rout Vine X; If the file does not end on a boundary then the buffer will have to be X; written by some other routine. X; X; Call with: R10 Contains the character to be put into file X; Registers destroyed: R1, R10 X; X; Program stops after error message is displayed if there is any type of err Vor. X;-- X XPUT: PUSHL R10 ; Save the character X MOVL WTCOUNT,R10 ; Get the offset into the buffer X MOVB (SP),WTBUF(R10) ; Put the character X TSTL (SP)+ ; Restore the stack X INCL WTCOUNT ; Increment the offset into the buff Ver X CMPL WTCOUNT,#512. ; Check to see if we are past the en Vd X BNEQ 10$ ; If not then branch X MOVAL WTRAB,R1 ; Get the RAB address X $RAB_STORE RAB=R1,RSZ=WTCOUNT ; Put its size into the RAB. X $WRITE R1 ; Put the buffer of data. X JSB RMSERR ; Check for file error X CLRL WTCOUNT ; Clear the pointer X10$: RSB ; Return to sender X X .SBTTL Convert to binary X;++ X; Convert 2 hexidecimal digits to binary X; Input is from the input buffer pointed to by R4 (it is incremented twice) X; X; Call with: R4 The pointer into the input buffer X; Returned: R10 The binary walue X; Registers destroyed: R10,R1 X;-- X XCVTBIN: X CLRL R10 ; Clear R10 for the BISB X BISB (R4)+,R10 ; Get the next digit X JSB BIN ; in place and convert to binary X ASHL #4,R10,R10 ; Multiply the result by 16 X MOVL R10,R1 ; and save it X CLRL R10 ; Clear R10 X BISB (R4)+,R10 ; Get the next digit X JSB BIN ; Convert to binary X BISL R1,R10 ; Set the correct bits for high orde Vr X ADDL2 R10,CHKSUM ; Add the value to the checksum X RSB ; Return to sender X XBIN: CMPL R10,#`5EA/9/ ; Check to see if above '9 X BLEQ 1$ ; If not then branch X SUBL2 #HEXOFFSET,R10 ; Subtract offset to alphabet X1$: SUBL2 #48.,R10 ; Make binary X RSB ; Return to sender X X X .SBTTL Receive a line of data X X;++ X; This will get a line of data from the input device X; X; Returned: R4 Address of start of data buffer X; Registers destroyed: R0, R1, R3, R4 X; X; A checksum error will cause a NAK to be sent and input to be read again X; A real error will cause an error message to be output and the program to s Vtop X;-- X XRECEIVE: X; Here to read from a file X MOVAL RDRAB,R1 ; Get the RAB address X $GET R1 ; Get the record X JSB RMSERR ; Check for file error X MOVZWL #MAX.MSG,R3 ; Assume we got a full buffer X; Here to check the data we got XRECCHK: MOVAL RDBUF,R4 ; Get the address of the information X CLRL R1 ; Clear the data start address X80$: BICB #MSB,(R4) ; Clear parity bit X SUBB3 #RCV.SOH,(R4)+,R0 ; Check for start of header X BLSS 81$ ; If not, just keep going X CMPB R0,#2 ; There are 3 possible headers X BGTR 81$ ; Not a header X MOVZBL R0,LNGADR ; Amount of extra bytes in the addre Vss X MOVL R4,R1 ; Start of header so save it X81$: SOBGTR R3,80$ ; Repeat until done X TSTL R1 ; Check to see if we got a SOH X BNEQ 85$ ; If good then skip the jump X JMP RECEIVE ; If not then re-read X85$: MOVL R1,R4 ; Move to R4 for use X PUSHL R4 ; Save SOH pointer on stack X X JSB CVTBIN ; Convert all to binary to see if X ; checksum is correct X MOVL R10,R3 ; Get the length of data X ADDL2 #4,R3 ; Add the length of address and fiel Vd X ; type and checksum X ADDL2 LNGADR,R3 ; If long address, skip more bytes X BLSS 94$ ; If we have a negative number then X ; must have been a bad length X CMPL R3,#MAX.MSG/2-1 ; If we got some length that is out V of X BGEQ 94$ ; range then NAK right away X92$: JSB CVTBIN ; Convert all to binary to see if X SOBGTR R3,92$ ; the checksum is OK X93$: BICL #LEFTBYTE,CHKSUM ; We only want an 8 bit checksum X TSTL CHKSUM ; Test for a zero checksum X BEQL 95$ ; If OK then exit normally X94$: CLRL CHKSUM ; Clear the checksum for the line X MOVAL M$NAK,R10 ; Get the address of the message X MOVZBL #L$NAK,R1 ; Only write the first character to X JSB WRITE ; the terminal X TSTL (SP)+ ; Pull the pointer off the stack X JMP RECEIVE ; Try to get the line again X X; Return to sender X95$: POPL R4 ; Get the pointer back X RSB ; Return to sender X X X .SBTTL End of the Dehexify X X .END DEHEX $ CALL UNPACK VMSDEH.MAR;1 53467680 $ create 'f' X$`09if p1 .eqs. "LINK" then goto 10$ X$`09fortran 'p1' funadv X$`09fortran 'p1' bug X$`09fortran 'p1' carry X$`09fortran 'p1' drop X$`09fortran 'p1' getin X$`09fortran 'p1' image_dir X$`09fortran 'p1' juggle X$`09fortran 'p1' ldcomn X$`09fortran 'p1' minpmid X$`09fortran 'p1' move X$`09fortran 'p1' pspeak X$`09fortran 'p1' put X$`09fortran 'p1' random X$`09fortran 'p1' rspeak X$`09fortran 'p1' speak X$`09fortran 'p1' svcomn X$`09fortran 'p1' vocab X$`09fortran 'p1' wizard X$`09fortran 'p1' yes X$`09pascal 'p1' shift X$`09pascal 'p1' user X$ 10$: X$`09link 'p2' funadv,bug,carry,drop,getin,image_dir,juggle,ldcomn,minpmid,- Xmove,pspeak,put,random,rspeak,speak,svcomn,vocab,wizard,yes,shift,user $ CALL UNPACK [.SRC]$BUILD.COM;1 1095441941 $ create 'f' X SUBROUTINE BUG(NUM)`20 X `20 X `20 X* THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS. NUMBER X* ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT 'RUN TIM X* 0 MESSAGE LINE > 70 CHARACTERS X* 1 NULL LINE IN MESSAGE X* 2 TOO MANY WORDS OF MESSAGES X* 3 TOO MANY TRAVEL OPTIONS`20 X* 4 TOO MANY VOCABULARY WORDS`20 X* 5 REQUIRED VOCABULARY WORD NOT FOUND X* 6 TOO MANY RTEXT OR MTEXT MESSAGES X* 7 TOO MANY HINTS X* 8 LOCATION HAS COND BIT BEING SET TWICE`20 X* 9 INVALID SECTION NUMBER IN DATABASE X* 20 SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST X* 21 RAN OFF END OF VOCABULARY TABLE`20 X* 22 VOCABULARY TYPE (N/1000) NOT BETWEEN 0 AND 3 X* 23 INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST X* 24 TRANSITIVE ACTION VERB EXCEEDS GOTO LIST X* 25 CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE X* 26 LOCATION HAS NO TRAVEL ENTRIES X* 27 HINT NUMBER EXCEEDS GOTO LIST`20 X* 28 INVALID MONTH RETURNED BY DATE FUNCTION`20 X*`20 X `20 X WRITE(6,1)NUM`20 X 1 FORMAT (' FATAL ERROR, See source code for interpretation.',/`20 X $' Probably cause: Erroneous info in database.',/ X $' Error code =',I2/) X STOP X END`20 $ CALL UNPACK [.SRC]BUG.FOR;2 1901143241 $ create 'f' X SUBROUTINE CARRY(OBJECT,WHERE) X `20 X* START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FO X* LOCATION. INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED. IF OBJECT> X* (MOVING 'FIXED' SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.`20 X `20 X IMPLICIT INTEGER(A-Z)`20 X COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,COND,PROP,LOC,LAMP,HOLDNG X DIMENSION PROP(100), LINK(200), PLACE(100), FIXED(100) X DIMENSION ATLOC(220), COND(220)`20 X `20 X IF(OBJECT.GT.100)GOTO 5`20 X IF(PLACE(OBJECT).EQ.-1)RETURN`20 X PLACE(OBJECT)=-1 X HOLDNG=HOLDNG+1`20 X 5 IF(ATLOC(WHERE).NE.OBJECT)GOTO 6 X ATLOC(WHERE)=LINK(OBJECT)`20 X RETURN X 6 TEMP=ATLOC(WHERE)`20 X 7 IF(LINK(TEMP).EQ.OBJECT)GOTO 8 X TEMP=LINK(TEMP)`20 X GOTO 7 X 8 LINK(TEMP)=LINK(OBJECT)`20 X RETURN X END`20 $ CALL UNPACK [.SRC]CARRY.FOR;1 1177761983 $ create 'f' X SUBROUTINE DROP(OBJECT,WHERE)`20 X `20 X* PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST. DECREAS VING`20 X* HOLDNG IF THE OBJECT WAS BEING TOTED. X `20 X IMPLICIT INTEGER(A-Z)`20 X COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,COND,PROP,LOC,LAMP,HOLDNG X DIMENSION PROP(100), LINK(200), PLACE(100), FIXED(100) X DIMENSION ATLOC(220), COND(220)`20 X `20 X IF(OBJECT.GT.100)GOTO 1`20 X IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1 X PLACE(OBJECT)=WHERE`20 X GOTO 2 X 1 FIXED(OBJECT-100)=WHERE`20 X 2 IF(WHERE.LE.0)RETURN X LINK(OBJECT)=ATLOC(WHERE)`20 X ATLOC(WHERE)=OBJECT`20 X RETURN X END`20 $ CALL UNPACK [.SRC]DROP.FOR;1 476067950 $ create 'f' X*** ****** * *** ****** *** * ******* *** * ****** **** V** X**** *** * * *** *** **** * *** *** * *** * ***` V20 X*** * *** * * *** *** *** * * *** *** * *** * ***` V20 X*** * *** * * *** *** *** * * *** *** * *** * ***` V20 X******* *** * * *** ****** *** * * *** *** * ****** **** V** X*** * *** * * *** *** *** * * *** *** * *** * ***` V20 X*** * *** * **** *** *** ** *** *** * *** * ***` V20 X*** * ****** *** ****** *** * *** ***** *** * **** V** X `20 X `20 X PROGRAM FunAdv X X***** FunAdv for VAX/VMS. X* C. T. Smith, Jr. 89/02/24. X* X* This version of Adventure has passed through many hand, including X* Gary M. Palter (MIT), Charles B. Fulghum (GIT), John West (GIT), X* and most recently Neal White III, who added quite a few differences X* between the original program and this new version. X* X* Computer lore has it that adventure was originally developed at MIT X* under MULTICS. A version was translated to fortran, which since has X* since spread throughout the computer world, from mainframes to PCs.`20 X* Many years ago, a copy made its way to Georgia Tech, and was hacked`20 X* to run on the CDC Cyber systems installed there about 1975. X* X* The sources came into Neal's hands some years later. He changed the X* code a bit, changed some features, added others, modified the database X* format slightly...still, the basic design of the program was not chang Ved X* very much. The original source was written back in the good old days X* before fortran had things like a character type and strings, and all X* text was stored as integers. It was clear from the source that at X* one point, the program had been implemented on a machine that packed X* five characers to a word. The cyber systems packed 10 characters to X* the word - sixbit characters. Both of these implementations still X* were clearly present in the source I started from. X* X* As of this writing, there is still no conversiosn guide, and again, X* the programs have seen quite a few changes while being moved to the Va Vx. X* In particular, the game text is no longer stored in an integer`20 X* array, though the data structure holding the text still has`20 X* similarities to the integer implementation. Also, when we deal X* with alpha data, the fortran CHARACTER type is used, rather than X* integer. These changes should make it easier to transport the`20 X* program, as the major hassle in doing this conversion were removing X* all the places where so many characters could be packed in an`20 X* integer. Due to it's cyber heritage, words can be up to 10 X* characters long. From the source I started with, its also apparent X* that this program passed through a machine with 5 characters`20 X* per integer, but much of this has been smoothed out in moving things X* to a character data type. X* X* Also, along the way, the text in the data base and program was X* changed to mixed case from upper case only.`20 X* X* Questions, problems, and bug reports should be sent to: X* X* Charles T. Smith, Jr. X* X* Internet: cts@dragon.com X* U.S. Mail: 2710 Regal Way \ Tucker, GA 30084 \ USA X* X* And, if you happen to have a copy of the conversion guide, or`20 X* other versions of adventure, especally versions with greater than X* 500 points, I'd love to have a copy for my collection. X* X* Enjoy! X* X X*** Original Author info. X* X* FURTHER INFORMATION WILL BE FOUND IN THE CONVERSION GUIDE ACCOMPANYING V`20 X* THIS PROGRAM. FOR STILL FURTHER INFORMATION, CONTACT:`20 X* GARY M. PALTER, MIT (617) 253-7728`20 X* (PALTER@MIT-MULTICS)`20 X*`20 X* SINCE THERE IS NO CONVERSION GUIDE, AND I HAVE CHANGED THIS PROGRAM X* IN MANY OBSCURE WAYS. TRY CONTACTING: `20 X* NEAL WHITE III, GIT (404) 436-1789`20 X* P. O. BOX 31011`20 X* GEORGIA TECH X* ATLANTA, GEORGIA 30332 X `20 X X X** Things to do: X* X* 1) Disable control C/Y. X* X X X`0C X*** ADVENTURE X*`20 X* CURRENT LIMITS: `20 X* X* 2000 LINES OF MESSAGE TEXT (LINES, LINSIZ). X* 1500 TRAVEL OPTIONS (TRAVEL, TRVSIZ)`20 X* 400 VOCABULARY WORDS (KTAB, ATAB, TABSIZ). X* 220 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ). X* 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP). X* 35 'ACTION' VERBS (ACTSPK, VRBSIZ). X* 250 RANDOM MESSAGES (RTEXT, RTXSIZ). X* 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).`20 X* 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ). X* 2 OBJECTS WHICH MAY BE WORN (WEARING). X* X* THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF V`20 X* THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYP VE,`20 X* SO THERE CAN'T BE MORE THAN 1000 WORDS.) THESE UPPER LIMITS ARE: `20 X* X* 1000 NON-SYNONYMOUS VOCABULARY WORDS`20 X* 300 LOCATIONS`20 X* 100 OBJECTS`20 X* X`0C X `20 X IMPLICIT INTEGER(A-Z)`20 X X STRUCTURE /TEXTYPE/ X Integer*4 count X Character*80 string X end structure X X LOGICAL DSEEN,BLKLIN,HINTED,YES`20 X LOGICAL WIZARD X LOGICAL TOTING,HERE,AT,BITSET,DARK,WZDARK,LMWARN,CLOSNG,PANIC, X $CLOSED,GAVEUP,SCORNG,FORCED,PCT`20 X LOGICAL WIZKID,LOOSE,ROW,LIT,BFULL,ONCE,WEARING(2),YESCALL X X record /textype/ lines`20 X X Character*80 text, incheck `20 X Character*10 Atab X Character*10 WD1, WD2 X Character*128 filedir X Real Secnds X X** Note. X* X* All information to be "saved" between games must be in common X* blocks and between /AAAAAA/ and /ZZZZZZ/! X* X X COMMON /AAAAAA/ CORE(1)`20 X COMMON /TXTCOM/ RTEXT,LINES,LINUSE X COMMON /VOCCOM/ TABSIZ,KTAB,ATAB X COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,COND,PROP,LOC,LAMP,HOLDNG X COMMON /PTXCOM/ PTEXT`20 X COMMON /STXCOM/ TEXT X COMMON /IOSCOM/ BLKLIN,YESCALL X COMMON /VARCOM/ WIZKID,ABB,ABBNUM,ACTSPK,ATTACK,AXE,BACK,BATTER, X $BEAR,BFULL,BOAT,BOATPOS,BOOK,BOTTLE,CAVE,CHAIN,CHAIR, X $CHASM,CHEST,CHLOC,CHLOC2,CLAM, X $CLOCK1,CLOCK2,CLOSED,CLOSNG,CLSMAX,CLSSES,COAL,COINS,CTEXT,CVAL, X $DALTLC,DETAIL,DFLAG,DKILL,DLOC,DOOR, X $DPRSSN,DRAGON,DSEEN,DTOTAL,DWARF, X $EGGS,EMRALD,ENTRNC,FIND,FISSUR,FIXD,FOOBAR,FOOD,FOUNTN,GAVEUP, X $GO2,GRATE,HINT,HINTED,HINTLC,HINTM3,HINTS,HLDMAX,HNTMAX,HNTSIZ,`20 X $INVENT,IWEST,KEY,KEYS,KNFLOC,KNIFE,K1,K2, X $LIMIT,LISTING,LIT,LL,LMWARN,LOCK, X $LOCSIZ,LOOK,LOOSE,LTEXT,MAGZIN,MAIL,MAXTRS,MESSAG,MIRROR,MISTS, X $MONGOOS,NEWLOC,NUGGET,NULL,NUMDIE,MAXDIE,ODLOC,OFF,OIL,OLDLC2, X $OLDLOC,ON,ONCE,OOPS,OYSTER,PANIC,PEARL,PILLOW,PLAC,PLANT,PLANT2, X $POTION,PYRAM,RING,RINGLOC,RIVLOC, X $ROD,ROD2,ROPE,ROW,RTXSIZ,RUG,RUNES,SACK, X $SAVED,SAY,SCORE,SCORNG,SETUP,SHIT,sit,SNAKE,SPICES,SPK,STEPS,STEXT,`20 X $STICK,SUSPND,SWITCH,TABLET,TABNDX,TALLY,TALLY2,THROW,TRAP,TRAVEL, X $TRIDNT,TROLL,TROLL2,TRSURE,TRVS,TRVSIZ,TURNS,VASE,VEND,VRBSIZ, X $WAITNG,WATER,WEARING,WHERE,WZDARK,XXM,YYM X X common /seed/ seed X COMMON /USER/ USERNUM`20 X COMMON /ZZZZZZ/ THEEND X X DIMENSION LINES(2000), TRAVEL(1500), RIVLOC(8)`20 X DIMENSION KTAB(400), ATAB(400) X DIMENSION LTEXT(220), STEXT(220), KEY(220), COND(220), ABB(220), X $ATLOC(220) X DIMENSION PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200), X $PTEXT(100),PROP(100) X DIMENSION ACTSPK(35), RTEXT(250) X DIMENSION CTEXT(12),CVAL(12) X DIMENSION HINTLC(20),HINTED(20),HINTS(20,4)`20 X DIMENSION TK(20),DSEEN(8),DLOC(8),ODLOC(8) X `20 X DATA LINSIZ/2000/, TRVSIZ/1500/, LOCSIZ/220/, VRBSIZ/35/, X $RTXSIZ/250/, CLSMAX/12/, HNTSIZ/20/`20 X X`0C `20 X** STATEMENT FUNCTIONS X*`20 X* TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED X* HERE(OBJ) = TRUE IF THE OBJ IS AT 'LOC' (OR IS BEING CARRIED)`20 X* AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT`20 X* LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE`20 X* LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC`20 X* BITSET(L,N) = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT) X* FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2)`20 X* DARK(DUMMY) = TRUE IF LOCATION 'LOC' IS DARK X* PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100)`20 X `20 X TOTING(OBJ)=PLACE(OBJ).EQ.-1 X HERE(OBJ)=PLACE(OBJ).EQ.LOC.OR.PLACE(OBJ).LT.0 X AT(OBJ)=PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC X LIQ2(PBOTL)=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL)`20 X LIQ(DUMMY)=LIQ2(MAX0(PROP(BOTTLE),-1-PROP(BOTTLE)))`20 X LIQLOC(LOC)=LIQ2((MOD(COND(LOC)/2*2,8)-5)*MOD(COND(LOC)/4,2)+1)`20 X BITSET(L,N)=(COND(L).AND.SHIFT(1,N)).NE.0 X FORCED(LOC)=COND(LOC).EQ.2 X DARK(DUMMY)=MOD(COND(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR. X $.NOT.HERE(LAMP)).AND. .NOT. LIT`20 X PCT(N)=random(100).LT.N X X`0C `20 X** LOAD 'SYSTEM' COMMON BLOCKS. THESE COMMON BLOCKS DEFINE THE STATE`20 X* OF A GAME WHICH HAS YET TO BE STARTED...`20 X*`20 X* NOTE: SETUP=0 MEANS READ IN THE DATABASE. X*`20 X*`20 X SETUP=0`20 X CALL LDCOMN(.TRUE.,FLNAME) X `20 X* READ IN THE DATABASE IF WE HAVE NOT YET DONE SO.`20 X `20 X IF(SETUP.NE.0) GOTO 1100 X X`0C `20 X*** DESCRIPTION OF THE DATABASE FORMAT`20 X*`20 X*`20 X* THE DATA FILE CONTAINS SEVERAL SECTIONS. EACH BEGINS WITH A LINE CONTA VINING X* A NUMBER IDENTIFYING THE SECTION, AND ENDS WITH A LINE CONTAINING '-1' V. X*`20 X* X* X* SECTION 1: LONG FORM DESCRIPTIONS. EACH LINE CONTAINS A LOCATION NUMB VER, X* A TAB, AND A LINE OF TEXT. THE SET OF (NECESSARILY ADJACENT) LINES V. X* WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X. X* X* X* SECTION 2: SHORT FORM DESCRIPTIONS. SAME FORMAT AS LONG FORM. NOT AL VL X* PLACES HAVE SHORT DESCRIPTIONS.`20 X* X* X* SECTION 3: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A S VECOND X* LOCATION NUMBER (Y), AND A LIST OF MOTION NUMBERS (SEE SECTION 4). X* EACH MOTION REPRESENTS A VERB WHICH WILL GO TO Y IF CURRENTLY AT X. V`20 X* Y, IN TURN, IS INTERPRETED AS FOLLOWS. LET M=Y/1000, N=Y MOD 1000. V`20 X* X* IF N<=300 IT IS THE LOCATION TO GO TO. X* IF 300<N<=500 N-300 IS USED IN A COMPUTED GOTO TO`20 X* A SECTION OF SPECIAL CODE. X* IF N>500 MESSAGE N-500 FROM SECTION 6 IS PRINTED, X* AND HE STAYS WHEREVER HE IS. X* X* MEANWHILE, M SPECIFIES THE CONDITIONS ON THE MOTION. X* X* IF M=0 IT'S UNCONDITIONAL.`20 X* IF 0<M<100 IT IS DONE WITH M% PROBABILITY.`20 X* IF M=100 UNCONDITIONAL, BUT FORBIDDEN TO DWARVES. X* IF 100<M<=200 HE MUST BE CARRYING OBJECT M-100.`20 X* IF 200<M<=300 MUST BE CARRYING OR IN SAME ROOM AS M-200. X* IF 300<M<=400 PROP(M MOD 100) MUST *NOT* BE 0. X* IF 400<M<=500 PROP(M MOD 100) MUST *NOT* BE 1. X* IF 500<M<=600 PROP(M MOD 100) MUST *NOT* BE 2, ETC.`20 X* X* IF THE CONDITION (IF ANY) IS NOT MET, THEN THE NEXT *DIFFERENT*`20 X* 'DESTINATION' VALUE IS USED (UNLESS IT FAILS TO MEET *ITS* CONDITIO VNS, X* IN WHICH CASE THE NEXT IS FOUND, ETC.). TYPICALLY, THE NEXT DEST W VILL X* BE FOR ONE OF THE SAME VERBS, SO THAT ITS ONLY USE IS AS THE ALTERN VATE X* DESTINATION FOR THOSE VERBS. FOR INSTANCE:`20 X* X* 15 110022 29 31 34 35 23 X* 15 14 29 X* X* THIS SAYS THAT, FROM LOC 15, ANY OF THE VERBS 29, 31, ETC., WILL TA VKE`20 X* HIM TO 22 IF HE'S CARRYING OBJECT 10, AND OTHERWISE WILL GO TO 14. X* X* 11 303008 49 X* 11 9 50 X* X* THIS SAYS THAT, FROM 11, 49 TAKES HIM TO 8 UNLESS PROP(3)=0, IN WHI VCH`20 X* CASE HE GOES TO 9. VERB 50 TAKES HIM TO 9 REGARDLESS OF PROP(3).`2 V0 X* X* X* SECTION 4: VOCABULARY. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A X* FIVE-LETTER WORD. CALL M=N/1000. IF M=0, THEN THE WORD IS A MOTIO VN X* VERB FOR USE IN TRAVELLING (SEE SECTION 3). ELSE, IF M=1, THE WORD V IS X* AN OBJECT. ELSE, IF M=2, THE WORD IS AN ACTION VERB (SUCH AS 'CARR VY'`20 X* OR 'ATTACK'). ELSE, IF M=3, THE WORD IS A SPECIAL CASE VERB (SUCH V AS`20 X* 'DIG') AND N MOD 1000 IS AN INDEX INTO SECTION 6. OBJECTS FROM 50 V TO`20 X* (CURRENTLY, ANYWAY) 79 ARE CONSIDERED TREASURES(FOR PIRATE, CLOSEOU VT). X* IF M=1 (OBJECT) THERE IS AN OBJECT LOCATION TABLE ATTACHED. EACH L VINE X* CONTAINS AN OBJECT'S INITIAL LOCATION (ZERO IF NONE). IF AN OBJECT V IS X* IMMOVABLE, THE LOCATION IS FOLLOWED BY A '-1'. IF THE OBJECT HAS T VWO`20 X* LOCATIONS IT IS FOLLOWED BY THE SECOND LOCATION; IT IS ASSUMED TO B VE X* IMMOVABLE. X* X* X* SECTION 5: OBJECT DESCRIPTIONS. EACH LINE CONTAINS A NUMBER (N), A TA VB,`20 X* AND A MESSAGE. IF N IS FROM 1 TO 100, THE MESSAGE IS THE 'INVENTOR VY'`20 +-+-+-+-+-+-+-+- END OF PART 5 +-+-+-+-+-+-+-+-