Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C	PICLET, A LITTLE LANGUAGE FOR PICTURE BOOK.

C
C	DEC-11-GPBAA-B-LA
C
C	COPYRIGHT (C) 1974
C	DIGITAL EQUIPMENT CORPORATION
C	MAYNARD, MASSACHUSETTS 01754

C	THE INFORMATION IN THIS SOURCE LISTING IS SUBJECT TO
C	CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A
C	COMMITTMENT BY DIGITAL EQUIPMENT CORPORATION.
C	DIGITAL EQUIPTMENT CORPORATION ASSUMES NO RESPONSIBILITY
C	FOR ANY ERRORS THAT MAY APPEAR IN THIS LISTING.

C	THIS SOFTWARE IS FURNISHED TO THE PURCHASER
C	UNDER A LICENSE FOR USE ON A SINGLE COMPUTER 
C	SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S
C	COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS
C	MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.

C	DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
C	FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT 
C	THAT IS NOT SUPPLIED BY DIGITAL.
C		
C
C
C	R. FRIEDENTHAL
C
C	EDIT 1, 2/23/73


C	PICLET CONVERTS ID LETTERS AND NUMERIC DATA FROM THE KEYBOARD
C	TO A STRING OF CODE WHICH PICTURE BOOK UNDERSTANDS.
C	IT SENDS THE STRING USING OUTCH, THE ASSEMBLY LANGUAGE
C	OUTPUT ROUTINE.


	DIMENSION IARGS(100)
	EQUIVALENCE (ID,IARGS(2)),(ID2,IARGS(3))
	DATA IARGS(1)/4/
	CALL SCALE(0.,1023.,0.,1023.)
C			SCALE FOR ARC ROUTINE
1	TYPE 101
101	FORMAT (1X,'NEXT',/)
	ACCEPT 102,ID
999	FORMAT(1X,O12)
	ID=((ID/2**29).AND."177)
C			FOR NEGATIVE CHARACTERS, PLAY WITH TWO'S COMP
	IF(ID.GE.64)ID=ID-1
102	FORMAT (A1)
	GOTO(10,10,12,20,22,24,10,10,70,10,16,10,10,22,16,14,10,28,26,
	1 22,10,70,22,26,80,80,18),ID-63
	IF(ID.NE.40)GOTO 1
C			GO ON ANY OTHER LETTER EXCEPT (
	DO 90 I=2,6
C			GET ARC'S ARGUMENTS
	ACCEPT 104,IARGS(I)
90	CONTINUE
	D=FLOAT(IARGS(2))
	TH=(FLOAT(IARGS(4))/180.)*3.1415
	PH=(FLOAT(IARGS(5))/180.)*3.1415
	FR=FLOAT(IARGS(6))/100.
	CALL ARC(D,IARGS(3),TH,PH,FR)
	GOTO 1
10	N=1
C	A,K,L,I,P,F,G,T
	GOTO 30
12	N=4
C	B
	GOTO 30
14	N=11
C	O
	GOTO 30
16	N=2
C	J OR N
	GOTO 30
18	N=1
C	Z
	GOTO 40
20	ACCEPT 102,ID2
	ID2=((ID2/2**29).AND."177)
	IF(ID2.GE.64)ID2=ID2-1
	ACCEPT 103,IARGS(4),IARGS(5)
103	FORMAT (I,/I)
	M=5
C	C
	GOTO 50
22	N=2
C	V,D,M,S
	GOTO 40
24	ACCEPT 102,ID2
	ID2=((ID2/2**29).AND."177)
	IF(ID2.GE.64)ID2=ID2-1
	M=3
C	E
	GOTO 50
26	M=2
C	R OR W (W DOESN'T WAIT,THOUGH)

	GOTO 50
28	ACCEPT 104,ID2
C			GET NUMBER OF CHARACTERS TO READ
	M=ID2+3
	DO 29 I=4,M
	ACCEPT 102,J
	J=(J/2**29).AND."177
	IF(J.GE.64)J=J-1
	IARGS(I)=J
C			  THE INPUT CHARACTER
29	CONTINUE
	GOTO 50
30	DO 31 I=1,N
	ACCEPT 104,IARGS(I+2)
104	FORMAT (I)
31	CONTINUE
	IF(ID.EQ.79)IARGS(4)=IARGS(4)/2
C			DIVIDE CHARACTER ARGUMENT TO OPEN BY 2
	M=N+2
	GOTO 50
40	DO 41 I=1,N
	ACCEPT 104,IBYTE
	IBYTE=IBYTE.AND."37777
	IHIBY=IBYTE/128
	IARGS(I*2+1)=IHIBY
	IARGS(I*2+2)=IBYTE-(IHIBY*128)
41	CONTINUE
	M=N*2+2
	GOTO 50
50	DO 51 I=1,M
C	TYPE 999,IARGS(I)
	CALL OUTCH(IARGS(I))
51	CONTINUE
	IF(ID.EQ.79.OR.(ID.EQ.64.AND.IARGS(3).EQ.0))GOTO 71
C			GO IF LAYOUT OR TIME RETURNED
	GOTO 1
70	CALL OUTCH(4)
C			H OR W
	CALL OUTCH(ID)
73	READ(5,106)I
	TYPE 105,I
106	FORMAT(O12)
71	READ(5,106)J
	TYPE 105,J
105	FORMAT(1X,I5)
	GOTO 1
80	ACCEPT 104,IARGS(3)
	ACCEPT 104,IARGS(4)
	DO 81 I=1,4
	CALL OUTCH(IARGS(I))
81	CONTINUE
	GOTO 71
CC82	CALL INCH(I)
C	CALL INCH(J)
	J=I*128+J
	IF(J.GT.8192)J=8192-J
	GOTO 71
	STOP
	END