10REM >!RunImage 20REM >for !X-Word application v0.07 30REM >by Alan Trewartha 2000 40 50REM ====== CONSTANTS ================= 60MAIN_PAGE%=0 70BAG_PAGE%=1 80SQUARES_PAGE%=2 90TILES_PAGE%=3 100OPTIONS_PAGE%=4 110 120_MOUSEX%=0 130_MOUSEY%=4 140_BUTTON%=8 150_WINDOW%=12 160_ICON%=16 170 180IN_BAG$="b" 190IN_RACK$="r" 200IN_DRAG$="d" 210IN_PLAY$="t" 220BINNED$="-" 230PLAYED$="*" 240 250BLANK$="[" 260 270GAME_OPT%=57 280PREF_GRID_COL%=1 290 300VERTICAL%=TRUE 310HORIZONTAL%=FALSE 320 330 340REM ====== GLOBAL "GAME-PLAY" VARIABLES ========= 350 360DIM Player_Data%(4,12) :REM (player,various) 0=score, 1=rack window wimp handle 370 REM 2=number of tiles being dragged 380 REM 3+ hold tiles numbers on rack 390DIM Player_History$(4,45) :REM string showing play 400DIM Player_History%(4,45) :REM score for each play 410DIM letters%(26,2) :REM ,0=value ,1=frequency ,2='weight' 420DIM Board_Squares$(8) :REM the bonus score squares 430DIM Board_Tiles%(14,14) :REM (y%,x%) holds the played tile numbers 440 450tile_letter$="" :REM each tile's face letter 460tile_state$="" :REM each tile's state 470 480Curr_Player%=0 490 500 510REM ====== GLOBAL VARIABLES ======== 520 530Board_Page%=MAIN_PAGE% 540SYS "OS_ReadMonotonicTime" TO Quit% 550Quit%=RND(-Quit%) 560Quit%=FALSE 570First_Tile%=0 580Last_Tile%=0 590blanks_in_play%=0 600window_move_x%=0 610window_move_y%=0 620Flash_Tiles%=0 630 640 650REM ====== RESERVE DATA AREAS ============ 660 670DIM wimpspace% 9000 :REM the wimp data block 680DIM menuspace%15000 :REM the menu data 690DIM workspace% 9000 :REM indirected text etc 700DIM fontspace% 256 :REM font handle data 710DIM grfxspace%50000 :REM sprites 720 730DIM messagebuff% 2000 :REM messages buffer space 740 750DIM xchk% 1830 :REM search 'crosscheck' bytes 760DIM value_stack% 400 :REM value stack for iterative routines 770stack_pointer%=0 780 790menu_top%=menuspace%+15000 800work_top%=workspace%+ 9000 810 820SYS"OS_DynamicArea",0,-1,1024*64,-1,%10000000,-1,0,-1,"X-Word Lexicon" TO ,lex_area_handle%,,lex1space% 830FOR a%=0 TO 252 STEP 4:fontspace%!a%=0:NEXT a% 840 850 860 870REM ====== EXECUTION ====== 880PROC_init_all 890ON ERROR IF FN_wimp_error THEN PROC_wimp_end_task:END 900PROC_wimp_poll 910PROC_wimp_end_task 920END 930 940 950DEF PROC_wimp_end_task 960 LOCAL a% 980 IF Curr_Player%<>0 THEN PROC_game_off 990 PROC_message_close 1000 SYS "OS_DynamicArea",1,lex_area_handle% 1010 FOR a%=0 TO 255 1020 WHILE fontspace%?a% 1030 SYS"XFont_LoseFont",a% 1040 fontspace%?a%=fontspace%?a%-1 1050 ENDWHILE 1060 NEXT a% 1070 SYS "Wimp_CloseDown",task%,&4B534154 1080ENDPROC 1090 1100 1110 1120 1130 1140 1150 1160REM ======= WIMP routines ========== 1170 1180DEF PROC_wimp_poll 1190 LOCAL a%, reason% 1200 REPEAT 1210 SYS "OS_ReadMonotonicTime" TO a% 1220 SYS "Wimp_PollIdle",0,wimpspace%,a%+25 TO reason% 1230 CASE reason% OF 1240 WHEN 0: PROC_wimp_idle 1250 WHEN 1: PROC_wind_redraw(wimpspace%!0) 1260 WHEN 2: PROC_wind_open(wimpspace%!0) 1270 WHEN 3: PROC_wind_close(wimpspace%!0) 1280 WHEN 6: PROC_wimp_mouse 1290 WHEN 7: PROC_drag_end 1300 WHEN 8: IF NOTFN_player_is_computer THEN PROC_wimp_key 1310 WHEN 9: PROC_wimp_menu 1320 WHEN 17,18: PROC_wimp_receive_message 1330 ENDCASE 1340 UNTIL Quit% 1350ENDPROC 1360 1370 1380 1390DEF PROC_wimp_idle 1400 LOCAL a%, t%, a$ 1410 REM ==== switch off the pressed default buttons 1420 IF FN_icon_flag(Control_Window%,2,21) THEN PROC_icon_flag_set(Control_Window%,2,0,1<<21) 1430 IF FN_icon_flag(Control_Window%,18,21) THEN PROC_icon_flag_set(Control_Window%,18,0,1<<21) 1440 1450 IF Board_Page% = OPTIONS_PAGE% THEN 1460 REM ==== Set the player name icon colours ====== 1470 FOR a%= 50 TO 53 1480 a$=$FN_icon_text(Board_Window%,a%) 1490 t%=(FN_icon_flags(Board_Window%,a%) DIV &1000000) AND 255 1500 IF a$="" THEN 1510 IF t%<>&17 THEN PROC_icon_flag_set(Board_Window%,a%,&17000000,&FF000000) 1520 ELSE 1530 IF ASC(RIGHT$(a$))>47 AND ASC(RIGHT$(a$))<58 THEN 1540 IF t%<>&0B THEN PROC_icon_flag_set(Board_Window%,a%,&0B000000,&FF000000) 1550 ELSE 1560 IF t%<>&07 THEN PROC_icon_flag_set(Board_Window%,a%,&07000000,&FF000000) 1570 ENDIF 1580 ENDIF 1590 NEXT a% 1600 ENDIF 1610 1620 IF FN_player_is_computer THEN 1630 IF FN_icon_flag(Board_Window%,GAME_OPT%+6,21) THEN 1640 t%=0 1650 WHILE INSTR(tile_state$,IN_PLAY$,t%+1) 1660 t%=INSTR(tile_state$,IN_PLAY$,t%+1) 1670 PROC_icon_flag_set(Board_Window%,FN_tile_icon(t%),2^21,0) 1680 ENDWHILE 1690 Flash_Tiles%+=1 1700 IF Flash_Tiles%=6 THEN 1710 Flash_Tiles%=0 1720 PROC_game_end_turn 1730 ENDIF 1740 ELSE 1750 PROC_game_end_turn 1760 ENDIF 1770 ENDIF 1780 ENDPROC 1790 1800 1810 1820DEF PROC_wimp_menu 1830 LOCAL adj% 1840 SYS "Wimp_GetPointerInfo",,wimpspace%+100 1850 adj%=(wimpspace%!108 AND 1) 1860 1870 CASE Curr_Menu% OF 1880 1890 WHEN Main_Menu%: 1900 CASE wimpspace%!0 OF 1910 WHEN 1: IF Curr_Player%=0 THEN PROC_game_start ELSE PROC_game_off 1920 WHEN 2: 1930 CASE wimpspace%!4 OF 1940 WHEN-1: REM nothing (options submenu) 1950 WHEN 0: PROC_wind_open_board(TILES_PAGE%) 1960 WHEN 1: PROC_wind_open_board(SQUARES_PAGE%) 1970 WHEN 2: PROC_wind_open_board(OPTIONS_PAGE%) 1980 ENDCASE 1990 WHEN 3: REM nothing (save sub window) 2000 WHEN 4: 2010 CASE wimpspace%!4 OF 2020 WHEN-1: REM nothing (racks submenu) 2030 WHEN 0: !(Arrange_Menu%+28)=!(Arrange_Menu%+28)EOR1 2040 WHEN 1: PROC_wind_racks_left 2050 WHEN 2: PROC_wind_racks_right 2060 WHEN 3: PROC_wind_racks_clock 2070 WHEN 4: PROC_wind_racks_anti 2080 ENDCASE 2090 WHEN 5: OSCLI"Filer_Run .!Help" 2100 WHEN 6: Quit%=TRUE 2110 ENDCASE 2120 2130 WHEN Icon_Bar_Menu%: 2140 CASE wimpspace%!0 OF 2150 WHEN 1: OSCLI"Filer_Run .!Help" 2160 WHEN 2: Quit%=TRUE 2170 ENDCASE 2180 2190 WHEN Tile_Value_Menu%: 2200 letters%(icon_click%-15,0)=!wimpspace% 2210 PROC_opt_redraw_tiles 2220 PROC_icon_refresh(Board_Window%,icon_click%) 2230 2240 WHEN Font_Menu%: 2250 PROC_opt_set_font 2260 2270 WHEN Rack_Menu%: 2280 CASE wimpspace%!0 OF 2290 WHEN 0: PROC_menu_tick(Rack_Menu%,0) 2300 PROC_menu_untick(Rack_Menu%,1) 2310 WHEN 1: PROC_menu_tick(Rack_Menu%,1) 2320 PROC_menu_untick(Rack_Menu%,0) 2330 WHEN 2: PROC_menu_tick(Rack_Menu%,2) 2340 PROC_menu_untick(Rack_Menu%,3) 2350 WHEN 3: PROC_menu_tick(Rack_Menu%,3) 2360 PROC_menu_untick(Rack_Menu%,2) 2370 ENDCASE 2380 2390 ENDCASE 2400 2410 IF adj% PROC_menu_open(Curr_Menu%,topx%,topy%) 2420ENDPROC 2430 2440 2450 2460DEF PROC_wimp_key 2470 LOCAL a$ 2480 CASE wimpspace%!24 OF 2490 2500 WHEN &00D: 2510 REM ===== simulate a mouse click ====== 2520 wimpspace%!12=Control_Window% 2530 CASE Board_Page% OF 2540 WHEN MAIN_PAGE%, BAG_PAGE%: wimpspace%!16=2 2550 OTHERWISE: wimpspace%!16=18 2560 ENDCASE 2570 PROC_icon_flag_set(Control_Window%,wimpspace%!16,1<<21,1<<21) 2580 PROC_wimp_mouse 2590 2600 WHEN &01e, &01b: 2610 REM ===== HOME, ESCAPE ===== 2620 PROC_rack_reset 2630 2640 WHEN ASC" ": 2650 PROC_rack_juggle 2660 2670 WHEN &18f, &18e, ASC"v", ASC"d": 2680 PROC_drag_dir_set(VERTICAL%) 2690 PROC_drag_block 2700 2710 WHEN &18c, &18d, ASC "h", ASC"a": 2720 PROC_drag_dir_set(HORIZONTAL%) 2730 PROC_drag_block 2740 2750 WHEN &181: REM === f1 === 2760 IF Curr_Player% THEN 2770 PROC_rack_reset 2780 a$=$FN_player_name(Curr_Player%) 2790 $FN_player_name(Curr_Player%)="Cheat9" 2800 PROC_comp_play 2810 $FN_player_name(Curr_Player%)=a$ 2820 ENDIF 2830 2840 OTHERWISE: 2850 SYS "Wimp_ProcessKey",wimpspace%!24 2860 2870 ENDCASE 2880ENDPROC 2890 2900 2910 2920DEF PROC_wimp_mouse 2930 mouse_x%=wimpspace%!_MOUSEX% 2940 mouse_y%=wimpspace%!_MOUSEY% 2950 wind_click%=wimpspace%!_WINDOW% 2960 icon_click%=wimpspace%!_ICON% 2970 wind_drag%=wind_click% 2980 icon_drag%=icon_click% 2990 button_click%=wimpspace%!_BUTTON% 3000 3010 IF button_click%>15 AND FN_menu_is_ticked(Rack_Menu%,2) THEN 3020 CASE button_click% OF 3030 WHEN 16: button_click%=64 3040 WHEN 64: button_click%=16 3050 ENDCASE 3060 ENDIF 3070 3080 CASE wind_click% OF 3090 WHEN -2: 3100 CASE button_click% OF 3110 WHEN 1,4: PROC_wind_open_board(Board_Page%) 3120 WHEN 2: PROC_menu_open(Icon_Bar_Menu%, mouse_x%-64, 120+44*3) 3130 ENDCASE 3140 3150 WHEN FN_active_rack: 3160 SYS "Wimp_SetCaretPosition", FN_active_rack,-1 3170 IF Curr_Player% THEN 3180 CASE button_click% OF 3190 WHEN 16: PROC_drag_start(1) 3200 WHEN 64: PROC_drag_start(7) 3210 WHEN 2: 3220 PROC_menu_open(Rack_Menu%, mouse_x%-64, mouse_y%) 3230 OTHERWISE: 3240 IF icon_click%=-1 THEN PROC_rack_juggle 3250 ENDCASE 3260 ENDIF 3270 3280 WHEN Save_Window%: 3290 IF button_click%>15 THEN 3300 PROC_drag_icon 3310 ELSE 3320 IF icon_click%=0 THEN 3330 a$=$FN_icon_text(Save_Window%,2) 3340 IF INSTR(a$,"::")<>0 AND INSTR(a$,"$.")<>0 THEN 3350 PROC_wimp_save_game 3360 ELSE 3370 SYS "Wimp_CreateMenu",,-1 3380 ERROR 1<<30, FN_message("misc_save") 3390 REM "To save, drag the icon to a directory viewer" 3400 ENDIF 3410 ENDIF 3420 IF icon_click%=1 THEN SYS "Wimp_CreateMenu",,-1 3430 ENDIF 3440 3450 WHEN Control_Window%: 3460 adj%=(button_click%=1)*2+1 3470 SYS "Wimp_SetCaretPosition", FN_rack(Curr_Player%),-1 3480 CASE icon_click% OF 3490 WHEN 1: 3500 IF FN_icon_flag(Control_Window%,1,21) THEN 3510 PROC_wind_open_board(BAG_PAGE%) 3520 ELSE 3530 PROC_wind_open_board(MAIN_PAGE%) 3540 ENDIF 3550 3560 WHEN 2: 3570 IF Curr_Player%=0 THEN 3580 PROC_game_start 3590 ELSE 3600 IF FN_player_is_computer THEN 3610 VDU 7 3620 ELSE 3630 IF blanks_in_play%=0 THEN 3640 PROC_game_end_turn 3650 ELSE 3660 PROC_wind_open_panes 3670 ENDIF 3680 ENDIF 3690 ENDIF 3700 3710 WHEN 13:Board_W%-=2*adj%:PROC_opt_alter_board 3720 WHEN 14:Board_W%+=2*adj%:PROC_opt_alter_board 3730 WHEN 16:Board_H%-=2*adj%:PROC_opt_alter_board 3740 WHEN 17:Board_H%+=2*adj%:PROC_opt_alter_board 3750 3760 WHEN 18: 3770 a%=0: 3780 FOR b%=1 TO 4 3790 IF $FN_player_name(b%)<>"" THEN a%+=1 3800 NEXT b% 3810 IF a% <2 THEN 3820 VDU7 3830 PROC_game_text(FN_message("misc_opt1")) 3840 REM "You need at least two players!" 3850 ELSE 3860 a%=0 3870 FOR b%=0 TO 26 3880 a%+=letters%(b%,1) 3890 NEXT b% 3900 IF a%>120 THEN 3910 VDU 7 3920 ELSE 3930 PROC_wind_open_board(MAIN_PAGE%) 3940 PROC_opt_save_file 3950 ENDIF 3960 ENDIF 3970 3980 WHEN 19: 3990 PROC_wind_open_board(MAIN_PAGE%) 4000 PROC_opt_read_file(".Options") 4010 4020 OTHERWISE: 4030 IF button_click%>15 THEN wind_drag%=Control_Window%:PROC_drag_icon 4040 ENDCASE 4050 4060 WHEN Board_Window%: 4070 IF FN_player_is_computer AND button_click%<>2 THEN ENDPROC 4080 SYS "Wimp_SetCaretPosition", FN_rack(Curr_Player%),-1 4090 CASE button_click% OF 4100 WHEN 2: 4110 CASE Board_Page% OF 4120 WHEN MAIN_PAGE%, BAG_PAGE%: 4130 PROC_menu_open(Main_Menu%, mouse_x%-96, mouse_y%) 4140 WHEN TILES_PAGE%: 4150 IF icon_click%=1 OR icon_click%=2 THEN PROC_menu_open(Font_Menu%, mouse_x%-96, mouse_y%) 4160 IF icon_click%>14 AND icon_click%<42 THEN 4170 PROC_menu_open(Tile_Value_Menu%, mouse_x%-96, mouse_y%) 4180 ENDIF 4190 ENDCASE 4200 4210 WHEN 1,4: 4220 adj%=(button_click%=1)*2+1 4230 CASE icon_click% OF 4240 WHEN -1: 4250 IF Curr_Player% THEN PROC_rack_reset 4260 IF Board_Page%=SQUARES_PAGE% THEN 4270 PROC_mouse_to_board_pos(mouse_x%, mouse_y%, FALSE) 4280 Board_W%=ABS((mouse_x%-7))*2+1 4290 Board_H%=ABS((mouse_y%-7))*2+1 4300 PROC_opt_alter_board 4310 ENDIF 4320 4330 WHEN 1: 4340 PROC_menu_open(Font_Menu%, mouse_x%-96, mouse_y%) 4350 4360 WHEN 2: 4370 PROC_menu_open(Font_Menu%, mouse_x%-96, mouse_y%) 4380 4390 WHEN 5:fontw%-=20*adj% 4400 WHEN 7:fonth%+=20*adj% 4410 WHEN 8:fonth%-=20*adj% 4420 WHEN 6:fontw%+=20*adj% 4430 WHEN 10:fontx%-=2*adj% 4440 WHEN 12:fonty%+=2*adj% 4450 WHEN 13:fonty%-=2*adj% 4460 WHEN 11:fontx%+=2*adj% 4470 4480 WHEN 54,56: *Filer_OpenDir .Lexicons -ss 4490 4500 OTHERWISE: 4510 REM ====== The tile frequencies ======= 4520 IF icon_click%>14 AND icon_click%<42 THEN 4530 IF letters%(icon_click%-15,1)<(21-adj%) AND letters%(icon_click%-15,1)>(-adj%-1) THEN 4540 letters%(icon_click%-15,1)+=adj% 4550 PROC_icon_text_set(Board_Window%,icon_click%,STR$letters%(icon_click%-15,1)) 4560 ENDIF 4570 a%=0 4580 FOR b%=0 TO 26 4590 a%+=letters%(b%,1) 4600 NEXT b% 4610 IF a%>120 THEN 4620 PROC_game_text(FN_message_sub("misc_til1", STR$(a%-120), "")) 4630 ELSE 4640 PROC_game_text(FN_message_sub("misc_til2", STR$a%, "")) 4650 ENDIF 4660 ENDIF 4670 4680 ENDCASE 4690 4700 IF fontw%<40 THEN fontw%=40 4710 IF fonth%<40 THEN fonth%=40 4720 IF icon_click%>2 AND icon_click%<14 THEN PROC_opt_alter_tiles 4730 4740 WHEN 16: 4750 IF Curr_Player%<>0 THEN 4760 IF Board_Page%=MAIN_PAGE% THEN PROC_drag_start(1) 4770 ELSE 4780 IF icon_click%=54 THEN PROC_drag_icon 4790 IF icon_click%=56 THEN PROC_drag_icon 4800 ENDIF 4810 4820 WHEN 64: 4830 IF Curr_Player%<>0 THEN 4840 IF Board_Page%=MAIN_PAGE% THEN PROC_drag_start(7) 4850 ELSE 4860 IF icon_click%=54 THEN PROC_drag_icon 4870 IF icon_click%=56 THEN PROC_drag_icon 4880 ENDIF 4890 4900 4910 ENDCASE 4920 4930 OTHERWISE: 4940 4950 ENDCASE 4960ENDPROC 4970 4980 4990 5000DEF PROC_wimp_receive_message 5010 CASE wimpspace%!16 OF 5020 WHEN 0:Quit%=TRUE 5030 WHEN 2:PROC_wimp_save 5040 WHEN 3,5:PROC_wimp_load 5050 WHEN &400c1: 5060 wimpspace%!0=Board_Window% 5070 SYS "Wimp_CloseWindow",,wimpspace% 5080 ENDCASE 5090ENDPROC 5100 5110 5120 5130DEF PROC_wimp_load 5140 PROC_wimp_end_string(wimpspace%+44):a$=$(wimpspace%+44) 5150 SYS"Wimp_GetPointerInfo",,wimpspace%+100 5160 5170 IF (wimpspace%!40>=&030) AND (wimpspace%!40<=&032) THEN 5180 REM === Acknowledge load, to prevent event being passed on === 5190 wimpspace%!12=wimpspace%!8:wimpspace%!16=4 5200 SYS "Wimp_SendMessage",17,wimpspace%,wimpspace%!4 5210 5220 REM === But do nothing when a game is in progress 5230 IF Curr_Player%<>0 THEN 5240 VDU 7 5250 ERROR 1<<30, FN_message("game_load") 5260 REM "Do not disturb: game in progress!" 5270 ENDIF 5280 5290 CASE wimpspace%!40 OF 5300 WHEN &030: 5310 VDU 7 5320 REM ===== TO LOAD GAME !!!! ====== 5330 PROC_opt_read_file(a$) 5340 PROC_opt_save_file 5350 WHEN &031: 5360 lexicon1$=a$ 5370 PROC_lex_load 5380 WHEN &032: 5390 lexicon2$=a$ 5400 PROC_lex_load 5410 ENDCASE 5420 ENDIF 5430ENDPROC 5440 5450 5460 5470DEF PROC_wimp_save 5480 SYS "Wimp_CreateMenu",,-1 5490 PROC_wimp_end_string(wimpspace%+44) 5500 save_string$=$(wimpspace%+44) 5510 CASE wind_drag% OF 5520 WHEN Board_Window%: 5530 CASE icon_drag% OF 5540 WHEN 54: 5550 SYS "Hourglass_On" 5560 file%= OPENOUT(save_string$) 5570 lex_node%=0 5580 Word$="" 5590 PROC_lex_ouput(lex1space%) 5600 CLOSE#file% 5610 SYS "XOS_CLI","SETTYPE "+save_string$+" fff" TO err%;flags% 5620 SYS "Hourglass_Off" 5630 WHEN 56: 5640 SYS "Hourglass_On" 5650 file%= OPENOUT(save_string$) 5660 lex_node%=0 5670 Word$="" 5680 PROC_lex_ouput(lex_area2%) 5690 CLOSE#file% 5700 SYS "XOS_CLI","SETTYPE "+save_string$+" fff" TO err%;flags% 5710 SYS "Hourglass_Off" 5720 5730 OTHERWISE: REM !!!!! 5740 ENDCASE 5750 5760 WHEN Save_Window%: 5770 $FN_icon_text(Save_Window%,2)=save_string$ 5780 PROC_wimp_save_game 5790 5800 OTHERWISE: REM !!!!! 5810 ENDCASE 5820 5830 wimpspace%!12=wimpspace%!8:wimpspace%!16=3 5840 SYS "Wimp_SendMessage",18,wimpspace%,wimpspace%!20 5850ENDPROC 5860 5870 5880 5890DEF PROC_wimp_save_game 5900 a$=$FN_icon_text(Save_Window%,2) 5910 file%=OPENOUT(a$) 5920 fileread%=OPENIN(".Options") 5930 WHILE NOT EOF#fileread% 5940 b$=GET$#fileread% 5950 BPUT#file%,b$ 5960 ENDWHILE 5970 CLOSE #fileread% 5980 CLOSE #file% 5990 SYS "XOS_CLI","SETTYPE "+a$+" 030" TO err%;flags% 6000ENDPROC 6010 6020 6030 6040 6050DEF PROC_wimp_save_to(leaf_name$,file_size%) 6060 SYS "Wimp_GetPointerInfo",,wimpspace% 6070 wimpspace%!20=wimpspace%!12 6080 wimpspace%!24=wimpspace%!16 6090 wimpspace%!28=wimpspace%!0 6100 wimpspace%!32=wimpspace%!4 6110 wimpspace%!36=file_size% 6120 wimpspace%!40=&fff 6130 $(wimpspace%+44)=leaf_name$ 6140 wimpspace%!0 =56 6150 wimpspace%!4=task% 6160 wimpspace%!8=1 : REM my ref 6170 wimpspace%!12=0 : REM wimps ref 6180 wimpspace%!16=1 : REM DATASAVE message 6190 SYS "Wimp_SendMessage",18,wimpspace%,wimpspace%!20 6200ENDPROC 6210 6220 6230 6240DEF FN_wimp_path_leaf(a$) 6250 WHILE INSTR(a$, "."): a$=MID$(a$,INSTR(a$,".")+1): ENDWHILE 6260=a$ 6270 6280 6290 6300DEF PROC_wimp_end_string(a%) 6310 LOCAL n% 6320 WHILE a%?n%>31 6330 n%+=1 6340 ENDWHILE 6350 a%?n%=13 6360ENDPROC 6370 6380 6390 6400DEF FN_wimp_error 6410 !wimpspace%=ERR 6420 CASE !wimpspace% OF 6430 WHEN 1<<30:err_str$="":box%=21 6440 OTHERWISE:err_str$=" at line "+STR$ERL:box%=22 6450 ENDCASE 6460 $(wimpspace%+4)=REPORT$+err_str$+CHR$0 6470 SYS "Wimp_ReportError",wimpspace%,box%,"X-Word" TO ,response% 6480=(response%=2) 6490 6500 6510 6520 6530 6540 6550 6560 6570REM ========= INITIALISATION ========== 6580 6590DEF PROC_init_all 6600 PROC_message_open(".Messages") 6610 6620 PREF_GRID_COL%=VALFN_message("pref_grid_colour") 6630 PREF_GRID_PAT%=VALFN_message("pref_grid_pattern") 6640 PREF_GRID_BEVEL%=VALFN_message("pref_grid_bevel") 6650 6660 FOR a%=ASC"A" TO ASCBLANK$ 6670 letters%(a%-ASC"A",2)=VALFN_message(CHR$a%+"@") 6680 NEXT a% 6690 6700 PROC_init_task 6710 PROC_init_sprites 6720 PROC_init_windows 6730 PROC_init_tiles 6740 PROC_init_menus 6750 6760 PROC_opt_read_file(".Options") 6770ENDPROC 6780 6790 6800DEF PROC_init_task 6810 taskname$=FN_message("taskname") 6820 !wimpspace%=0 6830 SYS "Wimp_Initialise",380,&4B534154,taskname$,wimpspace% TO ,task% 6840 !wimpspace%=-1:wimpspace%!4=0:wimpspace%!8=0 6850 wimpspace%!12=68:wimpspace%!16=68:wimpspace%!20=&3002 6860 $(wimpspace%+24)=FN_message("taskicon") 6870 SYS"Wimp_CreateIcon",,wimpspace% TO ihand% 6880ENDPROC 6890 6900 6910DEF PROC_init_sprites 6920 file%=OPENIN(FN_message("spriteset")) 6930 size%=EXT#file% 6940 CLOSE#file% 6950 !grfxspace%=size%+4+620*27 6960 grfxspace%!8=16 6970 SYS "OS_SpriteOp",256+9,grfxspace% 6980 SYS "OS_SpriteOp",256+10,grfxspace%,FN_message("spriteset") 6990 FOR a%=ASC"A" TO ASC"[" 7000 SYS "OS_SpriteOp",256+27,grfxspace%,"0",CHR$a% 7010 NEXT a% 7020ENDPROC 7030 7040 7050DEF PROC_init_windows 7060 SYS "Wimp_OpenTemplate",,".Templates" 7070 7080 Info_Window%=FN_wind_create("Info") 7090 Board_Window%=FN_wind_create("Board") 7100 Control_Window%=FN_wind_create("Controls") 7110 Save_Window%=FN_wind_create("SaveAs") 7120 7130 FOR a%=1 TO 4 7140 SYS "Wimp_LoadTemplate",,wimpspace%,workspace%,work_top%,fontspace%,"Player",0 TO ,,workspace% 7150 wimpspace%!64=grfxspace% 7160 wimpspace%?70=1:wimpspace%?71=0 7170 wimpspace%!4=wimpspace%!4-120*a%+120 7180 wimpspace%!12=wimpspace%!4+68 7190 Player_Data%(a%,2)=wimpspace%!72 7200 SYS "Wimp_CreateWindow",,wimpspace% TO Player_Data%(a%,1) 7210 SYS "Wimp_LoadTemplate",,wimpspace%,workspace%,work_top%,fontspace%,"Scores",0 TO ,,workspace% 7220 SYS "Wimp_CreateWindow",,wimpspace% TO Player_Data%(a%,12) 7230 NEXT a% 7240 Player_Data%(0,1)=Board_Window% 7250 7260 SYS "Wimp_CloseTemplate" 7270 7280 wimpspace%!0=Board_Window% 7290 SYS "Wimp_GetWindowInfo",,wimpspace%+1 7300 First_Tile%=(wimpspace%!88)-1 7310 7320 FOR Curr_Player%=1 TO 4 7330 FOR p%=0 TO 7 7340 PROC_rack_clear_pos(p%) 7350 NEXT p% 7360 NEXT Curr_Player% 7370 Curr_Player%=0 7380 7390 PROC_icon_text_set(Info_Window%,0,FN_message("name")) 7400 PROC_icon_text_set(Info_Window%,1,FN_message("purpose")) 7410 PROC_icon_text_set(Info_Window%,2,FN_message("author")) 7420 PROC_icon_text_set(Info_Window%,3,FN_message("version")+" ("+FN_message("date")+")") 7430 7440 FOR a%=2 TO 10 7450 IF FN_message("opt_"+STR$a%)="" THEN 7460 PROC_icon_show(Board_Window%,GAME_OPT%+a%,FALSE) 7470 ELSE 7480 PROC_icon_text_set(Board_Window%,GAME_OPT%+a%,FN_message("opt_"+STR$a%)) 7490 ENDIF 7500 NEXT a% 7510 7520ENDPROC 7530 7540 7550DEF PROC_init_tiles 7560 IF Last_Tile%<>0 THEN 7570 wimpspace%!0=Board_Window% 7580 WHILE Last_Tile%>First_Tile% 7590 wimpspace%!4=Last_Tile% 7600 SYS "Wimp_DeleteIcon",,wimpspace% 7610 Last_Tile%-=1 7620 ENDWHILE 7630 ENDIF 7640 7650 tile_letter$="" 7660 FOR a%=0 TO 25 7670 tile_letter$=tile_letter$+STRING$(letters%(a%,1),CHR$(65+a%)) 7680 NEXT a% 7690 tile_letter$=tile_letter$+STRING$(letters%(26,1),BLANK$) 7700 tile_state$=STRING$(LENtile_letter$,IN_BAG$) 7710 7720 FOR a%=1 TO LENtile_letter$ 7730 wimpspace%!0=Board_Window% 7740 wimpspace%!4=0 7750 wimpspace%!8=0 7760 wimpspace%!12=0 7770 wimpspace%!16=0 7780 wimpspace%!20=2+6*2^12 7790 $(wimpspace%+24)=FN_tile_letter(a%) 7800 SYS "Wimp_CreateIcon",,wimpspace% TO Last_Tile% 7810 PROC_tile_in_bag(Last_Tile%-First_Tile%) 7820 NEXT a% 7830 tile_state$=STRING$(LENtile_letter$,IN_BAG$) 7840ENDPROC 7850 7860 7870DEF PROC_init_menus 7880 Options_Menu%=FN_menu_create(FN_message("menu_opts")) 7890 Arrange_Menu%=FN_menu_create(FN_message("menu_layo")) 7900 Rack_Menu%=FN_menu_create(FN_message("menu_rack")) 7910 Icon_Bar_Menu%=FN_menu_create(FN_message("menu_ibar")) 7920 !(Icon_Bar_Menu%+32)=Info_Window% 7930 7940 Main_Menu%=FN_menu_create(FN_message("menu_main")) 7950 !(Main_Menu%+32)=Info_Window% 7960 !(Main_Menu%+32+48)=Options_Menu% 7970 !(Main_Menu%+32+72)=Save_Window% 7980 !(Main_Menu%+32+96)=Arrange_Menu% 7990 8000Tile_Value_Menu%=FN_menu_create(FN_message("menu_tile")) 8010 !(Tile_Value_Menu%+20)=52 8020 FOR a%=0 TO 10 8030 a$=STR$a% 8040 SYS "XOS_SpriteOp",256+24,grfxspace%,a$ TO ,,b% 8050 !(Tile_Value_Menu%+28+24*a%+8)=&0700010A 8060 !(Tile_Value_Menu%+28+24*a%+12)=b% 8070 !(Tile_Value_Menu%+28+24*a%+16)=grfxspace% 8080 !(Tile_Value_Menu%+28+24*a%+20)=0 8090 NEXT a% 8100 8110 Font_Menu%=menuspace% 8120 SYS "Font_ListFonts",,Font_Menu%,%101100*2^16,menu_top%-menuspace%,workspace%,work_top%-workspace%,0 TO ,,,a%,,b% 8130 REMPROCtrace(STR$a%+" on to "+ STR$menuspace% + " (top is "+ STR$menu_top%+")") 8140 REMPROCtrace(STR$b%+" on to "+ STR$workspace% + " (top is "+ STR$work_top%+")") 8150 menuspace%+=a% 8160 workspace%+=b% 8170 8180 8190ENDPROC 8200 8210 8220 8230 8240 8250 8260 8270REM ============ GAME CONTROL ROUTINES ============= 8280 8290DEF PROC_game_off 8300 SYS "Hourglass_Smash" 8310 Curr_Player%=0 8320 PROC_icon_flag_set(Control_Window%,1,2^22,2^22) 8330 PROC_icon_text_set(Control_Window%,2,FN_message("game_off1")) 8340 !(Main_Menu%+28+48+8)=&07000001 : REM activate the options submenu 8350 $(Main_Menu%+28+24+12)=FN_message("game_off1") 8360 PROC_wind_open_board(MAIN_PAGE%) 8370ENDPROC 8380 8390 8400 8410DEF PROC_game_on 8420 PROC_icon_flag_set(Control_Window%,1,0,2^22) 8430 PROC_icon_text_set(Control_Window%,2,FN_message("game_on01")) 8440 !(Main_Menu%+28+48+8)=&07400001 : REM grey out the options submenu 8450 $(Main_Menu%+28+24+12)=FN_message("game_on00") 8460 PROC_wind_open_board(MAIN_PAGE%) 8470ENDPROC 8480 8490 8500 8510DEF PROC_game_start 8520 PROC_init_tiles 8530 8540 REM ==== Set Bag Icon to activate or not ==== 8550 IF FN_icon_flag(Board_Window%,GAME_OPT%+9,21) THEN 8560 PROC_icon_flag_set(Control_Window%,1,&0000B000,&0020F000) 8570 ELSE 8580 PROC_icon_flag_set(Control_Window%,1,&00000000,&0020F000) 8590 ENDIF 8600 8610 REM ==== Clear the board ==== 8620 FOR a%=0 TO 14 8630 FOR b%=0 TO 14 8640 Board_Tiles%(a%,b%)=0 8650 NEXT b% 8660 NEXT a% 8670 8680 REM ==== Reset player info ==== 8690 FOR Curr_Player%=1 TO 4 8700 PROC_player_history_clear 8710 PROC_player_score_set(0) 8720 FOR b%=0 TO 7:PROC_rack_clear_pos(b%):NEXT b% 8730 IF $FN_player_name(Curr_Player%)<>"" THEN b%=FN_rack_replenish 8740 NEXT Curr_Player% 8750 8760 REM ==== Choose a random player ==== 8770 Curr_Player%=RND(4) 8780 REPEAT 8790 Curr_Player%+=1 8800 IF Curr_Player%=5 THEN Curr_Player%=1 8810 UNTIL $FN_player_name(Curr_Player%)<>"" 8820 8830 passes%=0 8840 PROC_wind_open_board(MAIN_PAGE%) 8850 PROC_wind_redraw_all 8860 PROC_game_on 8870 PROC_game_start_turn 8880ENDPROC 8890 8900 8910 8920DEF PROC_game_start_turn 8930 IF FN_player_is_computer THEN 8940 SYS "Hourglass_Start",1 8950 PROC_comp_play 8960 PROC_game_status 8970 blanks_in_play%=0 8980 ELSE 8990 SYS "Hourglass_Smash" 9000 blanks_in_play%=0 9010 PROC_wind_open_panes 9020 PROC_wind_open_racks 9030 ENDIF 9040ENDPROC 9050 9060 9070 9080DEF PROC_game_end_turn 9090 PROC_game_status 9100 a%=FN_score_tiles 9110 IF a%=0 AND INSTR(tile_state$,IN_PLAY$) THEN 9120 VDU 7 9130 PROC_rack_reset 9140 ELSE 9150 IF a%=0 THEN 9160 IF INSTR(tile_state$,BINNED$)=0 THEN 9170 passes%+=1 9180 Words$=FN_message("game_pass") 9190 ELSE 9200 passes%=0 9210 Words$=FN_message("game_exch") 9220 ENDIF 9230 ELSE 9240 passes%=0 9250 ENDIF 9260 PROC_player_history_add(LEFT$(Words$, INSTR(Words$+",", ",")-1),a%) 9270 PROC_comp_inc_player_score(a%) 9280 PROC_wind_redraw_rack_title(Curr_Player%) 9290 PROC_wind_redraw(FN_player_history(Curr_Player%)) 9300 9310 REM ==== Freeze tiles on the board ===== 9320 WHILE INSTR(tile_state$,IN_PLAY$) 9330 a%=INSTR(tile_state$,IN_PLAY$) 9340 IF FN_tile_letter(a%)>BLANK$ THEN 9350 PROC_icon_flag_set(Board_Window%,a%+First_Tile%,2^22,15*2^12+2^22) 9360 ELSE 9370 PROC_icon_flag_set(Board_Window%,a%+First_Tile%,0,15*2^12) 9380 ENDIF 9390 MID$(tile_state$,INSTR(tile_state$,IN_PLAY$),1)=PLAYED$ 9400 ENDWHILE 9410 9420 REM ==== Or return them to bag fully ==== 9430 WHILE INSTR(tile_state$,BINNED$) 9440 MID$(tile_state$,INSTR(tile_state$,BINNED$),1)=IN_BAG$ 9450 ENDWHILE 9460 9470 REM ==== Get new tiles from the rack ==== 9480 9490 IF FN_rack_replenish=0 OR passes%>3 THEN 9500 PROC_game_end 9510 ELSE 9520 9530 REPEAT 9540 Curr_Player%+=1 9550 IF Curr_Player%=5 THEN Curr_Player%=1 9560 UNTIL $FN_player_name(Curr_Player%)<>"" 9570 PROC_game_start_turn 9580 ENDIF 9590 9600 ENDIF 9610ENDPROC 9620 9630 9640 9650DEF PROC_game_end 9660 IF FN_icon_flag(Board_Window%,GAME_OPT%+2,21) THEN PROC_game_end_tiles 9670 hi%=0 9680 wins%=0 9690 a$="" 9700 FOR Curr_Player%=1 TO 4 9710 IF Player_Data%(Curr_Player%,0)=hi% THEN 9720 wins%+=1 9730 a$=FN_message_sub("game_win2", a$, $FN_player_name(Curr_Player%)) 9740 ENDIF 9750 IF Player_Data%(Curr_Player%,0)>hi% THEN 9760 hi%=Player_Data%(Curr_Player%,0):wins%=1 9770 a$=$FN_player_name(Curr_Player%) 9780 ENDIF 9790 NEXT Curr_Player% 9800 IF wins%>1 THEN 9810 a$=FN_message_sub("game_win3",a$, "") 9820 ELSE 9830 a$=FN_message_sub("game_win1",a$, "") 9840 ENDIF 9850 VDU 7 9860 PROC_game_off 9870 PROC_game_text(a$) 9880 PROC_wind_redraw_all 9890ENDPROC 9900 9910 9920 9930DEF PROC_game_end_tiles 9940 leftovers%=0 9950 tmp%=Curr_Player% 9960 FOR Curr_Player%=1 TO 4 9970 leftover%=0 9980 leftover$="" 9990 FOR a%=0 TO 7 10000 IF FN_rack_tile(a%) THEN 10010 leftover%+=FN_tile_value(FN_rack_tile(a%)) 10020 leftover$+=FN_rack_letter(a%) 10030 ENDIF 10040 NEXT a% 10050 IF leftover% THEN 10060 PROC_player_history_add("-"+leftover$,-leftover%) 10070 PROC_comp_inc_player_score(-leftover%) 10080 ENDIF 10090 leftovers%+=leftover% 10100 NEXT Curr_Player% 10110 IF passes%<4 THEN 10120 Curr_Player%=tmp% 10130 PROC_player_history_add(FN_message("game_fins"),leftovers%) 10140 PROC_comp_inc_player_score(leftovers%) 10150 ENDIF 10160ENDPROC 10170 10180 10190 10200 10210DEF PROC_game_status 10220 LOCAL a% 10230 FOR a%=4 TO 17 10240 PROC_icon_show(Control_Window%,a%,Board_Page%=SQUARES_PAGE%) 10250 NEXT a% 10260 CASE Board_Page% OF 10270 WHEN MAIN_PAGE%: 10280 IF Curr_Player%=0 THEN 10290 PROC_game_text(FN_message("game_off0")) :REM("Click 'New Game' to start...") 10300 ELSE 10310 a%= FN_score_tiles 10320 IF a% THEN 10330 WHILE INSTR(Words$, BLANK$) 10340 MID$(Words$,INSTR(Words$, BLANK$))="_" 10350 ENDWHILE 10360 PROC_game_text(FN_message_sub("game_trn4",Words$, STR$(a%))) 10370 ELSE 10380 IF INSTR(tile_state$,IN_PLAY$) THEN 10390 PROC_game_text(FN_message_sub("game_trn2", $FN_player_name(Curr_Player%), "")) 10400 ELSE 10410 IF INSTR(tile_state$,BINNED$) THEN 10420 PROC_game_text(FN_message_sub("game_trn3", $FN_player_name(Curr_Player%), "")) 10430 ELSE 10440 PROC_game_text(FN_message_sub("game_trn1", $FN_player_name(Curr_Player%), "")) 10450 ENDIF 10460 ENDIF 10470 ENDIF 10480 ENDIF 10490 WHEN SQUARES_PAGE%: 10500 IF $FN_icon_text(Control_Window%,3)<>"" THEN PROC_game_text("") 10510 WHEN TILES_PAGE%: 10520 PROC_game_text(FN_message("misc_til0")) 10530 WHEN OPTIONS_PAGE%: 10540 PROC_game_text(FN_message("misc_opt0")) 10550 ENDCASE 10560ENDPROC 10570 10580 10590 10600DEF PROC_game_text(a$) 10610 CASE Board_Page% OF 10620 WHEN MAIN_PAGE%, BAG_PAGE%: a%=0 10630 OTHERWISE: a%=3 10640 ENDCASE 10650 IF LENa$>99 THEN a$=RIGHT$(a$,99) 10660 PROC_icon_text_set(Control_Window%,a%,a$) 10670ENDPROC 10680 10690 10700 10710 10720 10730 10740 10750REM ======== DRAG ROUTINES ========= 10760 10770DEF PROC_drag_start(max%) 10780 IF wind_drag%=Board_Window% THEN 10790 PROC_tile_pos(FN_icon_tile(icon_drag%),x%,y%) 10800 WHILE y%<15 AND x%<15 AND max% 10810 IF Board_Tiles%(y%,x%)<>0 AND FN_tile_state(Board_Tiles%(y%,x%))=IN_PLAY$ THEN 10820 PROC_drag_tile(Board_Tiles%(y%,x%)) 10830 PROC_tile_remove_from_board(Board_Tiles%(y%,x%)) 10840 max%-=1 10850 ENDIF 10860 IF FN_drag_dir=VERTICAL% THEN y%+=1 ELSE x%+=1 10870 ENDWHILE 10880 ENDIF 10890 10900 IF wind_drag%=FN_active_rack THEN 10910 WHILE icon_drag%+FN_drag_no<=8 AND FN_rack_tile(icon_drag%+FN_drag_no)<>0 AND max% 10920 PROC_drag_tile(FN_rack_tile(icon_drag%+FN_drag_no)) 10930 PROC_rack_clear_pos(icon_drag%+FN_drag_no-1) 10940 max%-=1 10950 ENDWHILE 10960 ENDIF 10970 10980 IF FN_drag_no=1 THEN 10990 PROC_drag_icon 11000 ELSE 11010 PROC_drag_block 11020 ENDIF 11030ENDPROC 11040 11050 11060 11070DEF PROC_drag_icon 11080 wimpspace%!0=wind_drag% 11090 wimpspace%!4=icon_drag% 11100 SYS "Wimp_GetIconState",,wimpspace% 11110 IF (wimpspace%!24 AND 256)=256 THEN 11120 a%=wimpspace%!32+1 11130 ELSE 11140 a%=wimpspace%+28 11150 ENDIF 11160 IF INSTR($a%,"file") THEN 11170 a%+=INSTR($a%,"file")-1 11180 b%=1:d%=%011000101 11190 ELSE 11200 b%=grfxspace%:d%=%101000101: 11210 ENDIF 11220 wimpspace%!0=mouse_x%+10 11230 wimpspace%!4=mouse_y%+10 11240 wimpspace%!8=mouse_x%+10 11250 wimpspace%!12=mouse_y%+10 11260 SYS "DragASprite_Start",d%,b%,a%,wimpspace% 11270 PROC_icon_show(wind_drag%,icon_drag%,FALSE) 11280ENDPROC 11290 11300 11310 11320DEF PROC_drag_block 11330 IF FN_drag_no>1 THEN 11340 SYS "Wimp_GetPointerInfo",,wimpspace% 11350 mouse_x%=wimpspace%!0 11360 mouse_y%=wimpspace%!4 11370 11380 wimpspace%!4=5 11390 wimpspace%!8=mouse_x%-24 11400 IF FN_drag_dir=VERTICAL% THEN 11410 wimpspace%!12=mouse_y%+24-48*FN_drag_no 11420 wimpspace%!16=wimpspace%!8+48 11430 wimpspace%!20=mouse_y%+24 11440 ELSE 11450 wimpspace%!12=mouse_y%-24 11460 wimpspace%!16=wimpspace%!8+48*FN_drag_no 11470 wimpspace%!20=wimpspace%!12+48 11480 ENDIF 11490 wimpspace%!24=0 11500 wimpspace%!28=-400 11510 wimpspace%!32=2560 11520 wimpspace%!36=2048 11530 11540 SYS "Wimp_DragBox",,-1 11550 SYS "Wimp_DragBox",,wimpspace% 11560 ENDIF 11570ENDPROC 11580 11590 11600 11610DEF PROC_drag_end 11620 mouse_x%=wimpspace%!_MOUSEX% 11630 mouse_y%=wimpspace%!_MOUSEY% 11640 SYS"Wimp_GetPointerInfo",,wimpspace% 11650 wind_target%=wimpspace%!_WINDOW% 11660 icon_target%=wimpspace%!_ICON% 11670 IF wind_target%>0 THEN SYS"Wimp_GetWindowState",,wimpspace%+_WINDOW% 11680 11690 CASE wind_drag% OF 11700 WHEN FN_active_rack, Board_Window%: REM -- DRAG FROM RACK or BOARD -- 11710 CASE wind_target% OF 11720 WHEN FN_active_rack: PROC_drag_to_rack 11730 WHEN Board_Window%: 11740 CASE Board_Page% OF 11750 WHEN MAIN_PAGE%: PROC_drag_to_board 11760 WHEN BAG_PAGE% : 11770 SYS "OS_Byte",121,&85 TO ,a% 11780 IF icon_target%>First_Tile% AND a%=&FF THEN 11790 VDU7 11800 PROC_drag_swap_cheat 11810 ELSE 11820 PROC_drag_to_bag 11830 ENDIF 11840 OTHERWISE: PROC_drag_failed 11850 ENDCASE 11860 WHEN Control_Window%: 11870 IF icon_target%=1 THEN 11880 PROC_drag_to_bag 11890 ELSE 11900 PROC_drag_failed 11910 ENDIF 11920 OTHERWISE: 11930 CASE icon_drag% OF 11940 WHEN 54: REM lexicon 11950 PROC_wimp_save_to("Lexicon",2.5*(lex_area2%-lex1space%)) 11960 WHEN 56: REM house lexicon 11970 PROC_wimp_save_to("LexiconH",1.5*(lex_area_size%-(lex_area2%-lex1space%))) 11980 ENDCASE 11990 PROC_drag_failed 12000 ENDCASE 12010 12020 WHEN Control_Window%: REM -- DRAG FROM CONTROL -- 12030 CASE Board_Page% OF 12040 WHEN SQUARES_PAGE%: 12050 IF wind_target%=Board_Window% THEN PROC_opt_alter_squares 12060 PROC_drag_failed 12070 12080 WHEN MAIN_PAGE%: 12090 PROC_drag_blank(icon_target%-First_Tile%,CHR$(icon_drag%+77)) 12100 PROC_drag_failed 12110 ENDCASE 12120 12130 WHEN Save_Window%: 12140 a$=FN_wimp_path_leaf($FN_icon_text(Save_Window%,2)) 12150 PROC_wimp_save_to(a$,20) 12160 PROC_drag_failed 12170 12180 OTHERWISE: REM -- CATCH OTHERS?? -- 12190 IF icon_drag%>1 THEN PROC_drag_failed 12200 12210 ENDCASE 12220 PROC_game_status 12230ENDPROC 12240 12250 12260 12270DEF PROC_drag_failed 12280 IF FN_drag_no=0 THEN 12290 PROC_icon_show(wind_drag%,icon_drag%,TRUE) 12300 ELSE 12310 IF wind_drag%=Board_Window% THEN icon_drag%=0 12320 c%=0 12330 WHILE c%7-FN_drag_no THEN pos%=8-FN_drag_no 13090 WHILE c%Board_H%/2+7 THEN 13330 mouse_y%=8-Board_H%/2 13340 mouse_x%+=1 13350 IF mouse_x%>Board_W%/2+7 THEN mouse_x%=8-Board_W%/2 13360 ENDIF 13370 IF mouse_x%>Board_W%/2+7 THEN 13380 mouse_x%=8-Board_W%/2 13390 mouse_y%+=1 13400 IF mouse_y%>Board_H%/2+7 THEN mouse_y%=8-Board_H%/2 13410 ENDIF 13420 ENDWHILE 13430 PROC_drag_clear 13440 ENDIF 13450ENDPROC 13460 13470 13480 13490DEF PROC_drag_clear 13500 Player_Data%(0,2)=0 13510ENDPROC 13520 13530 13540 13550DEF FN_drag_no 13560=Player_Data%(0,2) 13570 13580 13590 13600DEF FN_dragged_tile(p%) 13610=Player_Data%(0,3+p%) 13620 13630 13640DEF FN_drag_dir 13650 LOCAL a% 13660 a%=VERTICAL% 13670 IF FN_menu_is_ticked(Rack_Menu%,0) THEN a%=HORIZONTAL% 13680=a% 13690 13700 13710DEF PROC_drag_dir_set(a%) 13720 PROC_menu_untick(Rack_Menu%,0) 13730 PROC_menu_untick(Rack_Menu%,1) 13740 IF a%=HORIZONTAL% THEN 13750 PROC_menu_tick(Rack_Menu%,0) 13760 ELSE 13770 PROC_menu_tick(Rack_Menu%,1) 13780 ENDIF 13790ENDPROC 13800 13810 13820 13830 13840REM ======= RACK actions ======== 13850 13860DEF FN_rack_replenish 13870 LOCAL c%,pos%,t% 13880 pos%=7 13890 WHILE FN_rack_tile(pos%)<>0 13900 c%+=1 13910 pos%-=1 13920 ENDWHILE 13930 pos%-=1 13940 13950 WHILE pos%>-1 13960 IF FN_rack_tile(pos%) THEN 13970 c%+=1 13980 ELSE 13990 IF INSTR(tile_state$,IN_BAG$) THEN 14000 REPEAT:t%=RND(LENtile_letter$):UNTIL FN_tile_state(t%)=IN_BAG$ 14010 PROC_rack_set_pos(pos%,t%) 14020 c%+=1 14030 ENDIF 14040 ENDIF 14050 pos%-=1 14060 ENDWHILE 14070=c% 14080 14090 14100 14110DEF PROC_rack_reset 14120 LOCAL a%,t% 14130 IF Curr_Player%=0 THEN ENDPROC 14140 WHILE INSTR(tile_state$,IN_PLAY$) 14150 t%=INSTR(tile_state$,IN_PLAY$) 14160 PROC_tile_remove_from_board(t%) 14170 a%=0 14180 WHILE FN_rack_tile(a%) 14190 a%+=1 14200 ENDWHILE 14210 PROC_rack_set_pos(a%,t%) 14220 ENDWHILE 14230 14240 WHILE INSTR(tile_state$,BINNED$) 14250 t%=INSTR(tile_state$,BINNED$) 14260 a%=0 14270 WHILE FN_rack_tile(a%) 14280 a%+=1 14290 ENDWHILE 14300 PROC_rack_set_pos(a%,t%) 14310 ENDWHILE 14320 PROC_game_status 14330ENDPROC 14340 14350 14360 14370DEF PROC_rack_juggle 14380 LOCAL pos%,pos2%,pos2tile%,c% 14390 IF Curr_Player%=0 ENDPROC 14400 14410 FOR c%=0 TO 7 14420 IF FN_rack_tile(c%) THEN 14430 PROC_rack_set_pos(pos%,FN_rack_tile(c%)) 14440 pos%+=1 14450 ENDIF 14460 NEXT c% 14470 14480 FOR c%=pos% TO 7 14490 PROC_rack_clear_pos(c%) 14500 NEXT c% 14510 14520 IF pos%>1 THEN 14530 FOR c%=0 TO pos%-2 14540 IF c%=pos%-2 THEN pos2%=pos%-1 ELSE pos2%=c%+RND(pos%-c%-1) 14550 pos2tile%=FN_rack_tile(pos2%) 14560 PROC_rack_set_pos(pos2%,FN_rack_tile(c%)) 14570 PROC_rack_set_pos(c%,pos2tile%) 14580 NEXT c% 14590 ENDIF 14600ENDPROC 14610 14620 14630 14640DEF PROC_rack_shuffle(pos%) 14650 a%=pos% 14660 shuffledir%=0 14670 WHILE (FN_rack_tile(a%)) AND a%>0 14680 a%-=1 14690 ENDWHILE 14700 IF FN_rack_tile(a%) THEN 14710 a%=pos% 14720 WHILE FN_rack_tile(a%) 14730 a%+=1 14740 ENDWHILE 14750 shuffledir%=-1 14760 ELSE 14770 shuffledir%=+1 14780 ENDIF 14790 WHILE a%<>pos% 14800 PROC_rack_set_pos(a%,FN_rack_tile(a%+shuffledir%)) 14810 a%=a%+shuffledir% 14820 ENDWHILE 14830ENDPROC 14840 14850 14860 14870DEF PROC_rack_set_pos(pos%,tile%) 14880 MID$(tile_state$,tile%,1)=IN_RACK$ 14890 PROC_rack_tile_set(pos%,tile%) 14900 wimpspace%!0=FN_active_rack 14910 wimpspace%!4=pos% 14920 SYS "Wimp_GetIconState",,wimpspace% 14930 14940 IF FN_player_is_computer AND FN_icon_flag(Board_Window%,GAME_OPT%+7,21) THEN 14950 $(wimpspace%!32)="S0" 14960 ELSE 14970 $(wimpspace%!32)="S"+FN_tile_letter(tile%) 14980 ENDIF 14990 15000 PROC_icon_show(FN_active_rack,pos%,TRUE) 15010 PROC_icon_show(Board_Window%,tile%+First_Tile%,FALSE) 15020ENDPROC 15030 15040 15050 15060DEF PROC_rack_clear_pos(pos%) 15070 PROC_rack_tile_set(pos%,0) 15080 PROC_icon_show(FN_active_rack,pos%,FALSE) 15090ENDPROC 15100 15110 15120 15130 15140 15150 15160 15170 15180REM ======= TILE actions ========= 15190 15200DEF PROC_tile_remove_from_board(t%) 15210 IF FN_tile_letter(t%)>BLANK$ THEN 15220 wimpspace%!0=Board_Window% 15230 wimpspace%!4=t%+First_Tile% 15240 SYS "Wimp_GetIconState",,wimpspace% 15250 SYS "Wimp_DeleteIcon",,wimpspace% 15260 wimpspace%!4=Board_Window% 15270 wimpspace%!24=2+6*2^12 15280 $(wimpspace%+28)=BLANK$ 15290 SYS "Wimp_CreateIcon",,wimpspace%+4 TO new_icon% 15300 MID$(tile_letter$, t%,1)=BLANK$ 15310 blanks_in_play%+=1 15320 ENDIF 15330 IF FN_tile_letter(t%)=BLANK$ THEN 15340 blanks_in_play%-=1 15350 IF blanks_in_play%=0 THEN PROC_wind_open_panes 15360 ENDIF 15370 PROC_icon_show(Board_Window%,t%+First_Tile%,FALSE) 15380 PROC_tile_pos(t%,x%,y%) 15390 Board_Tiles%(y%,x%)=0 15400ENDPROC 15410 15420 15430 15440DEF PROC_tile_place_on_board(x%,y%,t%) 15450 IF FN_tile_letter(t%)=BLANK$ THEN blanks_in_play%+=1 15460 Board_Tiles%(y%,x%)=t% 15470 MID$(tile_state$,t%,1)=IN_PLAY$ 15480 SYS "Wimp_ResizeIcon",Board_Window%,t%+First_Tile%,x%*48+16,-y%*48-64,x%*48+64,-y%*48-16 15490 PROC_icon_refresh(Board_Window%,t%+First_Tile%) 15500ENDPROC 15510 15520 15530 15540DEF PROC_tile_in_bag(t%) 15550 LOCAL x%, y% 15560 MID$(tile_state$,t%,1)=BINNED$ 15570 t%-=1 15580 x%=782+(t% MOD 12)*58 15590 y%=-79-INT(t%/12)*58 15600 t%+=1 15610 SYS "Wimp_ResizeIcon",Board_Window%,t%+First_Tile%,x%,y%,x%+48,y%+48 15620 PROC_icon_refresh(Board_Window%,t%+First_Tile%) 15630ENDPROC 15640 15650 15660 15670 15680 15690 15700 15710 15720 15730 15740REM ===== DATA manipulation ===== 15750 15760 15770DEF FN_player_name(a%) 15780=FN_icon_text(Board_Window%,49+a%) 15790 15800 15810DEF FN_player_is_computer 15820=ASC(RIGHT$($FN_player_name(Curr_Player%)))>47 AND ASC(RIGHT$($FN_player_name(Curr_Player%)))<58 15830 15840 15850DEF FN_player_level 15860=VAL(RIGHT$($FN_player_name(Curr_Player%))) 15870 15880 15890DEF FN_player_history(a%) 15900=Player_Data%(a%,12) 15910 15920 15930DEF PROC_player_history_clear 15940 FOR b%=0 TO 45 15950 Player_History$(Curr_Player%,b%)="" 15960 Player_History%(Curr_Player%,b%)=0 15970 NEXT b% 15980 wimpspace%!100=0 : wimpspace%!104=-392 15990 wimpspace%!108=394 : wimpspace%!112=0 16000 SYS "Wimp_SetExtent",FN_player_history(Curr_Player%),wimpspace%+100 16010ENDPROC 16020 16030 16040DEF PROC_player_history_add(a$,a%) 16050 c%=0 16060 WHILE Player_History$(Curr_Player%,c%)<>"": c%+=1:ENDWHILE 16070 Player_History$(Curr_Player%,c%)=a$ 16080 Player_History%(Curr_Player%,c%)=a% 16090 16100 wimpspace%!100=0 : wimpspace%!104=-c%*38-12-38 16110 wimpspace%!108=394 : wimpspace%!112=0 16120 SYS "Wimp_SetExtent",FN_player_history(Curr_Player%),wimpspace%+100 16130 16140 wimpspace%!100=FN_player_history(Curr_Player%) 16150 SYS "Wimp_GetWindowState",,wimpspace%+100 16160 IF wimpspace%!132 AND 2^16 THEN 16170 wimpspace%!124-=38 16180 SYS "Wimp_OpenWindow",,wimpspace%+100 16190 ENDIF 16200ENDPROC 16210 16220 16230 16240DEF PROC_player_score_set(a%) 16250 Player_Data%(Curr_Player%,0)=a% 16260ENDPROC 16270 16280 16290DEF PROC_comp_inc_player_score(a%) 16300 Player_Data%(Curr_Player%,0)+=a% 16310ENDPROC 16320 16330 16340 16350DEF FN_rack(a%) 16360=Player_Data%(a%,1) 16370 16380 16390DEF FN_active_window 16400=FN_rack(Curr_Player%) 16410 16420 16430DEF FN_active_rack 16440 LOCAL a% 16450 a%=FN_active_window 16460 IF Curr_Player%=0 THEN a%=0 16470=a% 16480 16490 16500 16510DEF FN_rack_tile(pos%) 16520=Player_Data%(Curr_Player%,3+pos%) 16530 16540 16550DEF PROC_rack_tile_set(pos%,t%) 16560 Player_Data%(Curr_Player%,3+pos%)=t% 16570ENDPROC 16580 16590 16600DEF FN_rack_letter(pos%) 16610 LOCAL a$ 16620 IF FN_rack_tile(pos%) THEN 16630 a$=FN_tile_letter(FN_rack_tile(pos%)) 16640 ELSE 16650 a$="" 16660 ENDIF 16670=a$ 16680 16690 16700 16710DEF FN_board_letter(a%,d%) 16720 LOCAL a$ 16730 IF a%<15 AND a%>-1 AND d%<15 AND d%>-1 THEN 16740 IF Board_Tiles%(d%,a%)=0 THEN 16750 a$="" 16760 ELSE 16770 a$=FN_tile_letter(Board_Tiles%(d%,a%)) 16780 IF a$>"Z" THEN a$=CHR$(ASCa$-32) 16790 ENDIF 16800 ENDIF 16810=a$ 16820 16830 16840 16850DEF FN_tile_state(t%) 16860 LOCAL a$ 16870 a$=MID$(tile_state$,t%,1) 16880 IF t%=0 THEN a$="" 16890=a$ 16900 16910 16920DEF FN_tile_letter(t%) 16930 LOCAL a$ 16940 a$=MID$(tile_letter$,t%,1) 16950 IF t%=0 THEN a$="" 16960=a$ 16970 16980 16990DEF FN_tile_value(t%) 17000 LOCAL value% 17010 IF FN_tile_letter(t%)20 THEN y%-=50 17240ENDPROC 17250 17260 17270 17280DEF FN_read_square(x%,y%) 17290 IF x%>7 THEN x%=14-x% 17300 IF y%>7 THEN y%=14-y% 17310=MID$(Board_Squares$(y%),x%*2+1,2) 17320 17330 17340 17350DEF PROC_mouse_to_board_pos(RETURN x%, RETURN y%,bound%) 17360 wimpspace%!0=Board_Window% 17370 SYS"Wimp_GetWindowState",,wimpspace% 17380 IF FN_drag_no>1 THEN x%+=24 17390 x%=(x%-wimpspace%!4-16)/48 17400 IF bound% THEN 17410 IF x%<8-Board_W%/2 THEN x%=8-Board_W%/2 17420 IF x%>7+Board_W%/2 THEN x%=7+Board_W%/2 17430 ENDIF 17440 17450 IF FN_drag_no>1 THEN y%+=24 17460 y%=-(y%-wimpspace%!16+wimpspace%!24+16)/48 17470 17480 IF FN_drag_no>1 AND FN_drag_dir=VERTICAL% THEN y%-=FN_drag_no-1 17490 IF bound% THEN 17500 IF y%<8-Board_H%/2 THEN y%=8-Board_H%/2 17510 IF y%>7+Board_H%/2 THEN y%=7+Board_H%/2 17520 ENDIF 17530ENDPROC 17540 17550 17560 17570DEF FN_mouse_to_rack_pos 17580 wimpspace%!0=FN_active_rack 17590 SYS"Wimp_GetWindowState",,wimpspace% 17600 IF FN_drag_no>1 THEN mouse_x%+=24 17610=(mouse_x%-wimpspace%!4+wimpspace%!20-8)/52 17620 17630 17640 17650 17660 17670 17680 17690 17700REM ==== SCORING ==== 17710 17720DEF FN_score_tiles 17730 LOCAL tiles_score%, tile1%, tile2%, x1%, x2%, y1%, y2% 17740 Words$="" 17750 tiles_score%=0 17760 17770 tile1%=INSTR(tile_state$,IN_PLAY$) 17780 17790 IF tile1% THEN 17800 Vert_Dir%=HORIZONTAL% 17810 PROC_tile_pos(tile1%,x1%,y1%) 17820 tile2%=tile1%+INSTR(MID$(tile_state$+" ",tile1%+1),IN_PLAY$) 17830 IF tile2% THEN 17840 PROC_tile_pos(tile2%,x2%,y2%) 17850 IF x1%=x2% THEN Vert_Dir%=VERTICAL% 17860 ENDIF 17870 17880 tiles_score%+=FN_score_word(x1%,y1%,Vert_Dir%) 17890 17900 IF Tiles_Used%=7 AND tiles_score% THEN tiles_score%+=VAL$FN_icon_text(Board_Window%,GAME_OPT%+1) 17910 17920 WHILE INSTR(MID$(tile_state$+" ",tile1%+1),IN_PLAY$) 17930 tile1%=tile1%+INSTR(MID$(tile_state$+" ",tile1%+1),IN_PLAY$) 17940 Tiles_Used%-=1 17950 ENDWHILE 17960 17970 IF Tiles_Used%<1 THEN tiles_score%=0 17980 17990 IF INSTR(tile_state$, PLAYED$) AND Tiles_Used%>0 THEN 18000 tiles_score%+=FN_score_word(x1%,y1%,NOT Vert_Dir%) 18010 tile1%=INSTR(tile_state$,IN_PLAY$) 18020 18030 WHILE INSTR(MID$(tile_state$+" ",tile1%+1),IN_PLAY$) 18040 tile2%=tile1%+INSTR(MID$(tile_state$+" ",tile1%+1),IN_PLAY$) 18050 PROC_tile_pos(tile2%,x2%,y2%) 18060 tiles_score%+=FN_score_word(x2%,y2%,NOT Vert_Dir%) 18070 tile1%=tile2% 18080 ENDWHILE 18090 ENDIF 18100 18110 ENDIF 18120=tiles_score% 18130 18140 18150 18160DEF FN_score_tiles_computer 18170 LOCAL tiles_score%, a%, x1%, y1% 18180 Words$="" 18190 tiles_score%=0 18200 tiles_score%+=FN_score_word(ac%,dn%,Vert_Dir%) 18210 IF Tiles_Used%=7 THEN tiles_score%+=VAL($FN_icon_text(Board_Window%,GAME_OPT%+1)) 18220 18230 x1%=ac%:y1%=dn% 18240 IF Vert_Dir% THEN y1%-=LENprefix$ ELSE x1%-=LENprefix$ 18250 FOR a%=1 TO LEN(prefix$+suffix$) 18260 tiles_score%+=FN_score_word(x1%,y1%, NOT Vert_Dir%) 18270 IF Vert_Dir% THEN y1%+=1 ELSE x1%+=1 18280 NEXT a% 18290=tiles_score% 18300 18310 18320 18330DEF FN_score_word(x%,y%,Vert_Dir%) 18340 LOCAL break%, Word$, word_score%, word_multiplier%, use_played_tile%, use_in_play_tile% 18350 LOCAL tile_score% 18360 18370 REM ===== find beginning of word ===== 18380 break%=TRUE 18390 WHILE (y%>-1 AND x%>-1 AND break%) 18400 IF Board_Tiles%(y%,x%) THEN 18410 IF Vert_Dir% THEN y%-=1 ELSE x%-=1 18420 ELSE 18430 break%=FALSE 18440 ENDIF 18450 ENDWHILE 18460 IF y%<0 THEN y%=0 18470 IF x%<0 THEN x%=0 18480 IF Board_Tiles%(y%,x%)=0 THEN 18490 IF Vert_Dir% THEN y%+=1 ELSE x%+=1 18500 ENDIF 18510 18520 IF INSTR(tile_state$, PLAYED$)=0 AND Board_Tiles%(7,7)<>0 THEN use_played_tile%=1 18530 word_multiplier%=1 18540 18550 REM ==== not a local variable ==== 18560 Tiles_Used%=0 18570 18580 WHILE (y%<15 AND x%<15) 18590 IF Board_Tiles%(y%,x%) THEN 18600 Word$=Word$+FN_tile_letter(Board_Tiles%(y%,x%)) 18610 tile_score%=FN_tile_value(Board_Tiles%(y%,x%)) 18620 IF FN_tile_state(Board_Tiles%(y%,x%))=PLAYED$ THEN use_played_tile%=1 18630 IF FN_tile_state(Board_Tiles%(y%,x%))=IN_PLAY$ THEN 18640 use_in_play_tile%=1 18650 Tiles_Used%+=1 18660 IF Vert_Dir% THEN 18670 IF x%>0 THEN IF FN_tile_state(Board_Tiles%(y%,x%-1))=PLAYED$ THEN use_played_tile%=1 18680 IF x%<14 THEN IF FN_tile_state(Board_Tiles%(y%,x%+1))=PLAYED$ THEN use_played_tile%=1 18690 ELSE 18700 IF y%>0 THEN IF FN_tile_state(Board_Tiles%(y%-1,x%))=PLAYED$ THEN use_played_tile%=1 18710 IF y%<14 THEN IF FN_tile_state(Board_Tiles%(y%+1,x%))=PLAYED$ THEN use_played_tile%=1 18720 ENDIF 18730 square$=FN_read_square(x%,y%) 18740 CASE RIGHT$(square$,1) OF 18750 WHEN "w": word_multiplier%=word_multiplier%*VAL(LEFT$(square$,1)) 18760 WHEN "l": tile_score%=tile_score%*VAL(LEFT$(square$,1)) 18770 OTHERWISE: REM ===== WHAT!!!! ===== 18780 ENDCASE 18790 ENDIF 18800 word_score%+=tile_score% 18810 ELSE 18820 x%=14:y%=14 18830 ENDIF 18840 IF Vert_Dir% THEN y%+=1 ELSE x%+=1 18850 ENDWHILE 18860 18870 word_score%=word_score%*word_multiplier%*use_played_tile%*use_in_play_tile%*-(LEN(Word$)>1) 18880 IF word_score% THEN 18890 IF Words$<>"" THEN Word$=", "+Word$ 18900 Words$+=Word$ 18910 ENDIF 18920= word_score% 18930 18940 18950 18960 18970 18980 18990 19000 19010 19020 19030 19040 19050 19060REM ======= C O M P U T E R P L A Y ======= 19070 19080 19090DEF PROC_comp_play 19100 LOCAL a$,a% 19110 best_play$="" 19120 best_play_x%=0 19130 best_play_y%=0 19140 best_play_V%=0 19150 best_play_s%=0 19160 19170 REM ===== Set the number of letters available in wd ====== 19180 FOR a%=0 TO 24 STEP 4 19190 !(xchk%+1800+a%)=0 19200 NEXT a% 19210 FOR a%=0 TO 7 19220 a$=FN_rack_letter(a%) 19230 IF a$<>"" THEN PROC_comp_inc_play(a$,1) 19240 NEXT a% 19250 19260 REM ===== Clear the crosscheck bytes ====== 19270 FOR a%=0 TO 1796 STEP 4 19280 xchk%!a%=0 19290 NEXT a% 19300 19310 JUST_THROW_SCORE%=0 19320 FOR a%=0 TO 7 19330 IF FN_rack_letter(a%)<>"" THEN 19340 IF letters%(ASCFN_rack_letter(a%)-ASC"A",2)<0 THEN 19350 JUST_THROW_SCORE%-=letters%(ASCFN_rack_letter(a%)-ASC"A",2) 19360 ENDIF 19370 ENDIF 19380 FOR b%=a%+1 TO 7 19390 IF b%<8 THEN IF FN_rack_letter(a%)=FN_rack_letter(b%) THEN JUST_THROW_SCORE%+=3 19400 NEXT b% 19410 NEXT a% 19420 19430 IF Board_Tiles%(7,7)=0 THEN 19440 19450 REM ==== special case of going first ===== 19460 Vert_Dir%=HORIZONTAL% 19470 prefix_len%=6 19480 dn%=7:ac%=7 19490 PROC_comp_try_anchor 19500 Vert_Dir%=VERTICAL% 19510 prefix_len%=6 19520 dn%=7:ac%=7 19530 PROC_comp_try_anchor 19540 19550 ELSE 19560 19570 REM ==== search the horizontal possibilities ==== 19580 Vert_Dir%=HORIZONTAL% 19590 FOR dn%=7-(Board_H%-1)/2 TO 7+(Board_H%-1)/2 19600 prefix_len%=0 19610 FOR ac%=7-(Board_W%-1)/2 TO 7+(Board_W%-1)/2 19620 PROC_comp_try_square 19630 NEXT ac% 19640 NEXT dn% 19650 19660 REM ===== search the vertical possibilities ==== 19670 Vert_Dir%=VERTICAL% 19680 FOR ac%=7-(Board_W%-1)/2 TO 7+(Board_W%-1)/2 19690 prefix_len%=0 19700 FOR dn%=7-(Board_H%-1)/2 TO 7+(Board_H%-1)/2 19710 PROC_comp_try_square 19720 NEXT dn% 19730 NEXT ac% 19740 19750 ENDIF 19760 19770 19780 IF best_play_s%>JUST_THROW_SCORE% OR (INSTR(tile_state$,IN_BAG$)=0 AND best_play$<>"") THEN 19790 FOR a%=1 TO LEN(best_play$) 19800 IF FN_board_letter(best_play_x%,best_play_y%) = "" THEN 19810 pos%=0 19820 a$=MID$(best_play$,a%,1) 19830 WHILE FN_rack_letter(pos%)="" OR (FN_rack_letter(pos%)<>a$ AND a$BLANK$ AND a$>=BLANK$) 19840 pos%+=1 19850 ENDWHILE 19860 PROC_tile_place_on_board(best_play_x%,best_play_y%,FN_rack_tile(pos%)) 19870 IF a$>=BLANK$ THEN PROC_drag_blank(FN_rack_tile(pos%),a$) 19880 PROC_rack_clear_pos(pos%) 19890 ENDIF 19900 IF best_play_V% THEN best_play_y%+=1 ELSE best_play_x%+=1 19910 NEXT a% 19920 ELSE 19930 REM ===== throw some tiles away if it's OK ===== 19940 IF INSTR(tile_state$,IN_BAG$) THEN 19950 FOR a%=0 TO 7 19960 IF FN_rack_letter(a%)<>"" THEN 19970 IF letters%(ASCFN_rack_letter(a%)-ASC"A",2)0) 20230 20240 20250 20260DEF PROC_comp_inc_play(a$,a%) 20270 ?(xchk%+1800+ASCa$-65)+=a% 20280ENDPROC 20290 20300 20310 20320DEF PROC_comp_try_square 20330 IF FN_board_letter(ac%,dn%)="" THEN 20340 match%=FALSE 20350 IF dn%>8-Board_H%/2 THEN IF FN_board_letter(ac%,dn%-1)<>"" THEN match%=TRUE 20360 IF dn%<7+Board_H%/2 THEN IF FN_board_letter(ac%,dn%+1)<>"" THEN match%=TRUE 20370 IF ac%>8-Board_W%/2 THEN IF FN_board_letter(ac%-1,dn%)<>"" THEN match%=TRUE 20380 IF ac%<7+Board_W%/2 THEN IF FN_board_letter(ac%+1,dn%)<>"" THEN match%=TRUE 20390 IF match%=TRUE THEN 20400 PROC_comp_try_anchor 20410 prefix_len%=0 20420 ELSE 20430 prefix_len%+=1 20440 ENDIF 20450 ENDIF 20460ENDPROC 20470 20480 20490 20500REM ==== OK, we've got an anchor square ==== 20510DEF PROC_comp_try_anchor 20520 prefix$="" 20530 suffix$="" 20540 lex_node%=0 20550 IF FN_board_letter(ac%-1-Vert_Dir%,dn%+Vert_Dir%)="" THEN 20560 PROC_comp_make_prefix_and_suffix 20570 ELSE 20580 IF FN_comp_board_prefix THEN PROC_comp_make_suffix 20590 ENDIF 20600ENDPROC 20610 20620 20630 20640DEF FN_comp_board_prefix 20650 LOCAL ac1%,dn1%,match%,c% 20660 ac1%=ac%:dn1%=dn% 20670 IF Vert_Dir% THEN dn1%-=1 ELSE ac1%-=1 20680 20690 REM ===== go to the start of the given prefix on the board ===== 20700 WHILE FN_board_letter(ac1%,dn1%)<>"" 20710 prefix$=FN_board_letter(ac1%,dn1%)+prefix$ 20720 IF Vert_Dir% THEN dn1%-=1 ELSE ac1%-=1 20730 ENDWHILE 20740 20750 REM ====== go to the end tracking through the lexicon ====== 20760 c%=1:match%=TRUE 20770 WHILE c%<=LEN(prefix$) AND match%=TRUE 20780 lex_node%-=1 20790 match%=FALSE 20800 REPEAT 20810 lex_node%+=1 20820 IF MID$(prefix$,c%,1)=FN_lex_node_letter(lex1space%,lex_node%) THEN 20830 match%=TRUE 20840 lex_node%= FN_lex_node_pointer(lex1space%,lex_node%) 20850 ENDIF 20860 UNTIL FN_lex_node_end(lex1space%,lex_node%) OR match%=TRUE 20870 c%+=1 20880 ENDWHILE 20890 20900=match% 20910 20920 20930 20940DEF PROC_comp_make_prefix_and_suffix 20950 PROC_lex_push(lex_node%) 20960 PROC_comp_make_suffix 20970 lex_node%=FN_lex_pop 20980 REM ====== BUILD IN SOME "SHORT-SIGHTEDNESS" ====== 20990 c%=RND(12)a$ AND a$BLANK$ AND a$>=BLANK$) 22090 pos%+=1 22100 ENDWHILE 22110 22120 Board_Tiles%(scorey%,scorex%)=FN_rack_tile(pos%) 22130 MID$(tile_state$,FN_rack_tile(pos%),1)=IN_PLAY$ 22140 PROC_rack_clear_pos(pos%) 22150 ENDIF 22160 IF Vert_Dir% THEN scorey%+=1 ELSE scorex%+=1 22170 NEXT a% 22180 22190 REM === work out score === 22200 this_go%=FN_score_tiles_computer 22210 22220 22230 REM === remove tiles from board === 22240 x1%=ac%:y1%=dn% 22250 IF Vert_Dir% THEN y1%-=LENprefix$ ELSE x1%-=LENprefix$ 22260 FOR b%=1 TO LEN(prefix$+suffix$) 22270 t%=Board_Tiles%(y1%,x1%) 22280 IF FN_tile_state(t%)=IN_PLAY$ THEN 22290 Board_Tiles%(y1%,x1%)=0 22300 MID$(tile_state$,t%,1)=IN_RACK$ 22310 a%=0:WHILE FN_rack_tile(a%):a%+=1:ENDWHILE 22320 PROC_rack_set_pos(a%,t%) 22330 ENDIF 22340 IF Vert_Dir% THEN y1%+=1 ELSE x1%+=1 22350 NEXT b% 22360 22370 REM === make a note of the biggest score === 22380 IF this_go%>best_play_s% THEN 22390 best_play_s%=this_go% 22400 best_play$=prefix$+suffix$ 22410 best_play_x%=ac% 22420 best_play_y%=dn% 22430 IF Vert_Dir% THEN best_play_y%-=LENprefix$ ELSE best_play_x%-=LENprefix$ 22440 best_play_V%=Vert_Dir% 22450 ENDIF 22460 22470 wimpspace%-=300 22480ENDPROC 22490 22500 22510 22520DEF FN_comp_keep_going 22530 LOCAL a$ 22540 a$="" 22550 IF Vert_Dir% THEN 22560 IF (dn%+LENsuffix$) > (7+Board_H%/2) THEN a$="#" ELSE a$=FN_board_letter(ac%,dn%+LENsuffix$) 22570 ELSE 22580 IF (ac%+LENsuffix$) > (7+Board_W%/2) THEN a$="#" ELSE a$=FN_board_letter(ac%+LENsuffix$,dn%) 22590 ENDIF 22600=(a$="") 22610 22620 22630 22640DEF FN_comp_cross_check(a$) 22650 LOCAL ac1%,dn1%,match%,c%,xword$ 22660 xword$=a$ 22670 ac1%=ac%+(1+Vert_Dir%)*LENsuffix$ 22680 dn1%=dn%-(Vert_Dir%*LENsuffix$) 22690 22700 xchkloc%=900*-Vert_Dir%+60*ac1%+4*dn1% 22710 match%=FALSE 22720 22730 IF (xchk%!xchkloc% AND 2^(ASCa$-65)) = 0 THEN 22740 IF Vert_Dir% THEN ac1%-=1 ELSE dn1%-=1 :REM look in the opposite sense 22750 WHILE FN_board_letter(ac1%,dn1%)<>"" 22760 xword$=FN_board_letter(ac1%,dn1%)+xword$ 22770 IF Vert_Dir% THEN ac1%-=1 ELSE dn1%-=1 22780 ENDWHILE 22790 22800 ac1%=ac%+(1+Vert_Dir%)*LENsuffix$ 22810 dn1%=dn%-(Vert_Dir%*LENsuffix$) 22820 IF Vert_Dir% THEN ac1%+=1 ELSE dn1%+=1 :REM look in the opposite sense 22830 WHILE FN_board_letter(ac1%,dn1%)<>"" 22840 xword$=xword$+FN_board_letter(ac1%,dn1%) 22850 IF Vert_Dir% THEN ac1%+=1 ELSE dn1%+=1 22860 ENDWHILE 22870 22880 c%=1:match%=TRUE:x_node%=0 22890 22900 IF LENxword$>1 THEN 22910 WHILE c%<=LEN(xword$) AND match%=TRUE 22920 x_node%-=1 22930 match%=FALSE 22940 REPEAT 22950 x_node%+=1 22960 IF (MID$(xword$,c%,1)=FN_lex_node_letter(lex1space%,x_node%)) AND ((c%VAL(RIGHT$($FN_player_name(Curr_Player%)))+3 THEN match%=FALSE 23060 REM =============================================== 23070 23080 REM ==== set the crosscheck bit if found letter blocked ===== 23090 IF match%=FALSE THEN xchk%!xchkloc% = xchk%!xchkloc% OR 2^(ASCa$-65) 23100 23110 ENDIF 23120 23130 ENDIF 23140=match% 23150 23160 23170 23180 23190 23200 23210 23220 23230 23240 23250REM LEXICON BASED ROUTINES 23260 23270DEF PROC_lex_load 23280 LOCAL size1%, size2%, type% 23290 23300 PROC_icon_text_set(Board_Window%,55, FN_wimp_path_leaf(lexicon1$)) 23310 PROC_icon_text_set(Board_Window%,57, FN_wimp_path_leaf(lexicon2$)) 23320 23330 SYS "XOS_File", 17, lexicon1$ TO type%,,,,size1% 23340 IF type%<>1 THEN 23350 lexicon1$=".Empty" 23360 size1%=4 23370 ENDIF 23380 23390 lex_area2%=lex1space%+size1% 23400 SYS "XOS_File", 17, lexicon2$ TO type%,,,,size2% 23410 IF type%<>1 THEN 23420 lexicon2$=".Empty" 23430 size2%=4 23440 ENDIF 23450 23460 IF lexicon1$=".Empty" THEN PROC_icon_text_set(Board_Window%,55, FN_message("misc_opt2")) 23470 IF lexicon2$=".Empty" THEN PROC_icon_text_set(Board_Window%,57, FN_message("misc_opt2")) 23480 23490 23500 SYS"OS_DynamicArea",2,lex_area_handle% TO ,,lex_area_size% 23510 SYS"OS_ChangeDynamicArea",lex_area_handle%,size1%+size2%+1024-lex_area_size% 23520 SYS"OS_DynamicArea",2,lex_area_handle% TO ,,lex_area_size% 23530 23540 SYS "OS_File",16,lexicon1$,lex1space%,0 23550 SYS "OS_File",16,lexicon2$,lex_area2%,0 23560ENDPROC 23570 23580 23590 23600DEF PROC_lex_ouput(lex_areaT%) 23610 IF !(lex_areaT%+4*lex_node%)<>255 THEN 23620 edge%=0 23630 REPEAT 23640 Word$=Word$+CHR$(64+ (!(lex_areaT%+4*(lex_node%+edge%)) AND 31)) 23650 IF !(lex_areaT%+4*(lex_node%+edge%)) AND %100000 THEN 23660 BPUT #file%, Word$ 23670 SYS "Hourglass_Percentage",(ASCWord$-65)*4 23680 ENDIF 23690 PROC_lex_push(lex_node%) 23700 PROC_lex_push(edge%) 23710 lex_node%=!(lex_areaT%+4*(lex_node%+edge%)) DIV 256 23720 PROC_lex_ouput(lex_areaT%) 23730 edge%=FN_lex_pop 23740 lex_node%=FN_lex_pop 23750 Word$=LEFT$(Word$) 23760 edge%+=1 23770 UNTIL !(lex_areaT%+4*(lex_node%+edge%)-4) AND %1000000 23780 ENDIF 23790ENDPROC 23800 23810 23820DEF FN_lex_node_not_terminal(lex%,node%) 23830=(!(lex%+4*node%) <> 255) 23840 23850DEF FN_lex_node_end(lex%,node%) 23860=!(lex%+4*node%) AND %1000000 23870 23880DEF FN_lex_node_terminating(lex%,node%) 23890=!(lex%+4*node%) AND %100000 23900 23910DEF FN_lex_node_letter(lex%,node%) 23920=CHR$(64+(!(lex%+4*node%)AND31)) 23930 23940 23950DEF FN_lex_node_pointer(lex%,node%) 23960= !(lex%+4*node%) DIV 256 23970 23980DEF PROC_lex_push(x%) 23990 !(value_stack%+4*stack_pointer%)=x% 24000 stack_pointer%+=1 24010ENDPROC 24020 24030DEF FN_lex_pop 24040 LOCAL x% 24050 stack_pointer%-=1 24060 x%=!(value_stack%+4*stack_pointer%) 24070=x% 24080 24090 24100 24110 24120 24130 24140 24150 24160 24170REM ======= OPTION manipulation ========== 24180 24190DEF PROC_opt_alter_board 24200 IF Board_H%<5 THEN Board_H%=5 24210 IF Board_H%>15 THEN Board_H%=15 24220 IF Board_W%<5 THEN Board_W%=5 24230 IF Board_W%>15 THEN Board_W%=15 24240 PROC_icon_text_set(Control_Window%,15,STR$Board_W%+" x "+STR$Board_H%) 24250 PROC_wind_redraw(Board_Window%) 24260ENDPROC 24270 24280 24290 24300DEF PROC_opt_alter_squares 24310 PROC_mouse_to_board_pos(mouse_x%,mouse_y%,TRUE) 24320 IF mouse_x%>7 THEN mouse_x%=14-mouse_x% 24330 IF mouse_y%>7 THEN mouse_y%=14-mouse_y% 24340 MID$(Board_Squares$(mouse_y%),mouse_x%*2+1,2)=MID$("2l3l4l5l..2w3w4w5w",icon_drag%*2-7,2) 24350 24360 wimpspace%!128=Board_Window% 24370 SYS "Wimp_GetWindowOutline",,wimpspace%+128 24380 bx%=wimpspace%!132:by%=wimpspace%!136 24390 mouse_x%=mouse_x%*48 24400 mouse_y%=mouse_y%*48 24410 24420 SYS "Wimp_ForceRedraw",-1,bx%+mouse_x%+18,by%+mouse_y%+18,bx%+mouse_x%+66,by%+mouse_y%+66 24430 SYS "Wimp_ForceRedraw",-1,bx%+mouse_x%+18,by%-mouse_y%+690,bx%+mouse_x%+66,by%-mouse_y%+738 24440 SYS "Wimp_ForceRedraw",-1,bx%-mouse_x%+690,by%+mouse_y%+18,bx%-mouse_x%+738,by%+mouse_y%+66 24450 SYS "Wimp_ForceRedraw",-1,bx%-mouse_x%+690,by%-mouse_y%+690,bx%-mouse_x%+738,by%-mouse_y%+738 24460ENDPROC 24470 24480 24490 24500DEF PROC_opt_alter_tiles 24510 PROC_opt_redraw_tiles 24520 PROC_opt_refresh_tiles 24530 PROC_icon_refresh(Board_Window%,30) 24540ENDPROC 24550 24560 24570 24580DEF PROC_opt_redraw_tiles 24590 SYS "XFont_FindFont",,FN_icon_text(Board_Window%,1),fontw%,fonth%,0,0 TO font%;er% 24600 IFer%=6 THEN SYS"XFont_SetFont",font% 24610 wimpspace%!0=0 24620 SYS "XOS_SpriteOp",256+60,grfxspace%,"0",0 24630 SYS "ColourTrans_InvalidateCache" 24640 SYS "Font_SetFontColours",font%,7,1,6 24650 24660 IF FN_icon_flag(Board_Window%,3,21) THEN case%=96 ELSE case%=64 24670 FOR a%=1 TO 26 24680 SYS "XOS_SpriteOp",256+60,grfxspace%,CHR$(64+a%),wimpspace% 24690 SYS "XOS_SpriteOp",256+28,grfxspace%,STR$(letters%(a%-1,0)),,,0 24700 SYS "Font_StringBBox",,CHR$(case%+a%) TO ,,,b% 24710 SYS "Font_Paint",font%,CHR$(case%+a%),256+16,fontx%-b%/1000,fonty% 24720 NEXT a% 24730 24740 SYS "XOS_SpriteOp",256+60,grfxspace%,BLANK$,wimpspace% 24750 SYS "XOS_SpriteOp",256+28,grfxspace%,STR$(letters%(26,0)),,,8 24760 24770 SYS "XOS_SpriteOp",60,0,0,1 24780 SYS "ColourTrans_InvalidateCache" 24790 SYS "XFont_LoseFont",font% 24800 24810 FOR a%=1 TO 27 24820 $FN_icon_text(Board_Window%,14+a%)=STR$(letters%(a%-1,1)) 24830 NEXT a% 24840ENDPROC 24850 24860 24870 24880DEF PROC_opt_refresh_tiles 24890 FOR a%=15 TO 41 24900 PROC_icon_refresh(Board_Window%,a%) 24910 NEXT a% 24920ENDPROC 24930 24940 24950 24960 24970 24980DEF PROC_opt_set_font 24990 IF wimpspace%!4=-1 AND !(Font_Menu%+28+24*wimpspace%!0+4)<>-1 THEN 25000 wimpspace%!4=0 25010 wimpspace%!8=-1 25020 ENDIF 25030 SYS"Wimp_DecodeMenu",,Curr_Menu%,wimpspace%,wimpspace%+100 25040 a$=$(wimpspace%+100) 25050 IF RIGHT$(a$,10)=".(Regular)" THEN a$=LEFT$(a$,LENa$-10) 25060 PROC_icon_text_set(Board_Window%,1,a$) 25070 PROC_opt_alter_tiles 25080ENDPROC 25090 25100 25110 25120 25130DEF PROC_opt_read_file(a$) 25140 25150 PROC_message_close 25160 PROC_message_open(a$) 25170 25180 FOR a%=1 TO 4 25190 $FN_player_name(a%)=FN_message("Player_"+STR$a%) 25200 NEXT a% 25210 25220 PROC_icon_text_set(Board_Window%,GAME_OPT%+1,FN_message("Game_opt1")) 25230 FOR a%=2 TO 10 25240 PROC_icon_flag_set(Board_Window%,GAME_OPT%+a%,2^21*VALFN_message("Game_opt"+STR$a%),2^21) 25250 NEXTa% 25260 25270 Board_W%=VALFN_message_N("Board_size",1) 25280 Board_H%=VALFN_message_N("Board_size",2) 25290 FOR a%=0 TO 7 25300 Board_Squares$(a%)=FN_message("Board_squares_"+STR$a%) 25310 NEXT a% 25320 25330 FOR a%=0 TO 25 25340 letters%(a%,0)=VALFN_message_N("Tile_"+CHR$(65+a%),1) 25350 letters%(a%,1)=VALFN_message_N("Tile_"+CHR$(65+a%),2) 25360 NEXT a% 25370 letters%(26,0)=VALFN_message_N("Tile_Blank",1) 25380 letters%(26,1)=VALFN_message_N("Tile_Blank",2) 25390 25400 PROC_icon_text_set(Board_Window%,1,FN_message_N("Tile_font",1)) 25410 fonth%=VALFN_message_N("Tile_font",2) 25420 fontw%=VALFN_message_N("Tile_font",3) 25430 fontx%=VALFN_message_N("Tile_font",4) 25440 fonty%=VALFN_message_N("Tile_font",5) 25450 25460 lexicon1$=FN_message("Lexicon1") 25470 lexicon2$=FN_message("Lexicon2") 25480 25490 PROC_message_open(".Messages") 25500 25510 PROC_lex_load 25520 PROC_opt_alter_board 25530 PROC_opt_alter_tiles 25540ENDPROC 25550 25560 25570 25580DEF PROC_opt_save_file 25590 file%= OPENOUT(".Options") 25600 FOR a%=1 TO 4 25610 BPUT #file%,"Player_"+STR$a%+":"+$FN_player_name(a%) 25620 NEXT a% 25630 BPUT #file%,"Lexicon1:"+lexicon1$ 25640 BPUT #file%,"Lexicon2:"+lexicon2$ 25650 BPUT #file%,"Game_opt1:"+$FN_icon_text(Board_Window%,GAME_OPT%+1) 25660 FOR a%=2 TO 10 25670 BPUT #file%,"Game_opt"+STR$a%+":"+STR$(-FN_icon_flag(Board_Window%,GAME_OPT%+a%,21)) 25680 NEXT a% 25690 BPUT #file%,"Board_size:"+STR$Board_W%+","+STR$Board_H% 25700 FOR a%=0 TO 7 25710 BPUT #file%,"Board_squares_"+STR$a% +":"+Board_Squares$(a%) 25720 NEXT a% 25730 25740 FOR a%=0 TO 25 25750 BPUT #file%,"Tile_"+CHR$(65+a%)+":"+STR$letters%(a%,0)+","+STR$letters%(a%,1) 25760 NEXT a% 25770 BPUT #file%,"Tile_Blank:"+STR$letters%(26,0)+","+STR$letters%(26,1) 25780 a$=$FN_icon_text(Board_Window%,1) 25790 a$=a$+","+STR$fonth% 25800 a$=a$+","+STR$fontw% 25810 a$=a$+","+STR$fontx% 25820 a$=a$+","+STR$fonty% 25830 BPUT #file%, "Tile_font:"+a$ 25840 CLOSE #file% 25850ENDPROC 25860 25870 25880 25890 25900 25910 25920 25930 25940 25950REM ======= WINDOW manipulation =========== 25960 25970DEF FN_wind_create(a$) 25980 SYS "Wimp_LoadTemplate",,wimpspace%,workspace%,work_top%,fontspace%,a$,0 TO ,,workspace% 25990 wimpspace%!64=grfxspace% 26000 SYS "Wimp_CreateWindow",,wimpspace% TO c% 26010=c% 26020 26030 26040 26050DEF PROC_wind_redraw_all 26060 PROC_wind_redraw(Board_Window%) 26070 FOR chk%=1 TO 4 26080 PROC_wind_redraw(FN_player_history(chk%)) 26090 NEXT chk% 26100ENDPROC 26110 26120 26130 26140DEF PROC_wind_redraw(w%) 26150 LOCAL more%, x%, y%, p%, c%, d% 26160 wimpspace%!128=Board_Window% 26170 SYS "Wimp_GetWindowOutline",,wimpspace%+128 26180 bx%=wimpspace%!132:by%=wimpspace%!136 26190 wimpspace%!0=w% 26200 SYS "Wimp_RedrawWindow",,wimpspace% TO more% 26210 WHILE more% 26220 IF w%=Board_Window% AND (Board_Page%=MAIN_PAGE% OR Board_Page%=SQUARES_PAGE%) THEN 26230 PROC_wind_draw_board 26240 ENDIF 26250 IF w%=FN_player_history(1) THEN PROC_wind_draw_history(1) 26260 IF w%=FN_player_history(2) THEN PROC_wind_draw_history(2) 26270 IF w%=FN_player_history(3) THEN PROC_wind_draw_history(3) 26280 IF w%=FN_player_history(4) THEN PROC_wind_draw_history(4) 26290 SYS "Wimp_GetRectangle",,wimpspace% TO more% 26300 ENDWHILE 26310ENDPROC 26320 26330 26340 26350DEF PROC_wind_draw_history(p%) 26360 x%=wimpspace%!4-wimpspace%!20+16:y%=wimpspace%!16-wimpspace%!24 26370 c%=0 26380 SYS "Wimp_SetColour",7 26390 SYS "Wimp_SetColour",129 26400 WHILE Player_History$(p%,c%)<>"" 26410 SYS"Wimp_TextOp",2,Player_History$(p%,c%),-1,-1,x%,y%-c%*38-32 26420 a$=STR$Player_History%(p%,c%) 26430 IF a$<>"0" THEN 26440 SYS"Wimp_TextOp",1,a$,0 TO d% 26450 SYS"Wimp_TextOp",2,a$,-1,-1,x%+360-d%,y%-c%*38-32 26460 ENDIF 26470 c%+=1 26480 ENDWHILE 26490ENDPROC 26500 26510 26520 26530DEF PROC_wind_draw_board 26540 LOCAL a%,b%,a1%,a2%,b1%,b2% 26550 26560 a2%=(wimpspace%!40-by%-18)/48 26570 IF a2%>(7+Board_H%/2) THEN a2%=(7+Board_H%/2) 26580 IF a2%<(8-Board_H%/2) THEN a2%=(8-Board_H%/2) 26590 26600 a1%=(wimpspace%!32-by%-18)/48 26610 IF a1%>(7+Board_H%/2) THEN a1%=(7+Board_H%/2) 26620 IF a1%<(8-Board_H%/2) THEN a1%=(8-Board_H%/2) 26630 26640 b2%=(wimpspace%!36-bx%-18)/48 26650 IF b2%>(7+Board_W%/2) THEN b2%=(7+Board_W%/2) 26660 IF b2%<(8-Board_W%/2) THEN b2%=(8-Board_W%/2) 26670 26680 b1%=(wimpspace%!28-bx%-18)/48 26690 IF b1%>(7+Board_W%/2) THEN b1%=(7+Board_W%/2) 26700 IF b1%<(8-Board_W%/2) THEN b1%=(8-Board_W%/2) 26710 26720 REM ===== Draw the bonus squares ===== 26730 FOR a%=a1% TO a2% 26740 FOR b%=b1% TO b2% 26750 IF a%>7 THEN 26760 IF b%>7 THEN 26770 a$=MID$(Board_Squares$(14-a%),(14-b%)*2+1,2) 26780 ELSE 26790 a$=MID$(Board_Squares$(14-a%),b%*2+1,2) 26800 ENDIF 26810 ELSE 26820 IF b%>7 THEN 26830 a$=MID$(Board_Squares$(a%),(14-b%)*2+1,2) 26840 ELSE 26850 a$=MID$(Board_Squares$(a%),b%*2+1,2) 26860 ENDIF 26870 ENDIF 26880 26890 IF a$ <>".." THEN 26900 SYS "ColourTrans_SelectTable",grfxspace%,a$,-1,-1,wimpspace%+256,0 26910 SYS "OS_SpriteOp",52+256,grfxspace%,a$,bx%+48*b%+18,by%+48*a%+18,8,0,wimpspace%+256 26920 ENDIF 26930 26940 NEXT b% 26950 NEXT a% 26960 26970 SYS "ColourTrans_SelectTable",grfxspace%,"start",-1,-1,wimpspace%+256,0 26980 SYS "OS_SpriteOp",52+256,grfxspace%,"start",bx%+48*7+18,by%+48*7+18,8,0,wimpspace%+256 26990 27000 REM ===== Draw the cell edges===== 27010 VDU 23,6,PREF_GRID_PAT% 27020 SYS "Wimp_SetColour",PREF_GRID_COL% 27030 FOR a%=a1% TO a2% 27040 SYS "OS_Plot",68,bx%+b1%*48+16,by%+a%*48+16 27050 SYS "OS_Plot",17,(b2%-b1%)*48+48,0 27060 NEXT a% 27070 FOR b%=b1% TO b2% 27080 SYS "OS_Plot",68,bx%+b%*48+16,by%+a1%*48+16 27090 SYS "OS_Plot",17,0,(a2%-a1%)*48+48 27100 NEXT b% 27110 27120 REM ===== Draw the board bevel ===== 27130 bx%+=376:by%+=376:z%=PREF_GRID_BEVEL% 27140 27150 SYS "Wimp_SetColour",5 27160 SYS "OS_Plot",68,bx%-24*Board_W%-z%,by%-24*Board_H%-z% 27170 SYS "OS_Plot",68,bx%-24*Board_W%,by%-24*Board_H% 27180 SYS "OS_Plot",85,bx%+24*Board_W%+z%,by%-24*Board_H%-z% 27190 SYS "OS_Plot",85,bx%+24*Board_W%,by%-24*Board_H% 27200 SYS "Wimp_SetColour",13 27210 SYS "OS_Plot",85,bx%+24*Board_W%+z%,by%+24*Board_H%+z% 27220 SYS "OS_Plot",85,bx%+24*Board_W%,by%+24*Board_H% 27230 SYS "Wimp_SetColour",0 27240 SYS "OS_Plot",85,bx%-24*Board_W%-z%,by%+24*Board_H%+z% 27250 SYS "OS_Plot",85,bx%-24*Board_W%,by%+24*Board_H% 27260 SYS "Wimp_SetColour",10 27270 SYS "OS_Plot",85,bx%-24*Board_W%-z%,by%-24*Board_H%-z% 27280 SYS "OS_Plot",85,bx%-24*Board_W%,by%-24*Board_H% 27290 27300 REM ===== Draw the board outlines ==== 27310 SYS "Wimp_SetColour",4 27320 SYS "OS_Plot",69,bx%-24*Board_W%-z%,by%-24*Board_H%-z% 27330 SYS "OS_Plot",37,bx%+24*Board_W%+z%,by%-24*Board_H%-z% 27340 SYS "OS_Plot",37,bx%+24*Board_W%+z%,by%+24*Board_H%+z% 27350 SYS "OS_Plot",37,bx%-24*Board_W%-z%,by%+24*Board_H%+z% 27360 SYS "OS_Plot",37,bx%-24*Board_W%-z%,by%-24*Board_H%-z% 27370 SYS "Wimp_SetColour",7 27380 SYS "OS_Plot",69,bx%-24*Board_W%,by%-24*Board_H% 27390 SYS "OS_Plot",37,bx%+24*Board_W%,by%-24*Board_H% 27400 SYS "OS_Plot",37,bx%+24*Board_W%,by%+24*Board_H% 27410 SYS "OS_Plot",37,bx%-24*Board_W%,by%+24*Board_H% 27420 SYS "OS_Plot",37,bx%-24*Board_W%,by%-24*Board_H% 27430 bx%-=376:by%-=376 27440 27450ENDPROC 27460 27470 27480 27490DEF PROC_wind_open(window%) 27500 REM ====== Note main window movement and move it =========== 27510 IF window%=Board_Window% THEN 27520 wimpspace%!100=Board_Window% 27530 SYS "Wimp_GetWindowState",,wimpspace%+100 27540 window_move_x%=wimpspace%!4-wimpspace%!104 27550 window_move_y%=wimpspace%!8-wimpspace%!108 27560 ENDIF 27570 SYS "Wimp_OpenWindow",,wimpspace% 27580 27590 REM ====== If rack, check if open (scores) or closed ======= 27600 FOR a%=1 TO 4 27610 IF window%=FN_rack(a%) THEN PROC_wind_open_rack(a%) 27620 NEXT a% 27630 27640 REM ====== Check control panel and possibly move racks ====== 27650 IF window%=Board_Window% THEN 27660 PROC_wind_open_panes 27670 IF Arrange_Menu%!28 AND 1 THEN PROC_wind_open_racks 27680 ENDIF 27690 27700 window_move_x%=0 27710 window_move_y%=0 27720ENDPROC 27730 27740 27750 27760DEF PROC_wind_open_board(p%) 27770 Board_Page%=p% 27780 !wimpspace%=Board_Window% 27790 SYS "Wimp_GetWindowState",,wimpspace% 27800 wimpspace%!20=750*Board_Page% 27810 wimpspace%!28=-1 27820 SYS "Wimp_OpenWindow",,wimpspace% 27830 PROC_wind_open_panes 27840 PROC_wind_open_racks 27850ENDPROC 27860 27870 27880 27890DEF PROC_wind_open_panes 27900 !wimpspace%=Board_Window% 27910 SYS "Wimp_GetWindowState",,wimpspace% 27920 minx%=wimpspace%!4:miny%=wimpspace%!8:maxx%=wimpspace%!12 27930 !wimpspace%=Control_Window% 27940 SYS "Wimp_GetWindowState",,wimpspace% 27950 wimpspace%!4=minx%:wimpspace%!12=maxx%:wimpspace%!16=miny%:wimpspace%!28=Board_Window% 27960 27970 CASE Board_Page% OF 27980 WHEN MAIN_PAGE%: 27990 IF blanks_in_play% THEN wimpspace%!20=1496 ELSE wimpspace%!20=0 28000 28010 WHEN BAG_PAGE%: wimpspace%!20=0 28020 28030 WHEN SQUARES_PAGE%,TILES_PAGE%, OPTIONS_PAGE% : wimpspace%!20=748 28040 OTHERWISE: 28050 ENDCASE 28060 28070 SYS "Wimp_OpenWindow",,wimpspace% 28080 PROC_game_status 28090ENDPROC 28100 28110 28120 28130DEF PROC_wind_close(window%) 28140 wimpspace%!0=window% 28150 SYS "Wimp_CloseWindow",,wimpspace% 28160 IF window%=Board_Window% THEN PROC_wind_close_panes: PROC_wind_close_racks 28170ENDPROC 28180 28190 28200 28210DEF PROC_wind_close_panes 28220 !wimpspace%=Control_Window% 28230 SYS "Wimp_CloseWindow",,wimpspace% 28240 PROC_wind_close_racks 28250ENDPROC 28260 28270 28280 28290DEF PROC_wind_open_racks 28300 IF Board_Page%=MAIN_PAGE% OR Board_Page%=BAG_PAGE% THEN 28310 FOR a%=1 TO 4 28320 PROC_wind_open_rack(a%) 28330 NEXT a% 28340 ELSE 28350 PROC_wind_close_racks 28360 ENDIF 28370 SYS "Wimp_SetCaretPosition", FN_rack(Curr_Player%),-1 28380ENDPROC 28390 28400 28410 28420DEF PROC_wind_open_rack(a%) 28430 !wimpspace%=FN_rack(a%) 28440 IF $FN_player_name(a%)<>"" THEN 28450 $(Player_Data%(a%,2))=$FN_player_name(a%)+": "+STR$(Player_Data%(a%,0)) 28460 SYS "Wimp_GetWindowState",,wimpspace% 28470 28480 IF FN_icon_flag(Board_Window%,GAME_OPT%+8,21) AND Curr_Player%<>0 AND Curr_Player%<>a% THEN 28490 wimpspace%!8=wimpspace%!16 28500 ELSE 28510 IF wimpspace%!16-wimpspace%!8>70 THEN 28520 wimpspace%!8=wimpspace%!16-108 28530 ELSE 28540 wimpspace%!8=wimpspace%!16-68 28550 ENDIF 28560 ENDIF 28570 28580 IF !(Arrange_Menu%+28) AND 1 THEN 28590 wimpspace%!4+=window_move_x% 28600 wimpspace%!8+=window_move_y% 28610 wimpspace%!16+=window_move_y% 28620 ENDIF 28630 28640 SYS "Wimp_OpenWindow",,wimpspace% 28650 IF wimpspace%!16-wimpspace%!8>70 THEN PROC_wind_open_history(a%) ELSE PROC_wind_close_history(a%) 28660 PROC_wind_redraw_rack_title(a%) 28670 ELSE 28680 SYS "Wimp_CloseWindow",,wimpspace% 28690 PROC_wind_close_history(a%) 28700 ENDIF 28710ENDPROC 28720 28730 28740 28750DEF PROC_wind_close_racks 28760 FOR a%=1 TO 4 28770 !wimpspace%=FN_rack(a%) 28780 SYS "Wimp_CloseWindow",,wimpspace% 28790 PROC_wind_close_history(a%) 28800 NEXT a% 28810ENDPROC 28820 28830 28840 28850DEF PROC_wind_redraw_rack_title(a%) 28860 wimpspace%!0=FN_rack(a%) 28870 SYS "Wimp_GetWindowOutline",,wimpspace% 28880 SYS "Wimp_ForceRedraw",-1,wimpspace%!4,wimpspace%!16-40,wimpspace%!12,wimpspace%!16 28890ENDPROC 28900 28910 28920 28930DEF PROC_wind_open_history(a%) 28940 minx%=wimpspace%!4:miny%=wimpspace%!8:maxx%=wimpspace%!12 28950 !wimpspace%=FN_player_history(a%) 28960 SYS "Wimp_GetWindowState",,wimpspace% 28970 wimpspace%!4=minx% 28980 wimpspace%!12=maxx%-38 28990 29000 wimpspace%!8=miny%-2+wimpspace%!16-wimpspace%!8 29010 wimpspace%!16=miny%-2 29020 wimpspace%!28=FN_rack(a%) 29030 SYS "Wimp_OpenWindow",,wimpspace% 29040ENDPROC 29050 29060 29070 29080DEF PROC_wind_close_history(a%) 29090 !wimpspace%=FN_player_history(a%) 29100 SYS "Wimp_CloseWindow",,wimpspace% 29110ENDPROC 29120 29130 29140 29150DEF PROC_wind_racks_left 29160 PROC_wind_close_racks 29170 wimpspace%!0=Board_Window% 29180 SYS "Wimp_GetWindowState",,wimpspace% 29190 wimpspace%!4-= 450 29200 wimpspace%!16-= 16 29210 FOR a%=1 TO 4 29220 IF $FN_player_name(a%)<>"" THEN 29230 wimpspace%!0=Player_Data%(a%,1) 29240 wimpspace%!16-=138: 29250 wimpspace%!8=wimpspace%!16-68 29260 SYS "Wimp_OpenWindow",,wimpspace% 29270 ENDIF 29280 NEXT a% 29290 PROC_wind_open_racks 29300ENDPROC 29310 29320 29330DEF PROC_wind_racks_right 29340 PROC_wind_close_racks 29350 wimpspace%!0=Board_Window% 29360 SYS "Wimp_GetWindowState",,wimpspace% 29370 wimpspace%!4+= 768 29380 wimpspace%!16-= 16 29390 FOR a%=1 TO 4 29400 IF $FN_player_name(a%)<>"" THEN 29410 wimpspace%!0=Player_Data%(a%,1) 29420 wimpspace%!16-=138: 29430 wimpspace%!8=wimpspace%!16-68 29440 SYS "Wimp_OpenWindow",,wimpspace% 29450 ENDIF 29460 NEXT a% 29470 PROC_wind_open_racks 29480ENDPROC 29490 29500 29510DEF PROC_wind_racks_clock 29520 PROC_wind_close_racks 29530 wimpspace%!0=Board_Window% 29540 SYS "Wimp_GetWindowState",,wimpspace% 29550 wimpspace%!4-= 450 29560 wimpspace%!16+=600 29570 29580 wimpspace%!0=Player_Data%(1,1) 29590 wimpspace%!16-=600 29600 wimpspace%!8=wimpspace%!16-108 29610 SYS "Wimp_OpenWindow",,wimpspace% 29620 29630 wimpspace%!0=Player_Data%(2,1) 29640 wimpspace%!4+=1218 29650 wimpspace%!8=wimpspace%!16-108 29660 SYS "Wimp_OpenWindow",,wimpspace% 29670 wimpspace%!0=Player_Data%(3,1) 29680 wimpspace%!16-=600 29690 wimpspace%!8=wimpspace%!16-108 29700 SYS "Wimp_OpenWindow",,wimpspace% 29710 29720 wimpspace%!0=Player_Data%(4,1) 29730 wimpspace%!4-=1218 29740 wimpspace%!8=wimpspace%!16-108 29750 SYS "Wimp_OpenWindow",,wimpspace% 29760 PROC_wind_open_racks 29770ENDPROC 29780 29790 29800DEF PROC_wind_racks_anti 29810 PROC_wind_close_racks 29820 wimpspace%!0=Board_Window% 29830 SYS "Wimp_GetWindowState",,wimpspace% 29840 wimpspace%!4-= 450 29850 wimpspace%!16+=600 29860 29870 wimpspace%!0=Player_Data%(1,1) 29880 wimpspace%!16-=600 29890 wimpspace%!8=wimpspace%!16-108 29900 SYS "Wimp_OpenWindow",,wimpspace% 29910 wimpspace%!0=Player_Data%(2,1) 29920 wimpspace%!16-=600 29930 wimpspace%!8=wimpspace%!16-108 29940 SYS "Wimp_OpenWindow",,wimpspace% 29950 29960 wimpspace%!0=Player_Data%(3,1) 29970 wimpspace%!4+=1218 29980 wimpspace%!8=wimpspace%!16-108 29990 SYS "Wimp_OpenWindow",,wimpspace% 30000 wimpspace%!0=Player_Data%(4,1) 30010 wimpspace%!16+=600 30020 wimpspace%!8=wimpspace%!16-108 30030 SYS "Wimp_OpenWindow",,wimpspace% 30040 PROC_wind_open_racks 30050ENDPROC 30060 30070 30080 30090 30100 30110 30120 30130 30140 30150 30160REM ======== WIMP ICON MANIPULATION/READING ======== 30170 30180 30190DEF FN_icon_text(w%,i%) 30200 wimpspace%!120=w%:wimpspace%!124=i% 30210 SYS "Wimp_GetIconState",,wimpspace%+120 30220=wimpspace%!148 30230 30240 30250DEF PROC_icon_text_set(w%,i%,a$) 30260 $(FN_icon_text(w%,i%))=a$ 30270 PROC_icon_refresh(w%,i%) 30280ENDPROC 30290 30300 30310DEF FN_icon_flag(w%,i%,d%) 30320 wimpspace%!120=w%:wimpspace%!124=i% 30330 SYS "Wimp_GetIconState",,wimpspace%+120 30340=((wimpspace%!144 AND 2^d%)=2^d%) 30350 30360 30370DEF FN_icon_flags(w%,i%) 30380 w%=FN_icon_flag(w%,i%,0) 30390=wimpspace%!144 30400 30410 30420DEF PROC_icon_flag_set(w%,i%,eor%,clear%) 30430 wimpspace%!120=w%:wimpspace%!124=i%:wimpspace%!128=eor%:wimpspace%!132=clear% 30440 SYS"Wimp_SetIconState",,wimpspace%+120 30450ENDPROC 30460 30470 30480DEF PROC_icon_refresh(w%,i%) 30490 PROC_icon_flag_set(w%,i%,0,0) 30500ENDPROC 30510 30520 30530DEF PROC_icon_show(w%,i%,d%) 30540 wimpspace%!200=w%:wimpspace%!204=i% 30550 SYS "Wimp_GetIconState",,wimpspace%+200 30560 IF d% THEN 30570 IF wimpspace%!212<-1000 THEN 30580 SYS "Wimp_ResizeIcon",wimpspace%!200,wimpspace%!204,wimpspace%!208,wimpspace%!212+2400,wimpspace%!216,wimpspace%!220+2400 30590 ENDIF 30600 PROC_icon_refresh(w%,i%) 30610 ELSE 30620 IF wimpspace%!212>-1000 THEN 30630 SYS "Wimp_ResizeIcon",wimpspace%!200,wimpspace%!204,wimpspace%!208,wimpspace%!212-2400,wimpspace%!216,wimpspace%!220-2400 30640 SYS "Wimp_ForceRedraw",wimpspace%!200,wimpspace%!208,wimpspace%!212,wimpspace%!216,wimpspace%!220 30650 ENDIF 30660 ENDIF 30670ENDPROC 30680 30690 30700 30710 30720 30730 30740 30750 30760 30770 30780 30790 30800 30810 30820 30830 30840 30850 30860 30870REM ========= MISC WIMP BITS AND USEFUL ROUTINES ========== 30880 30890 30900 30910 30920DEF FN_menu_create(menu$) 30930 start%=menuspace% 30940 menuspace%!12=&00070207:menuspace%!20=44:menuspace%!24=0 30950 item$=LEFT$(menu$,INSTR(menu$,"|")-1):menu$=MID$(menu$,INSTR(menu$,"|")+1) 30960 $(menuspace%)=item$ 30970 width%=LEN(item$)-3 30980 menuspace%+=28 30990 REPEAT 31000 a$=LEFT$(menu$,INSTR(menu$,"|")-1):menu$=MID$(menu$,INSTR(menu$,"|")+1) 31010 !menuspace%=0 31020 IF LEFT$(a$,1)="/" THEN a$=MID$(a$,2):!menuspace%=!menuspace% OR 1 31030 IF LEFT$(a$,1)="_" THEN a$=MID$(a$,2):!menuspace%=!menuspace% OR 2 31040 IF LEFT$(a$,1)="$" THEN a$=MID$(a$,2):!menuspace%=!menuspace% OR 4 31050 IF LEFT$(a$,1)="}" THEN a$=MID$(a$,2):!menuspace%=!menuspace% OR 8 31060 menuspace%!4=-1 31070 IF LENa$>width% THEN width%=LENa$ 31080 IF LENa$<12 THEN 31090 menuspace%!8=&07000001:$(menuspace%+12)=a$ 31100 ELSE 31110 menuspace%!8=&07000101:menuspace%!12=workspace%:menuspace%!16=-1 31120 menuspace%!20=LENa$+1 31130 $workspace%=a$:workspace%+=LENa$+1 31140 ENDIF 31150 menuspace%+=24 31160 UNTIL menu$="" 31170 !(menuspace%-24)=!(menuspace%-24) OR &80 31180 start%!16=width%*16+32 31190=start% 31200 31210 31220 31230DEF PROC_menu_open(menu%,x%,y%) 31240 Curr_Menu%=menu%:topx%=x%:topy%=y% 31250 IF menu%=Tile_Value_Menu% THEN 31260 a%=Tile_Value_Menu%+28+24*letters%(icon_click%-15,0) 31270 !a%=!a% EOR 1 31280 ENDIF 31290 SYS "Wimp_CreateMenu",,menu%,x%,y% 31300 IF menu%=Tile_Value_Menu% THEN 31310 a%=Tile_Value_Menu%+28+24*letters%(icon_click%-15,0) 31320 !a%=!a% EOR 1 31330 ENDIF 31340ENDPROC 31350 31360 31370DEF PROC_menu_tick(menu%,x%) 31380 !(menu%+28+24*x%)=!(menu%+28+24*x%)OR1 31390ENDPROC 31400 31410DEF PROC_menu_untick(menu%,x%) 31420 !(menu%+28+24*x%)=(!(menu%+28+24*x%)OR1)EOR1 31430ENDPROC 31440 31450DEF FN_menu_is_ticked(menu%,x%) 31460= !(menu%+28+24*x%)AND1 31470 31480 31490 31500 31510 31520 31530DEF PROC_message_open(file$) 31540 $(messagebuff%+16)=file$ 31550 SYS "MessageTrans_OpenFile",messagebuff%,messagebuff%+16,messagebuff%+100 31560ENDPROC 31570 31580 31590 31600DEF FN_message(mess$) 31610 SYS "MessageTrans_Lookup",messagebuff%,mess$,0,0,0,0,0,0 TO ,,mess$ 31620=mess$ 31630 31640 31650 31660DEF FN_message_sub(mess$,sub0$,sub1$) 31670 SYS "MessageTrans_Lookup",messagebuff%,mess$,wimpspace%+200,255,sub0$,sub1$,0,0 TO ,,a% 31680 PROC_wimp_end_string(a%) 31690=$a% 31700 31710 31720 31730DEF FN_message_N(mess$,a%) 31740 SYS "MessageTrans_Lookup",messagebuff%,mess$,0,0,0,0,0,0 TO ,,mess$ 31750 IF a% THEN 31760 mess$=mess$+"," 31770 WHILE a%>1 31780 mess$=MID$(mess$,INSTR(mess$,",")+1) 31790 a%-=1 31800 ENDWHILE 31810 mess$=LEFT$(mess$,INSTR(mess$,",")-1) 31820 ENDIF 31830=mess$ 31840 31850 31860 31870DEF PROC_message_close 31880 SYS "MessageTrans_CloseFile",messagebuff% 31890ENDPROC 31900 31910 31920 31930 31940 31950 31960 31970DEF PROC_trace(a$) 31980 LOCAL file% 31990 file% = OPENUP(".log") 32000 WHILE NOT (EOF #file%) 32010 PTR#file%=PTR#file%+1 32020 ENDWHILE 32030 BPUT #file%, a$ 32040 CLOSE #file% 32050ENDPROC 32060 32070