-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X declare integer constant nactions=22 X declare integer constant timelimit=15 X declare integer constant ctrlclimit=1000 X declare integer constant maxplanets=200 X declare integer constant ECM_COST=2 X declare integer constant LSJ_COST=4 X declare integer constant CLOAK_COST=3 X declare integer constant TRUE=1 X declare integer constant FALSE=0 X ! ------------------------- Types --------------------------------- X %include "gal-trader.h" X `20 X ! --------------------- Variables -------------------------------- X declare equip_type e(ntequip) ! info on equip sold on planet X declare player_type pr ! your info X declare shipstats_type s(-1 to ntships) ! general stats on ships X declare event_type ev(maxevents) ! Event queue X declare SINGLE points(ntrank) ! points needed to reach next rank X declare long return_status X declare string last_recipient`09 ! last message recipient X declare integer melt`09`09 ! set if your drive melts X declare integer l1`09`09`09 ! temporary variable for ship pos X dim rank$(ntrank) ! rank names X dim legal$(ntlegal) ! legal status names X dim tracomp%(maxplanets,13)`09`09 ! trading computer data X dim s0$(15),s1$(15),s2$(15),s3$(15),s4$(15) ! planet status descriptions X dim xp(maxplanets), yp(maxplanets), zone(maxplanets)`20 X dim name$(maxplanets) X dim exist(maxships) ! valid targets array X dim action_cmd$(20)`09`09`09 ! commands to be parsed X dim action_cost$(nactions,2)`09 ! each action is move, combat, or free X dim g_option$(6)`09`09`09 ! current settings of game options X `20 X ! --------------------- Map definitions ---------------------------- X map (planetmap) planetinfo_type pt ! static stats on planet X map (playermap) player_type op ! other player info X map (actionmap) string planetaction=15,SINGLE noship, & X targets_type t(maxships), cargo_type c(ntcargo) X map (scoremap) integer dummy, score_type sc(maxscores) X %include "common.h"`09`09`09 ! common block with display X common long timebuffer, fill1`09 ! buffer for system time value X`20 X ! ------------------- External Declarations ------------------------ X external sub lib$spawn (string) ! used to execute dcl commands X external sub lib$sys_trnlog(string by desc, INTEGER by ref, & X string by desc, INTEGER by ref, INTEGER by ref) X external sub display(integer, string) X external string function pnamegen(string by desc) X external sub lib$put_screen(STRING by desc, INTEGER by ref, & X INTEGER by ref, INTEGER by ref) X external sub sys$gettim X external long function lib$getjpi(LONG by ref, LONG by ref, STRING by de Vsc & X`09`09,LONG by ref, STRING by desc, WORD by desc) X external long constant jpi$_username X X ! ------------------- correct atan function ------------------------ X def single atan(single x,y) X angle=0 X if x<>0 then `20 X angle=atn(abs(y)/abs(x)) `20 X if sgn(x)+sgn(y)=0 then `20 X angle=angle+2*(90-angle) `20 X `09end if X `09if sgn(y)=-1 or (sgn(y)=0 and sgn(x)=-1) then X `09 angle=angle+180 `20 X `09end if `20 X else `20 X `09if sgn(y)=1 then `20 X `09 angle=90 `20 X `09else `20 X `09 angle=270 `20 X `09end if `20 X end if X atan=angle X end def X X ! find the next available ship insertion point. X ! X def integer next_ship X l12%=1 X until (l12%=200 or t(l12%)::ship=0 or t(l12%)::ship = -1) X l12%=l12%+1 X next X next_ship = l12% X end def X X ! Returns true if string is a valid (signed) integer X def integer integerp(string str_val$) X integerp=TRUE X if len(str_val$)=0 then integerp=FALSE end if X for cic=1 to len(str_val$)`09`20 X`09if (cic=1 and mid$(str_val$,cic,1)="-" and len(str_val$)>1) then X`09 iterate X`09end if X if ascii(mid$(str_val$,cic,1))<48 or ascii(mid$(str_val$,cic,1))>57 V then X`09 integerp=FALSE X end if X next cic X end def X X X def integer valid_id(string x) X valid_id = 1 X if x <> "GPHQ" then X when error in X`09 find #2%, key #0% eq x, wait 60% X use X `09 call display(33,"The trader id "+x+" is invalid.") X `09 valid_id = 0 X end when X`09free #2% X end if X end def X `20 X %IF (%SECURITY = 0) X %THEN X def integer valid_override() X a = noecho(0%) X input "Enter Override Password to proceed> ";a$ X a = echo(0%) X a$=edit$(a$,32%) `20 X! b$=date$(0%) X! a=int((val(mid$(b$,1,2)+mid$(b$,8,2))-1)*val(mid$(b$,8,2)+ & X!`09mid$(b$,1,2))/23+6) X! if a=val(a$) then X if a$=overridemode then X valid_override = 1 X else X valid_override = 0`09! should be 0 X end if X end def X %ELSE %IF (%SECURITY = 1 or %SECURITY = 2) X %THEN X def integer valid_override() X valid_override = 0 X end def X %END %IF X %END %IF X`20 X ! checkint returns 1 if string is all integers, -1 otherwise X def integer checkint(string str_val$) X checkint=1 X for cic=1 to len(str_val$) X if ascii(mid$(str_val$,cic,1))<48 or & X`09`09ascii(mid$(str_val$,cic,1))>57 then X`09 checkint=-1 X end if X next cic X checkint=intp X end def X `20 X X ! ----------------------- Initializations -------------------------- X when error in X melt = 0 X pr::time_owned = 1 X pr::chan1=1\pr::chan2=2 X pr::score=0\pr::thargoid=0\pr::escapes=0 ! player stats initialization X pr::on_ground=1\pr::energy=0\pr::shiptype=0 X pr::kills=0\pr::moves=0\pr::credits=startmoney X pr::legal=1\pr::rank=1\pr::scanrange=3\pr::shipnum=0\police_mode%=0 X pr::planet=int(numplanets*rnd+1)\pr::rpos=0 ! starting planet - check f Vile X pr::message=""\menumode$="none" X pr::date(0) = 0 X pr::date(1) = 0 X pr::pmode = 0`09`09`09 ! mode of player (god, police) X nocheck=0`09`09`09`09 ! timestamp checking enabled X ecm_status%=0`09`09`09 ! ecm (if present) is off X super_user_mode%=0`09`09`09 ! super_use_mode is off X debug%=0 ! debug%=1 for debug, 0 for normal X last_recipient = ""`09`09`09 ! no last message recipient X g_option$(1)="OFF"\g_option$(2)="OFF" ! game_options X g_option$(3)="OFF"\g_option$(4)="ON" X g_option$(5)="OFF"\g_option$(6)="OFF" X ! find and hash real ID X return_status = lib$getjpi(jpi$_username,,,,n$,) X n$=edit$(n$,128%) X if len(n$)=3 then n$=n$+"X" end if X n$=right$(n$,len(n$)-3) X call lib$sys_trnlog("SYS$LOGIN",a%,a$,0%,0%) X a$=edit$(a$,160%)`09`09`09 ! convert to uppercase`20 X a$=mid$(a$,len(a$)-4,4) X if left$(a$,1)="`5B" then X a$=mid$(a$,2,3)+"X" X end if X pr::username=a$ ! get username from log. name X if left$(n$,4) <> left$(a$,4) then X fake_id=1 X else X fake_id=0 X end if X numevents=0 ! No events in event queue X gal_flag=1`09`09`09`09 ! Assume galaxy exists - check later X restore X for i=1 to 10\read s1$(i)\next i ! read in planet desc messages X for i=1 to 11\read s2$(i)\next i X for i=1 to 12\read s3$(i)\next i X for i=1 to 10\read s4$(i)\next i X for i=1 to 10\read s0$(i)\next i X for i=1 to ntequip\read e(i)::ename, e(i)::usedeprice\next i X for i=1 to ntcargo X read c(i)::trade, c(i)::tprice, c(i)::ttech, checksum, c(i)::unit X if ((4*c(i)::tprice)`5E2+17*c(i)::ttech`5E3) <> checksum then X goto 10000 X end if X next i X for i=1 to ntlegal\read legal$(i)\next i X X for i=1 to ntships X read s(i)::sname, s(i)::menergy, s(i)::slaser, s(i)::mlaser, & X s(i)::mcargo, s(i)::mmissile, s(i)::rarity, s(i)::cost, & X s(i)::mdrive, s(i)::mfuel, s(i)::reliability, s(i)::resale,checksum X next i X X for i=1 to ntrank X read rank$(i), points(i) X next i X for i=1 to nactions X`09read action_cost$(i,1),action_cost$(i,2) X next i X X ! --------------------------------------------------------------- X ! Set up Files X ! --------------------------------------------------------------- X X when error in X open "gal_disk:gal-planets2.dat" as file #1%, organization indexed fix Ved, & X allow modify, access modify, primary key pt::pname duplicates, & X map planetmap, contiguous, filesize 100 X X open "gal_disk:gal-players1.dat" as file #2%, organization indexed fix Ved, & X allow modify, access modify, primary key op::username, & X map playermap, contiguous, filesize 100 X`20 X open "gal_disk:gal-action3.dat" as file #3%, organization indexed fixe Vd, & X allow modify, access modify, primary key planetaction, & X map actionmap, contiguous, filesize 100, extendsize 50 X use X print "Error opening game files - See your game manager." X continue 10000 X end when X free #3%\free #1% X`20 X when error in ! enable control C trapping X restore #1%\get #1%, wait 60 ! check if galaxy exists X use X gal_flag = 0 X end when`20 X when error in ! check if any players in game `20 X restore #2%\get #2%, wait 60 ! eof error ==> create new gal X use X if gal_flag=1 then X`09input "Previous Galaxy Saved. Do you want to keep it (y/n) ";a$ X`09a$=edit$(a$,32%) X if a$<>"N" then X`09 continue 547`09! keep galaxy X end if X end if X continue 2000`09! create new galaxy X end when X547 free #2%\restore #1% X550 numplanets=0 X when error in X while numplanets ";sel$ X sel$=edit$(sel$,32%) X! if op::date(1)<>0 then X! a = noecho(0%) X! print X! input "You have a password set, Enter password: ";a$ X`09 a$=edit$(a$,32%)`09! convert to uppercase X! a = echo(0%) X ! now decrypt X! p = 0 X! for i=1 to len(a$) X! p=p+ascii(mid$(a$,i,1))*i X! next i X! if p<>op::date(1) then goto bad_pass end if X! end if X`09 if sel$="N" or sel$="n" then X print "Starting a new game." X delete #2% X free #2% X goto init_planet X else X`09 pr = op X print "SUing your game. See your game manager to get it unlocked V." X pr::date(1)=11 X gosub 5100 X goto 8000 X end if X use X if fake_id=1 then X print "You are not allowed to use an ID alias when creating" X print "a character. ID aliases may only be used to link to" X print "an existing character." X print X if valid_override = 1 then X continue init_planet X`09 else X continue 10000 X end if X`09 else X continue init_planet X`09 end if X end when X else ! player has a save file X ! if player has a save file, and is already in game - ditch game X when error in X`09 find #2%, key #0% eq pr::username X`09 delete #2%\free #2% X use X`09 free #2% X end when X end if X pr = op X print "Successful revival from suspended animation." X if pr::energy <0 then X`09print "You have DIED in suspended animation..." X`09delete #4% X`09goto 10000 X end if X if pr::shiptype = 0 then X`09print "No current ship. Assigning a Yugo..." X`09pr::shiptype = 23 X`09pr::energy = s(23)::menergy X`09pr::credits = pr::credits - s(23)::cost X end if X if pr::date(1)=11 then X call sys$gettim(timebuffer) X ! if time is up, then allow revival X if abs((fill1-pr::timestamp(2)))>ctrlclimit then X print "Your CTRL-C lockout has been automatically purged." X pr::date(1)=0 X else X print "Your save file is locked due to use of CTRL-C. Note that" X`09 print "CTRL-C is *NOT* to be abused. Your game will be automatically" X print "freed in ";ctrlclimit-(fill1-pr::timestamp(2));" ticks." X print X goto bad_pass X end if X end if X if pr::date(1)<>0 then X print X a = noecho(0%) X input "You have a password set, Enter password: ";a$ X`09a$=edit$(a$,32%)`09! convert to uppercase X a = echo(0%) X ! now decrypt X p = 0 X for i=1 to len(a$) X p=p+(ascii(mid$(a$,i,1))+1)*i X next i X if p<>pr::date(1) then`20 X print "User authorization failure - incorrect password." X goto bad_pass`20 X end if X end if X goto 611 Xbad_pass: +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-