Программирование на языке BASIC 1990 г.

Приложение D - примеры программ.


П Р И Л О Ж Е Н И Е   D
                 П Р И М Е Р Ы   П Р О Г Р А М М
    Это  приложение содержит некоторые примеры  программ,  демон
стрирующие возможности ZX SPEKTRUM.
    Первая  из  этих  программ требует ввести  дату  и  дает  дни
недели, которые соответствуют этой дате.
     10 REM KONVERT DATE TO DAY
     20 DIM D$(7,6): REM DAYS OF WEEK
     30 FOR N=1 TO 7: READ D$(N): NEXT N
     40 DIM M(12): REM LENGTHS OF MONTHS
     50 FOR N=1 TO 12: READ M(N):NEXT N
    100 REM INPUT DAте
    110 INPUT "DAY?":DAY
    120 INPUT "WONTH?":WONTH
    130 INPUT "YEAR (20TH CENTURY ONLY) ?":YEAR
    140 IF YEAR<1901 THEN PRINT "20TH CENTURY STARTS AT 1901":
        GO TO 100
    150 IF YEAR>2000 THEN PRINT "20TH CENTURY ENDS AT 2000":
        GO TO 120
    160 IF MONTH <1 THEN GO TO 210
    170 IF MONTH>12 THEN GO TO 210
    180 IF YEAR/4-INT(YEAR/4)=0 THEN LET M(2)=29: REM LEAP YEAR
    190 IF DAY>M(MONTH) THEN PRINT "THIS MONTH HAS ONLY":
        M(MONTH):"DAYS": GO TO 500
    200 IF DAY>0 THEN GO TO 300
    210 PRINT "STUFF AND NONSENSE. GIVE ME A REAL DATE."
    220 GO TO 500
    300 REM CONVERT DATE TO NUMBER OF DAYS SINCE START OF CENTURY
    310 LET Y=YEAR-1901
    320 LET B=365*Y+INT(Y/4):REM NUMBER OF DAUS TO START OF YEAR
    330 FOR N=1 TO MONTH-1: REM ADD ON PREVIOUS MONTH
    340 LET B=B+M(N):NEXT N
    350 LET B=B+DAY
    400 REM SONVERT TO DAY OF WEEK
    410 LET B=B-7*INT(B/7)+1
    420 PRINT DAY;"/";MONTH;"/";YEAR
    430 FOR N=6 TO3 STEP-1:REM REMUVE TRAILING SPACES
    440 IF D$(B,N) <>" " THEN GO TO 460
    450 NEXT N
    460 LET E$=D$(B,TON)
    470 PRINT "IS A";E$;"DAY"
    500 LET M(2)=28:REM RESTORE FEBRUARY
    510 INPUT "AGAIN",A$
    520 IF A$ ="N"THEN GO TO 540
    530 IF A$<>"N' THEN GO TO 100
   1000 REM DAYS OF WEEK
   1010 DATA "MON","TUES","WEDNES"
   1020 DATA "THURS","FRI","SATUR","SUN"
Эта  программа  устанавливает соответствие между ярдом,  футом  и
дюймом:
     10 INPUT "YARDS?","YD","FEET","FT","INCHES",IN
     40 GO SUB 2000:REM PRINT THE VALUES
     50 PRINT " = "
     70 GO SUB 1000: REM THE ADJUSTMENT
     80 GO SUB 2000: REM PRINT THE ADJUSTED VALUES
     90 PRINT
    100 GO TO 10
   1000 REM SUBROUTINE TO ADJUST YD,FT,IN TO THE NORMAL FORM FOR
        YARDS, FEET AND INCHES
   1010 LET IN=35*YD+12*FT+IN:REM NOW EVERYTHING IS IN INCHES
   1030 LET S=SGN IN: LET IN=ABS IN: REM WE WORK WITH IN
        POSITIVE, HOLDING ITS SIGN IN S
   1060 LET FT=INT(IN/12): LET IN=(IN-12*FT)*S: REM NOW IN IS OR
   1080 LET YD=INT(FT/3)*S: LET FT=FT*S-3*YD:RETURN
   2000 REM  SUBROUTINE TO PRINT YD,FT AND IN "  ?  PRINT  YD;"
        YD";FT;"FT";IN;"IN";:RETURN
    эта  программа  моделирует  выбрасывание монеты  для  игры  в
