program rpg; { A helper program for AD&D } {$S+} { Turn on segmentation } {$R+} { Turn on range checking } {$I+} { Turn on I/O error checking } {$B+} { Set bundle bit } {$R rpg.Rsrc} { Identify resource file } {$T APPLRPGH} { Set application ID } {$O RPG} { Set output file name } {$U-} { Turn off auto link to runtime units } uses PasInOut,Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf; const MenuCnt = 8; { total # of menus } ApplMenu = 1000; { resource ID of Apple Menu } FileMenu = 1001; { " File Menu } EditMenu = 1002; { " Edit Menu } DiceMenu = 1003; { " Dice Menu } TimeMenu = 1004; { " Time Menu } CastMenu = 1005; { " Cast Menu } UtilMenu = 1006; { " Util Menu } CharMenu = 1007; { " Char Menu } AM = 1; { index into MenuList for Apple Menu } FM = 2; { " File Menu } EM = 3; { " Edit Menu } DM = 4; { " Dice Menu } TM = 5; { " Time Menu } CM = 6; { " Cast Menu } UM = 7; { " Util Menu } HM = 8; { " Char Menu } TimeID = 1000; { resource ID for TimeWindow } DiceID = 1001; { " DiceWindow } TreaID = 1002; { " TreaWindow } CharID = 1003; { " CharWindow } InfoID = 1004; { " InfoWindow } AboutID = 1000; { " About box } m1=259200; { Random number constants } ia1=7141; ic1=54773; rm1=3.8580247e-6; m2=134456; ia2=8121; ic2=28411; rm2=7.4373773e-6; m3=243000; ia3=4561; ic3=51349; type yearrange=0..2047; { Time types } dayrange=0..364; hourrange=0..23; minuterange=0..59; secondrange=0..59; timetype=record year:yearrange; day:dayrange; hour:hourrange; minute:minuterange; second:secondrange end; latrange=-90..90; terrainList=(plain,forest,jungle,hills,mountains,desert,broken, swamp,coast,ocean); terraintype=record lat:latrange; alt:Integer; ter:terrainList end; statrange=0..99; { Character types } ACrange=-10..10; saverange=1..20; statList=(str,int,wis,dex,con,cha,excep); stattype=array[statList] of statrange; saveList=(death,petpol,rsw,breath,magic); savetype=array[saveList] of saverange; heightrange=0..127; weightrange=0..511; HPrange=0..511; nametype=string[63]; racetype=string[8]; classtype=array[1..3] of 'A'..'T'; leveltype=array[1..3] of 0..63; charactertype=record name:nametype; class:classtype; level:leveltype; race:racetype; height:heightrange; weight:weightrange; DOB:timetype; AC,AC2:ACrange; HP:HPrange; stats:stattype; saves:savetype end; partytype=array[1..10] of charactertype; modetype=(fix,add); padtype=(zero,blank); var Finished : Boolean; { used to terminate the program } theEvent : EventRecord; { event passed from operating system } { Screen stuff} DragArea : Rect; { defines area where window can be dragged in } GrowArea : Rect; { defines area to which a window's size can change } ScreenArea : Rect; { defines screen dimensions } Watch : Cursor; { used to hold watch cursor } { Menu stuff} MenuList : array[1..MenuCnt] of MenuHandle; { holds menu info } { Window stuff } TimePtr,DicePtr,TreaPtr,CharPtr,InfoPtr:WindowPtr; { pointers to windows } ScreenPort : GrafPtr; { pointer to entire screen } { program specific stuff} time : timetype; { Stores current game time } terrain : terraintype; { Stores current terrain } party : partytype; { Stores party info } NumChars,SelChar : 0..10; { Character indices } glix1,glix2,glix3: LongInt; { Random number variables } glr: array [1..97] of real; { *** utility functions and procedures *** } function ran1:real; { Returns uniform deviate from 0 to 1. Initialise with negative idum } var k: Integer; begin glix1:=(ia1*glix1+ic1) mod m1; glix2:=(ia2*glix2+ic2) mod m2; glix3:=(ia3*glix3+ic3) mod m3; k:=1+(97*glix3) div m3; ran1:=glr[k]; glr[k]:=(glix1+glix2*rm2)*rm1 end; function die(dietype:integer):integer; { Returns a single die throw in the range 1..dietype } begin die:=trunc(dietype*ran1)+1 end; function dice(numdice,dietype:integer):integer; { Returns sum of numdice throws in range 1..dietype } var temp,i:integer; begin temp:=0; for i:=1 to numdice do temp:=temp+die(dietype); dice:=temp end; function Pad(padding,theNum:LongInt; leader:padtype):str255; { Outputs a string of padding characters containing theNum, padded } { with leading zeroes or blanks if necessary } var temp:str255; begin NumToString(theNum,temp); while (Length(temp)y then Max:=x else Max:=y end; { func Max } function OKNumber(theString:Str255; Min,Max:Integer; var theNum:LongInt; theDialog:DialogPtr; theItem:Integer):Boolean; { decides if an input string is okay as a numerical input, returning the result in theNum if it is, beeping the dialog if not } var i:Integer; temp:Boolean; OKChars:set of char; begin OKChars:=['+','-','0','1','2','3','4','5','6','7','8','9']; temp:=true; for i:=1 to Length(theString) do if not(theString[i] in OKChars) then temp:=false; StringToNum(theString,theNum); if (theNumMax) then temp:=false; if not(temp) then SelIText(theDialog,theItem,0,32767); OKNumber:=temp end; { func OKNumber } function GetDayMonth(DayNum:dayrange):str255; {Returns day/month format string given day of year in Greyhawk calendar} var GoneMonths:0..12; GoneFests:0..3; Day,Month:str255; DaysLeft:dayrange; begin GoneMonths:=0; GoneFests:=0; DaysLeft:=DayNum; while ((((GoneMonths div 3)=GoneFests)and(DaysLeft>28))or (((GoneMonths div 3)<>GoneFests)and(DaysLeft>7))) do begin if ((GoneMonths div 3)=GoneFests) then begin DaysLeft:=DaysLeft-28; GoneMonths:=GoneMonths+1 end else begin DaysLeft:=DaysLeft-7; GoneFests:=GoneFests+1 end end; if (GoneMonths-GoneFests*3=3) then case GoneFests of 0:Month:='Gr'; 1:Month:='Ri'; 2:Month:='Br'; 3:Month:='Ne' end else NumToString(GoneMonths+1,Month); NumToString(DaysLeft,Day); if (Length(Month)=1) then Month:='0'+Month; if (Length(Day)=1) then Day:='0'+Day; GetDayMonth:=Day+'/'+Month end; { function GetDayMonth } procedure AddTime(var thetime,theinterval:timetype); var temp:Integer; begin temp:=thetime.second+theinterval.second; thetime.second:=temp mod 60; temp:=thetime.minute+theinterval.minute+temp div 60; thetime.minute:=temp mod 60; temp:=thetime.hour+theinterval.hour+temp div 60; thetime.hour:=temp mod 24; temp:=thetime.day+theinterval.day+temp div 24; thetime.day:=temp mod 364; if (thetime.day=0) then thetime.day:=364; temp:=thetime.year+theinterval.year+(temp-1) div 364; thetime.year:=temp end; { proc AddTime } procedure DrawMoon(x,y,rad:Integer; phase:Real); { Draws a moon at the given position with the given phase } var Invert:Boolean; Moon,Shadow:Rect; PartRad:Integer; begin Invert:=false; with Moon do begin top:=y-rad; bottom:=y+rad; left:=x-rad; right:=x+rad end; FrameOval(Moon); if (phase<0.25) then begin phase:=phase+0.5; Invert:=true end; if (phase>=0.75) then begin phase:=phase-0.5; Invert:=true end; PartRad:=Trunc(0.4+Abs(cos(6.2831853072*phase)*rad)); InsetRect(Moon,1,1); Shadow:=Moon; Shadow.left:=x-PartRad; Shadow.right:=x+PartRad; PaintOval(Shadow); if (phase<0.5) then PaintArc(Moon,180,180) else PaintArc(Moon,0,180); if Invert then InvertOval(Moon) end; {proc DrawMoon} procedure ClearWindow(WPtr : WindowPtr); begin EraseRect(WPtr^.portRect) end; { of proc ClearWindow } procedure WriteTime; { Writes time in Greyhawk Calendar following the format day/month/year hour:minute:second Festivals are denoted by the first two letters in place of a month number, viz: "Gr"owfest, "Ri"chfest, "Br"ewfest, "Ne"edfest. } var display:str255; SavePort:WindowPtr; MoonPhase:Real; begin GetPort(SavePort); SetPort(TimePtr); ClearWindow(TimePtr); NumToString(time.year,display); display:=GetDayMonth(time.day)+'/'+display; MoveTo(20,20); DrawString(display); display:=Pad(2,time.hour,zero)+':'+Pad(2,time.minute,zero) +':'+Pad(2,time.second,zero); MoveTo(20,40); DrawString(display); case ((time.day) mod 7) of 0: display:='Saturday'; 1: display:='Sunday'; 2: display:='Monday'; 3: display:='Tuesday'; 4: display:='Wednesday'; 5: display:='Thursday'; 6: display:='Friday' end; MoveTo(20,60); DrawString(display); MoonPhase:=((time.day+17) mod 28)/28; DrawMoon(32,92,30,MoonPhase); MoonPhase:=((time.day+3) mod 91)/91; DrawMoon(80,92,17,MoonPhase); MoveTo(20,130); display:='Luna Celene'; DrawString(display); SetPort(SavePort) end; { proc WriteTime } procedure WriteChar; { Displays a character file } var display:str255; SavePort:WindowPtr; begin GetPort(SavePort); SetPort(CharPtr); ClearWindow(CharPtr); if (SelChar>0) then with party[SelChar] do begin MoveTo(5,10); DrawString(name); MoveTo(5,20); DrawString(race); MoveTo(100,20); display:=class[1]+Pad(1,level[1],zero); if (class[2]<>'N') then display:=display+'/'+class[2]+Pad(1,level[2],zero); if (class[3]<>'N') then display:=display+'/'+class[3]+Pad(1,level[3],zero); DrawString(display); MoveTo(5,40); display:='Str:'+Pad(3,stats[str],blank); if ((stats[str]=18)and(class[1] in ['F','P','R'])) then display:=display+'/'+Pad(2,stats[excep],zero); DrawString(display); MoveTo(5,50); display:='Int:'+Pad(3,stats[int],blank); DrawString(display); MoveTo(5,60); display:='Wis:'+Pad(3,stats[wis],blank); DrawString(display); MoveTo(5,70); display:='Dex:'+Pad(3,stats[dex],blank); DrawString(display); MoveTo(5,80); display:='Con:'+Pad(3,stats[con],blank); DrawString(display); MoveTo(5,90); display:='Chr:'+Pad(3,stats[cha],blank); DrawString(display); MoveTo(100,40); display:='AC: '+Pad(2,AC,blank)+'/'+Pad(1,AC2,blank); DrawString(display); MoveTo(100,50); display:='HP: '+Pad(2,HP,blank); DrawString(display); MoveTo(100,70); display:='Height: '+Pad(2,height,blank)+'"'; DrawString(display); MoveTo(100,80); display:='Weight: '+Pad(2,weight,blank)+'#'; DrawString(display); MoveTo(5,110); display:='Paral/Poison/Death:'+Pad(3,saves[death],blank); DrawString(display); MoveTo(5,120); display:='Petrifac/Polymorph:'+Pad(3,saves[petpol],blank); DrawString(display); MoveTo(5,130); display:='Rod/Staff/Wand :'+Pad(3,saves[rsw],blank); DrawString(display); MoveTo(5,140); display:='Breath Weapon :'+Pad(3,saves[breath],blank); DrawString(display); MoveTo(5,150); display:='Magic/Spells :'+Pad(3,saves[magic],blank); DrawString(display); end; SetPort(SavePort) end; { proc WriteChar } { ********* items in Char Menu *********** } procedure DoNoChar; { Selects no character to be displayed } begin if SelChar<>0 then SetItemMark(MenuList[HM],SelChar+2,Chr(NoMark)); SelChar:=0; SetItemMark(MenuList[HM],1,Chr(CheckMark)); WriteChar end; procedure DoSelChar(n:integer); { Selects a specified character to be displayed } begin if SelChar<>0 then SetItemMark(MenuList[HM],SelChar+2,Chr(NoMark)) else SetItemMark(MenuList[HM],1,Chr(NoMark)); SelChar:=n; SetItemMark(MenuList[HM],SelChar+2,Chr(CheckMark)); WriteChar end; {$S FileSeg} procedure DoCharDialog(mode:modetype); { Open, process, and close the Character dialog box. } { NOTE: saving throws follow a smooth linear progression with level, unlike official AD&D rules, but are close to the official values. } const humanBtn = 3; elfBtn = 4; halfelfBtn = 5; dwarfBtn = 6; gnomeBtn = 7; halflingBtn = 8; halforcBtn = 9; nameEdit = 20; fighterEdit = 21; muEdit = 22; clericEdit = 23; thiefEdit = 24; paladinEdit = 25; rangerEdit = 26; illusionistEdit = 27; druidEdit = 28; assassinEdit = 29; hpEdit = 30; acEdit = 31; ac2Edit = 32; heightEdit = 33; weightEdit = 34; yearEdit = 35; monthEdit = 36; dayEdit = 37; strEdit = 38; intEdit = 39; wisEdit = 40; dexEdit = 41; conEdit = 42; chaEdit = 43; excepEdit = 44; type typeOfChar=(C,F,MU,T,Z); slopeInt=(m,b,min); var theDialog: DialogPtr; itemHit: Integer; theType: Integer; r: Rect; radButton: array [humanBtn..halforcBtn] of ControlHandle; done,OKinput: Boolean; n,i: Integer; edits: array[nameEdit..excepEdit] of Handle; s: array[nameEdit..excepEdit] of Str255; vals: array[fighterEdit..excepEdit] of LongInt; theRace: string[8]; h: handle; SavePort:GrafPtr; num: Integer; classList:String[9]; saveData:array[C..T,saveList,slopeInt] of Real; theChar:typeOfChar; theSave:saveList; begin if mode=fix then begin num:=NumChars+1; if (num>10) then begin if (Alert(512,nil)>0) then {nothing}; Exit end end else begin if SelChar=0 then begin SysBeep(10); Exit end; num:=SelChar end; classList:='FMCTPRIDA'; saveData[C,death,m]:=-4/9; saveData[C,death,b]:=34/3; saveData[C,death,min]:=2.1; saveData[C,petpol,m]:=-4/9; saveData[C,petpol,b]:=43/3; saveData[C,petpol,min]:=5.1; saveData[C,rsw,m]:=-3/7; saveData[C,rsw,b]:=107/7; saveData[C,rsw,min]:=6.1; saveData[C,breath,m]:=-4/9; saveData[C,breath,b]:=52/3; saveData[C,breath,min]:=8.1; saveData[C,magic,m]:=-4/9; saveData[C,magic,b]:=49/3; saveData[C,magic,min]:=7.1; saveData[F,death,m]:=-0.75; saveData[F,death,b]:=16; saveData[F,death,min]:=3.1; saveData[F,petpol,m]:=-0.75; saveData[F,petpol,b]:=17; saveData[F,petpol,min]:=4.1; saveData[F,rsw,m]:=-0.75; saveData[F,rsw,b]:=18; saveData[F,rsw,min]:=5.1; saveData[F,breath,m]:=-1; saveData[F,breath,b]:=19; saveData[F,breath,min]:=4.1; saveData[F,magic,m]:=-0.75; saveData[F,magic,b]:=18.75; saveData[F,magic,min]:=6.1; saveData[MU,death,m]:=-2/7; saveData[MU,death,b]:=106/7; saveData[MU,death,min]:=8.1; saveData[MU,petpol,m]:=-0.4; saveData[MU,petpol,b]:=14.2; saveData[MU,petpol,min]:=5.1; saveData[MU,rsw,m]:=-0.4; saveData[MU,rsw,b]:=12.2; saveData[MU,rsw,min]:=3.1; saveData[MU,breath,m]:=-0.4; saveData[MU,breath,b]:=16.2; saveData[MU,breath,min]:=7.1; saveData[MU,magic,m]:=-0.4; saveData[MU,magic,b]:=13.2; saveData[MU,magic,min]:=4.1; saveData[T,death,m]:=-0.25; saveData[T,death,b]:=14; saveData[T,death,min]:=8.1; saveData[T,petpol,m]:=-0.25; saveData[T,petpol,b]:=13; saveData[T,petpol,min]:=7.1; saveData[T,rsw,m]:=-0.5; saveData[T,rsw,b]:=15.5; saveData[T,rsw,min]:=4.1; saveData[T,breath,m]:=-0.25; saveData[T,breath,b]:=17; saveData[T,breath,min]:=11.1; saveData[T,magic,m]:=-0.5; saveData[T,magic,b]:=16; saveData[T,magic,min]:=5.1; GetPort(SavePort); theDialog := GetNewDialog(259, nil, Pointer (-1)); SetPort(theDialog); GetDItem(theDialog,ok,theType,h,r); InsetRect(r,-4,-4); PenSize(3,3); FrameRoundRect(r,16,16); PenSize(1,1); SetPort(SavePort); for n := humanBtn to halforcBtn do GetDItem(theDialog,n,theType,Handle(radButton[n]),r); if mode=fix then begin SetCtlValue(radButton[humanBtn],1); theRace:='Human' end else begin theRace:=party[SelChar].race; case theRace[Length(theRace)-2] of 'm' : SetCtlValue(radButton[humanBtn],1); 'E' : if theRace='Elf' then SetCtlValue(radButton[elfBtn],1) else SetCtlValue(radButton[halfelfBtn],1); 'a' : SetCtlValue(radButton[dwarfBtn],1); 'o' : SetCtlValue(radButton[gnomeBtn],1); 'i' : SetCtlValue(radButton[halflingBtn],1); 'O' : SetCtlValue(radButton[halforcBtn],1) end {case} end; for n:=nameEdit to excepEdit do GetDItem(theDialog,n,theType,edits[n],r); for n:=fighterEdit to excepEdit do s[n]:='0'; if mode=add then with party[SelChar] do begin s[nameEdit]:=name; SetIText(edits[nameEdit],name); SelIText(theDialog,nameEdit,0,32767); NumToString(HP,s[hpEdit]); SetIText(edits[hpEdit],s[hpEdit]); NumToString(AC,s[acEdit]); SetIText(edits[acEdit],s[acEdit]); NumToString(AC2,s[ac2Edit]); SetIText(edits[ac2Edit],s[ac2Edit]); NumToString(height,s[heightEdit]); SetIText(edits[heightEdit],s[heightEdit]); NumToString(weight,s[weightEdit]); SetIText(edits[weightEdit],s[weightEdit]); NumToString(DOB.year,s[yearEdit]); SetIText(edits[yearEdit],s[yearEdit]); s[dayEdit]:=GetDayMonth(DOB.day); s[monthEdit]:=Copy(s[dayEdit],4,2); s[dayEdit]:=Copy(s[dayEdit],1,2); SetIText(edits[monthEdit],s[monthEdit]); SetIText(edits[dayEdit],s[dayEdit]); for n:=strEdit to excepEdit do begin NumToString(stats[statList(n-38)],s[n]); SetIText(edits[n],s[n]) end; for n:=1 to 3 do if class[n]<>'N' then begin case class[n] of 'F' : begin NumToString(level[n],s[fighterEdit]); SetIText(edits[fighterEdit],s[fighterEdit]) end; 'M' : begin NumToString(level[n],s[muEdit]); SetIText(edits[muEdit],s[muEdit]) end; 'C' : begin NumToString(level[n],s[clericEdit]); SetIText(edits[clericEdit],s[clericEdit]) end; 'T' : begin NumToString(level[n],s[thiefEdit]); SetIText(edits[thiefEdit],s[thiefEdit]) end; 'P' : begin NumToString(level[n],s[paladinEdit]); SetIText(edits[paladinEdit],s[paladinEdit]) end; 'R' : begin NumToString(level[n],s[rangerEdit]); SetIText(edits[rangerEdit],s[rangerEdit]) end; 'I' : begin NumToString(level[n],s[illusionistEdit]); SetIText(edits[illusionistEdit],s[illusionistEdit]) end; 'D' : begin NumToString(level[n],s[druidEdit]); SetIText(edits[druidEdit],s[druidEdit]) end; 'A' : begin NumToString(level[n],s[assassinEdit]); SetIText(edits[assassinEdit],s[assassinEdit]) end end {case} end end; repeat done := False; OKinput:=True; repeat ModalDialog(nil,itemHit); case itemHit of ok,cancel: done:=True; humanBtn..halforcBtn: begin for n := humanBtn to halforcBtn do SetCtlValue(radButton[n],Ord(n = itemHit)); case itemHit of humanBtn: theRace:='Human'; elfBtn: theRace:='Elf'; halfelfBtn: theRace:='Half-Elf'; dwarfBtn: theRace:='Dwarf'; gnomeBtn: theRace:='Gnome'; halflingBtn: theRace:='Halfling'; halforcBtn: theRace:='Half-Orc' end end; nameEdit..excepEdit: GetIText(edits[itemHit],s[itemHit]) end until done; if (itemHit=ok) then begin { Check for ok input } theType:=0; for n:=fighterEdit to assassinEdit do begin if s[n]<>'' then OKInput:=OKInput and OKNumber(s[n],0,63,vals[n],theDialog,n) else vals[n]:=0; if vals[n]>0 then begin theType:=theType+1; if theType=4 then begin OKInput:=false; SelIText(theDialog,n,0,32767) end end end; if theType<1 then begin OKInput:=false; SelIText(theDialog,fighterEdit,0,32767) end; OKInput:=OKInput and OKNumber(s[hpEdit],1,511,vals[hpEdit], theDialog,hpEdit); OKInput:=OKInput and OKNumber(s[acEdit],-10,10,vals[acEdit], theDialog,acEdit); OKInput:=OKInput and OKNumber(s[ac2Edit],-10,10,vals[ac2Edit], theDialog,ac2Edit); OKInput:=OKInput and OKNumber(s[heightEdit],1,127,vals[heightEdit], theDialog,heightEdit); OKInput:=OKInput and OKNumber(s[weightEdit],1,511,vals[weightEdit], theDialog,weightEdit); OKInput:=OKInput and OKNumber(s[yearEdit],0,2047,vals[yearEdit], theDialog,yearEdit); OKInput:=OKInput and OKNumber(s[dayEdit],1,28,vals[dayEdit], theDialog,dayEdit); for n:=strEdit to chaEdit do OKInput:=OKInput and OKNumber(s[n],3,25,vals[n],theDialog,n); OKInput:=OKInput and OKNumber(s[excepEdit],0,99,vals[excepEdit], theDialog,excepEdit); case s[monthEdit][1] of 'G','g': vals[dayEdit]:=vals[dayEdit]+84; 'R','r': vals[dayEdit]:=vals[dayEdit]+175; 'B','b': vals[dayEdit]:=vals[dayEdit]+266; 'N','n': vals[dayEdit]:=vals[dayEdit]+357 otherwise if OKNumber(s[monthEdit],1,12,vals[monthEdit],theDialog, monthEdit) then vals[dayEdit]:=vals[dayEdit]+(vals[monthEdit]-1)*28 +((vals[monthEdit]-1) div 3)*7 else OKinput:=False end; {case} if ((vals[dayEdit]>364)or(vals[dayEdit]<0)) then begin SelIText(theDialog,monthEdit,0,32767); OKinput:=False end; if (not(OKinput)) then SysBeep(10) end until OKinput; if (itemHit=ok) then { Process input } with party[num] do begin name:=s[nameEdit]; race:=theRace; height:=vals[heightEdit]; weight:=vals[weightEdit]; AC:=vals[acEdit]; AC2:=vals[ac2Edit]; HP:=vals[hpEdit]; DOB.year:=vals[yearEdit]; DOB.day:=vals[dayEdit]; stats[str]:=vals[strEdit]; stats[int]:=vals[intEdit]; stats[wis]:=vals[wisEdit]; stats[dex]:=vals[dexEdit]; stats[con]:=vals[conEdit]; stats[cha]:=vals[chaEdit]; if s[excepEdit]='' then stats[excep]:=0 else stats[excep]:=vals[excepEdit]; class[1]:='N'; class[2]:='N'; class[3]:='N'; for n:=fighterEdit to assassinEdit do if (class[1]='N') then begin if (vals[n]>0) then begin class[1]:=classList[n-20]; level[1]:=vals[n] end end else if (class[2]='N') then begin if (vals[n]>0) then begin class[2]:=classList[n-20]; level[2]:=vals[n] end end else if (class[3]='N') then begin if (vals[n]>0) then begin class[3]:=classList[n-20]; level[3]:=vals[n] end end; for n:=1 to 3 do begin case class[n] of 'F','P','R': theChar:=F; 'M','I': theChar:=MU; 'C','D': theChar:=C; 'T','A': theChar:=T; 'N': theChar:=Z end; {case} if n=1 then for theSave:=death to magic do saves[theSave]:= Max(Trunc(level[n]*saveData[theChar,theSave,m]+ saveData[theChar,theSave,b]+0.01), Trunc(saveData[theChar,theSave,min])) else if theChar<>Z then for theSave:=death to magic do begin i:=Max(Trunc(level[n]*saveData[theChar,theSave,m]+ saveData[theChar,theSave,b]+0.01), Trunc(saveData[theChar,theSave,min])); if i5) then { Get truncated name and } for n:=5 to Length(s[nameEdit]) do { insert in Char menu } if (s[nameEdit][n]=' ') then s[nameEdit]:=Copy(s[nameEdit],1,n-1); InsMenuItem(MenuList[HM],s[nameEdit],NumChars+1) end else begin DelMenuItem(MenuList[HM],SelChar+2); if (Length(s[nameEdit])>5) then { Get truncated name and } for n:=5 to Length(s[nameEdit]) do { insert in Char menu } if (s[nameEdit][n]=' ') then s[nameEdit]:=Copy(s[nameEdit],1,n-1); InsMenuItem(MenuList[HM],s[nameEdit],SelChar+1) end end; DisposDialog(theDialog); SetItemMark(MenuList[HM],1,Chr(NoMark)); DoSelChar(num) end; { proc DoCharDialog } { ********* items in File Menu *********** } procedure DoNew; { Define a new character } begin DoCharDialog(fix) end; procedure DoOpen; { Open a saved character file } var where:Point; prompt:Str255; reply:SFReply; refNum,n:Integer; errCode:Integer; byteCount:LongInt; typeList:SFTypeList; begin if (NumChars=10) then begin if (Alert(512,nil)>0) then {nothing}; Exit end; where.v:=50; where.h:=50; typeList[0]:='ADCH'; SFGetFile(where,prompt,nil,1,typeList,nil,reply); with reply do begin if not(good) then Exit; errCode:=FSOpen(fName,vRefNum,refNum); if errCode<>noErr then Exit; byteCount:=SizeOf(charactertype); errCode:=FSRead(refNum,byteCount,@party[NumChars+1]); if errCode<>noErr then Exit; errCode:=FSClose(refNum) end; NumChars:=NumChars+1; prompt:=party[NumChars].name; if (Length(prompt)>5) then { Get truncated name and } for n:=5 to Length(prompt) do { insert in Character menu } if (prompt[n]=' ') then prompt:=Copy(prompt,1,n-1); InsMenuItem(MenuList[HM],prompt,NumChars+1); DoSelChar(NumChars) end; procedure DoClose; { Close a character file } var Temp:charactertype; i:Integer; begin if (SelChar>0) then begin if (SelChar<>NumChars) then for i:=SelChar to NumChars-1 do party[i]:=party[i+1]; i:=SelChar+2; DoNoChar; NumChars:=NumChars-1; DelMenuItem(MenuList[HM],i) end else SysBeep(10) end; procedure DoSave; { Saves an old character file } begin { unimplemented } end; procedure DoSaveAs; { Saves a new character file } var where:Point; prompt,theName:Str255; reply:SFReply; refNum:Integer; errCode:Integer; byteCount:LongInt; begin if SelChar=0 then begin SysBeep(10); Exit end; where.v:=50; where.h:=50; prompt:='Save character as:'; theName:=party[SelChar].name; SFPutFile(where,prompt,theName,nil,reply); with reply do begin if not(good) then Exit; errCode:=Create(fName,vRefNum,'ADAD','ADCH'); if errCode<>noErr then Exit; errCode:=FSOpen(fName,vRefNum,refNum); if errCode<>noErr then Exit; byteCount:=SizeOf(charactertype); errCode:=FSWrite(refNum,byteCount,@party[SelChar]); if errCode<>noErr then Exit; errCode:=FSClose(refNum); errCode:=FlushVol(nil,0) end end; { proc DoSaveAs } procedure DoModify; { Modify an existing character } begin DoCharDialog(add) end; {$S } procedure DoQuit; { Quit. Obviously } begin Finished:=true end; { ********* items in Dice Menu *********** } procedure DoDice(TheDie:integer); var Throws,Totals:array [1..20] of Integer; Index:1..20; display:str255; SavePort:WindowPtr; begin for Index:=1 to 20 do Totals[Index]:=0; for Index:=1 to 20 do begin Throws[Index]:=die(TheDie); if Index=1 then Totals[Index]:=Throws[Index] else Totals[Index]:=Totals[Index-1]+Throws[Index]; end; {WriteDice} GetPort(SavePort); SetPort(DicePtr); ClearWindow(DicePtr); MoveTo(10,10); NumToString(TheDie,display); display:='d'+display+'s'; DrawString(display); MoveTo(5,20); display:='Num Die Tot'; DrawString(display); for Index:=1 to 20 do begin MoveTo(5,20+Index*10); display:=' '+Pad(2,Index,blank)+' '+Pad(3,Throws[Index],blank) +' '+Pad(4,Totals[Index],blank); DrawString(display) end; SetPort(SavePort) end; procedure DoOther; { Open, process, and close the Dice dialog box. } const DiceRef = 5; var theDialog: DialogPtr; itemHit: Integer; theType: Integer; r: Rect; edText:ControlHandle; done,OKinput: Boolean; h: Handle; newstr:Str255; new:Longint; SavePort:GrafPtr; begin GetPort(SavePort); theDialog := GetNewDialog(257,nil,Pointer (-1)); SetPort(theDialog); GetDItem(theDialog,ok,theType,h,r); InsetRect(r,-4,-4); PenSize(3,3); FrameRoundRect(r,16,16); PenSize(1,1); SetPort(SavePort); GetDItem(theDialog,DiceRef,theType,Handle(edText),r); { Set initial values in text boxes and storage array} SelIText(theDialog,DiceRef,0,1); newstr:='1'; repeat done := False; OKinput:=True; repeat ModalDialog(nil,itemHit); case itemHit of ok,cancel : done:=True; DiceRef :GetIText(Handle(edText),newstr) end; until done; if (itemHit=ok) then begin { Convert the input number to the die type } OKInput:=OKNumber(newstr,1,1000,new,theDialog,DiceRef); if (not(OKinput)) then SysBeep(10) end until OKinput; DisposDialog(theDialog); if (itemHit=ok) then DoDice(new) end; { proc DoOther } { ********* items in Time Menu *********** } procedure DoTurn; { Add a turn to the time } var interval:timetype; begin with interval do begin year:=0; day:=0; hour:=0; minute:=10; second:=0 end; AddTime(time,interval); WriteTime end; procedure DoRound; { Add a round to the time } var interval:timetype; begin with interval do begin year:=0; day:=0; hour:=0; minute:=1; second:=0 end; AddTime(time,interval); WriteTime end; procedure DoEnd; { End a combat: round time up to the nearest turn } var interval:timetype; begin with interval do begin year:=0; day:=0; hour:=0; second:=0 end; time.second:=0; interval.minute:=(60-time.minute) mod 10; if (interval.minute=0) then interval.minute:=10; AddTime(time,interval); WriteTime end; procedure DoDateDialog(mode:modetype); { Open, process, and close the Date dialog box. } const YearRef = 10; MonthRef = 11; DayRef = 12; HourRef = 13; MinuteRef = 14; SecondRef = 15; var theDialog: DialogPtr; itemHit: Integer; theType: Integer; r: Rect; edText: array [YearRef..SecondRef] of ControlHandle; done,OKinput: Boolean; n: Integer; h: Handle; s,t: Str255; newstr: array [YearRef..SecondRef] of Str255; new: array [YearRef..SecondRef] of Longint; interval:timetype; SavePort:GrafPtr; begin if (mode=fix) then ParamText('Set Time To:','Month:','','') else ParamText('Add Time Interval:','Weeks:','s',''); GetPort(SavePort); theDialog := GetNewDialog(256, nil, Pointer (-1)); SetPort(theDialog); GetDItem(theDialog,ok,theType,h,r); InsetRect(r,-4,-4); PenSize(3,3); FrameRoundRect(r,16,16); PenSize(1,1); SetPort(SavePort); for n := YearRef to SecondRef do GetDItem(theDialog,n,theType,Handle(edText[n]),r); { Set initial values in text boxes and storage array} if (mode=fix) then with time do begin s:=GetDayMonth(day); t:=Copy(s,4,2); SetIText(Handle(edText[MonthRef]),t); newstr[MonthRef]:=t; t:=Copy(s,1,2); SetIText(Handle(edText[DayRef]),t); newstr[DayRef]:=t; NumToString(hour,s); SetIText(Handle(edText[HourRef]),s); newstr[HourRef]:=s; NumToString(minute,s); SetIText(Handle(edText[MinuteRef]),s); newstr[MinuteRef]:=s; NumToString(second,s); SetIText(Handle(edText[SecondRef]),s); newstr[SecondRef]:=s; NumToString(year,s); SetIText(Handle(edText[YearRef]),s); newstr[YearRef]:=s end else for n:=YearRef to SecondRef do begin SetIText(Handle(edText[n]),'0'); newstr[n]:='0'; s:='0' end; SelIText(theDialog,YearRef,0,32767); repeat done := False; OKinput:=True; repeat ModalDialog(nil,itemHit); case itemHit of ok,cancel : done:=True; YearRef..SecondRef :GetIText(Handle(edText[itemHit]), newstr[itemHit]) end; until done; if (itemHit=ok) then begin { Convert the input numbers to the new time } OKInput:=OKInput and OKNumber(newstr[YearRef],0,2047, new[YearRef],theDialog,YearRef); OKInput:=OKInput and OKNumber(newstr[DayRef],1,28, new[DayRef],theDialog,DayRef); OKInput:=OKInput and OKNumber(newstr[HourRef],0,23, new[HourRef],theDialog,HourRef); OKInput:=OKInput and OKNumber(newstr[MinuteRef],0,59, new[MinuteRef],theDialog,MinuteRef); OKInput:=OKInput and OKNumber(newstr[SecondRef],0,59, new[SecondRef],theDialog,SecondRef); if (mode=fix) then case newstr[MonthRef][1] of 'G','g': new[DayRef]:=new[DayRef]+84; 'R','r': new[DayRef]:=new[DayRef]+175; 'B','b': new[DayRef]:=new[DayRef]+266; 'N','n': new[DayRef]:=new[DayRef]+357 otherwise if OKNumber(newstr[MonthRef],1,12,new[MonthRef],theDialog, MonthRef) then new[DayRef]:=new[DayRef]+(new[MonthRef]-1)*28 +((new[MonthRef]-1) div 3)*7 else begin SelIText(theDialog,MonthRef,0,32767); OKinput:=False end end {case} else if OKNumber(newstr[MonthRef],1,52,new[MonthRef],theDialog, MonthRef) then new[DayRef]:=new[DayRef]+7*new[MonthRef] else OKinput:=False; if ((new[DayRef]>364)or(new[DayRef]<0)) then begin SelIText(theDialog,MonthRef,0,32767); OKinput:=False end; if (not(OKinput)) then SysBeep(10) end until OKinput; if (itemHit=ok) then begin if (mode=fix) then with time do begin year:=new[YearRef]; day:=new[DayRef]; hour:=new[HourRef]; minute:=new[MinuteRef]; second:=new[SecondRef] end else begin with interval do begin year:=new[YearRef]; day:=new[DayRef]; hour:=new[HourRef]; minute:=new[MinuteRef]; second:=new[SecondRef] end; AddTime(time,interval) end end; DisposDialog(theDialog); WriteTime end; { proc DoDateDialog } procedure DoDay; { Add a day to the time, and set time to 08:00:00 } var interval:timetype; begin with interval do begin year:=0; day:=1; hour:=0; minute:=0; second:=0 end; with time do begin hour:=8; minute:=0; second:=0 end; AddTime(time,interval); WriteTime end; {proc DoDay} procedure DoTerrainDialog; { Open, process, and close the Terrain dialog box. } { NOTE: for future use in weather generation! } const LatRef = 3; AltRef = 4; PlainRef = 5; ForestRef = 6; JungleRef = 7; HillsRef = 8; MountainsRef = 9; DesertRef = 10; BrokenRef = 11; SwampRef = 12; CoastRef = 13; OceanRef = 14; var theDialog: DialogPtr; itemHit: Integer; theType: Integer; r: Rect; radButton: array [PlainRef..OceanRef] of ControlHandle; edText: array [LatRef..AltRef] of ControlHandle; done,OKinput: Boolean; n: Integer; h: Handle; s: Str255; newstr: array [LatRef..AltRef] of Str255; new: array [LatRef..AltRef] of Longint; SavePort:GrafPtr; theTer:terrainList; begin GetPort(SavePort); theDialog := GetNewDialog(260, nil, Pointer (-1)); SetPort(theDialog); GetDItem(theDialog,ok,theType,h,r); InsetRect(r,-4,-4); PenSize(3,3); FrameRoundRect(r,16,16); PenSize(1,1); SetPort(SavePort); for n := LatRef to AltRef do GetDItem(theDialog,n,theType,Handle(edText[n]),r); for n := PlainRef to OceanRef do GetDItem(theDialog,n,theType,Handle(radButton[n]),r); { Set initial values in text boxes and storage array} with terrain do begin theTer:=ter; new[LatRef]:=lat; new[AltRef]:=alt; NumToString(lat,s); SetIText(Handle(edText[LatRef]),s); newstr[LatRef]:=s; NumToString(alt,s); SetIText(Handle(edText[AltRef]),s); newstr[AltRef]:=s; case ter of plain : SetCtlValue(radButton[PlainRef],1); forest : SetCtlValue(radButton[ForestRef],1); jungle : SetCtlValue(radButton[JungleRef],1); hills : SetCtlValue(radButton[HillsRef],1); mountains : SetCtlValue(radButton[MountainsRef],1); desert : SetCtlValue(radButton[DesertRef],1); broken : SetCtlValue(radButton[BrokenRef],1); swamp : SetCtlValue(radButton[SwampRef],1); coast : SetCtlValue(radButton[CoastRef],1); ocean : SetCtlValue(radButton[OceanRef],1); end {case} end; SelIText(theDialog,LatRef,0,32767); repeat done := False; OKinput:=True; repeat ModalDialog(nil,itemHit); case itemHit of ok,cancel : done:=True; LatRef..AltRef : GetIText(Handle(edText[itemHit]), newstr[itemHit]); PlainRef..OceanRef : begin for n:=PlainRef to OceanRef do SetCtlValue(radButton[n],Ord(n=itemHit)); theTer:=terrainList(itemHit-5) end end {case} until done; if (itemHit=ok) then begin OKInput:=OKInput and OKNumber(newstr[LatRef],-90,90, new[LatRef],theDialog,LatRef); OKInput:=OKInput and OKNumber(newstr[AltRef],-1000,10000, new[AltRef],theDialog,AltRef); if (not(OKinput)) then SysBeep(10) end until OKinput; if (itemHit=ok) then with terrain do begin lat:=new[LatRef]; alt:=new[AltRef]; ter:=theTer end; DisposDialog(theDialog) end; { proc DoTerrainDialog } { ********* items in Cast Menu *********** } procedure DoMU; begin { unimplemented } end; procedure DoIllusionist; begin { unimplemented } end; procedure DoCleric; begin { unimplemented } end; procedure DoDruid; begin { unimplemented } end; { ********* items in Util Menu *********** } procedure DoSecret; { Check for secret doors } const found=' found a secret door!'; lost=' found nothing.'; var i:Integer; display:Str255; SavePort:WindowPtr; begin GetPort(SavePort); SetPort(InfoPtr); ClearWindow(InfoPtr); for i:=1 to NumChars do with party[i] do begin display:=name; case Die(6) of 1 : display:=display+found; 2 : if race[Length(race)-2]='E' then {if an elf or half-elf} display:=display+found else display:=display+lost; 3..6 : display:=display+lost end; {case} MoveTo(5,10*i); DrawString(display) end; SetPort(SavePort) end; procedure DoHear; { Check for hear noise chances } begin { unimplemented } end; procedure DoSaveThrow; { Roll saving throws for the party } begin { unimplemented } end; procedure DoTreasure(var TreasType:str255; var NumMonst,Percent:LongInt); { Generate a random treasure } type TreasureType=record Cu,Ag,El,Au,Pt:LongInt; Gems,Jewelry:Integer end; SmallInt=0..127; var count:Integer; theTreasure:TreasureType; Fract:Real; SavePort:WindowPtr; display:str255; Value:LongInt; procedure BigTreas(CuCh,CuNum,CuDie,AgCh,AgNum,AgDie,ElCh,ElNum,ElDie, AuCh,AuNum,AuDie,PtCh,PtNum,PtDie, GeCh,GeNum,GeDie,JeCh,JeNum,JeDie : SmallInt); begin with theTreasure do begin if (die(100)<=CuCh) then Cu:=Cu+LongInt(1000)*dice(CuNum,CuDie); if (die(100)<=AgCh) then Ag:=Ag+LongInt(1000)*dice(AgNum,AgDie); if (die(100)<=ElCh) then El:=El+LongInt(1000)*dice(ElNum,ElDie); if (die(100)<=AuCh) then Au:=Au+LongInt(1000)*dice(AuNum,AuDie); if (die(100)<=PtCh) then Pt:=Pt+LongInt(100)*dice(PtNum,PtDie); if (die(100)<=GeCh) then Gems:=Gems+dice(GeNum,GeDie); if (die(100)<=JeCh) then Jewelry:=Jewelry+dice(JeNum,JeDie) end end; {proc BigTreas} procedure IndTreas(var Pieces:LongInt; Num,Die:SmallInt); var index:Integer; begin for index:=1 to NumMonst do Pieces:=Pieces+dice(Num,Die) end; {proc IndTreas} begin SetCursor(Watch); with theTreasure do begin Cu:=0; Ag:=0; El:=0; Au:=0; Pt:=0; Gems:=0; Jewelry:=0 end; for count:=1 to Length(TreasType) do case TreasType[count] of 'a','A':BigTreas(25,1,6,30,1,6,35,1,6,40,1,10,25,1,4, 60,4,10,50,3,10); 'b','B':BigTreas(50,1,8,25,1,6,25,1,4,25,1,3,0,0,0, 30,1,8,20,1,4); 'c','C':BigTreas(20,1,12,30,1,6,10,1,4,0,0,0,0,0,0, 25,1,6,20,1,3); 'd','D':BigTreas(10,1,8,15,1,12,15,1,8,50,1,6,0,0,0, 30,1,10,25,1,6); 'e','E':BigTreas(5,1,10,25,1,12,25,1,6,25,1,8,0,0,0, 15,1,12,10,1,8); 'f','F':BigTreas(0,0,0,10,1,20,15,1,12,40,1,10,35,1,8, 20,3,10,10,1,10); 'g','G':BigTreas(0,0,0,0,0,0,0,0,0,50,10,4,50,1,20, 30,5,4,25,1,10); 'h','H':BigTreas(25,5,6,40,1,100,40,10,4,55,10,6,25,5,10, 50,1,100,50,10,4); 'i','I':BigTreas(0,0,0,0,0,0,0,0,0,0,0,0,30,3,6, 55,2,10,50,1,12); 'j','J':IndTreas(theTreasure.Cu,3,8); 'k','K':IndTreas(theTreasure.Ag,3,6); 'l','L':IndTreas(theTreasure.El,2,6); 'm','M':IndTreas(theTreasure.Au,2,4); 'n','N':IndTreas(theTreasure.Pt,1,6); 'o','O':BigTreas(25,1,4,20,1,3,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0); 'p','P':BigTreas(0,0,0,30,1,6,25,1,2,0,0,0,0,0,0, 0,0,0,0,0,0); 'q','Q':BigTreas(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 50,1,4,0,0,0); 'r','R':BigTreas(0,0,0,0,0,0,0,0,0,40,2,4,50,10,6, 55,4,8,45,1,12); 's','S':BigTreas(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0); 't','T':BigTreas(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0); 'u','U':BigTreas(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 90,10,8,80,5,6); 'v','V':BigTreas(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0); 'w','W':BigTreas(0,0,0,0,0,0,0,0,0,60,5,6,15,1,8, 60,10,8,50,5,8); 'x','X':BigTreas(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0); 'y','Y':BigTreas(0,0,0,0,0,0,0,0,0,70,2,12,0,0,0, 0,0,0,0,0,0); 'z','Z':BigTreas(20,1,3,25,1,4,25,1,4,30,1,4,30,1,6, 55,10,6,50,5,6) end; if (Percent<>100) then with theTreasure do begin Fract:=Percent/100; Cu:=Trunc(Cu*Fract); Ag:=Trunc(Ag*Fract); El:=Trunc(El*Fract); Au:=Trunc(Au*Fract); Pt:=Trunc(Pt*Fract); Gems:=Trunc(Gems*Fract); Jewelry:=Trunc(Jewelry*Fract) end; {Write Treasure} with theTreasure do Value:=Trunc(Pt*5+Au+El/10+Ag/20+Cu/200); GetPort(SavePort); SetPort(TreaPtr); ClearWindow(TreaPtr); MoveTo(5,10); display:=Pad(6,theTreasure.Cu,blank)+' Coppers'; DrawString(display); MoveTo(5,20); display:=Pad(6,theTreasure.Ag,blank)+' Silvers'; DrawString(display); MoveTo(5,30); display:=Pad(6,theTreasure.El,blank)+' Electrums'; DrawString(display); MoveTo(5,40); display:=Pad(6,theTreasure.Au,blank)+' Golds'; DrawString(display); MoveTo(5,50); display:=Pad(6,theTreasure.Pt,blank)+' Platinums'; DrawString(display); MoveTo(5,60); display:=Pad(6,theTreasure.Gems,blank)+' Gems'; DrawString(display); MoveTo(5,70); display:=Pad(6,theTreasure.Jewelry,blank)+' Jewellery'; DrawString(display); MoveTo(10,85); display:='Total value'; DrawString(display); MoveTo(10,95); display:=Pad(8,Value,blank)+' gp'; DrawString(display); SetPort(SavePort); SetCursor(Arrow) end; {proc DoTreasure} procedure DoTreasDialog; { Open, process, and close the Treas dialog box. } const TypeRef = 7; NumbRef = 8; PercentRef= 9; var theDialog: DialogPtr; itemHit: Integer; theType: Integer; r: Rect; edText:array [TypeRef..PercentRef] of ControlHandle; done,OKinput: Boolean; n:Integer; h: Handle; newstr:array [TypeRef..PercentRef] of Str255; new:array [NumbRef..PercentRef] of Longint; SavePort:GrafPtr; begin GetPort(SavePort); theDialog := GetNewDialog(258, nil, Pointer (-1)); SetPort(theDialog); GetDItem(theDialog,ok,theType,h,r); InsetRect(r,-4,-4); PenSize(3,3); FrameRoundRect(r,16,16); PenSize(1,1); SetPort(SavePort); for n:=TypeRef to PercentRef do GetDItem(theDialog,n,theType,Handle(edText[n]),r); { Set initial values in storage array} newstr[TypeRef]:=''; newstr[NumbRef]:='1'; newstr[PercentRef]:='100'; repeat done := False; OKinput:=True; repeat ModalDialog(nil,itemHit); case itemHit of ok,cancel : done:=True; TypeRef..PercentRef :GetIText(Handle(edText[itemHit]), newstr[itemHit]) end; until done; if (itemHit=ok) then begin { Convert the input numbers to numerical type } for n:=NumbRef to PercentRef do begin StringToNum(newstr[n],new[n]); if (new[n]<0) then OKinput:=False end; OKInput:=OKInput and OKNumber(newstr[NumbRef],1,1000,new[NumbRef], theDialog,NumbRef); OKInput:=OKInput and OKNumber(newstr[PercentRef],1,1000, new[PercentRef],theDialog,PercentRef); if (newstr[TypeRef]='') then OKinput:=false; if (not(OKinput)) then SysBeep(10) end until OKinput; DisposDialog(theDialog); if (itemHit=ok) then DoTreasure(newstr[TypeRef],new[NumbRef],new[PercentRef]) end; { proc DoTreasDialog } { ********* items in Apple Menu *********** } procedure DoAbout; { bring up 'About...' box using a dialog box } var theItem : Integer; AboutPtr : DialogPtr; h: handle; theType:integer; r:rect; SavePort:GrafPtr; begin GetPort(SavePort); AboutPtr := getNewDialog(AboutID,NIL,Pointer(-1)); SetPort(AboutPtr); GetDItem(AboutPtr,ok,theType,h,r); InsetRect(r,-4,-4); PenSize(3,3); FrameRoundRect(r,16,16); PenSize(1,1); SetPort(SavePort); ModalDialog(NIL,theItem); DisposDialog(AboutPtr); end; { of proc DoAbout } procedure DoDeskAcc(Item : Integer); { start up desk accessory from Apple menu } var SavePort : GrafPtr; RefNum : Integer; DName : String; begin GetPort(SavePort); GetItem(MenuList[AM],Item,DName); refNum := OpenDeskAcc(DName); SetPort(SavePort) end; { of proc DoDeskAcc } { ********* event handling routines *********** } procedure SetItemState(Mndx,Indx : Integer; Flag : Boolean); { if true, enables item Indx of menu Mndx; else disables } begin if Flag then EnableItem (MenuList[Mndx],Indx) else DisableItem(MenuList[Mndx],Indx) end; { of proc SetItemState } procedure HandleMenu(MenuInfo : LongInt); { decode MenuInfo and carry out command } var Menu : Integer; Item : Integer; B : Boolean; begin if MenuInfo <> 0 then begin Menu := HiWord(MenuInfo); Item := LoWord(MenuInfo); case Menu of ApplMenu : if Item = 1 then DoAbout else DoDeskAcc(Item); FileMenu : case Item of 1 : DoNew; 2 : DoOpen; 3 : DoClose; 4 : DoSave; 5 : DoSaveAs; 6 : DoModify; 8 : DoQuit end; EditMenu : case Item of 1,3..6 : if not SystemEdit(Item-1) { pass to desk acc } then { do nothing } end; DiceMenu : case Item of 1 : DoDice(4); 2 : DoDice(6); 3 : DoDice(8); 4 : DoDice(10); 5 : DoDice(12); 6 : DoDice(20); 7 : DoDice(100); 9 : DoOther end; TimeMenu : case Item of 1 : DoTurn; 2 : DoRound; 3 : DoEnd; 5 : DoDay; 7 : DoDateDialog(add); 8 : DoDateDialog(fix); 10 : DoTerrainDialog; end; CastMenu : case Item of 1 : DoMU; 2 : DoIllusionist; 3 : DoCleric; 4 : DoDruid end; UtilMenu : case Item of 1 : DoSecret; 2 : DoHear; 3 : DoSaveThrow; 5 : DoTreasDialog end; CharMenu : case Item of 1 : DoNoChar; 3..12 : DoSelChar(Item-2) end end;{case of Menu} HiliteMenu(0); end end; {of proc HandleMenu} procedure HandleClick(WPtr : WindowPtr; MLoc : Point); { handle mouse click within window } begin if WPtr <> FrontWindow then SelectWindow(WPtr) end; { of proc HandleClick } procedure HandleGoAway(WPtr : WindowPtr; MLoc : Point); { handle mouse click in go-away box } var WPeek : WindowPeek; begin if WPtr = FrontWindow then begin WPeek := WindowPeek(WPtr); if TrackGoAway(WPtr,MLoc) then begin if WPeek^.WindowKind = userKind then DisposeWindow(WPtr) else CloseDeskAcc(WPeek^.WindowKind) end end else SelectWindow(WPtr) end; { of proc HandleGoAway } procedure HandleGrow(WPtr : WindowPtr; MLoc : Point); { handle mouse click in grow box } type GrowRec = record case Integer of 0 : (Result : LongInt); 1 : (Height,Width : Integer) end; var GrowInfo : GrowRec; begin if WPtr = TimePtr then with GrowInfo do begin Result := GrowWindow(WPtr,MLoc,GrowArea); SizeWindow(WPtr,Width,Height,True); InvalRect(WPtr^.portRect) end end; { of proc HandleGrow } procedure DoMouseDown(theEvent:EventRecord); { identify where mouse was clicked and handle it } var Location : Integer; theWindow : WindowPtr; MLoc : Point; WLoc : Integer; begin MLoc := theEvent.Where; WLoc := FindWindow(MLoc,theWindow); case WLoc of InMenuBar : HandleMenu(MenuSelect(MLoc)); InContent : HandleClick(theWindow,MLoc); InGoAway : HandleGoAway(theWindow,MLoc); InGrow : HandleGrow(theWindow,MLoc); InDrag : DragWindow(theWindow,MLoc,DragArea); InSysWindow : SystemClick(theEvent,theWindow) end end; { of proc DoMouseDown } procedure DoKeypress(theEvent : EventRecord); { handles keypress (keyDown, autoKey) event } var KeyCh : Char; begin if (theEvent.modifiers and cmdKey) <> 0 then begin KeyCh := Chr(theEvent.Message and charCodeMask); HandleMenu(MenuKey(KeyCh)) end else SysBeep(1) end; { of proc DoKeypress } procedure DoUpdate(theEvent : EventRecord); { handles window update event } var SavePort,theWindow : WindowPtr; begin theWindow := WindowPtr(theEvent.Message); BeginUpdate(theWindow); if theWindow=TimePtr then begin SetCursor(Watch); WriteTime; SetCursor(Arrow) end; if theWindow=CharPtr then begin SetCursor(Watch); WriteChar; SetCursor(Arrow) end; EndUpdate(theWindow) end; { of proc DoUpdate } procedure DoActivate(theEvent : EventRecord); { handles window activation event } var I : Integer; AFlag : Boolean; theWindow : WindowPtr; begin with theEvent do begin theWindow := WindowPtr(Message); AFlag := Odd(Modifiers); if AFlag then SetPort(theWindow) else SetPort(ScreenPort); if (WindowPeek(theWindow)^.WindowKind=UserKind) then begin SetItemState(EM,1,not AFlag); for I := 3 to 6 do SetItemState(EM,I,not AFlag); SetItemState(FM,0,AFlag); for I := DM to HM do SetItemState(I,0,AFlag); DrawMenuBar end end end; { of proc DoActivate } {$S InitSeg} procedure Initialize; var Indx : Integer; watchHandle : CursHandle; j : Integer; begin InitGraf(@thePort); InitFonts; InitWindows; InitMenus; TEInit; InitDialogs(NIL); FlushEvents(everyEvent,0); watchHandle:=GetCursor(watchCursor); HLock(Handle(watchHandle)); Watch:=watchHandle^^; SetCursor(Watch); MenuList[AM] := GetMenu(ApplMenu); MenuList[FM] := GetMenu(FileMenu); MenuList[EM] := GetMenu(EditMenu); MenuList[DM] := GetMenu(DiceMenu); MenuList[TM] := GetMenu(TimeMenu); MenuList[CM] := GetMenu(CastMenu); MenuList[UM] := GetMenu(UtilMenu); MenuList[HM] := GetMenu(CharMenu); AddResMenu(MenuList[AM],'DRVR'); for Indx := 1 to MenuCnt do InsertMenu(MenuList[Indx],0); DrawMenuBar; GetWMgrPort(ScreenPort); SetPort(ScreenPort); TimePtr := GetNewWindow(TimeID,nil,Pointer(-1)); SetPort(TimePtr); TextFont(monaco); TextSize(9); DicePtr := GetNewWindow(DiceID,nil,Pointer(-1)); SetPort(DicePtr); TextFont(monaco); TextSize(9); TreaPtr := GetNewWindow(TreaID,nil,Pointer(-1)); SetPort(TreaPtr); TextFont(monaco); TextSize(9); CharPtr := GetNewWindow(CharID,nil,Pointer(-1)); SetPort(CharPtr); TextFont(monaco); TextSize(9); InfoPtr := GetNewWindow(InfoID,nil,Pointer(-1)); SetPort(InfoPtr); TextFont(monaco); TextSize(9); ScreenArea := screenBits.Bounds; with ScreenArea do begin SetRect(DragArea,5,25,Right-5,Bottom-10); SetRect(GrowArea,50,20,Right-5,Bottom-10) end; { Random number generator initialisation } glix1:=(ic1+TickCount) mod m1; glix1:=(ia1*glix1+ic1) mod m1; glix2:=glix1 mod m2; glix1:=(ia1*glix1+ic1) mod m1; glix3:=glix1 mod m3; for j:=1 to 97 do begin glix1:=(ia1*glix1+ic1) mod m1; glix2:=(ia2*glix2+ic2) mod m2; glr[j]:=(glix1+glix2*rm2)*rm1 end; { Variable initialisation } with time do begin year:=1; day:=1; hour:=0; minute:=0; second:=0 end; with terrain do begin lat:=40; alt:=0; ter:=plain end; NumChars:=0; DoNoChar; Finished := False; { set program terminator to false } SetCursor(Arrow) end; { of proc Initialize } procedure CleanUp; begin DisposeWindow(TimePtr); { get rid of the windows } DisposeWindow(DicePtr); DisposeWindow(TreaPtr); DisposeWindow(CharPtr); DisposeWindow(InfoPtr) end; { of proc CleanUp } {$S } procedure HandleEvent(theEvent : EventRecord); begin case theEvent.What of mouseDown : DoMouseDown(theEvent); keyDown : DoKeyPress(theEvent); autoKey : DoKeyPress(theEvent); updateEvt : DoUpdate(theEvent); activateEvt : DoActivate(theEvent) end end; { of proc HandleEvent } begin { main body of program AD&D } Initialize; UnloadSeg(@Initialize); repeat SystemTask; if GetNextEvent(everyEvent,theEvent) then HandleEvent(theEvent) until Finished; Cleanup end. { of program AD&D }