-> WoF.e v1.00 by Zebedee/A51 (03-Nov-97) -> An Amiga Workbench game conversion of the TV game "Wheel of Fortune" -> Not yet finished! OPT PREPROCESS ->#define debug MODULE 'gadtools','exec/ports','graphics/text','intuition/intuition', 'intuition/screens','libraries/gadtools','libraries/reqtools', 'reqtools','graphics/rastport' ENUM ERR_NONE,ERR_FONT,ERR_GAD,ERR_KICK,ERR_PUB,ERR_VIS,ERR_WIN RAISE ERR_FONT IF OpenFont()=NIL, ERR_GAD IF CreateGadgetA()=NIL, ERR_KICK IF KickVersion()=FALSE, ERR_PUB IF LockPubScreen()=NIL, ERR_VIS IF GetVisualInfoA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL ENUM GDBT_SPIN,GDBT_BUY,GDBT_SOLVE,GDBT_MT1,GDBT_CLEAR,GDBT_SAVE,GDBT_ENTER, GDBT_CONVERT,GDBT_NEW,GDBT_SHOW,GDBT_MT3,GDBT_ABOUT,GDBT_A,GDBT_B, GDBT_C,GDBT_D,GDBT_E,GDBT_F,GDBT_G,GDBT_H,GDBT_I,GDBT_J,GDBT_K,GDBT_L, GDBT_M,GDBT_N,GDBT_O,GDBT_P,GDBT_Q,GDBT_R,GDBT_S,GDBT_T,GDBT_U,GDBT_V, GDBT_W,GDBT_X,GDBT_Y,GDBT_Z,GDCB_CLUE,GDCB_HIDDEN /***************************************************************************\ ** VARIABLE DEFINITIONS ** \***************************************************************************/ DEF topaz80,mywin=NIL:PTR TO window,wanted=TRUE,my_gads[40]:ARRAY OF LONG, temps[255]:STRING,vi,tempi:PTR TO LONG,hide,clue, puzzlehide[53]:STRING,pl1[13]:STRING,pl2[13]:STRING,pl3[13]:STRING, pl4[13]:STRING,wheel[72]:LIST,puzzlet[255]:STRING,puzzlen[255]:STRING, req:PTR TO rtfilerequester,pl1score=0:PTR TO LONG,pl2score=0:PTR TO LONG, pl3score=0:PTR TO LONG,pl4score=0:PTR TO LONG,pl1total=0:PTR TO LONG, pl2total=0:PTR TO LONG,pl3total=0:PTR TO LONG,pl4total=0:PTR TO LONG, player=1:PTR TO LONG,fs1=0:PTR TO LONG,fs2=0:PTR TO LONG,fs3=0:PTR TO LONG, fs4=0:PTR TO LONG,luck=0:PTR TO LONG,buf[255]:STRING,srcn[255]:STRING, trgn[255]:STRING,src[255]:STRING,trg[255]:STRING,cons=0:PTR TO LONG, a=0:PTR TO LONG,b=0:PTR TO LONG,c=0:PTR TO LONG,d=0:PTR TO LONG, e=0:PTR TO LONG,f=0:PTR TO LONG,g=0:PTR TO LONG,h=0:PTR TO LONG, i=0:PTR TO LONG,j=0:PTR TO LONG,k=0:PTR TO LONG,l=0:PTR TO LONG, m=0:PTR TO LONG,n=0:PTR TO LONG,o=0:PTR TO LONG,p=0:PTR TO LONG, q=0:PTR TO LONG,r=0:PTR TO LONG,s=0:PTR TO LONG,t=0:PTR TO LONG, u=0:PTR TO LONG,v=0:PTR TO LONG,w=0:PTR TO LONG,x=0:PTR TO LONG, y=0:PTR TO LONG,z=0:PTR TO LONG,cluet[28]:STRING,fileptr=NIL, puzzleuse=1:PTR TO LONG,puzzlemax:PTR TO LONG,words:PTR TO LONG, l1[15]:STRING,l2[15]:STRING,l3[15]:STRING,l4[15]:STRING /***************************************************************************\ ** HANDLE GADGET EVENTS ** \***************************************************************************/ PROC handleGadgetEvent(gad:PTR TO gadget,code) DEF id id:=gad.gadgetid StrCopy(temps,gad.specialinfo::stringinfo.buffer) SELECT id CASE GDBT_SPIN;spinWheel() CASE GDBT_BUY;showMessage('Please select a VOWEL') CASE GDBT_SOLVE;StrCopy(temps,getString('So you think you know what it is, eh?','_Ok','',50)) CASE GDBT_CLEAR tempi:=rtRequest('Clear...','Please select','_Totals|_Scores|_Cancel',0) IF tempi=1 pl1total:=0 pl2total:=0 pl3total:=0 pl4total:=0 ENDIF IF tempi=2 pl1score:=0 pl2score:=0 pl3score:=0 pl4score:=0 ENDIF CASE GDBT_SAVE;letterBox(22,35) CASE GDBT_NEW; IF rtRequest('New Puzzle...','Use a new puzzle file?','_Yes|_No',0)=1 StrCopy(puzzlen,requestFile('Select puzzle file...','#?.wof')) ENDIF CASE GDBT_SHOW; IF rtRequest('Show Answer...','Show the answer\nand use the next?','_Yes|_No',0,TRUE)=1 getNextPuzzle(FALSE) showPuzzle() ENDIF CASE GDBT_ENTER tempi:=rtRequest('Enter Names...','Please select player','_1|_2|_3|_4|_Cancel',0) SELECT tempi CASE 1 StrCopy(pl1,getString('Enter your name player 1','_Ok',pl1,13)) CASE 2;StrCopy(pl2,getString('Enter your name player 2','_Ok',pl2,13)) CASE 3;StrCopy(pl3,getString('Enter your name player 3','_Ok',pl3,13)) CASE 4;StrCopy(pl4,getString('Enter your name player 4','_Ok',pl4,13)) ENDSELECT updatePlayerInfo(tempi) showCurrentPlayer(player) CASE GDBT_CONVERT;askConvertFile() #ifdef debug CASE GDBT_MT3 StringF(temps,'player=\d\nListLen(wheel)=\d\npuzzlen="\s"\npuzzlet="\s"\n' + 'cluet="\s"\nclue=\d\nfreespins=\d, \d, \d, \d',player,ListLen(wheel),puzzlen,puzzlet,cluet,clue,fs1,fs2,fs3,fs4) rtRequest('Debug Info...',temps,'_Ok',0) #endif CASE GDBT_ABOUT rtRequest('About...','Wheel of Fortune v1.00\n' + 'By Zebedee/Area 51 (03-Nov-97)\n\n' + '©1997 An Area 51 Production\n\n' + 'Based on the AmigaBASIC\n' + 'version by Hari Wiguna, USA','_Ok',0,TRUE) CASE GDCB_CLUE;clue:=code=1 ENDSELECT ENDPROC /***************************************************************************\ ** HANDLE VANILLA KEYBOARD INPUT ** \***************************************************************************/ PROC handleVanillaKey(code) SELECT "w" OF code CASE "q","Q";wanted:=FALSE ENDSELECT ENDPROC /***************************************************************************\ ** CREATE THE GADGETS ** \***************************************************************************/ PROC createAllGadgets(glistptr:PTR TO LONG) DEF gad,ng:PTR TO newgadget gad:=CreateContext(glistptr) ng:=[260,15,107,12,'Spin',topaz80,GDBT_SPIN,NIL,vi,0]:newgadget my_gads[GDBT_SPIN]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 28 ng.gadgettext := 'Buy a Vowel' ng.gadgetid := GDBT_BUY my_gads[GDBT_BUY]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 41 ng.gadgettext := 'Solve Puzzle' ng.gadgetid := GDBT_SOLVE my_gads[GDBT_SOLVE]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 54 ng.gadgettext := '' ng.gadgetid := GDBT_MT1 my_gads[GDBT_MT1]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 67 ng.gadgettext := 'Clear' ng.gadgetid := GDBT_CLEAR my_gads[GDBT_CLEAR]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 80 ng.gadgettext := 'Save Prefs' ng.gadgetid := GDBT_SAVE my_gads[GDBT_SAVE]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.leftedge := 371 ng.topedge := 15 ng.gadgettext := 'Enter Names' ng.gadgetid := GDBT_ENTER my_gads[GDBT_ENTER]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 28 ng.gadgettext := 'Conv. Puzzle' ng.gadgetid := GDBT_CONVERT my_gads[GDBT_CONVERT]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 41 ng.gadgettext := 'New Puzzle' ng.gadgetid := GDBT_NEW my_gads[GDBT_NEW]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 54 ng.gadgettext := 'Show Answer' ng.gadgetid := GDBT_SHOW my_gads[GDBT_SHOW]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 67 ng.gadgettext := '' #ifdef debug ng.gadgettext := 'Debug' #endif ng.gadgetid := GDBT_MT3 my_gads[GDBT_MT3]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.topedge := 80 ng.gadgettext := 'About' ng.gadgetid := GDBT_ABOUT my_gads[GDBT_ABOUT]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng.leftedge := 12 ng.topedge := 98 ng.width := 16 ng.height := 11 ng.gadgettext := 'A' ng.gadgetid := GDBT_A my_gads[GDBT_A]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 30 ng.gadgettext := 'B' ng.gadgetid := GDBT_B my_gads[GDBT_B]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 48 ng.gadgettext := 'C' ng.gadgetid := GDBT_C my_gads[GDBT_C]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 66 ng.gadgettext := 'D' ng.gadgetid := GDBT_D my_gads[GDBT_D]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 84 ng.gadgettext := 'E' ng.gadgetid := GDBT_E my_gads[GDBT_E]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 102 ng.gadgettext := 'F' ng.gadgetid := GDBT_F my_gads[GDBT_F]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 120 ng.gadgettext := 'G' ng.gadgetid := GDBT_G my_gads[GDBT_G]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 138 ng.gadgettext := 'H' ng.gadgetid := GDBT_H my_gads[GDBT_H]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 156 ng.gadgettext := 'I' ng.gadgetid := GDBT_I my_gads[GDBT_I]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 174 ng.gadgettext := 'J' ng.gadgetid := GDBT_J my_gads[GDBT_J]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 192 ng.gadgettext := 'K' ng.gadgetid := GDBT_K my_gads[GDBT_K]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 210 ng.gadgettext := 'L' ng.gadgetid := GDBT_L my_gads[GDBT_L]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 228 ng.gadgettext := 'M' ng.gadgetid := GDBT_M my_gads[GDBT_M]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 246 ng.gadgettext := 'N' ng.gadgetid := GDBT_N my_gads[GDBT_N]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 264 ng.gadgettext := 'O' ng.gadgetid := GDBT_O my_gads[GDBT_O]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 282 ng.gadgettext := 'P' ng.gadgetid := GDBT_P my_gads[GDBT_P]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 300 ng.gadgettext := 'Q' ng.gadgetid := GDBT_Q my_gads[GDBT_Q]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 318 ng.gadgettext := 'R' ng.gadgetid := GDBT_R my_gads[GDBT_R]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 336 ng.gadgettext := 'S' ng.gadgetid := GDBT_S my_gads[GDBT_S]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 354 ng.gadgettext := 'T' ng.gadgetid := GDBT_T my_gads[GDBT_T]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 372 ng.gadgettext := 'U' ng.gadgetid := GDBT_U my_gads[GDBT_U]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 390 ng.gadgettext := 'V' ng.gadgetid := GDBT_V my_gads[GDBT_V]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 408 ng.gadgettext := 'W' ng.gadgetid := GDBT_W my_gads[GDBT_W]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 426 ng.gadgettext := 'X' ng.gadgetid := GDBT_X my_gads[GDBT_X]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 444 ng.gadgettext := 'Y' ng.gadgetid := GDBT_Y my_gads[GDBT_Y]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 462 ng.gadgettext := 'Z' ng.gadgetid := GDBT_Z my_gads[GDBT_Z]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[NIL])) ng.leftedge := 354 ng.topedge := 130 ng.gadgettext := 'Clue' ng.gadgetid := GDCB_CLUE ng.flags := 2 my_gads[GDCB_CLUE]:=(gad:=CreateGadgetA(CHECKBOX_KIND,gad,ng, [GTCB_CHECKED,clue, GT_UNDERSCORE,"_",NIL])) ng.topedge := 142 ng.gadgettext := 'Show hidden' ng.gadgetid := GDCB_HIDDEN my_gads[GDCB_HIDDEN]:=(gad:=CreateGadgetA(CHECKBOX_KIND,gad,ng, [GTCB_CHECKED,hide, GT_UNDERSCORE,"_",NIL])) ENDPROC gad /***************************************************************************\ ** PROCESS THE WINDOW EVENTS ** \***************************************************************************/ PROC processWindowEvents() DEF imsg:PTR TO intuimessage,imsgClass,imsgCode,gad WHILE wanted Wait(Shl(1,mywin.userport.sigbit)) WHILE wanted AND (imsg:=Gt_GetIMsg(mywin.userport)) gad:=imsg.iaddress imsgClass:=imsg.class imsgCode:=imsg.code Gt_ReplyIMsg(imsg) SELECT imsgClass CASE IDCMP_GADGETDOWN; handleGadgetEvent(gad,imsgCode) CASE IDCMP_MOUSEMOVE; handleGadgetEvent(gad,imsgCode) CASE IDCMP_GADGETUP; handleGadgetEvent(gad,imsgCode) CASE IDCMP_VANILLAKEY; handleVanillaKey(imsgCode) CASE IDCMP_CLOSEWINDOW;IF rtRequest('Quit WOF...','Are you sure?','_Yes|_NO!',0,TRUE)=1 THEN wanted:=FALSE CASE IDCMP_REFRESHWINDOW Gt_BeginRefresh(mywin) Gt_EndRefresh(mywin,TRUE) ENDSELECT ENDWHILE ENDWHILE ENDPROC /***************************************************************************\ ** OPEN THE WINDOW ** \***************************************************************************/ PROC gadtoolsWindow() HANDLE DEF font=NIL,mysc=NIL:PTR TO screen,glist=NIL topaz80:=['topaz.font',8,0,0]:textattr font:=OpenFont(topaz80) mysc:=LockPubScreen(NIL) IF mysc.height=512 THEN rtRequest('Notice...', 'Because you''ve got interlace on, you may\n' + 'find the window a tad difficult to read!','_Sorry!',0,TRUE) vi:=GetVisualInfoA(mysc,[NIL]) createAllGadgets({glist}) mywin:=OpenWindowTagList(NIL, [WA_TITLE,'Wheel of Fortune', WA_SCREENTITLE,'Written by Zebedee/A51, based on the AmigaBASIC version by Hari Wiguna', WA_GADGETS, glist, WA_RMBTRAP, TRUE, WA_LEFT, (mysc.width/2)-245, WA_TOP, (mysc.height/2)-87, WA_WIDTH, 490, WA_HEIGHT, 174, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_ACTIVATE, TRUE, WA_CLOSEGADGET, TRUE, WA_SIZEGADGET, FALSE, WA_SMARTREFRESH,TRUE, WA_SIZEBRIGHT, FALSE, WA_SIZEBBOTTOM, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_REFRESHWINDOW OR IDCMP_VANILLAKEY OR SLIDERIDCMP OR STRINGIDCMP OR BUTTONIDCMP, WA_PUBSCREEN,mysc,NIL]) Gt_RefreshWindow(mywin,NIL) bevelBox(8,13,241,81,FALSE) -> Clue & puzzle bevelBox(12,15,233,12,TRUE) -> Clue bevelBox(12,28,233,64,TRUE) -> Puzzle bevelBox(256,13,226,81,FALSE) -> Gadgets bevelBox(8,96,474,15,FALSE) -> A-Z bevelBox(8,113,314,44,FALSE) -> Player info bevelBox(326,113,18,44,FALSE) -> Countdown bar bevelBox(348,113,134,11,FALSE) -> Prize bevelBox(348,126,134,31,FALSE) -> Preferences bevelBox(8,159,474,11,FALSE) -> Message box printText(1,13,115,' Total Score Free Player''s Name',1) FOR tempi:=1 TO 4 updatePlayerInfo(tempi) ENDFOR showCurrentPlayer(player) gadgetState(GDBT_MT1,FALSE) #ifndef debug gadgetState(GDBT_MT3,FALSE) #endif gadgetState(GDCB_HIDDEN,FALSE) showClue(cluet) clearPuzzle() showPuzzle() showPrize('BANKRUPT') showMessage('YOU CAN SPIN, BUY A VOWEL, OR SOLVE THE PUZZLE') StrCopy(temps,'Wheel:') StrAdd(temps,puzzlen) processWindowEvents() EXCEPT DO IF fileptr THEN Close(fileptr) IF mywin THEN CloseWindow(mywin) FreeGadgets(glist) IF vi THEN FreeVisualInfo(vi) IF mysc THEN UnlockPubScreen(mysc,NIL) IF font THEN CloseFont(font) ReThrow() ENDPROC PROC updatePlayerInfo(pl) DEF ypos:PTR TO LONG,fs:PTR TO LONG,total:PTR TO LONG,score:PTR TO LONG SELECT pl CASE 1;ypos:=124;StrCopy(temps,pl1);fs:=fs1;total:=pl1total;score:=pl1score CASE 2;ypos:=132;StrCopy(temps,pl2);fs:=fs2;total:=pl2total;score:=pl2score CASE 3;ypos:=140;StrCopy(temps,pl3);fs:=fs3;total:=pl3total;score:=pl3score CASE 4;ypos:=148;StrCopy(temps,pl4);fs:=fs4;total:=pl4total;score:=pl4score ENDSELECT StringF(temps,'£\d[6] £\d[6] \d[2] \s',total,score,fs,temps) printText(0,213,ypos,'XXXXXXXXXXXXX') -> Clear the player's name place first printText(1,13,ypos,temps) ENDPROC PROC showCurrentPlayer(pl) SELECT pl CASE 1;printText(2,205,124,'>');printText(0,205,148,' ') CASE 2;printText(2,205,132,'>');printText(0,205,124,' ') CASE 3;printText(2,205,140,'>');printText(0,205,132,' ') CASE 4;printText(2,205,148,'>');printText(0,205,140,' ') ENDSELECT ENDPROC PROC showFreeSpins(pl) SELECT pl CASE 1;StringF(temps,'\d[2]',fs1);printText(1,173,124,temps) CASE 2;StringF(temps,'\d[2]',fs2);printText(1,173,132,temps) CASE 3;StringF(temps,'\d[2]',fs3);printText(1,173,140,temps) CASE 4;StringF(temps,'\d[2]',fs4);printText(1,173,148,temps) ENDSELECT ENDPROC /***************************************************************************\ ** DRAW A BEVEL BOX ** \***************************************************************************/ PROC bevelBox(x,y,w,h,recessed=FALSE,frame=BBFT_BUTTON) IF recessed DrawBevelBoxA(mywin.rport,x,y,w,h,[GT_VISUALINFO,vi,GTBB_RECESSED,TRUE,GTBB_FRAMETYPE,frame,NIL]) ELSE DrawBevelBoxA(mywin.rport,x,y,w,h,[GT_VISUALINFO,vi,GTBB_FRAMETYPE,frame,NIL]) ENDIF ENDPROC /***************************************************************************\ ** ENABLE AND DISABLE A GADGET ** \***************************************************************************/ PROC gadgetState(gad_id,enable) IF enable THEN OnGadget(my_gads[gad_id],mywin,NIL) ELSE OffGadget(my_gads[gad_id],mywin,NIL) ENDPROC /***************************************************************************\ ** OPEN A REQTOOLS REQUESTER TO SHOW INFO & ASK QUESTIONS ** \***************************************************************************/ PROC rtRequest(title,body,buttons,default,centre=FALSE) IF centre tempi:=RtEZRequestA(body,buttons,0,0,[RTEZ_REQTITLE,title,RT_UNDERSCORE,"_",RTEZ_FLAGS,EZREQF_CENTERTEXT,RTEZ_DEFAULTRESPONSE,default,NIL]) ELSE tempi:=RtEZRequestA(body,buttons,0,0,[RTEZ_REQTITLE,title,RT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,default,NIL]) ENDIF ENDPROC tempi /***************************************************************************\ ** CENTRE THE TEXT IN THE CLUE/PRIZE/MESSAGE BOX ** \***************************************************************************/ PROC showClue(txt) printText(0,16,17,'XXXXXXX Clue is Off XXXXXXXX') printText(1,128-(StrLen(txt)*4),17,txt) ENDPROC PROC showPrize(txt) printText(0,351,115,'XXX BANKRUPT XXX') printText(1,415-(StrLen(txt)*4),115,txt) ENDPROC PROC showMessage(txt) printText(0,13,161,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX') printText(1,245-(StrLen(txt)*4),161,txt) ENDPROC PROC clearPuzzle() SetAPen(mywin.rport,0) FOR tempi:=29 TO 90 Move(mywin.rport,14,tempi) Draw(mywin.rport,242,tempi) ENDFOR ENDPROC PROC showPuzzle() DEF chr[1]:STRING,wordlen[20]:ARRAY OF LONG,chrcount:PTR TO LONG, last=0:PTR TO LONG,line=1:PTR TO LONG,la,lb,lc,ld a:=0;b:=0;c:=0;d:=0;e:=0;f:=0;g:=0;h:=0;i:=0;j:=0;k:=0;l:=0;m:=0 n:=0;o:=0;p:=0;q:=0;r:=0;s:=0;t:=0;u:=0;v:=0;w:=0;x:=0;y:=0;z:=0;cons:=0 clearPuzzle() printText(2,52,17,'! CREATING PUZZLE !',2) printText(2,72,53,'Please wait...',4) IF clue THEN showClue(cluet) StrCopy(puzzlehide,'') words:=1 chrcount:=-1 FOR tempi:=0 TO StrLen(puzzlet) MidStr(chr,puzzlet,tempi,1) INC chrcount IF StrCmp(chr,' ',1) wordlen[words]:=chrcount chrcount:=-1 INC words ENDIF IF (Char(chr)>=65) AND (Char(chr)<=90) THEN StrAdd(puzzlehide,'*') ELSE StrAdd(puzzlehide,chr) ENDFOR last:=0 FOR tempi:=1 TO words-1 last:=last+wordlen[tempi] ENDFOR wordlen[words]:=StrLen(puzzlet)-(words-1)-last #ifdef debug WriteF('==========showPuzzle()==========\n') WriteF('WORD:\s\nHIDE:\s\n',puzzlet,puzzlehide) FOR tempi:=1 TO words WriteF('word[\d]:=\d\n',tempi,wordlen[tempi]) ENDFOR WriteF('==============END===============\n') #endif /**TRY AND FIT THE PUZZLE IN THE CAPTION BOX**/ StrCopy(l1,'');StrCopy(l2,'');StrCopy(l3,'');StrCopy(l4,'') line:=1 la:=0 boxLetters(puzzlehide,35) #ifdef shareware WriteF('Chars on line 1: \d\n',la) #endif ENDPROC PROC boxLetters(text,ypos) DEF chr[1]:STRING,xpos:PTR TO LONG clearPuzzle() -> 128-(StrLen(txt)*4) xpos:=128-((StrLen(puzzlehide)*14)/2) FOR tempi:=0 TO StrLen(puzzlehide) MidStr(chr,text,tempi,1) IF StrCmp(chr,'*') THEN letterBox(xpos,ypos) xpos:=xpos+14 ENDFOR ENDPROC PROC letterBox(x,y) bevelBox(x,y,14,11,TRUE) SetAPen(mywin.rport,1) Move(mywin.rport,x+3,y+8) Text(mywin.rport,'*',1) ENDPROC /***************************************************************************\ ** PRINT INTUITEXT IN THE WINDOW ** \***************************************************************************/ PROC printText(pen,x,y,text,style=0) PrintIText(mywin.rport,[pen,0,RP_JAM2,0,0,['topaz.font',8,style,0]:textattr,text,NIL]:intuitext,x,y) ENDPROC /***************************************************************************\ ** OPEN A BASIC REQUESTER VIA INTUITION TO REPORT PROGRAM ERRORS ** \***************************************************************************/ PROC fatalError(text) EasyRequestArgs(0,[SIZEOF easystruct,0,'Error...',text,'Ok']:easystruct,0,0) ENDPROC /***************************************************************************\ ** LOAD THE PREFS FILE ** \***************************************************************************/ PROC loadPrefs() DEF fptr,buffer[32]:STRING IF fptr:=Open('S:WheelOfFortune.prefs',OLDFILE) Read(fptr,buffer,4) IF StrCmp(buffer,'WoFP',4) Read(fptr,buffer,4) IF StrCmp(buffer,'0100',4) Read(fptr,buffer,13) StrCopy(pl1,buffer) Read(fptr,buffer,6) pl1total:=Val(buffer,NIL) Read(fptr,buffer,13) StrCopy(pl2,buffer) Read(fptr,buffer,6) pl2total:=Val(buffer,NIL) Read(fptr,buffer,13) StrCopy(pl3,buffer) Read(fptr,buffer,6) pl3total:=Val(buffer,NIL) Read(fptr,buffer,13) StrCopy(pl4,buffer) Read(fptr,buffer,6) pl4total:=Val(buffer,NIL) Read(fptr,buffer,32) StrCopy(puzzlen,buffer) Read(fptr,buffer,6) -> RESERVED!!! Read(fptr,buffer,6) puzzleuse:=Val(buffer,NIL) Read(fptr,buffer,1) IF StrCmp(buffer,'1',1) THEN clue:=TRUE ELSE clue:=FALSE Read(fptr,buffer,1) IF StrCmp(buffer,'1',1) THEN hide:=TRUE ELSE hide:=FALSE Read(fptr,buffer,1) player:=Val(buffer,NIL) ELSE rtRequest('Error...','Invalid prefs file!\nUsing default settings!','_Ok',0,TRUE) initDefaultVars() ENDIF ELSE rtRequest('Error...','Not a Wheel of Fortune prefs file!\nUsing default settings!','_Ok',0,TRUE) ENDIF Close(fptr) ELSE rtRequest('Error...','Unable to load prefs file!\nUsing default settings!','_Ok',0,TRUE) initDefaultVars() ENDIF ENDPROC PROC initDefaultVars() StrCopy(pl1,'Zebedee') StrCopy(pl2,'Liz') StrCopy(pl3,'-') StrCopy(pl4,'-') pl1score:=0;pl2score:=0;pl3score:=0;pl4score:=0 -> Clear scores pl1total:=0;pl2total:=0;pl3total:=0;pl4total:=0 -> Clear totals fs1:=0;fs2:=0;fs3:=0;fs4:=0 -> Clear free spins player:=0 StrCopy(puzzlen,'WHEEL:Wheel.wof') StrCopy(puzzlet,'Snow White and the Seven Drawfs') ENDPROC PROC getString(txt,buttons,use,len) DEF text[255]:STRING StrCopy(text,use) IF req:=RtAllocRequestA(RT_REQINFO,NIL) RtGetStringA(text,len,NIL,req,[RTGS_GADFMT,buttons,RTGS_TEXTFMT,txt,RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_UNDERSCORE,"_",NIL]) RtFreeRequest(req) ELSE rtRequest('Error...','Unable to open requester!','_Ok',0) ENDIF ENDPROC text PROC spinWheel() DEF rand:PTR TO LONG,value:PTR TO LONG showMessage('The wheel is spinning...') rand:=Rnd(40)+1 #ifdef debug rand:=5 #endif SetAPen(mywin.rport,1) FOR tempi:=154 TO 115+(40-rand) STEP -1 Move(mywin.rport,330,tempi) Draw(mywin.rport,339,tempi) ENDFOR SetAPen(mywin.rport,0) FOR tempi:=115+(40-rand) TO 154 Delay(2) INC luck IF luck=ListLen(wheel) THEN luck:=0 value:=ListItem(wheel,luck) SELECT value CASE -4;StrCopy(temps,'Prize') CASE -3;StrCopy(temps,'Bankrupt') CASE -2;StrCopy(temps,'Lose a Turn') CASE -1;StrCopy(temps,'Free Spin') DEFAULT StringF(temps,'\d',value) ENDSELECT showPrize(temps) Move(mywin.rport,330,tempi) Draw(mywin.rport,339,tempi) ENDFOR IF value>0 THEN addScore(player,value) IF value=-4 THEN winPrize() IF (value=-2) OR (value=-3) IF value=-3 THEN clearScore(player) SELECT player CASE 1;IF fs1>0 THEN askUseFreeSpin(player,fs1) ELSE nextPlayer() CASE 2;IF fs2>0 THEN askUseFreeSpin(player,fs2) ELSE nextPlayer() CASE 3;IF fs3>0 THEN askUseFreeSpin(player,fs3) ELSE nextPlayer() CASE 4;IF fs4>0 THEN askUseFreeSpin(player,fs4) ELSE nextPlayer() ENDSELECT ENDIF IF value=-1 THEN addFreeSpin(player) showMessage('Please select a CONSONANT') ENDPROC PROC addScore(pl,sc) SELECT pl CASE 1;pl1score:=pl1score+sc CASE 2;pl2score:=pl2score+sc CASE 3;pl3score:=pl3score+sc CASE 4;pl4score:=pl4score+sc ENDSELECT updatePlayerInfo(pl) showCurrentPlayer(pl) ENDPROC PROC askUseFreeSpin(pl,fs) DEF opt:PTR TO LONG StringF(temps,'You have \d free spin\s!\nDo you want to use \s?',fs,IF fs>1 THEN 's' ELSE '',IF fs>1 THEN 'one' ELSE 'it') opt:=rtRequest('Request...',temps,'_Yes|_No',0,TRUE) IF opt=1 THEN subFreeSpin(pl) ELSE nextPlayer() ENDPROC opt PROC winPrize() tempi:=Rnd(5) SELECT tempi CASE 0;StrCopy(temps,'You win a cuddly toy!') CASE 1;StrCopy(temps,'You win a two week\nholiday to Blackpool') CASE 2;StrCopy(temps,'You win a bucket of fresh vomit!') CASE 3;StrCopy(temps,'You win a selection\nof porn films') CASE 4;StrCopy(temps,'You win Clare Danes\nfor a weekend') ENDSELECT rtRequest('Congratulations!',temps,'_Ok',0,TRUE) ENDPROC PROC nextPlayer() INC player IF player>4 THEN player:=1 showCurrentPlayer(player) ENDPROC PROC addFreeSpin(pl) SELECT pl CASE 1;INC fs1;showFreeSpins(player) CASE 2;INC fs2;showFreeSpins(player) CASE 3;INC fs3;showFreeSpins(player) CASE 4;INC fs4;showFreeSpins(player) ENDSELECT ENDPROC PROC subFreeSpin(pl) SELECT pl CASE 1;DEC fs1;showFreeSpins(player) CASE 2;DEC fs2;showFreeSpins(player) CASE 3;DEC fs3;showFreeSpins(player) CASE 4;DEC fs4;showFreeSpins(player) ENDSELECT ENDPROC PROC clearScore(pl) SELECT pl CASE 1;pl1score:=0;printText(1,93,124,'£ 0');printText(2,205,124,'>');printText(0,205,148,' ') CASE 2;pl2score:=0;printText(1,93,132,'£ 0');printText(2,205,132,'>');printText(0,205,124,' ') CASE 3;pl3score:=0;printText(1,93,140,'£ 0');printText(2,205,140,'>');printText(0,205,132,' ') CASE 4;pl4score:=0;printText(1,93,148,'£ 0');printText(2,205,148,'>');printText(0,205,140,' ') ENDSELECT ENDPROC PROC askConvertFile() IF rtRequest('Convert...','Are you sure?','_Yes|_No',0)=1 StrCopy(srcn,requestFile('Select text file...','#?.txt')) StrCopy(trgn,requestFile('Select puzzle file...','#?.wof')) StrCopy(src,'Wheel:');StrAdd(src,srcn) StrCopy(trg,'Wheel:');StrAdd(trg,trgn) IF StrCmp(srcn,trgn,ALL) AND (StrLen(srcn)>0) rtRequest('Error...','Both files can''t\nbe the same!','_Ok',0,TRUE) ELSE StringF(temps,'\n** WARNING **\nFile "\s" already exists!\n',trgn) StringF(temps,'Convert text file "\s"\ninto puzzle file "\s"?\n\s\nAre you sure?',srcn,trgn,IF FileLength(trg)>=0 THEN temps ELSE '') IF (StrLen(srcn)>0) AND (StrLen(trgn)>0) IF rtRequest('Convert...',temps,'_Yes|_No',0,TRUE)=1 THEN convertFile() ELSE rtRequest('Convert...','User abort','_Ok',0) ENDIF ENDIF ENDIF ENDPROC PROC convertFile() DEF srcf=NIL,trgf=NIL,lines=0:PTR TO LONG,oldout,line:PTR TO LONG, bad=0:PTR TO LONG,bar:PTR TO LONG,qt[53]:STRING,ct[26]:STRING srcf:=Open(src,OLDFILE) IF src=NIL StringF(temps,'Unable to open "\s"\nto convert',srcn) rtRequest('Error...',temps,'_Ok',0,TRUE) ELSE trgf:=Open(trg,NEWFILE) IF trgf=NIL StringF(temps,'Unable to create puzzle\nfile "\s"',trgn) rtRequest('Error...',temps,'_Ok',0,TRUE) ELSE showMessage('Counting lines in text file...') oldout:=SetStdOut(trgf) WHILE ReadStr(srcf,temps)=0 bar:=InStr(temps,'|',0) IF (bar<0) OR (bar>53) OR (StrLen(temps)-bar>26) THEN INC bad INC lines ENDWHILE Seek(srcf,0,-1) WriteF('WoFD\z\d[4]',lines-bad) showMessage('Converting text file to puzzle file...') bad:=0 FOR line:=1 TO lines ReadStr(srcf,temps) bar:=InStr(temps,'|',0) IF bar>-1 MidStr(qt,temps,0,bar);UpperStr(qt) IF bar>53 INC bad StringF(buf,'Question in line \d too long',line) rtRequest('Convert...',buf,'_Ok',0,TRUE) ELSE MidStr(ct,temps,bar+1,StrLen(temps)-bar);UpperStr(ct) IF StrLen(temps)-bar>26 INC bad StringF(buf,'Clue in line \d too long',line) rtRequest('Convert...',buf,'_Ok',0,TRUE) ELSE WriteF('\s[53]\s[26]',qt,ct) showClue(ct) ENDIF ENDIF ELSE INC bad StringF(temps,'Missing "|" in line \d',line) rtRequest('Convert...',temps,'_Ok',0) ENDIF ENDFOR Close(srcf) Close(trgf) trgf:=SetStdOut(oldout) ENDIF ENDIF showClue(' ') IF bad=0 StringF(temps,'Converted \d lines',lines) ELSE StringF(temps,'Converted \d of \d lines',lines-bad,lines) ENDIF rtRequest('Convert...',temps,'_Ok',0) ENDPROC /***************************************************************************\ ** OPEN THE FILE REQUESTER ** \***************************************************************************/ PROC requestFile(txt,pat) IF req:=RtAllocRequestA(RT_FILEREQ,NIL) RtChangeReqAttrA(req,[RTFI_DIR,'Wheel:',RTFI_MATCHPAT,pat]) buf[0]:=0 RtFileRequestA(req,buf,txt,[RTFI_OKTEXT,'Ok']) ELSE rtRequest('Error...','Unable to open file requester','_Ok',0) ENDIF ENDPROC buf PROC createPuzzleFile() DEF fptr=NIL,ok=FALSE fptr:=Open('Wheel:Wheel.wof',NEWFILE) IF fptr=NIL rtRequest('Error...','Unable to create file','_Ok',0) ELSE Write(fptr,'WoFD0003',8) Write(fptr,' SHEENA EASTON PERSON YELLOW STONE NATIONAL PARK PLACE YOGI BEAR FICTIONAL CHARACTER',237) Close(fptr) ok:=TRUE ENDIF ENDPROC ok PROC getNextPuzzle(firsttime) IF firsttime Read(fileptr,buf,4) Read(fileptr,buf,4) puzzlemax:=Val(buf,NIL) FOR tempi:=1 TO puzzleuse Read(fileptr,puzzlet,53) Read(fileptr,cluet,26) ENDFOR ELSE INC puzzleuse IF puzzleuse>puzzlemax Seek(fileptr,0,-1) Read(fileptr,buf,8) puzzleuse:=1 ENDIF Read(fileptr,puzzlet,53) Read(fileptr,cluet,26) ENDIF StrCopy(puzzlet,extractText(puzzlet)) StrCopy(cluet,extractText(cluet)) IF Not(firsttime) THEN showClue(cluet) ENDPROC PROC extractText(text) DEF dummy[1]:STRING,position=0:PTR TO LONG FOR tempi:=0 TO StrLen(text) MidStr(dummy,text,tempi,1) IF Not(StrCmp(dummy,' ',1)) position:=tempi tempi:=StrLen(text) ENDIF ENDFOR MidStr(temps,text,position,StrLen(text)-position) ENDPROC temps /***************************************************************************\ ** THE MAIN PROGRAM ** \***************************************************************************/ PROC main() HANDLE KickVersion(37) tempi:=Rnd(-32767) ListCopy(wheel,[1000,500,400,300,2000,-3,700,200,150,450,-2,200,400,250, -> 14 150,400,600,250,350,-1,750,800,300,200,-1,900,300,250,900,200,400,-> 17 550,1000,200,600,-1,200,550,400,900,250,-4,700,800,300,-2,200,700,-> 17 -1,-1,-2,-3,150,900,300,250,900,200,400,550,1000,200,600,200,550, -> 17 400,900,700,800,300,2000,700]) -> 7 IF gadtoolsbase:=OpenLibrary('gadtools.library',37) IF reqtoolsbase:=OpenLibrary('reqtools.library',37) loadPrefs() StrCopy(src,'Wheel:') StrAdd(src,puzzlen) IF (fileptr:=Open(src,OLDFILE))=NIL StringF(temps,'Unable to open puzzle file\n"\s"\n\nDo you want me to create it?',puzzlen) IF rtRequest('Error...',temps,'_Yes|_No',1,TRUE)=1 IF createPuzzleFile() fileptr:=Open(src,OLDFILE) IF fileptr=NIL rtRequest('Fatal error...','I still can''t open it!','_Ok',0) ELSE getNextPuzzle(TRUE) gadtoolsWindow() ENDIF ENDIF ENDIF ELSE getNextPuzzle(TRUE) gadtoolsWindow() ENDIF ELSE fatalError('Unable to open reqtools.library v37') ENDIF ELSE fatalError('Unable to open gadtools.library v37') ENDIF EXCEPT DO IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) SELECT exception CASE ERR_FONT; fatalError('Unable to open topaz.font 8') CASE ERR_GAD; fatalError('Unable to create all gadgets') CASE ERR_KICK; WriteF('ERROR: Requires Kickstart v37\n') CASE ERR_PUB; fatalError('Unable to lock default public screen') CASE ERR_VIS; fatalError('Unable to get visual info') CASE ERR_WIN; fatalError('Unable to open the window') ENDSELECT ENDPROC /***************************************************************************\ ** File format for "S:WheelOfFortune.prefs": ** ** ** ** ( 4) header WOFP ** ** ( 4) version 0100 ** ** ( 13) p1name Zebedee ** ** ( 6) p1total 0 ** ** ( 13) p2name Arsehole ** ** ( 6) p2total 0 ** ** ( 13) p3name Liz ** ** ( 6) p3total 0 ** ** ( 13) p4name Tara ** ** ( 6) p4total 0 ** ** ( 32) puzzlefile Wheel.wof ** ** ( 6) puzzleuse 1 ** ** ( 1) 0=no clue, 1=clue 1 ** ** ( 1) 0=don't hide, 1=hide used 0 ** ** ( 1) Current player's turn 1 ** \***************************************************************************/ version: CHAR '$VER: Wheel of Fortune v1.00 (03-Nov-97)',0