'тайку':
      5 RANDOMIZE
     10 FOR M=1 TO 6: REM FOR 6 THROWS
     20 LET C=0:REM INITIALIZE COINN TOTAL TO 0
     30 FOR N=1 TO 3: REM FOR 3 COINS
     40 LET C=C+2+INT(2*RND)
     50 NEXT N
     60 PRINT "   "
     70 FOR N=1 TO 2: REM 1BT FOR THE THROWN HEXAGRAM,
                          2 ND FOR THE CHANGES
     80 PRINT "-----" ;
     90 IF C=7 THEN PRINT "-";
    100 IF C=8 THEN PRINT " ";
    110 IF C=6 THEN PRINT "X";: LET C=7
    120 IF C=9 THEN PRINT "0";: LET C=8
    130 PRINT "-----"
    140 NEXT N
    150 PRINT
    160 INPUT A$
    170 NEXT м:NEW
    Для запуска программы введите ее в компьютер, запустите испо
лнение, а затем нажмите клавишу ENTER пять раз для получения двух
хексаграмм, просмотрите "китайскую книгу изменений",
она будет описывать ситуацию и последовательность соответствующую
этому действию,  а выбуквы 'е'!!   глубину параллелей между ней
и вашей собственной жизнью. Нажмите клавишу ENTER шестой раз.
программа  будет  обнуляться - это избавит вас от  легкомысленного
использования результатов.
    Многие  пользователи  найдут тесты  всегда  более  вероятными
ежели они сами могут это предполагать.
    Следующая  программа - игра "ящеры".  вы задумываете название
некоторого животного, а компьютер пытается  его отгадать, задавая
вам вопросы, на которые вы должны отвечать "да" или "нет".
Если компьютер не был ранее знаком с таким животным, то он просит
вас  задать  ему наводящие вопросы,  которые  помогут  ему  найти
правильный ответ или он попросит вас предложить ему задать назва-
ние нового животного:
   5 REM PANGOLINS
  10 LET NG=100: REM NUMBER OF GUESTIONS AND ANIMALS
  15 DIM G$(NQ,60):DIM A(NQ,2): DIM R$(1)
  20 LET QF=8
  30 FOR N=1 TO QF/2-1
  40 READ Q$(N): READA(N,1): READ A(N,2)
  50 NEXT N
  60 FOR N=N TO QF-1
  70 READ Q$(N): NEXT N
 100 REM 110 PRINT "THINK OF AN ANIMAL.","PRESS ANY KEY TO CONTINUE."
 120 PAUSE 0
 130 LET C=1. REM START WITH IST QUESTION
 140 IF A(C,1)=0 THEN GO TO 300
 150 LET P$=Q$(C): GO SUB 910
 160 PRINT"?": GO SUB 1000
 170 LET IN=1: IF R$="Y" THEN GO TO 210
 180 IF R$="Y" THEN GO TO 210
 190 LET IN=2: IF R$="N" THEN GO TO 210
 200 IF R$<>"N" THEN GO TO 150
 210 LET C=A(C,IN): GO TO 140
 300 REM ANIMAL
 310 PRINT"ARE YOU THINKING QF"
 320 LET P$=Q$(C): GO SUB 900: PRINT '?"
 330 GO SUB 1000
 340 IF R$="Y" THEN GO TO 400
 350 IF R$="Y" THEN GO TO 400
 360 IF R$="N" THEN GO TO 500
 380 PRINT "ANSWER ME PROPERLY WHEN I", "TALKING TO YOU":
     GO TO 300
 400 REM QUESSED IT
 410 PRINT "I THOUNT AS MUCH.": GO TO 800
 500 REM NEW ANIMAL
 510 IF QF>NQ-1 THEN PRINT"I" M SURE YOUR ANIMAL IS VERY",
     "INTERESTING, BUT I DON'T HAVE","ROOM FOR IT JUST NOW.":
      GO TO 800
 520 LET Q$(QF)=Q$(C):REM MOVE OLD ANIMAL
 530 PRINT "WHAT IS IT, THEN?": INPUT Q$(QF+1)
 540 PRINT "TELL ME A QUESTION XHICH DIST-","INQUISHES
     BETWEEN"
 550 LET P$=Q$(QF): GO SUB 900:PRINT "AND"
 560 LET P$=Q$(QF+1): GO SUB 900: PRINT " "
 570 INPUT S$: LET B=LEN S$
 580 IF S$(B)="?" THEN LET B=B-1
 590 LET Q$(C)=S$(TO B): REM INSERT QUESTION
 600 PRINT " WHAT IS THE ANSWER FOR"
 610 LET P$=Q$(QF+1): GO SUB 900: PRINT "?"
 620 GO SUB 1000
 630 LET IN=1:LET IO=2:REM ANSWERS FOR NEW AND OLD ANIMALS
 640 IF R$="y" THEN GO TO 700
 650 IF R$="Y" THEN GO TO 700
 660 LET IN=2: LET IO=1
 670 IF R$="n" THEN GO TO 700
 680 IF R$="N" THEN GO TO 700
 690 PRINT " THAT'S NO GOOD.": GO TO 600
 700 REM UPDATE ANSWERS
 710 LET A(C,IN)=QF+1: LET A(C,IO)=QF
 720 LET QF=QF+2: REM NEXT FREE ANIMAL SPACE
 730 PRINT "THAT FOOLED ME."
 800 REM AGAIN?
 810 PRINT "DO YOU WANT ANOTHER GO?": GO SUB 1000
 820 IF R$="у" THEN GO TO 100
 830 IF R$="Y" THEN GO TO 100
 840 STOP
 900 REM PRINT WITHOUT TRAILING SPACES
 905 PRINT " ";
 910 FOR N=50 TO 1 STEP-1
 920 IF P$(N)<>" " THEN GO TO 940
 930 NEXT N
 940 PRINT P$(TO N);: RETURN
