****** USAGE
*
* JST PCHAR
-* DAC Arg1
+* DAC Arg1-Addr
*
*
*
export MAKE
-MODULES = o$$al o$$la o$$pl o$$pb i$$pa pl$$up
+MODULES = o$$al o$$la o$$pl o$$pb i$$pa pl$$u pl$$mv
FRTN_COMMAND = frtn_original
ASM_COMMAND = asm_original
#org/O$AH Original ASR listing routine
#org/O$AH
-obj/PL$UP
+obj/PL$MV
+obj/PL$U
--- /dev/null
+* (PL$MV) REV 1.0 INCREMENTAL PLOTTER ROUTINES
+*
+*
+* PROGRAM TITLE:
+* PL$MV (PL$MV,PL$RST)
+*
+* PLOTTER MOVEMENT ROUTINES
+*
+*
+* REVISIONS:
+* 1.0 (2007-05-28)
+*
+* AUTHOR:
+*
+* PHILIPP HACHTMANN
+*
+*
+* PURPOSE:
+*
+* PROVIDE SIMPLE LIBRARY FUNCTIONS FOR INCREMENTAL PLOTTERS
+*
+*
+* STORAGE:
+*
+* ??? (OCTAL)
+* ??? (DECIMAL)
+*
+*
+* USAGE
+*
+* CALL PL$RST - SET VIRTUAL PLOT POSITION TO ZERO
+*
+* CALL PL$MV - MOVE TO POINT SPECIFIED
+* DAC XN BY XN
+* DAC YN AND YN VALUE
+*
+*
+*
+********************************************************************************
+*
+*
+ SUBR PL$MV,MOVE
+ SUBR PL$RST,RST
+*
+*
+ REL THIS IS A RELOCATABLE OBJECT
+ ORG '0
+*
+*
+RST DAC ** SET POINT ZERO
+ STA X
+ CRA
+ STA Y
+ IMA X
+ JMP* RST
+*
+*
+MOVE DAC ** MOVE YA!
+*
+ LDA* MOVE GET PARAMETERS
+ STA TMP
+ LDA* TMP
+ STA XN
+ SUB X
+ STA DX
+ IRS MOVE
+ LDA* MOVE
+ STA TMP
+ LDA* TMP
+ STA YN
+ SUB Y
+ STA DY
+ IRS MOVE
+ IRS MOVE CORRECT RETURN ADDRESS
+*
+* HLT
+* LDA YN
+* IAB
+* LDA XN
+* HLT
+* JMP 1
+*
+ LDA DX
+ SMI
+ JMP DXP DX POSITIVE
+* DX NEGATIVE
+ TCA
+ STA DX NOW, DX IS POSITIVE!
+ LDA ML
+ STA STPX
+ LDA MUL
+ STA DIYP
+ LDA MDL
+ STA DIYN
+ JMP DXNP
+DXP LDA MR
+ STA STPX
+ LDA MUR
+ STA DIYP
+ LDA MDR
+ STA DIYN
+ JMP DXNP
+*
+DXNP LDA DY
+ SMI
+ JMP DYP DY POSITIVE
+* DY NEGATIVE
+ TCA
+ STA DY NOW, DY IS POSITIVE!
+ LDA MD
+ STA STPY
+ LDA DIYN
+ STA STPD
+ JMP DYNP
+DYP LDA MU
+ STA STPY
+ LDA DIYP
+ STA STPD
+*
+DYNP LDA DX
+ CAS DY
+ JMP XGTY DX GREATER DY
+YGTX NOP DY GREATER OR EQUAL DX
+ LDA STPY
+ STA STPL
+ LDA STPX
+ STA STPS
+ LDA DX
+ STA DS
+ LDA DY
+ STA DL
+ JMP GTE
+*
+XGTY LDA STPY
+ STA STPS
+ LDA STPX
+ STA STPL
+ LDA DX
+ STA DL
+ LDA DY
+ STA DS
+*
+GTE LDA DL LONG DISTANCE
+ LGR 1 DIVIDE BY TWO
+ STA ERR INITIALIZE ERROR COUNTER
+*
+*
+*
+LOOP LDA DL
+ SNZ
+ JMP FNSH END OF WORK - HOPE SO....
+ SUB =1 DECREMENT DL
+ STA DL
+ LDA ERR
+ SUB DS
+ STA ERR
+ SMI SKIP IF NOT OVERFLOWN (MINUS)
+ JMP NDIA NO DIAG STEP
+ ADD DL RELOAD
+ STA ERR
+ LDA DS
+ SUB =1
+ STA DS
+ JST* STPD
+ JMP STEN END OF STEP
+NDIA JST* STPL LONG DIR STEP ONLY
+STEN JMP LOOP RELOOP
+*
+FNSH LDA XN
+ STA X
+ LDA YN
+ STA Y
+ JMP* MOVE END OF THE ROUTINE
+**********************
+*
+* VARIABLES
+*
+X DEC 0 PEN POSITION, X VALUE
+Y DEC 0 PEN POSITION, Y VALUE
+XN DEC 0 NEW PEN POSITION, X VALUE
+YN DEC 0 NEW PEN POSITION, Y VALUE
+DX DEC 0 X DIFFERENCE TO GO
+DY DEC 0 Y DIFFERENCE TO GO
+*
+DL DEC 0 LONG DISTANCE NEGATIVE
+DS DEC 0 SHORT DISTANCE NEGATIVE
+STPL DAC ** ROUTINE TO LONG DISTANCE STEP
+STPS DAC ** ROUTINE TO SHORT DISTANCE STEP
+STPD DAC ** ROUTINE TO DIAGONAL STEP
+ERR DEC 0 ERROR COUNTER
+*
+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
+MU XAC PL$U
+MD XAC PL$D
+ML XAC PL$L
+MR XAC PL$R
+MUL XAC PL$UL
+MUR XAC PL$UR
+MDL XAC PL$DL
+MDR XAC PL$DR
+*
+*
+ END
--- /dev/null
+* (PL$U) REV 1.0 LOW LEVEL INCREMENTAL PLOTTER DRIVER
+*
+*
+* PROGRAM TITLE: PL$U (PL$U, PL$D, PL$L, PL$R, PL$PU, PL$PD,
+* PL$UR,PL$UL,PL$DR,PL$DL)
+*
+* LOW LEVEL PEN PLOTTER ROUTINES
+*
+* REVISIONS:
+* 1.0 (2007-05-27)
+*
+* AUTHOR:
+*
+* PHILIPP HACHTMANN
+*
+*
+* PURPOSE:
+*
+* LOW LEVEL PEN PLOTTER DRIVER ROUTINES PROVIDING HARDWARE
+* ABSTRACTION BY PROVIDING SIMPLE ROUTINES FOR PEN MOVEMENT.
+*
+*
+* STORAGE:
+*
+* ??? (OCTAL)
+* ??? (DECIMAL)
+*
+*
+* USAGE:
+*
+* CALL PL$U - STEP UP
+* CALL PL$D - STEP DOWN
+* CALL PL$L - STEP LEFT
+* CALL PL$R - STEP RIGHT
+* CALL PL$PU - RAISE PEN
+* CALL PL$PD - LOWER PEN
+*
+* CALL PL$UR - STEP UP+RIGHT
+* CALL PL$UL - STEP UP+LEFT
+* CALL PL$DR - STEP DOWN+RIGHT
+* CALL PL$DL - STEP DOWN+LEFT
+*
+*
+*
+********************************************************************************
+*
+*
+PADR EQU '40 PORT ADDRESS OF THE PLOTTER INTERFACE
+*
+*
+ SUBR PL$UP,UP
+ SUBR PL$U,UP
+ SUBR PL$D,DOWN
+ SUBR PL$R,RGHT
+ SUBR PL$L,LEFT
+ SUBR PL$PU,PENU
+ SUBR PL$PD,PEND
+ SUBR PL$UR,UR
+ SUBR PL$UL,UL
+ SUBR PL$DR,DR
+ SUBR PL$DL,DL
+*
+*
+ REL THIS IS A RELOCATABLE OBJECT
+ ORG '0
+*
+*
+OUT DAC ** DO THE MOVEMENT
+ OTA PADR
+ JMP *-1
+ JMP* OUT
+*
+*
+UP DAC **
+ LDA CUP
+ JST OUT
+ JMP* UP
+*
+*
+DOWN DAC **
+ LDA CDWN
+ JST OUT
+ JMP* DOWN
+*
+*
+RGHT DAC **
+ LDA CRGT
+ JST OUT
+ JMP* RGHT
+*
+*
+LEFT DAC **
+ LDA CLFT
+ JST OUT
+ JMP* LEFT
+*
+*
+PENU DAC **
+ LDA CPNU
+ JST OUT
+ JMP* PENU
+*
+*
+PEND DAC **
+ LDA CPND
+ JST OUT
+ JMP* PEND
+*
+*
+UL DAC **
+ LDA CUP
+ ADD CLFT
+ JST OUT
+ JMP* UL
+*
+*
+UR DAC **
+ LDA CUP
+ ADD CRGT
+ JST OUT
+ JMP* UR
+*
+*
+DL DAC **
+ LDA CDWN
+ ADD CLFT
+ JST OUT
+ JMP* DL
+*
+*
+DR DAC **
+ LDA CDWN
+ ADD CRGT
+ JST OUT
+ JMP* DR
+*
+*
+* CONSTANTS
+CUP OCT '1
+CDWN OCT '2
+CLFT OCT '4
+CRGT OCT '10
+CPNU OCT '20
+CPND OCT '40
+*
+*
+ END
--- /dev/null
+C ACH JA, DAS AUCH
+C
+C
+ INTEGER X,Y
+C
+C
+ 1000 CALL PL$RST
+ DO 2000 X=0,600,50
+ CALL LINE(X,-100,X,100)
+ 2000 CONTINUE
+
+ 1500 DO 1600 Y=0,200,50
+ CALL LINE(0,Y-100,600,Y-100)
+ 1600 CONTINUE
+ CALL LINE (0,1,600,1)
+ CALL LINE (0,-1,600,-1)
+C
+ CALL PL$MV(0,0)
+ CALL PL$PD
+ DO 3000 X=0,600
+ TMP=X
+ PHI=(3.141/180.0)*TMP
+ Y=SIN(PHI)*90.0
+ CALL PL$MV(X,Y)
+ 3000 CONTINUE
+ CALL PL$PU
+C
+C
+C
+ CALL PL$MV(0,0)
+ CALL REBOOT
+ END
+C
+C
+C
+ SUBROUTINE LINE(X1,Y1,X2,Y2)
+ INTEGER X1,Y1,X2,Y2
+ CALL PL$MV(X1,Y1)
+ CALL PL$PD
+ CALL PL$MV(X2,Y2)
+ CALL PL$PU
+ RETURN
+ END
+$0
+
+
--- /dev/null
+C PLOTTER TEST PROGRAM
+C
+C
+ CALL PL$RST
+
+ CALL PL$PD
+ CALL PL$MV(610,0)
+ CALL PL$MV(610,95)
+ CALL PL$MV(0,95)
+ CALL PL$MV(0,0)
+ CALL PL$MV(1,1)
+ CALL PL$MV(609,1)
+ CALL PL$MV(609,94)
+ CALL PL$MV(1,94)
+ CALL PL$MV(1,1)
+ CALL PL$PU
+ CALL PL$MV(10,10)
+
+ DO 1000 I=1,10
+ CALL PL$RST
+ CALL PL$PD
+ CALL PL$MV(0,50)
+ CALL PL$MV(25,75)
+ CALL PL$MV(50,50)
+ CALL PL$MV(0,50)
+ CALL PL$MV(50,0)
+ CALL PL$MV(50,50)
+ CALL PL$MV(0,0)
+ CALL PL$MV(50,0)
+ CALL PL$PU
+ CALL PL$MV(60,0)
+ 1000 CONTINUE
+ CALL PL$MV(-540,-10)
+C
+C
+10000 CALL REBOOT
+ END
+$0
--- /dev/null
+C APFELMAENNCHEN-PROGRAMM, 06.FEBRUARY.2007 PHILIPP HACHTMANN
+C INTERMEDIATE VERSION
+C
+C THIS VERSION SHOULD RUN A BIT FASTER BECAUSE THE SQUARE
+C ROOT IS OMMITTED.
+C
+C SWITCH SETTINGS:
+C SENSE-SWITCH 1: IF SET, ASK FOR PARAMETERS
+C SENSE-SWITCH 2: IF SET, DON'T PRINT PARAMETERS ON START
+C SENSE-SWITCH 3: IF SET, RESTORE PARAMETERS TO DEFAULT VALUES
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C COMMON BLOCK DECLARATIONS
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA
+C
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ INTEGER INIT
+ COMMON /PARAM3/INIT
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C CONFIGURATION
+CCCCCC RESET DO DEFAULT VALUES?
+ 110 CALL SSWTCH(3,I)
+ IF (I.EQ.1) CALL RST
+C
+CCCCCC ON THE FIRST START OR IF DESIRED
+ IF(INIT.EQ.0) CALL STVAL
+C
+CCCCCC DO WE HAVE TO ASK FOR PARAMETERS?
+ CALL SSWTCH(1,I)
+ IF (I.EQ.1) CALL GETCFG
+C
+CCCCCC OUTPUT SETTINGS?
+ CALL SSWTCH(2,I)
+ IF(I.EQ.2) CALL OUTCFG
+C
+ WRITE (1,55)
+ 55 FORMAT (1H0)
+C
+ CALL CALC2
+C
+ WRITE(1, 60)
+ 60 FORMAT (5HREADY)
+C
+ PAUSE 7
+ GO TO 110
+ END
+C END OF MAIN PROGRAM
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC THE MANDELBROT SET CALCULATION
+ SUBROUTINE CALC2
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ REAL CMPAVL
+ REAL ZR,ZI,ZRN
+ REAL X,Y
+ INTEGER COUNT
+C
+CCCCCC ENTER THE CALCULATION
+ 299 CMPVAL=MAXVAL*MAXVAL
+ X=LOWX
+ Y=HIGHY
+C
+CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
+ 300 COUNT=0
+ ZR=0.0
+ ZI=0.0
+C
+CCCCCC HIER DER ITERIERTE TEIL
+C
+ 400 ZRN=ZR*ZR-ZI*ZI+X
+ ZI=2.0*ZR*ZI+Y
+ ZR=ZRN
+C
+ IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410
+ COUNT=COUNT+1
+ IF (COUNT.GE.MAXI) GO TO 410
+ GO TO 400
+C
+CCCCCC PUNKT FERTIG
+ 410 IF (COUNT.EQ.MAXI) CALL BLACK
+ IF (COUNT.LT.MAXI) CALL WHITE
+CCCCCC NEUEN PUNKT MACHEN
+ 500 X = X + XSTEP
+CCCCCC ZEILE NOCH NICHT VOLL?
+ IF (X.LE.HIGHX) GO TO 300
+CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
+ X = LOWX
+ CALL PLOTR
+C
+C
+CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
+ Y=Y-YSTEP
+ IF (Y.GE.LOWY) GO TO 300
+C
+CCCCCC HIER IST DAS BILD FERTIG.
+ RETURN
+ END
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+ SUBROUTINE PLOTI
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ CALL PL$UP
+ PEN=0
+ PENX=0
+ RETURN
+ END
+C
+ SUBROUTINE BLACK
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ IF (PEN.EQ.0) CALL PL$PD
+ PEN=1
+ CALL PL$R
+ PENX=PENX+1
+ RETURN
+ END
+C
+ SUBROUTINE WHITE
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ IF (PEN.EQ.1) CALL PL$PU
+ PEN=0
+ CALL PL$R
+ PENX=PENX+1
+ RETURN
+ END
+C
+ SUBROUTINE PLOTR
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ CALL WHITE
+ 8000 IF (PENX.EQ.0) GO TO 8100
+ CALL PL$L
+ PENX=PENX-1
+ GO TO 8000
+ 8100 CONTINUE
+ CALL PL$DN
+ RETURN
+ END
+C
+CCCCCC STARTWERTE AUSFUELLEN
+ SUBROUTINE STVAL
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ INTEGER INIT
+ COMMON /PARAM3/INIT
+C
+ CR = 13
+ LF = 10
+ WIDTH = 500
+ MAXI = 50
+ MAXVAL = 2.0
+ LOWX =-1.48
+ HIGHX = 0.5
+ LOWY =-1.2
+ HIGHY = 1.2
+ INIT = 1
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = XSTEP
+C
+ WRITE (1,1500)
+ 1500 FORMAT (20HDEFAULT VALUES USED.)
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC EINSTELLUNGEN EINLESEN
+ SUBROUTINE GETCFG
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ REAL XIN1,XIN2,YIN1,YIN2
+C
+ WRITE(1,11)
+ READ (1,16) XIN1
+ WRITE(1,12)
+ READ (1,16) XIN2
+ WRITE(1,13)
+ READ (1,16) YIN1
+ WRITE(1,14)
+ READ (1,16) YIN2
+ WRITE(1,15)
+ READ (1,17) MAXI
+C
+ 11 FORMAT(14H X FROM : )
+ 12 FORMAT(14H TO : )
+ 13 FORMAT(14H Y FROM : )
+ 14 FORMAT(14H TO : )
+ 15 FORMAT(14H MAXIT (I3): )
+ 16 FORMAT(F12.0)
+ 17 FORMAT(I3)
+C
+CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
+CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 150 I F(XIN2.GT.XIN1) GO TO 200
+ TEMP = XIN1
+ XIN1 = XIN2
+ XIN2 = TEMP
+C
+CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 200 IF(YIN2.GT.YIN1) GO TO 201
+ TEMP = YIN1
+ YIN1 = YIN2
+ YIN2 = TEMP
+C
+CCCCCC WERTE UEBERNEHMEN
+ 201 LOWX = XIN1
+ HIGHX = XIN2
+ LOWY = YIN1
+ HIGHY = YIN2
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = 2.0 * XSTEP
+C
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC EINSTELLUNGEN AUSGEBEN
+ SUBROUTINE OUTCFG
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ WRITE (1,20)
+ 20 FORMAT (9HSETTINGS:)
+ WRITE (1,30) LOWX, HIGHX
+ 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
+ WRITE (1,40) LOWY, HIGHY
+ 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
+ WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
+ 50 FORMAT ( 4HMAX:,I3,
+ + 8H MAXVAL:,F8.5,
+ + 7H XSTEP:,F8.5,
+ + 7H YSTEP:,F8.5,
+ + 7H WIDTH:,I2)
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC RUECKSETZEN
+ SUBROUTINE RST
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+C
+ WRITE(1,245)
+ 245 FORMAT(25HPARAMETER RESET REQUESTED)
+ INIT=0
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C PRELOAD VALUE OF INIT
+ BLOCK DATA
+ INTEGER INIT
+ COMMON /PARAM3/INIT
+ DATA INIT/0/
+ END
+CCCCCCCCCCCCCCCCCCCCCCCC
+$0
--- /dev/null
+C APFELMAENNCHEN-PROGRAMM, 06.FEBRUARY.2007 PHILIPP HACHTMANN
+C INTERMEDIATE VERSION
+C
+C THIS VERSION SHOULD RUN A BIT FASTER BECAUSE THE SQUARE
+C ROOT IS OMMITTED.
+C
+C SWITCH SETTINGS:
+C SENSE-SWITCH 1: IF SET, ASK FOR PARAMETERS
+C SENSE-SWITCH 2: IF SET, DON'T PRINT PARAMETERS ON START
+C SENSE-SWITCH 3: IF SET, RESTORE PARAMETERS TO DEFAULT VALUES
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C COMMON BLOCK DECLARATIONS
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA
+C
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ INTEGER INIT
+ COMMON /PARAM3/INIT
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C CONFIGURATION
+CCCCCC RESET DO DEFAULT VALUES?
+ 110 CALL SSWTCH(3,I)
+ IF (I.EQ.1) CALL RST
+C
+CCCCCC ON THE FIRST START OR IF DESIRED
+ IF(INIT.EQ.0) CALL STVAL
+C
+CCCCCC DO WE HAVE TO ASK FOR PARAMETERS?
+ CALL SSWTCH(1,I)
+ IF (I.EQ.1) CALL GETCFG
+C
+CCCCCC OUTPUT SETTINGS?
+ CALL SSWTCH(2,I)
+ IF(I.EQ.2) CALL OUTCFG
+C
+ WRITE (1,55)
+ 55 FORMAT (1H0)
+C
+ CALL CALC2
+C
+ WRITE(1, 60)
+ 60 FORMAT (5HREADY)
+C
+ PAUSE 7
+ GO TO 110
+ END
+C END OF MAIN PROGRAM
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC THE MANDELBROT SET CALCULATION
+ SUBROUTINE CALC2
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ REAL CMPAVL
+ REAL ZR,ZI,ZRN
+ REAL X,Y
+ INTEGER COUNT
+C
+CCCCCC ENTER THE CALCULATION
+ 299 CMPVAL=MAXVAL*MAXVAL
+ X=LOWX
+ Y=HIGHY
+C
+CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
+ 300 COUNT=0
+ ZR=0.0
+ ZI=0.0
+C
+CCCCCC HIER DER ITERIERTE TEIL
+C
+ 400 ZRN=ZR*ZR-ZI*ZI+X
+ ZI=2.0*ZR*ZI+Y
+ ZR=ZRN
+C
+ IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410
+ COUNT=COUNT+1
+ IF (COUNT.GE.MAXI) GO TO 410
+ GO TO 400
+C
+CCCCCC PUNKT FERTIG
+ 410 IF (COUNT.EQ.MAXI) CALL BLACK
+ IF (COUNT.LT.MAXI) CALL WHITE
+CCCCCC NEUEN PUNKT MACHEN
+ 500 X = X + XSTEP
+CCCCCC ZEILE NOCH NICHT VOLL?
+ IF (X.LE.HIGHX) GO TO 300
+CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
+ X = LOWX
+ CALL PLOTR
+C
+C
+CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
+ Y=Y-YSTEP
+ IF (Y.GE.LOWY) GO TO 300
+C
+CCCCCC HIER IST DAS BILD FERTIG.
+ RETURN
+ END
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+ SUBROUTINE PLOTI
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ CALL PL$UP
+ PEN=0
+ PENX=0
+ RETURN
+ END
+C
+ SUBROUTINE BLACK
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ CALL PL$R
+ IF (PEN.EQ.0) CALL PL$PD
+ PEN=1
+ CALL PL$UP
+ CALL PL$R
+ CALL PL$DN
+ PENX=PENX+2
+ RETURN
+ END
+C
+ SUBROUTINE WHITE
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ IF (PEN.EQ.1) CALL PL$PU
+ PEN=0
+ CALL PL$R
+ CALL PL$R
+ PENX=PENX+2
+ RETURN
+ END
+C
+ SUBROUTINE PLOTR
+ INTEGER PEN,PENX
+ COMMON /PENSTA/PEN,PENX
+ CALL WHITE
+ 8000 IF (PENX.EQ.0) GO TO 8100
+ CALL PL$L
+ PENX=PENX-1
+ GO TO 8000
+ 8100 CONTINUE
+ CALL PL$DN
+ CALL PL$DN
+ RETURN
+ END
+C
+CCCCCC STARTWERTE AUSFUELLEN
+ SUBROUTINE STVAL
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ INTEGER INIT
+ COMMON /PARAM3/INIT
+C
+ CR = 13
+ LF = 10
+ WIDTH = 100
+ MAXI = 50
+ MAXVAL = 2.0
+ LOWX =-1.48
+ HIGHX = 0.5
+ LOWY =-1.2
+ HIGHY = 1.2
+ INIT = 1
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = XSTEP
+C
+ WRITE (1,1500)
+ 1500 FORMAT (20HDEFAULT VALUES USED.)
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC EINSTELLUNGEN EINLESEN
+ SUBROUTINE GETCFG
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ REAL XIN1,XIN2,YIN1,YIN2
+C
+ WRITE(1,11)
+ READ (1,16) XIN1
+ WRITE(1,12)
+ READ (1,16) XIN2
+ WRITE(1,13)
+ READ (1,16) YIN1
+ WRITE(1,14)
+ READ (1,16) YIN2
+ WRITE(1,15)
+ READ (1,17) MAXI
+C
+ 11 FORMAT(14H X FROM : )
+ 12 FORMAT(14H TO : )
+ 13 FORMAT(14H Y FROM : )
+ 14 FORMAT(14H TO : )
+ 15 FORMAT(14H MAXIT (I3): )
+ 16 FORMAT(F12.0)
+ 17 FORMAT(I3)
+C
+CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
+CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 150 I F(XIN2.GT.XIN1) GO TO 200
+ TEMP = XIN1
+ XIN1 = XIN2
+ XIN2 = TEMP
+C
+CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 200 IF(YIN2.GT.YIN1) GO TO 201
+ TEMP = YIN1
+ YIN1 = YIN2
+ YIN2 = TEMP
+C
+CCCCCC WERTE UEBERNEHMEN
+ 201 LOWX = XIN1
+ HIGHX = XIN2
+ LOWY = YIN1
+ HIGHY = YIN2
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = 2.0 * XSTEP
+C
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC EINSTELLUNGEN AUSGEBEN
+ SUBROUTINE OUTCFG
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ WRITE (1,20)
+ 20 FORMAT (9HSETTINGS:)
+ WRITE (1,30) LOWX, HIGHX
+ 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
+ WRITE (1,40) LOWY, HIGHY
+ 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
+ WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
+ 50 FORMAT ( 4HMAX:,I3,
+ + 8H MAXVAL:,F8.5,
+ + 7H XSTEP:,F8.5,
+ + 7H YSTEP:,F8.5,
+ + 7H WIDTH:,I2)
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC RUECKSETZEN
+ SUBROUTINE RST
+C
+ INTEGER MAXI,WIDTH,CR,LF
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF
+C
+ WRITE(1,245)
+ 245 FORMAT(25HPARAMETER RESET REQUESTED)
+ INIT=0
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C PRELOAD VALUE OF INIT
+ BLOCK DATA
+ INTEGER INIT
+ COMMON /PARAM3/INIT
+ DATA INIT/0/
+ END
+CCCCCCCCCCCCCCCCCCCCCCCC
+$0
--- /dev/null
+C PLOTTER TEST PROGRAM
+C
+C
+C
+ 1000 WRITE (1,1001)
+ 1001 FORMAT (13HPLOTTER TEST!)
+C
+ 1005 DO 6000 J=1,300
+C
+ 1010 CALL PL$U
+ 1011 CALL PL$U
+ 1050 CALL PL$PD
+C
+ 1100 DO 2000 I=1,50
+ 1200 CALL PL$R
+ 2000 CONTINUE
+C
+ 2050 CALL PL$PU
+ 2100 CALL PL$U
+ 2150 CALL PL$U
+ 2170 CALL PL$PD
+C
+ 2200 DO 3000 N=1,50
+ 2300 CALL PL$L
+ 3000 CONTINUE
+C
+ 3100 CALL PL$PU
+C
+ 6000 CONTINUE
+CCCCCCCCCC
+CCCCCCCCCC
+11005 DO 16000 J=1,10
+C
+11010 CALL PL$R
+11011 CALL PL$R
+11050 CALL PL$PD
+C
+11100 DO 12000 I=1,40
+11200 CALL PL$D
+12000 CONTINUE
+C
+12050 CALL PL$PU
+12100 CALL PL$R
+12150 CALL PL$R
+12170 CALL PL$PD
+C
+12200 DO 13000 N=1,40
+12300 CALL PL$U
+13000 CONTINUE
+C
+13100 CALL PL$PU
+C
+16000 CONTINUE
+C
+ 6500 CALL REBOOT
+ 6600 GO TO 1005
+C
+ 7000 END
+$0
--- /dev/null
+C PLOTTER TEST PROGRAM
+C
+C
+ CALL PL$RST
+
+ CALL PL$PD
+ CALL PL$MV(610,0)
+ CALL PL$MV(610,95)
+ CALL PL$MV(0,95)
+ CALL PL$MV(0,0)
+ CALL PL$MV(1,1)
+ CALL PL$MV(609,1)
+ CALL PL$MV(609,94)
+ CALL PL$MV(1,94)
+ CALL PL$MV(1,1)
+ CALL PL$PU
+ CALL PL$MV(10,10)
+
+ DO 1000 I=1,10
+ CALL PL$RST
+ CALL PL$PD
+ CALL PL$MV(0,50)
+ CALL PL$MV(25,75)
+ CALL PL$MV(50,50)
+ CALL PL$MV(0,50)
+ CALL PL$MV(50,0)
+ CALL PL$MV(50,50)
+ CALL PL$MV(0,0)
+ CALL PL$MV(50,0)
+ CALL PL$PU
+ CALL PL$MV(60,0)
+ 1000 CONTINUE
+ CALL PL$MV(-540,-10)
+C
+C
+10000 CALL REBOOT
+ END
+$0
--- /dev/null
+C PLOTTER TEST PROGRAM
+C
+ INTEGER PHI
+ REAL PHIR
+ INTEGER XI,YI
+C
+C
+ 1000 CALL PL$RST
+C
+C
+ DO 2000 PHI=0,360,15
+ CALL PL$MV(0,0)
+ PHIR=PHI
+ X=COS(PHIR)*100.0
+ Y=SIN(PHIR)*100.0
+ XI=X
+ YI=Y
+ CALL PL$PD
+ CALL PL$MV(XI,YI)
+ CALL PL$PU
+ 2000 CONTINUE
+ CALL PL$MV(0,0)
+
+C
+C
+10000 CALL REBOOT
+ END
+$0
+
--- /dev/null
+at ptp /dev/lp0
+d p 37000
+d a 1000
+go
+d a 100
+go
+d a 37577
+go
--- /dev/null
+! rm out.slst
+at ptp out.slst
+
+r
+d p 37000
+d a 1000
+go
+
+d a 100
+go
+d a 36777
+go
projects / h316.git / commitdiff