{ Author: Bryan Cafferky Date: 05/12/88 } { Program: HangOpus Personal Pascal - O.S.S. } { } { Description: Hangman game with Opus drawn hanging by his tie. } { Includes a word file editor to allow creation and editing } { of word files. This is completely GEM based. } { Many routines were adapted/used from O.S.S demos or } { routines obtained through compuserve. My first PASCAL } { and GEM program which I think works well but tends to be } { a bit sloppy due to the learning process. } {$P-} { Turn pointer checking off} {**************************************************************************} PROGRAM HangOpus; CONST Mono = 2; cmd_write = 128 ; cmd_read = 0 ; chana_lo = 0 ; chana_hi = 1 ; chana_vol = 8 ; chan_enable = 7 ; enable_sound = 7 ; {$I b:gemconst.src} TYPE {$I b:gemtype.src} { The ST screen is 32000 bytes of data, soooo.... } Screen = packed array [ 0..31999 ] of BYTE; Song = packed array [0..3119] of BYTE; Ptr_Sng = ^Song; {pointer to song} Ptr_screen = ^Screen; { pointer to the screen array } channel = 0..2 ; Palette = Packed Array [ 0..15 ] of Integer; Resolution = Integer; Degas_scrn = PACKED RECORD Res : Resolution; Pal : Palette; Pic : Screen; End; Words = PACKED File of Char; VAR menu : Menu_Ptr ; menu1, menu2, Score, Tries_Left : Integer; wind_name, info_dat : Window_Title ; Hang_Dialog,Word_Dialog : Dialog_Ptr; A_Buttn, B_Buttn, C_Buttn, D_Buttn, E_Buttn : Integer; F_Buttn, G_Buttn, H_Buttn, J_Buttn, K_Buttn, L_Buttn, M_Buttn :Integer; N_Buttn, O_Buttn, P_Buttn, Q_Buttn, R_Buttn, S_Buttn, T_Buttn :Integer; U_Buttn, V_Buttn, W_Buttn, X_Buttn, Y_Buttn, Z_Buttn : Integer; I_Buttn, Ed_Buttn, Choice, First_Option, Second_Option, jnk : Integer; Third_Option, Fourth_Option,junk : Integer; Word_Line : ARRAY [0..80] OF Integer; volume, note : integer ; Game_Over, DONE : Boolean; Word_hld : ARRAY [0..80] OF STRING; Song1 : Long_Integer; Sngstrng : Song; S_ptr : Ptr_screen; { a pointer to a packed array of bytes... } SavScrn : Screen; { a place to save the current screen } Word, Hold, File_nam : String; Oldpal, Zip_pal : Palette; f, p : file of Degas_scrn; { a file containing a screenful of bytes.. } w : file of Words; {Word File} s : file of Song; {Song File} Fname, path : Path_Name; {$I b:gemsubs.src} {$I cursor.pas} FUNCTION IO_State : Boolean ; EXTERNAL ; FUNCTION IO_Result : Short_Integer ; EXTERNAL ; PROCEDURE IO_Check( YesNo : Boolean ) ; EXTERNAL ; Function XB_Rnd : Long_Integer; { get xbios random 24-bit number } Xbios( 17 ); Function Rnd : Real; Begin Rnd := XB_Rnd / 16777216.0; End; Function Random( Low, Hi : Integer ) : Integer; Begin Random := Low + Trunc( Rnd * ( Hi - Low +1 ) ); End; { physbase returns a pointer to the start of the ST's screen. } FUNCTION Physbase : Ptr_screen; XBIOS( 2 ); FUNCTION Getrez : Resolution; XBIOS( 4 ); PROCEDURE Setscreen( Logadr, Physadr : Long_Integer; Res : Resolution ); XBIOS( 5 ); PROCEDURE Setpalette( VAR Pal : Palette ); XBIOS( 6 ); FUNCTION Setcolor( N , Color : Integer ) : Integer; XBIOS( 7 ); Function GETCH : Long_Integer; GEMDOS(1); { Declare Obj Draw to update text fields in Dialog Box - Corr to vers 1} Procedure Obj_Draw(Box: Dialog_Ptr; Item: Tree_Index; Depth, X, Y, W, H: Integer); External; { clear screen procedure } PROCEDURE cls; BEGIN write( chr( 27 ) ); write( 'E' ); END; PROCEDURE Wait_for_click; Var event,junk : Integer; bstate : Short_Integer; msg : Message_Buffer ; BEGIN event := 0; bstate := 0; junk := 0; event := Get_Event( E_Button, $0001, $0001, 0, 0, false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg, junk, bstate, junk, junk, junk, junk ) ; END; { *** Sound Routines - Next two call sound demon } FUNCTION Addr(VAR music : Song) : Long_Integer; EXTERNAL; FUNCTION Play(songadr : Long_Integer) : Integer; { Gives string pointer to sound demon - so play begins} XBIOS(32); { ***** Generic Sound routines ******} { Two XBIOS functions (actually one call with two definitions!) needed to access the General Instruments sound chip. } FUNCTION gia_read( data, register : integer ) : integer ; XBIOS( 28 ) ; PROCEDURE gia_write( data, register : integer ) ; XBIOS( 28 ) ; { Call this routine to enable sound to be generated. } PROCEDURE Sound_Init ; VAR port_state : integer ; BEGIN port_state := gia_read( 0, chan_enable+cmd_read ) ; gia_write( port_state&(~enable_sound), chan_enable+cmd_write ) ; END ; { This routine turns on a particular note on one of the three channels. } PROCEDURE Sound( ch : channel ; pitch : integer ; vol : integer ) ; BEGIN gia_write( vol, chana_vol+ch+cmd_write ) ; gia_write( pitch&$FF, chana_lo+ch*2+cmd_write ) ; gia_write( shr(pitch,8), chana_hi+ch*2+cmd_write ) ; END ; { Call this routine to turn off sound after you're finished. } PROCEDURE Sound_Off ; VAR port_state : integer ; BEGIN Sound( 0, 0, 0 ) ; { First, make sure all volumes are zero. } Sound( 1, 0, 0 ) ; Sound( 2, 0, 0 ) ; { Now disable sound production on all three channels. } port_state := gia_read( 0, chan_enable+cmd_read ) ; gia_write( port_state|enable_sound, chan_enable+cmd_write ) ; END ; {Procedure to read in song files} PROCEDURE Get_Songs; BEGIN reset(s,'THEME.SND'); Read(s,Sngstrng); Song1 := Addr(Sngstrng); END; { *************************************************************************** Restore screen data from degas file. ************************************************************************* } PROCEDURE SRestore( name : STRING ); VAR i : Integer; Rez : Resolution; BEGIN Rez := Getrez; S_ptr := Physbase; { grab location of screen... } reset( f, name ); { bind f to file name } { reset automatically fills file buffer with data from first record } { decide if resolution can be changed... } IF ( ( f^.Res < Mono ) AND ( Rez < Mono ) ) THEN Setscreen( -1, -1, f^.Res ); { now check for picture compatability... } IF ( ( f^.Res = Mono ) AND ( Rez = Mono ) OR ( Rez < Mono ) AND ( f^.Res < Mono ) ) THEN Begin For i:= 0 TO 15 DO { save palette } BEGIN Oldpal[ i ] := Setcolor( i, -1 ); Zip_pal[i] := $FFFF; END; Setpalette( f^.Pal ); { use degas palette } SavScrn := S_ptr^; { save current screen } S_ptr^ := f^.Pic; { stuff picture into screen } End; { file is automatically closed when we leave this procedure. } END; Procedure Redo_Picture; BEGIN S_ptr^ := f^.Pic; { stuff picture into screen } Setpalette( f^.Pal ); { use degas palette } End; Procedure Pick_Word; VAR R,x,c,junk : Integer; i : Short_Integer; b : Boolean; BEGIN b := FALSE; IO_CHECK(False); Reset(W,Fname); i := IO_Result; IF i = -33 THEN BEGIN Fname := 'WORD.WDS'; Reset(W,Fname); END ELSE IF i < 0 THEN junk := Do_Alert('[3][Error |Opening file][Ok]',1); Readln(W,c); R := Random(1,c); For x := 1 to R Do Readln(W,Word); CLOSE(W); END; Procedure Picture; BEGIN File_nam := 'Test.pi'; { start a file name } File_nam := Concat( File_nam, Chr( Getrez + Ord( '1' ) ) ); { add extender } cls; { clear screen... } SRestore( File_nam ); { read screen data from file... } Reset(p,'OPPICS.PI2'); END; PROCEDURE Initialize_Dialog; BEGIN Hang_Dialog := New_Dialog(30,10,19,59,5); A_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,1,1,3,1,-4,1); B_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,5,1,3,1,-4,1); C_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,9,1,3,1,-4,1); D_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,13,1,3,1,-4,1); E_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,17,1,3,1,-4,1); F_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,21,1,3,1,-4,1); G_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,25,1,3,1,-4,1); H_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,29,1,3,1,-4,1); I_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,33,1,3,1,-4,1); J_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,37,1,3,1,-4,1); K_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,41,1,3,1,-4,1); L_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,45,1,3,1,-4,1); M_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,49,1,3,1,-4,1); N_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,1,3,3,1,-4,1); O_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,5,3,3,1,-4,1); P_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,9,3,3,1,-4,1); Q_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,13,3,3,1,-4,1); R_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,17,3,3,1,-4,1); S_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,21,3,3,1,-4,1); T_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,25,3,3,1,-4,1); U_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,29,3,3,1,-4,1); V_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,33,3,3,1,-4,1); W_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,37,3,3,1,-4,1); X_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,41,3,3,1,-4,1); Y_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,45,3,3,1,-4,1); Z_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,49,3,3,1,-4,1); Ed_Buttn := Add_DItem(Hang_Dialog,G_Button,Selectable|Exit_Btn,53,1,5,3,3,1); Set_Dtext(Hang_Dialog,A_Buttn,'A',System_Font,TE_Left); Set_Dtext(Hang_Dialog,B_Buttn,'B',System_Font,TE_Left); Set_Dtext(Hang_Dialog,C_Buttn,'C',System_Font,TE_Left); Set_Dtext(Hang_Dialog,D_Buttn,'D',System_Font,TE_Left); Set_Dtext(Hang_Dialog,E_Buttn,'E',System_Font,TE_Left); Set_Dtext(Hang_Dialog,F_Buttn,'F',System_Font,TE_Left); Set_Dtext(Hang_Dialog,G_Buttn,'G',System_Font,TE_Left); Set_Dtext(Hang_Dialog,H_Buttn,'H',System_Font,TE_Left); Set_Dtext(Hang_Dialog,I_Buttn,'I',System_Font,TE_Left); Set_Dtext(Hang_Dialog,J_Buttn,'J',System_Font,TE_Left); Set_Dtext(Hang_Dialog,K_Buttn,'K',System_Font,TE_Left); Set_Dtext(Hang_Dialog,L_Buttn,'L',System_Font,TE_Left); Set_Dtext(Hang_Dialog,M_Buttn,'M',System_Font,TE_Left); Set_Dtext(Hang_Dialog,N_Buttn,'N',System_Font,TE_Left); Set_Dtext(Hang_Dialog,O_Buttn,'O',System_Font,TE_Left); Set_Dtext(Hang_Dialog,P_Buttn,'P',System_Font,TE_Left); Set_Dtext(Hang_Dialog,Q_Buttn,'Q',System_Font,TE_Left); Set_Dtext(Hang_Dialog,R_Buttn,'R',System_Font,TE_Left); Set_Dtext(Hang_Dialog,S_Buttn,'S',System_Font,TE_Left); Set_Dtext(Hang_Dialog,T_Buttn,'T',System_Font,TE_Left); Set_Dtext(Hang_Dialog,U_Buttn,'U',System_Font,TE_Left); Set_Dtext(Hang_Dialog,V_Buttn,'V',System_Font,TE_Left); Set_Dtext(Hang_Dialog,W_Buttn,'W',System_Font,TE_Left); Set_Dtext(Hang_Dialog,X_Buttn,'X',System_Font,TE_Left); Set_Dtext(Hang_Dialog,Y_Buttn,'Y',System_Font,TE_Left); Set_Dtext(Hang_Dialog,Z_Buttn,'Z',System_Font,TE_Left); Set_Dtext(Hang_Dialog,Ed_Buttn,'END',System_Font,TE_Left); Obj_Draw(Hang_Dialog,0,1,0,0,0,0); Choice := Do_Dialog(Hang_Dialog,0); END; PROCEDURE Reset_Letter(btn: Tree_Index); BEGIN Obj_SetState(Hang_Dialog,btn,Normal,TRUE); Obj_Draw(Hang_Dialog,btn,1,0,0,0,0); END; PROCEDURE Init_Scores; VAR x : Integer; BEGIN Hide_Mouse; Draw_Mode(1); Paint_Outline(TRUE); Paint_Style(1); Line_Color(Red); Frame_Rect(13,35,145,33); Pick_Word; Hold := ''; For x := 1 to Length(Word) DO Hold := Concat(Hold,'_'); Tries_Left := 8; Score := 0; Position(6,9); Write('Score: ',Score); Position(7,4); Write('Tries Left: ',Tries_Left); Position(8,4); Write('Word: ',Hold); Paint_color(White); Paint_Rect(5,70,370,79); Show_Mouse; END; Procedure End_Game; BEGIN End_Dialog(Hang_Dialog); Delete_Dialog(Hang_Dialog); Setpalette(Zip_pal); Close_Window(1); Delete_Window(1); Hide_Mouse; Redo_Picture; Draw_Menu( menu ) ; Show_Mouse; Game_Over := TRUE; END; PROCEDURE Set_Letter(btn: Tree_Index); BEGIN Obj_SetState(Hang_Dialog,btn,Disabled,TRUE); Obj_Draw(Hang_Dialog,btn,1,0,0,0,0); END; Procedure Match_Rtn; VAR x,y : Integer; BEGIN Hide_Mouse; Paint_color(White); Paint_Rect(5,70,230,79); SavScrn := S_ptr^; { Get current screen } For y := 4 to 80 Do For x := 47 to 86 Do SavScrn[(y+66)*160+(x-24)] := p^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } Show_Mouse; Sound_Init; For x := 10 downto 1 Do For y := 1 to 100 Do BEGIN Sound(1,x * 100,12); Sound(0,x * 120,12); END; Sound_Off; END; Procedure No_Match_Rtn; Var L,x,y,event : Integer; j : Long_integer; BEGIN Hide_Mouse; Paint_color(White); Paint_Rect(5,70,245,79); SavScrn := S_ptr^; { Get current screen } For y := 5 to 80 Do For x := 1 to 44 Do SavScrn[(y+67)*160+(x+16)] := p^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } Sound_Init; For x := 1 to 10 Do For y := 1 to 100 Do BEGIN Sound(1,x * 100,12); Sound(0,x * 120,12); END; Sound_Off; Paint_Style(1); Paint_Color(Black); CASE Tries_Left of 7: Paint_Rect(560,170,43,20); 6: Paint_Rect(575,35,10,140); 5: Paint_Rect(317,35,258,7); 4: Paint_Rect(317,35,15,13); 3: BEGIN For y := 25 to 40 Do For x := 51 to 63 Do SavScrn[(y+22)*160+x+24] := f^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } END; 2: BEGIN For y := 36 to 60 Do For x := 51 to 85 Do SavScrn[(y+22)*160+x+24] := f^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } END; 1: BEGIN For y := 61 to 110 Do For x := 51 to 85 Do SavScrn[(y+22)*160+x+24] := f^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } END; 0: BEGIN For y := 111 to 124 Do For x := 51 to 80 Do SavScrn[(y+22)*160+x+24] := f^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } Paint_Color(White); Paint_Rect(5,70,300,78); Position(18,10); Write('Click mouse to continue...'); Wait_for_click; END; END; { End of CASE } Show_Mouse; END; Procedure Alert_Choice( Ch : Integer); VAR x : Integer; BEGIN IF Ch = 1 THEN BEGIN Hide_Mouse; Position(8,10); For x := 1 to Length(Word) Do Write(' '); Position(18,25); Write(' '); Position(16,25); Write(' '); Paint_Color(White); Paint_Rect(158,40,330,96); Init_Scores; For x := 1 to 26 Do Reset_Letter(x); Show_mouse; END; IF Ch = 2 THEN BEGIN Game_Over := TRUE; End_Game; END; END; Procedure You_Win; Var L,x,y,event : Integer; j : Long_integer; BEGIN Hide_Mouse; Paint_Color(0); Paint_Rect(300,35,280,113); Paint_Rect(575,35,10,140); Paint_Rect(560,170,43,20); Paint_Rect(5,70,300,75); SavScrn := S_ptr^; { Get current screen } For y := 4 to 80 Do For x := 115 to 158 Do SavScrn[(y+52)*160+(x-64)] := p^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } Show_Mouse; Sound_Init; For x := 1 to 15 Do For y := 1 to 50 Do BEGIN Sound(1,x * 100,12); Sound(0,x * 120,12); Sound(2,x * 140,12); END; For x := 15 downto 1 Do For y := 1 to 50 Do BEGIN Sound(1,x * 100,12); Sound(0,x * 120,12); Sound(2,x * 140,12); END; Sound_Off; Position(18,30); Write('Click mouse to continue...'); Wait_for_click; L := Do_Alert('[1][You Won Mellon Head][ REPLAY | END ]',0); Alert_Choice(L); END; Procedure You_Lose; Var L,x,y,event : Integer; j : Long_Integer; BEGIN Hide_Mouse; Paint_Color(0); Paint_Rect(300,35,290,113); Paint_Rect(560,170,43,20); Paint_Rect(575,35,10,140); Paint_Rect(5,100,300,40); Position(18,10); Write(' '); SavScrn := S_ptr^; { Get current screen } For y := 108 to 185 Do For x := 42 to 98 Do SavScrn[(y-50)*160+(x+8)] := p^.pic[y*160+x]; S_Ptr^ := SavScrn; { restore old screen } Show_Mouse; Sound_Init; For x := 15 downto 1 Do For y := 1 to 120 Do BEGIN Sound(1,x * 100,12); Sound(0,x * 120,12); Sound(2,x * 140,12); END; Sound_Off; Position(18,25); Write('Click mouse to continue...'); Wait_for_click; Paint_Rect(180,55,300,80); Paint_Rect(330,50,200,68); Position(16,25); Write('The Word is: ',Word); Wait_for_click; L := Do_Alert('[1][Sorry - You Lose!][ REPLAY | END ]',0); Alert_Choice(L); END; Procedure Process_Letter(letter : Char); VAR X : Integer; Match : Boolean; BEGIN Match := FALSE; For X := 1 to Length(Word) DO BEGIN If Word[X] = letter THEN BEGIN Score := Score + 1; Hold[X] := letter; Match := TRUE; END; END; IF Match = FALSE THEN BEGIN Tries_Left := Tries_Left - 1; No_Match_Rtn; END ELSE Match_Rtn; Position(6,16); Write(Score,' '); Position(7,16); Write(Tries_Left,' '); Position(8,10); Write(Hold); IF Score = Length(Word) THEN You_Win; IF Tries_Left = 0 THEN You_Lose; END; PROCEDURE Play_Game; BEGIN CASE Choice OF 1 : BEGIN Set_Letter(A_Buttn); Process_Letter('A'); END; 2 : BEGIN Set_Letter(B_Buttn); Process_Letter('B'); END; 3 : BEGIN Set_Letter(C_Buttn); Process_Letter('C'); END; 4 : BEGIN Set_Letter(D_Buttn); Process_Letter('D'); END; 5 : BEGIN Set_Letter(E_Buttn); Process_Letter('E'); END; 6 : BEGIN Set_Letter(F_Buttn); Process_Letter('F'); END; 7 : BEGIN Set_Letter(G_Buttn); Process_Letter('G'); END; 8 : BEGIN Set_Letter(H_Buttn); Process_Letter('H'); END; 9 : BEGIN Set_Letter(I_Buttn); Process_Letter('I'); END; 10 : BEGIN Set_Letter(J_Buttn); Process_Letter('J'); END; 11 : BEGIN Set_Letter(K_Buttn); Process_Letter('K'); END; 12 : BEGIN Set_Letter(L_Buttn); Process_Letter('L'); END; 13 : BEGIN Set_Letter(M_Buttn); Process_Letter('M'); END; 14 : BEGIN Set_Letter(N_Buttn); Process_Letter('N'); END; 15 : BEGIN Set_Letter(O_Buttn); Process_Letter('O'); END; 16 : BEGIN Set_Letter(P_Buttn); Process_Letter('P'); END; 17 : BEGIN Set_Letter(Q_Buttn); Process_Letter('Q'); END; 18 : BEGIN Set_Letter(R_Buttn); Process_Letter('R'); END; 19 : BEGIN Set_Letter(S_Buttn); Process_Letter('S'); END; 20 : BEGIN Set_Letter(T_Buttn); Process_Letter('T'); END; 21 : BEGIN Set_Letter(U_Buttn); Process_Letter('U'); END; 22 : BEGIN Set_Letter(V_Buttn); Process_Letter('V'); END; 23 : BEGIN Set_Letter(W_Buttn); Process_Letter('W'); END; 24 : BEGIN Set_Letter(X_Buttn); Process_Letter('X'); END; 25 : BEGIN Set_Letter(Y_Buttn); Process_Letter('Y'); END; 26 : BEGIN Set_Letter(Z_Buttn); Process_Letter('Z'); END; 27 : BEGIN End_Game; END; END; END; PROCEDURE play_hangman; BEGIN Game_Over := FALSE; Initialize_Dialog; Play_Game; WHILE Game_Over<>TRUE DO BEGIN Choice := Redo_Dialog(Hang_Dialog,0); Play_Game; END; END; PROCEDURE End_Edit; BEGIN Setpalette(Zip_Pal); End_Dialog(Word_Dialog); Delete_Dialog(Word_Dialog); Hide_Mouse; Redo_Picture; Draw_Menu(menu); Show_Mouse; END; PROCEDURE Select_File; VAR Flag : Boolean; hold : Integer; BEGIN Fname := 'WORD.WDS'; Path := '\*.WDS'; hold := f^.pal[2]; f^.pal[2] := $FFFF; Setpalette(f^.Pal); If GET_IN_FILE(Path, Fname) THEN Flag := TRUE ELSE BEGIN Fname := 'WORDS.WDS'; END; Hide_Mouse; Redo_Picture; f^.pal[2] := hold; Setpalette(f^.pal); Draw_Menu(menu); Show_Mouse; END; PROCEDURE Setup_Wrd_Dialog; VAR x,c,r,color,color2: Integer; BEGIN color := D_Color(Black,Black,True,5,Green); color2 := D_Color(Black,Red,False,3,Green); Word_Dialog := New_Dialog(80,1,2,77,23); c := 9; r := 4; For x := 0 to 74 Do BEGIN Word_Line[x] := Add_DItem(Word_Dialog,G_FText,Editable,c,r,10,1,0,color); c := c + 12; IF c > 63 THEN c := 9; IF c = 9 THEN r := r +1; Set_DEdit(Word_Dialog,Word_Line[x],'__________','FFFFFFFFFF',Word_hld[x],3,TE_Left); END; Word_Line[x] := Add_DItem(Word_Dialog,G_Button,Selectable|Exit_Btn, 48,20,6,2,3,Black); Set_DText(Word_Dialog,Word_Line[x],'Done',System_Font,TE_Left); Word_Line[x+1] := Add_DItem(Word_Dialog,G_BoxText,None,28,1,20,2,2,color2); Set_DText(Word_Dialog,Word_Line[x+1],'Word File Editor',System_Font,TE_Center); Word_Line[x+2] := Add_DItem(Word_Dialog,G_Button,Selectable|Exit_Btn, 20,20,8,2,3,color2); Set_DText(Word_Dialog,Word_Line[x+2],'Cancel',System_Font,TE_Center); END; PROCEDURE Get_Words; VAR x,c,check : Integer; hld : String[255]; BEGIN c := 0; For x := 0 to 74 Do Word_Hld[x] := ''; IO_Check(False); Reset(W,Fname); check := IO_Result; If check < 0 then c := -1 ELSE Readln(W,c); For x := 0 to c Do Readln(W,Word_Hld[x]); Close(W); END; PROCEDURE Do_Words; VAR x,c : Integer; hld : String[255]; BEGIN c := 0; For x := 0 to 74 Do BEGIN Get_DEdit(Word_Dialog,Word_Line[x],hld); IF hld <> '' THEN BEGIN Word_Hld[c] := hld; c := c+1; END; END; c := c-1; ReWrite(W,Fname); Writeln(W,c); For x := 0 to c Do Writeln(W,Word_Hld[x]); Close(W); END; PROCEDURE Edit_Words; BEGIN Choice := Do_Dialog(Word_Dialog,Word_Line[0]); IF Choice < 78 THEN Do_Words; END; PROCEDURE Event_Loop ; VAR wind_count, window, event, junk : integer ; msg : Message_Buffer ; BEGIN wind_count := 0 ; wind_name := 'HangOpus Game' ; info_dat := 'By: Bryan Cafferky'; event := Get_Event( E_Message, 0, 0, 0, 0, false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg, junk, junk, junk, junk, junk, junk ) ; CASE msg[0] OF MN_Selected: BEGIN If msg[3] = 3 then BEGIN Menu_Normal( menu, msg[3] ) ; junk := Do_Alert('[1][HangOpus|in Personal Pascal|By: Bryan Cafferky][Swell]',1); END; If msg[4] = First_Option then BEGIN Hide_Mouse; Menu_Normal( menu, msg[3] ) ; Paint_Color(0); Paint_Rect(1,1,635,199); window := New_Window( G_Name|G_Move|G_Info, wind_name, 0, 0, 0, 0 ) ; Set_Winfo(window, info_dat); Open_Window( window, 0, 0, 0, 0 ) ; Show_Mouse; Init_Scores; play_hangman; END ; If msg[4] = Second_Option then DONE := TRUE ; If msg[4] = Third_Option then BEGIN Menu_Normal( menu, msg[3] ) ; Select_File ; END; If msg[4] = Fourth_Option then BEGIN Menu_Normal( menu, msg[3] ) ; Select_File ; Get_Words; Setup_Wrd_Dialog; Edit_Words; End_Edit; END; END ; END ; END ; BEGIN Sound_Init; Get_Songs; jnk := Play(Song1); DONE := FALSE; Fname := 'WORD.WDS'; Init_Mouse; IF Init_Gem >= 0 THEN BEGIN Hide_Mouse; Picture; Show_mouse; menu := New_Menu( 3, ' About HangOpus...' ) ; menu1 := Add_Mtitle(menu,' Options '); menu2 := Add_Mtitle(menu,' File '); First_Option := Add_Mitem(menu,menu1,' Play HangOpus '); Second_Option := Add_Mitem(menu,menu1,' End Game '); Third_Option := Add_Mitem(menu,menu2,' Select Word File '); Fourth_Option := Add_Mitem(menu,menu2,' Edit Word File '); Draw_Menu( menu ) ; WHILE DONE=FALSE DO Event_Loop ; Erase_Menu( menu ); Setpalette( Oldpal ); { restore old palette } Exit_Gem ; END ; END.