1000 REM GET REPLY
1010 INPUT R$: IF R$=" " THEN RETURN
1020 LET R$=R$(1): RETURN
2000 REM INITIAL ANIMALS
2010 DATA "DOES IT LINE IN THE SEA",4,2
2020 DATA "IS IT SCALY",3,5
2030 DATA "DOES IT EAT ANTS",6,7
2040 DATA "A WHALE","A BLANCMANGE","A PANGOLIN","AN ANT"
    Следующая программа рисует на экране "UNION FLAG".
   5 REM UNION FLAG
  10 LET R=2: LET W=7: LET B=1
  20 BORDER 0: PAPER 8: INK W: CLS
  30 REM BLACK IN BOTTOM OF SCREEN
  40 INVERSE 1
  50 FOR N=40 TO 0 STEP -5
  60 PLOT PAPER  0;7,N: DRAW PAPER 0;24,0
  70 NEXT N: INVERSE 0
 100 REM DRAW IN WHITE PARTS
 105 REM ST. GEORGE
 110 FOR N=0 TO 7
 120 PLOT 104+N,175: DRAW 0,-35
 130 PLOT 151-N,175: DRAW 0,-35
 140 PLOT 151,-N,48: DRAW 0,35
 150 PLOT 104+N,48:  DRAW 0,35
 160 NEXT N
 200 FOR N=0 TO 11
 210 PLOT 0,139-N: DRAW 111,0
 220 PLOT 255,139-N: DRAW-111,0
 230 PLOT 255,84+N: DRAW -111,0
 240 PLOT 0,84+N: DRAW 111,0
 250 NEXT N
 300 REM ST, ANDREW
 310 FOR N=0 TO 35
 320 PLOT 1+2*N,175-N:DRAW 32,0
 330 PLOT 224-2*N,175-N: DRAW 16,0
 340 PLOT 254-2*N,48+N: DRAW-32,0
 350 PLOT 17+2*N,48+N: DRAW 16,0
 360 NEXT N
 370 FOR N=0 TO 19
 380 PLOT 185+2*N,140+N: DRAW 32,0
 390 PLOT 200+2*N,83-N: DRAW 16,0
 400 PLOT 39-2*N,83-N: DRAW 32,0
 410 PLOT 54-2*N,140+N: DRAW -16,0
 420 NEXT N
 430 FOR N=0 TO 15
 440 PLOT 255,160+N: DRAW 2*N-30,0
 450 PLOT 0,63-N: DRAW 3102*N,0
 460 NEXT N
 470 FOR N=0 TO 7
 480 PLOT 0,160+N: DRAW 14-2*N,0
 485 PLOT 255,63-N: DRAW 2*N-15,0
 490 NEXT N
 500 REM RED STRIPES
 510 INVERSE 1
 520 REM ST, GEORGE
 530 FOR N=96 TO 120 STEP 8
 540 PLOT PAPER R;7,N: DRAW PAPER N;241,0
 550 NEXT N
 560 FOR N=112 TO 136 STEP 8
 570 PLOT PAPER R;N,168: DRAW PAPER R;0,-113
 580 NEXT N
 600 REM ST, PATRICK
 610 PLOT PAPER R;170,140:DRAW PAPER R;70,35
 620 PLOT PAPER R;179,140: DRAW PAPER R;70,35
 630 PLOT PAPER R;199,83: DRAW PAPER R;56,-28
 640 PLOT PAPERR;184,83: DRAW PAPER R;70,-35
 650 PLOT PAPER R;86,83: DRAW PAPER R;-70,-35
 660 PLOT PAPER R;72,83: DRAW PAPER R;-70,-35
 670 PLOT PAPER R;56,140: DRAW PAPER R;-56,28
 680 PLOT PAPER R;71,140: DRAW PAPER R;-70,35
 690 INVERSE 0:PAPER 0: INK 7
    Если вы не англичанин, то можете изобразить свой флаг.
