Jump to content
Have You Played Atari Today?
2600|5200|7800|Lynx|Jaguar|Forums|Store
IGNORED

"Programs for the Tl Home Computer" (Book)

oddemann

By oddemann
in TI-99/4A Computers

 Share

Recommended Posts

oddemann Dragonstomper

oddemann

Posted
  • Author
Posted (edited)

MORSE CODER for TI EXTENDED BASIC by MIKE WILCOX (page 73)

 

There is a at least one bug. But I think it is working correct.

520 updated!!!
590 updated also!!!

 

 

Spoiler 

100 REM *MORSE CODER* TI EXTENDED BASIC
110 REM BY MIKE WILCOX
120 REM FROM PROGRAMS FOR THE TI HOME COMPUTER
130 REM COPYRIGHT (C) 1983 BY STEVE DAVIS
140 RANDOMIZE :: CALL CHAR(139,"F0F0F0F00F0F0F0F"):: CALL CLEAR :: CALL SCREEN(16)
150 FOR I=1 TO 32 :: CALL HCHAR(1,I,139) :: NEXT I
160 FOR I=1 TO 24 :: CALL VCHAR(I,32,139) :: NEXT I
170 FOR I=32 TO 1 STEP -1 :: CALL HCHAR(24,1,139):: NEXT I
180 FOR I=24 TO 1 STEP -1 :: CALL VCHAR(I,1,139) :: NEXT I
190 DISPLAY AT(3,7):"PROGRAMS FOR THE" :: DISPLAY AT(5,7):"TI HOME COMPUTER"
200 DISPLAY AT(7,11):"PRESENTS:" :: DISPLAY AT(10,4):"COMPUTER COURSE IN THE" :: DISPLAY AT(12,3):"INTERNATIONAL MORSE CODE"
210 DISPLAY AT(23,8):"COPYRIGHT 1982" :: DISPLAY AT(18,4):"PRESS ANY KEY TO BEGIN"
220 DEF XX=INT(14*RND+2)
230 CALL KEY(0,K,S):: CALL SOUND(22,2975,0):: CALL COLOR(14,XX,1)
240 T=850*INT(RND*2) :: CALL SOUND(22,2125+T, 0):: CALL COLOR(14,1,XX) :: CALL SOUND(-99,2125,0) :: IF S=0 THEN 230
250 OPTION BASE 1 :: DIM U(52):: CALL SCREEN(8)
260 CALL CLEAR
270 DISPLAY AT(2,8)BEEP:" MENU:" :: DISPLAY AT(4,1):"PRESS-" :: DISPLAY AT(7,1):"1. TO DISPLAY CODE TABLES"
280 DISPLAY AT(9,1):"2. TO PRINT CODE TABLES" :: DISPLAY AT(11,1):"3. TO CODE MESSAGE" :: DISPLAY AT(13,1):"4. TO DECODE MESSAGES"
290 DISPLAY AT(15,1):"5. TO TEST YOURSELF ON CODE" :: DISPLAY AT(17,1):"6. END PROGRAM"
300 CALL KEY(0,K,S):: W=RND :: IF S=0 THEN 300
310 IF (K<49)+(K>54)THEN 300
320 CALL CLEAR
330 ON K-48 GOTO 340,350,370,380,390,400
340 PR$="" :: FLAG=0 :: CALL CODE(FLAG,PR$) :: GOTO 260
350 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
360 FLAG=1 :: CALL CODE(FLAG,PR$):: GOTO 260
370 CALL CODER :: GOTO 260
380 CALL DECODER :: GOTO 260
390 CALL TEST(U()):: GOTO 260
400 CALL CLEAR :: STOP
410 SUB CODE(FLAG,PR$)
420 CALL CLEAR
430 IF FLAG<>1 THEN 450
440 OPEN #1:PR$,OUTPUT
450 C=1 :: R=1
460 RESTORE 900
470 DISPLAY AT(1,2):"INTERNATIONAL MORSE CODE:"
480 FOR I=1 TO 26
490 READ L$,CODE$
500 R=R+2
510 IF R>15 THEN R=3 :: C=C+7
520 DISPLAY AT(R,C):L$;" ";CODE$
530 NEXT I
540 CALL CHAR(97,RPT$("0",9)&"408102") :: CALL CHAR(98,RPT$("0",10)&"205408") :: CALL CHAR(99,RPT$("0",12)&"6666")
550 R=20 :: C=4
560 DISPLAY AT(18,3):"FOREIGN LANGUAGE LETTERS:"
570 FOR I=1 TO 6
580 READ L$,CODE$
590 DISPLAY AT(R,C):L$;" ";CODE$
600 R=R+3
610 IF R>23 THEN R=20 :: C=C+8
620 NEXT I
630 DISPLAY AT(19,4):"a" :: DISPLAY AT(22,4):"c" :: DISPLAY AT(19,12):"a" :: DISPLAY AT(22,12):"b" :: DISPLAY AT(19,20):"c" :: DISPLAY AT(22,20):"c"
640 IF FLAG<>1 THEN 680
650 FOR I=1 TO 24 :: FOR J=1 TO 32 :: CALL GCHAR(I,J,X) :t CALL HCHAR(I,J,30) :: CALL HCHAR(I,J,X)
660 P$=P$&CHR$(X) :: NEXT J :: PRINT #1:P$ :: P$="" :: NEXT I

670 GOTO 690
680 CALL KEY(0,K,S) :: IF S=0 THEN 680
690 CALL CLEAR
700 DISPLAY AT(1,2):"INTERNATIONAL MORSE CODE:"
710 DISPLAY AT(3,1):"PUNCTUATION:"
720 R=5 :: C=1
730 FOR I=1 TO 10
740 READ L$,CODE$
750 DISPLAY AT(R,C):L$ :: DISPLAY AT(R,C+14):CODE$
760 R=R+2
770 NEXT I
780 DISPLAY AT(3,21):"NUMBERS:"
790 R=5 :: C=22
800 FOR I=1 TO 10
810 READ L$,CODE$
820 DISPLAY AT(R,C):L$;" ";CODE$
830 R=R+2
840 NEXT I
850 IF FLAG<>1 THEN 890
860 FOR I=1 TO 24 STEP 2 :: FOR J=1 TO 32 :: CALL GCHAR(I,J,X) :: CALL HCHAR(I,J,30) :: CALL HCHAR(I,J,X)
870 P$=P$&CHR$(X):: NEXT J :: PRINT #1:P$ :: P$="" :: NEXT I :: CLOSE #1
880 FLAG=0 :: SUBEXIT
890 CALL KEY(0,K,S):: IF S=0 THEN 890
900 DATA A,._,B,_...,C,_._.,D, ..,E,.,F,...,G,__.,H,....,I,..,J,.___,K,_._,L,.-...,M,__,N,_.,O,___
910 DATA P,.__.,Q,__._,R,._.,S,...,T,_,U,.._,V,..._,W,.__,X,_.._,Y,_.__,Z,__..
920 DATA A,.__._,A,._._,E,.._..,N,__.__,O,___.,U,..__
930 DATA ", COMMA",__..__,. PERIOD,._._._,? QUESTION,..__..,; SEMI-COLON,_._._.,: COLON,___...
940 DATA ’ APOSTROPHE,.____.,- HYPHEN,_...._,/ SLASH,_.._.,()PARENTHESIS,_.__._,_ UNDERLINE,..__._
950 DATA 1,.____,2,..___,3,...__,4,...._,5,.....,6,_....,7,__...,8,___..,9,____.,0,_____,
960 SUBEND
970 SUB CODER
980 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE YOUR CODED": :"MESSAGES PRINTED-OUT (Y/N)?"
990 CALL KEY(3,K,S):: IF (K<> 89)*(K<>78)THEN 990
1000 IF K=78 THEN FLAG=0 ELSE FLAG=1
1010 IF FLAG=0 THEN 1040
1020 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
1030 OPEN #3:PR$, OUTPUT
1040 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE YOUR CODED": :"MESSAGE SOUNDED-OUT (Y/N)?"
1050 CALL KEY(3,K,S):: IF K<>78 AND K<>89 THEN 1050
1060 IF K=89 THEN FLAG2=1 ELSE FLAG2=0
1070 ROW=2 :: COL=1
1080 DISPLAY AT(2,1)ERASE ALL:"YOUR ARE IN THE CODING MODE "
1090 DISPLAY AT(10,3):"TO RETURN TO THE MENU ": :" TYPE AND ENTER ""MENU"""
1100 DISPLAY AT(16,3):"PRESS ANY KEY TO BEGIN." :: CALL KEY(0,K,S):: IF S=0 THEN 1100
1110 DISPLAY AT(10,10)ERASE ALL:"CODER:" :: DISPLAY AT(12,1)BEEP:"ENTER YOUR MESSAGE TO CODE:": :"(TYPE AND ENTER ""MENU"" TO": :"RETURN.)"
1120 LINPUT MSG$
1130 IF MSG$="MENU" THEN 1430
1140 M$(1)=SEG$(MSG$,1,60) :: M$(2)=SEG$(MSG$,61,120) :: M$(3)=SEG$(MSG$,121,180) :: M$(4)=SEG$(MSG$,181,240) :: M$(5)=SEG$(MSG$,241,300)
1150 CALL CLEAR :: DISPLAY AT(1,3):"TRANSLATING IN PROGRESS"
1160 FOR I=1 TO 5
1170 FOR J=1 TO LEN(M$(I))
1180 RESTORE 900
1190 A$=SEG$(M$(I),J,1):: IF A$=" " THEN CODE$=" " :: GOTO 1250
1200 FOR X=1 TO 52
1210 READ L$,CODE$

