Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50434/skim.f4
There are no other files named skim.f4 in the archive.
C SKIMMING, A LOOK AT 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 WRITTEN BY BOB FRIEDENTHAL
C
C FEBRUARY 25, 1972
C
C A DEMO OF PICTURE BOOK GRAPHICS
C
DIMENSION IARRAY(12)
DATA IARRAY/'A','B','C','D','E','F','G','H','I','J','K','L'/
CALL SCALE(0.,1023.,0.,1023.)
1000 CALL THEEND
DO 100 I=1,13
CALL CURSOR(0,1)
CALL CURSOR(-1,1)
100 CONTINUE
WRITE(5,1)
1 FORMAT('+','"SKIMMING"',//T21,'A LOOK AT PICTURE BOOK')
DO 109 I=1,20
CALL CURSOR(-1,0)
109 CONTINUE
DO 108 I=1,10
CALL CURSOR(1,0)
108 CONTINUE
CALL IOTA(1)
CALL HOLD(70)
WRITE(5,2)
2 FORMAT(1X,'FIRST LET''S START THE CLOCK TICKING USING,'//,
1 T20,'CALL IOTA(1)'//)
CALL IOTA(1)
CALL HOLD(50)
WRITE(5,1002)
1002 FORMAT(T20,'CALL IOTA(0)',//
1 1X,'RETURNS THE NUMBER OF TICKS THAT HAVE OCCURRED:'//)
CALL HOLD(40)
DO 101 I=1,10
J=IOTA(0)
WRITE(5,3),J
3 FORMAT(1X,T25,I5/)
101 CONTINUE
CALL HOLD(40)
WRITE(5,1003)
1003 FORMAT(//1X,'NEXT WE''LL SCALE THE SCREEN WITH,'//
1 T20, 'CALL SCALE(0.,1023.,0.,1023.)'//)
CALL HOLD(50)
WRITE(5,4)
4 FORMAT(//1X,'AND LAYOUT OUR BOOK'/)
CALL HOLD(40)
CALL LAYOUT(15,72,20,30,2,20,1,100,5,10,0)
WRITE(5,5)
5 FORMAT(1X,'USING,',//T20,'CALL LAYOUT(15,72,20,30'
1 ,',2,20,1,100,5,10,0)'//)
CALL HOLD (40)
WRITE(5,6)
6 FORMAT(1X,'THIS CREATES A BOOK CONSISTING OF:'//
1 T20,'15 LINES OF SCROLLING 72 CHARACTERS LONG',/
1T20,'20 PICTURES, 30 LINES LONG',/
1 T20,'2 FIGURES, 20 LINES LONG',/
1 T20,'1 GRAPH, 100 LINES LONG',/
1 T20,'5 TABLES, 10 LINES LONG, WITH ENGLISH CHARACTERS'//)
CALL HOLD (150)
WRITE(5,7)
7 FORMAT(1X,'AN 8K GT40 HAS ROOM FOR A BOOK 6000 INCHES LONG',/
1 1X, 'EACH LINE OF SCROLLING REQUIRES 44 INCHES',/
1 1X,'EACH PICTURE LINE TAKES 3 INCHES',/
1 1X,'ALL OTHER LINES TAKE 1 INCH EACH',/
1 1X,'THE MARGIN BETWEEN EACH PAGE TAKES 3 INCHES',/
1 1X,'AND EACH INDEX ENTRY (1 FOR EACH PAGE), TAKES 2 INCHES'//)
CALL HOLD (200)
WRITE(5,8)
8 FORMAT(1X,'INITIALLY PAGE 0 OF EACH PAGE TYPE IS OPEN',/
1 1X,'AND EACH PAGE''S MARKER POINTS TO LINE 0'//)
CALL HOLD (80)
WRITE(5,9)
9 FORMAT(1X,'IF WE DRAW AN ABSOLUTE POINT,'//
1 T20,'CALL DOT(100.,100.)'//)
CALL DOT (100.,100.)
CALL HOLD (40)
WRITE(5,10)
10 FORMAT(1X,'IT WILL ENTER PICTURE 0, LINE 0'//)
CALL HOLD (80)
WRITE(5,11)
11 FORMAT(1X,'THE MARKER FOR THAT PAGE WILL AUTOMATICALLY POINT',/
1 ' TO LINE 1'/)
CALL HOLD(60)
WRITE(5,111)
111 FORMAT(/1X,'TO RESET THE MARKER TO THE START OF THE PAGE,'//
1 T20,'CALL MARKP(0)'//)
CALL MARKP(0)
CALL HOLD(100)
WRITE(5,12)
12 FORMAT(1X,'IF WE THEN,',//T20,'CALL BITS(1,3,3,0)',//
1 1X,'WHICH SETS THE MODE OF THE PICTURE ENTRY TO:',//
1 T20,'BLINK',/
1 T20,'INTENSITY 3',/
1 T20,'DOTDASH',/
1 T20,'NON-LIGHT PEN SENSISTIVE,',///)
CALL BITS(1,3,3,0)
CALL HOLD (120)
WRITE(5,13)
13 FORMAT(1X,'WE CAN REPLACE THE DOT'
1 ' WITH A VECTOR OF THESE MODES USING,',//
1 T20,'CALL VECTOR(200.,200.)'//)
CALL VECTOR(200.,200.)
CALL HOLD (100)
WRITE(5,14)
14 FORMAT(1X,'TO CHANGE THE MODE OF FUTURE GRAPHICS TO'/,
1 1X,'NON-BLINK, INTENSITY 5, SOLID, ',
1 'LIGHT PEN SENSITIVE,'//
1 T20,'CALL BITS(0,5,0,1)'//)
CALL BITS (0,5,0,1)
CALL HOLD (100)
WRITE(5,15)
15 FORMAT(1X,'IF WE ISSUE A,'//
1 T20,'CALL VECFIG(0,0)'//)
CALL VECFIG(0,0)
CALL HOLD(60)
WRITE(5,16)
16 FORMAT(1X,'THIS SUB-PAGE CALL TO FIGURE 0 STARTING AT LINE 0',/
1 1X,'WILL TAKE ON THESE MODES'//)
CALL HOLD(50)
WRITE(5,17)
17 FORMAT(1X,'THEREFORE, ANYTHING WE DRAW IN FIGURE 0',/
1 1X,'WILL RESPOND TO LIGHT PEN HITS'//)
CALL HOLD (50)
WRITE(5,18)
18 FORMAT(T20,'CALL NOJOT(-40.,0.)',//
1 1X,'DRAWS AN INVISIBLE JOT IN FIGURE 0'//)
CALL NOJOT(-40.,0.)
CALL HOLD(50)
WRITE(5,19)
19 FORMAT(T20,'CALL ARC(80.,20,6.28,0.,.75)',//
1 1X,'DRAWS AN ELLIPSE OF DIAMETER 80., WITH 20 SIDES,'
1 1X,'A FULL 360 DEGREE ARC,',/
1 1X,'TILTED 0 DEGREES FROM THE HORIZONTAL,'/
1 1X,'WITH ITS Y DIAMETER 75 PERCENT OF ITS X DIAMETER'///)
CALL HOLD(40)
CALL ARC(80.,20,6.283,0.,.75)
CALL HOLD(160)
WRITE(5,20)
20 FORMAT(1X,'THE COORDINATES OF A LIGHT PEN HIT ON THIS ELLIPSE',/
1 1X,'WILL AUTOMATICALLY ENTER THE VECTOR IN PICTURE 0, LINE 0',/
1 1X,'MOVING IT AND, WITH IT, ALL THE NON-ABSOLUTE GRAPHICS',
1 ' THAT FOLLOW IT',//
1 1X,'TRY HITTING IT WITH THE LIGHT PEN'//)
CALL HOLD(80)
WRITE(5,21)
21 FORMAT(T20,'CALL LINEX(0,0)',//
1 1X,'WILL RETURN THE X COORDINATE OF PICTURE 0, LINE 0',//
1 1X,'AS THE ELLIPSE MOVES, WE CAN LIST '
1 'THE X COORDINATE OF ITS CENTER:',//)
CALL HOLD(90)
DO 103 I=1,15
J=LINEX(0,0)
WRITE(5,3),J
103 CONTINUE
CALL HOLD(80)
WRITE(5,22)
22 FORMAT(///T20,'CALL SET(400.,350.)'//
1 1X,'WILL DRAW AN INVISIBLE ABSOLUTE POINT',/
1 1X,'WHICH NEVER MOVES'//)
CALL SET(400.,350.)
CALL HOLD(90)
WRITE(5,23)
23 FORMAT(1X,'NOW WE CAN,'//
1 T20,'CALL TEXT (10,IARRAY)'//
1 1X,'WHICH WRITES 10 CHARACTERS FROM IARRAY INTO THE OPEN',
1 ' TABLE'//)
CALL TEXT(10,IARRAY)
CALL HOLD(80)
WRITE(5,24)
24 FORMAT(T20,'CALL TABLE (0,0)',//
1 1X,'DISPLAYS THEM, ALWAYS AS ITALICS'//)
CALL TABLE(0,0)
CALL HOLD(50)
WRITE(5,241)
241 FORMAT(1X,'USING THE CALL SET AND CALL TABLE,'/
1 1X,'WE CAN DISPLAY THIS TABLE FROM MANY PLACES ON THE SCREEN,'/
1 1X,'STARTING FROM ANY LINE IN THE TABLE'//)
CALL HOLD(50)
CALL SET(780.,600.)
CALL TABLE(0,2)
CALL HOLD(50)
CALL SET(700.,300.)
CALL TABLE(0,4)
CALL HOLD(50)
CALL SET (200.,300.)
CALL TABLE(0,6)
CALL HOLD(90)
WRITE(5,25)
25 FORMAT(T20,'CALL MARKT(8)',//
1 1X,'WILL POINT TABLE 0''S MARKER TO CHARACTER 8',/)
CALL MARKT(8)
CALL HOLD(50)
WRITE(5,26)
26 FORMAT(1X,'AND,'//
1 T20,'CALL TEXT(1,''+'')',//
1 1X,'WILL CHANGE THAT CHARACTER TO "+"',/)
CALL HOLD(90)
CALL TEXT(1,'+')
CALL HOLD(60)
WRITE(5,261)
261 FORMAT(1X,'WE CAN EXTEND THE TABLE BY CONTINUING TO',
1 ' WRITE IN IT'//)
CALL HOLD(40)
DO 2031 I=1,12
CALL TEXT(1,IARRAY(I))
2031 CONTINUE
CALL HOLD(60)
WRITE(5,27)
27 FORMAT(1X,'TO DRAW A GRAPH, WE''LL FIRST SET THE INCREMENT'/,
1 ' TO 20 USING,'//
1 T20,'CALL PLOT(-20)',//)
CALL PLOT (-20)
CALL HOLD(30)
WRITE(5,28)
28 FORMAT(1X,'THEN PLOT A FEW POINTS WITH,',//
1 T20,'CALL PLOT(N)',//)
DO 104 I=10,100,10
CALL PLOT(I+0)
104 CONTINUE
CALL HOLD(80)
WRITE(5,29)
29 FORMAT(1X,'AND DISPLAY IT ALONG THE X AXIS WITH,',//
1 T20,'CALL XGRAPH(0,0)',//)
CALL XGRAPH(0,0)
CALL HOLD(90)
WRITE(5,30)
30 FORMAT(1X,'CHANGING THE INCREMENT,'/)
DO 105 I=20,200,1
CALL PLOT(-I)
105 CONTINUE
WRITE(5,31)
31 FORMAT(1X,'AFFECTS ALL THE POINTS'//)
CALL HOLD(30)
WRITE(5,32)
32 FORMAT(1X,'SINCE WE NEVER CHANGED MODES,',/
1 1X,'THE TABLE AND THE GRAPH WILL RESPOND TO THE LIGHT PEN'//
1 1X,'TRY TOUCHING THE LIGHT PEN TO THE CHARACTERS'/)
CALL HOLD(100)
WRITE(5,33)
33 FORMAT(1X,'THE COORDINATES IN PICTURE 0, LINE 0 WILL CHANGE'//
1 1X,'PICTURE BOOK WILL ALSO SAVE THE PICTURE NUMBER AND LINE',/
1 1X,'OF THE LAST LIGHT PEN HIT'//)
CALL HOLD(60)
WRITE(5,34)
34 FORMAT(T20,'CALL HIT(N,M)',//
1 1X,'RETURNS THESE VALUES:'//)
CALL HIT(N,M)
WRITE(5,3)N,M
CALL HOLD(80)
WRITE(5,35)
35 FORMAT(//1X,'NOW LET''S DISABLE THE LIGHT PEN FOR FUTURE'
1 ,' GRAPHICS WITH,'//
1 T20,'CALL BITS(0,4,0,1)',//)
CALL BITS(0,4,0,1)
CALL HOLD(30)
WRITE(5,36)
36 FORMAT(1X,'AND ISSUE A CALL TO PICTURE 5, LINE 3 USING,'//
1 T20,'CALL PICTURE (5,3)',//)
CALL PICTUR(5,3)
CALL HOLD(50)
WRITE(5,37)
37 FORMAT(1X,'NOW IF WE OPEN THIS PAGE:',//
1 T20,'CALL OPENP(5)',//)
CALL OPENP(5)
CALL HOLD(30)
WRITE(5,38)
38 FORMAT(1X,'AND SET ITS MARKER TO 3 WITH,',//
1 T20,'CALL MARKP(3)',//)
CALL MARKP(3)
CALL HOLD(30)
WRITE(5,39)
39 FORMAT(1X,'A VECTOR WE DRAW USING,'//
1 T20,'CALL VECTOR(100.,0.)',//)
CALL VECTOR(100.,0.)
CALL HOLD(30)
WRITE(5,40)
40 FORMAT(1X,'WILL DISPLAY',///
1 1X,'IF WE CONTINUALLY RESET THE MARKER TO LINE 3,'/
1 1X,'AND REDRAW THE VECTOR,'//)
DO 106 I=1,100
CALL MARKP(3)
CALL VECTOR (ALOG10(FLOAT(I))*175.,
1 SIN(FLOAT(I)/5.)*100.)
106 CONTINUE
WRITE(5,41)
41 FORMAT(1X,'WE CAN ALTER ITS LENGTH AND DIRECTION',//)
CALL HOLD(50)
WRITE(5,42)
42 FORMAT(1X,'WE CAN ERASE PICTURE 5 BY SETTING THE MARKER TO 3',
1 ' AND ISSUING,'//
1 T20,'CALL ERASEP'//)
CALL HOLD(60)
CALL MARKP(3)
CALL ERASEP
CALL HOLD(20)
WRITE(5,43)
43 FORMAT(1X,'SIMILARLY WE CAN ERASE THE TABLE,'/)
CALL HOLD(20)
CALL MARKT(0)
CALL ERASET
WRITE(5,44)
44 FORMAT(1X,'THE GRAPH,'/)
CALL HOLD(20)
CALL MARKG(0)
CALL ERASEG
WRITE(5,45)
45 FORMAT(1X,'AND THE FIGURE',/)
CALL HOLD(20)
CALL MARKF(0)
CALL ERASEF
CALL HOLD(40)
WRITE(5,46)
46 FORMAT(1X,'TO ERASE PICTURE 0, WE OPEN IT WITH,',//
1 T20,'CALL OPENP(0)',//)
CALL OPENP(0)
CALL HOLD(40)
WRITE(5,461)
461 FORMAT(1X,'MARK IT WITH,',//T20,'CALL MARKP(0)',//)
CALL MARKP(0)
CALL HOLD(20)
WRITE(5,462)
462 FORMAT(1X,'THEN,'//
1 T20,'CALL ERASEP',//)
CALL OPENP(0)
CALL HOLD(20)
CALL ERASEP
CALL HOLD(40)
WRITE(5,47)
47 FORMAT(1X,'NOW LET''S STOP THE CLOCK:',//
1 T20,'CALL IOTA(-1)'//)
CALL HOLD(50)
WRITE(5,48)
48 FORMAT(1X,'TO RESET THE BOOK TO ITS ORIGINAL CONFIGURATION,'//
1 T20,'CALL THEEND',//)
CALL HOLD(60)
CALL THEEND
CALL IOTA(1)
CALL HOLD(40)
WRITE(5,49)
49 FORMAT(1X,'THE BOOK NOW SCROLLS 30 LINES,'/
1 1X,'HAS 1 FIGURE, 1 GRAPH, AND 1 TABLE EACH 1 LINE LONG',/
1 1X,'AND ENOUGH 100 LINE PICTURES',/
1 1X,'TO FILL THE REMAINING INCHES'//)
CALL HOLD (150)
WRITE(5,50)
50 FORMAT(1X,'THE PICTURE BOOK MANUAL DESCRIBES THE SUBROUTINES',
1 ' WE HAVE USED',/
1 1X,'AS WELL AS THE OTHERS AVAILABLE'//)
CALL HOLD(80)
WRITE(5,51)
51 FORMAT(1X,'NOW WE''LL START AGAIN FROM,'///)
CALL HOLD(60)
GOTO 1000
STOP
END
C HOLD, WAIT ROUTINE FOR SKIMMING
C
C DEC-11-GPBA-A-LA
C
C COPYRIGHT 1973
C DIGITAL EQUIPMENT CORPORATION
C MAYNARD, MASS. 01754
C
C WRITTEN BY BOB FRIEDENTHAL
C
C FEBRUARY 25, 1973
C
C HOLD WAITS THE NUMBER OF SECONDS SPECIFIED IN THE ARGUMENT
C AS COUNTED BY THE PDP-11/05'S CLOCK
C
SUBROUTINE HOLD(N)
J=IOTA(0)
1 K=IOTA(0)
DO 2 I=0,N*1000
2 CONTINUE
IF(K-J.LT.0)K=K+4095
C TEST FOR CLOCK WRAPAROUND
IF(K-J.LT.N*6)GOTO 1
RETURN
END