EMPTY ' LINE CODE 3LINE ASSEMBLE CLEAR line EQU STACK G_C EQU #5B77 line3 LD HL,(G_C) LD (BGC),HL RST #30 LD (BDX),HL RST #30 LD (BDY),HL EXX LD DE,-4 ADD HL,DE EXX CALL line LD HL,(BDY) RST 8 LD HL,(BDX) RST 8 LD HL,(BGC) INC H INC L LD (G_C),HL CALL line LD HL,(BDY) RST 8 LD HL,(BDX) RST 8 LD HL,(BGC) DEC H DEC L LD (G_C),HL JP line sav_g_c LD HL,(G_C) LD (BG_C),HL RET BG_C DEFW 0 BGC DEFW 0 BDX DEFW 0 BDY DEFW 0 ; --> 8 CONSTANT CELL CELL CODE 3X ( c -- ) ASSEMBLE CELL EQU STACK RST #20 EX AF,AF LD (WIDTHS),A CALL sav_g_c CALL prep_x LD A,(WIDTHS) AND %001 CALL edge CALL prep_x LD HL,(BG_C) LD A,H SUB CELL*5 LD H,A LD (G_C),HL LD A,(WIDTHS) AND %010 CALL edge CALL prep_x LD HL,(BG_C) LD A,H SUB CELL*10 LD H,A LD (G_C),HL LD A,(WIDTHS) AND %100 JP edge WIDTHS DEFB 0 prep_x LD HL,0 RST 8 LD HL,CELL*10 JP 8 edge_y JP Z,line LD HL,(G_C) LD (BGC),HL INC L DEC H LD (G_C),HL CALL prep_y CALL line LD HL,(BGC) LD (G_C),HL JP line3 prep_y LD HL,CELL*4 RST 8 LD HL,CELL*8 JP 8 edge \Z -- thin line, NZ -- thick line\ JP Z,line JP line3 ; --> CODE 3Y ( c -- ) ASSEMBLE RST #20 EX AF,AF LD (WIDTHS),A CALL sav_g_c CALL prep_y LD A,(WIDTHS) AND %001 CALL edge_y CALL prep_y LD HL,(BG_C) LD A,L ADD A,CELL*5 LD L,A LD (G_C),HL LD A,(WIDTHS) AND %010 CALL edge_y CALL prep_y LD HL,(BG_C) LD A,L ADD A,CELL*10 LD L,A LD (G_C),HL LD A,(WIDTHS) AND %100 JP edge_y ; CODE 3Z ( c -- ) ASSEMBLE RST #20 EX AF,AF LD (WIDTHS),A CALL sav_g_c CALL prep_z LD A,(WIDTHS) AND %001 CALL edge CALL prep_z LD HL,(BG_C) LD A,L ADD A,CELL*5 LD L,A LD (G_C),HL LD A,(WIDTHS) AND %010 CALL edge CALL prep_z LD HL,(BG_C) LD A,L ADD A,CELL*10 LD L,A LD (G_C),HL LD A,(WIDTHS) AND %100 JP edge prep_z LD HL,-10*CELL RST 8 LD HL,0 JP 8 ; 5 CONSTANT GI 3 CONSTANT 1I 7 CONSTANT 2I 147 CONSTANT TOP 36 CONSTANT LEFT : XYZ> ( X Y Z -- Y X ) SWAP >R 2 - CELL 5 * * TOP + 2 R@ - CELL 2* * - SWAP CELL 5 * * LEFT + R> CELL 2 SHIFT * + ; : C>G XYZ> G-CURSOR ; : GRID PAGE 15 EMIT GI INK 0 0 2 C>G 7 3X 0 1 2 C>G 1 3X 0 2 2 C>G 1 3X 0 0 2 C>G 7 3Y 0 0 1 C>G 4 3Y 0 0 0 C>G 4 3Y 0 0 2 C>G 7 3Z 0 1 2 C>G 4 3Z 0 2 2 C>G 4 3Z 17 EMIT 2 0 0 XYZ> 1- SWAP 1- SWAP G-CURSOR 0 2 LINE 2 2 0 XYZ> 1+ PLOT ; : SET ( X Y Z C -- ) INK G-OR XYZ> PLOT 3 PCIRCLE G-XOR 5 INK ; --> VARIABLE XX VARIABLE YY VARIABLE ZZ VARIABLE CP VARIABLE REST VARIABLE 1CNT VARIABLE 2CNT : XXYYZZ XX @ YY @ ZZ @ ; : XYZ>A XYZ> -3 SHIFT 191 ROT - -3 SHIFT 5 SHIFT + [ 0. ATTRIBUTE ] LITERAL + ; : XYZ@ XYZ>A C@ ; : +-CURS XXYYZZ XYZ> G-CURSOR 4 CIRCLE ; : -$ ( PAGE CR ." Stack " DEPTH . CR S.) 2000 MS ; : @3M! R! @ 3 MOD R> ! ; : |XYZ| XX @3M! YY @3M! ZZ @3M! ; : -X XX 1-! ; : +X XX 1+! ; : -Y YY 1-! ; : +Y YY 1+! ; : -Z ZZ 1-! ; : +Z ZZ 1+! ; 1I 2I XOR CONSTANT DIFF DOER HISTORY++ : +CHIP CP @ DUP DIFF XOR CP ! SET ; : +$ XXYYZZ XYZ@ GI = IF REST 1-! XXYYZZ +CHIP THEN ; --> CREATE delta 0 , 0 , 1 , 1 , 0 , 0 , 1 , -1 , 0 , 0 , -1 , 0 , -1 , -1 , 0 , 1 , 0 , 1 , 1 , -1 , 1 , 0 , -1 , 1 , -1 , -1 , 1 , 1 , 0 , -1 , 1 , -1 , -1 , 0 , -1 , -1 , -1 , -1 , -1 , VARIABLE DX VARIABLE DY VARIABLE DZ VARIABLE CX VARIABLE CY VARIABLE CZ : +DXYZ ( x y z -- x y z x+dx y+dy z+dz ) 2 PICK DX @ + 3 MOD 2 PICK DY @ + 3 MOD 2 PICK DZ @ + 3 MOD ; : XYZ+ 3 ROLL + >R TURN + >R + R> R> ; : XYZ3/ 3 DO' 3 / ROT LOOP' ; : XYZ<> ( x y z x1 y1 z1 -- . . . . . . ? ) DUP 4 PICK <> 2 PICK 6 PICK <> OR 3 PICK 7 PICK <> OR ; : XYZ<>C CZ @ <> >R CY @ <> >R CX @ <> R> R> OR OR ; DOER s-c? VARIABLE #poss --> : CENTER! XXYYZZ +DXYZ +DXYZ XYZ+ XYZ+ XYZ3/ CZ ! CY ! CX ! ; : SAME-COLOR? CENTER! XXYYZZ +DXYZ +DXYZ XYZ<>C >R XYZ<>C >R XYZ<>C R> R> AND AND IF 3DROP 3DROP ELSE s-c? THEN ; : CNT++ XXYYZZ 13 DO' I' 1- 6 * delta + R! @ DX ! R@ 2+ @ DY ! R> 4 + @ DZ ! +DXYZ +DXYZ XYZ<> IF SAME-COLOR? ELSE 3DROP 3DROP THEN LOOP' 3DROP ; : (s-c)1 MAKE s-c? XYZ@ >R XYZ@ CP @ DIFF XOR R! = R> R> = AND IF CP @ 1I = IF 2CNT ELSE 1CNT THEN 1+! THEN ; : .CNT (s-c)1 CNT++ 10 57 CURSOR 1I INK 1CNT @ 2 .R 15 57 CURSOR 2I INK 2CNT @ 2 .R GI INK REST @ 27 < IF HISTORY++ THEN ; --> 1 CONSTANT P1 0 CONSTANT P2 0 CONSTANT P3 : ?+poss1 IF P1 #poss +! THEN ; : ?+poss2 IF P2 #poss +! THEN ; : ?+poss3 IF P3 #poss +! THEN ; : TWO/2? ( c1 c2 -- ? ) CP @ R! = SWAP R> DIFF XOR <> AND ; : (s-c)2 MAKE s-c? ( xyz1 xyz2 -- ) XYZ@ >R XYZ@ DUP CP @ DIFF XOR R! <> R> R@ <> AND ?+poss1 R> 2DUP 2DUP TWO/2? -ROT SWAP TWO/2? OR ?+poss2 CP @ R! = SWAP R> = AND ?+poss3 ; : XYZ1+ 1+ 3 /MOD >R -ROT R> + 3 /MOD >R -ROT R> + 3 MOD -ROT ; : XYZ^FREE BEGIN 3DUP XYZ@ GI <> WHILE XYZ1+ REPEAT ; : GOTO ( xyz -- ) ZZ ! YY ! XX ! +$ 5 30 TONE ; : #POSS1 ( x y z -- #possib. of variant ) #poss 0! ZZ ! YY ! XX ! (s-c)2 CNT++ #poss @ ; : ^CP CP @ DIFF XOR CP ! ; --> BODY P1 BODY P2 BODY P3 : ^^^ ( p1 p2 p3 -- ) LITERAL ! LITERAL ! LITERAL ! ; : #POSS 1 1 1 ^^^ #POSS1 ^CP XXYYZZ 1 0 1 ^^^ #POSS1 ^CP + ; VARIABLE MAX-POSS VARIABLE i : ONLY 0. 0 XYZ^FREE 300 MS GOTO ; : CENTERED 1 1 1 600 MS GOTO ; : FIRST-MOVE 1 CHOOSE IF 2 0 2 600 MS GOTO ELSE CENTERED THEN ; : TEST-EXTREM REST @ CASE 1 OF ONLY ENDOF 27 OF FIRST-MOVE ENDOF EXIT ENDCASE R-EXIT ; : INDICATE 0 0 3 CP @ SET .CNT ; --> : ^XYZ 3 DO' 1- NEGATE 1+ 3 MOD -ROT LOOP' ; : 2@HOB XXYYZZ ^XYZ 3DUP XYZ@ GI <> IF 3DROP EXIT THEN 500 MS GOTO RDROP ; --> : @HOB INDICATE REST 1 @BITS 0= IF 2@HOB THEN TEST-EXTREM 0. 0 MAX-POSS 0! REST @ i ! BEGIN XYZ^FREE i @ WHILE 3DUP #POSS R! MAX-POSS @ MAX MAX-POSS ! i 1-! XYZ1+ REPEAT 3DROP REST @ i ! BEGIN i @ WHILE R> MAX-POSS @ TUCK / * i 1-! REPEAT BEGIN DEPTH CHOOSE R! PICK 0= WHILE RDROP REPEAT BEGIN DEPTH WHILE DROP REPEAT ( RSTACK: # of selected var. ) 0. 0 REST @ i ! BEGIN XYZ^FREE R@ WHILE R> 1- >R XYZ1+ REPEAT RDROP GOTO ; --> : @KBD INDICATE CP @ >R BEGIN +-CURS KEY# +-CURS >R R@ 90 = IF -X THEN R@ 92 = IF +X THEN R@ 110 = IF -Y THEN R@ 61 = IF +Y THEN R@ 93 = IF -Z THEN R@ 91 = IF +Z THEN R@ 4 = IF XXYYZZ XYZ1+ XYZ^FREE ZZ ! YY ! XX ! THEN R@ 5 = IF +$ THEN R> 65 = IF -$ RDROP R-EXIT THEN |XYZ| 150 MS 5 60 TONE CP @ R@ <> UNTIL R-EXIT ; DOER 1ST^ DOER 2ND^ : GAME 1 XX ! 1 YY ! 1 ZZ ! 1I CP ! 27 REST ! GRID 6 SPACES ." 3D Tic-Tac-Tow by Khachaturov Vasily, tel. 210-95-78" CR 3 2 1 1I SET 3 2 0 2I SET 149 30 G-CURSOR 12 12 BOX 1CNT 0! 2CNT 0! .CNT 1ST^ BEGIN 2ND^ 1ST^ REST @ 0= UNTIL .CNT -$ ; --> C? FREE CD :/TOYS/WORDS LOAD MENU CD : C 89 130 SW: SW1 137 130 SW: SW2 95 84 SW: SW3 CREATE picture 4 B/BUF * ALLOT : 1HOB 1 SW1 MAKE 1ST^ @HOB ; : 2HOB 1 SW2 MAKE 2ND^ @HOB ; : 1KBD 0 SW1 MAKE 1ST^ @KBD ; : 2KBD 0 SW2 MAKE 2ND^ @KBD ; : HIST+ 1 SW3 MAKE HISTORY++ PRINTER REST @ 1+ 1 AND IF 14 REST @ -1 ASHIFT - 2 .R ." ) " THEN ." ( " XX ? ." ; " YY ? ." ; " ZZ ? ASCII ) EMIT 9 EMIT REST @ 1 AND REST @ 0= IF DROP 9 EMIT 9 EMIT TRUE THEN IF 1CNT ? ." : " 2CNT ? CR THEN CONSOLE ; : HIST- 0 SW3 UNDO HISTORY++ ; --> : START 4 18 18 42 picture GET DROP [ ASSEMBLE RES 3,(IX+3) ; ] GAME 4 18 picture PUT ; : nl 32 CURSOR? NIP 1+ SWAP CURSOR ; : CONTROLS 1I 2I 10 22 picture 11 32 PANEL DROP ." When it is your move," nl ." your controls are:" nl nl ." Cursor arrows:" nl ." left, up, right & down" nl ." Register: closer" nl ." CShift: farther" nl ." SShift: next free" nl ." Space: set chip" nl ." EDIT: escape" nl 200 MS KEY# DROP picture PUT ; : END PAGE QUIT ; --> 27 20 6 ' 1HOB POS: '1HOBBIT' 39 32 6 ' 2HOB POS: '2HOBBIT' 27 20 10 ' 1KBD POS: '1PLAYER' 39 32 10 ' 2KBD POS: '2PLAYER' 30 20 12 ' HIST+ POS: 'HIST+' 40 32 12 ' START POS: 'START' 40 32 14 ' CONTROLS POS: 'CONTROLS' 30 20 16 ' HIST- POS: 'HIST-' 40 32 16 ' END POS: 'QUIT' \ CUR LT UP RT DN LINK: '1HOBBIT' '2HOBBIT' 'HIST-' '2HOBBIT' '1PLAYER' LINK: '2HOBBIT' '1HOBBIT' 'QUIT' '1HOBBIT' '2PLAYER' LINK: '1PLAYER' '2PLAYER' '1HOBBIT' '2PLAYER' 'HIST+' LINK: '2PLAYER' '1PLAYER' '2HOBBIT' '1PLAYER' 'START' LINK: 'HIST+' 'START' '1PLAYER' 'START' 'HIST-' LINK: 'START' 'HIST+' '2PLAYER' 'HIST+' 'CONTROLS' LINK: 'CONTROLS' 'CONTROLS' 'START' 'CONTROLS' 'QUIT' LINK: 'HIST-' 'QUIT' 'HIST+' 'QUIT' '1HOBBIT' LINK: 'QUIT' 'HIST-' 'CONTROLS' 'HIST-' '2HOBBIT' --> : selector 0 'START' BEGIN KEY# R! 5 = IF -1 CUR^ THEN R@ 13 = IF -1 CUR^ THEN R@ 90 = IF 1 CUR^ THEN R@ 91 = IF 2 CUR^ THEN R@ 92 = IF 3 CUR^ THEN R> 93 = IF 4 CUR^ THEN 100 MS 5 60 TONE AGAIN ; --> CODE ATTR-PBOX ( c start_addr ) ASSEMBLE CLEAR X EQU 4 Y EQU 5 RST #30 RST #20 LD A,Y loop_a EX AF,AF CALL draw_cols LD DE,32 ADD HL,DE EX AF,AF DEC A RET Z JR loop_a draw_cols LD B,X LD D,H LD E,L LD (DE),A INC DE DJNZ $-2 RET ; --> : PICTURE 0 PAPER 0 BORDER 0 BRIGHT GI INK PAGE GI 0 11 21 0 6 20 PANEL 3DROP 6 21 CURSOR ." HOBBIT" 6 33 CURSOR ." HOBBIT" 10 20 CURSOR ." PLAYER 1" 10 32 CURSOR ." PLAYER 2" [ 1I 6 20 ATTRIBUTE ] 2LITERAL ATTR-PBOX [ 2I 6 32 ATTRIBUTE ] 2LITERAL ATTR-PBOX 12 20 CURSOR ." HISTORY ON" 12 34 CURSOR ." START!" 14 32 CURSOR ." CONTROLS" 16 20 CURSOR ." HISTORY OFF" 16 35 CURSOR ." QUIT!" ; : X0 PICTURE 1HOB 2HOB HIST- selector ;