1220 IF A$=SEG$(L$,1,1)THEN 1250
1230 NEXT X
1240 IF A$<>L$ THEN CODE$="#"
1250 CMSG$=CMSG$&CODE$&" "
1260 FOR Z=1 TO LEN(CMSG$)
1270 COL=COL+1 :: IF COL<=31 THEN 1280 ELSE ROW=ROW+2 :: COL=2
1280 IF ROW>22 THEN ROW=3
1290 CALL HCHAR(ROW,COL,ASC(SEG$(CMSG$,Z,1)))
1300 NEXT Z
1310 CMSG$=""
1320 NEXT J
1330 NEXT I
1340 DISPLAY AT(1,1):" " :: DISPLAY AT(24,4):"TRANSLATION COMPLETED"
1350 IF FLAG=0 THEN 1410
1360 P$="" :: FOR X=2 TO 24 STEP 2 :: FOR Z=1 TO 32 :: CALL GCHAR(X,Z,M)
1370 P$=P$&CHR$(M)
1380 NEXT Z :: IF P$=RPT$(" ",32)THEN 1400
1390 PRINT #3:P$ :: P$="" :: NEXT X
1400 REM PRINTING COMPLETED
1410 IF FLAG2=1 THEN CALL SOUNDER(2,2)
1420 CALL KEY(0,K,S):: IF S=0 THEN 1420 ELSE ROW=2 :: COL=1 :: GOTO 1110
1430 IF FLAG=0 THEN 1450
1440 CLOSE #3
1450 FLAG=0 :: PR$="" :: SUBEND
1460 SUB DECODER :: MSG$=""
1470 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE THE DECODED": :"MESSAGES PRINTED-OUT (Y/N)?"
1480 CALL KEY(3,K,S):: IF (K<>78)*(K<>89)THEN 1480
1490 IF K=78 THEN FLAG=0 ELSE FLAG=1
1500 IF FLAG=0 THEN 1530
1510 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
1520 OPEN #4:PR$,OUTPUT
1530 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE THE CODED": :"MESSAGE SOUNDED-OUT (Y/N)?"
1540 CALL KEY(3,K,S):: IF K<>78 AND K<>89 THEN 1540
1550 IF K=89 THEN FLAG2=1 ELSE FLAG2=0
1560 DISPLAY AT(2,1)ERASE ALL:"YOU ARE IN THE DECODING MODE" :: DISPLAY AT(5, 1):"PRESS ENTER FOR TRANSLATION"
1570 DISPLAY AT(7,6):"""M"" TO RETURN TO MENU": :"FOR YOUR CONVENIENCE YOU": :"MAY USE A COMMA "","" TO PRINT"
1580 DISPLAY AT(13, 1):"A DASH "" "" (OR USE FCTN U)"
1590 DISPLAY AT(15,1):"YOU MUST LEAVE ONE SPACE": :"BETWEEN EACH LETTER, AND TWO": :"SPACES BETWEEN EACH WORD."
1600 DISPLAY AT(22,3):"PRESS ANY KEY TO BEGIN"
1610 CALL KEY(0,K,S):: IF S=0 THEN 1610
1620 DISPLAY AT(4,10)BEEP ERASE ALL:"DECODER:" :: DISPLAY AT(6,1):"PRESS ENTER T0 TRANSLATE": :"PRESS M TO RETURN PRESS C TO CORRECT"
1630 DISPLAY AT(12, 1):"ENTER YOUR MESSAGE:"
1640 CALL KEY(3,K,S):: IF (K<>13)*(K<>32)*(K<>44)*(K<>46)*(K<>67)*(K<>77)*(K<>95)THEN 1640
1650 IF K=67 AND MSG$="" THEN 1710 ELSE IF K=67 THEN MSG$=SEG$(MSG$, 1, LEN(MSG$)-1):: GOTO 1710
1660 IF K=77 THEN 2010
1670 IF K=44 THEN K=95
1680 IF K=32 THEN CALL SOUND(111,1000,5,2000,4,3000,3)
1690 IF K=13 THEN 1730
1700 MSG$=MSG$&CHR$(K)
1710 DISPLAY AT(14,1):MSG$
1720 GOTO 1640
1730 IF FLAG2=1 THEN CALL SOUNDER(14,1)
1740 CALL CLEAR :: ROW=2 :: COL=2 :: T$="" :: CMSG$=""
1750 DISPLAY AT(1,3):"TRANSLATING IN PROGRESS"
1760 S=POS (MSG$," ",1) :: IF S=1 THEN T$=" " :: GOTO I860
1770 IF S=0 THEN A$=MSG$ :: GOTO 1790
1780 A$=SEG$(MSG$,1,S-1)

1790 RESTORE 900
1800 FOR I=1 TO 52
1810 READ L$,CODE$
1820 IF A$=CODE$ THEN 1850
1830 NEXT I
1840 T$="#" :: GOTO 1860
1850 T$=SEG$(L$,1,1)
1860 FOR Z=1 TO LEN(T$)
1870 COL=COL+1
1880 IF COL<=31 THEN 1890 ELSE ROW=ROW+2 :: COL=2
1890 CALL HCHAR(ROW,COL,ASC(SEG$(T$,Z,1)))
1900 IF S=0 THEN 1930
1910 NEXT Z
1920 MSG$=SEG$(MSG$,S+1,LEN(MSG$)):: GOTO 1760
1930 DISPLAY AT(1,1):" " :: DISPLAY AT(24,3)BEEP:"TRANSLATION COMPLETED"
1940 IF FLAG=0 THEN 2000
1950 P$="" :: FOR X=2 TO 24 STEP 2 :: FOR Z=1 TO 32 :: CALL GCHAR(X,Z,M)
1960 P$=P$&CHR$(M)
1970 NEXT Z :: IF P$=RPT$(" ",32) THEN 1990
1980 PRINT #4:P$ :: P$="" :: NEXT X
1990 REM PRINTING COMPLETED
2000 CALL KEY(0,K,S):: IF S=0 THEN 2000 ELSE MS6$="" :: GOTO 1620
2010 IF FLAG=0 THEN 2030
2020 CLOSE #4
2030 SUBEND
2040 SUB TEST(U())
2050 SCORE, RIGHT=0 :: FOR I=1 TO 52 :: U(I)=0 :: NEXT I
2060 DISPLAY AT(1,5)ERASE ALL:"SELF-TEST MODE:"
2070 DISPLAY AT(3,1):"THE COMPUTER WILL RANDOMLY": :"SELECT 10 LETTERS, NUMBERS,": :"OR PUNCTUATION SYMBOLS CNO"
2080 DISPLAY AT(9, 1):"FOREIGN LANGUAGE LETTERS3": :"AND YOU WILL NEED TO PROVIDEH": :"EITHER THE CORRECT CODE OR"
2090 DISPLAY AT(15,1):"THE LETTER, NUMBER OR SYMBOL": :"THAT IS BEING DEFINED."
2100 DISPLAY AT(19,1):"YOU WILL RECIEVE A SCORE AT": :"THE END OF THIS TEST.": :" PRESS ANY KEY TO START"
2110 CALL KEY(0,K,S):: IF S=0 THEN 2110
2120 DISPLAY AT(10,9)ERASE ALL:"TEST SET-UP" :: DISPLAY AT(12,9):"IN PROGRESS..." :: DISPLAY AT (14,7):"PLEASE STAND BY..."
2130 REM SET-UP TEST
2140 FOR I=1 TO 10
2150 N=INT(52*RND+1)
2160 IF (N>26)*(N<33)THEN 2150
2170 IF U(N)=1 THEN 2150
2180 U(N)=1
2190 RESTORE 900
2200 FOR RD=1 TO N
2210 READ L$,CODE$
2220 NEXT RD
2230 IF RND>.45 THEN Q$(I)=CODE$ :: A$(I)=SEG$(L$,1,1) ELSE Q$(I)=SEG$(L$,1,1) :: A$(I)=CODE$
2240 NEXT I
2250 CALL CLEAR
2260 FOR I=1 TO 10
2270 IF SEG$(Q$(I),1,1)=" " AND A$(I)="..__._" OR SEG$(Q$(I),1,1)="." AND A$(I)="._._._" THEN DISPLAY AT(1*2-1,1):" CODE:" :: GOTO 2290
2280 IF SEG$(Q$(I),1,1)="." OR SEG$(Q$(I),1,1)="_" THEN DISPLAY AT(I*2-1,1):"DECODE:" ELSE DISPLAY AT(I*2-1,1):" CODE:"
2290 DISPLAY AT(I*2-1,9):Q$(I)
2300 ACCEPT AT(I*2-1,16)BEEP:AN$
2310 IF AN$<>A$(I) THEN CALL SOUND(110,220,2,330,3) :: DISPLAY AT(I*2,1):"THE RIGHT ANSWER IS ";A$(I)
2320 IF AN$=A$(I)THEN DISPLAY AT(I*2, 1):"YOU ARE CORRECT!" :: RIGHT=RIGHT+1
2330 NEXT I
2340 SCORE=RIGHT*10 :: DISPLAY AT(22,4):"YOUR SCORE IS ";STR$(SCORE);"%"
2350 DISPLAY AT(24,2):"PRESS ANY KEY TO CONTINUE"

2360 CALL KEY(0,K,S):: IF S=0 THEN 2360
2370 SUBEND
2380 SUB SOUNDER(M,N)
2390 FOR I=1 TO 300 :: NEXT I
2400 DISPLAY AT(1,4):"NOW SOUNDING-OUT CODE" :: DISPLAY AT(24,1):""
2410 FOR I=M TO 24 STEP N :: FOR J=2 TO 31 :: CALL GCHAR(I,J,C)
2420 IF C=32 THEN CALL SOUND(250,42000,30):: X=X+1
2430 IF X=5 THEN 2470
2440 IF C=46 THEN CALL SOUND(150,2975,0) :: CALL SOUND(150,42000,30) :: X=0
2450 IF C=95 THEN CALL SOUND(300,2125,1) :: CALL SOUND(150,42000,30) :: X=0
2460 NEXT J :: NEXT I
2470 DISPLAY AT(1,1):"" :: DISPLAY AT(24,4):"SOUND-OFF COMPLETED" :: X=0
2480 SUBEND
2490 END

 

 

Edited by oddemann
Bugs
  • Like 1
Link to comment
Share on other sites
Fritz442 Moonsweeper

Fritz442

Posted
Posted
29 minutes ago, oddemann said:

MORSE CODER for TI EXTENDED BASIC by MIKE WILCOX (page 73)

 

There is a at least one bug. But I think it is working correct.

 

 

 

  Reveal hidden contents 


100 REM *MQRSE CODER* TI EXTENDED BASIC
110 REM BY MIKE WILCOX
120 REM FROM PROGRAMS FOR THE TI HOME COMPUTER
130 REM COPYRIGHT (C) 1983 BY STEVE DAVIS
140 RANDOMIZE :: CALL CHAR(139,"F0F0F0F00F0F0F0F"):: CALL CLEAR :: CALL SCREEN(16)
150 FOR I=1 TO 32 :: CALL HCHAR(1,I,139) :: NEXT I
160 FOR I=1 TO 24 :: CALL VCHAR(I,32,139) :: NEXT I
170 FOR I=32 TO 1 STEP -1 :: CALL HCHAR(24,1,139):: NEXT I
180 FOR I=24 TO 1 STEP -1 :: CALL VCHAR(I,1,139) :: NEXT I
190 DISPLAY AT(3,7):"PROGRAMS FOR THE" :: DISPLAY AT(5,7):"TI HOME COMPUTER"
200 DISPLAY AT(7,11):"PRESENTS:" :: DISPLAY AT(10,4):"COMPUTER COURSE IN THE" :: DISPLAY AT(12,3):"INTERNATIONAL MORSE CODE"
210 DISPLAY AT(23,8):"COPYRIGHT 1982" :: DISPLAY AT(18,4):"PRESS ANY KEY TO BEGIN"
220 DEF XX=INT(14*RND+2)
230 CALL KEY(0,K,S):: CALL SOUND(22,2975,0):: CALL COLOR(14,XX,1)
240 T=850*INT(RND*2) :: CALL SOUND(22,2125+T, 0):: CALL COLOR(14,1,XX) :: CALL SOUND(-99,2125,0) :: IF S=0 THEN 230
250 OPTION BASE 1 :: DIM U(52):: CALL SCREEN(8)
260 CALL CLEAR
270 DISPLAY AT(2,8)BEEP:" MENU:" :: DISPLAY AT(4,1):"PRESS-" :: DISPLAY AT(7,1):"1. TO DISPLAY CODE TABLES"
280 DISPLAY AT(9,1):"2. TO PRINT CODE TABLES" :: DISPLAY AT(11,1):"3. TO CODE MESSAGE" :: DISPLAY AT(13,1):"4. TO DECODE MESSAGES"
290 DISPLAY AT(15,1):"5. TO TEST YOURSELF ON CODE" :: DISPLAY AT(17,1):"6. END PROGRAM"
300 CALL KEY(0,K,S):: W=RND :: IF S=0 THEN 300
310 IF (K<49)+(K>54)THEN 300
320 CALL CLEAR
330 ON K-48 GOTO 340,350,370,380,390,400
340 PR$="" :: FLAG=0 :: CALL CODE(FLAG,PR$) :: GOTO 260
350 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
360 FLAG=1 :: CALL CODE(FLAG,PR$):: GOTO 260
370 CALL CODER :: GOTO 260
380 CALL DECODER :: GOTO 260
390 CALL TEST(U()):: GOTO 260
400 CALL CLEAR :: STOP
410 SUB CODE(FLAG,PR$)
420 CALL CLEAR
430 IF FLAG<>1 THEN 450
440 OPEN #1:PR$,OUTPUT
450 C=1 :: R=1
460 RESTORE 900
470 DISPLAY AT(1,2):"INTERNATIONAL MORSE CODE:"
480 FOR I=1 TO 26
490 READ L$,CODE$
500 R=R+2
510 IF R>15 THEN R=3 :: C=C+7
520 DISPLAY AT(R,C):L$:" ";CODE$
530 NEXT I
540 CALL CHAR(97,RPT$("0",9)&"408102") :: CALL CHAR(98,RPT$("0",10)&"205408") :: CALL CHAR(99,RPT$("0",12)&"6666")
550 R=20 :: C=4
560 DISPLAY AT(18,3):"FOREIGN LANGUAGE LETTERS:"
570 FOR I=1 TO 6
580 READ L$,CODE$
590 DISPLAY AT(R,C):L$:" ";CODE$
600 R=R+3
610 IF R>23 THEN R=20 :: C=C+8
620 NEXT I
630 DISPLAY AT(19,4):"a" :: DISPLAY AT(22,4):"c" :: DISPLAY AT(19,12):"a" :: DISPLAY AT(22,12):"b" :: DISPLAY AT(19,20):"c" :: DISPLAY AT(22,20):"c"
640 IF FLAG<>1 THEN 680
650 FOR I=1 TO 24 :: FOR J=1 TO 32 :: CALL GCHAR(I,J,X) :t CALL HCHAR(I,J,30) :: CALL HCHAR(I,J,X)
660 P$=P$&CHR$(X) :: NEXT J :: PRINT #1:P$ :: P$="" :: NEXT I

670 GOTO 690
680 CALL KEY(0,K,S) :: IF S=0 THEN 680
690 CALL CLEAR
700 DISPLAY AT(1,2):"INTERNATIONAL MORSE CODE:"
710 DISPLAY AT(3,1):"PUNCTUATION:"
720 R=5 :: C=1
730 FOR I=1 TO 10
740 READ L$,CODE$
750 DISPLAY AT(R,C):L$ :: DISPLAY AT(R,C+14):CODE$
760 R=R+2
770 NEXT I
780 DISPLAY AT(3,21):"NUMBERS:"
790 R=5 :: C=22
800 FOR I=1 TO 10
810 READ L$,CODE$
820 DISPLAY AT(R,C):L$;" ";CODE$
830 R=R+2
840 NEXT I
850 IF FLAG<>1 THEN 890
860 FOR I=1 TO 24 STEP 2 :: FOR J=1 TO 32 :: CALL GCHAR(I,J,X) :: CALL HCHAR(I,J,30) :: CALL HCHAR(I,J,X)
870 P$=P$&CHR$(X):: NEXT J :: PRINT #1:P$ :: P$="" :: NEXT I :: CLOSE #1
880 FLAG=0 :: SUBEXIT
890 CALL KEY(0,K,S):: IF S=0 THEN 890
900 DATA A,._,B,_...,C,_._.,D, ..,E,.,F,...,G,__.,H,....,I,..,J,.___,K,_._,L,.-...,M,__,N,_.,O,___
910 DATA P,.__.,Q,__._,R,._.,S,...,T,_,U,.._,V,..._,W,.__,X,_.._,Y,_.__,Z,__..
920 DATA A,.__._,A,._._,E,.._..,N,__.__,O,___.,U,..__
930 DATA ", COMMA",__..__,. PERIOD,._._._,? QUESTION,..__..,; SEMI-COLON,_._._.,: COLON,___...
940 DATA ’ APOSTROPHE,.____.,- HYPHEN,_...._,/ SLASH,_.._.,()PARENTHESIS,_.__._,_ UNDERLINE,..__._
950 DATA 1,.____,2,..___,3,...__,4,...._,5,.....,6,_....,7,__...,8,___..,9,____.,0,_____,
960 SUBEND
970 SUB CODER
980 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE YOUR CODED": :"MESSAGES PRINTED-OUT (Y/N)?"
990 CALL KEY(3,K,S):: IF (K<> 89)*(K<>78)THEN 990
1000 IF K=78 THEN FLAG=0 ELSE FLAG=1
1010 IF FLAG=0 THEN 1040
1020 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
1030 OPEN #3:PR$, OUTPUT
1040 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE YOUR CODED": :"MESSAGE SOUNDED-OUT (Y/N)?"
1050 CALL KEY(3,K,S):: IF K<>78 AND K<>89 THEN 1050
1060 IF K=89 THEN FLAG2=1 ELSE FLAG2=0
1070 ROW=2 :: COL=1
1080 DISPLAY AT(2,1)ERASE ALL:"YOUR ARE IN THE CODING MODE "
1090 DISPLAY AT(10,3):"TO RETURN TO THE MENU ": :" TYPE AND ENTER ""MENU"""
1100 DISPLAY AT(16,3):"PRESS ANY KEY TO BEGIN." :: CALL KEY(0,K,S):: IF S=0 THEN 1100
1110 DISPLAY AT(10,10)ERASE ALL:"CODER:" :: DISPLAY AT(12,1)BEEP:"ENTER YOUR MESSAGE TO CODE:": :"(TYPE AND ENTER ""MENU"" TO": :"RETURN.)"
1120 LINPUT MSG$
1130 IF MSG$="MENU" THEN 1430
1140 M$(1)=SEG$(MSG$,1,60) :: M$(2)=SEG$(MSG$,61,120) :: M$(3)=SEG$(MSG$,121,180) :: M$(4)=SEG$(MSG$,181,240) :: M$(5)=SEG$(MSG$,241,300)
1150 CALL CLEAR :: DISPLAY AT(1,3):"TRANSLATING IN PROGRESS"
1160 FOR I=1 TO 5
1170 FOR J=1 TO LEN(M$(I))
1180 RESTORE 900
1190 A$=SEG$(M$(I),J,1):: IF A$=" " THEN CODE$=" " :: GOTO 1250
1200 FOR X=1 TO 52
1210 READ L$,CODE$

