From: hachti <hachti>
Date: Mon, 24 Dec 2007 07:07:08 +0000 (+0000)
Subject: *** empty log message ***
X-Git-Url: http://gitweb.hachti.de/?p=h316.git;a=commitdiff_plain;h=8eb8811723f247b223acf77c00171318fb1db645

*** empty log message ***
---

diff --git a/config/libs.config b/config/libs.config
new file mode 100644
index 0000000..ce5f3c5
--- /dev/null
+++ b/config/libs.config
@@ -0,0 +1,23 @@
+
+# Libraries used by fload, frun and fboot:
+LOAD_LIBS="\
+ $H316/lib/hachti/lib/hachti.lib\
+ $H316/lib/fortran/lib/math.lib\
+ $H316/lib/fortran/lib/math.lib\
+  $H316/lib/fortran/lib/math.lib\
+   $H316/lib/fortran/lib/math.lib\
+ $H316/lib/fortran/lib/flib1.lib\
+ $H316/lib/fortran/lib/flib2.lib\
+ $H316/lib/fortran/lib/flib3.lib\
+ $H316/lib/iolib/lib/io.lib\
+"
+
+#LOAD_LIBS="\
+# $H316/lib/hachti/lib/hachti.lib\
+# $H316/lib/fortran/lib/math.lib\
+# $H316/lib/fortran/lib/flib1.lib\
+# $H316/lib/fortran/lib/flib2.lib\
+# $H316/lib/fortran/lib/flib3.lib\
+# $H316/lib/iolib/lib/io.lib\
+#"
+
diff --git a/lib/hachti/Makefile b/lib/hachti/Makefile
index aedbe53..c24f3be 100644
--- a/lib/hachti/Makefile
+++ b/lib/hachti/Makefile
@@ -26,14 +26,15 @@ RECIPES=$(foreach recipe,$(shell ls $(RECIPE_DIR) | egrep "recipe$$" | grep -v C
 LIBS=$(foreach lib,$(basename $(notdir $(RECIPES))),$(LIB_DIR)/$(lib).lib)
 
 OBJECTS=$(shell cat $(RECIPES)|egrep -v '^[[:space:]]*(\#.*)*$$'|\
-                   grep $(OBJ_DIR)|sort -u)
+                   grep $(OBJ_DIR)| sort -u)
+#|sort -u		   
 
 OBJECT_FILES=$(foreach obj, $(MODULES), $(OBJ_DIR)/$(obj).obj)
 SOURCE_FILES=$(foreach obj, $(MODULES), $(SRC_DIR)/$(obj).asm)
 
 #************
 #tmp: 
-#	@echo $(OBJECT_FILES)
+#	@echo $(subst $$,\$$, $(OBJECTS))
 
 all: $(LIBS)
 
@@ -42,6 +43,7 @@ $(ORG_OBJDIR)/lastrun: $(ORG_LIBDIR)/*
 	@./buildlib.sh makeorg
 
 $(OBJECTS): $(OBJECT_FILES)
+	@#$(MAKE) $(subst $$,\$$,$?)
 
 $(OBJECT_FILES) : $(OBJ_DIR)/%.obj : $(SRC_DIR)/%.asm
 #	@echo Building: $(subst 	$$,\$$,$@)
@@ -51,15 +53,17 @@ $(OBJECT_FILES) : $(OBJ_DIR)/%.obj : $(SRC_DIR)/%.asm
 	@ cd $(OBJ_DIR) && $(LDC_COMMAND) $(notdir $(subst $$,\$$,$@))
 
 # $(ORG_OBJDIR)/lastrun
-$(LIBS):$(LIB_DIR)/%.lib: $(RECIPE_DIR)/%$(RECIPE_SUFFIX)  $(OBJECTS) 
+
+$(LIBS):$(LIB_DIR)/%.lib: $(RECIPE_DIR)/%$(RECIPE_SUFFIX)   $(OBJECTS)
 	@./buildlib.sh genlib $(RECIPE_DIR)/$(basename $(notdir $@))$(RECIPE_SUFFIX)
 
 src/font.asm:
 	@ln -sf $(shell pwd)/fonts/font_hp_charset0_2.asm $(shell pwd)/src/font.asm
 
 clean:
-	@rm -rf $(OBJ_DIR) $(LIB_DIR)  *.lst *.go src/font.asm *.obj *~ *.par
-	@./buildlib.sh clean
+	@rm -rf $(OBJ_DIR) $(LIB_DIR)  *.lst *.go src/font.asm *.obj *~ *.par \
+	$(SRC_DIR)/*~ $(RECIPE_DIR)/*~
+	@./buildlib.sh clean 
 
 .PHONY: clean all
 
diff --git a/lib/hachti/recipe/hachti.recipe b/lib/hachti/recipe/hachti.recipe
index 538301e..1ef6823 100644
--- a/lib/hachti/recipe/hachti.recipe
+++ b/lib/hachti/recipe/hachti.recipe
@@ -6,7 +6,6 @@ obj/PL$MV
 
 # Matrix operations
 obj/MATRIX
-obj/MATRIX
 
 # Low level pulse motion driver
 obj/PL$U
diff --git a/lib/hachti/src/matrix.asm b/lib/hachti/src/matrix.asm
index 0908793..812fd23 100644
--- a/lib/hachti/src/matrix.asm
+++ b/lib/hachti/src/matrix.asm
@@ -144,7 +144,7 @@
 *               JST     M$ROT
 *               DAC     MATRIX  MATRIX TO MODIFY
 *               DAC     ANGLE   RADIANT ANGLE
-* 
+*               DAC     0       FOR FORTRAN IV COMPATIBILITY 
 * 
 * M$SCLE: SCALE MATRIX
 * 
@@ -154,6 +154,7 @@
 *               JST     M$SCLE
 *               DAC     MATRIX  MATRIX TO MODIFY
 *               DAC     SCALE   SCALE FACTOR
+*               DAC     0       FOR FORTRAN IV COMPATIBILITY 
 * 
 *                
 ********************************************************************************
@@ -346,6 +347,7 @@ SCLE	DAC	**	SCALE MATRIX
 	STA	SX
 	STA	SY
 	IRS	SCLE	TALLY RETURN ADDRESS
+	IRS	SCLE	AGAIN
 *
 	CALL	L$22
 SM11	DAC	0
@@ -393,34 +395,45 @@ ROT	DAC	**	ENTRY
 	LDA*	ROT	GET MATRIX POINTER
 	STA	R111	M11, FIRST COPY
 	STA	R211	M11, SECOND COPY
+	STA	R311	M11, THIRD COPY
 	ADD	=2
 	STA	R112
 	STA	R212
+	STA	R312
+	STA	R412
 	ADD	=2
 	STA	R121
 	STA	R221
+	STA	R321
 	ADD	=2
 	STA	R122
 	STA	R222
+	STA	R322
 	IRS	ROT
+	LDA*	ROT
 	STA	RA1
 	STA	RA2
 	IRS	ROT
 	IRS	ROT
 * 
 * 
-	CALL	SINX1	FLOATING POINT SINE
+**** M11 CALCULATION
+* 
+	CALL	SIN	FLOATING POINT SINE
 RA1	DAC	**	POINTER TO ANGLE
-	LDA	='77
-	HLT
 	CALL	H$22	SAVE TO TMP1
 	DAC	TMP1
+*	CALL	L$22
+*	DAC	TMP1
 	CALL	M$22	MULTIPLY
 R112	DAC	**	M12
 	CALL	H$22	STORE TO TMP3
 	DAC	TMP3
-	CALL	COSX1	FLOATING POINT COSINE
-RA2	DAC	**	POINTER TO ANGLE
+* 
+*************************************
+* 
+	CALL	COS	FLOATING POINT COSINE
+RA2	DAC	**	POINTER TO ANGLE	
 	CALL	H$22	SAVE TO TMP2
 	DAC	TMP2
 	CALL	M$22	MULTIPLY
@@ -430,58 +443,90 @@ R111	DAC	**	M11
 	CALL	H$22	SAVE NEW M11 TO TMP3
 	DAC	TMP3
 * 
+* 
+* M12 CALCULATION
+* 
+* M12 = M12*COS(X)-M11*SIN(X)
+* 
+*  
 	CALL	L$22	LOAD SINE
 	DAC	TMP1
 	CALL	M$22	MULTIPLY
-R212	DAC	**	M12
+R211	DAC	**	M11
 	CALL	H$22	STORE TO TMP4
 	DAC	TMP4
 	CALL	L$22	LOAD COSINE
+	DAC	TMP2
 	CALL	M$22	MULTIPLY
-R211	DAC	**
-	CALL	S$22	SUBSTRACT
+R212	DAC	**
+* 
+	CALL	S$22	SUBSTRACT !!
 	DAC	TMP4
+* 
 	CALL	H$22	SAVE TO NEW M12
 R312	DAC	**
-	CALL	L$22	LOAD NEW M11 FROM TMP3
+*
+ 	CALL	L$22	LOAD NEW M11 FROM TMP3
+	DAC	TMP3
 	CALL	H$22	AND SAVE TO NEW M11
 R311	DAC	**
 * 
 * 
+* ******************************************
+* 
+* M21 CALCULATION
+* 
+* M21*COS(X)+M22*SIN(X)
+* 
+* M22*SIN(X) -> TMP3
+* M21*COS(X) - TMP3
+* 
+* 
+*    
 	CALL	L$22	LOAD SINE
+	DAC	TMP1
 	CALL	M$22	MULTIPLY
-R122	DAC	**	M12
+R122	DAC	**	M22
 	CALL	H$22	STORE TO TMP3
 	DAC	TMP3
-	CALL	H$22	LOAD COSINE
+	CALL	L$22	LOAD COSINE
 	DAC	TMP2
 	CALL	M$22	MULTIPLY
 R121	DAC	**	M11
 	CALL	A$22	ADD TMP3
 	DAC	TMP3
-	CALL	H$22	SAVE NEW M11 TO TMP3
+	CALL	H$22	SAVE NEW M21 TO TMP3
 	DAC	TMP3
+*
+* M22 CALCULATION
+* 
+* M22*COS(X)-M21*SIN(X)
+* 
 * 
+* 	JMP	NN	
 	CALL	L$22	LOAD SINE
 	DAC	TMP1
 	CALL	M$22	MULTIPLY
-R222	DAC	**	M12
+R221	DAC	**	M21
 	CALL	H$22	STORE TO TMP4
 	DAC	TMP4
 	CALL	L$22	LOAD COSINE
+	DAC	TMP2
 	CALL	M$22	MULTIPLY
-R221	DAC	**
+R222	DAC	**
 	CALL	S$22	SUBSTRACT
 	DAC	TMP4
-	CALL	H$22	SAVE TO NEW M12
+	CALL	H$22	SAVE TO NEW M22
 R322	DAC	**
-	CALL	L$22	LOAD NEW M11 FROM TMP3
-	CALL	H$22	AND SAVE TO NEW M11
+	CALL	L$22	LOAD NEW M21 FROM TMP3
+	DAC	TMP3
+	CALL	H$22	AND SAVE TO NEW M21
 R321	DAC	**
 * 
-* 
+*        
 	JMP*	ROT	RETURN.
-* 
+*
+R412	DAC	**
 *  
 ********************************************************************************
 *
@@ -502,25 +547,25 @@ R321	DAC	**
 *
 APII	DAC	**
 *
-	LDA*	APII
-	STA	MP11
-	ADD	=2
-	STA	MP12
-	ADD	=2
-	STA	MP21
-	ADD	=2
-	STA	MP22
-	IRS	APII
-*
-	LDA*	APII
-	STA	XP1
-	STA	XP2
-	IRS	APII
-	LDA*	APII
-	STA	YP1
-	STA	YP2
-	IRS	APII
-	IRS	APII
+	LDA*	APII	POINTER TO MATRIX
+	STA	MP11	STORE M11
+	ADD	=2	ADD 2
+	STA	MP12	STORE M12
+	ADD	=2	ADD 2
+	STA	MP21	STORE M21
+	ADD	=2	ADD 2
+	STA	MP22	STORE M22
+	IRS	APII	JUMP TO NEXT ARGUMENT (X)
+*
+	LDA*	APII	LOAD X VALUE
+	STA	XP1	STORE TO X-POINTER
+	STA	XP2	STORE TO X-POINTER
+	IRS	APII	JUMP TO NEXT ARGUMENT (Y)
+	LDA*	APII	LOAD Y VALUE
+	STA	YP1	STORE TO Y-POINTER
+	STA	YP2	STORE TO Y-POINTER
+	IRS	APII	CORRECT RETURN ADDRESS
+	IRS	APII	FOR FORTRANIV COMPATIBILITY
 	JST	APL	CALL REAL ROUTINE
 	JMP*	APII
 *	
diff --git a/lib/hachti/src/pl$mv.asm b/lib/hachti/src/pl$mv.asm
index 9d4f338..af93917 100644
--- a/lib/hachti/src/pl$mv.asm
+++ b/lib/hachti/src/pl$mv.asm
@@ -74,6 +74,7 @@
 	SUBR	PL$Y,Y
 	SUBR	PL$MAT,MTRX
 	SUBR	PL$SCL,SCLE
+	SUBR	PL$ROT,ROT
 	SUBR	PL$IDN,IDEN
 *
 *
@@ -85,64 +86,59 @@
 *
 LINE	DAC	0		DRAW A LINE FROM NEAR STARTING POINT
 	LDA*	LINE	X1
-	STA	X1P	
-	IRS	LINE
+	STA	X1
+	LDA*	X1
+	STA	X1	
+	IRS	LINE	
 	LDA*	LINE	Y1
-	STA	Y1P	
+	STA	Y1
+	LDA*	Y1
+	STA	Y1	
 	IRS	LINE
 	LDA*	LINE	X2
-	STA	X2P	
+	STA	X2
+	LDA*	X2
+	STA	X2	
 	IRS	LINE
 	LDA*	LINE	Y2
-	STA	Y2P	
+	STA	Y2
+	LDA*	Y2
+	STA	Y2	
 	IRS	LINE	TALLY RETURN ADDRESS
-	NOP
 	IRS	LINE	AGAIN FOR FORTRAN IV COMPATIBILITY
-	NOP
-*	
-	NOP
-	NOP
-	NOP
-*
-	CALL	M$APII
+* 
+* 
+	CALL	M$APLI
 	DAC	MTRX
-*	JMP	Y2P+2
-X2P	DAC	0
-Y2P	DAC	0
+	DAC	X1
 	DAC	0
-*
-	NOP
-	NOP
-	NOP
-*
-	CALL	M$APII
+* 
+	CALL	M$APLI
 	DAC	MTRX
-X1P	DAC	0
-Y1P	DAC	0
+	DAC	X2
 	DAC	0
-	NOP
-	NOP
-	NOP
 *
+* 
+* 
 	LDA	X
-	SUB*	X1P
+	SUB	X1
 	SPL		SKIP IF SIGN PLUS
 	TCA		TWO'S COMPLEMENT IF NEEDED
 	STA	D1
 	LDA	Y
-	SUB*	Y1P
+	SUB	Y1
 	SPL
 	TCA
 	ADD	D1
 	STA	D1
 *	
 	LDA	X
-	SUB*	X2P
+	SUB	X2
 	SPL		SKIP IF SIGN PLUS
 	TCA		TWO'S COMPLEMENT IF NEEDED
 	STA	D2
 	LDA	Y
-	SUB*	Y2P
+	SUB	Y2
 	SPL
 	TCA
 	ADD	D2
@@ -150,23 +146,23 @@ Y1P	DAC	0
 	JMP	D2BG	D2 IS BIGGER!
 	NOP
 *
-D1BG	LDA*	X2P	DIFFERENCE 1 IS BIGGER, SO START AT POINT X2,Y2
+D1BG	LDA	X2	DIFFERENCE 1 IS BIGGER, SO START AT POINT X2,Y2
 	STA	XA
-	LDA*	Y2P
+	LDA	Y2
 	STA	YA
-	LDA*	X1P
+	LDA	X1
 	STA	XB
-	LDA*	Y1P
+	LDA	Y1
 	STA	YB
 	JMP	WOKI	WORK!
 *
-D2BG	LDA*	X1P	DIFFERENCE 2 IS BIGGER, SO START AT POINT X1,Y1
+D2BG	LDA	X1	DIFFERENCE 2 IS BIGGER, SO START AT POINT X1,Y1
 	STA	XA
-	LDA*	Y1P
+	LDA	Y1
 	STA	YA
-	LDA*	X2P
+	LDA	X2
 	STA	XB
-	LDA*	Y2P
+	LDA	Y2
 	STA	YB
 *
 WOKI	LDA	X	TEST IF STARTING POINT IST CURRENT POSITION
@@ -196,21 +192,12 @@ NM1	CALL	PL$PD	WE ARE AT BEGINNING OF LINE
 	JST	RMOV	REAL MOVE
 	JMP*	LINE	END OF THE LINE :-)
 *
-*
-*X1P	DAC	0	ARGUMENT POINER TO X1
-*Y1P	DAC	0	ARGUMENT POINER TO Y1
-*X2P	DAC	0	ARGUMENT POINER TO X2
-*Y2P	DAC	0	ARGUMENT POINER TO Y2
-XA	DEC	0	REAL FIRST POINT X COORDINATE
-YA	DEC	0	REAL FIRST POINT Y COORDINATE
-XB	DEC	0	REAL SECOND POINT X COORDINATE
-YB	DEC	0	REAL SECOND POINT Y COORDINATE
-D1	DEC	0	ORTHOGONAL WAY LENGTH FROM CURRENT POS TO P1
-D2	DEC	0	ORTHOGONAL WAY LENGTH FROM CURRENT POS TO P2
 *	
 *
 ********************************************************************************	
 *
+**** MOVE PEN ROUTINE
+* 
 RST	DAC	**	SET POINT ZERO
 	CRA
 	STA	Y
@@ -362,9 +349,21 @@ SCLE	DAC	**
 	CALL	M$SCLE
 	DAC	MTRX
 FCTR	DAC	0
-	NOP
-	NOP
-	JMP*	SCLE	
+	DAC	0
+	JMP*	SCLE
+* 
+* 
+* 
+* 
+ROT	DAC	**
+	LDA*	ROT
+	STA	FCR2
+	IRS	ROT
+	CALL	M$ROT
+	DAC	MTRX
+FCR2	DAC	0
+	DAC	0
+	JMP*	ROT
 *
 *
 ********************************************************************************
@@ -411,9 +410,21 @@ STPX	DAC	**	X STEP ROUTINE
 STPY	DAC	**	Y STEP ROUTINE
 DIYP	DAC	**	DIAGONAL X-DIR+UP STEP ROUTINE
 DIYN	DAC	**	DIAGONAL X-DIR+DOWN STEP ROUTINE
-TMP	DAC	**	UNIVERSAL POINTER
 *
-*			GLUE IN THE MOVEMENT
+X1	DEC	0	LINE START POINT, X
+Y1	DEC	0	LINE START POINT, Y
+X2	DEC	0	LINE END POINT, X
+Y2	DEC	0	LINE END POINT, Y
+* 
+XA	DEC	0	REAL FIRST POINT X COORDINATE
+YA	DEC	0	REAL FIRST POINT Y COORDINATE
+XB	DEC	0	REAL SECOND POINT X COORDINATE
+YB	DEC	0	REAL SECOND POINT Y COORDINATE
+D1	DEC	0	ORTHOGONAL WAY LENGTH FROM CURRENT POS TO P1
+D2	DEC	0	ORTHOGONAL WAY LENGTH FROM CURRENT POS TO P2
+* 
+**** GLUE IN THE MOVEMENT ROUTINES
+* 
 MU	XAC	PL$U
 MD	XAC	PL$D
 ML	XAC	PL$L
diff --git a/programs/Makefile b/programs/Makefile
index 936d4d2..bf806aa 100644
--- a/programs/Makefile
+++ b/programs/Makefile
@@ -1,6 +1,6 @@
 
 MODULES=first-steps  fortran  mandelbrot  plotter\
-        punchomat  small-things  tools
+        punchomat  small-things  tools libtest
 
 
 %:
diff --git a/programs/libtest/Makefile b/programs/libtest/Makefile
index ecbc0a4..b905399 100644
--- a/programs/libtest/Makefile
+++ b/programs/libtest/Makefile
@@ -19,6 +19,6 @@ $(BUILD_DIR)/%.obj:$(SRC_DIR)/%.asm
 	$(ASM_CMD) $< $(LISTING)&& mv $(notdir $(basename $<)).obj $(BUILD_DIR)
 
 clean :
-	@rm -rf *.obj $(BUILD_DIR)/ *.lst *.go *.par
+	@rm -rf *.obj $(BUILD_DIR)/ *.lst *.go *.par $(SRC_DIR)/*~
 
 .PHONY: default clean
diff --git a/programs/libtest/src/matrix-test.f b/programs/libtest/src/matrix-test.f
index d7ad4a7..0c9db33 100644
--- a/programs/libtest/src/matrix-test.f
+++ b/programs/libtest/src/matrix-test.f
@@ -8,23 +8,29 @@ C
       INTEGER J
       DIMENSION J(2)
       
-      A(1)=10.0
-      A(2)=1.22
-      A(3)=23.0
-      A(4)=1.5
-
-      Z=1.0
+C      A(1)=10.0
+C      A(2)=1.22
+C      A(3)=23.0
+C      A(4)=1.5
 
+      Z=1.7070
+      Z=1.557
       CALL M$INIT(A)
       CALL M$INIT(B)
       CALL M$INIT(C)
-
  10   FORMAT (9HMATRIX A:)
  11   FORMAT (9HMATRIX B:)
  12   FORMAT (9HMATRIX C:)
       
-C      CALL M$ROT(A,3.141)
+
+C      A(1)=1.0
+C      A(2)=2.0
+C      A(3)=3.0
+C      A(4)=4.0
+
       WRITE (1,10)
+      CALL PMAT(A)
+      CALL M$ROT(A,Z)
       CALL PMAT (A)
       PAUSE 4
 C      A(1)=1.0
@@ -85,7 +91,7 @@ CCCCCCCCCCCCCCCCCCCCCCC
       WRITE (1,343) MATRIX
       WRITE (1,344)
 
- 343  FORMAT(2H[ ,F17.9,2X,F17.9,2H ])
+ 343  FORMAT(2H[ ,F18.10,2X,F18.10,2H ])
  344  FORMAT(X)
 
       RETURN
diff --git a/programs/libtest/src/plotter-matrix.f b/programs/libtest/src/plotter-matrix.f
new file mode 100644
index 0000000..d4dff8f
--- /dev/null
+++ b/programs/libtest/src/plotter-matrix.f
@@ -0,0 +1,101 @@
+C PLOTTING MATRIX TEST!
+C
+C
+      INTEGER DD(100)
+      INTEGER FF
+C
+      WRITE (1,100)
+ 100  FORMAT (5HHALLO)
+C
+      CALL PL$RST
+      CALL PL$IDN
+C
+ 
+
+C      CALL BOX(0,0)
+      CALL PL$LN(0,0,0,100)
+      CALL PL$LN(50,0,50,100)
+      
+      CALL PL$PU
+      CALL PL$MV(0,-120)
+      CALL PL$RST
+      CALL PL$SCL(0.5)
+      CALL PL$LN(0,0,0,100)
+      CALL PL$LN(50,0,50,100)
+      CALL PL$LN(100,0,100,100)
+      CALL PL$PU
+      
+C      CALL PL$SCL(0.5)
+C      CALL BOX(0,0)
+            
+C      CALL PL$LN(0,-20,0,20)
+C      CALL PL$LN(-20,0,20,0)
+C      CALL PL$LN(20,20,-20,-20)
+C      CALL PL$LN(-20,20,20,-20)
+C      CALL PL$PU
+C      CALL PL$MV(0,22)
+C       CALL PL$TXT(12HLochstreifen,12)
+C      CALL PL$LN(0,-20,0,20)
+C      CALL PL$LN(-20,0,20,0)
+C      CALL PL$LN(20,20,-20,-20)
+C      CALL PL$LN(-20,20,20,-20)
+C      CALL PL$PU
+C      CALL PL$MV(0,22)
+C      CALL PL$TXT(7HPhilipp,7)
+C      CALL PL$MV(0,-100)
+C      CALL PL$RST
+
+C     ALL PL$PU
+      CALL PL$MV(0,0)
+C      CALL PL$TXT(18HText auf der Linie,18)
+C      CALL PL$LN(0,16,18*8,16)
+C      CALL PL$LN(18*8,16,18*8,0)
+C      CALL PL$TXT(8Habc  ZZZ,5)
+C      CALL PL$TXT(7HPHILIPP,7)
+
+C 2    CALL PL$MV (0,-70)
+ 9999 CALL REBOOT
+
+ 2000 END
+      
+      FUNCTION RAD(RIN)
+      INTEGER RIN
+      REAL RINF,ROUT
+      REAL RAD,PI
+      PI=3.1416
+
+      RINF=RIN
+      ROUT = (RINF/180.0)*PI
+      RAD=ROUT
+      RETURN
+      END
+
+      SUBROUTINE BOX(X,Y)
+      INTEGER X,Y
+      CALL PL$LN(X     ,Y    ,X    ,Y+100)
+      CALL PL$LN(X     ,Y+100,X+100,Y+100)
+      CALL PL$LN(X+100 ,Y+100,X+100,Y  )
+      CALL PL$LN(X     ,Y    ,X+100 ,Y  )
+      CALL PL$PU
+      RETURN
+      END
+
+      SUBROUTINE OOPS
+      
+      CALL      PL$PU
+      CALL      PL$MV(100,0)
+      CALL      PL$PD
+      
+      DO 2345 N=1,850
+      CALL PL$SCL(0.99)
+      CALL PL$ROT(RAD(10))
+      CALL PL$MV(100,0)
+ 2345 CONTINUE
+      CALL PL$PU
+      CALL PL$MV(0,0)
+ 22   RETURN
+ 23   END
+
+
+$0
+