Следующая  программа  -  это игра в слова,  первый  игрок  вводит
слово, а второй его отгадывает.
   5 REM HANGMAN
  10 REM SET UP SCREEN
  20 INK 0: PAPER 7: CLS
  30 LET X=240: GO SUB 1000: REM DRAW MAN
  40 PLOT 235,128: DRAW 4,0: REM MOUTH
 100 REM SET UP WORD
 110 INPUT W$: REM WORD TO CUESS
 120 LET B=LENW$: LETV$=" "
 130 FOR N=2 TO B: LET V$=V$+" "
 140 NEXT N: REM V$=WORD GUESSED SO FAR
 150 LET C=0: LET D=0: REM CUESS & MISTAKE COUNTS
 160 FOR N=0 TO B-1
 170 PRINT AT 20,N;"-";
 180 NEXT N: REM WRITE-' S INSTEAD OF LETTERS'
 200 INPUT "GUESS A LETTER:";G$
 210 IFG$=" " THEN GO TO 200
 220 LET G$=G$(1): REM 1ST LETTER ONLY
 230 PRINT AT 0,C;G$
 24 U$=V$
 250 FOR
 N=1 TO B: REM UPDATE GUESSED WORD
 260 IF W$(N)=G$ THEN LET V$(N)=G$
 270 NEXT N
 280 PRINT AT 19,0; V$
 290 IF V$=W$ THEN GO TO 500: REM WORD GUESSED
 300 IF V$<>U$ THEN GO TO 200: REM GUESSED WAS RIGHT
 400 REM DRAW NEXT PART OF GALLOWS
 410 IF D=8 THEN GO TO 600: REM HANGED
 420 LET D=D+1
 430 READ X0,Y0,X,Y
 440 PLOT X0,Y0: DRAW X,Y
 450 GO TO 200
 500 REM FREE MAN
 510 OVER1: REM RUB OUT MAN
 520 LET X=240: GO  SUB 1000
 530 PLOT 238,128: DRAW 4,0: REM MOUTH
 540 OVER 0: REM REDRAW MAN
 550 LET X=146: GO SUB 1000
 560 PLOT 143,129: DRAW 6,0,P1/2: REM SMILE
 570 GO TO 800
 600 REM HANG MAN
 610 OVER 1: REM RUB OUT FLOOR
 620 PLOT 255,65: DRAW -48,0
 630 DRAW 0, -48: REM OPEN TRAPDOOR
 640 PLOT 238,128: DRAW 4,0: REM RUB OUT MOUTH
 650 REM MOVE LIMBS
 655 REM ARMS
 660 PLOT 255,117: DRAW -15,-15: DRAW -15,15
 670 OVER 0
 680 PLOT 238,81: DRAW 4,21: DRAW 4,21: DRAW 4,-21
 690 OVER 1: REM LEGS
 700 PLOT 255,56: DRAW -15,15: DRAW -15,-15
 710 OVER 0
 720 PLOT 236,60: DRAW 4,21: DRAW 4,-21
 730 PLOT 237,127: DRAW 6,0,PI/2: REM FROWN
 740 PRINT AT 19,0;W$
 800 INPUT "AGAIN?";A$
 810 IF A$=" " THEN GO TO 850
 820 LET A$=A$(1)
 830 IF A$="N" THEN STOP
 840 IF A$(1)="N" THEN STOP
 850 RESTORE: GOTO 5
1000 REM DRAW MAN AT COLUMN X
1010 REM HEAD
1020 CIRCLE X,132,8
1030 PLOT X+4,134: PLOT X-4,134: PLOT X,131
1055 PLOT X,101:DRAW 0,-19
1060 REM LEGS
1070 PLOT X-15,66: DRAW 15,15: DRAW 15,-15
1080 REM ARMS
1090 PLOT X-15,117: DRAW 15,-15: DRAW 15,15
1100 RETUPN
2000 DATA 120,55,135,0,184,65,0,91
2010 DATA 168,65,16,16,164,81,16,-16
2020 DATA 184,156,68,0,184,140,16,16
2030 DATA 204,156,-20,-22,240,156,0,-16
2040 DATA 184,156,68,0,184,140,16,16
2050 DATA 204,156,-20,-20,240,156,0,-16



СОДЕРЖАНИЕ:


  Оставте Ваш отзыв:

  НИК/ИМЯ
  ПОЧТА (шифруется)
  КОД



Темы: Игры, Программное обеспечение, Пресса, Аппаратное обеспечение, Сеть, Демосцена, Люди, Программирование

Похожие статьи:
ZX-Обоз - Итог всем предыдущим номерам газеты.
Ассемблер - Индикатор - цветные квадратики.
Кто там кодит? - Работаем с MS-DOS: Ms-Dos дискеты - описание структуры Ms-Dos диска.
Глюк - Глюк?! Где?! Это не глюк, a bеta-версия...
Short Story - Poджeр ЖEЛЯЗНЫ: Dark Evil.

В этот день...   25 апреля