1220 IF A$=SEG$(L$,1,1)THEN 1250
1230 NEXT X
1240 IF A$<>L$ THEN CODE$="#"
1250 CMSG$=CMSG$&CODE$&" "
1260 FOR Z=1 TO LEN(CMSG$)
1270 COL=COL+1 :: IF COL<=31 THEN 1280 ELSE ROW=ROW+2 :: COL=2
1280 IF ROW>22 THEN ROW=3
1290 CALL HCHAR(ROW,COL,ASC(SEG$(CMSG$,Z,1)))
1300 NEXT Z
1310 CMSG$=""
1320 NEXT J
1330 NEXT I
1340 DISPLAY AT(1,1):" " :: DISPLAY AT(24,4):"TRANSLATION COMPLETED"
1350 IF FLAG=0 THEN 1410
1360 P$="" :: FOR X=2 TO 24 STEP 2 :: FOR Z=1 TO 32 :: CALL GCHAR(X,Z,M)
1370 P$=P$&CHR$(M)
1380 NEXT Z :: IF P$=RPT$(" ",32)THEN 1400
1390 PRINT #3:P$ :: P$="" :: NEXT X
1400 REM PRINTING COMPLETED
1410 IF FLAG2=1 THEN CALL SOUNDER(2,2)
1420 CALL KEY(0,K,S):: IF S=0 THEN 1420 ELSE ROW=2 :: COL=1 :: GOTO 1110
1430 IF FLAG=0 THEN 1450
1440 CLOSE #3
1450 FLAG=0 :: PR$="" :: SUBEND
1460 SUB DECODER :: MSG$=""
1470 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE THE DECODED": :"MESSAGES PRINTED-OUT (Y/N)?"
1480 CALL KEY(3,K,S):: IF (K<>78)*(K<>89)THEN 1480
1490 IF K=78 THEN FLAG=0 ELSE FLAG=1
1500 IF FLAG=0 THEN 1530
1510 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
1520 OPEN #4:PR$,OUTPUT
1530 DISPLAY AT(10,1)BEEP ERASE ALL:"WOULD YOU LIKE THE CODED": :"MESSAGE SOUNDED-OUT (Y/N)?"
1540 CALL KEY(3,K,S):: IF K<>78 AND K<>89 THEN 1540
1550 IF K=89 THEN FLAG2=1 ELSE FLAG2=0
1560 DISPLAY AT(2,1)ERASE ALL:"YOU ARE IN THE DECODING MODE" :: DISPLAY AT(5, 1):"PRESS ENTER FOR TRANSLATION"
1570 DISPLAY AT(7,6):"""M"" TO RETURN TO MENU": :"FOR YOUR CONVENIENCE YOU": :"MAY USE A COMMA "","" TO PRINT"
1580 DISPLAY AT(13, 1):"A DASH "" "" (OR USE FCTN U)"
1590 DISPLAY AT(15,1):"YOU MUST LEAVE ONE SPACE": :"BETWEEN EACH LETTER, AND TWO": :"SPACES BETWEEN EACH WORD."
1600 DISPLAY AT(22,3):"PRESS ANY KEY TO BEGIN"
1610 CALL KEY(0,K,S):: IF S=0 THEN 1610
1620 DISPLAY AT(4,10)BEEP ERASE ALL:"DECODER:" :: DISPLAY AT(6,1):"PRESS ENTER T0 TRANSLATE": :"PRESS M TO RETURN PRESS C TO CORRECT"
1630 DISPLAY AT(12, 1):"ENTER YOUR MESSAGE:"
1640 CALL KEY(3,K,S):: IF (K<>13)*(K<>32)*(K<>44)*(K<>46)*(K<>67)*(K<>77)*(K<>95)THEN 1640
1650 IF K=67 AND MSG$="" THEN 1710 ELSE IF K=67 THEN MSG$=SEG$(MSG$, 1, LEN(MSG$)-1):: GOTO 1710
1660 IF K=77 THEN 2010
1670 IF K=44 THEN K=95
1680 IF K=32 THEN CALL SOUND(111,1000,5,2000,4,3000,3)
1690 IF K=13 THEN 1730
1700 MSG$=MSG$&CHR$(K)
1710 DISPLAY AT(14,1):MSG$
1720 GOTO 1640
1730 IF FLAG2=1 THEN CALL SOUNDER(14,1)
1740 CALL CLEAR :: ROW=2 :: COL=2 :: T$="" :: CMSG$=""
1750 DISPLAY AT(1,3):"TRANSLATING IN PROGRESS"
1760 S=POS (MSG$," ",1) :: IF S=1 THEN T$=" " :: GOTO I860
1770 IF S=0 THEN A$=MSG$ :: GOTO 1790
1780 A$=SEG$(MSG$,1,S-1)

1790 RESTORE 900
1800 FOR I=1 TO 52
1810 READ L$,CODE$
1820 IF A$=CODE$ THEN 1850
1830 NEXT I
1840 T$="#" :: GOTO 1860
1850 T$=SEG$(L$,1,1)
1860 FOR Z=1 TO LEN(T$)
1870 COL=COL+1
1880 IF COL<=31 THEN 1890 ELSE ROW=ROW+2 :: COL=2
1890 CALL HCHAR(ROW,COL,ASC(SEG$(T$,Z,1)))
1900 IF S=0 THEN 1930
1910 NEXT Z
1920 MSG$=SEG$(MSG$,S+1,LEN(MSG$)):: GOTO 1760
1930 DISPLAY AT(1,1):" " :: DISPLAY AT(24,3)BEEP:"TRANSLATION COMPLETED"
1940 IF FLAG=0 THEN 2000
1950 P$="" :: FOR X=2 TO 24 STEP 2 :: FOR Z=1 TO 32 :: CALL GCHAR(X,Z,M)
1960 P$=P$&CHR$(M)
1970 NEXT Z :: IF P$=RPT$(" ",32) THEN 1990
1980 PRINT #4:P$ :: P$="" :: NEXT X
1990 REM PRINTING COMPLETED
2000 CALL KEY(0,K,S):: IF S=0 THEN 2000 ELSE MS6$="" :: GOTO 1620
2010 IF FLAG=0 THEN 2030
2020 CLOSE #4
2030 SUBEND
2040 SUB TEST(U())
2050 SCORE, RIGHT=0 :: FOR I=1 TO 52 :: U(I)=0 :: NEXT I
2060 DISPLAY AT(1,5)ERASE ALL:"SELF-TEST MODE:"
2070 DISPLAY AT(3,1):"THE COMPUTER WILL RANDOMLY": :"SELECT 10 LETTERS, NUMBERS,": :"OR PUNCTUATION SYMBOLS CNO"
2080 DISPLAY AT(9, 1):"FOREIGN LANGUAGE LETTERS3": :"AND YOU WILL NEED TO PROVIDEH": :"EITHER THE CORRECT CODE OR"
2090 DISPLAY AT(15,1):"THE LETTER, NUMBER OR SYMBOL": :"THAT IS BEING DEFINED."
2100 DISPLAY AT(19,1):"YOU WILL RECIEVE A SCORE AT": :"THE END OF THIS TEST.": :" PRESS ANY KEY TO START"
2110 CALL KEY(0,K,S):: IF S=0 THEN 2110
2120 DISPLAY AT(10,9)ERASE ALL:"TEST SET-UP" :: DISPLAY AT(12,9):"IN PROGRESS..." :: DISPLAY AT (14,7):"PLEASE STAND BY..."
2130 REM SET-UP TEST
2140 FOR I=1 TO 10
2150 N=INT(52*RND+1)
2160 IF (N>26)*(N<33)THEN 2150
2170 IF U(N)=1 THEN 2150
2180 U(N)=1
2190 RESTORE 900
2200 FOR RD=1 TO N
2210 READ L$,CODE$
2220 NEXT RD
2230 IF RND>.45 THEN Q$(I)=CODE$ :: A$(I)=SEG$(L$,1,1) ELSE Q$(I)=SEG$(L$,1,1) :: A$(I)=CODE$
2240 NEXT I
2250 CALL CLEAR
2260 FOR I=1 TO 10
2270 IF SEG$(Q$(I),1,1)=" " AND A$(I)="..__._" OR SEG$(Q$(I),1,1)="." AND A$(I)="._._._" THEN DISPLAY AT(1*2-1,1):" CODE:" :: GOTO 2290
2280 IF SEG$(Q$(I),1,1)="." OR SEG$(Q$(I),1,1)="_" THEN DISPLAY AT(I*2-1,1):"DECODE:" ELSE DISPLAY AT(I*2-1,1):" CODE:"
2290 DISPLAY AT(I*2-1,9):Q$(I)
2300 ACCEPT AT(I*2-1,16)BEEP:AN$
2310 IF AN$<>A$(I) THEN CALL SOUND(110,220,2,330,3) :: DISPLAY AT(I*2,1):"THE RIGHT ANSWER IS ";A$(I)
2320 IF AN$=A$(I)THEN DISPLAY AT(I*2, 1):"YOU ARE CORRECT!" :: RIGHT=RIGHT+1
2330 NEXT I
2340 SCORE=RIGHT*10 :: DISPLAY AT(22,4):"YOUR SCORE IS ";STR$(SCORE);"%"
2350 DISPLAY AT(24,2):"PRESS ANY KEY TO CONTINUE"

2360 CALL KEY(0,K,S):: IF S=0 THEN 2360
2370 SUBEND
2380 SUB SOUNDER(M,N)
2390 FOR I=1 TO 300 :: NEXT I
2400 DISPLAY AT(1,4):"NOW SOUNDING-OUT CODE" :: DISPLAY AT(24,1):""
2410 FOR I=M TO 24 STEP N :: FOR J=2 TO 31 :: CALL GCHAR(I,J,C)
2420 IF C=32 THEN CALL SOUND(250,42000,30):: X=X+1
2430 IF X=5 THEN 2470
2440 IF C=46 THEN CALL SOUND(150,2975,0) :: CALL SOUND(150,42000,30) :: X=0
2450 IF C=95 THEN CALL SOUND(300,2125,1) :: CALL SOUND(150,42000,30) :: X=0
2460 NEXT J :: NEXT I
2470 DISPLAY AT(1,1):"" :: DISPLAY AT(24,4):"SOUND-OFF COMPLETED" :: X=0
2480 SUBEND
2490 END

 

 

Line 520 

520 DISPLAY AT(R,C):L$:" ";CODE$

Should be  

520 DISPLAY AT(R,C):L$;" ";CODE$

 

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites
Fritz442 Moonsweeper

Fritz442

Posted
Posted (edited)
1 hour ago, Fritz442 said:

Line 520 


520 DISPLAY AT(R,C):L$:" ";CODE$

Should be  


520 DISPLAY AT(R,C):L$;" ";CODE$

 

 

Also 590 and 900 have issues. 

590 DISPLAY AT(R,C):L$:" ";CODE$

should be  

590 DISPLAY AT(R,C):L$;" ";CODE$

  

900 DATA A,._,B,_...,C,_._.,D, ..,E,.,F,...,G,__.,H,....,I,..,J,.___,K,_._,L,.-...,M,__,N,_.,O,___

should be (letters D F L) 

900 DATA A,._,B,_...,C,_._.,D,_..,E,.,F,.._.,G,__.,H,....,I,..,J,.___,K,_._,L,._..,M,__,N,_.,O,___

I think I got them all.

 

 

Edited by Fritz442
  • Like 1
Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
Posted
8 hours ago, oddemann said:

Programs for the Tl Home Computer
by Steve Davis

 

I will slowly add code listings here!

If you find something interesting, feel free to copy the code to this tread.

The Book (If you don't have it)

programs-for-the-ti-home-computer.pdf 14.7 MB · 14 downloads

I have one those on the shelf. :) 

 

  • Like 1
Link to comment
Share on other sites
oddemann Dragonstomper

oddemann

Posted
  • Author
Posted
4 minutes ago, TheBF said:

As former radio amateur, from the time when you had to pass Morse code test to get a license, I must say something. :)

 

The Morse code audio output is incorrect.  The dit and the dah should be at the same frequency. 

This is how Morse code sounds over radio links.

Could you implement the correct audio?

Link to comment
Share on other sites
TheBF River Patroller

+TheBF

Posted
Posted
12 minutes ago, oddemann said:

Could you implement the correct audio?

I was looking at the code briefly and I don't exactly see where the pitch is being changed yet.

I will look again.

 

:

Ah yes.  They made a sounder sub-program.  

The timing is not right either as I listen.  If you find the time delays.

Change it to this: 

2380 SUB SOUNDER(M,N)
2382 ADIT=150
2390 FOR I=1 TO 300 :: NEXT I
2400 DISPLAY AT(1,4):"NOW SOUNDING-OUT CODE" :: DISPLAY AT(24,1):""
2410 FOR I=M TO 24 STEP N :: FOR J=2 TO 31 :: CALL GCHAR(I,J,C)
2420 IF C=32 THEN CALL SOUND(250,42000,30):: X=X+1
2430 IF X=5 THEN 2470
2440 IF C=46 THEN CALL SOUND(ADIT,2125,0) :: CALL SOUND(ADIT*3,42000,30) :: X=0
2450 IF C=95 THEN CALL SOUND(ADIT*3,2125,1) :: CALL SOUND(ADIT*3,42000,30) :: X=0
2460 NEXT J :: NEXT I
2470 DISPLAY AT(1,1):"" :: DISPLAY AT(24,4):"SOUND-OFF COMPLETED" :: X=0
2480 SUBEND

edit ADIT to 80

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites
oddemann Dragonstomper

oddemann

Posted
  • Author
Posted (edited)
5 hours ago, ti99iuc said:

maybe you missed the page on ti99iuc website:
https://www.ti99iuc.it/web/index.php?pageid=database_cerca&archivioid=345

all the programs are linked in the page already ?

 

 

 

? Well... then I saved myself some work! I was thinking this is a book not seen that much.

But thank you very much, @ti99iuc

Edited by oddemann
  • Like 1
Link to comment
Share on other sites
ti99iuc River Patroller

ti99iuc

Posted
Posted (edited)
8 hours ago, TheBF said:

I was looking at the code briefly and I don't exactly see where the pitch is being changed yet.

I will look again.

 

:

Ah yes.  They made a sounder sub-program.  

The timing is not right either as I listen.  If you find the time delays.

Change it to this: 


2380 SUB SOUNDER(M,N)
2382 ADIT=150
2390 FOR I=1 TO 300 :: NEXT I
2400 DISPLAY AT(1,4):"NOW SOUNDING-OUT CODE" :: DISPLAY AT(24,1):""
2410 FOR I=M TO 24 STEP N :: FOR J=2 TO 31 :: CALL GCHAR(I,J,C)
2420 IF C=32 THEN CALL SOUND(250,42000,30):: X=X+1
2430 IF X=5 THEN 2470
2440 IF C=46 THEN CALL SOUND(ADIT,2125,0) :: CALL SOUND(ADIT*3,42000,30) :: X=0
2450 IF C=95 THEN CALL SOUND(ADIT*3,2125,1) :: CALL SOUND(ADIT*3,42000,30) :: X=0
2460 NEXT J :: NEXT I
2470 DISPLAY AT(1,1):"" :: DISPLAY AT(24,4):"SOUND-OFF COMPLETED" :: X=0
2480 SUBEND

edit ADIT to 80

 

I have updated also the Morse Coder page on TI99iuc adding your Morse Code fix, thanks :)
https://www.ti99iuc.it/web/index.php?pageid=database_cerca&archivioid=375

Edited by ti99iuc
  • Like 1
Link to comment
Share on other sites
oddemann Dragonstomper

oddemann

Posted
  • Author
Posted
5 hours ago, ti99iuc said:

I am also work on the software published in the TERRIFIC GAMES for the TI99
https://www.ti99iuc.it/web/index.php?pageid=database_cerca&archivioid=643

someone still missing.

Make a separate tread for this book?

Anyway, I looked at... "Here Lives/QUI VIVE" and I am stomped at 1700, I think most of the bugs are out.
 

Spoiler 

10 REM TI EXTENDED-QUI VIVE
20 CALL CLEAR
30 RANDOMIZE
40 DIM SF(41,4),SO(41)
50 DIM D(107,1),DF(15,8)
60 DIM CC(4,1),B(24),C(24)
70 GOTO 1870
80 REM compute points of df**********
90 GV=0 :: P1=0 :: P2=0 :: C1=0 :: C2=0
100 D1=B(DF(NF,0)):: D2=B(DF(NF,1))
110 IF D1=1 OR 02=1 THEN P1=1
120 IF D1=10 OR 02=10 THEN C1=10
130 D1=B(DF(NF,2)):: D2=B(DF(NF,3))
140 IF D1=1 OR 02=1 THEN P2=1
150 IF D1=10 OR D2=10 THEN C2=10
160 GV=B(DF(NF,4))+B(DF(NF,5))+B(DF(NF,6))
170 P=GV+P1+P2+C1+C2
180 IF GV=30 AND(C1=0 OR C2=0)THEN P=P-10
190 IF GV=3 AND(P1=0 OR P2=0)THEN P=P-1
200 RETURN
210 REM initialize single figu~es (sf)
220 FOR I=0 TO 41 :: READ X$
230 FOR J=1 TO 5
240 SF(I,J-1)=ASC(SEG$(X$,J,1))-65
250 NEXT J :: NEXT I :: RETURN
260 REM wings(AV<>)*****
270 DATA UQMSV,PLHNT,KGCIO
280 DATA AGMIE,FLRNJ,KQWSO
290 DATA AGMQU,BHNRV,CIOSW
300 DATA EIHSV,DHLRX,CGKQW
310 REM times(X)*****
320 DATA ACGKM,BDHLN,CEIMO
330 DATA FLHPR,GIMQS,HJNRT
340 DATA KMQUW,LNRVX,MOSWY
350 REM plus(+)*****

360 DATA BFGHL,CGHIM,DHIJN
370 DATA GKLMQ,HLMNR,IMNOS
380 DATA LPQRV,MQRSW,NRSTX
390 REM diagonals(\/)
400 DATA AGHSY,EIMQU
410 REM columns(I)*****
420 DATA AFKPU,BGLQV,CHMRW
430 DATA DINSX,EJOTY
440 REM rows(-)*****
450 DATA ABCDE,FGHIJ,KLMNO
460 DATA PQRST,UVWXY
470 REM initialize double figures (df)
480 FOR I=0 TO 107 STEP 12 :: READ X$
490 FOR J=0 TO 11 :: FOR K=0 TO 1
500 L=2*J+K+1 :: D(I+J,K)=ASC(SEG$(X$,L,1))-49
510 NEXT K :: NEXT J :: NEXT I
520 RETURN
530 DATA 171:1A1C1E1M101P2>2@2B2J
540 DATA 393<3=3?3G474:4=4?4A4G40
550 DATA 4P5@5B5D5J696<6C6E6M7=7A
560 DATA 7C71707P8>8B8D8J9?9E9K:?
570 DATA :A:E:K:O:P;>;@;D;J<=<C<I
580 DATA =G=I=O>F>H>J?G?K?P@F@J@L
590 DATA AGAIAKANAOAPBHBJBNCICMCP
600 DATA DJDLDNEKEMEOFRFWGSGWHTHW
610 DATA IRIXJSJXKTKXLRLVMSHYNTNY
620 REM compute double figure fields••••••••••
630 TC=4 :: TN=0
640 FOR I=0 TO 4 :: C(SF(D(DF1,0),I))=1 :: NEXT I

650 FOR I=0 T0 4 :: SF1=SF(D(DF1,1),I)
660 IF C(SF1)=1 THEN 680
670 DF(NF,TN)=SF1 :: TN=TN+1 :: GOTO 690
680 DF(NF,TC)=SF1 :: TC=TC+1 .. C(SF1)=0
690 NEXT I
700 FOR I=0 TO 4 :: SF1=SF(D(DF1,0),I)
710 IF C(SF1)=I THEN DF(NF,TN)=SF1 :: TN=TN+1 :: C(SF1)=0
720 NEXT I :: RETURN
730 REM
740 REM display board**********
750 PRINT " "
760 FOR I=0 TO 4 :: FOR J=0 TO 4
770 F=5*1+J
780 IF B(F)=0 THEN PRINT " ";
790 IF B(F)=1 THEN PRINT "P";
800 IF B(F)=10 THEN PRINT "C";
810 NEXT J :: PRINT 5-I :: NEXT I
820 PRINT
830 PRINT "ABCDE"
840 PRINT " "
850 RETURN
860 REM determine owner of sf's**********
870 OM=-1 :: WM=-1
880 FOR SF1=0 TO 41
890 P=B(SF(SF1,0))+B(SF(SF1,1))+B(SF(SF1,2))+B(SF(SF1,3))+B(SF(SF1,4))
900 IF P=0 OR P=10 OR P=20 OR P=30 THEN SO(SF1)=10 :: GOTO 1000
910 IF P<>40 THEN 950
920 GOSUB 1010
930 GOSUB 1050
940 WM=1 :: SF1=41 :: GOTO 1000
950 IF P>20 OR P<3 OR P=11 OR P=12 THEN SO(SF1)=0 :: GOTO 1000
960 SO(SF1)=1
970 IF P=4 AND OM=-1 THEN GOSUB 1010
980 IF P=14 THEN GOSUB 1050
990 IF P=S THEN SF1=41
1000 NEXT SF1 :: RETURN
1010 REM determine obligatory move**********
1020 FOR I=0 TO 4
1030 IF B(SF(SF1,I))=0 THEN OM=SF(SF1,I)
1040 NEXT I :: RETURN
1050 REM determine pinned checker**********

1060 FOR I=0 TO 4
1070 IF B(SF(SF1,I))<>10 THEN 1110
1080 FOR J=0 TO CC1-1
1090 IF SF(SF1,I)=CC(J,0)THEN CC(J,1)=1
1100 NEXT J
1110 NEXT I
1120 RETURN
1130 REM determine interesting df's********
1140 NC=0 :: NP=0 :: NF=0
1150 FOR I=0 TO 15
1160 DF(I,8)=-1
1170 DF(I,7)=0
1180 NEXT I
1190 FOR DF1=0 TO 107
1200 O1=SO(D(DF1,0)) :: 02=SO(D(DF1,1))
1210 IF 01<>02 OR 01=0 OR 02=0 THEN 1330
1220 GOSUB 620
1230 GOSUB 80
1240 IF P=4 OR P=14 THEN DFINF,71=1 :: GOTO 1270
1250 IF 01=1 OR P<=DF(NF,8)THEN 1330
1260 DF(NF,7)=10

1270 DF(NF,S)=P
1280 NF=0
1290 FOR I=0 TO 15
1300 IF DF(I,8)>=DF(NF,8)THEN 1320
1310 IF DF(I,7)=0 OR DF(I,7)=10 THEN NF=I
1320 NEXT I
1330 NEXT DF1
1340 RETURN
1350 REM
1360 REM determine strategic value of move
1370 IF WM=1 THEN 1520
1380 MC=0 :: N2=0
1390 FOR NF=0 TO 1
1400 IF DF(NF,7)=0 THEN 1460
1410 GOSUB 80
1420 IF DF(NF,7)=1 THEN 1450
1430 IF P=MC THEN N2=N2+1
1440 IF P>MC THEN MC=P :: N2=1
1450 IF P=4 THEN NF=15
1460 NEXT NF
1470 IF PP=-1 THEN 1520
1480 IF P=4 THEN RETURN
1490 IF MC<MP THEN RETURN
1500 IF MC=MP AND N2<N1 THEN RETURN
1510 IF MC=MP AND N2=N1 AND RND<.5 THEN RETURN
1520 MP=MC :: N1=N2
1530 PP=CP :: PT=CT
1540 RETURN
1550 REM
1560 REM Player move*******
1570 IF PC<5 THEN 1610
1580 PRINT "WHICH CHECKER 00 YOU WANT TO MOVE"
1590 GOSUB 1690 :: PT=X
1600 IF B(PT)<>1 THEN PRINT "N(;.,. POSSIBLE" : : GOTO 1580
1610 PRINT "WHERE DO YOU PUT YOUR CHECKER"
1620 GOSUB 1690 1: PP=X
1630 IF B(PP)<>0 THEN PRINT "NOT POSSIBLE" :: GOTO 1610
1640 IF PC=5 THEN B(PT)=0
1650 IF PC<5 THEN PC=PC+1
1660 B(PP)=1
1670 GOSUB 740

1680 RETURN
1690 REM input**********
1700 INPUT X$:: IF LEN(X$)<>2 THEN 1750
1710 L$=SEG$(X$,1,1):: D$=SEG$(X$,2,1)
1720 IF L$<"A" OR L$>"E" OR D$<"1" OR D$>"5" THEN 1750
1730 X=ASC(L$)-S*VAL(D$)-40
1740 RETURN
1750 PRINT "WRONG INPUT,TRY AGAIN" :: GOTO 1700
1760 REM computer move**********
1770 IF CC1<5 THEN PT=CC1 :: CC1=CC1+1 :: GOTO 1830
1780 PRINT "I TAKE ";CHR$(65+PT-INT(PT/5)*5);5-INT(PT/5)
1790 B(PT)=0
1800 FOR CI=0 TO 4
1810 IF CC(CI,0)=PT THEN PT=CI :: CI=4
1820 NEXT CI
1830 PRINT "I PUT IT AT ";CHR$(65+PP-INT(PP/5)*5);5-INT(PP/5)
1840 B(PP)=10 :: CC(PT,0)=PP
1850 GOSUB 740
1860 RETURN
1870 REM main program**********
1880 PRINT "PLEASE WAIT"
1890 GOSUB 210
1900 GOSUB 470
1910 CC1=0 :: PC=0
1920 PP=12 :: GOTO 2140
1930 FOR I=0 TO 4 :: CC(I,1)=0 :: NEXT I

1940 GOSUB 860
1950 IF P=5 THEN END
1960 IF WM=1 THEN 1960
1970 GOSUB 1130
1980 MP=0 :: N1=0 :: PP=-1
1990 BF=0 :: EF=24
2000 IF OM<>-1 THEN BF=OM :: EF=OM
2010 FOR CP=BF TO EF
2020 IF B(CP)<>0 THEN 2130
2040 B(CP)=10
2050 IF CC1<5 THEN GOSUB 1360 :: GOTO 2120
2060 FOR CI=0 TO 4
2070 IF CC(CI,1) THEN 2110
2080 CT=CC(CI,0) :: B(CT)=0
2090 GOSUB 1360
2100 B(CT)=10
2110 NEXT CI
2120 B(CP)=0
2130 NEXT CP
2140 GOSUB 1760
2150 IF WM=1 THEN END
2160 GOSUB 1560
2170 PRINT "PLEASE WAIT"
2180 GOTO 1930

 

 

  • Thanks 1
Link to comment
Share on other sites
Lee Stewart Quadrunner

+Lee Stewart

Posted
Posted
26 minutes ago, oddemann said:

Anyway, I looked at... "Here Lives/QUI VIVE" and I am stomped at 1700, I think most of the bugs are out.

  

1600 IF B(PT)<>1 THEN PRINT "N(;.,. POSSIBLE" : : GOTO 1580

1680 RETURN
1690 REM input**********
1700 INPUT X$:: IF LEN(X$)<>2 THEN 1750
1710 L$=SEG$(X$,1,1):: D$=SEG$(X$,2,1)
1720 IF L$<"A" OR L$>"E" OR D$<"1" OR D$>"5" THEN 1750
1730 X=ASC(L$)-S*VAL(D$)-40
1740 RETURN
1750 PRINT "WRONG INPUT,TRY AGAIN" :: GOTO 1700

should be 

1600 IF B(PT)<>1 THEN PRINT "NOT POSSIBLE" : : GOTO 1580    <<----changed

1680 RETURN
1690 REM input**********
1700 INPUT X$:: IF LEN(X$)<>2 THEN 1750
1710 L$=SEG$(X$,1,1):: D$=SEG$(X$,2,1)
1720 IF L$<"A" OR L$>"E" OR D$<"1" OR D$>"5" THEN 1750
1730 X=ASC(L$)-5*VAL(D$)-40                                 <<----changed
1740 RETURN
1750 PRINT "WRONG INPUT,TRY AGAIN" :: GOTO 1700

...lee

  • Like 3
Link to comment
Share on other sites
oddemann Dragonstomper

oddemann

Posted
  • Author
Posted
1 minute ago, Lee Stewart said:

  


1600 IF B(PT)<>1 THEN PRINT "N(;.,. POSSIBLE" : : GOTO 1580

1680 RETURN
1690 REM input**********
1700 INPUT X$:: IF LEN(X$)<>2 THEN 1750
1710 L$=SEG$(X$,1,1):: D$=SEG$(X$,2,1)
1720 IF L$<"A" OR L$>"E" OR D$<"1" OR D$>"5" THEN 1750
1730 X=ASC(L$)-S*VAL(D$)-40
1740 RETURN
1750 PRINT "WRONG INPUT,TRY AGAIN" :: GOTO 1700

should be 


1600 IF B(PT)<>1 THEN PRINT "NOT POSSIBLE" : : GOTO 1580    <<----changed

1680 RETURN
1690 REM input**********
1700 INPUT X$:: IF LEN(X$)<>2 THEN 1750
1710 L$=SEG$(X$,1,1):: D$=SEG$(X$,2,1)
1720 IF L$<"A" OR L$>"E" OR D$<"1" OR D$>"5" THEN 1750
1730 X=ASC(L$)-5*VAL(D$)-40                                 <<----changed
1740 RETURN
1750 PRINT "WRONG INPUT,TRY AGAIN" :: GOTO 1700

...lee

Sorry Lee, I made a new tread for this... could you post it there too?

Anyway... Thx... You have eyes like an eagle!

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
 Share
Go to topic listing

  • Recently Browsing   0 members

    • No registered users viewing this page.
AtariAge
Forums
Store
General
Follow AtariAge

Copyright ©1998-2023 AtariAge

×
×
  • Create New...