PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #15)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “COLORDEMO”
Two main programs are on this disk. P*man are maze games that run
under BASIC. PCMAN requires a joystick, PATHMAN doesn't. As far as
games go, they are worth looking at and will beat you! COLORDEMO is
just that a demo program that displays computer generated graphics.
The demo can be run on a non-color monitor but to get the full effect a
color monitor is required (really no other use for the demo).
System Requirements: Color graphics
How to Start: Load DOS and type DRAW to enter the main program. To
run BASIC programs consult the directions in GETTING STARTED for your
configuration.
File Descriptions:
-------- --- COLORDEMO
ELEPH DAT Part of COLORDEMO
ELEPH EXE Part of COLORDEMO
ADVLAND PIC Part of COLORDEMO
FINISH BAS Part of COLORDEMO - end of demo
MCODE %%% Part of COLORDEMO
BLASTOFF BAS Part of COLORDEMO - rocket blasts off
ESSXFADE BAS Part of COLORDEMO
FLYBY BAS Part of COLORDEMO - objects in space
LANDSEQ BAS Part of COLORDEMO - landing
WELCOME BAS Part of COLORDEMO
BUTTRFLY BAS Part of COLORDEMO - butterflies flying
ELEPHANT BAS Part of COLORDEMO - dancing elephant
BLIMP BAS Part of COLORDEMO - blimp flying
OTHDEMO BAS Part of COLORDEMO - game demonstration
SCREEN ASM Assembler source for SCREEN.EXE
SCREEN EXE Set color/mono/40/80/low/med/high resolution
DRAW ASM Assembler source for DRAW.EXE
DRAW EXE Block-read a file directly to color/graphics buffer
FAMILYDA Y Part of COLORDEMO
NEXTSHOW BAS Part of COLORDEMO
START BAS Part of COLORDEMO
COLORDEM BAT Part of COLORDEMO - run color demo (impressive demo)
COLOR EXE Set display to color
MONO EXE Set display to monochrome
PRTGRAF BAS Draw a polygon, optionally print with graftrax
MONSW BAS Another color/mono program (Good as a subroutine)
PCMAN BAS Color game using joysticks (Untested)
PATHMAN BAS Color game using keypad - no joysticks needed
TEST BAS Test program
BLASTOFF.BAS
5 DIM SHIP(430),SHIP1(430)
10 CLS:KEY OFF:SCREEN 1:COLOR 1,0
50 LINE (50,181)-(270,199),1,BF
52 LINE (185,55)-(210,180),1,B
54 LINE (185,80)-(210,105),1,B
56 LINE (185,130)-(210,155),1,B
58 LINE (185,30)-(210,55),1,B
60 LINE (185,30)-(210,55),1
62 LINE (185,55)-(210,30),1
64 LINE (185,55)-(210,80),1
66 LINE (185,80)-(210,55),1
68 LINE (185,80)-(210,105),1
70 LINE (185,105)-(210,80),1
72 LINE (185,105)-(210,130),1
74 LINE (185,130)-(210,105),1
76 LINE (185,130)-(210,155),1
78 LINE (185,155)-(210,130),1
80 LINE (185,155)-(210,180),1
82 LINE (185,180)-(210,155),1
100 CIRCLE (185,100),60,3,3.14-0.75,3.14,1.5
110 CIRCLE (125,100),60,3,0,0.75,1.5
120 LINE(145,100)-(145,170),3
130 LINE(165,100)-(165,170),3
140 LINE(145,170)-(165,170),3
145 PAINT (146,169),2,3
150 LINE (145,140)-(135,150),3
152 LINE (135,150)-(135,180),3
154 LINE (135,180)-(145,170),3
155 PAINT (136,170),2,3
160 LINE (165,140)-(175,150),3
162 LINE (175,150)-(175,180),3
164 LINE (175,180)-(165,170),3
165 PAINT (166,170),2,3
200 A=11:B=20
201 LOCATE A,B:PRINT"I"
202 LOCATE A+1,B:PRINT"B"
203 LOCATE A+2,B:PRINT"M"
204 LOCATE A+3,B:PRINT" "
205 LOCATE A+4,B:PRINT"S"
206 LOCATE A+5,B:PRINT"H"
207 LOCATE A+6,B:PRINT"U"
208 LOCATE A+7,B:PRINT"T"
209 LOCATE A+8,B:PRINT"T"
210 LOCATE A+9,B:PRINT"L"
211 LOCATE A+10,B:PRINT"E"
490 II=0:FOR I=1 TO 100:II=II+1:NEXT I
491 LINE (50,181)-(270,199),0,BF
492 LINE (145,170)-(155,198),3
494 LINE (165,170)-(155,198),3
496 PAINT (155,190),3,3
500 GET (132,58)-(179,199),SHIP
504 PUT(132,58),SHIP,>=
505 LINE (50,181)-(270,199),1,BF
506 PUT(132,58),SHIP,>=
507 A=58:K=0
508 FOR I=1 TO 63
510 B=INT((I/10)^3)-INT(((I-1)/10)^3)
511 IF I<16 THEN GOSUB 600
512 IF (A-B)<0 THEN GOSUB 530:GOTO 517
515 GOSUB 520
517 NEXT I
518 GOTO 700
520 PUT(132,A),SHIP,>=
523 PUT(132,A-B),SHIP,>=
525 A=A-B
526 RETURN
530 IF (K MOD 2)=0 GOTO 542
532 GET (132,B-A)-(179,B-A+142),SHIP
534 PUT (132,A),SHIP1,>=
536 PUT (132,0),SHIP,>=
538 GOTO 550
542 GET (132,B-A)-(179,B-A+142),SHIP1
544 PUT (132,A),SHIP,>=
546 PUT (132,0),SHIP1,>=
550 A=0:K=K+1
552 RETURN
600 ON I GOTO 601,602,603,604,605,606,607,608,609,610,611,612,613,614,615
601 X=15:Y=193:R=6:GOTO 698
602 X=22:Y=190:R=9:GOTO 698
603 X=32:Y=190:R=9:GOTO 698
604 X=42:Y=185:R=11:GOTO 698
605 X=54:Y=185:R=11:GOTO 698
606 X=66:Y=185:R=11:GOTO 698
607 X=60:Y=170:R=11:GOTO 698
608 X=71:Y=165:R=15:GOTO 698
609 X=90:Y=185:R=14:GOTO 698
610 X=90:Y=155:R=13:GOTO 698
611 X=100:Y=168:R=16:GOTO 698
612 X=115:Y=185:R=11:GOTO 698
613 X=115:Y=155:R=25:GOTO 698
614 X=128:Y=185:R=11:GOTO 698
615 X=133:Y=135:R=15:GOTO 698
698 CIRCLE (155-X,Y),R,3,,,1:CIRCLE (155+X,Y),R,3,,,1:PAINT(155-X,Y),3,3:PAINT(155+X,Y),3,3
699 RETURN
700 REM this is BASICMOV
710 ' BASIC DEMO TO USE CALL FUNCTION
720 ' USES AN ASSEMBLER SUBROUTINE TO MOVE
730 ' UP TO 65535 BYTES IN MEMORY
740 N=10:REM number of frames to show, starting at highmemory(256k)
750 KEY OFF
760 'DEFINE SEGMENT TO PLACE THE ASSEMBLER CODE
770 DEF SEG=&H1200
780 ' THIS TEST IF IT IS ALREADY LOADED, IF NOT IT LOADS IT
790 BLOAD"mcode.%%%",0
800 SUBRT = 0
810 ' A% = THE FROM ADDRESS
820 ' B% = THE TO ADDRESS
830 ' C% = THE LENGTH TO MOVE
840 GOSUB 980:REM TURN ON COLOR SCREEN
850 DEF SEG=&H1200
860 KEY OFF:SCREEN 1:COLOR 1,0
870 FOR DISP=1 TO N
880 MEMDEL=DISP*1024
890 MEMORY=16384-MEMDEL
900 A%=MEMORY
910 B%=&HB800
920 C%=&H4000
930 CALL SUBRT (A%,B%,C%)
940 FOR PAUSE=1 TO 1000:NEXT
950 NEXT
952 GOSUB 1100
955 LOCATE 25,1:FOR EARTHMOVE=1 TO 25:PRINT " ":FOR PAUSE=1 TO 700:NEXT
956 FOR STAR=1 TO 6:PSET(RND*320,180)
957 NEXT STAR
958 NEXT EARTHMOVE
960 RUN"flyby
970 REM switch to color/graphics adapter
980 DEF SEG=0
990 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
1000 DEF SEG
1010 LOCATE ,,1,6,7
1020 SCREEN 0
1030 WIDTH 40
1040 RETURN
1100 CIRCLE(160,1),225
1105 COLOR 8,
1150 RETURN
BLIMP.BAS
10 DIM A(2000)
20 DIM C(2000)
30 DIM B(2000)
35 CLS:L$="HAVE A NICE VERMONT SUMMER!!!!"
37 F$ = " "+L$+".............."
40 IF L$ = "" THEN L$ = "-----introducing ... THE-IBM-personal-computer------"
50 SCREEN 1,0:COLOR 1,0:KEY OFF
60 CLS
70 GET (1,1)-(45,30),B
80 FOR G =5 TO 1 STEP -1
90 CIRCLE (130,83),80,2,,,G*0.1
100 IF G/2-INT(G/2)>0 THEN PAINT (130,80),1,2
110 IF G/2-INT(G/2)<0.01 THEN PAINT (130,80),3,2
120 NEXT G
130 LINE (124,120)-(138,126),2,BF
140 DRAW"c2br74bu10nu66br1nu66nl34u66l34run
150 PAINT (192,54),3,2
160 LOCATE 11,14:PRINT" IBM "
170 CIRCLE(100,10),6,3,1,4.1
180 CIRCLE(107,10),7,3,1,2.1
190 CIRCLE(104,15),6,3,3,4.3
200 CIRCLE(114,10),7,3,1,2.1
210 CIRCLE(114,12),8,3,0,1.1
220 CIRCLE(114,13),8,3,4.6,0
230 CIRCLE(107,15),8,3,3.7,5.7
240 CIRCLE(100,17),4,3,2.7,4.7
250 CIRCLE(94,13),4,,3,3.7,2.7
260 PAINT(100,10),3,3
270 GET (80,1)-(130,22),A
280 PUT (80,1),B,PSET
290 LINE (0,190)-(320,190),1
310 PAINT(22,192),1,1
315 LINE(0,190)-(27,158),1
320 LINE(56,191)-(35,151),1
330 LINE(29,162)-(27,158),1
340 LINE(29,162)-(35,151),1
350 PAINT(15,182),1,1
352 GET (0,191)-(56,150),C
360 FOR I = 1 TO 380
370 GOSUB 420
380 PUT (I,1),B,OR
385 PUT (I,150),C,PSET
390 IF I > 28 THEN PUT (I-28,1),A,PSET
392 IF I > 128 THEN PUT (I-128,21),A,PSET
400 IF I > 2 THEN LOCATE 11,11:PRINT R$
410 NEXT I
420 R$ = MID$(F$,I,14)
421 IF R$ = ".............." THEN F$ = F$ + L$+"..............":IF LEN(F$)> 210 THEN RUN"FINISH
430 FOR T = 1 TO 50:NEXT T'TIMER FOR LETTERS
440 RETURN
450 PAINT (1,1),3
460 PUT (80,2),B,PSET
BUTTRFLY.BAS
1 CLEAR
5 'SAVE "BUTTER"
7 'WRITTEN BY HAL W. JENNINGS
10 GOTO 1000
30 PUT (X,Y),P0:RETURN
35 PUT (X,Y),P5:RETURN
40 PUT (X1,Y1),P0:RETURN
45 PUT (X1,Y1),P5:RETURN
99 'CHECK FOR PICTURE NEEDING ATTENTION
100 I=(I MOD NP)+1:IF PT!(I)<FNTM!(T$) THEN ON I GOSUB 201,301,400 ELSE GOTO 100
102 IF SND AND RND>0.44 THEN L=(L MOD K)+1:PLAY "L=D(L);N=F(L);"
105 IF L>=152 THEN FOR PAUSE=1 TO 1500:PAUSE=PAUSE+0:NEXT PAUSE:RUN"OTHDEMO" ELSE GOTO 100
200 'BUTTERFLY 1 - MOVEMENT
201 PP=TP:TP=(TP MOD 2)+1:IF RND<0.07*(10-S) AND PP=1 THEN TP=PP:S=5 ELSE S=10
205 NX=X-S:IF NX<0 THEN NX=276
210 NY=80+TP*6:PT!(I)=(FNTM!(T$)):ON PP GOSUB 30,35:X=NX:Y=NY:ON TP GOSUB 30,35:RETURN
300 'BUTTERFLY 2 - MOVEMENT
301 P1=T1:T1=(T1 MOD 2)+1:IF RND<0.07*(10-S1) AND P1=1 THEN T1=P1:S1=4 ELSE S1=8
305 NX1=X1-S1:IF NX1<0 THEN NX1=276
310 NY1=114+T1*6:PT!(I)=(FNTM!(T$)+1+(11-S1)*0.6):ON P1 GOSUB 40,45:X1=NX1:Y1=NY1:ON T1 GOSUB 40,45:RETURN
1000 DEFINT A-Z:KEY OFF:PLAY "MBMN":DIM F(250),D(250)
1005 PP=0:TP=0:X=0:Y=0:NX=0:NY=0:NP=2
1010 DIM P(3,5),P0(150),P1(150),P2(150),P3(150),P4(150),P5(150),PT!(5)
1020 DEF FNTM!(T$)=PEEK(&H46E)*65536!+PEEK(&H46D)*256+PEEK(&H46C)
1025 TIME$=TIME$:DEF SEG=0:RANDOMIZE 0!
1029 K=1
1030 READ F,D:IF F<0 THEN 1034
1031 D(K)=24/D:IF F>0 THEN F(K)=F-20
1032 K=K+1:GOTO 1030
1034 K=K-1
1035 GOSUB 5000
1999 'PICTURE 0
2000 SCREEN 1,0:COLOR 0,0:CLS
2001 LINE (11,15)-(35,15),3
2005 LINE (11,18)-(35,18),3
2010 LINE (35,15)-(40,17),3
2015 LINE (35,18)-(40,17),3
2020 CIRCLE (8,17),3,3
2025 PAINT (13,17),3,3
2027 LINE (17,15)-(32,15),0
2030 LINE (2,9)-(9,15),1
2035 LINE (6,6)-(9,14),1
2040 CIRCLE (1,8),1,1
2045 CIRCLE (5,5),1,1
2050 CIRCLE (22,10),9,3,5.3,4.2
2055 PAINT (22,8),2,3
2060 CIRCLE (31,10),6,3,5,2.2
2065 PAINT (33,10),2,3
2070 CIRCLE (17,10),7,3,1.6,4.1
2075 PAINT (11,10),1,3
2080 GET (0,0)-(40,25),P0
2090 CLS
2099 'PICTURE 5
2100 LINE (11,9)-(35,9),3
2105 LINE (11,12)-(35,12),3
2110 LINE (35,9)-(40,11),3
2115 LINE (35,12)-(40,11),3
2120 CIRCLE (8,11),3,3
2125 PAINT (13,11),3,3
2130 LINE (17,12)-(34,12),0
2135 LINE (18,11)-(33,11),0
2140 LINE (2,5)-(9,9),1
2145 LINE (6,2)-(9,8),1
2150 CIRCLE (1,4),1,1
2155 CIRCLE (5,1),1,1
2160 CIRCLE (22,17),9,3,1.5,5.4
2165 CIRCLE (31,17),7,3,1.7,0.9
2170 PAINT (22,17),1,3
2175 PAINT (31,17),1,3
2180 CIRCLE (17,17),7,3,2,5
2185 PAINT (11,17),2,3
2190 GET (0,0)-(40,25),P5
2195 CLS
3000 CIRCLE (80,140),10,3
3005 PAINT (80,140),3,3
3010 CIRCLE (62,140),12,3
3015 PAINT (62,140),2,3
3020 CIRCLE (90,152),12,3
3025 PAINT (90,152),2,3
3030 CIRCLE (89,127),12,3
3035 PAINT (89,127),2,3
3040 CIRCLE (72,128),12,3,1,3.2
3045 PAINT (72,128),2,3
3050 CIRCLE (72,152),12,3,3,5.4
3055 PAINT (72,152),2,3
3060 CIRCLE (98,140),12,3,5.2,1.3
3065 PAINT (98,140),2,3
3070 LINE (77,162)-(74,180),1
3075 LINE (82,160)-(79,180),1
3080 LINE (74,180)-(77,199),1
3085 LINE (79,180)-(82,199),1
3090 LINE (74,180)-(70,170),1
3095 LINE (74,183)-(68,180),1
3100 CIRCLE (68,174),6,1,1.2,4.5
3300 CIRCLE (300,10),40,3
3305 PAINT (300,10),3,3
3310 'CIRCLE (35,5),20,3
3315 'CIRCLE (45,8),17,3
4000 X=276:Y=86:TP=1
4010 GOSUB 30
4020 X1=160:Y1=120:T1=1
4030 GOSUB 40
4040 GOTO 100
5000 L=1:SND=NOT SND:RETURN
6000 REM The IBM Personal Computer Music Scroll
6010 REM Version 1.00 (C)Copyright IBM Corp 1981
6020 REM Licensed Material - Program Property of IBM
6040 DATA 0,6,0,6,42,4,46,4,49,4,49,4,0,4,61,2,0,2,61,2,0,6,58,2,0,2,58,2,0,6,42,4,42,4
6050 DATA 46,4,49,4
6060 DATA 49,4,0,4,61,2,0,2,61,2,0,6,59,2,0,2,59,2,0,6,41,4,41,4,44,4,51,4,51,4
6070 DATA 0,4,63,2,0,2,63,2,0,6,59,2,0,2
6080 DATA 59,2,0,6,41,4,41,4,44,4,51,4,51,4,0,4,63,2,0,2,63,2,0,6,58,2,0,2,58,2
6090 DATA 0,6,42,4
6100 DATA 42,4,46,4,49,4,54,4,0,4,66,2,0,2,66,2,0,6,61,2,0,2,61,2,0,6,42,4
6110 DATA 42,4,46,4,49,4,54,4,0,4,66,2,0,2
6120 DATA 66,2,0,6,63,2,0,2,63,2,0,6,44,4,44,4,47,4,51,2,0,2,51,14,0,2,48,4
6130 DATA 49,4,58,16
6140 DATA 54,4,46,4,46,8,44,4,51,8,49,4,42,4,0,2,42,2,42,4,0,8,49,2,0,2,47,2
6150 DATA 0,6,49,2,0,2
6160 DATA 47,2,0,6,49,4,58,16,56,4,49,2,0,2,46,2,0,6,49,2,0,2,46,2,0,6,49,4
6170 DATA 56,16,54,4,49,2,0,2,47,2,0,6,49,2,0,2,47,2,0,6,49,4,58,16
6180 DATA 56,4,49,4,54,4,56,4,58,4,61,8,59,4,58,2,58,2,58,4,56,2,0,2,54,4,0,4,0,4
6190 DATA -1,-1
DRAW.ASM
CODE SEGMENT PUBLIC
DOSCALL MACRO FUNCTION
MOV AH,FUNCTION
INT 21H
ENDM
DFCB EQU DS:5CH
OPEN EQU 0FH
SET_DTA EQU 1AH
RB_READ EQU 27H
PAGE ,132
RBR PROC FAR
ASSUME CS:CODE,ES:CODE,DS:NOTHING
JMP START
FCB DB 1 ;DRIVE "A"
DB 'USASTATE'
DB 'PIC'
DB 0,0
LRECL DW 0
DB 0,0,0,0
DB 0,0 ;DATE
DB 10 DUP(0) ;RESERVED
DB 0
DB 0,0,0,0
START:
PUSH DS
XOR AX,AX
PUSH AX
;
MOV AX,CS
MOV ES,AX
MOV SI,OFFSET DFCB
MOV DI,OFFSET FCB
MOV CX,12
CLD
REP MOVSB
;
MOV AX,0B800H
MOV DS,AX
MOV DX,0
DOSCALL SET_DTA ;SET DTA AT SCREEN
;
MOV AX,CS
MOV DS,AX ;ADDRESS SEGMENT OF FCB
MOV DX,OFFSET FCB ;
DOSCALL OPEN ;ISSUE OPEN
;
MOV AX,4080H ;SET UP OF 65536 BYTE IO
MOV LRECL,AX ;
MOV CX,5 ;SET AT LEAST 5 RECORDS
DOSCALL RB_READ ;RANDOM BLOCK READ
;
RET
RBR ENDP
CODE ENDS
END
ELEPHANT.BAS
6 FOR I=1 TO 2400: NEXT I
10 DEFINT A-Z:KEY OFF:K=0:MN=0:Z=0
15 DEF SEG=&HB800
20 DIM ARA#(38),ARL#(50),ALA#(88),ALL#(88),BRA#(38),BLL#(88),CRL#(50),CLA#(88)
25 DIM AEYE#(4),ATAIL#(13),CEYE#(4),CTAIL#(13)
30 DIM A#(825)
35 GOSUB 1200
40 DIM TFT$(100):GOSUB 500:PLAY"MF O2;T255;L4"
100 CLS:COLOR 9:PUT(90,5),A#
105 GET(108,76)-(133,111),ARA#:GET(149,132)-(200,183),ALL#
110 GET(114,151)-(157,183),ARL#:GET(124,75)-(184,117),ALA#
115 GET(151,38)-(159,44),AEYE#:GET(196,159)-(217,173),ATAIL#
190 I=0:K=0
200 PLAY TFT$(K):K=K+1:IF K=MN THEN 1000 ELSE I=(I MOD 8)+1:ON I GOTO 220,240,260,280,300,320,340,360
205 BEEP:GOTO 200
220 PUT(149,132),BLL#,PSET:GOTO 200
240 PUT(108,76),BRA#,PSET:GOTO 200
260 PUT(149,132),ALL#,PSET:GOTO 200
280 PUT(108,76),ARA#,PSET:GOTO 200
300 PUT(114,151),CRL#,PSET:GOTO 200
320 PUT(124,75),CLA#,PSET:GOTO 200
340 PUT(114,151),ARL#,PSET:GOTO 200
360 PUT(124,75),ALA#,PSET:GOTO 200
500 READ TFT$(MN):IF TFT$(MN)<>"" THEN MN=MN+1:GOTO 500 ELSE RETURN
505 DATA "MLF2","MSFD"
510 DATA "MLE2","MSED"
515 DATA "F7F7F7","MLFMSF9D"
520 DATA "MLE2","MNE2"
525 DATA "MLE2","MSEC"
530 DATA "MLD2","MSDC"
535 DATA "E7E7E7","MLEMSE9C"
540 DATA "MLD2","MND2"
545 DATA "MLF2","MSFD"
550 DATA "MLE2","MSED"
555 DATA "F7F7F7","MLFMSF9D"
560 DATA "MLE2","MNC2","MSA2","P4","P4"
565 DATA "P4","P4","P4","P4"
570 DATA "P4","P4","P4","P4"
575 DATA "P4","P4","P4","P4"
580 DATA "P4"
605 DATA "MLA2","MSAF#"
610 DATA "MLG#2","MSG#F#"
615 DATA "A7A7A7","MLAMSA9F#"
620 DATA "MLG#2","MNG#2"
625 DATA "MLG#2","MSG#E"
630 DATA "MLF#2","MSF#E"
635 DATA "G#7G#7G#7","MLG#MSG#9E"
640 DATA "MLF#2","MNF#2"
645 DATA "MLA2","MSAF#"
650 DATA "MLG#2","MSG#F#"
655 DATA "A7A7A7","MLAMSA9F#"
660 DATA "MLG#2","MNE2","MSC#2","P4","P4"
665 DATA "P4","P4","P4","P4"
670 DATA "P4","P4","P4","P4"
675 DATA "P4","P4","P4","P4"
680 DATA "P4"
900 DATA ""
1000 PUT(151,38),CEYE#,PSET:Z=0
1010 FOR K=1 TO 20:PUT(196,159),CTAIL#,PSET:FOR I=1 TO 200:NEXT:PUT(196,159),ATAIL#,PSET:FOR I=1 TO 200:NEXT:NEXT K:Z=Z+1:ON Z GOTO 1015,1020,1025,100
1015 OS=0:EC=1:OC=1:X=180:Y=20:D$="ENCORE!":GOSUB 60010:GOTO 1010
1020 EC=2:OC=2:X=20:Y=100:D$="ENCORE!":GOSUB 60010:GOTO 1010
1025 EC=3:OC=3:X=220:Y=140:D$="ENCORE!":GOSUB 60010:RUN"buttrfly
1200 GOSUB 60140:SCREEN 1,0:COLOR 8,1:CLS
1201 EC=2:OC=2:X=40:Y=23:D$="Who says you can't teach":GOSUB 60010
1202 X=105:Y=48:D$="an elephant":GOSUB 60010
1203 X=95:Y=73:D$="to tap dance?":GOSUB 60010
1207 OPEN "ELEPH.DAT" AS #1 LEN=128: DIM E$(15)
1208 FOR I=0 TO 15:FIELD #1,I*8 AS DUMMY$,8 AS E$(I):NEXT I
1209 GET #1,1
1210 EC=0:OC=0:BC=3:X=65:Y=123:D$=" It's easy with the ":GOSUB 60010
1211 EC=3:OC=3:BC=4:X=24:Y=150:OS=128:D$="{}~ Personal Computer":GOSUB 60010
1214 FOR I=0 TO 825:A#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
1215 NEXT I
1220 FOR I=0 TO 38:BRA#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
1225 NEXT I
1230 FOR I=0 TO 88:BLL#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
1235 NEXT I
1240 FOR I=0 TO 50:CRL#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
1245 NEXT I
1250 FOR I=0 TO 88:CLA#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
1255 NEXT I
1260 FOR I=0 TO 4:CEYE#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
1265 NEXT I
1270 FOR I=0 TO 13:CTAIL#(I)=CVD(E$(Z)):Z=Z+1:IF Z=16 THEN GET #1:Z=0
1275 NEXT I
1300 CLOSE:RETURN
60000 'SAVE"GCS",A 'GRAPHICS CHARACTER SUBROUTINES
60010 'DISPLAY STRING
60020 FOR I=1 TO LEN(D$):A=ASC(MID$(D$,I,1))
60030 IF OS=128 THEN IF A<>32 THEN A=A+128
60040 'DISPLAY CHARACTER
60050 LX=X+W(A):IF LX>WID THEN X=0:Y=Y+SH:GOTO 60050
60060 LY=Y+H(A):IF LY>200 THEN Y=0:X=0:GOTO 60050
60070 IF (X AND 1)=0 THEN SWAP EC,OC
60080 IF BC<4 THEN LINE(X,Y)-(LX-1,LY-1),BC,BF
60090 K=POINT(X,Y):PSET(X,Y),K:FOR K=0 TO 2:IF CHAR$(A,K)<>"" THEN DRAW CHAR$(A,K)
60100 NEXT K:IF (X AND 1)=0 THEN SWAP EC,OC
60110 X=LX:IF X+SW>WID THEN X=0:Y=Y+SH:IF Y+SH>200 THEN Y=0
60120 NEXT I:RETURN
60130 '
60140 'INITIALIZATION
60150 A=0:X=0:Y=0:LX=0:LY=0:EC=3:OC=3:BC=4:D$="":K=0:WID=320
60160 DIM CHAR$(255,2),H(255),W(255)
60170 'GET CHARACTER SET
60180 OPEN "ELEPH.EXE" FOR INPUT AS #1
60190 INPUT #1,DEC,H,W,K:IF DEC=0 THEN 60220
60200 FOR I=0 TO K-1:INPUT #1,D$:IF H(DEC)<>99 THEN CHAR$(DEC,I)=D$
60210 NEXT I:H(DEC)=H:W(DEC)=W:GOTO 60190
60220 CLOSE #1:SH=H:SW=W:H(32)=SH:W(32)=SW:RETURN
ESSXFADE.BAS
700 REM this is BASICMOV
710 ' BASIC DEMO TO USE CALL FUNCTION
720 ' USES AN ASSEMBLER SUBROUTINE TO MOVE
730 ' UP TO 65535 BYTES IN MEMORY
740 N=10:REM number of frames to show, starting at highmemory(256k)
750 KEY OFF
760 'DEFINE SEGMENT TO PLACE THE ASSEMBLER CODE
770 DEF SEG=&H1200
780 ' THIS TEST IF IT IS ALREADY LOADED, IF NOT IT LOADS IT
790 BLOAD"mcode.%%%",0
800 SUBRT = 0
810 ' A% = THE FROM ADDRESS
820 ' B% = THE TO ADDRESS
830 ' C% = THE LENGTH TO MOVE
840 GOSUB 980:REM TURN ON COLOR SCREEN
850 DEF SEG=&H1200
860 KEY OFF:SCREEN 1:COLOR 1,0
870 FOR DISP=1 TO N
880 MEMDEL=DISP*1024
885 'MEMORY=8192-MEMDEL:REM 128k system
890 MEMORY=16384-MEMDEL:REM 256k system
900 A%=MEMORY
910 B%=&HB800
920 C%=&H4000
930 CALL SUBRT (A%,B%,C%)
940 FOR PAUSE=1 TO 400:NEXT
950 NEXT DISP
952 GOSUB 1100
955 LOCATE 25,1:FOR EARTHMOVE=1 TO 25:PRINT " ":FOR PAUSE=1 TO 700:NEXT
956 FOR STAR=1 TO 6:PSET(RND*320,180)
957 NEXT STAR
958 NEXT EARTHMOVE:END
960 RUN"flyby
970 REM switch to color/graphics adapter
980 DEF SEG=0
990 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
1000 DEF SEG
1010 LOCATE ,,1,6,7
1020 SCREEN 0
1030 WIDTH 40
1040 RETURN
1100 CIRCLE(160,1),225
1105 COLOR 8,
1150 RETURN
FILES015.TXT
Disk No 15
Program Title: COLORDEMO
PC-SIG version 1
Usage: Entertainment
System Requirements: IBM PC or close compatible with Color graphics
adapter, 2 disk drives, printer, and Dos 2.0 or later
and a version of BASIC.
File Descriptions:
PCMAN BAS+ Color game using joysticks (untested)
PATHMAN BAS+ Color game using keypad - no joysticks needed
DRAW EXE+ Block-read a file directly to color/graphics buffer
DRAW ASM+ Assembler source for draw.exe
SCREEN EXE+ Set color/mono/40/80/low/med/high resolution
SCREEN ASM+ Assembler source for screen.exe
MONSW BAS+ Another color/mono program (good as a subroutine)
PRTGRAF BAS+ Draw a polygon, optionally print with graftrax
MONO EXE+ Set display to monochrome
COLOR EXE+ Set display to color
------------ Colordemo
COLORDEM BAT+ Part of colordemo - run color demo (impressive demo)
START BAS+ Part of colordemo
NEXTSHOW BAS+ Part of colordemo
FAMILYDA Y + Part of colordemo
BLASTOFF BAS+ Part of colordemo - rocket blasts off
ESSXFADE BAS+ Part of colordemo
FLYBY BAS+ Part of colordemo - objects in space
LANDSEQ BAS+ Part of colordemo - landing
WELCOME BAS+ Part of colordemo
ELEPHANT BAS+ Part of colordemo - dancing elephant
BUTTRFLY BAS+ Part of colordemo - butterflies flying
OTHDEMO BAS+ Part of colordemo - game demonstration
BLIMP BAS+ Part of colordemo - blimp flying
FINISH BAS+ Part of colordemo - end of demo
ADVLAND PIC+ Part of colordemo
ELEPH EXE+ Part of colordemo
ELEPH DAT+ Part of colordemo
MCODE %%%+ Part of colordemo
PC-SIG
1030D E Duane Avenue
Sunnyvale Ca. 94086
(408) 730-9291
(c) Copyright 1987 PC-SIG
FINISH.BAS
10 DEFINT A-Z:KEY OFF:K=0:MN=0:Z=0
15 DEF SEG=&HB800
1100 GOSUB 60140
1200 SCREEN 1,0:COLOR 8,1:CLS
1201 EC=2:OC=2:X=20:Y=23:D$=" THANKS FOR VISITING":GOSUB 60010
1202 X=20:Y=68:D$=" THE WORLD OF THE":GOSUB 60010
1211 EC=3:OC=3:BC=4:X=24:Y=150:OS=128:D$="{}~ Personal Computer":GOSUB 60010
1215 FOR PAUSE=1 TO 500:PAUSE=PAUSE+0:NEXT PAUSE
1220 CLS
1221 OS=0:EC=2:OC=2:X=20:Y=23:D$="HAVE A NICE DAY !!!":GOSUB 60010
1300 ' ROUTINE TO SIGN SCREEN WITH MIKE DUFFY'S SIGNATURE
1310 PSET (41,131),0
1320 DRAW "C3"
1330 A$="FDDFDDDDDDDDDDGDDDDDDDGDDDDDDDDGDDDDDDDGDDDDGDDDDRUUUEUUUUE"
1332 GOSUB 4000
1334 A$="UUUUEUUUUEUUEUUEUUUEUUUEUUUEUUEUUEUEUEERFFDDDDFDDDDDDDDGDDDDDDDDDD"
1336 GOSUB 4000
1338 A$="GDDDDDDDDDDGDDDDDDDGDDDRUUUEUUUUUUUEUUUUEUUUUEUUUEUUUEUUUEUUUEUUUE"
1348 GOSUB 4000
1358 A$="UUUEUUEUEUEUEEFDDDDGDDDDDGDDDDDGDDDDDDDDDDDDDDDDDDDDFDDDDDDDDDD"
1368 GOSUB 4000
1378 A$="RUEUEUEUEUEUEUEUEUEUEUEURDGDGDDGDDDGDDDDDFREUEEUEEUEEUEEUEEUEUE"
1388 GOSUB 4000
1398 A$="UEUEUEUUEUEUUEUEUUUUUHLLGGGDGDDGDDGDDGDDDGDDDGDDDDEREREEEERERER"
1408 GOSUB 4000
1418 A$="FFFDFDDDDDDDGDGDGGLHUUEUEEERRRFFRFRFRFREREREREREEEEEUEUEUEUUEUU"
1428 GOSUB 4000
1438 A$="UEUUUUHHLLLGLGLGGDGDGDGDDDGDDDDDDGDDDDDFDDDFFRREREE"
1448 GOSUB 4000
1450 FOR PAUSE=1 TO 200:NEXT PAUSE
1455 DRAW "BE28BU31"
1500 A$="UFDFDDDFDDDDDDDDDDDDGDDDDDDGDDDDDDGDDDGDDDGDDGDGDGDGDGDGLHHHH"
1505 GOSUB 4000
1510 A$="UHUHUUHUUEERFFFFFFRFFRFRRRFRRRRRERRRERRRERREEREEEEUEEUEUEUEUE"
1515 GOSUB 4000
1520 A$="UUUUUUUUUHUUHUHUHHHHHHHHLHHHLHHHLHHLHLLHLLHLLLHLLLLLLGLLLLG"
1525 GOSUB 4000
1530 A$="LLLGLLGLLGLLGLGLGLGLGGGGGGGDGDGDDGDDDFDFDFFRRRRRERRRRRRERRRRERRRE"
1535 GOSUB 4000
1540 A$="RRERRERRERRERRERERERERERERERERERERERERERERERERERERERERERERERERE"
1545 GOSUB 4000
1550 A$="RERERERERERERERE"
1555 GOSUB 4000
1560 FOR PAUSE=1 TO 200:NEXT PAUSE
1565 DRAW "BG43BD20"
1570 A$="DEREREEEEEUEEUEEUEUEUUEUUEUUUEUUEUUEURDGDDGDDDGDDDGDDDDDGDFFREEEU"
1575 GOSUB 4000
1580 A$="EEUEUUEUUUEUUUEUUUEDDDDGDDDGDDDFFRRRREEEUEEEUEEUEUEUEUUEUUEUUEUE"
1585 GOSUB 4000
1590 A$="UUEUEUUEUUEUUUEUHLGDGDGDDGDDDGDDDGDDDDGDDDDDDGDDDDDDGDDDDDDDDDDDG"
1595 GOSUB 4000
1600 A$="DDDDDDDDDDDDDDGDDDDDDDDDDDDDFFREUUUUUUUEUUUUUUUUUUUUUUUUUE"
1605 GOSUB 4000
1610 A$="UUUUUUUUUUUUEUUUUUUUUHUUURDDDFDDDFDFFRREEEEUEEEUEEEUEUEUEUEU"
1615 GOSUB 4000
1620 A$="EUEUEUUEUEUUEUEUUEUUUUUUUUHHLGGGDGDGDDGDDDDDGDDDDDDGDDDDDDG"
1625 GOSUB 4000
1630 A$="DDDGDDDGDDDGDDDDDDDDDDGDDDDDDDDDDDDGDDDDDDDDDDDDDFDDFDDFDDF"
1635 GOSUB 4000
1640 A$="DFRREUUUUUUUHUUUUUUUUUUUUUUUUUUUUHUUUUUUUUUUUUUUUUUUEUUUUUEUUUUUR"
1645 GOSUB 4000
1650 A$="DDDDDDDDDDFDFFREEEEEEEUEEEEEEEUERGDGGGDGDGDDFRREEREFEFDFDDDF"
1655 GOSUB 4000
1660 A$="DDDDDDDFDDDDDDDDDGDDDDDDDDDGDDDDDGDDDDDGDDDGDGDGDGDGGLLH"
1665 GOSUB 4000
1670 A$="LHLHHUREREEEUEEEUEUEUEUEUEUUEUUEUEUEUEUEUEUEUEU"
1675 GOSUB 4000
1700 SYSTEM
4000 FOR I=1 TO LEN(A$)
4002 DRAW MID$(A$,I,1)+"NR1"
4004 NEXT I
4006 RETURN
5000 REM this is RUNSHOW
5010 REM "GOTO 1050" TO PICSAVE
5020 DIM FILE$(12):DIM FF(100)
5030 DIM LEM1(1000):DIM XX(200):DIM YY(200)
5040 KEY 9,"gosub 890"+CHR$(13):KEY 10,"gosub 970"+CHR$(13)
5050 N=1
5060 FOR GRAB=1 TO N
5070 READ FILE$(GRAB)
5080 MEMDEL=GRAB*1024
5090 MEMORY=8192-MEMDEL:REM 128K SYSTEM
5100 'MEMORY=16384-MEMDEL:REM 256K SYSTEM
5110 GOSUB 6030 :REM LOAD FILE$(N) INTO LOCATION "MEMORY"
5120 NEXT
5130 RESTORE
5140 REM this is BASICMOV
5150 ' BASIC DEMO TO USE CALL FUNCTION
5160 ' USES AN ASSEMBLER SUBROUTINE TO MOVE
5170 ' UP TO 65535 BYTES IN MEMORY
5180 '******
5190 KEY OFF
5200 'DEFINE SEGMENT TO PLACE THE ASSEMBLER CODE
5210 DEF SEG=&H1200
5220 ' THIS TEST IF IT IS ALREADY LOADED, IF NOT IT LOADS IT
5230 BLOAD"mcode.%%%",0
5240 SUBRT = 0
5250 ' A% = THE FROM ADDRESS
5260 ' B% = THE TO ADDRESS
5270 ' C% = THE LENGTH TO MOVE
5280 GOSUB 5820:REM TURN ON COLOR SCREEN
5290 DEF SEG=&H1200
5300 KEY OFF:SCREEN 1:COLOR 1,0
5310 FOR DISP=1 TO N
5320 MEMDEL=DISP*1024
5330 MEMORY=8192-MEMDEL:REM 128K SYSTEM
5340 PRINT MEMORY
5350 'MEMORY=16384-MEMDEL:REM 256K SYSTEM
5360 A%=MEMORY
5370 B%=&HB800
5380 C%=&H4000
5390 CALL SUBRT (A%,B%,C%)
5400 NEXT
5420 REM AT COMPLETION OF THIS LOOP, N FRAMES HAVE BEEN LOADED
5430 REM ********************SEQUENCING SETUP*************************
5440 REM ******OPTION TO STEP THRU SEQUENCE (1,2....N) BY HITTING ANY KEY******
5450 PRINT "TO STEP THRU IN CONSECUTIVE SEQUENCE,I.E. FROM 1,2,.....N"
5460 INPUT "ENTER 'SS' FOR SINGLE STEP OPTION ";SS$:PRINT
5470 IF SS$="SS" THEN PRINT "CURRENT SEQUENCE IS 1,2,.......N"
5480 IF SS$="SS" THEN GOTO 5310
5490 REM ********************SELECTING DESIRED SEQUENCE**************
5500 PRINT "ENTER FRAME SEQUENCE NUMBERS ONE AT A TIME"
5510 FF=0:N=0
5520 INPUT "ENTER FRAME NUMBER ";FRAME$
5530 PRINT "TO QUIT, HIT RETURN"
5540 IF FRAME$="" THEN GOTO 5590
5550 FRAME=VAL(FRAME$)
5560 N=N+1
5570 FF(N)=FRAME
5580 GOTO 5520
5590 PRINT "SEQUENCE IS":PRINT
5600 FOR SEQ=1 TO N:PRINT FF(SEQ):NEXT
5610 INPUT "SET PAUSE ";P
5620 PRINT "HIT ANY KEY TO RUN SEQUENCE"
5630 A$=INPUT$(1)
5640 DEF SEG=&H1200
5650 BLOAD"mcode.%%%",0
5660 SUBRT = 0
5670 GOSUB 5820:REM TURN ON COLOR SCREEN
5680 DEF SEG=&H1200
5690 KEY OFF:SCREEN 1:COLOR 1,0
5700 FOR SHOW=1 TO N
5710 MEMDEL=FF(SHOW)*1024
5720 MEMORY=8192-MEMDEL:REM 128K SYSTEM
5730 'MEMORY=16384-MEMDEL:REM 256K SYSTEM
5740 A%=MEMORY
5750 B%=&HB800
5760 C%=&H4000
5770 CALL SUBRT (A%,B%,C%)
5780 FOR N=1 TO P:NEXT
5790 NEXT
5800 END
5810 REM switch to color/graphics adapter
5820 DEF SEG=0
5830 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
5840 DEF SEG
5850 LOCATE ,,1,6,7
5860 SCREEN 0
5870 WIDTH 40
5880 RETURN
5890 REM switch to monochrome adapter
5900 DEF SEG=0
5910 POKE &H410,(PEEK(&H410) OR &H30)
5920 DEF SEG
5930 LOCATE ,,1,12,13
5940 SCREEN 0
5950 WIDTH 80
5960 RETURN
5970 REM this is PICSAVE
5980 INPUT "WHAT IS THE NAME YOU WANT TO SAVE UNDER ",A$
5990 DEF SEG=&HB800
6000 BSAVE A$,0,16384
6010 PRINT "SAVING ",A$
6020 END
6030 'PRINT "LOADING ";FILE$(GRAB);" STARTING AT ";MEMORY*16
6040 DEF SEG=MEMORY
6050 S$=FILE$(GRAB)
6060 BLOAD S$,0
6070 RETURN
6080 DATA SELF.pic
60000 'SAVE"GCS",A 'GRAPHICS CHARACTER SUBROUTINES
60010 'DISPLAY STRING
60020 FOR I=1 TO LEN(D$):A=ASC(MID$(D$,I,1))
60030 IF OS=128 THEN IF A<>32 THEN A=A+128
60040 'DISPLAY CHARACTER
60050 LX=X+W(A):IF LX>WID THEN X=0:Y=Y+SH:GOTO 60050
60060 LY=Y+H(A):IF LY>200 THEN Y=0:X=0:GOTO 60050
60070 IF (X AND 1)=0 THEN SWAP EC,OC
60080 IF BC<4 THEN LINE(X,Y)-(LX-1,LY-1),BC,BF
60090 K=POINT(X,Y):PSET(X,Y),K:FOR K=0 TO 2:IF CHAR$(A,K)<>"" THEN DRAW CHAR$(A,K)
60100 NEXT K:IF (X AND 1)=0 THEN SWAP EC,OC
60110 X=LX:IF X+SW>WID THEN X=0:Y=Y+SH:IF Y+SH>200 THEN Y=0
60120 NEXT I:RETURN
60130 '
60140 'INITIALIZATION
60145 'GOSUB 5000:REM LOAD IN VIDEO IMAGES OF SELF,.......
60150 A=0:X=0:Y=0:LX=0:LY=0:EC=3:OC=3:BC=4:D$="":K=0:WID=320
60160 DIM CHAR$(255,2),H(255),W(255)
60170 'GET CHARACTER SET
60180 OPEN "ELEPH.EXE" FOR INPUT AS #1
60190 INPUT #1,DEC,H,W,K:IF DEC=0 THEN 60220
60200 FOR I=0 TO K-1:INPUT #1,D$:IF H(DEC)<>99 THEN CHAR$(DEC,I)=D$
60210 NEXT I:H(DEC)=H:W(DEC)=W:GOTO 60190
60220 CLOSE #1:SH=H:SW=W:H(32)=SH:W(32)=SW:RETURN
FLYBY.BAS
5 DIM SX%(100),SY%(100)
10 CLS:KEY OFF :SCREEN 1:COLOR 0,0
11 GOSUB 800
20 EYE=0:X=150:Y=100:A=0:B=2*3.14:D=1:S1=5:CL=3:GOSUB 300
25 TW=2:GOSUB 900
30 EYE=0:X=230:Y=25:A=0:B=2*3.14:D=-1:S1=10:CL=2:GOSUB 300
35 TW=3:GOSUB 900
40 EYE=0:X=125:Y=30:A=0:B=2*3.14:D=1:S1=2:CL=1:GOSUB 300
45 TW=1:GOSUB 900
50 EYE=0:X=150:Y=160:A=0:B=2*3.14:D=1:S1=15:CL=3:GOSUB 300
55 TW=2:GOSUB 900
70 EYE=1:X=125:Y=100:A=-3.14-0.7:B=-3.14+0.7:D=1:S1=5:CL=2:GOSUB 300
75 TW=0:GOSUB 900
80 EYE=0:X=200:Y=150:A=0:B=2*3.14:D=-1:S1=5:CL=1:GOSUB 300
85 TW=5:GOSUB 900
130 EYE=1:X=200:Y=100:A=-0.7:B=-2*3.14+0.7:D=-1:S1=10:CL=2:GOSUB 300
135 TW=3:GOSUB 900
299 GOTO 600
300 I1=1:J1=(1+1/5)^2
310 FOR I=1 TO 75 STEP S1
320 J=D*(1+I/5)^2
330 GOSUB 400
331 PSET(SX%(KK),SY%(KK)),0
332 SX%(KK)=INT(319*RND):SY%(KK)=INT(199*RND):PSET(SX%(KK),SY%(KK)),3
333 KK=KK+1:KK=KK MOD 100
340 NEXT I
350 GOSUB 500
360 RETURN
400 CIRCLE(X1-J1,Y1),I1,0,A,B,1
410 IF EYE=1 THEN CIRCLE(X1-J1,Y1-I1\2),I1/10,0,,,1
415 I1=I:J1=J:X1=X:Y1=Y
420 CIRCLE(X-J,Y),I,CL,A,B,1
430 IF EYE=1 THEN CIRCLE(X-J,Y-I\2),I/10,CL,,,1
440 RETURN
500 CIRCLE(X1-J1,Y1),I1,0,A,B,1
510 IF EYE=1 THEN CIRCLE(X1-J1,Y1-I1\2),I1/10,0,,,1
520 RETURN
600 TW=3:GOSUB 900
651 LOCATE 11,16:PRINT" "
652 LOCATE 12,16:PRINT" I B M "
653 LOCATE 13,16:PRINT" "
655 LOCATE 14,16:PRINT" PC LAND "
656 LOCATE 15,16:PRINT" "
670 TW=5:GOSUB 900
690 GOSUB 1000
700 RUN"LANDSEQ
750 CIRCLE (155,100),G,2,,,12/13
751 RETURN
800 FOR L=1 TO 100
810 SX%(L)=INT(319*RND):SY%(L)=INT(199*RND):PSET(SX%(L),SY%(L)),3
820 NEXT L
825 KK=1
830 RETURN
900 TT$=TIME$
910 T1=(3600*VAL(MID$(TT$,1,2)))+(60*VAL(MID$(TT$,4,2)))+VAL(MID$(TT$,7,2))
920 TT$=TIME$
930 T2=(3600*VAL(MID$(TT$,1,2)))+(60*VAL(MID$(TT$,4,2)))+VAL(MID$(TT$,7,2))
931 PSET(SX%(KK),SY%(KK)),0
932 SX%(KK)=INT(319*RND):SY%(KK)=INT(199*RND):PSET(SX%(KK),SY%(KK)),3
933 KK=KK+1:KK=KK MOD 100
934 FOR L=1 TO 50:LL=LL*1:NEXT L
935 G=G+1:GOSUB 750
940 IF T2-T1<TW GOTO 920 ELSE RETURN
1000 'SUBROUTINE TO DRAW LINE TO "PC LAND PLANET"
1001 PSET (160,199),1:GOSUB 2000
1005 A$="C3L1L1L1L1L1H1L1L1L1L1L1H1L1L1L1L1H1L1L1L1L1H1L1L1L1L1H1"
1006 GOSUB 1500
1010 A$="L1L1L1H1L1L1L1H1L1L1L1H1L1L1L1H1L1L1H1L1L1H1L1L1H1L1L1H1"
1011 GOSUB 1500
1012 A$="L1H1L1H1L1H1L1H1L1H1L1H1H1L1H1H1L1H1H1L1H1H1H1L1H1H1H1"
1013 GOSUB 1500
1015 A$="L1H1H1H1L1H1H1H1H1H1H1H1H1H1U1H1H1H1U1H1H1U1H1H1U1H1"
1016 GOSUB 1500
1020 A$="H1U1H1U1H1U1H1U1H1U1H1U1H1U1U1H1U1U1H1U1U1H1U1U1H1U1U1"
1021 GOSUB 1500
1025 A$="H1U1U1U1H1U1U1U1H1U1U1U1U1U1U1U1U1U1U1U1U1U1U1U1U1U1E1"
1026 GOSUB 1500
1030 A$="U1U1U1E1U1U1U1E1U1U1U1E1U1U1E1U1U1E1U1U1E1U1E1U1E1U1E1"
1031 GOSUB 1500
1035 A$="U1E1E1U1E1E1U1E1E1U1E1E1E1U1E1E1E1U1E1E1E1E1E1E1E1E1E1"
1036 GOSUB 1500
1040 A$="R1E1E1R1E1E1R1E1E1R1E1R1E1R1E1R1R1E1R1R1E1R1R1R1R1R1R1"
1041 GOSUB 1500
1045 A$="R1R1R1F1R1R1R1F1R1R1F1R1R1F1R1F1R1F1R1F1R1F1F1R1F1F1F1"
1046 GOSUB 1500
1050 A$="F1F1F1F1D1F1F1F1D1F1F1D1"
1051 GOSUB 1500
1100 RETURN
1500 NUM=LEN(A$)/2
1502 FOR I=1 TO NUM
1504 DRAW MID$(A$,2*I-1,2):GOSUB 2000
1506 NEXT I
1508 RETURN
2000 FOR KK=1 TO 5:KK=KK+0:NEXT KK:RETURN
LANDSEQ.BAS
100 REM this is RUNSHOW
105 REM "GOTO 1050" TO PICSAVE
110 DIM FILE$(12):DIM FF(100)
115 DIM LEM1(1000):DIM XX(200):DIM YY(200)
120 KEY 9,"gosub 890"+CHR$(13):KEY 10,"gosub 970"+CHR$(13)
130 N=1
200 FOR GRAB=1 TO N
205 READ FILE$(GRAB)
210 MEMDEL=GRAB*1024
215 MEMORY=8192-MEMDEL:REM 128K SYSTEM
220 'MEMORY=16384-MEMDEL:REM 256K SYSTEM
230 GOSUB 1110 :REM LOAD FILE$(N) INTO LOCATION "MEMORY"
240 NEXT
245 RESTORE
250 REM this is BASICMOV
260 ' BASIC DEMO TO USE CALL FUNCTION
270 ' USES AN ASSEMBLER SUBROUTINE TO MOVE
280 ' UP TO 65535 BYTES IN MEMORY
290 '******
300 KEY OFF
310 'DEFINE SEGMENT TO PLACE THE ASSEMBLER CODE
320 DEF SEG=&H1200
330 ' THIS TEST IF IT IS ALREADY LOADED, IF NOT IT LOADS IT
340 BLOAD"mcode.%%%",0
350 SUBRT= 0
360 ' A% = THE FROM ADDRESS
370 ' B% = THE TO ADDRESS
380 ' C% = THE LENGTH TO MOVE
390 GOSUB 900:REM TURN ON COLOR SCREEN
400 DEF SEG=&H1200
410 KEY OFF:SCREEN 1:COLOR 1,0
420 FOR DISP=1 TO N
430 MEMDEL=DISP*1024
435 MEMORY=8192-MEMDEL:REM 128K SYSTEM
436 PRINT MEMORY
440 'MEMORY=16384-MEMDEL:REM 256K SYSTEM
450 A%=MEMORY
460 B%=&HB800
470 C%=&H4000
480 CALL SUBRT (A%,B%,C%)
500 NEXT
505 GOTO 1160
510 REM AT COMPLETION OF THIS LOOP, N FRAMES HAVE BEEN LOADED
520 REM ********************SEQUENCING SETUP*************************
530 REM ******OPTION TO STEP THRU SEQUENCE (1,2....N) BY HITTING ANY KEY******
540 PRINT "TO STEP THRU IN CONSECUTIVE SEQUENCE,I.E. FROM 1,2,.....N"
550 INPUT "ENTER 'SS' FOR SINGLE STEP OPTION ";SS$:PRINT
560 IF SS$="SS" THEN PRINT "CURRENT SEQUENCE IS 1,2,.......N"
570 IF SS$="SS" THEN GOTO 420
580 REM ********************SELECTING DESIRED SEQUENCE**************
590 PRINT "ENTER FRAME SEQUENCE NUMBERS ONE AT A TIME"
600 FF=0:N=0
610 INPUT "ENTER FRAME NUMBER ";FRAME$
620 PRINT "TO QUIT, HIT RETURN"
630 IF FRAME$="" THEN GOTO 680
640 FRAME=VAL(FRAME$)
650 N=N+1
660 FF(N)=FRAME
670 GOTO 610
680 PRINT "SEQUENCE IS":PRINT
690 FOR SEQ=1 TO N:PRINT FF(SEQ):NEXT
700 INPUT "SET PAUSE ";P
710 PRINT "HIT ANY KEY TO RUN SEQUENCE"
720 A$=INPUT$(1)
730 DEF SEG=&H1200
740 BLOAD"mcode.%%%",0
750 SUBRT= 0
760 GOSUB 900:REM TURN ON COLOR SCREEN
770 DEF SEG=&H1200
780 KEY OFF:SCREEN 1:COLOR 1,0
790 FOR SHOW=1 TO N
800 MEMDEL=FF(SHOW)*1024
805 MEMORY=8192-MEMDEL:REM 128K SYSTEM
810 'MEMORY=16384-MEMDEL:REM 256K SYSTEM
820 A%=MEMORY
830 B%=&HB800
840 C%=&H4000
850 CALL SUBRT (A%,B%,C%)
860 FOR N=1 TO P:NEXT
870 NEXT
880 END
890 REM switch to color/graphics adapter
900 DEF SEG=0
910 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
920 DEF SEG
930 LOCATE ,,1,6,7
940 SCREEN 0
950 WIDTH 40
960 RETURN
970 REM switch to monochrome adapter
980 DEF SEG=0
990 POKE &H410,(PEEK(&H410) OR &H30)
1000 DEF SEG
1010 LOCATE ,,1,12,13
1020 SCREEN 0
1030 WIDTH 80
1040 RETURN
1050 REM this is PICSAVE
1060 INPUT "WHAT IS THE NAME YOU WANT TO SAVE UNDER ",A$
1070 DEF SEG=&HB800
1080 BSAVE A$,0,16384
1090 PRINT "SAVING ",A$
1100 END
1110 'PRINT "LOADING ";FILE$(GRAB);" STARTING AT ";MEMORY*16
1120 DEF SEG=MEMORY
1125 S$=FILE$(GRAB)
1130 BLOAD S$,0
1140 RETURN
1150 DATA ADVLAND.pic
1160 GET(90,30)-(110,46),LEM1
1161 PUT(90,30),LEM1,>=
1174 XX=60:YY=0
1175 FOR MOVE=1 TO 30
1180 XX=XX+1:YY=YY+1
1185 PUT(XX,YY),LEM1,PSET
1190 FOR PAUSE=1 TO 40:NEXT
1195 NEXT
1205 XX=90:YY=30
1207 FOR MOVE=1 TO 140
1209 XX=XX+1:YY=YY+(0.5)
1215 PUT(XX,YY),LEM1,PSET
1217 FOR PAUSE=1 TO 60:NEXT
1220 NEXT
1223 GET(230,100)-(250,114),LEM1
1225 FOR DOWN=1 TO 50
1230 YY=YY+1
1235 PUT (XX,YY),LEM1,PSET
1237 FOR PAUSE=1 TO 90:NEXT
1240 NEXT
1241 FOR DOWN=1 TO 28
1242 YY=YY+1
1243 PUT (XX,YY),LEM1,PSET
1244 FOR PAUSE=1 TO 180:NEXT
1245 NEXT:FOR PAUSE=1 TO 3000:NEXT
1246 GET(229,178)-(249,199),LEM1
1247 PUT(229,178),LEM1,>=
1248 XX=XX-1
1250 FOR LEFT=1 TO 170
1252 PUT(XX,YY),LEM1,>=
1253 FOR PAUSE=1 TO 20:NEXT
1254 IF LEFT=140 THEN GOSUB 1296
1255 XX=XX-1
1262 PUT(XX+1,YY),LEM1,>=
1265 NEXT
1270 PUT(XX,YY),LEM1,PSET:GOSUB 1372
1275 PAINT (60,180)
1276 RUN"WELCOME
1296 LINE (56,199)-(56,166),0:LINE -(84,166),0:LINE -(84,199),0:PAINT(58,197),0
1297 FOR PAUSE=1 TO 2800:NEXT:RETURN
1372 FOR PAUSE=1 TO 4900:NEXT:RETURN
1472 FOR PAUSE=1 TO 300:NEXT:RETURN
MONSW.BAS
6999 DEFINT A-Z:DIM MON(1,50):GOSUB 7000:END
7000 DEF SEG=&H40: EQUIP=PEEK(&H10)
7010 IF (EQUIP AND &H30) = &H30 THEN I=0:INEW=1: ELSE I=1:INEW=0
7020 FOR J=0 TO &H1D: MON(I,J)=PEEK(&H49+J): NEXT J
7030 DEF SEG:MON(I,31)=PEEK(&H29):MON(I,32)=PEEK(&H48) 'width, SCREEN MODE
7040 MON(I,33)=PEEK(&H68):MON(I,34)=PEEK(&H69) 'CURSOR end, START-SCAN
7050 MON(I,35)=PEEK(&H4B):MON(I,36)=PEEK(&H4C) 'foreground, BACKGROUND COLOR
7060 MON(I,37)=PEEK(&H4E):MON(I,38)=PEEK(&H4F) 'COLOR PARMS FOR 6845
7065 MON(I,39)=PEEK(&H56):MON(I,40)=PEEK(&H57) 'Cursor row/col
7070 DEF SEG=&H40:IF I=0 THEN POKE &H10,(EQUIP AND &HCF) OR &H20 ELSE POKE &H10,EQUIP OR &H30 'Change the equipment flag to the other flavor
7080 IF MON(INEW,31)=0 THEN GOTO 7160 'No saved value, so init from scratch
7090 I=INEW: FOR J=0 TO &H1D:POKE &H49+J,MON(I,J):NEXT J
7100 DEF SEG:POKE &H29,MON(I,31):POKE &H48,MON(I,32) 'width, screen
7110 POKE &H68,MON(I,33):POKE &H69,MON(I,34) 'cursor end,start scans
7120 POKE &H4B,MON(I,35):POKE &H4C,MON(I,36) 'fore/background colors
7130 POKE &H4E,MON(I,37):POKE &H4F,MON(I,38) 'COLOR PARMS FOR 6845
7135 POKE &H56,MON(I,39):POKE &H57,MON(I,40) 'Cursor row/col
7140 IF I=0 THEN PRINT "IBM monitor" ELSE PRINT "Color Monitor"
7150 RETURN
7160 DEF SEG: IF INEW=1 THEN SCREEN 0,1:SCREEN 1,0:COLOR 1,1:WIDTH 40:CLS:LOCATE 1,1,1,6,7:OUT &H3D4,2:OUT &H3D5,&H2C
7180 IF INEW=0 THEN SCREEN 0:WIDTH 80:COLOR 7,0:LOCATE 1,1,1,12,13
7190 IF INEW=0 THEN PRINT "IBM monitor!" ELSE PRINT "Color Monitor!"
7200 RETURN
7210 REM We first determine our equipment (i=0 => monochrome display).
7220 REM Then we preserve our current status which includes the
7230 REM video display data area from segment &h40 and some pieces of the
7240 REM BASIC segment. We then switch monitors, using the previous saved
7250 REM status if there is some, or a sane default if none.
7260 REM
7499 REM Subroutine to switch between medium and hi resolution graphic modes.
7500 DEF SEG=&H40: EQUIP=PEEK(&H10): DEF SEG
7510 IF (EQUIP AND &H30)=&H30 THEN PRINT"Switch to Color monitor first": RETURN
7520 RES=PEEK(&H48): IF (RES=4) OR (RES=5) THEN GOTO 7600 'low now, go high
7525 IF RES<>6 THEN PRINT "Switch to graphics mode first": RETURN
7530 IF PALLET%=0 THEN PALLET%=&H31 'default to pretty blue
7540 POKE &H48,4: POKE &H29,40: OUT &H3D8,&H2A: OUT &H3D9,PALLET%
7560 DEF SEG=&H40: POKE &H49,4: POKE &H4A,40: POKE &H65,&H2A: POKE &H66,PALLET%
7570 DEF SEG: PRINT "Now in med res": RETURN
7600 POKE &H48,6: POKE &H29,80: OUT &H3D8,&H1E: OUT &H3D9,&H3F:
7610 DEF SEG=&H40: POKE &H49,6: POKE &H4A,80: POKE &H65,&H1E:PALLET%=PEEK(&H66)
7615 POKE &H66,&H3F
7620 DEF SEG: PRINT "Now in hi res": RETURN
NEXTSHOW.BAS
15 DEFINT A-Z:KEY OFF:K=0:MN=0:Z=0
20 DEF SEG=&HB800
25 GOSUB 60140
36 GOSUB 65027:REM SETUP INITIAL SECONDS,HOUR,MIN,SECOND
37 COUNTER=SECONDS:STARTTIME=COUNTER+10:REM BASE FOR CALCULATING SECONDS TO GO
50 ADR=30:GOSUB 500:NEXTSHOW$=TM$:KK=0:GOSUB 600:NST!=TM!
61 SCREEN 1,0:COLOR 8,1:K=0:MN=0:Z=0
62 CLS:EC=0:OC=0:BC=3:X=75:Y=23:D$="THE TIME IS NOW":GOSUB 60010
63 ADR=0:GOSUB 500:REALTIME$=TM$:LINE(135,48)-(230,65),0,BF
65 EC=2:OC=2:BC=4:X=135:Y=48:D$=REALTIME$:GOSUB 60010:REM PRINT CIVILIAN TIME
75 GOSUB 600:IF TM!=>NST! THEN RUN"FAMILYDAY
78 IF KK=1 THEN GOTO 63
79 KK=1
80 X=25:Y=98:D$="TIME OF THE NEXT SHOW":GOSUB 60010
85 EC=3:OC=3:BC=4:X=135:Y=120:D$=NEXTSHOW$:GOSUB 60010:REM PRINT NEXT SHOWTIME
90 GOTO 63
500 TM$=TIME$:TM!=(3600*VAL(MID$(TM$,1,2)))+(60*VAL(MID$(TM$,4,2)))+VAL(MID$(TM$,7,2))+ADR
502 TMH=INT(TM!/3600):IF TMH>12 THEN TMH=TMH-12
504 TMM=TM!-3600*INT(TM!/3600):TMM=100+INT(TMM/60)
506 TMS=100+(TM!-60*INT(TM!/60))
510 TM$=RIGHT$(STR$(TMH),2)+":"+RIGHT$(STR$(TMM),2)+":"+RIGHT$(STR$(TMS),2)
520 RETURN
600 TM!=(3600*VAL(MID$(TM$,1,2)))+(60*VAL(MID$(TM$,4,2)))+VAL(MID$(TM$,7,2))
602 RETURN
60000 'SAVE"GCS",A 'GRAPHICS CHARACTER SUBROUTINES
60010 'DISPLAY STRING
60020 FOR I=1 TO LEN(D$):A=ASC(MID$(D$,I,1))
60030 IF OS=128 THEN IF A<>32 THEN A=A+128
60040 'DISPLAY CHARACTER
60050 LX=X+W(A):IF LX>WID THEN X=0:Y=Y+SH:GOTO 60050
60060 LY=Y+H(A):IF LY>200 THEN Y=0:X=0:GOTO 60050
60070 IF (X AND 1)=0 THEN SWAP EC,OC
60080 IF BC<4 THEN LINE(X,Y)-(LX-1,LY-1),BC,BF
60090 K=POINT(X,Y):PSET(X,Y),K:FOR K=0 TO 2:IF CHAR$(A,K)<>"" THEN DRAW CHAR$(A,K)
60100 NEXT K:IF (X AND 1)=0 THEN SWAP EC,OC
60110 X=LX:IF X+SW>WID THEN X=0:Y=Y+SH:IF Y+SH>200 THEN Y=0
60120 NEXT I:RETURN
60130 '
60140 'INITIALIZATION
60150 A=0:X=0:Y=0:LX=0:LY=0:EC=3:OC=3:BC=4:D$="":K=0:WID=320
60160 DIM CHAR$(255,2),H(255),W(255)
60170 'GET CHARACTER SET
60180 OPEN "ELEPH.EXE" FOR INPUT AS #1
60190 INPUT #1,DEC,H,W,K:IF DEC=0 THEN 60220
60200 FOR I=0 TO K-1:INPUT #1,D$:IF H(DEC)<>99 THEN CHAR$(DEC,I)=D$
60210 NEXT I:H(DEC)=H:W(DEC)=W:GOTO 60190
60220 CLOSE #1:SH=H:SW=W:H(32)=SH:W(32)=SW:RETURN
60250 FOR BACKGROUND=1 TO 16
60252 FOR PAUSE=1 TO 300:NEXT
60255 FOR PALETTE=0 TO 1:NEXT
60257 COLOR BACKGROUND,PALETTE
60260 NEXT
60265 RETURN
64800 ' START.BAS SYSTEM STARTUP ROUTINE 6/9/81 PBK
64805 KEY OFF
64810 DIM A$(15),P$(15):SCREEN 0,1:WIDTH 40:COLOR 15,1,1:LOCATE ,,0
64815 GREEN=2: BLUE=9: CYAN=3: YELLOW=6 ELSE GREEN=7: BLUE=9: CYAN=7: YELLOW=7
64820 A$(13)= " Personal Computer "
64825 A$(1)=SPACE$(39):A$(2)=A$(1):A$(11)=A$(1):A$(12)=A$(1):A$(14)=A$(1):A$(15)=A$(1)
64830 A$(1)= " The "
64835 A$(3)= "▄▄▄▄ ▄▄▄▄▄▄ ▄▄ ▄▄"
64840 A$(4)= "▄▄▄▄ ▄▄▄▄▄▄▄ ▄▄▄ ▄▄▄"
64845 A$(5)=" ▄▄ ▄▄ ▄▄ ▄▄▄ ▄▄▄ "
64850 A$(6)=" ▄▄ ▄▄▄▄▄ ▄▄▄▄ ▄▄▄▄ "
64855 A$(7)=" ▄▄ ▄▄▄▄▄ ▄▄▄▄▄▄▄▄▄ "
64860 A$(8)=" ▄▄ ▄▄ ▄▄ ▄▄ ▄▄▄ ▄▄ "
64865 A$(9)="▄▄▄▄ ▄▄▄▄▄▄▄ ▄▄▄ ▄ ▄▄▄"
64870 A$(10)="▄▄▄▄ ▄▄▄▄▄▄ ▄▄▄ ▄ ▄▄▄"
64875 CLS
64880 FOR I = 2 TO 40
64885 FOR J = 3 TO 10
64890 LOCATE J+5,I:PRINT "▄";
64895 NEXT J:SOUND 100+RND*3000,1:NEXT I
64900 FOR I = 1 TO 7
64905 FOR J = 3 TO 10
64910 LOCATE J+5,I:PRINT " ";
64915 NEXT J:SOUND 100+RND*3000,1:NEXT I
64920 FOR I=8 TO 33:FOR J=3 TO 10:IF MID$(A$(J),I-7,1)=" "THEN LOCATE J+5,I:PRINT " ";
64925 NEXT J:SOUND 100+RND*3000,1:NEXT I
64930 FOR I = 34 TO 40
64935 FOR J = 3 TO 10
64940 LOCATE J+5,I:PRINT " ";
64945 NEXT J:SOUND 100+RND*3000,1:NEXT I
64950 GOTO 64965
64955 FOR I=2 TO 12
64960 COLOR 15,BLUE:LOCATE I+5,5: PRINT SPACE$(3)+A$(I)+SPACE$(3): NEXT
64965 COLOR 15,BLUE:LOCATE 1+5,6: PRINT SPACE$(3)+A$(1)+SPACE$(3)
64970 SOUND 100+RND*3000,1
64975 COLOR 15,BLUE:LOCATE 13+5,2: PRINT SPACE$(3)+A$(13)
64980 SOUND 100+RND*3000,4
64985 RETURN
65027 MILTIME$=TIME$:MILHR$=LEFT$(MILTIME$,2):MILHR=VAL(MILHR$)
65028 IF MILHR>12 THEN REALHR=MILHR-12:REALHR$=STR$(REALHR)
65029 REALTIME$=REALHR$+MID$(TIME$,3,6)
65030 HR$=LEFT$(REALTIME$,2):MIN$=MID$(TIME$,4,2):SEC$=RIGHT$(TIME$,2)
65035 HR=VAL(HR$):MIN=VAL(MIN$):SEC=VAL(SEC$)
65040 SECONDS=(60*MIN)+SEC
65045 MIN=INT(SECONDS/60)
65050 SECOND=(SECONDS-(MIN*60))
65060 RETURN
OTHDEMO.BAS
100 REM
102 REM******* ARRAY DIMENSIONS AND INITIALIZATION *************
104 REM
110 DIM T(580),XX(580),OO(580),MM(580),A(8,8)
120 DIM X4(8),Y4(8)
121 REM INDX 0=UP 4=DOWN
122 REM 1=UP/RIGHT 5=DOWN/LEFT
123 REM 2=RIGHT 6=LEFT
124 REM 3=DOWN/RIGHT 7=UP/LEFT
125 DATA 0,1,1,1,0,-1,-1,-1
126 FOR I=0 TO 7:READ X4(I):NEXT I
127 DATA -1,-1,0,1,1,1,0,-1
128 FOR I=0 TO 7:READ Y4(I):NEXT I
400 REM
402 REM******** SCREEN PLAY ROUTINE CONTROL **************
404 '
405 PTURN=2
410 GOSUB 1000
412 GOSUB 2000
414 GOSUB 1400:IF MOK=0 GOTO 412
416 GOSUB 1100
418 IF PTURN=1 THEN PTURN=2 ELSE PTURN=1
419 IF (TOTB+TOTW)=32 THEN RUN"blimp
420 IF (TOTB+TOTW)=64 THEN GOSUB 1180:GOTO 19900 ELSE GOSUB 1190
422 GOTO 412
1000 '
1001 ' ********** SUBROUTINE TO INTIIALIZE THE BOARD AND SCREEN ******
1002 '
1010 CLS:KEY OFF:SCREEN 1:COLOR 0,0,0:COLOR ,1
1012 LINE (0,0)-(199,199),1,BF
1014 LINE (3,3)-(27,27),0,B
1016 GET (3,3)-(27,27),T
1018 FOR J=0 TO 7
1020 FOR I=0 TO 7
1022 PUT (I*24+3,J*24+3),T,PSET
1024 NEXT I
1026 NEXT J
1028 X=3:Y=4:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),0,0
1030 X=4:Y=3:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),0,0
1032 X=4:Y=4:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),3,0
1034 X=3:Y=3:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),3,0
1036 X=1:Y=1:CIRCLE (X*24+15,Y*24+15),5,0,,,11/12:PAINT (X*24+4,Y*24+4),0,0:CIRCLE (X*24+15,Y*24+15),5,2:PAINT (X*24+15,Y*24+15),3,2
1038 GET (1*24+3,1*24+3)-(2*24+3,2*24+3),MM
1040 PUT (1*24+3,1*24+3),T,PSET
1042 X=0:Y=0:PC=1
1044 GET (3*24+3,4*24+3)-(4*24+3,5*24+3),XX
1046 GET (4*24+3,4*24+3)-(5*24+3,5*24+3),OO
1048 PUT (9*24+3,3*24+3),XX,PSET
1050 PUT (9*24+3,5*24+3),OO,PSET
1052 PUT (9*24+3,7*24+3),T,PSET:PUT (9*24+3,7*24+3),MM,>=
1054 LOCATE 23,32:PRINT "CURSOR"
1056 LOCATE 9,33:PRINT "COUNT"
1058 GOSUB 1190
1062 FOR I=0 TO 7:FOR J=0 TO 7:A(I,J)=0:NEXT J:NEXT I
1064 A(4,4)=1:A(3,3)=1:A(3,4)=2:A(4,3)=2 'NOTE: BLACK=`XX'=`2' WHITE=`OO'=`1'
1066 TOTW=2:TOTB=2:GOSUB 1100:RETURN
1100 '
1102 ' ********* SUBROUTINE TO PRINT PIECE COUNTS TO SCREEN ***********
1104 '
1110 LOCATE 12,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTB),4):LOCATE 18,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTW),4)
1112 LOCATE 12,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTB),4):LOCATE 18,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTW),4)
1114 RETURN
1120 RETURN
1180 '
1181 ' ********* SUBROUTINE TO SHOWN COMPLETION OF GAME *************
1182 '
1183 PUT (9*24+3,0*24+3),T,PSET
1184 LOCATE 2,32:PRINT " GAME IS":LOCATE 3,34:PRINT "OVER"
1186 RETURN
1190 '
1191 ' ********** SUBROUTINE TO UPDATE SCREEN PLAYER TURN INDICATOR ******
1192 '
1193 IF PTURN=1 THEN PUT (9*24+3,0*24+3),OO,PSET
1194 IF PTURN=2 THEN PUT (9*24+3,0*24+3),XX,PSET
1195 LOCATE 2,32:PRINT "PLAYER'S":LOCATE 3,34:PRINT "TURN"
1196 RETURN
1200 '
1202 ' ******** SUBROUTINE TO MOVE CURSOR ON THE SCREEN *********
1204 '
1208 IF PC=1 THEN GOSUB 1234:PC=0
1210 K$=INKEY$:IF K$="" GOTO 1210 ELSE IF K$=" " GOTO 19999 'SUB FOR INPUT KEY
1212 IF 13=ASC(MID$(K$,1,1)) THEN RETURN
1213 IF 27=ASC(MID$(K$,1,1)) THEN IF PTURN=1 THEN PTURN=2:GOSUB 1190:GOTO 1210 ELSE PTURN=1:GOSUB 1190:GOTO 1210
1214 IF LEN(K$)<>2 GOTO 1210
1216 IF 71=ASC(MID$(K$,2,1)) THEN IF (X=0 OR Y=0) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X-1:Y=Y-1:GOSUB 1234:GOTO 1210
1218 IF 73=ASC(MID$(K$,2,1)) THEN IF (X=7 OR Y=0) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X+1:Y=Y-1:GOSUB 1234:GOTO 1210
1220 IF 81=ASC(MID$(K$,2,1)) THEN IF (X=7 OR Y=7) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X+1:Y=Y+1:GOSUB 1234:GOTO 1210
1222 IF 79=ASC(MID$(K$,2,1)) THEN IF (X=0 OR Y=7) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X-1:Y=Y+1:GOSUB 1234:GOTO 1210
1224 IF 72=ASC(MID$(K$,2,1)) THEN IF Y=0 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:Y=Y-1:GOSUB 1234:GOTO 1210
1226 IF 75=ASC(MID$(K$,2,1)) THEN IF X=0 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X-1:GOSUB 1234:GOTO 1210
1228 IF 77=ASC(MID$(K$,2,1)) THEN IF X=7 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X+1:GOSUB 1234:GOTO 1210
1230 IF 80=ASC(MID$(K$,2,1)) THEN IF Y=7 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:Y=Y+1:GOSUB 1234:GOTO 1210
1232 BEEP:GOTO 1210
1234 PUT (X*24+3,Y*24+3),MM,>=:RETURN 'SUB TO PUT AND TAKE CURSOR ON BOARD
1300 '
1302 ' ******** SUBROUTINES TO PLACE PIECES ON BOARD AND ADJUST COUNTS *****
1304 '
1310 PUT (X*24+3,Y*24+3),T,PSET:A(X,Y)=0:PC=1:RETURN ' PUT BLANK SPACE ON BOARD
1311 PUT (X*24+3,Y*24+3),XX,PSET:A(X,Y)=PTURN:PC=1:TOTB=TOTB+1:RETURN 'PUT BLACK ON BOARD (B+1)
1312 PUT (X*24+3,Y*24+3),OO,PSET:A(X,Y)=PTURN:PC=1:TOTW=TOTW+1:RETURN 'PUT WHITE ON BOARD (W+1)
1321 PUT (X*24+3,Y*24+3),XX,PSET:A(X,Y)=PTURN:TOTB=TOTB+1:TOTW=TOTW-1:RETURN 'PUT BLACK ON BOARD FOR WHITE (B+1;W-1)
1322 PUT (X*24+3,Y*24+3),OO,PSET:A(X,Y)=PTURN:TOTW=TOTW+1:TOTB=TOTB-1:RETURN 'PUT WHITE ON BOARD FOR BLACK (B-1;W+1)
1400 '
1402 ' ********* SUBROUTINE TO CHECK FOR VALID MOVE ***********
1404 '
1405 MOK=0:IF A(X,Y)<>0 THEN BEEP:GOTO 1440
1407 IF PTURN=1 THEN MPOK=2 ELSE MPOK=1
1410 FOR I=0 TO 7
1412 PCNT=0
1413 FOR J=1 TO 7
1414 IF 0>(X+J*X4(I)) OR 7<(X+J*X4(I)) OR 0>(Y+J*Y4(I)) OR 7<(Y+J*Y4(I)) GOTO 1430
1415 IF A(X+J*X4(I),Y+J*Y4(I))=0 GOTO 1430
1416 IF A(X+J*X4(I),Y+J*Y4(I))=MPOK THEN PCNT=PCNT+1:NEXT J:GOTO 1430
1418 IF A(X+J*X4(I),Y+J*Y4(I))=PTURN THEN GOSUB 1450:GOTO 1430
1430 NEXT I
1435 IF MOK<>0 GOTO 1440
1436 IF PTURN=1 THEN PTURN=2 ELSE PTURN=1
1437 GOSUB 1190
1438 GOTO 1400
1440 RETURN
1450 '
1451 ' ********** SUBROUTINE TO MAKE THE MOVES ON THE BOARD *********
1452 '
1454 IF PCNT<1 GOTO 1466 ELSE X1=X:Y1=Y
1455 IF MOK=0 THEN ON PTURN GOSUB 1312,1311
1456 FOR K=1 TO PCNT
1458 X=X+K*X4(I):Y=Y+K*Y4(I)
1460 ON PTURN GOSUB 1322,1321
1462 X=X1:Y=Y1:NEXT K
1464 MOK=MOK+1
1466 RETURN
2000 '
2005 ' SUBROUTINE TO AUTOMATICALLY PLAY A GAME ON THE BOARD
2010 ' ASSUMES WHITE'S FIRST MOVE AND COORDINATES ARE GIVEN AS
2015 ' X,Y IN THE RANGE OF 0-7 FOR THE BOARD POSITIONS
2020 '
2021 DATA 5,4,3,5,2,4,5,3,4,2,2,3,4,5,1,5,3,2,4,1,2,1,5,1
2022 DATA 2,2,1,2,3,1,4,0,3,0,5,6,6,3,5,2,6,2,6,5,6,4,2,0
2023 DATA 2,5,2,6,4,6,5,7,3,6,7,5,4,7,5,5,7,3,3,7,2,7,7,2
2024 DATA 6,7,7,4,1,3,0,4,1,7,1,4,6,0,5,0,1,0,1,1,0,1,0,2
2025 DATA 0,0,6,6,7,7,0,5,1,6,7,6,0,6,0,7,6,1,7,1,7,0,0,3
2030 DATA 4,2,5,4,4,5,3,2,2,4,3,5,2,2,2,3,2,5,5,5,5,2,5,3
2035 DATA 5,6,6,3,7,2,4,1,4,0,5,1,5,0,6,2,7,3,5,7,3,1,2,0
2040 DATA 2,1,2,6,2,7,4,6,4,7,1,3,6,7,3,7,0,3,7,7,3,6,1,2
2045 DATA 0,2,1,5,1,4,0,4,0,5,6,4,7,4,7,5,6,5,6,1,7,0,7,1
2050 DATA 6,0,1,1,7,6,6,6,0,1,0,0,1,6,0,6,0,7,1,7,1,0,3,0
2100 IF PC=1 THEN GOSUB 1234:PC=0
2110 READ NX,NY
2120 DX=NX-X:DY=NY-Y:IF DX=0 AND DY=0 GOTO 2200
2130 GOSUB 1234:X=X+SGN(DX):Y=Y+SGN(DY):GOSUB 1234
2140 'K1$=INKEY$:IF K1$="" GOTO 2150
2145 'K1$=INKEY$:IF K1$="" GOTO 2145
2150 GOTO 2120
2200 RETURN
5000 ' ******** SUBROUTINE TO PRINT ARRAY `A' TO PRINTER ***********
5001 '
5002 FOR JJ=0 TO 7
5003 FOR II=0 TO 7
5004 LPRINT A(II,JJ);
5005 NEXT II
5006 LPRINT ""
5007 NEXT JJ
5008 RETURN
19900 K$=INKEY$:IF K$="" GOTO 19900
19910 CLS:LOCATE 10,15:PRINT "ANOTHER GAME?"
19920 K$=INKEY$:IF K$="" GOTO 19920
19930 IF K$<>"Y" AND K$<>"y" GOTO 19999
19935 IF SS=0 THEN RESTORE 2030:SS=1:PTURN=1:GOTO 19950
19940 IF SS=1 THEN RESTORE 2021:SS=0:PTURN=2:GOTO 19950
19950 GOTO 400
19999 LOCATE 5,1:CLS:SCREEN 0:KEY ON:WIDTH 80:END
PATHMAN.BAS
10 ' PATH MAN by D N Smith based on:
20 '++++++++ PC MAN BY ED DAVIS +++++++
30 DIM S%(300)
35 COLOR 7,0:CLS
40 GOSUB 2790 'color on
50 GOSUB 2150 'adjust paddles
60 GOSUB 1410 'CREATE CHARACTERS
70 GOSUB 1770 'INFO AND QUESTIONS
80 GOSUB 1050 'INITIALIZATION
90 '************************************************************************
100 GOSUB 3000 ' read keys
110 IF INT(ZY/100)=0 THEN T=2
115 IF DNS$<"1" AND DNS$<>" " THEN GOTO 210
120 IF DNS$=" " THEN BT%=0 ELSE BT%=STRIG(1):IF BT%<>-1 GOTO 210
130 IF SS<1 GOTO 210
140 SHOT=0:IF DC=4 AND XC=XY AND YC>YY OR DC=3 AND YC=YY AND XC>XY OR DC=2 AND XC=XY AND YC<YY OR DC=1 AND YC=YY AND XC<XY THEN SHOT=1
150 PLAY "MBL64T255O5CDEFGAB"
160 SS=SS-1:LOCATE 23,5:PRINT"PHASOR SHOTS REMAINING >";SS;
165 DNS$ = "0"
170 IF SHOT=0 GOTO 210
180 PUT(XC*12,YC*12),GC%:PUT (XC*12,YC*12),BB%: PLAY"MFL64T200O1CEACEA"
190 FOR I=1 TO 300:NEXT I
200 PUT (XC*12,YC*12),BB%:XC=22-XC:YC=12-YC:PUT(XC*12,YC*12),GC%:DC=DC+2:IF DC>4 THEN DC=DC-4
210 PUT(12*XY,12*YY),G%
220 IF ABS(XY-11)>1 AND ABS (YY-6)>1 THEN 400
230 ON DY GOTO 240,280,320,360
240 IF XY=12 THEN 420
250 GOSUB 3000 ' read keys
260 Z=INT(ZX/100)-1:LY=LY+Z:YY=YY+Z:IF LY<1 OR LY>5 THEN LY=LY-Z:YY=YY-Z
270 GOTO 420
280 IF YY=5 THEN 420
290 GOSUB 3000 ' read keys
300 Z=INT(ZX/100)-1:LY=LY+Z:XY=XY-Z:IF LY<1 OR LY>5 THEN LY=LY-Z:XY=XY+Z
310 GOTO 420
320 IF XY=10 THEN 420
330 GOSUB 3000 ' read keys
340 Z=INT(ZX/100)-1:LY=LY+Z:YY=YY-Z:IF LY<1 OR LY>5 THEN LY=LY-Z:YY=YY+Z
350 GOTO 420
360 IF YY=7 THEN 420
370 GOSUB 3000 ' read keys
380 Z=INT(ZX/100)-1:LY=LY+Z:XY=XY+Z:IF LY<1 OR LY>5 THEN LY=LY-Z:XY=XY-Z
390 GOTO 420
400 IF ABS(XY-11)<LY+6 OR ABS(YY-6)<LY+1 THEN 420
410 DY=DY-1:IF DY=0 THEN DY=4
420 ON DY GOTO 430,440,450,460
430 XY=XY+1:GOTO 480
440 YY=YY+1:GOTO 480
450 XY=XY-1:GOTO 480
460 YY=YY-1
470 '
480 IF XY=XC AND YY=YC THEN GOSUB 1690: GOTO 100
490 IF RK>2 THEN IF XY=XD AND YY=YD THEN CCC=1:GOSUB 1690: GOTO 100
500 Z%=XY*13+YY:SZ%=S%(Z%):IF SZ%<1 THEN 560
510 SC=SC+(S%(Z%)-1)*4+1:C=C-1:LOCATE 12,16:PRINT SC
520 IF SZ%=1 THEN PLAY "MBL32T255O1D":PUT(XY*12,YY*12),M1%
530 IF SZ%=2 THEN PLAY "MBL32T255O2ACA":PUT(XY*12+1,YY*12+1),M%
540 S%(Z%)=0
550 IF C=0 THEN GOSUB 1110:GOTO 90 ' (JUMPS INTO INITIALIZATION ROUTINE)
560 IF T=2 THEN T=1:GOTO 400
570 PUT (XY*12,YY*12),G%
580 IF RK>2 THEN T=2:SW=1-SW:ON SW +1 GOTO 590,840
590 PUT(XC*12,YC*12),GC%
600 SZ%=S%(XC*13+YC)
610 IF SZ%=2 THEN PUT(XC*12+1,YC*12+1),M%,PSET
620 IF XC<>11 AND YC<>6 THEN 700
630 R=0:IF RND(1)<0.3 THEN R=1
640 Z=SGN(LY-LC):LC=LC+Z
650 ON DC GOTO 660,670,680,690
660 YC=YC-Z:GOTO 720
670 XC=XC+Z:GOTO 720
680 YC=YC+Z:GOTO 720
690 XC=XC-Z:GOTO 720
700 IF ABS(XC-11)<LC+6 OR ABS(YC-6)<LC+1 THEN 720
710 DC=DC+1:IF DC=5 THEN DC=1
720 ON DC GOTO 730,740,750,760
730 XC=XC+1:GOTO 770
740 YC=YC+1:GOTO 770
750 XC=XC-1:GOTO 770
760 YC=YC-1
770 IF XC=XY AND YC=YY THEN GOSUB 1690 : GOTO 100
780 IF R=0 THEN 810
790 Z%=XC*13+YC:IF S%(Z%)=0 THEN C=C+1
800 S%(Z%)=2
810 IF TT=2 THEN TT=1:GOTO 590
820 PUT (XC*12,YC*12),GC%
830 GOTO 100
840 PUT (XD*12,YD*12),GC%
850 IF XD<>11 AND YD<>6 THEN 920
860 Z=SGN(LY-LD):LD=LD+Z
870 ON DD GOTO 880,890,900,910
880 YD=YD-Z:GOTO 940
890 XD=XD+Z:GOTO 940
900 YD=YD+Z:GOTO 940
910 XD=XD-Z:GOTO 940
920 IF ABS(XD-11)<LD+6 OR ABS(YD-6)<LD+1 THEN 940
930 DD=DD+1:IF DD=5 THEN DD=1
940 ON DD GOTO 950,960,970,980
950 XD=XD+1:GOTO 990
960 YD=YD+1:GOTO 990
970 XD=XD-1:GOTO 990
980 YD=YD-1
990 IF XD=XY AND YD=YY THEN CCC=1: GOSUB 1690 : GOTO 100
1000 IF TT=2 THEN TT=1:GOTO 840
1010 PUT (XD*12,YD*12),GC%
1020 GOTO 100
1030 END
1040 '***********************************************************************
1050 REM INITIALIZATION
1060 COLOR 0
1070 SCREEN 1,0
1080 HS=0:SC=0:SW=0
1090 IF SC>HS THEN HS=SC
1100 SC=0:RK=0:IF PK$="2" THEN RK=2
1110 C=200:RK=RK+1:SS=10:CCC=0
1115 ZX=100 : ZY = 0 : DELAY = 0
1118 DNS$="0"
1120 CLS
1125 WHILE INKEY$<>"" : WEND
1127 I = ASC(MID$(TIME$,7,1)) * ASC(MID$(TIME$,8,1))
1128 RANDOMIZE I
1130 FOR Y=0 TO 60 STEP 12
1140 LINE (Y,Y)-(276-Y,Y):LINE -(276-Y,156-Y):LINE -(Y,156-Y):LINE -(Y,Y)
1150 NEXT
1160 FOR Y=12 TO 48 STEP 12
1170 LINE (Y,65)-(Y,91),0
1180 LINE (276-Y ,65)-(276-Y,91),0
1190 LINE (125,Y)-(151,Y),0
1200 LINE (125,156-Y)-(151,156-Y),0
1210 NEXT
1220 FOR I=1 TO 299:S%(I)=0:NEXT I
1230 :
1240 FOR Y=0 TO 4
1250 FOR X=0 TO 9
1260 PUT(12*X,12*Y),M1%:S%(13*X+Y)=1
1270 PUT(264-12*X,12*Y),M1%:S%(13*(22-X)+Y)=1
1280 PUT(12*X,144-12*Y),M1%:S%(13*X+(12-Y))=1
1290 PUT(264-12*X,144-12*Y),M1%:S%(13*(22-X)+(12-Y))=1
1300 NEXT X:NEXT Y
1310 XC=10:YC=12:DC=3:LC=5:XY=12:YY=12:DY=1:LY=5
1320 PUT(XY*12,YY*12),G%
1330 PUT(XC*12,YC*12),GC%
1340 IF RK>2 THEN XD=10:YD=0:DD=1:LD=5:PUT(XD*12,YD*12),GC%
1350 LOCATE 10,15:PRINT"SCORE"
1360 LOCATE 11,15:PRINT"~~~~~"
1370 LOCATE 25,1:PRINT " HIGHEST SCORE TODAY } ";HS;
1380 FOR I=1 TO 1000:NEXT I
1390 RETURN
1400 '*******************************************************************
1410 REM CREATE CARACTERS
1420 DIM G%(18):DIM GC%(18):DIM M%(18):DIM M1%(18):DIM BB%(80)
1430 CLS
1440 SCREEN 1,0:COLOR 0,1:OUT 980,2:OUT 981,43
1450 LINE (103,103)-(107,107),2,BF
1460 GET(100,100)-(109,109),M%
1470 CLS
1480 CIRCLE (105,105),5,3
1490 PAINT (105,105),2,3
1500 GET(100,100)-(110,110),GC%
1510 REM PAINT MAN +++++++++++++++++
1520 CLS
1530 ' LINE (100,100)-(110,110),3,B
1540 PRESET (100,100):DRAW"C3S4"
1550 DRAW"BR3R4D2L1D1R4D2L4D1R1D2R2D2L3U2L2D2L3U2R2U4L3U2R4U1L1U2"
1560 PAINT (105,103),3,3
1570 GET (100,100)-(110,110),G%
1580 CLS
1590 LINE(105,103)-(105,107),3
1600 LINE(103,105)-(107,105),3
1610 GET(100,100)-(110,110),M1%
1620 CLS
1630 CIRCLE (110,110),10,3
1640 PAINT (110,110),2,3
1650 GET (100,100)-(120,120),BB%
1660 CLS
1670 RETURN
1680 '*************************************************************
1690 REM BLOW UP SEQUENCE ON COLLISION
1700 PLAY"MB L32T64O1EAEAEAEA"
1710 IF RK>2 AND CCC=1 THEN PUT (XD*12,YD*12),BB%,PRESET:GOTO 1730
1720 PUT(XC*12,YC*12),BB%,PRESET
1730 PLAY"L64O1AP10BP30CP20FEA"
1735 LOCATE 10,12:PRINT "Hit <CR>..."
1740 IF INKEY$<>CHR$(13) THEN 1740
1750 GOSUB 1090
1755 RETURN
1760 '**************************************************************************
1770 ' INFO AND QUESTIONS
1780 CLS
1790 LOCATE 1,3:PRINT "WELCOME TO THE GAME OF PATH MAN"
1800 LOCATE 4,2:PRINT " Using the keys you will be":PRINT " moving a man thru a maze filled with
1810 PRINT""
1820 PRINT " GOOD THINGS, AND BAD PEOPLE."
1830 PRINT""
1840 PRINT" Push the "8" for fast; "2" for slow.
1850 PRINT" Push space bar to FIRE phasor.
1860 PRINT" You only have 10 shots !"
1865 PRINT" 1 & 4 & 7 turn left 1, 2, or 3 rows.
1867 PRINT" 3 & 6 & 7 turn right 1, 2, or 3 rows.
1870 PRINT" The more you eat the higher your score"
1880 PRINT" The bad guys only want to eat YOU!"
1890 PRINT" Every once in a while a bad guy may "
1900 PRINT" drop some special food... "
1910 PRINT" ":PRINT" Hope you enjoy yourself."
1920 PRINT" Ed Davis & Dave Smith"
1930 LOCATE 25,4:PRINT "press space bar to continue";:I$=INKEY$
1940 IF I$<>" "GOTO 1930
1950 CLS
1960 PRINT" ":PRINT"~~~~~THE CAST OF CHARACTERS~~~~~"
1970 LOCATE 5,2:PRINT " YOU>"
1980 LOCATE 7,2:PRINT " THE BAD GUYS>"
1990 LOCATE 9,2:PRINT "FOOD (WORTH 1 POINT)>"
2000 LOCATE 11,2:PRINT"FOOD (WORTH 5 POINTS)>"
2010 PUT (200,30),G%
2020 PUT (200,46),GC%
2030 PUT (200,62),M1%
2040 PUT (200,78),M%
2050 LOCATE 19,3:PRINT "YOU MAY START IN THE CAGE WITH EITHER"
2060 LOCATE 20,3:PRINT "ONE OR TWO OF THE 'BAD GUYS'.
2070 LOCATE 22,3:PRINT"HOW MANY DO YOU WISH (1 OR 2) ?";:PK$=INKEY$
2080 RK=0
2090 IF PK$="1" THEN RK=1 :RETURN
2100 IF PK$="2" THEN RK=2: RETURN
2110 GOTO 2070
2120 END
2130 '******************************************************************
2140 ' joystick adjustment
2150 CLS:KEY OFF:STRIG ON
2155 IF STICK(0)=0 THEN RETURN
2160 LOCATE 25,5:PRINT " PRESS ANY KEY TO END THIS TEST"
2170 LOCATE 3,5:PRINT"THIS GAME REQUIRES A JOYSTICK":PRINT
2180 PRINT "HOLD JOYSTICK SUCH THAT AS YOU MOVE IT
2190 PRINT "LEFT AND RIGHT, UP AND DOWN, AND WHEN "
2200 PRINT"YOU PRESS THE BUTTON YOU GET"
2210 PRINT "THE CORRECT RESPONSES BELOW........
2220 K$=INKEY$: IF K$<>""THEN RETURN
2230 SX=STICK(0):SY=STICK(1)
2240 LOCATE 10,10: PRINT"X VAL. Y VAL. "
2250 REM ~~~~~~~~~~~~NOTE DECISION VALUE SET AT 50~~~~~~~~~~~~~~
2260 LOCATE 11,10:PRINT SX;" ";SY;" "
2270 ZX=INT(SX/50) :ZY=INT(SY/50)
2280 IF ZX=0 THEN M$=" <<<< LEFT HAND TURN "
2290 IF ZX=1 THEN M$=" ^ STAIGHT AHEAD ^ "
2300 IF ZX=2 THEN M$=" RIGHT HAND TURN >>>> "
2310 IF ZY=0 THEN MM$=" FASTER "
2320 IF ZY<>0 THEN MM$="NORMAL SPEED"
2330 LOCATE 15,4:PRINT M$
2340 LOCATE 17,11:PRINT MM$
2350 BT%=STRIG(1)
2360 LOCATE 20,8:PRINT " "
2370 IF BT%=-1 THEN LOCATE 20,8:PRINT"BUTTON IS PRESSED!"
2380 GOTO 2220
2390 '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2400 '
2410 ' REMARKS
2420 '
2430 '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2440 '
2450 ' WRITTED BY ED DAVIS ,BURLINGTON
2460 ' EXTENSION (8-446)-2091
2470 ' FROM IDEAS BY M. PELCZARSKI
2480 ' 1-1-81
2490 '
2500 ' NOTE LINE 2030 USES "OUT" COMMANDS
2510 ' TO SHIFT THE SCREEN LEFT, IF YOU
2520 ' ARE USING A MONITOR YOU MAY WISH
2530 ' TO REMOVE THESE. ALSO THE SENSI-
2540 ' TIVITY OF THE PADDLES MAY BE
2550 ' CHANGED ON LINES 61 AND 87.
2560 '
2570 '
2580 END
2590 '*******************************************************************
2600 ' COLOR MONITOR-MONOCHROME MONITOR SWITCH EMD 11-81
2610 CLS
2620 PRINT:PRINT"IF YOU WANT TO TOGGLE MONOCHROME/COLOR THEN;"
2630 PRINT" FOR COLOR PRESS - C"
2640 PRINT" FOR MONO PRESS - M"
2650 PRINT" FOR NO CHANGE PRESS ANY OTHER KEY."
2660 K$=INKEY$:IF K$="" GOTO 2660
2670 IF K$="C" OR K$="c" THEN GOSUB 2790:END
2680 IF K$="M" OR K$="m" THEN GOSUB 2710:END
2690 CLS
2700 PRINT"@@@@@@@@@@@@ NO CHANGE @@@@@@@@@@@@@@":END
2710 '************** switch to monochrome ***************************
2720 DEF SEG=0
2730 POKE &H410,(PEEK(&H410) OR &H30)
2740 DEF SEG
2750 LOCATE ,,1,12,13
2760 SCREEN 0 : WIDTH 80
2770 RETURN
2780 '***************************************************************8
2790 REM switch to color/graphics adapter
2800 DEF SEG=0
2810 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
2820 DEF SEG
2830 LOCATE ,,1,6,7
2840 SCREEN 0
2850 WIDTH 40
2860 RETURN
3000 'ZX = 50 : ZY = 50
3020 XXX$ = INKEY$ : IF XXX$<>"" THEN DNS$ = XXX$
3025 IF DNS$="m" THEN GOSUB 2710 : STOP
3030 LOCATE 23,35 : PRINT DNS$;
3040 IF DNS$="9" THEN ZX=405
3045 IF DNS$="6" THEN ZX=305
3047 IF DNS$="3" THEN ZX=205
3060 IF DNS$="8" THEN : ZY = 0
3065 IF DNS$="5" THEN ZX = 100
3070 IF DNS$="2" THEN : ZY = 400
3080 IF DNS$="7" THEN ZX= -200
3085 IF DNS$="4" THEN ZX= -100
3090 IF DNS$="1" THEN ZX= 0
3200 RETURN
PCMAN.BAS
5 REM * PUBLIC DOMAIN SOFTWARE *
10 '++++++++ PC MAN BY ED DAVIS +++++++
15 DIM S%(300)
20 GOSUB 65019
25 GOSUB 5000
26 GOSUB 2000:GOSUB 4000
30 GOTO 1000
60 ZX=STICK(0):ZY=STICK(1)
61 IF INT(ZY/40)=0 THEN T=2
62 BT%=STRIG(1):IF BT%<>-1 GOTO 72
63 IF SS<1 GOTO 72
64 SHOT=0:IF DC=4 AND XC=XY AND YC>YY OR DC=3 AND YC=YY AND XC>XY OR DC=2 AND XC=XY AND YC<YY OR DC=1 AND YC=YY AND XC<XY THEN SHOT=1
66 PLAY "MBL64T255O5CDEFGAB"
67 SS=SS-1:LOCATE 23,5:PRINT"PHASOR SHOTS REMAINING >";SS;
68 IF SHOT=0 GOTO 72
69 PUT(XC*12,YC*12),GC%:PUT (XC*12,YC*12),BB%: PLAY"MFL64T200O1CEACEA"
70 FOR I=1 TO 500:NEXT I
71 PUT (XC*12,YC*12),BB%:XC=22-XC:YC=12-YC:PUT(XC*12,YC*12),GC%:DC=DC+2:IF DC>4 THEN DC=DC-4
72 PUT(12*XY,12*YY),G%
76 IF ABS(XY-11)>1 AND ABS (YY-6)>1 THEN 110
78 ON DY GOTO 80,85,90,95
80 IF XY=12 THEN 150
81 ZX=STICK(0)
82 Z=INT(ZX/50)-1:LY=LY+Z:YY=YY+Z:IF LY<1 OR LY>5 THEN LY=LY-Z:YY=YY-Z
84 GOTO 150
85 IF YY=5 THEN 150
86 ZX=STICK(0)
87 Z=INT(ZX/50)-1:LY=LY+Z:XY=XY-Z:IF LY<1 OR LY>5 THEN LY=LY-Z:XY=XY+Z
89 GOTO 150
90 IF XY=10 THEN 150
91 ZX=STICK(0)
92 Z=INT(ZX/50)-1:LY=LY+Z:YY=YY-Z:IF LY<1 OR LY>5 THEN LY=LY-Z:YY=YY+Z
94 GOTO 150
95 IF YY=7 THEN 150
96 ZX=STICK(0)
97 Z=INT(ZX/50)-1:LY=LY+Z:XY=XY+Z:IF LY<1 OR LY>5 THEN LY=LY-Z:XY=XY-Z
99 GOTO 150
110 IF ABS(XY-11)<LY+6 OR ABS(YY-6)<LY+1 THEN 150
120 DY=DY-1:IF DY=0 THEN DY=4
150 ON DY GOTO 160,170,180,190
160 XY=XY+1:GOTO 200
170 YY=YY+1:GOTO 200
180 XY=XY-1:GOTO 200
190 YY=YY-1
200 IF XY=XC AND YY=YC THEN 3000
205 IF RK>2 THEN IF XY=XD AND YY=YD THEN CCC=1:GOTO 3000
210 Z%=XY*13+YY:SZ%=S%(Z%):IF SZ%<1 THEN 240
220 SC=SC+(S%(Z%)-1)*4+1:C=C-1:LOCATE 12,16:PRINT SC
222 IF SZ%=1 THEN PLAY "MBL32T255O1D":PUT(XY*12,YY*12),M1%
223 IF SZ%=2 THEN PLAY "MBL32T255O2ACA":PUT(XY*12+1,YY*12+1),M%
224 S%(Z%)=0
230 IF C=0 THEN 1015
240 IF T=2 THEN T=1:GOTO 110
250 PUT (XY*12,YY*12),G%
260 IF RK>2 THEN T=2:SW=1-SW:ON SW +1 GOTO 300,500
300 PUT(XC*12,YC*12),GC%
305 SZ%=S%(XC*13+YC)
307 IF SZ%=2 THEN PUT(XC*12+1,YC*12+1),M%,PSET
310 IF XC<>11 AND YC<>6 THEN 360
315 R=0:IF RND(1)<0.2 THEN R=1
320 Z=SGN(LY-LC):LC=LC+Z
330 ON DC GOTO 335,340,345,350
335 YC=YC-Z:GOTO 400
340 XC=XC+Z:GOTO 400
345 YC=YC+Z:GOTO 400
350 XC=XC-Z:GOTO 400
360 IF ABS(XC-11)<LC+6 OR ABS(YC-6)<LC+1 THEN 400
370 DC=DC+1:IF DC=5 THEN DC=1
400 ON DC GOTO 410,420,430,440
410 XC=XC+1:GOTO 450
420 YC=YC+1:GOTO 450
430 XC=XC-1:GOTO 450
440 YC=YC-1
450 IF XC=XY AND YC=YY THEN GOTO 3000
455 IF R=0 THEN 470
457 Z%=XC*13+YC:IF S%(Z%)=0 THEN C=C+1
460 S%(Z%)=2
470 IF TT=2 THEN TT=1:GOTO 300
480 PUT (XC*12,YC*12),GC%
490 GOTO 60
500 PUT (XD*12,YD*12),GC%
510 IF XD<>11 AND YD<>6 THEN 560
520 Z=SGN(LY-LD):LD=LD+Z
530 ON DD GOTO 535,540,545,550
535 YD=YD-Z:GOTO 600
540 XD=XD+Z:GOTO 600
545 YD=YD+Z:GOTO 600
550 XD=XD-Z:GOTO 600
560 IF ABS(XD-11)<LD+6 OR ABS(YD-6)<LD+1 THEN 600
570 DD=DD+1:IF DD=5 THEN D=1
600 ON DD GOTO 610,620,630,640
610 XD=XD+1:GOTO 650
620 YD=YD+1:GOTO 650
630 XD=XD-1:GOTO 650
640 YD=YD-1
650 IF XD=XY AND YD=YY THEN CCC=1: GOTO 3000
655 IF TT=2 THEN TT=1:GOTO 500
660 PUT (XD*12,YD*12),GC%
670 GOTO 60
999 END
1000 REM INITIALIZATION
1008 COLOR 0
1010 SCREEN 1,0
1011 HS=0:SC=0:SW=0
1013 IF SC>HS THEN HS=SC
1014 SC=0:RK=0:IF PK$="2" THEN RK=2
1015 C=200:RK=RK+1:SS=3:CCC=0
1020 CLS
1030 FOR Y=0 TO 60 STEP 12
1040 LINE (Y,Y)-(276-Y,Y):LINE -(276-Y,156-Y):LINE -(Y,156-Y):LINE -(Y,Y)
1050 NEXT
1070 FOR Y=12 TO 48 STEP 12
1080 LINE (Y,65)-(Y,91),0
1090 LINE (276-Y ,65)-(276-Y,91),0
1100 LINE (125,Y)-(151,Y),0
1110 LINE (125,156-Y)-(151,156-Y),0
1120 NEXT
1122 FOR I=1 TO 299:S%(I)=0:NEXT I
1125 :
1130 FOR Y=0 TO 4
1140 FOR X=0 TO 9
1150 PUT(12*X,12*Y),M1%:S%(13*X+Y)=1
1160 PUT(264-12*X,12*Y),M1%:S%(13*(22-X)+Y)=1
1170 PUT(12*X,144-12*Y),M1%:S%(13*X+(12-Y))=1
1180 PUT(264-12*X,144-12*Y),M1%:S%(13*(22-X)+(12-Y))=1
1190 NEXT X:NEXT Y
1220 XC=10:YC=12:DC=3:LC=5:XY=12:YY=12:DY=1:LY=5
1240 PUT(XY*12,YY*12),G%
1250 PUT(XC*12,YC*12),GC%
1255 IF RK>2 THEN XD=10:YD=0:DD=1:LD=5:PUT(XD*12,YD*12),GC%
1260 LOCATE 10,15:PRINT"SCORE"
1265 LOCATE 11,15:PRINT"~~~~~"
1280 LOCATE 25,1:PRINT " HIGHEST SCORE TODAY } ";HS;
1290 FOR I=1 TO 1000:NEXT I:GOTO 60
2000 REM CREATE CARACTERS
2010 DIM G%(18):DIM GC%(18):DIM M%(18):DIM M1%(18):DIM BB%(80)
2020 CLS
2030 SCREEN 1,0:COLOR 0,1:OUT 980,2:OUT 981,43
2040 LINE (103,103)-(107,107),2,BF
2050 GET(100,100)-(109,109),M%
2060 CLS
2070 CIRCLE (105,105),5,3
2080 PAINT (105,105),2,3
2090 GET(100,100)-(110,110),GC%
2100 REM PAINT MAN +++++++++++++++++
2102 CLS
2105 ' LINE (100,100)-(110,110),3,B
2110 PRESET (100,100):DRAW"C3S4"
2112 DRAW"BR3R4D2L1D1R4D2L4D1R1D2R2D2L3U2L2D2L3U2R2U4L3U2R4U1L1U2"
2116 PAINT (105,103),3,3
2120 GET (100,100)-(110,110),G%
2125 CLS
2130 LINE(105,103)-(105,107),3
2140 LINE(103,105)-(107,105),3
2150 GET(100,100)-(110,110),M1%
2160 CLS
2170 CIRCLE (110,110),10,3
2180 PAINT (110,110),2,3
2190 GET (100,100)-(120,120),BB%
2800 CLS
2900 RETURN
3000 REM BLOW UP SEQUENCE ON COLLISION
3010 PLAY"MB L32T64O1EAEAEAEA"
3018 IF RK>2 AND CCC=1 THEN PUT (XD*12,YD*12),BB%,PRESET:GOTO 3030
3020 PUT(XC*12,YC*12),BB%,PRESET
3030 PLAY"L64O1AP10BP30CP20FEA"
3040 FOR I=1 TO 400:NEXT I
3100 GOTO 1013
4000 ' INFO AND QUESTIONS
4100 CLS
4110 LOCATE 1,3:PRINT "WELCOME TO THE GAME OF *PC* MAN"
4120 LOCATE 4,2:PRINT " Using the control stick you will be":PRINT " moving a man thru a maze filled with
4125 PRINT""
4130 PRINT " GOOD THINGS, AND BAD PEOPLE."
4135 PRINT""
4140 PRINT" Push the stick forward to go FASTER"
4150 PRINT" Push button to FIRE phasor, but you"
4155 PRINT" only have 3 shots !"
4160 PRINT" The more you eat the higher your score"
4170 PRINT" The bad guys only want to eat YOU!"
4175 PRINT" Every once in a while a bad guy may "
4180 PRINT" drop some special food... "
4184 PRINT" ":PRINT" Hope you enjoy yourself."
4185 PRINT" Ed Davis"
4190 LOCATE 25,4:PRINT "press space bar to continue";:I$=INKEY$
4192 IF I$<>" "GOTO 4190
4200 CLS
4210 PRINT" ":PRINT"~~~~~THE CAST OF CHARACTERS~~~~~"
4220 LOCATE 5,2:PRINT " YOU>"
4230 LOCATE 7,2:PRINT " THE BAD GUYS>"
4240 LOCATE 9,2:PRINT "FOOD (WORTH 1 POINT)>"
4250 LOCATE 11,2:PRINT"FOOD (WORTH 5 POINTS)>"
4300 PUT (200,30),G%
4310 PUT (200,46),GC%
4320 PUT (200,62),M1%
4330 PUT (200,78),M%
4360 LOCATE 19,3:PRINT "YOU MAY START IN THE CAGE WITH EITHER"
4370 LOCATE 20,3:PRINT "ONE OR TWO OF THE 'BAD GUYS'.
4380 LOCATE 22,3:PRINT"HOW MANY DO YOU WISH (1 OR 2) ?";:PK$=INKEY$
4390 RK=0
4400 IF PK$="1" THEN RK=1 :RETURN
4410 IF PK$="2" THEN RK=2: RETURN
4420 GOTO 4380
4999 END
5000 CLS:KEY OFF:STRIG ON
5005 LOCATE 25,5:PRINT " PRESS ANY KEY TO END THIS TEST"
5010 LOCATE 3,5:PRINT"THIS GAME REQUIRES A JOYSTICK":PRINT
5020 PRINT "HOLD JOYSTICK SUCH THAT AS YOU MOVE IT
5030 PRINT "LEFT AND RIGHT, UP AND DOWN, AND WHEN "
5035 PRINT"YOU PRESS THE BUTTON YOU GET"
5040 PRINT "THE CORRECT RESPONSES BELOW........
5050 K$=INKEY$: IF K$<>""THEN RETURN
5060 SX=STICK(0):SY=STICK(1)
5070 LOCATE 10,10: PRINT"X VAL. Y VAL. "
5075 REM ~~~~~~~~~~~~NOTE DECISION VALUE SET AT 50~~~~~~~~~~~~~~
5080 LOCATE 11,10:PRINT SX;" ";SY;" "
5090 ZX=INT(SX/50) :ZY=INT(SY/50)
5100 IF ZX=0 THEN M$=" <<<< LEFT HAND TURN "
5110 IF ZX=1 THEN M$=" ^ STAIGHT AHEAD ^ "
5120 IF ZX=2 THEN M$=" RIGHT HAND TURN >>>> "
5130 IF ZY=0 THEN MM$=" FASTER "
5140 IF ZY<>0 THEN MM$="NORMAL SPEED"
5150 LOCATE 15,4:PRINT M$
5160 LOCATE 17,11:PRINT MM$
5170 BT%=STRIG(1)
5180 LOCATE 20,8:PRINT " "
5190 IF BT%=-1 THEN LOCATE 20,8:PRINT"BUTTON IS PRESSED!"
5300 GOTO 5050
6000 '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
6005 '
6010 ' REMARKS
6015 '
6020 '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
6030 '
6040 ' WRITTED BY ED DAVIS ,BURLINGTON
6045 ' EXTENSION (8-446)-2091
6050 ' FROM IDEAS BY M. PELCZARSKI
6060 ' 1-1-81
6070 '
6080 ' NOTE LINE 2030 USES "OUT" COMMANDS
6090 ' TO SHIFT THE SCREEN LEFT, IF YOU
6100 ' ARE USING A MONITOR YOU MAY WISH
6110 ' TO REMOVE THESE. ALSO THE SENSI-
6120 ' TIVITY OF THE PADDLES MAY BE
6130 ' CHANGED ON LINES 61 AND 87.
6140 '
6150 '
50000 END
65000 ' COLOR MONITOR-MONOCHROME MONITOR SWITCH EMD 11-81
65001 CLS
65002 PRINT:PRINT"IF YOU WANT TO TOGGLE MONOCHROME/COLOR THEN;"
65003 PRINT" FOR COLOR PRESS - C"
65004 PRINT" FOR MONO PRESS - M"
65005 PRINT" FOR NO CHANGE PRESS ANY OTHER KEY."
65006 K$=INKEY$:IF K$="" GOTO 65006
65007 IF K$="C" OR K$="c" THEN GOSUB 65019:END
65008 IF K$="M" OR K$="m" THEN GOSUB 65011:END
65009 CLS
65010 PRINT"@@@@@@@@@@@@ NO CHANGE @@@@@@@@@@@@@@":END
65011 REM switch to monochrome adapter
65012 DEF SEG=0
65013 POKE &H410,(PEEK(&H410) OR &H30)
65014 DEF SEG
65015 LOCATE ,,1,12,13
65016 SCREEN 0
65017 WIDTH 80
65018 RETURN
65019 REM switch to color/graphics adapter
65020 DEF SEG=0
65021 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
65022 DEF SEG
65023 LOCATE ,,1,6,7
65024 SCREEN 0
65025 WIDTH 40
65026 RETURN
PRTGRAF.BAS
5 WIDTH "lpt1:",255
6 GOSUB 10000
7 GOSUB 11000
10 INPUT "no of side of structure",S
20 INPUT "input the radius of structure",R
25 GOSUB 10000
30 SCREEN 2:KEY OFF:CLS
40 CONST = 3.141593*2/S
50 FOR I = 1 TO S
60 X1 = R*COS(I*CONST)*2
70 Y1 = (28*R/32)*SIN(I*CONST)
80 FOR N = 1 TO S
90 X2 = R*COS(N*CONST)*2
100 Y2 = (28*R/32)*SIN(N*CONST)
110 LINE (X1+320,Y1+100)-(X2+320,Y2+100),3
120 NEXT N
130 N=1
140 NEXT I
145 GOSUB 11000
150 INPUT "Would you like to print the screen 'Y' for yes: ",YES$
160 IF YES$<>"Y" GOTO 180
170 GOSUB 20500
180 INPUT "Would you like another pattern? 'Y' for yes: ",YES$
190 IF YES$="Y" GOTO 10
200 END
10000 REM switch to color
10010 KEY OFF
10020 LOCATE ,,0
10030 DEF SEG = 0
10040 POKE &H410,(PEEK(&H410)AND &HCF)OR &H10
10050 WIDTH 40
10060 LOCATE ,,1,6,7
10070 RETURN
11000 REM switch to mono
11010 KEY OFF
11020 LOCATE,,0
11030 DEF SEG = 0
11040 POKE &H410,PEEK(&H410) OR &H30
11050 DEF SEG
11060 SCREEN 1
11070 SCREEN 0
11080 WIDTH 80
11090 LOCATE ,,1,12,13
11100 RETURN
20500 DEF SEG = &HB800
20510 FOR J = 0 TO 79
20520 LPRINT CHR$(&H1B);"L";CHR$(&H20);CHR$(&H3);
20530 FOR K = 99 TO 0 STEP -1
20540 X=J+(80*K):C% = PEEK(X):B% = PEEK(8192+X)
20550 IF C%=13 THEN C%=9
20560 IF B%=13 THEN B%=9
20570 LPRINT CHR$(B%);CHR$(B%);CHR$(B%);CHR$(B%);CHR$(C%);CHR$(C%);CHR$(C%);CHR$(C%);
20580 NEXT K
20590 K=0:LPRINT CHR$(&H1B);"A";CHR$(8);CHR$(10);
20600 NEXT J
20610 RETURN
SCREEN.ASM
TITLE Convert to Color Display
PAGE ,132
NODISP_FLAG EQU 11001111B ;Turn OFF Monochrom
COLOR_FLAG EQU 00100000B ;Turn ON Color
MONO_FLAG EQU 00110000B ;Turn ON Monochrom
DATA SEGMENT AT 40H
ORG 10H
EQUIPFLAG DW ?
DATA ENDS
STACK SEGMENT STACK
DW 64 DUP(?)
STACK ENDS
CODE SEGMENT
ASSUME CS:CODE,DS:DATA
COLOR PROC FAR
PUSH DS ;Establish return vector
SUB AX,AX
PUSH AX
;
MOV BX,80H ;Offset into PSP
ADD BL,ES:[BX] ;+80H is length of modifier
MOV AL,ES:[BX] ;Get opperand
CMP AL,'0' ;if less that ascii 0
JL BAD ;goto error
CMP AL,'6' ;if greater that ascii 6
JG BAD ;goto error
SUB AL,30H ;Make binary
PUSH AX ;SAVE ON STACK
;
MOV AX,DATA
MOV DS,AX ;Set up segment register
MOV AX,EQUIPFLAG
AND AL,NODISP_FLAG ;Turn OFF Monochrom
OR AL,COLOR_FLAG ;Turn on color
MOV EQUIPFLAG,AX ;Restore equipment flag
POP AX ;Do a mode set
PUSH AX
INT 10H ;To the video interrupt
;
OR EQUIPFLAG,MONO_FLAG ;Reset EQUIPFLAG to Monochrom
MOV AX,3 ;Do a 80x25 mode set
INT 10H
MOV AX,CS ;Set up segment for print
MOV DS,AX
MOV DX,OFFSET MODE_TXT
MOV AH,9
INT 21H ;Print first part of message
POP AX ;Get mode set
SAL AX,1 ;*2 for table lookup
MOV SI,AX ;Put into DX for printing
MOV DX,CS:[SI+OFFSET MODE]
MOV AH,9
INT 21H ;PRINT and return
RET
BAD:
MOV AX,CS ;Set up segment register
MOV DS,AX ;and address text
MOV DX,OFFSET ERM
MOV AH,9H ;PRINT STRING
INT 21H
RET ;END
MODE LABEL WORD ;TABLE FOR PRINTING CURRECT SET
DW OFFSET MODE0
DW OFFSET MODE1
DW OFFSET MODE2
DW OFFSET MODE3
DW OFFSET MODE4
DW OFFSET MODE5
DW OFFSET MODE6
MODE_TXT DB 'Graphics card initialized as $'
MODE0 DB '40x80 BW (power on default).',13,10,36
MODE1 DB '40x25 Color.',13,10,36
MODE2 DB '80x25 BW.',13,10,36
MODE3 DB '80x25 Color.',13,10,36
MODE4 DB '320x200 Color.',13,10,36
MODE5 DB '320x200 BW.',13,10,36
MODE6 DB '640x200 BW.',13,10,36
ERM DB 7,'Invalid format.',10,13
DB 'Correct format is: SCREEN n',10,13
DB '...where "n" is 0 - 6... 0 = 40x25 BW',10,13
DB ' 1 = 40x25 Color',10,13
DB ' 2 = 80x25 BW',10,13
DB ' 3 = 80x25 Color',13,13,10
DB ' -GRAPHICS MODES-',10,13
DB ' 4 = 320x200 Color',10,13
DB ' 5 = 320x200 BW',10,13
DB ' 6 = 640x200 BW',10,13,'$'
COLOR ENDP
CODE ENDS
END COLOR
START.BAS
5 'SAVE "C"
100 KEY OFF: CLS
200 WIDTH 80: DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20
210 WIDTH 40 :SCREEN 1: SCREEN 0: LOCATE ,,1,6,7
215 RUN"nextshow
TEST.BAS
10 PRINT CHR$(16)
WELCOME.BAS
5 REM welcome - calls elephant
10 DEFINT A-Z:KEY OFF:K=0:MN=0:Z=0
15 DEF SEG=&HB800
1100 GOSUB 60140
1200 SCREEN 1,0:COLOR 8,1:CLS
1201 EC=2:OC=2:X=20:Y=23:D$="WELCOME TO THE WORLD":GOSUB 60010
1202 X=125:Y=48:D$="OF THE":GOSUB 60010
1211 EC=3:OC=3:BC=4:X=24:Y=150:OS=128:D$="{}~ Personal Computer":GOSUB 60010
5000 REM this is RUNSHOW
5020 DIM FILE$(12):DIM FF(100)
5030 REM ***LOADING IN REQUIRED PICTURES***
5050 N=10
5060 FOR GRAB=1 TO N
5070 READ FILE$(GRAB)
5080 MEMDEL=GRAB*1024
5090 'memORY=8192-MEMDEL:REM 128K SYSTEM
5100 MEMORY=16384-MEMDEL:REM 256K SYSTEM
5110 GOSUB 6030 :REM LOAD FILE$(N) INTO LOCATION "MEMORY"
5120 NEXT
5130 RESTORE
5140 REM this is BASICMOV
5150 ' BASIC DEMO TO USE CALL FUNCTION
5160 ' USES AN ASSEMBLER SUBROUTINE TO MOVE
5170 ' UP TO 65535 BYTES IN MEMORY
5180 '******
5190 KEY OFF
5200 'DEFINE SEGMENT TO PLACE THE ASSEMBLER CODE
5210 DEF SEG=&H1200
5220 ' THIS TEST IF IT IS ALREADY LOADED, IF NOT IT LOADS IT
5230 BLOAD"mcode.%%%",0
5240 SUBRT = 0
5250 ' A% = THE FROM ADDRESS
5260 ' B% = THE TO ADDRESS
5270 ' C% = THE LENGTH TO MOVE
5280 GOSUB 5820:REM TURN ON COLOR SCREEN
5290 DISP=1:GOSUB 6290:REM DISPLAY "SELF"
5395 SCREEN 1,0:COLOR 1,0:K=0:MN=0:Z=0
5396 DEF SEG=&HB800
5400 OS=0:EC=2:OC=2:BC=3:X=90:Y=5:D$="GREETINGS!!":GOSUB 60010
5405 EC=2:OC=2:BC=1:X=30:Y=155:D$="I AM THE IBM PERSONAL":GOSUB 60010
5410 EC=2:OC=2:BC=1:X=30:Y=175:D$=" COMPUTER ":GOSUB 60010
5415 'EC=2:OC=2:BC=1:X=30:Y=155:D$=" ":GOSUB 60010
5417 FOR PAUSE=1 TO 2500:NEXT
5420 OS=0:EC=2:OC=2:BC=1:X=30:Y=5:D$=" I MADE THIS PICTURE ":GOSUB 60010
5425 EC=2:OC=2:BC=1:X=30:Y=155:D$=" THAT YOU NOW SEE ":GOSUB 60010
5430 EC=2:OC=2:BC=1:X=30:Y=175:D$=" WITH A TV CAMERA!! ":GOSUB 60010
5432 FOR PAUSE=1 TO 2500:NEXT
5435 OS=0:EC=2:OC=2:BC=1:X=30:Y=5:D$=" LET ME SHOW YOU ":GOSUB 60010
5436 EC=2:OC=2:BC=1:X=30:Y=155:D$=" SOME OF THE PICTURES ":GOSUB 60010
5437 EC=2:OC=2:BC=1:X=30:Y=175:D$=" THAT I HAVE TAKEN ":GOSUB 60010
5438 FOR PAUSE=1 TO 2000:NEXT
5440 DISP=2:GOSUB 6290
5445 FOR PAUSE=1 TO 2500:NEXT
5450 DISP=3:GOSUB 6290
5455 FOR PAUSE=1 TO 2500:NEXT
5460 DISP=4:GOSUB 6290
5465 FOR PAUSE=1 TO 2500:NEXT
5470 DISP=5:GOSUB 6290
5475 FOR PAUSE=1 TO 2500:NEXT
5480 DISP=6:GOSUB 6290
5485 FOR N=1 TO 25
5490 DISP=5:GOSUB 6290
5495 DISP=6:GOSUB 6290
5500 FOR PAUSE=1 TO 5:NEXT
5505 NEXT
5510 FOR PAUSE=1 TO 1000:NEXT
5515 DISP=7:GOSUB 6290
5520 FOR PAUSE=1 TO 2500:NEXT
5525 DISP=8:GOSUB 6290
5530 FOR PAUSE=1 TO 2500:NEXT
5535 DISP=9:GOSUB 6290
5540 FOR PAUSE=1 TO 2500:NEXT
5545 DISP=10:GOSUB 6290
5548 FOR PAUSE=1 TO 2500:NEXT
5550 CLS
5560 OS=0:EC=2:OC=2:BC=3:X=30:Y=5:D$="I CAN ALSO DO.........":GOSUB 60010
5565 EC=2:OC=2:BC=1:X=50:Y=35:D$=" - THINGS FOR WORK":GOSUB 60010
5575 EC=2:OC=2:BC=1:X=50:Y=65:D$=" - PLAY GAMES":GOSUB 60010
5580 EC=2:OC=2:BC=1:X=50:Y=95:D$=" - ANIMATED ARTWORK":GOSUB 60010
5581 FOR PAUSE =1 TO 2000:NEXT
5582 COLOR 1,0
5583 CLS
5584 OS=0:EC=1:OC=1:BC=2:X=70:Y=80:D$=" ":GOSUB 60010
5586 EC=1:OC=1:BC=2:X=70:Y=100:D$=" WATCH ME!!!! ":GOSUB 60010
5587 EC=1:OC=1:BC=2:X=70:Y=120:D$=" ":GOSUB 60010
5595 FOR PAUSE=1 TO 2500:NEXT
5800 RUN"pictdisp
5810 REM switch to color/graphics adapter
5820 DEF SEG=0
5830 POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
5840 DEF SEG
5850 LOCATE ,,1,6,7
5860 SCREEN 0
5870 WIDTH 40
5880 RETURN
6030 RUN "elephant
6040 DEF SEG=MEMORY
6050 S$="d:"+FILE$(GRAB)
6060 BLOAD S$,0
6070 RETURN
6080 DATA SELF.pic,DAVIS.PIC,TK01.PIC,REDROOS.PIC,PEACOCK1.PIC,PEACOCKF.PIC,BLUEPALM.PIC,HAMMCOL.PIC,SWALLOW1.PIC,IBM.PIC
6280 GOSUB 5820:REM TURN ON COLOR SCREEN
6290 DEF SEG=&H1200
6300 KEY OFF:SCREEN 1:COLOR 1,0
6310 'FOR DISP=1 TO N
6320 MEMDEL=DISP*1024
6330 'MEMORY=8192-MEMDEL:REM 128K SYSTEM
6350 MEMORY=16384-MEMDEL:REM 256K SYSTEM
6360 A%=MEMORY
6370 B%=&HB800
6380 C%=&H4000
6390 CALL SUBRT (A%,B%,C%):RETURN:'NEXT
60000 'SAVE"GCS",A 'GRAPHICS CHARACTER SUBROUTINES
60010 'DISPLAY STRING
60020 FOR I=1 TO LEN(D$):A=ASC(MID$(D$,I,1))
60030 IF OS=128 THEN IF A<>32 THEN A=A+128
60040 'DISPLAY CHARACTER
60050 LX=X+W(A):IF LX>WID THEN X=0:Y=Y+SH:GOTO 60050
60060 LY=Y+H(A):IF LY>200 THEN Y=0:X=0:GOTO 60050
60070 IF (X AND 1)=0 THEN SWAP EC,OC
60080 IF BC<4 THEN LINE(X,Y)-(LX-1,LY-1),BC,BF
60090 K=POINT(X,Y):PSET(X,Y),K:FOR K=0 TO 2:IF CHAR$(A,K)<>"" THEN DRAW CHAR$(A,K)
60100 NEXT K:IF (X AND 1)=0 THEN SWAP EC,OC
60110 X=LX:IF X+SW>WID THEN X=0:Y=Y+SH:IF Y+SH>200 THEN Y=0
60120 NEXT I:RETURN
60130 '
60140 'INITIALIZATION
60145 'GOSUB 5000:REM LOAD IN VIDEO IMAGES OF SELF,.......
60150 A=0:X=0:Y=0:LX=0:LY=0:EC=3:OC=3:BC=4:D$="":K=0:WID=320
60160 DIM CHAR$(255,2),H(255),W(255)
60170 'GET CHARACTER SET
60180 OPEN "ELEPH.EXE" FOR INPUT AS #1
60190 INPUT #1,DEC,H,W,K:IF DEC=0 THEN 60220
60200 FOR I=0 TO K-1:INPUT #1,D$:IF H(DEC)<>99 THEN CHAR$(DEC,I)=D$
60210 NEXT I:H(DEC)=H:W(DEC)=W:GOTO 60190
60220 CLOSE #1:SH=H:SW=W:H(32)=SH:W(32)=SW:RETURN
Directory of PC-SIG Library Disk #0015
Volume in drive A has no label
Directory of A:\
PCMAN BAS 7552 8-03-82
PATHMAN BAS 9344 8-07-82
DRAW EXE 640 6-17-82
DRAW ASM 884 6-17-82
SCREEN EXE 1280 6-19-82
COLOR EXE 640 5-29-82
MONO EXE 640 5-29-82
COLORDEM BAT 37 7-31-82
START BAS 256 7-31-82
WELCOME BAS 4224 7-31-82
LANDSEQ BAS 3584 6-10-82
FLYBY BAS 2688 6-10-82
MONSW BAS 2304 7-14-82
ELEPHANT BAS 3584 7-31-82
PRTGRAF BAS 1152 6-18-82
ESSXFADE BAS 1152 6-12-82
BLASTOFF BAS 3200 6-12-82
FINISH BAS 6144 7-31-82
NEXTSHOW BAS 3456 6-12-82
BUTTRFLY BAS 3712 7-31-82
SCREEN ASM 2636 6-19-82
TEST BAS 128 3-03-82
OTHDEMO BAS 6144 6-12-82
BLIMP BAS 1408 6-12-82
ELEPH EXE 18048
ELEPH DAT 8960
ADVLAND PIC 16512 5-31-82
FAMILYDA Y 4864 6-11-82
MCODE %%% 128 4-20-82
FILES015 TXT 1732 5-29-87 10:06a
30 file(s) 117033 bytes
34816 bytes free