+acadiel Posted June 3, 2018 Share Posted June 3, 2018 I'll be putting tidbits from DC's HDD image (mostly BASIC programs or documents) in this thread as we find them. His whole drive dump, which Ksarul and I have, is 70 disks. For the first one, here's a name that you all should know. Assembly Object to XB Call Load converter by Paolo Bagnaresi. 1 ! ACE : Assembly Object to Extended Basic CALL LOADs Converter 8/3/1984 2 ! By Paolo Bagnaresi Tel.(02)-514.202 Address: 3 ! Via J.F. Kennedy 17 20097 San Donato Milanese (Milan)- Italy 10 GOTO 40 :: DIM STDEF$(100) :: D$,N$,F$,DEF$,PB$,SC$,RI$,CT$,L$,HEX$,H$,DSC$,DECC$,PROG$ 20 CALL LOAD :: CALL INIT :: CALL LINK :: CALL PEEK :: CALL CHAR :: CALL HCHAR :: CALL KEY 30 AUT,N,A,B,C,D,E,F,G,H,I,L,M,N,CT,MS,LS,DBM,DBL,FINELOC,LOC,INIZLOC,INDEF,NDEF,NLINK,NL,NLINE,NST,KY,ST,DEC,PO,Z 40 CALL CLEAR :: CALL SCREEN(16) :: FOR T=0 TO 14 :: CALL COLOR(T,13,16) :: NEXT T :: !@P- 50 CALL CHAR(128,"00282828",131,"000000FF") :: L$=RPT$(CHR$(131),28) :: H$="0123456789ABCDEF" :: CALL CLEAR 60 PB$="By Paolo Bagnaresi Via J..F.. Kennedy 17 20097 San Donato Milanese (Milan)- ITALY" 70 DISPLAY AT(1,1):L$:L$: : TAB (13);"ACE": : TAB (14);"by": TAB (7);"Paolo Bagnaresi": TAB (7);"Tel(02)-514..202":"San Donato Milanese-ITALY":L$ 80 DISPLAY AT(11,1): TAB (10);"Assembly": TAB (10);"Converter to": TAB (10);"Extended":L$ 90 DISPLAY AT(14,1):L$:"ACE converts the Object":"of an Assembly Program into":"an Extended Basic Program..":"The Assembly Program MUST be" 100 DISPLAY AT(19,1):"suitable for Extended Basic":"environment and MUST NOT":"contain any AORG..":L$ 110 DISPLAY AT(24,6) BEEP :"Press any key" 120 CALL KEY(0,KY,ST) :: IF ST=0 THEN 120 ELSE CALL CLEAR 130 DISPLAY AT(1,1):L$: TAB (5);"Are the Assembly":"Objects already loaded ?": :" Answer: (Y/N) N":L$ 140 ACCEPT AT(5,17) SIZE(-1) VALIDATE ("YN") BEEP :RI$ :: IF RI$="" THEN 50 ELSE IF RI$="Y" THEN CALL CLEAR :: GOTO 370 ELSE N$="1" :: CT$="Y" :: GOSUB 900 150 DISPLAY AT(6,1):L$:"Insert the diskette with the":"assembly object and enter":"the object progr.. name": :"Name : ";PROG$:L$ 160 DISPLAY AT(22,1):L$:"erase and press ENTER if you": TAB (9);"are through" 170 ACCEPT AT(11,9) SIZE(-10) BEEP :PROG$ :: IF PROG$="" THEN CALL CLEAR :: GOTO 320 180 DISPLAY AT(13,1):"Disk Drive ? (1-3) ";N$:L$ :: ACCEPT AT(13,20) SIZE(-1) VALIDATE ("123") BEEP :N$ :: IF N$="" THEN 130 190 ON ERROR 360 :: CALL LOAD("DSK"&N$&".."&PROG$) :: ON ERROR STOP 200 DISPLAY AT(15,1):"Do you want to check the":"loaded program ? (Y/N) ";CT$:L$ :: ACCEPT AT(16,24) SIZE(-1) VALIDATE ("YN") BEEP :CT$ :: IF CT$="N" THEN 150 210 DISPLAY AT(18,1):"Does the program come back":"to Extended Basic ? (Y/N) Y":L$ :: ACCEPT AT(19,27) SIZE(-1) VALIDATE ("YN") BEEP :SC$ 220 IF SC$="Y" THEN 240 ELSE FOR T=1 TO 10 :: DISPLAY AT(21,1) BEEP :"In this case no check":"is possible ":L$:L$ 230 FOR I=1 TO 100 :: NEXT I :: CALL HCHAR(21,1,32,96) :: NEXT T :: GOTO 150 240 CALL PEEK(8196,A,B) :: NST=0 :: INDEF=A*256+B :: FOR T=16376 TO INDEF STEP -8 :: NL=T :: GOSUB 870 :: NST=NST+1 :: STDEF$(NST)=DEF$ :: NEXT T 250 CALL CLEAR :: A=0 :: D$="1" 260 DISPLAY AT(1,1):L$:"List of DEFS to choose from":"for checking pourposes":L$ 270 FOR T=5 TO 20 STEP 2 :: FOR Z=1 TO 19 STEP 9 :: A=A+1 :: DISPLAY AT(T,Z) BEEP :A;STDEF$(A) :: IF A>=NST THEN 280 ELSE NEXT Z :: NEXT T 280 DISPLAY AT(T+1,1):L$ :: DISPLAY AT(20,1):L$:"DEF No.. ? (1 -";NST;") ":L$:"Press ENTER when finished":L$ :: ACCEPT AT(21,21) VALIDATE (DIGIT) SIZE(-2) BEEP $ :: IF D$<>"" THEN 340 290 CALL CLEAR :: DISPLAY AT(1,1):L$:"Are the programs loaded": :"so far OK.. ? (Y/N) Y":L$ :: ACCEPT AT(4,20) VALIDATE ("YN") SIZE(-1) BEEP :SC$ :: IF SC$="Y" THEN 320 300 DISPLAY AT(6,1):L$:"Unfortunately in this case": :"it's not possible to": :"eliminate just one program": :"but it's necessary to load" 310 DISPLAY AT(15,1):"all the program(s) all ": :"over again..": :"OK? (Y) Y":L$ :: ACCEPT AT(19,9) VALIDATE ("Y") SIZE(-1) BEEP :SC$ :: CALL INIT :: CALL CLEAR :: GOTO 150 320 DISPLAY AT(6,1):L$:"Are all the programs": :"loaded already ? (Y/N) Y":L$ :: ACCEPT AT(9,24) VALIDATE ("YN") SIZE(-1) BEEP :SC$ 330 IF SC$="N" OR SC$="" THEN CALL CLEAR :: GOTO 150 ELSE 370 340 A=VAL(D$) :: IF A>NST THEN 280 ELSE CALL LINK(STDEF$(A)) :: GOTO 250 350 ! Error handling 360 FOR T=1 TO 8 :: DISPLAY AT(20,1) BEEP :L$: TAB (6);"Drive error or": TAB (6);"Program name error":L$:L$ :: FOR I=1 TO 100 :: NEXT I :: CALL HCHAR(20,1,32,128) :: NEXT T :: RETURN 150 370 CALL CLEAR 380 ON ERROR 400 :: CALL PEEK(8194,A,B,C,D) :: FINELOC=A*256+B :: NL,INDEF=C*256+D :: GOSUB 870 :: IF ASC(DEF$)=255 THEN 400 ELSE INIZLOC=DBM*256+DBL 390 ON ERROR STOP :: GOTO 430 400 CALL CLEAR :: FOR I=1 TO 10 :: DISPLAY AT(10,1) BEEP :L$:L$:" The Assembly Programs": :" have not been loaded": : TAB (10);"LOAD THEM!":L$:L$ 410 FOR T=1 TO 100 :: NEXT T :: CALL HCHAR(12,1,32,160) :: NEXT I :: GOSUB 900 :: GOTO 150 420 !Disk-printing routine 430 CALL CLEAR :: GOSUB 790 :: IF F$="" OR N$="" THEN 32767 :: ON ERROR 840 :: GOSUB 920 :: OPEN #2:"DSK"&N$&".."&F$,VARIABLE 163 :: ON ERROR STOP :: N=0 440 !Address of the programmer 450 PRINT #2:CHR$(0)&CHR$(N)&CHR$(131)&CHR$(199)&CHR$(LEN(PB$))&PB$&CHR$(0) :: N=1 :: GOSUB 940 460 !Insert CALL INIT 470 PRINT #2:CHR$(0)&CHR$(N)&CHR$(157)&CHR$(200)&CHR$(4)&"INIT"&CHR$(0) :: N=2 :: LOC=INDEF :: GOSUB 940 480 ! DEFs name printing 490 FOR NDEF=INDEF TO 16376 STEP 8 500 PRINT #2:CHR$(0)&CHR$(N)&CHR$(157)&CHR$(200)&CHR$(4)&"LOAD"&CHR$(183)&CHR$(200)&CHR$(LEN(STR$(NDEF)))&STR$(NDEF); 510 FOR LOC=NDEF TO NDEF+6 STEP 2 520 CALL PEEK(LOC,MS,LS) :: PRINT #2:CHR$(179)&CHR$(200)&CHR$(LEN(STR$(MS)))&STR$(MS)&CHR$(179)&CHR$(200)&CHR$(LEN(STR$(LS)))&STR$(LS); 530 NEXT LOC 540 PRINT #2:CHR$(182)&CHR$(0) :: GOSUB 940 :: N=N+1 :: NEXT NDEF 550 !Print DEF pointer and FFALM 560 PRINT #2:CHR$(0)&CHR$(N)&CHR$(157)&CHR$(200)&CHR$(4)&"LOAD"&CHR$(183)&CHR$(200)&CHR$(LEN(STR$(8194)))&STR$(8194); 570 FOR LOC=8194 TO 8196 STEP 2 580 CALL PEEK(LOC,MS,LS) :: PRINT #2:CHR$(179)&CHR$(200)&CHR$(LEN(STR$(MS)))&STR$(MS)&CHR$(179)&CHR$(200)&CHR$(LEN(STR$(LS)))&STR$(LS); 590 NEXT LOC 600 PRINT #2:CHR$(182)&CHR$(0) :: GOSUB 940 :: N=N+1 :: LOC=9460 610 ! Main program printing 620 PRINT #2:CHR$(0)&CHR$(N)&CHR$(157)&CHR$(200)&CHR$(4)&"LOAD"&CHR$(183)&CHR$(200)&CHR$(LEN(STR$(LOC)))&STR$(LOC); 630 FOR LOC=LOC TO LOC+20 STEP 2 640 IF LOC>FINELOC THEN 670 :: CALL PEEK(LOC,MS,LS) :: PRINT #2:CHR$(179)&CHR$(200)&CHR$(LEN(STR$(MS)))&STR$(MS)&CHR$(179)&CHR$(200)&CHR$(LEN(STR$(LS)))&STR$(LS); 650 NEXT LOC 660 PRINT #2:CHR$(182)&CHR$(0) :: GOSUB 940 :: N=N+1 :: IF LOC<=FINELOC THEN 620 ELSE 680 670 PRINT #2:CHR$(182)&CHR$(0) :: GOSUB 940 680 N=N+1 690 ! CALL LINK printing 700 FOR NLINK=INDEF TO 16376 STEP 8 :: NL=NLINK :: GOSUB 870 710 PRINT #2:CHR$(0)&CHR$(N)&CHR$(157)&CHR$(200)&CHR$(4)&"LINK"&CHR$(183)&CHR$(199)&CHR$(LEN(DEF$))&DEF$&CHR$(182)&CHR$(0) :: GOSUB 940 720 N=N+1 :: NEXT NLINK 730 PRINT #2:CHR$(255)&CHR$(255) :: CLOSE #2 740 CALL CLEAR :: DISPLAY AT(5,1) BEEP :L$:"The assembly program ";DEF$: :"has been recorded as a": :"DIS/VAR 163 file.. The name": :"of this file is ";F$:L$ 750 DISPLAY AT(14,1):"You can MERGE this file": :"and obtain an Ext..B..Program":L$:"Execute now in command mode:": :">NEW":">MERGE DSK";N$;"..";F$ 760 FOR T=1 TO 70 :: DISPLAY AT(23,1) BEEP :">SAVE DSK";N$;"..";SEG$(F$,1,LEN(F$)-3)&"EXT":L$ :: CALL KEY(0,KY,ST) :: IF ST<>0 THEN STOP 770 NEXT T :: END 780 ! Open file: disk drive & name selection 790 DISPLAY AT(1,1):L$:"Name of the last DEF":"of the assembly programs": :"loaded in memory : ";DEF$:L$ 800 F$=DEF$&"MRG" :: DISPLAY AT(8,1):L$:"proposed name for the file": :"Max 10 characters ";F$: :L$ :: ACCEPT AT(11,19) SIZE(-10) BEEP :F$ 810 IF F$="" THEN RETURN ELSE IF POS(F$," ",1)>0 OR POS(F$,"..",1)>0 THEN 800 820 DISPLAY AT(14,1):L$:"Disk Drive? (1-3) ";N$:L$ :: ACCEPT AT(15,19) VALIDATE ("123") SIZE(-1) BEEP :N$ :: RETURN 830 ! Sub file error 840 ON ERROR 850 :: CLOSE #2 850 RETURN 430 860 ! call peek DEF names 870 CALL PEEK(NL,E,F,G,H,I,L,DBM,DBL) :: DEF$=CHR$(E)&CHR$(F)&CHR$(G)&CHR$(H)&CHR$(I)&CHR$(L) 880 PO=POS(DEF$," ",1) :: IF PO>0 THEN DEF$=SEG$(DEF$,1,PO-1) :: RETURN ELSE RETURN 890 ! Sub CALL INIT once only 900 IF CT=1 THEN RETURN ELSE CALL INIT :: CT=1 :: RETURN 910 ! Sub # of necessary printings 920 NLINE=ABS(INT(-((FINELOC-9460)/22+(16384-INDEF)/4+3))) :: DISPLAY AT(17,1) BEEP :"The necessary Printing":"operations with Disk Drive": :"(max 172) will be";NLINE:L$ 930 IF NLINE>172 THEN FOR T=1 TO 10 :: FOR I=1 TO 90 :: NEXT I :: CALL HCHAR(23,1,32,32) :: DISPLAY AT(22,1) BEEP :L$:"OBJECT SIZE IS TOO LARGE":L$ :: NEXT T :: STOP ELSE RETURN 940 NLINE=NLINE-1 :: DISPLAY AT(21,1):L$:"# of printings yet to be":"executed will be";NLINE:L$ :: RETURN 2 Quote Link to comment Share on other sites More sharing options...
+acadiel Posted June 3, 2018 Author Share Posted June 3, 2018 And another fun one. Typewriter by Extended Software Company. 100 CALL CLEAR :: CALL CHAR(127,"186699A1A1996618") !COPYRIGHT 1981,82,83 EXTENDED SOFTWARE CO. 110 DISPLAY AT(12,2):"Extended Software Company":" 11987 Cedarcreek Drive":" Cincinnati, Ohio 45240" :: DISPLAY AT(23,2):". 1981 VERSION 3..6" :: C$="TYPWRITER" 114 FOR A=28 TO 11 STEP -1 :: B=B+1 :: CALL SOUND(-9,-5,5) :: DISPLAY AT(8,A):SEG$(C$,1,B) :: NEXT A :: !CALL INIT :: CALL LOAD(-31878):: NL=280 :: DIM A$(286) 120 !CALL INIT :: CALL LOAD(-31878):: NL=280 :: DIM A$(286) 122 NL=120 :: DIM A$(126) 130 CALL KEY(5,K,E) :: FOR Z=97 TO 131 :: READ Z$ :: IF Z<123 THEN CALL CHAR(Z,"0000"&Z$) ELSE M$(Z-122)=Z$ 150 NEXT Z :: F$=RPT$(" ",150) :: @,G0,G1,G2=1 :: G3=10 :: G4,G5=60 :: @2=2 :: @3=3 :: @4=4 :: @5=5 :: @6=6 :: @9=9 :: @A=21 :: @B=200 :: @0=20 :: FOR R=@ TO 12 :: CALL COLOR(R,@2, :: NEXT R 180 ON BREAK NEXT :: GOTO 500 :: CALL SCREEN :: CALL GCHAR :: CALL HCHAR :: CALL VCHAR :: CALL ERR 190 B$(@),D$,E$,G$,H$,I$,N$,P$,Q$,R$,S$,T$,W$,Z$="" :: _,C,D,F,G,H,I,J,L,M,N,O,P,Q,S,T,U,V,W,X=Y :: CO,D1,D2,L1,L3,LP,P1,P3,QQ,ST,SW=ZL 210 !@P- 500 CALL CLEAR :: CALL SCREEN(@5) :: ON ERROR 11000 510 DISPLAY AT(@3,@9):"TYPWRITER": : : TAB (@9);"MAIN MENU" :: FOR R=@ TO @6 :: DISPLAY AT(R+8,@):CHR$(R+48);"=";M$(R) :: NEXT R :: DISPLAY AT(18,@):"CHOICE?" :: R=18 :: N=6 :: GOSUB 10300 :: CALL CLEAR :: M=I :: DISPLAY AT(@,15):M$(M) 550 ON M GOTO 1000,2000,3000,4000,5000,7000 1000 V=@ :: GOSUB 10000 :: DISPLAY AT(@5,@):"CLEARING MEMORY..": : : :: FOR L=@ TO NL :: A$(L)="" :: NEXT L :: U,L=_ :: G$="" :: DISPLAY AT(@5,@):"" 1020 D=@2 1030 CALL SCREEN(@6) :: DISPLAY AT(@,@):M$(;INT(L/@0)+@,M$(@) :: FOR D=D TO @A :: U=U+@ :: DISPLAY AT(D,@):;:"^^^^^^^^^^^^^^^^^^^^^^^^^^^^" :: ACCEPT AT(D,@):A$(U) 1070 CALL KEY(_,K,E) :: IF A$(U)="" THEN U=U-@ :: IF K=11 THEN 8000 ELSE 500 1110 NEXT D :: IF U>NL-@ THEN V=7 :: GOSUB 10000 :: GOTO 4000 ELSE DISPLAY AT(22,@):"" :: L=L+20 :: GOTO 1020 2000 G=_ :: CALL SCREEN(7) :: V=@2 :: GOSUB 10000 :: T$=M$(@2) :: IF G$="" THEN N$="CS1" ELSE N$=G$ 2020 GOSUB 10200 :: G$=N$ 2100 OPEN #@:G$,INPUT,INTERNAL,FIXED 192 :: FOR L=@ TO NL STEP @6 :: INPUT #@:A$(L),A$(L+@),A$(L+@2),A$(L+@3),A$(L+@4),A$(L+@5) :: CALL KEY(_,K,E) :: IF K=13 OR A$(L)=M$(@9) THEN 2170 2150 S=INT((L+@4)/20+@) :: DISPLAY AT(23,@):"S=";S;"L=";(L+@5)-20*(S-@) :: NEXT L 2170 FOR L=MIN(NL,L+@5) TO @ STEP -@ :: IF A$(L)<>"" AND A$(L)<>M$(@9) THEN U=L :: GOTO 2190 2180 NEXT L 2190 FOR R=U+@ TO NL :: A$(R)="" :: NEXT R :: CLOSE #@ 2200 IF G=@6 THEN CALL SCREEN(2) :: L=@ :: GOTO 5140 ELSE 500 3000 D=@2 :: CALL SCREEN(@5) :: DISPLAY AT(@,@):"STARTING AT SCREEN#:" :: R=@ :: C=24 :: N=9 :: GOSUB 10310 :: L=@0*(I-@2) :: IF L>=U THEN 3000 ELSE CALL CLEAR :: DISPLAY AT(@,15):M$(@3) :: GOTO 8500 3010 GOSUB 10010 :: IF K>15 THEN 8500 ELSE 8000 4000 CALL SCREEN(13) :: T$=M$(4) :: IF G$="" THEN IF E$<>"" THEN N$=E$ ELSE N$="CS1" ELSE N$=G$ 4010 GOSUB 10200 :: E$=N$ :: OPEN #@:E$,OUTPUT,INTERNAL,FIXED 192 :: FOR L=@ TO U STEP @6 :: CALL KEY(_,K,E) :: IF K=13 OR A$(L)="" THEN 4200 4150 PRINT #@:A$(L),A$(L+@),A$(L+@2),A$(L+@3),A$(L+@4),A$(L+@5) :: S=INT((L+@4)/@0+@) :: DISPLAY AT(23,@):"S=";S;"L=";L+@5-@0*(S-@),L;"OF";U :: NEXT L 4200 PRINT #@:M$(@9),M$(@9),M$(@9),M$(@9),M$(@9),M$(@9) :: CLOSE #@ :: GOTO 500 5000 CALL SCREEN(@2) :: SW,G,O,L3,B=_ :: R$="N" :: C$,D$="" :: IF F=@2 THEN F=_ :: CLOSE #F 5010 DISPLAY AT(@5,@):"WHAT TYPE PRINTER?":"1=RS232,PIO OR TP":"2=SCREEN":"3=FORMAT FOR TI-WRITER":;:;:"CHOICE? ";G0 5020 R=11 :: C=10 :: N=@ :: GOSUB 5307 :: G0=I :: IF I=@3 THEN F=@2 :: G=@5 ELSE IF I=@2 THEN F=_ :: GOTO 5050 ELSE F=@2 :: IF P$="" THEN N$="RS232" ELSE N$=P$ 5040 T$=M$(@5) :: GOSUB 10200 :: P$=N$ 5050 DISPLAY AT(@5,@):;:;:;:"BEGIN AT SCREEN #:";G1:"LINE #:";G2 :: DISPLAY AT(10,@):"# OF SPACES IN MARGIN:";G3:"# OF CHARACTERS/LINE:";G4:"# OF LINES/PAGE:";G5 5070 R=8 :: C=20 :: N=@2 :: GOSUB 5307 :: IF I>@6 THEN 5070 ELSE G1,S=I 5075 R=@9 :: C=@9 :: GOSUB 5307 :: IF I>@0 THEN 5075 ELSE G2=I :: L=I+@0*(S-@) 5080 R=10 :: C=24 :: GOSUB 5307 :: IF I>79 THEN 5080 ELSE G3,A=I 5085 R=11 :: C=23 :: N=@3 :: GOSUB 5307 :: IF I>227 THEN 5085 ELSE G4,Z=I 5087 R=12 :: C=18 :: GOSUB 5307 :: G5,LP=I :: DISPLAY AT(@,15):M$(@5) :: IF F=@2 THEN IF G=_ AND POS(SEG$(P$,@,@3),"TP",@)=_ THEN OPEN #F:P$,VARIABLE 254,OUTPUT ELSE OPEN #F:P$,OUTPUT 5140 DISPLAY AT(@0,@):M$(@9):">HOLD DOWN SPACE BAR TO HALT":G$:;: 5150 FOR L=L TO U :: CALL KEY(0,K,E) :: IF A$(L)="" OR (E=@ AND K=13) THEN 5310 ELSE IF K=32 THEN 5308 5160 S$=A$(L) :: S=INT((L-@)/@0+@) :: DISPLAY AT(@,@):,M$(M):"S=";S;"L=";L-@0*(S-@),L;"OF";U 5170 IF SEG$(S$,@,@)="@" THEN 5360 5230 IF O=@2 THEN C$=C$&S$ ELSE IF O=@ OR C$="" THEN C$=C$&S$ :: O=_ ELSE C$=C$&" "&S$ 5240 IF LEN(C$)>Z-@ THEN GOSUB 5260 5250 NEXT L :: GOTO 5310 5260 FOR J=Z+@ TO @ STEP -@2 :: P=POS(C$," ",J) :: IF P>_ AND P<Z+@2 THEN 5290 5270 NEXT J :: P=Z :: GOTO 5290 5280 IF C$="" THEN RETURN ELSE IF LEN(C$)>Z THEN 5260 ELSE P=LEN(C$)+@ :: SW=@ 5290 D$=SEG$(F$,@,A+B)&SEG$(C$,@,P-@) :: IF SW=_ AND R$="Y" THEN P1=@ :: GOSUB 32000 5292 PRINT #F:D$ :: C$=SEG$(C$,P+@,254) :: SW=_ 5300 L3=L3+@ :: IF LEN(C$)>Z THEN 5280 ELSE IF F<>_ THEN DISPLAY AT(12,17):L3;"OF";LP 5302 IF L3>=LP THEN L3=_ :: GOSUB 10010 5305 RETURN 5307 ACCEPT AT(R,C) VALIDATE (DIGIT) SIZE(-N) BEEP :I$ :: IF I$="" THEN F=_ :: GOTO 500 ELSE I=VAL(I$) :: RETURN 5308 CALL KEY(_,K,E) :: DISPLAY AT(24,1):"HALTED - PRESS 'C' TO CONT.." :: IF E=1 THEN DISPLAY AT(24,1) :: GOTO 5150 ELSE 5308 5310 GOSUB 5280 :: IF F=@2 THEN F=_ :: CLOSE #@2 5320 GOTO 500 5360 W$=SEG$(S$,@2,@) :: W=POS("LPTCMNSAOJUD",W$,@) :: ON W GOTO 5400,5440,5460,5480,5490,5500,5510,5520,5530,5540,5560,5570 5400 GOSUB 5280 :: PRINT #F:"" :: GOSUB 5300 :: S$=SEG$(S$,@4,@B) :: GOTO 5170 5440 H$=SEG$(S$,@4,@B) :: DISPLAY AT(14,@):H$ :: ACCEPT AT(15,@) BEEP :S$ :: GOTO 5170 5460 Y=VAL(SEG$(S$,@3,@3))-@ :: IF O=_ THEN Y=Y-@ 5465 IF LEN(C$)<=Y THEN C$=C$&SEG$(F$,@,Y-LEN(C$)) ELSE GOSUB 5280 :: C$=SEG$(F$,@,Y) 5470 S$=SEG$(S$,7,@B) :: GOTO 5170 5480 C$=SEG$(F$,@,INT((Z-LEN(C$)+@)/@2))&C$ :: GOSUB 5280 :: S$=SEG$(S$,@4,@B) :: GOTO 5170 5490 GOSUB 5280 :: B=VAL(SEG$(S$,@3,@2)) :: Z=VAL(SEG$(S$,@6,@3)) :: S$=SEG$(S$,10,@B) :: GOTO 5170 5500 GOSUB 5280 :: S$=SEG$(S$,@4,@B) :: GOTO 5170 5510 Y=VAL(SEG$(S$,@3,@3)) :: C$=C$&CHR$(Y) :: S$=SEG$(S$,7,@B) :: GOTO 5170 5520 N$=SEG$(S$,@4,@B) :: G=@6 :: IF N$="R" THEN 2200 ELSE G$=N$ :: GOTO 2100 5530 O=@ :: S$=SEG$(S$,@4,@B) :: GOTO 5170 5540 S$=SEG$(S$,@4,@B) :: IF R$="Y" THEN R$="N" ELSE R$="Y" 5550 GOTO 5170 5560 PRINT #F:SEG$(F$,@,A+B)&C$&CHR$(13); :: C$="" :: S$=SEG$(S$,@4,@B) :: GOTO 5170 5570 S$=SEG$(S$,@4,@B) :: IF O=@2 THEN O=_ ELSE O=@2 5580 GOTO 5170 7000 V,X=6 :: GOSUB 10000 :: END 8000 CALL SCREEN(10) :: DISPLAY AT(@,15):"EDIT MODE" :: DISPLAY AT(23,@2):"""BEGIN""";" TO CONTINUE TEXT" :: IF A$(L+D-@)="" THEN 8450 8010 CALL HCHAR(D,@2,30) :: CALL KEY(_,K,E) :: CALL VCHAR(@2,@2,32,@0) :: IF K<@3 OR K>15 THEN 8010 8020 ON K-@3 GOTO 8200,8010,8010,8300,8010,8800,8400,8450,8500,500,8700,8600 8200 X=@6 :: CALL CLEAR :: Z=L+D-@2 :: ZL=L :: DISPLAY AT(@,14):"INSERT MODE" :: FOR I=@ TO @5 :: DISPLAY AT(16+I,@):A$(Z+I) :: IF (Z-@5+I)>_ THEN DISPLAY AT(I+@,@):A$(Z-@5+I) 8220 NEXT I :: FOR I=@ TO MIN(10,NL-U) :: ACCEPT AT(I+@6,@) SIZE(-28):B$(I) :: CALL KEY(_,K,E) :: IF B$(I)="" AND K<>10 THEN 8270 8260 NEXT I 8270 I=I-@ :: FOR L=U+I TO Z+I STEP -@ :: IF L-I<@ THEN 8290 8280 A$(L)=A$(L-I) :: NEXT L 8290 FOR J=@ TO I :: A$(J+Z)=B$(J) :: B$(J)="" :: NEXT J :: L=ZL :: U=U+I :: DISPLAY AT(@,@):M$(,M$(@2) :: GOSUB 10090 :: GOTO 8010 8300 Z=L :: U=U-@ :: FOR L=L+D-@ TO U+@2 :: A$(L)=A$(L+@) :: NEXT L :: L=Z :: GOSUB 10090 :: GOTO 8010 8400 IF A$(L+D)<>"" AND D<@A THEN D=D+@ :: CALL HCHAR(D,@2,30) :: CALL KEY(_,K,E) :: CALL VCHAR(@2,@2,32,@0) :: IF K=10 THEN 8400 ELSE IF K=11 THEN 8450 ELSE 8010 ELSE IF D=@A THEN 8500 ELSE 8010 8450 IF D>@2 THEN D=D-@ :: CALL HCHAR(D,@2,30) :: CALL KEY(_,K,E) :: CALL VCHAR(@2,@2,32,@0) :: IF K=11 THEN 8450 ELSE IF K=10 THEN 8400 ELSE 8010 ELSE 8600 8500 D=@2 :: IF L+40<U THEN L=L+@0 :: GOSUB 10090 ELSE 8530 8510 IF K>15 THEN 3010 ELSE 8010 8530 IF L+@0<U THEN L=L+@0 :: D2=U-L+@2 :: GOSUB 10100 8540 IF K>15 THEN 8700 ELSE 8010 8600 D=@A :: IF INT(L/@0)>_ THEN L=L-@0 :: GOSUB 10090 ELSE D=@2 8610 GOTO 8010 8700 L1=INT(U/@0)*@0 :: D,D2=U-L1+@2 :: IF L<INT(U/@0)*20-@0 THEN D2=@A 8710 L=L1 :: GOSUB 10100 :: DISPLAY AT(22,@):;:;:;: :: GOTO 1030 8800 L1=L+D-@ :: ACCEPT AT(D,@) SIZE(-28):A$(L1) :: GOTO 8400 10000 CALL CLEAR :: CALL SCREEN(7) :: DISPLAY AT(2,@):">>>>>>"&M$(V)&"<<<<<":;:;:"CAUTION!":"ANY DOCUMENT IN CONSOLE":"WILL BE ERASED!" 10010 DISPLAY AT(23,@) BEEP :" PRESS ANY KEY TO CONTINUE OR 'ENTER' FOR MAIN MENU" 10020 CALL KEY(_,K,E) :: IF E<>@ THEN 10020 ELSE IF K=13 THEN 500 ELSE DISPLAY AT(22,1):;:;:;: 10030 D=@2 :: RETURN 10090 D2=@A 10100 DISPLAY AT(@,@) SIZE(10):M$(;INT(L/@0)+@ :: FOR D1=@2 TO D2 :: DISPLAY AT(D1,@):A$(L+D1-@) :: NEXT D1 :: RETURN 10200 DISPLAY AT(@5,@):"ENTER NULL FOR MAIN MENU":;:;:;:;:;:;: :: DISPLAY AT(17,@):"OPEN #1:":N$:;:;:"ENTER DEVICE OPEN STATEMENT (CS1, DSK1..FILENAME, TP..E, RS232..BA=600..EC, ETC..)" 10208 ACCEPT AT(18,@) SIZE(-28) BEEP :N$ :: IF N$="" THEN 500 10220 DISPLAY AT(@5,@):"" :: DISPLAY AT(@0,@):;:M$(@9):;:;:; :: RETURN 10300 DISPLAY AT(R,@):"CHOICE?" :: C=11 10310 CALL SOUND(100,1569,_) :: CALL GCHAR(R,C,Q) 10320 CALL HCHAR(R,C,30) :: CALL KEY(_,K,E) :: CALL HCHAR(R,C,Q) :: IF E<>@ THEN 10320 10330 CALL HCHAR(R,C,K) :: IF K=13 THEN 500 ELSE I=K-48 :: IF I<@ OR I>N THEN 10300 ELSE RETURN 11000 CALL ERR(CO,Z,Z,Z) :: ON ERROR 11000 11010 DISPLAY AT(11,@): :"CODE=";CO:"SEE X-BASIC MANUAL, PAGE 217WE HAVE JUST ENCOUNTERED AN ERROR.. ": : :: INPUT "'ENTER' TO CONTINUE ":Q$ :: ON ERROR 11060 :: CLOSE #@ 11060 ON ERROR 11065 :: F=_ :: CLOSE #@2 11065 ON ERROR 11070 :: CLOSE #@B 11070 ON ERROR 11000 :: RETURN 500 12990 !@P+ 13000 DATA 000038484834,40407048483,000038404038,080838484834,0018243C2018,18282038202,38484838083 13010 DATA 202038242424,100030101038,10003010507,404050605048,301010101038,00006C545454,000078484848 13020 DATA 00003048483,70584870404,384848380808,00002830202,00182038083,101038101018,000048484834 13030 DATA 00002424281,000044545428,000028102828,00484830102,000038102038 13040 DATA DOCUMENT Mode,INPUT Document,CONTINUE Mode,SAVE Document,PRINT Document,LEAVE Program 13050 DATA MEMORY NEAR FULL,SCREEN#:,>HOLD DOWN 'ENTER' TO STOP< 32000 IF SEG$(D$,A+B+P1,@)=" " THEN P1=P1+@ :: GOTO 32000 ELSE P3=P1+A+B :: IF POS(D$," ",P3)=_ THEN RETURN 32010 IF LEN(D$)>=A+B+Z THEN RETURN ELSE P3=POS(D$," ",P3+@2) :: IF P3=_ THEN 32000 32020 D$=SEG$(D$,@,P3)&" "&SEG$(D$,P3+@,LEN(D$)) :: GOTO 32010 3 Quote Link to comment Share on other sites More sharing options...
+acadiel Posted June 3, 2018 Author Share Posted June 3, 2018 Pascal Directory from Extended Basic (P-Code?) by P.E. Schippnick 100 REM 8410110156 110 REM PASCAL DIRECTORY FROM EXTENDED BASIC *V2.0* 120 REM BY P.E.SCHIPPNICK POMONA, CA 91766 (714) 629-8956 130 ON ERROR 1080 140 CALL CHARPAT(76,A$) :: IF SEG$(A$,15,2)="00" THEN GOSUB 1270 150 DEVICE$="PIO" 160 CALL CLEAR 170 DISPLAY AT(12,7):"PASCAL DIRECTORY" 180 OPEN #1:"DSK1..",INPUT,RELATIVE,INTERNAL 190 INPUT #1:DISKNAME$,[1,[2,[3 200 IF [3<>0 THEN 240 210 INPUT #1:FILENAME$,[4,[5,[6 220 IF FILENAME$<>"PASCAL" OR [4<>1 OR [6<>128 THEN 240 230 CLOSE #1 :: GOTO 260 240 CLOSE #1 :: GOSUB 1170 250 GOTO 160 260 OPEN #1:"DSK1..PASCAL",INPUT,DISPLAY,FIXED 128,RELATIVE 270 INPUT "WANT A PRINTOUT? ":I$ :: IF I$="Y" OR I$="y" OR I$="YES" OR I$="yes" OR I$="Yes" THEN F=1 280 IF F=1 THEN PRINT "OUTPUT DEVICE? "&DEVICE$ 290 IF F=1 THEN ACCEPT AT(23,16) SIZE(-32) BEEP :DEVICE$ 300 IF DEVICE$="" THEN F=0 310 CALL CLEAR 320 IF F=1 THEN OPEN #2:DEVICE$ 330 CALL CLEAR 340 IF F=1 THEN IF DEVICE$="TP" THEN F=0 :: Q=2 350 I=1 :: DIM [$(7),DIRECORD$(76),TYPE$(7),MONTH$(11) 360 MONTH$(0)="JAN" :: MONTH$(1)="FEB" :: MONTH$(2)="MAR" :: MONTH$(3)="APR" :: MONTH$(4)="MAY" :: MONTH$(5)="JUN" :: MONTH$(6)="JUL" :: MONTH$(7)="AUG" 370 MONTH$(="SEP" :: MONTH$(9)="OCT" :: MONTH$(10)="NOV" :: MONTH$(11)="DEC" 380 TYPE$(1)="bad" :: TYPE$(2)="code" :: TYPE$(3)="text" :: TYPE$(4)="info" :: TYPE$(5)="data" :: TYPE$(6)="graf" :: TYPE$(7)="foto" 390 A=([5-31)*2 :: LINPUT #1,REC A:[$(0) 400 LINPUT #1:[$(1) 410 LINPUT #1:[$(2) 420 LINPUT #1:[$(3) 430 LINPUT #1:[$(4) 440 LINPUT #1:[$(5) 450 LINPUT #1:[$(6) 460 LINPUT #1:[$(7) 470 USED=ASC(SEG$([$(0),4,1)) 480 LAST=USED 490 BLOCKS=ASC(SEG$([$(0),15,1))*256+ASC(SEG$([$(0),16,1)) 500 NUMREC=ASC(SEG$([$(0),18,1)) 510 DIR$=SEG$([$(0),27,102) 520 FOR DIRLIST=0 TO NUMREC-1 530 DIRECORD$(DIRLIST)=SEG$(DIR$,1,26) 540 DIR$=SEG$(DIR$,27,255) 550 IF I=8 THEN 570 560 IF LEN(DIR$)<128 THEN DIR$=DIR$&[$(I) :: I=I+1 570 NEXT DIRLIST 580 REM 590 PRINT #Q: TAB (7);"PASCAL DIRECTORY": : 600 IF F=1 THEN PRINT #2: TAB (17);"PASCAL DIRECTORY": : 610 PRINT #Q:"VOLUME: ";SEG$([$(0),8,ASC(SEG$([$(0),7,1))) 620 IF F=1 THEN PRINT #2:"VOLUME: ";SEG$([$(0),8,ASC(SEG$([$(0),7,1))) 630 PRINT #Q:"filename"; TAB (16);"size"; TAB (21);"blk"; TAB (25);"type" 640 IF F=1 THEN PRINT #2:"filename"; TAB (18);"size"; TAB (27);"date"; TAB (36);"block"; TAB (42);"type" 650 FOR DIRLIST=0 TO NUMREC-1 660 YEAR=INT(ASC(SEG$(DIRECORD$(DIRLIST),25,1))/2) 670 YEAR$=SEG$("0"&STR$(YEAR),LEN(STR$(YEAR)),2) 680 DAY=INT(ASC(SEG$(DIRECORD$(DIRLIST),26,1))/16)+(ASC(SEG$(DIRECORD$(DIRLIST),25,1))-2*YEAR)*16 690 DAY$=SEG$("0"&STR$(DAY),LEN(STR$(DAY)),2) 700 MONTH=ASC(SEG$(DIRECORD$(DIRLIST),26,1))-INT(ASC(SEG$(DIRECORD$(DIRLIST),26,1))/16)*16 710 FIRST=ASC(DIRECORD$(DIRLIST))*256+ASC(SEG$(DIRECORD$(DIRLIST),2,1)) 720 IF FIRST>LAST THEN GOSUB 1010 730 FIRST$=SEG$(" "&STR$(FIRST),LEN(STR$(FIRST)),3) 740 LAST=ASC(SEG$(DIRECORD$(DIRLIST),3,1))*256+ASC(SEG$(DIRECORD$(DIRLIST),4,1)) 750 FILELEN=LAST-FIRST 760 USED=USED+FILELEN 770 FILELEN$=SEG$(" "&STR$(FILELEN),LEN(STR$(FILELEN)),3) 780 TYPE=ASC(SEG$(DIRECORD$(DIRLIST),6,1)) 790 NAMELEN=ASC(SEG$(DIRECORD$(DIRLIST),7,1)) 800 PRINT #Q:SEG$(DIRECORD$(DIRLIST),8,NAMELEN); TAB (17);FILELEN$; TAB (21);FIRST$; TAB (25);TYPE$(TYPE) 810 IF F=1 THEN PRINT #2:SEG$(DIRECORD$(DIRLIST),8,NAMELEN); TAB (19);FILELEN$; TAB (25);DAY$&"-"&MONTH$(MONTH-1)&"-"&YEAR$; TAB (37);FIRST$; TAB (42);TYPE$(TYPE)&"file" 820 CALL KEY(0,KEY,STATUS) :: IF STATUS<>0 THEN GOSUB 990 830 NEXT DIRLIST 840 FILELEN=BLOCKS-LAST 850 FILELEN$=SEG$(" "&STR$(FILELEN),LEN(STR$(FILELEN)),3) 860 FIRST$=SEG$(" "&STR$(LAST),LEN(STR$(LAST)),3) 870 PRINT #Q:"< unused >"; TAB (17);FILELEN$; TAB (21);FIRST$ 880 IF F=1 THEN PRINT #2:"< unused >"; TAB (19);FILELEN$; TAB (25);" "; TAB (37);FIRST$ 890 PRINT #Q: :: IF F=1 THEN PRINT #2: 900 PRINT #Q:"Blocks free:";BLOCKS-USED 910 IF F=1 THEN PRINT #2:"Blocks free:";BLOCKS-USED 920 PRINT #Q: :: IF F=1 THEN PRINT #2: 930 PRINT "press any key to continue press Q to quit" 940 CALL KEY(0,KEY,STATUS) :: IF STATUS=0 THEN 940 950 CLOSE #1 :: IF F=1 THEN CLOSE #2 :: F=0 960 IF Q=2 THEN CLOSE #2 :: Q=0 970 IF KEY<>81 AND KEY<>112 THEN 160 980 END 990 CALL KEY(0,KEY,STATUS) :: IF STATUS<1 THEN 990 1000 RETURN 1010 IF LAST=0 THEN RETURN 1020 FILELEN=FIRST-LAST 1030 FILELEN$=SEG$(" "&STR$(FILELEN),LEN(STR$(FILELEN)),3) 1040 FIRST$=SEG$(" "&STR$(LAST),LEN(STR$(LAST)),3) 1050 PRINT #Q:"< unused >"; TAB (17);FILELEN$; TAB (21);FIRST$ 1060 IF F=1 THEN PRINT #2:"< unused >"; TAB (19);FILELEN$; TAB (25);" "; TAB (37);FIRST$ 1070 RETURN 1080 CALL ERR(CODE,TYPE,SEVERITY,LINE) 1090 ON ERROR 1080 1100 IF LINE=180 OR LINE=260 THEN 1170 1110 IF LINE>=390 AND LINE<=460 OR LINE=190 OR LINE=210 THEN ERR=1 :: GOTO 1170 1120 IF LINE=320 THEN 1220 1130 CALL SOUND(300,150,0) 1140 PRINT "ERROR #"&STR$(CODE)&" IN LINE";LINE 1150 PRINT "see APPENDIX 'N' page 217" 1160 STOP 1170 PRINT "Please insert PASCAL disk in DRIVE 1" 1180 PRINT "press any key to continue" 1190 CALL KEY(0,KEY,STATUS) :: IF STATUS=0 THEN 1190 1200 IF ERR=1 THEN RUN 1210 RETURN 1220 PRINT "Please re-enter" 1230 PRINT "OUTPUT DEVICE? " 1240 ACCEPT AT(23,16) BEEP :DEVICE$ 1250 IF DEVICE$="" THEN RUN 1260 RETURN 1270 FOR J=65 TO 90 :: CALL CHARPAT(J,A$) :: A$="0000"&SEG$(A$,1,4)&SEG$(A$,7,4)&SEG$(A$,13,4) :: CALL CHAR(J+32,A$) :: NEXT J 1280 RETURN 3 Quote Link to comment Share on other sites More sharing options...
+Ksarul Posted June 3, 2018 Share Posted June 3, 2018 That last one looks like it is taking the directory data from a UCSD p-System disk and parsing it out to view it in Extended BASIC. I think I've seen mention of this program before, in an old issue of the USUS Newsletter. . . 2 Quote Link to comment Share on other sites More sharing options...
atrax27407 Posted June 3, 2018 Share Posted June 3, 2018 (edited) I used Typewriter for several years to print our UG newsletter on a thermal printer. Edited June 3, 2018 by atrax27407 Quote Link to comment Share on other sites More sharing options...
+Ksarul Posted June 3, 2018 Share Posted June 3, 2018 I actually have an original copy of the Typewriter program on cassette. . . Quote Link to comment Share on other sites More sharing options...
ti99iuc Posted June 3, 2018 Share Posted June 3, 2018 (edited) Nice to have the Dump to this package thanks ! Edited June 3, 2018 by ti99iuc 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.